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