Subversion Repositories or1k

#

# Hyperhelp

# ----------------------------------------------------------------------

# Implements a help facility using html formatted hypertext files.

#

# ----------------------------------------------------------------------

#  AUTHOR: Kris Raney                   EMAIL: kraney@spd.dsccc.com

#

#  @(#) $Id: hyperhelp.itk,v 1.1.1.1 2002-01-16 10:24:50 markom 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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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 [code $this forward] -accelerator f

    $m add command -label "Back" -underline 0 -state disabled \

         -command [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 [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)  [code $this forward]

    bind $itk_component(hull)  [code $this back]

    bind $itk_component(hull)  [code $this forward]

    bind $itk_component(hull)  [code $this back]

    bind $itk_component(hull)  [code $this _pageforward]

    bind $itk_component(hull)  [code $this _pageforward]

    bind $itk_component(hull)  [code $this _pageback]

    bind $itk_component(hull)  [code $this _pageback]

    bind $itk_component(hull)  [code $this _pageback]

    bind $itk_component(hull)  [code $this _lineforward]

    bind $itk_component(hull)  [code $this _lineback]

    wm title $itk_component(hull) "Help"

    eval itk_initialize $args

    if {[lsearch -exact $args -closecmd] == -1} {

      configure -closecmd [code $this deactivate]

    }

}

# ------------------------------------------------------------------

#                             OPTIONS

# ------------------------------------------------------------------

# ------------------------------------------------------------------

# OPTION: -topics

#

# Specifies the topics to display on the menu. For each topic, there should

# be a file named /.html

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

configbody iwidgets::Hyperhelp::title {

    wm title $itk_component(hull) $itk_option(-title)

}

# ------------------------------------------------------------------

# OPTION: -helpdir

#

# Set location of help files

# ------------------------------------------------------------------

configbody iwidgets::Hyperhelp::helpdir {

    if {[string index [file dirname $itk_option(-helpdir)] 0] != "/" && \

        [string index [file dirname $itk_option(-helpdir)] 0] != "~"} {

      configure -helpdir [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

# ------------------------------------------------------------------

configbody iwidgets::Hyperhelp::closecmd {

  $itk_component(topicmenu) entryconfigure last -command $itk_option(-closecmd)

}

# ------------------------------------------------------------------

#                            METHODS

# ------------------------------------------------------------------

# ------------------------------------------------------------------

# METHOD: showtopic topic

#

# render text of help topic . The text is expected to be found in

# /.html

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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

        }

        error $err

      }

      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 "

            $itk_component(scrtxt) render "$err"

          } else {

            $itk_component(scrtxt) render "
$err
"

          }

      }

      wm title $itk_component(hull) "Help: $file"

      delete object [$itk_interior.feedbackshell childsite].helpfeedback

      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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

body iwidgets::Hyperhelp::_pageforward {} {

    $itk_component(scrtxt) yview scroll 1 pages

}

# ------------------------------------------------------------------

# PRIVATE METHOD: _pageback

#

# Callback for page back shortcut key

# ------------------------------------------------------------------

body iwidgets::Hyperhelp::_pageback {} {

    $itk_component(scrtxt) yview scroll -1 pages

}

# ------------------------------------------------------------------

# PRIVATE METHOD: _lineforward

#

# Callback for line forward shortcut key

# ------------------------------------------------------------------

body iwidgets::Hyperhelp::_lineforward {} {

    $itk_component(scrtxt) yview scroll 1 units

}

# ------------------------------------------------------------------

# PRIVATE METHOD: _lineback

#

# Callback for line back shortcut key

# ------------------------------------------------------------------

body iwidgets::Hyperhelp::_lineback {} {

    $itk_component(scrtxt) yview scroll -1 units

}