summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog5
-rw-r--r--tools/man2html.tcl171
-rw-r--r--tools/man2html1.tcl30
-rw-r--r--tools/man2html2.tcl53
4 files changed, 135 insertions, 124 deletions
diff --git a/ChangeLog b/ChangeLog
index 0c452b2..2c1e364 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-11-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/man2html.tcl, tools/man2html1.tcl: Update to use Tcl 8.4.
+ * tools/man2html2.tcl: Fix broken .SS handling.
+
2004-11-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* unix/Makefile.in: Add (commented-out) code to integrate tclConfig.h
diff --git a/tools/man2html.tcl b/tools/man2html.tcl
index 6f44aaa..386396f 100644
--- a/tools/man2html.tcl
+++ b/tools/man2html.tcl
@@ -1,6 +1,8 @@
-#!/proj/tcl/install/5.x-sparc/bin/tclsh7.5
+#!/bin/sh
+# \
+exec tclsh "$0" ${1+"$@"}
-if [catch {
+package require Tcl 8.4
# man2html.tcl --
#
@@ -12,7 +14,6 @@ if [catch {
# SCCS: @(#) man2html.tcl 1.5 96/04/11 20:21:43
#
-set homeDir /home/rjohnson/Projects/tools/generic
# sarray -
#
@@ -26,7 +27,7 @@ proc sarray {file args} {
set file [open $file w]
foreach a $args {
upvar $a array
- if ![array exists array] {
+ if {![array exists array]} {
puts "sarray: \"$a\" isn't an array"
break
}
@@ -40,13 +41,12 @@ proc sarray {file args} {
}
-
# footer --
#
# Builds footer info for HTML pages
#
# Arguments:
-# None
+# packages - List of packages to link to.
proc footer {packages} {
lappend f "<HR>"
@@ -64,8 +64,6 @@ proc footer {packages} {
}
-
-
# doDir --
#
# Given a directory as argument, translate all the man pages in
@@ -81,101 +79,112 @@ proc doDir dir {
}
-if {$argc < 2} {
- puts stderr "usage: $argv0 html_dir tcl_dir packages..."
- puts stderr "usage: $argv0 -clean html_dir"
- exit 1
-}
-
-if {[lindex $argv 0] == "-clean"} {
- set html_dir [lindex $argv 1]
- puts -nonewline "recursively remove: $html_dir? "
- flush stdout
- if {[gets stdin] == "y"} {
- puts "removing: $html_dir"
- exec rm -r $html_dir
- }
- exit 0
-}
-
-set html_dir [lindex $argv 0]
-set tcl_dir [lindex $argv 1]
-set packages [lrange $argv 2 end]
-
-#### need to add glob capability to packages ####
+# main --
+#
+# Main code for converting Tcl manual pages to HTML.
+#
+# Arguments:
+# argv - List of arguments to this script.
-# make sure there are doc directories for each package
+proc main {argv} {
+ global html_dir
+ # Global vars used in man2html1.tcl and man2html2.tcl
+ global NAME_file KEY_file lib state curFile file inDT textState nestStk
+ global curFont fontStart fontEnd noFillCount footer
-foreach i $packages {
- if ![file exists $tcl_dir/$i/doc] {
- puts stderr "Error: doc directory for package $i is missing"
+ if {[llength $argv] < 2} {
+ puts stderr "usage: $::argv0 html_dir tcl_dir packages..."
+ puts stderr "usage: $::argv0 -clean html_dir"
exit 1
}
- if ![file isdirectory $tcl_dir/$i/doc] {
- puts stderr "Error: $tcl_dir/$i/doc is not a directory"
- exit 1
+
+ if {[lindex $argv 0] eq "-clean"} {
+ set html_dir [lindex $argv 1]
+ puts -nonewline "recursively remove: $html_dir? "
+ flush stdout
+ if {[gets stdin] eq "y"} {
+ puts "removing: $html_dir"
+ file delete -force $html_dir
+ }
+ exit 0
}
-}
+ set html_dir [lindex $argv 0]
+ set tcl_dir [lindex $argv 1]
+ set packages [lrange $argv 2 end]
+ set homeDir [file dirname [info script]]
-# we want to start with a clean sheet
+ #### need to add glob capability to packages ####
-if [file exists $html_dir] {
- puts stderr "Error: HTML directory already exists"
- exit 1
-} else {
- exec mkdir $html_dir
-}
+ # make sure there are doc directories for each package
+
+ foreach i $packages {
+ if {![file exists $tcl_dir/$i/doc]} {
+ puts stderr "Error: doc directory for package $i is missing"
+ exit 1
+ }
+ if {![file isdirectory $tcl_dir/$i/doc]} {
+ puts stderr "Error: $tcl_dir/$i/doc is not a directory"
+ exit 1
+ }
+ }
+
+ # we want to start with a clean sheet
-set footer [footer $packages]
+ if {[file exists $html_dir]} {
+ puts stderr "Error: HTML directory already exists"
+ exit 1
+ } else {
+ file mkdir $html_dir
+ }
+ set footer [footer $packages]
-# make the hyperlink arrays and contents.html for all packages
-
-foreach package $packages {
- global homeDir
- exec mkdir $html_dir/$package
+ # make the hyperlink arrays and contents.html for all packages
+
+ foreach package $packages {
+ file mkdir $html_dir/$package
- # build hyperlink database arrays: NAME_file and KEY_file
- #
- puts "\nScanning man pages in $tcl_dir/$package/doc..."
- source $homeDir/man2html1.tcl
+ # build hyperlink database arrays: NAME_file and KEY_file
+ #
+ puts "\nScanning man pages in $tcl_dir/$package/doc..."
+ uplevel \#0 [list source $homeDir/man2html1.tcl]
- doDir $tcl_dir/$package/doc
-
- # clean up the NAME_file and KEY_file database arrays
- #
- catch {unset KEY_file()}
- foreach name [lsort [array names NAME_file]] {
- set file_name $NAME_file($name)
- if {[llength $file_name] > 1} {
- set file_name [lsort $file_name]
- puts stdout "Warning: '$name' multiply defined in: $file_name; using last"
- set NAME_file($name) [lindex $file_name end]
+ doDir $tcl_dir/$package/doc
+
+ # clean up the NAME_file and KEY_file database arrays
+ #
+ catch {unset KEY_file()}
+ foreach name [lsort [array names NAME_file]] {
+ set file_name $NAME_file($name)
+ if {[llength $file_name] > 1} {
+ set file_name [lsort $file_name]
+ puts "Warning: '$name' multiply defined in: $file_name;\
+ using last"
+ set NAME_file($name) [lindex $file_name end]
+ }
}
- }
-# sarray $html_dir/$package/xref.tcl NAME_file KEY_file
+ # sarray $html_dir/$package/xref.tcl NAME_file KEY_file
- # build the contents file from NAME_file
- #
- puts "\nGenerating contents.html for $package"
- doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl
+ # build the contents file from NAME_file
+ #
+ puts "\nGenerating contents.html for $package"
+ doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl
- # now translate the man pages to HTML pages
- #
- source $homeDir/man2html2.tcl
- puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
- doDir $tcl_dir/$package/doc
+ # now translate the man pages to HTML pages
+ #
+ uplevel \#0 [list source $homeDir/man2html2.tcl]
+ puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
+ doDir $tcl_dir/$package/doc
- unset NAME_file
+ unset NAME_file
+ }
}
-
-} result] {
+if [catch { main $argv } result] {
global errorInfo
puts stderr $result
puts stderr "in"
puts stderr $errorInfo
}
-
diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl
index 0adc61e..59dc396 100644
--- a/tools/man2html1.tcl
+++ b/tools/man2html1.tcl
@@ -8,6 +8,8 @@
# SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29
#
+package require Tcl 8.4
+
# Global variables used by these scripts:
#
# state - state variable that controls action of text proc.
@@ -27,7 +29,6 @@
# inDT - in dictionary term.
-
# text --
#
# This procedure adds entries to the hypertext arrays NAME_file
@@ -39,7 +40,6 @@
# Arguments:
# string - Text to index.
-
proc text string {
global state curFile NAME_file KEY_file inDT
@@ -80,7 +80,7 @@ proc macro {name args} {
switch $args {
NAME {
- if {$state == "INIT" } {
+ if {$state eq "INIT"} {
set state NAME
}
}
@@ -100,8 +100,8 @@ proc macro {name args} {
set inDT 0
set state INIT
if {[llength $args] != 5} {
- set args [join $args " "]
- puts stderr "Bad .TH macro: .$name $args"
+ set args [join $args " "]
+ puts stderr "Bad .TH macro: .$name $args"
}
set lib [lindex $args 3] ;# Tcl or Tk
}
@@ -109,7 +109,6 @@ proc macro {name args} {
}
-
# dash --
#
# This procedure is invoked to handle dash characters ("\-" in
@@ -120,13 +119,12 @@ proc macro {name args} {
proc dash {} {
global state
- if {$state == "NAME"} {
+ if {$state eq "NAME"} {
set state DASH
}
}
-
# newline --
#
# This procedure is invoked to handle newlines in the troff input.
@@ -141,8 +139,6 @@ proc newline {} {
}
-
-
# initGlobals, tab, font, char, macro2 --
#
# These procedures do nothing during the first pass.
@@ -184,14 +180,14 @@ proc doListing {file pattern} {
return
}
incr max_len
- set ncols [expr 90/$max_len]
- set nrows [expr int( ceil( [llength $type] / $ncols. ) ) ]
+ set ncols [expr {90/$max_len}]
+ set nrows [expr {int(ceil([llength $type] / double($ncols)))} ]
# ? max_len ncols nrows
set index 0
foreach f $type {
- lappend row([expr $index % $nrows]) $f
+ lappend row([expr {$index % $nrows}]) $f
incr index
}
@@ -215,8 +211,9 @@ proc doListing {file pattern} {
#
# 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.
+# 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
@@ -239,8 +236,6 @@ proc doContents {file packageName} {
}
-
-
# do --
#
# This is the toplevel procedure that searches a man page
@@ -266,4 +261,3 @@ proc do fileName {
exit 1
}
}
-
diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl
index 3e1344e..d206cbd 100644
--- a/tools/man2html2.tcl
+++ b/tools/man2html2.tcl
@@ -5,9 +5,11 @@
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
#
-# $Id: man2html2.tcl,v 1.6 2004/07/06 09:27:31 dkf Exp $
+# $Id: man2html2.tcl,v 1.7 2004/11/24 11:24:34 dkf Exp $
#
+package require Tcl 8.4
+
# Global variables used by these scripts:
#
# NAME_file - array indexed by NAME and containing file names used
@@ -76,7 +78,7 @@ proc initGlobals {} {
proc beginFont font {
global curFont file fontStart
- if {$curFont == $font} {
+ if {$curFont eq $font} {
return
}
endFont
@@ -95,9 +97,9 @@ proc beginFont font {
proc endFont {} {
global curFont file fontEnd
- if {$curFont != ""} {
- puts -nonewline $file $fontEnd($curFont)
- set curFont ""
+ if {$curFont ne ""} {
+ puts -nonewline $file $fontEnd($curFont)
+ set curFont ""
}
}
@@ -129,7 +131,7 @@ proc text string {
regsub -all \" $string {\&quot;} string
switch $textState {
REF {
- if {$inDT == {}} {
+ if {$inDT eq ""} {
set string [insertRef $string]
}
}
@@ -161,7 +163,7 @@ proc insertRef string {
global NAME_file self
set path {}
if ![catch {set ref $NAME_file([string trim $string])} ] {
- if {"$ref.html" != $self} {
+ if {"$ref.html" ne $self} {
set string "<A HREF=\"${path}$ref.html\">$string</A>"
# puts "insertRef: $self $ref.html ---$string--"
}
@@ -308,7 +310,7 @@ proc macro {name args} {
SHmacro $args
}
SS {
- SSmacro $args subsection
+ SHmacro $args subsection
}
SO {
global noFillCount inPRE file
@@ -321,12 +323,12 @@ proc macro {name args} {
font B
}
so {
- if {$args != "man.macros"} {
+ if {$args ne "man.macros"} {
puts stderr "Unknown macro: .$name [join $args " "]"
}
}
sp { ;# needs work
- if {$args == ""} {
+ if {$args eq ""} {
set count 1
} else {
set count [lindex $args 0]
@@ -389,13 +391,13 @@ proc font type {
P -
R {
endFont
- if {$textState == "REF"} {
+ if {$textState eq "REF"} {
set textState INSERT
}
}
B {
beginFont Code
- if {$textState == "INSERT"} {
+ if {$textState eq "INSERT"} {
set textState REF
}
}
@@ -422,7 +424,7 @@ proc font type {
proc formattedText text {
# puts "formattedText: $text"
- while {$text != ""} {
+ while {$text ne ""} {
set index [string first \\ $text]
if {$index < 0} {
text $text
@@ -466,7 +468,7 @@ proc formattedText text {
proc dash {} {
global textState charCnt
- if {$textState == "NAME"} {
+ if {$textState eq "NAME"} {
set textState 0
}
incr charCnt
@@ -579,7 +581,7 @@ proc lineBreak {} {
proc newline {} {
global noFillCount file inDT inPRE charCnt
- if {$inDT != {} } {
+ if {$inDT ne ""} {
puts $file "\n$inDT"
set inDT {}
} elseif {$noFillCount == 0 || $inPRE == 1} {
@@ -661,7 +663,7 @@ proc SHmacro {argList {style section}} {
nest reset
set tag H3
- if {[string compare "subsection" $level] == 0} {
+ if {$style eq "subsection"} {
set tag H4
}
puts -nonewline $file "<$tag>"
@@ -691,11 +693,12 @@ proc SHmacro {argList {style section}} {
# of the following forms:
#
# .IP [1] Translate to a "1Step" paragraph.
-# .IP [x] (x > 1) Translate to a "Step" paragraph.
+# .IP [x] (x > 1) Translate to a "Step" paragraph.
# .IP Translate to a "Bullet" paragraph.
-# .IP text count Translate to a FirstBody paragraph with special
-# indent and tab stop based on "count", and tab after
-# "text".
+# .IP \(bu Translate to a "Bullet" paragraph.
+# .IP text count Translate to a FirstBody paragraph with special
+# indent and tab stop based on "count", and tab
+# after "text".
#
# Arguments:
# argList - List of arguments to the .IP macro.
@@ -802,7 +805,7 @@ proc THmacro {argList} {
proc newPara {} {
global file nestStk
- if {[lindex $nestStk end] != "NEW" } {
+ if {[lindex $nestStk end] ne "NEW"} {
nest decr
}
puts -nonewline $file "<P>"
@@ -820,16 +823,16 @@ proc newPara {} {
# listStart - begin list tag: OL, UL, DL.
# listItem - item tag: LI, LI, DT.
-proc nest {op {listStart "NEW"} {listItem {} } } {
+proc nest {op {listStart "NEW"} {listItem ""} } {
global file nestStk inDT charCnt
# puts "nest: $op $listStart $listItem"
switch $op {
para {
set top [lindex $nestStk end]
- if {$top == "NEW" } {
+ if {$top eq "NEW"} {
set nestStk [lreplace $nestStk end end $listStart]
puts $file "<$listStart>"
- } elseif {$top != $listStart} {
+ } elseif {$top ne $listStart} {
puts stderr "nest para: bad stack"
exit 1
}
@@ -845,7 +848,7 @@ proc nest {op {listStart "NEW"} {listItem {} } } {
set nestStk NEW
}
set tag [lindex $nestStk end]
- if {$tag != "NEW"} {
+ if {$tag ne "NEW"} {
puts $file "</$tag>"
}
set nestStk [lreplace $nestStk end end]
generated by cgit v0.12 at 2024-11-05 02:59:58 (GMT)