| # |
| # Hyperhelp |
| # ---------------------------------------------------------------------- |
| # Implements a help facility using html formatted hypertext files. |
| # |
| # ---------------------------------------------------------------------- |
| # AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com |
| # |
| # @(#) $Id: hyperhelp.itk,v 1.5 2002/03/16 05:26:19 mgbacke Exp $ |
| # ---------------------------------------------------------------------- |
| # Copyright (c) 1996 DSC Technologies Corporation |
| # ====================================================================== |
| # Permission to use, copy, modify, distribute and license this software |
| # and its documentation for any purpose, and without fee or written |
| # agreement with DSC, is hereby granted, provided that the above copyright |
| # notice appears in all copies and that both the copyright notice and |
| # warranty disclaimer below appear in supporting documentation, and that |
| # the names of DSC Technologies Corporation or DSC Communications |
| # Corporation not be used in advertising or publicity pertaining to the |
| # software without specific, written prior permission. |
| # |
| # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING |
| # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- |
| # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE |
| # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, |
| # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL |
| # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR |
| # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, |
| # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, |
| # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS |
| # SOFTWARE. |
| # ====================================================================== |
| |
| # |
| # Acknowledgements: |
| # |
| # Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his |
| # help.tcl code from tk inspect. |
| |
| # |
| # Default resources. |
| # |
| option add *Hyperhelp.width 575 widgetDefault |
| option add *Hyperhelp.height 450 widgetDefault |
| option add *Hyperhelp.modality none widgetDefault |
| option add *Hyperhelp.vscrollMode static widgetDefault |
| option add *Hyperhelp.hscrollMode static widgetDefault |
| option add *Hyperhelp.maxHistory 20 widgetDefault |
| |
| # |
| # Usual options. |
| # |
| itk::usual Hyperhelp { |
| keep -activebackground -activerelief -background -borderwidth -cursor \ |
| -foreground -highlightcolor -highlightthickness \ |
| -selectbackground -selectborderwidth -selectforeground \ |
| -textbackground |
| } |
| |
| # ------------------------------------------------------------------ |
| # HYPERHELP |
| # ------------------------------------------------------------------ |
| itcl::class iwidgets::Hyperhelp { |
| inherit iwidgets::Shell |
| |
| constructor {args} {} |
| |
| itk_option define -topics topics Topics {} |
| itk_option define -helpdir helpdir Directory . |
| itk_option define -title title Title "Help" |
| itk_option define -closecmd closeCmd CloseCmd {} |
| itk_option define -maxhistory maxHistory MaxHistory 20 |
| |
| public variable beforelink {} |
| public variable afterlink {} |
| |
| public method showtopic {topic} |
| public method followlink {link} |
| public method forward {} |
| public method back {} |
| public method updatefeedback {n} |
| |
| protected method _readtopic {file {anchorpoint {}}} |
| protected method _pageforward {} |
| protected method _pageback {} |
| protected method _lineforward {} |
| protected method _lineback {} |
| protected method _fill_go_menu {} |
| |
| protected variable _history {} ;# History list of viewed pages |
| protected variable _history_ndx -1 ;# current position in history list |
| protected variable _history_len 0 ;# length of history list |
| protected variable _histdir -1 ;# direction in history we just came |
| ;# from |
| protected variable _len 0 ;# length of text to be rendered |
| protected variable _file {} ;# current topic |
| |
| private variable _remaining 0 ;# remaining text to be rendered |
| private variable _rendering 0 ;# flag - in process of rendering |
| } |
| |
| # |
| # Provide a lowercased access method for the Scrolledlistbox class. |
| # |
| proc ::iwidgets::hyperhelp {pathName args} { |
| uplevel ::iwidgets::Hyperhelp $pathName $args |
| } |
| |
| # ------------------------------------------------------------------ |
| # CONSTRUCTOR |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::constructor {args} { |
| itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady |
| |
| # |
| # Create a pulldown menu |
| # |
| itk_component add -private menubar { |
| frame $itk_interior.menu -relief raised -bd 2 |
| } { |
| keep -background -cursor |
| } |
| pack $itk_component(menubar) -side top -fill x |
| |
| itk_component add -private topicmb { |
| menubutton $itk_component(menubar).topicmb -text "Topics" \ |
| -menu $itk_component(menubar).topicmb.topicmenu \ |
| -underline 0 -padx 8 -pady 2 |
| } { |
| keep -background -cursor -font -foreground \ |
| -activebackground -activeforeground |
| } |
| pack $itk_component(topicmb) -side left |
| |
| itk_component add -private topicmenu { |
| menu $itk_component(topicmb).topicmenu -tearoff no |
| } { |
| keep -background -cursor -font -foreground \ |
| -activebackground -activeforeground |
| } |
| |
| itk_component add -private navmb { |
| menubutton $itk_component(menubar).navmb -text "Navigate" \ |
| -menu $itk_component(menubar).navmb.navmenu \ |
| -underline 0 -padx 8 -pady 2 |
| } { |
| keep -background -cursor -font -foreground \ |
| -activebackground -activeforeground |
| } |
| pack $itk_component(navmb) -side left |
| |
| itk_component add -private navmenu { |
| menu $itk_component(navmb).navmenu -tearoff no |
| } { |
| keep -background -cursor -font -foreground \ |
| -activebackground -activeforeground |
| } |
| set m $itk_component(navmenu) |
| $m add command -label "Forward" -underline 0 -state disabled \ |
| -command [itcl::code $this forward] -accelerator f |
| $m add command -label "Back" -underline 0 -state disabled \ |
| -command [itcl::code $this back] -accelerator b |
| $m add cascade -label "Go" -underline 0 -menu $m.go |
| |
| itk_component add -private navgo { |
| menu $itk_component(navmenu).go -postcommand [itcl::code $this _fill_go_menu] |
| } { |
| keep -background -cursor -font -foreground \ |
| -activebackground -activeforeground |
| } |
| |
| # |
| # Create a scrolledhtml object to display help pages |
| # |
| itk_component add scrtxt { |
| iwidgets::scrolledhtml $itk_interior.scrtxt \ |
| -linkcommand "$this followlink" -feedback "$this updatefeedback" |
| } { |
| keep -hscrollmode -vscrollmode -background -textbackground \ |
| -fontname -fontsize -fixedfont -link \ |
| -linkhighlight -borderwidth -cursor -sbwidth -scrollmargin \ |
| -width -height -foreground -highlightcolor -visibleitems \ |
| -highlightthickness -padx -pady -activerelief \ |
| -relief -selectbackground -selectborderwidth \ |
| -selectforeground -setgrid -wrap -unknownimage |
| } |
| pack $itk_component(scrtxt) -fill both -expand yes |
| |
| # |
| # Bind shortcut keys |
| # |
| bind $itk_component(hull) <Key-f> [itcl::code $this forward] |
| bind $itk_component(hull) <Key-b> [itcl::code $this back] |
| bind $itk_component(hull) <Alt-Right> [itcl::code $this forward] |
| bind $itk_component(hull) <Alt-Left> [itcl::code $this back] |
| bind $itk_component(hull) <Key-space> [itcl::code $this _pageforward] |
| bind $itk_component(hull) <Key-Next> [itcl::code $this _pageforward] |
| bind $itk_component(hull) <Key-BackSpace> [itcl::code $this _pageback] |
| bind $itk_component(hull) <Key-Prior> [itcl::code $this _pageback] |
| bind $itk_component(hull) <Key-Delete> [itcl::code $this _pageback] |
| bind $itk_component(hull) <Key-Down> [itcl::code $this _lineforward] |
| bind $itk_component(hull) <Key-Up> [itcl::code $this _lineback] |
| |
| wm title $itk_component(hull) "Help" |
| |
| eval itk_initialize $args |
| if {[lsearch -exact $args -closecmd] == -1} { |
| configure -closecmd [itcl::code $this deactivate] |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTIONS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -topics |
| # |
| # Specifies the topics to display on the menu. For each topic, there should |
| # be a file named <helpdir>/<topic>.html |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Hyperhelp::topics { |
| set m $itk_component(topicmenu) |
| $m delete 0 last |
| foreach topic $itk_option(-topics) { |
| if {[lindex $topic 1] == {} } { |
| $m add radiobutton -variable topic \ |
| -value $topic \ |
| -label $topic \ |
| -command [list $this showtopic $topic] |
| } else { |
| if {[string index [file dirname [lindex $topic 1]] 0] != "/" && \ |
| [string index [file dirname [lindex $topic 1]] 0] != "~"} { |
| set link $itk_option(-helpdir)/[lindex $topic 1] |
| } else { |
| set link [lindex $topic 1] |
| } |
| $m add radiobutton -variable topic \ |
| -value [lindex $topic 0] \ |
| -label [lindex $topic 0] \ |
| -command [list $this followlink $link] |
| } |
| } |
| $m add separator |
| $m add command -label "Close Help" -underline 0 \ |
| -command $itk_option(-closecmd) |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -title |
| # |
| # Specify the window title. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Hyperhelp::title { |
| wm title $itk_component(hull) $itk_option(-title) |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -helpdir |
| # |
| # Set location of help files |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Hyperhelp::helpdir { |
| if {[file pathtype $itk_option(-helpdir)] == "relative"} { |
| configure -helpdir [file join [pwd] $itk_option(-helpdir)] |
| } else { |
| set _history {} |
| set _history_len 0 |
| set _history_ndx -1 |
| $itk_component(navmenu) entryconfig 0 -state disabled |
| $itk_component(navmenu) entryconfig 1 -state disabled |
| configure -topics $itk_option(-topics) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -closecmd |
| # |
| # Specify the command to execute when close is selected from the menu |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Hyperhelp::closecmd { |
| $itk_component(topicmenu) entryconfigure last -command $itk_option(-closecmd) |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHODS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # METHOD: showtopic topic |
| # |
| # render text of help topic <topic>. The text is expected to be found in |
| # <helpdir>/<topic>.html |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::showtopic {topic} { |
| if ![regexp {(.*)#(.*)} $topic dummy topicname anchorpart] { |
| set topicname $topic |
| set anchorpart {} |
| } |
| if {$topicname == ""} { |
| set topicname $_file |
| set filepath $_file |
| } else { |
| set filepath $itk_option(-helpdir)/$topicname.html |
| } |
| if {[incr _history_ndx] < $itk_option(-maxhistory)} { |
| set _history [lrange $_history 0 [expr {$_history_ndx - 1}]] |
| set _history_len [expr {$_history_ndx + 1}] |
| } else { |
| incr _history_ndx -1 |
| set _history [lrange $_history 1 $_history_ndx] |
| set _history_len [expr {$_history_ndx + 1}] |
| } |
| lappend _history [list $topicname $filepath $anchorpart] |
| _readtopic $filepath $anchorpart |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: followlink link |
| # |
| # Callback for click on a link. Shows new topic. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::followlink {link} { |
| if {[string compare $beforelink ""] != 0} { |
| eval $beforelink $link |
| } |
| if ![regexp {(.*)#(.*)} $link dummy filepart anchorpart] { |
| set filepart $link |
| set anchorpart {} |
| } |
| if {$filepart != "" && [string index [file dirname $filepart] 0] != "/" && \ |
| [string index [file dirname $filepart] 0] != "~"} { |
| set filepart [$itk_component(scrtxt) pwd]/$filepart |
| set hfile $filepart |
| } else { |
| set hfile $_file |
| } |
| incr _history_ndx |
| set _history [lrange $_history 0 [expr {$_history_ndx - 1}]] |
| set _history_len [expr {$_history_ndx + 1}] |
| lappend _history [list [file rootname [file tail $hfile]] $hfile $anchorpart] |
| set ret [_readtopic $filepart $anchorpart] |
| if {[string compare $afterlink ""] != 0} { |
| eval $afterlink $link |
| } |
| return $ret |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: forward |
| # |
| # Show topic one forward in history list |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::forward {} { |
| if {$_rendering || ($_history_ndx+1) >= $_history_len} return |
| incr _history_ndx |
| eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end] |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: back |
| # |
| # Show topic one back in history list |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::back {} { |
| if {$_rendering || $_history_ndx <= 0} return |
| incr _history_ndx -1 |
| set _histdir 1 |
| eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end] |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: updatefeedback remaining |
| # |
| # Callback from text to update feedback widget |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::updatefeedback {n} { |
| if {($_remaining - $n) > .1*$_len} { |
| [$itk_interior.feedbackshell childsite].helpfeedback step [expr {$_remaining - $n}] |
| update idletasks |
| set _remaining $n |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _readtopic |
| # |
| # Read in file, render it in text area, and jump to anchorpoint |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::_readtopic {file {anchorpoint {}}} { |
| if {$file != ""} { |
| if {[string compare $file $_file] != 0} { |
| if {[catch {set f [open $file r]} err]} { |
| incr _history_ndx $_histdir |
| set _history_len [expr {$_history_ndx + 1}] |
| set _histdir -1 |
| set m $itk_component(navmenu) |
| if {($_history_ndx+1) < $_history_len} { |
| $m entryconfig 0 -state normal |
| } else { |
| $m entryconfig 0 -state disabled |
| } |
| if {$_history_ndx > 0} { |
| $m entryconfig 1 -state normal |
| } else { |
| $m entryconfig 1 -state disabled |
| } |
| return |
| } |
| set _file $file |
| set txt [read $f] |
| iwidgets::shell $itk_interior.feedbackshell -title \ |
| "Rendering HTML" -padx 1 -pady 1 |
| iwidgets::Feedback [$itk_interior.feedbackshell \ |
| childsite].helpfeedback \ |
| -steps [set _len [string length $txt]] \ |
| -labeltext "Rendering HTML" -labelpos n |
| pack [$itk_interior.feedbackshell childsite].helpfeedback |
| $itk_interior.feedbackshell center $itk_interior |
| $itk_interior.feedbackshell activate |
| set _remaining $_len |
| set _rendering 1 |
| if {[catch {$itk_component(scrtxt) render $txt [file dirname \ |
| $file]} err]} { |
| if [regexp "</pre>" $err] { |
| $itk_component(scrtxt) render "<tt>$err</tt>" |
| } else { |
| $itk_component(scrtxt) render "<pre>$err</pre>" |
| } |
| } |
| wm title $itk_component(hull) "Help: $file" |
| itcl::delete object [$itk_interior.feedbackshell \ |
| childsite].helpfeedback |
| itcl::delete object $itk_interior.feedbackshell |
| set _rendering 0 |
| } |
| } |
| set m $itk_component(navmenu) |
| if {($_history_ndx+1) < $_history_len} { |
| $m entryconfig 0 -state normal |
| } else { |
| $m entryconfig 0 -state disabled |
| } |
| if {$_history_ndx > 0} { |
| $m entryconfig 1 -state normal |
| } else { |
| $m entryconfig 1 -state disabled |
| } |
| if {$anchorpoint != {}} { |
| $itk_component(scrtxt) import -link #$anchorpoint |
| } else { |
| $itk_component(scrtxt) import -link # |
| } |
| set _histdir -1 |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _fill_go_menu |
| # |
| # update go submenu with current history |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::_fill_go_menu {} { |
| set m $itk_component(navgo) |
| catch {$m delete 0 last} |
| for {set i [expr {$_history_len - 1}]} {$i >= 0} {incr i -1} { |
| set topic [lindex [lindex $_history $i] 0] |
| set filepath [lindex [lindex $_history $i] 1] |
| set anchor [lindex [lindex $_history $i] 2] |
| $m add command -label $topic \ |
| -command [list $this followlink $filepath#$anchor] |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _pageforward |
| # |
| # Callback for page forward shortcut key |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::_pageforward {} { |
| $itk_component(scrtxt) yview scroll 1 pages |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _pageback |
| # |
| # Callback for page back shortcut key |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::_pageback {} { |
| $itk_component(scrtxt) yview scroll -1 pages |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _lineforward |
| # |
| # Callback for line forward shortcut key |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::_lineforward {} { |
| $itk_component(scrtxt) yview scroll 1 units |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _lineback |
| # |
| # Callback for line back shortcut key |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Hyperhelp::_lineback {} { |
| $itk_component(scrtxt) yview scroll -1 units |
| } |
