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