1# man2html1.tcl -- 2# 3# This file defines procedures that are used during the first pass of the 4# man page to html conversion process. It is sourced by h.tcl. 5# 6# Copyright (c) 1996 by Sun Microsystems, Inc. 7# 8# SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29 9# 10 11# Global variables used by these scripts: 12# 13# state - state variable that controls action of text proc. 14# 15# curFile - tail of current man page. 16# 17# file - file pointer; for both xref.tcl and contents.html 18# 19# NAME_file - array indexed by NAME and containing file names used 20# for hyperlinks. 21# 22# KEY_file - array indexed by KEYWORD and containing file names used 23# for hyperlinks. 24# 25# lib - contains package name. Used to label section in contents.html 26# 27# inDT - in dictionary term. 28 29 30 31# text -- 32# 33# This procedure adds entries to the hypertext arrays NAME_file 34# and KEY_file. 35# 36# DT: might do this: if first word of $dt matches $name and [llength $name==1] 37# and [llength $dt > 1], then add to NAME_file. 38# 39# Arguments: 40# string - Text to index. 41 42 43proc text string { 44 global state curFile NAME_file KEY_file inDT 45 46 switch $state { 47 NAME { 48 foreach i [split $string ","] { 49 lappend NAME_file([string trim $i]) $curFile 50 } 51 } 52 KEY { 53 foreach i [split $string ","] { 54 lappend KEY_file([string trim $i]) $curFile 55 } 56 } 57 DT - 58 OFF - 59 DASH {} 60 default { 61 puts stderr "text: unknown state: $state" 62 } 63 } 64} 65 66 67# macro -- 68# 69# This procedure is invoked to process macro invocations that start 70# with "." (instead of '). 71# 72# Arguments: 73# name - The name of the macro (without the "."). 74# args - Any additional arguments to the macro. 75 76proc macro {name args} { 77 switch $name { 78 SH { 79 global state 80 81 switch $args { 82 NAME { 83 if {$state == "INIT" } { 84 set state NAME 85 } 86 } 87 DESCRIPTION {set state DT} 88 INTRODUCTION {set state DT} 89 KEYWORDS {set state KEY} 90 default {set state OFF} 91 } 92 93 } 94 TP { 95 global inDT 96 set inDT 1 97 } 98 TH { 99 global lib state inDT 100 set inDT 0 101 set state INIT 102 if {[llength $args] != 5} { 103 set args [join $args " "] 104 puts stderr "Bad .TH macro: .$name $args" 105 } 106 set lib [lindex $args 3] ;# Tcl or Tk 107 } 108 } 109} 110 111 112 113# dash -- 114# 115# This procedure is invoked to handle dash characters ("\-" in 116# troff). It only function in pass1 is to terminate the NAME state. 117# 118# Arguments: 119# None. 120 121proc dash {} { 122 global state 123 if {$state == "NAME"} { 124 set state DASH 125 } 126} 127 128 129 130# newline -- 131# 132# This procedure is invoked to handle newlines in the troff input. 133# It's only purpose is to terminate a DT (dictionary term). 134# 135# Arguments: 136# None. 137 138proc newline {} { 139 global inDT 140 set inDT 0 141} 142 143 144 145 146# initGlobals, tab, font, char, macro2 -- 147# 148# These procedures do nothing during the first pass. 149# 150# Arguments: 151# None. 152 153proc initGlobals {} {} 154proc tab {} {} 155proc font type {} 156proc char name {} 157proc macro2 {name args} {} 158 159 160# doListing -- 161# 162# Writes an ls like list to a file. Searches NAME_file for entries 163# that match the input pattern. 164# 165# Arguments: 166# file - Output file pointer. 167# pattern - glob style match pattern 168 169proc doListing {file pattern} { 170 global NAME_file 171 172 set max_len 0 173 foreach name [lsort [array names NAME_file]] { 174 set ref $NAME_file($name) 175 if [string match $pattern $ref] { 176 lappend type $name 177 if {[string length $name] > $max_len} { 178 set max_len [string length $name] 179 } 180 } 181 } 182 if [catch {llength $type} ] { 183 puts stderr " doListing: no names matched pattern ($pattern)" 184 return 185 } 186 incr max_len 187 set ncols [expr 90/$max_len] 188 set nrows [expr int( ceil( [llength $type] / $ncols. ) ) ] 189 190# ? max_len ncols nrows 191 192 set index 0 193 foreach f $type { 194 lappend row([expr $index % $nrows]) $f 195 incr index 196 } 197 198 puts -nonewline $file "<PRE>" 199 for {set i 0} {$i<$nrows} {incr i} { 200 foreach name $row($i) { 201 set str [format "%-*s" $max_len $name] 202 regsub $name $str "<A HREF=\"$NAME_file($name).html\">$name</A>" str 203 puts -nonewline $file $str 204 } 205 puts $file {} 206 } 207 puts $file "</PRE>" 208} 209 210 211# doContents -- 212# 213# Generates a HTML contents file using the NAME_file array 214# as its input database. 215# 216# Arguments: 217# file - name of the contents file. 218# packageName - string used in the title and sub-heads of the HTML page. Normally 219# name of the package without version numbers. 220 221proc doContents {file packageName} { 222 global footer 223 224 set file [open $file w] 225 226 puts $file "<HTML><HEAD><TITLE>$packageName Manual</TITLE></HEAD><BODY>" 227 puts $file "<H3>$packageName</H3>" 228 doListing $file "*.1" 229 230 puts $file "<HR><H3>$packageName Commands</H3>" 231 doListing $file "*.n" 232 233 puts $file "<HR><H3>$packageName Library</H3>" 234 doListing $file "*.3" 235 236 puts $file $footer 237 puts $file "</BODY></HTML>" 238 close $file 239} 240 241 242 243 244# do -- 245# 246# This is the toplevel procedure that searches a man page 247# for hypertext links. It builds a data base consisting of 248# two arrays: NAME_file and KEY file. It runs the man2tcl 249# program to turn the man page into a script, then it evals 250# that script. 251# 252# Arguments: 253# fileName - Name of the file to scan. 254 255proc do fileName { 256 global curFile 257 set curFile [file tail $fileName] 258 set file stdout 259 puts " Pass 1 -- $fileName" 260 flush stdout 261 if [catch {eval [exec man2tcl [glob $fileName]]} msg] { 262 global errorInfo 263 puts stderr $msg 264 puts "in" 265 puts $errorInfo 266 exit 1 267 } 268} 269 270