home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / hyperhelp.itk < prev    next >
Encoding:
Text File  |  2003-09-01  |  18.7 KB  |  509 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.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. #
  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. itcl::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. itcl::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. # ------------------------------------------------------------------
  222. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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. # ------------------------------------------------------------------
  462. itcl::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. # ------------------------------------------------------------------
  479. itcl::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. # ------------------------------------------------------------------
  488. itcl::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. # ------------------------------------------------------------------
  497. itcl::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. # ------------------------------------------------------------------
  506. itcl::body iwidgets::Hyperhelp::_lineback {} { 
  507.     $itk_component(scrtxt) yview scroll -1 units 
  508. }
  509.