diff options
Diffstat (limited to 'tools')
| -rw-r--r-- | tools/Makefile.in | 49 | ||||
| -rw-r--r-- | tools/README | 4 | ||||
| -rw-r--r-- | tools/configure.in | 18 | ||||
| -rw-r--r-- | tools/index.tcl | 198 | ||||
| -rw-r--r-- | tools/man2help.tcl | 129 | ||||
| -rw-r--r-- | tools/man2help2.tcl | 950 | ||||
| -rw-r--r-- | tools/man2tcl.c | 400 | ||||
| -rw-r--r-- | tools/tcl.hpj | 14 |
8 files changed, 1762 insertions, 0 deletions
diff --git a/tools/Makefile.in b/tools/Makefile.in new file mode 100644 index 0000000..ceb539d --- /dev/null +++ b/tools/Makefile.in @@ -0,0 +1,49 @@ +# This makefile is used to convert Tcl manual pages into various +# alternate formats: +# +# Windows help file: 1. Build the winhelp target on Unix +# 2. Build the helpfile target on Windows +# +# HTML: 1. Build the html target on Unix + +# SCCS: %Z% $Id: Makefile.in,v 1.1 1998/04/28 18:53:49 stanton Exp $ + +TCL = tcl@TCL_VERSION@@TCL_PATCH_LEVEL@ +TK = tk@TCL_VERSION@@TCL_PATCH_LEVEL@ +VER=@TCL_WIN_VERSION@ + +TCL_SOURCE = @srcdir@/.. +TK_SOURCE = @srcdir@/../../$(TK) + +TCL_DOCS = \ + $(TCL_SOURCE)/doc/*.[13n] + +TK_DOCS = \ + $(TK_SOURCE)/doc/*.[13n] + +TCLSH = $(TCL_SOURCE)/unix/tclsh + + +all: winhelp + +winhelp: tcl.rtf +html: tcl$(VER).html + +man2tcl: man2tcl.c + $(CC) $(CFLAGS) -o man2tcl man2tcl.c + +tcl.rtf: man2help.tcl man2tcl $(TCL_DOCS) $(TK_DOCS) + $(TCLSH) man2help.tcl tcl $(VER) \ + $(TCL_SOURCE)/doc $(TK_SOURCE)/doc + +tcl$(VER).html: man2html.tcl man2tcl $(TCL_DOCS) $(TK_DOCS) + $(TCLSH) man2html.tcl tcl$(VER).html \ + ../.. ${TCL} ${TK} + +clean: + -rm -f man2tcl *.o tcl$(VER).cnt tcl$(VER).rtf + +helpfile: + hc31 tcl.hpj + mv tcl.hlp tcl$(VER).hlp + diff --git a/tools/README b/tools/README new file mode 100644 index 0000000..67cac12 --- /dev/null +++ b/tools/README @@ -0,0 +1,4 @@ + + This directory contains unsupported tools that are used + during the release engineering process. + diff --git a/tools/configure.in b/tools/configure.in new file mode 100644 index 0000000..1e8f726 --- /dev/null +++ b/tools/configure.in @@ -0,0 +1,18 @@ +dnl This file is an input file used by the GNU "autoconf" program to +dnl generate the file "configure", which is run to configure the +dnl Makefile in this directory. +AC_INIT(man2tcl.c) +# SCCS: %Z% $Id: configure.in,v 1.1 1998/04/28 18:53:49 stanton Exp $ + +# Recover information that Tcl computed with its configure script. + +. ../unix/tclConfig.sh + +TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION +AC_SUBST(TCL_WIN_VERSION) +CC=$TCL_CC +AC_SUBST(CC) +AC_SUBST(TCL_VERSION) +AC_SUBST(TCL_PATCH_LEVEL) + +AC_OUTPUT(Makefile) diff --git a/tools/index.tcl b/tools/index.tcl new file mode 100644 index 0000000..35f3638 --- /dev/null +++ b/tools/index.tcl @@ -0,0 +1,198 @@ +# index.tcl -- +# +# This file defines procedures that are used during the first pass of +# the man page conversion. It is used to extract information used to +# generate a table of contents and a keyword list. +# +# Copyright (c) 1996 by Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: %Z% $Id: index.tcl,v 1.1 1998/04/28 18:53:50 stanton Exp $ +# + +# Global variables used by these scripts: +# +# state - state variable that controls action of text proc. +# +# topics - array indexed by (package,section,topic) with value +# of topic ID. +# +# keywords - array indexed by keyword string with value of topic ID. +# +# curID - current topic ID, starts at 0 and is incremented for +# each new topic file. +# +# curPkg - current package name (e.g. Tcl). +# +# curSect - current section title (e.g. "Tcl Built-In Commands"). +# + +# getPackages -- +# +# Generate a sorted list of package names from the topics array. +# +# Arguments: +# none. + +proc getPackages {} { + global topics + foreach i [array names topics] { + regsub {^(.*),.*,.*$} $i {\1} i + set temp($i) {} + } + lsort [array names temp] +} + +# getSections -- +# +# Generate a sorted list of section titles in the specified package +# from the topics array. +# +# Arguments: +# pkg - Name of package to search. + +proc getSections {pkg} { + global topics + foreach i [array names topics "${pkg},*"] { + regsub {^.*,(.*),.*$} $i {\1} i + set temp($i) {} + } + lsort [array names temp] +} + +# getSections -- +# +# Generate a sorted list of topics in the specified section of the +# specified package from the topics array. +# +# Arguments: +# pkg - Name of package to search. +# sect - Name of section to search. + +proc getTopics {pkg sect} { + global topics + foreach i [array names topics "${pkg},${sect},*"] { + regsub {^.*,.*,(.*)$} $i {\1} i + set temp($i) {} + } + lsort [array names temp] +} + +# text -- +# +# This procedure adds entries to the hypertext arrays topics and keywords. +# +# Arguments: +# string - Text to index. + + +proc text string { + global state curID curPkg curSect topics keywords + + switch $state { + NAME { + foreach i [split $string ","] { + set topic [string trim $i] + set index "$curPkg,$curSect,$topic" + if {[info exists topics($index)] + && [string compare $topics($index) $curID] != 0} { + puts stderr "duplicate topic $topic in $curPkg" + } + set topics($index) $curID + lappend keywords($topic) $curID + } + } + KEY { + foreach i [split $string ","] { + lappend keywords([string trim $i]) $curID + } + } + 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} + } + + } + TH { + global state curID curPkg curSect topics keywords + set state INIT + if {[llength $args] != 5} { + set args [join $args " "] + puts stderr "Bad .TH macro: .$name $args" + } + incr curID + set topic [lindex $args 0] ;# Tcl_UpVar + set curPkg [lindex $args 3] ;# Tcl + set curSect [lindex $args 4] ;# {Tcl Library Procedures} + set index "$curPkg,$curSect,$topic" + set topics($index) $curID + lappend keywords($topic) $curID + } + } +} + + +# 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 + } +} + + + +# initGlobals, tab, font, char, macro2 -- +# +# These procedures do nothing during the first pass. +# +# Arguments: +# None. + +proc initGlobals {} {} +proc newline {} {} +proc tab {} {} +proc font type {} +proc char name {} +proc macro2 {name args} {} + diff --git a/tools/man2help.tcl b/tools/man2help.tcl new file mode 100644 index 0000000..daaefca --- /dev/null +++ b/tools/man2help.tcl @@ -0,0 +1,129 @@ +# man2help.tcl -- +# +# This file defines procedures that work in conjunction with the +# man2tcl program to generate a Windows help file from Tcl manual +# entries. +# +# Copyright (c) 1996 by Sun Microsystems, Inc. +# +# SCCS: %Z% $Id: man2help.tcl,v 1.1 1998/04/28 18:53:50 stanton Exp $ +# + +# +# PASS 1 +# + +proc generateContents {basename version files} { + global curID topics + set curID 0 + foreach f $files { + regsub -all -- {-} [file tail $f] {} curFile + puts "Pass 1 -- $f" + flush stdout + doFile $f + } + set fd [open "$basename$version.cnt" w] + puts $fd ":Base $basename$version.hlp" + foreach package [getPackages] { + foreach section [getSections $package] { + puts $fd "1 $section" + set lastTopic {} + foreach topic [getTopics $package $section] { + if {[string compare $lastTopic $topic] != 0} { + set id $topics($package,$section,$topic) + puts $fd "2 $topic=$id" + set lastTopic $topic + } + } + } + } + close $fd +} + + +# +# PASS 2 +# + +proc generateHelp {basename files} { + global curID topics keywords file id_keywords + set curID 0 + + foreach key [array names keywords] { + foreach id $keywords($key) { + lappend id_keywords($id) $key + } + } + + set file [open "$basename.rtf" w] + puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\}" + foreach f $files { + regsub -all -- {-} [file tail $f] {} curFile + puts "Pass 2 -- $f" + flush stdout + initGlobals + doFile $f + pageBreak + } + puts $file "\}" + close $file +} + +# doFile -- +# +# Given a file as argument, translate the file to a tcl script and +# evaluate it. +# +# Arguments: +# file - Name of file to translate. + +proc doFile {file} { + if [catch {eval [exec man2tcl [glob $file]]} msg] { + global errorInfo + puts stderr $msg + puts "in" + puts $errorInfo + exit 1 + } +} + +# doDir -- +# +# Given a directory as argument, translate all the man pages in +# that directory. +# +# Arguments: +# dir - Name of the directory. + +proc doDir dir { + puts "Generating man pages for $dir..." + foreach f [lsort [glob [file join $dir *.\[13n\]]]] { + do $f + } +} + +# process command line arguments + +if {$argc < 3} { + puts stderr "usage: $argv0 projectName version manFiles..." + exit 1 +} + +set baseName [lindex $argv 0] +set version [lindex $argv 1] +set files {} +foreach i [lrange $argv 2 end] { + set i [file join $i] + if [file isdir $i] { + foreach f [lsort [glob [file join $i *.\[13n\]]]] { + lappend files $f + } + } elseif [file exists $i] { + lappend files $i + } +} + +source [file join [file dir $argv0] index.tcl] +generateContents $baseName $version $files +source [file join [file dir $argv0] man2help2.tcl] +generateHelp $baseName $files diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl new file mode 100644 index 0000000..f1df4fb --- /dev/null +++ b/tools/man2help2.tcl @@ -0,0 +1,950 @@ +# man2help2.tcl -- +# +# This file defines procedures that are used during the second pass of +# the man page conversion. It converts the man format input to rtf +# form suitable for use by the Windows help compiler. +# +# Copyright (c) 1996 by Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: %Z% $Id: man2help2.tcl,v 1.1 1998/04/28 18:53:51 stanton Exp $ +# + +# Global variables used by these scripts: +# +# state - state variable that controls action of text proc. +# +# topics - array indexed by (package,section,topic) with value +# of topic ID. +# +# keywords - array indexed by keyword string with value of topic ID. +# +# curID - current topic ID, starts at 0 and is incremented for +# each new topic file. +# +# curPkg - current package name (e.g. Tcl). +# +# curSect - current section title (e.g. "Tcl Built-In Commands"). +# + +# initGlobals -- +# +# This procedure is invoked to set the initial values of all of the +# global variables, before processing a man page. +# +# Arguments: +# None. + +proc initGlobals {} { + uplevel \#0 unset state + global state chars + + set state(paragraphPending) 0 + set state(breakPending) 0 + set state(firstIndent) 0 + set state(leftIndent) 0 + + set state(inTP) 0 + set state(paragraph) 0 + set state(textState) 0 + set state(curFont) "" + set state(startCode) "{\\b " + set state(startEmphasis) "{\\i " + set state(endCode) "}" + set state(endEmphasis) "}" + set state(noFill) 0 + set state(charCnt) 0 + set state(offset) [getTwips 0.5i] + set state(leftMargin) [getTwips 0.5i] + set state(nestingLevel) 0 + set state(intl) 0 + setTabs 0.5i + +# set up international character table + + array set chars { + o^ F4 + } +} + + +# beginFont -- +# +# Arranges for future text to use a special font, rather than +# the default paragraph font. +# +# Arguments: +# font - Name of new font to use. + +proc beginFont {font} { + global file state + + textSetup + if {$state(curFont) == $font} { + return + } + endFont + puts -nonewline $file $state(start$font) + set state(curFont) $font +} + + +# endFont -- +# +# Reverts to the default font for the paragraph type. +# +# Arguments: +# None. + +proc endFont {} { + global state file + + if {$state(curFont) != ""} { + puts -nonewline $file $state(end$state(curFont)) + set state(curFont) "" + } +} + + +# textSetup -- +# +# This procedure is called the first time that text is output for a +# paragraph. It outputs the header information for the paragraph. +# +# Arguments: +# None. + +proc textSetup {} { + global file state + + if $state(breakPending) { + puts $file "\\line" + } + if $state(paragraphPending) { + puts $file [format "\\par\n\\pard\\fi%.0f\\li%.0f" \ + $state(firstIndent) $state(leftIndent)] + } + set state(breakPending) 0 + set state(paragraphPending) 0 +} + + +# text -- +# +# This procedure adds text to the current state(paragraph). If this is +# the first text in the state(paragraph) then header information for the +# state(paragraph) is output before the text. +# +# Arguments: +# string - Text to output in the state(paragraph). + +proc text {string} { + global file state chars + + textSetup + regsub -all "(\[\\\\\{\}\])" $string {\\\1} string + regsub -all { } $string {\\tab } string + regsub -all '' $string \" string + regsub -all `` $string \" string + +# Check if this is the beginning of an international character string. +# If so, look up the sequence in the chars table and substitute the +# appropriate hex value. + + if {$state(intl)} { + if {[regexp {^'([^']*)'} $string dummy ch]} { + if {[info exists chars($ch)]} { + regsub {^'[^']*'} $string "\\\\'$chars($ch)" string + } else { + puts stderr "Unknown international character '$ch'" + } + } + set state(intl) 0 + } + + switch $state(textState) { + REF { + if {$state(inTP) == 0} { + set string [insertRef $string] + } + } + SEE { + global topics curPkg curSect + foreach i [split $string] { + if ![regexp -nocase {^[a-z_]+} [string trim $i] i ] { + continue + } + if ![catch {set ref $topics($curPkg,$curSect,$i)} ] { + regsub $i $string [link $i $ref] string + } + } + } + KEY { + return + } + } + puts -nonewline $file "$string" +} + + + +# insertRef -- +# +# This procedure looks for a string in the cross reference table and +# generates a hot-link to the appropriate topic. Tries to find the +# nearest reference in the manual. +# +# Arguments: +# string - Text to output in the state(paragraph). + +proc insertRef {string} { + global NAME_file curPkg curSect topics curID + set path {} + set string [string trim $string] + set ref {} + if [info exists topics($curPkg,$curSect,$string)] { + set ref $topics($curPkg,$curSect,$string) + } else { + set sites [array names topics "$curPkg,*,$string"] + set count [llength $sites] + if {$count > 0} { + set ref $topics([lindex $sites 0]) + } else { + set sites [array names topics "*,*,$string"] + set count [llength $sites] + if {$count > 0} { + set ref $topics([lindex $sites 0]) + } + } + } + + if {([string compare $ref {}] != 0) && ($ref != $curID)} { + set string [link $string $ref] + } + return $string +} + + + +# 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} { + global state file + switch $name { + AP { + if {[llength $args] != 3 && [llength $args] != 2} { + puts stderr "Bad .AP macro: .$name [join $args " "]" + } + newPara 3.75i -3.75i + setTabs {1.25i 2.5i 3.75i} + font B + text [lindex $args 0] + tab + font I + text [lindex $args 1] + tab + font R + if {[llength $args] == 3} { + text "([lindex $args 2])" + } + tab + } + AS {} ;# next page and previous page + br { + lineBreak + } + BS {} + BE {} + CE { + decrNestingLevel + set state(noFill) 0 + set state(breakPending) 0 + newPara 0i + } + CS { ;# code section + incrNestingLevel + set state(noFill) 1 + newPara 0i + } + DE { + set state(noFill) 0 + decrNestingLevel + newPara 0i + } + DS { + set state(noFill) 1 + incrNestingLevel + newPara 0i + } + fi { + set state(noFill) 0 + } + IP { + IPmacro $args + } + LP { + newPara 0i + } + ne { + } + nf { + set state(noFill) 1 + } + OP { + if {[llength $args] != 3} { + puts stderr "Bad .OP macro: .$name [join $args " "]" + } + set state(nestingLevel) 0 + set state(breakPending) 1 + newPara 0i + setTabs 4c + text "Command-Line Name:" + tab + font B + set x [lindex $args 0] + regsub -all {\\-} $x - x + text $x + lineBreak + font R + text "Database Name:" + tab + font B + text [lindex $args 1] + lineBreak + font R + text "Database Class:" + tab + font B + text [lindex $args 2] + font R + set state(inTP) 0 + newPara 0.5i + set state(breakPending) 1 + } + PP { + set state(breakPending) 1 + newPara 0i + } + RE { + decrNestingLevel + } + RS { + incrNestingLevel + } + SE { + font R + set state(noFill) 0 + set state(nestingLevel) 0 + newPara 0i + text "See the " + font B + set temp $state(textState) + set state(textState) REF + text options + set state(textState) $temp + font R + text " manual entry for detailed descriptions of the above options." + } + SH { + SHmacro $args + } + SO { + SHmacro "STANDARD OPTIONS" + set state(nestingLevel) 0 + newPara 0i + setTabs {4c 8c 12c} + font B + set state(noFill) 1 + } + so { + if {$args != "man.macros"} { + puts stderr "Unknown macro: .$name [join $args " "]" + } + } + sp { ;# needs work + if {$args == ""} { + set count 1 + } else { + set count [lindex $args 0] + } + while {$count > 0} { + lineBreak + incr count -1 + } + } + ta { + setTabs $args + } + TH { + THmacro $args + } + TP { + TPmacro $args + } + UL { ;# underline + puts -nonewline $file "{\\ul " + text [lindex $args 0] + puts -nonewline $file "}" + if {[llength $args] == 2} { + text [lindex $args 1] + } + } + VE {} + VS {} + default { + puts stderr "Unknown macro: .$name [join $args " "]" + } + } +} + + +# link -- +# +# This procedure returns the string for a hot link to a different +# context location. +# +# Arguments: +# label - String to display in hot-spot. +# id - Context string to jump to. + +proc link {label id} { + return "{\\uldb $label}{\\v $id}" +} + + +# font -- +# +# This procedure is invoked to handle font changes in the text +# being output. +# +# Arguments: +# type - Type of font: R, I, B, or S. + +proc font {type} { + global state + switch $type { + P - + R { + endFont + if {$state(textState) == "REF"} { + set state(textState) INSERT + } + } + B { + beginFont Code + if {$state(textState) == "INSERT"} { + set state(textState) REF + } + } + I { + beginFont Emphasis + } + S { + } + default { + puts stderr "Unknown font: $type" + } + } +} + + + +# formattedText -- +# +# Insert a text string that may also have \fB-style font changes +# and a few other backslash sequences in it. +# +# Arguments: +# text - Text to insert. + +proc formattedText {text} { + global chars + + while {$text != ""} { + set index [string first \\ $text] + if {$index < 0} { + text $text + return + } + text [string range $text 0 [expr $index-1]] + set c [string index $text [expr $index+1]] + switch -- $c { + f { + font [string index $text [expr $index+2]] + set text [string range $text [expr $index+3] end] + } + e { + text \\ + set text [string range $text [expr $index+2] end] + } + - { + dash + set text [string range $text [expr $index+2] end] + } + | { + set text [string range $text [expr $index+2] end] + } + o { + text \\' + regexp "'([^']*)'(.*)" $text all ch text + text $chars($ch) + } + default { + puts stderr "Unknown sequence: \\$c" + set text [string range $text [expr $index+2] end] + } + } + } +} + + + +# dash -- +# +# This procedure is invoked to handle dash characters ("\-" in +# troff). It outputs a special dash character. +# +# Arguments: +# None. + +proc dash {} { + global state + if {$state(textState) == "NAME"} { + set state(textState) 0 + } + text "-" +} + + +# tab -- +# +# This procedure is invoked to handle tabs in the troff input. +# Right now it does nothing. +# +# Arguments: +# None. + +proc tab {} { + global file + + textSetup + puts -nonewline $file "\\tab " +} + + +# setTabs -- +# +# This procedure handles the ".ta" macro, which sets tab stops. +# +# Arguments: +# tabList - List of tab stops, each consisting of a number +# followed by "i" (inch) or "c" (cm). + +proc setTabs {tabList} { + global file state + + foreach arg $tabList { + set distance [expr $state(leftMargin) \ + + $state(offset) * $state(nestingLevel) \ + + [getTwips $arg]] + puts $file [format "\\tx%.0f" [expr round($distance)]] + } +} + + + +# lineBreak -- +# +# Generates a line break in the HTML output. +# +# Arguments: +# None. + +proc lineBreak {} { + global state + textSetup + set state(breakPending) 1 +} + + + +# newline -- +# +# This procedure is invoked to handle newlines in the troff input. +# It outputs either a space character or a newline character, depending +# on fill mode. +# +# Arguments: +# None. + +proc newline {} { + global state + + if $state(inTP) { + set state(inTP) 0 + lineBreak + } elseif $state(noFill) { + lineBreak + } else { + text " " + } +} + + +# pageBreak -- +# +# This procedure is invoked to generate a page break. +# +# Arguments: +# None. + +proc pageBreak {} { + global file + puts $file "\\page" +} + + +# char -- +# +# This procedure is called to handle a special character. +# +# Arguments: +# name - Special character named in troff \x or \(xx construct. + +proc char {name} { + global file state + + switch -exact $name { + \\o { + set state(intl) 1 + } + \\0 { + textSetup + puts -nonewline $file " \\emspace " + } + \\\\ { + textSetup + puts -nonewline $file "\\\\" + } + \\(+- { + textSetup + puts -nonewline $file "\\'b1 " + } + \\% - + \\| { + } + default { + puts stderr "Unknown character: $name" + } + } +} + + +# macro2 -- +# +# This procedure handles macros that are invoked with a leading "'" +# character instead of space. Right now it just generates an +# error diagnostic. +# +# Arguments: +# name - The name of the macro (without the "."). +# args - Any additional arguments to the macro. + +proc macro2 {name args} { + puts stderr "Unknown macro: '$name [join $args " "]" +} + + + +# SHmacro -- +# +# Subsection head; handles the .SH macro. +# +# Arguments: +# name - Section name. + +proc SHmacro {argList} { + global file state + + set args [join $argList " "] + if {[llength $argList] < 1} { + puts stderr "Bad .SH macro: .$name $args" + } + + # control what the text proc does with text + + switch $args { + NAME {set state(textState) NAME} + DESCRIPTION {set state(textState) INSERT} + INTRODUCTION {set state(textState) INSERT} + "WIDGET-SPECIFIC OPTIONS" {set state(textState) INSERT} + "SEE ALSO" {set state(textState) SEE} + KEYWORDS {set state(textState) KEY; return} + } + + if {$state(breakPending) != -1} { + set state(breakPending) 1 + } else { + set state(breakPending) 0 + } + set state(noFill) 0 + nextPara 0i + font B + text $args + font R + nextPara .5i +} + + + +# IPmacro -- +# +# This procedure is invoked to handle ".IP" macros, which may take any +# of the following forms: +# +# .IP [1] Translate to a "1Step" state(paragraph). +# .IP [x] (x > 1) Translate to a "Step" state(paragraph). +# .IP Translate to a "Bullet" state(paragraph). +# .IP text count Translate to a FirstBody state(paragraph) with special +# indent and tab stop based on "count", and tab after +# "text". +# +# Arguments: +# argList - List of arguments to the .IP macro. +# +# HTML limitations: 'count' in '.IP text count' is ignored. + +proc IPmacro {argList} { + global file state + + set length [llength $argList] + if {$length == 0} { + newPara 0.5i + return + } + if {$length == 1} { + set arg [lindex $argList 0] + if {$arg == {[1]}} { + newPara 0.5i + return + } + if {[regexp {^\[[0-9]*\]$} $arg] == 1} { + newPara 0.5i + return + } + newPara 0.5i -0.5i + setTabs 0.5i + formattedText [lindex $argList 0] + tab + return + } + if {$length == 2} { + set count [lindex $argList 1] + set tab [expr $count * 0.1]i + newPara $tab -$tab + setTabs $tab + formattedText [lindex $argList 0] + tab + return + } + puts stderr "Bad .IP macro: .IP [join $argList " "]" +} + + +# TPmacro -- +# +# This procedure is invoked to handle ".TP" macros, which may take any +# of the following forms: +# +# .TP x Translate to an state(indent)ed state(paragraph) with the +# specified state(indent) (in 100 twip units). +# .TP Translate to an state(indent)ed state(paragraph) with +# default state(indent). +# +# Arguments: +# argList - List of arguments to the .IP macro. +# +# HTML limitations: 'x' in '.TP x' is ignored. + + +proc TPmacro {argList} { + global state + set length [llength $argList] + if {$length == 0} { + set val 0.5i + } else { + set val [expr ([lindex $argList 0] * 100.0)/1440]i + } + newPara $val -$val + setTabs $val + set state(inTP) 1 + set state(breakPending) 1 +} + + + +# THmacro -- +# +# This procedure handles the .TH macro. It generates the non-scrolling +# header section for a given man page, and enters information into the +# table of contents. The .TH macro has the following form: +# +# .TH name section date footer header +# +# Arguments: +# argList - List of arguments to the .TH macro. + +proc THmacro {argList} { + global file curPkg curSect curID id_keywords state + + if {[llength $argList] != 5} { + set args [join $argList " "] + puts stderr "Bad .TH macro: .$name $args" + } + incr curID + set name [lindex $argList 0] ;# Tcl_UpVar + set page [lindex $argList 1] ;# 3 + set vers [lindex $argList 2] ;# 7.4 + set curPkg [lindex $argList 3] ;# Tcl + set curSect [lindex $argList 4] ;# {Tcl Library Procedures} + + puts $file "#{\\footnote $curID}" ;# Context string + puts $file "\${\\footnote $name}" ;# Topic title + set browse "${curSect}${name}" + regsub -all {[ _-]} $browse {} browse + puts $file "+{\\footnote $browse}" ;# Browse sequence + + # Suppress duplicates + foreach i $id_keywords($curID) { + set keys($i) 1 + } + foreach i [array names keys] { + set i [string trim $i] + if {[string length $i] > 0} { + puts $file "K{\\footnote $i}" ;# Keyword strings + } + } + unset keys + puts $file "\\pard\\tx3000\\sb100\\sa100\\fs24\\keepn" + font B + text $name + tab + text $curSect + font R + puts $file "\\fs20" + set state(breakPending) -1 +} + +# nextPara -- +# +# Set the indents for a new paragraph, and start a paragraph break +# +# Arguments: +# leftIndent - The new left margin for body lines. +# firstIndent - The offset from the left margin for the first line. + +proc nextPara {leftIndent {firstIndent 0i}} { + global state + set state(leftIndent) [getTwips $leftIndent] + set state(firstIndent) [getTwips $firstIndent] + set state(paragraphPending) 1 +} + + +# newPara -- +# +# This procedure sets the left and hanging state(indent)s for a line. +# State(Indent)s are specified in units of inches or centimeters, and are +# relative to the current nesting level and left margin. +# +# Arguments: +# leftState(Indent) - The new left margin for lines after the first. +# firstState(Indent) - The new left margin for the first line of a state(paragraph). + +proc newPara {leftIndent {firstIndent 0i}} { + global state file + if $state(paragraph) { + puts -nonewline $file "\\line\n" + } + set state(leftIndent) [expr $state(leftMargin) \ + + $state(offset) * $state(nestingLevel) \ + + [getTwips $leftIndent]] + set state(firstIndent) [getTwips $firstIndent] + set state(paragraphPending) 1 +} + + + +# getTwips -- +# +# This procedure converts a distance in inches or centimeters into +# twips (1/1440 of an inch). +# +# Arguments: +# arg - A number followed by "i" or "c" + +proc getTwips {arg} { + if {[scan $arg "%f%s" distance units] != 2} { + puts stderr "bad distance \"$arg\"" + return 0 + } + switch -- $units { + c { + set distance [expr $distance * 567] + } + i { + set distance [expr $distance * 1440] + } + default { + puts stderr "bad units in distance \"$arg\"" + continue + } + } + return $distance +} + +# incrNestingLevel -- +# +# This procedure does the work of the .RS macro, which increments +# the number of state(indent)ations that affect things like .PP. +# +# Arguments: +# None. + +proc incrNestingLevel {} { + global state + + incr state(nestingLevel) + set oldp $state(paragraph) + set state(paragraph) 0 + newPara 0i + set state(paragraph) $oldp +} + +# decrNestingLevel -- +# +# This procedure does the work of the .RE macro, which decrements +# the number of indentations that affect things like .PP. +# +# Arguments: +# None. + +proc decrNestingLevel {} { + global state + + if {$state(nestingLevel) == 0} { + puts stderr "Nesting level decremented below 0" + } else { + incr state(nestingLevel) -1 + } +} + diff --git a/tools/man2tcl.c b/tools/man2tcl.c new file mode 100644 index 0000000..2b3c426 --- /dev/null +++ b/tools/man2tcl.c @@ -0,0 +1,400 @@ +/* + * man2tcl.c -- + * + * This file contains a program that turns a man page of the + * form used for Tcl and Tk into a Tcl script that invokes + * a Tcl command for each construct in the man page. The + * script can then be eval'ed to translate the manual entry + * into some other format such as MIF or HTML. + * + * Usage: + * + * man2tcl ?fileName? + * + * Copyright (c) 1995 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * SCCS: %Z% $Id: man2tcl.c,v 1.1 1998/04/28 18:53:52 stanton Exp $ + */ + +#include <stdio.h> +#include <string.h> +#include <ctype.h> + +/* + * Imported things that aren't defined in header files: + */ + +extern int errno; + +/* + * Current line number, used for error messages. + */ + +static int lineNumber; + +/* + * The variable below is set to 1 if an error occurs anywhere + * while reading in the file. + */ + +static int status; + +/* + * The variable below is set to 1 if output should be generated. + * If it's 0, it means we're doing a pre-pass to make sure that + * the file can be properly parsed. + */ + +static int writeOutput; + +/* + * Prototypes for procedures defined in this file: + */ + +static void DoMacro(char *line); +static void DoText(char *line); +static void QuoteText(char *string, int count); + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This procedure is the main program, which does all of the work + * of the program. + * + * Results: + * None: exits with a 0 return status to indicate success, or + * 1 to indicate that there were problems in the translation. + * + * Side effects: + * A Tcl script is output to standard output. Error messages may + * be output on standard error. + * + *---------------------------------------------------------------------- + */ + +int +main(argc, argv) + int argc; /* Number of command-line arguments. */ + char **argv; /* Values of command-line arguments. */ +{ + FILE *f; +#define MAX_LINE_SIZE 500 + char line[MAX_LINE_SIZE]; + char *p; + + /* + * Find the file to read, and open it if it isn't stdin. + */ + + if (argc == 1) { + f = stdin; + } else if (argc == 2) { + f = fopen(argv[1], "r"); + if (f == NULL) { + fprintf(stderr, "Couldn't read \"%s\": %s\n", argv[1], + strerror(errno)); + exit(1); + } + } else { + fprintf(stderr, "Usage: %s ?fileName?\n", argv[0]); + } + + /* + * Make two passes over the file. In the first pass, just check + * to make sure we can handle everything. If there are problems, + * generate output and stop. If everything is OK, make a second + * pass to actually generate output. + */ + + for (writeOutput = 0; writeOutput < 2; writeOutput++) { + lineNumber = 0; + status = 0; + while (fgets(line, MAX_LINE_SIZE, f) != NULL) { + for (p = line; *p != 0; p++) { + if (*p == '\n') { + *p = 0; + break; + } + } + lineNumber++; + + if ((line[0] == '\'') && (line[1] == '\\') && (line[2] == '\"')) { + /* + * This line is a comment. Ignore it. + */ + + continue; + } + + if ((line[0] == '.') || (line[0] == '\'')) { + /* + * This line is a macro invocation. + */ + + DoMacro(line); + } else { + /* + * This line is text, possibly with formatting characters + * embedded in it. + */ + + DoText(line); + } + } + if (status != 0) { + break; + } + fseek(f, 0, SEEK_SET); + } + exit(status); +} + +/* + *---------------------------------------------------------------------- + * + * DoMacro -- + * + * This procedure is called to handle a macro invocation. + * It parses the arguments to the macro and generates a + * Tcl command to handle the invocation. + * + * Results: + * None. + * + * Side effects: + * A Tcl command is written to stdout. + * + *---------------------------------------------------------------------- + */ + +static void +DoMacro(line) + char *line; /* The line of text that contains the + * macro invocation. */ +{ + char *p, *end; + + /* + * If there is no macro name, then just skip the whole line. + */ + + if ((line[1] == 0) || (isspace(line[1]))) { + return; + } + + if (writeOutput) { + printf("macro"); + } + if (*line != '.') { + if (writeOutput) { + printf("2"); + } + } + + /* + * Parse the arguments to the macro (including the name), in order. + */ + + p = line+1; + while (1) { + if (writeOutput) { + putc(' ', stdout); + } + if (*p == '"') { + /* + * The argument is delimited by quotes. + */ + + for (end = p+1; *end != '"'; end++) { + if (*end == 0) { + fprintf(stderr, + "Unclosed quote in macro call on line %d.\n", + lineNumber); + status = 1; + break; + } + } + QuoteText(p+1, (end-(p+1))); + } else { + for (end = p+1; (*end != 0) && !isspace(*end); end++) { + /* Empty loop body. */ + } + QuoteText(p, end-p); + } + if (*end == 0) { + break; + } + p = end+1; + while (isspace(*p)) { + /* + * Skip empty space before next argument. + */ + + p++; + } + if (*p == 0) { + break; + } + } + if (writeOutput) { + putc('\n', stdout); + } +} + +/* + *---------------------------------------------------------------------- + * + * DoText -- + * + * This procedure is called to handle a line of troff text. + * It parses the text, generating Tcl commands for text and + * for formatting stuff such as font changes. + * + * Results: + * None. + * + * Side effects: + * Tcl commands are written to stdout. + * + *---------------------------------------------------------------------- + */ + +static void +DoText(line) + char *line; /* The line of text. */ +{ + char *p, *end; + + /* + * Divide the line up into pieces consisting of backslash sequences, + * tabs, and other text. + */ + + p = line; + while (*p != 0) { + if (*p == '\t') { + if (writeOutput) { + printf("tab\n"); + } + p++; + } else if (*p != '\\') { + /* + * Ordinary text. + */ + + for (end = p+1; (*end != '\\') && (*end != 0); end++) { + /* Empty loop body. */ + } + if (writeOutput) { + printf("text "); + } + QuoteText(p, end-p); + if (writeOutput) { + putc('\n', stdout); + } + p = end; + } else { + /* + * A backslash sequence. There are particular ones + * that we understand; output an error message for + * anything else and just ignore the backslash. + */ + + p++; + if (*p == 'f') { + /* + * Font change. + */ + + if (writeOutput) { + printf("font %c\n", p[1]); + } + p += 2; + } else if (*p == '-') { + if (writeOutput) { + printf("dash\n"); + } + p++; + } else if (*p == 'e') { + if (writeOutput) { + printf("text \\\\\n"); + } + p++; + } else if (*p == '.') { + if (writeOutput) { + printf("text .\n"); + } + p++; + } else if (*p == '&') { + p++; + } else if (*p == '(') { + if ((p[1] == 0) || (p[2] == 0)) { + fprintf(stderr, "Bad \\( sequence on line %d.\n", + lineNumber); + status = 1; + } else { + if (writeOutput) { + printf("char {\\(%c%c}\n", p[1], p[2]); + } + p += 3; + } + } else if (*p != 0) { + if (writeOutput) { + printf("char {\\%c}\n", *p); + } + p++; + } + } + } + if (writeOutput) { + printf("newline\n"); + } +} + +/* + *---------------------------------------------------------------------- + * + * QuoteText -- + * + * Copy the "string" argument to stdout, adding quote characters + * around any special Tcl characters so that they'll just be treated + * as ordinary text. + * + * Results: + * None. + * + * Side effects: + * Text is written to stdout. + * + *---------------------------------------------------------------------- + */ + +static void +QuoteText(string, count) + char *string; /* The line of text. */ + int count; /* Number of characters to write from string. */ +{ + if (count == 0) { + if (writeOutput) { + printf("{}"); + } + return; + } + for ( ; count > 0; string++, count--) { + if ((*string == '$') || (*string == '[') || (*string == '{') + || (*string == ' ') || (*string == ';') || (*string == '\\') + || (*string == '"') || (*string == '\t')) { + if (writeOutput) { + putc('\\', stdout); + } + } + if (writeOutput) { + putc(*string, stdout); + } + } +} diff --git a/tools/tcl.hpj b/tools/tcl.hpj new file mode 100644 index 0000000..9e58351 --- /dev/null +++ b/tools/tcl.hpj @@ -0,0 +1,14 @@ +[OPTIONS]
+REPORT=Yes
+TITLE=Tcl/Tk Reference Manual
+CONTENTS=contents
+COPYRIGHT=Copyright © 1996-1997 Sun Microsystems, Inc.
+
+[FILES]
+.\tcl.rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,0,,,0
+
+[CONFIG]
+BrowseButtons()
|