1# 2# Hyperhelp 3# ---------------------------------------------------------------------- 4# Implements a help facility using html formatted hypertext files. 5# 6# ---------------------------------------------------------------------- 7# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com 8# 9# @(#) $Id: hyperhelp.itk,v 1.5 2002/03/16 05:26:19 mgbacke Exp $ 10# ---------------------------------------------------------------------- 11# Copyright (c) 1996 DSC Technologies Corporation 12# ====================================================================== 13# Permission to use, copy, modify, distribute and license this software 14# and its documentation for any purpose, and without fee or written 15# agreement with DSC, is hereby granted, provided that the above copyright 16# notice appears in all copies and that both the copyright notice and 17# warranty disclaimer below appear in supporting documentation, and that 18# the names of DSC Technologies Corporation or DSC Communications 19# Corporation not be used in advertising or publicity pertaining to the 20# software without specific, written prior permission. 21# 22# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 23# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 24# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 25# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 26# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 27# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 28# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 29# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 30# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 31# SOFTWARE. 32# ====================================================================== 33 34# 35# Acknowledgements: 36# 37# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his 38# help.tcl code from tk inspect. 39 40# 41# Default resources. 42# 43option add *Hyperhelp.width 575 widgetDefault 44option add *Hyperhelp.height 450 widgetDefault 45option add *Hyperhelp.modality none widgetDefault 46option add *Hyperhelp.vscrollMode static widgetDefault 47option add *Hyperhelp.hscrollMode static widgetDefault 48option add *Hyperhelp.maxHistory 20 widgetDefault 49 50# 51# Usual options. 52# 53itk::usual Hyperhelp { 54 keep -activebackground -activerelief -background -borderwidth -cursor \ 55 -foreground -highlightcolor -highlightthickness \ 56 -selectbackground -selectborderwidth -selectforeground \ 57 -textbackground 58} 59 60# ------------------------------------------------------------------ 61# HYPERHELP 62# ------------------------------------------------------------------ 63itcl::class iwidgets::Hyperhelp { 64 inherit iwidgets::Shell 65 66 constructor {args} {} 67 68 itk_option define -topics topics Topics {} 69 itk_option define -helpdir helpdir Directory . 70 itk_option define -title title Title "Help" 71 itk_option define -closecmd closeCmd CloseCmd {} 72 itk_option define -maxhistory maxHistory MaxHistory 20 73 74 public variable beforelink {} 75 public variable afterlink {} 76 77 public method showtopic {topic} 78 public method followlink {link} 79 public method forward {} 80 public method back {} 81 public method updatefeedback {n} 82 83 protected method _readtopic {file {anchorpoint {}}} 84 protected method _pageforward {} 85 protected method _pageback {} 86 protected method _lineforward {} 87 protected method _lineback {} 88 protected method _fill_go_menu {} 89 90 protected variable _history {} ;# History list of viewed pages 91 protected variable _history_ndx -1 ;# current position in history list 92 protected variable _history_len 0 ;# length of history list 93 protected variable _histdir -1 ;# direction in history we just came 94 ;# from 95 protected variable _len 0 ;# length of text to be rendered 96 protected variable _file {} ;# current topic 97 98 private variable _remaining 0 ;# remaining text to be rendered 99 private variable _rendering 0 ;# flag - in process of rendering 100} 101 102# 103# Provide a lowercased access method for the Scrolledlistbox class. 104# 105proc ::iwidgets::hyperhelp {pathName args} { 106 uplevel ::iwidgets::Hyperhelp $pathName $args 107} 108 109# ------------------------------------------------------------------ 110# CONSTRUCTOR 111# ------------------------------------------------------------------ 112itcl::body iwidgets::Hyperhelp::constructor {args} { 113 itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady 114 115 # 116 # Create a pulldown menu 117 # 118 itk_component add -private menubar { 119 frame $itk_interior.menu -relief raised -bd 2 120 } { 121 keep -background -cursor 122 } 123 pack $itk_component(menubar) -side top -fill x 124 125 itk_component add -private topicmb { 126 menubutton $itk_component(menubar).topicmb -text "Topics" \ 127 -menu $itk_component(menubar).topicmb.topicmenu \ 128 -underline 0 -padx 8 -pady 2 129 } { 130 keep -background -cursor -font -foreground \ 131 -activebackground -activeforeground 132 } 133 pack $itk_component(topicmb) -side left 134 135 itk_component add -private topicmenu { 136 menu $itk_component(topicmb).topicmenu -tearoff no 137 } { 138 keep -background -cursor -font -foreground \ 139 -activebackground -activeforeground 140 } 141 142 itk_component add -private navmb { 143 menubutton $itk_component(menubar).navmb -text "Navigate" \ 144 -menu $itk_component(menubar).navmb.navmenu \ 145 -underline 0 -padx 8 -pady 2 146 } { 147 keep -background -cursor -font -foreground \ 148 -activebackground -activeforeground 149 } 150 pack $itk_component(navmb) -side left 151 152 itk_component add -private navmenu { 153 menu $itk_component(navmb).navmenu -tearoff no 154 } { 155 keep -background -cursor -font -foreground \ 156 -activebackground -activeforeground 157 } 158 set m $itk_component(navmenu) 159 $m add command -label "Forward" -underline 0 -state disabled \ 160 -command [itcl::code $this forward] -accelerator f 161 $m add command -label "Back" -underline 0 -state disabled \ 162 -command [itcl::code $this back] -accelerator b 163 $m add cascade -label "Go" -underline 0 -menu $m.go 164 165 itk_component add -private navgo { 166 menu $itk_component(navmenu).go -postcommand [itcl::code $this _fill_go_menu] 167 } { 168 keep -background -cursor -font -foreground \ 169 -activebackground -activeforeground 170 } 171 172 # 173 # Create a scrolledhtml object to display help pages 174 # 175 itk_component add scrtxt { 176 iwidgets::scrolledhtml $itk_interior.scrtxt \ 177 -linkcommand "$this followlink" -feedback "$this updatefeedback" 178 } { 179 keep -hscrollmode -vscrollmode -background -textbackground \ 180 -fontname -fontsize -fixedfont -link \ 181 -linkhighlight -borderwidth -cursor -sbwidth -scrollmargin \ 182 -width -height -foreground -highlightcolor -visibleitems \ 183 -highlightthickness -padx -pady -activerelief \ 184 -relief -selectbackground -selectborderwidth \ 185 -selectforeground -setgrid -wrap -unknownimage 186 } 187 pack $itk_component(scrtxt) -fill both -expand yes 188 189 # 190 # Bind shortcut keys 191 # 192 bind $itk_component(hull) <Key-f> [itcl::code $this forward] 193 bind $itk_component(hull) <Key-b> [itcl::code $this back] 194 bind $itk_component(hull) <Alt-Right> [itcl::code $this forward] 195 bind $itk_component(hull) <Alt-Left> [itcl::code $this back] 196 bind $itk_component(hull) <Key-space> [itcl::code $this _pageforward] 197 bind $itk_component(hull) <Key-Next> [itcl::code $this _pageforward] 198 bind $itk_component(hull) <Key-BackSpace> [itcl::code $this _pageback] 199 bind $itk_component(hull) <Key-Prior> [itcl::code $this _pageback] 200 bind $itk_component(hull) <Key-Delete> [itcl::code $this _pageback] 201 bind $itk_component(hull) <Key-Down> [itcl::code $this _lineforward] 202 bind $itk_component(hull) <Key-Up> [itcl::code $this _lineback] 203 204 wm title $itk_component(hull) "Help" 205 206 eval itk_initialize $args 207 if {[lsearch -exact $args -closecmd] == -1} { 208 configure -closecmd [itcl::code $this deactivate] 209 } 210} 211 212# ------------------------------------------------------------------ 213# OPTIONS 214# ------------------------------------------------------------------ 215 216# ------------------------------------------------------------------ 217# OPTION: -topics 218# 219# Specifies the topics to display on the menu. For each topic, there should 220# be a file named <helpdir>/<topic>.html 221# ------------------------------------------------------------------ 222itcl::configbody iwidgets::Hyperhelp::topics { 223 set m $itk_component(topicmenu) 224 $m delete 0 last 225 foreach topic $itk_option(-topics) { 226 if {[lindex $topic 1] == {} } { 227 $m add radiobutton -variable topic \ 228 -value $topic \ 229 -label $topic \ 230 -command [list $this showtopic $topic] 231 } else { 232 if {[string index [file dirname [lindex $topic 1]] 0] != "/" && \ 233 [string index [file dirname [lindex $topic 1]] 0] != "~"} { 234 set link $itk_option(-helpdir)/[lindex $topic 1] 235 } else { 236 set link [lindex $topic 1] 237 } 238 $m add radiobutton -variable topic \ 239 -value [lindex $topic 0] \ 240 -label [lindex $topic 0] \ 241 -command [list $this followlink $link] 242 } 243 } 244 $m add separator 245 $m add command -label "Close Help" -underline 0 \ 246 -command $itk_option(-closecmd) 247} 248 249# ------------------------------------------------------------------ 250# OPTION: -title 251# 252# Specify the window title. 253# ------------------------------------------------------------------ 254itcl::configbody iwidgets::Hyperhelp::title { 255 wm title $itk_component(hull) $itk_option(-title) 256} 257 258# ------------------------------------------------------------------ 259# OPTION: -helpdir 260# 261# Set location of help files 262# ------------------------------------------------------------------ 263itcl::configbody iwidgets::Hyperhelp::helpdir { 264 if {[file pathtype $itk_option(-helpdir)] == "relative"} { 265 configure -helpdir [file join [pwd] $itk_option(-helpdir)] 266 } else { 267 set _history {} 268 set _history_len 0 269 set _history_ndx -1 270 $itk_component(navmenu) entryconfig 0 -state disabled 271 $itk_component(navmenu) entryconfig 1 -state disabled 272 configure -topics $itk_option(-topics) 273 } 274} 275 276# ------------------------------------------------------------------ 277# OPTION: -closecmd 278# 279# Specify the command to execute when close is selected from the menu 280# ------------------------------------------------------------------ 281itcl::configbody iwidgets::Hyperhelp::closecmd { 282 $itk_component(topicmenu) entryconfigure last -command $itk_option(-closecmd) 283} 284 285# ------------------------------------------------------------------ 286# METHODS 287# ------------------------------------------------------------------ 288 289# ------------------------------------------------------------------ 290# METHOD: showtopic topic 291# 292# render text of help topic <topic>. The text is expected to be found in 293# <helpdir>/<topic>.html 294# ------------------------------------------------------------------ 295itcl::body iwidgets::Hyperhelp::showtopic {topic} { 296 if ![regexp {(.*)#(.*)} $topic dummy topicname anchorpart] { 297 set topicname $topic 298 set anchorpart {} 299 } 300 if {$topicname == ""} { 301 set topicname $_file 302 set filepath $_file 303 } else { 304 set filepath $itk_option(-helpdir)/$topicname.html 305 } 306 if {[incr _history_ndx] < $itk_option(-maxhistory)} { 307 set _history [lrange $_history 0 [expr {$_history_ndx - 1}]] 308 set _history_len [expr {$_history_ndx + 1}] 309 } else { 310 incr _history_ndx -1 311 set _history [lrange $_history 1 $_history_ndx] 312 set _history_len [expr {$_history_ndx + 1}] 313 } 314 lappend _history [list $topicname $filepath $anchorpart] 315 _readtopic $filepath $anchorpart 316} 317 318# ------------------------------------------------------------------ 319# METHOD: followlink link 320# 321# Callback for click on a link. Shows new topic. 322# ------------------------------------------------------------------ 323itcl::body iwidgets::Hyperhelp::followlink {link} { 324 if {[string compare $beforelink ""] != 0} { 325 eval $beforelink $link 326 } 327 if ![regexp {(.*)#(.*)} $link dummy filepart anchorpart] { 328 set filepart $link 329 set anchorpart {} 330 } 331 if {$filepart != "" && [string index [file dirname $filepart] 0] != "/" && \ 332 [string index [file dirname $filepart] 0] != "~"} { 333 set filepart [$itk_component(scrtxt) pwd]/$filepart 334 set hfile $filepart 335 } else { 336 set hfile $_file 337 } 338 incr _history_ndx 339 set _history [lrange $_history 0 [expr {$_history_ndx - 1}]] 340 set _history_len [expr {$_history_ndx + 1}] 341 lappend _history [list [file rootname [file tail $hfile]] $hfile $anchorpart] 342 set ret [_readtopic $filepart $anchorpart] 343 if {[string compare $afterlink ""] != 0} { 344 eval $afterlink $link 345 } 346 return $ret 347} 348 349# ------------------------------------------------------------------ 350# METHOD: forward 351# 352# Show topic one forward in history list 353# ------------------------------------------------------------------ 354itcl::body iwidgets::Hyperhelp::forward {} { 355 if {$_rendering || ($_history_ndx+1) >= $_history_len} return 356 incr _history_ndx 357 eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end] 358} 359 360# ------------------------------------------------------------------ 361# METHOD: back 362# 363# Show topic one back in history list 364# ------------------------------------------------------------------ 365itcl::body iwidgets::Hyperhelp::back {} { 366 if {$_rendering || $_history_ndx <= 0} return 367 incr _history_ndx -1 368 set _histdir 1 369 eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end] 370} 371 372# ------------------------------------------------------------------ 373# METHOD: updatefeedback remaining 374# 375# Callback from text to update feedback widget 376# ------------------------------------------------------------------ 377itcl::body iwidgets::Hyperhelp::updatefeedback {n} { 378 if {($_remaining - $n) > .1*$_len} { 379 [$itk_interior.feedbackshell childsite].helpfeedback step [expr {$_remaining - $n}] 380 update idletasks 381 set _remaining $n 382 } 383} 384 385# ------------------------------------------------------------------ 386# PRIVATE METHOD: _readtopic 387# 388# Read in file, render it in text area, and jump to anchorpoint 389# ------------------------------------------------------------------ 390itcl::body iwidgets::Hyperhelp::_readtopic {file {anchorpoint {}}} { 391 if {$file != ""} { 392 if {[string compare $file $_file] != 0} { 393 if {[catch {set f [open $file r]} err]} { 394 incr _history_ndx $_histdir 395 set _history_len [expr {$_history_ndx + 1}] 396 set _histdir -1 397 set m $itk_component(navmenu) 398 if {($_history_ndx+1) < $_history_len} { 399 $m entryconfig 0 -state normal 400 } else { 401 $m entryconfig 0 -state disabled 402 } 403 if {$_history_ndx > 0} { 404 $m entryconfig 1 -state normal 405 } else { 406 $m entryconfig 1 -state disabled 407 } 408 return 409 } 410 set _file $file 411 set txt [read $f] 412 iwidgets::shell $itk_interior.feedbackshell -title \ 413 "Rendering HTML" -padx 1 -pady 1 414 iwidgets::Feedback [$itk_interior.feedbackshell \ 415 childsite].helpfeedback \ 416 -steps [set _len [string length $txt]] \ 417 -labeltext "Rendering HTML" -labelpos n 418 pack [$itk_interior.feedbackshell childsite].helpfeedback 419 $itk_interior.feedbackshell center $itk_interior 420 $itk_interior.feedbackshell activate 421 set _remaining $_len 422 set _rendering 1 423 if {[catch {$itk_component(scrtxt) render $txt [file dirname \ 424 $file]} err]} { 425 if [regexp "</pre>" $err] { 426 $itk_component(scrtxt) render "<tt>$err</tt>" 427 } else { 428 $itk_component(scrtxt) render "<pre>$err</pre>" 429 } 430 } 431 wm title $itk_component(hull) "Help: $file" 432 itcl::delete object [$itk_interior.feedbackshell \ 433 childsite].helpfeedback 434 itcl::delete object $itk_interior.feedbackshell 435 set _rendering 0 436 } 437 } 438 set m $itk_component(navmenu) 439 if {($_history_ndx+1) < $_history_len} { 440 $m entryconfig 0 -state normal 441 } else { 442 $m entryconfig 0 -state disabled 443 } 444 if {$_history_ndx > 0} { 445 $m entryconfig 1 -state normal 446 } else { 447 $m entryconfig 1 -state disabled 448 } 449 if {$anchorpoint != {}} { 450 $itk_component(scrtxt) import -link #$anchorpoint 451 } else { 452 $itk_component(scrtxt) import -link # 453 } 454 set _histdir -1 455} 456 457# ------------------------------------------------------------------ 458# PRIVATE METHOD: _fill_go_menu 459# 460# update go submenu with current history 461# ------------------------------------------------------------------ 462itcl::body iwidgets::Hyperhelp::_fill_go_menu {} { 463 set m $itk_component(navgo) 464 catch {$m delete 0 last} 465 for {set i [expr {$_history_len - 1}]} {$i >= 0} {incr i -1} { 466 set topic [lindex [lindex $_history $i] 0] 467 set filepath [lindex [lindex $_history $i] 1] 468 set anchor [lindex [lindex $_history $i] 2] 469 $m add command -label $topic \ 470 -command [list $this followlink $filepath#$anchor] 471 } 472} 473 474# ------------------------------------------------------------------ 475# PRIVATE METHOD: _pageforward 476# 477# Callback for page forward shortcut key 478# ------------------------------------------------------------------ 479itcl::body iwidgets::Hyperhelp::_pageforward {} { 480 $itk_component(scrtxt) yview scroll 1 pages 481} 482 483# ------------------------------------------------------------------ 484# PRIVATE METHOD: _pageback 485# 486# Callback for page back shortcut key 487# ------------------------------------------------------------------ 488itcl::body iwidgets::Hyperhelp::_pageback {} { 489 $itk_component(scrtxt) yview scroll -1 pages 490} 491 492# ------------------------------------------------------------------ 493# PRIVATE METHOD: _lineforward 494# 495# Callback for line forward shortcut key 496# ------------------------------------------------------------------ 497itcl::body iwidgets::Hyperhelp::_lineforward {} { 498 $itk_component(scrtxt) yview scroll 1 units 499} 500 501# ------------------------------------------------------------------ 502# PRIVATE METHOD: _lineback 503# 504# Callback for line back shortcut key 505# ------------------------------------------------------------------ 506itcl::body iwidgets::Hyperhelp::_lineback {} { 507 $itk_component(scrtxt) yview scroll -1 units 508} 509