home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tclsrc / buildhelp.tcl < prev    next >
Encoding:
Text File  |  1993-11-19  |  15.5 KB  |  513 lines
  1. #
  2. # buildhelp.tcl --
  3. #
  4. # Program to extract help files from TCL manual pages or TCL script files.
  5. # The help directories are built as a hierarchical tree of subjects and help
  6. # files.  
  7. # 
  8. #------------------------------------------------------------------------------
  9. # Copyright 1992-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: buildhelp.tcl,v 3.0 1993/11/19 07:00:46 markd Rel $
  19. #------------------------------------------------------------------------------
  20. #
  21. # For nroff man pages, the areas of text to extract are delimited with:
  22. #
  23. #     '\"@help: subjectdir/helpfile
  24. #     '\"@endhelp
  25. #
  26. # start in column one. The text between these markers is extracted and stored
  27. # in help/subjectdir/help.  The file must not exists, this is done to enforced 
  28. # cleaning out the directories before help file generation is started, thus
  29. # removing any stale files.  The extracted text is run through:
  30. #
  31. #     nroff -man|col -xb   {col -b on BSD derived systems}
  32. #
  33. # If there is other text to include in the helpfile, but not in the manual 
  34. # page, the text, along with nroff formatting commands, may be included using:
  35. #
  36. #     '\"@:Other text to include in the help page.
  37. #
  38. # A entry in the brief file, used by apropos my be included by:
  39. #
  40. #     '\"@brief: Short, one line description
  41. #
  42. # These brief request must occur with in the bounds of a help section.
  43. #
  44. # If some header text, such as nroff macros, need to be preappended to the
  45. # text streem before it is run through nroff, then that text can be bracketed
  46. # with:
  47. #
  48. #     '\"@header
  49. #     '\"@endheader
  50. #
  51. # If multiple header blocks are encountered, they will all be preappended.
  52. #
  53. # For TCL script files, which are indentified because they end in ".tcl",
  54. # the text to be extracted is delimited by:
  55. #
  56. #    #@help: subjectdir/helpfile
  57. #    #@endhelp
  58. #
  59. # And brief lines are in the form:
  60. #
  61. #     #@brief: Short, one line description
  62. #
  63. # The only processing done on text extracted from .tcl files it to replace
  64. # the # in column one with a space.
  65. #
  66. #
  67. #-----------------------------------------------------------------------------
  68. # 
  69. # To generate help:
  70. #
  71. #   buildhelp helpDir brief.brf filelist
  72. #
  73. # o helpDir is the help tree root directory.  helpDir should  exists, but any
  74. #   subdirectories that don't exists will be created.  helpDir should be
  75. #   cleaned up before the start of manual page generation, as this program
  76. #   will not overwrite existing files.
  77. # o brief.brf  is the name of the brief file to create form the @brief entries.
  78. #   It must have an extension of ".brf".  It will be created in helpDir.
  79. # o filelist are the nroff manual pages, or .tcl, .tlib files to extract
  80. #   the help files from. If the suffix is not .tcl or .tlib, a nroff manual
  81. #   page is assumed.
  82. #
  83. #-----------------------------------------------------------------------------
  84.  
  85. #@package: TclX-buildhelp buildhelp
  86.  
  87. #-----------------------------------------------------------------------------
  88. # Truncate a file name of a help file if the system does not support long
  89. # file names.  If the name starts with `Tcl_', then this prefix is removed.
  90. # If the name is then over 14 characters, it is truncated to 14 charactes
  91. #  
  92. proc TruncFileName {pathName} {
  93.     global truncFileNames
  94.  
  95.     if {!$truncFileNames} {
  96.         return $pathName}
  97.     set fileName [file tail $pathName]
  98.     if {"[crange $fileName 0 3]" == "Tcl_"} {
  99.         set fileName [crange $fileName 4 end]}
  100.     set fileName [crange $fileName 0 13]
  101.     return "[file dirname $pathName]/$fileName"
  102. }
  103.  
  104. #-----------------------------------------------------------------------------
  105. # Proc to ensure that all directories for the specified file path exists,
  106. # and if they don't create them.  Don't use -path so we can set the
  107. # permissions.
  108.  
  109. proc EnsureDirs {filePath} {
  110.     set dirPath [file dirname $filePath]
  111.     if [file exists $dirPath] return
  112.     foreach dir [split $dirPath /] {
  113.         lappend dirList $dir
  114.         set partPath [join $dirList /]
  115.         if [file exists $partPath] continue
  116.  
  117.         mkdir $partPath
  118.         chmod u=rwx,go=rx $partPath
  119.     }
  120. }
  121.  
  122. #-----------------------------------------------------------------------------
  123. # Proc to set up scan context for use by FilterNroffManPage.
  124. # This keeps the a two line cache of the previous two lines encountered
  125. # and the blank lines that followed them.
  126. #
  127.  
  128. proc CreateFilterNroffManPageContext {} {
  129.     global filterNroffManPageContext
  130.  
  131.     set filterNroffManPageContext [scancontext create]
  132.  
  133.     # On finding a page header, drop the previous line (which is
  134.     # the page footer). Also deleting the blank lines followin
  135.     # the last line on the previous page.
  136.  
  137.     scanmatch $filterNroffManPageContext {@@@BUILDHELP@@@} {
  138.         catch {unset prev2Blanks}
  139.         catch {unset prev1Line}
  140.         catch {unset prev1Blanks}
  141.         set nukeBlanks {}
  142.     }
  143.  
  144.     # Save blank lines
  145.  
  146.     scanmatch $filterNroffManPageContext {$^} {
  147.         if ![info exists nukeBlanks] {
  148.             append prev1Blanks \n
  149.         }
  150.     }
  151.  
  152.     # Non-blank line, save it.  Output the 2nd previous line if necessary.
  153.  
  154.     scanmatch $filterNroffManPageContext {
  155.         catch {unset nukeBlanks}
  156.         if [info exists prev2Line] {
  157.             puts $outFH $prev2Line
  158.             unset prev2Line
  159.         }
  160.         if [info exists prev2Blanks] {
  161.             puts $outFH $prev2Blanks nonewline
  162.             unset prev2Blanks
  163.         }
  164.         if [info exists prev1Line] {
  165.             set prev2Line $prev1Line
  166.         }
  167.         set prev1Line $matchInfo(line)
  168.         if [info exists prev1Blanks] {
  169.             set prev2Blanks $prev1Blanks
  170.             unset prev1Blanks
  171.         }
  172.     }
  173. }
  174.  
  175. #-----------------------------------------------------------------------------
  176. # Proc to filter a formatted manual page, removing the page headers and
  177. # footers.  This relies on each manual page having a .TH macro in the form:
  178. #   .TH @@@BUILDHELP@@@ n
  179.  
  180. proc FilterNroffManPage {inFH outFH} {
  181.     global filterNroffManPageContext
  182.  
  183.     if ![info exists filterNroffManPageContext] {
  184.         CreateFilterNroffManPageContext
  185.     }
  186.  
  187.     scanfile $filterNroffManPageContext $inFH
  188.  
  189.     if [info exists prev2Line] {
  190.         puts $outFH $prev2Line
  191.     }
  192. }
  193.  
  194. #-----------------------------------------------------------------------------
  195. # Proc to set up scan context for use by ExtractNroffHeader
  196. #
  197.  
  198. proc CreateExtractNroffHeaderContext {} {
  199.     global extractNroffHeaderContext
  200.  
  201.     set extractNroffHeaderContext [scancontext create]
  202.  
  203.     scanmatch $extractNroffHeaderContext {'\\"@endheader[     ]*$} {
  204.         break
  205.     }
  206.     scanmatch $extractNroffHeaderContext {'\\"@:} {
  207.         append nroffHeader "[crange $matchInfo(line) 5 end]\n"
  208.     }
  209.     scanmatch $extractNroffHeaderContext {
  210.         append nroffHeader "$matchInfo(line)\n"
  211.     }
  212. }
  213.  
  214. #-----------------------------------------------------------------------------
  215. # Proc to extract nroff text to use as a header to all pass to nroff when
  216. # processing a help file.
  217. #    manPageFH - The file handle of the manual page.
  218. #
  219.  
  220. proc ExtractNroffHeader {manPageFH} {
  221.     global extractNroffHeaderContext nroffHeader
  222.  
  223.     if ![info exists extractNroffHeaderContext] {
  224.         CreateExtractNroffHeaderContext
  225.     }
  226.     scanfile $extractNroffHeaderContext $manPageFH
  227. }
  228.  
  229.  
  230. #-----------------------------------------------------------------------------
  231. # Proc to set up scan context for use by ExtractNroffHelp
  232. #
  233.  
  234. proc CreateExtractNroffHelpContext {} {
  235.     global extractNroffHelpContext
  236.  
  237.     set extractNroffHelpContext [scancontext create]
  238.  
  239.     scanmatch $extractNroffHelpContext {^'\\"@endhelp[     ]*$} {
  240.         break
  241.     }
  242.  
  243.     scanmatch $extractNroffHelpContext {^'\\"@brief:} {
  244.         if $foundBrief {
  245.             error {Duplicate "@brief:" entry}
  246.         }
  247.         set foundBrief 1
  248.         puts $briefHelpFH "$helpName\t[csubstr $matchInfo(line) 11 end]"
  249.         continue
  250.     }
  251.  
  252.     scanmatch $extractNroffHelpContext {^'\\"@:} {
  253.         puts $nroffFH  [csubstr $matchInfo(line) 5 end]
  254.         continue
  255.     }
  256.     scanmatch $extractNroffHelpContext {^'\\"@help:} {
  257.         error {"@help" found within another help section"}
  258.     }
  259.     scanmatch $extractNroffHelpContext {
  260.         puts $nroffFH $matchInfo(line)
  261.     }
  262. }
  263.  
  264. #-----------------------------------------------------------------------------
  265. # Proc to extract a nroff help file when it is located in the text.
  266. #    manPageFH - The file handle of the manual page.
  267. #    manLine - The '\"@help: line starting the data to extract.
  268. #
  269.  
  270. proc ExtractNroffHelp {manPageFH manLine} {
  271.     global helpDir nroffHeader briefHelpFH colArgs
  272.     global extractNroffHelpContext
  273.  
  274.     if ![info exists extractNroffHelpContext] {
  275.         CreateExtractNroffHelpContext
  276.     }
  277.  
  278.     set helpName [string trim [csubstr $manLine 9 end]]
  279.     set helpFile [TruncFileName "$helpDir/$helpName"]
  280.     if [file exists $helpFile] {
  281.         error "Help file already exists: $helpFile"
  282.     }
  283.     EnsureDirs $helpFile
  284.  
  285.     set tmpFile "[file dirname $helpFile]/tmp.[id process]"
  286.  
  287.     echo "    creating help file $helpName"
  288.  
  289.     set nroffFH [open "| nroff -man | col $colArgs > $tmpFile" w]
  290.  
  291.     puts $nroffFH {.TH @@@BUILDHELP@@@ 1}
  292.  
  293.     set foundBrief 0
  294.     scanfile $extractNroffHelpContext $manPageFH
  295.  
  296.     # Close returns an error on if anything comes back on stderr, even if
  297.     # its a warning.  Output errors and continue.
  298.  
  299.     set stat [catch {
  300.         close $nroffFH
  301.     } msg]
  302.     if $stat {
  303.         puts stderr "nroff: $msg"
  304.     }
  305.  
  306.     set tmpFH [open $tmpFile r]
  307.     set helpFH [open $helpFile w]
  308.  
  309.     FilterNroffManPage $tmpFH $helpFH
  310.  
  311.     close $tmpFH
  312.     close $helpFH
  313.  
  314.     unlink $tmpFile
  315.     chmod a-w,a+r $helpFile
  316. }
  317.  
  318. #-----------------------------------------------------------------------------
  319. # Proc to set up scan context for use by ExtractScriptHelp
  320. #
  321.  
  322. proc CreateExtractScriptHelpContext {} {
  323.     global extractScriptHelpContext
  324.  
  325.     set extractScriptHelpContext [scancontext create]
  326.  
  327.     scanmatch $extractScriptHelpContext {^#@endhelp[     ]*$} {
  328.         break
  329.     }
  330.  
  331.     scanmatch $extractScriptHelpContext {^#@brief:} {
  332.         if $foundBrief {
  333.             error {Duplicate "@brief" entry}
  334.         }
  335.         set foundBrief 1
  336.         puts $briefHelpFH "$helpName\t[csubstr $matchInfo(line) 9 end]"
  337.         continue
  338.     }
  339.  
  340.     scanmatch $extractScriptHelpContext {^#@help:} {
  341.         error {"@help" found within another help section"}
  342.     }
  343.     scanmatch $extractScriptHelpContext {
  344.         if {[clength $matchInfo(line)] > 1} {
  345.             puts $helpFH " [csubstr $matchInfo(line) 1 end]"
  346.         } else {
  347.             puts $helpFH $matchInfo(line)
  348.         }
  349.     }
  350. }
  351.  
  352. #-----------------------------------------------------------------------------
  353. # Proc to extract a tcl script help file when it is located in the text.
  354. #    ScriptPageFH - The file handle of the .tcl file.
  355. #    ScriptLine - The #@help: line starting the data to extract.
  356. #
  357.  
  358. proc ExtractScriptHelp {ScriptPageFH ScriptLine} {
  359.     global helpDir briefHelpFH
  360.     global extractScriptHelpContext
  361.  
  362.     if ![info exists extractScriptHelpContext] {
  363.         CreateExtractScriptHelpContext
  364.     }
  365.  
  366.     set helpName [string trim [csubstr $ScriptLine 7 end]]
  367.     set helpFile "$helpDir/$helpName"
  368.     if {[file exists $helpFile]} {
  369.         error "Help file already exists: $helpFile"
  370.     }
  371.     EnsureDirs $helpFile
  372.  
  373.     echo "    creating help file $helpName"
  374.  
  375.     set helpFH [open $helpFile w]
  376.  
  377.     set foundBrief 0
  378.     scanfile $extractScriptHelpContext $manPageFH
  379.  
  380.     close $helpFH
  381.     chmod a-w,a+r $helpFile
  382. }
  383.  
  384. #-----------------------------------------------------------------------------
  385. # Proc to scan a nroff manual file looking for the start of a help text
  386. # sections and extracting those sections.
  387. #    pathName - Full path name of file to extract documentation from.
  388. #
  389.  
  390. proc ProcessNroffFile {pathName} {
  391.    global nroffScanCT scriptScanCT nroffHeader
  392.  
  393.    set fileName [file tail $pathName]
  394.  
  395.    set nroffHeader {}
  396.    set manPageFH [open $pathName r]
  397.    set matchInfo(fileName) [file tail $pathName]
  398.  
  399.    echo "    scanning $pathName"
  400.  
  401.    scanfile $nroffScanCT $manPageFH
  402.  
  403.    close $manPageFH
  404. }
  405.  
  406. #-----------------------------------------------------------------------------
  407. # Proc to scan a Tcl script file looking for the start of a
  408. # help text sections and extracting those sections.
  409. #    pathName - Full path name of file to extract documentation from.
  410. #
  411.  
  412. proc ProcessTclScript {pathName} {
  413.    global scriptScanCT nroffHeader
  414.  
  415.    set scriptFH [open "$pathName" r]
  416.    set matchInfo(fileName) [file tail $pathName]
  417.  
  418.    echo "    scanning $pathName"
  419.    scanfile $scriptScanCT $scriptFH
  420.  
  421.    close $scriptFH
  422. }
  423.  
  424. #-----------------------------------------------------------------------------
  425. # build: main procedure.  Generates help from specified files.
  426. #    helpDirPath - Directory were the help files go.
  427. #    briefFile - The name of the brief file to create.
  428. #    sourceFiles - List of files to extract help files from.
  429.  
  430. proc buildhelp {helpDirPath briefFile sourceFiles} {
  431.     global helpDir truncFileNames nroffScanCT
  432.     global scriptScanCT briefHelpFH colArgs
  433.  
  434.     echo ""
  435.     echo "Begin building help tree"
  436.  
  437.     # Determine version of col command to use (no -x on BSD)
  438.     if {[system {col -bx </dev/null >/dev/null 2>&1}] != 0} {
  439.         set colArgs {-b}
  440.     } else {
  441.         set colArgs {-bx}
  442.     }
  443.     set helpDir $helpDirPath
  444.     if {![file exists $helpDir]} {
  445.         mkdir $helpDir
  446.     }
  447.  
  448.     if {![file isdirectory $helpDir]} {
  449.         error [concat "$helpDir is not a directory or does not exist. "  
  450.                       "This should be the help root directory"]
  451.     }
  452.         
  453.     set status [catch {set tmpFH [open $helpDir/AVeryVeryBigFileName w]}]
  454.     if {$status != 0} {
  455.         set truncFileNames 1
  456.     } else {
  457.         close $tmpFH
  458.         unlink $helpDir/AVeryVeryBigFileName
  459.         set truncFileNames 0
  460.     }
  461.  
  462.     set nroffScanCT [scancontext create]
  463.  
  464.     scanmatch $nroffScanCT {'\\"@help:} {
  465.         ExtractNroffHelp $matchInfo(handle) $matchInfo(line)
  466.         continue
  467.     }
  468.  
  469.     scanmatch $nroffScanCT {^'\\"@header} {
  470.         ExtractNroffHeader $matchInfo(handle)
  471.         continue
  472.     }
  473.     scanmatch $nroffScanCT {^'\\"@endhelp} {
  474.         error [concat {@endhelp" without corresponding "@help:"} \
  475.                  ", offset = $matchInfo(offset)"]
  476.     }
  477.     scanmatch $nroffScanCT {^'\\"@brief} {
  478.         error [concat {"@brief" without corresponding "@help:"} \
  479.                  ", offset = $matchInfo(offset)"]
  480.     }
  481.  
  482.     set scriptScanCT [scancontext create]
  483.     scanmatch $scriptScanCT {^#@help:} {
  484.         ExtractScriptHelp $matchInfo(handle) $matchInfo(line)
  485.     }
  486.  
  487.     if {[file extension $briefFile] != ".brf"} {
  488.         error "Brief file \"$briefFile\" must have an extension \".brf\""
  489.     }
  490.     if [file exists $helpDir/$briefFile] {
  491.         error "Brief file \"$helpDir/$briefFile\" already exists"
  492.     }
  493.     set briefHelpFH [open "|sort > $helpDir/$briefFile" w]
  494.  
  495.     foreach manFile [glob $sourceFiles] {
  496.         set ext [file extension $manFile]
  497.         if {$ext == ".tcl" || $ext == ".tlib"} {
  498.             set status [catch {ProcessTclScript $manFile} msg]
  499.         } else {
  500.             set status [catch {ProcessNroffFile $manFile} msg]
  501.         }
  502.         if {$status != 0} {
  503.             global errorInfo errorCode
  504.             error "Error extracting help from: $manFile" $errorInfo $errorCode
  505.         }
  506.     }
  507.  
  508.     close $briefHelpFH
  509.     chmod a-w,a+r $helpDir/$briefFile
  510.     echo "Completed extraction of help files"
  511. }
  512.  
  513.