From 2f91b9a160b5c4d0ce6e48a79afc8bd635645898 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 24 Nov 2004 11:24:32 +0000 Subject: Fix various problems with man2html converter reported by AKu Also updated to use [package require Tcl 8.4] --- ChangeLog | 5 ++ tools/man2html.tcl | 171 +++++++++++++++++++++++++++------------------------- tools/man2html1.tcl | 30 ++++----- tools/man2html2.tcl | 53 ++++++++-------- 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 + + * 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 * 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 "
" @@ -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 {\"} 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 "$string" # 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 "

" @@ -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 "" } set nestStk [lreplace $nestStk end end] -- cgit v0.12