home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets3.0.0 / scripts / hyperhelp.itk < prev    next >
Text File  |  1999-02-24  |  19KB  |  505 lines
  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.2 1998/08/24 18:35:11 stanton 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. #
  43. option add *Hyperhelp.width 575 widgetDefault
  44. option add *Hyperhelp.height 450 widgetDefault
  45. option add *Hyperhelp.modality none widgetDefault
  46. option add *Hyperhelp.vscrollMode static widgetDefault
  47. option add *Hyperhelp.hscrollMode static widgetDefault
  48. option add *Hyperhelp.maxHistory 20 widgetDefault
  49.  
  50. #
  51. # Usual options.
  52. #
  53. itk::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. # ------------------------------------------------------------------
  63. 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. #
  105. proc ::iwidgets::hyperhelp {pathName args} {
  106.     uplevel ::iwidgets::Hyperhelp $pathName $args
  107. }
  108.  
  109. # ------------------------------------------------------------------
  110. #                        CONSTRUCTOR
  111. # ------------------------------------------------------------------
  112. 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 [code $this forward] -accelerator f
  161.     $m add command -label "Back" -underline 0 -state disabled \
  162.          -command [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 [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> [code $this forward]
  193.     bind $itk_component(hull) <Key-b> [code $this back]
  194.     bind $itk_component(hull) <Alt-Right> [code $this forward]
  195.     bind $itk_component(hull) <Alt-Left> [code $this back]
  196.     bind $itk_component(hull) <Key-space> [code $this _pageforward]
  197.     bind $itk_component(hull) <Key-Next> [code $this _pageforward]
  198.     bind $itk_component(hull) <Key-BackSpace> [code $this _pageback]
  199.     bind $itk_component(hull) <Key-Prior> [code $this _pageback]
  200.     bind $itk_component(hull) <Key-Delete> [code $this _pageback]
  201.     bind $itk_component(hull) <Key-Down> [code $this _lineforward]
  202.     bind $itk_component(hull) <Key-Up> [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 [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. # ------------------------------------------------------------------
  222. 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. # ------------------------------------------------------------------
  254. 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. # ------------------------------------------------------------------
  263. 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. # ------------------------------------------------------------------
  281. 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. # ------------------------------------------------------------------
  295. 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. # ------------------------------------------------------------------
  323. 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. # ------------------------------------------------------------------
  354. 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. # ------------------------------------------------------------------
  365. 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. # ------------------------------------------------------------------
  377. 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. # ------------------------------------------------------------------
  390. 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.         error $err
  409.       }
  410.       set _file $file
  411.       set txt [read $f]
  412.       iwidgets::shell $itk_interior.feedbackshell -title "Rendering HTML" -padx 1 -pady 1
  413.       iwidgets::Feedback [$itk_interior.feedbackshell childsite].helpfeedback \
  414.           -steps [set _len [string length $txt]] \
  415.           -labeltext "Rendering HTML" -labelpos n
  416.       pack [$itk_interior.feedbackshell childsite].helpfeedback
  417.       $itk_interior.feedbackshell center $itk_interior
  418.       $itk_interior.feedbackshell activate
  419.       set _remaining $_len
  420.       set _rendering 1
  421.       if [catch {$itk_component(scrtxt) render $txt [file dirname $file]} err] {
  422.           if [regexp "</pre>" $err] {
  423.             $itk_component(scrtxt) render "<tt>$err</tt>"
  424.           } else {
  425.             $itk_component(scrtxt) render "<pre>$err</pre>"
  426.           }
  427.       }
  428.       wm title $itk_component(hull) "Help: $file"
  429.       delete object [$itk_interior.feedbackshell childsite].helpfeedback
  430.       delete object $itk_interior.feedbackshell
  431.       set _rendering 0
  432.     }
  433.   }
  434.   set m $itk_component(navmenu)
  435.   if {($_history_ndx+1) < $_history_len} {
  436.     $m entryconfig 0 -state normal
  437.   } else {
  438.     $m entryconfig 0 -state disabled
  439.   }
  440.   if {$_history_ndx > 0} {
  441.     $m entryconfig 1 -state normal
  442.   } else {
  443.     $m entryconfig 1 -state disabled
  444.   }
  445.   if {$anchorpoint != "{}"} {
  446.     $itk_component(scrtxt) import -link #$anchorpoint
  447.   } else {
  448.     $itk_component(scrtxt) import -link #
  449.   }
  450.   set _histdir -1
  451. }
  452.  
  453. # ------------------------------------------------------------------
  454. # PRIVATE METHOD: _fill_go_menu
  455. #
  456. # update go submenu with current history
  457. # ------------------------------------------------------------------
  458. body iwidgets::Hyperhelp::_fill_go_menu {} {
  459.     set m $itk_component(navgo)
  460.     catch {$m delete 0 last}
  461.     for {set i [expr $_history_len - 1]} {$i >= 0} {incr i -1} {
  462.       set topic [lindex [lindex $_history $i] 0]
  463.       set filepath [lindex [lindex $_history $i] 1]
  464.       set anchor [lindex [lindex $_history $i] 2]
  465.       $m add command -label $topic \
  466.          -command [list $this followlink $filepath#$anchor]
  467.     }
  468. }
  469.  
  470. # ------------------------------------------------------------------
  471. # PRIVATE METHOD: _pageforward
  472. #
  473. # Callback for page forward shortcut key
  474. # ------------------------------------------------------------------
  475. body iwidgets::Hyperhelp::_pageforward {} {
  476.     $itk_component(scrtxt) yview scroll 1 pages
  477. }
  478.  
  479. # ------------------------------------------------------------------
  480. # PRIVATE METHOD: _pageback
  481. #
  482. # Callback for page back shortcut key
  483. # ------------------------------------------------------------------
  484. body iwidgets::Hyperhelp::_pageback {} {
  485.     $itk_component(scrtxt) yview scroll -1 pages
  486. }
  487.  
  488. # ------------------------------------------------------------------
  489. # PRIVATE METHOD: _lineforward
  490. #
  491. # Callback for line forward shortcut key
  492. # ------------------------------------------------------------------
  493. body iwidgets::Hyperhelp::_lineforward {} { 
  494.     $itk_component(scrtxt) yview scroll 1 units 
  495. }
  496.  
  497. # ------------------------------------------------------------------
  498. # PRIVATE METHOD: _lineback
  499. #
  500. # Callback for line back shortcut key
  501. # ------------------------------------------------------------------
  502. body iwidgets::Hyperhelp::_lineback {} { 
  503.     $itk_component(scrtxt) yview scroll -1 units 
  504. }
  505.