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

Text File | 1991-11-19 | 51.5 KB | 1,777 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Karl Lehenbauer)
Subject:  v26i017:  tclx - extensions and on-line help for tcl 6.1, Part17/23
Message-ID: <[e-mail]>
X-Md4-Signature: 2d61823dde25fd3992cf7a7929335972
Date: Tue, 19 Nov 1991 13:56:03 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Karl Lehenbauer)
Posting-number: Volume 26, Issue 17
Archive-name: tclx/part17
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 17 (of 23)."
# Contents:  extended/src/fmath.c extended/src/regexputil.c
#   extended/src/unixcmds.c
# Wrapped by karl@one on Wed Nov 13 21:50:29 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'extended/src/fmath.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/src/fmath.c'\"
else
echo shar: Extracting \"'extended/src/fmath.c'\" \(16292 characters\)
sed "s/^X//" >'extended/src/fmath.c' <<'END_OF_FILE'
X/*
X * fmath.c --
X *
X *      Contains the TCL trig and floating point math functions.
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#include "tclExtdInt.h"
X#include <math.h>
X
X/*
X * Flag used to indicate if a floating point math routine is currently being
X * executed.  Used to determine if a fmatherr belongs to Tcl.
X */
Xstatic int G_inTclFPMath = FALSE;
X
X/*
X * Flag indicating if a floating point math error occured during the execution
X * of a library routine called by a Tcl command.  Will not be set by the trap
X * handler if the error did not occur while the `G_inTclFPMath' flag was
X * set.  If the error did occur the error type and the name of the function
X * that got the error are save here.
X */
Xstatic int   G_gotTclFPMathErr = FALSE;
Xstatic char *G_functionName;
Xstatic int   G_errorType;
X
X/*
X * Prototypes of internal functions.
X */
Xint
XTcl_UnaryFloatFunction _ANSI_ARGS_((Tcl_Interp *interp,
X                                    int         argc,
X                                    char      **argv,
X                                    double (*function)()));
X
X
X/*
X *----------------------------------------------------------------------
X *
X * ReturnFPMathError --
X *    Routine to set an interpreter result to contain a floating point
X * math error message.  Will clear the `G_gotTclFPMathErr' flag.
X * This routine always returns the value TCL_ERROR, so if can be called
X * as the argument to `return'.
X *
X * Globals:
X *   o G_gotTclFPMathErr (O) - Flag indicating an error occured, will be
X *     cleared.
X *   o G_functionName (I) - Name of function that got the error.
X *   o G_errorType (I) - Type of error that occured.
X *----------------------------------------------------------------------
X */
Xstatic int
XReturnFPMathError (interp)
X    Tcl_Interp *interp;
X{
X    char *errorMsg;
X
X    switch (G_errorType) {
X       case DOMAIN:
X           errorMsg = "domain";
X           break;
X       case SING:
X           errorMsg = "singularity";
X           break;
X       case OVERFLOW:
X           errorMsg = "overflow";
X           break;
X       case UNDERFLOW:
X           errorMsg = "underflow";
X           break;
X       case TLOSS:
X       case PLOSS:
X           errorMsg = "loss of significance";
X           break;
X    }
X    sprintf (interp->result, "%s: floating point %s error", G_functionName,
X             errorMsg);
X    G_gotTclFPMathErr = FALSE;  /* Clear the flag. */
X    return TCL_ERROR;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_MathError --
X *    Tcl math error handler, should be called by an application `matherr'
X *    routine to determine if an error was caused by Tcl code or by other
X *    code in the application.  If the error occured in Tcl code, flags will
X *    be set so that a standard Tcl interpreter error can be returned.
X *
X * Paramenter:
X *   o functionName (I) - The name of the function that got the error.  From
X *     the exception structure supplied to matherr.
X *   o errorType (I) - The type of error that occured.  From the exception
X *     structure supplied to matherr.
X * Results:
X *      Returns TRUE if the error was in Tcl code, in which case the
X *   matherr routine calling this function should return non-zero so no
X *   error message will be generated.  FALSE if the error was not in Tcl
X *   code, in which case the matherr routine can handle the error in any
X *   manner it choses.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_MathError (functionName, errorType)
X    char *functionName;
X    int   errorType;
X{
X
X  if (G_inTclFPMath) {
X      G_gotTclFPMathErr = TRUE;
X      G_functionName = functionName;
X      G_errorType = errorType;
X      return TRUE;
X  } else
X     return FALSE;
X
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_UnaryFloatFunction --
X *    Helper routine that implements Tcl unary floating point
X *     functions by validating parameters, converting the
X *     argument, applying the function (the address of which
X *     is passed as an argument), and converting the result to
X *     a string and storing it in the result buffer
X *
X * Results:
X *      Returns TCL_OK if number is present, conversion succeeded,
X *        the function was performed, etc.
X *      Return TCL_ERROR for any error; an appropriate error message
X *        is placed in the result string in this case.
X *
X *----------------------------------------------------------------------
X */
Xstatic int
XTcl_UnaryFloatFunction(interp, argc, argv, function)
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X    double (*function)();
X{
X    double dbVal;
X
X    if (argc != 2) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " val",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetDouble (interp, argv[1], &dbVal) != TCL_OK)
X        return TCL_ERROR;
X
X    G_inTclFPMath = TRUE;
X    sprintf(interp->result, "%g", (*function)(dbVal));
X    G_inTclFPMath = FALSE;
X
X    if (G_gotTclFPMathErr)
X        return ReturnFPMathError (interp);
X
X    return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_AcosCmd --
X *    Implements the TCL arccosine command:
X *        acos num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_AcosCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, acos);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_AsinCmd --
X *    Implements the TCL arcsin command:
X *        asin num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_AsinCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, asin);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_AtanCmd --
X *    Implements the TCL arctangent command:
X *        atan num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_AtanCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, atan);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_CosCmd --
X *    Implements the TCL cosine command:
X *        cos num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_CosCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, cos);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_SinCmd --
X *    Implements the TCL sin command:
X *        sin num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_SinCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, sin);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_TanCmd --
X *    Implements the TCL tangent command:
X *        tan num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_TanCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, tan);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_CoshCmd --
X *    Implements the TCL hyperbolic cosine command:
X *        cosh num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_CoshCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, cosh);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_SinhCmd --
X *    Implements the TCL hyperbolic sin command:
X *        sinh num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_SinhCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, sinh);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_TanhCmd --
X *    Implements the TCL hyperbolic tangent command:
X *        tanh num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_TanhCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, tanh);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_ExpCmd --
X *    Implements the TCL exponent command:
X *        exp num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_ExpCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, exp);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_LogCmd --
X *    Implements the TCL logarithm command:
X *        log num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_LogCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, log);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_Log10Cmd --
X *    Implements the TCL base-10 logarithm command:
X *        log10 num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_Log10Cmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, log10);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_SqrtCmd --
X *    Implements the TCL square root command:
X *        sqrt num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_SqrtCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, sqrt);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_FabsCmd --
X *    Implements the TCL floating point absolute value command:
X *        fabs num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_FabsCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, fabs);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_FloorCmd --
X *    Implements the TCL floor command:
X *        floor num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_FloorCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, floor);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_CeilCmd --
X *    Implements the TCL ceil command:
X *        ceil num
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_CeilCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    return Tcl_UnaryFloatFunction(interp, argc, argv, ceil);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_FmodCmd --
X *    Implements the TCL floating modulo command:
X *        fmod num1 num2
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_FmodCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    double dbVal, dbDivisor;
X
X    if (argc != 3) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " val divisor",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetDouble (interp, argv[1], &dbVal) != TCL_OK)
X        return TCL_ERROR;
X
X    if (Tcl_GetDouble (interp, argv[2], &dbDivisor) != TCL_OK)
X        return TCL_ERROR;
X
X    G_inTclFPMath = TRUE;
X    sprintf(interp->result, "%g", fmod(dbVal,dbDivisor));
X    G_inTclFPMath = FALSE;
X
X    if (G_gotTclFPMathErr)
X        return ReturnFPMathError (interp);
X
X    return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_PowCmd --
X *    Implements the TCL power (exponentiation) command:
X *        pow num1 num2
X *
X * Results:
X *      Returns TCL_OK if number is present and conversion succeeds.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_PowCmd(clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    double dbVal, dbExp;
X
X    if (argc != 3) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " val exp",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetDouble (interp, argv[1], &dbVal) != TCL_OK)
X        return TCL_ERROR;
X
X    if (Tcl_GetDouble (interp, argv[2], &dbExp) != TCL_OK)
X        return TCL_ERROR;
X
X    G_inTclFPMath = TRUE;
X    sprintf(interp->result, "%g", pow(dbVal,dbExp));
X    G_inTclFPMath = FALSE;
X
X    if (G_gotTclFPMathErr)
X        return ReturnFPMathError (interp);
X
X    return TCL_OK;
X}
END_OF_FILE
if test 16292 -ne `wc -c <'extended/src/fmath.c'`; then
    echo shar: \"'extended/src/fmath.c'\" unpacked with wrong size!
fi
# end of 'extended/src/fmath.c'
fi
if test -f 'extended/src/regexputil.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/src/regexputil.c'\"
else
echo shar: Extracting \"'extended/src/regexputil.c'\" \(15466 characters\)
sed "s/^X//" >'extended/src/regexputil.c' <<'END_OF_FILE'
X/*
X * regexputil.c --
X *
X * Tcl regular expression pattern matching utilities.
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 * Boyer-Moore code from:
X *     torek-boyer-moore/27-Aug-90 by
X *     [e-mail] (Chris Torek)
X */
X
X#include "tclExtdInt.h"
X#include "regexp.h"
X
X/*
X * This is declared in tclUtil.c.  Must be set to NULL before compiling
X * a regular expressions.
X */
Xextern char *tclRegexpError;
X
X/*
X * Meta-characters for regular expression
X */
X#define REXP_META               "^$.[()|?+*\\"
X#define REXP_META_NO_BRACKET    "^$.()|?+*\\"
X
X#ifndef CHAR_MAX
X#    define CHAR_MAX 255
X#endif
X
X/*
X * Prototypes of internal functions.
X */
X
Xchar *
XBoyerMooreCompile _ANSI_ARGS_((char *pat,
X                                  int patlen));
X
Xchar *
XBoyerMooreExecute _ANSI_ARGS_((char     *text,
X                               unsigned  textlen,
X                               char     *compPtr,
X                               unsigned *patLenP));
X
X
X/*
X * Boyer-Moore search: input is `text' (a string) and its length,
X * and a `pattern' (another string) and its length.
X *
X * The linear setup cost of this function is approximately 256 + patlen.
X * Afterwards, however, the average cost is O(textlen/patlen), and the
X * worst case is O(textlen+patlen).
X *
X * The Boyer-Moore algorithm works by observing that, for each position
X * in the text, if the character there does *not* occur somewhere in the
X * search pattern, no comparisons including that character will match.
X * That is, given the text "hello world..." and the pattern "goodbye", the
X * `w' in `world' means that none of `hello w', `ello wo', `llo wor',
X * `lo worl', `o world', ` world.', and `world..' can match.  In fact,
X * exactly patlen strings are certain not to match.  We can discover this
X * simply by looking at the patlen'th character.  Furthermore, even if
X * the text character does occur, it may be that it rules out some number
X * of other matches.  Again, we can discover this by doing the match
X * `backwards'.
X *
X * We set up a table of deltas for each possible character, with
X * delta[character] being patlen for characters not in the pattern,
X * less for characters in the pattern, growing progressively smaller
X * as we near the end of the pattern.  Matching then works as follows:
X *
X *       0         1         2         3
X *       01234567890123456789012345678901234567
X *      "Here is the string being searched into"        (text)
X *       ------                                         (pos = [0..5])
X *      "string"                                        (pat)
X *      654321-                                         (deltas)
X *
X * (the delta for `-' will be derived below).
X *
X * Positions 0..5 end with `i', which is not the `g' we want.  `i' does
X * appear in `string', but two characters before the end.  We skip
X * forward so as to make the `i's match up:
X *
X *      "Here is the string being searched into"        (text)
X *        "string"                                      (pos = [2..7])
X *
X * Next we find that ` ' and `g' do not match.  Since ` ' does not appear
X * in the pattern at all, we can skip forward 6:
X *
X *      "Here is the string being searched into"        (text)
X *              "string"                                (pos = [8..13])
X *
X * Comparing `t' vs `g', we again find no match, and so we obtain the
X * delta for `t', which is 4.  We skip to position 17:
X *
X *      "Here is the string being searched into"        (text)
X *                  "string"                            (pos = [12..17])
X *
X * It thus takes only four steps to move the search point forward to the
X * match, in this case.
X *
X * If the pattern has a recurring character, we must set the delta for
X * that character to the distance of the one closest to the end:
X *
X *      "befuddle the cat"      (text)
X *      "fuddle"                (pos = [0..5])
X *      654321-                 (delta)
X *
X * We want the next search to line the `d's up like this:
X *
X *      "befuddle the cat"      (text)
X *        "fuddle"              (pos = [2..7])
X *
X * and not like this:
X *
X *      "befuddle the cat"      (text)
X *         "fuddle"             (pos = [3..8])
X *
X * so we take the smaller delta for d, i.e., 2.
X *
X * The last task is computing the delta we have noted above as `-':
X *
X *      "candlesticks"          (text)
X *      "hand"                  (pos = [0..3])
X *      4321-                   (delta)
X *
X * Here the `d' in `hand' matches the `d' in `candlesticks', but the
X * strings differ.  Since there are no other `d's in `hand', we know
X * that none of (cand,andl,ndle,dles) can match, and thus we want this
X * delta to be 4 (the length of the pattern).  But if we had, e.g.:
X *
X *      "candlesticks"          (text)
X *      "deed"                  (pos = [0..3])
X *      4321-                   (delta)
X *
X * then we should advance to line up the other `d':
X *
X *      "candlesticks"          (text)
X *         "deed"               (pos = [3..6])
X *
X * As this suggests, the delta should be that for the `d' nearest the
X * end, but not including the end.  This is easily managed by setting up
X * a delta table as follows:
X *
X *      for int:c in [0..255] { delta[c] = patlen; };
X *      for int:x in [0..patlen-1) { delta[pat[x]] = patlen - (x + 1); };
X *
X * delta[pat[patlen-1]] is never written, so the last letter inherits the
X * delta from an earlier iteration or from the previous loop.
X *
X * NB: the nonsense with `deltaspace' below exists merely because gcc
X * does a horrible job of common subexpression elimination (it does not
X * notice that the array is at a constant stack address).
X */
X
Xstruct compiled_search_struct {
X        unsigned patlen;
X        unsigned deltaspace[CHAR_MAX + 1];
X};
X
X
Xstatic char *
XBoyerMooreCompile (pat, patlen)
X    char *pat;
X    int   patlen;
X{
X        register unsigned char *p, *t;
X        register unsigned i, p1, j, *delta;
X        struct compiled_search_struct *cp;
X        int alloc_len;
X
X        /* algorithm fails if pattern is empty */
X        if ((p1 = patlen) == 0)
X                return (NULL);
X
X        alloc_len = sizeof(struct compiled_search_struct) + patlen + 1;
X        cp = (struct compiled_search_struct *)ckalloc(alloc_len);
X
X        strncpy((char *)cp+sizeof(struct compiled_search_struct), pat, patlen);
X        *((char *)cp+alloc_len-1) = '\0';
X
X        /* set up deltas */
X        delta = cp->deltaspace;
X
X        for (i = 0; i <= CHAR_MAX; i++)
X                delta[i] = p1;
X
X        for (p = (unsigned char *)pat, i = p1; --i > 0;)
X                delta[*p++] = i;
X
X        cp->patlen = patlen;
X        return((char*) cp);
X}
X
Xstatic char *
XBoyerMooreExecute (text, textlen, compPtr, patLenP)
X        char     *text;
X        unsigned  textlen;
X        char     *compPtr;
X        unsigned *patLenP;
X{
X        register unsigned char *p, *t;
X        struct compiled_search_struct *csp =
X            (struct compiled_search_struct*) compPtr;
X        register unsigned i, p1, j, *delta = csp->deltaspace;
X        char *pat;
X        unsigned patlen;
X
X        *patLenP = p1 = patlen = csp->patlen;
X        /* code below fails (whenever i is unsigned) if pattern too long */
X        if (p1 > textlen)
X                return (NULL);
X
X        pat = (char *)csp + sizeof(struct compiled_search_struct);
X        /*
X         * From now on, we want patlen - 1.
X         * In the loop below, p points to the end of the pattern,
X         * t points to the end of the text to be tested against the
X         * pattern, and i counts the amount of text remaining, not
X         * including the part to be tested.
X         */
X        p1--;
X        p = (unsigned char *)pat + p1;
X        t = (unsigned char *)text + p1;
X        i = textlen - patlen;
X        for (;;) {
X                if (*p == *t &&
X                    memcmp((p - p1), (t - p1), p1) == 0)
X                        return ((char *)t - p1);
X                j = delta[*t];
X                if (i < j)
X                        break;
X                i -= j;
X                t += j;
X        }
X        return (NULL);
X}
X
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_RegExpClean --
X *     Free all resources associated with a regular expression info
X *     structure..
X *
X *----------------------------------------------------------------------
X */
Xvoid
XTcl_RegExpClean (regExpPtr)
X    regexp_pt regExpPtr;
X{
X    if (regExpPtr->progPtr != NULL)
X        ckfree ((char *) regExpPtr->progPtr);
X    if (regExpPtr->boyerMoorePtr != NULL)
X        ckfree ((char *) regExpPtr->boyerMoorePtr);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * FindNonRegExpSubStr
X *     Find the largest substring that does not have any regular
X *     expression meta-characters and is not located within `[...]'.
X *
X *----------------------------------------------------------------------
X */
Xstatic void
XFindNonRegExpSubStr (expression, subStrPtrPtr, subStrLenPtr)
X    char  *expression;
X    char **subStrPtrPtr;
X    int   *subStrLenPtr;
X{
X    register char *subStrPtr = NULL;
X    register char  subStrLen = 0;
X    register char *scanPtr   = expression;
X    register int   len;
X
X    while (*scanPtr != '\0') {
X        len = strcspn (scanPtr, REXP_META);
X        /*
X         * If we are at a meta-character, by-pass till non-meta.  If we hit
X         * a `[' then by-pass the entire `[...]' range, but be careful, could
X         * have omitted `]'.
X         */
X        if (len == 0) {
X            scanPtr += strspn (scanPtr, REXP_META_NO_BRACKET);
X            if (*scanPtr == '[') {
X                scanPtr += strcspn (scanPtr, "]");
X                if (*scanPtr == ']')
X                    scanPtr++;
X            }
X        } else {
X            if (len > subStrLen) {
X                subStrPtr = scanPtr;
X                subStrLen = len;
X            }
X            scanPtr += len;
X        }
X    }
X    *subStrPtrPtr = subStrPtr;
X    *subStrLenPtr = subStrLen;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_RegExpCompile --
X *     Compile a regular expression.
X *
X * Parameters:
X *     o regExpPtr - Used to hold info on this regular expression.  If the
X *       structure is being reused, it Tcl_RegExpClean should be called first.
X *     o expression - Regular expression to compile.
X *     o flags - The following flags are recognized:
X *         o REXP_NO_CASE - Comparison will be regardless of case.
X *         o REXP_BOTH_ALGORITHMS - If specified, a Boyer-Moore expression is
X *           compiled for the largest substring of the expression that does
X *           not contain any meta-characters.  This is slows compiling, but
X *           speeds up large searches.
X *
X * Results:
X *     Standard TCL results.
X *----------------------------------------------------------------------
X */
Xint
XTcl_RegExpCompile (interp, regExpPtr, expression, flags)
X    Tcl_Interp  *interp;
X    regexp_pt    regExpPtr;
X    char        *expression;
X    int          flags;
X{
X    char *expBuf;
X    int   anyMeta;
X
X    if (*expression == '\0') {
X        Tcl_AppendResult (interp, "Null regular expression", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    regExpPtr->progPtr = NULL;
X    regExpPtr->boyerMoorePtr = NULL;
X    regExpPtr->noCase = flags & REXP_NO_CASE;
X
X    if (flags & REXP_NO_CASE) {
X        expBuf = ckalloc (strlen (expression) + 1);
X        Tcl_DownShift (expBuf, expression);
X    } else
X        expBuf = expression;
X
X    anyMeta = strpbrk (expBuf, REXP_META) != NULL;
X
X    /*
X     * If no meta-characters, use Boyer-Moore string matching only.
X     */
X    if (!anyMeta) {
X        regExpPtr->boyerMoorePtr = BoyerMooreCompile (expBuf, strlen (expBuf));
X        goto okExitPoint;
X    }
X
X    /*
X     * Build a Boyer-Moore on the largest non-meta substring, if requested.
X     */
X    if (flags & REXP_BOTH_ALGORITHMS) {
X        char *subStrPtr;
X        int   subStrLen;
X
X        FindNonRegExpSubStr (expBuf, &subStrPtr, &subStrLen);
X        if (subStrLen > 0)
X            regExpPtr->boyerMoorePtr =
X                BoyerMooreCompile (subStrPtr, subStrLen);
X    }
X
X    /*
X     * Compile meta-character containing regular expression.
X     */
X    tclRegexpError = NULL;
X    regExpPtr->progPtr = regcomp (expBuf);
X    if (tclRegexpError != NULL) {
X        if (flags & REXP_NO_CASE)
X            ckfree (expBuf);
X        Tcl_AppendResult (interp, "error in regular expression: ",
X                          tclRegexpError, (char *) NULL);
X        if (flags & REXP_NO_CASE)
X            ckfree (expBuf);
X        Tcl_RegExpClean (regExpPtr);
X    }
X
XokExitPoint:
X    if (flags & REXP_NO_CASE)
X        ckfree (expBuf);
X    return TCL_OK;
X
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_RegExpExecute --
X *     Execute a regular expression compiled with Boyer-Moore and/or
X *     regexp.
X *
X * Parameters:
X *     o regExpPtr - Used to hold info on this regular expression.
X *     o matchStrIn - String to match against the regular expression.
X *     o matchStrLower - Optional lower case version of the string.  If
X *       multiple no case matches are being done, time can be saved by
X *       down shifting the string in advance.  NULL if not a no-case
X *       match or this procedure is to do the down shifting.
X *
X * Results:
X *     TRUE if a match, FALSE if it does not match.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_RegExpExecute (interp, regExpPtr, matchStrIn, matchStrLower)
X    Tcl_Interp  *interp;
X    regexp_pt    regExpPtr;
X    char        *matchStrIn;
X    char        *matchStrLower;
X{
X    char *matchStr;
X    int   result;
X
X    if (regExpPtr->noCase) {
X        if (matchStrLower == NULL) {
X            matchStr = ckalloc (strlen (matchStrIn) + 1);
X            Tcl_DownShift (matchStr, matchStrIn);
X        } else
X            matchStr = matchStrLower;
X    } else
X        matchStr = matchStrIn;
X    /*
X     * If a Boyer-Moore pattern has been compiled, use that algorithm to test
X     * against the text.  If that passes, then test with the regexp if we have
X     * it.
X     */
X    if (regExpPtr->boyerMoorePtr != NULL) {
X        char     *startPtr;
X        unsigned  matchLen;
X
X        startPtr = BoyerMooreExecute (matchStr, strlen (matchStr),
X                                      regExpPtr->boyerMoorePtr, &matchLen);
X        if (startPtr == NULL) {
X            result = FALSE;
X            goto exitPoint;
X        }
X        if (regExpPtr->progPtr == NULL) {
X            result = TRUE;  /* No regexp, its a match! */
X            goto exitPoint;
X        }
X    }
X
X    /*
X     * Give it a go with full regular expressions
X     */
X    result = regexec (regExpPtr->progPtr, matchStr);
X
X    /*
X     * Clean up and return status here.
X     */
XexitPoint:
X    if ((regExpPtr->noCase) && (matchStrLower == NULL))
X        ckfree (matchStr);
X    return result;
X}
END_OF_FILE
if test 15466 -ne `wc -c <'extended/src/regexputil.c'`; then
    echo shar: \"'extended/src/regexputil.c'\" unpacked with wrong size!
fi
# end of 'extended/src/regexputil.c'
fi
if test -f 'extended/src/unixcmds.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/src/unixcmds.c'\"
else
echo shar: Extracting \"'extended/src/unixcmds.c'\" \(16058 characters\)
sed "s/^X//" >'extended/src/unixcmds.c' <<'END_OF_FILE'
X/*
X * unixcmds.c --
X *
X * Tcl commands to access unix library calls.
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#include "tclExtdInt.h"
X
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_ExecvpCmd --
X *     Implements the TCL execvp command:
X *     execvp prog ["arg1...argN"]
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_ExecvpCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    if (argc < 2) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " prog [arg..]",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    /*
X     * Argv always ends in a null.
X     */
X    if (execvp (argv[1], &argv[1]) < 0) {
X        Tcl_AppendResult (interp, argv [0], ": ", argv [1], ": ",
X                          Tcl_UnixError (interp), (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    panic ("no execvp");
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_ForkCmd --
X *     Implements the TCL fork command:
X *     fork
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_ForkCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    int pid;
X
X    if (argc != 1) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv[0], (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    pid = Tcl_Fork ();
X    if (pid < 0) {
X        Tcl_AppendResult (interp, argv [0], ": ", Tcl_UnixError (interp),
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    sprintf(interp->result, "%d", pid);
X    return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_KillCmd --
X *     Implements the TCL kill command:
X *        kill [signal] proclist
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_KillCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int     argc;
X    char      **argv;
X{
X    int    signalNum, idx, procId, procArgc, result = TCL_ERROR;
X    char **procArgv;
X
X    if ((argc < 2) || (argc > 3)) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0],
X                          " [signal] processlist", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (argc == 2)
X        signalNum = SIGTERM;
X    else {
X        if (!Tcl_StrToInt (argv[1], 0, &signalNum)) {
X            signalNum = Tcl_SigNameToNum (argv[1]);
X        }
X        if ((signalNum < 0) || (signalNum > NSIG)) {
X            Tcl_AppendResult (interp, argv [0], ": invalid signal",
X                              (char *) NULL);
X            return TCL_ERROR;
X        }
X    }
X
X    if (Tcl_SplitList (interp, argv [argc - 1], &procArgc,
X                       &procArgv) != TCL_OK)
X        return TCL_ERROR;
X
X    for (idx = 0; idx < procArgc; idx++) {
X
X        if (Tcl_GetInt (interp, procArgv [idx], &procId) != TCL_OK)
X            goto exitPoint;
X
X        if (kill (procId, signalNum) < 0) {
X            Tcl_AppendResult (interp, argv [0], ": pid ", procArgv [idx],
X                              ": ", Tcl_UnixError (interp), (char *) NULL);
X            goto exitPoint;
X        }
X     }
X
X    result = TCL_OK;
XexitPoint:
X    ckfree ((char *) procArgv);
X    return result;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_AlarmCmd --
X *     Implements the TCL Alarm command:
X *         Alarm seconds
X *
X * Results:
X *      Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_AlarmCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    unsigned time;
X
X    if (argc != 2) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " seconds",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetInt (interp, argv[1], &time) != TCL_OK)
X        return TCL_ERROR;
X
X    sprintf (interp->result, "%d", alarm (time));
X    return TCL_OK;
X
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_SleepCmd --
X *     Implements the TCL sleep command:
X *         sleep seconds
X *
X * Results:
X *      Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_SleepCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    unsigned time;
X
X    if (argc != 2) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " seconds",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetUnsigned (interp, argv[1], &time) != TCL_OK)
X        return TCL_ERROR;
X
X    sleep (time);
X    return TCL_OK;
X
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_SystemCmd --
X *     Implements the TCL system command:
X *     system command
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_SystemCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    int exitCode;
X
X    if (argc != 2) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " command",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    exitCode = Tcl_System (interp, argv[1]);
X    if (exitCode == -1)
X        return TCL_ERROR;
X    sprintf (interp->result, "%d", exitCode);
X    return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_TimesCmd --
X *     Implements the TCL times command:
X *     times
X *
X * Results:
X *  Standard TCL results.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_TimesCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    struct tms tm;
X
X    /*
X     * Precompute milliseconds-per-tick, the " + CLK_TCK / 2" bit gets it to
X     * round off instead of truncate.
X     */
X#define MS_PER_TICK ((1000 + CLK_TCK/2) / CLK_TCK)
X
X    if (argc != 1) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv[0], (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    times(&tm);
X
X    sprintf(interp->result, "%ld %ld %ld %ld",
X            tm.tms_utime  * MS_PER_TICK,
X            tm.tms_stime  * MS_PER_TICK,
X            tm.tms_cutime * MS_PER_TICK,
X            tm.tms_cstime * MS_PER_TICK);
X    return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_UmaskCmd --
X *     Implements the TCL umask command:
X *     umask [octalmask]
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_UmaskCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    int mask;
X
X    if ((argc < 1) || (argc > 2)) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " octalmask",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (argc == 1) {
X        mask = umask (0);  /* Get current mask      */
X        umask (mask);      /* Now set it back (yuk) */
X        sprintf (interp->result, "%o", mask);
X    } else {
X        if (!Tcl_StrToInt (argv[1], 8, &mask)) {
X            Tcl_AppendResult (interp, "Expected octal number got: ", argv[1],
X                              (char *) NULL);
X            return TCL_ERROR;
X        }
X
X        umask(mask);
X    }
X
X    return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_LinkCmd --
X *     Implements the TCL unlink command:
X *         link srcpath destpath
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_LinkCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X
X    if (argc != 3) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0],
X                          " srcpath destpath", (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (link (argv [1], argv [2]) != 0) {
X       Tcl_AppendResult (interp, argv [0], ": ", Tcl_UnixError (interp),
X                        (char *) NULL);
X       return TCL_ERROR;
X    }
X
X    return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_UnlinkCmd --
X *     Implements the TCL unlink command:
X *         unlink fileList
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_UnlinkCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    int    idx, fileArgc, result = TCL_ERROR;
X    char **fileArgv;
X
X    if (argc != 2) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0],
X                          " filelist", (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (Tcl_SplitList (interp, argv [1], &fileArgc, &fileArgv) != TCL_OK)
X        return TCL_ERROR;
X
X    for (idx = 0; idx < fileArgc; idx++) {
X        if (unlink (fileArgv [idx]) != 0) {
X           Tcl_AppendResult (interp, argv [0], ": ", fileArgv [idx], ": ",
X                             Tcl_UnixError (interp), (char *) NULL);
X           goto exitPoint;
X        }
X    }
X
X    result = TCL_OK;
XexitPoint:
X    ckfree ((char *) fileArgv);
X    return result;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_MkdirCmd --
X *     Implements the TCL Mkdir command:
X *         mkdir [-path] dirList
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_MkdirCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    int           idx, dirArgc, result;
X    char        **dirArgv, *scanPtr;
X    struct stat   statBuf;
X
X    if ((argc < 2) || (argc > 3))
X        goto usageError;
X    if ((argc == 3) && !STREQU (argv [1], "-path"))
X        goto usageError;
X
X    if (Tcl_SplitList (interp, argv [argc - 1], &dirArgc, &dirArgv) != TCL_OK)
X        return TCL_ERROR;
X    /*
X     * Make all the directories, optionally making directories along the path.
X     */
X
X    for (idx = 0; idx < dirArgc; idx++) {
X        /*
X         * Make leading directories, if requested.
X         */
X        if (argc == 3) {
X            scanPtr = dirArgv [idx];
X            result = 0;  /* Start out ok, for dirs that are skipped */
X
X            while (*scanPtr != '\0') {
X                scanPtr = strchr (scanPtr+1, '/');
X                if ((scanPtr == NULL) || (*(scanPtr+1) == '\0'))
X                    break;
X                *scanPtr = '\0';
X                if (stat (dirArgv [idx], &statBuf) < 0)
X                    result = mkdir (dirArgv [idx], S_IFDIR | 0777, 0);
X                *scanPtr = '/';
X                if (result < 0)
X                   goto mkdirError;
X            }
X        }
X        /*
X         * Make final directory in the path.
X         */
X        if (mkdir (dirArgv [idx], S_IFDIR | 0777, 0) != 0)
X           goto mkdirError;
X    }
X
X    ckfree ((char *) dirArgv);
X    return TCL_OK;
X
XmkdirError:
X    Tcl_AppendResult (interp, argv [0], ": ", dirArgv [idx], ": ",
X                      Tcl_UnixError (interp), (char *) NULL);
X    ckfree ((char *) dirArgv);
X    return TCL_ERROR;
X
XusageError:
X    Tcl_AppendResult (interp, "wrong # args: ", argv [0],
X                      " [-path] dirlist", (char *) NULL);
X    return TCL_ERROR;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_RmdirCmd --
X *     Implements the TCL Rmdir command:
X *         rmdir dirList
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_RmdirCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    int    idx, dirArgc, result = TCL_ERROR;
X    char **dirArgv;
X
X    if (argc != 2) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0],
X                          " dirlist", (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (Tcl_SplitList (interp, argv [1], &dirArgc, &dirArgv) != TCL_OK)
X        return TCL_ERROR;
X
X    for (idx = 0; idx < dirArgc; idx++) {
X        if (rmdir (dirArgv [idx]) != 0) {
X           Tcl_AppendResult (interp, argv [0], ": ", dirArgv [idx], ": ",
X                             Tcl_UnixError (interp), (char *) NULL);
X           goto exitPoint;
X        }
X    }
X
X    result = TCL_OK;
XexitPoint:
X    ckfree ((char *) dirArgv);
X    return result;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_WaitCmd --
X *     Implements the TCL wait command:
X *     wait proclist
X *
X * Results:
X *  Standard TCL results, may return the UNIX system error message.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_WaitCmd (clientData, interp, argc, argv)
X    ClientData  clientData;
X    Tcl_Interp *interp;
X    int         argc;
X    char      **argv;
X{
X    int    waitPid, status, idx, procArgc, result = TCL_ERROR;
X    char **procArgv;
X    int   *procIdList;
X
X    if (argc != 2) {
X        Tcl_AppendResult (interp, "wrong # args: ", argv [0], " proclist",
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_SplitList (interp, argv [1], &procArgc, &procArgv) != TCL_OK)
X        return TCL_ERROR;
X
X    procIdList = (int *) ckalloc (procArgc * (sizeof (int)));
X
X    for (idx = 0; idx < procArgc; idx++) {
X        if (Tcl_GetInt (interp, procArgv [idx], &procIdList [idx]) != TCL_OK)
X            goto exitPoint;
X    }
X
X    waitPid = Tcl_WaitPids (procArgc, procIdList, &status);
X
X    if (waitPid < 0) {
X        Tcl_AppendResult (interp, argv [0], ": ", Tcl_UnixError (interp),
X                          (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (WIFEXITED (status))
X        sprintf (interp->result, "%d %s %d", waitPid, "EXIT",
X                 WEXITSTATUS (status));
X    else if (WIFSIGNALED (status))
X        sprintf (interp->result, "%d %s %s", waitPid, "SIG",
X                 Tcl_SignalId (WTERMSIG (status)));
X    else if (WIFSTOPPED (status))
X        sprintf (interp->result, "%d %s %s", waitPid, "STOP",
X                 Tcl_SignalId (WSTOPSIG (status)));
X
X    result = TCL_OK;
XexitPoint:
X    ckfree ((char *) procArgv);
X    ckfree ((char *) procIdList);
X    return result;
X}
END_OF_FILE
if test 16058 -ne `wc -c <'extended/src/unixcmds.c'`; then
    echo shar: \"'extended/src/unixcmds.c'\" unpacked with wrong size!
fi
# end of 'extended/src/unixcmds.c'
fi
echo shar: End of archive 17 \(of 23\).
cp /dev/null ark17isdone
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].