Import Tcl-core 8.6.6 (as of svn r86089)

tools/Makefile.in

@@ -0,0 +1,67 @@
+# 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
+
+TCL		= tcl@TCL_VERSION@
+TK		= tk@TCL_VERSION@
+VER		= @TCL_WIN_VERSION@
+
+TCL_BIN_DIR	= @TCL_BIN_DIR@
+TCL_SOURCE	= @TCL_SRC_DIR@
+TK_SOURCE	= $(TCL_SOURCE)/../$(TK)
+PRO_SOURCE	= $(TCL_SOURCE)/../pro
+ITCL_SOURCE	= $(TCL_SOURCE)/../itcl3.1.0
+
+TCL_DOCS	= $(TCL_SOURCE)/doc/*.[13n]
+
+TK_DOCS		= $(TK_SOURCE)/doc/*.[13n]
+
+PRO_DOCS	= \
+	$(PRO_SOURCE)/doc/man/procheck.1 \
+	$(PRO_SOURCE)/doc/man/prodebug.1 \
+	$(PRO_SOURCE)/doc/man/prodebug.n \
+	$(PRO_SOURCE)/doc/man/prolicense.1
+
+ITCL_DOCS	= \
+	$(ITCL_SOURCE)/itcl/doc/*.[13n] \
+	$(ITCL_SOURCE)/itk/doc/*.[13n]
+
+#	$(ITCL_SOURCE)/iwidgets3.0.0/doc/*.[13n]
+
+COREDOCS	= $(TCL_DOCS) $(TK_DOCS)
+#PRODOCS	= $(COREDOCS) $(PRO_DOCS) $(ITCL_DOCS)
+PRODOCS		= $(COREDOCS) $(PRO_DOCS)
+TCLSH		= $(TCL_BIN_DIR)/tclsh
+CC		= @CC@
+
+#
+# Targets
+#
+
+all: core
+
+pro:
+	$(MAKE) DOCS="$(PRODOCS)" VER="" rtf
+
+core:
+	$(MAKE) DOCS="$(COREDOCS)" rtf
+
+rtf: $(TCL_SOURCE)/tools/man2help.tcl man2tcl $(DOCS)
+	LD_LIBRARY_PATH=$(TCL_BIN_DIR) \
+	TCL_LIBRARY=$(TCL_SOURCE)/library \
+	$(TCLSH) $(TCL_SOURCE)/tools/man2help.tcl tcl "$(VER)" $(DOCS)
+
+winhelp: tcl.rtf
+
+man2tcl: $(TCL_SOURCE)/tools/man2tcl.c
+	$(CC) $(CFLAGS) -o man2tcl $(TCL_SOURCE)/tools/man2tcl.c
+
+clean:
+	-rm -f man2tcl *.o *.cnt *.rtf
+
+helpfile:
+	hcw /c /e tcl.hpj

tools/README

@@ -0,0 +1,25 @@
+This directory contains unsupported tools used to build parts of Tcl
+for distribution.
+
+
+uniParse.tcl -- Script for converting the Unicode character database
+	into a compact table stored in generic/tclUniData.c.
+
+uniClass.tcl -- Script for generating regexp class tables from the Tcl
+	"string is" classes
+
+Generating HTML files.
+The tcl-tk-man-html.tcl script from Robert Critchlow
+generates a nice set of HTML with good cross references.
+Use it like
+    tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl8.2
+This script is very picky about the organization of man pages,
+effectively acting as a style enforcer.
+
+Generating Windows Help Files:
+1) Build tcl in the ../unix directory
+2) On UNIX, (after autoconf and configure), do
+	make
+    this converts the Nroff to RTF files.
+2) On Windows, convert the RTF to a Help doc, do
+	nmake helpfile

tools/checkLibraryDoc.tcl

@@ -0,0 +1,293 @@
+# checkLibraryDoc.tcl --
+#
+# This script attempts to determine what APIs exist in the source base that
+# have not been documented.  By grepping through all of the doc/*.3 man
+# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
+# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch])
+# we create six lists:
+#      1) APIs in Source not in Docs.
+#      2) APIs in Docs not in Source.
+#      3) Internal APIs and structs.
+#      4) Misc APIs and structs that we are not documenting.
+#      5) Command APIs (e.g., Tcl_ArrayObjCmd.)
+#      6) Proc pointers (e.g., Tcl_CloseProc.)
+#
+# Note: Each list is "a best guess" approximation.  If developers write
+# non-standard code, this script will produce erroneous results.  Each
+# list should be carefully checked for accuracy.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+
+
+lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin"
+#lappend auto_path "/home/surles/cvs/tclx8.0/tcl/unix"
+if {[catch {package require Tclx}]} {
+    puts "error: could not load TclX.  Please set TCL_LIBRARY."
+    exit 1
+}
+
+# A list of structs that are known to be undocumented.
+
+set StructList {
+    Tcl_AsyncHandler \
+    Tcl_CallFrame \
+    Tcl_Condition \
+    Tcl_Encoding \
+    Tcl_EncodingState \
+    Tcl_EncodingType \
+    Tcl_HashEntry \
+    Tcl_HashSearch \
+    Tcl_HashTable \
+    Tcl_Mutex \
+    Tcl_Pid \
+    Tcl_QueuePosition \
+    Tcl_ResolvedVarInfo \
+    Tcl_SavedResult \
+    Tcl_ThreadDataKey \
+    Tcl_ThreadId \
+    Tcl_Time \
+    Tcl_TimerToken \
+    Tcl_Token \
+    Tcl_Trace \
+    Tcl_Value \
+    Tcl_ValueType \
+    Tcl_Var \
+    Tk_3DBorder \
+    Tk_ArgvInfo \
+    Tk_BindingTable \
+    Tk_Canvas \
+    Tk_CanvasTextInfo \
+    Tk_ConfigSpec \
+    Tk_ConfigTypes \
+    Tk_Cursor \
+    Tk_CustomOption \
+    Tk_ErrorHandler \
+    Tk_FakeWin \
+    Tk_Font \
+    Tk_FontMetrics \
+    Tk_GeomMgr \
+    Tk_Image \
+    Tk_ImageMaster \
+    Tk_ImageType \
+    Tk_Item \
+    Tk_ItemType \
+    Tk_OptionSpec\
+    Tk_OptionTable \
+    Tk_OptionType \
+    Tk_PhotoHandle \
+    Tk_PhotoImageBlock \
+    Tk_PhotoImageFormat \
+    Tk_PostscriptInfo \
+    Tk_SavedOption \
+    Tk_SavedOptions \
+    Tk_SegType \
+    Tk_TextLayout \
+    Tk_Window \
+}
+
+# Misc junk that appears in the comments of the source.  This just
+# allows us to filter comments that "fool" the script.
+
+set CommentList {
+    Tcl_Create\[Obj\]Command \
+    Tcl_DecrRefCount\\n \
+    Tcl_NewObj\\n \
+    Tk_GetXXX \
+}
+
+# Main entry point to this script.
+
+proc main {} {
+    global argv0
+    global argv
+
+    set len [llength $argv]
+    if {($len != 2) && ($len != 3)} {
+	puts "usage: $argv0 pkgName pkgDir \[outFile\]"
+	puts "   pkgName == Tcl,Tk"
+	puts "   pkgDir  == /home/surles/cvs/tcl8.2"
+	exit 1
+    }
+
+    set pkg [lindex $argv 0]
+    set dir [lindex $argv 1]
+    if {[llength $argv] == 3} {
+	set file [open [lindex $argv 2] w]
+    } else {
+	set file stdout
+    }
+
+    foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {}
+    filter $c $d $dir $pkg $file
+
+    if {$file ne "stdout"} {
+	close $file
+    }
+    return
+}
+
+# Intersect the two list and write out the sets of APIs in one
+# list that is not in the other.
+
+proc compare {list1 list2} {
+    set inter [intersect3 $list1 $list2]
+    return [list [lindex $inter 0] [lindex $inter 2]]
+}
+
+# Filter the lists into the six lists we report on.  Then write
+# the results to the file.
+
+proc filter {code docs dir pkg {outFile stdout}} {
+    set apis  {}
+
+    # A list of Tcl command APIs.  These are not documented.
+    # This list should just be verified for accuracy.
+
+    set cmds  {}
+
+    # A list of proc pointer structs.  These are not documented.
+    # This list should just be verified for accuracy.
+
+    set procs {}
+
+    # A list of internal declarations.  These are not documented.
+    # This list should just be verified for accuracy.
+
+    set decls [grepDecl $dir $pkg]
+
+    # A list of misc. procedure declarations that are not documented.
+    # This list should just be verified for accuracy.
+
+    set misc [grepMisc $dir $pkg]
+
+    set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
+
+    # A list of APIs in the source, not in the docs.
+    # This list should just be verified for accuracy.
+
+    foreach x $code {
+	if {[string match *Cmd $x]} {
+	    if {[string match ${pkg}* $x]} {
+		lappend cmds $x
+	    }
+	} elseif {[string match *Proc $x]} {
+	    if {[string match ${pkg}* $x]} {
+		lappend procs $x
+	    }
+	} elseif {[lsearch -exact $decls $x] >= 0} {
+	    # No Op.
+	} elseif {[lsearch -exact $misc $x] >= 0} {
+	    # No Op.
+	} else {
+	    lappend apis $x
+	}
+    }
+
+    dump $apis  "APIs in Source not in Docs." $outFile
+    dump $docs  "APIs in Docs not in Source." $outFile
+    dump $decls "Internal APIs and structs."  $outFile
+    dump $misc  "Misc APIs and structs that we are not documenting." $outFile
+    dump $cmds  "Command APIs."  $outFile
+    dump $procs "Proc pointers." $outFile
+    return
+}
+
+# Print the list of APIs if the list is not null.
+
+proc dump {list title file} {
+    if {$list ne ""} {
+	puts $file ""
+	puts $file $title
+	puts $file "---------------------------------------------------------"
+	foreach x $list {
+	    puts $file $x
+	}
+    }
+}
+
+# Grep into "dir/*/*.[ch]" looking for APIs that match $pkg_*.
+# (e.g., Tcl_Exit).  Return a list of APIs.
+
+proc grepCode {dir pkg} {
+    set apis [myGrep "${pkg}_\.\*" "${dir}/\*/\*\.\[ch\]"]
+    set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
+
+    foreach a $apis {
+	if {[regexp --  $pat1 $a main n1]} {
+	    set result([string trim $n1]) 1
+	}
+    }
+    return [lsort [array names result]]
+}
+
+# Grep into "dir/doc/*.3" looking for APIs that match $pkg_*.
+# (e.g., Tcl_Exit).  Return a list of APIs.
+
+proc grepDocs {dir pkg} {
+    set apis [myGrep "\\fB${pkg}_\.\*\\fR" "${dir}/doc/\*\.3"]
+    set pat1 ".*(${pkg}_\[A-z0-9]+)\\\\fR.*$"
+
+    foreach a $apis {
+	if {[regexp -- $pat1 $a main n1]} {
+	    set result([string trim $n1]) 1
+	}
+    }
+    return [lsort [array names result]]
+}
+
+# Grep into "generic/pkgIntDecls.h" looking for APIs that match $pkg_*.
+# (e.g., Tcl_Export).  Return a list of APIs.
+
+proc grepDecl {dir pkg} {
+    set file [file join $dir generic "[string tolower $pkg]IntDecls.h"]
+    set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_.*" $file]
+    set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
+
+    foreach a $apis {
+	if {[regexp -- $pat1 $a main n1]} {
+	    set result([string trim $n1]) 1
+	}
+    }
+    return [lsort [array names result]]
+}
+
+# Grep into "*/*.[ch]" looking for APIs that match $pkg_Db*.
+# (e.g., Tcl_DbCkalloc).  Return a list of APIs.
+
+proc grepMisc {dir pkg} {
+    global CommentList
+    global StructList
+
+    set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_Db.*" "${dir}/\*/\*\.\[ch\]"]
+    set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
+
+    foreach a $apis {
+	if {[regexp -- $pat1 $a main n1]} {
+	    set dbg([string trim $n1]) 1
+	}
+    }
+
+    set result {}
+    eval {lappend result} $StructList
+    eval {lappend result} [lsort [array names dbg]]
+    eval {lappend result} $CommentList
+    return $result
+}
+
+proc myGrep {searchPat globPat} {
+    set result {}
+    foreach file [glob -nocomplain $globPat] {
+	set file [open $file r]
+	set data [read $file]
+	close $file
+	foreach line [split $data "\n"] {
+	    if {[regexp "^.*${searchPat}.*\$" $line]} {
+		lappend result $line
+	    }
+	}
+    }
+    return $result
+}
+main
+

tools/configure.in

@@ -0,0 +1,35 @@
+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)
+AC_PREREQ(2.59)
+
+# Recover information that Tcl computed with its configure script.
+
+#--------------------------------------------------------------------
+#       See if there was a command-line option for where Tcl is;  if
+#       not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+DEF_VER=8.6
+
+AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`)
+if test ! -d $TCL_BIN_DIR; then
+    AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
+fi
+if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
+    AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
+fi
+
+. $TCL_BIN_DIR/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_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_BIN_DIR)
+
+AC_OUTPUT(Makefile tcl.hpj)

tools/eolFix.tcl

@@ -0,0 +1,80 @@
+## Super aggressive EOL-fixer!
+##
+##  Will even understand screwed up ones like CRCRLF.
+##  (found in bad CVS repositories, caused by spacey developers
+##   abusing CVS)
+##
+##  davygrvy@pobox.com    3:41 PM 10/12/2001
+##
+
+package provide EOL-fix 1.1
+
+namespace eval ::EOL {
+    variable outMode crlf
+}
+
+proc EOL::fix {filename {newfilename {}}} {
+    variable outMode
+
+    if {![file exists $filename]} {
+	return
+    }
+    puts "EOL Fixing: $filename"
+
+    file rename ${filename} ${filename}.o
+    set fhnd [open ${filename}.o r]
+
+    if {$newfilename ne ""} {
+	set newfhnd [open ${newfilename} w]
+    } else {
+	set newfhnd [open ${filename} w]
+    }
+
+    fconfigure $newfhnd -translation [list auto $outMode]
+    seek $fhnd 0 end
+    set theEnd [tell $fhnd]
+    seek $fhnd 0 start
+
+    fconfigure $fhnd -translation binary -buffersize $theEnd
+    set rawFile [read $fhnd $theEnd]
+    close $fhnd
+
+    regsub -all {(\r)|(\r){1,2}(\n)} $rawFile "\n" rawFile
+
+    set lineList [split $rawFile \n]
+
+    foreach line $lineList {
+	puts $newfhnd $line
+    }
+
+    close $newfhnd
+    file delete ${filename}.o
+}
+
+proc EOL::fixall {args} {
+    if {[llength $args] == 0} {
+	puts stderr "no files to fix"
+	exit 1
+    } else {
+	set cmd [lreplace $args -1 -1 glob -nocomplain]
+    }
+
+    foreach f [eval $cmd] {
+	if {[file isfile $f]} {fix $f}
+    }
+}
+
+if {$tcl_interactive == 0 && $argc > 0} {
+    if {[string index [lindex $argv 0] 0] eq "-"} {
+	switch -- [lindex $argv 0] {
+	    -cr   {set ::EOL::outMode cr}
+	    -crlf {set ::EOL::outMode crlf}
+	    -lf   {set ::EOL::outMode lf}
+	    default {puts stderr "improper mode switch"; exit 1}
+        }
+	set argv [lrange $argv 1 end]
+    }
+    eval EOL::fixall $argv
+} else {
+    return
+}

tools/findBadExternals.tcl

@@ -0,0 +1,53 @@
+# findBadExternals.tcl --
+#
+#	This script scans the Tcl load library for exported symbols
+#	that do not begin with 'Tcl' or 'tcl'.  It reports them on the
+#	standard output.  It is used to make sure that the library does
+#	not inadvertently export externals that may be in conflict with
+#	other code.
+#
+# Usage:
+#
+#	tclsh findBadExternals.tcl /path/to/tclXX.so-or-.dll
+#
+# Copyright (c) 2005 George Peter Staplin and Kevin Kenny
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#----------------------------------------------------------------------
+
+proc main {argc argv} {
+
+    if {$argc != 1} {
+	puts stderr "syntax is: [info script] libtcl"
+	return 1
+    }
+
+
+    switch -exact -- $::tcl_platform(platform) {
+	unix -
+	macosx {
+	    set status [catch {
+		exec nm --extern-only --defined-only [lindex $argv 0]
+	    } result]
+	}
+	windows {
+	    set status [catch {
+		exec dumpbin /exports [lindex $argv 0]
+	    } result]
+	}
+    }
+    if {$status != 0 && $::errorCode ne "NONE"} {
+	puts $result
+	return 1
+    }
+
+    foreach line [split $result \n] {
+	if {! [string match {* [Tt]cl*} $line]} {
+	    puts $line
+	}
+    }
+
+    return 0
+}
+exit [main $::argc $::argv]

tools/fix_tommath_h.tcl

@@ -0,0 +1,102 @@
+# fixtommath.tcl --
+#
+#	Changes to 'tommath.h' to make it conform with Tcl's linking
+#	conventions.
+#
+# Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#----------------------------------------------------------------------
+
+set f [open [lindex $argv 0] r]
+set data [read $f]
+close $f
+
+set eat_endif 0
+set eat_semi 0
+set def_count 0
+foreach line [split $data \n] {
+    if {!$eat_semi && !$eat_endif} {
+	switch -regexp -- $line {
+	    {#define BN_H_} {
+		puts $line
+		puts {}
+		puts "\#include \"tclInt.h\""
+		puts "\#include \"tclTomMathDecls.h\""
+		puts "\#ifndef MODULE_SCOPE"
+		puts "\#define MODULE_SCOPE extern"
+		puts "\#endif"
+	    }
+	    {typedef\s+unsigned long\s+mp_digit;} {
+		# change the second 'typedef unsigned long mp
+		incr def_count
+		puts "\#ifndef MP_DIGIT_DECLARED"
+		if {$def_count == 2} {
+		    puts [string map {long int} $line]
+		} else {
+		    puts $line
+		}
+		puts "\#define MP_DIGIT_DECLARED"
+		puts "\#endif"
+	    }
+	    {typedef.*mp_digit;} {
+		puts "\#ifndef MP_DIGIT_DECLARED"
+		puts $line
+		puts "\#define MP_DIGIT_DECLARED"
+		puts "\#endif"
+	    }
+	    {typedef struct} {
+		puts "\#ifndef MP_INT_DECLARED"
+		puts "\#define MP_INT_DECLARED"
+		puts "typedef struct mp_int mp_int;"
+		puts "\#endif"
+		puts "struct mp_int \{"
+	    }
+	    \}\ mp_int\; {
+		puts "\};"
+	    }
+	    {^(char|int|void)} {
+		puts "/*"
+		puts $line
+		set eat_semi 1
+		set after_semi "*/"
+	    }
+	    {^extern (int|const)} {
+		puts "\#if defined(BUILD_tcl) || !defined(_WIN32)"
+		puts [regsub {^extern} $line "MODULE_SCOPE"]
+		set eat_semi 1
+		set after_semi "\#endif"
+	    }
+	    {define heap macros} {
+		puts $line
+		puts "\#if 0 /* these are macros in tclTomMathDecls.h */"
+		set eat_endif 1
+	    }
+	    {__x86_64__} {
+		puts "[string map {__x86_64__ NEVER} $line]\
+                      /* 128-bit ints fail in too many places */"
+	    }
+	    {#include} {
+		# remove all includes
+	    }
+	    default {
+		puts $line
+	    }
+	}
+    } else {
+	puts $line
+    }
+    if {$eat_semi} {
+	if {[regexp {; *$} $line]} {
+	    puts $after_semi
+	    set eat_semi 0
+	}
+    }
+    if {$eat_endif} {
+	if {[regexp {^\#endif} $line]} {
+	    puts "\#endif"
+	    set eat_endif 0
+	}
+    }
+}

tools/index.tcl

@@ -0,0 +1,199 @@
+# 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.
+
+# 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
+    regsub -all {[][*?\\]} $pkg {\\&} pkg
+    foreach i [array names topics "${pkg},*"] {
+	regsub {^.*,(.*),.*$} $i {\1} i
+	set temp($i) {}
+    }
+    lsort [array names temp]
+}
+
+# getTopics --
+#
+# 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
+    regsub -all {[][*?\\]} $pkg {\\&} pkg
+    regsub -all {[][*?\\]} $sect {\\&} sect
+    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 - SS {
+	    global state
+
+	    switch $args {
+		NAME {
+		    if {$state eq "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}
+	    regsub -all {\\ } $curSect { } curSect
+	    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 eq "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} {}
+

tools/installData.tcl

@@ -0,0 +1,50 @@
+#!/bin/sh
+#\
+exec tclsh "$0" ${1+"$@"}
+
+#----------------------------------------------------------------------
+#
+# installData.tcl --
+#
+#	This file installs a hierarchy of data found in the directory
+#	specified by its first argument into the directory specified
+#	by its second.
+#
+#----------------------------------------------------------------------
+#
+# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#----------------------------------------------------------------------
+
+proc copyDir {d1 d2} {
+
+    puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
+	      [file tail $d2]]
+
+    file delete -force -- $d2
+    file mkdir $d2
+
+    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+	set f [file join $d1 $ftail]
+	if {[file isdirectory $f] && [string compare CVS $ftail]} {
+	    copyDir $f [file join $d2 $ftail]
+	} elseif {[file isfile $f]} {
+	    file copy -force $f [file join $d2 $ftail]
+	    if {$::tcl_platform(platform) eq {unix}} {
+		file attributes [file join $d2 $ftail] -permissions 0644
+	    } else {
+		file attributes [file join $d2 $ftail] -readonly 1
+	    }
+	}
+    }
+
+    if {$::tcl_platform(platform) eq {unix}} {
+	file attributes $d2 -permissions 0755
+    } else {
+	file attributes $d2 -readonly 1
+    }
+
+}
+
+copyDir [file normalize [lindex $argv 0]] [file normalize [lindex $argv 1]]

tools/loadICU.tcl

@@ -0,0 +1,619 @@
+#----------------------------------------------------------------------
+#
+# loadICU,tcl --
+#
+#	Extracts locale strings from a distribution of ICU
+#	(http://oss.software.ibm.com/developerworks/opensource/icu/project/)
+#	and makes Tcl message catalogs for the 'clock' command.
+#
+# Usage:
+#	loadICU.tcl sourceDir destDir
+#
+# Parameters:
+#	sourceDir -- Path name of the 'data' directory of your ICU4C
+#		     distribution.
+#	destDir -- Directory into which the Tcl message catalogs should go.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Creates the message catalogs.
+#
+#----------------------------------------------------------------------
+#
+# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#----------------------------------------------------------------------
+
+# Calculate the Chinese numerals from zero to ninety-nine.
+
+set zhDigits [list {} \u4e00 \u4e8c \u4e09 \u56db \
+		  \u4e94 \u516d \u4e03 \u516b \u4e5d]
+set t 0
+foreach zt $zhDigits {
+    if { $t == 0 } {
+	set zt {}
+    } elseif { $t == 10 } {
+	set zt \u5341
+    } else {
+	append zt \u5341
+    }
+    set d 0
+    foreach zd $zhDigits {
+	if { $t == 0 && $d == 0 } {
+	    set zd \u3007
+	} elseif { $t == 20 && $d != 0 } {
+	    set zt \u5eff
+	} elseif { $t == 30 && $d != 0 } {
+	    set zt \u5345
+	}
+	lappend zhNumbers $zt$zd
+	incr d
+    }
+    incr t 10
+}
+
+# Set format overrides for various locales.
+
+set format(zh,LOCALE_NUMERALS) $zhNumbers
+set format(ja,LOCALE_ERAS) [list \
+				[list -9223372036854775808 \u897f\u66a6 0 ] \
+				[list -3061011600 \u660e\u6cbb 1867] \
+				[list -1812186000 \u5927\u6b63 1911] \
+				[list -1357635600 \u662d\u548c 1925] \
+				[list 600220800 \u5e73\u6210 1988]]
+set format(zh,LOCALE_DATE_FORMAT) "\u516c\u5143%Y\u5e74%B%Od\u65E5"
+set format(ja,LOCALE_DATE_FORMAT) "%EY\u5e74%m\u6708%d\u65E5"
+set format(ko,LOCALE_DATE_FORMAT) "%Y\ub144%B%Od\uc77c"
+set format(zh,LOCALE_TIME_FORMAT) "%OH\u65f6%OM\u5206%OS\u79d2"
+set format(ja,LOCALE_TIME_FORMAT) "%H\u6642%M\u5206%S\u79d2"
+set format(ko,LOCALE_TIME_FORMAT) "%H\uc2dc%M\ubd84%S\ucd08"
+set format(zh,LOCALE_DATE_TIME_FORMAT) "%A %Y\u5e74%B%Od\u65E5%OH\u65f6%OM\u5206%OS\u79d2 %z"
+set format(ja,LOCALE_DATE_TIME_FORMAT) "%EY\u5e74%m\u6708%d\u65E5 (%a) %H\u6642%M\u5206%S\u79d2 %z"
+set format(ko,LOCALE_DATE_TIME_FORMAT) "%A %Y\ub144%B%Od\uc77c%H\uc2dc%M\ubd84%S\ucd08 %z"
+set format(ja,TIME_FORMAT_12) {%P %I:%M:%S}
+
+# The next set of format overrides were obtained from the glibc
+# localization strings.
+
+set format(cs_CZ,DATE_FORMAT) %d.%m.%Y
+set format(cs_CZ,DATE_TIME_FORMAT) {%a %e. %B %Y, %H:%M:%S %z}
+set format(cs_CZ,TIME_FORMAT) %H:%M:%S
+set format(cs_CZ,TIME_FORMAT_12) %I:%M:%S
+set format(da_DK,DATE_FORMAT) %d-%m-%Y
+set format(da_DK,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(da_DK,TIME_FORMAT) %T
+set format(da_DK,TIME_FORMAT_12) %T
+set format(de_AT,DATE_FORMAT) %Y-%m-%d
+set format(de_AT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(de_AT,TIME_FORMAT) %T
+set format(de_AT,TIME_FORMAT_12) %T
+set format(de_BE,DATE_FORMAT) %Y-%m-%d
+set format(de_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(de_BE,TIME_FORMAT) %T
+set format(de_BE,TIME_FORMAT_12) %T
+set format(de_CH,DATE_FORMAT) %Y-%m-%d
+set format(de_CH,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(de_CH,TIME_FORMAT) %T
+set format(de_CH,TIME_FORMAT_12) %T
+set format(de_DE,DATE_FORMAT) %Y-%m-%d
+set format(de_DE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(de_DE,TIME_FORMAT) %T
+set format(de_DE,TIME_FORMAT_12) %T
+set format(de_LU,DATE_FORMAT) %Y-%m-%d
+set format(de_LU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(de_LU,TIME_FORMAT) %T
+set format(de_LU,TIME_FORMAT_12) %T
+set format(en_CA,DATE_FORMAT) %d/%m/%y
+set format(en_CA,DATE_TIME_FORMAT) {%a %d %b %Y %r %z}
+set format(en_CA,TIME_FORMAT) %r
+set format(en_CA,TIME_FORMAT_12) {%I:%M:%S %p}
+set format(en_DK,DATE_FORMAT) %Y-%m-%d
+set format(en_DK,DATE_TIME_FORMAT) {%Y-%m-%dT%T %z}
+set format(en_DK,TIME_FORMAT) %T
+set format(en_DK,TIME_FORMAT_12) %T
+set format(en_GB,DATE_FORMAT) %d/%m/%y
+set format(en_GB,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(en_GB,TIME_FORMAT) %T
+set format(en_GB,TIME_FORMAT_12) %T
+set format(en_IE,DATE_FORMAT) %d/%m/%y
+set format(en_IE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(en_IE,TIME_FORMAT) %T
+set format(en_IE,TIME_FORMAT_12) %T
+set format(en_US,DATE_FORMAT) %m/%d/%y
+set format(en_US,DATE_TIME_FORMAT) {%a %d %b %Y %r %z}
+set format(en_US,TIME_FORMAT) %r
+set format(en_US,TIME_FORMAT_12) {%I:%M:%S %p}
+set format(es_ES,DATE_FORMAT) %d/%m/%y
+set format(es_ES,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(es_ES,TIME_FORMAT) %T
+set format(es_ES,TIME_FORMAT_12) %T
+set format(et_EE,DATE_FORMAT) %d.%m.%Y
+set format(et_EE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(et_EE,TIME_FORMAT) %T
+set format(et_EE,TIME_FORMAT_12) %T
+set format(eu_ES,DATE_FORMAT) {%a, %Yeko %bren %da}
+set format(eu_ES,DATE_TIME_FORMAT) {%y-%m-%d %T %z}
+set format(eu_ES,TIME_FORMAT) %T
+set format(eu_ES,TIME_FORMAT_12) %T
+set format(fi_FI,DATE_FORMAT) %d.%m.%Y
+set format(fi_FI,DATE_TIME_FORMAT) {%a %e %B %Y %T}
+set format(fi_FI,TIME_FORMAT) %T
+set format(fi_FI,TIME_FORMAT_12) %T
+set format(fo_FO,DATE_FORMAT) %d/%m-%Y
+set format(fo_FO,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(fo_FO,TIME_FORMAT) %T
+set format(fo_FO,TIME_FORMAT_12) %T
+set format(fr_BE,DATE_FORMAT) %d/%m/%y
+set format(fr_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(fr_BE,TIME_FORMAT) %T
+set format(fr_BE,TIME_FORMAT_12) %T
+set format(fr_CA,DATE_FORMAT) %Y-%m-%d
+set format(fr_CA,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(fr_CA,TIME_FORMAT) %T
+set format(fr_CA,TIME_FORMAT_12) %T
+set format(fr_CH,DATE_FORMAT) {%d. %m. %y}
+set format(fr_CH,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(fr_CH,TIME_FORMAT) %T
+set format(fr_CH,TIME_FORMAT_12) %T
+set format(fr_FR,DATE_FORMAT) %d.%m.%Y
+set format(fr_FR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(fr_FR,TIME_FORMAT) %T
+set format(fr_FR,TIME_FORMAT_12) %T
+set format(fr_LU,DATE_FORMAT) %d.%m.%Y
+set format(fr_LU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(fr_LU,TIME_FORMAT) %T
+set format(fr_LU,TIME_FORMAT_12) %T
+set format(ga_IE,DATE_FORMAT) %d.%m.%y
+set format(ga_IE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(ga_IE,TIME_FORMAT) %T
+set format(ga_IE,TIME_FORMAT_12) %T
+set format(gr_GR,DATE_FORMAT) %d/%m/%Y
+set format(gr_GR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(gr_GR,TIME_FORMAT) %T
+set format(gr_GR,TIME_FORMAT_12) %T
+set format(hr_HR,DATE_FORMAT) %d.%m.%y
+set format(hr_HR,DATE_TIME_FORMAT) {%a %d %b %Y %T}
+set format(hr_HR,TIME_FORMAT) %T
+set format(hr_HR,TIME_FORMAT_12) %T
+set format(hu_HU,DATE_FORMAT) %Y-%m-%d
+set format(hu_HU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(hu_HU,TIME_FORMAT) %T
+set format(hu_HU,TIME_FORMAT_12) %T
+set format(is_IS,DATE_FORMAT) {%a %e.%b %Y}
+set format(is_IS,DATE_TIME_FORMAT) {%a %e.%b %Y, %T %z}
+set format(is_IS,TIME_FORMAT) %T
+set format(is_IS,TIME_FORMAT_12) %T
+set format(it_IT,DATE_FORMAT) %d/%m/%Y
+set format(it_IT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(it_IT,TIME_FORMAT) %T
+set format(it_IT,TIME_FORMAT_12) %T
+set format(iw_IL,DATE_FORMAT) %d/%m/%y
+set format(iw_IL,DATE_TIME_FORMAT) {%z %H:%M:%S %Y %b %d %a}
+set format(iw_IL,TIME_FORMAT) %H:%M:%S
+set format(iw_IL,TIME_FORMAT_12) {%I:%M:%S %P}
+set format(kl_GL,DATE_FORMAT) {%d %b %Y}
+set format(kl_GL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(kl_GL,TIME_FORMAT) %T
+set format(kl_GL,TIME_FORMAT_12) %T
+set format(lt_LT,DATE_FORMAT) %Y.%m.%d
+set format(lt_LT,DATE_TIME_FORMAT) {%Y m. %B %d d. %T}
+set format(lt_LT,TIME_FORMAT) %T
+set format(lt_LT,TIME_FORMAT_12) %T
+set format(lv_LV,DATE_FORMAT) %Y.%m.%d.
+set format(lv_LV,DATE_TIME_FORMAT) {%A, %Y. gada %e. %B, plkst. %H un %M}
+set format(lv_LV,TIME_FORMAT) %T
+set format(lv_LV,TIME_FORMAT_12) %T
+set format(nl_BE,DATE_FORMAT) %d-%m-%y
+set format(nl_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(nl_BE,TIME_FORMAT) %T
+set format(nl_BE,TIME_FORMAT_12) %T
+set format(nl_NL,DATE_FORMAT) %d-%m-%y
+set format(nl_NL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(nl_NL,TIME_FORMAT) %T
+set format(nl_NL,TIME_FORMAT_12) %T
+set format(no_NO,DATE_FORMAT) %d-%m-%Y
+set format(no_NO,DATE_TIME_FORMAT) {%a %d-%m-%Y %T %z}
+set format(no_NO,TIME_FORMAT) %T
+set format(no_NO,TIME_FORMAT_12) %T
+set format(pl_PL,DATE_FORMAT) %Y-%m-%d
+set format(pl_PL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(pl_PL,TIME_FORMAT) %T
+set format(pl_PL,TIME_FORMAT_12) %T
+set format(pt_BR,DATE_FORMAT) %d-%m-%Y
+set format(pt_BR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(pt_BR,TIME_FORMAT) %T
+set format(pt_BR,TIME_FORMAT_12) %T
+set format(pt_PT,DATE_FORMAT) %d-%m-%Y
+set format(pt_PT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(pt_PT,TIME_FORMAT) %T
+set format(pt_PT,TIME_FORMAT_12) %T
+set format(ro_RO,DATE_FORMAT) %Y-%m-%d
+set format(ro_RO,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(ro_RO,TIME_FORMAT) %T
+set format(ro_RO,TIME_FORMAT_12) %T
+set format(ru_RU,DATE_FORMAT) %d.%m.%Y
+set format(ru_RU,DATE_TIME_FORMAT) {%a %d %b %Y %T}
+set format(ru_RU,TIME_FORMAT) %T
+set format(ru_RU,TIME_FORMAT_12) %T
+set format(sl_SI,DATE_FORMAT) %d.%m.%Y
+set format(sl_SI,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(sl_SI,TIME_FORMAT) %T
+set format(sl_SI,TIME_FORMAT_12) %T
+set format(sv_FI,DATE_FORMAT) %Y-%m-%d
+set format(sv_FI,DATE_TIME_FORMAT) {%a %e %b %Y %H.%M.%S}
+set format(sv_FI,TIME_FORMAT) %H.%M.%S
+set format(sv_FI,TIME_FORMAT_12) %H.%M.%S
+set format(sv_SE,DATE_FORMAT) %Y-%m-%d
+set format(sv_SE,DATE_TIME_FORMAT) {%a %e %b %Y %H.%M.%S}
+set format(sv_SE,TIME_FORMAT) %H.%M.%S
+set format(sv_SE,TIME_FORMAT_12) %H.%M.%S
+set format(tr_TR,DATE_FORMAT) %Y-%m-%d
+set format(tr_TR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z}
+set format(tr_TR,TIME_FORMAT) %T
+set format(tr_TR,TIME_FORMAT_12) %T
+
+#----------------------------------------------------------------------
+#
+# handleLocaleFile --
+#
+#	Extracts strings from an ICU locale definition.
+#
+# Parameters:
+#	localeName - Name of the locale (e.g., de_AT_euro)
+#	fileName - Name of the file containing the data
+#	msgFileName - Name of the file containing the Tcl message catalog
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Writes the Tcl message catalog.
+#
+#----------------------------------------------------------------------
+
+proc handleLocaleFile { localeName fileName msgFileName } {
+    variable format
+
+    # Get the content of the ICU file
+
+    set f [open $fileName r]
+    fconfigure $f -encoding utf-8
+    set data [read $f]
+    close $f
+
+    # Parse the ICU data
+
+    set state {}
+    foreach line [split $data \n] {
+	switch -exact -- $state {
+	    {} {
+
+		# Look for the beginnings of data blocks
+
+		switch -regexp -- $line {
+		    {^[[:space:]]*AmPmMarkers[[:space:]]+[\{]} {
+			set state data
+			set key AmPmMarkers
+		    }
+		    {^[[:space:]]*DateTimePatterns[[:space:]]+[\{]} {
+			set state data
+			set key DateTimePatterns
+		    }
+		    {^[[:space:]]*DayAbbreviations[[:space:]]+[\{]} {
+			set state data
+			set key DayAbbreviations
+		    }
+		    {^[[:space:]]*DayNames[[:space:]]+[\{]} {
+			set state data
+			set key DayNames
+		    }
+		    {^[[:space:]]*Eras[[:space:]]+[\{]} {
+			set state data
+			set key Eras
+		    }
+		    {^[[:space:]]*MonthAbbreviations[[:space:]]+[\{]} {
+			set state data
+			set key MonthAbbreviations
+		    }
+		    {^[[:space:]]*MonthNames[[:space:]]+[\{]} {
+			set state data
+			set key MonthNames
+		    }
+		}
+	    }
+	    data {
+
+
+		# Inside a data block, collect the strings, doing backslash
+		# expansion to pick up the Unicodes
+
+		if { [regexp {"(.*)",} $line -> item] } {
+		    lappend items($key) [subst -nocommands -novariables $item]
+		} elseif { [regexp {^[[:space:]]*[\}][[:space:]]*$} $line] } {
+		    set state {}
+		}
+	    }
+	}
+    }
+
+    # Skip locales that don't change time strings.
+
+    if {![array exists items]} return
+
+    # Write the Tcl message catalog
+
+    set f [open $msgFileName w]
+
+    # Write a header
+
+    puts $f "\# created by $::argv0 -- do not edit"
+    puts $f "namespace eval ::tcl::clock \{"
+
+    # Do ordinary sets of strings (weekday and month names)
+
+    foreach key {
+	DayAbbreviations DayNames MonthAbbreviations MonthNames
+    } tkey {
+	DAYS_OF_WEEK_ABBREV DAYS_OF_WEEK_FULL
+	MONTHS_ABBREV MONTHS_FULL
+    } {
+	if { [info exists items($key)] } {
+	    set itemList $items($key)
+	    set cmd1 "    ::msgcat::mcset "
+	    append cmd1 $localeName " " $tkey " \[list "
+	    foreach item $itemList {
+		append cmd1 \\\n {        } \" [backslashify $item] \"
+	    }
+	    append cmd1 \]
+	    puts $f $cmd1
+	}
+    }
+
+    # Do the eras, B.C.E., and C.E.
+
+    if { [info exists items(Eras)] } {
+	foreach { bce ce } $items(Eras) break
+	set cmd "    ::msgcat::mcset "
+	append cmd $localeName " " BCE " \"" [backslashify $bce] \"
+	puts $f $cmd
+	set cmd "    ::msgcat::mcset "
+	append cmd $localeName " " CE " \"" [backslashify $ce] \"
+	puts $f $cmd
+    }
+
+    # Do the AM and PM markers
+
+    if { [info exists items(AmPmMarkers)] } {
+	foreach { am pm } $items(AmPmMarkers) break
+	set cmd "    ::msgcat::mcset "
+	append cmd $localeName " " AM " \"" [backslashify $am] \"
+	puts $f $cmd
+	set cmd "    ::msgcat::mcset "
+	append cmd $localeName " " PM " \"" [backslashify $pm] \"
+	puts $f $cmd
+    }
+
+    # Do the date/time patterns. First date...
+
+    if { [info exists format($localeName,DATE_FORMAT)]
+	 || [info exists items(DateTimePatterns)] } {
+
+	# Find the shortest date format that includes a 4-digit year.
+
+	if { ![info exists format($localeName,DATE_FORMAT)] } {
+	    for { set i 7 } { $i >= 4 } { incr i -1 } {
+		if { [regexp yyyy [lindex $items(DateTimePatterns) $i]] } {
+		    break
+		}
+	    }
+	    set fmt \
+		[backslashify \
+		     [percentify [lindex $items(DateTimePatterns) $i]]]
+	    set format($localeName,DATE_FORMAT) $fmt
+	}
+
+	# Put it to the message catalog
+
+	set cmd "    ::msgcat::mcset "
+	append cmd $localeName " DATE_FORMAT \"" \
+	    $format($localeName,DATE_FORMAT) "\""
+	puts $f $cmd
+    }
+
+    # Time
+
+    if { [info exists format($localeName,TIME_FORMAT)]
+	 || [info exists items(DateTimePatterns)] } {
+
+	# Find the shortest time pattern that includes the seconds
+
+	if { ![info exists format($localeName,TIME_FORMAT)] } {
+	    for { set i 3 } { $i >= 0 } { incr i -1 } {
+		if { [regexp H [lindex $items(DateTimePatterns) $i]]
+		     && [regexp s [lindex $items(DateTimePatterns) $i]] } {
+		    break
+		}
+	    }
+	    if { $i >= 0 } {
+		set fmt \
+		    [backslashify \
+			 [percentify [lindex $items(DateTimePatterns) $i]]]
+		regsub { %Z} $fmt {} format($localeName,TIME_FORMAT)
+	    }
+	}
+
+	# Put it to the message catalog
+
+	if { [info exists format($localeName,TIME_FORMAT)] } {
+	    set cmd "    ::msgcat::mcset "
+	    append cmd $localeName " TIME_FORMAT \"" \
+		$format($localeName,TIME_FORMAT) "\""
+	    puts $f $cmd
+	}
+    }
+
+    # 12-hour time...
+
+    if { [info exists format($localeName,TIME_FORMAT_12)]
+	 || [info exists items(DateTimePatterns)] } {
+
+	# Shortest patterm with 12-hour time that includes seconds
+
+	if { ![info exists format($localeName,TIME_FORMAT_12)] } {
+	    for { set i 3 } { $i >= 0 } { incr i -1 } {
+		if { [regexp h [lindex $items(DateTimePatterns) $i]]
+		     && [regexp s [lindex $items(DateTimePatterns) $i]] } {
+		    break
+		}
+	    }
+	    if { $i >= 0 } {
+		set fmt \
+		    [backslashify \
+			 [percentify [lindex $items(DateTimePatterns) $i]]]
+		regsub { %Z} $fmt {} format($localeName,TIME_FORMAT_12)
+	    }
+	}
+
+	# Put it to the catalog
+
+	if { [info exists format($localeName,TIME_FORMAT_12)] } {
+	    set cmd "    ::msgcat::mcset "
+	    append cmd $localeName " TIME_FORMAT_12 \"" \
+		$format($localeName,TIME_FORMAT_12) "\""
+	    puts $f $cmd
+	}
+    }
+
+    # Date and time... Prefer 24-hour format to 12-hour format.
+
+    if { ![info exists format($localeName,DATE_TIME_FORMAT)]
+	 && [info exists format($localeName,DATE_FORMAT)]
+	 && [info exists format($localeName,TIME_FORMAT)]} {
+	set format($localeName,DATE_TIME_FORMAT) \
+	    $format($localeName,DATE_FORMAT)
+	append format($localeName,DATE_TIME_FORMAT) \
+	    " " $format($localeName,TIME_FORMAT) " %z"
+    }
+    if { ![info exists format($localeName,DATE_TIME_FORMAT)]
+	 && [info exists format($localeName,DATE_FORMAT)]
+	 && [info exists format($localeName,TIME_FORMAT_12)]} {
+	set format($localeName,DATE_TIME_FORMAT) \
+	    $format($localeName,DATE_FORMAT)
+	append format($localeName,DATE_TIME_FORMAT) \
+	    " " $format($localeName,TIME_FORMAT_12) " %z"
+    }
+
+    # Write date/time format to the file
+
+    if { [info exists format($localeName,DATE_TIME_FORMAT)] } {
+	set cmd "    ::msgcat::mcset "
+	append cmd $localeName " DATE_TIME_FORMAT \"" \
+	    $format($localeName,DATE_TIME_FORMAT) "\""
+	puts $f $cmd
+    }
+
+    # Write the string sets to the file.
+
+    foreach key {
+	LOCALE_NUMERALS LOCALE_DATE_FORMAT LOCALE_TIME_FORMAT
+	LOCALE_DATE_TIME_FORMAT LOCALE_ERAS LOCALE_YEAR_FORMAT
+    } {
+	if { [info exists format($localeName,$key)] } {
+	    set cmd "    ::msgcat::mcset "
+	    append cmd $localeName " " $key " \"" \
+		[backslashify $format($localeName,$key)] "\""
+	    puts $f $cmd
+	}
+    }
+
+    # Footer
+
+    puts $f "\}"
+    close $f
+}
+
+#----------------------------------------------------------------------
+#
+# percentify --
+#
+#	Converts a Java/ICU-style time format to a C/Tcl style one.
+#
+# Parameters:
+#	string -- Format to convert
+#
+# Results:
+#	Returns the converted format.
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc percentify { string } {
+    set retval {}
+    foreach { unquoted quoted } [split $string '] {
+	append retval [string map {
+	    EEEE %A MMMM %B yyyy %Y
+	    MMM %b EEE %a
+	    dd %d hh %I HH %H mm %M MM %m ss %S yy %y
+	    a %P d %e h %l H %k M %m z %z
+	} $unquoted]
+	append retval $quoted
+    }
+    return $retval
+}
+
+#----------------------------------------------------------------------
+#
+# backslashify --
+#
+#	Converts a UTF-8 string to a plain ASCII one with escapes.
+#
+# Parameters:
+#	string -- String to convert
+#
+# Results:
+#	Returns the converted string
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc backslashify { string } {
+
+    set retval {}
+    foreach char [split $string {}] {
+	scan $char %c ccode
+	if { $ccode >= 0x0020 && $ccode < 0x007f && $char ne "\""
+	     && $char ne "\{" && $char ne "\}" && $char ne "\["
+	     && $char ne "\]" && $char ne "\\" && $char ne "\$" } {
+	    append retval $char
+	} else {
+	    append retval \\u [format %04x $ccode]
+	}
+    }
+    return $retval
+}
+
+#----------------------------------------------------------------------
+#
+# MAIN PROGRAM
+#
+#----------------------------------------------------------------------
+
+# Extract directories from command line
+
+foreach { icudir msgdir } $argv break
+
+# Walk the ICU files and create corresponding Tcl message catalogs
+
+foreach fileName [glob -directory $icudir *.txt] {
+    set n [file rootname [file tail $fileName]]
+    if { [regexp {^[a-z]{2,3}(_[A-Z]{2,3}(_.*)?)?$} $n] } {
+	handleLocaleFile $n $fileName [file join $msgdir [string tolower $n].msg]
+    }
+}

tools/man2help.tcl

@@ -0,0 +1,141 @@
+# 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.
+
+#
+# PASS 1
+#
+
+set man2tclprog [file join [file dirname [info script]] \
+	man2tcl[file extension [info nameofexecutable]]]
+
+proc generateContents {basename version files} {
+    global curID topics
+    set curID 0
+    foreach f $files {
+	puts "Pass 1 -- $f"
+	flush stdout
+	doFile $f
+    }
+    set fd [open [file join [file dirname [info script]] $basename$version.cnt] w]
+    fconfigure $fd -translation crlf
+    puts $fd ":Base $basename$version.hlp"
+    foreach package [getPackages] {
+	foreach section [getSections $package] {
+            if {![info exists lastSection]} {
+	        set lastSection {}
+            }
+            if {[string compare $lastSection $section]} {
+	    puts $fd "1 $section"
+            }
+            set lastSection $section
+	    set lastTopic {}
+	    foreach topic [getTopics $package $section] {
+		if {[string compare $lastTopic $topic]} {
+		    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 [file join [file dirname [info script]] $basename.rtf] w]
+    fconfigure $file -translation crlf
+    puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\{\\f1\\fmodern\\fcharset0\\fprq1 Courier New\;\}\}"
+    foreach f $files {
+	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} {
+    global man2tclprog
+    if {[catch {eval [exec $man2tclprog [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 -directory $dir "*.\[13n\]"]] {
+	doFile $f
+    }
+}
+
+# process command line arguments
+
+if {$argc < 3} {
+    puts stderr "usage: $argv0 \[options\] projectName version manFiles..."
+    exit 1
+}
+
+set arg 0
+
+if {![string compare [lindex $argv $arg] "-bitmap"]} {
+    set bitmap [lindex $argv [incr arg]]
+    incr arg
+}
+set baseName [lindex $argv $arg]
+set version [lindex $argv [incr arg]]
+set files {}
+foreach i [lrange $argv [incr arg] end] {
+    set i [file join $i]
+    if {[file isdir $i]} {
+	foreach f [lsort [glob -directory $i "*.\[13n\]"]] {
+	    lappend files $f
+	}
+    } elseif {[file exists $i]} {
+	lappend files $i
+    }
+}
+source [file join [file dirname [info script]] index.tcl]
+generateContents $baseName $version $files
+source [file join [file dirname [info script]] man2help2.tcl]
+generateHelp $baseName $files

tools/man2html.tcl

@@ -0,0 +1,185 @@
+#!/bin/sh
+# \
+exec tclsh "$0" ${1+"$@"}
+
+# man2html.tcl --
+#
+# This file contains procedures that work in conjunction with the
+# man2tcl program to generate a HTML files from Tcl manual entries.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+
+
+# sarray -
+#
+# Save an array to a file so that it can be sourced.
+#
+# Arguments:
+# file -		Name of the output file
+# args -		Name of the arrays to save
+#
+proc sarray {file args} {
+    set file [open $file w]
+    foreach a $args {
+	upvar $a array
+	if {![array exists array]} {
+	    puts "sarray: \"$a\" isn't an array"
+	    break
+	}
+
+	foreach name [lsort [array names array]] {
+	    regsub -all " " $name "\\ " name1
+	    puts $file "set ${a}($name1) \{$array($name)\}"
+	}
+    }
+    close $file
+}
+
+
+# footer --
+#
+# Builds footer info for HTML pages
+#
+# Arguments:
+# packages -		List of packages to link to.
+
+proc footer {packages} {
+    lappend f "<HR>"
+    set h {[}
+    foreach package $packages {
+	lappend h "<A HREF=\"../$package/contents.html\">$package</A>"
+	lappend h "|"
+    }
+    lappend f [join [lreplace $h end end {]} ] " "]
+    lappend f "<HR>"
+    lappend f "<PRE>Copyright &#169; 1989-1994 The Regents of the University of California."
+    lappend f "Copyright &#169; 1994-1996 Sun Microsystems, Inc."
+    lappend f "</PRE>"
+    return [join $f "\n"]
+}
+
+
+# doDir --
+#
+# Given a directory as argument, translate all the man pages in
+# that directory.
+#
+# Arguments:
+# dir -			Name of the directory.
+
+proc doDir dir {
+    foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
+	do $f	;# defined in man2html1.tcl & man2html2.tcl
+    }
+}
+
+
+# main --
+#
+# Main code for converting Tcl manual pages to HTML.
+#
+# Arguments:
+# argv -		List of arguments to this script.
+
+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
+
+    if {[llength $argv] < 2} {
+	puts stderr "usage: $::argv0 html_dir tcl_dir packages..."
+	puts stderr "usage: $::argv0 -clean html_dir"
+	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]]
+
+    #### need to add glob capability to packages ####
+
+    # 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
+
+    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 {
+	file mkdir $html_dir/$package
+
+	# 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 "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
+
+	# 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
+	#
+	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
+    }
+}
+
+
+if [catch { main $argv } result] {
+    global errorInfo
+    puts stderr $result
+    puts stderr "in"
+    puts stderr $errorInfo
+}

tools/man2html1.tcl

@@ -0,0 +1,258 @@
+# man2html1.tcl --
+#
+# This file defines procedures that are used during the first pass of the
+# man page to html conversion process. It is sourced by h.tcl.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+
+# Global variables used by these scripts:
+#
+# state -	state variable that controls action of text proc.
+#
+# curFile -	tail of current man page.
+#
+# file -	file pointer; for both xref.tcl and contents.html
+#
+# NAME_file -	array indexed by NAME and containing file names used
+#		for hyperlinks.
+#
+# KEY_file -	array indexed by KEYWORD and containing file names used
+#		for hyperlinks.
+#
+# lib -		contains package name. Used to label section in contents.html
+#
+# inDT -	in dictionary term.
+
+
+# text --
+#
+# This procedure adds entries to the hypertext arrays NAME_file
+# and KEY_file.
+#
+# DT: might do this: if first word of $dt matches $name and [llength $name==1]
+# 	and [llength $dt > 1], then add to NAME_file.
+#
+# Arguments:
+# string -		Text to index.
+
+proc text string {
+    global state curFile NAME_file KEY_file inDT
+
+    switch $state {
+	NAME {
+	    foreach i [split $string ","] {
+		lappend NAME_file([string trim $i]) $curFile
+	    }
+	}
+	KEY {
+	    foreach i [split $string ","] {
+		lappend KEY_file([string trim $i]) $curFile
+	    }
+	}
+	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 - SS {
+	    global state
+
+	    switch $args {
+		NAME {
+		    if {$state eq "INIT"} {
+			set state NAME
+		    }
+		}
+		DESCRIPTION {set state DT}
+		INTRODUCTION {set state DT}
+		KEYWORDS {set state KEY}
+		default {set state OFF}
+	    }
+
+	}
+	TP {
+	    global inDT
+	    set inDT 1
+	}
+	TH {
+	    global lib state inDT
+	    set inDT 0
+	    set state INIT
+	    if {[llength $args] != 5} {
+		set args [join $args " "]
+		puts stderr "Bad .TH macro: .$name $args"
+	    }
+	    set lib [lindex $args 3]				;# Tcl or Tk
+	}
+    }
+}
+
+
+# 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 eq "NAME"} {
+	set state DASH
+    }
+}
+
+
+# newline --
+#
+# This procedure is invoked to handle newlines in the troff input.
+# It's only purpose is to terminate a DT (dictionary term).
+#
+# Arguments:
+# None.
+
+proc newline {} {
+    global inDT
+    set inDT 0
+}
+
+
+# initGlobals, tab, font, char, macro2 --
+#
+# These procedures do nothing during the first pass.
+#
+# Arguments:
+# None.
+
+proc initGlobals {} {}
+proc tab {} {}
+proc font type {}
+proc char name {}
+proc macro2 {name args} {}
+
+
+# doListing --
+#
+# Writes an ls like list to a file. Searches NAME_file for entries
+# that match the input pattern.
+#
+# Arguments:
+# file -		Output file pointer.
+# pattern -		glob style match pattern
+
+proc doListing {file pattern} {
+    global NAME_file
+
+    set max_len 0
+    foreach name [lsort [array names NAME_file]] {
+	set ref $NAME_file($name)
+	    if [string match $pattern $ref] {
+		lappend type $name
+		if {[string length $name] > $max_len} {
+		set max_len [string length $name]
+	    }
+	}
+    }
+    if [catch {llength $type} ] {
+	puts stderr "       doListing: no names matched pattern ($pattern)"
+	return
+    }
+    incr max_len
+    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
+	incr index
+    }
+
+    puts -nonewline $file "<PRE>"
+    for {set i 0} {$i<$nrows} {incr i} {
+	foreach name $row($i) {
+	    set str [format "%-*s" $max_len $name]
+	    regsub $name $str "<A HREF=\"$NAME_file($name).html\">$name</A>" str
+	    puts -nonewline $file $str
+	}
+	puts $file {}
+    }
+    puts $file "</PRE>"
+}
+
+
+# doContents --
+#
+# Generates a HTML contents file using the NAME_file array
+# as its input database.
+#
+# 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.
+
+proc doContents {file packageName} {
+    global footer
+
+    set file [open $file w]
+
+    puts $file "<HTML><HEAD><TITLE>$packageName Manual</TITLE></HEAD><BODY>"
+    puts $file "<H3>$packageName</H3>"
+    doListing $file "*.1"
+
+    puts $file "<HR><H3>$packageName Commands</H3>"
+    doListing $file "*.n"
+
+    puts $file "<HR><H3>$packageName Library</H3>"
+    doListing $file "*.3"
+
+    puts $file $footer
+    puts $file "</BODY></HTML>"
+    close $file
+}
+
+
+# do --
+#
+# This is the toplevel procedure that searches a man page
+# for hypertext links.  It builds a data base consisting of
+# two arrays: NAME_file and KEY file. It runs the man2tcl
+# program to turn the man page into a script, then it evals
+# that script.
+#
+# Arguments:
+# fileName -		Name of the file to scan.
+
+proc do fileName {
+    global curFile
+    set curFile [file tail $fileName]
+    set file stdout
+    puts "  Pass 1 -- $fileName"
+    flush stdout
+    if [catch {eval [exec man2tcl [glob $fileName]]} msg] {
+	global errorInfo
+	puts stderr $msg
+	puts "in"
+	puts $errorInfo
+	exit 1
+    }
+}

tools/man2html2.tcl

@@ -0,0 +1,927 @@
+##############################################################################
+# man2html2.tcl --
+#
+# This file defines procedures that are used during the second pass of the man
+# page to html conversion process. It is sourced by man2html.tcl.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+
+# Global variables used by these scripts:
+#
+# NAME_file -	array indexed by NAME and containing file names used for
+#		hyperlinks.
+#
+# textState -	state variable defining action of 'text' proc.
+#
+# nestStk -	stack oriented list containing currently active HTML tags (UL,
+#		OL, DL). Local to 'nest' proc.
+#
+# inDT -	set by 'TPmacro', cleared by 'newline'. Used to insert the
+#		tag while in a dictionary list <DL>.
+#
+# curFont -	Name of special font that is currently in use. Null means the
+#		default paragraph font is being used.
+#
+# file -	Where to output the generated HTML.
+#
+# fontStart -	Array to map font names to starting sequences.
+#
+# fontEnd -	Array to map font names to ending sequences.
+#
+# noFillCount -	Non-zero means don't fill the next $noFillCount lines: force a
+#		line break at each newline. Zero means filling is enabled, so
+#		don't output line breaks for each newline.
+#
+# footer -	info inserted at bottom of each page. Normally read from the
+#		xref.tcl file
+
+##############################################################################
+# 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 {} {
+    global file noFillCount textState
+    global fontStart fontEnd curFont inPRE charCnt inTable
+
+    nest init
+    set inPRE 0
+    set inTable 0
+    set textState 0
+    set curFont ""
+    set fontStart(Code) "<B>"
+    set fontStart(Emphasis) "<I>"
+    set fontEnd(Code) "</B>"
+    set fontEnd(Emphasis) "</I>"
+    set noFillCount 0
+    set charCnt 0
+    setTabs 0.5i
+}
+
+##############################################################################
+# 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 curFont file fontStart
+
+    if {$curFont eq $font} {
+	return
+    }
+    endFont
+    puts -nonewline $file $fontStart($font)
+    set curFont $font
+}
+
+##############################################################################
+# endFont --
+#
+# Reverts to the default font for the paragraph type.
+#
+# Arguments:
+# None.
+
+proc endFont {} {
+    global curFont file fontEnd
+
+    if {$curFont ne ""} {
+	puts -nonewline $file $fontEnd($curFont)
+	set curFont ""
+    }
+}
+
+##############################################################################
+# text --
+#
+# This procedure adds text to the current paragraph. If this is the first text
+# in the paragraph then header information for the paragraph is output before
+# the text.
+#
+# Arguments:
+# string -		Text to output in the paragraph.
+
+proc text string {
+    global file textState inDT charCnt inTable
+
+    set pos [string first "\t" $string]
+    if {$pos >= 0} {
+    	text [string range $string 0 [expr $pos-1]]
+    	tab
+    	text [string range $string [expr $pos+1] end]
+	return
+    }
+    if {$inTable} {
+	if {$inTable == 1} {
+	    puts -nonewline $file <TR>
+	    set inTable 2
+	}
+	puts -nonewline $file <TD>
+    }
+    incr charCnt [string length $string]
+    regsub -all {&} $string {\&amp;}  string
+    regsub -all {<} $string {\&lt;}  string
+    regsub -all {>} $string {\&gt;}  string
+    regsub -all \"  $string {\&quot;}  string
+    switch -exact -- $textState {
+	REF {
+	    if {$inDT eq ""} {
+		set string [insertRef $string]
+	    }
+	}
+	SEE {
+	    global NAME_file
+	    foreach i [split $string] {
+		if {![regexp -nocase {^[a-z_]+} [string trim $i] i]} {
+# 		    puts "Warning: $i in SEE ALSO not found"
+		    continue
+		}
+		if {![catch { set ref $NAME_file($i) }]} {
+		    regsub $i $string "<A HREF=\"$ref.html\">$i</A>" string
+		}
+	    }
+	}
+    }
+    puts -nonewline $file "$string"
+    if {$inTable} {
+	puts -nonewline $file </TD>
+    }
+}
+
+##############################################################################
+# insertRef --
+#
+# Arguments:
+# string -		Text to output in the paragraph.
+
+proc insertRef string {
+    global NAME_file self
+    set path {}
+    if {![catch { set ref $NAME_file([string trim $string]) }]} {
+	if {"$ref.html" ne $self} {
+	    set string "<A HREF=\"${path}$ref.html\">$string</A>"
+#	    puts "insertRef: $self $ref.html ---$string--"
+	}
+    }
+    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} {
+    switch $name {
+	AP {
+	    if {[llength $args] != 3} {
+		puts stderr "Bad .AP macro: .$name [join $args " "]"
+	    }
+	    setTabs {1.25i 2.5i 3.75i}
+	    TPmacro {}
+	    font B
+	    text "[lindex $args 0]  "
+	    font I
+	    text "[lindex $args 1]"
+	    font R
+	    text " ([lindex $args 2])"
+	    newline
+	}
+	AS {}				;# next page and previous page
+	br {
+	    lineBreak
+	}
+	BS {}
+	BE {}
+	CE {
+	    global file noFillCount inPRE
+	    puts $file </PRE></BLOCKQUOTE>
+	    set inPRE 0
+	}
+	CS {				;# code section
+	    global file noFillCount inPRE
+	    puts -nonewline $file <BLOCKQUOTE><PRE>
+	    set inPRE 1
+	}
+	DE {
+	    global file noFillCount inTable
+	    puts $file </TABLE></BLOCKQUOTE>
+	    set inTable 0
+	    set noFillCount 0
+	}
+	DS {
+	    global file noFillCount inTable
+	    puts -nonewline $file {<BLOCKQUOTE><TABLE BORDER="0">}
+	    set noFillCount 10000000
+	    set inTable 1
+	}
+	fi {
+	    global noFillCount
+	    set noFillCount 0
+	}
+	IP {
+	    IPmacro $args
+	}
+	LP {
+	    nest decr
+	    nest incr
+	    newPara
+	}
+	ne {
+	}
+	nf {
+	    global noFillCount
+	    set noFillCount 1000000
+	}
+	OP {
+	    global inDT file inPRE
+	    if {[llength $args] != 3} {
+		puts stderr "Bad .OP macro: .$name [join $args " "]"
+	    }
+	    nest para DL DT
+	    set inPRE 1
+	    puts -nonewline $file <PRE>
+	    setTabs 4c
+	    text "Command-Line Name:"
+	    tab
+	    font B
+	    set x [lindex $args 0]
+	    regsub -all {\\-} $x - x
+	    text $x
+	    newline
+	    font R
+	    text "Database Name:"
+	    tab
+	    font B
+	    text [lindex $args 1]
+	    newline
+	    font R
+	    text "Database Class:"
+	    tab
+	    font B
+	    text [lindex $args 2]
+	    font R
+	    puts -nonewline $file </PRE>
+	    set inDT "\n<DD>"			;# next newline writes inDT
+	    set inPRE 0
+	    newline
+	}
+	PP {
+	    nest decr
+	    nest incr
+	    newPara
+	}
+	RE {
+	    nest decr
+	}
+	RS {
+	    nest incr
+	}
+	SE {
+	    global noFillCount textState inPRE file
+
+	    font R
+	    puts -nonewline $file </PRE>
+	    set inPRE 0
+	    set noFillCount 0
+	    nest reset
+	    newPara
+	    text "See the "
+	    font B
+	    set temp $textState
+	    set textState REF
+	    if {[llength $args] > 0} {
+		text [lindex $args 0]
+	    } else {
+		text options
+	    }
+	    set textState $temp
+	    font R
+	    text " manual entry for detailed descriptions of the above options."
+	}
+	SH {
+	    SHmacro $args
+	}
+	SS {
+	    SHmacro $args subsection
+	}
+	SO {
+	    global noFillCount inPRE file
+
+	    SHmacro "STANDARD OPTIONS"
+	    setTabs {4c 8c 12c}
+	    set noFillCount 1000000
+	    puts -nonewline $file <PRE>
+	    set inPRE 1
+	    font B
+	}
+	so {
+	    if {$args ne "man.macros"} {
+		puts stderr "Unknown macro: .$name [join $args " "]"
+	    }
+	}
+	sp {					;# needs work
+	    if {$args eq ""} {
+		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
+	    global file
+	    puts -nonewline $file "<B><U>"
+	    text [lindex $args 0]
+	    puts -nonewline $file "</U></B>"
+	    if {[llength $args] == 2} {
+		text [lindex $args 1]
+	    }
+	}
+	VE {
+#	    global file
+#	    puts -nonewline $file "</FONT>"
+	}
+	VS {
+#	    global file
+#	    if {[llength $args] > 0} {
+#		puts -nonewline $file "<BR>"
+#	    }
+#	    puts -nonewline $file "<FONT COLOR=\"GREEN\">"
+	}
+	QW {
+	    puts -nonewline $file "&\#147;"
+	    text [lindex $args 0]
+	    puts -nonewline $file "&\#148;"
+	    if {[llength $args] > 1} {
+		text [lindex $args 1]
+	    }
+	}
+	PQ {
+	    puts -nonewline $file "(&\#147;"
+	    if {[lindex $args 0] eq {\N'34'}} {
+		puts -nonewline $file \"
+	    } else {
+		text [lindex $args 0]
+	    }
+	    puts -nonewline $file "&\#148;"
+	    if {[llength $args] > 1} {
+		text [lindex $args 1]
+	    }
+	    puts -nonewline $file ")"
+	    if {[llength $args] > 2} {
+		text [lindex $args 2]
+	    }
+	}
+	QR {
+	    puts -nonewline $file "&\#147;"
+	    text [lindex $args 0]
+	    puts -nonewline $file "&\#148;&\#150;&\#147;"
+	    text [lindex $args 1]
+	    puts -nonewline $file "&\#148;"
+	    if {[llength $args] > 2} {
+		text [lindex $args 2]
+	    }
+	}
+	MT {
+	    puts -nonewline $file "&\#147;&\#148;"
+	}
+	default {
+	    puts stderr "Unknown macro: .$name [join $args " "]"
+	}
+    }
+
+#	global nestStk; puts "$name [format "%-20s" $args] $nestStk"
+#	flush stdout; flush stderr
+}
+
+##############################################################################
+# 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 textState
+    switch $type {
+	P -
+	R {
+	    endFont
+	    if {$textState eq "REF"} {
+		set textState INSERT
+	    }
+	}
+	B {
+	    beginFont Code
+	    if {$textState eq "INSERT"} {
+		set 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 {
+#	puts "formattedText: $text"
+    while {$text ne ""} {
+	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]
+	    }
+	    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 textState charCnt
+    if {$textState eq "NAME"} {
+    	set textState 0
+    }
+    incr charCnt
+    text "-"
+}
+
+##############################################################################
+# tab --
+#
+# This procedure is invoked to handle tabs in the troff input.
+#
+# Arguments:
+# None.
+
+proc tab {} {
+    global inPRE charCnt tabString file
+#	? charCnt
+    if {$inPRE == 1} {
+	set pos [expr $charCnt % [string length $tabString] ]
+	set spaces [string first "1" [string range $tabString $pos end] ]
+	text [format "%*s" [incr spaces] " "]
+    } else {
+#	puts "tab: found tab outside of <PRE> block"
+    }
+}
+
+##############################################################################
+# 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 breakPending tabString
+
+    # puts "setTabs: --$tabList--"
+    set last 0
+    set tabString {}
+    set charsPerInch 14.
+    set numTabs [llength $tabList]
+    foreach arg $tabList {
+	if {[string match +* $arg]} {
+	    set relative 1
+	    set arg [string range $arg 1 end]
+	} else {
+	    set relative 0
+	}
+	# Always operate in relative mode for "measurement" mode
+	if {[regexp {^\\w'(.*)'u$} $arg content]} {
+	    set distance [string length $content]
+	} else {
+	    if {[scan $arg "%f%s" distance units] != 2} {
+		puts stderr "bad distance \"$arg\""
+		return 0
+	    }
+	    switch -- $units {
+		c {
+		    set distance [expr {$distance * $charsPerInch / 2.54}]
+		}
+		i {
+		    set distance [expr {$distance * $charsPerInch}]
+		}
+		default {
+		    puts stderr "bad units in distance \"$arg\""
+		    continue
+		}
+	    }
+	}
+	# ? distance
+	if {$relative} {
+	    append tabString [format "%*s1" [expr {round($distance-1)}] " "]
+	    set last [expr {$last + $distance}]
+	} else {
+	    append tabString [format "%*s1" [expr {round($distance-$last-1)}] " "]
+	    set last $distance
+	}
+    }
+    # puts "setTabs: --$tabString--"
+}
+
+##############################################################################
+# lineBreak --
+#
+# Generates a line break in the HTML output.
+#
+# Arguments:
+# None.
+
+proc lineBreak {} {
+    global file inPRE
+    puts $file "<BR>"
+}
+
+##############################################################################
+# 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 noFillCount file inDT inPRE charCnt inTable
+
+    if {$inDT ne ""} {
+    	puts $file "\n$inDT"
+    	set inDT {}
+    } elseif {$inTable} {
+	if {$inTable > 1} {
+	    puts $file </tr>
+	    set inTable 1
+	}
+    } elseif {$noFillCount == 0 || $inPRE == 1} {
+	puts $file {}
+    } else {
+	lineBreak
+	incr noFillCount -1
+    }
+    set charCnt 0
+}
+
+##############################################################################
+# 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 charCnt
+
+    incr charCnt
+#	puts "char: $name"
+    switch -exact $name {
+	\\0 {					;#  \0
+	    puts -nonewline $file " "
+	}
+	\\\\ {					;#  \
+	    puts -nonewline $file "\\"
+	}
+	\\(+- { 				;#  +/-
+	    puts -nonewline $file "&#177;"
+	}
+	\\% {}					;#  \%
+	\\| {					;#  \|
+	}
+	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 and .SS macros.
+#
+# Arguments:
+# name -		Section name.
+# style -		Type of section (optional)
+
+proc SHmacro {argList {style section}} {
+    global file noFillCount textState charCnt
+
+    set args [join $argList " "]
+    if {[llength $argList] < 1} {
+	puts stderr "Bad .SH macro: .$name $args"
+    }
+
+    set noFillCount 0
+    nest reset
+
+    set tag H3
+    if {$style eq "subsection"} {
+	set tag H4
+    }
+    puts -nonewline $file "<$tag>"
+    text $args
+    puts $file "</$tag>"
+
+#	? args textState
+
+    # control what the text proc does with text
+
+    switch $args {
+	NAME {set textState NAME}
+	DESCRIPTION {set textState INSERT}
+	INTRODUCTION {set textState INSERT}
+	"WIDGET-SPECIFIC OPTIONS" {set textState INSERT}
+	"SEE ALSO" {set textState SEE}
+	KEYWORDS {set textState 0}
+    }
+    set charCnt 0
+}
+
+##############################################################################
+# IPmacro --
+#
+# This procedure is invoked to handle ".IP" macros, which may take any of the
+# following forms:
+#
+# .IP [1]			Translate to a "1Step" paragraph.
+# .IP [x] (x > 1)		Translate to a "Step" paragraph.
+# .IP				Translate to a "Bullet" paragraph.
+# .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.
+#
+# HTML limitations: 'count' in '.IP text count' is ignored.
+
+proc IPmacro argList {
+    global file
+
+    setTabs 0.5i
+    set length [llength $argList]
+    if {$length == 0} {
+    	nest para UL LI
+	return
+    }
+    # Special case for alternative mechanism for declaring bullets
+    if {[lindex $argList 0] eq "\\(bu"} {
+	nest para UL LI
+	return
+    }
+    if {[regexp {^\[\d+\]$} [lindex $argList 0]]} {
+    	nest para OL LI
+	return
+    }
+    nest para DL DT
+    formattedText [lindex $argList 0]
+    puts $file "\n<DD>"
+    return
+}
+
+##############################################################################
+# TPmacro --
+#
+# This procedure is invoked to handle ".TP" macros, which may take any of the
+# following forms:
+#
+# .TP x		Translate to an indented paragraph with the specified indent
+# 			(in 100 twip units).
+# .TP		Translate to an indented paragraph with default indent.
+#
+# Arguments:
+# argList -		List of arguments to the .IP macro.
+#
+# HTML limitations: 'x' in '.TP x' is ignored.
+
+proc TPmacro {argList} {
+    global inDT
+    nest para DL DT
+    set inDT "\n<DD>"			;# next newline writes inDT
+    setTabs 0.5i
+}
+
+##############################################################################
+# 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
+
+    if {[llength $argList] != 5} {
+	set args [join $argList " "]
+	puts stderr "Bad .TH macro: .$name $args"
+    }
+    set name  [lindex $argList 0]		;# Tcl_UpVar
+    set page  [lindex $argList 1]		;# 3
+    set vers  [lindex $argList 2]		;# 7.4
+    set lib   [lindex $argList 3]		;# Tcl
+    set pname [lindex $argList 4]		;# {Tcl Library Procedures}
+
+    puts -nonewline $file "<HTML><HEAD><TITLE>"
+    text "$lib - $name ($page)"
+    puts $file "</TITLE></HEAD><BODY>\n"
+
+    puts -nonewline $file "<H1><CENTER>"
+    text $pname
+    puts $file "</CENTER></H1>\n"
+}
+
+##############################################################################
+# newPara --
+#
+# This procedure sets the left and hanging indents for a line. Indents are
+# specified in units of inches or centimeters, and are relative to the current
+# nesting level and left margin.
+#
+# Arguments:
+# None
+
+proc newPara {} {
+    global file nestStk
+
+    if {[lindex $nestStk end] ne "NEW"} {
+	nest decr
+    }
+    puts -nonewline $file "<P>"
+}
+
+##############################################################################
+# nest --
+#
+# This procedure takes care of inserting the tags associated with the IP, TP,
+# RS, RE, LP and PP macros. Only 'nest para' takes arguments.
+#
+# Arguments:
+# op -				operation: para, incr, decr, reset, init
+# listStart -		begin list tag: OL, UL, DL.
+# listItem -		item tag:       LI, LI, DT.
+
+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 eq "NEW"} {
+		set nestStk [lreplace $nestStk end end $listStart]
+		puts $file "<$listStart>"
+	    } elseif {$top ne $listStart} {
+		puts stderr "nest para: bad stack"
+		exit 1
+	    }
+	    puts $file "\n<$listItem>"
+	    set charCnt 0
+	}
+	incr {
+	   lappend nestStk NEW
+	}
+	decr {
+	    if {[llength $nestStk] == 0} {
+		puts stderr "nest error: nest length is zero"
+		set nestStk NEW
+	    }
+	    set tag [lindex $nestStk end]
+	    if {$tag ne "NEW"} {
+		puts $file "</$tag>"
+	    }
+	    set nestStk [lreplace $nestStk end end]
+	}
+	reset {
+	    while {[llength $nestStk] > 0} {
+		nest decr
+	    }
+	    set nestStk NEW
+	}
+	init {
+	    set nestStk NEW
+	    set inDT {}
+	}
+    }
+    set charCnt 0
+}
+
+##############################################################################
+# do --
+#
+# This is the toplevel procedure that translates a man page to HTML. It runs
+# the man2tcl program to turn the man page into a script, then it evals that
+# script.
+#
+# Arguments:
+# fileName -		Name of the file to translate.
+
+proc do fileName {
+    global file self html_dir package footer
+    set self "[file tail $fileName].html"
+    set file [open "$html_dir/$package/$self" w]
+    puts "  Pass 2 -- $fileName"
+    flush stdout
+    initGlobals
+    if {[catch { eval [exec man2tcl [glob $fileName]] } msg]} {
+	global errorInfo
+	puts stderr $msg
+	puts "in"
+	puts stderr $errorInfo
+	exit 1
+    }
+    nest reset
+    puts $file $footer
+    puts $file "</BODY></HTML>"
+    close $file
+}

tools/man2tcl.c

@@ -0,0 +1,424 @@
+/*
+ * 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.
+ */
+
+static char sccsid[] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08";
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <errno.h>
+
+/*
+ * Imported things that aren't defined in header files:
+ */
+
+/*
+ * Some <errno.h> define errno to be something complex and thread-aware; in
+ * that case we definitely do not want to declare errno ourselves!
+ */
+
+#ifndef errno
+extern int errno;
+#endif
+
+/*
+ * 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;
+
+#define PRINT(args)	if (writeOutput) { printf args; }
+#define PRINTC(chr)	if (writeOutput) { putc((chr), stdout); }
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static void		DoMacro(char *line);
+static void		DoText(char *line);
+static void		QuoteText(char *string, int count);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ *	This function 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(
+    int argc,			/* Number of command-line arguments. */
+    char **argv)		/* Values of command-line arguments. */
+{
+    FILE *f;
+#define MAX_LINE_SIZE 4000
+    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[0] == '\'')) && (line[1] == '\\') && (line[2] == '\"')) {
+		/*
+		 * This line is a comment. Ignore it.
+		 */
+
+		continue;
+	    }
+
+	    if (strlen(line) >= MAX_LINE_SIZE -1) {
+		fprintf(stderr, "Too long line. Max is %d chars.\n",
+			MAX_LINE_SIZE - 1);
+		exit(1);
+	    }
+
+	    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 function 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(
+    char *line)			/* The line of text that contains the macro
+				 * invocation. */
+{
+    char *p, *end;
+    int quote;
+
+    /*
+     * If there is no macro name, then just skip the whole line.
+     */
+
+    if ((line[1] == 0) || (isspace(line[1]))) {
+	return;
+    }
+
+    PRINT(("macro"));
+    if (*line != '.') {
+	PRINT(("2"));
+    }
+
+    /*
+     * Parse the arguments to the macro (including the name), in order.
+     */
+
+    p = line+1;
+    while (1) {
+	PRINTC(' ');
+	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 {
+	    quote = 0;
+	    for (end = p+1; (*end != 0) && (quote || !isspace(*end)); end++) {
+		if (*end == '\'') {
+		    quote = !quote;
+		}
+	    }
+	    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;
+	}
+    }
+    PRINTC('\n');
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoText --
+ *
+ *	This function 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(
+    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') {
+	    PRINT(("tab\n"));
+	    p++;
+	} else if (*p != '\\') {
+	    /*
+	     * Ordinary text.
+	     */
+
+	    for (end = p+1; (*end != '\\') && (*end != 0); end++) {
+		/* Empty loop body. */
+	    }
+	    PRINT(("text "));
+	    QuoteText(p, end-p);
+	    PRINTC('\n');
+	    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.
+		 */
+
+		PRINT(("font %c\n", p[1]));
+		p += 2;
+	    } else if (*p == '-') {
+		PRINT(("dash\n"));
+		p++;
+	    } else if (*p == 'e') {
+		PRINT(("text \\\\\n"));
+		p++;
+	    } else if (*p == '.') {
+		PRINT(("text .\n"));
+		p++;
+	    } else if (*p == '&') {
+		p++;
+	    } else if (*p == '0') {
+		PRINT(("text { }\n"));
+		p++;
+	    } else if (*p == '(') {
+		if ((p[1] == 0) || (p[2] == 0)) {
+		    fprintf(stderr, "Bad \\( sequence on line %d.\n",
+			    lineNumber);
+		    status = 1;
+		} else {
+		    PRINT(("char {\\(%c%c}\n", p[1], p[2]));
+		    p += 3;
+		}
+	    } else if (*p == 'N' && *(p+1) == '\'') {
+		int ch;
+
+		p += 2;
+		sscanf(p,"%d",&ch);
+		PRINT(("text \\u%04x\n", ch));
+		while(*p&&*p!='\'') p++;
+		p++;
+	    } else if (*p != 0) {
+		PRINT(("char {\\%c}\n", *p));
+		p++;
+	    }
+	}
+    }
+    PRINT(("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(
+    char *string,		/* The line of text. */
+    int count)			/* Number of characters to write from
+				 * string. */
+{
+    if (count == 0) {
+	PRINT(("{}"));
+	return;
+    }
+    for ( ; count > 0; string++, count--) {
+	switch (*string) {
+	case '\\':
+	    if (*(string+1) == 'N' && *(string+2) == '\'') {
+		int ch;
+
+		string += 3;
+		count -= 3;
+		sscanf(string,"%d",&ch);
+		PRINT(("\\u%04x", ch));
+		while(count>0&&*string!='\'') {string++;count--;}
+		continue;
+	    } else if (*(string+1) == '0') {
+		PRINT(("\\ "));
+		string++;
+		count--;
+		continue;
+	    }
+	case '$': case '[': case '{': case ' ': case ';':
+	case '"': case '\t':
+	    PRINTC('\\');
+	default:
+	    PRINTC(*string);
+	}
+    }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */

tools/mkdepend.tcl

@@ -0,0 +1,420 @@
+#==============================================================================
+#
+# mkdepend : generate dependency information from C/C++ files
+#
+# Copyright (c) 1998, Nat Pryce
+#
+# Permission is hereby granted, without written agreement and without
+# license or royalty fees, to use, copy, modify, and distribute this
+# software and its documentation for any purpose, provided that the
+# above copyright notice and the following two paragraphs appear in
+# all copies of this software.
+#
+# IN NO EVENT SHALL THE AUTHOR BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
+# SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF
+# THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR HAS BEEN ADVISED
+# OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+# THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
+# BASIS, AND THE AUTHOR HAS NO OBLIGATION TO PROVIDE  MAINTENANCE, SUPPORT,
+# UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+#==============================================================================
+#
+# Modified heavily by David Gravereaux <davygrvy@pobox.com> about 9/17/2006.
+# Original can be found @
+#	http://web.archive.org/web/20070616205924/http://www.doc.ic.ac.uk/~np2/software/mkdepend.html
+#==============================================================================
+
+array set mode_data {}
+set mode_data(vc32) {cl -nologo -E}
+
+set source_extensions [list .c .cpp .cxx .cc]
+
+set excludes [list]
+if [info exists env(INCLUDE)] {
+    set rawExcludes [split [string trim $env(INCLUDE) ";"] ";"]
+    foreach exclude $rawExcludes {
+	lappend excludes [file normalize $exclude]
+    }
+}
+
+
+# openOutput --
+#
+#	Opens the output file.
+#
+# Arguments:
+#	file	The file to open
+#
+# Results:
+#	None.
+
+proc openOutput {file} {
+    global output
+    set output [open $file w]
+    puts $output "# Automatically generated at [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] by [info script]\n"
+}
+
+# closeOutput --
+#
+#	Closes output file.
+#
+# Arguments:
+#	none
+#
+# Results:
+#	None.
+
+proc closeOutput {} {
+    global output
+    if {[string match stdout $output] != 0} {
+        close $output
+    }
+}
+
+# readDepends --
+#
+#	Read off CCP pipe for #line references.
+#
+# Arguments:
+#	chan	The pipe channel we are reading in.
+#
+# Results:
+#	Raw dependency list pairs.
+
+proc readDepends {chan} {
+    set line ""
+    array set depends {}
+
+    while {[gets $chan line] != -1} {
+        if {[regexp {^#line [0-9]+ \"(.*)\"$} $line dummy fname] != 0} {
+	    set fname [file normalize $fname]
+            if {![info exists target]} {
+		# this is ourself
+		set target $fname
+		puts stderr "processing [file tail $fname]"
+            } else {
+		# don't include ourselves as a dependency of ourself.
+		if {![string compare $fname $target]} {continue}
+		# store in an array so multiple occurances are not counted.
+                set depends($target|$fname) ""
+            }
+        }
+    }
+
+    set result {}
+    foreach n [array names depends] {
+        set pair [split $n "|"]
+        lappend result [list [lindex $pair 0] [lindex $pair 1]]
+    }
+
+    return $result
+}
+
+# writeDepends --
+#
+#	Write the processed list out to the file.
+#
+# Arguments:
+#	out		The channel to write to.
+#	depends		The list of dependency pairs
+#
+# Results:
+#	None.
+
+proc writeDepends {out depends} {
+    foreach pair $depends {
+        puts $out "[lindex $pair 0] : \\\n\t[join [lindex $pair 1] " \\\n\t"]"
+    }
+}
+
+# stringStartsWith --
+#
+#	Compares second string to the beginning of the first.
+#
+# Arguments:
+#	str		The string to test the beginning of.
+#	prefix		The string to test against
+#
+# Results:
+#	the result of the comparison.
+
+proc stringStartsWith {str prefix} {
+    set front [string range $str 0 [expr {[string length $prefix] - 1}]]
+    return [expr {[string compare [string tolower $prefix] \
+                                  [string tolower $front]] == 0}]
+}
+
+# filterExcludes --
+#
+#	Remove non-project header files.
+#
+# Arguments:
+#	depends		List of dependency pairs.
+#	excludes	List of directories that should be removed
+#
+# Results:
+#	the processed dependency list.
+
+proc filterExcludes {depends excludes} {
+    set filtered {}
+
+    foreach pair $depends {
+        set excluded 0
+        set file [lindex $pair 1]
+
+        foreach dir $excludes {
+            if [stringStartsWith $file $dir] {
+                set excluded 1
+                break;
+            }
+        }
+
+        if {!$excluded} {
+            lappend filtered $pair
+        }
+    }
+
+    return $filtered
+}
+
+# replacePrefix --
+#
+#	Take the normalized search path and put back the
+#	macro name for it.
+#
+# Arguments:
+#	file	filename.
+#
+# Results:
+#	filename properly replaced with macro for it.
+
+proc replacePrefix {file} {
+    global srcPathList srcPathReplaceList
+
+    foreach was $srcPathList is $srcPathReplaceList {
+	regsub $was $file $is file
+    }
+    return $file
+}
+
+# rebaseFiles --
+#
+#	Replaces normalized paths with original macro names.
+#
+# Arguments:
+#	depends		Dependency pair list.
+#
+# Results:
+#	The processed dependency pair list.
+
+proc rebaseFiles {depends} {
+    set rebased {}
+    foreach pair $depends {
+        lappend rebased [list \
+                [replacePrefix [lindex $pair 0]] \
+		[replacePrefix [lindex $pair 1]]]
+
+    }
+    return $rebased
+}
+
+# compressDeps --
+#
+#	Compresses same named tragets into one pair with
+#	multiple deps.
+#
+# Arguments:
+#	depends	Dependency pair list.
+#
+# Results:
+#	The processed list.
+
+proc compressDeps {depends} {
+    array set compressed [list]
+
+    foreach pair $depends {
+	lappend compressed([lindex $pair 0]) [lindex $pair 1]
+    }
+
+    set result [list]
+    foreach n [array names compressed] {
+        lappend result [list $n [lsort $compressed($n)]]
+    }
+
+    return $result
+}
+
+# addSearchPath --
+#
+#	Adds a new set of path and replacement string to the global list.
+#
+# Arguments:
+#	newPathInfo	comma seperated path and replacement string
+#
+# Results:
+#	None.
+
+proc addSearchPath {newPathInfo} {
+    global srcPathList srcPathReplaceList
+
+    set infoList [split $newPathInfo ,]
+    lappend srcPathList [file normalize [lindex $infoList 0]]
+    lappend srcPathReplaceList [lindex $infoList 1]
+}
+
+
+# displayUsage --
+#
+#	Displays usage to stderr
+#
+# Arguments:
+#	none.
+#
+# Results:
+#	None.
+
+proc displayUsage {} {
+    puts stderr "mkdepend.tcl \[options\] genericDir,macroName compatDir,macroName platformDir,macroName"
+}
+
+# readInputListFile --
+#
+#	Open and read the object file list.
+#
+# Arguments:
+#	objectListFile - name of the file to open.
+#
+# Results:
+#	None.
+
+proc readInputListFile {objectListFile} {
+    global srcFileList srcPathList source_extensions
+    set f [open $objectListFile r]
+    set fl [read $f]
+    close $f
+
+    # fix native path seperator so it isn't treated as an escape.
+    regsub -all {\\} $fl {/} fl
+
+    # Treat the string as a list so filenames between double quotes are
+    # treated as list elements.
+    foreach fname $fl {
+	# Compiled .res resource files should be ignored.
+	if {[file extension $fname] ne ".obj"} {continue}
+
+	# Just filename without path or extension because the path is
+	# the build directory, not where the source files are located.
+	set baseName [file rootname [file tail $fname]]
+
+	set found 0
+	foreach path $srcPathList {
+	    foreach ext $source_extensions {
+		set test [file join $path ${baseName}${ext}]
+		if {[file exist $test]} {
+		    lappend srcFileList $test
+		    set found 1
+		    break
+		}
+	    }
+	    if {$found} break
+	}
+    }
+}
+
+# main --
+#
+#	The main procedure of this script.
+#
+# Arguments:
+#	none.
+#
+# Results:
+#	None.
+
+proc main {} {
+    global argc argv mode mode_data srcFileList srcPathList excludes
+    global remove_prefix target_prefix output env
+
+    set srcPathList [list]
+    set srcFileList [list]
+
+    if {$argc == 1} {displayUsage}
+
+    # Parse mkdepend input
+    for {set i 0} {$i < [llength $argv]} {incr i} {
+	switch -glob -- [set arg [lindex $argv $i]] {
+	    -vc32 {
+		set mode vc32
+	    }
+	    -bc32 {
+		set mode bc32
+	    }
+	    -wc32 {
+		set mode wc32
+	    }
+	    -lc32 {
+		set mode lc32
+	    }
+	    -mgw32 {
+		set mode mgw32
+	    }
+	    -passthru:* {
+		set passthru [string range $arg 10 end]
+		regsub -all {"} $passthru {\"} passthru
+		regsub -all {\\} $passthru {/} passthru
+	    }
+	    -out:* {
+		openOutput [string range $arg 5 end]
+	    }
+	    @* {
+		set objfile [string range $arg 1 end]
+		regsub -all {\\} $objfile {/} objfile
+		readInputListFile $objfile
+	    }
+	    -? - -help - --help {
+		displayUsage
+		exit 1
+	    }
+	    default {
+		if {![info exist mode]} {
+		    puts stderr "mode not set"
+		    displayUsage
+		}
+		addSearchPath $arg
+	    }
+	}
+    }
+
+    # Execute the CPP command and parse output
+
+    foreach srcFile $srcFileList {
+	if {[catch {
+	    set command "$mode_data($mode) $passthru \"$srcFile\""
+	    set input [open |$command r]
+	    set depends [readDepends $input]
+	    set status [catch {close $input} result]
+	    if {$status == 1 && [lindex $::errorCode 0] eq "CHILDSTATUS"} {
+		foreach { - pid code } $::errorCode break
+		if {$code == 2} {
+		    # preprocessor died a cruel death.
+		    error $result
+		}
+	    }
+	} err]} {
+	    puts stderr "error ocurred: $err\n"
+	    continue
+	}
+	set depends [filterExcludes $depends $excludes]
+	set depends [rebaseFiles $depends]
+	set depends [compressDeps $depends]
+	writeDepends $output $depends
+    }
+
+    closeOutput
+}
+
+# kick it up.
+main

tools/regexpTestLib.tcl

@@ -0,0 +1,263 @@
+# regexpTestLib.tcl --
+#
+# This file contains tcl procedures used by spencer2testregexp.tcl and
+# spencer2regexp.tcl, which are programs written to convert Henry
+# Spencer's test suite to tcl test files.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+
+proc readInputFile {} {
+    global inFileName
+    global lineArray
+
+    set fileId [open $inFileName r]
+
+    set i 0
+    while {[gets $fileId line] >= 0} {
+
+	set len [string length $line]
+
+	if {($len > 0) && ([string index $line [expr $len - 1]] == "\\")} {
+	    if {[info exists lineArray(c$i)] == 0} {
+		set lineArray(c$i) 1
+	    } else {
+		incr lineArray(c$i)
+	    }
+	    set line [string range $line 0 [expr $len - 2]]
+	    append lineArray($i) $line
+	    continue
+	}
+	if {[info exists lineArray(c$i)] == 0} {
+	    set lineArray(c$i) 1
+	} else {
+	    incr lineArray(c$i)
+	}
+	append lineArray($i) $line
+	incr i
+    }
+
+    close $fileId
+    return $i
+}
+
+#
+# strings with embedded @'s are truncated
+# unpreceeded @'s are replaced by {}
+#
+proc removeAts {ls} {
+    set len [llength $ls]
+    set newLs {}
+    foreach item $ls {
+	regsub @.* $item "" newItem
+	lappend newLs $newItem
+    }
+    return $newLs
+}
+
+proc convertErrCode {code} {
+
+    set errMsg "couldn't compile regular expression pattern:"
+
+    if {[string compare $code "INVARG"] == 0} {
+	return "$errMsg invalid argument to regex routine"
+    } elseif {[string compare $code "BADRPT"] == 0} {
+	return "$errMsg ?+* follows nothing"
+    } elseif {[string compare $code "BADBR"] == 0} {
+	return "$errMsg invalid repetition count(s)"
+    } elseif {[string compare $code "BADOPT"] == 0} {
+	return "$errMsg invalid embedded option"
+    } elseif {[string compare $code "EPAREN"] == 0} {
+	return "$errMsg unmatched ()"
+    } elseif {[string compare $code "EBRACE"] == 0} {
+	return "$errMsg unmatched {}"
+    } elseif {[string compare $code "EBRACK"] == 0} {
+	return "$errMsg unmatched \[\]"
+    } elseif {[string compare $code "ERANGE"] == 0} {
+	return "$errMsg invalid character range"
+    } elseif {[string compare $code "ECTYPE"] == 0} {
+	return "$errMsg invalid character class"
+    } elseif {[string compare $code "ECOLLATE"] == 0} {
+	return "$errMsg invalid collating element"
+    } elseif {[string compare $code "EESCAPE"] == 0} {
+	return "$errMsg invalid escape sequence"
+    } elseif {[string compare $code "BADPAT"] == 0} {
+	return "$errMsg invalid regular expression"
+    } elseif {[string compare $code "ESUBREG"] == 0} {
+	return "$errMsg invalid backreference number"
+    } elseif {[string compare $code "IMPOSS"] == 0} {
+	return "$errMsg can never match"
+    }
+    return "$errMsg $code"
+}
+
+proc writeOutputFile {numLines fcn} {
+    global outFileName
+    global lineArray
+
+    # open output file and write file header info to it.
+
+    set fileId [open $outFileName w]
+
+    puts $fileId "# Commands covered:  $fcn"
+    puts $fileId "#"
+    puts $fileId "# This Tcl-generated file contains tests for the $fcn tcl command."
+    puts $fileId "# Sourcing this file into Tcl runs the tests and generates output for"
+    puts $fileId "# errors.  No output means no errors were found.  Setting VERBOSE to"
+    puts $fileId "# -1 will run tests that are known to fail."
+    puts $fileId "#"
+    puts $fileId "# Copyright (c) 1998 Sun Microsystems, Inc."
+    puts $fileId "#"
+    puts $fileId "# See the file \"license.terms\" for information on usage and redistribution"
+    puts $fileId "# of this file, and for a DISCLAIMER OF ALL WARRANTIES."
+    puts $fileId "#"
+    puts $fileId "\# SCCS: \%Z\% \%M\% \%I\% \%E\% \%U\%"
+    puts $fileId "\nproc print \{arg\} \{puts \$arg\}\n"
+    puts $fileId "if \{\[string compare test \[info procs test\]\] == 1\} \{"
+    puts $fileId "    source defs ; set VERBOSE -1\n\}\n"
+    puts $fileId "if \{\$VERBOSE != -1\} \{"
+    puts $fileId "    proc print \{arg\} \{\}\n\}\n"
+    puts $fileId "#"
+    puts $fileId "# The remainder of this file is Tcl tests that have been"
+    puts $fileId "# converted from Henry Spencer's regexp test suite."
+    puts $fileId "#\n"
+
+    set lineNum 0
+    set srcLineNum 1
+    while {$lineNum < $numLines} {
+
+	set currentLine $lineArray($lineNum)
+
+	# copy comment string to output file and continue
+
+	if {[string index $currentLine 0] == "#"} {
+	    puts $fileId $currentLine
+	    incr srcLineNum $lineArray(c$lineNum)
+	    incr lineNum
+	    continue
+	}
+
+	set len [llength $currentLine]
+
+	# copy empty string to output file and continue
+
+	if {$len == 0} {
+	    puts $fileId "\n"
+	    incr srcLineNum $lineArray(c$lineNum)
+	    incr lineNum
+	    continue
+	}
+	if {($len < 3)} {
+	    puts "warning: test is too short --\n\t$currentLine"
+	    incr srcLineNum $lineArray(c$lineNum)
+	    incr lineNum
+	    continue
+	}
+
+	puts $fileId [convertTestLine $currentLine $len $lineNum $srcLineNum]
+
+	incr srcLineNum $lineArray(c$lineNum)
+	incr lineNum
+    }
+
+    close $fileId
+}
+
+proc convertTestLine {currentLine len lineNum srcLineNum} {
+
+    regsub -all {(?b)\\} $currentLine {\\\\} currentLine
+    set re [lindex $currentLine 0]
+    set flags [lindex $currentLine 1]
+    set str [lindex $currentLine 2]
+
+    # based on flags, decide whether to skip the test
+
+    if {[findSkipFlag $flags]} {
+	regsub -all {\[|\]|\(|\)|\{|\}|\#} $currentLine {\&} line
+	set msg "\# skipping char mapping test from line $srcLineNum\n"
+	append msg "print \{... skip test from line $srcLineNum:  $line\}"
+	return $msg
+    }
+
+    # perform mapping if '=' flag exists
+
+    set noBraces 0
+    if {[regexp {=|>} $flags] == 1} {
+	regsub -all {_} $currentLine {\\ } currentLine
+	regsub -all {A} $currentLine {\\007} currentLine
+	regsub -all {B} $currentLine {\\b} currentLine
+	regsub -all {E} $currentLine {\\033} currentLine
+	regsub -all {F} $currentLine {\\f} currentLine
+	regsub -all {N} $currentLine {\\n} currentLine
+
+	# if and \r substitutions are made, do not wrap re, flags,
+	# str, and result in braces
+
+	set noBraces [regsub -all {R} $currentLine {\\\u000D} currentLine]
+	regsub -all {T} $currentLine {\\t} currentLine
+	regsub -all {V} $currentLine {\\v} currentLine
+	if {[regexp {=} $flags] == 1} {
+	    set re [lindex $currentLine 0]
+	}
+	set str [lindex $currentLine 2]
+    }
+    set flags [removeFlags $flags]
+
+    # find the test result
+
+    set numVars [expr $len - 3]
+    set vars {}
+    set vals {}
+    set result 0
+    set v 0
+
+    if {[regsub {\*} "$flags" "" newFlags] == 1} {
+	# an error is expected
+
+	if {[string compare $str "EMPTY"] == 0} {
+	    # empty regexp is not an error
+	    # skip this test
+
+	    return "\# skipping the empty-re test from line $srcLineNum\n"
+	}
+	set flags $newFlags
+	set result "\{1 \{[convertErrCode $str]\}\}"
+    } elseif {$numVars > 0} {
+	# at least 1 match is made
+
+	if {[regexp {s} $flags] == 1} {
+	    set result "\{0 1\}"
+	} else {
+	    while {$v < $numVars} {
+		append vars " var($v)"
+		append vals " \$var($v)"
+		incr v
+	    }
+	    set tmp [removeAts [lrange $currentLine 3 $len]]
+	    set result "\{0 \{1 $tmp\}\}"
+	    if {$noBraces} {
+		set result "\[subst $result\]"
+	    }
+	}
+    } else {
+	# no match is made
+
+	set result "\{0 0\}"
+    }
+
+    # set up the test and write it to the output file
+
+    set cmd [prepareCmd $flags $re $str $vars $noBraces]
+    if {$cmd == -1} {
+	return "\# skipping test with metasyntax from line $srcLineNum\n"
+    }
+
+    set test "test regexp-1.$srcLineNum \{converted from line $srcLineNum\} \{\n"
+    append test "\tcatch {unset var}\n"
+    append test "\tlist \[catch \{\n"
+    append test "\t\tset match \[$cmd\]\n"
+    append test "\t\tlist \$match $vals\n"
+    append test "\t\} msg\] \$msg\n"
+    append test "\} $result\n"
+    return $test
+}
+

tools/tcl.hpj.in

@@ -0,0 +1,19 @@
+; This file is maintained by HCW. Do not modify this file directly.
+
+[OPTIONS]
+HCW=0
+LCID=0x409 0x0 0x0 ;English (United States)
+REPORT=Yes
+TITLE=Tcl/Tk Reference Manual
+CNT=tcl86.cnt
+COPYRIGHT=Copyright <20> 2000 Ajuba Solutions
+HLP=tcl86.hlp
+
+[FILES]
+tcl.rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,0
+
+[CONFIG]
+BrowseButtons()

tools/tcltk-man2html.tcl

@@ -0,0 +1,752 @@
+#!/usr/bin/env tclsh
+
+if {[catch {package require Tcl 8.6-} msg]} {
+    puts stderr "ERROR: $msg"
+    puts stderr "If running this script from 'make html', set the\
+	NATIVE_TCLSH environment\nvariable to point to an installed\
+	tclsh8.6 (or the equivalent tclsh86.exe\non Windows)."
+    exit 1
+}
+
+# Convert Ousterhout format man pages into highly crosslinked hypertext.
+#
+# Along the way detect many unmatched font changes and other odd things.
+#
+# Note well, this program is a hack rather than a piece of software
+# engineering.  In that sense it's probably a good example of things
+# that a scripting language, like Tcl, can do well.  It is offered as
+# an example of how someone might convert a specific set of man pages
+# into hypertext, not as a general solution to the problem.  If you
+# 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.6"
+set ::CSSFILE "docs.css"
+
+##
+## Source the utility functions that provide most of the
+## implementation of the transformation from nroff to html.
+##
+source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]
+
+proc parse_command_line {} {
+    global argv Version
+
+    # These variables determine where the man pages come from and where
+    # the converted pages go to.
+    global tcltkdir tkdir tcldir webdir build_tcl build_tk verbose
+
+    # Set defaults based on original code.
+    set tcltkdir ../..
+    set tkdir {}
+    set tcldir {}
+    set webdir ../html
+    set build_tcl 0
+    set build_tk 0
+    set verbose 0
+    # Default search version is a glob pattern
+    set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}
+
+    # Handle arguments a la GNU:
+    #   --version
+    #   --useversion=<version>
+    #   --help
+    #   --srcdir=/path
+    #   --htmldir=/path
+
+    foreach option $argv {
+	switch -glob -- $option {
+	    --version {
+		puts "tcltk-man-html $Version"
+		exit 0
+	    }
+
+	    --help {
+		puts "usage: tcltk-man-html \[OPTION\] ...\n"
+		puts "  --help              print this help, then exit"
+		puts "  --version           print version number, then exit"
+		puts "  --srcdir=DIR        find tcl and tk source below DIR"
+		puts "  --htmldir=DIR       put generated HTML in DIR"
+		puts "  --tcl               build tcl help"
+		puts "  --tk                build tk help"
+		puts "  --useversion        version of tcl/tk to search for"
+		puts "  --verbose           whether to print longer messages"
+		exit 0
+	    }
+
+	    --srcdir=* {
+		# length of "--srcdir=" is 9.
+		set tcltkdir [string range $option 9 end]
+	    }
+
+	    --htmldir=* {
+		# length of "--htmldir=" is 10
+		set webdir [string range $option 10 end]
+	    }
+
+	    --useversion=* {
+		# length of "--useversion=" is 13
+		set useversion [string range $option 13 end]
+	    }
+
+	    --tcl {
+		set build_tcl 1
+	    }
+
+	    --tk {
+		set build_tk 1
+	    }
+
+	    --verbose=* {
+		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
+    }
+
+    if {$build_tcl} {
+	# Find Tcl.
+	set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
+		-directory $tcltkdir tcl$useversion]] end]
+	if {$tcldir eq ""} {
+	    puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
+	    exit 1
+	}
+	puts "using Tcl source directory $tcldir"
+    }
+
+    if {$build_tk} {
+	# Find Tk.
+	set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
+		-directory $tcltkdir tk$useversion]] end]
+	if {$tkdir eq ""} {
+	    puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
+	    exit 1
+	}
+	puts "using Tk source directory $tkdir"
+    }
+
+    puts "verbose messages are [expr {$verbose ? {on} : {off}}]"
+
+    # the title for the man pages overall
+    global overall_title
+    set overall_title ""
+    if {$build_tcl} {
+	append overall_title "[capitalize $tcldir]"
+    }
+    if {$build_tcl && $build_tk} {
+	append overall_title "/"
+    }
+    if {$build_tk} {
+	append overall_title "[capitalize $tkdir]"
+    }
+    append overall_title " Documentation"
+}
+
+proc capitalize {string} {
+    return [string toupper $string 0]
+}
+
+##
+## Returns the style sheet.
+##
+proc css-style args {
+    upvar 1 style style
+    set body [uplevel 1 [list subst [lindex $args end]]]
+    set tokens [join [lrange $args 0 end-1] ", "]
+    append style $tokens " \{" $body "\}\n"
+}
+proc css-stylesheet {} {
+    set hBd "1px dotted #11577b"
+
+    css-style body div p th td li dd ul ol dl dt blockquote {
+	font-family: Verdana, sans-serif;
+    }
+    css-style pre code {
+	font-family: 'Courier New', Courier, monospace;
+    }
+    css-style pre {
+	background-color:  #f6fcec;
+	border-top:        1px solid #6A6A6A;
+	border-bottom:     1px solid #6A6A6A;
+	padding:           1em;
+	overflow:          auto;
+    }
+    css-style body {
+	background-color:  #FFFFFF;
+	font-size:         12px;
+	line-height:       1.25;
+	letter-spacing:    .2px;
+	padding-left:      .5em;
+    }
+    css-style h1 h2 h3 h4 {
+	font-family:       Georgia, serif;
+	padding-left:      1em;
+	margin-top:        1em;
+    }
+    css-style h1 {
+	font-size:         18px;
+	color:             #11577b;
+	border-bottom:     $hBd;
+	margin-top:        0px;
+    }
+    css-style h2 {
+	font-size:         14px;
+	color:             #11577b;
+	background-color:  #c5dce8;
+	padding-left:      1em;
+	border:            1px solid #6A6A6A;
+    }
+    css-style h3 h4 {
+	color:             #1674A4;
+	background-color:  #e8f2f6;
+	border-bottom:     $hBd;
+	border-top:        $hBd;
+    }
+    css-style h3 {
+	font-size: 12px;
+    }
+    css-style h4 {
+	font-size: 11px;
+    }
+    css-style ".keylist dt" ".arguments dt" {
+	width: 20em;
+	float: left;
+	padding: 2px;
+	border-top: 1px solid #999;
+    }
+    css-style ".keylist dt" { font-weight: bold; }
+    css-style ".keylist dd" ".arguments dd" {
+	margin-left: 20em;
+	padding: 2px;
+	border-top: 1px solid #999;
+    }
+    css-style .copy {
+	background-color:  #f6fcfc;
+	white-space:       pre;
+	font-size:         80%;
+	border-top:        1px solid #6A6A6A;
+	margin-top:        2em;
+    }
+    css-style .tablecell {
+	font-size:	   12px;
+	padding-left:	   .5em;
+	padding-right:	   .5em;
+    }
+}
+
+##
+## foreach of the man directories specified by args
+## convert manpages into hypertext in the directory
+## specified by html.
+##
+proc make-man-pages {html args} {
+    global manual overall_title tcltkdesc verbose
+    global excluded_pages forced_index_pages process_first_patterns
+
+    makedirhier $html
+    set cssfd [open $html/$::CSSFILE w]
+    puts $cssfd [css-stylesheet]
+    close $cssfd
+    set manual(short-toc-n) 1
+    set manual(short-toc-fp) [open $html/[indexfile] w]
+    puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title]
+    puts $manual(short-toc-fp) "<DL class=\"keylist\">"
+    set manual(merge-copyrights) {}
+
+    foreach arg $args {
+	# preprocess to set up subheader for the rest of the files
+	if {![llength $arg]} {
+	    continue
+	}
+	lassign $arg -> name file
+	if {[regexp {(.*)(?: Package)? Commands(?:, version .*)?} $name -> pkg]} {
+	    set name "$pkg Commands"
+	} elseif {[regexp {(.*)(?: Package)? C API(?:, version .*)?} $name -> pkg]} {
+	    set name "$pkg C API"
+	}
+	lappend manual(subheader) $name $file
+    }
+
+    ##
+    ## parse the manpages in a section of the docs (split by
+    ## package) and construct formatted manpages
+    ##
+    foreach arg $args {
+	if {[llength $arg]} {
+	    make-manpage-section $html $arg
+	}
+    }
+
+    ##
+    ## build the keyword index.
+    ##
+    if {!$verbose} {
+	puts stderr "Assembling index"
+    }
+    file delete -force -- $html/Keywords
+    makedirhier $html/Keywords
+    set keyfp [open $html/Keywords/[indexfile] w]
+    puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \
+		     $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]\]*"]
+	if {[llength $keys]} {
+	    lappend keyheader "<A HREF=\"$a.htm\">$a</A>"
+	} else {
+	    # No keywords for this letter
+	    lappend keyheader $a
+	}
+    }
+    set keyheader <H3>[join $keyheader " |\n"]</H3>
+    puts $keyfp $keyheader
+    foreach a $letters {
+	set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
+	if {![llength $keys]} {
+	    continue
+	}
+	# Per-keyword page
+	set afp [open $html/Keywords/$a.htm w]
+	puts $afp [htmlhead "$tcltkdesc Keywords - $a" \
+		       "$tcltkdesc Keywords - $a" \
+		       $overall_title "../[indexfile]"]
+	puts $afp $keyheader
+	puts $afp "<DL class=\"keylist\">"
+	foreach k [lsort -dictionary $keys] {
+	    set k [string range $k 8 end]
+	    puts $afp "<DT><A NAME=\"$k\">$k</A></DT>"
+	    puts $afp "<DD>"
+	    set refs {}
+	    foreach man $manual(keyword-$k) {
+		set name [lindex $man 0]
+		set file [lindex $man 1]
+		if {[info exists manual(tooltip-$file)]} {
+		    set tooltip $manual(tooltip-$file)
+		    if {[string match {*[<>""]*} $tooltip]} {
+			manerror "bad tooltip for $file: \"$tooltip\""
+		    }
+		    lappend refs "<A HREF=\"../$file\" TITLE=\"$tooltip\">$name</A>"
+		} else {
+		    lappend refs "<A HREF=\"../$file\">$name</A>"
+		}
+	    }
+	    puts $afp "[join $refs {, }]</DD>"
+	}
+	puts $afp "</DL>"
+	# insert merged copyrights
+	puts $afp [copyout $manual(merge-copyrights)]
+	puts $afp "</BODY></HTML>"
+	close $afp
+    }
+    # insert merged copyrights
+    puts $keyfp [copyout $manual(merge-copyrights)]
+    puts $keyfp "</BODY></HTML>"
+    close $keyfp
+
+    ##
+    ## finish off short table of contents
+    ##
+    puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/[indexfile]\">Keywords</A><DD>The keywords from the $tcltkdesc man pages."
+    puts $manual(short-toc-fp) "</DL>"
+    # insert merged copyrights
+    puts $manual(short-toc-fp) [copyout $manual(merge-copyrights)]
+    puts $manual(short-toc-fp) "</BODY></HTML>"
+    close $manual(short-toc-fp)
+
+    ##
+    ## output man pages
+    ##
+    unset manual(section)
+    if {!$verbose} {
+	puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links and write out"
+    }
+    foreach path $manual(all-pages) wing_name $manual(all-page-domains) {
+	set manual(wing-file) [file dirname $path]
+	set manual(tail) [file tail $path]
+	set manual(name) [file root $manual(tail)]
+	try {
+	    set text $manual(output-$manual(wing-file)-$manual(name))
+	    set ntext 0
+	    foreach item $text {
+		incr ntext [llength [split $item \n]]
+		incr ntext
+	    }
+	    set toc $manual(toc-$manual(wing-file)-$manual(name))
+	    set ntoc 0
+	    foreach item $toc {
+		incr ntoc [llength [split $item \n]]
+		incr ntoc
+	    }
+	    if {$verbose} {
+		puts stderr "rescanning page $manual(name) $ntoc/$ntext"
+	    } else {
+		puts -nonewline stderr .
+	    }
+	    set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
+	    puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \
+		    $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} {
+		if {!$verbose} {puts stderr ""}
+		manerror "forcing index generation"
+		foreach item $toc {
+		    puts $outfd $item
+		}
+	    }
+	    foreach item $text {
+		puts $outfd [insert-cross-references $item]
+	    }
+	    puts $outfd "</BODY></HTML>"
+	} on error msg {
+	    if {$verbose} {
+		puts stderr $msg
+	    } else {
+		puts stderr "\nError when processing $manual(name): $msg"
+	    }
+	} finally {
+	    catch {close $outfd}
+	}
+    }
+    if {!$verbose} {
+	puts stderr "\nDone"
+    }
+    return {}
+}
+
+##
+## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk).
+##
+proc plus-base {var root glob name dir desc} {
+    global tcltkdir
+    if {$var} {
+	if {[file exists $tcltkdir/$root/README]} {
+	    set f [open $tcltkdir/$root/README]
+	    set d [read $f]
+	    close $f
+	    if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} {
+	       append name ", version $version"
+	    }
+	}
+	set glob $root/$glob
+	return [list $tcltkdir/$glob $name $dir $desc]
+    }
+}
+
+##
+## Helper for assembling the descriptions of contributed packages.
+##
+proc plus-pkgs {type args} {
+    global build_tcl tcltkdir tcldir
+    if {$type ni {n 3}} {
+	error "unknown type \"$type\": must be 3 or n"
+    }
+    if {!$build_tcl} return
+    set result {}
+    set pkgsdir $tcltkdir/$tcldir/pkgs
+    foreach {dir name version} $args {
+	set globpat $pkgsdir/$dir/doc/*.$type
+	if {![llength [glob -type f -nocomplain $globpat]]} {
+	    # Fallback for manpages generated using doctools
+	    set globpat $pkgsdir/$dir/doc/man/*.$type
+	    if {![llength [glob -type f -nocomplain $globpat]]} {
+		continue
+	    }
+	}
+	set dir [string trimright $dir "0123456789-."]
+	switch $type {
+	    n {
+		set title "$name Package Commands"
+		if {$version ne ""} {
+		    append title ", version $version"
+		}
+		set dir [string totitle $dir]Cmd
+		set desc \
+		    "The additional commands provided by the $name package."
+	    }
+	    3 {
+		set title "$name Package C API"
+		if {$version ne ""} {
+		    append title ", version $version"
+		}
+		set dir [string totitle $dir]Lib
+		set desc \
+		    "The additional C functions provided by the $name package."
+	    }
+	}
+	lappend result [list $globpat $title $dir $desc]
+    }
+    return $result
+}
+
+##
+## Set up some special cases. It would be nice if we didn't have them,
+## but we do...
+##
+set excluded_pages {case menubar pack-old}
+set forced_index_pages {GetDash}
+set process_first_patterns {*/ttk_widget.n */options.n}
+set ensemble_commands {
+    after array binary chan clock dde dict encoding file history info interp
+    memory namespace package registry self string trace update zlib
+    clipboard console font grab grid image option pack place selection tk
+    tkwait ttk::style winfo wm itcl::delete itcl::find itcl::is
+}
+array set remap_link_target {
+    stdin  Tcl_GetStdChannel
+    stdout Tcl_GetStdChannel
+    stderr Tcl_GetStdChannel
+    style  ttk::style
+    {style map} ttk::style
+    {tk busy}   busy
+    library     auto_execok
+    safe-tcl    safe
+    tclvars     env
+    tcl_break   catch
+    tcl_continue catch
+    tcl_error   catch
+    tcl_ok      catch
+    tcl_return  catch
+    int()       mathfunc
+    wide()      mathfunc
+    packagens   pkg::create
+    pkgMkIndex  pkg_mkIndex
+    pkg_mkIndex pkg_mkIndex
+    Tcl_Obj     Tcl_NewObj
+    Tcl_ObjType Tcl_RegisterObjType
+    Tcl_OpenFileChannelProc Tcl_FSOpenFileChannel
+    errorinfo 	env
+    errorcode 	env
+    tcl_pkgpath env
+    Tcl_Command Tcl_CreateObjCommand
+    Tcl_CmdProc Tcl_CreateObjCommand
+    Tcl_CmdDeleteProc Tcl_CreateObjCommand
+    Tcl_ObjCmdProc Tcl_CreateObjCommand
+    Tcl_Channel Tcl_OpenFileChannel
+    Tcl_WideInt Tcl_NewIntObj
+    Tcl_ChannelType Tcl_CreateChannel
+    Tcl_DString Tcl_DStringInit
+    Tcl_Namespace Tcl_AppendExportList
+    Tcl_Object  Tcl_NewObjectInstance
+    Tcl_Class   Tcl_GetObjectAsClass
+    Tcl_Event   Tcl_QueueEvent
+    Tcl_Time	Tcl_GetTime
+    Tcl_ThreadId Tcl_CreateThread
+    Tk_Window	Tk_WindowId
+    Tk_3DBorder Tk_Get3DBorder
+    Tk_Anchor	Tk_GetAnchor
+    Tk_Cursor	Tk_GetCursor
+    Tk_Dash	Tk_GetDash
+    Tk_Font	Tk_GetFont
+    Tk_Image	Tk_GetImage
+    Tk_ImageMaster Tk_GetImage
+    Tk_ItemType Tk_CreateItemType
+    Tk_Justify	Tk_GetJustify
+    Ttk_Theme	Ttk_GetTheme
+}
+array set exclude_refs_map {
+    bind.n		{button destroy option}
+    clock.n		{next}
+    history.n		{exec}
+    next.n		{unknown}
+    zlib.n		{binary close filename text}
+    canvas.n		{bitmap text}
+    console.n		{eval}
+    checkbutton.n	{image}
+    clipboard.n		{string}
+    entry.n		{string}
+    event.n		{return}
+    font.n		{menu}
+    getOpenFile.n	{file open text}
+    grab.n		{global}
+    interp.n		{time}
+    menu.n		{checkbutton radiobutton}
+    messageBox.n	{error info}
+    options.n		{bitmap image set}
+    radiobutton.n	{image}
+    safe.n		{join split}
+    scale.n		{label variable}
+    scrollbar.n		{set}
+    selection.n		{string}
+    tcltest.n		{error}
+    tkvars.n		{tk}
+    tkwait.n		{variable}
+    tm.n		{exec}
+    ttk_checkbutton.n	{variable}
+    ttk_combobox.n	{selection}
+    ttk_entry.n		{focus variable}
+    ttk_intro.n		{focus text}
+    ttk_label.n		{font text}
+    ttk_labelframe.n	{text}
+    ttk_menubutton.n	{flush}
+    ttk_notebook.n	{image text}
+    ttk_progressbar.n	{variable}
+    ttk_radiobutton.n	{variable}
+    ttk_scale.n		{variable}
+    ttk_scrollbar.n	{set}
+    ttk_spinbox.n	{format}
+    ttk_treeview.n	{text open}
+    ttk_widget.n	{image text variable}
+    TclZlib.3		{binary flush filename text}
+}
+array set exclude_when_followed_by_map {
+    canvas.n {
+	bind widget
+	focus widget
+	image are
+	lower widget
+	raise widget
+    }
+    selection.n {
+	clipboard selection
+	clipboard ;
+    }
+    ttk_image.n {
+	image imageSpec
+    }
+    fontchooser.n {
+	tk fontchooser
+    }
+}
+
+try {
+    # Parse what the user told us to do
+    parse_command_line
+
+    # Some strings depend on what options are specified
+    set tcltkdesc ""; set cmdesc ""; set appdir ""
+    if {$build_tcl} {
+	append tcltkdesc "Tcl"
+	append cmdesc "Tcl"
+	append appdir "$tcldir"
+    }
+    if {$build_tcl && $build_tk} {
+	append tcltkdesc "/"
+	append cmdesc " and "
+	append appdir ","
+    }
+    if {$build_tk} {
+	append tcltkdesc "Tk"
+	append cmdesc "Tk"
+	append appdir "$tkdir"
+    }
+
+    apply {{} {
+    global packageBuildList tcltkdir tcldir build_tcl
+
+    # When building docs for Tcl, try to build docs for bundled packages too
+    set packageBuildList {}
+    if {$build_tcl} {
+	set pkgsDir [file join $tcltkdir $tcldir pkgs]
+	set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *]
+
+	foreach dir [lsort $subdirs] {
+	    # Parse the subdir name into (name, version) as fallback...
+	    set description [split $dir -]
+	    if {2 != [llength $description]} {
+		regexp {([^0-9]*)(.*)} $dir -> n v
+		set description [list $n $v]
+	    }
+
+	    # ... but try to extract (name, version) from subdir contents
+	    try {
+		try {
+		    set f [open [file join $pkgsDir $dir configure.in]]
+		} trap {POSIX ENOENT} {} {
+		    set f [open [file join $pkgsDir $dir configure.ac]]
+		}
+		foreach line [split [read $f] \n] {
+		    if {2 == [scan $line \
+			    { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} {
+			set description [list $n $v]
+			break
+		    }
+		}
+	    } finally {
+		catch {close $f; unset f}
+	    }
+
+	    if {[file exists [file join $pkgsDir $dir configure]]} {
+		# Looks like a package, record our best extraction attempt
+		lappend packageBuildList $dir {*}$description
+	    }
+	}
+    }
+
+    # Get the list of packages to try, and what their human-readable names
+    # are. Note that the package directory list should be version-less.
+    try {
+	set packageDirNameMap {}
+	if {$build_tcl} {
+	    set f [open $tcltkdir/$tcldir/pkgs/package.list.txt]
+	    try {
+		foreach line [split [read $f] \n] {
+		    if {[string trim $line] eq ""} continue
+		    if {[string match #* $line]} continue
+		    lassign $line dir name
+		    lappend packageDirNameMap $dir $name
+		}
+	    } finally {
+		close $f
+	    }
+	}
+    } trap {POSIX ENOENT} {} {
+	set packageDirNameMap {
+	    itcl {[incr Tcl]}
+	    tdbc {TDBC}
+	    thread Thread
+	}
+    }
+
+    # Convert to human readable names, if applicable
+    for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} {
+	lassign [lrange $packageBuildList $idx $idx+2] d n v
+	if {[dict exists $packageDirNameMap $n]} {
+	    lset packageBuildList $idx+1 [dict get $packageDirNameMap $n]
+	}
+    }
+    }}
+
+    #
+    # Invoke the scraper/converter engine.
+    #
+    make-man-pages $webdir \
+	[list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \
+	     "The interpreters which implement $cmdesc."] \
+	[plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \
+	     "The commands which the <B>tclsh</B> interpreter implements."] \
+	[plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \
+	     "The additional commands which the <B>wish</B> 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."] \
+	[plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \
+	     "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]
+    exit 1
+}
+
+# Local-Variables:
+# mode: tcl
+# End:

tools/tsdPerf.tcl

@@ -0,0 +1,24 @@
+
+package require Thread
+
+set ::tids [list]
+for {set i 0} {$i < 4} {incr i} {
+    lappend ::tids [thread::create [string map [list IVALUE $i] {
+	set curdir [file dirname [info script]]
+	load [file join $curdir tsdPerf[info sharedlibextension]]
+
+	while 1 {
+	    tsdPerfSet IVALUE
+	}
+    }]]
+}
+
+puts TIDS:$::tids
+
+set curdir [file dirname [info script]]
+load [file join $curdir tsdPerf[info sharedlibextension]]
+
+tsdPerfSet 1234
+while 1 {
+    puts "TIME:[time {set value [tsdPerfGet]} 1000] VALUE:$value"
+}

tools/uniClass.tcl

@@ -0,0 +1,130 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not tcl \
+exec tclsh "$0" ${1+"$@"}
+
+#
+# uniClass.tcl --
+#
+#	Generates the character ranges and singletons that are used in
+#	generic/regc_locale.c for translation of character classes.
+#	This file must be generated using a tclsh that contains the
+#	correct corresponding tclUniData.c file (generated by uniParse.tcl)
+#	in order for the class ranges to match.
+#
+
+proc emitRange {first last} {
+    global ranges numranges chars numchars extchars extranges
+
+    if {$first < ($last-1)} {
+	if {!$extranges && ($first) > 0xffff} {
+	    set extranges 1
+	    set numranges 0
+	    set ranges [string trimright $ranges " \n\r\t,"]
+	    append ranges "\n#if TCL_UTF_MAX > 4\n    ,"
+	}
+	append ranges [format "{0x%x, 0x%x}, " \
+		$first $last]
+	if {[incr numranges] % 4 == 0} {
+	    set ranges [string trimright $ranges]
+	    append ranges "\n    "
+	}
+    } else {
+	if {!$extchars && ($first) > 0xffff} {
+	    set extchars 1
+	    set numchars 0
+	    set chars [string trimright $chars " \n\r\t,"]
+	    append chars "\n#if TCL_UTF_MAX > 4\n    ,"
+	}
+	append chars [format "0x%x, " $first]
+	incr numchars
+	if {$numchars % 9 == 0} {
+	    set chars [string trimright $chars]
+	    append chars "\n    "
+	}
+	if {$first != $last} {
+	    append chars [format "0x%x, " $last]
+	    incr numchars
+	    if {$numchars % 9 == 0} {
+		append chars "\n    "
+	    }
+	}
+    }
+}
+
+proc genTable {type} {
+    global first last ranges numranges chars numchars extchars extranges
+    set first -2
+    set last -2
+
+    set ranges "    "
+    set numranges 0
+    set chars "    "
+    set numchars 0
+    set extchars 0
+    set extranges 0
+
+    for {set i 0} {$i <= 0x10ffff} {incr i} {
+    if {$i == 0xd800} {
+	# Skip surrogates
+	set i 0xdc00
+    }
+	if {[string is $type [format %c $i]]} {
+	    if {$i == ($last + 1)} {
+		set last $i
+	    } else {
+		if {$first >= 0} {
+		    emitRange $first $last
+		}
+		set first $i
+		set last $i
+	    }
+	}
+    }
+    emitRange $first $last
+
+    set ranges [string trimright $ranges "\t\n ,"]
+    if {$extranges} {
+	append ranges "\n#endif"
+    }
+    set chars  [string trimright $chars "\t\n ,"]
+    if {$extchars} {
+	append chars "\n#endif"
+    }
+    if {$ranges ne ""} {
+	puts "static const crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
+	puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n"
+    } else {
+	puts "/* no contiguous ranges of $type characters */\n"
+    }
+    if {$chars ne ""} {
+	puts "static const chr ${type}CharTable\[\] = {\n$chars\n};\n"
+	puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n"
+    } else {
+	puts "/*\n * no singletons of $type characters.\n */\n"
+    }
+}
+
+puts "/*
+ *	Declarations of Unicode character ranges.  This code
+ *	is automatically generated by the tools/uniClass.tcl script
+ *	and used in generic/regc_locale.c.  Do not modify by hand.
+ */
+"
+
+foreach {type desc} {
+    alpha "alphabetic characters"
+    control "control characters"
+    digit "decimal digit characters"
+    punct "punctuation characters"
+    space "white space characters"
+    lower "lowercase characters"
+    upper "uppercase characters"
+    graph "unicode print characters excluding space"
+} {
+    puts "/*\n * Unicode: $desc.\n */\n"
+    genTable $type
+}
+
+puts "/*
+ *	End of auto-generated Unicode character ranges declarations.
+ */"

tools/uniParse.tcl

@@ -0,0 +1,411 @@
+# uniParse.tcl --
+#
+#	This program parses the UnicodeData file and generates the
+#	corresponding tclUniData.c file with compressed character
+#	data tables.  The input to this program should be the latest
+#	UnicodeData file from:
+#	    ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+
+
+namespace eval uni {
+    set shift 5;		# number of bits of data within a page
+				# This value can be adjusted to find the
+				# best split to minimize table size
+
+    variable pMap;		# map from page to page index, each entry is
+				# an index into the pages table, indexed by
+				# page number
+    variable pages;		# map from page index to page info, each
+				# entry is a list of indices into the groups
+				# table, the list is indexed by the offset
+    variable groups;		# list of character info values, indexed by
+				# group number, initialized with the
+				# unassigned character group
+
+    variable categories {
+	Cn Lu Ll Lt Lm Lo Mn Me Mc Nd Nl No Zs Zl Zp
+	Cc Cf Co Cs Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So
+    };				# Ordered list of character categories, must
+				# match the enumeration in the header file.
+}
+
+proc uni::getValue {items index} {
+    variable categories
+
+    # Extract character info
+
+    set category [lindex $items 2]
+    if {[scan [lindex $items 12] %x toupper] == 1} {
+	set toupper [expr {$index - $toupper}]
+    } else {
+	set toupper 0
+    }
+    if {[scan [lindex $items 13] %x tolower] == 1} {
+	set tolower [expr {$tolower - $index}]
+    } else {
+	set tolower 0
+    }
+    if {[scan [lindex $items 14] %x totitle] == 1} {
+	set totitle [expr {$index - $totitle}]
+    } elseif {$tolower} {
+	set totitle 0
+    } else {
+	set totitle $toupper
+    }
+
+    set categoryIndex [lsearch -exact $categories $category]
+    if {$categoryIndex < 0} {
+	error "Unexpected character category: $index($category)"
+    }
+
+    return [list $categoryIndex $toupper $tolower $totitle]
+}
+
+proc uni::getGroup {value} {
+    variable groups
+
+    set gIndex [lsearch -exact $groups $value]
+    if {$gIndex == -1} {
+	set gIndex [llength $groups]
+	lappend groups $value
+    }
+    return $gIndex
+}
+
+proc uni::addPage {info} {
+    variable pMap
+    variable pages
+    variable shift
+
+    set pIndex [lsearch -exact $pages $info]
+    if {$pIndex == -1} {
+	set pIndex [llength $pages]
+	lappend pages $info
+    }
+    lappend pMap [expr {$pIndex << $shift}]
+    return
+}
+
+proc uni::buildTables {data} {
+    variable shift
+
+    variable pMap {}
+    variable pages {}
+    variable groups {{0 0 0 0}}
+    variable next 0
+    set info {}			;# temporary page info
+
+    set mask [expr {(1 << $shift) - 1}]
+
+    foreach line [split $data \n] {
+	if {$line eq ""} {
+	    if {!($next & $mask)} {
+		# next character is already on page boundary
+		continue
+	    }
+	    # fill remaining page
+	    set line [format %X [expr {($next-1)|$mask}]]
+	    append line ";;Cn;0;ON;;;;;N;;;;;\n"
+	}
+
+	set items [split $line \;]
+
+	scan [lindex $items 0] %x index
+	if {$index > 0x2ffff} then {
+	    # Ignore non-BMP characters, as long as Tcl doesn't support them
+	    continue
+	}
+	set index [format %d $index]
+
+	set gIndex [getGroup [getValue $items $index]]
+
+	# Since the input table omits unassigned characters, these will
+	# show up as gaps in the index sequence.  There are a few special cases
+	# where the gaps correspond to a uniform block of assigned characters.
+	# These are indicated as such in the character name.
+
+	# Enter all unassigned characters up to the current character.
+	if {($index > $next) \
+		&& ![regexp "Last>$" [lindex $items 1]]} {
+	    for {} {$next < $index} {incr next} {
+		lappend info 0
+		if {($next & $mask) == $mask} {
+		    addPage $info
+		    set info {}
+		}
+	    }
+	}
+
+	# Enter all assigned characters up to the current character
+	for {set i $next} {$i <= $index} {incr i} {
+	    # Add the group index to the info for the current page
+	    lappend info $gIndex
+
+	    # If this is the last entry in the page, add the page
+	    if {($i & $mask) == $mask} {
+		addPage $info
+		set info {}
+	    }
+	}
+	set next [expr {$index + 1}]
+    }
+    return
+}
+
+proc uni::main {} {
+    global argc argv0 argv
+    variable pMap
+    variable pages
+    variable groups
+    variable shift
+    variable next
+
+    if {$argc != 2} {
+	puts stderr "\nusage: $argv0 <datafile> <outdir>\n"
+	exit 1
+    }
+    set f [open [lindex $argv 0] r]
+    set data [read $f]
+    close $f
+
+    buildTables $data
+    puts "X = [llength $pMap]  Y= [llength $pages]  A= [llength $groups]"
+    set size [expr {[llength $pMap]*2 + ([llength $pages]<<$shift)}]
+    puts "shift = $shift, space = $size"
+
+    set f [open [file join [lindex $argv 1] tclUniData.c] w]
+    fconfigure $f -translation lf
+    puts $f "/*
+ * tclUniData.c --
+ *
+ *	Declarations of Unicode character information tables.  This file is
+ *	automatically generated by the tools/uniParse.tcl script.  Do not
+ *	modify this file by hand.
+ *
+ * Copyright (c) 1998 by Scriptics Corporation.
+ * All rights reserved.
+ */
+
+/*
+ * A 16-bit Unicode character is split into two parts in order to index
+ * into the following tables.  The lower OFFSET_BITS comprise an offset
+ * into a page of characters.  The upper bits comprise the page number.
+ */
+
+#define OFFSET_BITS $shift
+
+/*
+ * The pageMap is indexed by page number and returns an alternate page number
+ * that identifies a unique page of characters.  Many Unicode characters map
+ * to the same alternate page number.
+ */
+
+static const unsigned short pageMap\[\] = {"
+    set line "    "
+    set last [expr {[llength $pMap] - 1}]
+    for {set i 0} {$i <= $last} {incr i} {
+	if {$i == [expr {0x10000 >> $shift}]} {
+	    set line [string trimright $line " \t,"]
+	    puts $f $line
+	    set lastpage [expr {[lindex $line end] >> $shift}]
+	    puts stdout "lastpage: $lastpage"
+	    puts $f "#if TCL_UTF_MAX > 3"
+	    set line "    ,"
+	}
+	append line [lindex $pMap $i]
+	if {$i != $last} {
+	    append line ", "
+	}
+	if {[string length $line] > 70} {
+	    puts $f [string trimright $line]
+	    set line "    "
+	}
+    }
+    puts $f $line
+    puts $f "#endif /* TCL_UTF_MAX > 3 */"
+    puts $f "};
+
+/*
+ * The groupMap is indexed by combining the alternate page number with
+ * the page offset and returns a group number that identifies a unique
+ * set of character attributes.
+ */
+
+static const unsigned char groupMap\[\] = {"
+    set line "    "
+    set lasti [expr {[llength $pages] - 1}]
+    for {set i 0} {$i <= $lasti} {incr i} {
+	set page [lindex $pages $i]
+	set lastj [expr {[llength $page] - 1}]
+	if {$i == ($lastpage + 1)} {
+	    puts $f [string trimright $line " \t,"]
+	    puts $f "#if TCL_UTF_MAX > 3"
+	    set line "    ,"
+	}
+	for {set j 0} {$j <= $lastj} {incr j} {
+	    append line [lindex $page $j]
+	    if {$j != $lastj || $i != $lasti} {
+		append line ", "
+	    }
+	    if {[string length $line] > 70} {
+		puts $f [string trimright $line]
+		set line "    "
+	    }
+	}
+    }
+    puts $f $line
+    puts $f "#endif /* TCL_UTF_MAX > 3 */"
+    puts $f "};
+
+/*
+ * Each group represents a unique set of character attributes.  The attributes
+ * are encoded into a 32-bit value as follows:
+ *
+ * Bits 0-4	Character category: see the constants listed below.
+ *
+ * Bits 5-7	Case delta type: 000 = identity
+ *				 010 = add delta for lower
+ *				 011 = add delta for lower, add 1 for title
+ *				 100 = subtract delta for title/upper
+ *				 101 = sub delta for upper, sub 1 for title
+ *				 110 = sub delta for upper, add delta for lower
+ *
+ * Bits 8-31	Case delta: delta for case conversions.  This should be the
+ *			    highest field so we can easily sign extend.
+ */
+
+static const int groups\[\] = {"
+    set line "    "
+    set last [expr {[llength $groups] - 1}]
+    for {set i 0} {$i <= $last} {incr i} {
+	foreach {type toupper tolower totitle} [lindex $groups $i] {}
+
+	# Compute the case conversion type and delta
+
+	if {$totitle} {
+	    if {$totitle == $toupper} {
+		# subtract delta for title or upper
+		set case 4
+		set delta $toupper
+		if {$tolower} {
+		    error "New case conversion type needed: $toupper $tolower $totitle"
+		}
+	    } elseif {$toupper} {
+		# subtract delta for upper, subtract 1 for title
+		set case 5
+		set delta $toupper
+		if {($totitle != 1) || $tolower} {
+		    error "New case conversion type needed: $toupper $tolower $totitle"
+		}
+	    } else {
+		# add delta for lower, add 1 for title
+		set case 3
+		set delta $tolower
+		if {$totitle != -1} {
+		    error "New case conversion type needed: $toupper $tolower $totitle"
+		}
+	    }
+	} elseif {$toupper} {
+	    # subtract delta for upper, add delta for lower
+	    set case 6
+	    set delta $toupper
+	    if {$tolower != $toupper} {
+		error "New case conversion type needed: $toupper $tolower $totitle"
+	    }
+	} elseif {$tolower} {
+	    # add delta for lower
+	    set case 2
+	    set delta $tolower
+	} else {
+	    # noop
+	    set case 0
+	    set delta 0
+	}
+
+	append line [expr {($delta << 8) | ($case << 5) | $type}]
+	if {$i != $last} {
+	    append line ", "
+	}
+	if {[string length $line] > 65} {
+	    puts $f [string trimright $line]
+	    set line "    "
+	}
+    }
+    puts $f $line
+    puts -nonewline $f "};
+
+#if TCL_UTF_MAX > 3
+#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1fffff) >= [format 0x%x $next])
+#else
+#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1f0000) != 0)
+#endif
+
+/*
+ * The following constants are used to determine the category of a
+ * Unicode character.
+ */
+
+enum {
+    UNASSIGNED,
+    UPPERCASE_LETTER,
+    LOWERCASE_LETTER,
+    TITLECASE_LETTER,
+    MODIFIER_LETTER,
+    OTHER_LETTER,
+    NON_SPACING_MARK,
+    ENCLOSING_MARK,
+    COMBINING_SPACING_MARK,
+    DECIMAL_DIGIT_NUMBER,
+    LETTER_NUMBER,
+    OTHER_NUMBER,
+    SPACE_SEPARATOR,
+    LINE_SEPARATOR,
+    PARAGRAPH_SEPARATOR,
+    CONTROL,
+    FORMAT,
+    PRIVATE_USE,
+    SURROGATE,
+    CONNECTOR_PUNCTUATION,
+    DASH_PUNCTUATION,
+    OPEN_PUNCTUATION,
+    CLOSE_PUNCTUATION,
+    INITIAL_QUOTE_PUNCTUATION,
+    FINAL_QUOTE_PUNCTUATION,
+    OTHER_PUNCTUATION,
+    MATH_SYMBOL,
+    CURRENCY_SYMBOL,
+    MODIFIER_SYMBOL,
+    OTHER_SYMBOL
+};
+
+/*
+ * The following macros extract the fields of the character info.  The
+ * GetDelta() macro is complicated because we can't rely on the C compiler
+ * to do sign extension on right shifts.
+ */
+
+#define GetCaseType(info) (((info) & 0xe0) >> 5)
+#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1f)
+#define GetDelta(info) ((info) >> 8)
+
+/*
+ * This macro extracts the information about a character from the
+ * Unicode character tables.
+ */
+
+#if TCL_UTF_MAX > 3
+#   define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1fffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
+#else
+#   define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
+#endif
+"
+
+    close $f
+}
+
+uni::main
+
+return