# 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.

#

# SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29

#

# 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 {

	    global state

	    switch $args {

		NAME {

		    if {$state == "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 == "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] / $ncols. ) ) ]

#	? max_len ncols nrows

    set index 0

    foreach f $type {

	lappend row([expr $index % $nrows]) $f

	incr index

    }

    puts -nonewline $file "<PRE>"

    for {set i 0} {$i<$nrows} {incr i} {

	foreach name $row($i) {

	    set str [format "%-*s" $max_len $name]

	    regsub $name $str "<A HREF=\"$NAME_file($name).html\">$name</A>" str

	    puts -nonewline $file $str

	}

	puts $file {}

    }

    puts $file "</PRE>"

}

# 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 "<HTML><HEAD><TITLE>$packageName Manual</TITLE></HEAD><BODY>"

    puts $file "<H3>$packageName</H3>"

    doListing $file "*.1"

    puts $file "<HR><H3>$packageName Commands</H3>"

    doListing $file "*.n"

    puts $file "<HR><H3>$packageName Library</H3>"

    doListing $file "*.3"

    puts $file $footer

    puts $file "</BODY></HTML>"

    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

    }

}