[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.) NB. there is some formatting confusion for the demo code below because both this Wiki and this code have special meaning for leading whitespace. Hence the need for '''WIKIFIX''' below. ---- ##+########################################################################## # # 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]