---- [http://mini.net/files/htext_ppc.jpg] set docu(htext) {Richard Suchenwirth 2006-01-18 - Here's an update, tweaked for [eTcl] on [PocketPC], of the [htext] simple hypertext system that you might use for online help. It exports a single command: htext::htext (widget) ?title? brings up a toplevel showing the specified page (or an alphabetic index of titles, if not specified). Thus you can use it for context-sensitive help. You create help pages by just assigning to the global [[::docu]] array. 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. In a nutshell, you get a tiny browser, an information server, and a search engine ;-) See also [[htext format]]. } set {docu(htext format)} { The htext hypertext pages stored in the [::docu] array are in a subset of Wiki format: * indented lines come in fixed font without evaluation; * blank lines break paragraphs * 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). } set docu(::docu) { This global array is used for storing htext pages. The advantage is that source files can be documented just by assigning to ::docu fields, without creating a dependency on htext. After creating a htext widget, all docu documentation is instantly available. If you wish to have spaces in title, brace the whole thing: set {docu(An example)} {...} } package require Tk namespace eval htext { variable history {} seen {} proc htext {w args} { if ![winfo exists $w] { wm title [toplevel $w] Help scrollbar $w.y -command "$w.t yview" text $w.t -border 5 -relief flat -wrap word \ -state disabled -font {Tahoma 10} -yscr "$w.y set" pack $w.y $w.t -side right -fill y -expand 1 wm geometry $w 240x268+0+26 bind $w [list event generate $w ] bind $w [list event generate $w ] set w $w.t } $w tag config link -foreground blue -underline 1 $w tag config seen -foreground purple4 -underline 1 $w tag bind link <1> "[namespace current]::click $w %x %y" $w tag config hdr -font {Tahoma 14} $w tag config fix -font {Courier 9} raise $w if ![llength [array names ::docu $args]] {set args Index} show $w $args } proc click {w x y} { set range [$w tag prevrange link [$w index @$x,$y]] if [llength $range] {show $w [eval $w get $range]} } proc back w { variable history set l [llength $history] set last [lindex $history [expr $l-2]] set history [lrange $history 0 [expr $l-3]] show $w $last } proc listpage {w list} { foreach i $list {$w insert end \n; showlink $w $i} } proc search w { $w insert end "\nSearch phrase: " entry $w.e -textvar [namespace current]::search -font {Tahoma 10} $w window create end -window $w.e focus $w.e $w.e select range 0 end bind $w.e "htext::dosearch $w" button $w.b -text Search! -command "htext::dosearch $w" -pady 0 $w window create end -window $w.b catch {wce sipshow} ;# eTcl/PPC only } proc dosearch w { variable search catch {wce siphide} ;# eTcl/PPC only $w config -state normal $w insert end "\n\nSearch results for '$search':\n" foreach i [lsort [array names ::docu]] { if [regexp -nocase $search $i] { $w insert end \n; showlink $w $i ;# found in title } elseif [regexp -nocase -indices -- $search $::docu($i) pos] { regsub -all \n [string range $::docu($i) \ [expr [lindex $pos 0]-20] [expr [lindex $pos 1]+20]] \ " " context $w insert end \n showlink $w $i $w insert end " - ...$context..." } } $w config -state disabled } proc showlink {w link} { variable seen set tag link if {[lsearch -exact $seen $link]>-1} { lappend tag seen } else {lappend seen $link} $w insert end $link $tag } proc show {w title} { variable history $w config -state normal $w delete 1.0 end $w insert end $title hdr \n switch -- $title { Back {back $w; return} History {listpage $w $history} Index {listpage $w [lsort -dic [array names ::docu]]} Search {search $w} default { if {![info exists ::docu($title)]} { $w insert end "404 - This page was referenced but not written yet." } else { set var 1 foreach i [split $::docu($title) \n] { if [regexp {^[ \t]+} $i] { if $var {$w insert end \n\n; set var 0} $w insert end $i\n fix continue } set i [string trim $i] if ![string length $i] {$w insert end \n\n; continue} if !$var {$w insert end \n} set var 1 while {[regexp {([^[]*)[[]([^]]+)[]](.*)} $i \ -> before link after]} { $w insert end "$before " {} showlink $w $link set i $after } $w insert end "$i " } } } } $w insert end \n------\n {} Index link " - " {} Search link if [llength $history] { $w insert end " - " {} History link " - " {} Back link } $w insert end \n lremove history $title ;# make sure it's in only once lappend history $title $w config -state disabled } } ;# end namespace htext proc lremove {_list el} { upvar 1 $_list list set pos [lsearch -exact $list $el] set list [lreplace $list $pos $pos] } if {[file tail [info script]]==[file tail $argv0]} { htext::htext .h htext wm withdraw . bind .h {exec tclsh $argv0 &; exit} } ---- This extra line adds the call to htext in eTcl's console menu: console eval {.menubar.help add command -label Help \ -command {consoleinterp eval {htext::htext .h}}} ---- [Category Widget]