** Description **
[Keith Vetter] 2007-06-27 : Here's a nice, tcl only hypertext help system. It was originally based on
[A little hypertext system] which I extended to add more formatting. Recently I upgraded it to use
[tile]'s new treeview widget to add a table of contents paned window.
To explain how to use it, I simply created a help system using this code--just run
the code and you'll see examples and instructions. But basically you just
add pages using '''::Help::AddPage''' then display the help using '''::Help::Help'''.
(The version I'm using includes the ability to read help pages from an
external file, but I left that out of here for simplicity's sake.)
** See Also **
[A Minimal Hypertext Help System]:
** Changes **
[PYK] 2012-12-10: eliminated [update]
** Discussion **
----
[MG] has just put a modified version of this into an app, and it's working (and looking) much better than what I was using before. Thanks :)
[zdia] The code works perfectly with wish 8.5.8 if you comment out the Tile package:
# package require tile 0.7.8
set haveTile078 0
[kevinwalzer] I have a version of this code that supports images and launching a browser or mail client for http:// and mailto:: links, and will gladly share with anyone who asks.
----
[http://wiki.tcl.tk/_repo/wiki_images/hyperhelp.png]
----
** code **
======
##+##########################################################################
#
# Hypertext HelpSystem.tcl -- A help system based on wiki 1194 and tile
# by Keith Vetter, May 2007
#
package require tile 0.7.8
interp alias {} ::button {} ::ttk::button
set haveTile078 1
namespace eval ::Help {
variable W ;# Various widgets
variable pages ;# All the help pages
variable alias ;# Alias to help pages
variable state
variable font {Helvetica 10}
array unset pages
array unset alias
array unset state
array set state {history {} seen {} current {} all {} allTOC {} haveTOC 0}
array set W {top .helpSystem main "" tree ""}
array set alias {index Index previous Previous back Back search Search
history History next Next}
}
## BON HELP
##+##########################################################################
#
# Help Section
#
# Based on http://wiki.tcl.tk/1194
#
# AddPage title aliases text -- register a hypertext page
# Help ?title? -- bring up a toplevel showing the specified page
# or a index of titles, if not specified
#
# Hypertext pages are in a subset of Wiki format:
# indented lines come in fixed font without evaluation;
# blank lines break paragraphs
# a line starting with " * " gets a bullet
# a line starting with " - " gets a dash# a line starting with " 1. " will be a numbered list
# repeating the initial *,- or "1" will indent the list# a line starting with " | " will be an indented block paragraph (one level only)
#
# text enclosed by '''<text>''' is embolden
# text enclosed by ''<text>'' is italics
# all lines without leading blanks are displayed without explicit
# linebreak (but possibly word-wrapped)
# a link is the title of another page in brackets (see examples at
# end). Links are displayed underlined and blue (or purple if they
# have been visited before), and change the cursor to a pointing
# hand. Clicking on a link of course brings up that page.
#
# In addition, you get "Index", "Search" (case-insensitive regexp in
# titles and full text), "History", and "Back" links at the bottom of
# pages.
##+##########################################################################
#
# ::Help::Help -- initializes and creates the help dialog
#
proc ::Help::Help {{title ""}} {
variable W
if {![winfo exists $W(top)]} {
::Help::DoDisplay $W(top)
}
raise $W(top)
::Help::Show $title
}
##+##########################################################################
#
# ::Help::ReadHelpFiles -- reads "help.txt" in the packages directory
# and creates all the help pages.
#
proc ::Help::ReadHelpFiles {dir} {
set fname [file join $dir help.txt]
set fin [open $fname r]
set data [read $fin] ; list
close $fin
regsub -all -line {^-+$} $data \x01 data
regsub -all -line {^\#.*$\n} $data {} data
foreach section [split $data \x01] {
set n [regexp -line {^title:\s*(.*)$} $section => title]
if {! $n} {
WARN "Bad help section\n'[string range $section 0 400]'"
continue
}
set aliases {}
foreach {. alias} [regexp -all -line -inline {^alias:\s*(.*)$} $section] {
lappend aliases $alias
}
regsub -all -line {^(title:|alias:).*$\n} $section {} section
::Help::AddPage $title $aliases $section
}
::Help::BuildTOC
}
##+##########################################################################
#
# ::Help::AddPage -- Adds another page to the help system
#
proc ::Help::AddPage {title aliases body} {
variable pages
variable state
variable alias
set title [string trim $title]
set body [string trim $body "\n"]
regsub -all {\\\n} $body {} body ;# Remove escaped lines
regsub -all {[ \t]+\n} $body "\n" body ;# Remove trailing spaces
regsub -all {([^\n])\n([^\s])} $body {\1 \2} body ;# Unwrap paragraphs
set pages($title) $body
lappend aliases [string tolower $title]
foreach name $aliases { set alias([string tolower $name]) $title }
if {[lsearch $state(all) $title] == -1} {
set state(all) [lsort [lappend state(all) $title]]
}
}
##+##########################################################################
#
# ::Help::DoDisplay -- Creates our help display. If we have tile 0.7.8 then
# we will also have a TOC pane.
#
proc ::Help::DoDisplay {TOP} {
variable state
destroy $TOP
toplevel $TOP
wm title $TOP "Help"
wm transient $TOP .
frame $TOP.bottom -bd 2 -relief ridge
button $TOP.b -text "Dismiss" -command [list destroy $TOP]
pack $TOP.bottom -side bottom -fill both
pack $TOP.b -side bottom -expand 1 -pady 10 -in $TOP.bottom
set P $TOP.p
if {$::haveTile078} { ;# Need tags on treeview
set state(haveTOC) 1
::ttk::panedwindow $P -orient horizontal
pack $P -side top -fill both -expand 1
frame $P.toc -relief ridge
frame $P.help -bd 2 -relief ridge
$P add $P.toc
$P add $P.help
::Help::CreateTOC $P.toc
::Help::CreateHelp $P.help
} else {
set state(haveTOC) 0
frame $P
pack $P -side top -fill both -expand 1
::Help::CreateHelp $P
}
bind $TOP <Map> [list apply { TOP {
bind $TOP <Map> {}
CenterWindow $TOP
}} $TOP]
}
##+##########################################################################
#
# ::Help::CreateTOC -- Creates a TOC display from tile's treeview widget
#
proc ::Help::CreateTOC {TOC} {
variable W
set W(tree) $TOC.tree
scrollbar $TOC.sby -orient vert -command "$W(tree) yview"
#scrollbar $TOC.sbx -orient hori -command "$W(tree) xview"
::ttk::treeview $W(tree) -padding {0 0 0 0} -selectmode browse \
-yscrollcommand "$TOC.sby set" ;#$ -xscrollcommand "$TOC.sbx set"
grid $W(tree) $TOC.sby -sticky news
#grid $TOC.sbx -sticky ew
grid rowconfigure $TOC 0 -weight 1
grid columnconfigure $TOC 0 -weight 1
$W(tree) heading #0 -text "Table of Contents"
$W(tree) tag configure link -foreground blue
# NB. binding to buttonpress sometimes "misses" clicks
#$W(tree) tag bind link <ButtonPress> ::Help::ButtonPress
bind $W(tree) <<TreeviewSelect>> ::Help::TreeviewSelection
::Help::BuildTOC
}
##+##########################################################################
#
# ::Help::CreateHelp -- Creates our main help widget
#
proc ::Help::CreateHelp {w} {
variable W
variable font
set W(main) $w.t
text $w.t -border 5 -relief flat -wrap word -state disabled -width 60 \
-yscrollcommand "$w.s set" -padx 5 -font $font
scrollbar $w.s -orient vert -command "$w.t yview"
pack $w.s -fill y -side right
pack $w.t -fill both -expand 1 -side left
$w.t tag config link -foreground blue -underline 1
$w.t tag config seen -foreground purple4 -underline 1
$w.t tag bind link <Enter> "$w.t config -cursor hand2"
$w.t tag bind link <Leave> "$w.t config -cursor {}"
$w.t tag bind link <1> "::Help::Click $w.t %x %y"
$w.t tag config hdr -font {Times 18 bold}
$w.t tag config fix -font \
"[font actual [$w.t cget -font]] -family Courier"
$w.t tag config bold -font \
"[font actual [$w.t cget -font]] -weight bold"
$w.t tag config italic -font \
"[font actual [$w.t cget -font]] -slant italic"
set l1 [font measure $font " "]
set l2 [font measure $font " \u2022 "]
set l3 [font measure $font " \u2013 "]
set l3 [expr {$l2 + ($l2 - $l1)}]
$w.t tag config bullet -lmargin1 $l1 -lmargin2 $l2
$w.t tag config number -lmargin1 $l1 -lmargin2 $l2
$w.t tag config dash -lmargin1 $l1 -lmargin2 $l2 $w.t tag config bar -lmargin1 $l2 -lmargin2 $l2
bind $w.t <n> [list ::Help::Next $w.t 1]
bind $w.t <p> [list ::Help::Next $w.t -1]
bind $w.t <b> [list ::Help::Back $w.t]
bind $w.t <Key-space> [bind Text <Key-Next>]
# Create the bitmap for our bullet
if {0 && [lsearch [image names] ::img::bullet] == -1} {
image create bitmap ::img::bullet -data {
#define bullet_width 11
#define bullet_height 9
static char bullet_bits[] = {
0x00,0x00, 0x00,0x00, 0x70,0x00, 0xf8,0x00, 0xf8,0x00,
0xf8,0x00, 0x70,0x00, 0x00,0x00, 0x00,0x00
};
}
}
}
##+##########################################################################
#
# ::Help::Click -- Handles clicking a link on the help page
#
proc ::Help::Click {w x y} {
set range [$w tag prevrange link "[$w index @$x,$y] + 1 char"]
if {[llength $range]} {::Help::Show [eval $w get $range]}
}
##+##########################################################################
#
# ::Help::Back -- Goes back in help history
#
proc ::Help::Back {w} {
variable state
set l [llength $state(history)]
if {$l <= 1} return
set last [lindex $state(history) [expr {$l-2}]]
set history [lrange $state(history) 0 [expr {$l-3}]]
::Help::Show $last
}
##+##########################################################################
#
# ::Help::Next -- Goes to next help page
#
proc ::Help::Next {w dir} {
variable state
set what $state(all)
if {$state(allTOC) ne {}} {set what $state(allTOC)} ;# TOC order if we can
set n [lsearch -exact $what $state(current)]
set n [expr {($n + $dir) % [llength $what]}]
set next [lindex $what $n]
::Help::Show $next
}
##+##########################################################################
#
# ::Help::Listpage -- Puts up a help page with a bunch of links (all or history)
#
proc ::Help::Listpage {w llist} {
foreach i $llist {$w insert end \n; ::Help::Showlink $w $i}
}
##+##########################################################################
#
# ::Help::Search -- Creates search help page
#
proc ::Help::Search {w} {
$w insert end "\nSearch phrase: "
entry $w.e -textvar ::Help::state(search)
$w window create end -window $w.e
focus $w.e
$w.e select range 0 end
bind $w.e <Return> "::Help::DoSearch $w"
button $w.b -text Search! -command "::Help::DoSearch $w"
$w window create end -window $w.b
}
##+##########################################################################
#
# ::Help::DoSearch -- Does actual help search
#
proc ::Help::DoSearch {w} {
variable pages
variable state
$w config -state normal
$w insert end "\n\nSearch results for '$state(search)':\n"
foreach i $state(all) {
if {[regexp -nocase $state(search) $i]} { ;# Found in title
$w insert end \n
::Help::Showlink $w $i
} elseif {[regexp -nocase -indices -- $state(search) $pages($i) pos]} {
set p1 [expr {[lindex $pos 0]-20}]
set p2 [expr {[lindex $pos 1]+20}]
regsub -all \n [string range $pages($i) $p1 $p2] " " context
$w insert end \n
::Help::Showlink $w $i
$w insert end " - ...$context..."
}
}
$w config -state disabled
}
##+##########################################################################
#
# ::Help::Showlink -- Displays link specially
#
proc ::Help::Showlink {w link {tag {}}} {
variable state
set tag [concat $tag link]
set title [::Help::FindPage $link]
if {[lsearch -exact $state(seen) $title] > -1} {
lappend tag seen
}
$w insert end $link $tag
}
##+##########################################################################
#
# ::Help::FindPage -- Finds actual pages given a possible alias
#
proc ::Help::FindPage {title} {
variable pages
variable alias
if {[info exists pages($title)]} { return $title }
set title2 [string tolower $title]
if {[info exists alias($title2)]} { return $alias($title2) }
return "ERROR!"
}
##+##########################################################################
#
# ::Help::Show -- Shows help or meta-help page
#
proc ::Help::Show {title} {
variable pages
variable alias
variable state
variable W
set w $W(main)
set title [::Help::FindPage $title]
if {[lsearch -exact $state(seen) $title] == -1} {lappend state(seen) $title}
$w config -state normal
$w delete 1.0 end
$w insert end $title hdr "\n"
set next 0 ;# Some pages have no next page
switch -- $title {
Back { ::Help::Back $w; return}
History { ::Help::Listpage $w $state(history)}
Next { ::Help::Next $w 1; return}
Previous { ::Help::Next $w -1; return}
Index { ::Help::Listpage $w $state(all)}
Search { ::Help::Search $w}
default { ::Help::ShowPage $w $title ; set next 1 }
}
# Add bottom of the page links
$w insert end \n------\n {}
if {! $state(haveTOC) && [info exists alias(toc)]} {
$w insert end TOC link " - " {}
}
$w insert end Index link " - " {} Search link
if {$next} {
$w insert end " - " {} Previous link " - " {} Next link
}
if {[llength $state(history)]} {
$w insert end " - " {} History link " - " {} Back link
}
$w insert end \n
lappend state(history) $title
$w config -state disabled
set state(current) $title
}
##+##########################################################################
#
# ::Help::ShowPage -- Shows a text help page, doing wiki type transforms
#
proc ::Help::ShowPage {w title} {
variable pages
set endash \u2013
set emdash \u2014
set bullet \u2022
$w insert end \n ;# Space down from the title
if {! [info exists pages($title)]} {
set lines [list "This help page is missing."]
} else {
set lines [split $pages($title) \n]
}
foreach line $lines {
set tag {}
set op1 "" if {[regexp {^ +([1*-|]+)\s*(.*)} $line -> op txt]} {
set op1 [string index $op 0]
set lvl [expr {[string length $op] - 1}]
set indent [string repeat " " $lvl]
if {$op1 eq "1"} { ;# Number
if {! [info exists number($lvl)]} { set number($lvl) 0 }
set tag number
incr number($lvl)
$w insert end "$indent $number($lvl)" $tag
} elseif {$op1 eq "*"} { ;# Bullet
set tag bullet
$w insert end "$indent $bullet " $tag
} elseif {$op1 eq "-"} { ;# Dash
set tag dash
$w insert end "$indent $endash " $tag } elseif {$op1 eq "|"} { ;# Bar
set tag bar
}
set line $txt
} elseif {[string match " *" $line]} { ;# Line beginning w/ a space
$w insert end $line\n fix
unset -nocomplain number
continue
}
if {$op1 ne "1"} {unset -nocomplain number}
while {1} { ;# Look for markups
set link0 [set bold0 [set ital0 $line]]
set n1 [regexp {^(.*?)[[](.*?)[]](.*$)} $line -> link0 link link1]
set n2 [regexp {^(.*?)'''(.*?)'''(\s*.*$)} $line -> bold0 bold bold1]
set n3 [regexp {^(.*?)''(.*?)''(\s*.*$)} $line -> ital0 ital ital1]
if {$n1 == 0 && $n2 == 0 && $n3 == 0} break
set len1 [expr {$n1 ? [string length $link0] : 9999}]
set len2 [expr {$n2 ? [string length $bold0] : 9999}]
set len3 [expr {$n3 ? [string length $ital0] : 9999}]
if {$len1 < $len3} {
$w insert end $link0 $tag
::Help::Showlink $w $link $tag
set line $link1
} elseif {$len2 <= $len3} {
$w insert end $bold0 $tag $bold [concat $tag bold]
set line $bold1
} else {
$w insert end $ital0 $tag $ital [concat $tag italic]
set line $ital1
}
}
$w insert end "$line\n" $tag
}
}
##+##########################################################################
#
# ::Help::BuildTOC -- Fills in our TOC widget based on a TOC page
#
proc ::Help::BuildTOC {} {
variable W
variable pages
variable state
set state(allTOC) {} ;# All pages in TOC ordering
if {! [winfo exists $W(tree)]} return
set tocData $pages([::Help::FindPage toc])
$W(tree) delete [$W(tree) child {}]
unset -nocomplain parent
set parent() {}
regsub -all {'{2,}} $tocData {} tocData
foreach line [split $tocData \n] {
set n [regexp {^\s*(-+)\s*(.*)} $line => dashes txt]
if {! $n} continue
set isLink [regexp {^\[(.*)\]$} $txt => txt]
set pDashes [string range $dashes 1 end]
set parent($dashes) [$W(tree) insert $parent($pDashes) end -text $txt]
if {$isLink} {
$W(tree) item $parent($dashes) -tag link
set ptitle [::Help::FindPage $txt]
if {[lsearch $state(allTOC) $ptitle] == -1} {
lappend state(allTOC) $ptitle
}
}
}
}
##+##########################################################################
#
# ::Help::ButtonPress -- Handles clicking on a TOC link
# !!! Sometimes misses clicks, so we're using TreeviewSelection instead
#
proc ::Help::ButtonPress {} {
variable W
set id [$W(tree) selection]
set title [$W(tree) item $id -text]
::Help::Show $title
}
##+##########################################################################
#
# ::Help::TreeviewSelection -- Handles clicking on any item in the TOC
#
proc ::Help::TreeviewSelection {} {
variable W
set id [$W(tree) selection]
set title [$W(tree) item $id -text]
set tag [$W(tree) item $id -tag]
if {$tag eq "link"} {
::Help::Show $title
} else { ;# Make all children visible
set last [lindex [$W(tree) children $id] end]
if {$last ne {} && [$W(tree) item $id -open]} {
$W(tree) see $last
}
}
}
proc CenterWindow {w} {
wm withdraw $w
set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- [winfo vrootx [winfo parent $w]]]
set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- [winfo vrooty [winfo parent $w]]]
wm geom $w +$x+$y
wm deiconify $w
}
################################################################
#
# Debugging routines
#
##+##########################################################################
#
# ::Help::Reset -- (for testing), resets all help info
#
proc ::Help::Reset {} {
variable W
variable state
variable pages
variable alias
array unset pages
array unset state
array set state {history {} seen {} current {} all {} allTOC {}}
array unset alias
foreach title {Back History Next Previous Index Search} {
set alias([string tolower $title]) $title
}
destroy $W(top)
}
##+##########################################################################
#
# ::Help::Sanity -- Checks for missing help links
#
proc ::Help::Sanity {} {
variable state
set missing {}
foreach page $state(all) {
set m [::Help::CheckLinks $page]
if {$m ne {}} {
puts "$page: $m"
set missing [concat $missing $m]
}
}
return $missing
}
##+##########################################################################
#
# ::Help::CheckLinks -- Checks one page for missing help links
#
proc ::Help::CheckLinks {title} {
variable pages
variable alias
set missing {}
set title [::Help::FindPage $title]
foreach {. link} [regexp -all -inline {\[(.*?)\]} $pages($title)] {
if {! [info exists alias([string tolower $link])]} {
lappend missing $link
}
}
return $missing
}
proc WIKIFIX {txt} {
regsub -all {\n } $txt "\n" txt
return $txt
}
## EON HELP
################################################################
################################################################
::Help::AddPage "Table of Contents" TOC [WIKIFIX {
- [Welcome to the Help System]
- [What's New]
- Formatting
-- [Basic Formatting]
-- [Aliases]
-- [Lists]
- [Creating the TOC]
- [To Do]
}]
::Help::AddPage "Welcome to the Help System" overview [WIKIFIX {
This is a simple hypertext help system.
It's based on ''A Little Hypertext System'' so it includes:
* Hyperlinks to other help pages
* Simple searching ability
* History
* Simple wiki formatting
This new version also includes (see [What's New])
* [Table of Contents]
* Hypertext [aliases]
* [Multi-level Lists]
11. numeric lists
** bullet lists
-- dash list
* '''Bold text'''
* ''Italic text''
}]
::Help::AddPage "What's New" "" [WIKIFIX {
Here are some features of this help system not found in the previous version:
* Table of Content
* Bullets
* Multiple levels of indentation
-- like this
-- ''and this''
--- '''and even this'''
* Aliases
-- So this link [Welcome to the Help System]
-- is the same as this link [Overview]
}]
::Help::AddPage "Basic Formatting" "Formatting" [WIKIFIX {
The formatting code for the help pages follows much like the
tcler's wiki.
'''Links, lists, bold, italics, unformatted''' are
all done the same way.
| You can also have block paragraphs by prefixing the first line
with a " | ". It will wrap the text and indent all the lines. Only
one level of indentation can be requested.
[Aliases] and [multi-level lists] are only slightly more complicated.
}]
::Help::AddPage "Aliases" {alias} [WIKIFIX {
''Aliases'' allow the same page to be referenced by different names.
So this link [Welcome to the Help System]
is the same as this link [Overview].
}]
::Help::AddPage "Multi-level Lists" "lists" [WIKIFIX {
1. numbered list
1. numbered list
11. numbered list
11. numbered list
1. numbered list
1. numbered list
* bullet list
** nested bullet list
** nested bullet list
* bullet list
- dash lists
-- nested dashed list
-- nested dashed list
- dash lists
}]
::Help::AddPage "Creating the TOC" "" [WIKIFIX {
The '''Table of Content''' is a just a help page with the
name (or [alias]) '''TOC''' which gets displayed in a
tile treeview widget. You can also view the [TOC] as a
normal help page.
Each line of the TOC help page that begins with a dash becomes
a node in the treeview. The level of indentation dictates the
tree structure.
}]
::Help::AddPage "To Do" {} [WIKIFIX {
1. Visual clues in TOC about what is a link (don't know treeview well enough to do this)
1. Mouse buttons 4 & 5 do history back and forward like Firefox and IE
1. Image support--not hard, I just haven't needed it
1. msgcat support
1. read help data from separate file (actually this is done, but for simplicity I omitted here)
}]
################################################################
::Help::Help overview
return
======
[RLE] 2010-08-25 - Applying the following .diff to the above code will add one more operator to the wiki syntax, the " | " operator, which will create a block indented paragraph. Currently only one level of indent is supported.
======
---[KPV] hth.tcl.orig 2010-08-25 14:27:51.000000000 -0400
+++ hth.tcl 2010-08-25 14:28:32.000000000 -0400
@@ -42,6 +42,7 @@
# a line starting with " - " gets a dash
# a line starting with " 1. " will be a numbered list
# repeating the initial *,- orI "1" will indent the list
+ # a line starting with " | " will simply be an indented block paoragraph (only one level of indent at the moment)
#
# text enclosed by '''<text>''' is embolden
# text enclosed by ''<text>'' is italics
@@ -225,6 +226,7 @@
$w.t tag config bullet -lmargin1 $l1 -lmargin2 $l2
$w.t tag config number -lmargin1 $l1 -lmargin2 $l2
$w.t tag config dash -lmargin1 $l1 -lmargin2 $l2
+ $w.t tag config bar -lmargin1 $l2 -lmargin2 $l2
bind $w.t <n> [list ::Hhelp::Next $w.t 1]
bind $w.t <p> [list ::Help::Next $w.t -1]
@@ -420,7 +422,7 @@
foreach line $lines {
set tag {}
set op1 ""
- if {[regexp {^ +([1*-]+)\s*(.*)} $line -> op txt]} {
+ if {[regexp {^ +([1*-|]+)\s*(.*)} $line -> op txt]} {
set op1 [string index $op 0]
set lvl [expr {[string length $op] - 1}]
set indent [string repeat " " $lvl]
@@ -435,6 +437,8 @@
} elseif {$cop1 eq "-"} { ;# Dash
set tag dash
$w insert end "$indent $endash " $tag
+ } elseif { $op1 eq "|" } { ; # Bar
+ set tag bar
}
set line $txt
} elseif {[string match " *" $line]} { ;# Line beginning w/ a space
======.
<<categories>> Documentation | Command | Widget