]> www.wagner.pp.ru Git - oss/fgis.git/blob - tcl/help.tcl
Added logic to find GDAL installation.
[oss/fgis.git] / tcl / help.tcl
1 ##
2 ## help.tcl
3 ## minimal generic help system implemented as a mega-widget
4 ##
5 ## Jeffrey Hobbs
6 ## Initiated: 28 October 1996
7 ##
8
9 ##------------------------------------------------------------------------
10 ## PROCEDURE
11 ##      help_dialog
12 ##
13 ## DESCRIPTION
14 ##      Implements a minimal generic help system dialog
15 ##
16 ## ARGUMENTS
17 ##      help_dialog <window pathname> <options>
18 ##
19 ## OPTIONS
20 ##      (Any help widget option may be used in addition to these)
21 ##
22 ## RETURNS: the toplevel window pathname
23 ##
24 ## BINDINGS (in addition to default widget bindings)
25 ##
26 ## -dismisstext str                     DEFAULT: Dismiss
27 ##      The text for the dismiss button (hides the Help dialog).  If
28 ##      text=={}, the button is not shown.
29 ##
30 ## METHODS
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
33 ## widgets.
34 ##
35 ## configure ?option? ?value option value ...?
36 ## cget option
37 ##      Standard tk widget routines.
38 ##
39 ## subwidget widget
40 ##      Returns the true widget path of the specified widget.  Valid
41 ##      widgets are label, dismiss.
42 ##
43 ## hide
44 ##      Hides the help dialog
45 ##
46 ## show
47 ##      Deiconifies the help dialog
48 ##
49 ## NAMESPACE & STATE
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.
56 ##
57 ## EXAMPLE USAGE:
58 if 0 {
59     helpdialog .h -label "Tiger Help" -title "Tiger Help" -buttons {
60         {Index    index}
61         {Contents http://www.acm.org/}
62     }
63     .h link index http://www.altavista.digital.com/
64     .h show
65 }
66 ##------------------------------------------------------------------------
67
68 ##------------------------------------------------------------------------
69 ## PROCEDURE
70 ##      help
71 ##
72 ## DESCRIPTION
73 ##      Implements a minimal generic help system
74 ##
75 ## ARGUMENTS
76 ##      help <window pathname> <options>
77 ##
78 ## OPTIONS
79 ##      (Any frame option may be used in addition to these)
80 ##
81 ## RETURNS: the toplevel window pathname
82 ##
83 ## BINDINGS (in addition to default widget bindings)
84 ##
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.
91 ##
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.
97 ##
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.
103 ##
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.
108 ##
109 ## -label str                           DEFAULT: {}
110 ##      The text for a label at the top of the dialog.  If text=={}, the
111 ##      label is not shown.
112 ##
113 ## -subst TCL_BOOLEAN                   DEFAULT: 1
114 ##      Performs a subst on the tagOrURL, allowing you to do delayed
115 ##      evaluation on the tagOrURL contents.
116 ##
117 ## METHODS
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
120 ## widgets.
121 ##
122 ## configure ?option? ?value option value ...?
123 ## cget option
124 ##      Standard tk widget routines.
125 ##
126 ## subwidget widget
127 ##      Returns the true widget path of the specified widget.  Valid
128 ##      widgets are label.
129 ##
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.
133 ##
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.
145 ##
146 ## load tagOrURL
147 ##      Launches the HTML viewer with the specified tagOrURL.  A gettag
148 ##      call is done of the tagOrURL link.
149 ##
150 ## NAMESPACE & STATE
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.
157 ##
158 ## EXAMPLE USAGE:
159 if 0 {
160     help .h -label "Tiger Help" -buttons {
161         {Index    index}
162         {Contents http://www.acm.org/}
163     }
164     .h link index http://www.altavista.digital.com/
165     pack .h -fill both -exp 1
166 }
167 ##------------------------------------------------------------------------
168
169 #package require Tk
170 #package require Megawidget 1.0
171 #package require Bookmarks 1.0
172 #package require WWW 1.0
173
174 #package provide Help 1.0
175
176 array set Help {
177     type        frame
178     base        frame
179
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}
187 }
188
189 if {[string match windows $tcl_platform(platform)]} {
190     set Help(-executable) {executable Executable {{exec netscape "%s" &}}}
191 }
192
193 if {[info exists env(NETSCAPE_PATH)]} {
194     regsub -all netscape $Help(-executable) \
195             $env(NETSCAPE_PATH) \
196             Help(-executable)
197 } elseif {[string match windows $tcl_platform(platform)]} {
198     regsub -all netscape $Help(-executable) \
199             {"c:/program files/netscape/navigator/program/netscape.exe"} \
200             Help(-executable)
201 }
202
203 array set HelpDialog {
204     type                toplevel
205     base                help
206     components          {{button dismiss} {frame separator}}
207
208     -dismisstext        {dismisstext    DismissText     Dismiss}
209     -title              {title          Title           "Help"}
210 }
211 ## For the indexer to pick up
212 proc Help args {}
213 proc help args {}
214 proc HelpDialog args {}
215 proc helpdialog args {}
216 proc help_dialog args {}
217 widget create Help
218 widget create HelpDialog
219 interp alias {} help_dialog {} HelpDialog
220
221 ;proc HelpDialog:construct {w} {
222     upvar \#0 $w data
223     global $w
224     wm title $w $data(-title)
225
226     $data(separator) configure -height 2 -relief ridge -bd 2
227     $data(dismiss) configure -textvariable ${w}(-dismisstext) \
228             -command [list $w hide]
229
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
235 }
236
237 ;proc HelpDialog:configure {w args} {
238     upvar \#0 $w data
239     set truth {^(1|yes|true|on)$}
240     foreach {key val} $args {
241         switch -- $key {
242             -title      { wm title $w $val }
243         }
244         set data($key) $val
245     }
246 }
247
248 ;proc HelpDialog_hide w { if {[winfo exists $w]} {wm withdraw $w} }
249
250 ;proc HelpDialog_show w { if {[winfo exists $w]} {wm deiconify $w} }
251
252 ;proc Help:construct {w} {
253     upvar \#0 $w data
254
255     ## Private variables
256     array set data [list \
257             buttonframe $w.bf \
258             hierframe   $w.hf \
259             labelframe  $w.lf \
260             label       $w.lf.lbl \
261             hierarchy   $w.hf.h \
262             ]
263
264     ## Label Frame
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 }
269
270     ## Button Frame
271     pack [frame $data(buttonframe)] -fill x
272     Help:buttons $w $data(buttonframe) $data(-buttons)
273
274     ## Hierarchy (Bookmark) Frame
275     pack [frame $data(hierframe)] -fill both -exp 1
276 }
277
278 ;proc Help_subwidget {w widget} {
279     upvar \#0 $w data
280     switch -- $widget {
281         base - container - label - hierarchy { return $data($widget) }
282         default { return -code error "No $data(class) subwidget \"$widget\"" }
283     }
284 }
285
286 ;proc Help:configure {w args} {
287     upvar \#0 $w data
288     set truth {^(1|yes|true|on)$}
289     foreach {key val} $args {
290         switch -- $key {
291             -binding    {
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"
295                 }
296                 set data($key) $val
297             }
298             -buttons    {
299                 set data($key) $val
300                 Help:buttons $w $data(buttonframe) $val
301             }
302             -executable { set data($key) $val }
303             -inherit    { set data($key) [regexp -nocase $truth $val] }
304             -label      {
305                 set data($key) $val
306                 if {[string comp {} $val]} {
307                     pack $data(labelframe) -fill x -before $data(buttonframe)
308                 } else {
309                     pack forget $data(labelframe)
310                 }
311             }
312         }
313     }
314 }
315
316 ;proc Help:destroy w {
317     upvar \#0 $w data
318     if {[string comp {} $data(-binding)]} { bind all $data(-binding) {} }  
319 }
320
321 ;proc Help:buttons {w f btns} {
322     catch {eval destroy [winfo children $f]}
323     set i 0
324     foreach btn $btns {
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
329         }
330         pack $f.$i -fill x -side left
331     }
332 }
333
334 ;proc Help_link {w tag {url NULL}} {
335     upvar \#0 $w data
336     if {[string comp NULL $url]} {
337         set i 100
338         while {[info exists data(@$url)] && $i<100} {
339             set url $data(@$url)
340             incr i
341         }
342         set data(@$tag) $url
343     } elseif {[string match {} $url]} {
344         catch {unset data(@$tag)}
345         return
346     }
347     if {[info exists data(@$tag)]} {
348         return $data(@$tag)
349     } else {
350         return -code error "no help link \"$tag\" defined"
351     }
352 }
353
354 ;proc Help_gettag {w tag} {
355     upvar \#0 $w data
356     set found 0
357     while {[info exists data(@$tag)] && $found<100} {
358         incr found
359         if {$data(-subst)} {
360             set tag [uplevel \#0 [list subst $data(@$tag)]]
361         } else {
362             set tag $data(@$tag)
363         }
364     }
365     if {$found} {
366         return $tag
367     } elseif {$data(-inherit) && [winfo exists $tag]} {
368         while {![info exists data(@$tag)] && [string comp . $tag]} {
369             set tag [winfo parent $tag]
370         }
371         if {[info exists data(@$tag)]} { return $data(@$tag) }
372     }
373     return
374 }
375
376 ;proc Help_load {w url {complain 1}} {
377     upvar \#0 $w data
378     set link [Help_gettag $w $url]
379     if {[string comp {} $link]} {
380         Help:load $w $link
381     } elseif {[string match http:/* $url] || [string match file:/* $url]} {
382         Help:load $w $url
383     } elseif {$complain} {
384         return -code error "\"$url\" not recognized as proper URL or help link"
385     }
386 }
387
388 ;proc Help:load {w url} {
389     upvar \#0 $w data
390     regsub -all {([^\\])%s} $data(-executable) "\\1$url" cmds
391     set failed 1
392     foreach cmd $cmds {
393         if {![catch $cmd]} {
394             set failed 0
395             break
396         }
397     }
398     if {$failed} {
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." \
402                 warning 0 OK
403     }
404 }
405