diff options
Diffstat (limited to 'tools')
39 files changed, 4173 insertions, 5239 deletions
diff --git a/tools/Makefile.in b/tools/Makefile.in index ecd115a..6034fe9 100644 --- a/tools/Makefile.in +++ b/tools/Makefile.in @@ -6,8 +6,6 @@ # # HTML: 1. Build the html target on Unix -# RCS: @(#) $Id: Makefile.in,v 1.9 2000/04/20 01:30:20 hobbs Exp $ - TCL = tcl@TCL_VERSION@ TK = tk@TCL_VERSION@ VER = @TCL_WIN_VERSION@ diff --git a/tools/README b/tools/README index 821b2b3..f4bf627 100644 --- a/tools/README +++ b/tools/README @@ -23,6 +23,3 @@ Generating Windows Help Files: this converts the Nroff to RTF files. 2) On Windows, convert the RTF to a Help doc, do nmake helpfile - -Generating Windows binary distribution. -Update and compile the WYSE tcl.wse configuration. diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl index 8a7008c..6d147ac 100755 --- a/tools/checkLibraryDoc.tcl +++ b/tools/checkLibraryDoc.tcl @@ -1,7 +1,7 @@ # 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 +# 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: @@ -11,15 +11,13 @@ # 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. +# list should be carefully checked for accuracy. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -# -# RCS: @(#) $Id: checkLibraryDoc.tcl,v 1.7 2002/01/15 17:55:30 dgp Exp $ lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin" @@ -88,7 +86,7 @@ set StructList { Tk_Window \ } -# Misc junk that appears in the comments of the source. This just +# Misc junk that appears in the comments of the source. This just # allows us to filter comments that "fool" the script. set CommentList { @@ -101,8 +99,8 @@ set CommentList { # Main entry point to this script. proc main {} { - global argv0 - global argv + global argv0 + global argv set len [llength $argv] if {($len != 2) && ($len != 3)} { @@ -123,12 +121,12 @@ proc main {} { foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {} filter $c $d $dir $pkg $file - if {$file != "stdout"} { + 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. @@ -147,7 +145,7 @@ proc filter {code docs dir pkg {outFile stdout}} { # 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. @@ -164,7 +162,7 @@ proc filter {code docs dir pkg {outFile stdout}} { 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. @@ -198,7 +196,7 @@ proc filter {code docs dir pkg {outFile stdout}} { # Print the list of APIs if the list is not null. proc dump {list title file} { - if {$list != {}} { + if {$list ne ""} { puts $file "" puts $file $title puts $file "---------------------------------------------------------" @@ -242,7 +240,7 @@ proc grepDocs {dir 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 file [file join $dir generic "[string tolower $pkg]IntDecls.h"] set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_.*" $file] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" @@ -260,7 +258,7 @@ proc grepDecl {dir pkg} { proc grepMisc {dir pkg} { global CommentList global StructList - + set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_Db.*" "${dir}/\*/\*\.\[ch\]"] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" diff --git a/tools/configure b/tools/configure index 29b0eb5..3d30039 100755 --- a/tools/configure +++ b/tools/configure @@ -1,9 +1,8 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.57. +# Generated by GNU Autoconf 2.59. # -# Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002 -# Free Software Foundation, Inc. +# Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## @@ -20,9 +19,10 @@ if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi +DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. -if (FOO=FOO; unset FOO) >/dev/null 2>&1; then +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false @@ -41,7 +41,7 @@ for as_var in \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do - if (set +x; test -n "`(eval $as_var=C; export $as_var) 2>&1`"); then + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var @@ -218,16 +218,17 @@ rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else + test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. -as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. -as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g" +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS @@ -630,7 +631,7 @@ done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ - localstatedir libdir includedir oldincludedir infodir mandir + localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in @@ -670,10 +671,10 @@ if test -z "$srcdir"; then # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$0" : 'X\(//\)[^/]' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || + X"$0" : 'X\(//\)[^/]' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } @@ -745,9 +746,9 @@ _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] + [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] + [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify @@ -817,12 +818,45 @@ case $srcdir in ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac -# Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be -# absolute. -ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd` -ac_abs_top_builddir=`cd "$ac_dir" && cd ${ac_top_builddir}. && pwd` -ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd` -ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd` + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. @@ -833,7 +867,7 @@ ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd` echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || - test -f $ac_srcdir/configure.in; then + test -f $ac_srcdir/configure.in; then echo $ac_configure --help else @@ -847,8 +881,7 @@ test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF -Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002 -Free Software Foundation, Inc. +Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -860,7 +893,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by $as_me, which was -generated by GNU Autoconf 2.57. Invocation command line was +generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ @@ -937,19 +970,19 @@ do 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then - ac_must_keep_next=false # Got value, back to normal. + ac_must_keep_next=false # Got value, back to normal. else - case $ac_arg in - *=* | --config-cache | -C | -disable-* | --disable-* \ - | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ - | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ - | -with-* | --with-* | -without-* | --without-* | --x) - case "$ac_configure_args0 " in - "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; - esac - ;; - -* ) ac_must_keep_next=true ;; - esac + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. @@ -983,12 +1016,12 @@ _ASBOX case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ - "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" + "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ - "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } @@ -1017,7 +1050,7 @@ _ASBOX for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` - echo "$ac_var='"'"'$ac_val'"'"'" + echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi @@ -1036,7 +1069,7 @@ _ASBOX echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 - rm -f core core.* *.core && + rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 @@ -1116,7 +1149,7 @@ fi # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | - sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do + sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" @@ -1133,13 +1166,13 @@ echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then - { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 + { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} - { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 + { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} - { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 + { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} - ac_cache_corrupted=: + ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. @@ -1188,7 +1221,6 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -# RCS: @(#) $Id: configure,v 1.4 2003/03/13 10:39:57 mdejong Exp $ # Recover information that Tcl computed with its configure script. @@ -1197,7 +1229,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.5 +DEF_VER=8.6 # Check whether --with-tcl or --without-tcl was given. @@ -1258,13 +1290,13 @@ _ACEOF # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ - "s/'/'\\\\''/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ - "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | @@ -1294,13 +1326,13 @@ test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=/{ + ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; -s/^\([^=]*=[ ]*\):*/\1/; +s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; -s/^[^=]*=[ ]*$//; +s/^[^=]*=[ ]*$//; }' fi @@ -1314,13 +1346,13 @@ fi cat >confdef2opt.sed <<\_ACEOF t clear : clear -s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote -s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote -s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g @@ -1342,7 +1374,7 @@ ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_i=`echo "$ac_i" | - sed 's/\$U\././;s/\.o$//;s/\.obj$//'` + sed 's/\$U\././;s/\.o$//;s/\.obj$//'` # 2. Add them. ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' @@ -1386,9 +1418,10 @@ if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi +DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. -if (FOO=FOO; unset FOO) >/dev/null 2>&1; then +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false @@ -1407,7 +1440,7 @@ for as_var in \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do - if (set +x; test -n "`(eval $as_var=C; export $as_var) 2>&1`"); then + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var @@ -1586,16 +1619,17 @@ rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else + test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. -as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. -as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g" +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS @@ -1622,7 +1656,7 @@ _ASBOX cat >&5 <<_CSEOF This file was extended by $as_me, which was -generated by GNU Autoconf 2.57. Invocation command line was +generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -1666,7 +1700,7 @@ Usage: $0 [OPTIONS] [FILE]... -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] - instantiate the configuration file FILE + instantiate the configuration file FILE Configuration files: $config_files @@ -1677,11 +1711,10 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ config.status -configured by $0, generated by GNU Autoconf 2.57, +configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" -Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001 -Free Software Foundation, Inc. +Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir @@ -1901,9 +1934,9 @@ _ACEOF (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" + ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else - ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" + ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end @@ -1921,21 +1954,21 @@ for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin - cat >$tmp/stdin - ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + cat >$tmp/stdin + ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$ac_file" : 'X\(//\)[^/]' \| \ - X"$ac_file" : 'X\(//\)$' \| \ - X"$ac_file" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } @@ -1951,10 +1984,10 @@ echo X"$ac_file" | as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } @@ -1992,12 +2025,45 @@ case $srcdir in ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac -# Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be -# absolute. -ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd` -ac_abs_top_builddir=`cd "$ac_dir" && cd ${ac_top_builddir}. && pwd` -ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd` -ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd` + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac @@ -2015,7 +2081,7 @@ echo "$as_me: creating $ac_file" >&6;} configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | - sed 's,.*/,,'` by configure." + sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. @@ -2024,24 +2090,24 @@ echo "$as_me: creating $ac_file" >&6;} case $f in -) echo $tmp/stdin ;; [\\/$]*) - # Absolute (can't be DOS-style, as IFS=:) - test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 + # Absolute (can't be DOS-style, as IFS=:) + test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } - echo $f;; + echo "$f";; *) # Relative - if test -f "$f"; then - # Build tree - echo $f - elif test -f "$srcdir/$f"; then - # Source tree - echo $srcdir/$f - else - # /dev/null tree - { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 + if test -f "$f"; then + # Build tree + echo "$f" + elif test -f "$srcdir/$f"; then + # Source tree + echo "$srcdir/$f" + else + # /dev/null tree + { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } - fi;; + fi;; esac done` || { (exit 1); exit 1; } _ACEOF diff --git a/tools/configure.in b/tools/configure.in index ffae2ba..6aebcaa 100644 --- a/tools/configure.in +++ b/tools/configure.in @@ -2,8 +2,7 @@ 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.57) -# RCS: @(#) $Id: configure.in,v 1.11 2003/03/13 10:39:57 mdejong Exp $ +AC_PREREQ(2.59) # Recover information that Tcl computed with its configure script. @@ -12,7 +11,7 @@ AC_PREREQ(2.57) # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.5 +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 diff --git a/tools/encoding/big5.txt b/tools/encoding/big5.txt index 33e5226..5cc9e81 100644 --- a/tools/encoding/big5.txt +++ b/tools/encoding/big5.txt @@ -7,8 +7,6 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: big5.txt,v 1.2 1999/04/16 00:47:43 stanton Exp $ -# # NOTE: this table has been modified to include the 7-bit ASCII # characters that are allowed in BIG5 files. # diff --git a/tools/encoding/ebcdic.txt b/tools/encoding/ebcdic.txt index d9fa42e..d9fa42e 100755..100644 --- a/tools/encoding/ebcdic.txt +++ b/tools/encoding/ebcdic.txt diff --git a/tools/encoding/gb2312.txt b/tools/encoding/gb2312.txt index b9a1629..fc9f6f0 100644 --- a/tools/encoding/gb2312.txt +++ b/tools/encoding/gb2312.txt @@ -7,8 +7,6 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: gb2312.txt,v 1.2 1999/04/16 00:47:55 stanton Exp $ -# # NOTE: this table has been modified to include the 7-bit ASCII # characters that are allowed in GB2312 files. # diff --git a/tools/encoding/tis-620.txt b/tools/encoding/tis-620.txt index d3656c5..d3656c5 100755..100644 --- a/tools/encoding/tis-620.txt +++ b/tools/encoding/tis-620.txt diff --git a/tools/eolFix.tcl b/tools/eolFix.tcl index ed3ec7c..3f35ed4 100644 --- a/tools/eolFix.tcl +++ b/tools/eolFix.tcl @@ -13,16 +13,18 @@ namespace eval ::EOL { variable outMode crlf } -proc EOL::fix {filename {newfilename ""}} { +proc EOL::fix {filename {newfilename {}}} { variable outMode - if {![file exists $filename]} { return } + if {![file exists $filename]} { + return + } puts "EOL Fixing: $filename" file rename ${filename} ${filename}.o set fhnd [open ${filename}.o r] - if {$newfilename != ""} { + if {$newfilename ne ""} { set newfhnd [open ${newfilename} w] } else { set newfhnd [open ${filename} w] @@ -63,12 +65,12 @@ proc EOL::fixall {args} { } if {$tcl_interactive == 0 && $argc > 0} { - if {[string index [lindex $argv 0] 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 } + -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] } diff --git a/tools/findBadExternals.tcl b/tools/findBadExternals.tcl new file mode 100755 index 0000000..7592f17 --- /dev/null +++ b/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] diff --git a/tools/fix_tommath_h.tcl b/tools/fix_tommath_h.tcl index 92b1f77..04bf857 100755 --- a/tools/fix_tommath_h.tcl +++ b/tools/fix_tommath_h.tcl @@ -7,48 +7,96 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: fix_tommath_h.tcl,v 1.2 2005/05/10 18:35:25 kennykb Exp $ -# #---------------------------------------------------------------------- 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] { - switch -regexp -- $line { - {#define BN_H_} { - puts $line - puts {} - puts "\#ifdef TCL_TOMMATH" - puts "\#include <tclTomMath.h>" - puts "\#endif" - puts "\#ifndef TOMMATH_STORAGE_CLASS" - puts "\#define TOMMATH_STORAGE_CLASS extern" - puts "\#endif" + 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 + } } - {typedef.*mp_digit;} { - puts "\#ifndef MP_DIGIT_DECLARED" - puts $line - puts "\#define MP_DIGIT_DECLARED" - puts "\#endif" + } else { + puts $line + } + if {$eat_semi} { + if {[regexp {; *$} $line]} { + puts $after_semi + set eat_semi 0 } - {typedef struct} { - puts "\#ifndef MP_INT_DECLARED" - puts "\#define MP_INT_DECLARED" - puts "typedef struct mp_int mp_int;" + } + if {$eat_endif} { + if {[regexp {^\#endif} $line]} { puts "\#endif" - puts "struct mp_int \{" - } - \}\ mp_int\; { - puts "\};" - } - "^(char|int|void)" { - puts "TOMMATH_STORAGE_CLASS $line" - } - default { - puts $line + set eat_endif 0 } } -}
\ No newline at end of file +} diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 15cb0a2..7a75dc6 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -1,22 +1,22 @@ # genStubs.tcl -- # # This script generates a set of stub files for a given -# interface. -# +# interface. +# # # Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> +# # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: genStubs.tcl,v 1.17 2004/03/17 18:14:18 das Exp $ -package require Tcl 8 +package require Tcl 8.4 namespace eval genStubs { # libraryName -- # # The name of the entire library. This value is used to compute - # the USE_*_STUB_PROCS macro and the name of the init file. + # the USE_*_STUBS macro and the name of the init file. variable libraryName "UNKNOWN" @@ -33,6 +33,22 @@ namespace eval genStubs { variable curName "UNKNOWN" + # scspec -- + # + # Storage class specifier for external function declarations. + # Normally "EXTERN", may be set to something like XYZAPI + # + variable scspec "EXTERN" + + # epoch, revision -- + # + # The epoch and revision numbers of the interface currently being defined. + # (@@@TODO: should be an array mapping interface names -> numbers) + # + + variable epoch {} + variable revision 0 + # hooks -- # # An array indexed by interface name that contains the set of @@ -94,6 +110,27 @@ proc genStubs::interface {name} { return } +# genStubs::scspec -- +# +# Define the storage class macro used for external function declarations. +# Typically, this will be a macro like XYZAPI or EXTERN that +# expands to either DLLIMPORT or DLLEXPORT, depending on whether +# -DBUILD_XYZ has been set. +# +proc genStubs::scspec {value} { + variable scspec $value +} + +# genStubs::epoch -- +# +# Define the epoch number for this library. The epoch +# should be incrememented when a release is made that +# contains incompatible changes to the public API. +# +proc genStubs::epoch {value} { + variable epoch $value +} + # genStubs::hooks -- # # This function defines the subinterface hooks for the current @@ -132,11 +169,18 @@ proc genStubs::hooks {names} { proc genStubs::declare {args} { variable stubs variable curName - - if {[llength $args] != 3} { + variable revision + + incr revision + if {[llength $args] == 2} { + lassign $args index decl + set platformList generic + } elseif {[llength $args] == 3} { + lassign $args index platformList decl + } else { puts stderr "wrong # args: declare $args" + return } - lassign $args index platformList decl # Check for duplicate declarations, then add the declaration and # bump the lastNum counter if necessary. @@ -150,7 +194,7 @@ proc genStubs::declare {args} { set decl [parseDecl $decl] foreach platform $platformList { - if {$decl != ""} { + if {$decl ne ""} { set stubs($curName,$platform,$index) $decl if {![info exists stubs($curName,$platform,lastNum)] \ || ($index > $stubs($curName,$platform,lastNum))} { @@ -161,6 +205,25 @@ proc genStubs::declare {args} { return } +# genStubs::export -- +# +# This function is used in the declarations file to declare a symbol +# that is exported from the library but is not in the stubs table. +# +# Arguments: +# decl The C function declaration, or {} for an undefined +# entry. +# +# Results: +# None. + +proc genStubs::export {args} { + if {[llength $args] != 1} { + puts stderr "wrong # args: export $args" + } + return +} + # genStubs::rewriteFile -- # # This function replaces the machine generated portion of the @@ -181,6 +244,7 @@ proc genStubs::rewriteFile {file text} { } set in [open ${file} r] set out [open ${file}.new w] + fconfigure $out -translation lf while {![eof $in]} { set line [gets $in] @@ -215,25 +279,63 @@ proc genStubs::rewriteFile {file text} { # Results: # Returns the original text inside an appropriate #ifdef. -proc genStubs::addPlatformGuard {plat text} { +proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { + set text "" switch $plat { win { - return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n" + append text "#if defined(_WIN32)" + if {$withCygwin} { + append text " || defined(__CYGWIN__)" + } + append text " /* WIN */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* WIN */\n${eltxt}" + } + append text "#endif /* WIN */\n" } unix { - return "#if !defined(__WIN32__) /* UNIX */\n${text}#endif /* UNIX */\n" - } + append text "#if !defined(_WIN32)" + if {$withCygwin} { + append text " && !defined(__CYGWIN__)" + } + append text " && !defined(MAC_OSX_TCL)\ + /* UNIX */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* UNIX */\n${eltxt}" + } + append text "#endif /* UNIX */\n" + } macosx { - return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n" + append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* MACOSX */\n${eltxt}" + } + append text "#endif /* MACOSX */\n" } aqua { - return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n" + append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* AQUA */\n${eltxt}" + } + append text "#endif /* AQUA */\n" } x11 { - return "#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n" + append text "#if !(defined(_WIN32)" + if {$withCygwin} { + append text " || defined(__CYGWIN__)" + } + append text " || defined(MAC_OSX_TK))\ + /* X11 */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* X11 */\n${eltxt}" + } + append text "#endif /* X11 */\n" + } + default { + append text "${iftxt}${eltxt}" } } - return "$text" + return $text } # genStubs::emitSlots -- @@ -250,10 +352,9 @@ proc genStubs::addPlatformGuard {plat text} { # None. proc genStubs::emitSlots {name textVar} { - variable stubs upvar $textVar text - forAllStubs $name makeSlot 1 text {" void *reserved$i;\n"} + forAllStubs $name makeSlot 1 text {" void (*reserved$i)(void);\n"} return } @@ -272,8 +373,8 @@ proc genStubs::emitSlots {name textVar} { proc genStubs::parseDecl {decl} { if {![regexp {^(.*)\((.*)\)$} $decl all prefix args]} { - puts stderr "Malformed declaration: $decl" - return + set prefix $decl + set args {} } set prefix [string trim $prefix] if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} { @@ -281,19 +382,23 @@ proc genStubs::parseDecl {decl} { return } set rtype [string trim $rtype] + if {$args eq ""} { + return [list $rtype $fname {}] + } foreach arg [split $args ,] { lappend argList [string trim $arg] } if {![string compare [lindex $argList end] "..."]} { - if {[llength $argList] != 2} { - puts stderr "Only one argument is allowed in varargs form: $decl" - } - set arg [parseArg [lindex $argList 0]] - if {$arg == "" || ([llength $arg] != 2)} { - puts stderr "Bad argument: '[lindex $argList 0]' in '$decl'" - return + set args TCL_VARARGS + foreach arg [lrange $argList 0 end-1] { + set argInfo [parseArg $arg] + if {[llength $argInfo] == 2 || [llength $argInfo] == 3} { + lappend args $argInfo + } else { + puts stderr "Bad argument: '$arg' in '$decl'" + return + } } - set args [list TCL_VARARGS $arg] } else { set args {} foreach arg $argList { @@ -325,14 +430,14 @@ proc genStubs::parseDecl {decl} { proc genStubs::parseArg {arg} { if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} { - if {$arg == "void"} { + if {$arg eq "void"} { return $arg } else { return } } set result [list [string trim $type] $name] - if {$array != ""} { + if {$array ne ""} { lappend result $array } return $result @@ -351,10 +456,11 @@ proc genStubs::parseArg {arg} { # Returns the formatted declaration string. proc genStubs::makeDecl {name decl index} { + variable scspec lassign $decl rtype fname args append text "/* $index */\n" - set line "EXTERN $rtype" + set line "$scspec $rtype" set count [expr {2 - ([string length $line] / 8)}] append line [string range "\t\t\t" 0 $count] set pad [expr {24 - [string length $line]}] @@ -362,7 +468,13 @@ proc genStubs::makeDecl {name decl index} { append line " " set pad 0 } - append line "$fname _ANSI_ARGS_(" + if {$args eq ""} { + append line $fname + append text $line + append text ";\n" + return $text + } + append line $fname set arg1 [lindex $args 0] switch -exact $arg1 { @@ -370,19 +482,42 @@ proc genStubs::makeDecl {name decl index} { append line "(void)" } TCL_VARARGS { - set arg [lindex $args 1] - append line "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])" + set sep "(" + foreach arg [lrange $args 1 end] { + append line $sep + set next {} + append next [lindex $arg 0] + if {[string index $next end] ne "*"} { + append next " " + } + append next [lindex $arg 1] [lindex $arg 2] + if {[string length $line] + [string length $next] \ + + $pad > 76} { + append text [string trimright $line] \n + set line "\t\t\t\t" + set pad 28 + } + append line $next + set sep ", " + } + append line ", ...)" + if {[lindex $args end] eq "{const char *} format"} { + append line " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")" + } } default { set sep "(" foreach arg $args { append line $sep set next {} - append next [lindex $arg 0] " " [lindex $arg 1] \ - [lindex $arg 2] + append next [lindex $arg 0] + if {[string index $next end] ne "*"} { + append next " " + } + append next [lindex $arg 1] [lindex $arg 2] if {[string length $line] + [string length $next] \ + $pad > 76} { - append text $line \n + append text [string trimright $line] \n set line "\t\t\t\t" set pad 28 } @@ -392,11 +527,7 @@ proc genStubs::makeDecl {name decl index} { append line ")" } } - append text $line - - append text ");" - format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \ - $fname $fname $text + return "$text$line;\n" } # genStubs::makeMacro -- @@ -417,91 +548,12 @@ proc genStubs::makeMacro {name decl index} { set lfname [string tolower [string index $fname 0]] append lfname [string range $fname 1 end] - set text "#ifndef $fname\n#define $fname" - set arg1 [lindex $args 0] - set argList "" - switch -exact $arg1 { - void { - set argList "()" - } - TCL_VARARGS { - } - default { - set sep "(" - foreach arg $args { - append argList $sep [lindex $arg 1] - set sep ", " - } - append argList ")" - } + set text "#define $fname \\\n\t(" + if {$args eq ""} { + append text "*" } - append text " \\\n\t(${name}StubsPtr->$lfname)" - append text " /* $index */\n#endif\n" - return $text -} - -# genStubs::makeStub -- -# -# Emits a stub function definition. -# -# Arguments: -# name The interface name. -# decl The function declaration. -# index The slot index for this function. -# -# Results: -# Returns the formatted stub function definition. - -proc genStubs::makeStub {name decl index} { - lassign $decl rtype fname args - - set lfname [string tolower [string index $fname 0]] - append lfname [string range $fname 1 end] - - append text "/* Slot $index */\n" $rtype "\n" $fname - - set arg1 [lindex $args 0] - - if {![string compare $arg1 "TCL_VARARGS"]} { - lassign [lindex $args 1] type argName - append text " TCL_VARARGS_DEF($type,$argName)\n\{\n" - append text " " $type " var;\n va_list argList;\n" - if {[string compare $rtype "void"]} { - append text " " $rtype " resultValue;\n" - } - append text "\n var = (" $type ") TCL_VARARGS_START(" \ - $type "," $argName ",argList);\n\n " - if {[string compare $rtype "void"]} { - append text "resultValue = " - } - append text "(" $name "StubsPtr->" $lfname "VA)(var, argList);\n" - append text " va_end(argList);\n" - if {[string compare $rtype "void"]} { - append text "return resultValue;\n" - } - append text "\}\n\n" - return $text - } - - if {![string compare $arg1 "void"]} { - set argList "()" - set argDecls "" - } else { - set argList "" - set sep "(" - foreach arg $args { - append argList $sep [lindex $arg 1] - append argDecls " " [lindex $arg 0] " " \ - [lindex $arg 1] [lindex $arg 2] ";\n" - set sep ", " - } - append argList ")" - } - append text $argList "\n" $argDecls "{\n " - if {[string compare $rtype "void"]} { - append text "return " - } - append text "(" $name "StubsPtr->" $lfname ")" $argList ";\n}\n\n" + append text "${name}StubsPtr->$lfname)" + append text " /* $index */\n" return $text } @@ -524,29 +576,50 @@ proc genStubs::makeSlot {name decl index} { append lfname [string range $fname 1 end] set text " " - append text $rtype " (*" $lfname ") _ANSI_ARGS_(" - + if {$args eq ""} { + append text $rtype " *" $lfname "; /* $index */\n" + return $text + } + if {[string range $rtype end-8 end] eq "__stdcall"} { + append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " + } else { + append text $rtype " (*" $lfname ") " + } set arg1 [lindex $args 0] switch -exact $arg1 { void { append text "(void)" } TCL_VARARGS { - set arg [lindex $args 1] - append text "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])" + set sep "(" + foreach arg [lrange $args 1 end] { + append text $sep [lindex $arg 0] + if {[string index $text end] ne "*"} { + append text " " + } + append text [lindex $arg 1] [lindex $arg 2] + set sep ", " + } + append text ", ...)" + if {[lindex $args end] eq "{const char *} format"} { + append text " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")" + } } default { set sep "(" foreach arg $args { - append text $sep [lindex $arg 0] " " [lindex $arg 1] \ - [lindex $arg 2] + append text $sep [lindex $arg 0] + if {[string index $text end] ne "*"} { + append text " " + } + append text [lindex $arg 1] [lindex $arg 2] set sep ", " } append text ")" } } - - append text "); /* $index */\n" + + append text "; /* $index */\n" return $text } @@ -563,7 +636,11 @@ proc genStubs::makeSlot {name decl index} { # Returns the formatted declaration string. proc genStubs::makeInit {name decl index} { - append text " " [lindex $decl 1] ", /* " $index " */\n" + if {[lindex $decl 2] eq ""} { + append text " &" [lindex $decl 1] ", /* " $index " */\n" + } else { + append text " " [lindex $decl 1] ", /* " $index " */\n" + } return $text } @@ -588,7 +665,7 @@ proc genStubs::makeInit {name decl index} { # Results: # None. -proc genStubs::forAllStubs {name slotProc onAll textVar \ +proc genStubs::forAllStubs {name slotProc onAll textVar {skipString {"/* Slot $i is reserved */\n"}}} { variable stubs upvar $textVar text @@ -607,113 +684,230 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \ set emit 0 if {[info exists stubs($name,generic,$i)]} { if {[llength $slots] > 1} { - puts stderr "platform entry duplicates generic entry: $i" + puts stderr "conflicting generic and platform entries:\ + $name $i" } append text [$slotProc $name $stubs($name,generic,$i) $i] set emit 1 } elseif {[llength $slots] > 0} { - foreach plat {unix win} { - if {[info exists stubs($name,$plat,$i)]} { - append text [addPlatformGuard $plat \ - [$slotProc $name $stubs($name,$plat,$i) $i]] - set emit 1 + array set slot {unix 0 x11 0 win 0 macosx 0 aqua 0} + foreach s $slots { + set slot([lindex [split $s ,] 1]) 1 + } + # "aqua", "macosx" and "x11" are special cases: + # "macosx" implies "unix", "aqua" implies "macosx" and "x11" + # implies "unix", so we need to be careful not to emit + # duplicate stubs entries: + if {($slot(unix) && $slot(macosx)) || ( + ($slot(unix) || $slot(macosx)) && + ($slot(x11) || $slot(aqua)))} { + puts stderr "conflicting platform entries: $name $i" + } + ## unix ## + set temp {} + set plat unix + if {!$slot(aqua) && !$slot(x11)} { + if {$slot($plat)} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] } elseif {$onAll} { - append text [eval {addPlatformGuard $plat} $skipString] - set emit 1 + eval {append temp} $skipString } } - # - # "aqua" and "macosx" and "x11" are special cases, - # since "macosx" always implies "unix" and "aqua", - # "macosx", so we need to be careful not to - # emit duplicate stubs entries for the two. - # - if {[info exists stubs($name,aqua,$i)] - && ![info exists stubs($name,macosx,$i)] - && ![info exists stubs($name,unix,$i)]} { - append text [addPlatformGuard aqua \ - [$slotProc $name $stubs($name,aqua,$i) $i]] + if {$temp ne ""} { + append text [addPlatformGuard $plat $temp] set emit 1 } - if {[info exists stubs($name,macosx,$i)] - && ![info exists stubs($name,unix,$i)]} { - append text [addPlatformGuard macosx \ - [$slotProc $name $stubs($name,macosx,$i) $i]] + ## x11 ## + set temp {} + set plat x11 + if {!$slot(unix) && !$slot(macosx)} { + if {$slot($plat)} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + } elseif {$onAll} { + eval {append temp} $skipString + } + } + if {$temp ne ""} { + append text [addPlatformGuard $plat $temp] set emit 1 } - if {[info exists stubs($name,x11,$i)] - && ![info exists stubs($name,unix,$i)]} { - append text [addPlatformGuard x11 \ - [$slotProc $name $stubs($name,x11,$i) $i]] + ## win ## + set temp {} + set plat win + if {$slot($plat)} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + } elseif {$onAll} { + eval {append temp} $skipString + } + if {$temp ne ""} { + append text [addPlatformGuard $plat $temp] + set emit 1 + } + ## macosx ## + set temp {} + set plat macosx + if {!$slot(aqua) && !$slot(x11)} { + if {$slot($plat)} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + } elseif {$slot(unix)} { + append temp [$slotProc $name $stubs($name,unix,$i) $i] + } elseif {$onAll} { + eval {append temp} $skipString + } + } + if {$temp ne ""} { + append text [addPlatformGuard $plat $temp] + set emit 1 + } + ## aqua ## + set temp {} + set plat aqua + if {!$slot(unix) && !$slot(macosx)} { + if {[string range $skipString 1 2] ne "/*"} { + # genStubs.tcl previously had a bug here causing it to + # erroneously generate both a unix entry and an aqua + # entry for a given stubs table slot. To preserve + # backwards compatibility, generate a dummy stubs entry + # before every aqua entry (note that this breaks the + # correspondence between emitted entry number and + # actual position of the entry in the stubs table, e.g. + # TkIntStubs entry 113 for aqua is in fact at position + # 114 in the table, entry 114 at position 116 etc). + eval {append temp} $skipString + set temp "[string range $temp 0 end-1] /*\ + Dummy entry for stubs table backwards\ + compatibility */\n" + } + if {$slot($plat)} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + } elseif {$onAll} { + eval {append temp} $skipString + } + } + if {$temp ne ""} { + append text [addPlatformGuard $plat $temp] set emit 1 } } - if {$emit == 0} { + if {!$emit} { eval {append text} $skipString } } - } else { # Emit separate stubs blocks per platform - foreach plat {unix win} { - if {[info exists stubs($name,$plat,lastNum)]} { - set lastNum $stubs($name,$plat,lastNum) - set temp {} - for {set i 0} {$i <= $lastNum} {incr i} { - if {![info exists stubs($name,$plat,$i)]} { - eval {append temp} $skipString - } else { - append temp [$slotProc $name $stubs($name,$plat,$i) $i] - } + array set block {unix 0 x11 0 win 0 macosx 0 aqua 0} + foreach s [array names stubs $name,*,lastNum] { + set block([lindex [split $s ,] 1]) 1 + } + ## unix ## + if {$block(unix) && !$block(x11)} { + set temp {} + set plat unix + set lastNum $stubs($name,$plat,lastNum) + for {set i 0} {$i <= $lastNum} {incr i} { + if {[info exists stubs($name,$plat,$i)]} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + } else { + eval {append temp} $skipString } - append text [addPlatformGuard $plat $temp] } + append text [addPlatformGuard $plat $temp {} true] } - if {[info exists stubs($name,unix,lastNum)]} { - set afterUnixNum [expr $stubs($name,unix,lastNum) + 1] - } else { - set afterUnixNum 0 + ## win ## + if {$block(win)} { + set temp {} + set plat win + set lastNum $stubs($name,$plat,lastNum) + for {set i 0} {$i <= $lastNum} {incr i} { + if {[info exists stubs($name,$plat,$i)]} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + } else { + eval {append temp} $skipString + } + } + append text [addPlatformGuard $plat $temp {} true] } - if {[info exists stubs($name,aqua,lastNum)]} { - set lastNum $stubs($name,aqua,lastNum) + ## macosx ## + if {($block(unix) || $block(macosx)) && !$block(aqua) && !$block(x11)} { set temp {} - # Again, make sure you don't duplicate entries for macosx & unix & aqua. - for {set i $afterUnixNum} {$i <= $lastNum} {incr i} { - if {![info exists stubs($name,macosx,$i)]} { - if {![info exists stubs($name,aqua,$i)]} { - eval {append temp} $skipString - } else { - append temp [$slotProc $name $stubs($name,aqua,$i) $i] + set lastNum -1 + foreach plat {unix macosx} { + if {$block($plat)} { + set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum) + ? $lastNum : $stubs($name,$plat,lastNum)}] + } + } + for {set i 0} {$i <= $lastNum} {incr i} { + set emit 0 + foreach plat {unix macosx} { + if {[info exists stubs($name,$plat,$i)]} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + set emit 1 + break } } + if {!$emit} { + eval {append temp} $skipString + } } - append text [addPlatformGuard aqua $temp] + append text [addPlatformGuard macosx $temp] } - if {[info exists stubs($name,macosx,lastNum)]} { - set lastNum $stubs($name,macosx,lastNum) + ## aqua ## + if {$block(aqua)} { set temp {} - # Again, make sure you don't duplicate entries for macosx & unix. - for {set i $afterUnixNum} {$i <= $lastNum} {incr i} { - if {![info exists stubs($name,macosx,$i)]} { + set lastNum -1 + foreach plat {unix macosx aqua} { + if {$block($plat)} { + set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum) + ? $lastNum : $stubs($name,$plat,lastNum)}] + } + } + for {set i 0} {$i <= $lastNum} {incr i} { + set emit 0 + foreach plat {unix macosx aqua} { + if {[info exists stubs($name,$plat,$i)]} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + set emit 1 + break + } + } + if {!$emit} { eval {append temp} $skipString - } else { - append temp [$slotProc $name $stubs($name,macosx,$i) $i] } } - append text [addPlatformGuard macosx $temp] + append text [addPlatformGuard aqua $temp] } - if {[info exists stubs($name,x11,lastNum)]} { - set lastNum $stubs($name,x11,lastNum) + ## x11 ## + if {$block(x11)} { set temp {} - # Again, make sure you don't duplicate entries for x11 & unix. - for {set i $afterUnixNum} {$i <= $lastNum} {incr i} { - if {![info exists stubs($name,x11,$i)]} { + set lastNum -1 + foreach plat {unix macosx x11} { + if {$block($plat)} { + set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum) + ? $lastNum : $stubs($name,$plat,lastNum)}] + } + } + for {set i 0} {$i <= $lastNum} {incr i} { + set emit 0 + foreach plat {unix macosx x11} { + if {[info exists stubs($name,$plat,$i)]} { + if {$plat ne "macosx"} { + append temp [$slotProc $name \ + $stubs($name,$plat,$i) $i] + } else { + eval {set etxt} $skipString + append temp [addPlatformGuard $plat [$slotProc \ + $name $stubs($name,$plat,$i) $i] $etxt true] + } + set emit 1 + break + } + } + if {!$emit} { eval {append temp} $skipString - } else { - append temp [$slotProc $name $stubs($name,x11,$i) $i] } } - append text [addPlatformGuard x11 $temp] + append text [addPlatformGuard x11 $temp {} true] } } } @@ -730,7 +924,6 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \ # None. proc genStubs::emitDeclarations {name textVar} { - variable stubs upvar $textVar text append text "\n/*\n * Exported function declarations:\n */\n\n" @@ -750,17 +943,16 @@ proc genStubs::emitDeclarations {name textVar} { # None. proc genStubs::emitMacros {name textVar} { - variable stubs variable libraryName upvar $textVar text set upName [string toupper $libraryName] - append text "\n#if defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS)\n" + append text "\n#if defined(USE_${upName}_STUBS)\n" append text "\n/*\n * Inline function declarations:\n */\n\n" - + forAllStubs $name makeMacro 0 text - append text "\n#endif /* defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS) */\n" + append text "\n#endif /* defined(USE_${upName}_STUBS) */\n" return } @@ -778,31 +970,49 @@ proc genStubs::emitMacros {name textVar} { proc genStubs::emitHeader {name} { variable outDir variable hooks + variable epoch + variable revision set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] + if {$epoch ne ""} { + set CAPName [string toupper $name] + append text "\n" + append text "#define ${CAPName}_STUBS_EPOCH $epoch\n" + append text "#define ${CAPName}_STUBS_REVISION $revision\n" + } + + append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" + emitDeclarations $name text if {[info exists hooks($name)]} { - append text "\ntypedef struct ${capName}StubHooks {\n" + append text "\ntypedef struct {\n" foreach hook $hooks($name) { set capHook [string toupper [string index $hook 0]] append capHook [string range $hook 1 end] - append text " struct ${capHook}Stubs *${hook}Stubs;\n" + append text " const struct ${capHook}Stubs *${hook}Stubs;\n" } append text "} ${capName}StubHooks;\n" } append text "\ntypedef struct ${capName}Stubs {\n" append text " int magic;\n" - append text " struct ${capName}StubHooks *hooks;\n\n" + if {$epoch ne ""} { + append text " int epoch;\n" + append text " int revision;\n" + } + if {[info exists hooks($name)]} { + append text " const ${capName}StubHooks *hooks;\n\n" + } else { + append text " void *hooks;\n\n" + } emitSlots $name text - append text "} ${capName}Stubs;\n" + append text "} ${capName}Stubs;\n\n" - append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" - append text "extern ${capName}Stubs *${name}StubsPtr;\n" + append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n" append text "#ifdef __cplusplus\n}\n#endif\n" emitMacros $name text @@ -811,27 +1021,6 @@ proc genStubs::emitHeader {name} { return } -# genStubs::emitStubs -- -# -# This function emits the body of the <name>Stubs.c file for -# the specified interface. -# -# Arguments: -# name The name of the interface being emitted. -# -# Results: -# None. - -proc genStubs::emitStubs {name} { - variable outDir - - append text "\n/*\n * Exported stub functions:\n */\n\n" - forAllStubs $name makeStub 0 text - - rewriteFile [file join $outDir ${name}Stubs.c] $text - return -} - # genStubs::emitInit -- # # Generate the table initializers for an interface. @@ -844,15 +1033,17 @@ proc genStubs::emitStubs {name} { # Returns the formatted output. proc genStubs::emitInit {name textVar} { - variable stubs variable hooks + variable interfaces + variable epoch upvar $textVar text + set root 1 set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] if {[info exists hooks($name)]} { - append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n" + append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n" set sep " " foreach sub $hooks($name) { append text $sep "&${sub}Stubs" @@ -860,15 +1051,32 @@ proc genStubs::emitInit {name textVar} { } append text "\n\};\n" } - append text "\n${capName}Stubs ${name}Stubs = \{\n" - append text " TCL_STUB_MAGIC,\n" + foreach intf [array names interfaces] { + if {[info exists hooks($intf)]} { + if {[lsearch -exact $hooks($intf) $name] >= 0} { + set root 0 + break + } + } + } + + append text "\n" + if {!$root} { + append text "static " + } + append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n" + if {$epoch ne ""} { + set CAPName [string toupper $name] + append text " ${CAPName}_STUBS_EPOCH,\n" + append text " ${CAPName}_STUBS_REVISION,\n" + } if {[info exists hooks($name)]} { append text " &${name}StubHooks,\n" } else { - append text " NULL,\n" + append text " 0,\n" } - - forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"} + + forAllStubs $name makeInit 1 text {" 0, /* $i */\n"} append text "\};\n" return @@ -958,13 +1166,14 @@ proc genStubs::init {} { # Results: # Returns any values that were not assigned to variables. -proc lassign {valueList args} { - if {[llength $args] == 0} { - error "wrong # args: lassign list varname ?varname..?" - } - - uplevel [list foreach $args $valueList {break}] - return [lrange $valueList [llength $args] end] +if {[string length [namespace which lassign]] == 0} { + proc lassign {valueList args} { + if {[llength $args] == 0} { + error "wrong # args: should be \"lassign list varName ?varName ...?\"" + } + uplevel [list foreach $args $valueList {break}] + return [lrange $valueList [llength $args] end] + } } genStubs::init diff --git a/tools/genWinImage.tcl b/tools/genWinImage.tcl deleted file mode 100644 index e57d018..0000000 --- a/tools/genWinImage.tcl +++ /dev/null @@ -1,157 +0,0 @@ -# genWinImage.tcl -- -# -# This script generates the Windows installer. -# -# Copyright (c) 1999 by Scriptics Corporation. -# All rights reserved. -# -# RCS: @(#) $Id: genWinImage.tcl,v 1.5 2000/04/25 22:29:21 hobbs Exp $ - - -# This file is insensitive to the directory from which it is invoked. - -namespace eval genWinImage { - # toolsDir -- - # - # This variable points to the platform specific tools directory. - - variable toolsDir - - # tclBuildDir -- - # - # This variable points to the directory containing the Tcl built tree. - - variable tclBuildDir - - # tkBuildDir -- - # - # This variable points to the directory containing the Tk built tree. - - variable tkBuildDir - - # our script name at runtime - variable script [info script] -} - -# genWinImage::init -- -# -# This is the main entry point. -# -# Arguments: -# None. -# -# Results: -# None. - -proc genWinImage::init {} { - global tcl_platform argv argv0 - variable tclBuildDir - variable tkBuildDir - variable toolsDir - variable script - - puts "\n--- $script started: \ - [clock format [clock seconds] -format "%Y%m%d-%H:%M"] --\n" - - if {$tcl_platform(platform) != "windows"} { - puts stderr "ERROR: Cannot build TCL.EXE on Unix systems" - exit 1 - } - - if {[llength $argv] != 3} { - puts stderr "usage: $argv0 <tclBuildDir> <tkBuildDir> <toolsDir>" - exit 0 - } - - set tclBuildDir [lindex $argv 0] - set tkBuildDir [lindex $argv 1] - set toolsDir [lindex $argv 2] - - generateInstallers - - puts "\n--- $script finished: \ - [clock format [clock seconds] -format "%Y%m%d-%H:%M"] --\n\n" -} - -# genWinImage::makeTextFile -- -# -# Convert the input file into a CRLF terminated text file. -# -# Arguments: -# infile The input file to convert. -# outfile The location where the text file should be stored. -# -# Results: -# None. - -proc genWinImage::makeTextFile {infile outfile} { - set f [open $infile r] - set text [read $f] - close $f - set f [open $outfile w] - fconfigure $f -translation crlf - puts -nonewline $f $text - close $f -} - -# genWinImage::generateInstallers -- -# -# Perform substitutions on the pro.wse.in file and then -# invoke the WSE script twice; once for CD and once for web. -# -# Arguments: -# None. -# -# Results: -# Leaves proweb.exe and procd.exe sitting in the curent directory. - -proc genWinImage::generateInstallers {} { - variable toolsDir - variable tclBuildDir - variable tkBuildDir - - # Now read the "pro/srcs/install/pro.wse.in" file, have Tcl make - # appropriate substitutions, write out the resulting file in a - # current-working-directory. Use this new file to perform installation - # image creation. Note that we have to use this technique to set - # the value of _WISE_ because wise32 won't use a /d switch for this - # variable. - - set __TCLBASEDIR__ [file native $tclBuildDir] - set __TKBASEDIR__ [file native $tkBuildDir] - set __WISE__ [file native [file join $toolsDir wise]] - - set f [open [file join $__TCLBASEDIR__ generic/tcl.h] r] - set s [read $f] - close $f - regexp {TCL_PATCH_LEVEL\s*\"([^\"]*)\"} $s dummy __TCL_PATCH_LEVEL__ - - set f [open tcl.wse.in r] - set s [read $f] - close $f - set s [subst -nocommands -nobackslashes $s] - set f [open tcl.wse w] - puts $f $s - close $f - - # Ensure the text files are CRLF terminated - - makeTextFile [file join $tclBuildDir win/README.binary] \ - [file join $tclBuildDir win/readme.txt] - makeTextFile [file join $tclBuildDir license.terms] \ - [file join $tclBuildDir license.txt] - - set wise32ProgFilePath [file native [file join $__WISE__ wise32.exe]] - - # Run the Wise installer to create the Windows install images. - - if {[catch {exec [file native $wise32ProgFilePath] /c tcl.wse} errMsg]} { - puts stderr "ERROR: $errMsg" - } else { - puts "\"TCL.EXE\" created." - } - - return -} - -genWinImage::init diff --git a/tools/index.tcl b/tools/index.tcl index b39f7ca..71329c2 100644 --- a/tools/index.tcl +++ b/tools/index.tcl @@ -8,14 +8,11 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: index.tcl,v 1.5 2004/05/18 12:28:40 dkf Exp $ -# # Global variables used by these scripts: # # state - state variable that controls action of text proc. -# +# # topics - array indexed by (package,section,topic) with value # of topic ID. # @@ -138,7 +135,7 @@ proc macro {name args} { switch $args { NAME { - if {$state == "INIT" } { + if {$state eq "INIT" } { set state NAME } } @@ -147,7 +144,7 @@ proc macro {name args} { KEYWORDS {set state KEY} default {set state OFF} } - + } TH { global state curID curPkg curSect topics keywords @@ -179,7 +176,7 @@ proc macro {name args} { proc dash {} { global state - if {$state == "NAME"} { + if {$state eq "NAME"} { set state DASH } } @@ -188,7 +185,7 @@ proc dash {} { # initGlobals, tab, font, char, macro2 -- # -# These procedures do nothing during the first pass. +# These procedures do nothing during the first pass. # # Arguments: # None. diff --git a/tools/installData.tcl b/tools/installData.tcl index cf067a3..4b43f1e 100644 --- a/tools/installData.tcl +++ b/tools/installData.tcl @@ -1,6 +1,6 @@ #!/bin/sh #\ - exec tclsh "$0" ${1+"$@"} +exec tclsh "$0" ${1+"$@"} #---------------------------------------------------------------------- # @@ -15,39 +15,36 @@ # 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. -# -# RCS: @(#) $Id: installData.tcl,v 1.1 2004/08/18 19:59:09 kennykb Exp $ -# #---------------------------------------------------------------------- -proc copyDir { d1 d2 } { +proc copyDir {d1 d2} { - puts [format {%*sCreating %s} [expr { 4 * [info level] }] {} \ + 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] } { + if {[file isdirectory $f] && [string compare CVS $ftail]} { copyDir $f [file join $d2 $ftail] - } elseif { [file isfile $f] } { + } elseif {[file isfile $f]} { file copy -force $f [file join $d2 $ftail] - if { $::tcl_platform(platform) eq {unix} } { + 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} } { + + if {$::tcl_platform(platform) eq {unix}} { file attributes $d2 -permissions 0755 } else { file attributes $d2 -readonly 1 } -} - -copyDir [lindex $argv 0] [lindex $argv 1] +} + +copyDir [file normalize [lindex $argv 0]] [file normalize [lindex $argv 1]] diff --git a/tools/loadICU.tcl b/tools/loadICU.tcl index a41a8dc..5b09e2c 100755 --- a/tools/loadICU.tcl +++ b/tools/loadICU.tcl @@ -25,9 +25,6 @@ # 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. -# -# RCS: @(#) $Id: loadICU.tcl,v 1.1 2004/08/18 19:59:09 kennykb Exp $ -# #---------------------------------------------------------------------- # Calculate the Chinese numerals from zero to ninety-nine. @@ -61,22 +58,22 @@ foreach zt $zhDigits { # Set format overrides for various locales. set format(zh,LOCALE_NUMERALS) $zhNumbers -set format(ja,LOCALE_NUMERALS) $zhNumbers set format(ja,LOCALE_ERAS) [list \ [list -9223372036854775808 \u897f\u66a6 0 ] \ - [list -3060979200 \u660e\u6cbb 1867] \ - [list -1812153600 \u5927\u6b63 1911] \ - [list -1357603200 \u662d\u548c 1925] \ - [list 568512000 \u5e73\u6210 1987]] + [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%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) "%OH\u6642%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) "%A %EY\u5e74%B%Od\u65E5%OH\u6642%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. @@ -591,7 +588,7 @@ proc backslashify { string } { set retval {} foreach char [split $string {}] { scan $char %c ccode - if { $ccode >= 0x0020 && $ccode < 0x007f + if { $ccode >= 0x0020 && $ccode < 0x007f && $char ne "\"" && $char ne "\{" && $char ne "\}" && $char ne "\[" && $char ne "\]" && $char ne "\\" && $char ne "\$" } { append retval $char @@ -617,6 +614,6 @@ foreach { icudir msgdir } $argv break 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 ${n}.msg] + handleLocaleFile $n $fileName [file join $msgdir [string tolower $n].msg] } } diff --git a/tools/makeTestCases.tcl b/tools/makeTestCases.tcl index 497205b..d96a221 100755 --- a/tools/makeTestCases.tcl +++ b/tools/makeTestCases.tcl @@ -1,8 +1,9 @@ # TODO - When integrating this with the Core, path names will need to be # swizzled here. -package require newclock +package require msgcat set d [file dirname [file dirname [info script]]] +puts "getting transition data from [file join $d library tzdata America Detroit]" source [file join $d library/tzdata/America/Detroit] namespace eval ::tcl::clock { @@ -369,49 +370,74 @@ proc testcases3 { f2 } { set dow [expr { ( $secs / 86400 + 4 ) % 7}] switch -exact $dow { 0 { + # Year starts on a Sunday. + # Prior year started on a Friday or Saturday, and was + # a 52-week year. + # 1 January is ISO week 52 of the prior year. 2 January + # begins ISO week 1 of the current year. + # 1 January is week 1 according to %U. According to %W, + # week 1 begins on 2 January testISO $f2 $ym1 52 1 [expr { $secs - 6*86400 }] testISO $f2 $ym1 52 6 [expr { $secs - 86400 }] testISO $f2 $ym1 52 7 $secs testISO $f2 $y 1 1 [expr { $secs + 86400 }] + testISO $f2 $y 1 6 [expr { $secs + 6*86400}] testISO $f2 $y 1 7 [expr { $secs + 7*86400 }] testISO $f2 $y 2 1 [expr { $secs + 8*86400 }] } 1 { + # Year starts on a Monday. + # Previous year started on a Saturday or Sunday, and was + # a 52-week year. + # 1 January is ISO week 1 of the current year + # According to %U, it's week 0 until 7 January + # 1 January is week 1 according to %W testISO $f2 $ym1 52 1 [expr { $secs - 7*86400 }] + testISO $f2 $ym1 52 6 [expr {$secs - 2*86400}] testISO $f2 $ym1 52 7 [expr { $secs - 86400 }] testISO $f2 $y 1 1 $secs + testISO $f2 $y 1 6 [expr {$secs + 5*86400}] testISO $f2 $y 1 7 [expr { $secs + 6*86400 }] testISO $f2 $y 2 1 [expr { $secs + 7*86400 }] } 2 { + # Year starts on a Tuesday. testISO $f2 $ym1 52 1 [expr { $secs - 8*86400 }] + testISO $f2 $ym1 52 6 [expr {$secs - 3*86400}] testISO $f2 $ym1 52 7 [expr { $secs - 2*86400 }] testISO $f2 $y 1 1 [expr { $secs - 86400 }] testISO $f2 $y 1 2 $secs + testISO $f2 $y 1 6 [expr {$secs + 4*86400}] testISO $f2 $y 1 7 [expr { $secs + 5*86400 }] testISO $f2 $y 2 1 [expr { $secs + 6*86400 }] } 3 { testISO $f2 $ym1 52 1 [expr { $secs - 9*86400 }] + testISO $f2 $ym1 52 6 [expr {$secs - 4*86400}] testISO $f2 $ym1 52 7 [expr { $secs - 3*86400 }] testISO $f2 $y 1 1 [expr { $secs - 2*86400 }] testISO $f2 $y 1 3 $secs + testISO $f2 $y 1 6 [expr {$secs + 3*86400}] testISO $f2 $y 1 7 [expr { $secs + 4*86400 }] testISO $f2 $y 2 1 [expr { $secs + 5*86400 }] } 4 { testISO $f2 $ym1 52 1 [expr { $secs - 10*86400 }] + testISO $f2 $ym1 52 6 [expr {$secs - 5*86400}] testISO $f2 $ym1 52 7 [expr { $secs - 4*86400 }] testISO $f2 $y 1 1 [expr { $secs - 3*86400 }] testISO $f2 $y 1 4 $secs + testISO $f2 $y 1 6 [expr {$secs + 2*86400}] testISO $f2 $y 1 7 [expr { $secs + 3*86400 }] testISO $f2 $y 2 1 [expr { $secs + 4*86400 }] } 5 { testISO $f2 $ym1 53 1 [expr { $secs - 4*86400 }] testISO $f2 $ym1 53 5 $secs + testISO $f2 $ym1 53 6 [expr {$secs + 86400}] testISO $f2 $ym1 53 7 [expr { $secs + 2*86400 }] testISO $f2 $y 1 1 [expr { $secs + 3*86400 }] + testISO $f2 $y 1 6 [expr {$secs + 8*86400}] testISO $f2 $y 1 7 [expr { $secs + 9*86400 }] testISO $f2 $y 2 1 [expr { $secs + 10*86400 }] } @@ -427,6 +453,7 @@ proc testcases3 { f2 } { testISO $f2 $ym1 52 7 [expr { $secs + 86400 }] } testISO $f2 $y 1 1 [expr { $secs + 2*86400 }] + testISO $f2 $y 1 6 [expr { $secs + 7*86400 }] testISO $f2 $y 1 7 [expr { $secs + 8*86400 }] testISO $f2 $y 2 1 [expr { $secs + 9*86400 }] } @@ -444,11 +471,13 @@ proc testISO { f2 G V u secs } { set shortdays {Sun Mon Tue Wed Thu Fri Sat Sun} puts $f2 "test clock-3.[incr case] {ISO week-based calendar [format %04d-W%02d-%d $G $V $u]} {" - puts $f2 " clock format $secs -format {%a %A %g %G %u %V %w} -gmt true; \# $G-W[format %02d $V]-$u" + puts $f2 " clock format $secs -format {%a %A %g %G %u %U %V %w %W} -gmt true; \# $G-W[format %02d $V]-$u" puts $f2 "} {[lindex $shortdays $u] [lindex $longdays $u]\ [format %02d [expr { $G % 100 }]] $G\ $u\ - [format %02d $V] [expr { $u % 7 }]}" + [clock format $secs -format %U -gmt true]\ + [format %02d $V] [expr { $u % 7 }]\ + [clock format $secs -format %W -gmt true]}" } @@ -547,17 +576,14 @@ proc testcases5 { f2 } { set fmt {%H:%M:%S %z %Z} set i 0 - puts $f2 "::tcltest::testConstraint detroit 0" puts $f2 "test clock-5.[incr i] {does Detroit exist} {" puts $f2 " clock format 0 -format {} -timezone :America/Detroit" - puts $f2 " ::tcltest::testConstraint detroit 1" puts $f2 " concat" puts $f2 "} {}" puts $f2 "test clock-5.[incr i] {does Detroit have a Y2038 problem} detroit {" puts $f2 " if { \[clock format 2158894800 -format %z -timezone :America/Detroit\] ne {-0400} } {" puts $f2 " concat {y2038 problem}" puts $f2 " } else {" - puts $f2 " ::tcltest::testConstraint y2038 1" puts $f2 " concat {ok}" puts $f2 " }" puts $f2 "} ok" diff --git a/tools/man2help.tcl b/tools/man2help.tcl index 91fcb89..018fa84 100644 --- a/tools/man2help.tcl +++ b/tools/man2help.tcl @@ -5,15 +5,13 @@ # entries. # # Copyright (c) 1996 by Sun Microsystems, Inc. -# -# RCS: @(#) $Id: man2help.tcl,v 1.14 2003/06/04 23:40:18 mistachkin Exp $ -# # # PASS 1 # -set man2tclprog [file join [file dirname [info script]] man2tcl.exe] +set man2tclprog [file join [file dirname [info script]] \ + man2tcl[file extension [info nameofexecutable]]] proc generateContents {basename version files} { global curID topics diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index 62b5b2e..9c8f503 100644 --- a/tools/man2help2.tcl +++ b/tools/man2help2.tcl @@ -8,14 +8,11 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: man2help2.tcl,v 1.15 2004/07/07 12:08:43 dkf Exp $ -# # Global variables used by these scripts: # # state - state variable that controls action of text proc. -# +# # topics - array indexed by (package,section,topic) with value # of topic ID. # @@ -179,12 +176,12 @@ proc text {string} { } switch $state(textState) { - REF { + REF { if {$state(inTP) == 0} { set string [insertRef $string] } } - SEE { + SEE { global topics curPkg curSect foreach i [split $string] { if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} { @@ -234,7 +231,7 @@ proc insertRef {string} { } } - if {($ref != {}) && ($ref != $curID)} { + if {($ref != "") && ($ref != $curID)} { set string [link $string $ref] } return $string @@ -276,7 +273,7 @@ proc macro {name args} { # next page and previous page } br { - lineBreak + lineBreak } BS {} BE {} @@ -391,12 +388,12 @@ proc macro {name args} { set state(noFill) 1 } so { - if {$args != "man.macros"} { + if {$args ne "man.macros"} { puts stderr "Unknown macro: .$name [join $args " "]" } } sp { ;# needs work - if {$args == ""} { + if {$args eq ""} { set count 1 } else { set count [lindex $args 0] @@ -425,6 +422,21 @@ proc macro {name args} { } VE {} VS {} + QW { + formattedText "``[lindex $args 0]''[lindex $args 1] " + } + MT { + text "``'' " + } + PQ { + formattedText \ + "(``[lindex $args 0]''[lindex $args 1])[lindex $args 2] " + } + QR { + formattedText "``[lindex $args 0]" + dash + formattedText "[lindex $args 1]''[lindex $args 2] " + } default { puts stderr "Unknown macro: .$name [join $args " "]" } @@ -460,14 +472,14 @@ proc font {type} { P - R { endFont - if {$state(textState) == "REF"} { + if {$state(textState) eq "REF"} { set state(textState) INSERT } } C - B { beginFont Code - if {$state(textState) == "INSERT"} { + if {$state(textState) eq "INSERT"} { set state(textState) REF } } @@ -495,7 +507,7 @@ proc font {type} { proc formattedText {text} { global chars - while {$text != ""} { + while {$text ne ""} { set index [string first \\ $text] if {$index < 0} { text $text @@ -516,13 +528,12 @@ proc formattedText {text} { dash set text [string range $text [expr {$index+2}] end] } - | { + & - | { set text [string range $text [expr {$index+2}] end] } - o { - text "\\'" - regexp {'([^']*)'(.*)} $text all ch text - text $chars($ch) + ( { + char [string range $text $index [expr {$index+3}]] + set text [string range $text [expr {$index+4}] end] } default { puts stderr "Unknown sequence: \\$c" @@ -586,7 +597,7 @@ proc setTabs {tabList} { set relativeTo [expr {$state(leftMargin) \ + ($state(offset) * $state(nestingLevel))}] } - if {[regexp {^\w'(.*)'u$} $arg -> submatch]} { + if {[regexp {^\\w'([^']*)'u$} $arg -> submatch]} { # Magic factor! set distance [expr {[string length $submatch] * 86.4}] } else { @@ -665,32 +676,55 @@ proc char {name} { global file state switch -exact $name { - \\o { + {\o} { set state(intl) 1 } - \\\ { + {\ } { textSetup puts -nonewline $file " " } - \\0 { + {\0} { textSetup puts -nonewline $file " \\emspace " } - \\\\ { + {\\} - {\e} { textSetup puts -nonewline $file "\\\\" } - \\(+- { + {\(+-} { textSetup puts -nonewline $file "\\'b1 " } - \\% - - \\| { + {\%} - {\|} { } - \\(bu { + {\(->} { + textSetup + puts -nonewline $file "->" + } + {\(bu} { textSetup puts -nonewline $file "\\bullet " } + {\(co} { + textSetup + puts -nonewline $file "\\'a9 " + } + {\(mi} { + textSetup + puts -nonewline $file "-" + } + {\(mu} { + textSetup + puts -nonewline $file "\\'d7 " + } + {\(em} - {\(en} { + textSetup + puts -nonewline $file "-" + } + {\(fm} { + textSetup + puts -nonewline $file "\\'27 " + } default { puts stderr "Unknown character: $name" } @@ -730,7 +764,7 @@ proc SHmacro {argList {style section}} { } # control what the text proc does with text - + switch $args { NAME {set state(textState) NAME} DESCRIPTION {set state(textState) INSERT} @@ -855,7 +889,7 @@ proc THmacro {argList} { set curVer [lindex $argList 2] ;# 7.4 set curPkg [lindex $argList 3] ;# Tcl set curSect [lindex $argList 4] ;# {Tcl Library Procedures} - + regsub -all {\\ } $curSect { } curSect ;# Clean up for [incr\ Tcl] puts $file "#{\\footnote $curID}" ;# Context string @@ -920,7 +954,7 @@ proc newPara {leftIndent {firstIndent 0i}} { if $state(paragraph) { puts -nonewline $file "\\line\n" } - if {$leftIndent != ""} { + if {$leftIndent ne ""} { set state(leftIndent) [expr {$state(leftMargin) \ + ($state(offset) * $state(nestingLevel)) \ + [getTwips $leftIndent]}] @@ -943,6 +977,10 @@ proc getTwips {arg} { puts stderr "bad distance \"$arg\"" return 0 } + if {[string length $units] > 1} { + puts stderr "additional characters after unit \"$arg\"" + set units [string index $units 0] + } switch -- $units { c { set distance [expr {$distance * 567}] @@ -952,7 +990,7 @@ proc getTwips {arg} { } default { puts stderr "bad units in distance \"$arg\"" - continue + return 0 } } return $distance @@ -986,7 +1024,7 @@ proc incrNestingLevel {} { proc decrNestingLevel {} { global state - + if {$state(nestingLevel) == 0} { puts stderr "Nesting level decremented below 0" } else { diff --git a/tools/man2html.tcl b/tools/man2html.tcl index 386396f..fa57b03 100644 --- a/tools/man2html.tcl +++ b/tools/man2html.tcl @@ -10,9 +10,6 @@ package require Tcl 8.4 # man2tcl program to generate a HTML files from Tcl manual entries. # # Copyright (c) 1996 by Sun Microsystems, Inc. -# -# SCCS: @(#) man2html.tcl 1.5 96/04/11 20:21:43 -# # sarray - diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl index 59dc396..f2b2e43 100644 --- a/tools/man2html1.tcl +++ b/tools/man2html1.tcl @@ -4,9 +4,6 @@ # man page to html conversion process. It is sourced by h.tcl. # # Copyright (c) 1996 by Sun Microsystems, Inc. -# -# SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29 -# package require Tcl 8.4 diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl index 14bbab0..163196e 100644 --- a/tools/man2html2.tcl +++ b/tools/man2html2.tcl @@ -1,31 +1,28 @@ +############################################################################## # 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. +# 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. -# -# $Id: man2html2.tcl,v 1.9 2005/05/10 18:35:25 kennykb Exp $ -# package require Tcl 8.4 # Global variables used by these scripts: # -# NAME_file - array indexed by NAME and containing file names used -# for hyperlinks. +# 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. +# 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 <DT> tag while in a dictionary list <DL>. +# 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. +# 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. # @@ -33,28 +30,29 @@ package require Tcl 8.4 # # 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. +# 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 - +# 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. +# 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 + global fontStart fontEnd curFont inPRE charCnt inTable nest init set inPRE 0 + set inTable 0 set textState 0 set curFont "" set fontStart(Code) "<B>" @@ -65,12 +63,12 @@ proc initGlobals {} { set charCnt 0 setTabs 0.5i } - - + +############################################################################## # beginFont -- # -# Arranges for future text to use a special font, rather than -# the default paragraph font. +# Arranges for future text to use a special font, rather than the default +# paragraph font. # # Arguments: # font - Name of new font to use. @@ -86,7 +84,7 @@ proc beginFont font { set curFont $font } - +############################################################################## # endFont -- # # Reverts to the default font for the paragraph type. @@ -102,67 +100,74 @@ proc endFont {} { 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. +# 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 + 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 + 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 {\&} string regsub -all {<} $string {\<} string regsub -all {>} $string {\>} string regsub -all \" $string {\"} string - switch $textState { - REF { + switch -exact -- $textState { + REF { if {$inDT eq ""} { set string [insertRef $string] } } - SEE { + SEE { global NAME_file foreach i [split $string] { - if ![regexp -nocase {^[a-z_]+} [string trim $i] i ] { + 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)} ] { + 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 {![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--" @@ -170,13 +175,12 @@ proc insertRef string { } return $string } - - - + +############################################################################## # macro -- # -# This procedure is invoked to process macro invocations that start -# with "." (instead of '). +# This procedure is invoked to process macro invocations that start with "." +# (instead of '). # # Arguments: # name - The name of the macro (without the "."). @@ -200,7 +204,7 @@ proc macro {name args} { } AS {} ;# next page and previous page br { - lineBreak + lineBreak } BS {} BE {} @@ -215,16 +219,16 @@ proc macro {name args} { set inPRE 1 } DE { - global file noFillCount inPRE - puts $file </PRE></BLOCKQUOTE> - set inPRE 0 + global file noFillCount inTable + puts $file </TABLE></BLOCKQUOTE> + set inTable 0 set noFillCount 0 } DS { - global file noFillCount inPRE - puts -nonewline $file <BLOCKQUOTE><PRE> + global file noFillCount inTable + puts -nonewline $file {<BLOCKQUOTE><TABLE BORDER="0">} set noFillCount 10000000 - set inPRE 1 + set inTable 1 } fi { global noFillCount @@ -245,13 +249,13 @@ proc macro {name args} { set noFillCount 1000000 } OP { - global inDT file inPRE + 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> + puts -nonewline $file <PRE> setTabs 4c text "Command-Line Name:" tab @@ -272,8 +276,8 @@ proc macro {name args} { font B text [lindex $args 2] font R - puts -nonewline $file </PRE> - set inDT "\n<DD>" ;# next newline writes inDT + puts -nonewline $file </PRE> + set inDT "\n<DD>" ;# next newline writes inDT set inPRE 0 newline } @@ -283,7 +287,7 @@ proc macro {name args} { newPara } RE { - nest decr + nest decr } RS { nest incr @@ -301,7 +305,11 @@ proc macro {name args} { font B set temp $textState set textState REF - text options + 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." @@ -367,6 +375,43 @@ proc macro {name args} { # } # 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 " "]" } @@ -375,12 +420,11 @@ proc macro {name 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. +# This procedure is invoked to handle font changes in the text being output. # # Arguments: # type - Type of font: R, I, B, or S. @@ -411,13 +455,12 @@ proc font type { } } } - - - + +############################################################################## # formattedText -- # -# Insert a text string that may also have \fB-style font changes -# and a few other backslash sequences in it. +# 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. @@ -455,13 +498,12 @@ proc formattedText text { } } } - - - + +############################################################################## # dash -- # -# This procedure is invoked to handle dash characters ("\-" in -# troff). It outputs a special dash character. +# This procedure is invoked to handle dash characters ("\-" in troff). It +# outputs a special dash character. # # Arguments: # None. @@ -474,18 +516,17 @@ proc dash {} { incr charCnt text "-" } - - + +############################################################################## # tab -- # # This procedure is invoked to handle tabs in the troff input. -# Right now it does nothing. # # Arguments: # None. proc tab {} { - global inPRE charCnt tabString + global inPRE charCnt tabString file # ? charCnt if {$inPRE == 1} { set pos [expr $charCnt % [string length $tabString] ] @@ -496,7 +537,7 @@ proc tab {} { } } - +############################################################################## # setTabs -- # # This procedure handles the ".ta" macro, which sets tab stops. @@ -552,9 +593,8 @@ proc setTabs {tabList} { } # puts "setTabs: --$tabString--" } - - - + +############################################################################## # lineBreak -- # # Generates a line break in the HTML output. @@ -567,23 +607,26 @@ proc lineBreak {} { 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. +# 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 + 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 { @@ -592,9 +635,8 @@ proc newline {} { } set charCnt 0 } - - - + +############################################################################## # char -- # # This procedure is called to handle a special character. @@ -625,13 +667,12 @@ proc char name { } } } - - + +############################################################################## # macro2 -- # -# This procedure handles macros that are invoked with a leading "'" -# character instead of space. Right now it just generates an -# error diagnostic. +# 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 "."). @@ -640,16 +681,15 @@ proc char name { 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) +# style - Type of section (optional) proc SHmacro {argList {style section}} { global file noFillCount textState charCnt @@ -673,7 +713,7 @@ proc SHmacro {argList {style section}} { # ? args textState # control what the text proc does with text - + switch $args { NAME {set textState NAME} DESCRIPTION {set textState INSERT} @@ -684,21 +724,20 @@ proc SHmacro {argList {style section}} { } set charCnt 0 } - - - + +############################################################################## # IPmacro -- # -# This procedure is invoked to handle ".IP" macros, which may take any -# of the following forms: +# 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". +# .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. @@ -728,38 +767,35 @@ proc IPmacro argList { puts $file "\n<DD>" return } - - + +############################################################################## # TPmacro -- # -# This procedure is invoked to handle ".TP" macros, which may take any -# of the following forms: +# 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. +# .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 + 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: +# 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 # @@ -782,38 +818,36 @@ proc THmacro {argList} { 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. +# 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 + 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. +# 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 @@ -863,14 +897,13 @@ proc nest {op {listStart "NEW"} {listItem ""} } { } set charCnt 0 } - - - + +############################################################################## # do -- # -# This is the toplevel procedure that translates a man page -# to Frame. It runs the man2tcl program to turn the man page -# into a script, then it evals that script. +# 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. @@ -882,7 +915,7 @@ proc do fileName { puts " Pass 2 -- $fileName" flush stdout initGlobals - if [catch {eval [exec man2tcl [glob $fileName]]} msg] { + if {[catch { eval [exec man2tcl [glob $fileName]] } msg]} { global errorInfo puts stderr $msg puts "in" diff --git a/tools/man2tcl.c b/tools/man2tcl.c index a5c71cb..8e59bea 100644 --- a/tools/man2tcl.c +++ b/tools/man2tcl.c @@ -1,11 +1,10 @@ -/* +/* * 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. + * 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: * @@ -13,30 +12,27 @@ * * 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. - * - * RCS: @(#) $Id: man2tcl.c,v 1.8 2003/12/09 15:27:47 dkf Exp $ + * 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> -#ifndef NO_ERRNO_H #include <errno.h> -#endif /* * 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! + * 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 @@ -48,22 +44,25 @@ extern int errno; static int lineNumber; /* - * The variable below is set to 1 if an error occurs anywhere - * while reading in the file. + * 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. + * 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 procedures defined in this file: + * Prototypes for functions defined in this file: */ static void DoMacro(char *line); @@ -75,27 +74,27 @@ static void QuoteText(char *string, int count); * * main -- * - * This procedure is the main program, which does all of the work - * of the program. + * 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. + * 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. + * A Tcl script is output to standard output. Error messages may be + * output on standard error. * *---------------------------------------------------------------------- */ int -main(argc, argv) - int argc; /* Number of command-line arguments. */ - char **argv; /* Values of command-line arguments. */ +main( + int argc, /* Number of command-line arguments. */ + char **argv) /* Values of command-line arguments. */ { FILE *f; -#define MAX_LINE_SIZE 1000 +#define MAX_LINE_SIZE 4000 char line[MAX_LINE_SIZE]; char *p; @@ -117,10 +116,10 @@ main(argc, argv) } /* - * 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. + * 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++) { @@ -134,15 +133,15 @@ main(argc, argv) } } lineNumber++; - - if ((line[0] == '\'') && (line[1] == '\\') && (line[2] == '\"')) { - /* - * This line is a comment. Ignore it. + + 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); @@ -153,14 +152,14 @@ main(argc, argv) /* * This line is a macro invocation. */ - + DoMacro(line); } else { /* * This line is text, possibly with formatting characters * embedded in it. */ - + DoText(line); } } @@ -177,9 +176,9 @@ main(argc, argv) * * DoMacro -- * - * This procedure is called to handle a macro invocation. - * It parses the arguments to the macro and generates a - * Tcl command to handle the invocation. + * 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. @@ -191,11 +190,12 @@ main(argc, argv) */ static void -DoMacro(line) - char *line; /* The line of text that contains the - * macro invocation. */ +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. @@ -205,13 +205,9 @@ DoMacro(line) return; } - if (writeOutput) { - printf("macro"); - } + PRINT(("macro")); if (*line != '.') { - if (writeOutput) { - printf("2"); - } + PRINT(("2")); } /* @@ -220,10 +216,8 @@ DoMacro(line) p = line+1; while (1) { - if (writeOutput) { - putc(' ', stdout); - } - if (*p == '"') { + PRINTC(' '); + if (*p == '"') { /* * The argument is delimited by quotes. */ @@ -231,16 +225,19 @@ DoMacro(line) for (end = p+1; *end != '"'; end++) { if (*end == 0) { fprintf(stderr, - "Unclosed quote in macro call on line %d.\n", - lineNumber); + "Unclosed quote in macro call on line %d.\n", + lineNumber); status = 1; break; } } QuoteText(p+1, (end-(p+1))); } else { - for (end = p+1; (*end != 0) && !isspace(*end); end++) { - /* Empty loop body. */ + quote = 0; + for (end = p+1; (*end != 0) && (quote || !isspace(*end)); end++) { + if (*end == '\'') { + quote = !quote; + } } QuoteText(p, end-p); } @@ -259,9 +256,7 @@ DoMacro(line) break; } } - if (writeOutput) { - putc('\n', stdout); - } + PRINTC('\n'); } /* @@ -269,9 +264,9 @@ DoMacro(line) * * DoText -- * - * This procedure is called to handle a line of troff text. - * It parses the text, generating Tcl commands for text and - * for formatting stuff such as font changes. + * 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. @@ -283,22 +278,20 @@ DoMacro(line) */ static void -DoText(line) - char *line; /* The line of text. */ +DoText( + char *line) /* The line of text. */ { char *p, *end; /* - * Divide the line up into pieces consisting of backslash sequences, - * tabs, and other text. + * Divide the line up into pieces consisting of backslash sequences, tabs, + * and other text. */ p = line; while (*p != 0) { if (*p == '\t') { - if (writeOutput) { - printf("tab\n"); - } + PRINT(("tab\n")); p++; } else if (*p != '\\') { /* @@ -308,19 +301,15 @@ DoText(line) for (end = p+1; (*end != '\\') && (*end != 0); end++) { /* Empty loop body. */ } - if (writeOutput) { - printf("text "); - } + PRINT(("text ")); QuoteText(p, end-p); - if (writeOutput) { - putc('\n', stdout); - } + 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. + * A backslash sequence. There are particular ones that we + * understand; output an error message for anything else and just + * ignore the backslash. */ p++; @@ -329,49 +318,46 @@ DoText(line) * Font change. */ - if (writeOutput) { - printf("font %c\n", p[1]); - } + PRINT(("font %c\n", p[1])); p += 2; } else if (*p == '-') { - if (writeOutput) { - printf("dash\n"); - } + PRINT(("dash\n")); p++; } else if (*p == 'e') { - if (writeOutput) { - printf("text \\\\\n"); - } + PRINT(("text \\\\\n")); p++; } else if (*p == '.') { - if (writeOutput) { - printf("text .\n"); - } + 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 { - if (writeOutput) { - printf("char {\\(%c%c}\n", p[1], p[2]); - } + 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) { - if (writeOutput) { - printf("char {\\%c}\n", *p); - } + PRINT(("char {\\%c}\n", *p)); p++; } } } - if (writeOutput) { - printf("newline\n"); - } + PRINT(("newline\n")); } /* @@ -379,9 +365,9 @@ DoText(line) * * 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. + * 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. @@ -393,26 +379,46 @@ DoText(line) */ static void -QuoteText(string, count) - char *string; /* The line of text. */ - int count; /* Number of characters to write from string. */ +QuoteText( + char *string, /* The line of text. */ + int count) /* Number of characters to write from + * string. */ { if (count == 0) { - if (writeOutput) { - printf("{}"); - } + PRINT(("{}")); return; } for ( ; count > 0; string++, count--) { - if ((*string == '$') || (*string == '[') || (*string == '{') - || (*string == ' ') || (*string == ';') || (*string == '\\') - || (*string == '"') || (*string == '\t')) { - if (writeOutput) { - putc('\\', stdout); + 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; } - } - if (writeOutput) { - putc(*string, stdout); + case '$': case '[': case '{': case ' ': case ';': + case '"': case '\t': + PRINTC('\\'); + default: + PRINTC(*string); } } } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/tools/mkdepend.tcl b/tools/mkdepend.tcl new file mode 100644 index 0000000..de5fdba --- /dev/null +++ b/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 diff --git a/tools/regexpTestLib.tcl b/tools/regexpTestLib.tcl index d43cd4e..d84a012 100644 --- a/tools/regexpTestLib.tcl +++ b/tools/regexpTestLib.tcl @@ -5,9 +5,6 @@ # Spencer's test suite to tcl test files. # # Copyright (c) 1996 by Sun Microsystems, Inc. -# -# SCCS: @(#) regexpTestLib.tcl 1.4 98/01/22 14:48:34 -# proc readInputFile {} { global inFileName @@ -46,7 +43,7 @@ proc readInputFile {} { # # strings with embedded @'s are truncated # unpreceeded @'s are replaced by {} -# +# proc removeAts {ls} { set len [llength $ls] set newLs {} @@ -97,7 +94,7 @@ proc writeOutputFile {numLines fcn} { global outFileName global lineArray - # open output file and write file header info to it. + # open output file and write file header info to it. set fileId [open $outFileName w] @@ -136,7 +133,7 @@ proc writeOutputFile {numLines fcn} { puts $fileId $currentLine incr srcLineNum $lineArray(c$lineNum) incr lineNum - continue + continue } set len [llength $currentLine] @@ -147,7 +144,7 @@ proc writeOutputFile {numLines fcn} { puts $fileId "\n" incr srcLineNum $lineArray(c$lineNum) incr lineNum - continue + continue } if {($len < 3)} { puts "warning: test is too short --\n\t$currentLine" @@ -212,21 +209,21 @@ proc convertTestLine {currentLine len lineNum srcLineNum} { 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 { @@ -243,7 +240,7 @@ proc convertTestLine {currentLine len lineNum srcLineNum} { } } else { # no match is made - + set result "\{0 0\}" } @@ -251,16 +248,16 @@ proc convertTestLine {currentLine len lineNum srcLineNum} { set cmd [prepareCmd $flags $re $str $vars $noBraces] if {$cmd == -1} { - return "\# skipping test with metasyntax from line $srcLineNum\n" + 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" + 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 } diff --git a/tools/str2c b/tools/str2c index 15cb8e6..cff7ba2 100644 --- a/tools/str2c +++ b/tools/str2c @@ -4,10 +4,8 @@ # # 1997/10 -- dl # -# $Id: str2c,v 1.2 1999/04/16 00:47:40 stanton Exp $ -# # restart with tclsh \ -exec tclsh8.0 "$0" "$@" +exec tclsh "$0" ${1+"$@"} # Max string length # (some C compiler have a 2048 chars limits (so 2047 real chars with @@ -38,7 +36,7 @@ static char data\[\]=\"[translate $r]\";" puts "/* * Multi parts read only string generated by str2c */ -static CONST char * CONST data\[\]= {" +static const char * const data\[\]= {" set n 1 for {set i 0} {$i<$lg} {incr i $MAX} { set part [string range $r $i [expr $i+$MAX-1]] @@ -50,7 +48,7 @@ static CONST char * CONST data\[\]= {" } puts "\tNULL\t/* End of data marker */\n};" puts "\n/* use for instance with: - CONST char * CONST *chunk; + const char * const *chunk; for (chunk=data; *chunk; chunk++) { Tcl_AppendResult(interp, *chunk, (char *) NULL); } diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in index 0d01f35..3bdccbe 100644 --- a/tools/tcl.hpj.in +++ b/tools/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl85.cnt +CNT=tcl86.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl85.hlp +HLP=tcl86.hlp [FILES] tcl.rtf diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in deleted file mode 100644 index f079ee5..0000000 --- a/tools/tcl.wse.in +++ /dev/null @@ -1,2376 +0,0 @@ -Document Type: WSE -item: Global - Version=6.01 - Title=Tcl 8.5 for Windows Installation - Flags=00010100 - Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - Japanese Font Name=MS Gothic - Japanese Font Size=10 - Start Gradient=0 0 255 - End Gradient=0 0 0 - Windows Flags=00000000000000010010110000001000 - Log Pathname=%MAINDIR%\INSTALL.LOG - Message Font=MS Sans Serif - Font Size=8 - Disk Label=tcl8.5a4 - Disk Filename=setup - Patch Flags=0000000000000001 - Patch Threshold=85 - Patch Memory=4000 - Variable Name1=_SYS_ - Variable Default1=C:\WINDOWS\SYSTEM - Variable Flags1=00001000 - Variable Name2=_ODBC16_ - Variable Default2=C:\WINDOWS\SYSTEM - Variable Flags2=00001000 - Variable Name3=_WISE_ - Variable Default3=${__WISE__} - Variable Flags3=00001000 -end -item: Open/Close INSTALL.LOG - Flags=00000001 -end -item: Check if File/Dir Exists - Pathname=%SYS% - Flags=10000100 -end -item: Set Variable - Variable=SYS - Value=%WIN% -end -item: End Block -end -item: Set Variable - Variable=VER - Value=8.5 -end -item: Set Variable - Variable=PATCHLEVEL - Value=${__TCL_PATCH_LEVEL__} -end -item: Set Variable - Variable=APPTITLE - Value=Tcl/Tk %PATCHLEVEL% for Windows -end -item: Set Variable - Variable=URL - Value=http://www.tcl.tk/ -end -item: Set Variable - Variable=GROUP - Value=Tcl -end -item: Set Variable - Variable=DISABLED - Value=! -end -item: Set Variable - Variable=MAINDIR - Value=Tcl -end -item: Check Configuration - Flags=10111011 -end -item: Get Registry Key Value - Variable=PROGRAM_FILES - Key=SOFTWARE\Microsoft\Windows\CurrentVersion - Default=C:\Program Files - Value Name=ProgramFilesDir - Flags=00000100 -end -item: Set Variable - Variable=MAINDIR - Value=%PROGRAM_FILES%\%MAINDIR% -end -item: Set Variable - Variable=EXPLORER - Value=1 -end -item: Else Statement -end -item: Set Variable - Variable=MAINDIR - Value=C:\%MAINDIR% -end -item: End Block -end -item: Set Variable - Variable=BACKUP - Value=%MAINDIR%\BACKUP -end -item: Set Variable - Variable=DOBACKUP - Value=B -end -item: Set Variable - Variable=BRANDING - Value=0 -end -remarked item: If/While Statement - Variable=BRANDING - Value=1 -end -remarked item: Read INI Value - Variable=NAME - Pathname=%INST%\CUSTDATA.INI - Section=Registration - Item=Name -end -remarked item: Read INI Value - Variable=COMPANY - Pathname=%INST%\CUSTDATA.INI - Section=Registration - Item=Company -end -remarked item: If/While Statement - Variable=NAME -end -remarked item: Set Variable - Variable=DOBRAND - Value=1 -end -remarked item: End Block -end -remarked item: End Block -end -item: Set Variable - Variable=TYPE - Value=C -end -item: Set Variable - Variable=COMPONENTS - Value=ABC -end -item: Wizard Block - Direction Variable=DIRECTION - Display Variable=DISPLAY - X Position=0 - Y Position=0 - Filler Color=8421440 - Flags=00000001 -end -item: Custom Dialog Set - Name=Splash - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Bienvenue - Title German=Willkommen - Title Portuguese=Bem-vindo - Title Spanish=Bienvenido - Title Italian=Benvenuto - Title Danish=Velkommen - Title Dutch=Welkom - Title Norwegian=Velkommen - Title Swedish=Välkommen - Width=273 - Height=250 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=166 214 208 228 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - end - item: Push Button - Rectangle=212 214 254 228 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=Cancel - end - item: Static - Rectangle=0 0 268 233 - Action=2 - Enabled Color=00000000000000001111111111111111 - Create Flags=01010000000000000000000000001011 - Pathname=${__TCLBASEDIR__}\tools\white.bmp - end - item: Static - Rectangle=5 5 268 215 - Destination Dialog=1 - Action=2 - Enabled Color=00000000000000001111111111111111 - Create Flags=01010000000000000000000000001011 - Pathname=${__TCLBASEDIR__}\tools\tclSplash.bmp - end - end -end -item: End Block -end -item: Wizard Block - Direction Variable=DIRECTION - Display Variable=DISPLAY - Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP - X Position=9 - Y Position=10 - Filler Color=8421440 - Dialog=Welcome - Dialog=Select Destination Directory - Dialog=Select Installation Type - Dialog=Select Components - Dialog=Select Program Manager Group - Variable= - Variable= - Variable= - Variable=TYPE - Variable=EXPLORER - Value= - Value= - Value= - Value=C - Value=1 - Compare=0 - Compare=0 - Compare=0 - Compare=1 - Compare=0 - Flags=00000011 -end -item: Custom Dialog Set - Name=Welcome - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Welcome! - Text French=Bienvenue ! - Text German=Willkommen! - Text Spanish=¡Bienvenido! - Text Italian=Benvenuti! - end - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DISABLED - Value=! - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=85 41 255 130 - Create Flags=01010000000000000000000000000000 - Text=This installation program will install %APPTITLE%. - Text= - Text=Press the Next button to start the installation. You can press the Exit Setup button now if you do not want to install %APPTITLE% at this time. - Text= - Text=It is strongly recommended that you exit all Windows programs before running this installation program. - Text French=Ce programme d'installation va installer %APPTITLE%. - Text French= - Text French=Cliquez sur le bouton Suite pour démarrer l'installation. Vous pouvez cliquer sur le bouton Quitter l'installation si vous ne voulez pas installer %APPTITLE% tout de suite. - Text German=Mit diesem Installationsprogramm wird %APPTITLE% installiert. - Text German= - Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Abbrechen", um die Installation von %APPTITLE% abzubrechen. - Text Spanish=Este programa de instalación instalará %APPTITLE%. - Text Spanish= - Text Spanish=Presione el botón Siguiente para iniciar la instalación. Puede presionar el botón Salir de instalación si no desea instalar %APPTITLE% en este momento. - Text Italian=Questo programma installerà %APPTITLE%. - Text Italian= - Text Italian=Per avvviare l'installazione premere il pulsante Avanti. Se non si desidera installare %APPTITLE% ora, premere il pulsante Esci dall'installazione. - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - end -end -item: Custom Dialog Set - Name=Select Destination Directory - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Flags=0000000000000001 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Select Destination Directory - Text French=Sélectionner le répertoire de destination - Text German=Zielverzeichnis wählen - Text Spanish=Seleccione el directorio de destino - Text Italian=Selezionare Directory di destinazione - end - item: Static - Rectangle=86 39 256 114 - Create Flags=01010000000000000000000000000000 - Text=Please select the directory where the %APPTITLE% files are to be installed. - Text= - Text=To install in the default directory below, click Next. - Text= - Text=To install in a different directory, click Browse and select another directory. - Text French=Veuillez sélectionner le répertoire dans lequel les fichiers %APPTITLE% doivent être installés. - Text German=Geben Sie an, in welchem Verzeichnis die %APPTITLE%-Dateien installiert werden sollen. - Text Spanish=Por favor seleccione el directorio donde desee instalar los archivos de %APPTITLE%. - Text Italian=Selezionare la directory dove verranno installati i file %APPTITLE%. - end - item: Static - Rectangle=86 130 256 157 - Action=1 - Create Flags=01010000000000000000000000000111 - end - item: Push Button - Rectangle=205 138 250 153 - Variable=MAINDIR_SAVE - Value=%MAINDIR% - Destination Dialog=1 - Action=2 - Create Flags=01010000000000010000000000000000 - Text=Browse - Text French=Parcourir - Text German=Durchsuchen - Text Spanish=Buscar - Text Italian=Sfoglie - end - item: Static - Rectangle=91 140 198 151 - Create Flags=01010000000000000000000000000000 - Text=%MAINDIR% - Text French=%MAINDIR% - Text German=%MAINDIR% - Text Spanish=%MAINDIR% - Text Italian=%MAINDIR% - end - end - item: Dialog - Title=Select Destination Directory - Title French=Sélectionner le répertoire de destination - Title German=Zielverzeichnis wählen - Title Spanish=Seleccione el directorio de destino - Title Italian=Selezionare Directory di destinazione - Width=221 - Height=173 - Font Name=Helv - Font Size=8 - item: Listbox - Rectangle=5 5 163 149 - Variable=MAINDIR - Create Flags=01010000100000010000000101000000 - Flags=0000110000100010 - Text=%MAINDIR% - Text French=%MAINDIR% - Text German=%MAINDIR% - Text Spanish=%MAINDIR% - Text Italian=%MAINDIR% - end - item: Push Button - Rectangle=167 6 212 21 - Create Flags=01010000000000010000000000000001 - Text=OK - Text French=OK - Text German=OK - Text Spanish=Aceptar - Text Italian=OK - end - item: Push Button - Rectangle=167 25 212 40 - Variable=MAINDIR - Value=%MAINDIR_SAVE% - Create Flags=01010000000000010000000000000000 - Flags=0000000000000001 - Text=Cancel - Text French=Annuler - Text German=Abbrechen - Text Spanish=Cancelar - Text Italian=Annulla - end - end -end -remarked item: Custom Dialog Set - Name=Select Installation Type - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Select Installation Type - Text French=Sélectionner les composants - Text German=Komponenten auswählen - Text Spanish=Seleccione componentes - Text Italian=Selezionare i componenti - end - item: Static - Rectangle=194 162 242 172 - Variable=COMPONENTS - Value=MAINDIR - Create Flags=01010000000000000000000000000010 - end - item: Static - Rectangle=194 153 242 162 - Variable=COMPONENTS - Create Flags=01010000000000000000000000000010 - end - item: Static - Rectangle=107 153 196 164 - Create Flags=01010000000000000000000000000000 - Text=Disk Space Required: - Text French=Espace disque requis : - Text German=Notwendiger Speicherplatz: - Text Spanish=Espacio requerido en el disco: - Text Italian=Spazio su disco necessario: - end - item: Static - Rectangle=107 162 196 172 - Create Flags=01010000000000000000000000000000 - Text=Disk Space Remaining: - Text French=Espace disque disponible : - Text German=Verbleibender Speicherplatz: - Text Spanish=Espacio en disco disponible: - Text Italian=Spazio su disco disponibile: - end - item: Static - Rectangle=86 145 256 175 - Action=1 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 42 256 61 - Create Flags=01010000000000000000000000000000 - Text=Choose which type of installation to perform by selecting one of the buttons below. - Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous. - Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken. - Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo. - Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti. - end - item: Radio Button - Rectangle=86 74 256 128 - Variable=TYPE - Create Flags=01010000000000010000000000001001 - Text=&Full Installation (Recommended) - Text=&Minimal Installation - Text=C&ustom Installation - Text= - end - end -end -item: Custom Dialog Set - Name=Select Components - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Select Components - Text French=Sélectionner les composants - Text German=Komponenten auswählen - Text Spanish=Seleccione componentes - Text Italian=Selezionare i componenti - end - item: Checkbox - Rectangle=86 75 256 129 - Variable=COMPONENTS - Create Flags=01010000000000010000000000000011 - Flags=0000000000000110 - Text=Tcl Run-Time Files - Text=Example Scripts - Text=Help Files - Text=Header and Library Files - Text= - Text French=Tcl Run-Time Files - Text French=Example Scripts - Text French=Help Files - Text French=Header and Library Files - Text French= - Text German=Tcl Run-Time Files - Text German=Example Scripts - Text German=Help Files - Text German=Header and Library Files - Text German= - Text Spanish=Tcl Run-Time Files - Text Spanish=Example Scripts - Text Spanish=Help Files - Text Spanish=Header and Library Files - Text Spanish= - Text Italian=Tcl Run-Time Files - Text Italian=Example Scripts - Text Italian=Help Files - Text Italian=Header and Library Files - Text Italian= - end - item: Static - Rectangle=194 162 242 172 - Variable=COMPONENTS - Value=MAINDIR - Create Flags=01010000000000000000000000000010 - end - item: Static - Rectangle=194 153 242 162 - Variable=COMPONENTS - Create Flags=01010000000000000000000000000010 - end - item: Static - Rectangle=107 153 196 164 - Create Flags=01010000000000000000000000000000 - Text=Disk Space Required: - Text French=Espace disque requis : - Text German=Notwendiger Speicherplatz: - Text Spanish=Espacio requerido en el disco: - Text Italian=Spazio su disco necessario: - end - item: Static - Rectangle=107 162 196 172 - Create Flags=01010000000000000000000000000000 - Text=Disk Space Remaining: - Text French=Espace disque disponible : - Text German=Verbleibender Speicherplatz: - Text Spanish=Espacio en disco disponible: - Text Italian=Spazio su disco disponibile: - end - item: Static - Rectangle=86 145 256 175 - Action=1 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 42 256 61 - Create Flags=01010000000000000000000000000000 - Text=Choose which components to install by checking the boxes below. - Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous. - Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken. - Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo. - Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti. - end - end -end -item: Custom Dialog Set - Name=Select Program Manager Group - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Flags=0000000000000001 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Select ProgMan Group - Text French=Sélectionner le groupe du Gestionnaire de programme - Text German=Bestimmung der Programm-Managergruppe - Text Spanish=Seleccione grupo del Administrador de programas - Text Italian=Selezionare il gruppo ProgMan - end - item: Static - Rectangle=86 44 256 68 - Create Flags=01010000000000000000000000000000 - Text=Enter the name of the Program Manager group to add the %APPTITLE% icons to: - Text French=Entrez le nom du groupe du Gestionnaire de programme dans lequel vous souhaitez ajouter les icônes de %APPTITLE% : - Text German=Geben Sie den Namen der Programmgruppe ein, der das Symbol %APPTITLE% hinzugefügt werden soll: - Text Spanish=Escriba el nombre del grupo del Administrador de programas en el que desea agregar los iconos de %APPTITLE%: - Text Italian=Inserire il nome del gruppo Program Manager per aggiungere le icone %APPTITLE% a: - end - item: Combobox - Rectangle=86 69 256 175 - Variable=GROUP - Create Flags=01010000000000010000001000000001 - Flags=0000000000000001 - Text=%GROUP% - Text French=%GROUP% - Text German=%GROUP% - Text Spanish=%GROUP% - Text Italian=%GROUP% - end - end -end -item: Custom Dialog Set - Name=Start Installation - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Ready to Install! - Text French=Prêt à installer ! - Text German=Installationsbereit! - Text Spanish=¡Preparado para la instalación! - Text Italian=Pronto per l'installazione! - end - item: Static - Rectangle=86 42 256 102 - Create Flags=01010000000000000000000000000000 - Text=You are now ready to install %APPTITLE%. - Text= - Text=Press the Next button to begin the installation or the Back button to reenter the installation information. - Text French=Vous êtes maintenant prêt à installer les fichiers %APPTITLE%. - Text French= - Text French=Cliquez sur le bouton Suite pour commencer l'installation ou sur le bouton Retour pour entrer les informations d'installation à nouveau. - Text German=Sie können %APPTITLE% nun installieren. - Text German= - Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Zurück", um die Installationsinformationen neu einzugeben. - Text Spanish=Ya está listo para instalar %APPTITLE%. - Text Spanish= - Text Spanish=Presione el botón Siguiente para comenzar la instalación o presione Atrás para volver a ingresar la información para la instalación. - Text Italian=Ora è possibile installare %APPTITLE%. - Text Italian= - Text Italian=Premere il pulsante Avanti per avviare l'installazione o il pulsante Indietro per reinserire le informazioni di installazione. - end - end -end -item: If/While Statement - Variable=DISPLAY - Value=Select Destination Directory -end -item: Set Variable - Variable=BACKUP - Value=%MAINDIR%\BACKUP -end -item: End Block -end -item: End Block -end -item: If/While Statement - Variable=TYPE - Value=B -end -item: Set Variable - Variable=COMPONENTS - Value=A -end -item: End Block -end -item: If/While Statement - Variable=DOBACKUP - Value=A -end -item: Set Variable - Variable=BACKUPDIR - Value=%BACKUP% -end -item: End Block -end -remarked item: If/While Statement - Variable=BRANDING - Value=1 -end -remarked item: If/While Statement - Variable=DOBRAND - Value=1 -end -remarked item: Edit INI File - Pathname=%INST%\CUSTDATA.INI - Settings=[Registration] - Settings=NAME=%NAME% - Settings=COMPANY=%COMPANY% - Settings= -end -remarked item: End Block -end -remarked item: End Block -end -item: Set Variable - Variable=MAINDIRSHORT - Value=%MAINDIR% - Flags=00010100 -end -item: Open/Close INSTALL.LOG -end -item: Check Disk Space - Component=COMPONENTS -end -item: Install File - Source=${__TCLBASEDIR__}\license.txt - Destination=%MAINDIR%\license.txt - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\Readme.txt - Destination=%MAINDIR%\Readme.txt - Flags=0000000000000010 -end -item: If/While Statement - Variable=COMPONENTS - Value=D - Flags=00001010 -end -item: Install File - Source=${__TKBASEDIR__}\win\release\tk85.lib - Destination=%MAINDIR%\lib\tk85.lib - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\win\release\tkstub85.lib - Destination=%MAINDIR%\lib\tkstub85.lib - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tcl85.lib - Destination=%MAINDIR%\lib\tcl85.lib - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tclstub85.lib - Destination=%MAINDIR%\lib\tclstub85.lib - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\Xutil.h - Destination=%MAINDIR%\include\X11\Xutil.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\Xlib.h - Destination=%MAINDIR%\include\X11\Xlib.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\Xfuncproto.h - Destination=%MAINDIR%\include\X11\Xfuncproto.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\Xatom.h - Destination=%MAINDIR%\include\X11\Xatom.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\X.h - Destination=%MAINDIR%\include\X11\X.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\keysymdef.h - Destination=%MAINDIR%\include\X11\keysymdef.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\keysym.h - Destination=%MAINDIR%\include\X11\keysym.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\cursorfont.h - Destination=%MAINDIR%\include\X11\cursorfont.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\generic\tk.h - Destination=%MAINDIR%\include\tk.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\generic\tkDecls.h - Destination=%MAINDIR%\include\tkDecls.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\generic\tkPlatDecls.h - Destination=%MAINDIR%\include\tkPlatDecls.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\generic\tkIntXlibDecls.h - Destination=%MAINDIR%\include\tkIntXlibDecls.h - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\generic\tcl.h - Destination=%MAINDIR%\include\tcl.h - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\generic\tclDecls.h - Destination=%MAINDIR%\include\tclDecls.h - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\generic\tclPlatDecls.h - Destination=%MAINDIR%\include\tclPlatDecls.h - Flags=0000000000000010 -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\msgcat\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.4\pkgIndex.tcl - Flags=0000000010000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\msgcat\msgcat.tcl - Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.4\msgcat.tcl - Flags=0000000010000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\tcltest\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\tcltest\tcltest.tcl - Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\tcltest.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\symbol.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\symbol.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\shiftjis.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\shiftjis.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macUkraine.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macUkraine.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macTurkish.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macTurkish.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macThai.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macThai.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macRomania.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRomania.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macRoman.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRoman.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macJapan.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macJapan.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macIceland.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macIceland.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macGreek.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macGreek.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macDingbats.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macDingbats.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macCyrillic.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCyrillic.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macCroatian.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCroatian.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macCentEuro.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCentEuro.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\ksc5601.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\ksc5601.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\koi8-r.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\koi8-r.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\jis0212.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0212.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\jis0208.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0208.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\jis0201.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0201.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-15.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-15.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-9.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-9.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-8.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-8.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-7.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-7.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-6.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-6.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-5.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-5.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-4.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-4.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-3.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-3.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-2.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-2.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-1.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-1.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso2022.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso2022-kr.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-kr.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso2022-jp.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-jp.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\gb2312.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb2312.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\gb1988.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb1988.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\gb12345.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb12345.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\euc-cn.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-cn.enc - Flags=0000000010000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\euc-jp.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-jp.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\euc-kr.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-kr.enc - Flags=0000000010000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\dingbats.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\dingbats.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp950.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp950.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp949.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp949.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp936.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp936.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp932.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp932.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp874.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp874.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp869.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp869.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp866.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp866.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp865.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp865.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp864.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp864.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp863.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp863.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp862.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp862.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp861.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp861.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp860.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp860.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp857.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp857.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp855.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp855.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp852.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp852.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp850.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp850.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp775.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp775.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp737.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp737.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp437.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp437.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1258.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1258.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1257.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1257.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1256.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1256.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1255.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1255.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1254.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1254.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1253.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1253.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1252.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1252.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1251.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1251.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1250.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1250.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\ascii.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\ascii.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\big5.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\big5.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\opt\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\opt\optparse.tcl - Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\http\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\http\http.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\msgbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\optMenu.tcl - Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\clrpick.tcl - Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\entry.tcl - Destination=%MAINDIR%\lib\tk%VER%\entry.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\spinbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\spinbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\comdlg.tcl - Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\bgerror.tcl - Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\obsolete.tcl - Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\button.tcl - Destination=%MAINDIR%\lib\tk%VER%\button.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\xmfbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\console.tcl - Destination=%MAINDIR%\lib\tk%VER%\console.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\listbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\menu.tcl - Destination=%MAINDIR%\lib\tk%VER%\menu.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\dialog.tcl - Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\focus.tcl - Destination=%MAINDIR%\lib\tk%VER%\focus.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\palette.tcl - Destination=%MAINDIR%\lib\tk%VER%\palette.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\tkfbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\tk.tcl - Destination=%MAINDIR%\lib\tk%VER%\tk.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\text.tcl - Destination=%MAINDIR%\lib\tk%VER%\text.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\tearoff.tcl - Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\tclIndex - Destination=%MAINDIR%\lib\tk%VER%\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\scrlbar.tcl - Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\scale.tcl - Destination=%MAINDIR%\lib\tk%VER%\scale.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\safetk.tcl - Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\http1.0\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\http1.0\http.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\reg\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tclreg10.dll - Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg10.dll - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\dde\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tcldde12.dll - Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\tcldde12.dll - Flags=0000000000000010 -end -item: Install File - Source=C:\WINNT\SYSTEM32\Msvcrt.dll - Destination=%MAINDIR%\bin\msvcrt.dll - Flags=0010001000000011 -end -item: Install File - Source=${__TKBASEDIR__}\win\release\wish85.exe - Destination=%MAINDIR%\bin\wish85.exe - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tclsh85.exe - Destination=%MAINDIR%\bin\tclsh85.exe - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tclpip85.dll - Destination=%MAINDIR%\bin\tclpip85.dll - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tcl85.dll - Destination=%MAINDIR%\bin\tcl85.dll - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\win\release\tk85.dll - Destination=%MAINDIR%\bin\tk85.dll - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\auto.tcl - Destination=%MAINDIR%\lib\tcl%VER%\auto.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\history.tcl - Destination=%MAINDIR%\lib\tcl%VER%\history.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\init.tcl - Destination=%MAINDIR%\lib\tcl%VER%\init.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\package.tcl - Destination=%MAINDIR%\lib\tcl%VER%\package.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\parray.tcl - Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\safe.tcl - Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\tclIndex - Destination=%MAINDIR%\lib\tcl%VER%\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\word.tcl - Destination=%MAINDIR%\lib\tcl%VER%\word.tcl - Flags=0000000000000010 -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=B - Flags=00001010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\tai-ku.gif - Destination=%MAINDIR%\lib\tk%VER%\images\tai-ku.gif - Flags=0000000010000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\teapot.ppm - Destination=%MAINDIR%\lib\tk%VER%\demos\images\teapot.ppm - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\tcllogo.gif - Destination=%MAINDIR%\lib\tk%VER%\demos\images\tcllogo.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\pattern.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\pattern.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\noletter.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\noletter.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\letters.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\letters.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\gray25.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\gray25.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\flagup.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagup.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\flagdown.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagdown.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\face.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\face.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\earthris.gif - Destination=%MAINDIR%\lib\tk%VER%\demos\images\earthris.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\earth.gif - Destination=%MAINDIR%\lib\tk%VER%\demos\images\earth.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\vscale.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\vscale.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\twind.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\twind.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\text.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\text.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\style.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\style.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\states.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\states.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\search.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\search.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\sayings.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\sayings.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\ruler.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\ruler.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\radio.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\radio.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\puzzle.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\puzzle.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\plot.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\plot.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\msgbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\msgbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\menubu.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\menubu.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\menu.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\menu.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\label.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\label.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\items.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\items.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\image2.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\image2.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\image1.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\image1.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\icon.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\icon.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\hscale.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\hscale.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\form.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\form.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\ixset - Destination=%MAINDIR%\lib\tk%VER%\demos\ixset.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\rolodex - Destination=%MAINDIR%\lib\tk%VER%\demos\rolodex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\square - Destination=%MAINDIR%\lib\tk%VER%\demos\square.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\Readme - Destination=%MAINDIR%\lib\tk%VER%\demos\Readme - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\hello - Destination=%MAINDIR%\lib\tk%VER%\demos\hello.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\tclIndex - Destination=%MAINDIR%\lib\tk%VER%\demos\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\browse - Destination=%MAINDIR%\lib\tk%VER%\demos\browse.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\timer - Destination=%MAINDIR%\lib\tk%VER%\demos\timer.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\widget - Destination=%MAINDIR%\lib\tk%VER%\demos\widget.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\tcolor - Destination=%MAINDIR%\lib\tk%VER%\demos\tcolor.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\rmt - Destination=%MAINDIR%\lib\tk%VER%\demos\rmt.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\floor.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\floor.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\filebox.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\filebox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo75.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo75.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo200.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo200.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo175.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo175.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo150.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo150.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo100.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo100.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\logoMed.gif - Destination=%MAINDIR%\lib\tk%VER%\images\logoMed.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\logoLarge.gif - Destination=%MAINDIR%\lib\tk%VER%\images\logoLarge.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\logo64.gif - Destination=%MAINDIR%\lib\tk%VER%\images\logo64.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\logo100.gif - Destination=%MAINDIR%\lib\tk%VER%\images\logo100.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\Readme - Destination=%MAINDIR%\lib\tk%VER%\images\Readme - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\arrow.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\arrow.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\bind.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\bind.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\bitmap.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\bitmap.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\button.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\button.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\check.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\check.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\clrpick.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\clrpick.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\colors.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\colors.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\cscroll.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\cscroll.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\ctext.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\ctext.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\dialog1.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\dialog1.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\dialog2.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\dialog2.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\entry1.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\entry1.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\entry2.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\entry2.tcl - Flags=0000000000000010 -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=C - Flags=00001010 -end -item: Install File - Source=${__TCLBASEDIR__}\tools\tcl85.cnt - Destination=%MAINDIR%\doc\tcl85.cnt - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\tools\tcl85.hlp - Destination=%MAINDIR%\doc\tcl85.hlp - Flags=0000000000000010 -end -item: End Block -end -item: Set Variable - Variable=MAINDIR - Value=%MAINDIR% - Flags=00010100 -end -item: Include Script - Pathname=\\pop\tools\1.2\win32-ix86\wise\INCLUDE\uninstal.wse -end -item: Check Configuration - Flags=10111011 -end -item: Get Registry Key Value - Variable=GROUPDIR - Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders - Default=%WIN%\Start Menu\Programs - Value Name=Programs - Flags=00000010 -end -item: Set Variable - Variable=GROUP - Value=%GROUPDIR%\%GROUP% -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Create Shortcut - Source=%MAINDIR%\bin\wish85.exe - Destination=%GROUP%\Wish.lnk - Working Directory=%MAINDIR% -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Create Shortcut - Source=%MAINDIR%\bin\tclsh85.exe - Destination=%GROUP%\Tclsh.lnk - Working Directory=%MAINDIR% - Key Type=1536 - Flags=00000001 -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=C - Flags=00001010 -end -item: Create Shortcut - Source=%MAINDIR%\doc\tcl85.hlp - Destination=%GROUP%\Tcl Help.lnk - Working Directory=%MAINDIR% -end -item: End Block -end -item: Create Shortcut - Source=%MAINDIR%\Readme.txt - Destination=%GROUP%\Readme.lnk - Working Directory=%MAINDIR% -end -item: If/While Statement - Variable=COMPONENTS - Value=B - Flags=00001010 -end -item: Create Shortcut - Source=%MAINDIR%\lib\tk%VER%\demos\widget.tcl - Destination=%GROUP%\Widget Tour.lnk - Working Directory=%MAINDIR% - Key Type=1536 - Flags=00000001 -end -item: End Block -end -item: Else Statement -end -item: If/While Statement - Variable=COMPONENTS - Value=B - Flags=00001010 -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Widget Tour - Command Line=%MAINDIR%\lib\tk%VER%\demos\widget.tcl - Icon Pathname=%MAINDIR%\bin\wish85.exe - Default Directory=%MAINDIR% -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=C - Flags=00001010 -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Tcl Help - Command Line=%MAINDIR%\doc\tcl85.hlp - Default Directory=%MAINDIR% -end -item: End Block -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Readme - Command Line=%MAINDIR%\Readme.txt - Default Directory=%MAINDIR% -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Wish - Command Line=%MAINDIR%\bin\wish85.exe - Default Directory=%MAINDIR% -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Tclsh - Command Line=%MAINDIR%\bin\tclsh85.exe - Default Directory=%MAINDIR% -end -item: End Block -end -item: End Block -end -item: Self-Register OCXs/DLLs - Description=Updating System Configuration, Please Wait... -end -item: Edit Registry - Total Keys=1 - Key=SOFTWARE\Scriptics\Tcl\%VER% - New Value=%MAINDIR% - Value Name=Root - Root=2 -end -item: Edit Registry - Total Keys=1 - Key=TclScript\DefaultIcon - New Value=%MAINDIR%\bin\tk85.dll -end -item: Edit Registry - Total Keys=1 - Key=.tcl - New Value=TclScript -end -item: Edit Registry - Total Keys=1 - Key=TclScript - New Value=TclScript -end -item: Edit Registry - Total Keys=1 - Key=TclScript\shell\open\command - New Value=%MAINDIRSHORT%\bin\wish85.exe "%%1" %%* -end -item: Edit Registry - Total Keys=1 - Key=TclScript\shell\edit - New Value=&Edit -end -item: Edit Registry - Total Keys=1 - Key=TclScript\shell\edit\command - New Value=notepad "%%1" -end -item: Add Directory to Path - Directory=%MAINDIR%\bin -end -item: Check Configuration - Flags=10111011 -end -item: Set Variable - Variable=TO_SCRIPTICS - Value=A -end -item: Else Statement -end -item: Set Variable - Variable=TO_SCRIPTICS -end -item: End Block -end -item: Wizard Block - Direction Variable=DIRECTION - Display Variable=DISPLAY - Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP - X Position=9 - Y Position=10 - Filler Color=8421440 - Flags=00000011 -end -item: Custom Dialog Set - Name=Finished - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Finish - Text French=&Fin - Text German=&Weiter - Text Spanish=&Terminar - Text Italian=&Fine - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DISABLED - Value=! - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Variable=DISABLED - Value=! - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Installation Completed! - Text French=Installation terminée ! - Text German=Die Installation ist abgeschlossen! - Text Spanish=¡Instalación terminada! - Text Italian=Installazione completata! - end - item: Static - Rectangle=86 42 256 153 - Create Flags=01010000000000000000000000000000 - Text=%APPTITLE% has been successfully installed. - Text= - Text=Click the Finish button to exit this installation. - Text= - Text=You can learn more about Tcl/Tk %VER%, including release notes, updates, tutorials, and more at %URL%. Check the box below to start your web browser and go there now. - Text= - Text=The installer may ask you to reboot your computer, this is to update your PATH and is not necessary to do immediately. - Text French=%APPTITLE% est maintenant installé. - Text French= - Text French=Cliquez sur le bouton Fin pour quitter l'installation. - Text German=%APPTITLE% wurde erfolgreich installiert. - Text German= - Text German=Klicken Sie auf "Weiter", um die Installation zu beenden. - Text Spanish=%APPTITLE% se ha instalado con éxito. - Text Spanish= - Text Spanish=Presione el botón Terminar para salir de esta instalación. - Text Italian=L'installazione %APPTITLE% è stata portata a termine con successo. - Text Italian= - Text Italian=Premere il pulsante Fine per uscire dall'installazione. - end - item: Checkbox - Rectangle=88 143 245 157 - Variable=TO_SCRIPTICS - Enabled Color=00000000000000001111111111111111 - Create Flags=01010000000000010000000000000011 - Text=Show me important information about - Text= - end - item: Static - Rectangle=99 156 245 170 - Enabled Color=00000000000000001111111111111111 - Create Flags=01010000000000000000000000000000 - Text=Tcl/Tk %VER% and TclPro - end - end -end -item: End Block -end -item: Check Configuration - Flags=10111011 -end -item: If/While Statement - Variable=TO_SCRIPTICS - Value=A - Flags=00000010 -end -item: Execute Program - Command Line=%URL% -end -item: End Block -end -item: Execute Program - Pathname=explorer - Command Line=%GROUP% -end -item: End Block -end diff --git a/tools/tclSplash.bmp b/tools/tclSplash.bmp Binary files differdeleted file mode 100644 index db8a17e..0000000 --- a/tools/tclSplash.bmp +++ /dev/null diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl index f3750c1..005919a 100755 --- a/tools/tclZIC.tcl +++ b/tools/tclZIC.tcl @@ -12,7 +12,7 @@ # Parameters: # inputDir - Directory (e.g., tzdata2003e) where Olson's source # files are to be found. -# outputDir - Directory (e.g., ../library/clock/tzdata) where +# outputDir - Directory (e.g., ../library/tzdata) where # the time zone information files are to be placed. # # Results: @@ -28,9 +28,6 @@ # 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. -# -# RCS: @(#) $Id: tclZIC.tcl,v 1.5 2005/05/10 18:35:25 kennykb Exp $ -# #---------------------------------------------------------------------- package require Tcl 8.5 @@ -44,10 +41,6 @@ set olsonFiles { pacificnew southamerica systemv } -# Temporary scaffolding - load up the new 'clock' package. - -source [file join [file dirname [info script]] .. library clock.tcl] - # Define the year at which the DST information will stop. set maxyear 2100 @@ -56,7 +49,7 @@ set maxyear 2100 set MAXWIDE [expr {wide(1)}] while 1 { - set next [expr {$MAXWIDE + $MAXWIDE + 1}] + set next [expr {wide($MAXWIDE + $MAXWIDE + 1)}] if {$next < 0} { break } @@ -172,7 +165,7 @@ proc loadZIC {fileName} { # Detect continuations of a zone and flag the list appropriately lappend words "" } - lappend words {expand}[regexp -all -inline {\S+} $line] + lappend words {*}[regexp -all -inline {\S+} $line] # Switch on the directive @@ -365,7 +358,7 @@ proc parseON {on} { # third possibility - lastWeekday - field 5 last([[:alpha:]]+) )$ - } $on -> dom1 wday2 dir2 num2 wday3]} then { + } $on -> dom1 wday2 dir2 num2 wday3]} { error "can't parse ON field \"$on\"" } if {$dom1 ne ""} { @@ -401,8 +394,12 @@ proc parseON {on} { #---------------------------------------------------------------------- proc onDayOfMonth {day year month} { + scan $day %d day + scan $year %d year + scan $month %d month set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ - [dict create era CE year $year month $month dayOfMonth $day]] + [dict create era CE year $year month $month dayOfMonth $day] \ + 2361222] return [dict get $date julianDay] } @@ -435,7 +432,7 @@ proc onDayOfMonth {day year month} { proc onWeekdayInMonth {dayOfWeek relation dayOfMonth year month} { set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ - era CE year $year month $month dayOfMonth $dayOfMonth]] + era CE year $year month $month dayOfMonth $dayOfMonth] 2361222] switch -exact -- $relation { <= { return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ @@ -473,7 +470,7 @@ proc onLastWeekdayInMonth {dayOfWeek year month} { # Find day 0 of the following month, which is the last day of # the current month. Yes, it works to ask for day 0 of month 13! set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ - era CE year $year month $month dayOfMonth 0]] + era CE year $year month $month dayOfMonth 0] 2361222] return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ [dict get $date julianDay]] } @@ -512,7 +509,7 @@ proc parseTOD {tod} { (?: ([wsugz]) # field 4 - type indicator )? - } $tod -> hour minute second ind]} then { + } $tod -> hour minute second ind]} { puts stderr "$fileName:$lno:can't parse time field \"$tod\"" incr errorCount } @@ -561,7 +558,7 @@ proc parseOffsetTime {offset} { :([[:digit:]]{2}) # field 4 - second )? )? - } $offset -> signum hour minute second]} then { + } $offset -> signum hour minute second]} { puts stderr "$fileName:$lno:can't parse offset time \"$offset\"" incr errorCount } @@ -917,7 +914,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset set untilBaseSecs [expr { wide(86400) * wide($untilJCD) - 210866803200 }] set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \ - $DSTOffset {expand}$untilTimeOfDay] + $DSTOffset {*}$untilTimeOfDay] } set origStartSecs $startSecs @@ -943,7 +940,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset if { $earliestSecs > $startSecs && ($until eq "" || $earliestSecs < $untilSecs) - } then { + } { # Test if the initial transition has been done. # If not, do it now. @@ -982,7 +979,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset if {$until ne ""} { set untilSecs [convertTimeOfDay $untilBaseSecs \ - $stdGMTOffset $DSTOffset {expand}$untilTimeOfDay] + $stdGMTOffset $DSTOffset {*}$untilTimeOfDay] } } @@ -990,9 +987,9 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset incr year set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ - [dict create era CE year $year month 1 dayOfMonth 1]] + [dict create era CE year $year month 1 dayOfMonth 1] 2361222] set startSecs [expr { - [dict get $date julianDay] * wide(86400) - 210866803200 + [dict get $date julianDay] * wide(86400) - 210866803200 - $stdGMTOffset - $DSTOffset }] @@ -1084,7 +1081,7 @@ proc findEarliestRule {remainingRules year stdGMTOffset DSTOffset} { set dayIn [eval $daySpecOn] set secs [expr {wide(86400) * wide($dayIn) - 210866803200}] set secs [convertTimeOfDay $secs \ - $stdGMTOffset $DSTOffset {expand}$timeAt] + $stdGMTOffset $DSTOffset {*}$timeAt] if {$secs < $earliest} { set earliest $secs set earliestIdx $i @@ -1158,7 +1155,7 @@ proc convertTimeOfDay {seconds stdGMTOffset DSTOffset timeOfDay flag} { incr seconds [expr {-$stdGMTOffset}] incr seconds [expr {-$DSTOffset}] } - z { + s { incr seconds [expr {-$stdGMTOffset}] } } @@ -1210,7 +1207,7 @@ proc processTimeZone {zoneName zoneData} { set startDay [eval $dayRule] set secs [expr {wide(86400) * wide($startDay) -210866803200}] set secs [convertTimeOfDay $secs \ - $stdGMTOffset $DSTOffset {expand}$timeOfDay] + $stdGMTOffset $DSTOffset {*}$timeOfDay] } lappend dstRule \ $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \ @@ -1268,6 +1265,7 @@ proc writeZones {outDir} { # Write the data to the information file set f [open $fileName w] + fconfigure $f -translation lf puts $f "\# created by $::argv0 - do not edit" puts $f "" puts $f [list set TZData(:$zoneName) $data] @@ -1320,6 +1318,7 @@ proc writeLinks {outDir} { # Write the file set f [open $fileName w] + fconfigure $f -translation lf puts $f "\# created by $::argv0 - do not edit" puts $f $ifCmd puts $f $setCmd @@ -1335,10 +1334,16 @@ proc writeLinks {outDir} { # #---------------------------------------------------------------------- +puts "Compiling time zones -- [clock format [clock seconds] \ + -format {%x %X} -locale system]" + # Determine directories lassign $argv inDir outDir +puts "Olson files in $inDir" +puts "Tcl files to be placed in $outDir" + # Initialize count of errors set errorCount 0 diff --git a/tools/tclmin.wse b/tools/tclmin.wse deleted file mode 100644 index 2fd8185..0000000 --- a/tools/tclmin.wse +++ /dev/null @@ -1,247 +0,0 @@ -Document Type: WSE -item: Global - Version=5.0 - Flags=00000100 - Split=1420 - Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - Japanese Font Name=MS Gothic - Japanese Font Size=10 - Start Gradient=0 0 255 - End Gradient=0 0 0 - Windows Flags=00000000000000010010110000001000 - Message Font=MS Sans Serif - Font Size=8 - Disk Filename=SETUP - Patch Flags=0000000000000001 - Patch Threshold=85 - Patch Memory=4000 -end -item: Remark - Text=------- -end -item: Remark - Text=Tcl 8.0 Minimal Installation -end -item: Remark - Text=------- -end -item: Install File - Source=n:\dist\tcl8.0\library\opt0.4\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\opt0.4\optparse.tcl - Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\http\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\http\http.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\safe.tcl - Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\history.tcl - Destination=%MAINDIR%\lib\tcl%VER%\history.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\msgbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\optMenu.tcl - Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\clrpick.tcl - Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\entry.tcl - Destination=%MAINDIR%\lib\tk%VER%\entry.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\comdlg.tcl - Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\bgerror.tcl - Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\obsolete.tcl - Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\button.tcl - Destination=%MAINDIR%\lib\tk%VER%\button.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\xmfbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\console.tcl - Destination=%MAINDIR%\lib\tk%VER%\console.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\listbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\menu.tcl - Destination=%MAINDIR%\lib\tk%VER%\menu.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\dialog.tcl - Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\focus.tcl - Destination=%MAINDIR%\lib\tk%VER%\focus.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\palette.tcl - Destination=%MAINDIR%\lib\tk%VER%\palette.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\tkfbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\tk.tcl - Destination=%MAINDIR%\lib\tk%VER%\tk.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\text.tcl - Destination=%MAINDIR%\lib\tk%VER%\text.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\tearoff.tcl - Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\tclIndex - Destination=%MAINDIR%\lib\tk%VER%\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\scrlbar.tcl - Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\scale.tcl - Destination=%MAINDIR%\lib\tk%VER%\scale.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\safetk.tcl - Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\http1.0\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\http1.0\http.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\tclreg80.dll - Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg80.dll - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\Tcl1680.dll - Destination=%SYS32%\Tcl1680.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\tcl80.dll - Destination=%SYS32%\tcl80.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\tclpip80.dll - Destination=%SYS32%\tclpip80.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\Bc45\Bin\cw3215.dll - Destination=%SYS32%\cw3215.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\tk8.0\win\tk80.dll - Destination=%SYS32%\tk80.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\tk8.0\win\wish80.exe - Destination=%MAINDIR%\bin\wish80.exe - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\tclsh80.exe - Destination=%MAINDIR%\bin\tclsh80.exe - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\tclIndex - Destination=%MAINDIR%\lib\tcl%VER%\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\init.tcl - Destination=%MAINDIR%\lib\tcl%VER%\init.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\parray.tcl - Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\word.tcl - Destination=%MAINDIR%\lib\tcl%VER%\word.tcl - Flags=0000000000000010 -end diff --git a/tools/tclsh.svg b/tools/tclsh.svg new file mode 100644 index 0000000..34d45a4 --- /dev/null +++ b/tools/tclsh.svg @@ -0,0 +1,67 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<svg + xmlns:dc="http://purl.org/dc/elements/1.1/" + xmlns:cc="http://creativecommons.org/ns#" + xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" + xmlns:svg="http://www.w3.org/2000/svg" + xmlns="http://www.w3.org/2000/svg" + xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" + xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" + width="256" + height="256" + id="svg2309" + sodipodi:version="0.32" + inkscape:version="0.46" + sodipodi:modified="true" + version="1.0" + sodipodi:docname="tcl.svg" + inkscape:output_extension="org.inkscape.output.svg.inkscape" + inkscape:export-filename="tcl.png" + inkscape:export-xdpi="8.4399996" + inkscape:export-ydpi="8.4399996"> + <defs + id="defs2311" /> + <sodipodi:namedview + id="base" + pagecolor="#ffffff" + bordercolor="#666666" + borderopacity="1.0" + gridtolerance="10000" + guidetolerance="10" + objecttolerance="10" + inkscape:pageopacity="0.0" + inkscape:pageshadow="2" + inkscape:zoom="1.8096812" + inkscape:cx="110.83011" + inkscape:cy="132.34375" + inkscape:document-units="px" + inkscape:current-layer="layer1" + inkscape:window-width="993" + inkscape:window-height="669" + inkscape:window-x="5" + inkscape:window-y="49" + showgrid="false" /> + <g + inkscape:label="Layer 1" + inkscape:groupmode="layer" + id="layer1" + transform="translate(-311.79308,-365.73272)"> + <g + id="g2392" + transform="matrix(0.9671783,0,0,0.9671783,10.08245,12.003966)"> + <path + id="path4426" + d="M 499.58925,374.01397 C 499.97085,397.34606 499.27848,420.4264 479.08925,442.35772 L 478.33925,443.20147 L 479.46425,443.20147 L 487.71425,443.32647 C 474.30875,471.21288 465.58677,499.02017 446.308,526.79522 L 445.6205,527.79522 L 446.808,527.57647 L 456.9955,525.63897 C 449.7786,543.94928 437.43792,556.07176 424.058,560.13897 C 420.3754,508.57034 446.11026,463.05191 467.96425,417.67022 C 467.98435,417.62848 468.00666,417.58696 468.02675,417.54522 L 467.21425,416.98272 C 431.42858,456.99623 415.30305,513.43153 409.21425,559.98272 C 397.08579,553.13549 393.04346,544.06962 388.933,531.73272 L 397.40175,535.29522 L 398.27675,535.67022 L 398.08925,534.73272 C 391.65291,506.11299 401.64573,485.57026 411.33925,458.57647 L 418.308,463.23272 L 419.1205,463.79522 L 419.08925,462.82647 C 418.54325,440.89528 433.31028,418.87866 452.90175,399.23272 L 455.6205,406.51397 L 455.9955,407.48272 L 456.52675,406.57647 L 462.4955,396.63897 L 462.52675,396.57647 C 472.37862,383.00695 482.79421,378.58965 499.58925,374.01397 z" + style="opacity:1;fill:#3465a4;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" /> + <path + sodipodi:nodetypes="ccccccccccccccccccccccc" + id="path7600" + d="M 499.59927,374.00103 C 482.86154,378.56724 472.31963,383.0333 462.48689,396.57647 L 462.45564,396.63897 L 456.48689,406.57647 L 455.95564,407.48272 L 455.58064,406.51397 L 452.86189,399.23272 C 433.27042,418.87866 418.50339,440.89528 419.04939,462.82647 L 419.08064,463.79522 L 418.26814,463.23272 L 411.29939,458.57647 C 401.60587,485.57026 391.61305,506.11299 398.04939,534.73272 L 398.23689,535.67022 L 397.36189,535.29522 L 388.98689,531.76397 C 389.01386,531.93545 389.0525,532.09443 389.08064,532.26397 C 393.12974,544.32172 397.22634,553.23735 409.17439,559.98272 C 409.64601,556.37703 410.17162,552.69478 410.76814,548.98272 C 396.17755,514.81858 408.84232,489.70162 414.61189,467.10772 L 423.48689,472.23272 C 422.26097,451.07724 434.68113,428.26233 450.83064,408.35772 L 455.51814,416.60772 C 467.52689,391.90688 477.02451,381.99197 499.59927,374.00103 z" + style="opacity:1;fill:#eeeeec;fill-opacity:1;fill-rule:evenodd;stroke:#eff1cb;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" /> + <path + style="opacity:1;fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" + d="M 505.90485,365.73272 L 505.3736,365.82647 C 485.689,369.25998 466.41815,376.49266 457.96735,393.79522 L 454.40485,387.57647 L 454.09235,387.01397 L 453.6236,387.48272 C 443.92989,396.7586 433.52309,408.77328 425.84235,420.57647 C 418.63263,431.65584 413.85062,442.49956 414.3736,450.79522 L 409.34235,444.51397 L 408.84235,443.88897 L 408.4986,444.60772 C 402.37467,457.83671 396.19429,474.11179 392.4986,489.04522 C 388.9946,503.20407 387.73979,516.09228 390.9986,524.20147 L 382.71735,519.38897 L 382.02985,518.98272 L 381.96735,519.79522 C 380.40824,543.41224 390.00555,554.68855 401.02985,565.57647 L 391.84235,567.85772 L 389.9986,568.32647 L 391.84235,568.82647 C 397.11688,570.2558 402.11758,571.86507 405.59235,574.54522 C 409.06712,577.22537 411.06333,580.91104 410.46735,586.79522 L 410.46735,586.82647 L 410.46735,612.32647 L 410.46735,612.48272 L 410.5611,612.60772 L 422.0611,629.10772 L 422.96735,630.42022 L 422.96735,628.82647 L 422.96735,589.95147 C 424.48916,583.40757 426.27542,578.90352 428.84235,575.92022 C 431.40928,572.93692 434.74946,571.40505 439.52985,570.82647 L 441.2486,570.60772 L 439.6861,569.88897 L 433.6236,567.01397 C 448.07909,558.31023 464.26865,536.97467 468.52985,516.70147 L 468.71735,515.88897 L 467.9361,516.10772 L 460.4361,518.13897 C 467.09909,511.88271 473.81127,499.48743 480.1861,485.04522 C 486.94715,469.72802 493.25982,452.38054 498.4361,438.51397 L 498.71735,437.76397 L 497.9361,437.82647 L 492.15485,438.23272 C 499.30195,430.64691 503.27438,418.11982 505.21735,404.88897 C 507.23962,391.11815 507.0977,376.61792 505.96735,366.26397 L 505.90485,365.73272 z M 500.46735,374.01397 C 500.84895,397.34606 500.15658,420.4264 479.96735,442.35772 L 479.21735,443.20147 L 480.34235,443.20147 L 488.59235,443.32647 C 475.18685,471.21288 466.46487,499.02017 447.1861,526.79522 L 446.4986,527.79522 L 447.6861,527.57647 L 457.8736,525.63897 C 450.6567,543.94928 438.31602,556.07176 424.9361,560.13897 C 421.2535,508.57034 446.98836,463.05191 468.84235,417.67022 C 468.86245,417.62848 468.88476,417.58696 468.90485,417.54522 L 468.09235,416.98272 C 432.30668,456.99623 416.18115,513.43153 410.09235,559.98272 C 397.96389,553.13549 393.92156,544.06962 389.8111,531.73272 L 398.27985,535.29522 L 399.15485,535.67022 L 398.96735,534.73272 C 392.53101,506.11299 402.52383,485.57026 412.21735,458.57647 L 419.1861,463.23272 L 419.9986,463.79522 L 419.96735,462.82647 C 419.42135,440.89528 434.18838,418.87866 453.77985,399.23272 L 456.4986,406.51397 L 456.8736,407.48272 L 457.40485,406.57647 L 463.3736,396.63897 L 463.40485,396.57647 C 473.25672,383.00695 483.67231,378.58965 500.46735,374.01397 z" + id="path2177" /> + </g> + </g> +</svg> diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl new file mode 100644 index 0000000..8fd1245 --- /dev/null +++ b/tools/tcltk-man2html-utils.tcl @@ -0,0 +1,1629 @@ +## +## Utility functions for Man->HTML converter. Note that these +## functions are specifically intended to work with the format as used +## by Tcl and Tk; they do not cope with arbitrary nroff markup. +## +## Copyright (c) 1995-1997 Roger E. Critchlow Jr +## Copyright (c) 2004-2011 Donal K. Fellows + +set ::manual(report-level) 1 + +proc manerror {msg} { + global manual + set name {} + set subj {} + set procname [lindex [info level -1] 0] + if {[info exists manual(name)]} { + set name $manual(name) + } + if {[info exists manual(section)] && [string length $manual(section)]} { + puts stderr "$name: $manual(section): $procname: $msg" + } else { + puts stderr "$name: $procname: $msg" + } +} + +proc manreport {level msg} { + global manual + if {$level < $manual(report-level)} { + uplevel 1 [list manerror $msg] + } +} + +proc fatal {msg} { + global manual + uplevel 1 [list manerror $msg] + exit 1 +} + +## +## templating +## +proc indexfile {} { + if {[info exists ::TARGET] && $::TARGET eq "devsite"} { + return "index.tml" + } else { + return "contents.htm" + } +} + +proc copyright {copyright {level {}}} { + # We don't actually generate a separate copyright page anymore + #set page "${level}copyright.htm" + #return "<A HREF=\"$page\">Copyright</A> © [htmlize-text [lrange $copyright 2 end]]" + # obfuscate any email addresses that may appear in name + set who [string map {@ (at)} [lrange $copyright 2 end]] + return "Copyright © [htmlize-text $who]" +} + +proc copyout {copyrights {level {}}} { + set out "<div class=\"copy\">" + foreach c $copyrights { + append out "[copyright $c $level]\n" + } + append out "</div>" + return $out +} + +proc CSS {{level ""}} { + return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n" +} + +proc DOCTYPE {} { + return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">" +} + +proc htmlhead {title header args} { + set level "" + if {[lindex $args end] eq "../[indexfile]"} { + # XXX hack - assume same level for CSS file + set level "../" + } + set out "[DOCTYPE]\n<HTML>\n<HEAD><TITLE>$title</TITLE>\n[CSS $level]</HEAD>\n" + foreach {uptitle url} $args { + set header "<a href=\"$url\">$uptitle</a> <small>></small> $header" + } + append out "<BODY><H2>$header</H2>" + global manual + if {[info exists manual(subheader)]} { + set subs {} + foreach {name subdir} $manual(subheader) { + if {$name eq $title} { + lappend subs $name + } else { + lappend subs "<A HREF=\"${level}$subdir/[indexfile]\">$name</A>" + } + } + append out "\n<H3>[join $subs { | }]</H3>" + } + return $out +} + +## +## parsing +## +proc unquote arg { + return [string map [list \" {}] $arg] +} + +proc parse-directive {line codename restname} { + upvar 1 $codename code $restname rest + return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest] +} + +proc htmlize-text {text {charmap {}}} { + # contains some extras for use in nroff->html processing + # build on the list passed in, if any + lappend charmap \ + "–" "–" \ + {&} {&} \ + {\\} "\" \ + {\e} "\" \ + {\ } { } \ + {\|} { } \ + {\0} { } \ + \" {"} \ + {<} {<} \ + {>} {>} \ + \u201c "“" \ + \u201d "”" + + return [string map $charmap $text] +} + +proc process-text {text} { + global manual + # preprocess text; note that this is an incomplete map, and will probably + # need to have things added to it as the manuals expand to use them. + set charmap [list \ + {\&} "\t" \ + {\%} {} \ + "\\\n" "\n" \ + {\(+-} "±" \ + {\(co} "©" \ + {\(em} "—" \ + {\(en} "–" \ + {\(fm} "′" \ + {\(mu} "×" \ + {\(mi} "−" \ + {\(->} "<font size=\"+1\">→</font>" \ + {\fP} {\fR} \ + {\.} . \ + {\(bu} "•" \ + {\*(qo} "ô" \ + ] + lappend charmap {\-\|\-} -- ; # two hyphens + lappend charmap {\-} - ; # a hyphen + + set text [htmlize-text $text $charmap] + # General quoted entity + regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text + while {[string first "\\" $text] >= 0} { + # C R + if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \ + {\1<TT>\2</TT>\3} text]} continue + # B R + if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \ + {\1<B>\2</B>\3} text]} continue + # B I + if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \ + {\1<B>\2</B>\\fI\3} text]} continue + # I R + if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \ + {\1<I>\2</I>\3} text]} continue + # I B + if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \ + {\1<I>\2</I>\\fB\3} text]} continue + # B B, I I, R R + if { + [regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \ + {\1\\fB\2\3} ntext] + || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \ + {\1\\fI\2\3} ntext] + || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \ + {\1\\fR\2\3} ntext] + } { + manerror "impotent font change: $text" + set text $ntext + continue + } + # unrecognized + manerror "uncaught backslash: $text" + set text [string map [list "\\" "\"] $text] + } + return $text +} + +## +## pass 2 text input and matching +## +proc open-text {} { + global manual + set manual(text-length) [llength $manual(text)] + set manual(text-pointer) 0 +} + +proc more-text {} { + global manual + return [expr {$manual(text-pointer) < $manual(text-length)}] +} + +proc next-text {} { + global manual + if {[more-text]} { + set text [lindex $manual(text) $manual(text-pointer)] + incr manual(text-pointer) + return $text + } + manerror "read past end of text" + error "fatal" +} + +proc is-a-directive {line} { + return [string match .* $line] +} + +proc split-directive {line opname restname} { + upvar 1 $opname op $restname rest + set op [string range $line 0 2] + set rest [string trim [string range $line 3 end]] +} + +proc next-op-is {op restname} { + global manual + upvar 1 $restname rest + if {[more-text]} { + set text [lindex $manual(text) $manual(text-pointer)] + if {[string equal -length 3 $text $op]} { + set rest [string range $text 4 end] + incr manual(text-pointer) + return 1 + } + } + return 0 +} + +proc backup-text {n} { + global manual + if {$manual(text-pointer)-$n >= 0} { + incr manual(text-pointer) -$n + } +} + +proc match-text args { + global manual + set nargs [llength $args] + if {$manual(text-pointer) + $nargs > $manual(text-length)} { + return 0 + } + set nback 0 + foreach arg $args { + if {![more-text]} { + backup-text $nback + return 0 + } + set arg [string trim $arg] + set targ [string trim [lindex $manual(text) $manual(text-pointer)]] + if {$arg eq $targ} { + incr nback + incr manual(text-pointer) + continue + } + if {[regexp {^@(\w+)$} $arg all name]} { + upvar 1 $name var + set var $targ + incr nback + incr manual(text-pointer) + continue + } + if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\ + && [string equal $op [lindex $targ 0]]} { + upvar 1 $name var + set var [lrange $targ 1 end] + incr nback + incr manual(text-pointer) + continue + } + backup-text $nback + return 0 + } + return 1 +} + +proc expand-next-text {n} { + global manual + return [join [lrange $manual(text) $manual(text-pointer) \ + [expr {$manual(text-pointer)+$n-1}]] \n\n] +} + +## +## pass 2 output +## +proc man-puts {text} { + global manual + lappend manual(output-$manual(wing-file)-$manual(name)) $text +} + +## +## build hypertext links to tables of contents +## +proc long-toc {text} { + global manual + set here M[incr manual(section-toc-n)] + set manual($manual(name)-id-$text) $here + set there L[incr manual(long-toc-n)] + lappend manual(section-toc) \ + "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>" + return "<A NAME=\"$here\">$text</A>" +} + +proc option-toc {name class switch} { + global manual + # Special case handling, oh we hate it but must do it + if {[string match "*OPTIONS" $manual(section)]} { + if {$manual(name) ne "ttk_widget" && ($manual(name) ne "ttk_entry" || + ![string match validate* $name])} { + # link the defined option into the long table of contents + set link [long-toc "$switch, $name, $class"] + regsub -- "$switch, $name, $class" $link "$switch" link + return $link + } + } elseif {"$manual(name):$manual(section)" ne "options:DESCRIPTION"} { + error "option-toc in $manual(name) section $manual(section)" + } + + # link the defined standard option to the long table of contents and make + # a target for the standard option references from other man pages. + + set first [lindex $switch 0] + set here M$first + set there L[incr manual(long-toc-n)] + set manual(standard-option-$manual(name)-$first) \ + "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>" + lappend manual(section-toc) \ + "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>" + return "<A NAME=\"$here\">$switch</A>" +} + +proc std-option-toc {name page} { + global manual + if {[info exists manual(standard-option-$page-$name)]} { + lappend manual(section-toc) <DD>$manual(standard-option-$page-$name) + return $manual(standard-option-$page-$name) + } + manerror "missing reference to \"$name\" in $page.n" + set here M[incr manual(section-toc-n)] + set there L[incr manual(long-toc-n)] + set other M$name + lappend manual(section-toc) "<DD><A HREF=\"$page.htm#$other\">$name</A>" + return "<A HREF=\"$page.htm#$other\">$name</A>" +} + +## +## process the widget option section +## in widget and options man pages +## +proc output-widget-options {rest} { + global manual + man-puts <DL> + lappend manual(section-toc) <DL> + backup-text 1 + set para {} + while {[next-op-is .OP rest]} { + switch -exact -- [llength $rest] { + 3 { + lassign $rest switch name class + } + 5 { + set switch [lrange $rest 0 2] + set name [lindex $rest 3] + set class [lindex $rest 4] + } + default { + fatal "bad .OP $rest" + } + } + if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch \ + all oswitch switch cswitch]} { + if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch \ + all oswitch switch1 switch2 cswitch]} { + error "not Switch: $switch" + } + set switch "$switch1$cswitch or $oswitch$switch2" + } + if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} { + error "not Name: $name" + } + if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} { + error "not Class: $class" + } + man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch" + man-puts "<DT>Database Name: $oname$name$cname" + man-puts "<DT>Database Class: $oclass$class$cclass" + man-puts <DD>[next-text] + set para <P> + + if {[next-op-is .RS rest]} { + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + switch -exact -- $code { + .RE { + break + } + .SH - .SS { + manerror "unbalanced .RS at section end" + backup-text 1 + break + } + default { + output-directive $line + } + } + } else { + man-puts $line + } + } + } + } + man-puts </DL> + lappend manual(section-toc) </DL> +} + +## +## process .RS lists +## +proc output-RS-list {} { + global manual + if {[next-op-is .IP rest]} { + output-IP-list .RS .IP $rest + if {[match-text .RE .sp .RS @rest .IP @rest2]} { + man-puts <P>$rest + output-IP-list .RS .IP $rest2 + } + if {[match-text .RE .sp .RS @rest .RE]} { + man-puts <P>$rest + return + } + if {[next-op-is .RE rest]} { + return + } + } + man-puts <DL><DD> + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + switch -exact -- $code { + .RE { + break + } + .SH - .SS { + manerror "unbalanced .RS at section end" + backup-text 1 + break + } + default { + output-directive $line + } + } + } else { + man-puts $line + } + } + man-puts </DL> +} + +## +## process .IP lists which may be plain indents, +## numeric lists, or definition lists +## +proc output-IP-list {context code rest} { + global manual + if {![string length $rest]} { + # blank label, plain indent, no contents entry + man-puts <DL><DD> + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + if {$code eq ".IP" && $rest eq {}} { + man-puts "<P>" + continue + } + if {$code in {.br .DS .RS}} { + output-directive $line + } else { + backup-text 1 + break + } + } else { + man-puts $line + } + } + man-puts </DL> + } else { + # labelled list, make contents + if {$context ne ".SH" && $context ne ".SS"} { + man-puts <P> + } + set dl "<DL class=\"[string tolower $manual(section)]\">" + set enddl "</DL>" + if {$code eq ".IP"} { + if {[regexp {^\[[\da-f]+\]|\(?[\da-f]+\)$} $rest]} { + set dl "<OL class=\"[string tolower $manual(section)]\">" + set enddl "</OL>" + } elseif {"•" eq $rest} { + set dl "<UL class=\"[string tolower $manual(section)]\">" + set enddl "</UL>" + } + } + man-puts $dl + lappend manual(section-toc) $dl + backup-text 1 + set accept_RE 0 + set para {} + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + switch -exact -- $code { + .IP { + if {$accept_RE} { + output-IP-list .IP $code $rest + continue + } + if {$manual(section) eq "ARGUMENTS"} { + man-puts "$para<DT>$rest<DD>" + } elseif {[regexp {^\[([\da-f]+)\]$} $rest -> value]} { + man-puts "$para<LI value=\"$value\">" + } elseif {[regexp {^\(?([\da-f]+)\)$} $rest -> value]} { + man-puts "$para<LI value=\"$value\">" + } elseif {"•" eq $rest} { + man-puts "$para<LI>" + } else { + man-puts "$para<DT>[long-toc $rest]<DD>" + } + } + .sp - .br - .DS - .CS { + output-directive $line + } + .RS { + if {[match-text .RS]} { + output-directive $line + incr accept_RE 1 + } elseif {[match-text .CS]} { + output-directive .CS + incr accept_RE 1 + } elseif {[match-text .PP]} { + output-directive .PP + incr accept_RE 1 + } elseif {[match-text .DS]} { + output-directive .DS + incr accept_RE 1 + } else { + output-directive $line + } + } + .PP { + if {[match-text @rest1 .br @rest2 .RS]} { + # yet another nroff kludge as above + man-puts "$para<DT>[long-toc $rest1]" + man-puts "<DT>[long-toc $rest2]<DD>" + incr accept_RE 1 + } elseif {[match-text @rest .RE]} { + # gad, this is getting ridiculous + if {!$accept_RE} { + man-puts "$enddl<P>$rest$dl" + backup-text 1 + set para {} + break + } + man-puts "<P>$rest" + incr accept_RE -1 + } elseif {$accept_RE} { + output-directive $line + } else { + backup-text 1 + break + } + } + .RE { + if {!$accept_RE} { + backup-text 1 + break + } + incr accept_RE -1 + } + default { + backup-text 1 + break + } + } + } else { + man-puts $line + } + set para <P> + } + man-puts "$para$enddl" + lappend manual(section-toc) $enddl + if {$accept_RE} { + manerror "missing .RE in output-IP-list" + } + } +} + +## +## handle the NAME section lines +## there's only one line in the NAME section, +## consisting of a comma separated list of names, +## followed by a hyphen and a short description. +## +proc output-name {line} { + global manual + # split name line into pieces + regexp {^([^-]+) - (.*)$} [regsub -all {[ \n\r\t]+} $line " "] -> head tail + # output line to manual page untouched + man-puts "$head — $tail" + # output line to long table of contents + lappend manual(section-toc) "<DL><DD>$head — $tail</DD></DL>" + # separate out the names for future reference + foreach name [split $head ,] { + set name [string trim $name] + if {[llength $name] > 1} { + manerror "name has a space: {$name}\nfrom: $line" + } + lappend manual(wing-toc) $name + lappend manual(name-$name) $manual(wing-file)/$manual(name) + } + set manual(tooltip-$manual(wing-file)/$manual(name).htm) $line +} + +## +## build a cross-reference link if appropriate +## +proc cross-reference {ref} { + global manual remap_link_target + global ensemble_commands exclude_refs_map exclude_when_followed_by_map + set manname $manual(name) + set mantail $manual(tail) + if {[string match "Tcl_*" $ref] || [string match "Tk_*" $ref] || [string match "Ttk_*" $ref] || [string match "Itcl_*" $ref] || [string match "Tdbc_*" $ref]} { + regexp {^\w+} $ref lref + ## + ## apply a link remapping if available + ## + if {[info exists remap_link_target($lref)]} { + set lref $remap_link_target($lref) + } + } elseif {$ref eq "Tcl"} { + set lref $ref + } elseif { + [regexp {^[A-Z0-9 ?!]+$} $ref] + && [info exists manual($manname-id-$ref)] + } { + return "<A HREF=\"#$manual($manname-id-$ref)\">$ref</A>" + } else { + set lref [string tolower $ref] + ## + ## apply a link remapping if available + ## + if {[info exists remap_link_target($lref)]} { + set lref $remap_link_target($lref) + } + } + ## + ## nothing to reference + ## + if {![info exists manual(name-$lref)]} { + foreach name $ensemble_commands { + if { + [regexp "^$name \[a-z0-9]*\$" $lref] && + [info exists manual(name-$name)] && + $mantail ne "$name.n" && + (![info exists exclude_refs_map($mantail)] || + $manual(name-$name) ni $exclude_refs_map($mantail)) + } { + return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>" + } + } + if {$lref in {end}} { + # no good place to send this tcl token? + } + return $ref + } + set manref $manual(name-$lref) + ## + ## would be a self reference + ## + foreach name $manref { + if {"$manual(wing-file)/$manname" in $name} { + return $ref + } + } + ## + ## multiple choices for reference + ## + if {[llength $manref] > 1} { + set tcl_i [lsearch -glob $manref *TclCmd*] + if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd" + || $manual(wing-file) eq "TclLib"} { + set tcl_ref [lindex $manref $tcl_i] + return "<A HREF=\"../$tcl_ref.htm\">$ref</A>" + } + set tk_i [lsearch -glob $manref *TkCmd*] + if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd" + || $manual(wing-file) eq "TkLib"} { + set tk_ref [lindex $manref $tk_i] + return "<A HREF=\"../$tk_ref.htm\">$ref</A>" + } + if {$lref eq "exit" && $mantail eq "tclsh.1" && $tcl_i >= 0} { + set tcl_ref [lindex $manref $tcl_i] + return "<A HREF=\"../$tcl_ref.htm\">$ref</A>" + } + puts stderr "multiple cross reference to $ref in $manref from $manual(wing-file)/$mantail" + return $ref + } + ## + ## exceptions, sigh, to the rule + ## + if {[info exists exclude_when_followed_by_map($mantail)]} { + upvar 1 text tail + set following_word [lindex [regexp -inline {\S+} $tail] 0] + foreach {this that} $exclude_when_followed_by_map($mantail) { + # only a ref if $this is not followed by $that + if {$lref eq $this && [string match $that* $following_word]} { + return $ref + } + } + } + if { + [info exists exclude_refs_map($mantail)] + && $lref in $exclude_refs_map($mantail) + } { + return $ref + } + ## + ## return the cross reference + ## + return "<A HREF=\"../$manref.htm\">$ref</A>" +} + +## +## reference generation errors +## +proc reference-error {msg text} { + global manual + puts stderr "$manual(tail): $msg: {$text}" + return $text +} + +## +## insert as many cross references into this text string as are appropriate +## +proc insert-cross-references {text} { + global manual + set result "" + + while 1 { + ## + ## we identify cross references by: + ## ``quotation'' + ## <B>emboldening</B> + ## Tcl_ prefix + ## Tk_ prefix + ## [a-zA-Z0-9]+ manual entry + ## and we avoid messing with already anchored text + ## + ## + ## find where each item lives - EXPENSIVE - and accumulate a list + ## + unset -nocomplain offsets + foreach {name pattern} { + anchor {<A } end-anchor {</A>} + quote {``} end-quote {''} + bold {<B>} end-bold {</B>} + c.tcl {Tcl_} + c.tk {Tk_} + c.ttk {Ttk_} + c.tdbc {Tdbc_} + c.itcl {Itcl_} + Tcl1 {Tcl manual entry} + Tcl2 {Tcl overview manual entry} + url {http://} + } { + set o [string first $pattern $text] + if {[set offset($name) $o] >= 0} { + set invert($o) $name + lappend offsets $o + } + } + ## + ## if nothing, then we're done. + ## + if {![info exists offsets]} { + return [append result $text] + } + ## + ## sort the offsets + ## + set offsets [lsort -integer $offsets] + ## + ## see which we want to use + ## + switch -exact -- $invert([lindex $offsets 0]) { + anchor { + if {$offset(end-anchor) < 0} { + return [reference-error {Missing end anchor} $text] + } + append result [string range $text 0 $offset(end-anchor)] + set text [string range $text[set text ""] \ + [expr {$offset(end-anchor)+1}] end] + continue + } + quote { + if {$offset(end-quote) < 0} { + return [reference-error "Missing end quote" $text] + } + if {$invert([lindex $offsets 1]) in {tcl tk ttk}} { + set offsets [lreplace $offsets 1 1] + } + switch -exact -- $invert([lindex $offsets 1]) { + end-quote { + append result [string range $text 0 [expr {$offset(quote)-1}]] + set body [string range $text [expr {$offset(quote)+2}] \ + [expr {$offset(end-quote)-1}]] + set text [string range $text[set text ""] \ + [expr {$offset(end-quote)+2}] end] + append result `` [cross-reference $body] '' + continue + } + bold - anchor { + append result [string range $text \ + 0 [expr {$offset(end-quote)+1}]] + set text [string range $text[set text ""] \ + [expr {$offset(end-quote)+2}] end] + continue + } + } + return [reference-error "Uncaught quote case" $text] + } + bold { + if {$offset(end-bold) < 0} { + return [append result $text] + } + if {[string match "c.*" $invert([lindex $offsets 1])]} { + set offsets [lreplace $offsets 1 1] + } + switch -exact -- $invert([lindex $offsets 1]) { + url - end-bold { + append result \ + [string range $text 0 [expr {$offset(bold)-1}]] + set body [string range $text [expr {$offset(bold)+3}] \ + [expr {$offset(end-bold)-1}]] + set text [string range $text[set text ""] \ + [expr {$offset(end-bold)+4}] end] + regsub {http://[\w/.]+} $body {<A HREF="&">&</A>} body + append result <B> [cross-reference $body] </B> + continue + } + anchor { + append result \ + [string range $text 0 [expr {$offset(end-bold)+3}]] + set text [string range $text[set text ""] \ + [expr {$offset(end-bold)+4}] end] + continue + } + default { + return [reference-error "Uncaught bold case" $text] + } + } + } + c.tk - c.ttk - c.tcl - c.tdbc - c.itcl { + append result [string range $text 0 \ + [expr {[lindex $offsets 0]-1}]] + regexp -indices -start [lindex $offsets 0] {\w+} $text range + set body [string range $text {*}$range] + set text [string range $text[set text ""] \ + [expr {[lindex $range 1]+1}] end] + append result [cross-reference $body] + continue + } + Tcl1 - Tcl2 { + set off [lindex $offsets 0] + append result [string range $text 0 [expr {$off-1}]] + set text [string range $text[set text ""] [expr {$off+3}] end] + append result [cross-reference Tcl] + continue + } + url { + set off [lindex $offsets 0] + append result [string range $text 0 [expr {$off-1}]] + regexp -indices -start $off {http://[\w/.]+} $text range + set url [string range $text {*}$range] + append result "<A HREF=\"[string trimright $url .]\">$url</A>" + set text [string range $text[set text ""] \ + [expr {[lindex $range 1]+1}] end] + continue + } + end-anchor - end-bold - end-quote { + return [reference-error "Out of place $invert([lindex $offsets 0])" $text] + } + } + } +} + +## +## process formatting directives +## +proc output-directive {line} { + global manual + # process format directive + split-directive $line code rest + switch -exact -- $code { + .BS - .BE { + # man-puts <HR> + } + .SH - .SS { + # drain any open lists + # announce the subject + set manual(section) $rest + # start our own stack of stuff + set manual($manual(name)-$manual(section)) {} + lappend manual(has-$manual(section)) $manual(name) + if {$code ne ".SS"} { + man-puts "<H3>[long-toc $manual(section)]</H3>" + } else { + man-puts "<H4>[long-toc $manual(section)]</H4>" + } + # some sections can simply free wheel their way through the text + # some sections can be processed in their own loops + switch -exact -- [string index $code end]:$manual(section) { + H:NAME { + set names {} + while {1} { + set line [next-text] + if {[is-a-directive $line]} { + backup-text 1 + if {[llength $names]} { + output-name [join $names { }] + } + return + } + lappend names [string trim $line] + } + } + H:SYNOPSIS { + lappend manual(section-toc) <DL> + while {1} { + if { + [next-op-is .nf rest] + || [next-op-is .br rest] + || [next-op-is .fi rest] + } { + continue + } + if { + [next-op-is .SH rest] + || [next-op-is .SS rest] + || [next-op-is .BE rest] + || [next-op-is .SO rest] + } { + backup-text 1 + break + } + if {[next-op-is .sp rest]} { + #man-puts <P> + continue + } + set more [next-text] + if {[is-a-directive $more]} { + manerror "in SYNOPSIS found $more" + backup-text 1 + break + } + foreach more [split $more \n] { + regexp {^(\s*)(.*)} $more -> spaces more + set spaces [string map {" " " "} $spaces] + if {[string length $spaces]} { + set spaces <TT>$spaces</TT> + } + man-puts $spaces$more<BR> + if {$manual(wing-file) in {TclLib TkLib}} { + lappend manual(section-toc) <DD>$more + } + } + } + lappend manual(section-toc) </DL> + return + } + {H:SEE ALSO} { + while {[more-text]} { + if {[next-op-is .SH rest] || [next-op-is .SS rest]} { + backup-text 1 + return + } + set more [next-text] + if {[is-a-directive $more]} { + manerror "$more" + backup-text 1 + return + } + set nmore {} + foreach cr [split $more ,] { + set cr [string trim $cr] + if {![regexp {^<B>.*</B>$} $cr]} { + set cr <B>$cr</B> + } + if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} { + set cr <B>$name</B> + } + lappend nmore $cr + } + man-puts [join $nmore {, }] + } + return + } + H:KEYWORDS { + while {[more-text]} { + if {[next-op-is .SH rest] || [next-op-is .SS rest]} { + backup-text 1 + return + } + set more [next-text] + if {[is-a-directive $more]} { + manerror "$more" + backup-text 1 + return + } + set keys {} + foreach key [split $more ,] { + set key [string trim $key] + lappend manual(keyword-$key) [list $manual(name) \ + $manual(wing-file)/$manual(name).htm] + set initial [string toupper [string index $key 0]] + lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>" + } + man-puts [join $keys {, }] + } + return + } + } + if {[next-op-is .IP rest]} { + output-IP-list $code .IP $rest + return + } + if {[next-op-is .PP rest]} { + return + } + return + } + .SO { + # When there's a sequence of multiple .SO chunks, process into one + set optslist {} + while 1 { + if {[match-text @stuff .SE]} { + foreach opt [split $stuff \n\t] { + lappend optslist [list $opt $rest] + } + } else { + manerror "unexpected .SO format:\n[expand-next-text 2]" + } + if {![next-op-is .SO rest]} { + break + } + } + output-directive {.SH STANDARD OPTIONS} + man-puts <DL> + lappend manual(section-toc) <DL> + foreach optionpair [lsort -dictionary -index 0 $optslist] { + lassign $optionpair option targetPage + man-puts "<DT><B>[std-option-toc $option $targetPage]</B>" + } + man-puts </DL> + lappend manual(section-toc) </DL> + } + .OP { + output-widget-options $rest + return + } + .IP { + output-IP-list .IP .IP $rest + return + } + .PP - .sp { + man-puts <P> + } + .RS { + output-RS-list + return + } + .br { + man-puts <BR> + return + } + .DS { + if {[next-op-is .ta rest]} { + # skip the leading .ta directive if it is there + } + if {[match-text @stuff .DE]} { + set td "<td><p class=\"tablecell\">" + set bodyText [string map [list \n <tr>$td \t $td] \n$stuff] + man-puts "<dl><dd><table border=\"0\">$bodyText</table></dl>" + #man-puts <PRE>$stuff</PRE> + } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} { + man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>" + } else { + manerror "unexpected .DS format:\n[expand-next-text 2]" + } + return + } + .CS { + if {[next-op-is .ta rest]} { + # ??? + } + if {[match-text @stuff .CE]} { + man-puts <PRE>$stuff</PRE> + } else { + manerror "unexpected .CS format:\n[expand-next-text 2]" + } + return + } + .nf { + if {[match-text @more .fi]} { + foreach more [split $more \n] { + man-puts $more<BR> + } + } elseif {[match-text .RS @more .RE .fi]} { + man-puts <DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts </DL> + } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} { + man-puts <DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts <DL><DD> + foreach more2 [split $more2 \n] { + man-puts $more2<BR> + } + man-puts </DL></DL> + } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} { + man-puts <DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts <DL><DD> + foreach more2 [split $more2 \n] { + man-puts $more2<BR> + } + man-puts </DL><DD> + foreach more3 [split $more3 \n] { + man-puts $more3<BR> + } + man-puts </DL> + } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} { + man-puts <P><DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts <DL><DD> + foreach more2 [split $more2 \n] { + man-puts $more2<BR> + } + man-puts </DL></DL><P> + } elseif {[match-text .RS .sp @more .sp .RE .fi]} { + man-puts <P><DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts </DL><P> + } else { + manerror "ignoring $line" + } + } + .RE - .DE - .CE { + manerror "unexpected $code" + return + } + .ta - .fi - .na - .ad - .UL - .ie - .el - .ne { + manerror "ignoring $line" + } + default { + manerror "unrecognized format directive: $line" + } + } +} + +## +## merge copyright listings +## +proc merge-copyrights {l1 l2} { + set merge {} + set re1 {^Copyright +(?:\(c\)|\\\(co|©) +(\w.*?)(?:all rights reserved)?(?:\. )*$} + set re2 {^(\d+) +(?:by +)?(\w.*)$} ;# date who + set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$} ;# from to who + set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who + foreach copyright [concat $l1 $l2] { + if {[regexp -nocase -- $re1 $copyright -> info]} { + set info [string trimright $info ". "] ; # remove extra period + if {[regexp -- $re2 $info -> date who]} { + lappend dates($who) $date + continue + } elseif {[regexp -- $re3 $info -> from to who]} { + for {set date $from} {$date <= $to} {incr date} { + lappend dates($who) $date + } + continue + } elseif {[regexp -- $re3 $info -> date1 date2 who]} { + lappend dates($who) $date1 $date2 + continue + } + } + puts "oops: $copyright" + } + foreach who [array names dates] { + set list [lsort -dictionary $dates($who)] + if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} { + lappend merge "Copyright © [lindex $list 0] $who" + } else { + lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who" + } + } + return [lsort -dictionary $merge] +} + +## +## foreach of the man pages in the section specified by +## sectionDescriptor, convert manpages into hypertext in +## the directory specified by outputDir. +## +proc make-manpage-section {outputDir sectionDescriptor} { + global manual overall_title tcltkdesc verbose + global excluded_pages forced_index_pages process_first_patterns + + set LQ \u201c + set RQ \u201d + + lassign $sectionDescriptor \ + manual(wing-glob) \ + manual(wing-name) \ + manual(wing-file) \ + manual(wing-description) + set manual(wing-copyrights) {} + makedirhier $outputDir/$manual(wing-file) + set manual(wing-toc-fp) [open $outputDir/$manual(wing-file)/[indexfile] w] + # whistle + puts stderr "scanning section $manual(wing-name)" + # put the entry for this section into the short table of contents + if {[regexp {^(.+), version (.+)$} $manual(wing-name) -> name version]} { + puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\" TITLE=\"version $version\">$name</A></DT><DD>$manual(wing-description)</DD>" + } else { + puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>" + } + # initialize the wing table of contents + puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \ + $manual(wing-name) $overall_title "../[indexfile]"] + # initialize the short table of contents for this section + set manual(wing-toc) {} + # initialize the man directory for this section + makedirhier $outputDir/$manual(wing-file) + # initialize the long table of contents for this section + set manual(long-toc-n) 1 + # get the manual pages for this section + set manual(pages) [lsort -dictionary [glob -nocomplain $manual(wing-glob)]] + # Some pages have to go first so that their links override others + foreach pat $process_first_patterns { + set n [lsearch -glob $manual(pages) $pat] + if {$n >= 0} { + set f [lindex $manual(pages) $n] + puts stderr "shuffling [file tail $f] to front of processing queue" + set manual(pages) \ + [linsert [lreplace $manual(pages) $n $n] 0 $f] + } + } + # set manual(pages) [lrange $manual(pages) 0 5] + foreach manual_page $manual(pages) { + set manual(page) [file normalize $manual_page] + # whistle + if {$verbose} { + puts stderr "scanning page $manual(page)" + } else { + puts -nonewline stderr . + } + set manual(tail) [file tail $manual(page)] + set manual(name) [file root $manual(tail)] + set manual(section) {} + if {$manual(name) in $excluded_pages} { + # obsolete + if {!$verbose} { + puts stderr "" + } + manerror "discarding $manual(name)" + continue + } + set manual(infp) [open $manual(page)] + set manual(text) {} + set manual(partial-text) {} + foreach p {.RS .DS .CS .SO} { + set manual($p) 0 + } + set manual(stack) {} + set manual(section) {} + set manual(section-toc) {} + set manual(section-toc-n) 1 + set manual(copyrights) {} + lappend manual(all-pages) $manual(wing-file)/$manual(tail) + lappend manual(all-page-domains) $manual(wing-name) + manreport 100 $manual(name) + while {[gets $manual(infp) line] >= 0} { + manreport 100 $line + if {[regexp {^[`'][/\\]} $line]} { + if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} { + lappend manual(copyrights) $copyright + } + # comment + continue + } + if {"$line" eq {'}} { + # comment + continue + } + if {![parse-directive $line code rest]} { + addbuffer $line + continue + } + switch -exact -- $code { + .if - .nr - .ti - .in - .ie - .el - + .ad - .na - .so - .ne - .AS - .HS - .VE - .VS - . { + # ignore + continue + } + } + switch -exact -- $code { + .SH - .SS { + flushbuffer + if {[llength $rest] == 0} { + gets $manual(infp) rest + } + lappend manual(text) "$code [unquote $rest]" + } + .TH { + flushbuffer + lappend manual(text) "$code [unquote $rest]" + } + .QW { + lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ + inQuote afterwards + addbuffer $LQ [unquote $inQuote] $RQ [unquote $afterwards] + } + .PQ { + lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ + inQuote punctuation afterwards + addbuffer ( $LQ [unquote $inQuote] $RQ \ + [unquote $punctuation] ) [unquote $afterwards] + } + .QR { + lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ + rangeFrom rangeTo afterwards + addbuffer $LQ [unquote $rangeFrom] "–" \ + [unquote $rangeTo] $RQ [unquote $afterwards] + } + .MT { + addbuffer $LQ$RQ + } + .HS - .UL - .ta { + flushbuffer + lappend manual(text) "$code [unquote $rest]" + } + .BS - .BE - .br - .fi - .sp - .nf { + flushbuffer + if {$rest ne ""} { + if {!$verbose} { + puts stderr "" + } + manerror "unexpected argument: $line" + } + lappend manual(text) $code + } + .AP { + flushbuffer + lappend manual(text) [concat .IP [process-text \ + "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]] + } + .IP { + flushbuffer + regexp {^(.*) +\d+$} $rest all rest + lappend manual(text) ".IP [process-text \ + [unquote [string trim $rest]]]" + } + .TP { + flushbuffer + while {[is-a-directive [set next [gets $manual(infp)]]]} { + if {!$verbose} { + puts stderr "" + } + manerror "ignoring $next after .TP" + } + if {"$next" ne {'}} { + lappend manual(text) ".IP [process-text $next]" + } + } + .OP { + flushbuffer + lassign $rest cmdName dbName dbClass + lappend manual(text) [concat .OP [process-text \ + "\\fB$cmdName\\fR \\fB$dbName\\fR \\fB$dbClass\\fR"]] + } + .PP - .LP { + flushbuffer + lappend manual(text) {.PP} + } + .RS { + flushbuffer + incr manual(.RS) + lappend manual(text) $code + } + .RE { + flushbuffer + incr manual(.RS) -1 + lappend manual(text) $code + } + .SO { + flushbuffer + incr manual(.SO) + if {[llength $rest] == 0} { + lappend manual(text) "$code options" + } else { + lappend manual(text) "$code [unquote $rest]" + } + } + .SE { + flushbuffer + incr manual(.SO) -1 + lappend manual(text) $code + } + .DS { + flushbuffer + incr manual(.DS) + lappend manual(text) $code + } + .DE { + flushbuffer + incr manual(.DS) -1 + lappend manual(text) $code + } + .CS { + flushbuffer + incr manual(.CS) + lappend manual(text) $code + } + .CE { + flushbuffer + incr manual(.CS) -1 + lappend manual(text) $code + } + .de { + while {[gets $manual(infp) line] >= 0} { + if {[string match "..*" $line]} { + break + } + } + } + .. { + if {!$verbose} { + puts stderr "" + } + error "found .. outside of .de" + } + default { + if {!$verbose} { + puts stderr "" + } + flushbuffer + manerror "unrecognized format directive: $line" + } + } + } + flushbuffer + close $manual(infp) + # fixups + if {$manual(.RS) != 0} { + if {!$verbose} { + puts stderr "" + } + puts "unbalanced .RS .RE" + } + if {$manual(.DS) != 0} { + if {!$verbose} { + puts stderr "" + } + puts "unbalanced .DS .DE" + } + if {$manual(.CS) != 0} { + if {!$verbose} { + puts stderr "" + } + puts "unbalanced .CS .CE" + } + if {$manual(.SO) != 0} { + if {!$verbose} { + puts stderr "" + } + puts "unbalanced .SO .SE" + } + # output conversion + open-text + set haserror 0 + if {[next-op-is .HS rest]} { + set manual($manual(wing-file)-$manual(name)-title) \ + "[join [lrange $rest 1 end] { }] [lindex $rest 0] manual page" + } elseif {[next-op-is .TH rest]} { + set manual($manual(wing-file)-$manual(name)-title) \ + "[lindex $rest 0] manual page - [join [lrange $rest 4 end] { }]" + } else { + set haserror 1 + if {!$verbose} { + puts stderr "" + } + manerror "no .HS or .TH record found" + } + if {!$haserror} { + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + output-directive $line + } else { + man-puts $line + } + } + man-puts [copyout $manual(copyrights) "../"] + set manual(wing-copyrights) [merge-copyrights \ + $manual(wing-copyrights) $manual(copyrights)] + } + # + # make the long table of contents for this page + # + set manual(toc-$manual(wing-file)-$manual(name)) \ + [concat <DL> $manual(section-toc) </DL>] + } + if {!$verbose} { + puts stderr "" + } + + # + # make the wing table of contents for the section + # + set width 0 + foreach name $manual(wing-toc) { + if {[string length $name] > $width} { + set width [string length $name] + } + } + set perline [expr {118 / $width}] + set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}] + set n 0 + catch {unset rows} + foreach name [lsort -dictionary $manual(wing-toc)] { + set tail $manual(name-$name) + if {[llength $tail] > 1} { + manerror "$name is defined in more than one file: $tail" + set tail [lindex $tail [expr {[llength $tail]-1}]] + } + set tail [file tail $tail] + if {[info exists manual(tooltip-$manual(wing-file)/$tail.htm)]} { + set tooltip $manual(tooltip-$manual(wing-file)/$tail.htm) + set tooltip [string map {[ {\[} ] {\]} $ {\$} \\ \\\\} $tooltip] + regsub {^[^-]+-\s*(.)} $tooltip {[string totitle \1]} tooltip + append rows([expr {$n%$nrows}]) \ + "<td> <a href=\"$tail.htm\" title=\"[subst $tooltip]\">$name</a> </td>" + } else { + append rows([expr {$n%$nrows}]) \ + "<td> <a href=\"$tail.htm\">$name</a> </td>" + } + incr n + } + puts $manual(wing-toc-fp) <table> + foreach row [lsort -integer [array names rows]] { + puts $manual(wing-toc-fp) <tr>$rows($row)</tr> + } + puts $manual(wing-toc-fp) </table> + + # + # insert wing copyrights + # + puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"] + puts $manual(wing-toc-fp) "</BODY></HTML>" + close $manual(wing-toc-fp) + set manual(merge-copyrights) \ + [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)] +} + +proc makedirhier {dir} { + try { + if {![file isdirectory $dir]} { + file mkdir $dir + } + } on error msg { + return -code error "cannot create directory $dir: $msg" + } +} + +proc addbuffer {args} { + global manual + if {$manual(partial-text) ne ""} { + append manual(partial-text) \n + } + append manual(partial-text) [join $args ""] +} +proc flushbuffer {} { + global manual + if {$manual(partial-text) ne ""} { + lappend manual(text) [process-text $manual(partial-text)] + set manual(partial-text) "" + } +} + +return diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index db24a9a..89e8e5c 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -1,14 +1,16 @@ -#!/bin/sh -# The next line is executed by /bin/sh, but not tcl \ -exec tclsh8.4 "$0" ${1+"$@"} +#!/usr/bin/env tclsh -package require Tcl 8.4 +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. +# Convert Ousterhout format man pages into highly crosslinked hypertext. # -# Along the way detect many unmatched font changes and other odd -# things. +# 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 @@ -18,61 +20,23 @@ package require Tcl 8.4 # try to use this, you'll be very much on your own. # # Copyright (c) 1995-1997 Roger E. Critchlow Jr -# -# The authors hereby grant permission to use, copy, modify, distribute, -# and license this software and its documentation for any purpose, provided -# that existing copyright notices are retained in all copies and that this -# notice is included verbatim in any distributions. No written agreement, -# license, or royalty fee is required for any of the authorized uses. -# Modifications to this software may be copyrighted by their authors -# and need not follow the licensing terms described here, provided that -# the new terms are clearly indicated on the first page of each file where -# they apply. -# -# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY -# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES -# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY -# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE -# POSSIBILITY OF SUCH DAMAGE. -# -# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, -# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE -# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE -# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR -# MODIFICATIONS. -# -# Revisions: -# May 15, 1995 - initial release -# May 16, 1995 - added a back to home link to toplevel table of -# contents. -# May 18, 1995 - broke toplevel table of contents into separate -# pages for each section, and broke long table of contents -# into a one page for each man page. -# Mar 10, 1996 - updated for tcl7.5b3/tk4.1b3 -# Apr 14, 1996 - incorporated command line parsing from Tom Tromey, -# <tromey@creche.cygnus.com> -- thanks Tom. -# - updated for tcl7.5/tk4.1 final release. -# - converted to same copyright as the man pages. -# Sep 14, 1996 - made various modifications for tcl7.6b1/tk4.2b1 -# Oct 18, 1996 - added tcl7.6/tk4.2 to the list of distributions. -# Oct 22, 1996 - major hacking on indentation code and elsewhere. -# Mar 4, 1997 - -# May 28, 1997 - added tcl8.0b1/tk8.0b1 to the list of distributions -# - cleaned source for tclsh8.0 execution -# - renamed output files for windoze installation -# - added spaces to tables -# Oct 24, 1997 - moved from 8.0b1 to 8.0 release -# +# Copyright (c) 2004-2010 Donal K. Fellows -set Version "0.32" +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 + global tcltkdir tkdir tcldir webdir build_tcl build_tk verbose # Set defaults based on original code. set tcltkdir ../.. @@ -81,8 +45,9 @@ proc parse_command_line {} { 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]{,.[0-9]{,[0-9]}}}} + set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}} # Handle arguments a la GNU: # --version @@ -107,6 +72,7 @@ proc parse_command_line {} { 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 } @@ -133,6 +99,10 @@ proc parse_command_line {} { 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 @@ -140,13 +110,16 @@ proc parse_command_line {} { } } - if {!$build_tcl && !$build_tk} {set build_tcl 1; set build_tk 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 == ""} then { + -directory $tcltkdir tcl$useversion]] end] + if {$tcldir eq ""} { puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" exit 1 } @@ -156,1578 +129,620 @@ proc parse_command_line {} { if {$build_tk} { # Find Tk. set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ - -directory $tcltkdir tk$useversion]] end] - if {$tkdir == ""} then { + -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 " Manual" + 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. ## -set manual(report-level) 1 - -proc manerror {msg} { - global manual - set name {} - set subj {} - if {[info exists manual(name)]} { - set name $manual(name) - } - if {[info exists manual(section)] && [string length $manual(section)]} { - puts stderr "$name: $manual(section): $msg" - } else { - puts stderr "$name: $msg" - } -} - -proc manreport {level msg} { - global manual - if {$level < $manual(report-level)} { - manerror $msg - } -} - -proc fatal {msg} { - global manual - manerror $msg - exit 1 -} +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; + } +} + ## -## parsing +## foreach of the man directories specified by args +## convert manpages into hypertext in the directory +## specified by html. ## -proc unquote arg { - return [string map [list \" {}] $arg] -} +proc make-man-pages {html args} { + global manual overall_title tcltkdesc verbose + global excluded_pages forced_index_pages process_first_patterns -proc parse-directive {line codename restname} { - upvar $codename code $restname rest - return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest] -} + 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) {} -proc process-text {text} { - global manual - # preprocess text - set text [string map [list \ - {\&} "\t" \ - {&} {&} \ - {\\} {\} \ - {\e} {\} \ - {\ } { } \ - {\|} { } \ - {\0} { } \ - {\%} {} \ - "\\\n" "\n" \ - \" {"} \ - {<} {<} \ - {>} {>} \ - {\(+-} {±} \ - {\fP} {\fR} \ - {\.} . \ - {\(bu} {•} \ - ] $text] - regsub -all {\\o'o\^'} $text {\ô} text; # o-circumflex in re_syntax.n - regsub -all {\\-\\\|\\-} $text -- text; # two hyphens - regsub -all -- {\\-\\\^\\-} $text -- text; # two hyphens - regsub -all {\\-} $text - text; # a hyphen - regsub -all "\\\\\n" $text "\\\\n" text; # backslashed newline - while {[string first "\\" $text] >= 0} { - # C R - if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \ - {\1<TT>\2</TT>\3} text]} continue - # B R - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \ - {\1<B>\2</B>\3} text]} continue - # B I - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \ - {\1<B>\2</B>\\fI\3} text]} continue - # I R - if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \ - {\1<I>\2</I>\3} text]} continue - # I B - if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \ - {\1<I>\2</I>\\fB\3} text]} continue - # B B, I I, R R - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \ - {\1\\fB\2\3} ntext] - || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \ - {\1\\fI\2\3} ntext] - || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \ - {\1\\fR\2\3} ntext]} { - manerror "process-text: impotent font change: $text" - set text $ntext - continue - } - # unrecognized - manerror "process-text: uncaught backslash: $text" - set text [string map [list "\\" "#92;"] $text] - } - return $text -} -## -## pass 2 text input and matching -## -proc open-text {} { - global manual - set manual(text-length) [llength $manual(text)] - set manual(text-pointer) 0 -} -proc more-text {} { - global manual - return [expr {$manual(text-pointer) < $manual(text-length)}] -} -proc next-text {} { - global manual - if {[more-text]} { - set text [lindex $manual(text) $manual(text-pointer)] - incr manual(text-pointer) - return $text - } - manerror "read past end of text" - error "fatal" -} -proc is-a-directive {line} { - return [string match .* $line] -} -proc split-directive {line opname restname} { - upvar $opname op $restname rest - set op [string range $line 0 2] - set rest [string trim [string range $line 3 end]] -} -proc next-op-is {op restname} { - global manual - upvar $restname rest - if {[more-text]} { - set text [lindex $manual(text) $manual(text-pointer)] - if {[string equal -length 3 $text $op]} { - set rest [string range $text 4 end] - incr manual(text-pointer) - return 1 - } - } - return 0 -} -proc backup-text {n} { - global manual - if {$manual(text-pointer)-$n >= 0} { - incr manual(text-pointer) -$n - } -} -proc match-text args { - global manual - set nargs [llength $args] - if {$manual(text-pointer) + $nargs > $manual(text-length)} { - return 0 - } - set nback 0 foreach arg $args { - if {![more-text]} { - backup-text $nback - return 0 - } - set arg [string trim $arg] - set targ [string trim [lindex $manual(text) $manual(text-pointer)]] - if {[string equal $arg $targ]} { - incr nback - incr manual(text-pointer) + # preprocess to set up subheader for the rest of the files + if {![llength $arg]} { continue } - if {[regexp {^@(\w+)$} $arg all name]} { - upvar $name var - set var $targ - incr nback - incr manual(text-pointer) - continue - } - if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\ - && [string equal $op [lindex $targ 0]]} { - upvar $name var - set var [lrange $targ 1 end] - incr nback - incr manual(text-pointer) - 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" } - backup-text $nback - return 0 + lappend manual(subheader) $name $file } - return 1 -} -proc expand-next-text {n} { - global manual - return [join [lrange $manual(text) $manual(text-pointer) \ - [expr {$manual(text-pointer)+$n-1}]] \n\n] -} -## -## pass 2 output -## -proc man-puts {text} { - global manual - lappend manual(output-$manual(wing-file)-$manual(name)) $text -} -## -## build hypertext links to tables of contents -## -proc long-toc {text} { - global manual - set here M[incr manual(section-toc-n)] - set there L[incr manual(long-toc-n)] - lappend manual(section-toc) \ - "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>" - return "<A NAME=\"$here\">$text</A>" -} -proc option-toc {name class switch} { - global manual - if {[string equal $manual(section) "WIDGET-SPECIFIC OPTIONS"]} { - # link the defined option into the long table of contents - set link [long-toc "$switch, $name, $class"] - regsub -- "$switch, $name, $class" $link "$switch" link - return $link - } elseif {[string equal $manual(name):$manual(section) \ - "options:DESCRIPTION"]} { - # link the defined standard option to the long table of - # contents and make a target for the standard option references - # from other man pages. - set first [lindex $switch 0] - set here M$first - set there L[incr manual(long-toc-n)] - set manual(standard-option-$first) "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>" - lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>" - return "<A NAME=\"$here\">$switch</A>" - } else { - error "option-toc in $manual(name) section $manual(section)" - } -} -proc std-option-toc {name} { - global manual - if {[info exists manual(standard-option-$name)]} { - lappend manual(section-toc) <DD>$manual(standard-option-$name) - return $manual(standard-option-$name) - } - set here M[incr manual(section-toc-n)] - set there L[incr manual(long-toc-n)] - set other M$name - lappend manual(section-toc) "<DD><A HREF=\"options.htm#$other\">$name</A>" - return "<A HREF=\"options.htm#$other\">$name</A>" -} -## -## process the widget option section -## in widget and options man pages -## -proc output-widget-options {rest} { - global manual - man-puts <DL> - lappend manual(section-toc) <DL> - backup-text 1 - set para {} - while {[next-op-is .OP rest]} { - switch -exact [llength $rest] { - 3 { foreach {switch name class} $rest { break } } - 5 { - set switch [lrange $rest 0 2] - set name [lindex $rest 3] - set class [lindex $rest 4] - } - default { - fatal "bad .OP $rest" - } - } - if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} { - if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} { - error "not Switch: $switch" - } else { - set switch "$switch1$cswitch or $oswitch$switch2" - } - } - if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} { - error "not Name: $name" - } - if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} { - error "not Class: $class" + ## + ## 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 } - man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch" - man-puts "<DT>Database Name: $oname$name$cname" - man-puts "<DT>Database Class: $oclass$class$cclass" - man-puts <DD>[next-text] - set para <P> } - man-puts </DL> - lappend manual(section-toc) </DL> -} -## -## process .RS lists -## -proc output-RS-list {} { - global manual - if {[next-op-is .IP rest]} { - output-IP-list .RS .IP $rest - if {[match-text .RE .sp .RS @rest .IP @rest2]} { - man-puts <P>$rest - output-IP-list .RS .IP $rest2 - } - if {[match-text .RE .sp .RS @rest .RE]} { - man-puts <P>$rest - return - } - if {[next-op-is .RE rest]} { - return - } + ## + ## build the keyword index. + ## + if {!$verbose} { + puts stderr "Assembling index" } - man-puts <DL><DD> - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - split-directive $line code rest - switch -exact $code { - .RE { - break - } - .SH - .SS { - manerror "unbalanced .RS at section end" - backup-text 1 - break - } - default { - output-directive $line - } - } + 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 { - man-puts $line + # No keywords for this letter + lappend keyheader $a } - } - man-puts </DL> -} - -## -## process .IP lists which may be plain indents, -## numeric lists, or definition lists -## -proc output-IP-list {context code rest} { - global manual - if {![string length $rest]} { - # blank label, plain indent, no contents entry - man-puts <DL><DD> - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - split-directive $line code rest - if {[string equal $code ".IP"] && [string equal $rest {}]} { - man-puts "<P>" - continue - } - if {[lsearch {.br .DS .RS} $code] >= 0} { - output-directive $line - } else { - backup-text 1 - break - } - } else { - man-puts $line - } - } - man-puts </DL> - } else { - # labelled list, make contents - if { - [string compare $context ".SH"] && - [string compare $context ".SS"] - } then { - man-puts <P> + } + 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 } - man-puts <DL> - lappend manual(section-toc) <DL> - backup-text 1 - set accept_RE 0 - set para {} - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - split-directive $line code rest - switch -exact $code { - .IP { - if {$accept_RE} { - output-IP-list .IP $code $rest - continue - } - if {[string equal $manual(section) "ARGUMENTS"] || \ - [regexp {^\[\d+\]$} $rest]} { - man-puts "$para<DT>$rest<DD>" - } elseif {[string equal {•} $rest]} { - man-puts "$para<DT><DD>$rest " - } else { - man-puts "$para<DT>[long-toc $rest]<DD>" - } - if {[string equal $manual(name):$manual(section) \ - "selection:DESCRIPTION"]} { - if {[match-text .RE @rest .RS .RS]} { - man-puts <DT>[long-toc $rest]<DD> - } - } - } - .sp - - .br - - .DS - - .CS { - output-directive $line - } - .RS { - if {[match-text .RS]} { - output-directive $line - incr accept_RE 1 - } elseif {[match-text .CS]} { - output-directive .CS - incr accept_RE 1 - } elseif {[match-text .PP]} { - output-directive .PP - incr accept_RE 1 - } elseif {[match-text .DS]} { - output-directive .DS - incr accept_RE 1 - } else { - output-directive $line - } - } - .PP { - if {[match-text @rest1 .br @rest2 .RS]} { - # yet another nroff kludge as above - man-puts "$para<DT>[long-toc $rest1]" - man-puts "<DT>[long-toc $rest2]<DD>" - incr accept_RE 1 - } elseif {[match-text @rest .RE]} { - # gad, this is getting ridiculous - if {!$accept_RE} { - man-puts "</DL><P>$rest<DL>" - backup-text 1 - set para {} - break - } else { - man-puts "<P>$rest" - incr accept_RE -1 - } - } elseif {$accept_RE} { - output-directive $line - } else { - backup-text 1 - break - } - } - .RE { - if {!$accept_RE} { - backup-text 1 - break - } - incr accept_RE -1 - } - default { - backup-text 1 - break + # 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>" } - } else { - man-puts $line } - set para <P> - } - man-puts "$para</DL>" - lappend manual(section-toc) </DL> - if {$accept_RE} { - manerror "missing .RE in output-IP-list" - } - } -} -## -## handle the NAME section lines -## there's only one line in the NAME section, -## consisting of a comma separated list of names, -## followed by a hyphen and a short description. -## -proc output-name {line} { - global manual - # split name line into pieces - regexp {^([^-]+) - (.*)$} $line all head tail - # output line to manual page untouched - man-puts $line - # output line to long table of contents - lappend manual(section-toc) <DL><DD>$line</DL> - # separate out the names for future reference - foreach name [split $head ,] { - set name [string trim $name] - if {[llength $name] > 1} { - manerror "name has a space: {$name}\nfrom: $line" + puts $afp "[join $refs {, }]</DD>" } - lappend manual(wing-toc) $name - lappend manual(name-$name) $manual(wing-file)/$manual(name) - } -} -## -## build a cross-reference link if appropriate -## -proc cross-reference {ref} { - global manual - if {[string match Tcl_* $ref]} { - set lref $ref - } elseif {[string match Tk_* $ref]} { - set lref $ref - } elseif {[string equal $ref "Tcl"]} { - set lref $ref - } else { - set lref [string tolower $ref] - } - ## - ## nothing to reference - ## - if {![info exists manual(name-$lref)]} { - foreach name {array file history info interp string trace - after clipboard grab image option pack place selection tk tkwait update winfo wm} { - if {[regexp "^$name \[a-z0-9]*\$" $lref] && \ - [info exists manual(name-$name)] && \ - [string compare $manual(tail) "$name.n"]} { - return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>" - } - } - if {[lsearch {stdin stdout stderr end} $lref] >= 0} { - # no good place to send these - # tcl tokens? - # also end - } - return $ref + 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 + ## - ## would be a self reference + ## finish off short table of contents ## - foreach name $manual(name-$lref) { - if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} { - return $ref - } - } + 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) + ## - ## multiple choices for reference + ## output man pages ## - if {[llength $manual(name-$lref)] > 1} { - set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*] - set tcl_ref [lindex $manual(name-$lref) $tcl_i] - set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*] - set tk_ref [lindex $manual(name-$lref) $tk_i] - if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} \ - || "$manual(wing-file)" == {TclLib}} { - return "<A HREF=\"../$tcl_ref.htm\">$ref</A>" - } - if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} \ - || "$manual(wing-file)" == {TkLib}} { - return "<A HREF=\"../$tk_ref.htm\">$ref</A>" - } - if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} { - return "<A HREF=\"../$tcl_ref.htm\">$ref</A>" - } - puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)" - return $ref + unset manual(section) + if {!$verbose} { + puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links and write out" } - ## - ## exceptions, sigh, to the rule - ## - switch $manual(tail) { - canvas.n { - if {$lref == {focus}} { - upvar tail tail - set clue [string first command $tail] - if {$clue < 0 || $clue > 5} { - return $ref - } - } - if {[lsearch {bitmap image text} $lref] >= 0} { - return $ref - } - } - checkbutton.n - - radiobutton.n { - if {[lsearch {image} $lref] >= 0} { - return $ref - } - } - menu.n { - if {[lsearch {checkbutton radiobutton} $lref] >= 0} { - return $ref - } - } - options.n { - if {[lsearch {bitmap image set} $lref] >= 0} { - return $ref - } - } - regexp.n { - if {[lsearch {string} $lref] >= 0} { - return $ref - } - } - source.n { - if {[lsearch {text} $lref] >= 0} { - return $ref - } - } - history.n { - if {[lsearch {exec} $lref] >= 0} { - return $ref - } - } - return.n { - if {[lsearch {error continue break} $lref] >= 0} { - return $ref + 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 } - } - scrollbar.n { - if {[lsearch {set} $lref] >= 0} { - return $ref + 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} } } - ## - ## return the cross reference - ## - return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>" -} -## -## reference generation errors -## -proc reference-error {msg text} { - global manual - puts stderr "$manual(tail): $msg: {$text}" - return $text + if {!$verbose} { + puts stderr "\nDone" + } + return {} } + ## -## insert as many cross references into this text string as are appropriate +## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk). ## -proc insert-cross-references {text} { - global manual - ## - ## we identify cross references by: - ## ``quotation'' - ## <B>emboldening</B> - ## Tcl_ prefix - ## Tk_ prefix - ## [a-zA-Z0-9]+ manual entry - ## and we avoid messing with already anchored text - ## - ## - ## find where each item lives - ## - array set offset [list \ - anchor [string first {<A } $text] \ - end-anchor [string first {</A>} $text] \ - quote [string first {``} $text] \ - end-quote [string first {''} $text] \ - bold [string first {<B>} $text] \ - end-bold [string first {</B>} $text] \ - tcl [string first {Tcl_} $text] \ - tk [string first {Tk_} $text] \ - Tcl1 [string first {Tcl manual entry} $text] \ - Tcl2 [string first {Tcl overview manual entry} $text] \ - ] - ## - ## accumulate a list - ## - foreach name [array names offset] { - if {$offset($name) >= 0} { - set invert($offset($name)) $name - lappend offsets $offset($name) - } - } - ## - ## if nothing, then we're done. - ## - if {![info exists offsets]} { - return $text - } - ## - ## sort the offsets - ## - set offsets [lsort -integer $offsets] - ## - ## see which we want to use - ## - switch -exact $invert([lindex $offsets 0]) { - anchor { - if {$offset(end-anchor) < 0} { - return [reference-error {Missing end anchor} $text] - } - set head [string range $text 0 $offset(end-anchor)] - set tail [string range $text [expr {$offset(end-anchor)+1}] end] - return $head[insert-cross-references $tail] - } - quote { - if {$offset(end-quote) < 0} { - return [reference-error "Missing end quote" $text] - } - if {$invert([lindex $offsets 1]) == "tk"} { - set offsets [lreplace $offsets 1 1] - } - if {$invert([lindex $offsets 1]) == "tcl"} { - set offsets [lreplace $offsets 1 1] - } - switch -exact $invert([lindex $offsets 1]) { - end-quote { - set head [string range $text 0 [expr {$offset(quote)-1}]] - set body [string range $text [expr {$offset(quote)+2}] \ - [expr {$offset(end-quote)-1}]] - set tail [string range $text \ - [expr {$offset(end-quote)+2}] end] - return "$head``[cross-reference $body]''[insert-cross-references $tail]" - } - bold - - anchor { - set head [string range $text \ - 0 [expr {$offset(end-quote)+1}]] - set tail [string range $text \ - [expr {$offset(end-quote)+2}] end] - return "$head[insert-cross-references $tail]" - } - } - return [reference-error "Uncaught quote case" $text] - } - bold { - if {$offset(end-bold) < 0} { return $text } - if {$invert([lindex $offsets 1]) == "tk"} { - set offsets [lreplace $offsets 1 1] +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" } - if {$invert([lindex $offsets 1]) == "tcl"} { - set offsets [lreplace $offsets 1 1] - } - switch -exact $invert([lindex $offsets 1]) { - end-bold { - set head [string range $text 0 [expr {$offset(bold)-1}]] - set body [string range $text [expr {$offset(bold)+3}] \ - [expr {$offset(end-bold)-1}]] - set tail [string range $text \ - [expr {$offset(end-bold)+4}] end] - return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]" - } - anchor { - set head [string range $text \ - 0 [expr {$offset(end-bold)+3}]] - set tail [string range $text \ - [expr {$offset(end-bold)+4}] end] - return "$head[insert-cross-references $tail]" - } - } - return [reference-error "Uncaught bold case" $text] - } - tk { - set head [string range $text 0 [expr {$offset(tk)-1}]] - set tail [string range $text $offset(tk) end] - if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} { - return [reference-error "Tk regexp failed" $text] - } - return $head[cross-reference $body][insert-cross-references $tail] - } - tcl { - set head [string range $text 0 [expr {$offset(tcl)-1}]] - set tail [string range $text $offset(tcl) end] - if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} { - return [reference-error {Tcl regexp failed} $text] - } - return $head[cross-reference $body][insert-cross-references $tail] - } - Tcl1 - - Tcl2 { - set off [lindex $offsets 0] - set head [string range $text 0 [expr {$off-1}]] - set body Tcl - set tail [string range $text [expr {$off+3}] end] - return $head[cross-reference $body][insert-cross-references $tail] - } - end-anchor - - end-bold - - end-quote { - return [reference-error "Out of place $invert([lindex $offsets 0])" $text] } + set glob $root/$glob + return [list $tcltkdir/$glob $name $dir $desc] } } + ## -## process formatting directives +## Helper for assembling the descriptions of contributed packages. ## -proc output-directive {line} { - global manual - # process format directive - split-directive $line code rest - switch -exact $code { - .BS - - .BE { - # man-puts <HR> - } - .SH - .SS { - # drain any open lists - # announce the subject - set manual(section) $rest - # start our own stack of stuff - set manual($manual(name)-$manual(section)) {} - lappend manual(has-$manual(section)) $manual(name) - if {[string compare .SS $code]} { - man-puts "<H3>[long-toc $manual(section)]</H3>" - } else { - man-puts "<H4>[long-toc $manual(section)]</H4>" - } - # some sections can simply free wheel their way through the text - # some sections can be processed in their own loops - switch -exact $manual(section) { - NAME { - if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} { - # these manual pages have two NAME sections - if {[info exists manual($manual(tail)-NAME)]} { - return - } - set manual($manual(tail)-NAME) 1 - } - set names {} - while {1} { - set line [next-text] - if {[is-a-directive $line]} { - backup-text 1 - output-name [join $names { }] - return - } else { - lappend names [string trim $line] - } - } - } - SYNOPSIS { - lappend manual(section-toc) <DL> - while {1} { - if {[next-op-is .nf rest] - || [next-op-is .br rest] - || [next-op-is .fi rest]} { - continue - } - if {[next-op-is .SH rest] - || [next-op-is .SS rest] - || [next-op-is .BE rest] - || [next-op-is .SO rest]} { - backup-text 1 - break - } - if {[next-op-is .sp rest]} { - #man-puts <P> - continue - } - set more [next-text] - if {[is-a-directive $more]} { - manerror "in SYNOPSIS found $more" - backup-text 1 - break - } else { - foreach more [split $more \n] { - man-puts $more<BR> - if {[lsearch {TclLib TkLib} $manual(wing-file)] < 0} { - lappend manual(section-toc) <DD>$more - } - } - } - } - lappend manual(section-toc) </DL> - return - } - {SEE ALSO} { - while {[more-text]} { - if {[next-op-is .SH rest] || [next-op-is .SS rest]} { - backup-text 1 - return - } - set more [next-text] - if {[is-a-directive $more]} { - manerror "$more" - backup-text 1 - return - } - set nmore {} - foreach cr [split $more ,] { - set cr [string trim $cr] - if {![regexp {^<B>.*</B>$} $cr]} { - set cr <B>$cr</B> - } - if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} { - set cr <B>$name</B> - } - lappend nmore $cr - } - man-puts [join $nmore {, }] - } - return - } - KEYWORDS { - while {[more-text]} { - if {[next-op-is .SH rest] || [next-op-is .SS rest]} { - backup-text 1 - return - } - set more [next-text] - if {[is-a-directive $more]} { - manerror "$more" - backup-text 1 - return - } - set keys {} - foreach key [split $more ,] { - set key [string trim $key] - lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm] - set initial [string toupper [string index $key 0]] - lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>" - } - man-puts [join $keys {, }] - } - return - } - } - if {[next-op-is .IP rest]} { - output-IP-list $code .IP $rest - return - } - if {[next-op-is .PP rest]} { - return - } - return - } - .SO { - if {[match-text @stuff .SE]} { - output-directive {.SH STANDARD OPTIONS} - set opts {} - foreach line [split $stuff \n] { - foreach option [split $line \t] { - lappend opts $option - } - } - man-puts <DL> - lappend manual(section-toc) <DL> - foreach option [lsort $opts] { - man-puts "<DT><B>[std-option-toc $option]</B>" - } - man-puts </DL> - lappend manual(section-toc) </DL> - } else { - manerror "unexpected .SO format:\n[expand-next-text 2]" - } - } - .OP { - output-widget-options $rest - return - } - .IP { - output-IP-list .IP .IP $rest - return - } - .PP { - man-puts <P> - } - .RS { - output-RS-list - return - } - .RE { - manerror "unexpected .RE" - return - } - .br { - man-puts <BR> - return - } - .DE { - manerror "unexpected .DE" - return - } - .DS { - if {[next-op-is .ta rest]} { - - } - if {[match-text @stuff .DE]} { - man-puts <PRE>$stuff</PRE> - } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} { - man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>" - } else { - manerror "unexpected .DS format:\n[expand-next-text 2]" - } - return - } - .CS { - if {[next-op-is .ta rest]} { - - } - if {[match-text @stuff .CE]} { - man-puts <PRE>$stuff</PRE> - } else { - manerror "unexpected .CS format:\n[expand-next-text 2]" +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 } - return - } - .CE { - manerror "unexpected .CE" - return - } - .sp { - man-puts <P> } - .ta { - # these are tab stop settings for short tables - switch -exact $manual(name):$manual(section) { - {bind:MODIFIERS} - - {bind:EVENT TYPES} - - {bind:BINDING SCRIPTS AND SUBSTITUTIONS} - - {expr:OPERANDS} - - {expr:MATH FUNCTIONS} - - {history:DESCRIPTION} - - {history:HISTORY REVISION} - - {switch:DESCRIPTION} - - {upvar:DESCRIPTION} { - return; # fix.me - } - default { - manerror "ignoring $line" + 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." } - } - .nf { - if {[match-text @more .fi]} { - foreach more [split $more \n] { - man-puts $more<BR> - } - } elseif {[match-text .RS @more .RE .fi]} { - man-puts <DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts </DL> - } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} { - man-puts <DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts <DL><DD> - foreach more2 [split $more2 \n] { - man-puts $more2<BR> - } - man-puts </DL></DL> - } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} { - man-puts <DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts <DL><DD> - foreach more2 [split $more2 \n] { - man-puts $more2<BR> - } - man-puts </DL><DD> - foreach more3 [split $more3 \n] { - man-puts $more3<BR> - } - man-puts </DL> - } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} { - man-puts <P><DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> + 3 { + set title "$name Package C API" + if {$version ne ""} { + append title ", version $version" } - man-puts <DL><DD> - foreach more2 [split $more2 \n] { - man-puts $more2<BR> - } - man-puts </DL></DL><P> - } elseif {[match-text .RS .sp @more .sp .RE .fi]} { - man-puts <P><DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts </DL><P> - } else { - manerror "ignoring $line" + set dir [string totitle $dir]Lib + set desc \ + "The additional C functions provided by the $name package." } } - .fi { - manerror "ignoring $line" - } - .na - - .ad - - .UL - - .ne { - manerror "ignoring $line" - } - default { - manerror "unrecognized format directive: $line" - } + lappend result [list $globpat $title $dir $desc] } + return $result } + ## -## merge copyright listings -## -proc merge-copyrights {l1 l2} { - foreach copyright [concat $l1 $l2] { - if {[regexp {^Copyright +\(c\) +(\d+) +(by +)?(\w.*)$} $copyright all date by who]} { - lappend dates($who) $date - continue - } - if {[regexp {^Copyright +\(c\) +(\d+)-(\d+) +(by +)?(\w.*)$} $copyright all from to by who]} { - for {set date $from} {$date <= $to} {incr date} { - lappend dates($who) $date - } - continue - } - if {[regexp {^Copyright +\(c\) +(\d+), *(\d+) +(by +)?(\w.*)$} $copyright all date1 date2 by who]} { - lappend dates($who) $date1 $date2 - continue - } - puts "oops: $copyright" +## 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" } - foreach who [array names dates] { - set list [lsort $dates($who)] - if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} { - lappend merge "Copyright (c) [lindex $list 0] $who" - } else { - lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who" - } + if {$build_tcl && $build_tk} { + append tcltkdesc "/" + append cmdesc " and " + append appdir "," } - return [lsort $merge] -} - -proc makedirhier {dir} { - if {![file isdirectory $dir] && \ - [catch {file mkdir $dir} error]} { - return -code error "cannot create directory $dir: $error" + if {$build_tk} { + append tcltkdesc "Tk" + append cmdesc "Tk" + append appdir "$tkdir" } -} -## -## 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 env manual overall_title tcltkdesc - makedirhier $html - set manual(short-toc-n) 1 - set manual(short-toc-fp) [open $html/contents.htm w] - puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>" - puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>" - set manual(merge-copyrights) {} - foreach arg $args { - if {$arg == ""} {continue} - set manual(wing-glob) [lindex $arg 0] - set manual(wing-name) [lindex $arg 1] - set manual(wing-file) [lindex $arg 2] - set manual(wing-description) [lindex $arg 3] - set manual(wing-copyrights) {} - makedirhier $html/$manual(wing-file) - set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w] - # whistle - puts stderr "scanning section $manual(wing-name)" - # put the entry for this section into the short table of contents - puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)" - # initialize the wing table of contents - puts $manual(wing-toc-fp) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>" - puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>" - # initialize the short table of contents for this section - set manual(wing-toc) {} - # initialize the man directory for this section - makedirhier $html/$manual(wing-file) - # initialize the long table of contents for this section - set manual(long-toc-n) 1 - # get the manual pages for this section - set manual(pages) [lsort [glob $manual(wing-glob)]] - if {[lsearch -glob $manual(pages) */options.n] >= 0} { - set n [lsearch $manual(pages) */options.n] - set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]" - } - # set manual(pages) [lrange $manual(pages) 0 5] - foreach manual(page) $manual(pages) { - # whistle - puts stderr "scanning page $manual(page)" - set manual(tail) [file tail $manual(page)] - set manual(name) [file root $manual(tail)] - set manual(section) {} - if {[lsearch {case pack-old menubar} $manual(name)] >= 0} { - # obsolete - manerror "discarding $manual(name)" - continue - } - set manual(infp) [open $manual(page)] - set manual(text) {} - set manual(partial-text) {} - foreach p {.RS .DS .CS .SO} { - set manual($p) 0 - } - set manual(stack) {} - set manual(section) {} - set manual(section-toc) {} - set manual(section-toc-n) 1 - set manual(copyrights) {} - lappend manual(all-pages) $manual(wing-file)/$manual(tail) - manreport 100 $manual(name) - while {[gets $manual(infp) line] >= 0} { - manreport 100 $line - if {[regexp {^[`'][/\\]} $line]} { - if {[regexp {Copyright \(c\).*$} $line copyright]} { - lappend manual(copyrights) $copyright - } - # comment - continue - } - if {"$line" == {'}} { - # comment - continue - } - if {[parse-directive $line code rest]} { - switch -exact $code { - .ad - .na - .so - .ne - .AS - .VE - .VS - - . { - # ignore - continue - } - } - if {"$manual(partial-text)" != {}} { - lappend manual(text) [process-text $manual(partial-text)] - set manual(partial-text) {} - } - switch -exact $code { - .SH - .SS { - if {[llength $rest] == 0} { - gets $manual(infp) rest - } - lappend manual(text) "$code [unquote $rest]" - } - .TH { - lappend manual(text) "$code [unquote $rest]" - } - .HS - .UL - - .ta { - lappend manual(text) "$code [unquote $rest]" - } - .BS - .BE - .br - .fi - .sp - - .nf { - if {"$rest" != {}} { - manerror "unexpected argument: $line" - } - lappend manual(text) $code - } - .AP { - lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]] - } - .IP { - regexp {^(.*) +\d+$} $rest all rest - lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]" - } - .TP { - while {[is-a-directive [set next [gets $manual(infp)]]]} { - manerror "ignoring $next after .TP" - } - if {"$next" != {'}} { - lappend manual(text) ".IP [process-text $next]" - } - } - .OP { - lappend manual(text) [concat .OP [process-text \ - "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]] - } - .PP - - .LP { - lappend manual(text) {.PP} - } - .RS { - incr manual(.RS) - lappend manual(text) $code - } - .RE { - incr manual(.RS) -1 - lappend manual(text) $code - } - .SO { - incr manual(.SO) - lappend manual(text) $code - } - .SE { - incr manual(.SO) -1 - lappend manual(text) $code - } - .DS { - incr manual(.DS) - lappend manual(text) $code - } - .DE { - incr manual(.DS) -1 - lappend manual(text) $code - } - .CS { - incr manual(.CS) - lappend manual(text) $code - } - .CE { - incr manual(.CS) -1 - lappend manual(text) $code - } - .de { - while {[gets $manual(infp) line] >= 0} { - if {[string match "..*" $line]} { - break - } - } - } - .. { - error "found .. outside of .de" - } - default { - manerror "unrecognized format directive: $line" - } - } - } else { - if {$manual(partial-text) == ""} { - set manual(partial-text) $line - } else { - append manual(partial-text) \n$line - } - } - } - if {$manual(partial-text) != ""} { - lappend manual(text) [process-text $manual(partial-text)] - } - close $manual(infp) - # fixups - if {$manual(.RS) != 0} { - if {$manual(name) != "selection"} { - puts "unbalanced .RS .RE" - } - } - if {$manual(.DS) != 0} { - puts "unbalanced .DS .DE" - } - if {$manual(.CS) != 0} { - puts "unbalanced .CS .CE" - } - if {$manual(.SO) != 0} { - puts "unbalanced .SO .SE" - } - # output conversion - open-text - if {[next-op-is .HS rest]} { - set manual($manual(name)-title) \ - "[lrange $rest 1 end] [lindex $rest 0] manual page" - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - output-directive $line - } else { - man-puts $line - } - } - man-puts <HR><PRE> - foreach copyright $manual(copyrights) { - man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" - } - man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>" - set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)] - } elseif {[next-op-is .TH rest]} { - set manual($manual(name)-title) "[lrange $rest 4 end] - [lindex $rest 0] manual page" - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - output-directive $line - } else { - man-puts $line + 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 { + set f [open [file join $pkgsDir $dir configure.in]] + foreach line [split [read $f] \n] { + if {2 == [scan $line \ + { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} { + set description [list $n $v] + break } } - man-puts <HR><PRE> - foreach copyright $manual(copyrights) { - man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" - } - man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>" - set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)] - } else { - manerror "no .HS or .TH record found" + } finally { + catch {close $f; unset f} } - # - # make the long table of contents for this page - # - set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>] - } - # - # make the wing table of contents for the section - # - set width 0 - foreach name $manual(wing-toc) { - if {[string length $name] > $width} { - set width [string length $name] + if {[file exists [file join $pkgsDir $dir configure]]} { + # Looks like a package, record our best extraction attempt + lappend packageBuildList $dir {*}$description } } - set perline [expr {120 / $width}] - set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}] - set n 0 - catch {unset rows} - foreach name [lsort $manual(wing-toc)] { - set tail $manual(name-$name) - if {[llength $tail] > 1} { - manerror "$name is defined in more than one file: $tail" - set tail [lindex $tail [expr {[llength $tail]-1}]] - } - set tail [file tail $tail] - append rows([expr {$n%$nrows}]) \ - "<td> <a href=\"$tail.htm\">$name</a>" - incr n - } - puts $manual(wing-toc-fp) <table> - foreach row [lsort -integer [array names rows]] { - puts $manual(wing-toc-fp) <tr>$rows($row)</tr> - } - puts $manual(wing-toc-fp) </table> - - # - # insert wing copyrights - # - puts $manual(wing-toc-fp) "<HR><PRE>" - foreach copyright $manual(wing-copyrights) { - puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" - } - puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." - puts $manual(wing-toc-fp) "</PRE></BODY></HTML>" - close $manual(wing-toc-fp) - set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)] } - ## - ## build the keyword index. - ## - proc strcasecmp {a b} { return [string compare -nocase $a $b] } - set keys [lsort -command strcasecmp [array names manual keyword-*]] - makedirhier $html/Keywords - catch {eval file delete -- [glob $html/Keywords/*]} - puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/contents.htm\">Keywords</A><DD>The keywords from the $tcltkdesc man pages." - set keyfp [open $html/Keywords/contents.htm w] - puts $keyfp "<HTML><HEAD><TITLE>$tcltkdesc Keywords</TITLE></HEAD>" - puts $keyfp "<BODY><HR><H3>$tcltkdesc Keywords</H3><HR><H2>" - foreach a {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} { - puts $keyfp "<A HREF=\"$a.htm\">$a</A>" - set afp [open $html/Keywords/$a.htm w] - puts $afp "<HTML><HEAD><TITLE>$tcltkdesc Keywords - $a</TITLE></HEAD>" - puts $afp "<BODY><HR><H3>$tcltkdesc Keywords - $a</H3><HR><H2>" - foreach b {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} { - puts $afp "<A HREF=\"$b.htm\">$b</A>" - } - puts $afp "</H2><HR><DL>" - foreach k $keys { - if {[string match -nocase "keyword-${a}*" $k]} { - set k [string range $k 8 end] - puts $afp "<DT><A NAME=\"$k\">$k</A><DD>" - set refs {} - foreach man $manual(keyword-$k) { - set name [lindex $man 0] - set file [lindex $man 1] - lappend refs "<A HREF=\"../$file\">$name</A>" + # 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 } - puts $afp [join $refs {, }] + } finally { + close $f } } - puts $afp "</DL><HR><PRE>" - # insert merged copyrights - foreach copyright $manual(merge-copyrights) { - puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" + } trap {POSIX ENOENT} {} { + set packageDirNameMap { + itcl {[incr Tcl]} + tdbc {TDBC} + thread Thread } - puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." - puts $afp "</PRE></BODY></HTML>" - close $afp - } - puts $keyfp "</H2><HR><PRE>" - - # insert merged copyrights - foreach copyright $manual(merge-copyrights) { - puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" - } - puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." - puts $keyfp </PRE><HR></BODY></HTML> - close $keyfp - - ## - ## finish off short table of contents - ## - puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.} - puts $manual(short-toc-fp) "</DL><HR><PRE>" - # insert merged copyrights - foreach copyright $manual(merge-copyrights) { - puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" } - puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." - puts $manual(short-toc-fp) "</PRE></BODY></HTML>" - close $manual(short-toc-fp) - ## - ## output man pages - ## - unset manual(section) - foreach path $manual(all-pages) { - set manual(wing-file) [file dirname $path] - set manual(tail) [file tail $path] - set manual(name) [file root $manual(tail)] - set text $manual(output-$manual(wing-file)-$manual(name)) - set ntext 0 - foreach item $text { - incr ntext [llength [split $item \n]] - incr ntext + # 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] } - set toc $manual(toc-$manual(wing-file)-$manual(name)) - set ntoc 0 - foreach item $toc { - incr ntoc [llength [split $item \n]] - incr ntoc - } - puts stderr "rescanning page $manual(name) $ntoc/$ntext" - set manual(outfp) [open $html/$manual(wing-file)/$manual(name).htm w] - puts $manual(outfp) "<HTML><HEAD><TITLE>$manual($manual(name)-title)</TITLE></HEAD><BODY>" - if {($ntext > 60) && ($ntoc > 32) || [lsearch { - Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType - CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash - GetJustify GetPixels GetVisual ParseArgv QueueEvent - } $manual(tail)] >= 0} { - foreach item $toc { - puts $manual(outfp) $item - } - } - foreach item $text { - puts $manual(outfp) [insert-cross-references $item] - } - puts $manual(outfp) </BODY></HTML> - close $manual(outfp) } - return {} -} - -parse_command_line - -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"} + }} -set usercmddesc "The interpreters which implement $cmdesc." -set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.} -set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.} -set tcllibdesc {The C functions which a Tcl extended C program may use.} -set tklibdesc {The additional C functions which a Tk extended C program may use.} - -if {1} { - if {[catch { - make-man-pages $webdir \ - "$tcltkdir/{$appdir}/doc/*.1 \"$tcltkdesc Applications\" UserCmd {$usercmddesc}" \ - [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" : ""}] \ - [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" : ""}] \ - [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" : ""}] \ - [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" : ""}] - } error]} { - puts $error\n$errorInfo - } + # + # 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: diff --git a/tools/tsdPerf.c b/tools/tsdPerf.c new file mode 100644 index 0000000..40004b1 --- /dev/null +++ b/tools/tsdPerf.c @@ -0,0 +1,59 @@ +#include <tcl.h> + +extern DLLEXPORT Tcl_PackageInitProc Tsdperf_Init; + +static Tcl_ThreadDataKey key; + +typedef struct { + int value; +} TsdPerf; + + +static int +tsdPerfSetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { + TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf)); + int i; + + if (2 != objc) { + Tcl_WrongNumArgs(interp, 1, objv, "value"); + return TCL_ERROR; + } + + if (TCL_OK != Tcl_GetIntFromObj(interp, objv[1], &i)) { + return TCL_ERROR; + } + + perf->value = i; + + return TCL_OK; +} + +static int +tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { + TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf)); + + + Tcl_SetObjResult(interp, Tcl_NewIntObj(perf->value)); + + return TCL_OK; +} + +int +Tsdperf_Init(Tcl_Interp *interp) { + if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + return TCL_ERROR; + } + + Tcl_CreateObjCommand(interp, "tsdPerfSet", tsdPerfSetObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "tsdPerfGet", tsdPerfGetObjCmd, NULL, NULL); + + return TCL_OK; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/tools/tsdPerf.tcl b/tools/tsdPerf.tcl new file mode 100644 index 0000000..360ca9c --- /dev/null +++ b/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" +} diff --git a/tools/uniClass.tcl b/tools/uniClass.tcl index 442fc2a..9b4819d 100644 --- a/tools/uniClass.tcl +++ b/tools/uniClass.tcl @@ -13,22 +13,36 @@ exec tclsh "$0" ${1+"$@"} # proc emitRange {first last} { - global ranges numranges chars numchars + global ranges numranges chars numchars extchars extranges if {$first < ($last-1)} { - append ranges [format "{0x%04x, 0x%04x}, " \ + 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 { - append chars [format "0x%04x, " $first] + 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%04x, " $last] + append chars [format "0x%x, " $last] incr numchars if {$numchars % 9 == 0} { append chars "\n " @@ -38,7 +52,7 @@ proc emitRange {first last} { } proc genTable {type} { - global first last ranges numranges chars numchars + global first last ranges numranges chars numchars extchars extranges set first -2 set last -2 @@ -46,13 +60,19 @@ proc genTable {type} { set numranges 0 set chars " " set numchars 0 + set extchars 0 + set extranges 0 - for {set i 0} {$i <= 0xFFFF} {incr i} { + 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} { + if {$first >= 0} { emitRange $first $last } set first $i @@ -63,18 +83,24 @@ proc genTable {type} { emitRange $first $last set ranges [string trimright $ranges "\t\n ,"] + if {$extranges} { + append ranges "\n#endif" + } set chars [string trimright $chars "\t\n ,"] - if {$ranges != ""} { - puts "static crange ${type}RangeTable\[\] = {\n$ranges\n};\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 != ""} { - puts "static chr ${type}CharTable\[\] = {\n$chars\n};\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 "/* no singletons of $type characters */\n" + puts "/*\n * no singletons of $type characters.\n */\n" } } @@ -87,6 +113,7 @@ puts "/* foreach {type desc} { alpha "alphabetic characters" + control "control characters" digit "decimal digit characters" punct "punctuation characters" space "white space characters" @@ -94,7 +121,7 @@ foreach {type desc} { upper "uppercase characters" graph "unicode print characters excluding space" } { - puts "/* Unicode: $desc */\n" + puts "/*\n * Unicode: $desc.\n */\n" genTable $type } diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl index 3fe38d2..e33b3c7 100644 --- a/tools/uniParse.tcl +++ b/tools/uniParse.tcl @@ -4,12 +4,10 @@ # 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-Latest.txt +# ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -# -# RCS: @(#) $Id: uniParse.tcl,v 1.4 2001/05/28 04:37:57 hobbs Exp $ namespace eval uni { @@ -32,45 +30,38 @@ namespace eval uni { 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. - - variable titleCount 0; # Count of the number of title case - # characters. This value is used in the - # regular expression code to allocate enough - # space for the title case variants. } proc uni::getValue {items index} { variable categories - variable titleCount # Extract character info set category [lindex $items 2] - if {[scan [lindex $items 12] %4x toupper] == 1} { + if {[scan [lindex $items 12] %x toupper] == 1} { set toupper [expr {$index - $toupper}] } else { - set toupper {} + set toupper 0 } - if {[scan [lindex $items 13] %4x tolower] == 1} { + if {[scan [lindex $items 13] %x tolower] == 1} { set tolower [expr {$tolower - $index}] } else { - set tolower {} + set tolower 0 } - if {[scan [lindex $items 14] %4x totitle] == 1} { + if {[scan [lindex $items 14] %x totitle] == 1} { set totitle [expr {$index - $totitle}] + } elseif {$tolower} { + set totitle 0 } else { - set totitle {} + set totitle $toupper } set categoryIndex [lsearch -exact $categories $category] if {$categoryIndex < 0} { - puts "Unexpected character category: $index($category)" - set categoryIndex 0 - } elseif {$category == "Lt"} { - incr titleCount + error "Unexpected character category: $index($category)" } - return "$categoryIndex,$toupper,$tolower,$totitle" + return [list $categoryIndex $toupper $tolower $totitle] } proc uni::getGroup {value} { @@ -87,38 +78,48 @@ proc uni::getGroup {value} { 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 $pIndex + lappend pMap [expr {$pIndex << $shift}] return } - + proc uni::buildTables {data} { variable shift variable pMap {} variable pages {} - variable groups {{0,,,}} + variable groups {{0 0 0 0}} + variable next 0 set info {} ;# temporary page info - - set mask [expr {(1 << $shift) - 1}] - set next 0 + set mask [expr {(1 << $shift) - 1}] foreach line [split $data \n] { - if {$line == ""} { - set line "FFFF;;Cn;0;ON;;;;;N;;;;;\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] %4x index - set index [format 0x%0.4x $index] - + 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 @@ -140,15 +141,11 @@ proc uni::buildTables {data} { # Enter all assigned characters up to the current character for {set i $next} {$i <= $index} {incr i} { - # Split character index into offset and page number - set offset [expr {$i & $mask}] - set page [expr {($i >> $shift)}] - # 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 {$offset == $mask} { + if {($i & $mask) == $mask} { addPage $info set info {} } @@ -164,7 +161,7 @@ proc uni::main {} { variable pages variable groups variable shift - variable titleCount + variable next if {$argc != 2} { puts stderr "\nusage: $argv0 <datafile> <outdir>\n" @@ -176,9 +173,8 @@ proc uni::main {} { buildTables $data puts "X = [llength $pMap] Y= [llength $pages] A= [llength $groups]" - set size [expr {[llength $pMap] + [llength $pages]*(1<<$shift)}] - puts "shift = 6, space = $size" - puts "title case count = $titleCount" + 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 @@ -191,8 +187,6 @@ proc uni::main {} { * * Copyright (c) 1998 by Scriptics Corporation. * All rights reserved. - * - * RCS: @(#) \$Id\$ */ /* @@ -209,20 +203,29 @@ proc uni::main {} { * to the same alternate page number. */ -static unsigned char pageMap\[\] = {" +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 $line + puts $f [string trimright $line] set line " " } } puts $f $line + puts $f "#endif /* TCL_UTF_MAX > 3 */" puts $f "}; /* @@ -231,24 +234,30 @@ static unsigned char pageMap\[\] = {" * set of character attributes. */ -static unsigned char groupMap\[\] = {" +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 $line + puts $f [string trimright $line] set line " " } } } puts $f $line + puts $f "#endif /* TCL_UTF_MAX > 3 */" puts $f "}; /* @@ -260,43 +269,53 @@ static unsigned char groupMap\[\] = {" * Bits 5-7 Case delta type: 000 = identity * 010 = add delta for lower * 011 = add delta for lower, add 1 for title - * 100 = sutract delta for title/upper + * 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-21 Reserved for future use. - * - * Bits 22-31 Case delta: delta for case conversions. This should be the + * Bits 8-31 Case delta: delta for case conversions. This should be the * highest field so we can easily sign extend. */ -static int groups\[\] = {" +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} [split [lindex $groups $i] ,] {} - + foreach {type toupper tolower totitle} [lindex $groups $i] {} + # Compute the case conversion type and delta - if {$totitle != ""} { + if {$totitle} { if {$totitle == $toupper} { # subtract delta for title or upper set case 4 set delta $toupper - } elseif {$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 != ""} { + } elseif {$toupper} { # subtract delta for upper, add delta for lower set case 6 set delta $toupper - } elseif {$tolower != ""} { + if {$tolower != $toupper} { + error "New case conversion type needed: $toupper $tolower $totitle" + } + } elseif {$tolower} { # add delta for lower set case 2 set delta $tolower @@ -306,27 +325,29 @@ static int groups\[\] = {" set delta 0 } - set val [expr {($delta << 22) | ($case << 5) | $type}] - - append line [format "%d" $val] + append line [expr {($delta << 8) | ($case << 5) | $type}] if {$i != $last} { append line ", " } if {[string length $line] > 65} { - puts $f $line + puts $f [string trimright $line] set line " " } } puts $f $line - puts $f "}; + 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. */ -#define UNICODE_CATEGORY_MASK 0X1F - enum { UNASSIGNED, UPPERCASE_LETTER, @@ -366,16 +387,16 @@ enum { * to do sign extension on right shifts. */ -#define GetCaseType(info) (((info) & 0xE0) >> 5) -#define GetCategory(info) ((info) & 0x1F) -#define GetDelta(info) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22))) +#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. */ -#define GetUniCharInfo(ch) (groups\[groupMap\[(pageMap\[(((int)(ch)) & 0xffff) >> OFFSET_BITS\] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) +#define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) " close $f |
