home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_30.z / tclx7_30 / usr / X386 / bin / tclhelp next >
Encoding:
Tcl/Tk script  |  1994-02-08  |  9.4 KB  |  316 lines
  1. #!/usr/bin/wishx -f
  2.  
  3. # tclhelp.tcl --
  4. #
  5. # Tk program to access Extended Tcl & Tk help pages.  Uses internal functions
  6. # of TclX help command.
  7. # 
  8. #------------------------------------------------------------------------------
  9. # Copyright 1993 Karl Lehenbauer and Mark Diekhans.
  10. #
  11. # Permission to use, copy, modify, and distribute this software and its
  12. # documentation for any purpose and without fee is hereby granted, provided
  13. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14. # Mark Diekhans make no representations about the suitability of this
  15. # software for any purpose.  It is provided "as is" without express or
  16. # implied warranty.
  17. #------------------------------------------------------------------------------
  18. # $Id: tclhelp.tcl,v 3.2 1994/01/11 05:18:48 markd Exp $
  19. #------------------------------------------------------------------------------
  20.  
  21. #------------------------------------------------------------------------------
  22. # Add a button associated with either a file or directory in the help tree.
  23. # This handles creating frames to hold each row of buttons.  Buttons should
  24. # be delivered in accending row order, and accending column order within each
  25. # row.  Special handling is done for '..'/
  26.  
  27. proc AddButton {parent subject fileName row col} {
  28.  
  29.     # Prep name to use in button and other file info.
  30.  
  31.     set isDir [string match */ $fileName]
  32.     if [string match */ $subject] {
  33.         set subject [csubstr $subject 0 len-1]
  34.     }
  35.     if {$fileName == ".."} {
  36.         set fileName "<Up>"
  37.         set filePath [file dirname $subject]
  38.         set isDir 1
  39.     } else {
  40.         set filePath ${subject}/${fileName}
  41.     }
  42.  
  43.     # Set up a row frame, if needed.
  44.  
  45.     set nframe $parent.row$row
  46.     if {$col == 0} {
  47.         frame $nframe
  48.         pack $nframe -side top -expand 1 -anchor w -fill x
  49.     }
  50.  
  51.     # Set up the button.
  52.  
  53.     set buttonName $nframe.col$col
  54.     if $isDir {
  55.         button $buttonName -text $fileName -width 20 \
  56.             -command "DisplaySubject $filePath"
  57.     } else {
  58.         button $buttonName -text $fileName -width 20 \
  59.             -command "DisplayPage $filePath"
  60.     }
  61.     pack $buttonName -side left -anchor w
  62. }
  63.  
  64. #------------------------------------------------------------------------------
  65. # Create a frame to hold buttons for the specified list of either help files
  66. # or directories.
  67.  
  68. proc ButtonFrame {w title subject fileList} {
  69.     frame $w
  70.     label $w.label -relief flat -text $title -background SlateGray1
  71.     pack $w.label -side top -fill both
  72.     frame $w.buttons
  73.     pack $w.buttons -side top -expand 1 -anchor w
  74.     set col 0
  75.     set row 0
  76.     while {![lempty $fileList]} {
  77.         AddButton $w.buttons $subject [lvarpop fileList] $row $col
  78.         if {[incr col] >= 5} {
  79.             incr row
  80.             set col 0
  81.         }
  82.     }
  83. }
  84.  
  85. #------------------------------------------------------------------------------
  86. # Display the panels contain the subjects (directories) and the help files for
  87. # a given directory.
  88.  
  89. proc DisplaySubject {subject} {
  90.  
  91.     help:ListSubject $subject [help:ConvertPath $subject] subjects pages
  92.     if {$subject != "/"} {
  93.         lvarpush subjects ".."
  94.     }
  95.  
  96.     set frame .tkhelp.pick
  97.     catch {destroy $frame}
  98.     frame $frame
  99.     pack $frame -side top -fill x
  100.     
  101.     ButtonFrame $frame.subjects "Subjects available in $subject" \
  102.         $subject $subjects
  103.     pack $frame.subjects -side top -fill x
  104.  
  105.     ButtonFrame $frame.pages "Help files available in $subject" \
  106.         $subject $pages
  107.     pack $frame.pages -side top -fill x
  108. }
  109.  
  110. #------------------------------------------------------------------------------
  111. # Display a file in a top-level text window.
  112.  
  113. proc DisplayPage {page} {
  114.     set fileName [file tail $page]
  115.  
  116.     set w ".tkhelp-[translit "." "_" $page]"
  117.  
  118.     catch {destroy $w}
  119.     toplevel $w
  120.  
  121.     wm title $w "Help on '$page'"
  122.     wm iconname $w "Help: $page"
  123.     wm minsize $w 1 1
  124.     frame $w.frame -borderwidth 10
  125.  
  126.     scrollbar $w.frame.yscroll -relief sunken \
  127.         -command "$w.frame.page yview"
  128.     text $w.frame.page -yscroll "$w.frame.yscroll set" \
  129.         -width 80 -height 20 -relief sunken -wrap word
  130.     pack $w.frame.yscroll -side right -fill y
  131.     pack $w.frame.page -side top -expand 1 -fill both
  132.  
  133.     if [catch {
  134.             set contents [read_file [help:ConvertPath $page]]
  135.         } msg] {
  136.         set contents $msg
  137.     }
  138.     $w.frame.page insert 0.0 $contents
  139.     $w.frame.page configure -state disabled
  140.  
  141.     button $w.dismiss -text Dismiss -command "destroy $w"
  142.     pack $w.frame -side top -fill both -expand 1
  143.     pack $w.dismiss -side bottom -fill x
  144. }
  145.  
  146. #------------------------------------------------------------------------------
  147. # Set up the apropos panel.
  148.  
  149. proc AproposPanel {} {
  150.     global aproposEntryNumber aproposReferenceFrame referenceFrameItem
  151.  
  152.     set aproposEntryNumber 0
  153.     catch {destory .apropos}
  154.     toplevel .apropos
  155.     wm minsize .apropos 1 1
  156.     frame .apropos.entryFrame
  157.     pack .apropos.entryFrame -side top -fill x
  158.  
  159.     label .apropos.entryFrame.label -text "Search for"
  160.     pack .apropos.entryFrame.label -side left
  161.  
  162.     entry .apropos.entryFrame.entry -relief sunken
  163.     pack .apropos.entryFrame.entry -side left -fill x -expand 1
  164.  
  165.     bind .apropos.entryFrame.entry <Return> PerformAproposSearch
  166.  
  167.     frame .apropos.canvasFrame
  168.     set w .apropos.canvasFrame
  169.  
  170.     canvas $w.canvas -yscroll "$w.yscroll set" -xscroll "$w.xscroll set" \
  171.         -width 15c -height 5c -relief sunken
  172.  
  173.     scrollbar $w.yscroll -relief sunken \
  174.         -command "$w.canvas yview"
  175.  
  176.     scrollbar $w.xscroll -relief sunken -orient horiz \
  177.         -command "$w.canvas xview"
  178.  
  179.     pack $w.xscroll -side bottom -fill x
  180.     pack $w.yscroll -side right -fill y
  181.     pack $w.canvas -in $w -expand yes -fill both
  182.     pack $w -side top -expand yes -fill both
  183.  
  184.     # put in the dismiss button
  185.     set w .apropos.buttonFrame
  186.     frame $w
  187.     pack $w -side top -fill x
  188.     button $w.dismiss -text Dismiss -command "destroy .apropos"
  189.     pack $w.dismiss -side bottom -fill x
  190. }
  191.  
  192. #---------------------------------------------------------------------------
  193. #put a line in the reference display for this apropos entry we've discovered
  194. #
  195. proc DisplayAproposReference {path description} {
  196.     global aproposEntryNumber aproposReferenceFrame
  197.  
  198.     set frame $aproposReferenceFrame.e$aproposEntryNumber
  199.     frame $frame
  200.     pack $frame -side top -anchor w
  201.  
  202.     button $frame.button -text $path -width 30 \
  203.         -command "DisplayPage /$path"
  204.     pack $frame.button -side left
  205.  
  206.     label $frame.label -text $description
  207.     pack $frame.label -side left
  208.  
  209.     incr aproposEntryNumber
  210. }
  211.  
  212. #---------------------------------------------------------------------------
  213. #the actual search is cadged from "apropos" in the tclx help system
  214. #
  215. proc PerformAproposSearch {} {
  216.     global TCLXENV referenceFrameItem aproposEntryNumber aproposReferenceFrame
  217.  
  218.     #  start variables and clean up any residue from previous searches
  219.     set w .apropos.canvasFrame
  220.     set aproposEntryNumber 0
  221.     .apropos.canvasFrame.canvas delete all
  222.     set aproposReferenceFrame $w.canvas.frame
  223.     catch "destroy $aproposReferenceFrame"
  224.     catch "destroy .apropos.canvasFrame.failed"
  225.  
  226.     # create the frame we'll pack matches into and put it into the canvas
  227.     frame $aproposReferenceFrame
  228.     set referenceFrameItem \
  229.         [$w.canvas create window 2 2 -window $aproposReferenceFrame -anchor nw]
  230.  
  231.     set regexp [.apropos.entryFrame.entry get]
  232.     focus none
  233.  
  234.     set TCLXENV(help:lineCnt) 0
  235.  
  236.     # set up scan context
  237.     set ch [scancontext create]
  238.     scanmatch -nocase $ch $regexp {
  239.         set path [lindex $matchInfo(line) 0]
  240.         set desc [lrange $matchInfo(line) 1 end]
  241.         DisplayAproposReference $path $desc
  242.     }
  243.  
  244.     # perform search
  245.     foreach dir [help:RootDirs] {
  246.         foreach brief [glob -nocomplain $dir/*.brf] {
  247.             set briefFH [open $brief]
  248.             scanfile $ch $briefFH
  249.             close $briefFH
  250.         }
  251.     }
  252.  
  253.     # delete scan context
  254.     scancontext delete $ch
  255.  
  256.     # force display to update so we can find out our bounding box
  257.     update
  258.  
  259.     # if nothing matched, complain
  260.     if {$aproposEntryNumber == 0} {
  261.         label $aproposReferenceFrame.failed -text "NOTHING MATCHED."
  262.         pack $aproposReferenceFrame.failed -side left
  263.     }
  264.  
  265.     # set the canvas scrollregion to the size of the bounding box
  266.     lassign [.apropos.canvasFrame.canvas bbox $referenceFrameItem] \
  267.         dummy dummy xSize ySize
  268.     .apropos.canvasFrame.canvas configure -scrollregion \
  269.     "0 0 $xSize $ySize"
  270. }
  271.  
  272. #------------------------------------------------------------------------------
  273. # Set up the command buttons.
  274.  
  275. proc CreateCommandButtons {frameName} {
  276.     frame $frameName
  277.  
  278.     button $frameName.quit -text "Quit" -command exit
  279.     pack $frameName.quit -side left
  280.  
  281.     button $frameName.apropos -text "Apropos" -command AproposPanel
  282.     pack $frameName.apropos -side left
  283. }
  284.  
  285. #------------------------------------------------------------------------------
  286. # Tk base help command for Tcl/Tk/TclX.  Directories in args are pushed on the
  287. # path so that they are included in help search.
  288.  
  289. proc tkhelp addPaths {
  290.     global auto_path
  291.     if ![auto_load help] {
  292.         puts stderr "couldn't auto_load TclX 'help' command"
  293.         exit 255
  294.     }
  295.     foreach dir $addPaths {
  296.         lvarpush auto_path $dir
  297.     }
  298.     CreateCommandButtons .command
  299.     pack .command -side top -fill x
  300.  
  301.     catch {destroy .tkhelp}
  302.     frame .tkhelp
  303.     pack .tkhelp -side top -fill both
  304.  
  305.     DisplaySubject "/"
  306.  
  307. }
  308.  
  309. if !$tcl_interactive {
  310.     if [catch {
  311.         tkhelp $argv
  312.     } msg] {
  313.         tkerror $msg
  314.     }
  315. }
  316.