????
Current Path : /proc/thread-self/root/proc/thread-self/root/usr/lib64/tcl8.5/tclx8.4/ |
Current File : //proc/thread-self/root/proc/thread-self/root/usr/lib64/tcl8.5/tclx8.4/buildhelp.tcl |
# # buildhelp.tcl -- # # Program to extract help files from TCL manual pages or TCL script files. # The help directories are built as a hierarchical tree of subjects and help # files. # #------------------------------------------------------------------------------ # Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. Karl Lehenbauer and # Mark Diekhans make no representations about the suitability of this # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ # $Id: buildhelp.tcl,v 1.3 2005/03/25 19:32:48 hobbs Exp $ #------------------------------------------------------------------------------ # # For nroff man pages, the areas of text to extract are delimited with: # # '\"@help: subjectdir/helpfile # '\"@endhelp # # start in column one. The text between these markers is extracted and stored # in help/subjectdir/help. The file must not exists, this is done to enforced # cleaning out the directories before help file generation is started, thus # removing any stale files. The extracted text is run through: # # nroff -man|col -xb {col -b on BSD derived systems} # # If there is other text to include in the helpfile, but not in the manual # page, the text, along with nroff formatting commands, may be included using: # # '\"@:Other text to include in the help page. # # A entry in the brief file, used by apropos my be included by: # # '\"@brief: Short, one line description # # These brief request must occur with in the bounds of a help section. # # If some header text, such as nroff macros, need to be preappended to the # text streem before it is run through nroff, then that text can be bracketed # with: # # '\"@header # '\"@endheader # # If multiple header blocks are encountered, they will all be preappended. # # For TCL script files, which are indentified because they end in ".tcl", # the text to be extracted is delimited by: # # #@help: subjectdir/helpfile # #@endhelp # # And brief lines are in the form: # # #@brief: Short, one line description # # The only processing done on text extracted from .tcl files it to replace # the # in column one with a space. # # #----------------------------------------------------------------------------- # # To generate help: # # buildhelp helpDir brief.brf filelist # # o helpDir is the help tree root directory. helpDir should exists, but any # subdirectories that don't exists will be created. helpDir should be # cleaned up before the start of manual page generation, as this program # will not overwrite existing files. # o brief.brf is the name of the brief file to create form the @brief entries. # It must have an extension of ".brf". It will be created in helpDir. # o filelist are the nroff manual pages, or .tcl, .tlib files to extract # the help files from. If the suffix is not .tcl or .tlib, a nroff manual # page is assumed. # #----------------------------------------------------------------------------- #@package: TclX-buildhelp buildhelp #----------------------------------------------------------------------------- # Truncate a file name of a help file if the system does not support long # file names. If the name starts with `Tcl_', then this prefix is removed. # If the name is then over 14 characters, it is truncated to 14 charactes # proc TruncFileName {pathName} { global truncFileNames if {!$truncFileNames} { return $pathName} set fileName [file tail $pathName] if {"[crange $fileName 0 3]" == "Tcl_"} { set fileName [crange $fileName 4 end]} set fileName [crange $fileName 0 13] return "[file dirname $pathName]/$fileName" } #----------------------------------------------------------------------------- # Proc to ensure that all directories for the specified file path exists, # and if they don't create them. Don't use -path so we can set the # permissions. proc EnsureDirs {filePath} { set dirPath [file dirname $filePath] if [file exists $dirPath] return foreach dir [split $dirPath /] { lappend dirList $dir set partPath [join $dirList /] if [file exists $partPath] continue mkdir $partPath chmod u=rwx,go=rx $partPath } } #----------------------------------------------------------------------------- # Proc to set up scan context for use by FilterNroffManPage. # This keeps the a two line cache of the previous two lines encountered # and the blank lines that followed them. # proc CreateFilterNroffManPageContext {} { global filterNroffManPageContext set filterNroffManPageContext [scancontext create] # On finding a page header, drop the previous line (which is # the page footer). Also deleting the blank lines followin # the last line on the previous page. scanmatch $filterNroffManPageContext {@@@BUILDHELP@@@} { catch {unset prev2Blanks} catch {unset prev1Line} catch {unset prev1Blanks} set nukeBlanks {} } # Save blank lines scanmatch $filterNroffManPageContext {$^} { if ![info exists nukeBlanks] { append prev1Blanks \n } } # Non-blank line, save it. Output the 2nd previous line if necessary. scanmatch $filterNroffManPageContext { catch {unset nukeBlanks} if [info exists prev2Line] { puts $outFH $prev2Line unset prev2Line } if [info exists prev2Blanks] { puts $outFH $prev2Blanks nonewline unset prev2Blanks } if [info exists prev1Line] { set prev2Line $prev1Line } set prev1Line $matchInfo(line) if [info exists prev1Blanks] { set prev2Blanks $prev1Blanks unset prev1Blanks } } } #----------------------------------------------------------------------------- # Proc to filter a formatted manual page, removing the page headers and # footers. This relies on each manual page having a .TH macro in the form: # .TH @@@BUILDHELP@@@ n proc FilterNroffManPage {inFH outFH} { global filterNroffManPageContext if ![info exists filterNroffManPageContext] { CreateFilterNroffManPageContext } scanfile $filterNroffManPageContext $inFH if [info exists prev2Line] { puts $outFH $prev2Line } } #----------------------------------------------------------------------------- # Proc to set up scan context for use by ExtractNroffHeader # proc CreateExtractNroffHeaderContext {} { global extractNroffHeaderContext set extractNroffHeaderContext [scancontext create] scanmatch $extractNroffHeaderContext {'\\"@endheader[ ]*$} { break } scanmatch $extractNroffHeaderContext {'\\"@:} { append nroffHeader "[crange $matchInfo(line) 5 end]\n" } scanmatch $extractNroffHeaderContext { append nroffHeader "$matchInfo(line)\n" } } #----------------------------------------------------------------------------- # Proc to extract nroff text to use as a header to all pass to nroff when # processing a help file. # manPageFH - The file handle of the manual page. # proc ExtractNroffHeader {manPageFH} { global extractNroffHeaderContext nroffHeader if ![info exists extractNroffHeaderContext] { CreateExtractNroffHeaderContext } scanfile $extractNroffHeaderContext $manPageFH } #----------------------------------------------------------------------------- # Proc to set up scan context for use by ExtractNroffHelp # proc CreateExtractNroffHelpContext {} { global extractNroffHelpContext set extractNroffHelpContext [scancontext create] scanmatch $extractNroffHelpContext {^'\\"@endhelp[ ]*$} { break } scanmatch $extractNroffHelpContext {^'\\"@brief:} { if $foundBrief { error {Duplicate "@brief:" entry} } set foundBrief 1 puts $briefHelpFH "$helpName\t[csubstr $matchInfo(line) 11 end]" continue } scanmatch $extractNroffHelpContext {^'\\"@:} { puts $nroffFH [csubstr $matchInfo(line) 5 end] continue } scanmatch $extractNroffHelpContext {^'\\"@help:} { error {"@help" found within another help section"} } scanmatch $extractNroffHelpContext { puts $nroffFH $matchInfo(line) } } #----------------------------------------------------------------------------- # Proc to extract a nroff help file when it is located in the text. # manPageFH - The file handle of the manual page. # manLine - The '\"@help: line starting the data to extract. # proc ExtractNroffHelp {manPageFH manLine} { global helpDir nroffHeader briefHelpFH colArgs global extractNroffHelpContext if ![info exists extractNroffHelpContext] { CreateExtractNroffHelpContext } set helpName [string trim [csubstr $manLine 9 end]] set helpFile [TruncFileName "$helpDir/$helpName"] if [file exists $helpFile] { error "Help file already exists: $helpFile" } EnsureDirs $helpFile set tmpFile "[file dirname $helpFile]/tmp.[id process]" echo " creating help file $helpName" set nroffFH [open "| nroff -man | col $colArgs > $tmpFile" w] puts $nroffFH {.TH @@@BUILDHELP@@@ 1} set foundBrief 0 scanfile $extractNroffHelpContext $manPageFH # Close returns an error on if anything comes back on stderr, even if # its a warning. Output errors and continue. set stat [catch { close $nroffFH } msg] if $stat { puts stderr "nroff: $msg" } set tmpFH [open $tmpFile r] set helpFH [open $helpFile w] FilterNroffManPage $tmpFH $helpFH close $tmpFH close $helpFH unlink $tmpFile chmod a-w,a+r $helpFile } #----------------------------------------------------------------------------- # Proc to set up scan context for use by ExtractScriptHelp # proc CreateExtractScriptHelpContext {} { global extractScriptHelpContext set extractScriptHelpContext [scancontext create] scanmatch $extractScriptHelpContext {^#@endhelp[ ]*$} { break } scanmatch $extractScriptHelpContext {^#@brief:} { if $foundBrief { error {Duplicate "@brief" entry} } set foundBrief 1 puts $briefHelpFH "$helpName\t[csubstr $matchInfo(line) 9 end]" continue } scanmatch $extractScriptHelpContext {^#@help:} { error {"@help" found within another help section"} } scanmatch $extractScriptHelpContext {^#$} { puts $helpFH "" } scanmatch $extractScriptHelpContext { if {[clength $matchInfo(line)] > 1} { puts $helpFH " [csubstr $matchInfo(line) 1 end]" } else { puts $helpFH $matchInfo(line) } } } #----------------------------------------------------------------------------- # Proc to extract a tcl script help file when it is located in the text. # ScriptPageFH - The file handle of the .tcl file. # ScriptLine - The #@help: line starting the data to extract. # proc ExtractScriptHelp {scriptPageFH scriptLine} { global helpDir briefHelpFH global extractScriptHelpContext if ![info exists extractScriptHelpContext] { CreateExtractScriptHelpContext } set helpName [string trim [csubstr $scriptLine 7 end]] set helpFile "$helpDir/$helpName" if {[file exists $helpFile]} { error "Help file already exists: $helpFile" } EnsureDirs $helpFile echo " creating help file $helpName" set helpFH [open $helpFile w] set foundBrief 0 scanfile $extractScriptHelpContext $scriptPageFH close $helpFH chmod a-w,a+r $helpFile } #----------------------------------------------------------------------------- # Proc to scan a nroff manual file looking for the start of a help text # sections and extracting those sections. # pathName - Full path name of file to extract documentation from. # proc ProcessNroffFile {pathName} { global nroffScanCT scriptScanCT nroffHeader set fileName [file tail $pathName] set nroffHeader {} set manPageFH [open $pathName r] set matchInfo(fileName) [file tail $pathName] echo " scanning $pathName" scanfile $nroffScanCT $manPageFH close $manPageFH } #----------------------------------------------------------------------------- # Proc to scan a Tcl script file looking for the start of a # help text sections and extracting those sections. # pathName - Full path name of file to extract documentation from. # proc ProcessTclScript {pathName} { global scriptScanCT nroffHeader set scriptFH [open "$pathName" r] set matchInfo(fileName) [file tail $pathName] echo " scanning $pathName" scanfile $scriptScanCT $scriptFH close $scriptFH } #----------------------------------------------------------------------------- # build: main procedure. Generates help from specified files. # helpDirPath - Directory were the help files go. # briefFile - The name of the brief file to create. # sourceFiles - List of files to extract help files from. proc buildhelp {helpDirPath briefFile sourceFiles} { global helpDir truncFileNames nroffScanCT global scriptScanCT briefHelpFH colArgs echo "" echo "Begin building help tree" # Determine version of col command to use (no -x on BSD) if {[catch {exec col -bx </dev/null >/dev/null 2>/dev/null}]} { set colArgs {-b} } else { set colArgs {-bx} } set helpDir $helpDirPath if {![file exists $helpDir]} { mkdir $helpDir } if {![file isdirectory $helpDir]} { error "$helpDir is not a directory or does not exist.\n \ This should be the help root directory" } set status [catch {set tmpFH [open $helpDir/AVeryVeryBigFileName w]}] if {$status != 0} { set truncFileNames 1 } else { close $tmpFH unlink $helpDir/AVeryVeryBigFileName set truncFileNames 0 } set nroffScanCT [scancontext create] scanmatch $nroffScanCT {'\\"@help:} { ExtractNroffHelp $matchInfo(handle) $matchInfo(line) continue } scanmatch $nroffScanCT {^'\\"@header} { ExtractNroffHeader $matchInfo(handle) continue } scanmatch $nroffScanCT {^'\\"@endhelp} { error [concat {@endhelp" without corresponding "@help:"} \ ", offset = $matchInfo(offset)"] } scanmatch $nroffScanCT {^'\\"@brief} { error [concat {"@brief" without corresponding "@help:"} \ ", offset = $matchInfo(offset)"] } set scriptScanCT [scancontext create] scanmatch $scriptScanCT {^#@help:} { ExtractScriptHelp $matchInfo(handle) $matchInfo(line) } if {[file extension $briefFile] != ".brf"} { error "Brief file \"$briefFile\" must have an extension \".brf\"" } if [file exists $helpDir/$briefFile] { error "Brief file \"$helpDir/$briefFile\" already exists" } set briefHelpFH [open "|sort > $helpDir/$briefFile" w] foreach manFile [glob $sourceFiles] { set ext [file extension $manFile] if {$ext == ".tcl" || $ext == ".tlib"} { set status [catch {ProcessTclScript $manFile} msg] } else { set status [catch {ProcessNroffFile $manFile} msg] } if {$status != 0} { global errorInfo errorCode error "Error extracting help from: $manFile" $errorInfo $errorCode } } close $briefHelpFH chmod a-w,a+r $helpDir/$briefFile echo "Completed extraction of help files" }