home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets2.2.0 / scripts / hyperhelp.itk < prev    next >
Text File  |  1999-02-24  |  17KB  |  473 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.1 1998/07/27 18:49:31 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.  
  49. #
  50. # Usual options.
  51. #
  52. itk::usual Hyperhelp {
  53.     keep -activebackground -activerelief -background -borderwidth -cursor \
  54.          -foreground -highlightcolor -highlightthickness \
  55.          -selectbackground -selectborderwidth -selectforeground \
  56.          -textbackground
  57. }
  58.  
  59. # ------------------------------------------------------------------
  60. #                          HYPERHELP
  61. # ------------------------------------------------------------------
  62. class ::iwidgets::Hyperhelp {
  63.     inherit iwidgets::Shell
  64.  
  65.     constructor {args} {}
  66.  
  67.     itk_option define -topics topics Topics {}
  68.     itk_option define -helpdir helpdir Directory .
  69.     itk_option define -title title Title "Help"
  70.  
  71.     public method showtopic {topic}
  72.     public method followlink {link}
  73.     public method forward {}
  74.     public method back {}
  75.     public method updatefeedback {n max}
  76.  
  77.     protected method _readtopic {file {anchorpoint {}}}
  78.     protected method _pageforward {}
  79.     protected method _pageback {}
  80.     protected method _lineforward {}
  81.     protected method _lineback {}
  82.     protected method _fill_go_menu {}
  83.  
  84.     protected variable _history {}      ;# History list of viewed pages
  85.     protected variable _history_ndx -1  ;# current position in history list
  86.     protected variable _history_len 0   ;# length of history list
  87.     protected variable _histdir -1      ;# direction in history we just came 
  88.                                         ;# from
  89.     protected variable _len 0           ;# length of text to be rendered
  90.     protected variable _file {}         ;# current topic
  91.  
  92.     private variable _rendering 0       ;# flag - in process of rendering
  93. }
  94.  
  95. #
  96. # Provide a lowercased access method for the Scrolledlistbox class.
  97. #
  98. proc ::iwidgets::hyperhelp {pathName args} {
  99.     uplevel ::iwidgets::Hyperhelp $pathName $args
  100. }
  101.  
  102. # ------------------------------------------------------------------
  103. #                        CONSTRUCTOR
  104. # ------------------------------------------------------------------
  105. body ::iwidgets::Hyperhelp::constructor {args} {
  106.     itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady
  107.  
  108.     #
  109.     # Create a pulldown menu
  110.     #
  111.     itk_component add menubar {
  112.       frame $itk_interior.menu -relief raised -bd 2
  113.     } {
  114.       keep -background -cursor
  115.     }
  116.     pack $itk_component(menubar) -side top -fill x
  117.  
  118.     itk_component add topicmb {
  119.       menubutton $itk_component(menubar).topicmb -text "Topics" \
  120.            -menu $itk_component(menubar).topicmb.topicmenu \
  121.            -underline 0 -padx 8 -pady 2
  122.     } {
  123.       keep -background -cursor -font -foreground \
  124.               -activebackground -activeforeground
  125.     }
  126.     pack $itk_component(topicmb) -side left
  127.  
  128.     itk_component add topicmenu {
  129.       menu $itk_component(topicmb).topicmenu -tearoff no
  130.     } {
  131.       keep -background -cursor -font -foreground \
  132.               -activebackground -activeforeground
  133.     }
  134.  
  135.     itk_component add navmb {
  136.       menubutton $itk_component(menubar).navmb -text "Navigate" \
  137.           -menu $itk_component(menubar).navmb.navmenu \
  138.           -underline 0 -padx 8 -pady 2
  139.     } {
  140.       keep -background -cursor -font -foreground \
  141.              -activebackground -activeforeground
  142.     }
  143.     pack $itk_component(navmb) -side left
  144.  
  145.     itk_component add navmenu {
  146.       menu $itk_component(navmb).navmenu -tearoff no
  147.     } {
  148.       keep -background -cursor -font -foreground \
  149.               -activebackground -activeforeground
  150.     }
  151.     set m $itk_component(navmenu)
  152.     $m add command -label "Forward" -underline 0 -state disabled \
  153.          -command [code $this forward] -accelerator f
  154.     $m add command -label "Back" -underline 0 -state disabled \
  155.          -command [code $this back] -accelerator b
  156.     $m add cascade -label "Go" -underline 0 -menu $m.go
  157.  
  158.     itk_component add navgo {
  159.       menu $itk_component(navmenu).go -postcommand [code $this _fill_go_menu]
  160.     } {
  161.       keep -background -cursor -font -foreground \
  162.               -activebackground -activeforeground
  163.     }
  164.  
  165.     #
  166.     # Create a scrolledhtml object to display help pages
  167.     #
  168.     itk_component add scrtxt {
  169.       iwidgets::scrolledhtml $itk_interior.scrtxt \
  170.            -linkcommand [code $this followlink] \
  171.            -feedback [code $this updatefeedback]
  172.     } {
  173.         keep    -hscrollmode -vscrollmode -background -textbackground \
  174.                 -fontname -fontsize -fixedfont -link \
  175.                 -linkhighlight -borderwidth -cursor -sbwidth -scrollmargin \
  176.                 -width -height -foreground -highlightcolor -visibleitems \
  177.                 -highlightthickness -padx -pady -activerelief \
  178.                 -relief -selectbackground -selectborderwidth \
  179.                 -selectforeground -setgrid -wrap -unknownimage
  180.     }
  181.     pack $itk_component(scrtxt) -fill both -expand yes
  182.  
  183.     #
  184.     # Bind shortcut keys
  185.     #
  186.     bind $itk_component(hull) <Key-f> "$this forward"
  187.     bind $itk_component(hull) <Key-b> "$this back"
  188.     bind $itk_component(hull) <Alt-Right> "$this forward"
  189.     bind $itk_component(hull) <Alt-Left> "$this back"
  190.     bind $itk_component(hull) <Key-space> [code $this _pageforward]
  191.     bind $itk_component(hull) <Key-Next> [code $this _pageforward]
  192.     bind $itk_component(hull) <Key-BackSpace> [code $this _pageback]
  193.     bind $itk_component(hull) <Key-Prior> [code $this _pageback]
  194.     bind $itk_component(hull) <Key-Delete> [code $this _pageback]
  195.     bind $itk_component(hull) <Key-Down> [code $this _lineforward]
  196.     bind $itk_component(hull) <Key-Up> [code $this _lineback]
  197.  
  198.     wm title $itk_component(hull) "Help"
  199.  
  200.     eval itk_initialize $args
  201. }
  202.  
  203. # ------------------------------------------------------------------
  204. #                             OPTIONS
  205. # ------------------------------------------------------------------
  206.  
  207. # ------------------------------------------------------------------
  208. # OPTION: -topics
  209. #
  210. # Specifies the topics to display on the menu. For each topic, there should
  211. # be a file named <helpdir>/<topic>.html
  212. # ------------------------------------------------------------------
  213. configbody iwidgets::Hyperhelp::topics {
  214.     set m $itk_component(topicmenu)
  215.     $m delete 0 last
  216.     foreach topic $itk_option(-topics) {
  217.       if {[lindex $topic 1] == {} } {
  218.         $m add radiobutton -variable topic \
  219.           -value $topic \
  220.           -label $topic \
  221.           -command [list $this showtopic $topic]
  222.       } else {
  223.         if {[file pathtype $itk_option(-helpdir)] == "relative" } {
  224.           set link [file join $itk_option(-helpdir) [lindex $topic 1]]
  225.         } else {
  226.           set link [lindex $topic 1]
  227.         }
  228.         $m add radiobutton -variable topic \
  229.           -value [lindex $topic 0] \
  230.           -label [lindex $topic 0] \
  231.           -command [list $this followlink $link]
  232.       }
  233.     }
  234.     $m add separator
  235.     $m add command -label "Close Help" -underline 0 \
  236.       -command "delete object $this"
  237. }
  238.  
  239. # ------------------------------------------------------------------
  240. # OPTION: -title
  241. #
  242. # Specify the window title.
  243. # ------------------------------------------------------------------
  244. configbody iwidgets::Hyperhelp::title {
  245.     wm title $itk_component(hull) $itk_option(-title)
  246. }
  247.  
  248. # ------------------------------------------------------------------
  249. # OPTION: -helpdir
  250. #
  251. # Set location of help files
  252. # ------------------------------------------------------------------
  253. configbody iwidgets::Hyperhelp::helpdir {
  254.     if {[file pathtype $itk_option(-helpdir)] == "relative" } {
  255.         set $itk_option(-helpdir) [file join [pwd] $itk_option(-helpdir)]
  256.     }
  257.     set _history {}
  258.     set _history_len 0
  259.     set _history_ndx -1
  260.     $itk_component(navmenu) entryconfig 0 -state disabled
  261.     $itk_component(navmenu) entryconfig 1 -state disabled
  262.     configure -topics $itk_option(-topics)
  263.    
  264. }
  265.  
  266. # ------------------------------------------------------------------
  267. #                            METHODS
  268. # ------------------------------------------------------------------
  269.  
  270. # ------------------------------------------------------------------
  271. # METHOD: showtopic topic
  272. #
  273. # render text of help topic <topic>. The text is expected to be found in
  274. # <helpdir>/<topic>.html
  275. # ------------------------------------------------------------------
  276. body iwidgets::Hyperhelp::showtopic {topic} {
  277.   if ![regexp {(.*)#(.*)} $topic dummy topicname anchorpart] {
  278.     set topicname $topic
  279.     set anchorpart {}
  280.   }
  281.   if {$topicname == ""} {
  282.     set topicname $_file
  283.     set filepath $_file
  284.   } else {
  285.     set filepath [file join $itk_option(-helpdir) $topicname.html]
  286.   }
  287.   incr _history_ndx
  288.   set _history [lrange $_history 0 [expr $_history_ndx - 1]]
  289.   set _history_len [expr $_history_ndx + 1]
  290.   lappend _history [list $topicname $filepath $anchorpart]
  291.   _readtopic $filepath $anchorpart
  292. }
  293.  
  294. # ------------------------------------------------------------------
  295. # METHOD: followlink link
  296. #
  297. # Callback for click on a link. Shows new topic.
  298. # ------------------------------------------------------------------
  299. body iwidgets::Hyperhelp::followlink {link} {
  300.   if ![regexp {(.*)#(.*)} $link dummy filepart anchorpart] {
  301.     set filepart $link
  302.     set anchorpart {}
  303.   }
  304.   if {$filepart != "" && [file pathtype $filepart] == "relative"} {
  305.     set filepart [file join [$itk_component(scrtxt) pwd] $filepart]
  306.     set hfile $filepart
  307.   } else {
  308.     set hfile $_file
  309.   }
  310.   incr _history_ndx
  311.   set _history [lrange $_history 0 [expr $_history_ndx - 1]]
  312.   set _history_len [expr $_history_ndx + 1]
  313.   lappend _history [list [file rootname [file tail $hfile]] $hfile $anchorpart]
  314.   _readtopic $filepart $anchorpart
  315. }
  316.  
  317. # ------------------------------------------------------------------
  318. # METHOD: forward
  319. #
  320. # Show topic one forward in history list
  321. # ------------------------------------------------------------------
  322. body iwidgets::Hyperhelp::forward {} {
  323.     if {$_rendering || ($_history_ndx+1) >= $_history_len} return
  324.     incr _history_ndx
  325.     eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
  326. }
  327.  
  328. # ------------------------------------------------------------------
  329. # METHOD: back
  330. #
  331. # Show topic one back in history list
  332. # ------------------------------------------------------------------
  333. body iwidgets::Hyperhelp::back {} {
  334.     if {$_rendering || $_history_ndx <= 0} return
  335.     incr _history_ndx -1
  336.     set _histdir 1
  337.     eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
  338. }
  339.  
  340. # ------------------------------------------------------------------
  341. # METHOD: updatefeedback remaining
  342. #
  343. # Callback from text to update feedback widget
  344. # ------------------------------------------------------------------
  345. body iwidgets::Hyperhelp::updatefeedback {n max} {
  346.     set win "[$itk_interior.feedbackshell childsite].helpfeedback"
  347.     $win configure -steps $max
  348.     $win step $n
  349.     update idletasks
  350. }
  351.  
  352. # ------------------------------------------------------------------
  353. # PRIVATE METHOD: _readtopic 
  354. #
  355. # Read in file, render it in text area, and jump to anchorpoint
  356. # ------------------------------------------------------------------
  357. body iwidgets::Hyperhelp::_readtopic {file {anchorpoint {}}} {
  358.   if {$file != ""} {
  359.     if {[string compare $file $_file] != 0} {
  360.       if {[catch {set f [open $file r]} err]} {
  361.         incr _history_ndx $_histdir
  362.         set _history_len [expr $_history_ndx + 1]
  363.         set _histdir -1
  364.         set m $itk_component(navmenu)
  365.         if {($_history_ndx+1) < $_history_len} {
  366.           $m entryconfig 0 -state normal
  367.         } else {
  368.           $m entryconfig 0 -state disabled
  369.         }
  370.         if {$_history_ndx > 0} {
  371.           $m entryconfig 1 -state normal
  372.         } else {
  373.           $m entryconfig 1 -state disabled
  374.         }
  375.         error $err
  376.       }
  377.       set _file $file
  378.       set txt [read $f]
  379.       iwidgets::shell $itk_interior.feedbackshell \
  380.           -title "Rendering HTML" -padx 1 -pady 1
  381.       iwidgets::Feedback [$itk_interior.feedbackshell childsite].helpfeedback \
  382.           -steps [set _len [string length $txt]] \
  383.           -labeltext "Rendering HTML" -labelpos n
  384.       pack [$itk_interior.feedbackshell childsite].helpfeedback
  385.       $itk_interior.feedbackshell center $itk_interior
  386.       $itk_interior.feedbackshell activate
  387.       set _remaining $_len
  388.       set _rendering 1
  389.       if [catch {$itk_component(scrtxt) render $txt [file dirname $file]} err] {
  390.           if [regexp "</pre>" $err] {
  391.             $itk_component(scrtxt) render "<tt>$err</tt>"
  392.           } else {
  393.             $itk_component(scrtxt) render "<pre>$err</pre>"
  394.           }
  395.       }
  396.       wm title $itk_component(hull) "Help: $file"
  397.       delete object [$itk_interior.feedbackshell childsite].helpfeedback
  398.       delete object $itk_interior.feedbackshell
  399.       set _rendering 0
  400.     }
  401.   }
  402.   set m $itk_component(navmenu)
  403.   if {($_history_ndx+1) < $_history_len} {
  404.     $m entryconfig 0 -state normal
  405.   } else {
  406.     $m entryconfig 0 -state disabled
  407.   }
  408.   if {$_history_ndx > 0} {
  409.     $m entryconfig 1 -state normal
  410.   } else {
  411.     $m entryconfig 1 -state disabled
  412.   }
  413.   if {$anchorpoint != "{}"} {
  414.     $itk_component(scrtxt) import -link #$anchorpoint
  415.   } else {
  416.     $itk_component(scrtxt) import -link #
  417.   }
  418.   set _histdir -1
  419. }
  420.  
  421. # ------------------------------------------------------------------
  422. # PRIVATE METHOD: _fill_go_menu
  423. #
  424. # update go submenu with current history
  425. # ------------------------------------------------------------------
  426. body ::iwidgets::Hyperhelp::_fill_go_menu {} {
  427.     set m $itk_component(navgo)
  428.     catch {$m delete 0 last}
  429.     for {set i [expr $_history_len - 1]} {$i >= 0} {incr i -1} {
  430.       set topic [lindex [lindex $_history $i] 0]
  431.       set filepath [lindex [lindex $_history $i] 1]
  432.       set anchor [lindex [lindex $_history $i] 2]
  433.       $m add command -label $topic \
  434.          -command [list $this followlink $filepath#$anchor]
  435.     }
  436. }
  437.  
  438. # ------------------------------------------------------------------
  439. # PRIVATE METHOD: _pageforward
  440. #
  441. # Callback for page forward shortcut key
  442. # ------------------------------------------------------------------
  443. body iwidgets::Hyperhelp::_pageforward {} {
  444.     $itk_component(scrtxt) yview scroll 1 pages
  445. }
  446.  
  447. # ------------------------------------------------------------------
  448. # PRIVATE METHOD: _pageback
  449. #
  450. # Callback for page back shortcut key
  451. # ------------------------------------------------------------------
  452. body iwidgets::Hyperhelp::_pageback {} {
  453.     $itk_component(scrtxt) yview scroll -1 pages
  454. }
  455.  
  456. # ------------------------------------------------------------------
  457. # PRIVATE METHOD: _lineforward
  458. #
  459. # Callback for line forward shortcut key
  460. # ------------------------------------------------------------------
  461. body iwidgets::Hyperhelp::_lineforward {} { 
  462.     $itk_component(scrtxt) yview scroll 1 units 
  463. }
  464.  
  465. # ------------------------------------------------------------------
  466. # PRIVATE METHOD: _lineback
  467. #
  468. # Callback for line back shortcut key
  469. # ------------------------------------------------------------------
  470. body iwidgets::Hyperhelp::_lineback {} { 
  471.     $itk_component(scrtxt) yview scroll -1 units 
  472. }
  473.