home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / tls / tls074c.sunsparc.Z / tls074c.sunsparc / usr / lib / tcl / buildhlp.tcl next >
Encoding:
Text File  |  1995-07-20  |  15.2 KB  |  455 lines
  1. # CVS $Id: buildhlp.tcl,v 1.2 1994/04/28 16:39:09 shonagh Exp $
  2. #    @(#) buildhlp.tcl 25.1 92/07/31 
  3. #
  4. #    Copyright (C) 1992 The Santa Cruz Operation, Inc.
  5. #        All Rights Reserved.
  6. #    The information in this file is provided for the exclusive use of
  7. #    the licensees of The Santa Cruz Operation, Inc.  Such users have the
  8. #    right to use, modify, and incorporate this code into other products
  9. #    for purposes authorized by the license agreement provided they include
  10. #    this notice and the associated copyright notice with any such product.
  11. #    The information in this file is provided "AS IS" without warranty.
  12. #
  13. #-----------------------------------------------------------------------------
  14. #                                buildhelp.tcl
  15. #-----------------------------------------------------------------------------
  16. #
  17. # Program to extract help files from TCL manual pages or TCL script files.
  18. # The help directories are built as a hierarchical tree of subjects and help
  19. # files.  
  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. # A similar construct is used for manual page name index generation:
  54. #
  55. #      ;@index: subject1 subjectN
  56. #
  57. # This is used by `installTcl' to generate the name index files.  There should
  58. # be one per file, usuall right before the name line.  The subjects listed are
  59. # all of the procedures or commands to link to the manual page, usually the
  60. # same as on the .SH NAME line.
  61. #
  62. # For TCL script files, which are indentified because they end in ".tcl",
  63. # the text to be extracted is delimited by:
  64. #
  65. #    #@help: subjectdir/helpfile
  66. #    #@endhelp
  67. #
  68. # And brief lines are in the form:
  69. #
  70. #     #@brief: Short, one line description
  71. #
  72. # The only processing done on text extracted from .tcl files it to replace
  73. # the # in column one with a space.
  74. #
  75. #
  76. #-----------------------------------------------------------------------------
  77. # 
  78. # To run this program:
  79. #
  80. #   tcl buildhelp.tcl [-m mergeTree] [-i nameindex] helpDir file-1 file-2 ...
  81. #
  82. # o -m mergeTree is a tree of help code, plus a brief file to merge with the
  83. #   help files that are to be extracted.  This will become part of the new
  84. #   help tree.  Used to merge in the documentation from UCB Tcl.
  85. # o -i nameindex is an name index file to create from the '@index markers in
  86. #   the man files.
  87. # o helpDir is the help tree root directory.  helpDir should  exists, but any
  88. #   subdirectories that don't exists will be created.  helpDir should be
  89. #   cleaned up before the start of manual page generation, as this program
  90. #   will not overwrite existing files.
  91. # o file-n are the nroff manual pages (.man) or .tcl or .tlib files to extract
  92. #   the help files from.
  93. #-----------------------------------------------------------------------------
  94.  
  95. #-----------------------------------------------------------------------------
  96. # Truncate a file name of a help file if the system does not support long
  97. # file names.  If the name starts with `Tcl_', then this prefix is removed.
  98. # If the name is then over 14 characters, it is truncated to 14 charactes
  99. #  
  100. proc TruncFileName {pathName} {
  101.     global G_truncFileNames
  102.  
  103.     if {!$G_truncFileNames} {
  104.         return $pathName}
  105.     set fileName [file tail $pathName]
  106.     if {"[crange $fileName 0 3]" == "Tcl_"} {
  107.         set fileName [crange $fileName 4 end]}
  108.     set fileName [crange $fileName 0 13]
  109.     return "[file dirname $pathName]/$fileName"
  110. }
  111.  
  112. #-----------------------------------------------------------------------------
  113. # Proc to ensure that all directories for the specified file path exists,
  114. # and if they don't create them.
  115.  
  116. proc EnsureDirs {filePath} {
  117.     set dirPath [file dirname $filePath]
  118.     if {![file exists $dirPath]} {
  119.         mkdir -path $dirPath}
  120. }
  121.  
  122.  
  123. #-----------------------------------------------------------------------------
  124. #
  125. # Proc to extract nroff text to use as a header to all pass to nroff when
  126. # processing a help file.
  127. #    manPageFH - The file handle of the manual page.
  128. #
  129.  
  130. proc ExtractNroffHeader {manPageFH} {
  131.     global nroffHeader
  132.     while {[gets $manPageFH manLine] >= 0} {
  133.         if {[string first "'@endheader" $manLine] == 0} {
  134.             break;
  135.             }
  136.         if {[string first "'@:" $manLine] == 0} {
  137.             set manLine [csubstr manLine 3 end]
  138.             }
  139.         append nroffHeader "$manLine\n"
  140.         }
  141. }
  142.  
  143. #-----------------------------------------------------------------------------
  144. #
  145. # Proc to extract a nroff help file when it is located in the text.
  146. #    manPageFH - The file handle of the manual page.
  147. #    manLine - The '@help: line starting the data to extract.
  148. #
  149.  
  150. proc ExtractNroffHelp {manPageFH manLine} {
  151.     global G_helpDir nroffHeader G_briefHelpFH G_colArgs
  152.  
  153.     set helpName [string trim [csubstr $manLine 7 end]]
  154.     set helpFile [TruncFileName "$G_helpDir/$helpName"]
  155.     if {[file exists $helpFile]} {
  156.         error "Help file already exists: $helpFile"}
  157.     EnsureDirs $helpFile
  158.     set helpFH [open "| nroff -man | col $G_colArgs > $helpFile" w]
  159.     echo "    creating help file $helpName"
  160.  
  161.     # Nroff commands from .TH macro to get the formatting right.  The `\n'
  162.     # are newline separators to output, the `\\n' become `\n' in the text.
  163.         
  164.     puts $helpFH ".ad b\n.PD\n.nrIN \\n()Mu\n.nr)R 0\n.nr)I \\n()Mu"
  165.     puts $helpFH ".nr)R 0\n.\}E\n.DT\n.na\n.nh"
  166.     puts $helpFH $nroffHeader
  167.     set foundBrief 0
  168.     while {[gets $manPageFH manLine] >= 0} {
  169.         if {[string first "'@endhelp" $manLine] == 0} {
  170.             break;
  171.         }
  172.         if {[string first "'@brief:" $manLine] == 0} {
  173.             if $foundBrief {
  174.                 error {Duplicate "'@brief" entry"}
  175.             }
  176.             set foundBrief 1
  177.         puts $G_briefHelpFH "$helpName\t[csubstr $manLine 8 end]"
  178.             continue;
  179.         }
  180.         if {[string first "'@:" $manLine] == 0} {
  181.             set manLine [csubstr $manLine 3 end]
  182.         }
  183.         if {[string first "'@help" $manLine] == 0} {
  184.             error {"'@help" found within another help section"}
  185.         }
  186.         puts $helpFH $manLine
  187.         }
  188.     close $helpFH
  189.     chmod a-w,a+r $helpFile
  190. }
  191.  
  192. #-----------------------------------------------------------------------------
  193. #
  194. # Proc to extract a tcl script help file when it is located in the text.
  195. #    ScriptPageFH - The file handle of the .tcl file.
  196. #    ScriptLine - The #@help: line starting the data to extract.
  197. #
  198.  
  199. proc ExtractScriptHelp {ScriptPageFH ScriptLine} {
  200.     global G_helpDir G_briefHelpFH
  201.     set helpName [string trim [csubstr $ScriptLine 7 end]]
  202.     set helpFile "$G_helpDir/$helpName"
  203.     if {[file exists $helpFile]} {
  204.         error "Help file already exists: $helpFile"}
  205.     EnsureDirs $helpFile
  206.     set helpFH [open $helpFile w]
  207.     echo "    creating help file $helpName"
  208.     set foundBrief 0
  209.     while {[gets $ScriptPageFH ScriptLine] >= 0} {
  210.         if {[string first "#@endhelp" $ScriptLine] == 0} {
  211.             break;
  212.         }
  213.         if {[string first "#@brief:" $ScriptLine] == 0} {
  214.             if $foundBrief {
  215.                 error {Duplicate "#@brief" entry"}
  216.             }
  217.             set foundBrief 1
  218.         puts $G_briefHelpFH "$helpName\t[csubstr $ScriptLine 8 end]"
  219.             continue;
  220.         }
  221.         if {[string first "#@help" $ScriptLine] == 0} {
  222.             error {"#@help" found within another help section"}
  223.         }
  224.         if {[clength $ScriptLine] > 1} {
  225.             set ScriptLine " [csubstr $ScriptLine 1 end]"
  226.         } else {
  227.             set ScriptLine ""
  228.         }
  229.         puts $helpFH $ScriptLine
  230.         }
  231.     close $helpFH
  232.     chmod a-w,a+r $helpFile
  233. }
  234.  
  235. #-----------------------------------------------------------------------------
  236. #
  237. # Proc to scan a nroff manual file looking for the start of a help text
  238. # sections and extracting those sections.
  239. #    pathName - Full path name of file to extract documentation from.
  240. #
  241.  
  242. proc ProcessNroffFile {pathName} {
  243.    global G_nroffScanCT G_scriptScanCT nroffHeader
  244.  
  245.    set fileName [file tail $pathName]
  246.  
  247.    set nroffHeader {}
  248.    set manPageFH [open $pathName r]
  249.    echo "    scanning $pathName"
  250.    set matchInfo(fileName) [file tail $pathName]
  251.    scanfile $G_nroffScanCT $manPageFH
  252.    close $manPageFH
  253. }
  254.  
  255. #-----------------------------------------------------------------------------
  256. #
  257. # Proc to scan a Tcl script file looking for the start of a
  258. # help text sections and extracting those sections.
  259. #    pathName - Full path name of file to extract documentation from.
  260. #
  261.  
  262. proc ProcessTclScript {pathName} {
  263.    global G_scriptScanCT nroffHeader
  264.  
  265.    set scriptFH [open "$pathName" r]
  266.  
  267.    echo "    scanning $pathName"
  268.    set matchInfo(fileName) [file tail $pathName]
  269.    scanfile $G_scriptScanCT $scriptFH
  270.    close $scriptFH
  271. }
  272.  
  273. #-----------------------------------------------------------------------------
  274. # Proc to copy the help merge tree, excluding the brief file.
  275. # 
  276.  
  277. proc CopyMergeTree {helpDirPath mergeTree} {
  278.     if {"[cindex $helpDirPath 0]" != "/"} {
  279.         set helpDirPath "[pwd]/$helpDirPath"
  280.     }
  281.     set oldDir [pwd]
  282.     cd $mergeTree
  283.  
  284.     set curHelpDir "."
  285.  
  286.     for_recursive_glob mergeFile {.} {
  287.         if {"$mergeFile" == "./brief"} {
  288.             continue}
  289.             set helpFile "$helpDirPath/$mergeFile"
  290.         if {[file isdirectory $mergeFile]} {
  291.             if ![file exists $helpFile] {
  292.                 mkdir $helpFile
  293.                 chmod go-w,a+rx $helpFile
  294.             }
  295.         } else {
  296.             if {[file exists $helpFile]} {
  297.                 error "Help file already exists: $helpFile"}
  298.             set inFH [open $mergeFile r]
  299.             set outFH [open $helpFile w]
  300.             copyfile $inFH $outFH
  301.             close $outFH
  302.             close $inFH
  303.             chmod a-w,a+r $helpFile
  304.         }
  305.     }
  306.     cd $oldDir
  307. }
  308.  
  309. #-----------------------------------------------------------------------------
  310. # GenerateHelp: main procedure.  Generates help from specified files.
  311. #    helpDirPath - Directory were the help files go.
  312. #    mergeTree - Help file tree to merge with the extracted help files.
  313. #    manIndexFile - Manual page index file to build, or {} to not build one.
  314. #    sourceFiles - List of files to extract help files from.
  315.  
  316. proc GenerateHelp {helpDirPath mergeTree manIndexFile sourceFiles} {
  317.     global G_helpDir G_truncFileNames G_manIndexFH G_nroffScanCT
  318.     global G_scriptScanCT G_briefHelpFH G_colArgs
  319.  
  320.     echo ""
  321.     echo "Begin building help tree"
  322.  
  323.     # Determine version of col command to use (no -x on BSD)
  324.     if {[system {col -bx </dev/null >/dev/null 2>&1}] != 0} {
  325.         set G_colArgs {-b}
  326.     } else {
  327.         set G_colArgs {-bx}
  328.     }
  329.     set G_helpDir [glob $helpDirPath]
  330.  
  331.     if {![file isdirectory $G_helpDir]} {
  332.         error [concat "$G_helpDir is not a directory or does not exist. "  
  333.                       "This should be the help root directory"]
  334.     }
  335.         
  336.     set status [catch {set tmpFH [open xxx $G_helpDir/AVeryVeryBigFileName w]}]
  337.     if {$status != 0} {
  338.         set G_truncFileNames 1
  339.     } else {
  340.         close $tmpFH
  341.         unlink $G_helpDir/AVeryVeryBigFileName
  342.         set G_truncFileNames 0
  343.     }
  344.  
  345.     set G_manIndexFH {}
  346.     if {![lempty $manIndexFile]} {
  347.         set G_manIndexFH [open $manIndexFile w]
  348.     }
  349.  
  350.     set G_nroffScanCT [scancontext create]
  351.  
  352.     scanmatch $G_nroffScanCT "^'@help:" {
  353.         ExtractNroffHelp $matchInfo(handle) $matchInfo(line)
  354.         continue
  355.     }
  356.  
  357.     scanmatch $G_nroffScanCT "^'@header" {
  358.         ExtractNroffHeader $matchInfo(handle)
  359.         continue
  360.     }
  361.     scanmatch $G_nroffScanCT "^'@endhelp" {
  362.         error [concat {"'@endhelp" without corresponding "'@help:"} \
  363.                  ", offset = $matchInfo(offset)"]
  364.     }
  365.     scanmatch $G_nroffScanCT "^'@brief" {
  366.         error [concat {"'@brief" without corresponding "'@help:"}
  367.                  ", offset = $matchInfo(offset)"]
  368.     }
  369.  
  370.     scanmatch $G_nroffScanCT "^'@index:" {
  371.         global G_manIndexFH
  372.         if {[llength $matchInfo(line)] == 1} {
  373.             error "no subjects specified in \"'@index:\" line"}
  374.         if {![lempty $G_manIndexFH]} {
  375.             puts $G_manIndexFH [concat $matchInfo(fileName) \
  376.                                        [list [lrange $matchInfo(line) 1 end]]]
  377.         }
  378.     }
  379.  
  380.     set G_scriptScanCT [scancontext create]
  381.     scanmatch $G_scriptScanCT "^#@help:" {
  382.         ExtractScriptHelp $matchInfo(handle) $matchInfo(line)
  383.     }
  384.  
  385.     if ![lempty $mergeTree] {
  386.         echo "    Merging tree: $mergeTree"
  387.         CopyMergeTree $helpDirPath $mergeTree
  388.     }
  389.  
  390.     set G_briefHelpFH [open "|sort > $G_helpDir/brief" w]
  391.  
  392.     if {(![lempty $mergeTree]) && [file exists $mergeTree/brief]} {
  393.         echo "    Merging file: $mergeTree/brief"
  394.         set mergeBriefFH [open $mergeTree/brief r]
  395.         puts $G_briefHelpFH [read $mergeBriefFH]
  396.         close $mergeBriefFH
  397.     }
  398.     foreach manFile $sourceFiles {
  399.         set manFile [glob $manFile]
  400.         set ext [file extension $manFile]
  401.         if {"$ext" == ".man"} {
  402.             set status [catch {ProcessNroffFile $manFile} msg]
  403.         } else {
  404.             set status [catch {ProcessTclScript $manFile} msg]
  405.         }
  406.         if {$status != 0} {
  407.             echo "Error extracting help from: $manFile"
  408.             echo $msg
  409.             global errorInfo interactiveSession
  410.             if {!$interactiveSession} {
  411.                 echo $errorInfo
  412.                 exit 1
  413.             }
  414.         }
  415.     }
  416.  
  417.     close $G_briefHelpFH
  418.     chmod a-w,a+r $G_helpDir/brief
  419.     if {$G_manIndexFH != ""} {
  420.         close $G_manIndexFH
  421.     }
  422.     echo "*** completed extraction of all help files"
  423. }
  424.  
  425. #-----------------------------------------------------------------------------
  426. # Print a usage message and exit the program
  427. proc Usage {} {
  428.     echo {Wrong args: [-m mergetree] [-i index] helpdir manfile1 [manfile2..]}
  429.     exit 1
  430. }
  431.  
  432. #-----------------------------------------------------------------------------
  433. # Main program body, decides if help is interactive or batch.
  434.  
  435. if {$interactiveSession} {
  436.     echo "To extract help, use the command:"
  437.     echo "  GenerateHelp [-m mergetree] [-i nameindex] sourceFiles helpdir file-1 file-2 ..."
  438. } else {
  439.     set mergeTree {}
  440.     set manIndexFile {}
  441.     while {[string match "-*" [lindex $argv 0]]} {
  442.         set flag [lvarpop argv 0]
  443.         case $flag in {
  444.             "-m" {set mergeTree [lvarpop argv 0]}
  445.             "-i" {set manIndexFile [lvarpop argv 0]}
  446.             default Usage
  447.         }
  448.     }
  449.     if {[llength $argv] < 2} {
  450.         Usage
  451.     }
  452.     GenerateHelp [lindex $argv 0] $mergeTree $manIndexFile [lrange $argv 1 end]
  453.    
  454. }
  455.