URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [tags/] [start/] [insight/] [itcl/] [iwidgets3.0.0/] [generic/] [hyperhelp.itk] - Rev 1782
Go to most recent revision | Compare with Previous | Blame | View Log
#
# 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) <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.
# ------------------------------------------------------------------
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 <topic>. The text is expected to be found in
# <helpdir>/<topic>.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 "</pre>" $err] {
$itk_component(scrtxt) render "<tt>$err</tt>"
} else {
$itk_component(scrtxt) render "<pre>$err</pre>"
}
}
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
}
Go to most recent revision | Compare with Previous | Blame | View Log