os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/man2html1.tcl
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/man2html1.tcl Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,269 @@
1.4 +# man2html1.tcl --
1.5 +#
1.6 +# This file defines procedures that are used during the first pass of the
1.7 +# man page to html conversion process. It is sourced by h.tcl.
1.8 +#
1.9 +# Copyright (c) 1996 by Sun Microsystems, Inc.
1.10 +#
1.11 +# SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29
1.12 +#
1.13 +
1.14 +# Global variables used by these scripts:
1.15 +#
1.16 +# state - state variable that controls action of text proc.
1.17 +#
1.18 +# curFile - tail of current man page.
1.19 +#
1.20 +# file - file pointer; for both xref.tcl and contents.html
1.21 +#
1.22 +# NAME_file - array indexed by NAME and containing file names used
1.23 +# for hyperlinks.
1.24 +#
1.25 +# KEY_file - array indexed by KEYWORD and containing file names used
1.26 +# for hyperlinks.
1.27 +#
1.28 +# lib - contains package name. Used to label section in contents.html
1.29 +#
1.30 +# inDT - in dictionary term.
1.31 +
1.32 +
1.33 +
1.34 +# text --
1.35 +#
1.36 +# This procedure adds entries to the hypertext arrays NAME_file
1.37 +# and KEY_file.
1.38 +#
1.39 +# DT: might do this: if first word of $dt matches $name and [llength $name==1]
1.40 +# and [llength $dt > 1], then add to NAME_file.
1.41 +#
1.42 +# Arguments:
1.43 +# string - Text to index.
1.44 +
1.45 +
1.46 +proc text string {
1.47 + global state curFile NAME_file KEY_file inDT
1.48 +
1.49 + switch $state {
1.50 + NAME {
1.51 + foreach i [split $string ","] {
1.52 + lappend NAME_file([string trim $i]) $curFile
1.53 + }
1.54 + }
1.55 + KEY {
1.56 + foreach i [split $string ","] {
1.57 + lappend KEY_file([string trim $i]) $curFile
1.58 + }
1.59 + }
1.60 + DT -
1.61 + OFF -
1.62 + DASH {}
1.63 + default {
1.64 + puts stderr "text: unknown state: $state"
1.65 + }
1.66 + }
1.67 +}
1.68 +
1.69 +
1.70 +# macro --
1.71 +#
1.72 +# This procedure is invoked to process macro invocations that start
1.73 +# with "." (instead of ').
1.74 +#
1.75 +# Arguments:
1.76 +# name - The name of the macro (without the ".").
1.77 +# args - Any additional arguments to the macro.
1.78 +
1.79 +proc macro {name args} {
1.80 + switch $name {
1.81 + SH {
1.82 + global state
1.83 +
1.84 + switch $args {
1.85 + NAME {
1.86 + if {$state == "INIT" } {
1.87 + set state NAME
1.88 + }
1.89 + }
1.90 + DESCRIPTION {set state DT}
1.91 + INTRODUCTION {set state DT}
1.92 + KEYWORDS {set state KEY}
1.93 + default {set state OFF}
1.94 + }
1.95 +
1.96 + }
1.97 + TP {
1.98 + global inDT
1.99 + set inDT 1
1.100 + }
1.101 + TH {
1.102 + global lib state inDT
1.103 + set inDT 0
1.104 + set state INIT
1.105 + if {[llength $args] != 5} {
1.106 + set args [join $args " "]
1.107 + puts stderr "Bad .TH macro: .$name $args"
1.108 + }
1.109 + set lib [lindex $args 3] ;# Tcl or Tk
1.110 + }
1.111 + }
1.112 +}
1.113 +
1.114 +
1.115 +
1.116 +# dash --
1.117 +#
1.118 +# This procedure is invoked to handle dash characters ("\-" in
1.119 +# troff). It only function in pass1 is to terminate the NAME state.
1.120 +#
1.121 +# Arguments:
1.122 +# None.
1.123 +
1.124 +proc dash {} {
1.125 + global state
1.126 + if {$state == "NAME"} {
1.127 + set state DASH
1.128 + }
1.129 +}
1.130 +
1.131 +
1.132 +
1.133 +# newline --
1.134 +#
1.135 +# This procedure is invoked to handle newlines in the troff input.
1.136 +# It's only purpose is to terminate a DT (dictionary term).
1.137 +#
1.138 +# Arguments:
1.139 +# None.
1.140 +
1.141 +proc newline {} {
1.142 + global inDT
1.143 + set inDT 0
1.144 +}
1.145 +
1.146 +
1.147 +
1.148 +
1.149 +# initGlobals, tab, font, char, macro2 --
1.150 +#
1.151 +# These procedures do nothing during the first pass.
1.152 +#
1.153 +# Arguments:
1.154 +# None.
1.155 +
1.156 +proc initGlobals {} {}
1.157 +proc tab {} {}
1.158 +proc font type {}
1.159 +proc char name {}
1.160 +proc macro2 {name args} {}
1.161 +
1.162 +
1.163 +# doListing --
1.164 +#
1.165 +# Writes an ls like list to a file. Searches NAME_file for entries
1.166 +# that match the input pattern.
1.167 +#
1.168 +# Arguments:
1.169 +# file - Output file pointer.
1.170 +# pattern - glob style match pattern
1.171 +
1.172 +proc doListing {file pattern} {
1.173 + global NAME_file
1.174 +
1.175 + set max_len 0
1.176 + foreach name [lsort [array names NAME_file]] {
1.177 + set ref $NAME_file($name)
1.178 + if [string match $pattern $ref] {
1.179 + lappend type $name
1.180 + if {[string length $name] > $max_len} {
1.181 + set max_len [string length $name]
1.182 + }
1.183 + }
1.184 + }
1.185 + if [catch {llength $type} ] {
1.186 + puts stderr " doListing: no names matched pattern ($pattern)"
1.187 + return
1.188 + }
1.189 + incr max_len
1.190 + set ncols [expr 90/$max_len]
1.191 + set nrows [expr int( ceil( [llength $type] / $ncols. ) ) ]
1.192 +
1.193 +# ? max_len ncols nrows
1.194 +
1.195 + set index 0
1.196 + foreach f $type {
1.197 + lappend row([expr $index % $nrows]) $f
1.198 + incr index
1.199 + }
1.200 +
1.201 + puts -nonewline $file "<PRE>"
1.202 + for {set i 0} {$i<$nrows} {incr i} {
1.203 + foreach name $row($i) {
1.204 + set str [format "%-*s" $max_len $name]
1.205 + regsub $name $str "<A HREF=\"$NAME_file($name).html\">$name</A>" str
1.206 + puts -nonewline $file $str
1.207 + }
1.208 + puts $file {}
1.209 + }
1.210 + puts $file "</PRE>"
1.211 +}
1.212 +
1.213 +
1.214 +# doContents --
1.215 +#
1.216 +# Generates a HTML contents file using the NAME_file array
1.217 +# as its input database.
1.218 +#
1.219 +# Arguments:
1.220 +# file - name of the contents file.
1.221 +# packageName - string used in the title and sub-heads of the HTML page. Normally
1.222 +# name of the package without version numbers.
1.223 +
1.224 +proc doContents {file packageName} {
1.225 + global footer
1.226 +
1.227 + set file [open $file w]
1.228 +
1.229 + puts $file "<HTML><HEAD><TITLE>$packageName Manual</TITLE></HEAD><BODY>"
1.230 + puts $file "<H3>$packageName</H3>"
1.231 + doListing $file "*.1"
1.232 +
1.233 + puts $file "<HR><H3>$packageName Commands</H3>"
1.234 + doListing $file "*.n"
1.235 +
1.236 + puts $file "<HR><H3>$packageName Library</H3>"
1.237 + doListing $file "*.3"
1.238 +
1.239 + puts $file $footer
1.240 + puts $file "</BODY></HTML>"
1.241 + close $file
1.242 +}
1.243 +
1.244 +
1.245 +
1.246 +
1.247 +# do --
1.248 +#
1.249 +# This is the toplevel procedure that searches a man page
1.250 +# for hypertext links. It builds a data base consisting of
1.251 +# two arrays: NAME_file and KEY file. It runs the man2tcl
1.252 +# program to turn the man page into a script, then it evals
1.253 +# that script.
1.254 +#
1.255 +# Arguments:
1.256 +# fileName - Name of the file to scan.
1.257 +
1.258 +proc do fileName {
1.259 + global curFile
1.260 + set curFile [file tail $fileName]
1.261 + set file stdout
1.262 + puts " Pass 1 -- $fileName"
1.263 + flush stdout
1.264 + if [catch {eval [exec man2tcl [glob $fileName]]} msg] {
1.265 + global errorInfo
1.266 + puts stderr $msg
1.267 + puts "in"
1.268 + puts $errorInfo
1.269 + exit 1
1.270 + }
1.271 +}
1.272 +