Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume26/tclx/part10

Text File | 1991-11-19 | 46.8 KB | 1,409 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Karl Lehenbauer)
Subject:  v26i010:  tclx - extensions and on-line help for tcl 6.1, Part10/23
Message-ID: <[e-mail]>
X-Md4-Signature: d29f799aa78025252413ac906f222e4e
Date: Tue, 19 Nov 1991 00:55:53 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Karl Lehenbauer)
Posting-number: Volume 26, Issue 10
Archive-name: tclx/part10
Environment: UNIX

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 10 (of 23)."
# Contents:  extended/ossupport/strftime.c extended/src/tclExtdInt.h
#   extended/tcllib/help/commands/history
#   extended/tcllib/help/commands/info extended/tclsrc/help.tcl
#   extended/tests/iocmds.test
# Wrapped by karl@one on Wed Nov 13 21:50:22 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'extended/ossupport/strftime.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/ossupport/strftime.c'\"
else
echo shar: Extracting \"'extended/ossupport/strftime.c'\" \(6767 characters\)
sed "s/^X//" >'extended/ossupport/strftime.c' <<'END_OF_FILE'
X/*
X * strftime.c
X *
X * Public-domain relatively quick-and-dirty implemenation of
X * ANSI library routine for System V Unix systems.
X *
X * It's written in old-style C for maximal portability.
X *
X * The code for %c, %x, and %X is my best guess as to what's "appropriate".
X * This version ignores LOCALE information.
X * It also doesn't worry about multi-byte characters.
X * So there.
X *
X * Arnold Robbins
X * January, February, 1991
X *
X * Fixes from [e-mail]
X * February 1991
X */
X
X/*
X * To avoid Unix version problems, this code has been simplified to avoid
X * const and size_t, however this can cause an incompatible definition on
X * ansi-C systems, so a game is played with defines to ignore a strftime
X * declaration in time.h
X */
X
X#define strftime ___srtftime
X
X#include <stdio.h>
X#include <string.h>
X#include <time.h>
X#include <sys/types.h>
X
X#undef strftime
X
Xextern void tzset();
Xextern char *strchr();
Xstatic int weeknumber();
X
X#ifndef TCL_HAS_TM_ZONE
Xextern char *tzname[2];
Xextern int daylight;
X#endif
X
X/* strftime --- produce formatted time */
X
Xint
Xstrftime(s, maxsize, format, timeptr)
X    char            *s;
X    int              maxsize;
X    char            *format;
X    struct tm       *timeptr;
X{
X    char *endp = s + maxsize;
X    char *start = s;
X    char tbuf[100];
X    int i;
X    static short first = 1;
X
X    /* various tables, useful in North America */
X    static char *days_a[] = {
X        "Sun", "Mon", "Tue", "Wed",
X        "Thu", "Fri", "Sat",
X    };
X    static char *days_l[] = {
X        "Sunday", "Monday", "Tuesday", "Wednesday",
X        "Thursday", "Friday", "Saturday",
X    };
X    static char *months_a[] = {
X        "Jan", "Feb", "Mar", "Apr", "May", "Jun",
X        "Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
X    };
X    static char *months_l[] = {
X        "January", "February", "March", "April",
X        "May", "June", "July", "August", "September",
X        "October", "November", "December",
X    };
X    static char *ampm[] = { "AM", "PM", };
X
X    if (s == NULL || format == NULL || timeptr == NULL || maxsize == 0)
X        return 0;
X
X    if (strchr(format, '%') == NULL && strlen(format) + 1 >= maxsize)
X        return 0;
X
X    if (first) {
X        tzset();
X        first = 0;
X    }
X
X    for (; *format && s < endp - 1; format++) {
X        tbuf[0] = '\0';
X        if (*format != '%') {
X            *s++ = *format;
X            continue;
X        }
X        switch (*++format) {
X        case '\0':
X            *s++ = '%';
X            goto out;
X
X        case '%':
X            *s++ = '%';
X            continue;
X
X        case 'a':    /* abbreviated weekday name */
X            if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6)
X                strcpy(tbuf, "?");
X            else
X                strcpy(tbuf, days_a[timeptr->tm_wday]);
X            break;
X
X        case 'A':    /* full weekday name */
X            if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6)
X                strcpy(tbuf, "?");
X            else
X                strcpy(tbuf, days_l[timeptr->tm_wday]);
X            break;
X
X        case 'h':    /* abbreviated month name */
X        case 'b':    /* abbreviated month name */
X            if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11)
X                strcpy(tbuf, "?");
X            else
X                strcpy(tbuf, months_a[timeptr->tm_mon]);
X            break;
X
X        case 'B':    /* full month name */
X            if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11)
X                strcpy(tbuf, "?");
X            else
X                strcpy(tbuf, months_l[timeptr->tm_mon]);
X            break;
X
X        case 'c':    /* appropriate date and time representation */
X            sprintf(tbuf, "%s %s %2d %02d:%02d:%02d %d",
X                days_a[timeptr->tm_wday],
X                months_a[timeptr->tm_mon],
X                timeptr->tm_mday,
X                timeptr->tm_hour,
X                timeptr->tm_min,
X                timeptr->tm_sec,
X                timeptr->tm_year + 1900);
X            break;
X
X        case 'd':    /* day of the month, 01 - 31 */
X            sprintf(tbuf, "%02d", timeptr->tm_mday);
X            break;
X
X        case 'H':    /* hour, 24-hour clock, 00 - 23 */
X            sprintf(tbuf, "%02d", timeptr->tm_hour);
X            break;
X
X        case 'I':    /* hour, 12-hour clock, 01 - 12 */
X            i = timeptr->tm_hour;
X            if (i == 0)
X                i = 12;
X            else if (i > 12)
X                i -= 12;
X            sprintf(tbuf, "%02d", i);
X            break;
X
X        case 'j':    /* day of the year, 001 - 366 */
X            sprintf(tbuf, "%03d", timeptr->tm_yday + 1);
X            break;
X
X        case 'm':    /* month, 01 - 12 */
X            sprintf(tbuf, "%02d", timeptr->tm_mon + 1);
X            break;
X
X        case 'M':    /* minute, 00 - 59 */
X            sprintf(tbuf, "%02d", timeptr->tm_min);
X            break;
X
X        case 'p':    /* am or pm based on 12-hour clock */
X            if (timeptr->tm_hour < 12)
X                strcpy(tbuf, ampm[0]);
X            else
X                strcpy(tbuf, ampm[1]);
X            break;
X
X        case 'S':    /* second, 00 - 61 */
X            sprintf(tbuf, "%02d", timeptr->tm_sec);
X            break;
X
X        case 'U':    /* week of year, Sunday is first day of week */
X            sprintf(tbuf, "%d", weeknumber(timeptr, 0));
X            break;
X
X        case 'w':    /* weekday, Sunday == 0, 0 - 6 */
X            sprintf(tbuf, "%d", timeptr->tm_wday);
X            break;
X
X        case 'W':    /* week of year, Monday is first day of week */
X            sprintf(tbuf, "%d", weeknumber(timeptr, 1));
X            break;
X
X        case 'x':    /* appropriate date representation */
X            sprintf(tbuf, "%s %s %2d %d",
X                days_a[timeptr->tm_wday],
X                months_a[timeptr->tm_mon],
X                timeptr->tm_mday,
X                timeptr->tm_year + 1900);
X            break;
X
X        case 'X':    /* appropriate time representation */
X            sprintf(tbuf, "%02d:%02d:%02d",
X                timeptr->tm_hour,
X                timeptr->tm_min,
X                timeptr->tm_sec);
X            break;
X
X        case 'y':    /* year without a century, 00 - 99 */
X            i = timeptr->tm_year % 100;
X            sprintf(tbuf, "%d", i);
X            break;
X
X        case 'Y':    /* year with century */
X            sprintf(tbuf, "%d", 1900 + timeptr->tm_year);
X            break;
X
X        case 'Z':    /* time zone name or abbrevation */
X#ifdef TCL_HAS_TM_ZONE
X                        strcpy(tbuf, timeptr->tm_zone);
X#else
X            i = 0;
X            if (daylight && timeptr->tm_isdst)
X                i = 1;
X            strcpy(tbuf, tzname[i]);
X#endif
X            break;
X
X        case 'n':    /* same as \n */
X            tbuf[0] = '\n';
X            tbuf[1] = '\0';
X            break;
X
X        case 't':    /* same as \t */
X            tbuf[0] = '\t';
X            tbuf[1] = '\0';
X            break;
X
X        case 'D':    /* date as %m/%d/%y */
X            strftime(tbuf, sizeof tbuf, "%m/%d/%y", timeptr);
X            break;
X
X        case 'e':    /* day of month, blank padded */
X            sprintf(tbuf, "%2d", timeptr->tm_mday);
X            break;
X
X        case 'r':    /* time as %I:%M:%S %p */
X            strftime(tbuf, sizeof tbuf, "%I:%M:%S %p", timeptr);
X            break;
X
X        case 'R':    /* time as %H:%M */
X            strftime(tbuf, sizeof tbuf, "%H:%M", timeptr);
X            break;
X
X        case 'T':    /* time as %H:%M:%S */
X            strftime(tbuf, sizeof tbuf, "%H:%M:%S", timeptr);
X            break;
X
X        default:
X            tbuf[0] = '%';
X            tbuf[1] = *format;
X            tbuf[2] = '\0';
X            break;
X        }
X        i = strlen(tbuf);
X        if (i)
X            if (s + i < endp - 1) {
X                strcpy(s, tbuf);
X                s += i;
X            } else
X                return 0;
X    }
Xout:
X    if (s < endp && *format == '\0') {
X        *s = '\0';
X        return (s - start);
X    } else
X        return 0;
X}
X
X/* weeknumber --- figure how many weeks into the year */
X
X/* With thanks and tip of the hatlo to [e-mail] */
X
Xstatic int
Xweeknumber(timeptr, firstweekday)
X    struct tm *timeptr;
X    int        firstweekday;
X{
X    if (firstweekday == 0)
X        return (timeptr->tm_yday + 7 - timeptr->tm_wday) / 7;
X    else
X        return (timeptr->tm_yday + 7 -
X            (timeptr->tm_wday ? (timeptr->tm_wday - 1) : 6)) / 7;
X}
END_OF_FILE
if test 6767 -ne `wc -c <'extended/ossupport/strftime.c'`; then
    echo shar: \"'extended/ossupport/strftime.c'\" unpacked with wrong size!
fi
# end of 'extended/ossupport/strftime.c'
fi
if test -f 'extended/src/tclExtdInt.h' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/src/tclExtdInt.h'\"
else
echo shar: Extracting \"'extended/src/tclExtdInt.h'\" \(6363 characters\)
sed "s/^X//" >'extended/src/tclExtdInt.h' <<'END_OF_FILE'
X/*
X * tclExtdInt.h
X *
X * Standard internal include file for Extended Tcl library..
X *---------------------------------------------------------------------------
X * Copyright 1991 Karl Lehenbauer and Mark Diekhans.
X *
X * Permission to use, copy, modify, and distribute this software and its
X * documentation for any purpose and without fee is hereby granted, provided
X * that the above copyright notice appear in all copies.  Karl Lehenbauer and
X * Mark Diekhans make no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without express or
X * implied warranty.
X */
X
X#ifndef TCLEXTDINT_H
X#define TCLEXTDINT_H
X
X#include "tclExtend.h"
X#include "tclInt.h"
X#include "tclUnix.h"
X
X#include <values.h>
X#include <grp.h>
X/*
X * If sys/times.h was not included by tclUnix.h, then include it.  On some
X * systems, it cann't be double included.
X */
X#if TCL_GETTOD
X#   include <sys/times.h>
X#endif
X
X/*
X * On some systems this is not included by tclUnix.h.
X */
X#include <sys/param.h>
X#ifndef CLK_TCK
X#    ifdef HZ
X#        define CLK_TCK HZ
X#    else
X#        define CLK_TCK 60
X#    endif
X#endif
X
X
X
X#ifndef MAXINT
X#    define BITSPERBYTE   8
X#    define BITS(type)    (BITSPERBYTE * (int)sizeof(type))
X#    define HIBITI        (1 << BITS(int) - 1)
X#    define MAXINT        (~HIBITI)
X#endif
X
X#ifndef MININT
X#    define MININT (-MAXINT)-1
X#endif
X
X#ifndef TRUE
X#    define TRUE   (1)
X#    define FALSE  (0)
X#endif
X
X/*
X * Structure to hold a regular expression, plus a Boyer-Moore compiled
X * pattern.
X */
X
Xtypedef struct regexp_t {
X    regexp *progPtr;
X    char   *boyerMoorePtr;
X    int     noCase;
X    } regexp_t;
Xtypedef regexp_t *regexp_pt;
X/*
X * Flags used by RegExpCompile:
X */
X#define REXP_NO_CASE         1   /* Do matching regardless of case    */
X#define REXP_BOTH_ALGORITHMS 2   /* Use boyer-moore along with regexp */
X
X/*
X * Data structure to control a dynamic buffer.  These buffers are primarly
X * used for reading things from files, were the maximum size is not known
X * in advance, and the buffer must grow.  These are used in the case were
X * the value is not to be returned as the interpreter result.
X */
X
X#define INIT_DYN_BUFFER_SIZE 256
X
Xtypedef struct dynamicBuf_t {
X    char  buf [INIT_DYN_BUFFER_SIZE];   /* Initial buffer area.              */
X    char *ptr;                          /* Pointer to buffer area.           */
X    int   size;                         /* Current size of buffer.           */
X    int   used;                         /* Current amount used, include '\0' */
X    } dynamicBuf_t;
X
X/*
X * Macros to do string compares.  They pre-check the first character before
X * checking of the strings are equal.
X */
X
X#define STREQU(str1, str2) \
X        ((str1[0] == str2[0]) && (strcmp (str1, str2) == 0))
X#define STRNEQU(str1, str2, cnt) \
X        ((str1[0] == str2[0]) && (strncmp (str1, str2, cnt) == 0))
X
Xvoid
XTcl_DynBufInit _ANSI_ARGS_((dynamicBuf_t *dynBufPtr));
X
Xvoid
XTcl_DynBufFree _ANSI_ARGS_((dynamicBuf_t *dynBufPtr));
X
Xvoid
XTcl_DynBufReturn _ANSI_ARGS_((Tcl_Interp    *interp,
X                              dynamicBuf_t *dynBufPtr));
X
Xvoid
XTcl_DynBufAppend _ANSI_ARGS_((dynamicBuf_t *dynBufPtr,
X                              char         *newStr));
X
Xint
XTcl_DynamicFgets _ANSI_ARGS_((dynamicBuf_t *dynBufPtr,
X                              FILE         *filePtr));
X
Xint
XTcl_ConvertFileHandle _ANSI_ARGS_((Tcl_Interp *interp,
X                                  char       *handle));
X
Xint
XTcl_ProcessSignal _ANSI_ARGS_((Tcl_Interp *interp,
X                               int         cmdResultCode));
X
Xvoid
XTcl_RegExpClean _ANSI_ARGS_((regexp_pt regExpPtr));
X
Xint
XTcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp  *interp,
X                               regexp_pt    regExpPtr,
X                               char        *expression,
X                               int          flags));
X
Xint
XTcl_RegExpExecute _ANSI_ARGS_((Tcl_Interp  *interp,
X                               regexp_pt    regExpPtr,
X                               char        *matchStrIn,
X                               char        *matchStrLower));
Xvoid
XTcl_ResetSignals ();
X
X/*
X * Definitions required to initialize all extended commands.  These are either
X * the command executors or initialization routines that do the command
X * initialization.  The initialization routines are used when there is more
X * to initializing the command that just binding the command name to the
X * executor.  Usually, this means initializing some command local data via
X * the ClientData mechanism.
X */
X
X/*
X * from chmod.c
X */
Xextern Tcl_CmdProc  Tcl_ChmodCmd, Tcl_ChownCmd, Tcl_ChgrpCmd;
X
X/*
X * from clock.c
X */
Xextern Tcl_CmdProc  Tcl_GetclockCmd, Tcl_FmtclockCmd;
X
X/*
X * from cmdloop.c
X */
Xextern Tcl_CmdProc  Tcl_CommandloopCmd;
X
X/*
X * from debug.c
X */
Xvoid
XTcl_InitDebug _ANSI_ARGS_((Tcl_Interp *interp));
X
X/*
X * from filescan.c
X */
Xvoid
XTcl_InitFilescan _ANSI_ARGS_((Tcl_Interp *interp));
X
X/*
X * from fmath.c
X */
Xextern Tcl_CmdProc  Tcl_AcosCmd, Tcl_AsinCmd, Tcl_AtanCmd,  Tcl_CosCmd,
X                    Tcl_SinCmd,  Tcl_TanCmd,  Tcl_CoshCmd,  Tcl_SinhCmd,
X                    Tcl_TanhCmd, Tcl_ExpCmd,  Tcl_LogCmd,   Tcl_Log10Cmd,
X                    Tcl_SqrtCmd, Tcl_FabsCmd, Tcl_FloorCmd, Tcl_CeilCmd,
X                    Tcl_FmodCmd, Tcl_PowCmd;
X
X/*
X * from general.c
X */
Xextern Tcl_CmdProc  Tcl_EchoCmd, Tcl_InfoxCmd, Tcl_LoopCmd;
X
X/*
X * from id.c
X */
Xextern Tcl_CmdProc  Tcl_IdCmd;
X
X/*
X * from iocmds.c
X */
Xextern Tcl_CmdProc  Tcl_BsearchCmd, Tcl_DupCmd, Tcl_PipeCmd, Tcl_CopyfileCmd,
X                    Tcl_FstatCmd,   Tcl_FcntlCmd, Tcl_SelectCmd;
X
X/*
X * from list.c
X */
Xextern Tcl_CmdProc  Tcl_LvarpopCmd, Tcl_LemptyCmd, Tcl_KeyldelCmd,
X                    Tcl_KeylgetCmd, Tcl_KeylsetCmd;
X
X/*
X * from math.c
X */
Xextern Tcl_CmdProc  Tcl_MaxCmd, Tcl_MinCmd, Tcl_RandomCmd;
X
X/*
X * from signal.c
X */
Xvoid
XTcl_InitSignalHandling _ANSI_ARGS_((Tcl_Interp *interp));
X
X/*
X * from string.c
X */
Xextern Tcl_CmdProc  Tcl_CindexCmd,     Tcl_ClengthCmd,   Tcl_CrangeCmd,
X                    Tcl_ReplicateCmd,  Tcl_TranslitCmd,  Tcl_CtypeCmd;
X
X
X/*
X * from unixcmds.c
X */
Xextern Tcl_CmdProc  Tcl_ExecvpCmd, Tcl_ForkCmd,   Tcl_KillCmd,  Tcl_AlarmCmd,
X                    Tcl_SleepCmd,  Tcl_SystemCmd, Tcl_TimesCmd, Tcl_UmaskCmd,
X                    Tcl_LinkCmd,   Tcl_UnlinkCmd, Tcl_MkdirCmd, Tcl_RmdirCmd,
X                    Tcl_WaitCmd;
X
X
X#endif
END_OF_FILE
if test 6363 -ne `wc -c <'extended/src/tclExtdInt.h'`; then
    echo shar: \"'extended/src/tclExtdInt.h'\" unpacked with wrong size!
fi
# end of 'extended/src/tclExtdInt.h'
fi
if test -f 'extended/tcllib/help/commands/history' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/tcllib/help/commands/history'\"
else
echo shar: Extracting \"'extended/tcllib/help/commands/history'\" \(8154 characters\)
sed "s/^X//" >'extended/tcllib/help/commands/history' <<'END_OF_FILE'
X          history ?option? ?arg arg ...?
X               Note:  this command may not be available  in  all  Tcl-
X               based applications.  Typically, only those that receive
X               command  input  in  a  typescript  form  will   support
X               history.   The  history command performs one of several
X               operations  related   to   recently-executed   commands
X               recorded  in  a  history  list.  Each of these recorded
X               commands  is  referred  to  as  an   ``event''.    When
X               specifying   an  event  to  the  history  command,  the
X               following forms may be used:
X
X               [1]  A number:  if positive, it  refers  to  the  event
X                    with that number (all events are numbered starting
X                    at 1).  If the number is negative, it  selects  an
X                    event  relative to the current event (-1 refers to
X                    the previous event, -2 to the one before that, and
X                    so on).
X
X               [2]  A string:  selects  the  most  recent  event  that
X                    matches  the  string.   An  event is considered to
X                    match the string either if the string is the  same
X                    as  the  first  characters of the event, or if the
X                    string matches the  event  in  the  sense  of  the
X                    string match command.
X
X               The history command  can  take  any  of  the  following
X               forms:
X
X               history
X                    Same as history info, described below.
X
X               history add command ?exec?
X                    Add the command argument to the history list as  a
X                    new  event.  If exec is specified (or abbreviated)
X                    then the command is also executed and  its  result
X                    is  returned.   If  exec  isn't  specified then an
X                    empty string is returned as result.
X
X               history change newValue ?event?
X                    Replace the  value  recorded  for  an  event  with
X                    newValue.   Event  specifies the event to replace,
X                    and defaults to the current event (not event  -1).
X                    This  command is intended for use in commands that
X                    implement new forms of  history  substitution  and
X                    wish  to  replace the current event (which invokes
X                    the substitution) with the command created through
X                    substitution.    The  return  value  is  an  empty
X                    string.
X
X               history event ?event?
X                    Returns the value of the  event  given  by  event.
X                    Event defaults to -1.  This command causes history
X                    revision to occur: see below for details.
X
X               history info ?count?
X                    Returns a formatted string (intended for humans to
X                    read)  giving  the  event  number and contents for
X                    each of the events in the history list except  the
X                    current  event.   If  count is specified then only
X                    the most recent count events are returned.
X
X               history keep count
X                    This command may be used to change the size of the
X                    history  list  to  count  events.   Initially,  20
X                    events are retained in  the  history  list.   This
X                    command returns an empty string.
X
X               history nextid
X                    Returns  the  number  of  the  next  event  to  be
X                    recorded  in  the  history list.  It is useful for
X                    things like printing the event number in  command-
X                    line prompts.
X
X               history redo ?event?
X                    Re-execute the  command  indicated  by  event  and
X                    return  its  result.   Event defaults to -1.  This
X                    command results in history  revision:   see  below
X                    for details.
X
X               history substitute old new ?event?
X                    Retrieve  the  command  given  by  event  (-1   by
X                    default), replace any occurrences of old by new in
X                    the command (only  simple  character  equality  is
X                    supported;  no  wild cards), execute the resulting
X                    command, and return the result of that  execution.
X                    This  command  results  in  history revision:  see
X                    below for details.
X
X               history words selector ?event?
X                    Retrieve from the command given by  event  (-1  by
X                    default)  the  words given by selector, and return
X                    those words in a string separated by spaces.   The
X                    selector  argument  has  three  forms.  If it is a
X                    single number then it selects the  word  given  by
X                    that  number  (0  for  the command name, 1 for its
X                    first argument, and so on).  If it consists of two
X                    numbers  separated  by a dash, then it selects all
X                    the  arguments  between  those   two.    Otherwise
X                    selector  is  treated  as  a  pattern;  all  words
X                    matching that pattern  (in  the  sense  of  string
X                    match)  are  returned.  In the numeric forms $ may
X                    be used to select the last word of a command.  For
X                    example,  suppose  the  most recent command in the
X                    history list is
X
X                      format  {%s is %d years old} Alice [expr $ageInMonths/12]
X
X                    Below are some history commands  and  the  results
X                    they would produce:
X
X
X                         history words $
X                                 [expr $ageInMonths/12]
X                         history words 1-2
X                                 {%s is %d years  old} Alice
X                         history words *a*o*
X                                 {%s is %d years old} [expr $ageInMonths/12]
X                    History words results in  history  revision:   see
X                    below for details.
X
X               The history options event, redo, substitute, and  words
X               result  in  ``history  revision''.   When  one of these
X               options is invoked then the current event  is  modified
X               to  eliminate  the  history command and replace it with
X               the  result  of  the  history  command.   For  example,
X               suppose  that  the  most  recent command in the history
X               list is
X
X                    set a [expr $b+2]
X
X               and suppose that the next command invoked is one of the
X               ones  on the left side of the table below.  The command
X               actually recorded in the  history  event  will  be  the
X               corresponding one on the right side of the table.
X
X
X                    history                set a [expr $b+2]
X                    history s a b          set b [expr $b+2]
X                    set c [history w 2]    set c [expr $b+2]
X
X               History revision is  needed  because  event  specifiers
X               like -1 are only valid at a particular time:  once more
X               events have been added to the history list a  different
X               event  specifier  would  be  needed.   History revision
X               occurs even when history is invoked indirectly from the
X               current event (e.g. a user types a command that invokes
X               a Tcl procedure that invokes history):   the  top-level
X               command   whose  execution  eventually  resulted  in  a
X               history command is replaced.  If  you  wish  to  invoke
X               commands  like  history words without history revision,
X               you can use history event to save the  current  history
X               event and then use history change to restore it later.
END_OF_FILE
if test 8154 -ne `wc -c <'extended/tcllib/help/commands/history'`; then
    echo shar: \"'extended/tcllib/help/commands/history'\" unpacked with wrong size!
fi
# end of 'extended/tcllib/help/commands/history'
fi
if test -f 'extended/tcllib/help/commands/info' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/tcllib/help/commands/info'\"
else
echo shar: Extracting \"'extended/tcllib/help/commands/info'\" \(6394 characters\)
sed "s/^X//" >'extended/tcllib/help/commands/info' <<'END_OF_FILE'
X          info option ?arg arg ...?
X               Provide information about various internals to the  Tcl
X               interpreter.    The   legal   option's  (which  may  be
X               abbreviated) are:
X
X               info args procname
X                    Returns  a  list  containing  the  names  of   the
X                    arguments   to   procedure   procname,  in  order.
X                    Procname  must  be  the  name  of  a  Tcl  command
X                    procedure.
X
X               info body procname
X                    Returns the body of procedure procname.   Procname
X                    must be the name of a Tcl command procedure.
X
X               info cmdcount
X                    Returns a count of the total  number  of  commands
X                    that have been invoked in this interpreter.
X
X               info commands ?pattern?
X                    If pattern isn't  specified,  returns  a  list  of
X                    names  of all the Tcl commands, including both the
X                    built-in commands written in  C  and  the  command
X                    procedures  defined  using  the  proc command.  If
X                    pattern is specified, only  those  names  matching
X                    pattern  are  returned.   Matching  is  determined
X                    using the same rules as for string match.
X
X               info default procname arg varname
X                    Procname  must  be  the  name  of  a  Tcl  command
X                    procedure  and arg must be the name of an argument
X                    to that procedure.  If arg doesn't have a  default
X                    value  then  the  command returns 0.  Otherwise it
X                    returns 1 and places the default value of arg into
X                    variable varname.
X
X               info exists varName
X                    Returns 1 if the variable named varName exists  in
X                    the  current  context (either as a global or local
X                    variable), returns 0 otherwise.
X
X               info globals ?pattern?
X                    If pattern isn't specified, returns a list of  all
X                    the  names  of currently-defined global variables.
X                    If pattern is specified, only those names matching
X                    pattern  are  returned.   Matching  is  determined
X                    using the same rules as for string match.
X
X               info level ?number?
X                    If number is not specified, this command returns a
X                    number  giving  the  stack  level  of the invoking
X                    procedure, or 0 if the command is invoked at  top-
X                    level.  If number is specified, then the result is
X                    a list consisting of the name  and  arguments  for
X                    the  procedure  call at level number on the stack.
X                    If number is positive then it selects a particular
X                    stack  level  (1  refers  to  the  top-most active
X                    procedure, 2 to the procedure it  called,  and  so
X                    on);  otherwise  it  gives a level relative to the
X                    current level (0 refers to the current  procedure,
X                    -1  to  its  caller,  and so on).  See the uplevel
X                    command for more information on what stack  levels
X                    mean.
X
X               info library
X                    Returns the name of the library directory in which
X                    standard  Tcl  scripts are stored.  If there is no
X                    such   directory   defined   for    the    current
X                    installation  then an error is generated.  See the
X                    library manual entry for details of the facilities
X                    provided by the Tcl script library.  Normally each
X                    application will have its own application-specific
X                    library  in  addition  to  the Tcl script library;
X                    the location of the  application-specific  library
X                    should be kept in the $appLibrary global variable.
X
X               info locals ?pattern?
X                    If pattern isn't specified, returns a list of  all
X                    the  names  of  currently-defined local variables,
X                    including arguments to the current  procedure,  if
X                    any.   Variables defined with the global and upvar
X                    commands will not  be  returned.   If  pattern  is
X                    specified,  only  those names matching pattern are
X                    returned.  Matching is determined using  the  same
X                    rules as for string match.
X
X               info procs ?pattern?
X                    If pattern isn't specified, returns a list of  all
X                    the  names  of Tcl command procedures.  If pattern
X                    is specified, only those  names  matching  pattern
X                    are  returned.   Matching  is determined using the
X                    same rules as for string match.
X
X               info script
X                    If a Tcl script file is currently being  evaluated
X                    (i.e.  there  is  a call to Tcl_EvalFile active or
X                    there  is  an  active  invocation  of  the  source
X                    command),  then  this  command returns the name of
X                    the innermost file being processed.  Otherwise the
X                    command returns an empty string.
X
X               info tclversion
X                    Returns the version number for this version of Tcl
X                    in  the  form  x.y,  where  changes to x represent
X                    major changes with probable incompatibilities  and
X                    changes  to y represent small enhancements and bug
X                    fixes that retain backward compatibility.
X
X               info vars ?pattern?
X                    If pattern isn't specified, returns a list of  all
X                    the    names   of   currently-visible   variables,
X                    including  both   locals   and   currently-visible
X                    globals.   If  pattern  is  specified,  only those
X                    names matching pattern are returned.  Matching  is
X                    determined  using  the  same  rules  as for string
X                    match.
END_OF_FILE
if test 6394 -ne `wc -c <'extended/tcllib/help/commands/info'`; then
    echo shar: \"'extended/tcllib/help/commands/info'\" unpacked with wrong size!
fi
# end of 'extended/tcllib/help/commands/info'
fi
if test -f 'extended/tclsrc/help.tcl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/tclsrc/help.tcl'\"
else
echo shar: Extracting \"'extended/tclsrc/help.tcl'\" \(7490 characters\)
sed "s/^X//" >'extended/tclsrc/help.tcl' <<'END_OF_FILE'
X#@package: help help helpcd helppwd apropos
X
X#==============================================================================
X# help.tcl --
X#     Tcl help command. (see Tcl shell manual)
X#==============================================================================
X
X#------------------------------------------------------------------------------
X# Take a path name which might have . and .. elements and flatten them out.
X
Xproc help:flattenPath {pathName} {
X    set newPath {}
X    foreach element [split $pathName /] {
X        if {"$element" == "."} {
X           continue
X        }
X        if {"$element" == ".."} {
X            if {[llength [join $newPath /]] == 0} {
X                error "Help: name goes above subject directory root"}
X            lvarpop newPath [expr [llength $newPath]-1]
X            continue
X        }
X        lappend newPath $element
X    }
X    set newPath [join $newPath /]
X
X    # Take care of the case where we started with something line "/" or "/."
X
X    if {("$newPath" == "") && [string match "/*" $pathName]} {
X        set newPath "/"}
X
X    return $newPath
X}
X
X#------------------------------------------------------------------------------
X# Take the help current directory and a path and evaluate it into a help root-
X# based path name.
X
Xproc help:EvalPath {pathName} {
X    global TCLENV
X
X    if {![string match "/*" $pathName]} {
X        if {"$pathName" == ""} {
X            return $TCLENV(help:curDir)}
X        if {"$TCLENV(help:curDir)" == "/"} {
X            set pathName "/$pathName"
X        } else {
X            set pathName "$TCLENV(help:curDir)/$pathName"
X        }
X    }
X    set pathName [help:flattenPath $pathName]
X    if {[string match "*/" $pathName] && ($pathName != "/")} {
X        set pathName [csubstr $pathName 0 [expr [length $pathName]-1]]}
X
X    return $pathName
X}
X
X#------------------------------------------------------------------------------
X# Display a line of output, pausing waiting for input before displaying if the
X# screen size has been reached.  Return 1 if output is to continue, return
X# 0 if no more should be outputed, indicated by input other than return.
X#
X
Xproc help:Display {line} {
X    global TCLENV
X    if {$TCLENV(help:lineCnt) >= 23} {
X        set TCLENV(help:lineCnt) 0
X        puts stdout ":" nonewline
X        flush stdout
X        gets stdin response
X        if {![lempty $response]} {
X            return 0}
X    }
X    puts stdout $line
X    incr TCLENV(help:lineCnt)
X}
X
X#------------------------------------------------------------------------------
X# Display a file.
X
Xproc help:DisplayFile {filepath} {
X
X    set inFH [open $filepath r]
X    while {[gets $inFH fileBuf] >= 0} {
X        if {![help:Display $fileBuf]} {
X            break}
X    }
X    close $inFH
X
X}
X
X#------------------------------------------------------------------------------
X# Procedure to return contents of a directory.  A list is returned, consisting
X# of two lists.  The first list are all the directories (subjects) in the
X# specified directory.  The second is all of the help files.  Eash sub-list
X# is sorted in alphabetical order.
X#
X
Xproc help:ListDir {dirPath} {
X    set dirList {}
X    set fileList {}
X    if {[catch {set dirFiles [glob $dirPath/*]}] != 0} {
X        error "No files in subject directory: $dirPath"}
X    foreach fileName $dirFiles {
X        if [file isdirectory $fileName] {
X            lappend dirList "[file tail $fileName]/"
X        } else {
X            lappend fileList [file tail $fileName]
X        }
X    }
X   return [list [lsort $dirList] [lsort $fileList]]
X}
X
X#------------------------------------------------------------------------------
X# Display a list of file names in a column format. This use columns of 14
X# characters 3 blanks.
X
Xproc help:DisplayColumns {nameList} {
X    set count 0
X    set outLine ""
X    foreach name $nameList {
X        if {$count == 0} {
X            append outLine "   "}
X        append outLine $name
X        if {[incr count] < 4} {
X            set padLen [expr 17-[clength $name]]
X            if {$padLen < 3} {
X               set padLen 3}
X            append outLine [replicate " " $padLen]
X        } else {
X           if {![help:Display $outLine]} {
X               return}
X           set outLine ""
X           set count 0
X        }
X    }
X    if {$count != 0} {
X        help:Display $outLine}
X    return
X}
X
X
X#------------------------------------------------------------------------------
X# Help command main.
X
Xproc help {args} {
X    global TCLENV
X
X    if {[llength $args] > 1} {
X        error "Help: too many arguments"}
X
X    set TCLENV(help:lineCnt) 0
X
X    # Special case "help help", so we can get it at any level.
X
X    if {("$args" == "help") || ("$args" == "?")} {
X        help:DisplayFile "$TCLENV(help:root)/help"
X        return
X    }
X
X    set request [help:EvalPath $args]
X    set requestPath "$TCLENV(help:root)$request"
X
X    if {![file exists $requestPath]} {
X        error "Help:\"$request\" does not exist"}
X
X    if [file isdirectory $requestPath] {
X        set dirList [help:ListDir $requestPath]
X        set subList  [lindex $dirList 0]
X        set fileList [lindex $dirList 1]
X        if {[llength $subList] != 0} {
X            help:Display "\nSubjects available in $request:"
X            help:DisplayColumns $subList
X        }
X        if {[llength $fileList] != 0} {
X            help:Display "\nHelp files available in $request:"
X            help:DisplayColumns $fileList
X        }
X    } else {
X        help:DisplayFile $requestPath
X    }
X    return
X}
X
X
X#------------------------------------------------------------------------------
X# Helpcd main.
X#
X# The name of the new current directory is assembled from the current
X# directory and the argument.  The name will be flatten and any trailing
X# "/" will be removed, unless the name is just "/".
X
Xproc helpcd {args} {
X    global TCLENV
X
X    if [lempty $args] {
X        set args "/"
X    } else {
X        if {[llength $args] > 1} {
X            error "Helpcd: too many arugments"}
X    }
X
X    set request [help:EvalPath $args]
X    set requestPath "$TCLENV(help:root)$request"
X
X    if {![file exists $requestPath]} {
X        error "Helpcd: \"$request\" does not exist"}
X
X    if {![file isdirectory $requestPath]} {
X        error "Helpcd: \"$request\" is not a directory"}
X
X    set TCLENV(help:curDir) $request
X    return
X}
X
X#------------------------------------------------------------------------------
X# Helpcd main.
X
Xproc helppwd {} {
X        global TCLENV
X        echo "Current help subject directory: $TCLENV(help:curDir)"
X}
X
X#==============================================================================
X#     Tcl apropos command.  (see Tcl shell manual)
X#------------------------------------------------------------------------------
X
Xproc apropos {name} {
X    global TCLENV
X
X    set TCLENV(help:lineCnt) 0
X
X    set aproposCT [scancontext create]
X    scanmatch -nocase $aproposCT $name {
X        set path [lindex $matchInfo(line) 0]
X        set desc [lrange $matchInfo(line) 1 end]
X        if {![help:Display [format "%s - %s" $path $desc]]} {
X            return}
X    }
X    set briefFH [open $TCLENV(help:root)/brief]
X
X    scanfile $aproposCT $briefFH
X
X    scancontext delete $aproposCT
X    close $briefFH
X}
X
X#------------------------------------------------------------------------------
X# One time initialization done when the file is sourced.
X#
Xglobal TCLENV TCLPATH
X
Xset TCLENV(help:root) [searchpath $TCLPATH help]
Xset TCLENV(help:curDir) "/"
Xset TCLENV(help:outBuf) {}
END_OF_FILE
if test 7490 -ne `wc -c <'extended/tclsrc/help.tcl'`; then
    echo shar: \"'extended/tclsrc/help.tcl'\" unpacked with wrong size!
fi
# end of 'extended/tclsrc/help.tcl'
fi
if test -f 'extended/tests/iocmds.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/tests/iocmds.test'\"
else
echo shar: Extracting \"'extended/tests/iocmds.test'\" \(6451 characters\)
sed "s/^X//" >'extended/tests/iocmds.test' <<'END_OF_FILE'
X#
X# iocmds.test
X#
X# Tests for the bsearch, dup, copyfile, pipe, and fcntl commands.
X#---------------------------------------------------------------------------
X# Copyright 1991 Karl Lehenbauer and Mark Diekhans.
X#
X# Permission to use, copy, modify, and distribute this software and its
X# documentation for any purpose and without fee is hereby granted, provided
X# that the above copyright notice appear in all copies.  Karl Lehenbauer and
X# Mark Diekhans make no representations about the suitability of this
X# software for any purpose.  It is provided "as is" without express or
X# implied warranty.
X#
X
Xglobal ModuleName
Xset ModuleName "Unix I/O"
Xsource testutil.tcl
Xif {[info procs test] != "test"} then {source defs}
X
X# Genenerate a unique file record that can be verified.  The record has
X# grows quite large to test the dynamic buffering in the file I/O.
X
Xproc GenRec {id} {
X    return [format "Key:%04d {This is a test of file I/O (%d)} KeyX:%04d %s" \
X                    $id $id $id [replicate :@@@@@@@@: $id]]
X}
X
X# Create a test file
X
Xcatch {unlink {IOTEST.TMP IOTEST2.TMP}}
X
Xset testFH [open IOTEST.TMP w]
Xfor {set cnt 0} {$cnt < 100} {incr cnt} {
X     puts $testFH [GenRec $cnt]
X}
Xclose $testFH
X
X# Test bsearch
X
Xproc BsearchTestCmp {key line} {
X    set linekey [lindex $line 2]
X    return [string compare $key $linekey]
X}
X
Xset testFH [open IOTEST.TMP r]
Xset toggle 0
Xfor {set cnt 0} {$cnt < 100} {incr cnt} {
X    set key1 [format "Key:%04d" $cnt]
X    set key2 [format "KeyX:%04d" $cnt]
X    if {($cnt % 6) == 0} {
X        if {$toggle} {
X            set rec1 [bsearch $testFH $key1]
X            set rec2 [bsearch $testFH $key2 {} BsearchTestCmp]
X        } else {
X            check [bsearch $testFH $key1 rec1] 1                          1.1
X            check [bsearch $testFH $key2 rec2 BsearchTestCmp] 1           1.2
X        }
X        set expect [GenRec $cnt]
X        check $rec1 $expect                                              1.3
X        check $rec2 $expect                                              1.4
X        set toggle [expr !$toggle]
X    }
X}
Xclose $testFH
X
X# Test dup, including redirection of stdin/stdout in a child process.
X
Xset testFH [open IOTEST.TMP]
Xset testFH2 [dup $testFH]
Xgets $testFH2 testRec
Xcheck $testRec [GenRec 0]                                               2.1
Xclose $testFH
Xclose $testFH2
X
Xset data {{now is the time}    {for all good programmers}
X          {to come to the aid} {of their software}}
Xset inFH [open INCMDS.TMP w]
Xcatch {unlink OUTPUT.TMP}
Xforeach line $data {
X    puts $inFH "puts stdout \"$line\""
X}
Xputs $inFH {flush stdout}
Xputs $inFH {exit 0}
Xclose $inFH
X
Xif {[set childPid [fork]] == 0} {
X    set inFH  [open INCMDS.TMP r]
X    set outFH [open OUTPUT.TMP w]
X
X    close stdin
X    dup $inFH stdin
X    close $inFH
X
X    close stdout
X    dup $outFH stdout
X    close $outFH
X
X    execvp ../tcl -qc {commandloop {return ""} {return ""}}
X    error "Should never make it here"
X}
X
Xcheck [wait $childPid] "$childPid EXIT 0"                               2.3
X
Xset outFH [open OUTPUT.TMP r]
Xforeach line $data {
X    check [gets $outFH] $line                                           2.4
X}
Xclose $outFH
X
X
X# Test copyfile
X
Xset testFH [open IOTEST.TMP r]
Xset testFH2 [open IOTEST2.TMP w]
Xcopyfile $testFH $testFH2
Xclose $testFH
Xclose $testFH2
Xset retVal [system "diff IOTEST.TMP IOTEST2.TMP >/dev/null 2>&1"]
Xcheck $retVal 0                                                         3.1
X
Xset testFH [open IOTEST.TMP w]
Xset testFH2 [open IOTEST2.TMP w]
Xdo1cmd {copyfile $testFH $testFH2} msg                                  3.2
Xcheck $msg {Source file is not open for read access}                    3.3
Xclose $testFH
Xclose $testFH2
X
Xset testFH [open IOTEST.TMP r]
Xset testFH2 [open IOTEST2.TMP r]
Xdo1cmd {copyfile $testFH $testFH2} msg                                  3.4
Xcheck $msg {Target file is not open for write access}                   3.5
Xclose $testFH
Xclose $testFH2
X
Xdo1cmd {copyfile $testFH $testFH2}  msg                                 3.6
Xcheck $msg "file \"$testFH\" isn't open"                                3.7
Xdo1cmd {copyfile} msg                                                   3.8
Xcheck $msg {wrong # args: copyfile fromfilehandle tofilehandle}         3.9
X
X# Test the pipe command.
X
Xpipe readPF writePF
X
Xflush stdout  ;# Not going to exec, must clean up the buffers.
Xflush stderr
Xset sonPid [fork]
X
Xif {$sonPid == 0} {
X    for {set cnt 0} {$cnt < 50} {incr cnt} {
X        if {![gets $readPF msgBuf]} {
X            check "Premature eof on pipe" ""                            4.1
X        }
X        check $msgBuf [GenRec $cnt]                                     4.2
X    }
X    close $readPF
X    exit 0
X}
X
Xfor {set cnt 0} {$cnt < 50} {incr cnt} {
X    puts $writePF [GenRec $cnt]
X}
Xflush $writePF
Xcheck [wait $sonPid] "$sonPid EXIT 0"                                  4.3
Xclose $readPF
Xclose $writePF
X
X# Test fcntl.
X
Xset testFH [open IOTEST.TMP r+]
X
Xcheck [fcntl $testFH] {RDWR}                 5.1
X
Xfcntl $testFH CLEXEC 1
Xcheck [fcntl $testFH] {RDWR CLEXEC}          5.2
X
Xfcntl $testFH CLEXEC 0
Xcheck [fcntl $testFH] {RDWR}                 5.3
X
Xfcntl $testFH NDELAY 1
Xcheck [fcntl $testFH] {RDWR NDELAY}          5.4
X
Xfcntl $testFH append 1
Xcheck [fcntl $testFH] {RDWR NDELAY APPEND}   5.5
X
Xfcntl $testFH APPEND 0
Xcheck [fcntl $testFH] {RDWR NDELAY}          5.6
X
Xfcntl $testFH ndelay 0
Xcheck [fcntl $testFH] {RDWR}                 5.7
X
Xfcntl $testFH NOBUF 1
Xcheck [fcntl $testFH] {RDWR NOBUF}           5.7.1
X
Xdo1cmd "fcntl $testFH NOBUF 0" msg           5.7.2
Xcheck $msg {NOBUF flag may not be cleared}   5.7.3
X
Xclose $testFH
Xset testFH [open IOTEST.TMP r+]  ;# Reopen, can not have both nobuf and linebuf
X
Xfcntl $testFH LINEBUF 1
Xcheck [fcntl $testFH] {RDWR LINEBUF}         5.7.4
X
Xdo1cmd "fcntl $testFH LINEBUF 0" msg         5.7.5
Xcheck $msg {LINEBUF flag may not be cleared} 5.7.6
X
X
Xdo1cmd "fcntl $testFH FOO" msg               5.8
Xcheck $msg {wrong # args: fcntl handle [attribute value]}  5.9
X
Xdo1cmd "fcntl $testFH BAZ 1" msg             5.10
Xcheck $msg {unknown attribute name "BAZ", expected one of: APPEND, CLEXEC, NDELAY, NOBUF, LINEBUF}         5.12
X
Xdo1cmd "fcntl $testFH APPEND FOO" msg        5.13
Xcheck $msg {expected boolean value but got "FOO"}         5.14
X
Xclose $testFH
X
Xdo1cmd "fcntl $testFH" msg                   5.15
Xcheck $msg "file \"$testFH\" isn't open"     5.16
X
Xunlink {IOTEST.TMP IOTEST2.TMP OUTPUT.TMP INCMDS.TMP}
Xrename GenRec {}
X
X
END_OF_FILE
if test 6451 -ne `wc -c <'extended/tests/iocmds.test'`; then
    echo shar: \"'extended/tests/iocmds.test'\" unpacked with wrong size!
fi
# end of 'extended/tests/iocmds.test'
fi
echo shar: End of archive 10 \(of 23\).
cp /dev/null ark10isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 23 archives.
    echo "Now cd to "extended", edit the makefile, then do a "make""
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].