# man2html1.tcl -- # # This file defines procedures that are used during the first pass of the # man page to html conversion process. It is sourced by h.tcl. # # Copyright (c) 1996 by Sun Microsystems, Inc. package require Tcl 8.4- # Global variables used by these scripts: # # state - state variable that controls action of text proc. # # curFile - tail of current man page. # # file - file pointer; for both xref.tcl and contents.html # # NAME_file - array indexed by NAME and containing file names used # for hyperlinks. # # KEY_file - array indexed by KEYWORD and containing file names used # for hyperlinks. # # lib - contains package name. Used to label section in contents.html # # inDT - in dictionary term. # text -- # # This procedure adds entries to the hypertext arrays NAME_file # and KEY_file. # # DT: might do this: if first word of $dt matches $name and [llength $name==1] # and [llength $dt > 1], then add to NAME_file. # # Arguments: # string - Text to index. proc text string { global state curFile NAME_file KEY_file inDT switch $state { NAME { foreach i [split $string ","] { lappend NAME_file([string trim $i]) $curFile } } KEY { foreach i [split $string ","] { lappend KEY_file([string trim $i]) $curFile } } DT - OFF - DASH {} default { puts stderr "text: unknown state: $state" } } } # macro -- # # This procedure is invoked to process macro invocations that start # with "." (instead of '). # # Arguments: # name - The name of the macro (without the "."). # args - Any additional arguments to the macro. proc macro {name args} { switch $name { SH - SS { global state switch $args { NAME { if {$state eq "INIT"} { set state NAME } } DESCRIPTION {set state DT} INTRODUCTION {set state DT} KEYWORDS {set state KEY} default {set state OFF} } } TP { global inDT set inDT 1 } TH { global lib state inDT set inDT 0 set state INIT if {[llength $args] != 5} { set args [join $args " "] puts stderr "Bad .TH macro: .$name $args" } set lib [lindex $args 3] ;# Tcl or Tk } } } # dash -- # # This procedure is invoked to handle dash characters ("\-" in # troff). It only function in pass1 is to terminate the NAME state. # # Arguments: # None. proc dash {} { global state if {$state eq "NAME"} { set state DASH } } # newline -- # # This procedure is invoked to handle newlines in the troff input. # It's only purpose is to terminate a DT (dictionary term). # # Arguments: # None. proc newline {} { global inDT set inDT 0 } # initGlobals, tab, font, char, macro2 -- # # These procedures do nothing during the first pass. # # Arguments: # None. proc initGlobals {} {} proc tab {} {} proc font type {} proc char name {} proc macro2 {name args} {} # doListing -- # # Writes an ls like list to a file. Searches NAME_file for entries # that match the input pattern. # # Arguments: # file - Output file pointer. # pattern - glob style match pattern proc doListing {file pattern} { global NAME_file set max_len 0 foreach name [lsort [array names NAME_file]] { set ref $NAME_file($name) if [string match $pattern $ref] { lappend type $name if {[string length $name] > $max_len} { set max_len [string length $name] } } } if [catch {llength $type} ] { puts stderr " doListing: no names matched pattern ($pattern)" return } incr max_len set ncols [expr {90/$max_len}] set nrows [expr {int(ceil([llength $type] / double($ncols)))} ] # ? max_len ncols nrows set index 0 foreach f $type { lappend row([expr {$index % $nrows}]) $f incr index } puts -nonewline $file "
"
    for {set i 0} {$i<$nrows} {incr i} {
	foreach name $row($i) {
	    set str [format "%-*s" $max_len $name]
	    regsub $name $str "$name" str
	    puts -nonewline $file $str
	}
	puts $file {}
    }
    puts $file "
" } # doContents -- # # Generates a HTML contents file using the NAME_file array # as its input database. # # Arguments: # file - name of the contents file. # packageName - string used in the title and sub-heads of the HTML # page. Normally name of the package without version # numbers. proc doContents {file packageName} { global footer set file [open $file w] puts $file "$packageName Manual" puts $file "

$packageName

" doListing $file "*.1" puts $file "

$packageName Commands

" doListing $file "*.n" puts $file "

$packageName Library

" doListing $file "*.3" puts $file $footer puts $file "" close $file } # do -- # # This is the toplevel procedure that searches a man page # for hypertext links. It builds a data base consisting of # two arrays: NAME_file and KEY file. It runs the man2tcl # program to turn the man page into a script, then it evals # that script. # # Arguments: # fileName - Name of the file to scan. proc do fileName { global curFile set curFile [file tail $fileName] set file stdout puts " Pass 1 -- $fileName" flush stdout if [catch {eval [exec man2tcl [glob $fileName]]} msg] { global errorInfo puts stderr $msg puts "in" puts $errorInfo exit 1 } }