Updated 2012-01-16 04:23:54 by RLE

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 <Up>   [list event generate $w <Prior>]
                bind $w <Down> [list event generate $w <Next>]
            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 <Return> "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 <Escape> {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}}}

For an editable alternative, see a pocket Wiki