3 ## minimal generic help system implemented as a mega-widget
6 ## Initiated: 28 October 1996
9 ##------------------------------------------------------------------------
14 ## Implements a minimal generic help system dialog
17 ## help_dialog <window pathname> <options>
20 ## (Any help widget option may be used in addition to these)
22 ## RETURNS: the toplevel window pathname
24 ## BINDINGS (in addition to default widget bindings)
26 ## -dismisstext str DEFAULT: Dismiss
27 ## The text for the dismiss button (hides the Help dialog). If
28 ## text=={}, the button is not shown.
31 ## These are the methods that an instance of this megawidget recognizes.
32 ## Aside from those listed here, it accepts methods that are valid for text
35 ## configure ?option? ?value option value ...?
37 ## Standard tk widget routines.
40 ## Returns the true widget path of the specified widget. Valid
41 ## widgets are label, dismiss.
44 ## Hides the help dialog
47 ## Deiconifies the help dialog
50 ## The megawidget creates a global array with the classname, and a
51 ## global array which is the name of each megawidget created. The latter
52 ## array is deleted when the megawidget is destroyed.
53 ## The procedure help and those beginning with Help are
54 ## used. Also, when a widget is created, commands named .$widgetname
55 ## and HelpDialog$widgetname are created.
59 helpdialog .h -label "Tiger Help" -title "Tiger Help" -buttons {
61 {Contents http://www.acm.org/}
63 .h link index http://www.altavista.digital.com/
66 ##------------------------------------------------------------------------
68 ##------------------------------------------------------------------------
73 ## Implements a minimal generic help system
76 ## help <window pathname> <options>
79 ## (Any frame option may be used in addition to these)
81 ## RETURNS: the toplevel window pathname
83 ## BINDINGS (in addition to default widget bindings)
85 ## -binding event DEFAULT: {}
86 ## A binding for using the help in a context-sensitive manner. If
87 ## binding is specified, the help dialog will make a bind that event
88 ## to all and call the load method with the widget it is over when it
89 ## is triggered. Thus you need to register the widget name as a tag
90 ## for it to be recognized in context sensitive help.
92 ## -buttons buttonlist DEFAULT: {}
93 ## A list of tuples that define the buttons to display. Each tuple
94 ## must be of the form {"Button Name" tagOrURL}. For each tuple in
95 ## the list, a button is created in the help dialog with the specified
96 ## name and its command is set to load the specified tagOrURL.
98 ## -executable execlist
99 ## DEFAULT: {{exec netscape -remote "openURL(%s)"} {exec netscape "%s" &}}
100 ## A list of lists which represent what commands to evaluate in order
101 ## to view the URL. In the string, %s is replaced with the URL to be
102 ## loaded. %s may not start the string.
104 ## -inherit TCL_BOOLEAN DEFAULT: 1
105 ## In combination with a binding specification, tells whether the help
106 ## widget should iteratively look for a link associated with a parent
107 ## widget when one is not found for the current widget.
109 ## -label str DEFAULT: {}
110 ## The text for a label at the top of the dialog. If text=={}, the
111 ## label is not shown.
113 ## -subst TCL_BOOLEAN DEFAULT: 1
114 ## Performs a subst on the tagOrURL, allowing you to do delayed
115 ## evaluation on the tagOrURL contents.
118 ## These are the methods that an instance of this megawidget recognizes.
119 ## Aside from those listed here, it accepts methods that are valid for text
122 ## configure ?option? ?value option value ...?
124 ## Standard tk widget routines.
127 ## Returns the true widget path of the specified widget. Valid
128 ## widgets are label.
130 ## gettag tagOrWidget
131 ## Returns an absolute tag reference for a particular tag (following
132 ## all links and doing all substs) or {} if no tag exists.
134 ## link tagOrWidget ?tagOrURL?
135 ## Creates a tag for an URL to allow you to easily reference the URL
136 ## where URLs are required in other methods for this dialog.
137 ## If a widget pathname is specified as the tagOrWidget, then that
138 ## will become a tag that will load the specified URL when the help
139 ## binding is activated (if -binding is specified) which uses load.
140 ## If tagOrURL=={}, the tagOrWidget id is removed.
141 ## If it is not specified, the tagOrWidget link is returned.
142 ## A subst will be done on the tagOrURL at load time, so be careful
143 ## to escape special characters if you don't want them interpreted.
144 ## No subst will be done during the link operation though.
147 ## Launches the HTML viewer with the specified tagOrURL. A gettag
148 ## call is done of the tagOrURL link.
151 ## The megawidget creates a global array with the classname, and a
152 ## global array which is the name of each megawidget created. The latter
153 ## array is deleted when the megawidget is destroyed.
154 ## The procedure help and those beginning with Help are
155 ## used. Also, when a widget is created, commands named .$widgetname
156 ## and Help$widgetname are created.
160 help .h -label "Tiger Help" -buttons {
162 {Contents http://www.acm.org/}
164 .h link index http://www.altavista.digital.com/
165 pack .h -fill both -exp 1
167 ##------------------------------------------------------------------------
170 #package require Megawidget 1.0
171 #package require Bookmarks 1.0
172 #package require WWW 1.0
174 #package provide Help 1.0
180 -executable {executable Executable \
181 {{exec netscape -remote "openURL(%s)"} {exec netscape "%s" &}}}
182 -label {label Label {}}
183 -binding {binding Binding {}}
184 -buttons {buttons Buttons {}}
185 -inherit {inherit Inherit 1}
186 -subst {subst Subst 1}
189 if {[string match windows $tcl_platform(platform)]} {
190 set Help(-executable) {executable Executable {{exec netscape "%s" &}}}
193 if {[info exists env(NETSCAPE_PATH)]} {
194 regsub -all netscape $Help(-executable) \
195 $env(NETSCAPE_PATH) \
197 } elseif {[string match windows $tcl_platform(platform)]} {
198 regsub -all netscape $Help(-executable) \
199 {"c:/program files/netscape/navigator/program/netscape.exe"} \
203 array set HelpDialog {
206 components {{button dismiss} {frame separator}}
208 -dismisstext {dismisstext DismissText Dismiss}
209 -title {title Title "Help"}
211 ## For the indexer to pick up
214 proc HelpDialog args {}
215 proc helpdialog args {}
216 proc help_dialog args {}
218 widget create HelpDialog
219 interp alias {} help_dialog {} HelpDialog
221 ;proc HelpDialog:construct {w} {
224 wm title $w $data(-title)
226 $data(separator) configure -height 2 -relief ridge -bd 2
227 $data(dismiss) configure -textvariable ${w}(-dismisstext) \
228 -command [list $w hide]
230 grid $data(help) -in $w -sticky news
231 grid $data(separator) -in $w -sticky ew
232 grid $data(dismiss) -padx 4 -pady 2 -sticky ew
233 grid columnconfig $w 0 -weight 1
234 grid rowconfig $w 0 -weight 1
237 ;proc HelpDialog:configure {w args} {
239 set truth {^(1|yes|true|on)$}
240 foreach {key val} $args {
242 -title { wm title $w $val }
248 ;proc HelpDialog_hide w { if {[winfo exists $w]} {wm withdraw $w} }
250 ;proc HelpDialog_show w { if {[winfo exists $w]} {wm deiconify $w} }
252 ;proc Help:construct {w} {
256 array set data [list \
265 frame $data(labelframe)
266 pack [label $data(label) -textvar $w\(-label\)]
267 pack [frame $data(labelframe).sep -height 2 -relief ridge -bd 2] -fill x
268 if {[string comp {} $data(-label)]} { pack $data(labelframe) -fill x }
271 pack [frame $data(buttonframe)] -fill x
272 Help:buttons $w $data(buttonframe) $data(-buttons)
274 ## Hierarchy (Bookmark) Frame
275 pack [frame $data(hierframe)] -fill both -exp 1
278 ;proc Help_subwidget {w widget} {
281 base - container - label - hierarchy { return $data($widget) }
282 default { return -code error "No $data(class) subwidget \"$widget\"" }
286 ;proc Help:configure {w args} {
288 set truth {^(1|yes|true|on)$}
289 foreach {key val} $args {
292 if {[string comp {} $data($key)]} { bind all $data($key) {} }
293 if {[string comp {} $val]} {
294 bind all $val "Help_load $w \[winfo contain %X %Y\] 0"
300 Help:buttons $w $data(buttonframe) $val
302 -executable { set data($key) $val }
303 -inherit { set data($key) [regexp -nocase $truth $val] }
306 if {[string comp {} $val]} {
307 pack $data(labelframe) -fill x -before $data(buttonframe)
309 pack forget $data(labelframe)
316 ;proc Help:destroy w {
318 if {[string comp {} $data(-binding)]} { bind all $data(-binding) {} }
321 ;proc Help:buttons {w f btns} {
322 catch {eval destroy [winfo children $f]}
325 foreach {b tag list} $btn break
326 button $f.[incr i] -text $b -command "Help_load $w $tag"
327 if {[regexp -nocase {^(1|yes|true|on)$} $list]} {
328 ## tagOrURL represents bookmark page for hierarchy list
330 pack $f.$i -fill x -side left
334 ;proc Help_link {w tag {url NULL}} {
336 if {[string comp NULL $url]} {
338 while {[info exists data(@$url)] && $i<100} {
343 } elseif {[string match {} $url]} {
344 catch {unset data(@$tag)}
347 if {[info exists data(@$tag)]} {
350 return -code error "no help link \"$tag\" defined"
354 ;proc Help_gettag {w tag} {
357 while {[info exists data(@$tag)] && $found<100} {
360 set tag [uplevel \#0 [list subst $data(@$tag)]]
367 } elseif {$data(-inherit) && [winfo exists $tag]} {
368 while {![info exists data(@$tag)] && [string comp . $tag]} {
369 set tag [winfo parent $tag]
371 if {[info exists data(@$tag)]} { return $data(@$tag) }
376 ;proc Help_load {w url {complain 1}} {
378 set link [Help_gettag $w $url]
379 if {[string comp {} $link]} {
381 } elseif {[string match http:/* $url] || [string match file:/* $url]} {
383 } elseif {$complain} {
384 return -code error "\"$url\" not recognized as proper URL or help link"
388 ;proc Help:load {w url} {
390 regsub -all {([^\\])%s} $data(-executable) "\\1$url" cmds
399 tk_dialog $w.dialog "Failed to load URL." \
400 "Failed to load URL via any of the commands:\n$cmds\
401 \nMake sure the command exists and is in your path." \