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 '''<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
}
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 <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
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} { 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
}
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: -- like this
-- ''and this''
--- '''and even this''' -- 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 { - 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