summaryrefslogtreecommitdiff
path: root/iwidgets/generic/hyperhelp.itk
diff options
context:
space:
mode:
Diffstat (limited to 'iwidgets/generic/hyperhelp.itk')
-rw-r--r--iwidgets/generic/hyperhelp.itk508
1 files changed, 508 insertions, 0 deletions
diff --git a/iwidgets/generic/hyperhelp.itk b/iwidgets/generic/hyperhelp.itk
new file mode 100644
index 00000000000..df2ea5e8847
--- /dev/null
+++ b/iwidgets/generic/hyperhelp.itk
@@ -0,0 +1,508 @@
+#
+# Hyperhelp
+# ----------------------------------------------------------------------
+# Implements a help facility using html formatted hypertext files.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# 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
+}
View Lorry Controller Status