diff options
Diffstat (limited to 'tools')
| -rw-r--r--[-rwxr-xr-x] | tools/checkLibraryDoc.tcl | 0 | ||||
| -rw-r--r--[-rwxr-xr-x] | tools/configure | 2215 | ||||
| -rw-r--r-- | tools/configure.in | 3 | ||||
| -rw-r--r-- | tools/cvtEOL.tcl | 32 | ||||
| -rwxr-xr-x | tools/findBadExternals.tcl | 53 | ||||
| -rwxr-xr-x | tools/fix_tommath_h.tcl | 98 | ||||
| -rw-r--r-- | tools/genStubs.tcl | 604 | ||||
| -rw-r--r-- | tools/genWinImage.tcl | 155 | ||||
| -rw-r--r-- | tools/index.tcl | 2 | ||||
| -rw-r--r-- | tools/installData.tcl | 50 | ||||
| -rwxr-xr-x | tools/loadICU.tcl | 619 | ||||
| -rwxr-xr-x | tools/makeTestCases.tcl | 1180 | ||||
| -rw-r--r-- | tools/man2help.tcl | 7 | ||||
| -rw-r--r-- | tools/man2help2.tcl | 153 | ||||
| -rw-r--r-- | tools/man2html.tcl | 171 | ||||
| -rw-r--r-- | tools/man2html1.tcl | 32 | ||||
| -rw-r--r-- | tools/man2html2.tcl | 465 | ||||
| -rw-r--r-- | tools/man2tcl.c | 250 | ||||
| -rw-r--r-- | tools/mkdepend.tcl | 420 | ||||
| -rw-r--r-- | tools/tcl.hpj.in | 4 | ||||
| -rw-r--r-- | tools/tcl.wse.in | 76 | ||||
| -rw-r--r-- | tools/tclSplash.bmp | bin | 162030 -> 162030 bytes | |||
| -rwxr-xr-x | tools/tclZIC.tcl | 1375 | ||||
| -rw-r--r-- | tools/tclmin.wse | 4 | ||||
| -rwxr-xr-x | tools/tcltk-man2html.tcl | 1107 | ||||
| -rw-r--r-- | tools/uniClass.tcl | 4 | ||||
| -rw-r--r-- | tools/uniParse.tcl | 6 |
27 files changed, 7262 insertions, 1823 deletions
diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl index cd08c2a..cd08c2a 100755..100644 --- a/tools/checkLibraryDoc.tcl +++ b/tools/checkLibraryDoc.tcl diff --git a/tools/configure b/tools/configure index 209d394..98b5867 100755..100644 --- a/tools/configure +++ b/tools/configure @@ -1,28 +1,288 @@ #! /bin/sh - # Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf version 2.13 -# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. +# Generated by GNU Autoconf 2.59. # +# 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. +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +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 ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + 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 + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi -# Defaults: -ac_help= +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +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="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="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + + +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +exec 6>&1 + +# +# Initializations. +# ac_default_prefix=/usr/local -# Any additions from configure.in: -ac_help="$ac_help - --with-tcl=DIR use Tcl $DEF_VER binaries from DIR" +ac_config_libobj_dir=. +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Maximum number of lines to put in a shell here document. +# This variable seems obsolete. It should probably be removed, and +# only ac_max_sed_lines should be used. +: ${ac_max_here_lines=38} + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= + +ac_unique_file="man2tcl.c" +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_WIN_VERSION CC TCL_VERSION TCL_PATCH_LEVEL TCL_SRC_DIR TCL_BIN_DIR LIBOBJS LTLIBOBJS' +ac_subst_files='' # Initialize some variables set by options. +ac_init_help= +ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. -build=NONE -cache_file=./config.cache +cache_file=/dev/null exec_prefix=NONE -host=NONE no_create= -nonopt=NONE no_recursion= prefix=NONE program_prefix=NONE @@ -31,10 +291,15 @@ program_transform_name=s,x,x, silent= site= srcdir= -target=NONE verbose= x_includes=NONE x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' @@ -48,17 +313,9 @@ oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' -# Initialize some other variables. -subdirs= -MFLAGS= MAKEFLAGS= -SHELL=${CONFIG_SHELL-/bin/sh} -# Maximum number of lines to put in a shell here document. -ac_max_here_lines=12 - ac_prev= for ac_option do - # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" @@ -66,59 +323,59 @@ do continue fi - case "$ac_option" in - -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; - *) ac_optarg= ;; - esac + ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. - case "$ac_option" in + case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) - bindir="$ac_optarg" ;; + bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) - ac_prev=build ;; + ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) - build="$ac_optarg" ;; + build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) - cache_file="$ac_optarg" ;; + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) - datadir="$ac_optarg" ;; + datadir=$ac_optarg ;; -disable-* | --disable-*) - ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` + ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then - { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } - fi - ac_feature=`echo $ac_feature| sed 's/-/_/g'` - eval "enable_${ac_feature}=no" ;; + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) - ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` + ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then - { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } - fi - ac_feature=`echo $ac_feature| sed 's/-/_/g'` - case "$ac_option" in - *=*) ;; + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac - eval "enable_${ac_feature}='$ac_optarg'" ;; + eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ @@ -127,95 +384,47 @@ do -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) - exec_prefix="$ac_optarg" ;; + exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; - -help | --help | --hel | --he) - # Omit some internal or obsolete options to make the list less imposing. - # This message is too long to be a string in the A/UX 3.1 sh. - cat << EOF -Usage: configure [options] [host] -Options: [defaults in brackets after descriptions] -Configuration: - --cache-file=FILE cache test results in FILE - --help print this message - --no-create do not create output files - --quiet, --silent do not print \`checking...' messages - --version print the version of autoconf that created configure -Directory and file names: - --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] - --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [same as prefix] - --bindir=DIR user executables in DIR [EPREFIX/bin] - --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] - --libexecdir=DIR program executables in DIR [EPREFIX/libexec] - --datadir=DIR read-only architecture-independent data in DIR - [PREFIX/share] - --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data in DIR - [PREFIX/com] - --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] - --libdir=DIR object code libraries in DIR [EPREFIX/lib] - --includedir=DIR C header files in DIR [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] - --infodir=DIR info documentation in DIR [PREFIX/info] - --mandir=DIR man documentation in DIR [PREFIX/man] - --srcdir=DIR find the sources in DIR [configure dir or ..] - --program-prefix=PREFIX prepend PREFIX to installed program names - --program-suffix=SUFFIX append SUFFIX to installed program names - --program-transform-name=PROGRAM - run sed PROGRAM on installed program names -EOF - cat << EOF -Host type: - --build=BUILD configure for building on BUILD [BUILD=HOST] - --host=HOST configure for HOST [guessed] - --target=TARGET configure for TARGET [TARGET=HOST] -Features and packages: - --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) - --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] - --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --x-includes=DIR X include files are in DIR - --x-libraries=DIR X library files are in DIR -EOF - if test -n "$ac_help"; then - echo "--enable and --with options recognized:$ac_help" - fi - exit 0 ;; + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; -host | --host | --hos | --ho) - ac_prev=host ;; + ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) - host="$ac_optarg" ;; + host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) - includedir="$ac_optarg" ;; + includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) - infodir="$ac_optarg" ;; + infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) - libdir="$ac_optarg" ;; + libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) - libexecdir="$ac_optarg" ;; + libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ @@ -224,19 +433,19 @@ EOF -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) - localstatedir="$ac_optarg" ;; + localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) - mandir="$ac_optarg" ;; + mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) + | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ @@ -250,26 +459,26 @@ EOF -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) - oldincludedir="$ac_optarg" ;; + oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix="$ac_optarg" ;; + prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) - program_prefix="$ac_optarg" ;; + program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) - program_suffix="$ac_optarg" ;; + program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ @@ -286,7 +495,7 @@ EOF | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) - program_transform_name="$ac_optarg" ;; + program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) @@ -296,7 +505,7 @@ EOF ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) - sbindir="$ac_optarg" ;; + sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ @@ -307,58 +516,57 @@ EOF | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) - sharedstatedir="$ac_optarg" ;; + sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) - site="$ac_optarg" ;; + site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) - srcdir="$ac_optarg" ;; + srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) - sysconfdir="$ac_optarg" ;; + sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) - ac_prev=target ;; + ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) - target="$ac_optarg" ;; + target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; - -version | --version | --versio | --versi | --vers) - echo "configure generated by autoconf version 2.13" - exit 0 ;; + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; -with-* | --with-*) - ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` + ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then - { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } - fi + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` - case "$ac_option" in - *=*) ;; + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac - eval "with_${ac_package}='$ac_optarg'" ;; + eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) - ac_package=`echo $ac_option|sed -e 's/-*without-//'` + ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then - { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } - fi - ac_package=`echo $ac_package| sed 's/-/_/g'` - eval "with_${ac_package}=no" ;; + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package | sed 's/-/_/g'` + eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. @@ -369,99 +577,110 @@ EOF ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) - x_includes="$ac_optarg" ;; + x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) - x_libraries="$ac_optarg" ;; + x_libraries=$ac_optarg ;; - -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } + -*) { echo "$as_me: error: unrecognized option: $ac_option +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } ;; + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { (exit 1); exit 1; }; } + ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` + eval "$ac_envvar='$ac_optarg'" + export $ac_envvar ;; + *) - if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then - echo "configure: warning: $ac_option: invalid host type" 1>&2 - fi - if test "x$nonopt" != xNONE; then - { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } - fi - nonopt="$ac_option" + # FIXME: should be removed in autoconf 3.0. + echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then - { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } -fi - -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - -# File descriptor usage: -# 0 standard input -# 1 file creation -# 2 errors and warnings -# 3 some systems may open it to /dev/tty -# 4 used on the Kubota Titan -# 6 checking for... messages and results -# 5 compiler messages saved in config.log -if test "$silent" = yes; then - exec 6>/dev/null -else - exec 6>&1 + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + { echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } fi -exec 5>./config.log -echo "\ -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. -" 1>&5 +# Be sure to have absolute paths. +for ac_var in exec_prefix prefix +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* | NONE | '' ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done -# Strip out --no-create and --no-recursion so they do not pile up. -# Also quote any args containing shell metacharacters. -ac_configure_args= -for ac_arg +# Be sure to have absolute paths. +for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ + localstatedir libdir includedir oldincludedir infodir mandir do - case "$ac_arg" in - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) ;; - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) - ac_configure_args="$ac_configure_args '$ac_arg'" ;; - *) ac_configure_args="$ac_configure_args $ac_arg" ;; + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; esac done -# NLS nuisances. -# Only set these to C if already set. These must not be set unconditionally -# because not all systems understand e.g. LANG=C (notably SCO). -# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! -# Non-C LC_CTYPE values break the ctype check. -if test "${LANG+set}" = set; then LANG=C; export LANG; fi -if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi -if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi -if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi -# confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -rf conftest* confdefs.h -# AIX cpp loses on an empty file, so make sure it contains at least a newline. -echo > confdefs.h +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null -# A filename unique to this package, relative to the directory that -# configure is in, which we can look for to find out if srcdir is correct. -ac_unique_file=man2tcl.c # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. - ac_prog=$0 - ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` - test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. + ac_confdir=`(dirname "$0") 2>/dev/null || +$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$0" : 'X\(//\)[^/]' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$0" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. @@ -471,13 +690,427 @@ else fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then - { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 + { (exit 1); exit 1; }; } else - { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } fi fi -srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` +(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || + { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 + { (exit 1); exit 1; }; } +srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` +ac_env_build_alias_set=${build_alias+set} +ac_env_build_alias_value=$build_alias +ac_cv_env_build_alias_set=${build_alias+set} +ac_cv_env_build_alias_value=$build_alias +ac_env_host_alias_set=${host_alias+set} +ac_env_host_alias_value=$host_alias +ac_cv_env_host_alias_set=${host_alias+set} +ac_cv_env_host_alias_value=$host_alias +ac_env_target_alias_set=${target_alias+set} +ac_env_target_alias_value=$target_alias +ac_cv_env_target_alias_set=${target_alias+set} +ac_cv_env_target_alias_value=$target_alias + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +_ACEOF + + cat <<_ACEOF +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data [PREFIX/share] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --infodir=DIR info documentation [PREFIX/info] + --mandir=DIR man documentation [PREFIX/man] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-tcl=DIR use Tcl $DEF_VER binaries from DIR + +_ACEOF +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + ac_popdir=`pwd` + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d $ac_dir || continue + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# 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. + if test -f $ac_srcdir/configure.gnu; then + echo + $SHELL $ac_srcdir/configure.gnu --help=recursive + elif test -f $ac_srcdir/configure; then + echo + $SHELL $ac_srcdir/configure --help=recursive + elif test -f $ac_srcdir/configure.ac || + test -f $ac_srcdir/configure.in; then + echo + $ac_configure --help + else + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi + cd $ac_popdir + done +fi + +test -n "$ac_init_help" && exit 0 +if $ac_init_version; then + cat <<\_ACEOF + +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 + exit 0 +fi +exec 5>config.log +cat >&5 <<_ACEOF +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.59. Invocation command line was + + $ $0 $@ + +_ACEOF +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +hostinfo = `(hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_sep= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 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. + 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 + fi + ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" + # Get rid of the leading space. + ac_sep=" " + ;; + esac + done +done +$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } +$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Be sure not to use single quotes in there, as some shells, +# such as our DU 5.0 friend, will then `close' the trap. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +{ + (set) 2>&1 | + 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" + ;; + *) + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------- ## +## Output files. ## +## ------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + sed "/^$/d" confdefs.h | sort + echo + fi + test "$ac_signal" != 0 && + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core && + rm -rf conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status + ' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo >confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then @@ -488,40 +1121,106 @@ if test -z "$CONFIG_SITE"; then fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then - echo "loading site script $ac_site_file" + { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then - echo "loading cache $cache_file" - . $cache_file + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { echo "$as_me:$LINENO: loading cache $cache_file" >&5 +echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . $cache_file;; + *) . ./$cache_file;; + esac + fi else - echo "creating cache $cache_file" - > $cache_file + { echo "$as_me:$LINENO: creating cache $cache_file" >&5 +echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file fi -ac_ext=c -# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. -ac_cpp='$CPP $CPPFLAGS' -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' -cross_compiling=$ac_cv_prog_cc_cross - -ac_exeext= -ac_objext=o -if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then - # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. - if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then - ac_n= ac_c=' -' ac_t=' ' - else - ac_n=-n ac_c= ac_t= +# Check that the precious variables saved in the cache have kept the same +# 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 + 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" + eval ac_new_val="\$ac_env_${ac_var}_value" + case $ac_old_set,$ac_new_set in + set,) + { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + 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: error: \`$ac_var' has changed since the previous run:" >&2;} + { 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: current value: $ac_new_val" >&2;} + ac_cache_corrupted=: + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + esac fi -else - ac_n= ac_c='\c' ac_t= +done +if $ac_cache_corrupted; then + { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { (exit 1); exit 1; }; } fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + + + + + + + + + + + + # Recover information that Tcl computed with its configure script. @@ -530,7 +1229,8 @@ fi # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.4 +DEF_VER=8.5 + # Check whether --with-tcl or --without-tcl was given. if test "${with_tcl+set}" = set; then @@ -538,13 +1238,16 @@ if test "${with_tcl+set}" = set; then TCL_BIN_DIR=$withval else TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd` -fi - +fi; if test ! -d $TCL_BIN_DIR; then - { echo "configure: error: Tcl directory $TCL_BIN_DIR doesn't exist" 1>&2; exit 1; } + { { echo "$as_me:$LINENO: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&5 +echo "$as_me: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&2;} + { (exit 1); exit 1; }; } fi if test ! -f $TCL_BIN_DIR/tclConfig.sh; then - { echo "configure: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; } + { { echo "$as_me:$LINENO: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&5 +echo "$as_me: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&2;} + { (exit 1); exit 1; }; } fi . $TCL_BIN_DIR/tclConfig.sh @@ -558,260 +1261,910 @@ CC=$TCL_CC -trap '' 1 2 15 -cat > confcache <<\EOF + ac_config_files="$ac_config_files Makefile tcl.hpj" +cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure -# scripts and configure runs. It is not useful on other systems. -# If it contains results you don't want to keep, you may remove or edit it. +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. # -# By default, configure uses ./config.cache as the cache file, -# creating it if it does not exist already. You can give configure -# the --cache-file=FILE option to use a different cache file; that is -# what configure does when it calls configure scripts in -# subdirectories, so they share the cache. -# Giving --cache-file=/dev/null disables caching, for debugging configure. -# config.status only pays attention to the cache file if you give it the -# --recheck option to rerun configure. +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. # -EOF +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. -(set) 2>&1 | - case `(ac_space=' '; set | grep ac_space) 2>&1` in - *ac_space=\ *) - # `set' does not quote correctly, so add quotes (double-quote substitution - # turns \\\\ into \\, and sed turns \\ into \). - sed -n \ - -e "s/'/'\\\\''/g" \ - -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" - ;; - *) - # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' - ;; - esac >> confcache -if cmp -s $cache_file confcache; then - : -else +{ + (set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `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" + ;; + *) + # `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" + ;; + esac; +} | + sed ' + t clear + : clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + : end' >>confcache +if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then - echo "updating cache $cache_file" - cat confcache > $cache_file + test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" + cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' -# Any assignment to VPATH causes Sun make to only execute -# the first set of double-colon rules, so remove it if not needed. -# If there is a colon in the path, we need to keep it. +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# 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[ ]*=[^:]*$/d' + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/; +s/:*\${srcdir}:*/:/; +s/:*@srcdir@:*/:/; +s/^\([^=]*=[ ]*\):*/\1/; +s/:*$//; +s/^[^=]*=[ ]*$//; +}' fi -trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 - # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. -cat > conftest.defs <<\EOF -s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g -s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g -s%\[%\\&%g -s%\]%\\&%g -s%\$%$$%g -EOF -DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` -rm -f conftest.defs - - -# Without the "./", some shells look in PATH for config.status. -: ${CONFIG_STATUS=./config.status} +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then we branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +cat >confdef2opt.sed <<\_ACEOF +t clear +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +t quote +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +t quote +d +: quote +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,\[,\\&,g +s,\],\\&,g +s,\$,$$,g +p +_ACEOF +# We use echo to avoid assuming a particular line-breaking character. +# The extra dot is to prevent the shell from consuming trailing +# line-breaks from the sub-command output. A line-break within +# single-quotes doesn't work because, if this script is created in a +# platform that uses two characters for line-breaks (e.g., DOS), tr +# would break. +ac_LF_and_DOT=`echo; echo .` +DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` +rm -f confdef2opt.sed + + +ac_libobjs= +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$//'` + # 2. Add them. + ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" + ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs -echo creating $CONFIG_STATUS -rm -f $CONFIG_STATUS -cat > $CONFIG_STATUS <<EOF -#! /bin/sh -# Generated automatically by configure. +LTLIBOBJS=$ac_ltlibobjs + + + +: ${CONFIG_STATUS=./config.status} +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 +echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF +#! $SHELL +# Generated by $as_me. # Run this file to recreate the current configuration. -# This directory was configured as follows, -# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# -# $0 $ac_configure_args -# # Compiler output produced by configure, useful for debugging -# configure, is in ./config.log if it exists. +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false +SHELL=\${CONFIG_SHELL-$SHELL} +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +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 -ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" -for ac_option +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME do - case "\$ac_option" in - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" - exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; - -version | --version | --versio | --versi | --vers | --ver | --ve | --v) - echo "$CONFIG_STATUS generated by autoconf version 2.13" - exit 0 ;; - -help | --help | --hel | --he | --h) - echo "\$ac_cs_usage"; exit 0 ;; - *) echo "\$ac_cs_usage"; exit 1 ;; - esac + 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 + fi done -ac_given_srcdir=$srcdir +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi -trap 'rm -fr `echo "Makefile tcl.hpj" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 -EOF -cat >> $CONFIG_STATUS <<EOF +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi -# Protect against being on the right side of a sed subst in config.status. -sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g; - s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF -$ac_vpsub -$extrasub -s%@SHELL@%$SHELL%g -s%@CFLAGS@%$CFLAGS%g -s%@CPPFLAGS@%$CPPFLAGS%g -s%@CXXFLAGS@%$CXXFLAGS%g -s%@FFLAGS@%$FFLAGS%g -s%@DEFS@%$DEFS%g -s%@LDFLAGS@%$LDFLAGS%g -s%@LIBS@%$LIBS%g -s%@exec_prefix@%$exec_prefix%g -s%@prefix@%$prefix%g -s%@program_transform_name@%$program_transform_name%g -s%@bindir@%$bindir%g -s%@sbindir@%$sbindir%g -s%@libexecdir@%$libexecdir%g -s%@datadir@%$datadir%g -s%@sysconfdir@%$sysconfdir%g -s%@sharedstatedir@%$sharedstatedir%g -s%@localstatedir@%$localstatedir%g -s%@libdir@%$libdir%g -s%@includedir@%$includedir%g -s%@oldincludedir@%$oldincludedir%g -s%@infodir@%$infodir%g -s%@mandir@%$mandir%g -s%@TCL_WIN_VERSION@%$TCL_WIN_VERSION%g -s%@CC@%$CC%g -s%@TCL_VERSION@%$TCL_VERSION%g -s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g -s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g -s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g -CEOF -EOF - -cat >> $CONFIG_STATUS <<\EOF - -# Split the substitutions into bite-sized pieces for seds with -# small command number limits, like on Digital OSF/1 and HP-UX. -ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. -ac_file=1 # Number of current file. -ac_beg=1 # First line for current file. -ac_end=$ac_max_sed_cmds # Line after last line for current file. -ac_more_lines=: -ac_sed_cmds="" -while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file - else - sed "${ac_end}q" conftest.subs > conftest.s$ac_file - fi - if test ! -s conftest.s$ac_file; then - ac_more_lines=false - rm -f conftest.s$ac_file +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' else - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f conftest.s$ac_file" - else - ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" - fi - ac_file=`expr $ac_file + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_cmds` + PATH_SEPARATOR=: fi -done -if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat + rm -f conf$$.sh fi -EOF -cat >> $CONFIG_STATUS <<EOF -CONFIG_FILES=\${CONFIG_FILES-"Makefile tcl.hpj"} -EOF -cat >> $CONFIG_STATUS <<\EOF -for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` - ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - *) ac_file_in="${ac_file}.in" ;; + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 +echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; esac - # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 +echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi - # Remove last slash and all that follows it. Not all systems have dirname. - ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` - if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then - # The file is in a subdirectory. - test ! -d "$ac_dir" && mkdir "$ac_dir" - ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" - # A "../" for each directory in $ac_dir_suffix. - ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' else - ac_dir_suffix= ac_dots= + as_ln_s='ln -s' fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file - case "$ac_given_srcdir" in - .) srcdir=. - if test -z "$ac_dots"; then top_srcdir=. - else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; - /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; - *) # Relative path. - srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" - top_srcdir="$ac_dots$ac_given_srcdir" ;; +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="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="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + +exec 6>&1 + +# Open the log real soon, to keep \$[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. Logging --version etc. is OK. +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX +} >&5 +cat >&5 <<_CSEOF + +This file was extended by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +_CSEOF +echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 +echo >&5 +_ACEOF + +# Files that config.status was made for. +if test -n "$ac_config_files"; then + echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_headers"; then + echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_links"; then + echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_commands"; then + echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS +fi + +cat >>$CONFIG_STATUS <<\_ACEOF + +ac_cs_usage="\ +\`$as_me' instantiates files from templates according to the +current configuration. + +Usage: $0 [OPTIONS] [FILE]... + + -h, --help print this help, then exit + -V, --version print version number, then exit + -q, --quiet do not print progress messages + -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 + +Configuration files: +$config_files + +Report bugs to <bug-autoconf@gnu.org>." +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.59, + with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" + +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 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +# If no file are specified by the user, then we need to provide default +# value. By we need to know if files were specified by the user. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "x$1" : 'x\([^=]*\)='` + ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` + ac_shift=: + ;; + -*) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + *) # This is not an option, so the user has probably given explicit + # arguments. + ac_option=$1 + ac_need_defaults=false;; + esac + + case $ac_option in + # Handling of the options. +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --vers* | -V ) + echo "$ac_cs_version"; exit 0 ;; + --he | --h) + # Conflict between --help and --header + { { echo "$as_me:$LINENO: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; };; + --help | --hel | -h ) + echo "$ac_cs_usage"; exit 0 ;; + --debug | --d* | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + CONFIG_FILES="$CONFIG_FILES $ac_optarg" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + ac_need_defaults=false;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; } ;; + + *) ac_config_targets="$ac_config_targets $1" ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +if \$ac_cs_recheck; then + echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion +fi + +_ACEOF + + + + + +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_config_target in $ac_config_targets +do + case "$ac_config_target" in + # Handling of arguments. + "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; + *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + { (exit 1); exit 1; }; };; esac +done + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason to put it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Create a temporary directory, and hook for its removal unless debugging. +$debug || +{ + trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 + trap '{ (exit 1); exit 1; }' 1 2 13 15 +} + +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./confstat$$-$RANDOM + (umask 077 && mkdir $tmp) +} || +{ + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF + +# +# CONFIG_FILES section. +# + +# No need to generate the scripts if there are no CONFIG_FILES. +# This happens for instance when ./config.status config.h +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t +s,@CC@,$CC,;t t +s,@TCL_VERSION@,$TCL_VERSION,;t t +s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t +s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t +s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t +s,@LIBOBJS@,$LIBOBJS,;t t +s,@LTLIBOBJS@,$LTLIBOBJS,;t t +CEOF - echo creating "$ac_file" - rm -f "$ac_file" - configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." - case "$ac_file" in - *Makefile*) ac_comsub="1i\\ -# $configure_input" ;; - *) ac_comsub= ;; +_ACEOF + + cat >>$CONFIG_STATUS <<\_ACEOF + # Split the substitutions into bite-sized pieces for seds with + # small command number limits, like on Digital OSF/1 and HP-UX. + ac_max_sed_lines=48 + ac_sed_frag=1 # Number of current file. + ac_beg=1 # First line for current file. + ac_end=$ac_max_sed_lines # Line after last line for current file. + ac_more_lines=: + ac_sed_cmds= + while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + else + sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + fi + if test ! -s $tmp/subs.frag; then + ac_more_lines=false + else + # The purpose of the label and of the branching condition is to + # speed up the sed processing (if there are no `@' at all, there + # is no need to browse any of the substitutions). + # These are the two extra sed commands mentioned above. + (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" + else + 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 + ac_end=`expr $ac_end + $ac_max_sed_lines` + fi + done + if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat + fi +fi # test -n "$CONFIG_FILES" + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +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,:.*,,'` ;; + *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + * ) ac_file_in=$ac_file.in ;; esac - ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` - sed -e "$ac_comsub -s%@configure_input@%$configure_input%g -s%@srcdir@%$srcdir%g -s%@top_srcdir@%$top_srcdir%g -" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file -fi; done -rm -f conftest.s* + # 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 || +echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + { if $as_mkdir_p; then + mkdir -p "$ac_dir" + else + as_dir="$ac_dir" + as_dirs= + while test ! -d "$as_dir"; do + 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 || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + done + test ! -n "$as_dirs" || mkdir $as_dirs + fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 +echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} + { (exit 1); exit 1; }; }; } + + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi -EOF -cat >> $CONFIG_STATUS <<EOF +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# 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 + + + + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + if test x"$ac_file" = x-; then + configure_input= + else + configure_input="$ac_file. " + fi + configure_input=$configure_input"Generated from `echo $ac_file_in | + sed 's,.*/,,'` by configure." + + # First look for the input files in the build tree, otherwise in the + # src tree. + ac_file_inputs=`IFS=: + for f in $ac_file_in; do + 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 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + 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 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + fi;; + esac + done` || { (exit 1); exit 1; } +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + sed "$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s,@configure_input@,$configure_input,;t t +s,@srcdir@,$ac_srcdir,;t t +s,@abs_srcdir@,$ac_abs_srcdir,;t t +s,@top_srcdir@,$ac_top_srcdir,;t t +s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t +s,@builddir@,$ac_builddir,;t t +s,@abs_builddir@,$ac_abs_builddir,;t t +s,@top_builddir@,$ac_top_builddir,;t t +s,@abs_top_builddir@,$ac_abs_top_builddir,;t t +" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out + rm -f $tmp/stdin + if test x"$ac_file" != x-; then + mv $tmp/out $ac_file + else + cat $tmp/out + rm -f $tmp/out + fi -EOF -cat >> $CONFIG_STATUS <<\EOF +done +_ACEOF -exit 0 -EOF +cat >>$CONFIG_STATUS <<\_ACEOF + +{ (exit 0); exit 0; } +_ACEOF chmod +x $CONFIG_STATUS -rm -fr confdefs* $ac_clean_files -test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 +ac_clean_files=$ac_clean_files_save + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || { (exit 1); exit 1; } +fi diff --git a/tools/configure.in b/tools/configure.in index fe0c59b..542c1d3 100644 --- a/tools/configure.in +++ b/tools/configure.in @@ -2,6 +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) # Recover information that Tcl computed with its configure script. @@ -10,7 +11,7 @@ AC_INIT(man2tcl.c) # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.4 +DEF_VER=8.5 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/cvtEOL.tcl b/tools/cvtEOL.tcl deleted file mode 100644 index 8fa5441..0000000 --- a/tools/cvtEOL.tcl +++ /dev/null @@ -1,32 +0,0 @@ -# cvtEOL.tcl -- -# -# This file contains a script to parse a Tcl/Tk distribution and -# convert the EOL from \n to \r on all text files. -# -# Copyright (c) 1996-1997 by Sun Microsystems, Inc. - -# -# Convert files in the distribution to Mac style -# - -set distDir [lindex $argv 0] - -set dirs {unix mac generic win library compat tests unix/dltest \ - library/demos library/demos/images bitmaps xlib xlib/X11 .} -set files {*.c *.y *.h *.r *.tcl *.test *.rc *.bc *.vc *.bmp *.html \ - *.in *.notes *.terms all defs \ - README ToDo changes tclIndex configure install-sh mkLinks \ - square widget rmt ixset hello browse rolodex tcolor timer} - -foreach x $dirs { - if [catch {cd $distDir/$x}] continue - puts "Working on $x..." - foreach y [eval glob $files] { - exec chmod 666 $y - exec cp $y $y.tmp - exec tr \012 \015 < $y.tmp > $y - exec chmod 444 $y - exec rm $y.tmp - } -} - 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 new file mode 100755 index 0000000..f92b7ac --- /dev/null +++ b/tools/fix_tommath_h.tcl @@ -0,0 +1,98 @@ +# fixtommath.tcl -- +# +# Changes to 'tommath.h' to make it conform with Tcl's linking +# conventions. +# +# Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +#---------------------------------------------------------------------- + +set f [open [lindex $argv 0] r] +set data [read $f] +close $f + +set eat_endif 0 +set eat_semi 0 +set def_count 0 +foreach line [split $data \n] { + if { !$eat_semi && !$eat_endif } { + switch -regexp -- $line { + {#define BN_H_} { + puts $line + puts {} + puts "\#include <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 */" + } + default { + puts $line + } + } + } else { + puts $line + } + if {$eat_semi} { + if {[regexp {; *$} $line]} { + puts $after_semi + set eat_semi 0 + } + } + if {$eat_endif} { + if {[regexp {^\#endif} $line]} { + puts "\#endif" + set eat_endif 0 + } + } +} diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 8e8cbfd..464ba50 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -1,20 +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. -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" @@ -120,7 +122,7 @@ proc genStubs::hooks {names} { # Arguments: # index The index number of the interface. # platform The platform the interface belongs to. Should be one -# of generic, win, unix, or mac, or macosx or aqua or x11. +# of generic, win, unix, or macosx or aqua or x11. # decl The C function declaration, or {} for an undefined # entry. # @@ -131,10 +133,15 @@ proc genStubs::declare {args} { variable stubs variable curName - if {[llength $args] != 3} { + 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. @@ -144,6 +151,8 @@ proc genStubs::declare {args} { puts stderr "Duplicate entry: declare $args" } } + regsub -all const $decl CONST decl + regsub -all _XCONST $decl _Xconst decl regsub -all "\[ \t\n\]+" [string trim $decl] " " decl set decl [parseDecl $decl] @@ -159,6 +168,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 @@ -182,7 +210,7 @@ proc genStubs::rewriteFile {file text} { while {![eof $in]} { set line [gets $in] - if {[regexp {!BEGIN!} $line]} { + if {[string match "*!BEGIN!*" $line]} { break } puts $out $line @@ -191,7 +219,7 @@ proc genStubs::rewriteFile {file text} { puts $out $text while {![eof $in]} { set line [gets $in] - if {[regexp {!END!} $line]} { + if {[string match "*!END!*" $line]} { break } } @@ -213,28 +241,51 @@ 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 {}}} { + set text "" switch $plat { win { - return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n" + append text "#ifdef __WIN32__ /* WIN */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* WIN */\n${eltxt}" + } + append text "#endif /* WIN */\n" } unix { - return "#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */\n${text}#endif /* UNIX */\n" - } - mac { - return "#ifdef MAC_TCL\n${text}#endif /* MAC_TCL */\n" + append text "#if !defined(__WIN32__) && !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_TCL) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n" + append text "#if !(defined(__WIN32__) || 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 -- @@ -251,10 +302,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;\n"} return } @@ -273,8 +323,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]} { @@ -282,19 +332,23 @@ proc genStubs::parseDecl {decl} { return } set rtype [string trim $rtype] + if {$args == ""} { + 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 { @@ -355,6 +409,9 @@ proc genStubs::makeDecl {name decl index} { lassign $decl rtype fname args append text "/* $index */\n" + if {$rtype != "void"} { + regsub -all void $rtype VOID rtype + } set line "EXTERN $rtype" set count [expr {2 - ([string length $line] / 8)}] append line [string range "\t\t\t" 0 $count] @@ -363,27 +420,54 @@ proc genStubs::makeDecl {name decl index} { append line " " set pad 0 } - append line "$fname _ANSI_ARGS_(" + if {$args == ""} { + append line $fname + append text $line + append text ";\n" + return $text + } + append line $fname + regsub -all void $args VOID args set arg1 [lindex $args 0] switch -exact $arg1 { - void { + VOID { 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 ", ...)" } 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 } @@ -393,10 +477,9 @@ proc genStubs::makeDecl {name decl index} { append line ")" } } - append text $line - - append text ");\n" - return $text + append text $line ";" + format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \ + $fname $fname $text } # genStubs::makeMacro -- @@ -417,94 +500,15 @@ 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 "#ifndef $fname\n#define $fname \\\n\t(" + if {$args == ""} { + append text "*" } - append text " \\\n\t(${name}StubsPtr->$lfname)" + append text "${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" - return $text -} - # genStubs::makeSlot -- # # Generate the stub table entry for a function. @@ -524,29 +528,51 @@ proc genStubs::makeSlot {name decl index} { append lfname [string range $fname 1 end] set text " " - append text $rtype " (*" $lfname ") _ANSI_ARGS_(" - + if {$rtype != "void"} { + regsub -all void $rtype VOID rtype + } + if {$args == ""} { + append text $rtype " *" $lfname "; /* $index */\n" + return $text + } + if {[string range $rtype end-7 end] == "CALLBACK"} { + append text [string trim [string range $rtype 0 end-8]] " (CALLBACK *" $lfname ") " + } else { + append text $rtype " (*" $lfname ") " + } + regsub -all void $args VOID args set arg1 [lindex $args 0] switch -exact $arg1 { - void { + 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 ", ...)" } 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 +589,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] == ""} { + append text " &" [lindex $decl 1] ", /* " $index " */\n" + } else { + append text " " [lindex $decl 1] ", /* " $index " */\n" + } return $text } @@ -588,7 +618,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,109 +637,231 @@ 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 mac} { - 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)]} { - append text [addPlatformGuard aqua \ - [$slotProc $name $stubs($name,aqua,$i) $i]] + if {$temp ne ""} { + append text [addPlatformGuard $plat $temp] + set emit 1 + } + ## 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 + } + ## 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 } - if {[info exists stubs($name,macosx,$i)] - && ![info exists stubs($name,unix,$i)]} { - append text [addPlatformGuard macosx \ - [$slotProc $name $stubs($name,macosx,$i) $i]] + ## 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 } - if {[info exists stubs($name,x11,$i)] - && ![info exists stubs($name,unix,$i)]} { - append text [addPlatformGuard x11 \ - [$slotProc $name $stubs($name,x11,$i) $i]] + ## 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 mac} { - 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] } - # Again, make sure you don't duplicate entries for macosx & aqua. - if {[info exists stubs($name,aqua,lastNum)] - && ![info exists stubs($name,macosx,lastNum)]} { - set lastNum $stubs($name,aqua,lastNum) + ## 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,aqua,$i)]} { - eval {append temp} $skipString + if {[info exists stubs($name,$plat,$i)]} { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] } else { - append temp [$slotProc $name $stubs($name,aqua,$i) $i] - } + eval {append temp} $skipString } - append text [addPlatformGuard aqua $temp] } - # Again, make sure you don't duplicate entries for macosx & unix. - if {[info exists stubs($name,macosx,lastNum)] - && ![info exists stubs($name,unix,lastNum)]} { - set lastNum $stubs($name,macosx,lastNum) + append text [addPlatformGuard $plat $temp] + } + ## macosx ## + if {$block(macosx) && !$block(aqua) && !$block(x11)} { set temp {} + 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} { - if {![info exists stubs($name,macosx,$i)]} { - eval {append temp} $skipString - } else { - append temp [$slotProc $name $stubs($name,macosx,$i) $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 } } - append text [addPlatformGuard macosx $temp] + if {!$emit} { + eval {append temp} $skipString + } } - # Again, make sure you don't duplicate entries for x11 & unix. - if {[info exists stubs($name,x11,lastNum)] - && ![info exists stubs($name,unix,lastNum)]} { - set lastNum $stubs($name,x11,lastNum) + append text [addPlatformGuard macosx $temp] + } + ## aqua ## + if {$block(aqua)} { set temp {} + 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} { - if {![info exists stubs($name,x11,$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,x11,$i) $i] + } + } + append text [addPlatformGuard aqua $temp] + } + ## x11 ## + if {$block(x11)} { + set temp {} + 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] + } + set emit 1 + break } } - append text [addPlatformGuard x11 $temp] + if {!$emit} { + eval {append temp} $skipString + } } + append text [addPlatformGuard x11 $temp] + } } } @@ -725,7 +877,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" @@ -745,17 +896,18 @@ 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) &&\ + !defined(USE_${upName}_STUB_PROCS)\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) &&\ + !defined(USE_${upName}_STUB_PROCS) */\n" return } @@ -806,27 +958,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. @@ -847,7 +978,7 @@ proc genStubs::emitInit {name textVar} { append capName [string range $name 1 end] if {[info exists hooks($name)]} { - append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n" + append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n" set sep " " foreach sub $hooks($name) { append text $sep "&${sub}Stubs" @@ -862,7 +993,7 @@ proc genStubs::emitInit {name textVar} { } else { append text " NULL,\n" } - + forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"} append text "\};\n" @@ -953,13 +1084,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 f923df8..0000000 --- a/tools/genWinImage.tcl +++ /dev/null @@ -1,155 +0,0 @@ -# genWinImage.tcl -- -# -# This script generates the Windows installer. -# -# Copyright (c) 1999 by Scriptics Corporation. -# All rights reserved. - - -# 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 b986012..7b11e3f 100644 --- a/tools/index.tcl +++ b/tools/index.tcl @@ -130,7 +130,7 @@ proc text string { proc macro {name args} { switch $name { - SH { + SH - SS { global state switch $args { diff --git a/tools/installData.tcl b/tools/installData.tcl new file mode 100644 index 0000000..4b43f1e --- /dev/null +++ b/tools/installData.tcl @@ -0,0 +1,50 @@ +#!/bin/sh +#\ +exec tclsh "$0" ${1+"$@"} + +#---------------------------------------------------------------------- +# +# installData.tcl -- +# +# This file installs a hierarchy of data found in the directory +# specified by its first argument into the directory specified +# by its second. +# +#---------------------------------------------------------------------- +# +# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +#---------------------------------------------------------------------- + +proc copyDir {d1 d2} { + + puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \ + [file tail $d2]] + + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + copyDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + if {$::tcl_platform(platform) eq {unix}} { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if {$::tcl_platform(platform) eq {unix}} { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } + +} + +copyDir [file normalize [lindex $argv 0]] [file normalize [lindex $argv 1]] diff --git a/tools/loadICU.tcl b/tools/loadICU.tcl new file mode 100755 index 0000000..5b09e2c --- /dev/null +++ b/tools/loadICU.tcl @@ -0,0 +1,619 @@ +#---------------------------------------------------------------------- +# +# loadICU,tcl -- +# +# Extracts locale strings from a distribution of ICU +# (http://oss.software.ibm.com/developerworks/opensource/icu/project/) +# and makes Tcl message catalogs for the 'clock' command. +# +# Usage: +# loadICU.tcl sourceDir destDir +# +# Parameters: +# sourceDir -- Path name of the 'data' directory of your ICU4C +# distribution. +# destDir -- Directory into which the Tcl message catalogs should go. +# +# Results: +# None. +# +# Side effects: +# Creates the message catalogs. +# +#---------------------------------------------------------------------- +# +# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +#---------------------------------------------------------------------- + +# Calculate the Chinese numerals from zero to ninety-nine. + +set zhDigits [list {} \u4e00 \u4e8c \u4e09 \u56db \ + \u4e94 \u516d \u4e03 \u516b \u4e5d] +set t 0 +foreach zt $zhDigits { + if { $t == 0 } { + set zt {} + } elseif { $t == 10 } { + set zt \u5341 + } else { + append zt \u5341 + } + set d 0 + foreach zd $zhDigits { + if { $t == 0 && $d == 0 } { + set zd \u3007 + } elseif { $t == 20 && $d != 0 } { + set zt \u5eff + } elseif { $t == 30 && $d != 0 } { + set zt \u5345 + } + lappend zhNumbers $zt$zd + incr d + } + incr t 10 +} + +# Set format overrides for various locales. + +set format(zh,LOCALE_NUMERALS) $zhNumbers +set format(ja,LOCALE_ERAS) [list \ + [list -9223372036854775808 \u897f\u66a6 0 ] \ + [list -3061011600 \u660e\u6cbb 1867] \ + [list -1812186000 \u5927\u6b63 1911] \ + [list -1357635600 \u662d\u548c 1925] \ + [list 600220800 \u5e73\u6210 1988]] +set format(zh,LOCALE_DATE_FORMAT) "\u516c\u5143%Y\u5e74%B%Od\u65E5" +set format(ja,LOCALE_DATE_FORMAT) "%EY\u5e74%m\u6708%d\u65E5" +set format(ko,LOCALE_DATE_FORMAT) "%Y\ub144%B%Od\uc77c" +set format(zh,LOCALE_TIME_FORMAT) "%OH\u65f6%OM\u5206%OS\u79d2" +set format(ja,LOCALE_TIME_FORMAT) "%H\u6642%M\u5206%S\u79d2" +set format(ko,LOCALE_TIME_FORMAT) "%H\uc2dc%M\ubd84%S\ucd08" +set format(zh,LOCALE_DATE_TIME_FORMAT) "%A %Y\u5e74%B%Od\u65E5%OH\u65f6%OM\u5206%OS\u79d2 %z" +set format(ja,LOCALE_DATE_TIME_FORMAT) "%EY\u5e74%m\u6708%d\u65E5 (%a) %H\u6642%M\u5206%S\u79d2 %z" +set format(ko,LOCALE_DATE_TIME_FORMAT) "%A %Y\ub144%B%Od\uc77c%H\uc2dc%M\ubd84%S\ucd08 %z" +set format(ja,TIME_FORMAT_12) {%P %I:%M:%S} + +# The next set of format overrides were obtained from the glibc +# localization strings. + +set format(cs_CZ,DATE_FORMAT) %d.%m.%Y +set format(cs_CZ,DATE_TIME_FORMAT) {%a %e. %B %Y, %H:%M:%S %z} +set format(cs_CZ,TIME_FORMAT) %H:%M:%S +set format(cs_CZ,TIME_FORMAT_12) %I:%M:%S +set format(da_DK,DATE_FORMAT) %d-%m-%Y +set format(da_DK,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(da_DK,TIME_FORMAT) %T +set format(da_DK,TIME_FORMAT_12) %T +set format(de_AT,DATE_FORMAT) %Y-%m-%d +set format(de_AT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(de_AT,TIME_FORMAT) %T +set format(de_AT,TIME_FORMAT_12) %T +set format(de_BE,DATE_FORMAT) %Y-%m-%d +set format(de_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(de_BE,TIME_FORMAT) %T +set format(de_BE,TIME_FORMAT_12) %T +set format(de_CH,DATE_FORMAT) %Y-%m-%d +set format(de_CH,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(de_CH,TIME_FORMAT) %T +set format(de_CH,TIME_FORMAT_12) %T +set format(de_DE,DATE_FORMAT) %Y-%m-%d +set format(de_DE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(de_DE,TIME_FORMAT) %T +set format(de_DE,TIME_FORMAT_12) %T +set format(de_LU,DATE_FORMAT) %Y-%m-%d +set format(de_LU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(de_LU,TIME_FORMAT) %T +set format(de_LU,TIME_FORMAT_12) %T +set format(en_CA,DATE_FORMAT) %d/%m/%y +set format(en_CA,DATE_TIME_FORMAT) {%a %d %b %Y %r %z} +set format(en_CA,TIME_FORMAT) %r +set format(en_CA,TIME_FORMAT_12) {%I:%M:%S %p} +set format(en_DK,DATE_FORMAT) %Y-%m-%d +set format(en_DK,DATE_TIME_FORMAT) {%Y-%m-%dT%T %z} +set format(en_DK,TIME_FORMAT) %T +set format(en_DK,TIME_FORMAT_12) %T +set format(en_GB,DATE_FORMAT) %d/%m/%y +set format(en_GB,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(en_GB,TIME_FORMAT) %T +set format(en_GB,TIME_FORMAT_12) %T +set format(en_IE,DATE_FORMAT) %d/%m/%y +set format(en_IE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(en_IE,TIME_FORMAT) %T +set format(en_IE,TIME_FORMAT_12) %T +set format(en_US,DATE_FORMAT) %m/%d/%y +set format(en_US,DATE_TIME_FORMAT) {%a %d %b %Y %r %z} +set format(en_US,TIME_FORMAT) %r +set format(en_US,TIME_FORMAT_12) {%I:%M:%S %p} +set format(es_ES,DATE_FORMAT) %d/%m/%y +set format(es_ES,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(es_ES,TIME_FORMAT) %T +set format(es_ES,TIME_FORMAT_12) %T +set format(et_EE,DATE_FORMAT) %d.%m.%Y +set format(et_EE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(et_EE,TIME_FORMAT) %T +set format(et_EE,TIME_FORMAT_12) %T +set format(eu_ES,DATE_FORMAT) {%a, %Yeko %bren %da} +set format(eu_ES,DATE_TIME_FORMAT) {%y-%m-%d %T %z} +set format(eu_ES,TIME_FORMAT) %T +set format(eu_ES,TIME_FORMAT_12) %T +set format(fi_FI,DATE_FORMAT) %d.%m.%Y +set format(fi_FI,DATE_TIME_FORMAT) {%a %e %B %Y %T} +set format(fi_FI,TIME_FORMAT) %T +set format(fi_FI,TIME_FORMAT_12) %T +set format(fo_FO,DATE_FORMAT) %d/%m-%Y +set format(fo_FO,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(fo_FO,TIME_FORMAT) %T +set format(fo_FO,TIME_FORMAT_12) %T +set format(fr_BE,DATE_FORMAT) %d/%m/%y +set format(fr_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(fr_BE,TIME_FORMAT) %T +set format(fr_BE,TIME_FORMAT_12) %T +set format(fr_CA,DATE_FORMAT) %Y-%m-%d +set format(fr_CA,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(fr_CA,TIME_FORMAT) %T +set format(fr_CA,TIME_FORMAT_12) %T +set format(fr_CH,DATE_FORMAT) {%d. %m. %y} +set format(fr_CH,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(fr_CH,TIME_FORMAT) %T +set format(fr_CH,TIME_FORMAT_12) %T +set format(fr_FR,DATE_FORMAT) %d.%m.%Y +set format(fr_FR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(fr_FR,TIME_FORMAT) %T +set format(fr_FR,TIME_FORMAT_12) %T +set format(fr_LU,DATE_FORMAT) %d.%m.%Y +set format(fr_LU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(fr_LU,TIME_FORMAT) %T +set format(fr_LU,TIME_FORMAT_12) %T +set format(ga_IE,DATE_FORMAT) %d.%m.%y +set format(ga_IE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(ga_IE,TIME_FORMAT) %T +set format(ga_IE,TIME_FORMAT_12) %T +set format(gr_GR,DATE_FORMAT) %d/%m/%Y +set format(gr_GR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(gr_GR,TIME_FORMAT) %T +set format(gr_GR,TIME_FORMAT_12) %T +set format(hr_HR,DATE_FORMAT) %d.%m.%y +set format(hr_HR,DATE_TIME_FORMAT) {%a %d %b %Y %T} +set format(hr_HR,TIME_FORMAT) %T +set format(hr_HR,TIME_FORMAT_12) %T +set format(hu_HU,DATE_FORMAT) %Y-%m-%d +set format(hu_HU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(hu_HU,TIME_FORMAT) %T +set format(hu_HU,TIME_FORMAT_12) %T +set format(is_IS,DATE_FORMAT) {%a %e.%b %Y} +set format(is_IS,DATE_TIME_FORMAT) {%a %e.%b %Y, %T %z} +set format(is_IS,TIME_FORMAT) %T +set format(is_IS,TIME_FORMAT_12) %T +set format(it_IT,DATE_FORMAT) %d/%m/%Y +set format(it_IT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(it_IT,TIME_FORMAT) %T +set format(it_IT,TIME_FORMAT_12) %T +set format(iw_IL,DATE_FORMAT) %d/%m/%y +set format(iw_IL,DATE_TIME_FORMAT) {%z %H:%M:%S %Y %b %d %a} +set format(iw_IL,TIME_FORMAT) %H:%M:%S +set format(iw_IL,TIME_FORMAT_12) {%I:%M:%S %P} +set format(kl_GL,DATE_FORMAT) {%d %b %Y} +set format(kl_GL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(kl_GL,TIME_FORMAT) %T +set format(kl_GL,TIME_FORMAT_12) %T +set format(lt_LT,DATE_FORMAT) %Y.%m.%d +set format(lt_LT,DATE_TIME_FORMAT) {%Y m. %B %d d. %T} +set format(lt_LT,TIME_FORMAT) %T +set format(lt_LT,TIME_FORMAT_12) %T +set format(lv_LV,DATE_FORMAT) %Y.%m.%d. +set format(lv_LV,DATE_TIME_FORMAT) {%A, %Y. gada %e. %B, plkst. %H un %M} +set format(lv_LV,TIME_FORMAT) %T +set format(lv_LV,TIME_FORMAT_12) %T +set format(nl_BE,DATE_FORMAT) %d-%m-%y +set format(nl_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(nl_BE,TIME_FORMAT) %T +set format(nl_BE,TIME_FORMAT_12) %T +set format(nl_NL,DATE_FORMAT) %d-%m-%y +set format(nl_NL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(nl_NL,TIME_FORMAT) %T +set format(nl_NL,TIME_FORMAT_12) %T +set format(no_NO,DATE_FORMAT) %d-%m-%Y +set format(no_NO,DATE_TIME_FORMAT) {%a %d-%m-%Y %T %z} +set format(no_NO,TIME_FORMAT) %T +set format(no_NO,TIME_FORMAT_12) %T +set format(pl_PL,DATE_FORMAT) %Y-%m-%d +set format(pl_PL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(pl_PL,TIME_FORMAT) %T +set format(pl_PL,TIME_FORMAT_12) %T +set format(pt_BR,DATE_FORMAT) %d-%m-%Y +set format(pt_BR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(pt_BR,TIME_FORMAT) %T +set format(pt_BR,TIME_FORMAT_12) %T +set format(pt_PT,DATE_FORMAT) %d-%m-%Y +set format(pt_PT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(pt_PT,TIME_FORMAT) %T +set format(pt_PT,TIME_FORMAT_12) %T +set format(ro_RO,DATE_FORMAT) %Y-%m-%d +set format(ro_RO,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(ro_RO,TIME_FORMAT) %T +set format(ro_RO,TIME_FORMAT_12) %T +set format(ru_RU,DATE_FORMAT) %d.%m.%Y +set format(ru_RU,DATE_TIME_FORMAT) {%a %d %b %Y %T} +set format(ru_RU,TIME_FORMAT) %T +set format(ru_RU,TIME_FORMAT_12) %T +set format(sl_SI,DATE_FORMAT) %d.%m.%Y +set format(sl_SI,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(sl_SI,TIME_FORMAT) %T +set format(sl_SI,TIME_FORMAT_12) %T +set format(sv_FI,DATE_FORMAT) %Y-%m-%d +set format(sv_FI,DATE_TIME_FORMAT) {%a %e %b %Y %H.%M.%S} +set format(sv_FI,TIME_FORMAT) %H.%M.%S +set format(sv_FI,TIME_FORMAT_12) %H.%M.%S +set format(sv_SE,DATE_FORMAT) %Y-%m-%d +set format(sv_SE,DATE_TIME_FORMAT) {%a %e %b %Y %H.%M.%S} +set format(sv_SE,TIME_FORMAT) %H.%M.%S +set format(sv_SE,TIME_FORMAT_12) %H.%M.%S +set format(tr_TR,DATE_FORMAT) %Y-%m-%d +set format(tr_TR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} +set format(tr_TR,TIME_FORMAT) %T +set format(tr_TR,TIME_FORMAT_12) %T + +#---------------------------------------------------------------------- +# +# handleLocaleFile -- +# +# Extracts strings from an ICU locale definition. +# +# Parameters: +# localeName - Name of the locale (e.g., de_AT_euro) +# fileName - Name of the file containing the data +# msgFileName - Name of the file containing the Tcl message catalog +# +# Results: +# None. +# +# Side effects: +# Writes the Tcl message catalog. +# +#---------------------------------------------------------------------- + +proc handleLocaleFile { localeName fileName msgFileName } { + variable format + + # Get the content of the ICU file + + set f [open $fileName r] + fconfigure $f -encoding utf-8 + set data [read $f] + close $f + + # Parse the ICU data + + set state {} + foreach line [split $data \n] { + switch -exact -- $state { + {} { + + # Look for the beginnings of data blocks + + switch -regexp -- $line { + {^[[:space:]]*AmPmMarkers[[:space:]]+[\{]} { + set state data + set key AmPmMarkers + } + {^[[:space:]]*DateTimePatterns[[:space:]]+[\{]} { + set state data + set key DateTimePatterns + } + {^[[:space:]]*DayAbbreviations[[:space:]]+[\{]} { + set state data + set key DayAbbreviations + } + {^[[:space:]]*DayNames[[:space:]]+[\{]} { + set state data + set key DayNames + } + {^[[:space:]]*Eras[[:space:]]+[\{]} { + set state data + set key Eras + } + {^[[:space:]]*MonthAbbreviations[[:space:]]+[\{]} { + set state data + set key MonthAbbreviations + } + {^[[:space:]]*MonthNames[[:space:]]+[\{]} { + set state data + set key MonthNames + } + } + } + data { + + + # Inside a data block, collect the strings, doing backslash + # expansion to pick up the Unicodes + + if { [regexp {"(.*)",} $line -> item] } { + lappend items($key) [subst -nocommands -novariables $item] + } elseif { [regexp {^[[:space:]]*[\}][[:space:]]*$} $line] } { + set state {} + } + } + } + } + + # Skip locales that don't change time strings. + + if {![array exists items]} return + + # Write the Tcl message catalog + + set f [open $msgFileName w] + + # Write a header + + puts $f "\# created by $::argv0 -- do not edit" + puts $f "namespace eval ::tcl::clock \{" + + # Do ordinary sets of strings (weekday and month names) + + foreach key { + DayAbbreviations DayNames MonthAbbreviations MonthNames + } tkey { + DAYS_OF_WEEK_ABBREV DAYS_OF_WEEK_FULL + MONTHS_ABBREV MONTHS_FULL + } { + if { [info exists items($key)] } { + set itemList $items($key) + set cmd1 " ::msgcat::mcset " + append cmd1 $localeName " " $tkey " \[list " + foreach item $itemList { + append cmd1 \\\n { } \" [backslashify $item] \" + } + append cmd1 \] + puts $f $cmd1 + } + } + + # Do the eras, B.C.E., and C.E. + + if { [info exists items(Eras)] } { + foreach { bce ce } $items(Eras) break + set cmd " ::msgcat::mcset " + append cmd $localeName " " BCE " \"" [backslashify $bce] \" + puts $f $cmd + set cmd " ::msgcat::mcset " + append cmd $localeName " " CE " \"" [backslashify $ce] \" + puts $f $cmd + } + + # Do the AM and PM markers + + if { [info exists items(AmPmMarkers)] } { + foreach { am pm } $items(AmPmMarkers) break + set cmd " ::msgcat::mcset " + append cmd $localeName " " AM " \"" [backslashify $am] \" + puts $f $cmd + set cmd " ::msgcat::mcset " + append cmd $localeName " " PM " \"" [backslashify $pm] \" + puts $f $cmd + } + + # Do the date/time patterns. First date... + + if { [info exists format($localeName,DATE_FORMAT)] + || [info exists items(DateTimePatterns)] } { + + # Find the shortest date format that includes a 4-digit year. + + if { ![info exists format($localeName,DATE_FORMAT)] } { + for { set i 7 } { $i >= 4 } { incr i -1 } { + if { [regexp yyyy [lindex $items(DateTimePatterns) $i]] } { + break + } + } + set fmt \ + [backslashify \ + [percentify [lindex $items(DateTimePatterns) $i]]] + set format($localeName,DATE_FORMAT) $fmt + } + + # Put it to the message catalog + + set cmd " ::msgcat::mcset " + append cmd $localeName " DATE_FORMAT \"" \ + $format($localeName,DATE_FORMAT) "\"" + puts $f $cmd + } + + # Time + + if { [info exists format($localeName,TIME_FORMAT)] + || [info exists items(DateTimePatterns)] } { + + # Find the shortest time pattern that includes the seconds + + if { ![info exists format($localeName,TIME_FORMAT)] } { + for { set i 3 } { $i >= 0 } { incr i -1 } { + if { [regexp H [lindex $items(DateTimePatterns) $i]] + && [regexp s [lindex $items(DateTimePatterns) $i]] } { + break + } + } + if { $i >= 0 } { + set fmt \ + [backslashify \ + [percentify [lindex $items(DateTimePatterns) $i]]] + regsub { %Z} $fmt {} format($localeName,TIME_FORMAT) + } + } + + # Put it to the message catalog + + if { [info exists format($localeName,TIME_FORMAT)] } { + set cmd " ::msgcat::mcset " + append cmd $localeName " TIME_FORMAT \"" \ + $format($localeName,TIME_FORMAT) "\"" + puts $f $cmd + } + } + + # 12-hour time... + + if { [info exists format($localeName,TIME_FORMAT_12)] + || [info exists items(DateTimePatterns)] } { + + # Shortest patterm with 12-hour time that includes seconds + + if { ![info exists format($localeName,TIME_FORMAT_12)] } { + for { set i 3 } { $i >= 0 } { incr i -1 } { + if { [regexp h [lindex $items(DateTimePatterns) $i]] + && [regexp s [lindex $items(DateTimePatterns) $i]] } { + break + } + } + if { $i >= 0 } { + set fmt \ + [backslashify \ + [percentify [lindex $items(DateTimePatterns) $i]]] + regsub { %Z} $fmt {} format($localeName,TIME_FORMAT_12) + } + } + + # Put it to the catalog + + if { [info exists format($localeName,TIME_FORMAT_12)] } { + set cmd " ::msgcat::mcset " + append cmd $localeName " TIME_FORMAT_12 \"" \ + $format($localeName,TIME_FORMAT_12) "\"" + puts $f $cmd + } + } + + # Date and time... Prefer 24-hour format to 12-hour format. + + if { ![info exists format($localeName,DATE_TIME_FORMAT)] + && [info exists format($localeName,DATE_FORMAT)] + && [info exists format($localeName,TIME_FORMAT)]} { + set format($localeName,DATE_TIME_FORMAT) \ + $format($localeName,DATE_FORMAT) + append format($localeName,DATE_TIME_FORMAT) \ + " " $format($localeName,TIME_FORMAT) " %z" + } + if { ![info exists format($localeName,DATE_TIME_FORMAT)] + && [info exists format($localeName,DATE_FORMAT)] + && [info exists format($localeName,TIME_FORMAT_12)]} { + set format($localeName,DATE_TIME_FORMAT) \ + $format($localeName,DATE_FORMAT) + append format($localeName,DATE_TIME_FORMAT) \ + " " $format($localeName,TIME_FORMAT_12) " %z" + } + + # Write date/time format to the file + + if { [info exists format($localeName,DATE_TIME_FORMAT)] } { + set cmd " ::msgcat::mcset " + append cmd $localeName " DATE_TIME_FORMAT \"" \ + $format($localeName,DATE_TIME_FORMAT) "\"" + puts $f $cmd + } + + # Write the string sets to the file. + + foreach key { + LOCALE_NUMERALS LOCALE_DATE_FORMAT LOCALE_TIME_FORMAT + LOCALE_DATE_TIME_FORMAT LOCALE_ERAS LOCALE_YEAR_FORMAT + } { + if { [info exists format($localeName,$key)] } { + set cmd " ::msgcat::mcset " + append cmd $localeName " " $key " \"" \ + [backslashify $format($localeName,$key)] "\"" + puts $f $cmd + } + } + + # Footer + + puts $f "\}" + close $f +} + +#---------------------------------------------------------------------- +# +# percentify -- +# +# Converts a Java/ICU-style time format to a C/Tcl style one. +# +# Parameters: +# string -- Format to convert +# +# Results: +# Returns the converted format. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc percentify { string } { + set retval {} + foreach { unquoted quoted } [split $string '] { + append retval [string map { + EEEE %A MMMM %B yyyy %Y + MMM %b EEE %a + dd %d hh %I HH %H mm %M MM %m ss %S yy %y + a %P d %e h %l H %k M %m z %z + } $unquoted] + append retval $quoted + } + return $retval +} + +#---------------------------------------------------------------------- +# +# backslashify -- +# +# Converts a UTF-8 string to a plain ASCII one with escapes. +# +# Parameters: +# string -- String to convert +# +# Results: +# Returns the converted string +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc backslashify { string } { + + set retval {} + foreach char [split $string {}] { + scan $char %c ccode + if { $ccode >= 0x0020 && $ccode < 0x007f && $char ne "\"" + && $char ne "\{" && $char ne "\}" && $char ne "\[" + && $char ne "\]" && $char ne "\\" && $char ne "\$" } { + append retval $char + } else { + append retval \\u [format %04x $ccode] + } + } + return $retval +} + +#---------------------------------------------------------------------- +# +# MAIN PROGRAM +# +#---------------------------------------------------------------------- + +# Extract directories from command line + +foreach { icudir msgdir } $argv break + +# Walk the ICU files and create corresponding Tcl message catalogs + +foreach fileName [glob -directory $icudir *.txt] { + set n [file rootname [file tail $fileName]] + if { [regexp {^[a-z]{2,3}(_[A-Z]{2,3}(_.*)?)?$} $n] } { + handleLocaleFile $n $fileName [file join $msgdir [string tolower $n].msg] + } +} diff --git a/tools/makeTestCases.tcl b/tools/makeTestCases.tcl new file mode 100755 index 0000000..d96a221 --- /dev/null +++ b/tools/makeTestCases.tcl @@ -0,0 +1,1180 @@ +# TODO - When integrating this with the Core, path names will need to be +# swizzled here. + +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 { + ::msgcat::mcmset en_US_roman { + LOCALE_ERAS { + {-62164627200 {} 0} + {-59008867200 c 100} + {-55853107200 cc 200} + {-52697347200 ccc 300} + {-49541587200 cd 400} + {-46385827200 d 500} + {-43230067200 dc 600} + {-40074307200 dcc 700} + {-36918547200 dccc 800} + {-33762787200 cm 900} + {-30607027200 m 1000} + {-27451267200 mc 1100} + {-24295507200 mcc 1200} + {-21139747200 mccc 1300} + {-17983987200 mcd 1400} + {-14828227200 md 1500} + {-11672467200 mdc 1600} + {-8516707200 mdcc 1700} + {-5364662400 mdccc 1800} + {-2208988800 mcm 1900} + {946684800 mm 2000} + } + LOCALE_NUMERALS { + ? i ii iii iv v vi vii viii ix + x xi xii xiii xiv xv xvi xvii xviii xix + xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix + xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix + xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix + l li lii liii liv lv lvi lvii lviii lix + lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix + lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix + lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii + lxxxix + xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix + c + } + DATE_FORMAT {%m/%d/%Y} + TIME_FORMAT {%H:%M:%S} + DATE_TIME_FORMAT {%x %X} + LOCALE_DATE_FORMAT {die %Od mensis %Om annoque %EY} + LOCALE_TIME_FORMAT {%OH h %OM m %OS s} + LOCALE_DATE_TIME_FORMAT {%Ex %EX} + } +} + +#---------------------------------------------------------------------- +# +# listYears -- +# +# List the years to test in the common clock test cases. +# +# Parameters: +# startOfYearArray - Name of an array in caller's scope that will +# be initialized as +# Results: +# None +# +# Side effects: +# Determines the year numbers of one common year, one leap year, one year +# following a common year, and one year following a leap year -- starting +# on each day of the week -- in the XIXth, XXth and XXIth centuries. +# Initializes the given array to have keys equal to the year numbers and +# values equal to [clock seconds] at the start of the corresponding +# years. +# +#---------------------------------------------------------------------- + +proc listYears { startOfYearArray } { + + upvar 1 $startOfYearArray startOfYear + + # List years after 1970 + + set y 1970 + set s 0 + set dw 4 ;# Thursday + while { $y < 2100 } { + if { $y % 4 == 0 && $y % 100 != 0 || $y % 400 == 0 } { + set l 1 + incr dw 366 + set s2 [expr { $s + wide( 366 * 86400 ) }] + } else { + set l 0 + incr dw 365 + set s2 [expr { $s + wide( 365 * 86400 ) }] + } + set x [expr { $y >= 2037 }] + set dw [expr {$dw % 7}] + set c [expr { $y / 100 }] + if { ![info exists do($x$c$dw$l)] } { + set do($x$c$dw$l) $y + set startOfYear($y) $s + set startOfYear([expr {$y + 1}]) $s2 + } + set s $s2 + incr y + } + + # List years before 1970 + + set y 1970 + set s 0 + set dw 4; # Thursday + while { $y >= 1801 } { + set s0 $s + incr dw 371 + incr y -1 + if { $y % 4 == 0 && $y % 100 != 0 || $y % 400 == 0 } { + set l 1 + incr dw -366 + set s [expr { $s - wide(366 * 86400) }] + } else { + set l 0 + incr dw -365 + set s [expr { $s - wide(365 * 86400) }] + } + set dw [expr {$dw % 7}] + set c [expr { $y / 100 }] + if { ![info exists do($c$dw$l)] } { + set do($c$dw$l) $y + set startOfYear($y) $s + set startOfYear([expr {$y + 1}]) $s0 + } + } + +} + +#---------------------------------------------------------------------- +# +# processFile - +# +# Processes the 'clock.test' file, updating the test cases in it. +# +# Parameters: +# None. +# +# Side effects: +# Replaces the file with a new copy, constructing needed test cases. +# +#---------------------------------------------------------------------- + +proc processFile {d} { + + # Open two files + + set f1 [open [file join $d tests/clock.test] r] + set f2 [open [file join $d tests/clock.new] w] + + # Copy leading portion of the test file + + set state {} + while { [gets $f1 line] >= 0 } { + switch -exact -- $state { + {} { + puts $f2 $line + if { [regexp "^\# BEGIN (.*)" $line -> cases] + && [string compare {} [info commands $cases]] } { + set state inCaseSet + $cases $f2 + } + } + inCaseSet { + if { [regexp "^\#\ END $cases\$" $line] } { + puts $f2 $line + set state {} + } + } + } + } + + # Rotate the files + + close $f1 + close $f2 + file delete -force [file join $d tests/clock.bak] + file rename -force [file join $d tests/clock.test] \ + [file join $d tests/clock.bak] + file rename [file join $d tests/clock.new] [file join $d tests/clock.test] + +} + +#---------------------------------------------------------------------- +# +# testcases2 -- +# +# Outputs the 'clock-2.x' test cases. +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for formatting in Gregorian calendar are written to the +# output file. +# +#---------------------------------------------------------------------- + +proc testcases2 { f2 } { + + listYears startOfYear + + # Define the roman numerals + + set roman { + ? i ii iii iv v vi vii viii ix + x xi xii xiii xiv xv xvi xvii xviii xix + xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix + xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix + xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix + l li lii liii liv lv lvi lvii lviii lix + lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix + lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix + lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii lxxxix + xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix + c + } + set romanc { + ? c cc ccc cd d dc dcc dccc cm + m mc mcc mccc mcd md mdc mdcc mdccc mcm + mm mmc mmcc mmccc mmcd mmd mmdc mmdcc mmdccc mmcm + mmm mmmc mmmcc mmmccc mmmcd mmmd mmmdc mmmdcc mmmdccc mmmcm + } + + # Names of the months + + set short {{} Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} + set long { + {} January February March April May June July August September + October November December + } + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test formatting of Gregorian year, month, day, all formats" + puts $f2 "\# Formats tested: %b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y %EY" + puts $f2 "" + + # Generate the test cases for the first and last day of every month + # from 1896 to 2045 + + set n 0 + foreach { y } [lsort -integer [array names startOfYear]] { + set s [expr { $startOfYear($y) + wide(12*3600 + 34*60 + 56) }] + set m 0 + set yd 1 + foreach hath { 31 28 31 30 31 30 31 31 30 31 30 31 } { + incr m + if { $m == 2 && ( $y%4 == 0 && $y%100 != 0 || $y%400 == 0 ) } { + incr hath + } + + set b [lindex $short $m] + set B [lindex $long $m] + set C [format %02d [expr { $y / 100 }]] + set h $b + set j [format %03d $yd] + set mm [format %02d $m] + set N [format %2d $m] + set yy [format %02d [expr { $y % 100 }]] + + set J [expr { ( $s / 86400 ) + 2440588 }] + + set dt $y-$mm-01 + set result "" + append result $b " " $B " " \ + $mm /01/ $y " 12:34:56 " \ + "die i mensis " [lindex $roman $m] " annoque " \ + [lindex $romanc [expr { $y / 100 }]] \ + [lindex $roman [expr { $y % 100 }]] " " \ + [lindex $roman 12] " h " [lindex $roman 34] " m " \ + [lindex $roman 56] " s " \ + $C " " [lindex $romanc [expr { $y / 100 }]] \ + " 01 i 1 i " \ + $h " " $j " " $J " " $mm " " [lindex $roman $m] " " $N \ + " " $mm "/01/" $y \ + " die i mensis " [lindex $roman $m] " annoque " \ + [lindex $romanc [expr { $y / 100 }]] \ + [lindex $roman [expr { $y % 100 }]] \ + " " $yy " " [lindex $roman [expr { $y % 100 }]] " " $y + puts $f2 "test clock-2.[incr n] {conversion of $dt} {" + puts $f2 " clock format $s \\" + puts $f2 "\t-format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \\" + puts $f2 "\t-gmt true -locale en_US_roman" + puts $f2 "} {$result}" + + set hm1 [expr { $hath - 1 }] + incr s [expr { 86400 * ( $hath - 1 ) }] + incr yd $hm1 + + set dd [format %02d $hath] + set ee [format %2d $hath] + set j [format %03d $yd] + + set J [expr { ( $s / 86400 ) + 2440588 }] + + set dt $y-$mm-$dd + set result "" + append result $b " " $B " " \ + $mm / $dd / $y " 12:34:56 " \ + "die " [lindex $roman $hath] " mensis " [lindex $roman $m] \ + " annoque " \ + [lindex $romanc [expr { $y / 100 }]] \ + [lindex $roman [expr { $y % 100 }]] " " \ + [lindex $roman 12] " h " [lindex $roman 34] " m " \ + [lindex $roman 56] " s " \ + $C " " [lindex $romanc [expr { $y / 100 }]] \ + " " $dd " " [lindex $roman $hath] " " \ + $ee " " [lindex $roman $hath] " "\ + $h " " $j " " $J " " $mm " " [lindex $roman $m] " " $N \ + " " $mm "/" $dd "/" $y \ + " die " [lindex $roman $hath] " mensis " [lindex $roman $m] \ + " annoque " \ + [lindex $romanc [expr { $y / 100 }]] \ + [lindex $roman [expr { $y % 100 }]] \ + " " $yy " " [lindex $roman [expr { $y % 100 }]] " " $y + puts $f2 "test clock-2.[incr n] {conversion of $dt} {" + puts $f2 " clock format $s \\" + puts $f2 "\t-format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \\" + puts $f2 "\t-gmt true -locale en_US_roman" + puts $f2 "} {$result}" + + incr s 86400 + incr yd + } + } + puts "testcases2: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases3 -- +# +# Generate test cases for ISO8601 calendar. +# +# Parameters: +# f2 - Channel handle to the output file +# +# Results: +# None +# +# Side effects: +# Makes a test case for the first and last day of weeks 51, 52, and 1 +# plus the first and last day of a year. Does so for each possible +# weekday on which a Common Year or Leap Year can begin. +# +#---------------------------------------------------------------------- + +proc testcases3 { f2 } { + + listYears startOfYear + + set case 0 + foreach { y } [lsort -integer [array names startOfYear]] { + set secs $startOfYear($y) + set ym1 [expr { $y - 1 }] + 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 }] + } + 6 { + # messy case because previous year may have had 52 or 53 weeks + if { $y%4 == 1 } { + testISO $f2 $ym1 53 1 [expr { $secs - 5*86400 }] + testISO $f2 $ym1 53 6 $secs + testISO $f2 $ym1 53 7 [expr { $secs + 86400 }] + } else { + testISO $f2 $ym1 52 1 [expr { $secs - 5*86400 }] + testISO $f2 $ym1 52 6 $secs + 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 }] + } + } + } + puts "testcases3: $case test cases." + +} + +proc testISO { f2 G V u secs } { + + upvar 1 case case + + set longdays {Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sunday} + 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 %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\ + [clock format $secs -format %U -gmt true]\ + [format %02d $V] [expr { $u % 7 }]\ + [clock format $secs -format %W -gmt true]}" + +} + +#---------------------------------------------------------------------- +# +# testcases4 -- +# +# Makes the test cases that test formatting of time of day. +# +# Parameters: +# f2 - Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Writes test cases to the output. +# +#---------------------------------------------------------------------- + +proc testcases4 { f2 } { + + puts $f2 {} + puts $f2 "\# Test formatting of time of day" + puts $f2 "\# Format groups tested: %H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+" + puts $f2 {} + + set i 0 + set fmt "%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+" + foreach { h romanH I romanI am } { + 0 ? 12 xii AM + 1 i 1 i AM + 11 xi 11 xi AM + 12 xii 12 xii PM + 13 xiii 1 i PM + 23 xxiii 11 xi PM + } { + set hh [format %02d $h] + set II [format %02d $I] + set hs [format %2d $h] + set Is [format %2d $I] + foreach { m romanM } { 0 ? 1 i 58 lviii 59 lix } { + set mm [format %02d $m] + foreach { s romanS } { 0 ? 1 i 58 lviii 59 lix } { + set ss [format %02d $s] + set x [expr { ( $h * 60 + $m ) * 60 + $s }] + set result "" + append result $hh " " $romanH " " $II " " $romanI " " \ + $hs " " $romanH " " $Is " " $romanI " " $mm " " $romanM " " \ + $am " " [string tolower $am] " " \ + $II ":" $mm ":" $ss " " [string tolower $am] " " \ + $hh ":" $mm " " \ + $ss " " $romanS " " \ + $hh ":" $mm ":" $ss " " \ + $hh ":" $mm ":" $ss " " \ + $romanH " h " $romanM " m " $romanS " s " \ + "Thu Jan 1 " $hh : $mm : $ss " GMT 1970" + puts $f2 "test clock-4.[incr i] { format time of day $hh:$mm:$ss } {" + puts $f2 " clock format $x \\" + puts $f2 " -format [list $fmt] \\" + puts $f2 " -locale en_US_roman \\" + puts $f2 " -gmt true" + puts $f2 "} {$result}" + } + } + } + + puts "testcases4: $i test cases." +} + +#---------------------------------------------------------------------- +# +# testcases5 -- +# +# Generates the test cases for Daylight Saving Time +# +# Parameters: +# f2 - Channel handle for the input file +# +# Results: +# None. +# +# Side effects: +# Makes test cases for each known or anticipated time change +# in Detroit. +# +#---------------------------------------------------------------------- + +proc testcases5 { f2 } { + variable TZData + + puts $f2 {} + puts $f2 "\# Test formatting of Daylight Saving Time" + puts $f2 {} + + set fmt {%H:%M:%S %z %Z} + + set i 0 + puts $f2 "test clock-5.[incr i] {does Detroit exist} {" + puts $f2 " clock format 0 -format {} -timezone :America/Detroit" + 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 " concat {ok}" + puts $f2 " }" + puts $f2 "} ok" + + foreach row $TZData(:America/Detroit) { + foreach { t offset isdst tzname } $row break + if { $t > -4000000000000 } { + set conds [list detroit] + if { $t > wide(0x7fffffff) } { + set conds [list detroit y2038] + } + incr t -1 + set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ + -timezone :America/Detroit] + set r [clock format $t -format $fmt \ + -timezone :America/Detroit] + puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" + puts $f2 " clock format $t -format [list $fmt] \\" + puts $f2 " -timezone :America/Detroit" + puts $f2 "} [list $r]" + incr t + set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ + -timezone :America/Detroit] + set r [clock format $t -format $fmt \ + -timezone :America/Detroit] + puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" + puts $f2 " clock format $t -format [list $fmt] \\" + puts $f2 " -timezone :America/Detroit" + puts $f2 "} [list $r]" + incr t + set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ + -timezone :America/Detroit] + set r [clock format $t -format $fmt \ + -timezone :America/Detroit] + puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" + puts $f2 " clock format $t -format [list $fmt] \\" + puts $f2 " -timezone :America/Detroit" + puts $f2 "} [list $r]" + } + } + puts "testcases5: $i test cases" +} + +#---------------------------------------------------------------------- +# +# testcases8 -- +# +# Outputs the 'clock-8.x' test cases. +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for parsing dates in ccyymmdd format are written to the +# output file. +# +#---------------------------------------------------------------------- + +proc testcases8 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of ccyymmdd" + puts $f2 "" + + set n 0 + foreach year {1970 1971 2000 2001} { + foreach month {01 12} { + foreach day {02 31} { + set scanned [clock scan $year$month$day -gmt true] + foreach ccyy {%C%y %Y} { + foreach mm {%b %B %h %m %Om %N} { + foreach dd {%d %Od %e %Oe} { + set string [clock format $scanned \ + -format "$ccyy $mm $dd" \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-8.[incr n] {parse ccyymmdd} {" + puts $f2 " [list clock scan $string -format [list $ccyy $mm $dd] -locale en_US_roman -gmt 1]" + puts $f2 "} $scanned" + } + } + } + foreach fmt {%x %D} { + set string [clock format $scanned \ + -format $fmt \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-8.[incr n] {parse ccyymmdd} {" + puts $f2 " [list clock scan $string -format $fmt -locale en_US_roman -gmt 1]" + puts $f2 "} $scanned" + } + } + } + } + + puts "testcases8: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases11 -- +# +# Outputs the 'clock-11.x' test cases. +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for precedence among YYYYMMDD and YYYYDDD are written +# to f2. +# +#---------------------------------------------------------------------- + +proc testcases11 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test precedence among yyyymmdd and yyyyddd" + puts $f2 "" + + array set v { + Y 1970 + m 01 + d 01 + j 002 + } + + set n 0 + + foreach {a b c d} { + Y m d j m Y d j d Y m j j Y m d + Y m j d m Y j d d Y j m j Y d m + Y d m j m d Y j d m Y j j m Y d + Y d j m m d j Y d m j Y j m d Y + Y j m d m j Y d d j Y m j d Y m + Y j d m m j d Y d j m Y j d m Y + } { + foreach x [list $a $b $c $d] { + switch -exact -- $x { + m - d { + set value 0 + } + j { + set value 86400 + } + } + } + set format "%$a%$b%$c%$d" + set string "$v($a)$v($b)$v($c)$v($d)" + puts $f2 "test clock-11.[incr n] {precedence of ccyyddd and ccyymmdd} {" + puts $f2 " [list clock scan $string -format $format -gmt 1]" + puts $f2 "} $value" + } + + puts "testcases11: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases12 -- +# +# Outputs the 'clock-12.x' test cases, parsing CCyyWwwd +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for parsing dates in Gregorian calendar are written to the +# output file. +# +#---------------------------------------------------------------------- + +proc testcases12 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of ccyyWwwd" + puts $f2 "" + + set n 0 + foreach year {1970 1971 2000 2001} { + foreach month {01 12} { + foreach day {02 31} { + set scanned [clock scan $year$month$day -gmt true] + foreach d {%a %A %u %w %Ou %Ow} { + set string [clock format $scanned \ + -format "%G W%V $d" \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-12.[incr n] {parse ccyyWwwd} {" + puts $f2 " [list clock scan $string -format [list %G W%V $d] -locale en_US_roman -gmt 1]" + puts $f2 "} $scanned" + } + } + } + } + + puts "testcases12: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases14 -- +# +# Outputs the 'clock-14.x' test cases. +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for parsing yymmdd dates are output. +# +#---------------------------------------------------------------------- + +proc testcases14 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of yymmdd" + puts $f2 "" + + set n 0 + foreach year {1938 1970 2000 2037} { + foreach month {01 12} { + foreach day {02 31} { + set scanned [clock scan $year$month$day -gmt true] + foreach yy {%y %Oy} { + foreach mm {%b %B %h %m %Om %N} { + foreach dd {%d %Od %e %Oe} { + set string [clock format $scanned \ + -format "$yy $mm $dd" \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-14.[incr n] {parse yymmdd} {" + puts $f2 " [list clock scan $string -format [list $yy $mm $dd] -locale en_US_roman -gmt 1]" + puts $f2 "} $scanned" + } + } + } + } + } + } + + puts "testcases14: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases17 -- +# +# Outputs the 'clock-17.x' test cases, parsing yyWwwd +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for parsing dates in Gregorian calendar are written to the +# output file. +# +#---------------------------------------------------------------------- + +proc testcases17 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of yyWwwd" + puts $f2 "" + + set n 0 + foreach year {1970 1971 2000 2001} { + foreach month {01 12} { + foreach day {02 31} { + set scanned [clock scan $year$month$day -gmt true] + foreach d {%a %A %u %w %Ou %Ow} { + set string [clock format $scanned \ + -format "%g W%V $d" \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-17.[incr n] {parse yyWwwd} {" + puts $f2 " [list clock scan $string -format [list %g W%V $d] -locale en_US_roman -gmt 1]" + puts $f2 "} $scanned" + } + } + } + } + + puts "testcases17: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases19 -- +# +# Outputs the 'clock-19.x' test cases. +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for parsing mmdd dates are output. +# +#---------------------------------------------------------------------- + +proc testcases19 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of mmdd" + puts $f2 "" + + set n 0 + foreach year {1938 1970 2000 2037} { + set base [clock scan ${year}0101 -gmt true] + foreach month {01 12} { + foreach day {02 31} { + set scanned [clock scan $year$month$day -gmt true] + foreach mm {%b %B %h %m %Om %N} { + foreach dd {%d %Od %e %Oe} { + set string [clock format $scanned \ + -format "$mm $dd" \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-19.[incr n] {parse mmdd} {" + puts $f2 " [list clock scan $string -format [list $mm $dd] -locale en_US_roman -base $base -gmt 1]" + puts $f2 "} $scanned" + } + } + } + } + } + + puts "testcases19: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases21 -- +# +# Outputs the 'clock-21.x' test cases, parsing Wwwd +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for parsing dates in Gregorian calendar are written to the +# output file. +# +#---------------------------------------------------------------------- + +proc testcases22 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of Wwwd" + puts $f2 "" + + set n 0 + foreach year {1970 1971 2000 2001} { + set base [clock scan ${year}0104 -gmt true] + foreach month {03 10} { + foreach day {01 31} { + set scanned [clock scan $year$month$day -gmt true] + foreach d {%a %A %u %w %Ou %Ow} { + set string [clock format $scanned \ + -format "W%V $d" \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-22.[incr n] {parse Wwwd} {" + puts $f2 " [list clock scan $string -format [list W%V $d] -locale en_US_roman -gmt 1] -base $base" + puts $f2 "} $scanned" + } + } + } + } + + puts "testcases22: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases24 -- +# +# Outputs the 'clock-24.x' test cases. +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for parsing naked day of the month are output. +# +#---------------------------------------------------------------------- + +proc testcases24 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of naked day-of-month" + puts $f2 "" + + set n 0 + foreach year {1970 2000} { + foreach month {01 12} { + set base [clock scan ${year}${month}01 -gmt true] + foreach day {02 28} { + set scanned [clock scan $year$month$day -gmt true] + foreach dd {%d %Od %e %Oe} { + set string [clock format $scanned \ + -format "$dd" \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-24.[incr n] {parse naked day of month} {" + puts $f2 " [list clock scan $string -format $dd -locale en_US_roman -base $base -gmt 1]" + puts $f2 "} $scanned" + } + } + } + } + + puts "testcases24: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases26 -- +# +# Outputs the 'clock-26.x' test cases, parsing naked day of week +# +# Parameters: +# f2 -- Channel handle to the output file +# +# Results: +# None. +# +# Side effects: +# Test cases for parsing dates in Gregorian calendar are written to the +# output file. +# +#---------------------------------------------------------------------- + +proc testcases26 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of naked day of week" + puts $f2 "" + + set n 0 + foreach year {1970 2001} { + foreach week {01 52} { + set base [clock scan ${year}W${week}4 \ + -format %GW%V%u -gmt true] + foreach day {1 7} { + set scanned [clock scan ${year}W${week}${day} \ + -format %GW%V%u -gmt true] + foreach d {%a %A %u %w %Ou %Ow} { + set string [clock format $scanned \ + -format "$d" \ + -locale en_US_roman \ + -gmt true] + puts $f2 "test clock-26.[incr n] {parse naked day of week} {" + puts $f2 " [list clock scan $string -format $d -locale en_US_roman -gmt 1] -base $base" + puts $f2 "} $scanned" + } + } + } + } + + puts "testcases26: $n test cases" +} + +#---------------------------------------------------------------------- +# +# testcases29 -- +# +# Makes test cases for parsing of time of day. +# +# Parameters: +# f2 -- Channel where tests are to be written +# +# Results: +# None. +# +# Side effects: +# Writes the tests. +# +#---------------------------------------------------------------------- + +proc testcases29 { f2 } { + + # Put out a header describing the tests + + puts $f2 "" + puts $f2 "\# Test parsing of time of day" + puts $f2 "" + + set n 0 + foreach hour {0 1 11 12 13 23} \ + hampm {12 1 11 12 1 11} \ + lhour {? i xi xii xiii xxiii} \ + lhampm {xii i xi xii i xi} \ + ampmind {am am am pm pm pm} { + set sphr [format %2d $hour] + set 2dhr [format %02d $hour] + set sphampm [format %2d $hampm] + set 2dhampm [format %02d $hampm] + set AMPMind [string toupper $ampmind] + foreach minute {00 01 59} lminute {? i lix} { + foreach second {00 01 59} lsecond {? i lix} { + set time [expr { ( 60 * $hour + $minute ) * 60 + $second }] + foreach {hfmt afmt} [list \ + %H {} %k {} %OH {} %Ok {} \ + %I %p %l %p \ + %OI %p %Ol %p \ + %I %P %l %P \ + %OI %P %Ol %P] \ + {hfld afld} [list \ + $2dhr {} $sphr {} $lhour {} $lhour {} \ + $2dhampm $AMPMind $sphampm $AMPMind \ + $lhampm $AMPMind $lhampm $AMPMind \ + $2dhampm $ampmind $sphampm $ampmind \ + $lhampm $ampmind $lhampm $ampmind] \ + { + if { $second eq "00" } { + if { $minute eq "00" } { + puts $f2 "test clock-29.[incr n] {time parsing} {" + puts $f2 " clock scan {2440588 $hfld $afld} \\" + puts $f2 " -gmt true -locale en_US_roman \\" + puts $f2 " -format {%J $hfmt $afmt}" + puts $f2 "} $time" + } + puts $f2 "test clock-29.[incr n] {time parsing} {" + puts $f2 " clock scan {2440588 $hfld:$minute $afld} \\" + puts $f2 " -gmt true -locale en_US_roman \\" + puts $f2 " -format {%J $hfmt:%M $afmt}" + puts $f2 "} $time" + puts $f2 "test clock-29.[incr n] {time parsing} {" + puts $f2 " clock scan {2440588 $hfld:$lminute $afld} \\" + puts $f2 " -gmt true -locale en_US_roman \\" + puts $f2 " -format {%J $hfmt:%OM $afmt}" + puts $f2 "} $time" + } + puts $f2 "test clock-29.[incr n] {time parsing} {" + puts $f2 " clock scan {2440588 $hfld:$minute:$second $afld} \\" + puts $f2 " -gmt true -locale en_US_roman \\" + puts $f2 " -format {%J $hfmt:%M:%S $afmt}" + puts $f2 "} $time" + puts $f2 "test clock-29.[incr n] {time parsing} {" + puts $f2 " clock scan {2440588 $hfld:$lminute:$lsecond $afld} \\" + puts $f2 " -gmt true -locale en_US_roman \\" + puts $f2 " -format {%J $hfmt:%OM:%OS $afmt}" + puts $f2 "} $time" + } + } + } + + } + puts "testcases29: $n test cases" +} + +processFile $d diff --git a/tools/man2help.tcl b/tools/man2help.tcl index 6c8356c..018fa84 100644 --- a/tools/man2help.tcl +++ b/tools/man2help.tcl @@ -10,7 +10,8 @@ # 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 @@ -26,10 +27,10 @@ proc generateContents {basename version files} { foreach package [getPackages] { foreach section [getSections $package] { if {![info exists lastSection]} { - set lastSection {} + set lastSection {} } if {[string compare $lastSection $section]} { - puts $fd "1 $section" + puts $fd "1 $section" } set lastSection $section set lastTopic {} diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index d5c0b93..75f4249 100644 --- a/tools/man2help2.tcl +++ b/tools/man2help2.tcl @@ -157,6 +157,7 @@ proc text {string} { "\t" {\tab } \ '' "\\rdblquote " \ `` "\\ldblquote " \ + "\u00b7" "\\bullet " \ ] $string] # Check if this is the beginning of an international character string. @@ -375,6 +376,9 @@ proc macro {name args} { SH { SHmacro $args } + SS { + SHmacro $args subsection + } SO { SHmacro "STANDARD OPTIONS" set state(nestingLevel) 0 @@ -418,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 " "]" } @@ -509,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" @@ -564,22 +582,32 @@ proc tab {} { # This procedure handles the ".ta" macro, which sets tab stops. # # Arguments: -# tabList - List of tab stops, each consisting of a number -# followed by "i" (inch) or "c" (cm). +# tabList - List of tab stops in *roff format proc setTabs {tabList} { global file state set state(tabs) {} foreach arg $tabList { - set distance [expr {$state(leftMargin) \ - + ($state(offset) * $state(nestingLevel)) + [getTwips $arg]}] - lappend state(tabs) [expr {round($distance)}] + if {[string match +* $arg]} { + set relativeTo [lindex $state(tabs) end] + set arg [string range $arg 1 end] + } else { + # Local left margin + set relativeTo [expr {$state(leftMargin) \ + + ($state(offset) * $state(nestingLevel))}] + } + if {[regexp {^\\w'([^']*)'u$} $arg -> submatch]} { + # Magic factor! + set distance [expr {[string length $submatch] * 86.4}] + } else { + set distance [getTwips $arg] + } + lappend state(tabs) [expr {round($distance + $relativeTo)}] } } - # lineBreak -- # # Generates a line break in the HTML output. @@ -648,31 +676,50 @@ 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 " } - \\% - - \\| { + {\%} - {\|} { + } + {\(->} { + textSetup + puts -nonewline $file "->" + } + {\(bu} { + textSetup + puts -nonewline $file "\\bullet " + } + {\(co} { + textSetup + puts -nonewline $file "\\'a9 " + } + {\(mu} { + textSetup + puts -nonewline $file "\\'d7 " } - \\(bu { + {\(em} { textSetup - puts -nonewline $file "·" + puts -nonewline $file "-" + } + {\(fm} { + textSetup + puts -nonewline $file "\\'27 " } default { puts stderr "Unknown character: $name" @@ -699,12 +746,12 @@ proc macro2 {name args} { # SHmacro -- # -# Subsection head; handles the .SH macro. +# Subsection head; handles the .SH and .SS macros. # # Arguments: # name - Section name. -proc SHmacro {argList} { +proc SHmacro {argList {style section}} { global file state set args [join $argList " "] @@ -729,26 +776,28 @@ proc SHmacro {argList} { set state(breakPending) 0 } set state(noFill) 0 - nextPara 0i + if {[string compare "subsection" $style] == 0} { + nextPara .25i + } else { + nextPara 0i + } font B text $args font R nextPara .5i } - - # IPmacro -- # # This procedure is invoked to handle ".IP" macros, which may take any # of the following forms: # -# .IP [1] Translate to a "1Step" state(paragraph). +# .IP [1] Translate to a "1Step" state(paragraph). # .IP [x] (x > 1) Translate to a "Step" state(paragraph). -# .IP Translate to a "Bullet" state(paragraph). +# .IP Translate to a "Bullet" state(paragraph). # .IP text count Translate to a FirstBody state(paragraph) with special -# indent and tab stop based on "count", and tab after -# "text". +# indent and tab stop based on "count", and tab after +# "text". # # Arguments: # argList - List of arguments to the .IP macro. @@ -759,31 +808,28 @@ proc IPmacro {argList} { global file state set length [llength $argList] - if {$length == 0} { - newPara 0.5i - return + foreach {text indent} $argList break + if {$length > 2} { + puts stderr "Bad .IP macro: .IP [join $argList " "]" } - if {$length == 1} { - newPara 0.5i -0.5i - set state(sb) 80 - setTabs 0.5i - formattedText [lindex $argList 0] - tab - return + + if {$length == 0} { + set text {\(bu} + set indent 5 + } elseif {$length == 1} { + set indent 5 } - if {$length == 2} { - set count [lindex $argList 1] - set tab [expr $count * 0.1]i - newPara $tab -$tab - set state(sb) 80 - setTabs $tab - formattedText [lindex $argList 0] - tab - return + if {$text == {\(bu}} { + set text "\u00b7" } - puts stderr "Bad .IP macro: .IP [join $argList " "]" -} + set tab [expr $indent * 0.1]i + newPara $tab -$tab + set state(sb) 80 + setTabs $tab + formattedText $text + tab +} # TPmacro -- # @@ -927,6 +973,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}] @@ -936,7 +986,7 @@ proc getTwips {arg} { } default { puts stderr "bad units in distance \"$arg\"" - continue + return 0 } } return $distance @@ -977,4 +1027,3 @@ proc decrNestingLevel {} { incr state(nestingLevel) -1 } } - diff --git a/tools/man2html.tcl b/tools/man2html.tcl index 2d14047..fa57b03 100644 --- a/tools/man2html.tcl +++ b/tools/man2html.tcl @@ -1,6 +1,8 @@ -#!/proj/tcl/install/5.x-sparc/bin/tclsh7.5 +#!/bin/sh +# \ +exec tclsh "$0" ${1+"$@"} -if [catch { +package require Tcl 8.4 # man2html.tcl -- # @@ -9,7 +11,6 @@ if [catch { # # Copyright (c) 1996 by Sun Microsystems, Inc. -set homeDir /home/rjohnson/Projects/tools/generic # sarray - # @@ -23,7 +24,7 @@ proc sarray {file args} { set file [open $file w] foreach a $args { upvar $a array - if ![array exists array] { + if {![array exists array]} { puts "sarray: \"$a\" isn't an array" break } @@ -37,13 +38,12 @@ proc sarray {file args} { } - # footer -- # # Builds footer info for HTML pages # # Arguments: -# None +# packages - List of packages to link to. proc footer {packages} { lappend f "<HR>" @@ -61,8 +61,6 @@ proc footer {packages} { } - - # doDir -- # # Given a directory as argument, translate all the man pages in @@ -78,101 +76,112 @@ proc doDir dir { } -if {$argc < 2} { - puts stderr "usage: $argv0 html_dir tcl_dir packages..." - puts stderr "usage: $argv0 -clean html_dir" - exit 1 -} - -if {[lindex $argv 0] == "-clean"} { - set html_dir [lindex $argv 1] - puts -nonewline "recursively remove: $html_dir? " - flush stdout - if {[gets stdin] == "y"} { - puts "removing: $html_dir" - exec rm -r $html_dir - } - exit 0 -} - -set html_dir [lindex $argv 0] -set tcl_dir [lindex $argv 1] -set packages [lrange $argv 2 end] - -#### need to add glob capability to packages #### +# main -- +# +# Main code for converting Tcl manual pages to HTML. +# +# Arguments: +# argv - List of arguments to this script. -# make sure there are doc directories for each package +proc main {argv} { + global html_dir + # Global vars used in man2html1.tcl and man2html2.tcl + global NAME_file KEY_file lib state curFile file inDT textState nestStk + global curFont fontStart fontEnd noFillCount footer -foreach i $packages { - if ![file exists $tcl_dir/$i/doc] { - puts stderr "Error: doc directory for package $i is missing" + if {[llength $argv] < 2} { + puts stderr "usage: $::argv0 html_dir tcl_dir packages..." + puts stderr "usage: $::argv0 -clean html_dir" exit 1 } - if ![file isdirectory $tcl_dir/$i/doc] { - puts stderr "Error: $tcl_dir/$i/doc is not a directory" - exit 1 + + if {[lindex $argv 0] eq "-clean"} { + set html_dir [lindex $argv 1] + puts -nonewline "recursively remove: $html_dir? " + flush stdout + if {[gets stdin] eq "y"} { + puts "removing: $html_dir" + file delete -force $html_dir + } + exit 0 } -} + set html_dir [lindex $argv 0] + set tcl_dir [lindex $argv 1] + set packages [lrange $argv 2 end] + set homeDir [file dirname [info script]] -# we want to start with a clean sheet + #### need to add glob capability to packages #### -if [file exists $html_dir] { - puts stderr "Error: HTML directory already exists" - exit 1 -} else { - exec mkdir $html_dir -} + # make sure there are doc directories for each package + + foreach i $packages { + if {![file exists $tcl_dir/$i/doc]} { + puts stderr "Error: doc directory for package $i is missing" + exit 1 + } + if {![file isdirectory $tcl_dir/$i/doc]} { + puts stderr "Error: $tcl_dir/$i/doc is not a directory" + exit 1 + } + } + + # we want to start with a clean sheet -set footer [footer $packages] + if {[file exists $html_dir]} { + puts stderr "Error: HTML directory already exists" + exit 1 + } else { + file mkdir $html_dir + } + set footer [footer $packages] -# make the hyperlink arrays and contents.html for all packages - -foreach package $packages { - global homeDir - exec mkdir $html_dir/$package + # make the hyperlink arrays and contents.html for all packages + + foreach package $packages { + file mkdir $html_dir/$package - # build hyperlink database arrays: NAME_file and KEY_file - # - puts "\nScanning man pages in $tcl_dir/$package/doc..." - source $homeDir/man2html1.tcl + # build hyperlink database arrays: NAME_file and KEY_file + # + puts "\nScanning man pages in $tcl_dir/$package/doc..." + uplevel \#0 [list source $homeDir/man2html1.tcl] - doDir $tcl_dir/$package/doc - - # clean up the NAME_file and KEY_file database arrays - # - catch {unset KEY_file()} - foreach name [lsort [array names NAME_file]] { - set file_name $NAME_file($name) - if {[llength $file_name] > 1} { - set file_name [lsort $file_name] - puts stdout "Warning: '$name' multiply defined in: $file_name; using last" - set NAME_file($name) [lindex $file_name end] + doDir $tcl_dir/$package/doc + + # clean up the NAME_file and KEY_file database arrays + # + catch {unset KEY_file()} + foreach name [lsort [array names NAME_file]] { + set file_name $NAME_file($name) + if {[llength $file_name] > 1} { + set file_name [lsort $file_name] + puts "Warning: '$name' multiply defined in: $file_name;\ + using last" + set NAME_file($name) [lindex $file_name end] + } } - } -# sarray $html_dir/$package/xref.tcl NAME_file KEY_file + # sarray $html_dir/$package/xref.tcl NAME_file KEY_file - # build the contents file from NAME_file - # - puts "\nGenerating contents.html for $package" - doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl + # build the contents file from NAME_file + # + puts "\nGenerating contents.html for $package" + doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl - # now translate the man pages to HTML pages - # - source $homeDir/man2html2.tcl - puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..." - doDir $tcl_dir/$package/doc + # now translate the man pages to HTML pages + # + uplevel \#0 [list source $homeDir/man2html2.tcl] + puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..." + doDir $tcl_dir/$package/doc - unset NAME_file + unset NAME_file + } } - -} result] { +if [catch { main $argv } result] { global errorInfo puts stderr $result puts stderr "in" puts stderr $errorInfo } - diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl index be969f9..f2b2e43 100644 --- a/tools/man2html1.tcl +++ b/tools/man2html1.tcl @@ -5,6 +5,8 @@ # # Copyright (c) 1996 by Sun Microsystems, Inc. +package require Tcl 8.4 + # Global variables used by these scripts: # # state - state variable that controls action of text proc. @@ -24,7 +26,6 @@ # inDT - in dictionary term. - # text -- # # This procedure adds entries to the hypertext arrays NAME_file @@ -36,7 +37,6 @@ # Arguments: # string - Text to index. - proc text string { global state curFile NAME_file KEY_file inDT @@ -72,12 +72,12 @@ proc text string { proc macro {name args} { switch $name { - SH { + SH - SS { global state switch $args { NAME { - if {$state == "INIT" } { + if {$state eq "INIT"} { set state NAME } } @@ -97,8 +97,8 @@ proc macro {name args} { set inDT 0 set state INIT if {[llength $args] != 5} { - set args [join $args " "] - puts stderr "Bad .TH macro: .$name $args" + set args [join $args " "] + puts stderr "Bad .TH macro: .$name $args" } set lib [lindex $args 3] ;# Tcl or Tk } @@ -106,7 +106,6 @@ proc macro {name args} { } - # dash -- # # This procedure is invoked to handle dash characters ("\-" in @@ -117,13 +116,12 @@ proc macro {name args} { proc dash {} { global state - if {$state == "NAME"} { + if {$state eq "NAME"} { set state DASH } } - # newline -- # # This procedure is invoked to handle newlines in the troff input. @@ -138,8 +136,6 @@ proc newline {} { } - - # initGlobals, tab, font, char, macro2 -- # # These procedures do nothing during the first pass. @@ -181,14 +177,14 @@ proc doListing {file pattern} { return } incr max_len - set ncols [expr 90/$max_len] - set nrows [expr int( ceil( [llength $type] / $ncols. ) ) ] + set ncols [expr {90/$max_len}] + set nrows [expr {int(ceil([llength $type] / double($ncols)))} ] # ? max_len ncols nrows set index 0 foreach f $type { - lappend row([expr $index % $nrows]) $f + lappend row([expr {$index % $nrows}]) $f incr index } @@ -212,8 +208,9 @@ proc doListing {file pattern} { # # Arguments: # file - name of the contents file. -# packageName - string used in the title and sub-heads of the HTML page. Normally -# name of the package without version numbers. +# packageName - string used in the title and sub-heads of the HTML +# page. Normally name of the package without version +# numbers. proc doContents {file packageName} { global footer @@ -236,8 +233,6 @@ proc doContents {file packageName} { } - - # do -- # # This is the toplevel procedure that searches a man page @@ -263,4 +258,3 @@ proc do fileName { exit 1 } } - diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl index aee1da3..163196e 100644 --- a/tools/man2html2.tcl +++ b/tools/man2html2.tcl @@ -1,26 +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. +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. # @@ -28,28 +30,29 @@ # # 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>" @@ -60,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. @@ -73,7 +76,7 @@ proc initGlobals {} { proc beginFont font { global curFont file fontStart - if {$curFont == $font} { + if {$curFont eq $font} { return } endFont @@ -81,7 +84,7 @@ proc beginFont font { set curFont $font } - +############################################################################## # endFont -- # # Reverts to the default font for the paragraph type. @@ -92,86 +95,92 @@ proc beginFont font { proc endFont {} { global curFont file fontEnd - if {$curFont != ""} { - puts -nonewline $file $fontEnd($curFont) - set curFont "" + if {$curFont ne ""} { + puts -nonewline $file $fontEnd($curFont) + set curFont "" } } - - - + +############################################################################## # 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 { - if {$inDT == {}} { + regsub -all \" $string {\"} string + 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 {"$ref.html" != $self} { + if {![catch { set ref $NAME_file([string trim $string]) }]} { + if {"$ref.html" ne $self} { set string "<A HREF=\"${path}$ref.html\">$string</A>" # puts "insertRef: $self $ref.html ---$string--" } } return $string } - - - + +############################################################################## # macro -- # -# This procedure is invoked to process macro invocations that start -# with "." (instead of '). +# This procedure is invoked to process macro invocations that start with "." +# (instead of '). # # Arguments: # name - The name of the macro (without the "."). @@ -195,7 +204,7 @@ proc macro {name args} { } AS {} ;# next page and previous page br { - lineBreak + lineBreak } BS {} BE {} @@ -210,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 @@ -240,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 @@ -267,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 } @@ -278,7 +287,7 @@ proc macro {name args} { newPara } RE { - nest decr + nest decr } RS { nest incr @@ -296,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." @@ -304,6 +317,9 @@ proc macro {name args} { SH { SHmacro $args } + SS { + SHmacro $args subsection + } SO { global noFillCount inPRE file @@ -315,12 +331,12 @@ proc macro {name args} { font B } so { - if {$args != "man.macros"} { + if {$args ne "man.macros"} { puts stderr "Unknown macro: .$name [join $args " "]" } } sp { ;# needs work - if {$args == ""} { + if {$args eq ""} { set count 1 } else { set count [lindex $args 0] @@ -359,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 " "]" } @@ -367,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. @@ -383,13 +435,13 @@ proc font type { P - R { endFont - if {$textState == "REF"} { + if {$textState eq "REF"} { set textState INSERT } } B { beginFont Code - if {$textState == "INSERT"} { + if {$textState eq "INSERT"} { set textState REF } } @@ -403,20 +455,19 @@ 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. proc formattedText text { # puts "formattedText: $text" - while {$text != ""} { + while {$text ne ""} { set index [string first \\ $text] if {$index < 0} { text $text @@ -447,37 +498,35 @@ 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. proc dash {} { global textState charCnt - if {$textState == "NAME"} { + if {$textState eq "NAME"} { set textState 0 } 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] ] @@ -488,7 +537,7 @@ proc tab {} { } } - +############################################################################## # setTabs -- # # This procedure handles the ".ta" macro, which sets tab stops. @@ -500,38 +549,52 @@ proc tab {} { proc setTabs {tabList} { global file breakPending tabString -# puts "setTabs: --$tabList--" + # puts "setTabs: --$tabList--" set last 0 set tabString {} set charsPerInch 14. set numTabs [llength $tabList] foreach arg $tabList { - if {[scan $arg "%f%s" distance units] != 2} { - puts stderr "bad distance \"$arg\"" - return 0 - } - switch -- $units { - c { - set distance [expr $distance * $charsPerInch / 2.54 ] - } - i { - set distance [expr $distance * $charsPerInch] + if {[string match +* $arg]} { + set relative 1 + set arg [string range $arg 1 end] + } else { + set relative 0 + } + # Always operate in relative mode for "measurement" mode + if {[regexp {^\\w'(.*)'u$} $arg content]} { + set distance [string length $content] + } else { + if {[scan $arg "%f%s" distance units] != 2} { + puts stderr "bad distance \"$arg\"" + return 0 } - default { - puts stderr "bad units in distance \"$arg\"" - continue + switch -- $units { + c { + set distance [expr {$distance * $charsPerInch / 2.54}] + } + i { + set distance [expr {$distance * $charsPerInch}] + } + default { + puts stderr "bad units in distance \"$arg\"" + continue + } } - } -# ? distance - lappend tabString [format "%*s1" [expr round($distance-$last-1)] " "] - set last $distance + } + # ? distance + if {$relative} { + append tabString [format "%*s1" [expr {round($distance-1)}] " "] + set last [expr {$last + $distance}] + } else { + append tabString [format "%*s1" [expr {round($distance-$last-1)}] " "] + set last $distance + } } - set tabString [join $tabString {}] -# puts "setTabs: --$tabString--" + # puts "setTabs: --$tabString--" } - - - + +############################################################################## # lineBreak -- # # Generates a line break in the HTML output. @@ -544,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 != {} } { + 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 { @@ -569,9 +635,8 @@ proc newline {} { } set charCnt 0 } - - - + +############################################################################## # char -- # # This procedure is called to handle a special character. @@ -602,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 "."). @@ -617,17 +681,17 @@ proc char name { proc macro2 {name args} { puts stderr "Unknown macro: '$name [join $args " "]" } - - - + +############################################################################## # SHmacro -- # -# Subsection head; handles the .SH macro. +# Subsection head; handles the .SH and .SS macros. # # Arguments: # name - Section name. +# style - Type of section (optional) -proc SHmacro argList { +proc SHmacro {argList {style section}} { global file noFillCount textState charCnt set args [join $argList " "] @@ -638,14 +702,18 @@ proc SHmacro argList { set noFillCount 0 nest reset - puts -nonewline $file "<H3>" + set tag H3 + if {$style eq "subsection"} { + set tag H4 + } + puts -nonewline $file "<$tag>" text $args - puts $file "</H3>" + puts $file "</$tag>" # ? args textState # control what the text proc does with text - + switch $args { NAME {set textState NAME} DESCRIPTION {set textState INSERT} @@ -656,20 +724,20 @@ proc SHmacro argList { } 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 [x] (x > 1) Translate to a "Step" paragraph. # .IP Translate to a "Bullet" paragraph. -# .IP text count Translate to a FirstBody paragraph with special -# indent and tab stop based on "count", and tab after -# "text". +# .IP \(bu Translate to a "Bullet" paragraph. +# .IP text count Translate to a FirstBody paragraph with +# special indent and tab stop based on "count", +# and tab after "text". # # Arguments: # argList - List of arguments to the .IP macro. @@ -685,50 +753,49 @@ proc IPmacro argList { nest para UL LI return } - if {$length == 1} { + # Special case for alternative mechanism for declaring bullets + if {[lindex $argList 0] eq "\\(bu"} { + nest para UL LI + return + } + if {[regexp {^\[\d+\]$} [lindex $argList 0]]} { nest para OL LI - return - } - if {$length > 1} { - nest para DL DT - formattedText [lindex $argList 0] - puts $file "\n<DD>" - return + return } - puts stderr "Bad .IP macro: .IP [join $argList " "]" + nest para DL DT + formattedText [lindex $argList 0] + puts $file "\n<DD>" + return } - - + +############################################################################## # TPmacro -- # -# This procedure is invoked to handle ".TP" macros, which may take any -# of the following forms: +# 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 # @@ -751,54 +818,52 @@ 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] != "NEW" } { - nest decr + + if {[lindex $nestStk end] ne "NEW"} { + nest decr } puts -nonewline $file "<P>" } - - - + +############################################################################## # nest -- # -# This procedure takes care of inserting the tags associated with the -# IP, TP, RS, RE, LP and PP macros. Only 'nest para' takes arguments. +# This procedure takes care of inserting the tags associated with the IP, TP, +# RS, RE, LP and PP macros. Only 'nest para' takes arguments. # # Arguments: # op - operation: para, incr, decr, reset, init # listStart - begin list tag: OL, UL, DL. # listItem - item tag: LI, LI, DT. -proc nest {op {listStart "NEW"} {listItem {} } } { +proc nest {op {listStart "NEW"} {listItem ""} } { global file nestStk inDT charCnt # puts "nest: $op $listStart $listItem" switch $op { para { set top [lindex $nestStk end] - if {$top == "NEW" } { + if {$top eq "NEW"} { set nestStk [lreplace $nestStk end end $listStart] puts $file "<$listStart>" - } elseif {$top != $listStart} { + } elseif {$top ne $listStart} { puts stderr "nest para: bad stack" exit 1 } @@ -814,7 +879,7 @@ proc nest {op {listStart "NEW"} {listItem {} } } { set nestStk NEW } set tag [lindex $nestStk end] - if {$tag != "NEW"} { + if {$tag ne "NEW"} { puts $file "</$tag>" } set nestStk [lreplace $nestStk end end] @@ -832,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. @@ -851,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" @@ -863,6 +927,3 @@ proc do fileName { puts $file "</BODY></HTML>" close $file } - - - diff --git a/tools/man2tcl.c b/tools/man2tcl.c index 464bb34..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,28 +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. + * 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 @@ -46,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); @@ -73,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; @@ -115,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++) { @@ -132,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); @@ -151,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); } } @@ -175,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. @@ -189,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. @@ -203,13 +205,9 @@ DoMacro(line) return; } - if (writeOutput) { - printf("macro"); - } + PRINT(("macro")); if (*line != '.') { - if (writeOutput) { - printf("2"); - } + PRINT(("2")); } /* @@ -218,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. */ @@ -229,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); } @@ -257,9 +256,7 @@ DoMacro(line) break; } } - if (writeOutput) { - putc('\n', stdout); - } + PRINTC('\n'); } /* @@ -267,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. @@ -281,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 != '\\') { /* @@ -306,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++; @@ -327,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")); } /* @@ -377,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. @@ -391,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/tcl.hpj.in b/tools/tcl.hpj.in index 2a8c94a..0d01f35 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=tcl84.cnt +CNT=tcl85.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl84.hlp +HLP=tcl85.hlp [FILES] tcl.rtf diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in index 1dceec0..69690a8 100644 --- a/tools/tcl.wse.in +++ b/tools/tcl.wse.in @@ -1,7 +1,7 @@ Document Type: WSE item: Global Version=6.01 - Title=Tcl 8.4 for Windows Installation + 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 @@ -12,7 +12,7 @@ item: Global Log Pathname=%MAINDIR%\INSTALL.LOG Message Font=MS Sans Serif Font Size=8 - Disk Label=tcl8.4.19 + Disk Label=tcl8.5.11 Disk Filename=setup Patch Flags=0000000000000001 Patch Threshold=85 @@ -42,7 +42,7 @@ item: End Block end item: Set Variable Variable=VER - Value=8.4 + Value=8.5 end item: Set Variable Variable=PATCHLEVEL @@ -960,23 +960,23 @@ item: If/While Statement Flags=00001010 end item: Install File - Source=${__TKBASEDIR__}\win\release\tk84.lib - Destination=%MAINDIR%\lib\tk84.lib + Source=${__TKBASEDIR__}\win\release\tk85.lib + Destination=%MAINDIR%\lib\tk85.lib Flags=0000000000000010 end item: Install File - Source=${__TKBASEDIR__}\win\release\tkstub84.lib - Destination=%MAINDIR%\lib\tkstub84.lib + Source=${__TKBASEDIR__}\win\release\tkstub85.lib + Destination=%MAINDIR%\lib\tkstub85.lib Flags=0000000000000010 end item: Install File - Source=${__TCLBASEDIR__}\win\release\tcl84.lib - Destination=%MAINDIR%\lib\tcl84.lib + Source=${__TCLBASEDIR__}\win\release\tcl85.lib + Destination=%MAINDIR%\lib\tcl85.lib Flags=0000000000000010 end item: Install File - Source=${__TCLBASEDIR__}\win\release\tclstub84.lib - Destination=%MAINDIR%\lib\tclstub84.lib + Source=${__TCLBASEDIR__}\win\release\tclstub85.lib + Destination=%MAINDIR%\lib\tclstub85.lib Flags=0000000000000010 end item: Install File @@ -1063,12 +1063,12 @@ item: If/While Statement end item: Install File Source=${__TCLBASEDIR__}\library\msgcat\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.2\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.2\msgcat.tcl + Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.4\msgcat.tcl Flags=0000000010000010 end item: Install File @@ -1443,12 +1443,12 @@ item: Install File end item: Install File Source=${__TCLBASEDIR__}\library\http\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.5\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.5\http.tcl + Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl Flags=0000000000000010 end item: Install File @@ -1607,28 +1607,28 @@ item: Install File Flags=0010001000000011 end item: Install File - Source=${__TKBASEDIR__}\win\release\wish84.exe - Destination=%MAINDIR%\bin\wish84.exe + Source=${__TKBASEDIR__}\win\release\wish85.exe + Destination=%MAINDIR%\bin\wish85.exe Flags=0000000000000010 end item: Install File - Source=${__TCLBASEDIR__}\win\release\tclsh84.exe - Destination=%MAINDIR%\bin\tclsh84.exe + Source=${__TCLBASEDIR__}\win\release\tclsh85.exe + Destination=%MAINDIR%\bin\tclsh85.exe Flags=0000000000000010 end item: Install File - Source=${__TCLBASEDIR__}\win\release\tclpip84.dll - Destination=%MAINDIR%\bin\tclpip84.dll + Source=${__TCLBASEDIR__}\win\release\tclpip85.dll + Destination=%MAINDIR%\bin\tclpip85.dll Flags=0000000000000010 end item: Install File - Source=${__TCLBASEDIR__}\win\release\tcl84.dll - Destination=%MAINDIR%\bin\tcl84.dll + Source=${__TCLBASEDIR__}\win\release\tcl85.dll + Destination=%MAINDIR%\bin\tcl85.dll Flags=0000000000000010 end item: Install File - Source=${__TKBASEDIR__}\win\release\tk84.dll - Destination=%MAINDIR%\bin\tk84.dll + Source=${__TKBASEDIR__}\win\release\tk85.dll + Destination=%MAINDIR%\bin\tk85.dll Flags=0000000000000010 end item: Install File @@ -2031,13 +2031,13 @@ item: If/While Statement Flags=00001010 end item: Install File - Source=${__TCLBASEDIR__}\tools\tcl84.cnt - Destination=%MAINDIR%\doc\tcl84.cnt + Source=${__TCLBASEDIR__}\tools\tcl85.cnt + Destination=%MAINDIR%\doc\tcl85.cnt Flags=0000000000000010 end item: Install File - Source=${__TCLBASEDIR__}\tools\tcl84.hlp - Destination=%MAINDIR%\doc\tcl84.hlp + Source=${__TCLBASEDIR__}\tools\tcl85.hlp + Destination=%MAINDIR%\doc\tcl85.hlp Flags=0000000000000010 end item: End Block @@ -2070,7 +2070,7 @@ item: If/While Statement Flags=00001010 end item: Create Shortcut - Source=%MAINDIR%\bin\wish84.exe + Source=%MAINDIR%\bin\wish85.exe Destination=%GROUP%\Wish.lnk Working Directory=%MAINDIR% end @@ -2082,7 +2082,7 @@ item: If/While Statement Flags=00001010 end item: Create Shortcut - Source=%MAINDIR%\bin\tclsh84.exe + Source=%MAINDIR%\bin\tclsh85.exe Destination=%GROUP%\Tclsh.lnk Working Directory=%MAINDIR% Key Type=1536 @@ -2096,7 +2096,7 @@ item: If/While Statement Flags=00001010 end item: Create Shortcut - Source=%MAINDIR%\doc\tcl84.hlp + Source=%MAINDIR%\doc\tcl85.hlp Destination=%GROUP%\Tcl Help.lnk Working Directory=%MAINDIR% end @@ -2132,7 +2132,7 @@ item: Add ProgMan Icon Group=%GROUP% Icon Name=Widget Tour Command Line=%MAINDIR%\lib\tk%VER%\demos\widget.tcl - Icon Pathname=%MAINDIR%\bin\wish84.exe + Icon Pathname=%MAINDIR%\bin\wish85.exe Default Directory=%MAINDIR% end item: End Block @@ -2145,7 +2145,7 @@ end item: Add ProgMan Icon Group=%GROUP% Icon Name=Tcl Help - Command Line=%MAINDIR%\doc\tcl84.hlp + Command Line=%MAINDIR%\doc\tcl85.hlp Default Directory=%MAINDIR% end item: End Block @@ -2164,7 +2164,7 @@ end item: Add ProgMan Icon Group=%GROUP% Icon Name=Wish - Command Line=%MAINDIR%\bin\wish84.exe + Command Line=%MAINDIR%\bin\wish85.exe Default Directory=%MAINDIR% end item: End Block @@ -2177,7 +2177,7 @@ end item: Add ProgMan Icon Group=%GROUP% Icon Name=Tclsh - Command Line=%MAINDIR%\bin\tclsh84.exe + Command Line=%MAINDIR%\bin\tclsh85.exe Default Directory=%MAINDIR% end item: End Block @@ -2197,7 +2197,7 @@ end item: Edit Registry Total Keys=1 Key=TclScript\DefaultIcon - New Value=%MAINDIR%\bin\tk84.dll + New Value=%MAINDIR%\bin\tk85.dll end item: Edit Registry Total Keys=1 @@ -2212,7 +2212,7 @@ end item: Edit Registry Total Keys=1 Key=TclScript\shell\open\command - New Value=%MAINDIRSHORT%\bin\wish84.exe "%%1" %%* + New Value=%MAINDIRSHORT%\bin\wish85.exe "%%1" %%* end item: Edit Registry Total Keys=1 diff --git a/tools/tclSplash.bmp b/tools/tclSplash.bmp Binary files differindex e3e83ad..db8a17e 100644 --- a/tools/tclSplash.bmp +++ b/tools/tclSplash.bmp diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl new file mode 100755 index 0000000..1b19d82 --- /dev/null +++ b/tools/tclZIC.tcl @@ -0,0 +1,1375 @@ +#---------------------------------------------------------------------- +# +# tclZIC.tcl -- +# +# Take the time zone data source files from Arthur Olson's +# repository at elsie.nci.nih.gov, and prepare time zone +# information files for Tcl. +# +# Usage: +# tclsh tclZIC.tcl inputDir outputDir +# +# Parameters: +# inputDir - Directory (e.g., tzdata2003e) where Olson's source +# files are to be found. +# outputDir - Directory (e.g., ../library/tzdata) where +# the time zone information files are to be placed. +# +# Results: +# May produce error messages on the standard error. An exit +# code of zero denotes success; any other exit code is failure. +# +# This program parses the timezone data in a means analogous to the +# 'zic' command, and produces Tcl time zone information files suitable +# for loading into the 'clock' namespace. +# +#---------------------------------------------------------------------- +# +# 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. +#---------------------------------------------------------------------- + +package require Tcl 8.5 + +# Define the names of the Olson files that we need to load. +# We avoid the solar time files and the leap seconds. + +set olsonFiles { + africa antarctica asia australasia + backward etcetera europe northamerica + pacificnew southamerica systemv +} + +# Define the year at which the DST information will stop. + +set maxyear 2100 + +# Determine how big a wide integer is. + +set MAXWIDE [expr {wide(1)}] +while 1 { + set next [expr {wide($MAXWIDE + $MAXWIDE + 1)}] + if {$next < 0} { + break + } + set MAXWIDE $next +} +set MINWIDE [expr {-$MAXWIDE-1}] + +#---------------------------------------------------------------------- +# +# loadFiles -- +# +# Loads the time zone files for each continent into memory +# +# Parameters: +# dir - Directory where the time zone source files are found +# +# Results: +# None. +# +# Side effects: +# Calls 'loadZIC' for each continent's data file in turn. +# Reports progress on stdout. +# +#---------------------------------------------------------------------- + +proc loadFiles {dir} { + variable olsonFiles + foreach file $olsonFiles { + puts "loading: [file join $dir $file]" + loadZIC [file join $dir $file] + } + return +} + +#---------------------------------------------------------------------- +# +# checkForwardRuleRefs -- +# +# Checks to make sure that all references to Daylight Saving +# Time rules designate defined rules. +# +# Parameters: +# None. +# +# Results: +# None. +# +# Side effects: +# Produces an error message and increases the error count if +# any undefined rules are present. +# +#---------------------------------------------------------------------- + +proc checkForwardRuleRefs {} { + variable forwardRuleRefs + variable rules + + foreach {rule where} [array get forwardRuleRefs] { + if {![info exists rules($rule)]} { + foreach {fileName lno} $where { + puts stderr "$fileName:$lno:can't locate rule \"$rule\"" + incr errorCount + } + } + } +} + +#---------------------------------------------------------------------- +# +# loadZIC -- +# +# Load one continent's data into memory. +# +# Parameters: +# fileName -- Name of the time zone source file. +# +# Results: +# None. +# +# Side effects: +# The global variable, 'errorCount' counts the number of errors. +# The global array, 'links', contains a distillation of the +# 'Link' directives in the file. The keys are 'links to' and +# the values are 'links from'. The 'parseRule' and 'parseZone' +# procedures are called to handle 'Rule' and 'Zone' directives. +# +#---------------------------------------------------------------------- + +proc loadZIC {fileName} { + variable errorCount + variable links + + # Suck the text into memory. + + set f [open $fileName r] + set data [read $f] + close $f + + # Break the input into lines, and count line numbers. + + set lno 0 + foreach line [split $data \n] { + incr lno + + # Break a line of input into words. + + regsub {\s*(\#.*)?$} $line {} line + if {$line eq ""} { + continue + } + set words {} + if {[regexp {^\s} $line]} { + # Detect continuations of a zone and flag the list appropriately + lappend words "" + } + lappend words {*}[regexp -all -inline {\S+} $line] + + # Switch on the directive + + switch -exact -- [lindex $words 0] { + Rule { + parseRule $fileName $lno $words + } + Link { + set links([lindex $words 2]) [lindex $words 1] + } + Zone { + set lastZone [lindex $words 1] + set until [parseZone $fileName $lno \ + $lastZone [lrange $words 2 end] "minimum"] + } + {} { + set i 0 + foreach word $words { + if {[lindex $words $i] ne ""} { + break + } + incr i + } + set words [lrange $words $i end] + set until [parseZone $fileName $lno $lastZone $words $until] + } + default { + incr errorCount + puts stderr "$fileName:$lno:unknown line type \"[lindex $words 0]\"" + } + } + } + + return +} + +#---------------------------------------------------------------------- +# +# parseRule -- +# +# Parses a Rule directive in an Olson file. +# +# Parameters: +# fileName -- Name of the file being parsed. +# lno - Line number within the file +# words - The line itself, broken into words. +# +# Results: +# None. +# +# Side effects: +# The rule is analyzed and added to the 'rules' array. +# Errors are reported and counted. +# +#---------------------------------------------------------------------- + +proc parseRule {fileName lno words} { + variable rules + variable errorCount + + # Break out the columns + + lassign $words Rule name from to type in on at save letter + + # Handle the 'only' keyword + + if {$to eq "only"} { + set to $from + } + + # Process the start year + + if {![string is integer $from]} { + if {![string equal -length [string length $from] $from "minimum"]} { + puts stderr "$fileName:$lno:FROM field \"$from\" not an integer." + incr errorCount + return + } else { + set from "minimum" + } + } + + # Process the end year + + if {![string is integer $to]} { + if {![string equal -length [string length $to] $to "maximum"]} { + puts stderr "$fileName:$lno:TO field \"$to\" not an integer." + incr errorCount + return + } else { + set to "maximum" + } + } + + # Process the type of year in which the rule applies + + if {$type ne "-"} { + puts stderr "$fileName:$lno:year types are not yet supported." + incr errorCount + return + } + + # Process the month in which the rule starts + + if {[catch {lookupMonth $in} in]} { + puts stderr "$fileName:$lno:$in" + incr errorCount + return + } + + # Process the day of the month on which the rule starts + + if {[catch {parseON $on} on]} { + puts stderr "$fileName:$lno:$on" + incr errorCount + return + } + + # Process the time of day on which the rule starts + + if {[catch {parseTOD $at} at]} { + puts stderr "$fileName:$lno:$at" + incr errorCount + return + } + + # Process the DST adder + + if {[catch {parseOffsetTime $save} save]} { + puts stderr "$fileName:$lno:$save" + incr errorCount + return + } + + # Process the letter to use for summer time + + if {$letter eq "-"} { + set letter "" + } + + # Accumulate all the data. + + lappend rules($name) $from $to $type $in $on $at $save $letter + return + +} + +#---------------------------------------------------------------------- +# +# parseON -- +# +# Parse a specification for a day of the month +# +# Parameters: +# on - the ON field from a line in an Olson file. +# +# Results: +# Returns a partial Tcl command. When the year and number of the +# month are appended, the command will return the Julian Day Number +# of the desired date. +# +# Side effects: +# None. +# +# The specification can be: +# - a simple number, which designates a constant date. +# - The name of a weekday, followed by >= or <=, followed by a number. +# This designates the nearest occurrence of the given weekday on +# or before (on or after) the given day of the month. +# - The word 'last' followed by a weekday name with no intervening +# space. This designates the last occurrence of the given weekday +# in the month. +# +#---------------------------------------------------------------------- + +proc parseON {on} { + if {![regexp -expanded { + ^(?: + # first possibility - simple number - field 1 + ([[:digit:]]+) + | + # second possibility - weekday >= (or <=) number + # field 2 - weekday + ([[:alpha:]]+) + # field 3 - direction + ([<>]=) + # field 4 - number + ([[:digit:]]+) + | + # third possibility - lastWeekday - field 5 + last([[:alpha:]]+) + )$ + } $on -> dom1 wday2 dir2 num2 wday3]} then { + error "can't parse ON field \"$on\"" + } + if {$dom1 ne ""} { + return [list onDayOfMonth $dom1] + } elseif {$wday2 ne ""} { + set wday2 [lookupDayOfWeek $wday2] + return [list onWeekdayInMonth $wday2 $dir2 $num2] + } elseif {$wday3 ne ""} { + set wday3 [lookupDayOfWeek $wday3] + return [list onLastWeekdayInMonth $wday3] + } else { + error "in parseOn \"$on\": can't happen" + } +} + +#---------------------------------------------------------------------- +# +# onDayOfMonth -- +# +# Find a given day of a given month +# +# Parameters: +# day - Day of the month +# year - Gregorian year +# month - Number of the month (1-12) +# +# Results: +# Returns the Julian Day Number of the desired day. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +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] \ + 2361222] + return [dict get $date julianDay] +} + +#---------------------------------------------------------------------- +# +# onWeekdayInMonth -- +# +# Find the weekday falling on or after (on or before) a +# given day of the month +# +# Parameters: +# dayOfWeek - Day of the week (Monday=1, Sunday=7) +# relation - <= for the weekday on or before a given date, >= for +# the weekday on or after the given date. +# dayOfMonth - Day of the month +# year - Gregorian year +# month - Number of the month (1-12) +# +# Results: +# Returns the Juloan Day Number of the desired day. +# +# Side effects: +# None. +# +# onWeekdayInMonth is used to compute Daylight Saving Time rules +# like 'Sun>=1' (for the nearest Sunday on or after the first of the month) +# or "Mon<=4' (for the Monday on or before the fourth of the month). +# +#---------------------------------------------------------------------- + +proc onWeekdayInMonth {dayOfWeek relation dayOfMonth year month} { + set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ + era CE year $year month $month dayOfMonth $dayOfMonth] 2361222] + switch -exact -- $relation { + <= { + return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ + [dict get $date julianDay]] + } + >= { + return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ + [expr {[dict get $date julianDay] + 6}]] + } + } +} + +#---------------------------------------------------------------------- +# +# onLastWeekdayInMonth -- +# +# Find the last instance of a given weekday in a month. +# +# Parameters: +# dayOfWeek - Weekday to find (Monday=1, Sunday=7) +# year - Gregorian year +# month - Month (1-12) +# +# Results: +# Returns the Julian Day number of the last instance of +# the given weekday in the given month +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc onLastWeekdayInMonth {dayOfWeek year month} { + incr 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] 2361222] + return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ + [dict get $date julianDay]] +} + +#---------------------------------------------------------------------- +# +# parseTOD -- +# +# Parses the specification of a time of day in an Olson file. +# +# Parameters: +# tod - Time of day, which may be followed by 'w', 's', 'u', 'g' +# or 'z'. 'w' (or no letter) designates a wall clock time, +# 's' designates Standard Time in the given zone, and +# 'u', 'g', and 'z' all designate UTC. +# +# Results: +# Returns a two element list containing a count of seconds from +# midnight and the letter that followed the time. +# +# Side effects: +# Reports and counts an error if the time cannot be parsed. +# +#---------------------------------------------------------------------- + +proc parseTOD {tod} { + if {![regexp -expanded { + ^ + ([[:digit:]]{1,2}) # field 1 - hour + (?: + :([[:digit:]]{2}) # field 2 - minute + (?: + :([[:digit:]]{2}) # field 3 - second + )? + )? + (?: + ([wsugz]) # field 4 - type indicator + )? + } $tod -> hour minute second ind]} then { + puts stderr "$fileName:$lno:can't parse time field \"$tod\"" + incr errorCount + } + scan $hour %d hour + if {$minute ne ""} { + scan $minute %d minute + } else { + set minute 0 + } + if {$second ne ""} { + scan $second %d second + } else { + set second 0 + } + if {$ind eq ""} { + set ind w + } + return [list [expr {($hour * 60 + $minute) * 60 + $second}] $ind] +} + +#---------------------------------------------------------------------- +# +# parseOffsetTime -- +# +# Parses the specification of an offset time in an Olson file. +# +# Parameters: +# offset - Offset time as [+-]hh:mm:ss +# +# Results: +# Returns the offset time as a count of seconds. +# +# Side effects: +# Reports and counts an error if the time cannot be parsed. +# +#---------------------------------------------------------------------- + +proc parseOffsetTime {offset} { + if {![regexp -expanded { + ^ + ([-+])? # field 1 - signum + ([[:digit:]]{1,2}) # field 2 - hour + (?: + :([[:digit:]]{2}) # field 3 - minute + (?: + :([[:digit:]]{2}) # field 4 - second + )? + )? + } $offset -> signum hour minute second]} then { + puts stderr "$fileName:$lno:can't parse offset time \"$offset\"" + incr errorCount + } + append signum 1 + scan $hour %d hour + if {$minute ne ""} { + scan $minute %d minute + } else { + set minute 0 + } + if {$second ne ""} { + scan $second %d second + } else { + set second 0 + } + return [expr {(($hour * 60 + $minute) * 60 + $second) * $signum}] + +} + +#---------------------------------------------------------------------- +# +# lookupMonth - +# Looks up a month by name +# +# Parameters: +# month - Name of a month. +# +# Results: +# Returns the number of the month. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc lookupMonth {month} { + set indx [lsearch -regexp { + {} January February March April May June + July August September October November December + } ${month}.*] + if {$indx < 1} { + error "unknown month name \"$month\"" + } + return $indx +} + +#---------------------------------------------------------------------- +# +# lookupDayOfWeek -- +# +# Looks up the name of a weekday. +# +# Parameters: +# wday - Weekday name (or a unique prefix). +# +# Results: +# Returns the weekday number (Monday=1, Sunday=7) +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc lookupDayOfWeek {wday} { + set indx [lsearch -regexp { + {} Monday Tuesday Wednesday Thursday Friday Saturday Sunday + } ${wday}.*] + if {$indx < 1} { + error "unknown weekday name \"$wday\"" + } + return $indx +} + +#---------------------------------------------------------------------- +# +# parseZone -- +# +# Parses a Zone directive in an Olson file +# +# Parameters: +# fileName -- Name of the file being parsed. +# lno -- Line number within the file. +# zone -- Name of the time zone +# words -- Remaining words on the line. +# start -- 'Until' time from the previous line if this is a +# continuation line, or 'minimum' if this is the first line. +# +# Results: +# Returns the 'until' field of the current line +# +# Side effects: +# Stores a row in the 'zones' array describing the current zone. +# The row consists of a start time (year month day tod), a Standard +# Time offset from Greenwich, a Daylight Saving Time offset from +# Standard Time, and a format for printing the time zone. +# +# The start time is the result of an earlier call to 'parseUntil' +# or else the keyword 'minimum'. The GMT offset is the +# result of a call to 'parseOffsetTime'. The Daylight Saving +# Time offset is represented as a partial Tcl command. To the +# command will be appended a start time (seconds from epoch) +# the current offset of Standard Time from Greenwich, the current +# offset of Daylight Saving Time from Greenwich, the default +# offset from this line, the name pattern from this line, +# the 'until' field from this line, and a variable name where points +# are to be stored. This command is implemented by the 'applyNoRule', +# 'applyDSTOffset' and 'applyRules' procedures. +# +#---------------------------------------------------------------------- + +proc parseZone {fileName lno zone words start} { + variable zones + variable rules + variable errorCount + variable forwardRuleRefs + + lassign $words gmtoff save format + if {[catch {parseOffsetTime $gmtoff} gmtoff]} { + puts stderr "$fileName:$lno:$gmtoff" + incr errorCount + return + } + if {[info exists rules($save)]} { + set save [list applyRules $save] + } elseif {$save eq "-"} { + set save [list applyNoRule] + } elseif {[catch {parseOffsetTime $save} save2]} { + lappend forwardRuleRefs($save) $fileName $lno + set save [list applyRules $save] + } else { + set save [list applyDSTOffset $save2] + } + lappend zones($zone) $start $gmtoff $save $format + if {[llength $words] >= 4} { + return [parseUntil [lrange $words 3 end]] + } else { + return {} + } +} + +#---------------------------------------------------------------------- +# +# parseUntil -- +# +# Parses the 'UNTIL' part of a 'Zone' directive. +# +# Parameters: +# words - The 'UNTIL' part of the directie. +# +# Results: +# Returns a list comprising the year, the month, the day, and +# the time of day. Time of day is represented as the result of +# 'parseTOD'. +# +#---------------------------------------------------------------------- + +proc parseUntil {words} { + variable firstYear + + if {[llength $words] >= 1} { + set year [lindex $words 0] + if {![string is integer $year]} { + error "can't parse UNTIL field \"$words\"" + } + if {![info exists firstYear] || $year < $firstYear} { + set firstYear $year + } + } else { + set year "maximum" + } + if {[llength $words] >= 2} { + set month [lookupMonth [lindex $words 1]] + } else { + set month 1 + } + if {[llength $words] >= 3} { + set day [parseON [lindex $words 2]] + } else { + set day {onDayOfMonth 1} + } + if {[llength $words] >= 4} { + set tod [parseTOD [lindex $words 3]] + } else { + set tod {0 w} + } + return [list $year $month $day $tod] +} + +#---------------------------------------------------------------------- +# +# applyNoRule -- +# +# Generates time zone data for a zone without Daylight Saving +# Time. +# +# Parameters: +# year - Year in which the rule applies +# startSecs - Time at which the rule starts. +# stdGMTOffset - Offset from Greenwich prior to the start of the +# rule +# DSTOffset - Offset of Daylight from Standard prior to the +# start of the rule. +# nextGMTOffset - Offset from Greenwich when the rule is in effect. +# namePattern - Name of the timezone. +# until - Time at which the rule expires. +# pointsVar - Name of a variable in callers scope that receives +# transition times +# +# Results: +# Returns a two element list comprising 'nextGMTOffset' and +# 0 - the zero indicates that Daylight Saving Time is not +# in effect. +# +# Side effects: +# Appends a row to the 'points' variable comprising the start time, +# the offset from GMT, a zero (indicating that DST is not in effect), +# and the name of the time zone. +# +#---------------------------------------------------------------------- + +proc applyNoRule {year startSecs stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { + upvar 1 $pointsVar points + lappend points $startSecs $nextGMTOffset 0 \ + [convertNamePattern $namePattern -] + return [list $nextGMTOffset 0] +} + +#---------------------------------------------------------------------- +# +# applyDSTOffset -- +# +# Generates time zone data for a zone with permanent Daylight +# Saving Time. +# +# Parameters: +# nextDSTOffset - Offset of Daylight from Standard while the +# rule is in effect. +# year - Year in which the rule applies +# startSecs - Time at which the rule starts. +# stdGMTOffset - Offset from Greenwich prior to the start of the +# rule +# DSTOffset - Offset of Daylight from Standard prior to the +# start of the rule. +# nextGMTOffset - Offset from Greenwich when the rule is in effect. +# namePattern - Name of the timezone. +# until - Time at which the rule expires. +# pointsVar - Name of a variable in callers scope that receives +# transition times +# +# Results: +# Returns a two element list comprising 'nextGMTOffset' and +# 'nextDSTOffset'. +# +# Side effects: +# Appends a row to the 'points' variable comprising the start time, +# the offset from GMT, a one (indicating that DST is in effect), +# and the name of the time zone. +# +#---------------------------------------------------------------------- + +proc applyDSTOffset {nextDSTOffset year startSecs + stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { + upvar 1 $pointsVar points + lappend points \ + $startSecs \ + [expr {$nextGMTOffset + $nextDSTOffset}] \ + 1 \ + [convertNamePattern $namePattern S] + return [list $nextGMTOffset $nextDSTOffset] +} + +#---------------------------------------------------------------------- +# +# applyRules -- +# +# Applies a rule set to a time zone for a given range of time +# +# Parameters: +# ruleSet - Name of the rule set to apply +# year - Starting year for the rules +# startSecs - Time at which the rules begin to apply +# stdGMTOffset - Offset from Greenwich prior to the start of the +# rules. +# DSTOffset - Offset of Daylight from Standard prior to the +# start of the rules. +# nextGMTOffset - Offset from Greenwich when the rules are in effect. +# namePattern - Name pattern for the time zone. +# until - Time at which the rule set expires. +# pointsVar - Name of a variable in callers scope that receives +# transition times +# +# Results: +# Returns a two element list comprising the offset from GMT +# to Standard and the offset from Standard to Daylight (if DST +# is in effect) at the end of the period in which the rules apply +# +# Side effects: +# Appends one or more rows to the 'points' variable, each of which +# comprises a transition time, the offset from GMT that is +# in effect after the transition, a flag for whether DST is in +# effect, and the name of the time zone. +# +#---------------------------------------------------------------------- + +proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { + variable done + variable rules + variable maxyear + + upvar 1 $pointsVar points + + # Extract the rules that apply to the current year, and the number + # of rules (now or in future) that will end at a specific year. + # Ignore rules entirely in the past. + + lassign [divideRules $ruleSet $year] currentRules nSunsetRules + + # If the first transition is later than $startSecs, and $stdGMTOffset is + # different from $nextGMTOffset, we will need an initial record like: + # lappend points $startSecs $stdGMTOffset 0 \ + # [convertNamePattern $namePattern -] + + set didTransitionIn false + + # Determine the letter to use in Standard Time + + set prevLetter "" + foreach { + fromYear toYear yearType monthIn daySpecOn timeAt save letter + } $rules($ruleSet) { + if {$save == 0} { + set prevLetter $letter + break + } + } + + # Walk through each year in turn. This loop will break when + # (a) the 'until' time is passed + # or (b) the 'until' time is empty and all remaining rules extend to + # the end of time + + set stdGMTOffset $nextGMTOffset + + # convert "until" to seconds from epoch in current time zone + + if {$until ne ""} { + lassign $until untilYear untilMonth untilDaySpec untilTimeOfDay + lappend untilDaySpec $untilYear $untilMonth + set untilJCD [eval $untilDaySpec] + set untilBaseSecs [expr { + wide(86400) * wide($untilJCD) - 210866803200 }] + set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \ + $DSTOffset {*}$untilTimeOfDay] + } + + set origStartSecs $startSecs + + while {($until ne "" && $startSecs < $untilSecs) + || ($until eq "" && ($nSunsetRules > 0 || $year < $maxyear))} { + set remainingRules $currentRules + while {[llength $remainingRules] > 0} { + + # Find the rule with the earliest start time from among the + # active rules that haven't yet been processed. + + lassign [findEarliestRule $remainingRules $year \ + $stdGMTOffset $DSTOffset] earliestSecs earliestIndex + + set endi [expr {$earliestIndex + 7}] + set rule [lrange $remainingRules $earliestIndex $endi] + lassign $rule fromYear toYear \ + yearType monthIn daySpecOn timeAt save letter + + # Test if the rule is in effect. + + if { + $earliestSecs > $startSecs && + ($until eq "" || $earliestSecs < $untilSecs) + } then { + # Test if the initial transition has been done. + # If not, do it now. + + if {!$didTransitionIn && $earliestSecs > $origStartSecs} { + set nm [convertNamePattern $namePattern $prevLetter] + lappend points \ + $origStartSecs \ + [expr {$stdGMTOffset + $DSTOffset}] \ + 0 \ + $nm + set didTransitionIn true + } + + # Add a row to 'points' for the rule + + set nm [convertNamePattern $namePattern $letter] + lappend points \ + $earliestSecs \ + [expr {$stdGMTOffset + $save}] \ + [expr {$save != 0}] \ + $nm + } + + # Remove the rule just applied from the queue + + set remainingRules [lreplace \ + $remainingRules[set remainingRules {}] \ + $earliestIndex $endi] + + # Update current DST offset and time zone letter + + set DSTOffset $save + set prevLetter $letter + + # Reconvert the 'until' time in the current zone. + + if {$until ne ""} { + set untilSecs [convertTimeOfDay $untilBaseSecs \ + $stdGMTOffset $DSTOffset {*}$untilTimeOfDay] + } + } + + # Advance to the next year + + incr year + set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ + [dict create era CE year $year month 1 dayOfMonth 1] 2361222] + set startSecs [expr { + [dict get $date julianDay] * wide(86400) - 210866803200 + - $stdGMTOffset - $DSTOffset + }] + + # Get rules in effect in the new year. + + lassign [divideRules $ruleSet $year] currentRules nSunsetRules + } + + return [list $stdGMTOffset $DSTOffset] +} + +#---------------------------------------------------------------------- +# +# divideRules -- +# Determine what Daylight Saving Time rules may be in effect in +# a given year. +# +# Parameters: +# ruleSet - Set of rules from 'parseRule' +# year - Year to test +# +# Results: +# Returns a two element list comprising the subset of 'ruleSet' +# that is in effect in the given year, and the count of rules +# that expire in the future (as opposed to those that expire in +# the past or not at all). If this count is zero, the rules do +# not change in future years. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc divideRules {ruleSet year} { + variable rules + + set currentRules {} + set nSunsetRules 0 + + foreach { + fromYear toYear yearType monthIn daySpecOn timeAt save letter + } $rules($ruleSet) { + if {$toYear ne "maximum" && $year > $toYear} { + # ignore - rule is in the past + } else { + if {$fromYear eq "minimum" || $fromYear <= $year} { + lappend currentRules $fromYear $toYear $yearType $monthIn \ + $daySpecOn $timeAt $save $letter + } + if {$toYear ne "maximum"} { + incr nSunsetRules + } + } + } + + return [list $currentRules $nSunsetRules] + +} + +#---------------------------------------------------------------------- +# +# findEarliestRule -- +# +# Find the rule in a rule set that has the earliest start time. +# +# Parameters: +# remainingRules -- Rules to search +# year - Year being processed. +# stdGMTOffset - Current offset of standard time from GMT +# DSTOffset - Current offset of daylight time from standard, +# if daylight time is in effect. +# +# Results: +# Returns the index in remainingRules of the next rule to +# go into effect. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc findEarliestRule {remainingRules year stdGMTOffset DSTOffset} { + set earliest $::MAXWIDE + set i 0 + foreach { + fromYear toYear yearType monthIn daySpecOn timeAt save letter + } $remainingRules { + lappend daySpecOn $year $monthIn + set dayIn [eval $daySpecOn] + set secs [expr {wide(86400) * wide($dayIn) - 210866803200}] + set secs [convertTimeOfDay $secs \ + $stdGMTOffset $DSTOffset {*}$timeAt] + if {$secs < $earliest} { + set earliest $secs + set earliestIdx $i + } + incr i 8 + } + + return [list $earliest $earliestIdx] +} + +#---------------------------------------------------------------------- +# +# convertNamePattern -- +# +# Converts a name pattern to the name of the time zone. +# +# Parameters: +# pattern - Patthern to convert +# flag - Daylight Time flag. An empty string denotes Standard +# Time, anything else is Daylight Time. +# +# Results; +# Returns the name of the time zone. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc convertNamePattern {pattern flag} { + if {[regexp {(.*)/(.*)} $pattern -> standard daylight]} { + if {$flag ne ""} { + set pattern $daylight + } else { + set pattern $standard + } + } + return [string map [list %s $flag] $pattern] +} + +#---------------------------------------------------------------------- +# +# convertTimeOfDay -- +# +# Takes a time of day specifier from 'parseAt' and converts +# to seconds from the Epoch, +# +# Parameters: +# seconds -- Time at which the GMT day starts, in seconds +# from the Posix epoch +# stdGMTOffset - Offset of Standard Time from Greenwich +# DSTOffset - Offset of Daylight Time from standard. +# timeOfDay - Time of day to convert, in seconds from midnight +# flag - Flag indicating whether the time is Greenwich, Standard +# or wall-clock. (g, s, or w) +# +# Results: +# Returns the time of day in seconds from the Posix epoch. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc convertTimeOfDay {seconds stdGMTOffset DSTOffset timeOfDay flag} { + incr seconds $timeOfDay + switch -exact $flag { + g - u - z { + } + w { + incr seconds [expr {-$stdGMTOffset}] + incr seconds [expr {-$DSTOffset}] + } + s { + incr seconds [expr {-$stdGMTOffset}] + } + } + return $seconds +} + +#---------------------------------------------------------------------- +# +# processTimeZone -- +# +# Generate the information about all time transitions in a +# time zone. +# +# Parameters: +# zoneName - Name of the time zone +# zoneData - List containing the rows describing the time zone, +# obtained from 'parseZone. +# +# Results: +# Returns a list of rows. Each row consists of a time in +# seconds from the Posix epoch, an offset from GMT to local +# that begins at that time, a flag indicating whether DST +# is in effect after that time, and the printable name of the +# timezone that goes into effect at that time. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc processTimeZone {zoneName zoneData} { + set points {} + set i 0 + foreach {startTime nextGMTOffset dstRule namePattern} $zoneData { + incr i 4 + set until [lindex $zoneData $i] + if {![info exists stdGMTOffset]} { + set stdGMTOffset $nextGMTOffset + } + if {![info exists DSTOffset]} { + set DSTOffset 0 + } + if {$startTime eq "minimum"} { + set secs $::MINWIDE + set year 0 + } else { + lassign $startTime year month dayRule timeOfDay + lappend dayRule $year $month + set startDay [eval $dayRule] + set secs [expr {wide(86400) * wide($startDay) -210866803200}] + set secs [convertTimeOfDay $secs \ + $stdGMTOffset $DSTOffset {*}$timeOfDay] + } + lappend dstRule \ + $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \ + $namePattern $until points + lassign [eval $dstRule] stdGMTOffset DSTOffset + } + return $points +} + +#---------------------------------------------------------------------- +# +# writeZones -- +# +# Writes all the time zone information files. +# +# Parameters: +# outDir - Directory in which to store the files. +# +# Results: +# None. +# +# Side effects: +# Writes the time zone information files; traces what's happening +# on the standard output. +# +#---------------------------------------------------------------------- + +proc writeZones {outDir} { + variable zones + + # Walk the zones + + foreach zoneName [lsort -dictionary [array names zones]] { + puts "calculating: $zoneName" + set fileName [eval [list file join $outDir] [file split $zoneName]] + + # Create directories as needed + + set dirName [file dirname $fileName] + if {![file exists $dirName]} { + puts "creating directory: $dirName" + file mkdir $dirName + } + + # Generate data for a zone + + set data "" + foreach { + time offset dst name + } [processTimeZone $zoneName $zones($zoneName)] { + append data "\n " [list [list $time $offset $dst $name]] + } + append data \n + + # 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] + close $f + } + + return +} + +#---------------------------------------------------------------------- +# +# writeLinks -- +# +# Write files describing time zone synonyms (the Link directives +# from the Olson files) +# +# Parameters: +# outDir - Name of the directory where the output files go. +# +# Results: +# None. +# +# Side effects: +# Creates a file for each link. + +proc writeLinks {outDir} { + variable links + + # Walk the links + + foreach zoneName [lsort -dictionary [array names links]] { + puts "creating link: $zoneName" + set fileName [eval [list file join $outDir] [file split $zoneName]] + + # Create directories as needed + + set dirName [file dirname $fileName] + if {![file exists $dirName]} { + puts "creating directory: $dirName" + file mkdir $dirName + } + + # Create code for the synonym + + set linkTo $links($zoneName) + set sourceCmd "\n [list LoadTimeZoneFile $linkTo]\n" + set ifCmd [list if "!\[info exists TZData($linkTo)\]" $sourceCmd] + set setCmd "set TZData(:$zoneName) \$TZData(:$linkTo)" + + # 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 + close $f + } + + return +} + +#---------------------------------------------------------------------- +# +# MAIN PROGRAM +# +#---------------------------------------------------------------------- + +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 + +# Parse the Olson files + +loadFiles $inDir +if {$errorCount > 0} { + exit 1 +} + +# Check that all riles appearing in Zone and Link lines actually exist + +checkForwardRuleRefs +if {$errorCount > 0} { + exit 1 +} + +# Write the time zone information files + +writeZones $outDir +writeLinks $outDir +if {$errorCount > 0} { + exit 1 +} + +# All done! + +exit diff --git a/tools/tclmin.wse b/tools/tclmin.wse index 2e7f69b..2fd8185 100644 --- a/tools/tclmin.wse +++ b/tools/tclmin.wse @@ -37,12 +37,12 @@ item: Install File end item: Install File Source=n:\dist\tcl8.0\library\http\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.5\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.5\http.tcl + Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl Flags=0000000000000010 end item: Install File diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index c96362f..c6932d0 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -2,13 +2,11 @@ # The next line is executed by /bin/sh, but not tcl \ exec tclsh "$0" ${1+"$@"} -package require Tcl 8.4 +package require Tcl 8.5 -# 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,54 +16,10 @@ 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 -# -set Version "0.32" +set Version "0.40" + +set ::CSSFILE "docs.css" proc parse_command_line {} { global argv Version @@ -82,7 +36,7 @@ proc parse_command_line {} { set build_tcl 0 set build_tk 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 @@ -140,13 +94,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 } @@ -157,7 +114,7 @@ proc parse_command_line {} { # Find Tk. set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tk$useversion]] end] - if {$tkdir == ""} then { + if {$tkdir eq ""} { puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" exit 1 } @@ -167,10 +124,16 @@ proc parse_command_line {} { # 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} { @@ -186,28 +149,168 @@ 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): $msg" + puts stderr "$name: $manual(section): $procname: $msg" } else { - puts stderr "$name: $msg" + puts stderr "$name: $procname: $msg" } } proc manreport {level msg} { global manual if {$level < $manual(report-level)} { - manerror $msg + uplevel 1 [list manerror $msg] } } proc fatal {msg} { global manual - manerror $msg + 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 +} +proc gencss {} { + set hBd "1px dotted #11577b" + return " +body, div, p, th, td, li, dd, ul, ol, dl, dt, blockquote { + font-family: Verdana, sans-serif; +} + +pre, code { font-family: 'Courier New', Courier, monospace; } + +pre { + background-color: #f6fcec; + border-top: 1px solid #6A6A6A; + border-bottom: 1px solid #6A6A6A; + padding: 1em; + overflow: auto; +} + +body { + background-color: #FFFFFF; + font-size: 12px; + line-height: 1.25; + letter-spacing: .2px; + padding-left: .5em; +} + +h1, h2, h3, h4 { + font-family: Georgia, serif; + padding-left: 1em; + margin-top: 1em; +} + +h1 { + font-size: 18px; + color: #11577b; + border-bottom: $hBd; + margin-top: 0px; +} + +h2 { + font-size: 14px; + color: #11577b; + background-color: #c5dce8; + padding-left: 1em; + border: 1px solid #6A6A6A; +} + +h3, h4 { + color: #1674A4; + background-color: #e8f2f6; + border-bottom: $hBd; + border-top: $hBd; +} + +h3 { font-size: 12px; } +h4 { font-size: 11px; } + +.keylist dt, .arguments dt { + width: 20em; + float: left; + padding: 2px; + border-top: 1px solid #999; +} + +.keylist dt { font-weight: bold; } + +.keylist dd, .arguments dd { + margin-left: 20em; + padding: 2px; + border-top: 1px solid #999; +} + +.copy { + background-color: #f6fcfc; + white-space: pre; + font-size: 80%; + border-top: 1px solid #6A6A6A; + margin-top: 2em; +} +" +} + ## ## parsing ## @@ -216,36 +319,53 @@ proc unquote arg { } proc parse-directive {line codename restname} { - upvar $codename code $restname rest + 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 - 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 + set charmap [list \ + {\&} "\t" \ + {\%} {} \ + "\\\n" "\n" \ + {\(+-} "±" \ + {\(co} "©" \ + {\(em} "—" \ + {\(fm} "′" \ + {\(mu} "×" \ + {\(->} "<font size=\"+1\">→</font>" \ + {\fP} {\fR} \ + {\.} . \ + {\(bu} "•" \ + ] + lappend charmap {\o'o^'} {ô} ; # o-circumflex in re_syntax.n + 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 \ @@ -263,19 +383,21 @@ proc process-text {text} { if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \ {\1<I>\2</I>\\fB\3} text]} continue # B B, I I, R R - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \ + 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" + {\1\\fR\2\3} ntext] + } then { + manerror "impotent font change: $text" set text $ntext continue } # unrecognized - manerror "process-text: uncaught backslash: $text" - set text [string map [list "\\" "#92;"] $text] + manerror "uncaught backslash: $text" + set text [string map [list "\\" "\"] $text] } return $text } @@ -305,13 +427,13 @@ proc is-a-directive {line} { return [string match .* $line] } proc split-directive {line opname restname} { - upvar $opname op $restname rest + 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 $restname rest + upvar 1 $restname rest if {[more-text]} { set text [lindex $manual(text) $manual(text-pointer)] if {[string equal -length 3 $text $op]} { @@ -342,13 +464,13 @@ proc match-text args { } set arg [string trim $arg] set targ [string trim [lindex $manual(text) $manual(text-pointer)]] - if {[string equal $arg $targ]} { + if {$arg eq $targ} { incr nback incr manual(text-pointer) continue } if {[regexp {^@(\w+)$} $arg all name]} { - upvar $name var + upvar 1 $name var set var $targ incr nback incr manual(text-pointer) @@ -356,7 +478,7 @@ proc match-text args { } if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\ && [string equal $op [lindex $targ 0]]} { - upvar $name var + upvar 1 $name var set var [lrange $targ 1 end] incr nback incr manual(text-pointer) @@ -393,37 +515,44 @@ proc long-toc {text} { } 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 { + if {[string match "*OPTIONS" $manual(section)]} { + if { + $manual(name) ne "ttk_widget" + && $manual(section) ne "WIDGET-SPECIFIC OPTIONS" + } then { + # 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} { +proc std-option-toc {name page} { global manual - if {[info exists manual(standard-option-$name)]} { - lappend manual(section-toc) <DD>$manual(standard-option-$name) - return $manual(standard-option-$name) + 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=\"options.htm#$other\">$name</A>" - return "<A HREF=\"options.htm#$other\">$name</A>" + 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 @@ -436,8 +565,10 @@ proc output-widget-options {rest} { backup-text 1 set para {} while {[next-op-is .OP rest]} { - switch -exact [llength $rest] { - 3 { foreach {switch name class} $rest { break } } + switch -exact -- [llength $rest] { + 3 { + lassign $rest switch name class + } 5 { set switch [lrange $rest 0 2] set name [lindex $rest 3] @@ -447,12 +578,13 @@ proc output-widget-options {rest} { fatal "bad .OP $rest" } } - if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} { - if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} { + 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" } + set switch "$switch1$cswitch or $oswitch$switch2" } if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} { error "not Name: $name" @@ -465,6 +597,30 @@ proc output-widget-options {rest} { 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> @@ -494,7 +650,7 @@ proc output-RS-list {} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest - switch -exact $code { + switch -exact -- $code { .RE { break } @@ -510,7 +666,7 @@ proc output-RS-list {} { } else { man-puts $line } - } + } man-puts </DL> } @@ -527,11 +683,11 @@ proc output-IP-list {context code rest} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest - if {[string equal $code ".IP"] && [string equal $rest {}]} { + if {$code eq ".IP" && $rest eq {}} { man-puts "<P>" continue } - if {[lsearch {.br .DS .RS} $code] >= 0} { + if {$code in {.br .DS .RS}} { output-directive $line } else { backup-text 1 @@ -544,14 +700,12 @@ proc output-IP-list {context code rest} { man-puts </DL> } else { # labelled list, make contents - if { - [string compare $context ".SH"] && - [string compare $context ".SS"] - } then { + if {$context ne ".SH" && $context ne ".SS"} { man-puts <P> } - man-puts <DL> - lappend manual(section-toc) <DL> + set dl "<DL class=\"[string tolower $manual(section)]\">" + man-puts $dl + lappend manual(section-toc) $dl backup-text 1 set accept_RE 0 set para {} @@ -559,31 +713,28 @@ proc output-IP-list {context code rest} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest - switch -exact $code { + switch -exact -- $code { .IP { if {$accept_RE} { output-IP-list .IP $code $rest continue } - if {[string equal $manual(section) "ARGUMENTS"] || \ + if {$manual(section) eq "ARGUMENTS" || \ [regexp {^\[\d+\]$} $rest]} { man-puts "$para<DT>$rest<DD>" - } elseif {[string equal {•} $rest]} { - man-puts "$para<DT><DD>$rest " + } elseif {"•" eq $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 {"$manual(name):$manual(section)" eq \ + "selection:DESCRIPTION"} { if {[match-text .RE @rest .RS .RS]} { man-puts <DT>[long-toc $rest]<DD> } } } - .sp - - .br - - .DS - - .CS { + .sp - .br - .DS - .CS { output-directive $line } .RS { @@ -664,7 +815,7 @@ proc output-name {line} { # output line to manual page untouched man-puts $line # output line to long table of contents - lappend manual(section-toc) <DL><DD>$line</DL> + lappend manual(section-toc) <DL><DD>$line</DD></DL> # separate out the names for future reference foreach name [split $head ,] { set name [string trim $name] @@ -680,11 +831,11 @@ proc output-name {line} { ## proc cross-reference {ref} { global manual - if {[string match Tcl_* $ref]} { + if {[string match "Tcl_*" $ref]} { set lref $ref - } elseif {[string match Tk_* $ref]} { + } elseif {[string match "Tk_*" $ref]} { set lref $ref - } elseif {[string equal $ref "Tcl"]} { + } elseif {$ref eq "Tcl"} { set lref $ref } else { set lref [string tolower $ref] @@ -693,15 +844,17 @@ proc cross-reference {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} { + 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"]} { + $manual(tail) ne "$name.n"} { return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>" } } - if {[lsearch {stdin stdout stderr end} $lref] >= 0} { + if {$lref in {stdin stdout stderr end}} { # no good place to send these # tcl tokens? # also end @@ -712,7 +865,7 @@ proc cross-reference {ref} { ## would be a self reference ## foreach name $manual(name-$lref) { - if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} { + if {"$manual(wing-file)/$manual(name)" in $name} { return $ref } } @@ -724,15 +877,15 @@ proc cross-reference {ref} { 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}} { + if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd" + || $manual(wing-file) eq "TclLib"} { return "<A HREF=\"../$tcl_ref.htm\">$ref</A>" } - if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} \ - || "$manual(wing-file)" == {TkLib}} { + if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd" + || $manual(wing-file) eq "TkLib"} { return "<A HREF=\"../$tk_ref.htm\">$ref</A>" } - if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} { + if {$lref eq "exit" && $manual(tail) eq "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)" @@ -741,57 +894,56 @@ proc cross-reference {ref} { ## ## exceptions, sigh, to the rule ## - switch $manual(tail) { + switch -exact -- $manual(tail) { canvas.n { - if {$lref == {focus}} { - upvar tail tail + if {$lref eq "focus"} { + upvar 1 tail tail set clue [string first command $tail] if {$clue < 0 || $clue > 5} { return $ref } } - if {[lsearch {bitmap image text} $lref] >= 0} { + if {$lref in {bitmap image text}} { return $ref } } - checkbutton.n - - radiobutton.n { - if {[lsearch {image} $lref] >= 0} { + checkbutton.n - radiobutton.n { + if {$lref in {image}} { return $ref } } menu.n { - if {[lsearch {checkbutton radiobutton} $lref] >= 0} { + if {$lref in {checkbutton radiobutton}} { return $ref } } options.n { - if {[lsearch {bitmap image set} $lref] >= 0} { + if {$lref in {bitmap image set}} { return $ref } } regexp.n { - if {[lsearch {string} $lref] >= 0} { + if {$lref in {string}} { return $ref } } source.n { - if {[lsearch {text} $lref] >= 0} { + if {$lref in {text}} { return $ref } } history.n { - if {[lsearch {exec} $lref] >= 0} { + if {$lref in {exec}} { return $ref } } return.n { - if {[lsearch {error continue break} $lref] >= 0} { + if {$lref in {error continue break}} { return $ref } } scrollbar.n { - if {[lsearch {set} $lref] >= 0} { + if {$lref in {set}} { return $ref } } @@ -860,7 +1012,7 @@ proc insert-cross-references {text} { ## ## see which we want to use ## - switch -exact $invert([lindex $offsets 0]) { + switch -exact -- $invert([lindex $offsets 0]) { anchor { if {$offset(end-anchor) < 0} { return [reference-error {Missing end anchor} $text] @@ -873,13 +1025,13 @@ proc insert-cross-references {text} { if {$offset(end-quote) < 0} { return [reference-error "Missing end quote" $text] } - if {$invert([lindex $offsets 1]) == "tk"} { + if {$invert([lindex $offsets 1]) eq "tk"} { set offsets [lreplace $offsets 1 1] } - if {$invert([lindex $offsets 1]) == "tcl"} { + if {$invert([lindex $offsets 1]) eq "tcl"} { set offsets [lreplace $offsets 1 1] } - switch -exact $invert([lindex $offsets 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}] \ @@ -900,14 +1052,16 @@ proc insert-cross-references {text} { return [reference-error "Uncaught quote case" $text] } bold { - if {$offset(end-bold) < 0} { return $text } - if {$invert([lindex $offsets 1]) == "tk"} { + if {$offset(end-bold) < 0} { + return $text + } + if {$invert([lindex $offsets 1]) eq "tk"} { set offsets [lreplace $offsets 1 1] } - if {$invert([lindex $offsets 1]) == "tcl"} { + if {$invert([lindex $offsets 1]) eq "tcl"} { set offsets [lreplace $offsets 1 1] } - switch -exact $invert([lindex $offsets 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}] \ @@ -964,9 +1118,8 @@ proc output-directive {line} { global manual # process format directive split-directive $line code rest - switch -exact $code { - .BS - - .BE { + switch -exact -- $code { + .BS - .BE { # man-puts <HR> } .SH - .SS { @@ -976,16 +1129,16 @@ proc output-directive {line} { # start our own stack of stuff set manual($manual(name)-$manual(section)) {} lappend manual(has-$manual(section)) $manual(name) - if {[string compare .SS $code]} { + 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 $manual(section) { + switch -exact -- $manual(section) { NAME { - if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} { + if {$manual(tail) in {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3}} { # these manual pages have two NAME sections if {[info exists manual($manual(tail)-NAME)]} { return @@ -1007,15 +1160,19 @@ proc output-directive {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]} { + if { + [next-op-is .nf rest] + || [next-op-is .br rest] + || [next-op-is .fi rest] + } then { continue } - if {[next-op-is .SH rest] - || [next-op-is .SS rest] - || [next-op-is .BE rest] - || [next-op-is .SO rest]} { + if { + [next-op-is .SH rest] + || [next-op-is .SS rest] + || [next-op-is .BE rest] + || [next-op-is .SO rest] + } then { backup-text 1 break } @@ -1028,12 +1185,11 @@ proc output-directive {line} { 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 - } + } + foreach more [split $more \n] { + man-puts $more<BR> + if {$manual(wing-file) in {TclLib TkLib}} { + lappend manual(section-toc) <DD>$more } } } @@ -1101,18 +1257,14 @@ proc output-directive {line} { return } .SO { + set targetPage $rest 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 - } - } + set opts [split $stuff \n\t] man-puts <DL> lappend manual(section-toc) <DL> - foreach option [lsort $opts] { - man-puts "<DT><B>[std-option-toc $option]</B>" + foreach option [lsort -dictionary $opts] { + man-puts "<DT><B>[std-option-toc $option $targetPage]</B>" } man-puts </DL> lappend manual(section-toc) </DL> @@ -1149,10 +1301,13 @@ proc output-directive {line} { } .DS { if {[next-op-is .ta rest]} { - + # skip the leading .ta directive if it is there } if {[match-text @stuff .DE]} { - man-puts <PRE>$stuff</PRE> + set td "<td><p style=\"font-size:12px;padding-left:.5em;padding-right:.5em;\">" + 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 { @@ -1162,7 +1317,7 @@ proc output-directive {line} { } .CS { if {[next-op-is .ta rest]} { - + # ??? } if {[match-text @stuff .CE]} { man-puts <PRE>$stuff</PRE> @@ -1180,7 +1335,7 @@ proc output-directive {line} { } .ta { # these are tab stop settings for short tables - switch -exact $manual(name):$manual(section) { + switch -exact -- $manual(name):$manual(section) { {bind:MODIFIERS} - {bind:EVENT TYPES} - {bind:BINDING SCRIPTS AND SUBSTITUTIONS} - @@ -1188,7 +1343,6 @@ proc output-directive {line} { {expr:MATH FUNCTIONS} - {history:DESCRIPTION} - {history:HISTORY REVISION} - - {re_syntax:BRACKET EXPRESSIONS} - {switch:DESCRIPTION} - {upvar:DESCRIPTION} { return; # fix.me @@ -1271,32 +1425,38 @@ proc output-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 {^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} { + 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 } - continue - } - if {[regexp {^Copyright +\(c\) +(\d+), *(\d+) +(by +)?(\w.*)$} $copyright all date1 date2 by who]} { - lappend dates($who) $date1 $date2 - continue } puts "oops: $copyright" } 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" + 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 (c) [lindex $list 0]-[lrange $list end end] $who" + lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who" } } - return [lsort $merge] + return [lsort -dictionary $merge] } proc makedirhier {dir} { @@ -1306,35 +1466,64 @@ proc makedirhier {dir} { } } +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) "" + } +} + ## ## 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 + global manual overall_title tcltkdesc makedirhier $html + set cssfd [open $html/$::CSSFILE w] + puts $cssfd [gencss] + close $cssfd 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(short-toc-fp) [open $html/[indexfile] w] + puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title] + puts $manual(short-toc-fp) "<DL class=\"keylist\">" set manual(merge-copyrights) {} foreach arg $args { - if {$arg == ""} {continue} + # preprocess to set up subheader for the rest of the files + if {![llength $arg]} { + continue + } + set name [lindex $arg 1] + set file [lindex $arg 2] + lappend manual(subheader) $name $file + } + foreach arg $args { + if {![llength $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] + set manual(wing-toc-fp) [open $html/$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 - puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)" + 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) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>" - puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>" + 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 @@ -1342,19 +1531,26 @@ proc make-man-pages {html args} { # 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) [lsort -dictionary [glob $manual(wing-glob)]] + set n [lsearch -glob $manual(pages) */ttk_widget.n] + if {$n >= 0} { + set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]" + } + set n [lsearch -glob $manual(pages) */options.n] + if {$n >= 0} { 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) { + set LQ \u201c + set RQ \u201d + foreach manual_page $manual(pages) { + set manual(page) $manual_page # 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} { + if {$manual(name) in {case pack-old menubar}} { # obsolete manerror "discarding $manual(name)" continue @@ -1370,140 +1566,167 @@ proc make-man-pages {html args} { set manual(section-toc) {} set manual(section-toc-n) 1 set manual(copyrights) {} + lappend manual(copyrights) "Copyright © 1995-1997 Roger E. Critchlow Jr." 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]} { + if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} { lappend manual(copyrights) $copyright } # comment continue } - if {"$line" == {'}} { + if {"$line" eq {'}} { # comment continue } - if {[parse-directive $line code rest]} { - switch -exact $code { - .ad - .na - .so - .ne - .AS - .VE - .VS - - . { - # ignore - continue + if {![parse-directive $line code rest]} { + addbuffer $line + continue + } + switch -exact -- $code { + .ad - .na - .so - .ne - .AS - .VE - .VS - . { + # ignore + continue + } + } + switch -exact -- $code { + .SH - .SS { + flushbuffer + if {[llength $rest] == 0} { + gets $manual(infp) rest } + lappend manual(text) "$code [unquote $rest]" } - if {"$manual(partial-text)" != {}} { - lappend manual(text) [process-text $manual(partial-text)] - set manual(partial-text) {} + .TH { + flushbuffer + lappend manual(text) "$code [unquote $rest]" } - 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 + .QW { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + addbuffer $LQ [unquote [lindex $rest 0]] $RQ \ + [unquote [lindex $rest 1]] + } + .PQ { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + addbuffer ( $LQ [unquote [lindex $rest 0]] $RQ \ + [unquote [lindex $rest 1]] ) \ + [unquote [lindex $rest 2]] + } + .QR { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + addbuffer $LQ [unquote [lindex $rest 0]] - \ + [unquote [lindex $rest 1]] $RQ \ + [unquote [lindex $rest 2]] + } + .MT { + addbuffer $LQ$RQ + } + .HS - .UL - .ta { + flushbuffer + lappend manual(text) "$code [unquote $rest]" + } + .BS - .BE - .br - .fi - .sp - .nf { + flushbuffer + if {"$rest" ne {}} { + manerror "unexpected argument: $line" } - .DE { - incr manual(.DS) -1 - lappend manual(text) $code + 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)]]]} { + manerror "ignoring $next after .TP" } - .CS { - incr manual(.CS) - lappend manual(text) $code + if {"$next" ne {'}} { + lappend manual(text) ".IP [process-text $next]" } - .CE { - incr manual(.CS) -1 - lappend manual(text) $code + } + .OP { + flushbuffer + lappend manual(text) [concat .OP [process-text \ + "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\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]" } - .de { - while {[gets $manual(infp) line] >= 0} { - if {[string match "..*" $line]} { - break - } + } + .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 } } - .. { - 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 + .. { + error "found .. outside of .de" + } + default { + flushbuffer + manerror "unrecognized format directive: $line" } } } - if {$manual(partial-text) != ""} { - lappend manual(text) [process-text $manual(partial-text)] - } + flushbuffer close $manual(infp) # fixups if {$manual(.RS) != 0} { - if {$manual(name) != "selection"} { - puts "unbalanced .RS .RE" - } + puts "unbalanced .RS .RE" } if {$manual(.DS) != 0} { puts "unbalanced .DS .DE" @@ -1516,25 +1739,17 @@ proc make-man-pages {html args} { } # output conversion open-text + set haserror 0 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" + set manual($manual(name)-title) "[lindex $rest 0] manual page - [lrange $rest 4 end]" + } else { + set haserror 1 + manerror "no .HS or .TH record found" + } + if {!$haserror} { while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { @@ -1543,19 +1758,13 @@ proc make-man-pages {html args} { 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>" + man-puts [copyout $manual(copyrights) "../"] set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)] - } else { - manerror "no .HS or .TH record found" } # # make the long table of contents for this page # - set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>] + set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL>] } # @@ -1571,7 +1780,7 @@ proc make-man-pages {html args} { set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}] set n 0 catch {unset rows} - foreach name [lsort $manual(wing-toc)] { + 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" @@ -1591,12 +1800,8 @@ proc make-man-pages {html args} { # # 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>" + 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)] } @@ -1604,66 +1809,68 @@ proc make-man-pages {html args} { ## ## build the keyword index. ## - proc strcasecmp {a b} { return [string compare -nocase $a $b] } - set keys [lsort -command strcasecmp [array names manual keyword-*]] + file delete -force -- $html/Keywords 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 keyfp [open $html/Keywords/[indexfile] w] + puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \ + $overall_title "../[indexfile]"] + set letters {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} + # Create header first + set keyheader {} + foreach a $letters { + set keys [array names manual "keyword-\[[string totitle $a$a]\]*"] + if {[llength $keys]} { + lappend keyheader "<A HREF=\"$a.htm\">$a</A>" + } else { + # No keywords for this letter + lappend keyheader $a + } + } + set keyheader "<H3>[join $keyheader " |\n"]</H3>" + puts $keyfp $keyheader + foreach a $letters { + set keys [array names manual "keyword-\[[string totitle $a$a]\]*"] + if {![llength $keys]} { + continue + } + # Per-keyword page set afp [open $html/Keywords/$a.htm w] - puts $afp "<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>" - } - puts $afp [join $refs {, }] + 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] + lappend refs "<A HREF=\"../$file\">$name</A>" } + puts $afp "[join $refs {, }]</DD>" } - puts $afp "</DL><HR><PRE>" + puts $afp "</DL>" # insert merged copyrights - foreach copyright $manual(merge-copyrights) { - puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" - } - puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." - puts $afp "</PRE></BODY></HTML>" + puts $afp [copyout $manual(merge-copyrights)] + puts $afp "</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> + puts $keyfp [copyout $manual(merge-copyrights)] + puts $keyfp "</BODY></HTML>" close $keyfp ## ## finish off short table of contents ## - puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.} - puts $manual(short-toc-fp) "</DL><HR><PRE>" + 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 - 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>" + puts $manual(short-toc-fp) [copyout $manual(merge-copyrights)] + puts $manual(short-toc-fp) "</BODY></HTML>" close $manual(short-toc-fp) ## @@ -1687,22 +1894,26 @@ proc make-man-pages {html args} { 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} { + set outfd [open $html/$manual(wing-file)/$manual(name).htm w] + puts $outfd [htmlhead "$manual($manual(name)-title)" \ + $manual(name) $manual(wing-file) "[indexfile]" \ + $overall_title "../[indexfile]"] + if { + (($ntext > 60) && ($ntoc > 32)) || $manual(tail) in { + Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType + CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash + GetJustify GetPixels GetVisual ParseArgv QueueEvent + } + } then { foreach item $toc { - puts $manual(outfp) $item + puts $outfd $item } } foreach item $text { - puts $manual(outfp) [insert-cross-references $item] + puts $outfd [insert-cross-references $item] } - puts $manual(outfp) </BODY></HTML> - close $manual(outfp) + puts $outfd "</BODY></HTML>" + close $outfd } return {} } @@ -1710,16 +1921,28 @@ proc make-man-pages {html args} { 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"} +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 \ diff --git a/tools/uniClass.tcl b/tools/uniClass.tcl index f741434..db5e8c9 100644 --- a/tools/uniClass.tcl +++ b/tools/uniClass.tcl @@ -91,13 +91,13 @@ proc genTable {type} { append chars "\n#endif" } if {$ranges ne ""} { - puts "static CONST crange ${type}RangeTable\[\] = {\n$ranges\n};\n" + puts "static const crange ${type}RangeTable\[\] = {\n$ranges\n};\n" puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n" } else { puts "/* no contiguous ranges of $type characters */\n" } if {$chars ne ""} { - puts "static CONST chr ${type}CharTable\[\] = {\n$chars\n};\n" + puts "static const chr ${type}CharTable\[\] = {\n$chars\n};\n" puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n" } else { puts "/*\n * no singletons of $type characters.\n */\n" diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl index 86f6d04..baf8a4b 100644 --- a/tools/uniParse.tcl +++ b/tools/uniParse.tcl @@ -203,7 +203,7 @@ proc uni::main {} { * to the same alternate page number. */ -static CONST unsigned short pageMap\[\] = {" +static const unsigned short pageMap\[\] = {" set line " " set last [expr {[llength $pMap] - 1}] for {set i 0} {$i <= $last} {incr i} { @@ -234,7 +234,7 @@ static CONST unsigned short pageMap\[\] = {" * set of character attributes. */ -static CONST unsigned char groupMap\[\] = {" +static const unsigned char groupMap\[\] = {" set line " " set lasti [expr {[llength $pages] - 1}] for {set i 0} {$i <= $lasti} {incr i} { @@ -277,7 +277,7 @@ static CONST unsigned char groupMap\[\] = {" * highest field so we can easily sign extend. */ -static CONST int groups\[\] = {" +static const int groups\[\] = {" set line " " set last [expr {[llength $groups] - 1}] for {set i 0} {$i <= $last} {incr i} { |
