iwidgets4 4.0.1-5 / usr / share / tcltk / iwidgets4.0.1 / scripts / hyperhelp.itk

#
# 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 
}