1
################################################################################
3
# Project : Help System
5
# Developed by : Andrei A. Gratchev <grand@deversys.com>
9
# Description : Help system based on HTML & HTML viewer
11
################################################################################
13
package provide help 1.5
21
variable curfilename ""
28
variable font "Helvetica"
29
variable fontfixed "Courier"
32
variable forecolor black
33
variable linkcolor "#006800"
34
variable alinkcolor "#c00000"
42
array set _images "broken [image create photo -data "R0lGODlhIAAgALP/AP///8DAwP8A/7+/v39/f38AfwD//wB/AAAA/wAAfwAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAEALAAAAAAgACAAAAT/kMhJq50h60yA/2AoAtKmdWMqEgNhBuggz3Rdd60Z35NNx66Th3c4EBJI1u2T4wxnEhLyk/yBmjsZwZgYJZStUC7bOnRTX5lizV7Dntrj54iSQiuKN+B3BiAVUx5pcRN5ZAN9CQoSiWAzHoZwMkiUjHWDNJB6NhVfc5iPAJF7PpYgioWhoy0+np8ECAaoMppACjZ9UosGCKgstUMdtzR9R7sIvYu/opsow5NUx8i+A8B7HQKiM5RJvMjJEtXMQAAC2cPcX9/TyuKr2AIF2o3p1NZh5gXnjW1s4ffY9MUT0OjCv3HBABRYyDCdwYPv4j0M54MWwj39Mj6r6G5Ti4mOGHzcI/SQY8c6KlKOGKWyJYg8GmPK1BggAgA7"]
43
disc [image create photo -data "R0lGODlhEAAFAID/AMDAwAAAACH5BAEAAAAALAAAAAAQAAUAAAINhA+hyKff2FvRzYogKwA7"]
44
circle [image create photo -data "R0lGODlhEAAHAID/AMDAwAAAACH5BAEAAAAALAAAAAAQAAcAAAIShA+hyBfe0JPRTFivrbvztDAFADs="]
45
square [image create photo -data "R0lGODlhEAAFAID/AMDAwAAAACH5BAEAAAAALAAAAAAQAAUAAAINhB+Zx6zb2gtRvuouKwA7"]
46
ugol [image create photo -data "R0lGODlhDAAMAJH/AP///8DAwH9/fwAAACH5BAEAAAEALAAAAAAMAAwAAAIbjI8BmSB83IMSKvFWw3dnHnFV+GVGhZZXmaoFADs="]
47
d1 [image create photo -data "R0lGODlhEAAQAPf/AP///////P//+///7///6f//5f//5P//4f//3P//2f//0v//z///zv//zf//zP//y///yv//yf//x///xv//xf//xP//wv/+5v/+1f/82//82v/81//81v/81f7/8/783v373Pv9x/v9vfr9zPn5+vn5+fn57/n57ff7yfX4v/T68uv0w+Dvrdvtr9TU19TU0dTT19PptNLS1dLS0tLS0dLSz8znoczMzszMzMvLy8nkxsnIksjjw8fHx8fHwMbGxsLCwsHBwcDAwL+/v76+vri4uLbiyLGxsbCwsK+vr6ampqWlpaGhoaCgoJaWmJaWlpOTk5KSko+Pj4yMjIvFa4mJiX7HsHq+YXJycmy2WmmzRmSyV2Cfe16uN1udkVqsM1RUVE2XhExJTkpIPkhFSURBRkI/R0I/RkGgFD2dEzo4OSWSCiKQAB0cHRyAaxcWFwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAEAAQAAAI0QDhCBxIsOAQOEESKly4EAAcIEeiPJn4xIkTKEp+EBniEEgTHCVCkjhhwgWYKTmIdGQyA4BLDxUY+LiBpcqPlS1dKuiiYscYMW+KrJRhgICOLWy+KHgQgEySlTUcpHBjJA0PBREwnEECdcEKLgVYJAghYcPWlTQAHBABocUHLw0ynH3IhKiFEVS0WAkTdy4QJjUeOIixBk0WFGXnBmHyogGFBTauDJggQStXOD2WwLiQgQMCEBo2dBDg1KEQKWrKnDFj5sxqM2TaCOXosrbt2wEBADs="]
48
d2 [image create photo -data "R0lGODlhEAAQAPf/AP///////f///P//+///9///8v//5v//5P//4///4f//3///3f//2///2f//2P//1P//0P//zv//y///yv//yf//yP//x///xf//w///wP/+5f/+2f/+1f/82//81//81v/81f7+v/v96vv9zPn7yPn5+vn5+fn57/n57fj8uPb7xvT7xvH3/vH2wNrvldTpndTU19TU0dTT19LpxtLS1dLS0tLS0dLSz8/pgc/MkMzMzszMzMvLy8nmrsnfwsfHx8fHwcbGxsLCwsHiq8HBwcDAwL+/v76+vr3hpby8vLvdrri4uLe4t7XadLKysrGxsbCwsK+wr6+vr6ampqWlpaPGwKLYlaGhoaCgoJaWmJaWlpOTk5KSko+Pj43FdIyMjImJiX/FiXmtp3PAW3Jycm2jp2y2RGu2T2ayRlafmFRUVFBLRkxITkmNdUhFSURBRkI/R0I/RkCfLT6eHzo4OTeCgSGQCB0cHRcWFxOJAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAEAAQAAAI2gD3CBxIsOCOPUQSKlyo0AiAPUKecNFCUUuWLFumBDly5KEQLDtMiCyB4gQMNV94BPF4pQaAlwQyTACigwyYJSxdAihQwYCDHGvY4JHCksYBBiTEpBnTAwcAN1BY3pBwwUcbFmfyIFkQJyrEKzciQHCQ4MUcO0MUdGVpI8AMJU1SqBARosParzYEoNHjpUELDBbsehUCdoEZOWHK1BlRwcNdIldiPHCxwkqVFRQscIhDdM8PKjI0INigwACDDyAGuMG5p0gXOm/iwIETRzYcN3cc7njJu7dvAAEBADs="]
49
d3 [image create photo -data "R0lGODlhEAAQAPf/AP///////P//+v//9f//7///6///5f//4f//4P//2///2P//0P//z///zf//zP//y///yv//yf//yP//x///xv//xf//w//+5v/+3f/+2v/+2f/+1f/91//82//81//81vz+zPz9y/v98vn5+vn5+fn57/n57fj7w/j7wvj7ufb62O33tOn2oefzv+PxntTU19TU0dTT19LS1dLS0tLS0dLSz9DjxczMzszMzMvLy8nfxsjIjcfHx8fHwcbiocbGxsLCwsHBwcDZ0sDAwL+/v77htr6+vrvfrbrijLncsri4uLbTtbXbirLYhrGxsbCwsK+vr6jUeqampqWlpaHM0aGhoaCgoJjJx5aWmJaWlpOTk5KSko+Pj4yMjImJiXS5WnJycmq0UWSxOla0aFRUVFGsSExJTkukM0pIPkhFSUeRhERBRkKQlkI/R0I/Rj2eGzo4OSSRAB0cHRcWFxKIABFragB/AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAEAAQAAAI1wDvCBxIsCCRO0ESKlyokAiAO0CcbMlCMQsWLFqk/DBi5CEQKzhIiBxhosQLMl1y/PBYZQaAlwMsQOhxA4wXJSxdvjxQYcEONGbmQGEpg0CUMF9ATFgAIUCaJyxrMPBBJ44IFDYebHADFWKVGgrGFBGT4kQdHRq4sqQBgI0QBy5UULlyQK1XGQaWqEnQ5EwZJAjsAvn6IEIIBUnsvGnBwW6QKjAaUJAQYcURJiwUuBl6h8eUGBc6ePiAocCBDALS4LwzhAucNW7atHETu00aOQ4dvtzNu3dAADs="]
51
back [image create photo -data "R0lGODlhDwANAKL/AM///8DAwJD//y/I/y+X/y9n/wAAAAAAACH5BAEAAAEALAAAAAAPAA0AAAM0GLq2/qE0+AqYVFmB6eZFKEoRIAyCaaYCYWxDLM9uYBAxoe/7dA8ug3AoZOg6mRsyuUxmEgA7"]
52
forward [image create photo -data "R0lGODlhDwANAKL/AM///8DAwJD//y/I/y+X/y9n/wAAAAAAACH5BAEAAAEALAAAAAAPAA0AAAM3GLpa/K8YSMuYlBVwV/kgCAhdsAFoig7ktA1wLA9SQdw4DkuB4f8/Ag2TMRB4GYUBmewRm09FAgA7"]
53
stop [image create photo -data "R0lGODlhDQANALP/AP///1Lq81I5Of+EhCEAAHsAAMYAAP+UQv9zCHuMjP8AMf8AKf+MnK1CSv8QIQAAACH5BAEAAAEALAAAAAANAA0AAARWMMjUTC1J6ubOQYdiCBuIIMuiiCT1OWu6Ys05AMPC4ItBGB8dYMdI+RoHR4qY6v1CwlvRcEQ4brndwFAgJAwIRdPIzVTEYiqXJBEU1FQCW5Mg2O0ZSQQAOw=="]
54
refresh [image create photo -data "R0lGODlhDAANALP/AP///zk5OVJSUoSEhKWlpcDAwP//1v//xr3erZTOezGcEFKtSimce3NzezkxOQAAACH5BAEAAAUALAAAAAAMAA0AAARRcJBJyRilEMC5AcjQaB1wHMYkCFuXLKDQONsBLIuynEBAGAcJAnYy0AyGBOLENPg4qGUISTMdEIoEg4A6ohK6BND4YyqBqCdyve453vB44BEBADs="]
56
inc [image create photo -data "R0lGODlhDAAMAJECAICAgAAAAP///wAAACH5BAEAAAIALAAAAAAMAAwAAAIglH+BphxtQADi2fTWkY9qdS2S42HWtECVOmJleGqyUQAAOw=="]
57
dec [image create photo -data "R0lGODlhDAAMAJECAICAgAAAAP///wAAACH5BAEAAAIALAAAAAAMAAwAAAIalC+hirjdApyUygoCqG/mtEEL03yGFjHdUQAAOw=="]
58
cont [image create photo -data "R0lGODlhDAAMALMAADg4ONDQ0AEBAZqamv///4aGhrCwsGdnZ2wCAgCYmIaenoaGnj8/BJiYAAQ/P56GhiH5BAAAAAAALAAAAAAMAAwAAARBkAwhACGADqJJOEcgUcAwAGVxKQiSeoKBGqQ5C2JxvkF8VwPVSLRoMEq74GUCVPU2hEfCAaABTxTSBYbbZrJgcAQAOw=="]
59
index [image create photo -data "R0lGODlhDAAMAKIEAACAAP//AP///wAAAP///wAAAAAAAAAAACH5BAEAAAQALAAAAAAMAAwAAAMpSLM89G+IMMWCimrpogWAxURaRXUcqAZoWaKfCrCkWcGDPLf2GTVAQgIAOw=="]
60
find [image create photo -data "R0lGODlhDAAMAJEDAMDAwP///wAAAP///yH5BAEAAAMALAAAAAAMAAwAAAIgnI8oaysa3hDxuMtadFtegE3UAnYYh3XiuGzQqTjJPBQAOw=="]
61
search [image create photo -data "R0lGODlhDAAMALMPADExMP//j2hoaGFhLgEBAYWFhe3t7a2tqv39aNPT0xcXFqGhH1BQXCoqHQgICv///yH5BAEAAA8ALAAAAAAMAAwAAARV8LR2kk3m6RZCGeAgaA/QIV0HkByKBgiQlafSLIECHA8XHAoBY6Eo8BggR4HAXMoMlgaAIJAyExoB4UAFJJiOLIMJUAKmWYNDdii4CdmGY/QwKBSOCAA7"]
62
open [image create photo -data "R0lGODlhDAAMALMPAOvr605OOfv7iDk5FbGxsZ2dNM3NzY2NjcrKXYaGAImJABoaCIuLABkZAGFhYf///yH5BAEAAA8ALAAAAAAMAAwAAARJ8EkJyBhmanAeDwTXaY/TEE5ROCxrHAcQCAJiIw4xzXSfhAAZrdAoFheNwawwYCieDEZAhhgkrlcF5rGwMrCMLbexKJt1pPQkAgA7"]
63
reload [image create photo -data "R0lGODlhDAAMAKIHAO3tYefnnkVFQTExgzc3J29vf8DAXv///yH5BAEAAAcALAAAAAAMAAwAAAM7eEJ8/sqAYAR0ZE7GyQqTURSGQTFTMYwDGHzGoI3gAtDTsL4EJYMqiS2gKrgmCwmloDl5BNBF1HOpHhIAOw=="]
64
prev [image create photo -data "R0lGODlhDAAMAKIEAAAAgP//AP///wAAAP///wAAAAAAAAAAACH5BAEAAAQALAAAAAAMAAwAAAMpSLM89G+IMMWCimrpYqUAE2kCAFCdBJpTupqo97ZjBVuyTWdflTZAQgIAOw=="]
65
up [image create photo -data "R0lGODlhDAAMAKIEAAAAgP//AP///wAAAP///wAAAAAAAAAAACH5BAEAAAQALAAAAAAMAAwAAAMnSLM89G+IMMWCimrpYt1XVgFVJ1FAOploqpqCK7Nf6WkfjVNm4xMJADs="]
66
next [image create photo -data "R0lGODlhDAAMAKIEAAAAgP//////AAAAAP///wAAAAAAAAAAACH5BAEAAAQALAAAAAAMAAwAAAMrSLM89G8EMcOCimrp4gTblQUAWHWSUJoCSq0m+pVb9LKWp2qTW/GohpCQAAA7"]
69
#Controls/buttons: link_name text/hint vis_cond activ_cond button_name
70
array set btninfo "__prev {[list "Back" 1 {$help::hpos>0} "bback"]}
71
contents {[list "Contents" 1 {[lsearch $help::index "contents"]!=-1} "bcont"]}
72
__dec {[list "Decrease" 1 {$help::fontsize>6} "bdec"]}
73
__find {[list "Find" 1 1 "bfind"]}
74
__next {[list "Forward" 1 {$help::hpos<[expr [llength $help::history] - 1]} "bforward"]}
75
__inc {[list "Increase" 1 {$help::fontsize<30} "binc"]}
76
__index {[list "Index" 1 {$help::index!=""} "bindex"]}
77
__Next {[list "Next" {$help::h4contents!=""} {[lsearch $help::sequence $help::curtopic]<[expr [llength $help::sequence] - 1] && [lsearch $help::sequence $help::curtopic]>-1} "bnext"]}
78
__open {[list "Open" 1 1 "bopen"]}
79
__Prev {[list "Previous" {$help::h4contents!=""} {[lsearch $help::sequence $help::curtopic]>0} "bprev"]}
80
__refresh {[list "Refresh" 1 1 "brefresh"]}
81
__reload {[list "Reload" 1 1 "breload"]}
82
__search {[list "Search" 1 {$help::index!=""} "bsearch"]}
83
__stop {[list "Stop" 1 {$help::showing || $help::insearch} "bstop"]}
84
__up1level {[list "UpLevel" {$help::h4contents!=""} {[array names help::up1level $help::curtopic]!=""} "bup"]}
99
variable h4contents ""
101
variable h_appendlist 1
102
array set settings "back {$backcolor} fore {$forecolor} link {$linkcolor} alink {$alinkcolor}"
105
variable fnd_case "-nocase"
106
variable fnd_regexp ""
107
variable fnd_direction "-forwards"
108
variable searchedtext ""
114
array set tables "level 0 stack {} count 0 tables {}"
115
variable ext_loaded ""
118
#===============================================================================
120
#-------------------------------------------------------------------------------
121
# Functions : help::tag_*
122
# Description : Process corresponding open/close tag
123
# Parameters : params - arguments of tag
125
#-------------------------------------------------------------------------------
126
proc help::tag_\$ {params} {
130
foreach {param value} $params {
131
if {[info exists data(subst,$param,begin)]} {
132
set _text "$data(subst,$param,begin)$_text"
138
proc help::tag_/\$ {params} {
142
foreach {param value} $params {
143
if {[info exists data(subst,$param,end)]} {
144
set _text "$data(subst,$param,end)$_text"
150
proc help::tag_center {params} {
154
set attr(justify,global) [linsert $attr(justify,global) 0 "center"]
155
if {[$w.text get "end -2c"]!="\n"} {
156
$w.text insert end "\n" [gettags]
160
proc help::tag_/center {params} {
164
catch {set attr(justify,global) [lreplace $attr(justify,global) 0 0]}
165
if {[$w.text get "end -2c"]!="\n"} {
166
$w.text insert end "\n" [gettags]
170
proc help::tag_b {params} {
173
set attr(style) [linsert $attr(style) 0 "b"]
176
proc help::tag_/b {params} {
179
if {[set pos [lsearch $attr(style) "b"]]!=-1} {
180
set attr(style) [lreplace $attr(style) $pos $pos]
184
proc help::tag_i {params} {
187
set attr(style) [linsert $attr(style) 0 "i"]
190
proc help::tag_/i {params} {
193
if {[set pos [lsearch $attr(style) "i"]]!=-1} {
194
set attr(style) [lreplace $attr(style) $pos $pos]
198
proc help::tag_u {params} {
201
set attr(style) [linsert $attr(style) 0 "u"]
204
proc help::tag_/u {params} {
207
if {[set pos [lsearch $attr(style) "u"]]!=-1} {
208
set attr(style) [lreplace $attr(style) $pos $pos]
212
proc help::tag_pre {params} {
215
set attr(style) [linsert $attr(style) 0 "p"]
218
proc help::tag_/pre {params} {
221
if {[set pos [lsearch $attr(style) "p"]]!=-1} {
222
set attr(style) [lreplace $attr(style) $pos $pos]
226
proc help::tag_nobr {params} {
229
set attr(style) [linsert $attr(style) 0 "n"]
232
proc help::tag_/nobr {params} {
235
if {[set pos [lsearch $attr(style) "n"]]!=-1} {
236
set attr(style) [lreplace $attr(style) $pos $pos]
240
proc help::tag_hr {params} {
245
if {[$w.text get "end -2c"]!="\n"} {
246
$w.text insert end "\n" [gettags]
250
foreach {param value} $params {
253
eval "$w.text insert end [gethr $p_height $p_color]"
254
if {[string index $_text 0]=="\n"} {
255
set _text [string range $_text 1 end]
259
proc help::tag_br {params} {
261
$w.text insert end "\n" [gettags]
264
proc help::tag_ul {params} {
271
foreach {param value} $params {
274
incr attr(margin) $p_indent
275
set attr(ul_type) [linsert $attr(ul_type) 0 $p_type]
276
set attr(indent) [linsert $attr(indent) 0 $p_indent]
277
# if {[$w.text get "end -3c"]!="\n"} {
278
# $w.text insert end "\n" [gettags]
280
if {[$w.text get "end -3c"]!="\n"} {
281
$w.text insert end "\n" [gettags]
285
proc help::tag_/ul {params} {
291
catch {incr attr(margin) [expr {-[lindex $attr(indent) 0]}]}
292
if {$attr(margin)<$lmargin && $tables(stack)==""} {set attr(margin) $lmargin}
293
if {[$w.text get "end-3c"]!="\n"} {
294
$w.text insert end "\n" [gettags]
296
catch {set attr(indent) [lreplace $attr(indent) 0 0]}
297
catch {set attr(ul_type) [lreplace $attr(ul_type) 0 0]}
300
proc help::tag_li {params} {
309
if {[$w.text get "end -2c"]!="\n"} {
310
$w.text insert end "\n" [gettags]
312
set p_type [lindex $attr(ul_type) 0]
313
foreach {param value} $params {
316
if {![info exists _images($p_type)]} {
317
if {[info exists data($p_type,image)]} {
318
set im $data($p_type,image)
320
set im $_images(disc)
323
set im $_images($p_type)
325
catch {set imind [$w.text image create end -image $im -align center -padx 3]}
326
catch {$w.text tag add [gettags] $imind}
327
catch {$w.text tag configure tag[incr _count] -lmargin1 [expr $attr(margin) - 22] -rmargin $rmargin}
328
catch {$w.text tag add tag$_count $imind}
329
set _text [string trimleft $_text " \t\n"]
332
proc help::tag_p {params} {
336
if {[$w.text get "end -3c"]!="\n"} {
337
$w.text insert end "\n" [gettags]
339
if {[$w.text get "end -3c"]!="\n"} {
340
$w.text insert end "\n" [gettags]
343
foreach {param value} $params {
347
if {[set p_align [string tolower $p_align]]!="left" && $p_align!="center" && $p_align!="right"} {set p_align ""}
348
set attr(justify) $p_align
351
proc help::tag_/p {params} {
357
proc help::tag_a {params} {
365
foreach {param value} $params {
368
#sch p_href bearbeiten
369
# if p_href is a external reference (http: file: mailto: usw.), then ignore
370
if {[string first ":" $p_href]>=0} {
371
switch -glob -- [string tolower $p_href] {
372
file://* {set p_href [string range $p_href 7 end]}
373
tcl:* {set p_href "tcl:[string range $p_href 4 end]"}
374
tclscript:* {set p_href "tclscript:[string range $p_href 10 end]"}
375
default {set p_title $p_href
376
set p_href "tcl:help::showurl {$p_href}"
380
if {$p_href!="" && ![regexp "^tcl(script)?:" $p_href]} {
381
set p_href_neu [string tolower $p_href]
384
if {[set pos [string first "?" $curtopic]]!=-1} {
385
set filename [string tolower [string range $curtopic 0 [expr $pos - 1]]]
386
if {[string first "#" $p_href_neu]==0} {
387
set p_href_neu $filename?[string range $p_href_neu 1 end]
388
} elseif {[set pos [string first "#" $p_href_neu]]>0} {
389
set p_href_neu [string replace $p_href_neu $pos $pos "?"]
393
if {[lsearch $index $p_href_neu]>=0} {
394
set p_href $p_href_neu
396
if {[string first "#" $p_href]==0} {
397
set p_href $curtopic$p_href
403
set attr(links) [linsert $attr(links) 0 $p_href]
406
set p_name [string tolower $p_name]
407
$w.text mark set "mark_$p_name" [$w.text index end-1c]
408
$w.text mark gravity "mark_$p_name" left
409
if {$p_name==$mark} {
410
after 200 "catch {$w.text yview \"mark_$p_name\"}; catch {$w.text see \"mark_$p_name\"}"
414
set attr(link_titles) [linsert $attr(link_titles) 0 $p_title]
417
proc help::tag_/a {params} {
420
catch {set attr(links) [lreplace $attr(links) 0 0]}
421
catch {set attr(link_titles) [lreplace $attr(link_titles) 0 0]}
424
proc help::tag_font {params} {
433
set {p_point-size} ""
434
foreach {param value} $params {
438
set attr(colors) [linsert $attr(colors) 0 [correctcolor [string tolower $p_color]]]
439
lappend tag_font "colors"
441
if {$p_bgcolor!=""} {
442
set attr(bgcolors) [linsert $attr(bgcolors) 0 [correctcolor [string tolower $p_bgcolor]]]
443
lappend tag_font "bgcolors"
446
if {[set sign [string index $p_size 0]]=="+" || $sign=="-" || ($p_size=="0" && [set sign "+"]=="+")} {
447
set attr(sizes) [linsert $attr(sizes) 0 "$sign[expr {abs($p_size) * 2}]"]
449
set attr(sizes) [linsert $attr(sizes) 0 [expr {$p_size * 2 + $fontsize - 6}]]
451
lappend tag_font "sizes"
453
if {${p_point-size}!=""} {
454
set attr(sizes) [linsert $attr(sizes) 0 ${p_point-size}]
455
lappend tag_font "sizes"
458
set attr(face) [linsert $attr(face) 0 $p_face]
459
lappend tag_font "face"
461
set attr(tag_fonts) [linsert $attr(tag_fonts) 0 $tag_font]
464
proc help::tag_/font {params} {
467
foreach t [lindex $attr(tag_fonts) 0] {
468
catch {set attr($t) [lreplace $attr($t) 0 0]}
470
catch {set attr(tag_fonts) [lreplace $attr(tag_fonts) 0 0]}
473
proc help::tag_img {params} {
484
foreach {param value} $params {
487
if {[info exists data($p_src,image)]} {
488
catch {set imind [$w.text image create end -image $data($p_src,image)]}
490
#sch i think you mean [catch {...}] == 0
491
#angra No, i mean that i mean: if i can't load image, the default image is drawing
492
if {[catch {set data($p_src,image) [image create photo -file [file join [file dirname $curfilename] $p_src]]}]} {
494
catch {set imind [$w.text image create end -image $_images(broken)]}
496
catch {set imind [$w.text image create end -image $data($p_src,image)]}
499
if {[set p_align [string tolower $p_align]]=="middle"} {
502
catch {$w.text image configure $imind -align [string tolower $p_align]}
503
catch {$w.text image configure $imind -padx $p_border -pady $p_border}
504
catch {$w.text tag add [gettags] $imind}
506
set data($p_id,image,id) $imind
507
set data($p_id,image,widget) $w
511
proc help::tag_tt {params} {
514
set attr(style) [linsert $attr(style) 0 "t"]
517
proc help::tag_/tt {params} {
520
if {[set pos [lsearch $attr(style) "t"]]!=-1} {
521
set attr(style) [lreplace $attr(style) $pos $pos]
525
proc help::tag_ol {params} {
529
proc help::tag_/ol {params} {
533
proc help::tag_em {params} {
537
proc help::tag_/em {params} {
541
proc help::tag_strong {params} {
545
proc help::tag_/strong {params} {
549
proc help::tag_code {params} {
554
proc help::tag_/code {params} {
559
proc help::tag_samp {params} {
563
proc help::tag_/samp {params} {
567
proc help::tag_kbd {params} {
570
set attr(style) [linsert $attr(style) 0 "k"]
573
proc help::tag_/kbd {params} {
576
if {[set pos [lsearch $attr(style) "k"]]!=-1} {
577
set attr(style) [lreplace $attr(style) $pos $pos]
581
proc help::tag_cite {params} {
585
proc help::tag_/cite {params} {
589
proc help::tag_var {params} {
593
proc help::tag_/var {params} {
597
proc help::tag_address {params} {
601
proc help::tag_/address {params} {
605
proc help::tag_h1 {params} {
610
set attr(sizes) [linsert $attr(sizes) 0 [expr {$fontsize + 10}]] ;#22
611
set attr(style) [linsert $attr(style) 0 "b"]
613
if {[$w.text get "end -3c"]!="\n"} {
614
$w.text insert end "\n" [gettags]
616
if {[$w.text get "end -3c"]!="\n"} {
617
$w.text insert end "\n" [gettags]
620
foreach {param value} $params {
624
if {[set p_align [string tolower $p_align]]!="left" && $p_align!="center" && $p_align!="right"} {set p_align ""}
625
set attr(justify) $p_align
629
proc help::tag_/h1 {params} {
633
if {[set pos [lsearch $attr(style) "b"]]!=-1} {
634
set attr(style) [lreplace $attr(style) $pos $pos]
636
catch {set attr(sizes) [lreplace $attr(sizes) 0 0]}
637
if {[$w.text get "end -2c"]!="\n"} {
638
$w.text insert end "\n" [gettags]
645
proc help::tag_h2 {params} {
650
set attr(sizes) [linsert $attr(sizes) 0 [expr {$fontsize + 6}]] ;#18
651
set attr(style) [linsert $attr(style) 0 "b"]
653
if {[$w.text get "end -3c"]!="\n"} {
654
$w.text insert end "\n" [gettags]
656
if {[$w.text get "end -3c"]!="\n"} {
657
$w.text insert end "\n" [gettags]
660
foreach {param value} $params {
664
if {[set p_align [string tolower $p_align]]!="left" && $p_align!="center" && $p_align!="right"} {set p_align ""}
665
set attr(justify) $p_align
669
proc help::tag_/h2 {params} {
673
proc help::tag_h3 {params} {
678
set attr(sizes) [linsert $attr(sizes) 0 [expr {$fontsize + 2}]] ;#14
679
set attr(style) [linsert $attr(style) 0 "b"]
681
if {[$w.text get "end -3c"]!="\n"} {
682
$w.text insert end "\n" [gettags]
684
if {[$w.text get "end -3c"]!="\n"} {
685
$w.text insert end "\n" [gettags]
688
foreach {param value} $params {
692
if {[set p_align [string tolower $p_align]]!="left" && $p_align!="center" && $p_align!="right"} {set p_align ""}
693
set attr(justify) $p_align
697
proc help::tag_/h3 {params} {
701
proc help::tag_h4 {params} {
706
set attr(sizes) [linsert $attr(sizes) 0 $fontsize] ;#12
707
set attr(style) [linsert $attr(style) 0 "b"]
709
if {[$w.text get "end -3c"]!="\n"} {
710
$w.text insert end "\n" [gettags]
712
if {[$w.text get "end -3c"]!="\n"} {
713
$w.text insert end "\n" [gettags]
716
foreach {param value} $params {
720
if {[set p_align [string tolower $p_align]]!="left" && $p_align!="center" && $p_align!="right"} {set p_align ""}
721
set attr(justify) $p_align
725
proc help::tag_/h4 {params} {
729
proc help::tag_h5 {params} {
734
set attr(sizes) [linsert $attr(sizes) 0 [expr {$fontsize - 2}]] ;#10
735
set attr(style) [linsert $attr(style) 0 "b"]
737
if {[$w.text get "end -3c"]!="\n"} {
738
$w.text insert end "\n" [gettags]
740
if {[$w.text get "end -3c"]!="\n"} {
741
$w.text insert end "\n" [gettags]
744
foreach {param value} $params {
748
if {[set p_align [string tolower $p_align]]!="left" && $p_align!="center" && $p_align!="right"} {set p_align ""}
749
set attr(justify) $p_align
753
proc help::tag_/h5 {params} {
757
proc help::tag_h6 {params} {
762
set attr(sizes) [linsert $attr(sizes) 0 [expr {$fontsize - 4}]] ;#8
763
set attr(style) [linsert $attr(style) 0 "b"]
765
if {[$w.text get "end -3c"]!="\n"} {
766
$w.text insert end "\n" [gettags]
768
if {[$w.text get "end -3c"]!="\n"} {
769
$w.text insert end "\n" [gettags]
772
foreach {param value} $params {
776
if {[set p_align [string tolower $p_align]]!="left" && $p_align!="center" && $p_align!="right"} {set p_align ""}
777
set attr(justify) $p_align
781
proc help::tag_/h6 {params} {
785
proc help::tag_blockquote {params} {
789
proc help::tag_/blockquote {params} {
793
proc help::tag_menu {params} {
797
proc help::tag_/menu {params} {
801
proc help::tag_dir {params} {
805
proc help::tag_/dir {params} {
809
proc help::tag_div {params} {
813
proc help::tag_/div {params} {
817
proc help::tag_body {params} {
823
foreach {v1 v2} {text fore bgcolor back link link alink alink} {
824
set p_$v1 $settings($v2)
826
foreach {param value} $params {
829
foreach {v1 v2} {text fore bgcolor back link link alink alink} {
830
set settings($v2) [correctcolor [string tolower [set p_$v1]]]
832
catch {$w.text configure -foreground $settings(fore)}
833
catch {$w.text configure -background $settings(back)}
834
catch {$w.title configure -foreground $settings(fore)}
835
catch {$w.title configure -background $settings(back)}
836
foreach {name} {title line __index contents __next __prev __Next __Prev __up1level
837
__dec __find __inc __open __refresh __reload __stop __search} {
839
if {[$w.title bind $_t_title($name) <1>]==""} {
840
catch {$w.title itemconfigure $_t_title($name) -fill $settings(fore)}
842
catch {$w.title itemconfigure $_t_title($name) -fill $settings(link)}
848
proc help::tag_title {params} {
852
proc help::tag_/title {params} {
858
if {[info exists data(title)] && $data(title)!=""} {
859
regsub -all -- "\[\r\n \]+" $data(title) " " data(title)
861
set data(title) "Untitled"
864
if {[string match {.tophelpwindow*} $w]} {
865
wm title .tophelpwindow "Help - [specialentities $data(title)]"
867
$w.title itemconfigure $_t_title(title) -text [specialentities $data(title)]
870
proc help::tag_/head {params} {
878
proc help::tag_/tr {params} {
881
if {[$w.text get "end -2c"]!="\n"} {
882
$w.text insert end "\n" [gettags]
886
proc help::tag_/td {params} {
889
if {[$w.text get "end -2c"]!=" "} {
890
$w.text insert end " " [gettags]
894
proc help::tag_table {params} {
898
if {[$w.text get "end -2c"]!="\n"} {
899
$w.text insert end "\n" [gettags]
903
foreach {param value} $params {
906
if {$p_bgcolor!=""} {
907
set attr(bgcolors) [linsert $attr(bgcolors) 0 [correctcolor [string tolower $p_bgcolor]]]
908
set attr(tables) [linsert $attr(tables) 0 "bg"]
912
proc help::tag_/table {params} {
916
if {[$w.text get "end -2c"]!="\n"} {
917
$w.text insert end "\n" [gettags]
919
if {[set pos [lsearch $attr(tables) "bg"]]!=-1} {
920
set attr(tables) [lreplace $attr(tables) $pos $pos]
921
catch {set attr(bgcolors) [lreplace $attr(bgcolors) 0 0]}
925
proc help::tag_dd {params} {
929
if {[set pos [lsearch $_need_tag "/dt"]]!=-1} {
932
if {[$w.text get "end -2c"]!="\n"} {
933
$w.text insert "end -1c" "\n" [gettags]
935
set _need_tag [linsert $_need_tag 0 "/dd"]
938
proc help::tag_/dd {params} {
941
if {[set pos [lsearch $_need_tag "/dd"]]!=-1} {
942
set _need_tag [lreplace $_need_tag $pos $pos]
946
proc help::tag_dl {params} {
950
proc help::tag_/dl {params} {
954
proc help::tag_dt {params} {
958
if {[set pos [lsearch $_need_tag "/dt"]]!=0} {
959
set _need_tag [linsert $_need_tag 0 "/dt"]
962
if {[$w.text get "end -2c"]!="\n"} {
963
$w.text insert "end -1c" "\n" [gettags]
968
proc help::tag_/dt {params} {
971
if {[set pos [lsearch $_need_tag "/dt"]]!=-1} {
972
set _need_tag [lreplace $_need_tag $pos $pos]
977
proc help::tag_frame {params} {
982
foreach {param value} $params {
989
if {[$w.text get "end -2c"]!="\n"} {
990
$w.text insert end "\n" [gettags]
992
$w.text insert end "Frame " [gettags]
993
tag_a [list href $p_src]
994
$w.text insert end "$p_name" [gettags]
1000
proc help::tag_script {params} {
1006
foreach {param value} $params {
1009
if {[string tolower $p_language]=="tclscript"} {
1017
proc help::tag_/script {params} {
1023
if {$_isscript && $data(script)!=""} {
1024
if {[catch {$interp eval $data(script)}]} {
1025
set data(__@Error@__,title) "Error in loaded script"
1026
set data(__@Error@__,text) "<font color=red><pre>[string map {{&} {&} {>} {>} {<} {<}} $::errorInfo]</pre></font>"
1030
} elseif {!$_istext} {
1036
proc help::tag_style {params} {
1040
proc help::tag_/style {params} {
1044
proc help::tag_span {params} {
1052
foreach {param value} $params {
1057
set data($p_id,names,id) "tag$_count"
1058
set data($p_id,names,widget) $w
1059
set data($p_id,names,pos) [$w.text index "end-1c"]
1060
if {$p_hidden==""} {set p_hidden 1}
1061
catch {$w.text tag configure "tag$_count" -elide $p_hidden}
1063
set attr(span) [linsert $attr(span) 0 $p_id]
1066
proc help::tag_/span {params} {
1070
if {[set p_id [lindex $attr(span) 0]]!=""} {
1071
catch {$data($p_id,names,widget).text tag add $data($p_id,names,id) $data($p_id,names,pos) "end-1c"}
1073
set attr(span) [lreplace $attr(span) 0 0]
1076
#===============================================================================
1078
#-------------------------------------------------------------------------------
1079
# Function : help::correctcolor
1080
# Description : Converts color names to color values
1081
# Parameters : color - name of color
1082
# Return : Color value
1083
#-------------------------------------------------------------------------------
1084
proc help::correctcolor {color} {
1085
return [string map {\
1086
green "#008000" silver "#c0c0c0" lime "#00ff00" gray "#808080" \
1087
olive "#808000" navy "#000080" purple "#800080" teal "#008080" \
1088
fuchsia "#ff00ff" aqua "#00ffff" maroon "#800000"
1092
#-------------------------------------------------------------------------------
1093
# Function : help::_load
1094
# Description : Load helpfile with includes
1095
# Parameters : filename - name of file with help
1096
# Return : True or false
1097
#-------------------------------------------------------------------------------
1098
proc help::_load {filename} {
1111
variable curfilename
1124
variable h_appendlist
1125
variable searchedtext ""
1129
set stat "Loading $filename..."
1131
if {[catch {set fname [::open $filename r]}]!=0} {
1132
append data(__file_error,text) "<p><font color=#c00000>Error while opening file:</font> <b>\"$filename\"</b><font color=#c00000>!</font></p>"
1133
set data(__file_error,title) "Error!"
1134
if {![info exists index] || [lsearch $index "__file_error"]==-1} {
1135
lappend index __file_error
1141
while {![eof $fname]} {
1142
append filedata [read $fname 100000]
1145
if {$h4topics!="" || $h4contents!=""} {
1146
regsub -all -- {<!--.*?-->} $filedata "" filedata
1148
set filedata [split $filedata "\n"]
1149
foreach str $filedata {
1150
#sch test section headings and create topics, fill hcontents
1151
append headerstr $str
1152
if {![regexp -nocase {<h[1-6][^>]*>} $headerstr]} {
1154
} elseif {[regexp -nocase \
1155
{<h([1-6])[^>]*>(.*?)</h[1-6]>} $headerstr Dummy headerlevel headertxt]} {
1157
if {$h2ignore!="" && [regexp -nocase $h2ignore $headerstr]} {
1162
if {$h4topics!="" && [regexp -nocase -- $h4topics $headerstr]} {
1163
regsub -all -nocase -- {<br>} $headertxt { } headertxt
1164
regsub -all -- {<[^>]*>} $headertxt {} topictitle
1165
if {![regexp -nocase {^.*<a +.*? *name *= *(" *([^\"]+) *"|([^\"]([^ >]*)))} \
1166
$headertxt Dummy topicname]} {
1167
set topicname internal_[incr schAnkerNr]
1169
set curtopic [string tolower [file tail $filename]?[string trim $topicname "\t\" "]]
1170
lappend index $curtopic
1171
set data($curtopic,text) ""
1172
set data($curtopic,title) [string trim [specialentities $topictitle] "\t\" "]
1177
if {$h4contents!="" && [regexp -nocase -- $h4contents $headerstr]} {
1178
regsub -all -nocase -- {<br>} $headertxt { } headertxt
1179
regsub -all -- {<[^>]*>} $headertxt {} topictitle
1180
if {$topicname!=""} {
1181
lappend hcontents [list $headertxt $headerlevel [string trim $topictitle] $curtopic]
1183
lappend hcontents [list $headertxt $headerlevel [string trim $topictitle] ""]
1194
#sch new control directives .h2ignore* .h4topics* .h4contents* added in switch
1196
switch -glob -- $str {
1197
.h_ignore* {set h2ignore [string trim [string range $str 9 end] "\t\" "]}
1198
.h_topics* {set h4topics [string trim [string range $str 9 end] "\t\" "]}
1199
.h_contents* {set h4contents [string trim [string range $str 11 end] "\t\" "]}
1200
.h_appendlist* {set h_appendlist [regexp -- "(yes)|(1)|(true)" [string tolower [string trim [string range $str 11 end] "\t\" "]]]}
1201
.fontsize* {catch {set fontsize [expr [string trim [string range $str 9 end] "\t\" "]]}}
1202
.fontfixed* {set fontfixed [string trim [string range $str 10 end] "\t\" "]}
1203
.font* {set font [string trim [string range $str 5 end] "\t\" "]}
1204
.forecolor* {set forecolor [correctcolor [string tolower [string trim [string range $str 10 end] "\t\" "]]]}
1205
.backcolor* {set backcolor [correctcolor [string tolower [string trim [string range $str 10 end] "\t\" "]]]}
1206
.linkcolor* {set linkcolor [correctcolor [string tolower [string trim [string range $str 10 end] "\t\" "]]]}
1207
.alinkcolor* {set alinkcolor [correctcolor [string tolower [string trim [string range $str 11 end] "\t\" "]]]}
1208
.lmargin* {catch {set lmargin [expr [string trim [string range $str 8 end] "\t\" "]]}}
1209
.rmargin* {catch {set rmargin [expr [string trim [string range $str 8 end] "\t\" "]]}}
1210
.topic* {set curtopic [string trim [string range $str 6 end] "\t\" "]
1211
if {$curtopic!=""} {
1212
lappend index $curtopic
1213
set data($curtopic,title) "$curtopic"
1214
set data($curtopic,text) ""
1217
.title* {if {$curtopic!=""} {
1218
set data($curtopic,title) [string trim [string range $str 6 end] "\t\" "]
1221
.image* {set str [split $str]
1226
for {} {$i<[llength $str]} {incr i} {
1227
if {[lindex $str $i]!=""} {
1228
set imname [string trim [lindex $str $i]]
1233
for {} {$i<[llength $str]} {incr i} {
1234
if {[lindex $str $i]!=""} {
1235
set imtype [string trim [lindex $str $i]]
1240
set imdata [string trim [join [lrange $str $i end]]]
1242
file {catch {set data($imname,image) [image create photo -file [file join [file dirname $filename] $imdata]]}}
1243
data {catch {set data($imname,image) [image create photo -data $imdata]}}
1246
.include* {variable inclstr
1247
set inclstr [string trim [join [lrange [split $str] 1 end]] "\t\" "]
1248
catch "namespace eval :: {set [namespace current]::inclstr \"$inclstr\"}"
1249
_load [file join [file dirname $filename] $inclstr]
1251
.$* {set str [split $str]
1256
for {} {$i<[llength $str]} {incr i} {
1257
if {[lindex $str $i]!=""} {
1258
set substname [string tolower [string trim [lindex $str $i]]]
1263
set subst [string trim [join [lrange $str $i end]]]
1264
catch {set substbegin [lindex $subst 0]}
1265
catch {set substend [lindex $subst 1]}
1266
if {$substname!="" && ($substbegin!="" || $substend!="")} {
1267
set data(subst,$substname,begin) $substbegin
1268
set data(subst,$substname,end) $substend
1272
set controls [string tolower [string trim [string range $str 9 end] "\t\" "]]
1275
set buttons [string tolower [string trim [string range $str 8 end] "\t\" "]]
1277
default {if {$curtopic!=""} {
1278
if {[string index $str 0]!={;}} {
1279
append data($curtopic,text) "$str\n"
1282
append data(text) "$str\n"
1291
#-------------------------------------------------------------------------------
1292
# Function : help::load
1293
# Description : Load helpfile and make index
1294
# Parameters : filename - name of file with help
1295
# Return : True or false
1296
#-------------------------------------------------------------------------------
1297
proc help::load {filename} {
1301
variable curfilename
1303
if {$filename==$curfilename} {
1318
variable font "Helvetica"
1319
variable fontfixed "Courier"
1320
variable fontsize 12
1321
variable backcolor ""
1322
variable forecolor black
1323
variable linkcolor "#006800"
1324
variable alinkcolor "#c00000"
1327
variable curtopic ""
1331
variable sequence ""
1332
variable hcontents ""
1333
variable h2ignore ""
1334
variable h4topics ""
1335
variable h4contents ""
1337
variable h_appendlist 1
1338
# CHANGED BY JAIME URZUA
1339
#variable controls "back forw cont index search prev up next"
1340
variable controls ""
1341
# CHANGED BY JAIME URZUA
1342
#variable buttons "back forw prev up next sep stop sep cont ind"
1343
variable buttons "back forw prev up next sep stop sep"
1344
array set settings "back {$backcolor} fore {$forecolor} link {$linkcolor} alink {$alinkcolor}"
1346
foreach imn [array names data *,image] {
1347
catch {image delete $data($imn)}
1350
foreach btn "back cont dec find forward inc index next open prev refresh reload search stop up" {
1351
catch {grid forget $w.b$btn}
1353
for {set i 0} {$i<50} {incr i} {grid columnconfig $w $i -minsize 0}
1354
if {![_load $filename]} {
1356
set stat "Error while loading $filename!"
1364
#sch create Topic Contents from hcontents and up1level for __up1level
1365
if {$hcontents!=""} {
1366
set data(contents,title) "Contents"
1367
set data(contents,text) "<ul>"
1368
set links(contents) ""
1369
# set topicname_prev ""
1370
set level(0) [list Contents 0 Contents contents]
1371
for {set i 1} {$i<=6} {incr i} {
1374
foreach str $hcontents {
1375
#set headertxt [lindex $str 0]
1376
set headerlevel [lindex $str 1]
1377
set topictitle [lindex $str 2]
1378
set topicname [lindex $str 3]
1379
set prefix [string repeat " " [expr $headerlevel - 1]]
1380
set level($headerlevel) $str
1381
for {set i [expr $headerlevel + 1]} {$i<=6} {incr i} {
1384
set links($topicname) ""
1385
if {$topicname!=""} {
1386
append data(contents,text) "$prefix<a href=\"$topicname\">$topictitle</a><br>"
1388
append data(contents,text) "$prefix$topictitle<br>"
1390
for {set i [expr $headerlevel - 1]} {$i>0&&$level($i)==""} {incr i -1} {
1392
set str_i $level($i)
1394
#set headertxt_i [lindex $str_i 0]
1395
set headerlevel_i [lindex $str_i 1]
1396
set topictitle_i [lindex $str_i 2]
1397
set topicname_i [lindex $str_i 3]
1398
if {$topicname_i != ""} {
1399
set up1level($topicname) $topicname_i
1400
if {$topicname!=""} {
1401
append links($topicname_i) "<a href=\"$topicname\">$topictitle</a><br>"
1406
append data(contents,text) "</ul>"
1407
lappend index contents
1408
if {$h_appendlist} {
1409
set links(contents) ""
1410
foreach topicname_i [array names links] {
1411
if {$links($topicname_i)!=""} {
1412
append data($topicname_i,text) "<ul>" $links($topicname_i) "</ul>"
1419
#sch_05 create sequence for __Next, __up1level and __Prev
1420
if {[lsearch $index contents]>=0} {
1421
lappend sequence contents
1423
foreach topicname $index {
1424
if {$topicname!="contents"} {
1425
lappend sequence $topicname
1428
lappend sequence __index
1435
lappend iind [list $i $data($i,title)]
1437
set iind [lsort -index 1 -dictionary $iind]
1438
set data(__index,title) "Index"
1439
set data(__index,text) "<br><ul>"
1441
set outtext [lindex $i 1]
1442
append data(__index,text) "<li><a href=\"[lindex $i 0]\">[string map {{&} {&} {>} {>} {<} {<}} $outtext]</a> <br>"
1444
append data(__index,text) "</ul>"
1445
lappend index __index
1447
catch {$w.text configure -font "-family $font -size $fontsize"}
1448
catch {$w.text configure -foreground $forecolor}
1449
catch {$w.text configure -background $backcolor}
1450
catch {$w.title configure -background [$w.text cget -background]}
1451
set curfilename $filename
1452
array set settings "back {$backcolor} fore {$forecolor} link {$linkcolor} alink {$alinkcolor}"
1456
#-------------------------------------------------------------------------------
1457
# Function : help::init
1458
# Description : Create window, load file and show topic
1459
# Parameters : filename - name of file with help
1460
# : topic - topic name
1461
# : parent - parent widget
1462
# : width - initial width of help window
1463
# : height - initial height of help window
1465
#-------------------------------------------------------------------------------
1466
#sch new parameters {width 450} {height 400}
1467
proc help::init {filename {topic contents} {parent {}} {width 450} {height 400} } {
1480
if {![info exists w] || ![winfo exists $w]} {
1483
set w ".tophelpwindow"
1485
if {$width<450} {set width 450}
1486
if {$height<400} {set height 400}
1487
toplevel $w -width $width -height $height
1489
wm title .tophelpwindow "Help"
1490
wm minsize .tophelpwindow 170 120
1491
raise .tophelpwindow
1492
focus -force .tophelpwindow
1495
if {[wm protocol [winfo toplevel $w] WM_DELETE_WINDOW]==""} {
1496
wm protocol [winfo toplevel $w] WM_DELETE_WINDOW "help::destroy 1"
1499
if {$w!="."} {append w "."}
1501
frame ${w}f -width $width -height $height -bd 2 -relief sunken
1503
pack ${w}f -fill both -expand 1
1507
canvas $w.title -bd 0 -highlightthickness 0 -cursor arrow -height 0
1508
# CHANGED BY JAIME URZUA
1509
# ----------------> <----
1510
text $w.text -wrap word -cursor arrow -state disabled -bd 0 \
1511
-insertwidth 0 -insertontime 0 -exportselection 1\
1512
-highlightthickness 0 -takefocus 1 -insertborderwidth 0 \
1513
-yscrollcommand "$w.vs set" -xscrollcommand "$w.hs set"
1514
foreach elem {text title} {
1515
catch {$w.$elem configure -font "-family $font"}
1516
catch {$w.$elem configure -font "-size $fontsize"}
1517
catch {$w.$elem configure -foreground $settings(fore)}
1518
catch {$w.$elem configure -background $settings(back)}
1520
scrollbar $w.vs -command "$w.text yview"
1521
scrollbar $w.hs -command "$w.text xview" -orient horizontal
1523
button $w.bback -image $_images(back) -width 15 -height 13 -command "help::show __prev" -state disabled
1524
button $w.bforward -image $_images(forward) -width 15 -height 13 -command "help::show __next" -state disabled
1525
button $w.bstop -image $_images(stop) -width 15 -height 13 -command "set help::abort 1" -state disabled
1526
button $w.brefresh -image $_images(refresh) -width 15 -height 13 -command "event generate $w.text <Control-r>"
1528
button $w.bdec -image $_images(dec) -width 15 -height 13 -command "event generate $w.text <Control-bracketleft>"
1529
button $w.binc -image $_images(inc) -width 15 -height 13 -command "event generate $w.text <Control-bracketright>"
1530
button $w.bcont -image $_images(cont) -width 15 -height 13 -command "help::show contents"
1531
button $w.bindex -image $_images(index) -width 15 -height 13 -command "help::show __index"
1532
button $w.bfind -image $_images(find) -width 15 -height 13 -command "help::dlgfind:init"
1533
button $w.bsearch -image $_images(search) -width 15 -height 13 -command "help::dlgfind:init 0"
1534
button $w.breload -image $_images(reload) -width 15 -height 13 -command "event generate $w.text <Control-l>"
1535
button $w.bopen -image $_images(open) -width 15 -height 13 -command "event generate $w.text <Control-o>"
1536
button $w.bprev -image $_images(prev) -width 15 -height 13 -command "help::show __Prev"
1537
button $w.bup -image $_images(up) -width 15 -height 13 -command "help::show __up1level"
1538
button $w.bnext -image $_images(next) -width 15 -height 13 -command "help::show __Next"
1540
foreach {name} {__index contents __next __prev __Next __Prev __up1level
1541
__dec __find __inc __open __refresh __reload __stop __search} {
1542
foreach {txt vis expr btn} $btninfo($name) {
1543
bind $w.$btn <Enter> "set help::stat \{$txt\}"
1544
bind $w.$btn <Leave> "set help::stat \{Done.\}"
1548
label $w.stat -relief sunken -bd 1 -textvariable help::stat -justify left -anchor w
1549
label $w.d -image $_images(d[set _dnum]) -bd 0 -anchor se
1550
label $w.ugol -image $_images(ugol) -bd 0 -anchor se
1552
grid rowconfig $w 0 -weight 1 -minsize 0
1553
grid rowconfig $w 1 -weight 1000 -minsize 50
1554
# grid rowconfig $w 3 -minsize 20
1555
grid columnconfig $w 50 -weight 1000 -minsize 50
1557
grid $w.title -padx 0 -pady 0 \
1558
-row 0 -column 0 -rowspan 1 -columnspan 52 -sticky new
1559
grid $w.text -padx 0 -pady 0 \
1560
-row 1 -column 0 -rowspan 1 -columnspan 51 -sticky news
1561
grid $w.vs -padx 1 -pady 0 \
1562
-row 1 -column 51 -rowspan 1 -columnspan 1 -sticky news
1563
grid $w.hs -padx 0 -pady 1 \
1564
-row 2 -column 0 -rowspan 1 -columnspan 51 -sticky news
1565
grid $w.d -padx 0 -pady 0 \
1566
-row 2 -column 51 -rowspan 1 -columnspan 1 -sticky news
1567
grid $w.stat -padx 0 -pady 0 \
1568
-row 3 -column 50 -rowspan 1 -columnspan 1 -sticky nwes
1569
grid $w.ugol -padx 0 -pady 0 \
1570
-row 3 -column 51 -rowspan 1 -columnspan 1 -sticky es
1575
$w.text tag configure h -font "-size 1" -spacing3 0
1577
bind $w.text <Key> "break"
1578
bind $w.text <KeyPress> "break"
1579
bind $w.text <KeyRelease> "break"
1580
bind $w.text <BackSpace> "help::show __prev;break"
1581
bind $w.text <Alt-F5> "help::show __prev;break"
1582
bind $w.text <Alt-Left> "help::show __prev;break"
1583
bind $w.text <Alt-Right> "help::show __next;break"
1584
bind $w.text <Double-1> "break"
1585
bind $w.text <1> "focus $w.text; $w.text tag remove fnd 1.0 end"
1586
bind $w.text <Escape> "set help::abort 1"
1587
bind $w.text <Control-R> "event generate $w.text <Control-r>"
1588
bind $w.text <Control-L> "event generate $w.text <Control-l>"
1589
bind $w.text <Control-bracketleft> "if {\$help::fontsize>6} {incr help::fontsize -2; event generate $w.text <Control-r>}"
1590
bind $w.text <Control-bracketright> "if {\$help::fontsize<30} {incr help::fontsize 2; event generate $w.text <Control-r>}"
1591
bind $w.text <Control-c> "event generate $w.text <<Copy>>"
1592
bind $w.text <Control-C> "event generate $w.text <Control-c>"
1593
bind $w.text <Control-Insert> "event generate $w.text <Control-c>"
1594
bind $w.text <Control-o> "help::open"
1595
bind $w.text <Control-O> "event generate $w.text <Control-o>"
1596
bind $w.text <Right> "$w.text xview scroll +1 units; break"
1597
bind $w.text <Left> "$w.text xview scroll -1 units; break"
1598
bind $w.text <Down> "$w.text yview scroll +1 units; break"
1599
bind $w.text <Up> "$w.text yview scroll -1 units; break"
1600
bind $w.text <Next> "$w.text yview scroll +1 pages; break"
1601
bind $w.text <Prior> "$w.text yview scroll -1 pages; break"
1602
bind $w.text <Home> "$w.text yview moveto 0; break"
1603
bind $w.text <End> "$w.text yview moveto 1; break"
1604
bind $w.d <Double-1> "help::show_about"
1605
bind $w.text <Control-f> "help::dlgfind:init; break"
1606
bind $w.text <Control-F> "event generate $w.text <Control-f>"
1607
bind $w.text <Control-s> "help::dlgfind:init 0; break"
1608
bind $w.text <Control-S> "event generate $w.text <Control-s>"
1609
bind $w.text <Control-Shift-f> "event generate $w.text <Control-s>"
1610
bind $w.text <Control-Shift-F> "event generate $w.text <Control-s>"
1612
bind .tophelpwindow <FocusIn> "help::focusin %W %m"
1613
bind .tophelpwindow <FocusOut> "help::focusout %W %m"
1614
bind .tophelpwindow <Configure> "help::focusin %W %m"
1615
bind .tophelpwindow <Destroy> "help::focusout %W %m"
1616
bind .tophelpwindow <Expose> "help::focusin %W %m"
1619
menu $w.menu -tearoff 0
1620
$w.menu add command -label "Back" -command "help::show __prev" -accelerator "<--"
1621
$w.menu add command -label "Forward" -command "help::show __next"
1622
$w.menu add command -label "Stop" -command "set help::abort 1" -accelerator "Esc"
1624
$w.menu add command -label "Copy" -command "event generate $w.text <Control-c>" -accelerator "Ctrl+Ins"
1626
$w.menu add command -label "Find..." -command "event generate $w.text <Control-f>" -accelerator "Ctrl+F"
1627
$w.menu add command -label "Search in topics..." -command "event generate $w.text <Control-Shift-f>" -accelerator "Ctrl+S"
1629
$w.menu add command -label "Open file..." -command "event generate $w.text <Control-o>" -accelerator "Ctrl+O"
1631
$w.menu add command -label "Increase font size" -command "event generate $w.text <Control-bracketright>" -accelerator "Ctrl+\]"
1632
$w.menu add command -label "Decrease font size" -command "event generate $w.text <Control-bracketleft>" -accelerator "Ctrl+\["
1634
$w.menu add command -label "Refresh" -command "event generate $w.text <Control-r>" -accelerator "Ctrl+R"
1635
$w.menu add command -label "Reload" -command "event generate $w.text <Control-l>" -accelerator "Ctrl+L"
1636
bind $w.text <3> "help::rightclick %X %Y"
1638
menu $w.menuX -tearoff 0
1639
$w.menuX add command -label "About" -command "help::show_about"
1640
bind $w.d <3> "help::rightclickX %X %Y"
1644
if {[info exists w] && [winfo exists $w]} {
1645
raise [winfo toplevel $w]
1646
focus -force [winfo toplevel $w]
1647
focus -force $w.text
1650
bind $w.text <Control-l> "set help::curtopic {}; set help::curfilename {}; help::init \{$filename\} \[lindex \[lindex \$help::history \$help::hpos\] 0\]"
1652
if {$filename==""} {
1657
if {[load $filename]} {
1664
proc help::userinit {w} {
1667
#-------------------------------------------------------------------------------
1668
# Function : help::buttons
1669
# Description : Place buttons
1672
#-------------------------------------------------------------------------------
1673
proc help::buttons {} {
1679
foreach btn $buttons {
1680
switch -glob -- $btn {
1684
fi* {set btn "find"}
1685
fo* {set btn "forward"}
1686
inc* {set btn "inc"}
1687
ind* {set btn "index"}
1688
n* {if {$h4contents==""} {continue}; set btn "next"}
1690
p* {if {$h4contents==""} {continue}; set btn "prev"}
1691
ref* {set btn "refresh"}
1692
rel* {set btn "reload"}
1693
sea* {set btn "search"}
1694
sep* {grid columnconfig $gw [incr bcount] -minsize 5; continue}
1695
st* {set btn "stop"}
1696
u* {if {$h4contents==""} {continue}; set btn "up"}
1699
grid $gw.b$btn -padx 0 -pady 0 -row 3 -column [incr bcount] \
1700
-rowspan 1 -columnspan 1 -sticky news
1705
#-------------------------------------------------------------------------------
1706
# Function : help::gettags
1707
# Description : Configure and get tag for current text with attr
1710
#-------------------------------------------------------------------------------
1711
proc help::gettags {} {
1726
if {[set justify [lindex $attr(justify) 0]]==""} {
1727
set justify [lindex $attr(justify,global) 0]
1730
if {[info exists _tags($w,$attr(style),$attr(links),$attr(bgcolors),$attr(colors),$attr(sizes),$justify,$attr(margin))]} {
1731
return $_tags($w,$attr(style),$attr(links),$attr(bgcolors),$attr(colors),$attr(sizes),$justify,$attr(margin))
1736
if {[lsearch $attr(style) "p"]==-1 && [lsearch $attr(style) "t"]==-1 && [lsearch $attr(style) "k"]==-1} {
1737
if {$attr(face)!=""} {
1738
append ffont "-family \{[lindex $attr(face) 0]\} "
1740
append ffont "-family \{$font\} "
1743
append ffont "-family \{$fontfixed\} "
1745
if {[lsearch $attr(style) "b"]!=-1} {
1746
append ffont "-weight bold "
1748
if {[lsearch $attr(style) "i"]!=-1} {
1749
append ffont "-slant italic "
1751
if {[lsearch $attr(style) "u"]!=-1} {
1752
append ffont "-underline 1 "
1754
if {[lsearch $attr(style) "n"]==-1 && [lsearch $attr(style) "t"]==-1 && [lsearch $attr(style) "p"]==-1} {
1755
$w.text tag configure tag$_count -wrap word
1757
if {$attr(sizes)!=""} {
1758
if {[set ind [string index [set size [lindex $attr(sizes) 0]] 0]]=="+" || $ind=="-"} {
1759
catch {append ffont "-size [expr $fontsize $size]"}
1761
catch {append ffont "-size [expr $size]"}
1764
append ffont "-size $fontsize"
1766
if {$attr(colors)!=""} {
1767
set color "[lindex $attr(colors) 0]"
1769
if {$attr(bgcolors)!=""} {
1770
catch {$w.text tag configure tag$_count -background [lindex $attr(bgcolors) 0]}
1772
catch {$w.text tag configure tag$_count -font $ffont}
1773
catch {$w.text tag configure tag$_count -foreground $color}
1774
catch {$w.text tag configure tag$_count -justify $justify}
1775
catch {$w.text tag configure tag$_count -lmargin1 $attr(margin) -lmargin2 $attr(margin) -rmargin $rmargin}
1776
if {[set lnk [lindex $attr(links) 0]]!=""} {
1777
$w.text tag configure tag$_count -underline 1
1778
catch {$w.text tag configure tag$_count -foreground $settings(link)}
1779
$w.text tag bind tag$_count <Enter> "$w.text configure -cursor hand2; catch {$w.text tag configure tag$_count -foreground \$help::settings(alink)}"
1780
if {![regexp "^tcl(script)?:(.*)" $lnk x lnk_type lnk]} {
1781
$w.text tag bind tag$_count <1> "help::show \{$lnk\}"
1782
if {[lindex $attr(link_titles) 0]!=""} {
1783
$w.text tag bind tag$_count <Enter> "+ set help::stat \{[lindex $attr(link_titles) 0]\}"
1784
} elseif {[info exists data([set ltopic [lindex [split $lnk "#"] 0]],title)]} {
1785
$w.text tag bind tag$_count <Enter> "+ set help::stat \{$data($ltopic,title)\}"
1786
} elseif {$ltopic=="" && [info exists data($curtopic,title)]} {
1787
$w.text tag bind tag$_count <Enter> "+ set help::stat \{$data($curtopic,title)\}"
1788
} elseif {$index==""} {
1789
$w.text tag bind tag$_count <Enter> "+ set help::stat \{$lnk\}"
1792
if {$lnk_type==""} {
1793
$w.text tag bind tag$_count <1> "if {\[catch \{namespace eval :: \{$lnk\}\}\]} {set help::data(__@Error@__,title) Error; set help::data(__@Error@__,text) \"<font color=red><pre>\$::errorInfo</pre></font>\"; help::show __@Error@__}"
1795
$w.text tag bind tag$_count <1> "if {\[catch \{$interp eval \{$lnk\}\}\]} {set help::data(__@Error@__,title) Error; set help::data(__@Error@__,text) \"<font color=red><pre>\$::errorInfo</pre></font>\"; help::show __@Error@__}"
1797
if {[lindex $attr(link_titles) 0]!=""} {
1798
$w.text tag bind tag$_count <Enter> "+ set help::stat \{[lindex $attr(link_titles) 0]\}"
1801
$w.text tag bind tag$_count <Leave> "$w.text configure -cursor arrow; catch {$w.text tag configure tag$_count -foreground \$help::settings(link)}; set help::stat \{Done.\}"
1803
set _tags($w,$attr(style),$attr(links),$attr(bgcolors),$attr(colors),$attr(sizes),$justify,$attr(margin)) tag$_count
1807
#-------------------------------------------------------------------------------
1808
# Function : help::gethr
1809
# Description : Configure and get tag for horizontal line
1810
# Parameters : width - line width
1811
# Return : Text with tags
1812
#-------------------------------------------------------------------------------
1813
proc help::gethr {height color} {
1818
if {$color==""} {set color $settings(fore)}
1819
if {$height==""} {set height 1}
1821
$w.text tag configure tagh$_count -font "-size 1"
1822
catch {$w.text tag configure tagh$_count -background $settings(fore)}
1823
catch {$w.text tag configure tagh$_count -background $color}
1824
catch {$w.text tag configure tagh$_count -font "-size $height" -spacing3 0}
1825
return "\"\n\" h \"\n\" tagh$_count \"\n\" h"
1828
#-------------------------------------------------------------------------------
1829
# Function : help::show
1830
# Description : Show topic
1831
# Parameters : topic - topic name
1832
# : modhist - modify or not history
1834
#-------------------------------------------------------------------------------
1835
proc help::show {{topic contents} {modhist 1} {textpos {}}} {
1855
variable curfilename
1862
variable _isscript 0
1865
#sch vars for __Prev, __up1level, __Next
1871
variable _need_tag ""
1878
switch -exact -- $topic {
1879
__dec {event generate $w.text <Control-bracketleft>; return}
1880
__find {dlgfind:init; return}
1881
__inc {event generate $w.text <Control-bracketright>; return}
1882
__open {event generate $w.text <Control-o>; return}
1883
__refresh {event generate $w.text <Control-r>; return}
1884
__reload {event generate $w.text <Control-l>; return}
1885
__stop {set abort 1; return}
1886
__search {dlgfind:init 0; return}
1890
if {[set pos [string first "#" $topic]]!=-1} {
1891
set mark [string tolower [string range $topic [expr $pos + 1] end]]
1892
set topic [string range $topic 0 [expr $pos - 1]]
1898
set topic "contents"
1902
if {$curtopic==$topic || ($index=="" && $curtopic==[file join [file dirname $curfilename] $topic])} {
1905
if {[llength $history] && $hpos==[expr [llength $history]-1]} {
1906
set history [lreplace $history $hpos $hpos [lreplace [lindex $history $hpos] 1 1 [$w.text index @0,0]]]
1908
catch {set history [lrange $history 0 $hpos]}
1909
if {[lindex [lindex $history end] 0]!="$curtopic#$mark"} {
1910
lappend history [list "$curtopic#$mark" 0]
1912
set hpos [expr [llength $history] - 1]
1914
showmark "mark_$mark"
1925
catch {after cancel "help::show $topic $modhist"}
1926
after 200 "help::show $topic $modhist"
1931
bind $w.text <Control-r> ""
1933
#sch find topic for __up1level, __Prev and __Next
1934
if {$topic=="__up1level"} {
1935
set topic $up1level($curtopic)
1937
if {$topic=="__Prev" || $topic=="__Next"} {
1938
set i [lsearch $sequence $curtopic]
1939
if {$topic=="__Prev"} {
1944
set topic [lindex $sequence $i]
1948
if {$topic=="__prev" || $topic=="__next"} {
1950
if {[llength $history]} {
1951
set history [lreplace $history $hpos $hpos [lreplace [lindex $history $hpos] 1 1 [$w.text index @0,0]]]
1953
[string range $topic 2 end]
1957
if {$modhist && [llength $history] && $hpos==[expr [llength $history]-1]} {
1958
set history [lreplace $history $hpos $hpos [lreplace [lindex $history $hpos] 1 1 [$w.text index @0,0]]]
1963
if {$topic!="" && $index!=""} {
1964
if {[lsearch $index $topic]==-1} {
1965
if {$topic=="contents"} {
1970
if {[string match "__@*@__" $topic]} {
1971
if {[catch {set _text $data($topic,text); set title $data($topic,title)}]} {
1977
set _text "<font color=#c00000>Topic</font> <b>\"$topic\"</b> <font color=#c00000>not found in</font> <b>\"[file join [pwd] $curfilename]\"</b><font color=#c00000>!</font>"
1978
set title "Topic not found!"
1982
set _text $data($topic,text)
1983
set title $data($topic,title)
1984
if {$index=="__file_error"} {
1989
if {[string match "__@*@__" $topic]} {
1990
if {[catch {set _text $data($topic,text); set title $data($topic,title)}]} {
1996
if {$topic=="contents"} {
1997
set topic $curfilename
1999
set topic [file join [file dirname $curfilename] $topic]
2000
# make it an absolute path
2001
if {[file exists [file dirname $topic]]} {
2003
cd [file dirname $topic]
2007
set topic [file join $absdir [file tail $topic]]
2009
if {![load $topic]} {
2011
catch {set history [lrange $history 0 $hpos]}
2012
if {[lindex [lindex $history end] 0]!="$topic#$mark"} {
2013
lappend history [list "$topic#$mark" 0]
2015
set hpos [expr [llength $history] - 1]
2019
set _text $data(text)
2020
regsub -all -- "\[\r\n \]+" $data(title) " " data(title)
2021
set title $data(title)
2023
# set curtopic $curfilename
2024
# set topic $curfilename
2029
catch {set history [lrange $history 0 $hpos]}
2030
if {[lindex [lindex $history end] 0]!="$topic#$mark"} {
2031
lappend history [list "$topic#$mark" 0]
2033
set hpos [expr [llength $history] - 1]
2036
#sch get position for __Prev and __Next
2037
set spos [lsearch $sequence $curtopic]
2040
catch {unset tables}
2041
array set tables "level 0 stack {} count 0 tables {}"
2042
catch {interp delete $interp}
2043
catch {set interp [interp create]}
2044
catch {$interp alias g_eval ::eval}
2045
catch {$interp alias img_change ::help::img_change}
2046
catch {$interp alias id_change ::help::id_change }
2047
catch {$interp alias id_visible ::help::id_visible}
2048
catch {$interp eval [list set script_dir [file dirname $curfilename]]}
2051
bind $w.text <Control-r> "set help::curtopic {}; help::show $topic"
2053
set stat "Creating title..."
2055
if {$title==""} {set title "Untitled"}
2057
array set settings "back {$backcolor} fore {$forecolor} link {$linkcolor} alink {$alinkcolor}"
2058
catch {$w.title configure -foreground $settings(fore)}
2059
catch {$w.title configure -background $settings(back)}
2060
catch {$w.text configure -foreground $settings(fore)}
2061
catch {$w.text configure -background $settings(back)}
2062
set _t_title(title) [$w.title create text 4 4 -anchor nw -fill $settings(fore) -text $title \
2063
-font "-family $font -size [expr $fontsize + 12] -weight bold"]
2065
set inc [font metrics "-family $font -size [expr $fontsize + 12] -weight bold" -displayof $w -ascent]
2066
set spc [font measure "-family $font -size [expr $fontsize - 2]" -displayof $w.title " "]
2069
foreach control $controls {
2070
switch -glob -- $control {
2071
b* {set link "__prev"}
2072
c* {set link "contents"}
2073
d* {set link "__dec"}
2074
fi* {set link "__find"}
2075
fo* {set link "__next"}
2076
inc* {set link "__inc"}
2077
ind* {set link "__index"}
2078
n* {set link "__Next"}
2079
o* {set link "__open"}
2080
p* {set link "__Prev"}
2081
ref* {set link "__refresh"}
2082
rel* {set link "__reload"}
2083
sea* {set link "__search"}
2084
sep* {incr x $spc; continue}
2085
st* {set link "__stop"}
2086
u* {set link "__up1level"}
2089
foreach {txt vis expr btn} $btninfo($link) {
2092
set _t_title($link) [$w.title create text $x [expr $fontsize + $inc] -anchor nw -fill $settings(fore) \
2093
-text $txt -font "-family $font -size [expr $fontsize - 2] -underline 1"]
2094
catch {$w.title itemconfigure $_t_title($link) -fill $settings(link)}
2095
$w.title bind $_t_title($link) <1> "help::show \{$link\}"
2096
$w.title bind $_t_title($link) <Enter> "$w.title configure -cursor hand2; catch {$w.title itemconfigure $_t_title($link) -fill \$help::settings(alink)}; set help::stat \{$txt\}"
2097
$w.title bind $_t_title($link) <Leave> "$w.title configure -cursor arrow; catch {$w.title itemconfigure $_t_title($link) -fill \$help::settings(link)}; set help::stat \{Done.\}"
2099
set _t_title($link) [$w.title create text $x [expr $fontsize + $inc] -anchor nw -fill $settings(fore) \
2100
-text $txt -font "-family $font -size [expr $fontsize - 2]"]
2102
set x [expr [lindex [$w.title bbox $_t_title($link)] 2] + $spc]
2107
updatehead "__prev __next __stop __Prev __Next __up1level contents __index __search"
2109
if {$controls!=""} {
2110
incr inc [expr 4 + [font metrics "-family $font -size [expr $fontsize - 2]" -displayof $w -linespace]]
2112
incr inc [font metrics "-family $font -size [expr $fontsize - 2]" -displayof $w -ascent]
2113
set _t_title(line) [$w.title create line 0 $inc 5000 $inc -width 2 -fill $settings(fore)]
2115
foreach {x1 y1 x2 y2} [$w.title bbox all] {break}
2116
$w.title configure -scrollregion "$x1 $y1 $x2 $y2" -height [expr $y2 - $y1]
2117
$w.title xview moveto 0 ; $w.title yview moveto 0
2119
if {[string match {.tophelpwindow*} $w]} {
2120
wm title .tophelpwindow "Help - $title"
2123
set stat "Displaying..."
2125
catch {after cancel "help::updatestate"}
2126
after 250 "help::updatestate"
2127
catch {after cancel "help::update_d"}
2128
after 100 "help::update_d"
2130
$w.text configure -state normal
2131
$w.text delete 1.0 end
2132
eval "$w.text mark unset [$w.text mark names]"
2138
set attr(ul_type) ""
2140
set attr(tag_fonts) ""
2143
set attr(link_titles) ""
2145
set attr(bgcolors) ""
2148
set attr(justify) ""
2149
set attr(justify,global) ""
2150
set attr(margin) $lmargin
2153
set deltags [lrange [$w.text tag names] 2 end]
2154
catch {eval "$w.text tag delete $deltags"}
2155
catch {$w.text tag configure fnd -foreground [$w.text tag cget sel -foreground] \
2156
-background [$w.text tag cget sel -background]}
2157
if {$h4topics=="" && $h4contents==""} {
2158
regsub -all -- {<!--.*?-->} $_text "" _all_text
2160
set _all_text $_text
2162
set totallen [string length $_all_text]
2165
while {!$abort && $_text_pos!=$totallen} {
2166
set pos [string first "<" [string range $_all_text [expr {$_text_pos + 1024}] end]]
2168
set _text [string range $_all_text $_text_pos end]
2169
set _text_pos $totallen
2171
set _text [string range $_all_text $_text_pos [expr {$_text_pos + 1024 + $pos - 1}]]
2172
set _text_pos [expr {$_text_pos + 1024 + $pos}]
2174
set perc [format %2.1f [expr ($_text_pos - [string length $_text]) * 100 / $totallen.0]]
2176
while {!$abort && [set pos [string first "<" $_text]]!=-1} {
2177
set outtext [string range $_text 0 [expr {$pos - 1}]]
2178
set _text [string range $_text $pos end]
2180
append data(title) $outtext
2181
} elseif {$_isscript} {
2182
append data(script) $outtext
2183
if {![regexp -nocase "^\<\[\r\t\n \]*\/script" $_text]} {
2184
append data(script) "<"
2185
set _text [string range $_text 1 end]
2188
} elseif {$_istext} {
2189
if {[lsearch $attr(style) "p"]==-1} {
2190
if {[$w.text get "end -2c"]=="\n"} {
2191
set outtext [string trimleft $outtext " \t\n"]
2193
regsub -all -- "\[\r\t\n \]+" $outtext " " outtext
2196
$w.text insert end [specialentities $outtext] [gettags]
2199
if {[set pos [string first ">" $_text]]!=-1} {
2200
set tag [string trim [string range $_text 0 $pos] "< >\t\n"]
2201
set _text [string range $_text [incr pos] end]
2203
set tag [string trim $_text "< >\t\n"]
2206
regsub -all -- "\[\r\t\n \]+" $tag " " tag
2207
if {[set pos [string first " " $tag]]!=-1} {
2208
set tagparams [parsetag [string range $tag $pos end]]
2209
set tag [string range $tag 0 [expr $pos - 1]]
2213
set tag [string tolower $tag]
2214
catch {tag_$tag $tagparams}
2217
if {!$_istitle && !$_isscript && $_istext} {
2218
if {[lsearch $attr(style) "p"]==-1} {
2219
if {[$w.text get "end -2c"]=="\n"} {
2220
set _text [string trimleft $_text " \t\n"]
2221
if {$_text_pos==$totallen} {
2222
set _text [string trimright $_text " \t\n"]
2225
regsub -all -- "\[\r\t\n \]+" $_text " " _text
2228
$w.text insert end [specialentities $_text] [gettags]
2230
} elseif {$_isscript} {
2231
append data(script) "$_text"
2236
if {!$abort && $_isscript} {
2237
append data(script) "$_text"
2238
catch {tag_/script ""}
2242
while {$tables(stack)!=""} {
2246
$w.text configure -cursor arrow
2247
$w.text configure -state disabled
2248
$w.text tag raise fnd
2249
$w.text tag raise sel
2253
#-------------------------------------------------------------------------------
2254
# Function : help::updatehead
2258
#-------------------------------------------------------------------------------
2259
proc help::updatehead {{what "__prev __next __inc __dec __stop __Prev __Next __up1level"}} {
2274
foreach link $what {
2275
foreach {txt vis expr btn } $btninfo($link) {
2277
catch {$w.[set btn] configure -state normal}
2279
$w.title itemconfigure $_t_title($link) -font "-family $font -size [expr $fontsize - 2] -underline 1"
2280
catch {$w.title itemconfigure $_t_title($link) -fill $settings(link)}
2281
$w.title bind $_t_title($link) <1> "help::show \{$link\}"
2282
$w.title bind $_t_title($link) <Enter> "$w.title configure -cursor hand2; catch {$w.title itemconfigure $_t_title($link) -fill \$help::settings(alink)}; set help::stat \{$txt\}"
2283
$w.title bind $_t_title($link) <Leave> "$w.title configure -cursor arrow; catch {$w.title itemconfigure $_t_title($link) -fill \$help::settings(link)}; set help::stat \{Done.\}"
2286
catch {$w.[set btn] configure -state disabled}
2288
$w.title itemconfigure $_t_title($link) -font "-family $font -size [expr $fontsize - 2] -underline 0"
2289
catch {$w.title itemconfigure $_t_title($link) -fill $settings(fore)}
2290
$w.title bind $_t_title($link) <1> ""
2291
$w.title bind $_t_title($link) <Enter> ""
2292
$w.title bind $_t_title($link) <Leave> ""
2293
$w.title configure -cursor arrow
2300
#-------------------------------------------------------------------------------
2301
# Function : help::prev
2302
# Description : Show previous topic
2305
#-------------------------------------------------------------------------------
2306
proc help::prev {} {
2312
set tpos [lindex [lindex $history [incr hpos -1]] 1]
2313
if {[set pos [string first "#" [set topic [lindex [lindex $history $hpos] 0]]]]!=-1} {
2314
set topic [string range $topic 0 [expr $pos - 1]]
2320
#-------------------------------------------------------------------------------
2321
# Function : help::next
2322
# Description : Show next topic
2325
#-------------------------------------------------------------------------------
2326
proc help::next {} {
2331
if {$hpos<[expr [llength $history] - 1]} {
2332
set tpos [lindex [lindex $history [incr hpos]] 1]
2333
if {[set pos [string first "#" [set topic [lindex [lindex $history $hpos] 0]]]]!=-1} {
2334
set topic [string range $topic 0 [expr $pos - 1]]
2340
#-------------------------------------------------------------------------------
2341
# Function : help::reg
2342
# Description : Assign help topic to widget
2343
# Parameters : widget - widget path
2344
# : filename - name of file with help
2345
# : topic - topic name
2347
#-------------------------------------------------------------------------------
2348
proc help::reg {widget filename topic {parent {}} {event {<F1>}} {width 450} {height 400}} {
2351
if {$filename=="" || $topic==""} {
2352
if {[info exists $regs($widget)]} {
2353
bind $widget $event ""
2357
bind $widget $event "help::init \{$filename\} \{$topic\} \{$parent\} $width $height; break"
2362
#-------------------------------------------------------------------------------
2363
# Function : help::updatestate
2364
# Description : Update statusbar every 1/4 of seconds
2367
#-------------------------------------------------------------------------------
2368
proc help::updatestate {} {
2374
set stat "Displaying... $perc%."
2375
after 250 "help::updatestate"
2379
#-------------------------------------------------------------------------------
2380
# Function : help::update_d
2381
# Description : Update animated image
2384
#-------------------------------------------------------------------------------
2385
proc help::update_d {} {
2393
if {$_dnum>3} {set _dnum 1}
2394
$gw.d configure -image $_images(d[set _dnum])
2395
after 200 "help::update_d"
2399
#-------------------------------------------------------------------------------
2400
# Function : help::show_about
2401
# Description : Show about text
2404
#-------------------------------------------------------------------------------
2405
proc help::show_about {} {
2408
set data(__@AbOuT@__,text) "<body text=black bgcolor=#ffffd2 link=navy>
2409
<p><img src=\"__@LoGo@__\"></p>
2410
<p>(c) Copyright by <b><font color=navy>Andrei A. Gratchev</font></b>,
2411
<font color=navy>Russia</font>, <font color=navy>Moscow</font>,
2412
<font color=navy>2000</font> - <font color=navy>2003</font><br>
2413
E-Mail: <font color=navy><u><tt><a href=mailto:grand@deversys.com>grand@deversys.com</a></tt></u></font>
2414
</p><br><p><font size=-1>Special thanks to:<ul><li><kbd>J.W.Schmitz-Hübsch
2415
</kbd><br> for implementations of additional features<li><kbd>Dave Clews</kbd><br>
2416
for help in translation of in-line documentation</ul></font></p>"
2417
set data(__@AbOuT@__,title) "About"
2418
if {![info exists data(__@LoGo@__,image)]} {
2419
set data(__@LoGo@__,image) [image create photo -data \
2420
"R0lGODlhowBFAPf/AAMDCQUFCgMDBgsLDfDw8efn6MnJyjM1ai8xYTc8eCksVzA3bz9IjiMoTB4hOQkKEUhWpgUHET1Nm0BQnzZEhBwjRCIuYik3cx4oUBMZMiczZSgyWzA5YhUZKnmFum10kRElbBEjZBUmYhkraRQiUhEdRhkpYQ0VMx0vbQcLGhwrXxsoWRomVCQ0bSc4dBolTC0/fgUHDhcgPzZKkiAsVxYdNiEoQRASGT5E
2421
WxUXHo2UrMrP4g4ndBYvexUrcxcrbhcrahovchktbhcpZRYoYBQkVxEfSxktaxUmWw0XOBAcQg8aPQsTLAkPIx4zdCA1eRssZQgNHh4vZyAyayQ3dhYiRyg8fgwSJSs9dSg4aklYijM7VlZhhE1TZmZrfA8rexgzfwMGDhw1fh04ghIhTiU+hQYKFS1FjCw9bT5VlDtPh0hemzVFclRooEJPc2Bzp0dVe1lolEFLaG19rC40RVNc
2422
dIyZvV1jdIaNol5haY6SnQMFCg0PFH2NtXeEppikwjo+SKewx5qhssXK1lNZZ6Sru6WorykrL7nAzq+0vjQ1N+rr7d/g4pWdq4OKlh0eH2ZoatTW2Li5un+FiG1xc8/S0wIDA3R4d56iob7Av2tubJWYlU9QT7Kzsn2Aetzd2tHVxMnNusfKtLCypGtsZc7QvcfJsGRlWWhpXdrcwuvs3PDx5Pf5z/X3zfP1y/X3z7m6nru8o7y9
2423
pvX24u/wxtvct8PEpP//0fr6zv//0/390fX1yvPzycnJpvf3zeXlvtDQrbe3mP//1f390/Pzy+rqw9TUscDAoLq6m/f3z/X1zczMq///1/391fr60vHxy7GxlaOjifX1z///2f391/Pzzvv71qurkpeXgYqKdm1tXf//2/392XJyYv//3f3928fHrGFhVPv72v//3/393fT01erqzXl5arKynf//4v394PX121RUS/j43sDArP//
2424
5vr64v//6vv76HFxaVlZU0pKRUFBPfb26mRkYV5eXP////39/fr6+vX19SQkJAgICCwAAAAAowBFAAAI/wBz5WI2bZu3ceO8edvGTJjAWxAjSrwlMJcwYcwITtvIMWNDhxUnihxJsqTJkyhTqlwp0eI0b+liyvQ2rWGukgIvEjSIsGdPhdu21bT5kKXRo0iTKsUI8927ePGcpmMoTBcuXRNz7oQZ06lXqTIRLhwKUqnZs2iTCps2
2425
Ll2BHTsGDUKEKJIzZbx24Wppkdm2tl6hCh78NSZCoUTTKl7MOKKwv+92BPpjp8+cOYVS1fpFay/EnC/TORW8ilGkuXTpVorESB7YhDUdNp5NG6nftoMoe3izZo0Od7aA/dr1eSBb0VDvRZpMuXKf59D72PmD6NMsdeOo5sJau7t3krfhIf/qszvNGTV+rkE7VosXxYF/kcurNLnynDdv2ujXj//yHD/PJfKJONY448tV3yWYoF/k
2426
tIPIfWuM8QQMH2CDDTTG0KKLS4DFU0B9u60xQxlWlFhiGWWckcYa/LWBnw6p/FIMLb4oaGNtj33TTiC8zdBDEFRw4Uk20fRSjC5rNRUPI5T18UYaZTyBghRQVCmFFFO04MQTVqQ4wwxqaBGHO+AY84t7N6a52FrfrMPjGmf8GOQ5nkRjSzHO+IUck3bM0UYZTgxBhApSZOHGoW6gocEUWDqxJZcUaHENOsdkqOalaLHpJm9xAsnF
2427
POdgc6czx71TAGVzrCEGEEhAwcYdmpD/gk8++eCDDyR31IFGC1OgcMQUF7BhITTLHInpsUhp+manQZIS6jF4boNcIH2qKmgWd5BCDyf1dOstJ/TkQ8odbLRwZRZs0InNMb94huy7KSnLqZxcOLvuL9Y0FYkdHrQxBqtZUJIPJ/YoYo893nbLDjvhjssGGmi4gc882ATTLrwYnyQvnPTaCy01gP3h5AxBiCCFF/nUY3A97IRzijYw
2428
a4NKOOGEa2sdcMBBDyrZBFNLjRkHLdLGzNb7bDEgp6OKZf7+YEId+KhsDzvaZINNNFhjjU0253SDyin00ENIHOzw7DPQQqd9C9EdH81NW5U4mQYYQEBxBz3dhnNONNDY/7IMMIAv08sx0ETDtTY150NPN/eirXbQbHvqcTFvp/NgGz4e0QIkeIeTzTW2GLNZMaQX80stxvSCjOHnwNzN57384vjjGEferNvjwFPIvCigoUk+ehdZ
2429
y4y7+GK8L7vwYnotywQTzdZXI2NMMe7SXvs0bS7bNja9PPN2O3/M6wQWl3hcC43VQ2SVL7QUU8vgwQRzjHCdWQ859ptyHIQVXJyTDTS1qMY31NEOQbQBSmBwAgw8MaRrAKMYvuDOSKyyC1qcDnWj24UE7fcutjnBCnEgEjh+UQ51wGMWhTjgGcAwoQpdY4TVGEZIJrg+WrSPeAjiILzYJgYrfGAT6CiFOf/WIQ95zCIRmCsDGMQA
2430
Ay5gIhZCLIdHQFKUiazveDnUYQfx96YZLLEMHxiFKFKhilkUcRWVSOIYwFAG9IxxiOIIykY+UpGbqE99utigFpG1sRmssQxtEEQiELEaRnwiEgZ4gxqUCIYxnME3oDCHKtaBnYSMJTZU3OPj+qjEMqShDXPwgHTsQEo74EELMBBDI1XUBj9k4hOqaIdM0iEWORLFjprMGCdX+cn++McPfoiDGqzghB44kkVz6EMgBqEKr8wyIYgp
2431
Sy6vl70ejeELXzCml2aQhm5qgQtxQCUVgtADMLDyDf+RDiGb+ZqF3HKaW6ymiMDAg3r64J4+CII+ndD/AjTIAWdYaIEQyOnIFfnyOXZIRCVWERN1jEWa8MQU0b7AAxCE4KIiyKhGVbCBLeCAEHAIqK9+EAResuigffhDJeChjm/EpooRTdNELRqCEaCgBRfIaU6zkAUOeLQLdWBDFqg0AiAMVAxiKAM3T4rOOeigEu0QBzUyGRGr
2432
sKIVWM2qVrfK1a569atgDatYs6qMsppVGbtIq1qTVzzuzDQEbrgEJSCRh7ralRCc4FZexSZUKplgCEMwahDEUFAWuegNhVBFOZwhQ1zqohqpAEUpQkHZylr2spjNbGVFwdnOevazoOWsKUZL2tKa1hTgSK1qV8ta1trCFseIBSzmZ6yZ/w4BDr/jVsK6dTBF+PZgnCAEIdyQBUZBwQRQGMFA2bhUFuHBHM+oBivchYtfZEIQOsCD
2433
drfL3e5y1xHgDa94x0teR0zivOhNr3rXOwkGuve98I0vfM9B33nMQ2aMA0aN2PYDFMABHwQ7GMJ421vfGhhhnMhHHuqQKEZJ4QjL9dKKGhGjYvDCM6xIhSE+EE4tePjDIA5xzkZMYjgg6sQnloOKV8xiFePgxTCOsYwBQeMa2/jGNTawjg18iB4rohuwcA9//Yu3btGDZkgOGzvqUeCDdWuvCg5qcVFAUBSFyRCl2MyFb8EKUDRC
2434
mBSAgZjHTGYsmPnMZtYpT9ecBQ24+f/NG4iznDdAgzrXGQMNyLOe82yDPvvZBg4ItKAFXYMadODQiO7AIxa96Bw42tE3uAEf+HADf4QjGELm4ryEQIU6KC4cr7OQqC2UDa514xQ1W9jC8rpXfGiiDligwhPA0Mg2xkEWZYKgLrr8ZQpYgQrADnawHUXsKRj72Fe6UpVUwGwVrODZK2CBtKX9gmq/oArYzrYMts3tQhc6A+AGd6I7
2435
cIVymzvS6J60utU9gHa7+xGXzrQ8i4YPVIQqGLbohb73PThkFI7UXdMGqumxsHBp4hJqgMGse8BENQDRFufDRZd1sAYYUMEJ+sx4xlEgBCEc4eMjCDkUhmACExDh5Ej/SHkRVk6ClpOADGQwgsxLQHMl2HwJOMd5EnZ+gp6fgAlAB3q5m0D0KBg9CilIgRmWboYIOD0GUA+A1AMAAAFY/R8DgDem16Zp/QUJFa9z4GZ+QfayX9AY
2436
y7AFMoJxjeeZ+munIMUlJrHINfaAChT4QDTQsQzZTVycGtdnxwf/cSAYHrBDyOjJiaDylRfB5TCPuRFoXgKbKyHnS9g5z30edKFfgehNOHrSk870p4fh9HvYQ9WtLgBLuB7rWpd3/opGCor5jBZrVSsveGFD053OGMBQ3b+zwUCrOaLuPRgfF64Gi/YkAxQ6QOUTAi94wh/B8EBAvKAWn3IkOB7ykp98/80tn3PNJ8HnP+/80EEv
2437
etIv3ekROH0YUg+A1bv+9VmPN9fnvT12pa+qeYQLuOALvLc8tRB8/nYNCogJIlIGP+ICbmA1DkQLzxd9MIBxgzd4P/BxR7CB2Id4KNd93vd9LQdzMid+N1d+5nd+6Nd5TAB6RYd0o1d6pjd/qsd6rYd/sbd/s9d/7VJHM2RFApg87XN2ywAO7vAkndICbHAJRHInrQB9WoAFTnB92PeBgYV9RQVYjDeCjveF4DdzlZd5K7iC6Jd+
2438
QgeDRjd67td0Tod69Ld6OWgJsKd/tmM09+IMGDFFMCUSVoELRGg6qVAKFOdFQjAFbAAq90IMpXBKLv+AAoIiAiBIBBkFWIY3AoAlAiPYcl9Igi8neWO4eT1Xhi2ofuy3hmxIgzEAh6onh/dXh1t3hx7zC6RiEEIxDVRlErrgDK9QDuZgDnZwQGDwA1KABqTwOsgwPJngB2rQAlDQhdyXcicHgiLAeI8XczDnciUYeSYYimfoc5pX
2439
ikGnhmzYhm4YAVAHh3I4h7Aoe9ojOUdDDQdhGDTxTiSRE9wgDuugCnbwJD0ABFIgMWZTC6lQCHFAAVNgAo/XiSSwcpSIciwXcyVwB17gBpF3ghg5eZd3fkBHBx71jT1niqdYjkx3jvHHiut4f3SYf7HYdbSHO+kwCLOQDg41R7kYEaD/ARPwsDRvQDJDIAV1QA+n0DO1UApfhgVSgAQk0AmSoAcl6AiSYABIYI0leIIlIAmZ8AFW
2440
aXM0t5UcSQiY0AmZYACV0AkNwHmdp4aomAKEkA+AQIM1mHo3iIMqKQD/sIOyeDTiIBqIEAiqwFLkcIsZcRF1pBPx8Q7z0QdtcAZCYAIakAfsMJTJSIhacAFQoJRM6ZQtpweZEAlUaZWUF5VaWXM4pwRdqZFLcAKEwJSZYAiSwAiMIAdomIYx2H4pwJR5QIPyZ4P1l5J1eZd26JL9VwzfkA7ywByD0A7tQA6WJEccURCH+RT38Aep
2441
IgYkxwYDcwrrUguhcEqW+XhY2QiO/9cIlfAJjEcCRrABdVAHXfACNJcJlaCVKpZnFKkAJTBzSrBzYikJFYBzCtAIXoADdAB0TUBjdBB6HRBchIADHZACdBCVk0BjTucPeVUPfEB1PeZoecUHlpAD4fII/wCcLcl/8LguxGlCzSEdkdAOLEWTPoEQXfEUUDEeb8CYRDAFdcAtqMA9tSAJzNgCCkkCYykI3ScIn1AA5/kBncCUkmAI
2442
G0AGBvAJH0AGlWAAhjCWVboBJ7iRBhAJkdAFOncCemAAksAEV+AAY3kHTWADrjmWBrAJKUCWn2BIkWAGlMCkrfkIe7Ckm9CmncAJnUCWlXADWXcKI9qDJQot3EBAz//hB/cxB3/wCfAAD6IhE18hGPeACH2SBk4gAiaAnSxzDg4UCoZwkAm5clFaAKq6CItAAP0gKFyQCZLABVwQpTpQBEfqByQAmwbwAY3ACIsgCN2Ic4ZQAATA
2443
D4tgCF5wAndgAAbQBUxwB6xhA1cQqJnQBTigB4YQBV5QAP0gCXJFCAaQCQPTpZMQBmQZCWIJm4wQla16CQPgD/gQZDz4jrdjotTQJvehHyc1B3aACKrgGqMxGKuwHNXyBCSXBTlqD/TQM8YgChY4BdYYCQSgDxZ7sfogBESgUB9QBEiABwXACEhgrH5QBAWwCFNKBpHADwSwAs5mBJe3BYzQD/vAD/3/sAiZIANd6ghMIAmLUAhA
2444
9wlV2gU20AQZEHr9oA+TkHSSEAmX4HSeYBphAKyTsAf+wA/8MAkCwAcW6wk5cAikQK95aaLWYA3loIRe0q/PEQiE5KWV0JdN8iQISwQKSw8Iow2iYgw+Okwo0IWMoA878CUzsAMW+wRAsAgnm7QXOwRJiwdF4Kq6SgKIYLEt0AIWgJov8AGJwAhYyw+NoAcF8Al0wA/68AEvwASJoKquKgmAQHT7oLRJRwCtSrr68Lox8LqTUG4W
2445
m7tXYLGO4AB0oAliy0UHNAY+8ANOUC8UAy3O4AzF8AHitCUFdVihFB3PASFlUDImULdM1rDQAAyh/yAIB0kFR7B9FbsDEpC+hKsPZ2AFFjsIpURK7qsPOkAEr4sHrTIIFhtmLUAGl6cApVkCXPC+cvC6k0sAC6ABLyADk/C3FssIFVADvgtuFosI2wVeFWCxeJBnvlsBGawPG7wFlBALmSYO5VAIHAMCQzAF/8U47OIMtGAMmBAH
2446
bHABU3AEKLAlEmZY/GoexDQCRAAF3Ds13WAneusH4lS+gPW6OwABEzAB6ysBM/C3gSu4HkABFmsHUKDBUKAFFrsDDEAB/VsCS1AJXvACSsACXqwPgYABkXCxgZAAC4AB0LoEclAAFosAGOC7MlABb2wACoAACtAAH6AAFqsDgqzBCv9gyPSrACJMwmvDDNRQDn8AJ0EAWC7gaaRwL61QDMtwDdjgBXCABsYlBTksayZSIheHAs8o
2447
xGyQB3arCPUwkOF7kMRkhULwxRDgxOsLARLgAQ/8B4GwCIGbxVJgsQUwCIrbBxJAARdAApVnrPuACPqrD/0QBxaABxc7BxQwx/pQCY4gCO+7AArwtwSAB4XwARYbCTogCMmMAIecyCC8yPGMAyMsZMxgDeYgCGtAAVSAAi5AAUGJt7bwC538yVxDCpDAYMVFJVaSbMeFXFNgKHcwME42lMFgDKWwjID3Az8gBE+gy0/cyxMgAXaw
2448
CBgbCBKQxS1gsShtsYHgy2IMzSX/IAgVe7E70AYJYAEc4NIMwAAJQANvjNNakAAH4AcYmwAgi7GFsACHfADwTL8IENU6wAH2TK8W8Qq10AhtoAYUQAFhUgdUIyrDUQzGEAzYcA5gEzb4sGCH8jBrhgZs4AZ1cAecQzAGQzU9swzmkAk6ML4YCNJWMAMT4MTpKwGFbdjp+wYe4AG7PAEzEGYuYLHhsxtOzAAwIAXoaQQsYAFcgE5t
2449
EMYLQAMDrA9/EMYJsAEYwAEfMAdx8NNGjQBs8AHQmwC2HQe0bdtGvQAHANVT/dsI0NsIsAXC6x4CEcPQkA3zMCtLRsTR0HfJ8wu9kNxqTXCsFja0Yiu2QivbwmQr/7M4FfML5hAKfz1M05dxT5Aihy24M5C+7H3YJR3ZMGAFk23au3zZzqwCLccCKqABWEABP93NFrAChWCxod3NNIABCnAACfDVcowAGxDcB7AAvN3bFg7ci5zh
2450
g5xni9wAdBC2aKILMYwO2DAPeONknoMh1IMLFrQM0LA13ZBqu7VbAuZkev3czjDeXzZMF5dxW2IFZxDkQh7kMzDkZ8DeRT7fJULZj43ZFzDgJMACK2ABLYAFMPDVWKABNNDTgAvbWo4BNKABFA7VCpDgChDhU70Bi6zmGa5nHjxocH4I+LB1t8DitRALaQ02C6M329kZVsELv2AMtlA4pqbnSzbjLP/TMlUTDcegC8rwC6Gw4xaH
2451
cT7+BFyCIiRyIqlsBTAw5L4GbJxOAYVd0pjdAs7mcvytATh1AQlMAywQ5g1OAQmQBTRQbWC+yLVeAX1cAXvW6w3gwd+WAeOWaF9rqGgCiL8ADGhtav5TMcKhQbdgFRBxOstAOG5HX90gM6iACq7T7KDj6OaQCpJQ3pNOfUHgKJb+BMRGbPvkKMDmKCgQ7y3gAjDwJWF2AVKgAtcYeVEu5dF2bVXQ2Qsgx1qOxjjHbUuQAel3AuEm
2452
bohmplcgg0r3ABRf8RTPB5ZG5xDRPu+TgNCAb/QzO4B4C8VwCwcIP9DQdlkTDQqIDOyxa+F+XcH/xOOUbu6Bl4Ef/QNAcH0hh4mVKAXzLmYuMAWXuY2gSXmWVwUvQAMWoAEWgAFVkJqzaaYwGHoSr3Tvd5L0R5c6qH9VtRdnJzqbgXv/ZxRW1QoxLwgz72uOEgQZ+PZw73FWeHiTeHLIhSXGJgUmoJQvh5Hjl4KmqfQYgAHXJvVp
2453
qZZrCZenFwBxyHqvyJJoIhGAqCEyQgu7dyB6pIu4sFXKEO6TJQlqH04UEGtO4CscePqoz4FaqH2ZuHhdKI3dt+9HT36YV5phGpJB93mnePUlGZeNb3WPv4NVxQquUIBk5wrP8AzE4ApjhVXKUAypcFmi0AmYoAeO8AFcAAdsEFDG/1UlrP/94F9yri+CXvh44Bd+lFd5KahzooiWub9+Vp/4vY+O6RgGUld/wG+XkF9VzwAQqUKJ
2454
EmXK4EGECQ8SZGiqEyY9jiRK/MAFjhs2aLJosNBRxUeQIUWOBLnC5EkWKVWyeNHyRRWYMWHKoFlzSQ2cNTLs5NmTyU8mV4QOFXrD6FE+SZU+YDrAqdN/Uf8NeBQuGK9bWXHVGrVp0lewYcWOFXvpThc5adVyYLvBLQ24ceXOpVsXw128eV26rNDXb9+agR04yFk4584OiRUv7pDD8WPIRyUbVZrUKR9/VrFmbSVqkxdCoUWPJl2a
2455
NFocqVWn3tLa9WvYsWXPpk3H9qtt3Ll1776tyLeiQ8GFDyde3Lg/5MmRK+oGa/MtX8auTbpU3fp17Nm1X6LU3ft38OHFjyf/XdN59OnVrz9Pyv17+PHlk0JV3/59/Pntn+If7lQ3bIDxJatbdKHFGFtkkSUWBht08EEII5RwQgortLBBWDLUcEMOO/TwQxBDzBAZEkskMRgUg0EGmGJ0IbBAX3bhZUYaa7TxRhxz1HFHHnv08Ucg
2456
gxTSFxdvCQgAO5NUckkmm3TySWB8kXJKKqu08sors9FySy679PJLL3sRZkEyyzTzTDTTVHNNNtt08004JwsIADs="]
2458
append data(__@AbOuT@__,text) "<br><br><font size=-1 color=#303030><p>System info:<ul>
2459
<li>Tcl/Tk version: $::tcl_version/$::tk_version<li>OS: $::tcl_platform(os),
2460
$::tcl_platform(osVersion) on $::tcl_platform(machine)</ul></p></font>"
2464
#-------------------------------------------------------------------------------
2465
# Function : help::destroy
2466
# Description : Destroy handler
2469
#-------------------------------------------------------------------------------
2470
proc help::destroy {{top 0}} {
2475
variable curfilename
2480
after 200 "help::destroy $top"
2482
catch {::destroy .dlgfind}
2483
foreach imn [array names data *,image] {
2484
catch {image delete $data($imn)}
2489
if {[info exists gw] && [winfo exists $gw]} {
2490
if {[string match {.tophelpwindow*} $gw]} {
2491
::destroy [winfo toplevel $gw]
2493
if {[wm protocol [winfo toplevel $gw] WM_DELETE_WINDOW]=="help::destroy 1"} {
2494
wm protocol [winfo toplevel $gw] WM_DELETE_WINDOW ""
2497
::destroy [winfo toplevel $gw]
2507
#-------------------------------------------------------------------------------
2508
# Function : help::parsetag
2509
# Description : Parsing string to list
2510
# Parameters : tagparams -
2511
# Return : List of parsed params {name value name value ...}
2512
#-------------------------------------------------------------------------------
2513
proc help::parsetag {tagparams} {
2515
set tagparams [string trim $tagparams]
2516
while {$tagparams!=""} {
2517
if {[set sp [string first " " $tagparams]]==-1} {
2520
if {[set i [string first "=" $tagparams]]!=-1 && $i<$sp} {
2521
set param [string tolower [string trim [string range $tagparams 0 [expr $i-1]]]]
2523
set tagparams [string trim [string range $tagparams $i end]]
2524
set lastC [string index $tagparams 0]
2525
if {$lastC!="\"" && $lastC!="\'"} {
2528
set tagparams [string range $tagparams 1 end]
2530
if {[set i [string first $lastC $tagparams]]==-1} {
2531
set value $tagparams
2534
set value [string range $tagparams 0 [expr $i-1]]
2536
set tagparams [string trim [string range $tagparams $i end]]
2539
set param [string tolower [string trim [string range $tagparams 0 [expr $sp-1]]]]
2540
set tagparams [string trim [string range $tagparams $sp end]]
2543
lappend res $param $value
2548
#-------------------------------------------------------------------------------
2549
# Function : help::showmark
2550
# Description : Goto mark anisochronously
2551
# Parameters : mark - name of mark
2553
#-------------------------------------------------------------------------------
2554
proc help::showmark {mark} {
2558
if {[catch {$w.text yview $mark}] && $showing} {
2559
after 200 "help::showmark \{$mark\}"
2561
updatehead "__prev __next"
2563
catch {$w.text see $mark}
2566
#-------------------------------------------------------------------------------
2567
# Function : help::showpos
2568
# Description : Goto mark anisochronously
2569
# Parameters : mark - name of mark
2571
#-------------------------------------------------------------------------------
2572
proc help::showpos {pos} {
2576
if {$showing && [$gw.text get $pos]==""} {
2577
after 200 "help::showpos \{$pos\}"
2579
catch {$gw.text yview $pos}
2580
catch {$gw.text see $pos}
2581
updatehead "__prev __next"
2585
#-------------------------------------------------------------------------------
2586
# Function : help::open
2587
# Description : Show "Open" dialog and open help
2590
#-------------------------------------------------------------------------------
2591
proc help::open {} {
2593
variable curfilename
2595
set tk_strictMotif 0
2597
{"Help files" {.help} TEXT}
2598
{"HTML files" {.htm .html} TEXT}
2601
set res [tk_getOpenFile -filetypes $filetypes -parent $gw \
2602
-initialdir [file dirname $curfilename]]
2606
if {$curfilename==""} {
2612
#-------------------------------------------------------------------------------
2613
# Function : help::rightclick
2614
# Description : Show popup menu
2615
# Parameters : x & y - position
2617
#-------------------------------------------------------------------------------
2618
proc help::rightclick {x y} {
2627
$gw.menu entryconfigure "Back" -state [expr {($hpos>0)?"normal":"disabled"}]
2628
$gw.menu entryconfigure "Forward" -state [expr {($hpos<([llength $history] - 1))?"normal":"disabled"}]
2629
$gw.menu entryconfigure "Stop" -state [expr {($showing || $insearch)?"normal":"disabled"}]
2630
$gw.menu entryconfigure "Copy" -state [expr {([catch {selection get}])?"disabled":"normal"}]
2631
$gw.menu entryconfigure "Increase font size" -state [expr {($fontsize<30)?"normal":"disabled"}]
2632
$gw.menu entryconfigure "Decrease font size" -state [expr {($fontsize>6)?"normal":"disabled"}]
2633
$gw.menu entryconfigure "Search in topics..." -state [expr {([llength $index])?"normal":"disabled"}]
2634
tk_popup $gw.menu $x $y
2637
#-------------------------------------------------------------------------------
2638
# Function : help::rightclickX
2639
# Description : Show popup menu
2640
# Parameters : x & y - position
2642
#-------------------------------------------------------------------------------
2643
proc help::rightclickX {x y} {
2646
tk_popup $gw.menuX $x $y
2649
#sch replace specialentities by characters
2650
#-------------------------------------------------------------------------------
2651
# Function : help::specialentities
2652
# Description : replace specialentities by characters
2655
#-------------------------------------------------------------------------------
2656
proc help::specialentities {text} {
2657
set text [string map {\
2658
{ } > > < < & {&} "&" {&} \
2659
¡ � ¢ � £ � ¤ � ¥ � ¦ � \
2660
§ � ¨ � © � ª � « � ¬ � \
2661
­ � ® � ¯ � ° � ± � ² � \
2662
³ � ´ � µ � ¶ � · � ¸ � \
2663
¹ � º � » � ¼ � ½ � ¾ � \
2664
¿ � À � Á � Â � Ã � Ä � \
2665
Å � Æ � Ç � È � É � Ê � \
2666
Ë � Ì � Í � Î � Ï � Ð � \
2667
Ñ � Ò � Ó � Ô � Õ � Ö � \
2668
× � Ø � Ù � Ú � Û � Ü � \
2669
Ý � Þ � ß � à � á � â � \
2670
ã � ä � å � æ � ç � è � \
2671
é � ê � ë � ì � í � î � \
2672
ï � ð � ñ � ò � ó � ô � \
2673
õ � ö � ÷ � ø � ù � ú � \
2674
û � ü � ý � þ � ÿ � " \" \
2676
while {[regexp -- {&#([0-9]+);} $text x num]} {
2677
regsub -all -- $x $text [binary format c $num] text
2683
#-------------------------------------------------------------------------------
2684
# Function : help::focusin
2685
# Description : FocusIn handler (it necessary to correct behavior if
2686
# : any modal window exists)
2689
#-------------------------------------------------------------------------------
2690
proc help::focusin {rw m} {
2693
if {$rw==[winfo toplevel $rw]} {
2695
if {[grab current .]!="" && $_focus_w==""} {
2696
set _focus_w [grab current .]
2697
catch {grab release $_focus_w}
2702
#-------------------------------------------------------------------------------
2703
# Function : help::focusout
2704
# Description : FocusOut handler (it necessary to correct behavior if
2705
# : any modal window exists)
2708
#-------------------------------------------------------------------------------
2709
proc help::focusout {rw m} {
2712
if {$rw==[winfo toplevel $rw]} {
2714
if {$_focus_w!=""} {
2715
catch {grab $_focus_w}
2721
proc help::img_change {name p_src} {
2723
variable curfilename
2726
if {[info exists data($name,image,id)]} {
2727
if {[info exists data($p_src,image)]} {
2728
catch {$data($name,image,widget).text image configure $data($name,image,id) -image $data($p_src,image)}
2730
if {[catch {set data($p_src,image) [image create photo -file [file join [file dirname $curfilename] $p_src]]}]} {
2731
catch {set imind [$data($name,image,widget).text image configure $data($name,image,id) -image $_images(broken)]}
2733
catch {set imind [$data($name,image,widget).text image configure $data($name,image,id) -image $data($p_src,image)]}
2739
proc help::id_visible {name {vis 1}} {
2742
catch {$data($name,names,widget).text tag configure $data($name,names,id) -elide [expr {! $vis}]}
2745
proc help::id_change {name text} {
2749
set range [$data($name,names,widget).text tag ranges $data($name,names,id)]
2750
set names [$data($name,names,widget).text tag names [lindex $range 0]]
2751
$data($name,names,widget).text configure -state normal
2752
eval "\$data(\$name,names,widget).text delete $range"
2753
$data($name,names,widget).text insert [lindex $range 0] $text $names
2754
$data($name,names,widget).text configure -state disabled
2758
#-------------------------------------------------------------------------------
2759
# Function : help::dlgfind:init
2760
# Description : Create and show find dialog
2761
# Parameters : mode_local - make local(true) or global(false) find dialog
2763
#-------------------------------------------------------------------------------
2764
proc help::dlgfind:init {{mode_local 1}} {
2768
if {!$mode_local && $index==""} {return}
2770
catch {::destroy .dlgfind}
2773
wm overrideredirect .dlgfind 1
2774
wm transient .dlgfind $gw
2775
wm withdraw .dlgfind
2779
wm resizable .dlgfind 0 0
2782
pack .dlgfind.f .dlgfind.btn -side left -expand 1 -fill y -padx 3
2784
wm title .dlgfind "Find"
2785
button .dlgfind.btn.f -text "Find" -width 8 -default active -command "help::dlgfind:find"
2787
wm title .dlgfind "Search in all topics"
2788
button .dlgfind.btn.f -text "Find" -width 8 -default active -command "help::dlgfind:search"
2790
button .dlgfind.btn.c -text "Cancel" -width 8 -command "help::dlgfind:destroy"
2791
pack .dlgfind.btn.f .dlgfind.btn.c -side top -expand 0 -fill x -pady 3
2793
frame .dlgfind.f.text
2795
pack .dlgfind.f.text .dlgfind.f.b -side top -fill x -expand 1 -anchor w -pady 3
2796
label .dlgfind.f.text.l -text "Find what: "
2797
entry .dlgfind.f.text.e -textvariable help::fnd_str -width 30
2798
pack .dlgfind.f.text.l .dlgfind.f.text.e -side left -fill y -expand 1
2799
.dlgfind.f.text.e selection range 0 end
2800
frame .dlgfind.f.b.l
2801
frame .dlgfind.f.b.dir
2802
pack .dlgfind.f.b.l .dlgfind.f.b.dir -side left -anchor s
2805
frame .dlgfind.f.b.dir.p -relief flat -borderwidth 0
2806
frame .dlgfind.f.b.dir.b -highlightthickness 0 -relief groove -borderwidth 2
2807
label .dlgfind.f.b.dir.l -highlightthickness 0 -text "Direction" \
2808
-relief flat -bd 0 -padx 2 -pady 0
2809
frame .dlgfind.f.b.dir.b.p -relief flat -bd 0 -highlightthickness 0
2810
frame .dlgfind.f.b.dir.f -relief flat -bd 0 -highlightthickness 0
2811
set height [winfo reqheight .dlgfind.f.b.dir.l]
2812
.dlgfind.f.b.dir.p configure -height [expr {$height/2}]
2813
.dlgfind.f.b.dir.b.p configure -height [expr {$height/2+$height%2+1}]
2814
pack .dlgfind.f.b.dir.b.p -side top -fill x
2815
pack .dlgfind.f.b.dir.f -in .dlgfind.f.b.dir.b -fill both -expand yes -padx 4 -pady 4
2816
pack .dlgfind.f.b.dir.p -side top -fill x
2817
pack .dlgfind.f.b.dir.b -fill both -expand yes
2818
place .dlgfind.f.b.dir.l -x 5 -anchor nw -y 0
2820
set f .dlgfind.f.b.dir.f
2821
radiobutton $f.up -text "Up" -value "-backwards" -variable help::fnd_direction
2822
radiobutton $f.down -text "Down" -value "-forwards" -variable help::fnd_direction
2823
pack $f.up $f.down -side left -fill y -expand 1
2825
checkbutton .dlgfind.f.b.l.case -text "Match case" -onvalue "" -offvalue "-nocase" -variable help::fnd_case
2826
checkbutton .dlgfind.f.b.l.regexp -text "Regexp expression" -onvalue "-regexp" -offvalue "" -variable help::fnd_regexp
2827
pack .dlgfind.f.b.l.regexp .dlgfind.f.b.l.case -side bottom -expand 1 -anchor sw
2828
bind .dlgfind <Return> ".dlgfind.btn.f configure -relief sunken; update idletasks; .dlgfind.btn.f configure -relief raised; .dlgfind.btn.f invoke"
2829
bind .dlgfind <Escape> "help::dlgfind:destroy"
2830
bind .dlgfind.f.text.e <KeyRelease> help::dlgfind:checkstate
2831
bind .dlgfind <FocusIn> "help::focusin %W %m"
2832
bind .dlgfind <FocusOut> "help::focusout %W %m"
2833
bind .dlgfind <Configure> "help::focusin %W %m"
2834
bind .dlgfind <Destroy> "help::focusout %W %m"
2835
bind .dlgfind <Expose> "help::focusin %W %m"
2839
set w [winfo reqwidth .dlgfind]
2840
set h [winfo reqheight .dlgfind]
2841
set x [expr [winfo rootx $gw] + ([winfo width $gw] - $w)/2]
2842
set y [expr [winfo rooty $gw] + ([winfo height $gw] - $h)/2]
2843
wm geometry .dlgfind "${w}x${h}+${x}+${y}"
2845
wm overrideredirect .dlgfind 0
2846
wm deiconify .dlgfind
2848
tkwait visibility .dlgfind
2849
catch {focus -force .dlgfind.f.text.e}
2852
#-------------------------------------------------------------------------------
2853
# Function : help::dlgfind:destroy
2854
# Description : Destroy find dialog
2857
#-------------------------------------------------------------------------------
2858
proc help::dlgfind:destroy {} {
2861
catch {::destroy .dlgfind}
2862
catch {focus -force $gw.text}
2865
#-------------------------------------------------------------------------------
2866
# Function : help::dlgfind:checkstate
2867
# Description : Modify state of "Find" button
2870
#-------------------------------------------------------------------------------
2871
proc help::dlgfind:checkstate {} {
2875
.dlgfind.btn.f configure -state disabled
2877
.dlgfind.btn.f configure -state normal
2881
#-------------------------------------------------------------------------------
2882
# Function : help::dlgfind:find
2883
# Description : Find function
2886
#-------------------------------------------------------------------------------
2887
proc help::dlgfind:find {} {
2893
variable fnd_direction
2895
if {![dlgfind:checkregexp $fnd_regexp $fnd_str]} {return}
2896
if {$fnd_direction=="-forwards"} {set offset "+${fnd_len}chars"; set stop "end"} else {set offset "-${fnd_len}chars"; set stop "1.0"}
2897
set pos [$gw.text index "insert$offset"]
2898
if {[set findpos [eval $gw.text search $fnd_case $fnd_regexp $fnd_direction -count "help::fnd_len" -- {$fnd_str} $pos $stop]]!=""} {
2899
$gw.text mark set insert $findpos
2900
$gw.text see $findpos
2901
$gw.text tag remove fnd 1.0 end
2902
$gw.text tag remove sel 1.0 end
2903
$gw.text tag add sel $findpos "$findpos +${fnd_len}chars"
2904
$gw.text tag add fnd $findpos "$findpos +${fnd_len}chars"
2908
#-------------------------------------------------------------------------------
2909
# Function : help::dlgfind:search
2910
# Description : Find function (at all topics)
2913
#-------------------------------------------------------------------------------
2914
proc help::dlgfind:search {} {
2917
variable fnd_len [string length $fnd_str]
2920
variable searchedtext
2929
after 250 help::dlgfind:search
2933
if {![dlgfind:checkregexp $fnd_regexp $fnd_str]} {return}
2936
if {$searchedtext==[list $fnd_str $fnd_case $fnd_regexp]} {
2937
set help::curtopic ""
2938
show "__@SearchResult@__"
2942
set searchedtext [list $fnd_str $fnd_case $fnd_regexp]
2945
set data(__@SearchResult@__,title) "Search results"
2946
set data(__@SearchResult@__,text) "<body text=black bgcolor=#ffffd2 link=#006800><ul>"
2949
if {$fnd_case==""} {
2952
set fstr [string tolower $fnd_str]
2954
if {[set pos [lsearch -exact $index "__index"]]!=-1} {
2955
set topics [lreplace $index $pos $pos]
2959
foreach topic $topics {
2960
set _all_text $data($topic,text)
2961
set totallen [string length $_all_text]
2963
set stat "Searching in $data($topic,title)..."
2966
while {!$abort && $_text_pos!=$totallen} {
2967
set pos [string first "<" [string range $_all_text [expr {$_text_pos + 1024}] end]]
2969
set _text [string range $_all_text $_text_pos end]
2970
set _text_pos $totallen
2972
set _text [string range $_all_text $_text_pos [expr {$_text_pos + 1024 + $pos - 1}]]
2973
set _text_pos [expr {$_text_pos + 1024 + $pos}]
2975
while {!$abort && [set pos [string first "<" $_text]]!=-1} {
2976
append outtext [string range $_text 0 [expr {$pos - 1}]]
2977
set _text [string range $_text $pos end]
2978
if {[set pos [string first ">" $_text]]!=-1} {
2979
set _text [string range $_text [incr pos] end]
2985
append outtext $_text
2991
set outtext [specialentities $outtext]
2992
if {$fnd_regexp!=""} {
2993
if {[eval regexp -indices $fnd_case -- \$fnd_str \$outtext rpos]} {
2994
set pos [lindex $rpos 0]
2995
set fnd_len [expr {[lindex $rpos 1] - [lindex $rpos 0] + 1}]
3000
if {$fnd_case==""} {
3003
set _text [string tolower $outtext]
3005
set pos [string first $fstr $_text]
3008
set str1 [string map {{&} {&} {>} {>} {<} {<}} [string range $outtext [expr {$pos - 50}] [expr {$pos - 1}]]]
3009
set str2 [string map {{&} {&} {>} {>} {<} {<}} [string range $outtext $pos [expr {$pos + $fnd_len - 1}]]]
3010
set str3 [string map {{&} {&} {>} {>} {<} {<}} [string range $outtext [expr {$pos + $fnd_len}] [expr {$pos + $fnd_len + 70}]]]
3012
append data(__@SearchResult@__,text) "<li><a href=\"$topic\">[string map {{&} {&} {>} {>} {<} {<}} $data($topic,title)]</a><br>"
3013
append data(__@SearchResult@__,text) "<font size=-1>...$str1<font color=#000080><b>$str2</b></font>$str3...</font><br><br>"
3019
append data(__@SearchResult@__,text) "</ul><font color=#c00000>Search aborted.</font></body>"
3021
} elseif {!$found} {
3022
append data(__@SearchResult@__,text) "</ul><font color=#c00000>No topics found for request</font> <b>\"[string map {{&} {&} {>} {>} {<} {<}} $fnd_str]\"</b> <font color=#c00000>!</font></body>"
3024
append data(__@SearchResult@__,text) "</ul></body>"
3026
set data(__@SearchResult@__,title) "Search results ($found found)"
3028
$gw.text configure -cursor arrow
3031
# updatehead "__stop"
3032
set help::curtopic ""
3033
show "__@SearchResult@__"
3036
#-------------------------------------------------------------------------------
3037
# Function : help::dlgfind:checkregexp
3038
# Description : Check function
3041
#-------------------------------------------------------------------------------
3042
proc help::dlgfind:checkregexp {regexp val} {
3043
if {$regexp=="-regexp"} {
3044
if {[catch {regexp -- "$val" {}}]} {
3045
tk_dialog .help_error_in_regexp_dialog "Error in regexp" "Error in regular expression:\n\"$val\"" "" 0 "Ok"
3055
#-------------------------------------------------------------------------------
3056
# Function : help::add_ext
3057
# Description : Loads extensions for help package
3058
# Parameters : filename - name of file to load
3060
#-------------------------------------------------------------------------------
3061
proc help::add_ext {filename} {
3065
set name [file tail $filename]
3066
if {[lsearch $ext_loaded $name]==-1} {
3067
if {![catch {source $filename}]} {
3068
lappend ext_loaded $name
3073
#===============================================================================
3074
# Initialization section
3075
#===============================================================================
3076
if {[catch {package require Tcl 8.1}] || [catch {package require Tk 8.1}]} {
3077
error "Incompatible version of Tcl/Tk. Please update your Tcl/Tk."
3080
switch -- $tcl_platform(platform) {
3082
proc help::showurl {url} {
3083
eval exec [auto_execok start] [list $url] &
3088
proc help::showurl {url} {
3089
exec netscape [list $url] &
3094
proc help::showurl {url} {
3097
if {![info exists env(BROWSER)]} {
3098
set env(BROWSER) "Browse the Internet"
3101
AppleScript execute "tell application \"$env(BROWSER)\"
3105
error "Error displaying $url in browser\n$emsg"
3111
help::add_ext [file join [file dirname [info script]] "help_chk.tcl"]
3112
help::add_ext [file join [file dirname [info script]] "help_2htm.tcl"]
3113
### ADD BY JAIME URZUA GREZ
3114
help::add_ext [file join [file dirname [info script]] "help_tbl.tcl"]
added
removed
tcl/sciGUI/local_extra/HelpSystem-1.5/help.tcl
