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 in 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 immedietly after a bullet item continues 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 { title Index } } {
        if ![winfo exists $w] {
            wm title [toplevel $w] Help
            set t [text $w.t -border 5 -relief flat -wrap word \
                    -state disabled -font {Times 10}]
            pack $t -fill both -expand 1

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

        raise $w
        show  $w.t $title
    }

    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}
        puts $title
        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 .
 }

<<categories>> Widget