[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.) ---- ##+########################################################################## # # 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://mini.net/tcl/1194.html # # 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 # # text enclosed by '''''' is embolden # text enclosed by '''' 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 } CenterWindow $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 ::Help::ButtonPress bind $W(tree) <> ::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 "$w.t config -cursor hand2" $w.t tag bind link "$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 bind $w.t [list ::Help::Next $w.t 1] bind $w.t

[list ::Help::Next $w.t -1] bind $w.t [list ::Help::Back $w.t] bind $w.t [bind Text ] # 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 "::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 } 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 update idletasks 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. [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 ---- [Category Documentation] | [Category Command] | [Category Widget]