hyperhelp.itk

linux 下的源代码分析阅读器 red hat公司新版

#
# Hyperhelp
# ----------------------------------------------------------------------
# Implements a help facility using html formatted hypertext files.
#
# ----------------------------------------------------------------------
#  AUTHOR: Kris Raney                   EMAIL: [e-mail]
#
#  @(#) $Id: hyperhelp.itk 144 2003-02-05 10:56:26Z mdejong $
# ----------------------------------------------------------------------
#            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([e-mail]), 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) <Key-f> [code $this forward]
    bind $itk_component(hull) <Key-b> [code $this back]
    bind $itk_component(hull) <Alt-Right> [code $this forward]
    bind $itk_component(hull) <Alt-Left> [code $this back]
    bind $itk_component(hull) <Key-space> [code $this _pageforward]
    bind $itk_component(hull) <Key-Next> [code $this _pageforward]
    bind $itk_component(hull) <Key-BackSpace> [code $this _pageback]
    bind $itk_component(hull) <Key-Prior> [code $this _pageback]
    bind $itk_component(hull) <Key-Delete> [code $this _pageback]
    bind $itk_component(hull) <Key-Down> [code $this _lineforward]
    bind $itk_component(hull) <Key-Up> [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 <helpdir>/<topic>.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.
# ------------------------------------------------------------------