Updated 2006-11-12 11:08:45

set docu(htext) { Richard Suchenwirth - Here's an update to a 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].

Formatting upgrade by John Roll } set {docu(htext format)} { The htext hypertext pages stored in the [::docu] array are similar to Wiki format:

  • *Fixed format for code* indented lines come in fixed font without evaluation
  • *Formatted 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.
  • [Bold format] is enabled by wrapping words with *.
  • [Italic format] is enabled by wrapping words with ~.
  • *Blank lines break paragraphs*
  • *Single Level Bullet Lists* are created by beginning a line with *. Indented lines immediately after a bullet item continue that bullet description.

}
 set {docu(Bold format)} {For example this text is unformatted when indented:

  *This phrase is bold*
  ~This phrase is italic~

But appears formatted and wrapped when flush left:

*This phrase is bold* ~This phrase is italic~
 }
 set {docu(Italic format)} {For example this text is unformatted when indented:

  *This phrase is bold*
  ~This phrase is italic~

But appears formatted and wrapped when flush left:

*This phrase is bold* ~This phrase is italic~
 }

 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)} {...}
 }

 namespace eval htext {
    namespace export htext
    variable history {} seen {}
    proc htext {w args} {
        if ![winfo exists $w] {
            wm title [toplevel $w] Help
            text $w.t -border 5 -relief flat -wrap word \
                    -state disabled -font {Times 10}
            pack $w.t -fill both -expand 1
            set w $w.t
        } else {
            raise $w
        }

        $w tag config link -foreground blue -underline 1
        $w tag config seen -foreground purple4 -underline 1
        $w tag bind link <Enter> "$w config -cursor hand2"
        $w tag bind link <Leave> "$w config -cursor {}"
        $w tag bind link <1> "[namespace current]::click $w %x %y"
        $w tag config hdr    -font {Times 18}
        $w tag config fix    -font {Courier 10}
        $w tag config italic -font {Times 12 italic}
        $w tag config bold   -font {Times 12 bold}
        $w tag config plain  -font {Times 12}
        $w tag config dtx    -lmargin1 20 -lmargin2 20
        $w tag config bullet -font {Courier 8 bold} -offset 3 -lmargin1 10

        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
        $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
    }
    proc dosearch w {
        variable search
        $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 { tags {} } } {
        variable seen
        set tag "link $tags"
        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 0
                set dtx {}
                foreach i [split $::docu($title) \n] {
                    if { ![string compare $dtx {}] } {
                        if [regexp {^[ \t]+} $i] {
                            $w insert end $i\n fix
                            set var 0
                            continue
                        }
                    }
                    set i [string trim $i]

                    if { ![string length $i] } {
                        $w insert end "\n" plain
                        if { $var } { $w insert end "\n" plain }
                        set dtx {}
                        continue
                    }

                    if { [regexp {^[*] (.*)} $i -> i] } {
                        if { !$var || [string compare $dtx {}] } {
                            $w insert end \n plain }
                        $w insert end "o " bullet
                        set dtx dtx
                    }

                    set var 1
                    regsub {]} $i {[} i
                    while {[regexp {([^[~*]*)([*~[])([^~[*]+)(\2)(.*)} $i \
                        -> before type marked junked after]} {
                        $w insert end $before "plain $dtx"
                        switch $type {
                         {~} { $w insert end "$marked " "italic $dtx" }
                         {*} { $w insert end "$marked " "bold   $dtx" }
                         {[} {    showlink $w $marked   "plain $dtx"}
                        }
                        set i $after
                    }
                    $w insert end "$i " "plain $dtx"
                }
            }
        }
      }
      $w insert end \n------\n {} Index link " - " {} Search link
      if [llength $history] {
          $w insert end " - " {} History link " - " {} Back link
      }
      $w insert end \n
      lappend history $title
      $w config -state disabled
    }
 } ;# end namespace htext

 if {[file tail [info script]]==[file tail $argv0]} {

     htext::htext .h htext
     wm withdraw .
 }

Category Widget