"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "OpenVerse/lib/tkohlp.tcl" of archive OpenVerse-0.8-7.tar.gz:
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 #!/usr/bin/wish -f
2 #
3 #
4 # tkHelp. A simple Open Help App.
5 #
6 # See OHA for ohlp description.
7 #
8 # (C) 1999 Juan J. Martinez Siguenza (reidrac@rocketmail.com)
9 # See GPL for distribution and usage details.
10 #
11 # I used TK8.0 (try other previous versions of TK and let me
12 # know if it works).
13 #
14
15
16 #
17 # title -> title of help window
18 # helptext -> ohlp text
19 #
20 proc openHelp {title helptext} {
21
22 set w ".openHelpWin"
23
24 if {[winfo exists $w]} {
25 destroy $w.text
26 } else {
27 toplevel $w
28 scrollbar $w.scroll -relief sunken -command "$w.text yview"
29
30 frame $w.f -relief raised -border 2
31 pack $w.f -side bottom -fill x
32
33 button $w.f.close -text "Close" -command { destroy .openHelpWin }
34 button $w.f.about -text "OHlp" -command { aboutOpenHelp }
35
36 pack $w.f.close -side left
37 pack $w.f.about -side right
38 pack $w.scroll -side right -fill y -padx 2 -pady 2
39 }
40
41
42 text $w.text -setgrid yes -wrap word \
43 -width 55 -relief sunken -border 2 \
44 -yscroll "$w.scroll set"
45
46 pack $w.text -fill both -expand 1 -padx 5
47
48 wm title $w "Help - $title"
49 wm minsize $w 1 1
50
51 outText $w.text $helptext
52 }
53
54
55 #
56 # w -> text widget
57 # ohlp -> ohlp text
58 #
59 proc outText {w ohlp} {
60
61 # normal
62 $w configure -font -*-Helvetica-Medium-R-Normal-*-12-*
63 # bold normal
64 $w tag configure b -font -*-Helvetica-Bold-R-Normal-*-12-*
65 set dtags(b) b
66 # italic normal
67 $w tag configure i -font -*-Helvetica-Medium-O-Normal-*-12-*
68 set dtags(i) i
69 # underline
70 $w tag configure u -underline 1
71 set dtags(u) u
72 # header 1
73 $w tag configure h1 -font -*-Helvetica-Bold-R-Normal-*-24-*
74 set dtags(h1) h1
75 # header 2
76 $w tag configure h2 -font -*-Helvetica-Bold-R-Normal-*-18-*
77 set dtags(h2) h2
78 # header 3
79 $w tag configure h3 -font -*-Helvetica-Bold-R-Normal-*-14-*
80 set dtags(h3) h3
81
82 # justify left -default-
83 # justify right
84 $w tag configure right -justify right
85 set dtags(right) right
86 # justify center
87 $w tag configure center -justify center
88 set dtags(center) center
89
90 # relief 1
91 $w tag configure r1 -relief raised -border 1
92 set dtags(r1) r1
93 # relief 2
94 $w tag configure r2 -relief raised -border 2
95 set dtags(r2) r2
96 # relief 3
97 $w tag configure r3 -relief raised -border 3
98 set dtags(r3) r3
99
100 # color red
101 $w tag configure fgr -foreground red
102 set dtags(fgr) fgr
103 # color blue
104 $w tag configure fgb -foreground blue
105 set dtags(fgb) fgb
106 # color green
107 $w tag configure fgg -foreground green
108 set dtags(fgg) fgg
109 # color white
110 $w tag configure fgw -foreground white
111 set dtags(fgw) fgw
112 # color yellow
113 $w tag configure fgy -foreground yellow
114 set dtags(fgy) fgy
115 # color black -default-
116 $w configure -foreground black
117
118 # bgcolor red
119 $w tag configure bgr -background red
120 set dtags(bgr) bgr
121 # bgcolor blue
122 $w tag configure bgb -background blue
123 set dtags(bgb) bgb
124 # bgcolor green
125 $w tag configure bgg -background green
126 set dtags(bgg) bgg
127 # bgcolor yellow
128 $w tag configure bgy -background yellow
129 set dtags(bgy) bgy
130 # bgcolor black
131 $w tag configure bgk -background black
132 set dtags(bgk) bgk
133 # bgcolor white -default-
134 $w configure -background white
135
136 $w mark set insert 0.0
137
138 # main loop
139 set t $ohlp
140
141 while {[regexp -indices {<([^@>]*)>} $t match inds] == 1} {
142 set start [lindex $inds 0]
143 set end [lindex $inds 1]
144 set keyword [string range $t $start $end]
145
146 set oldend [$w index end]
147
148 if {[string range $keyword 0 0] != "/"} {
149 # if is not a tag -> is a link
150 if {[info exists dtags($keyword)] != 1} {
151 # links
152 set selected "$w tag configure \"$keyword\" -relief raise -border 1\
153 -background lightgrey"
154 set unselected "$w tag configure \"$keyword\" -relief flat -background white"
155 $w tag configure "$keyword" -foreground blue -underline 1
156 $w tag bind "$keyword" <Button-1> $keyword
157 $w tag bind "$keyword" <Any-Enter> $selected
158 $w tag bind "$keyword" <Any-Leave> $unselected
159 set dtags("$keyword") $keyword
160 }
161 }
162
163 $w insert end [string range $t 0 [expr $start - 2]]
164
165 quitTags $w $oldend insert
166
167 if {[string range $keyword 0 0] == "/"} {
168 set keyword [string trimleft $keyword "/"]
169 if {[info exists tags($keyword)] == 0} {
170 error "\nClose Tag Error: Tag not found\n"
171 }
172 $w tag add $keyword $tags($keyword) insert
173 unset tags($keyword)
174 } else {
175 if {[info exists tags($keyword)] == 1} {
176 error "\nOpen Tag Error: Tag found twice\n"
177 }
178 set tags($keyword) [$w index insert]
179 }
180 set t [string range $t [expr $end + 2] end]
181 }
182 set oldend [$w index end]
183 $w insert end $t
184 quitTags $w $oldend insert
185
186 $w configure -state disabled
187 }
188
189 proc quitTags {w start end} {
190 foreach tag [$w tag names $start] {
191 w$ tag remove $tag $start $end
192 }
193 }
194
195 proc aboutOpenHelp {} {
196
197 openHelp "About OpenHelp" {
198
199 <h1><fgb>Open Help v1.1</fgb></h1>
200
201 Open help is a tiny <i>Tcl/Tk</i> script that makes easy to include help modules with links and rich format like text. It was developed using <b>Tk8.0</b> and was not tested with previous versions.
202
203
204 <h3>Contents</h3>
205
206 1.<ohlpInfo>Introduction to ohlp</ohlpInfo>
207 2.<gplInfo>Distribution details</gplInfo>
208 3.<contactInfo>Contacts and bugs</contactInfo>
209 4.<futureInfo>Future versions</futureInfo>
210
211
212
213 <fgr><h3>What's New on v1.1</h3></fgr>
214
215 . Some bugs fixed
216 . English traslation of <b>ohlp</b> help
217
218
219 }
220 }
221
222 proc ohlpInfo {} {
223
224 openHelp "Introduction to ohlp" {
225
226 <h2><fgb>Introduction to ohlp</fgb></h2>
227
228 <b>ohlp</b> works like <i>Html</i>. Uses <i>tags</i> and right slash <i>/</i> to set text properties. As in <i>Html</i>, the <i>tags</i> may be put between the symbols of <i>minor as</i> and <i>major as</i>.
229
230 The <i>tags</i> supported under <fgb><b>Open Help v1.1</b></fgb> are:
231
232 <u><i>tag</i></u> <u><b>Description</b></u>
233
234 <i>h1</i> Big Header
235 <i>h2</i> Medium Header
236 <i>h3</i> Small Header
237
238 <i>right</i> Justify right
239 <i>center</i> Center Text
240
241 <u>Not compatible with <i>h1 h2 h3</i></u>
242 <i>b</i> Bold Text
243 <i>i</i> Italic Text
244 <i>u</i> Underline Text
245
246 <u>Foreground Colors</u>
247 <i>fgb</i> Blue
248 <i>fgr</i> Red
249 <i>fgg</i> Green
250 <i>fgy</i> Yellow
251 <i>fgw</i> White
252
253 <u>Background Colors</u>
254 <i>bgb</i> Blue
255 <i>bgr</i> Red
256 <i>bgg</i> Green
257 <i>bgy</i> Yellow
258 <i>bgk</i> Black
259
260 <i>r1</i> Big Raised
261 <i>r2</i> Medium Raised
262 <i>r3</i> Small Raised
263
264
265 Links are <i>tags</i> not defined by <b><fgb>Open Help</fgb></b>. If you put as <i>tag</i> the word <i>openInfo</i>, it is suposed to be a link and <b><fgb>Open Help</fgb></b> calls the <i>Tcl/Tk</i> script with that name.
266
267 It's important remember than the close <i>tag</i> must be equal to open <i>tag</i> -with the slash <i>/</i>, of course-. Afterall you can combine some <i>tags</i> to get a lot of different text output.
268
269 See <i>example.ohlp</i> that comes with <b><fgb>Open Help</fgb></b> for more details.
270
271
272 <aboutOpenHelp>Contents</aboutOpenHelp>
273
274 }
275 }
276
277 proc gplInfo {} {
278
279 openHelp "Distribution Details" {
280
281 <h2><fgb>Distribution Details</fgb></h2>
282
283 <b><fgb>Open Help v1.0</fgb></b> uses <b>GPL</b> terms in distribution. Moreover i thanx you send a <i>mail</i> to the <contactInfo>author</contactInfo> with comments about <b>ohlp</b>.
284
285 Copyright (C)1999 Juan J. Martinez.
286
287 This program is free software; you may redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version.
288
289 This is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. See the GNU General Public License for more details.
290
291 You should have received a copy of the GNU General Public License with your copy of Open Help. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
292
293
294
295 <aboutOpenHelp>Contents</aboutOpenHelp>
296
297 }
298 }
299
300 proc contactInfo {} {
301
302 openHelp "Contacts and Bugs" {
303
304 <h2><fgb>Contacts and Bugs</fgb></h2>
305
306 <b><fgb>Open Help</fgb></b> can have bugs -i hope this-. If you find a important bug, please send me a <i>mail</i> and i'll look what to do. Send me your comments, too.
307
308 I am here :
309 <i><fgr>reidrac@rocketmail.com</fgr></i>
310
311 Or traditional mail:
312
313 <i>Juan Jose Martinez Siguenza</i>
314
315 <i>C/ Fda. Sta. Maria 67 4p 4pl
316 03204 Elche (Alicante) SPAIN</i>
317
318 I need work. Please, let me know if you are working in a project and want some help.
319
320 <i>Elche, 16 de Febrero de 1999</i>
321
322
323 <i>Note: My english SUCKS. Sorry!</i>
324
325
326 <aboutOpenHelp>Contents</aboutOpenHelp>
327
328 }
329 }
330
331 proc futureInfo {} {
332
333 openHelp "Future Versions" {
334
335 <h2><fgb>Future Versions</fgb></h2>
336
337 I'm not soure to release another version of <b>ohlp</b>. This release is only for translate the help into english. The previous version have some little bugs -sure that you can fix it-, but is in spanish. You know: <i>Si eres de habla hispana, la version anterior te puede interesar</i>.
338
339 If someone want to improve this script i would like to have a copy of the modified script. Thanx.
340
341 Some thigs TODO:
342
343 . Add back button -links with history-
344 . Add some pretty bitmaps to the buttons and tips -so easy-
345 . Add a search option
346 . Add GIF support -too difficult?-
347
348
349 <aboutOpenHelp>Contents</aboutOpenHelp>
350
351 }
352 }
353
354 proc error { text } {
355
356 destroy if exists .error
357
358 toplevel .error
359
360 frame .error.f0 -relief raised -border 2
361 pack .error.f0 -side top -fill both -expand yes
362
363 label .error.f0.mess -text $text
364 pack .error.f0.mess
365
366 frame .error.f1 -relief groove -border 2
367 pack .error.f1 -side top -fill both -expand yes
368
369 button .error.f1.ok -text Ok -command { destroy .error }
370 pack .error.f1.ok
371
372 wm title .error "Help Error"
373 }
374