A little hypertext system
An updated version of this is at htext which also allows embedded help windows and documentation
Richard Suchenwirth - Here's a simple hypertext system that you might use for online help. It exports two commands:
hpage (title) (text) ;# register a hypertext page's title and text body htext (widget) ?title? ;# bring 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. Hypertext pages 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).
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 ;-)
IDG This is really nice - thanks Richard. However there is an off-by-1 error. When you click on the very first character of a link word, it jumps to the preceeding link. This can be fixed with the following modification to proc click
set range [$w tag prevrange link "[$w index @$x,$y] + 1 char"]
}
namespace eval htext {
namespace export hpage htext
variable pages
variable history {} seen {}
proc hpage {title body} {
variable pages
set pages($title) $body
}
proc htext {w args} {
if ![winfo exists $w] {
wm title [toplevel $w] Help
text $w.t -border 5 -relief flat -wrap word -state disabled
pack $w.t -fill both -expand 1
$w.t tag config link -foreground blue -underline 1
$w.t tag config seen -foreground purple4 -underline 1
$w.t tag bind link <Enter> "$w.t config -cursor hand2"
$w.t tag bind link <Leave> "$w.t config -cursor {}"
$w.t tag bind link <1> "[namespace current]::click $w.t %x %y"
$w.t tag config hdr -font {Times 16}
$w.t tag config fix -font {Courier 9}
}
raise $w
variable pages
if ![llength [array names pages $args]] {set args Index}
show $w.t $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
variable pages
$w config -state normal
$w insert end "\n\nSearch results for '$search':\n"
foreach i [lsort [array names pages]] {
if [regexp -nocase $search $i] {
$w insert end \n; showlink $w $i ;# found in title
} elseif [regexp -nocase -indices -- $search $pages($i) pos] {
regsub -all \n [string range $pages($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
}
$w insert end $link $tag
}
proc show {w title} {
variable pages
variable history
variable seen
if {[lsearch -exact $seen $title]==-1} {lappend seen $title}
$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 [array names pages]]}
Search {search $w}
default {
set var 1
foreach i [split $pages($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
lappend history $title
$w config -state disabled
}
}# Example test code (please ignore the links below):
namespace import htext::*
hpage Test {This is a help page with a Reference. Before this sentence came a hard linebreak.
This is after an empty line. }
hpage Reference {This is another page which points back to [Test] and to [Index]. It also shows a
code example [which should come in Courier] and has two lines that should stay close together
and back in normal text. }
hpage Foo {Frequent but undefined word. See also [Bar]}
hpage Bar {Place to drink, for example. Have you checked [Foo]?}
hpage "Two words" {Just checking - [Foo] and [Bar].}
htext .h
Since my help texts are fairly long sometimes, I added a scrollbar.
Just change two lines of proc htext:
...
text $w.t -border 5 -relief flat -wrap word -state disabled
pack $w.t -fill both -expand 1
...to
...
text $w.t -border 5 -relief flat -wrap word -state disabled \
-yscrollcommand "$w.s set"
scrollbar $w.s -orient vert -command "$w.t yview"
pack $w.t -fill both -expand 1 -side left
pack $w.s -fill y -side left
...