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