1#
2# Hyperhelp
3# ----------------------------------------------------------------------
4# Implements a help facility using html formatted hypertext files.
5#
6# ----------------------------------------------------------------------
7#  AUTHOR: Kris Raney                   EMAIL: kraney@spd.dsccc.com
8#
9#  @(#) $Id: hyperhelp.itk,v 1.5 2002/03/16 05:26:19 mgbacke Exp $
10# ----------------------------------------------------------------------
11#            Copyright (c) 1996 DSC Technologies Corporation
12# ======================================================================
13# Permission to use, copy, modify, distribute and license this software
14# and its documentation for any purpose, and without fee or written
15# agreement with DSC, is hereby granted, provided that the above copyright
16# notice appears in all copies and that both the copyright notice and
17# warranty disclaimer below appear in supporting documentation, and that
18# the names of DSC Technologies Corporation or DSC Communications
19# Corporation not be used in advertising or publicity pertaining to the
20# software without specific, written prior permission.
21#
22# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
23# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
24# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
25# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
26# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
27# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
28# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
29# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
30# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
31# SOFTWARE.
32# ======================================================================
33
34#
35# Acknowledgements:
36#
37# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
38# help.tcl code from tk inspect.
39
40#
41# Default resources.
42#
43option add *Hyperhelp.width 575 widgetDefault
44option add *Hyperhelp.height 450 widgetDefault
45option add *Hyperhelp.modality none widgetDefault
46option add *Hyperhelp.vscrollMode static widgetDefault
47option add *Hyperhelp.hscrollMode static widgetDefault
48option add *Hyperhelp.maxHistory 20 widgetDefault
49
50#
51# Usual options.
52#
53itk::usual Hyperhelp {
54    keep -activebackground -activerelief -background -borderwidth -cursor \
55         -foreground -highlightcolor -highlightthickness \
56         -selectbackground -selectborderwidth -selectforeground \
57         -textbackground
58}
59
60# ------------------------------------------------------------------
61#                          HYPERHELP
62# ------------------------------------------------------------------
63itcl::class iwidgets::Hyperhelp {
64    inherit iwidgets::Shell
65
66    constructor {args} {}
67
68    itk_option define -topics topics Topics {}
69    itk_option define -helpdir helpdir Directory .
70    itk_option define -title title Title "Help"
71    itk_option define -closecmd closeCmd CloseCmd {}
72    itk_option define -maxhistory maxHistory MaxHistory 20
73
74    public variable beforelink {}
75    public variable afterlink {}
76
77    public method showtopic {topic}
78    public method followlink {link}
79    public method forward {}
80    public method back {}
81    public method updatefeedback {n}
82
83    protected method _readtopic {file {anchorpoint {}}}
84    protected method _pageforward {}
85    protected method _pageback {}
86    protected method _lineforward {}
87    protected method _lineback {}
88    protected method _fill_go_menu {}
89
90    protected variable _history {}      ;# History list of viewed pages
91    protected variable _history_ndx -1  ;# current position in history list
92    protected variable _history_len 0   ;# length of history list
93    protected variable _histdir -1      ;# direction in history we just came
94                                        ;# from
95    protected variable _len 0           ;# length of text to be rendered
96    protected variable _file {}         ;# current topic
97
98    private variable _remaining 0       ;# remaining text to be rendered
99    private variable _rendering 0       ;# flag - in process of rendering
100}
101
102#
103# Provide a lowercased access method for the Scrolledlistbox class.
104#
105proc ::iwidgets::hyperhelp {pathName args} {
106    uplevel ::iwidgets::Hyperhelp $pathName $args
107}
108
109# ------------------------------------------------------------------
110#                        CONSTRUCTOR
111# ------------------------------------------------------------------
112itcl::body iwidgets::Hyperhelp::constructor {args} {
113    itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady
114
115    #
116    # Create a pulldown menu
117    #
118    itk_component add -private menubar {
119      frame $itk_interior.menu -relief raised -bd 2
120    } {
121      keep -background -cursor
122    }
123    pack $itk_component(menubar) -side top -fill x
124
125    itk_component add -private topicmb {
126      menubutton $itk_component(menubar).topicmb -text "Topics" \
127           -menu $itk_component(menubar).topicmb.topicmenu \
128           -underline 0 -padx 8 -pady 2
129    } {
130      keep -background -cursor -font -foreground \
131              -activebackground -activeforeground
132    }
133    pack $itk_component(topicmb) -side left
134
135    itk_component add -private topicmenu {
136      menu $itk_component(topicmb).topicmenu -tearoff no
137    } {
138      keep -background -cursor -font -foreground \
139              -activebackground -activeforeground
140    }
141
142    itk_component add -private navmb {
143      menubutton $itk_component(menubar).navmb -text "Navigate" \
144          -menu $itk_component(menubar).navmb.navmenu \
145          -underline 0 -padx 8 -pady 2
146    } {
147      keep -background -cursor -font -foreground \
148             -activebackground -activeforeground
149    }
150    pack $itk_component(navmb) -side left
151
152    itk_component add -private navmenu {
153      menu $itk_component(navmb).navmenu -tearoff no
154    } {
155      keep -background -cursor -font -foreground \
156              -activebackground -activeforeground
157    }
158    set m $itk_component(navmenu)
159    $m add command -label "Forward" -underline 0 -state disabled \
160         -command [itcl::code $this forward] -accelerator f
161    $m add command -label "Back" -underline 0 -state disabled \
162         -command [itcl::code $this back] -accelerator b
163    $m add cascade -label "Go" -underline 0 -menu $m.go
164
165    itk_component add -private navgo {
166      menu $itk_component(navmenu).go -postcommand [itcl::code $this _fill_go_menu]
167    } {
168      keep -background -cursor -font -foreground \
169              -activebackground -activeforeground
170    }
171
172    #
173    # Create a scrolledhtml object to display help pages
174    #
175    itk_component add scrtxt {
176      iwidgets::scrolledhtml $itk_interior.scrtxt \
177           -linkcommand "$this followlink" -feedback "$this updatefeedback"
178    } {
179        keep    -hscrollmode -vscrollmode -background -textbackground \
180                -fontname -fontsize -fixedfont -link \
181                -linkhighlight -borderwidth -cursor -sbwidth -scrollmargin \
182                -width -height -foreground -highlightcolor -visibleitems \
183                -highlightthickness -padx -pady -activerelief \
184                -relief -selectbackground -selectborderwidth \
185                -selectforeground -setgrid -wrap -unknownimage
186    }
187    pack $itk_component(scrtxt) -fill both -expand yes
188
189    #
190    # Bind shortcut keys
191    #
192    bind $itk_component(hull) <Key-f> [itcl::code $this forward]
193    bind $itk_component(hull) <Key-b> [itcl::code $this back]
194    bind $itk_component(hull) <Alt-Right> [itcl::code $this forward]
195    bind $itk_component(hull) <Alt-Left> [itcl::code $this back]
196    bind $itk_component(hull) <Key-space> [itcl::code $this _pageforward]
197    bind $itk_component(hull) <Key-Next> [itcl::code $this _pageforward]
198    bind $itk_component(hull) <Key-BackSpace> [itcl::code $this _pageback]
199    bind $itk_component(hull) <Key-Prior> [itcl::code $this _pageback]
200    bind $itk_component(hull) <Key-Delete> [itcl::code $this _pageback]
201    bind $itk_component(hull) <Key-Down> [itcl::code $this _lineforward]
202    bind $itk_component(hull) <Key-Up> [itcl::code $this _lineback]
203
204    wm title $itk_component(hull) "Help"
205
206    eval itk_initialize $args
207    if {[lsearch -exact $args -closecmd] == -1} {
208      configure -closecmd [itcl::code $this deactivate]
209    }
210}
211
212# ------------------------------------------------------------------
213#                             OPTIONS
214# ------------------------------------------------------------------
215
216# ------------------------------------------------------------------
217# OPTION: -topics
218#
219# Specifies the topics to display on the menu. For each topic, there should
220# be a file named <helpdir>/<topic>.html
221# ------------------------------------------------------------------
222itcl::configbody iwidgets::Hyperhelp::topics {
223    set m $itk_component(topicmenu)
224    $m delete 0 last
225    foreach topic $itk_option(-topics) {
226      if {[lindex $topic 1] == {} } {
227        $m add radiobutton -variable topic \
228          -value $topic \
229          -label $topic \
230          -command [list $this showtopic $topic]
231      } else {
232        if {[string index [file dirname [lindex $topic 1]] 0] != "/" && \
233            [string index [file dirname [lindex $topic 1]] 0] != "~"} {
234          set link $itk_option(-helpdir)/[lindex $topic 1]
235        } else {
236          set link [lindex $topic 1]
237        }
238        $m add radiobutton -variable topic \
239          -value [lindex $topic 0] \
240          -label [lindex $topic 0] \
241          -command [list $this followlink $link]
242      }
243    }
244    $m add separator
245    $m add command -label "Close Help" -underline 0 \
246      -command $itk_option(-closecmd)
247}
248
249# ------------------------------------------------------------------
250# OPTION: -title
251#
252# Specify the window title.
253# ------------------------------------------------------------------
254itcl::configbody iwidgets::Hyperhelp::title {
255    wm title $itk_component(hull) $itk_option(-title)
256}
257
258# ------------------------------------------------------------------
259# OPTION: -helpdir
260#
261# Set location of help files
262# ------------------------------------------------------------------
263itcl::configbody iwidgets::Hyperhelp::helpdir {
264    if {[file pathtype $itk_option(-helpdir)] == "relative"} {
265      configure -helpdir [file join [pwd] $itk_option(-helpdir)]
266    } else {
267      set _history {}
268      set _history_len 0
269      set _history_ndx -1
270      $itk_component(navmenu) entryconfig 0 -state disabled
271      $itk_component(navmenu) entryconfig 1 -state disabled
272      configure -topics $itk_option(-topics)
273   }
274}
275
276# ------------------------------------------------------------------
277# OPTION: -closecmd
278#
279# Specify the command to execute when close is selected from the menu
280# ------------------------------------------------------------------
281itcl::configbody iwidgets::Hyperhelp::closecmd {
282  $itk_component(topicmenu) entryconfigure last -command $itk_option(-closecmd)
283}
284
285# ------------------------------------------------------------------
286#                            METHODS
287# ------------------------------------------------------------------
288
289# ------------------------------------------------------------------
290# METHOD: showtopic topic
291#
292# render text of help topic <topic>. The text is expected to be found in
293# <helpdir>/<topic>.html
294# ------------------------------------------------------------------
295itcl::body iwidgets::Hyperhelp::showtopic {topic} {
296  if ![regexp {(.*)#(.*)} $topic dummy topicname anchorpart] {
297    set topicname $topic
298    set anchorpart {}
299  }
300  if {$topicname == ""} {
301    set topicname $_file
302    set filepath $_file
303  } else {
304    set filepath $itk_option(-helpdir)/$topicname.html
305  }
306  if {[incr _history_ndx] < $itk_option(-maxhistory)} {
307    set _history [lrange $_history 0 [expr {$_history_ndx - 1}]]
308    set _history_len [expr {$_history_ndx + 1}]
309  } else {
310    incr _history_ndx -1
311    set _history [lrange $_history 1 $_history_ndx]
312    set _history_len [expr {$_history_ndx + 1}]
313  }
314  lappend _history [list $topicname $filepath $anchorpart]
315  _readtopic $filepath $anchorpart
316}
317
318# ------------------------------------------------------------------
319# METHOD: followlink link
320#
321# Callback for click on a link. Shows new topic.
322# ------------------------------------------------------------------
323itcl::body iwidgets::Hyperhelp::followlink {link} {
324  if {[string compare $beforelink ""] != 0} {
325    eval $beforelink $link
326  }
327  if ![regexp {(.*)#(.*)} $link dummy filepart anchorpart] {
328    set filepart $link
329    set anchorpart {}
330  }
331  if {$filepart != "" && [string index [file dirname $filepart] 0] != "/" && \
332      [string index [file dirname $filepart] 0] != "~"} {
333    set filepart [$itk_component(scrtxt) pwd]/$filepart
334    set hfile $filepart
335  } else {
336    set hfile $_file
337  }
338  incr _history_ndx
339  set _history [lrange $_history 0 [expr {$_history_ndx - 1}]]
340  set _history_len [expr {$_history_ndx + 1}]
341  lappend _history [list [file rootname [file tail $hfile]] $hfile $anchorpart]
342  set ret [_readtopic $filepart $anchorpart]
343  if {[string compare $afterlink ""] != 0} {
344    eval $afterlink $link
345  }
346  return $ret
347}
348
349# ------------------------------------------------------------------
350# METHOD: forward
351#
352# Show topic one forward in history list
353# ------------------------------------------------------------------
354itcl::body iwidgets::Hyperhelp::forward {} {
355    if {$_rendering || ($_history_ndx+1) >= $_history_len} return
356    incr _history_ndx
357    eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
358}
359
360# ------------------------------------------------------------------
361# METHOD: back
362#
363# Show topic one back in history list
364# ------------------------------------------------------------------
365itcl::body iwidgets::Hyperhelp::back {} {
366    if {$_rendering || $_history_ndx <= 0} return
367    incr _history_ndx -1
368    set _histdir 1
369    eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
370}
371
372# ------------------------------------------------------------------
373# METHOD: updatefeedback remaining
374#
375# Callback from text to update feedback widget
376# ------------------------------------------------------------------
377itcl::body iwidgets::Hyperhelp::updatefeedback {n} {
378    if {($_remaining - $n) > .1*$_len} {
379      [$itk_interior.feedbackshell childsite].helpfeedback step [expr {$_remaining - $n}]
380      update idletasks
381      set _remaining $n
382    }
383}
384
385# ------------------------------------------------------------------
386# PRIVATE METHOD: _readtopic
387#
388# Read in file, render it in text area, and jump to anchorpoint
389# ------------------------------------------------------------------
390itcl::body iwidgets::Hyperhelp::_readtopic {file {anchorpoint {}}} {
391    if {$file != ""} {
392        if {[string compare $file $_file] != 0} {
393            if {[catch {set f [open $file r]} err]} {
394                incr _history_ndx $_histdir
395                set _history_len [expr {$_history_ndx + 1}]
396                set _histdir -1
397                set m $itk_component(navmenu)
398                if {($_history_ndx+1) < $_history_len} {
399                    $m entryconfig 0 -state normal
400                } else {
401                    $m entryconfig 0 -state disabled
402                }
403                if {$_history_ndx > 0} {
404                    $m entryconfig 1 -state normal
405                } else {
406                    $m entryconfig 1 -state disabled
407                }
408                return
409            }
410            set _file $file
411            set txt [read $f]
412            iwidgets::shell $itk_interior.feedbackshell -title \
413                    "Rendering HTML" -padx 1 -pady 1
414            iwidgets::Feedback [$itk_interior.feedbackshell \
415                    childsite].helpfeedback \
416            -steps [set _len [string length $txt]] \
417                    -labeltext "Rendering HTML" -labelpos n
418            pack [$itk_interior.feedbackshell childsite].helpfeedback
419            $itk_interior.feedbackshell center $itk_interior
420            $itk_interior.feedbackshell activate
421            set _remaining $_len
422            set _rendering 1
423            if {[catch {$itk_component(scrtxt) render $txt [file dirname \
424                    $file]} err]} {
425                if [regexp "</pre>" $err] {
426                    $itk_component(scrtxt) render "<tt>$err</tt>"
427                } else {
428                    $itk_component(scrtxt) render "<pre>$err</pre>"
429                }
430            }
431            wm title $itk_component(hull) "Help: $file"
432            itcl::delete object [$itk_interior.feedbackshell \
433                    childsite].helpfeedback
434            itcl::delete object $itk_interior.feedbackshell
435            set _rendering 0
436        }
437    }
438    set m $itk_component(navmenu)
439    if {($_history_ndx+1) < $_history_len} {
440        $m entryconfig 0 -state normal
441    } else {
442        $m entryconfig 0 -state disabled
443    }
444    if {$_history_ndx > 0} {
445        $m entryconfig 1 -state normal
446    } else {
447        $m entryconfig 1 -state disabled
448    }
449    if {$anchorpoint != {}} {
450        $itk_component(scrtxt) import -link #$anchorpoint
451    } else {
452        $itk_component(scrtxt) import -link #
453    }
454    set _histdir -1
455}
456
457# ------------------------------------------------------------------
458# PRIVATE METHOD: _fill_go_menu
459#
460# update go submenu with current history
461# ------------------------------------------------------------------
462itcl::body iwidgets::Hyperhelp::_fill_go_menu {} {
463    set m $itk_component(navgo)
464    catch {$m delete 0 last}
465    for {set i [expr {$_history_len - 1}]} {$i >= 0} {incr i -1} {
466        set topic [lindex [lindex $_history $i] 0]
467        set filepath [lindex [lindex $_history $i] 1]
468        set anchor [lindex [lindex $_history $i] 2]
469        $m add command -label $topic \
470                -command [list $this followlink $filepath#$anchor]
471    }
472}
473
474# ------------------------------------------------------------------
475# PRIVATE METHOD: _pageforward
476#
477# Callback for page forward shortcut key
478# ------------------------------------------------------------------
479itcl::body iwidgets::Hyperhelp::_pageforward {} {
480    $itk_component(scrtxt) yview scroll 1 pages
481}
482
483# ------------------------------------------------------------------
484# PRIVATE METHOD: _pageback
485#
486# Callback for page back shortcut key
487# ------------------------------------------------------------------
488itcl::body iwidgets::Hyperhelp::_pageback {} {
489    $itk_component(scrtxt) yview scroll -1 pages
490}
491
492# ------------------------------------------------------------------
493# PRIVATE METHOD: _lineforward
494#
495# Callback for line forward shortcut key
496# ------------------------------------------------------------------
497itcl::body iwidgets::Hyperhelp::_lineforward {} {
498    $itk_component(scrtxt) yview scroll 1 units
499}
500
501# ------------------------------------------------------------------
502# PRIVATE METHOD: _lineback
503#
504# Callback for line back shortcut key
505# ------------------------------------------------------------------
506itcl::body iwidgets::Hyperhelp::_lineback {} {
507    $itk_component(scrtxt) yview scroll -1 units
508}
509