Index: tools/tcltk-man2html.tcl
==================================================================
--- tools/tcltk-man2html.tcl
+++ tools/tcltk-man2html.tcl
@@ -20,12 +20,12 @@
# try to use this, you'll be very much on your own.
#
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
# Copyright (c) 2004-2010 Donal K. Fellows
-set ::Version "50/8.7"
-set ::CSSFILE "docs.css"
+set ::Version 50/8.7
+set ::CSSFILE docs.css
##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
@@ -39,15 +39,14 @@
if {$name eq ""} {
set name [string toupper [file root [file tail $tclh]]]
}
# backslash isn't required in front of quote, but it keeps syntax
# highlighting straight in some editors
- if {[regexp -lineanchor \
- [string map [list @name@ $name] \
- {^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}] \
- $data -> major minor]} {
- return [list $major $minor]
+ if {[regexp -lineanchor [string map [list @name@ $name
+ ] {^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}
+ ] $data -> major minor]} {
+ return [list $major $minor]
}
}
}
proc findversion {top name useversion} {
# Default search version is a glob pattern, switch it for string match:
@@ -54,25 +53,27 @@
if {$useversion eq {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}} {
set useversion {[8-9].[0-9]}
}
# Search:
set upper [string toupper $name]
- foreach top1 [list $top $top/..] sub {{} generic} {
- foreach dirname [
- glob -nocomplain -tails -type d -directory $top1 *] {
-
- set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /]
- set v [getversion $tclh $upper]
- if {[llength $v]} {
- lassign $v major minor
- # to do
- # use glob matching instead of string matching or add
- # brace handling to [string matcch]
- if {$useversion eq "" || [string match $useversion $major.$minor]} {
- set top [file dirname [file dirname $tclh]]
- set prefix [file dirname $top]
- return [list $prefix [file tail $top] $major $minor]
+ foreach top1 [list $top $top/..] {
+ foreach sub {{} generic} {
+ foreach dirname [
+ glob -nocomplain -tails -type d -directory $top1 *] {
+
+ set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /]
+ set v [getversion $tclh $upper]
+ if {[llength $v]} {
+ lassign $v major minor
+ # to do
+ # use glob matching instead of string matching or add
+ # brace handling to [string matcch]
+ if {$useversion eq "" || [string match $useversion $major.$minor]} {
+ set top [file dirname [file dirname $tclh]]
+ set prefix [file dirname $top]
+ return [list $prefix [file tail $top] $major $minor]
+ }
}
}
}
}
}
@@ -148,32 +149,36 @@
set build_tk 1
set opt_build_tk 1
}
--verbose=* {
- set verbose [string range $option \
- [string length --verbose=] end]
+ set verbose [string range $option [
+ string length --verbose=] end]
}
default {
puts stderr "tcltk-man-html: unrecognized option -- `$option'"
exit 1
}
}
}
- if {!$build_tcl && !$build_tk} {
- set build_tcl 1;
- set build_tk 1
+ switch $build_tcl$build_tk {
+ 00 {
+ error [list {either --tcl or --tk must be given}]
+ }
+ 11 {
+ error [list {both --tcl and --tk may not be given}]
+ }
}
set major ""
set minor ""
if {$build_tcl} {
# Find Tcl (firstly using glob pattern / backwards compatible way)
set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
- -directory $tcltkdir tcl$useversion]] end]
+ -directory $tcltkdir tcl$useversion]] end]
if {$tcldir ne ""} {
# obtain version from generic header if we can:
lassign [getversion [file join $tcltkdir $tcldir generic tcl.h]] major minor
} else {
lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor
@@ -181,17 +186,14 @@
if {$tcldir eq "" && $opt_build_tcl} {
puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
exit 1
}
puts "using Tcl source directory [file join $tcltkdir $tcldir]"
- }
-
-
- if {$build_tk} {
+ } elseif {$build_tk} {
# Find Tk (firstly using glob pattern / backwards compatible way)
set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
- -directory $tcltkdir tk$useversion]] end]
+ -directory $tcltkdir tk$useversion]] end]
if {$tkdir ne ""} {
if {$major eq ""} {
# obtain version from generic header if we can:
lassign [getversion [file join $tcltkdir $tkdir generic tk.h]] major minor
}
@@ -372,11 +374,11 @@
file delete -force -- $html/Keywords
makedirhier $html/Keywords
set keyfp [open $html/Keywords/[indexfile] w]
fconfigure $keyfp -translation lf -encoding utf-8
puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \
- $overall_title "../[indexfile]"]
+ $overall_title "../[indexfile]"]
set letters {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
# Create header first
set keyheader {}
foreach a $letters {
set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
@@ -396,12 +398,11 @@
}
# Per-keyword page
set afp [open $html/Keywords/$a.html w]
fconfigure $afp -translation lf -encoding utf-8
puts $afp [htmlhead "$tcltkdesc Keywords - $a" \
- "$tcltkdesc Keywords - $a" \
- $overall_title "../[indexfile]"]
+ "$tcltkdesc Keywords - $a" $overall_title ../[indexfile]]
puts $afp $keyheader
puts $afp ""
foreach k [lsort -dictionary $keys] {
set k [string range $k 8 end]
puts $afp "- $k
"
@@ -473,12 +474,12 @@
puts -nonewline stderr .
}
set outfd [open $html/$manual(wing-file)/$manual(name).html w]
fconfigure $outfd -translation lf -encoding utf-8
puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \
- $manual(name) $wing_name "[indexfile]" \
- $overall_title "../[indexfile]"]
+ $manual(name) $wing_name "[indexfile]" \
+ $overall_title "../[indexfile]"]
if {($ntext > 60) && ($ntoc > 32)} {
foreach item $toc {
puts $outfd $item
}
} elseif {$manual(name) in $forced_index_pages} {
@@ -518,11 +519,11 @@
set f [open $tcltkdir/$root/README]
fconfigure $f -encoding utf-8
set d [read $f]
close $f
if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} {
- append name ", version $version"
+ append name ", version $version"
}
}
set glob $root/$glob
return [list $tcltkdir/$glob $name $dir $desc]
}
@@ -546,11 +547,11 @@
set globpat $pkgsdir/$dir/doc/man/*.$type
if {![llength [glob -type f -nocomplain $globpat]]} {
continue
}
}
- set dir [string trimright $dir "0123456789-."]
+ set dir [string trimright $dir 0123456789-.]
switch $type {
n {
set title "$name Package Commands"
if {$version ne ""} {
append title ", version $version"
@@ -809,20 +810,20 @@
#
# Invoke the scraper/converter engine.
#
make-man-pages $webdir \
[list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \
- "The interpreters which implement $cmdesc."] \
+ "The interpreters which implement $cmdesc."] \
[plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \
- "The commands which the tclsh interpreter implements."] \
+ "The commands which the tclsh interpreter implements."] \
[plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \
- "The additional commands which the wish interpreter implements."] \
+ "The additional commands which the wish interpreter implements."] \
{*}[plus-pkgs n {*}$packageBuildList] \
[plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \
- "The C functions which a Tcl extended C program may use."] \
+ "The C functions which a Tcl extended C program may use."] \
[plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \
- "The additional C functions which a Tk extended C program may use."] \
+ "The additional C functions which a Tk extended C program may use."] \
{*}[plus-pkgs 3 {*}$packageBuildList]
} on error {msg opts} {
# On failure make sure we show what went wrong. We're not supposed
# to get here though; it represents a bug in the script.
puts $msg\n[dict get $opts -errorinfo]