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}
 }

 console eval {.menubar.help add command -label Help \
               -command {consoleinterp eval {htext::htext .h}}}