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

Text File | 1991-11-19 | 48.6 KB | 1,452 lines

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

Submitted-by: [e-mail] (Karl Lehenbauer)
Posting-number: Volume 26, Issue 16
Archive-name: tclx/part16
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 16 (of 23)."
# Contents:  extended/src/handles.c extended/src/tclstartup.c
#   extended/tcllib/buildhelp.tcl
# Wrapped by karl@one on Wed Nov 13 21:50:28 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'extended/src/handles.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/src/handles.c'\"
else
echo shar: Extracting \"'extended/src/handles.c'\" \(15132 characters\)
sed "s/^X//" >'extended/src/handles.c' <<'END_OF_FILE'
X/*
X *
X * handles.c --
X *
X * Tcl handles.  Provides a mechanism for managing expandable tables that are
X * addressed by textual handles.
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 * This is the table header.  It is separately allocated from the table body,
X * since it must keep track of a table body that might move.  Each entry in the
X * table is preceded with a header which has the free list link, which is a
X * entry index of the next free entry.  Special values keep track of allocated
X * entries.
X */
X
X#define NULL_IDX      -1
X#define ALLOCATED_IDX -2
X
Xtypedef unsigned char ubyte_t;
Xtypedef ubyte_t *ubyte_pt;
X
Xtypedef struct {
X    int      useCount;          /* Keeps track of the number sharing       */
X    int      entrySize;         /* Entry size in bytes, including overhead */
X    int      tableSize;         /* Current number of entries in the table  */
X    int      freeHeadIdx;       /* Index of first free entry in the table  */
X    ubyte_pt bodyP;             /* Pointer to table body                   */
X    int      baseLength;        /* Length of handleBase.                   */
X    char     handleBase [1];    /* Base handle name.  MUST BE LAST FIELD!  */
X    } tblHeader_t;
Xtypedef tblHeader_t *tblHeader_pt;
X
Xtypedef struct {
X    int freeLink;
X  } entryHeader_t;
Xtypedef entryHeader_t *entryHeader_pt;
X
X/*
X * This macro is used to return a pointer to an entry, given its index.
X */
X#define TBL_INDEX(hdrP, idx) \
X    ((entryHeader_pt) (hdrP->bodyP + (hdrP->entrySize * idx)))
X
X/*
X * This macros to convert between pointers to the user and header area of
X * an table entry.
X */
X#define USER_AREA(entryPtr) \
X (void_pt) (((ubyte_pt) entryPtr) + sizeof (entryHeader_t));
X#define HEADER_AREA(entryPtr) \
X (entryHeader_pt) (((ubyte_pt) entryPtr) - sizeof (entryHeader_t));
X
X/*
X * Prototypes of internal functions.
X */
Xvoid
XLinkInNewEntries _ANSI_ARGS_((tblHeader_pt tblHdrPtr,
X                              int          newIdx,
X                              int          numEntries));
X
Xvoid
XExpandTable _ANSI_ARGS_((tblHeader_pt tblHdrPtr,
X                         int          neededIdx));
X
XentryHeader_pt
XAllocEntry _ANSI_ARGS_((tblHeader_pt  tblHdrPtr,
X                        int          *entryIdxPtr));
X
Xint
XHandleDecode _ANSI_ARGS_((Tcl_Interp   *interp,
X                          tblHeader_pt  tblHdrPtr,
X                          CONST char   *handle));
X
X/*=============================================================================
X * LinkInNewEntries --
X *   Build free links through the newly allocated part of a table.
X *
X * Parameters:
X *   o tblHdrPtr (I) - A pointer to the table header.
X *   o newIdx (I) - Index of the first new entry.
X *   o numEntries (I) - The number of new entries.
X *-----------------------------------------------------------------------------
X */
Xstatic void
XLinkInNewEntries (tblHdrPtr, newIdx, numEntries)
X    tblHeader_pt tblHdrPtr;
X    int          newIdx;
X    int          numEntries;
X{
X    int            entIdx, lastIdx;
X    entryHeader_pt entryPtr;
X
X    lastIdx = newIdx + numEntries - 1;
X
X    for (entIdx = newIdx; entIdx < lastIdx; entIdx++) {
X        entryPtr = TBL_INDEX (tblHdrPtr, entIdx);
X        entryPtr->freeLink = entIdx + 1;
X    }
X    entryPtr = TBL_INDEX (tblHdrPtr, lastIdx);
X    entryPtr->freeLink = tblHdrPtr->freeHeadIdx;
X    tblHdrPtr->freeHeadIdx = newIdx;
X
X} /* LinkInNewEntries */
X
X/*=============================================================================
X * ExpandTable --
X *   Expand a handle table, doubling its size.
X * Parameters:
X *   o tblHdrPtr (I) - A pointer to the table header.
X *   o neededIdx (I) - If positive, then the table will be expanded so that
X *     this entry is available.  If -1, then just expand by the number of
X *     entries specified on table creation.  MUST be smaller than this size.
X *-----------------------------------------------------------------------------
X */
Xstatic void
XExpandTable (tblHdrPtr, neededIdx)
X    tblHeader_pt tblHdrPtr;
X    int          neededIdx;
X{
X    ubyte_pt oldBodyP = tblHdrPtr->bodyP;
X    int      numNewEntries;
X    int      newSize;
X
X    if (neededIdx < 0)
X        numNewEntries = tblHdrPtr->tableSize;
X    else
X        numNewEntries = (neededIdx - tblHdrPtr->tableSize) + 1;
X    newSize = (tblHdrPtr->tableSize + numNewEntries) * tblHdrPtr->entrySize;
X
X    tblHdrPtr->bodyP = (ubyte_pt) ckalloc (newSize);
X    memcpy (tblHdrPtr->bodyP, oldBodyP, newSize);
X    LinkInNewEntries (tblHdrPtr, tblHdrPtr->tableSize, numNewEntries);
X    tblHdrPtr->tableSize += numNewEntries;
X    ckfree (oldBodyP);
X
X} /* ExpandTable */
X
X/*=============================================================================
X * AllocEntry --
X *   Allocate a table entry, expanding if necessary.
X *
X * Parameters:
X *   o tblHdrPtr (I) - A pointer to the table header.
X *   o entryIdxPtr (O) - The index of the table entry is returned here.
X * Returns:
X *    The a pointer to the entry.
X *-----------------------------------------------------------------------------
X */
Xstatic entryHeader_pt
XAllocEntry (tblHdrPtr, entryIdxPtr)
X    tblHeader_pt  tblHdrPtr;
X    int          *entryIdxPtr;
X{
X    int            entryIdx;
X    entryHeader_pt entryPtr;
X
X    if (tblHdrPtr->freeHeadIdx == NULL_IDX)
X        ExpandTable (tblHdrPtr, -1);
X
X    entryIdx = tblHdrPtr->freeHeadIdx;
X    entryPtr = TBL_INDEX (tblHdrPtr, entryIdx);
X    tblHdrPtr->freeHeadIdx = entryPtr->freeLink;
X    entryPtr->freeLink = ALLOCATED_IDX;
X
X    *entryIdxPtr = entryIdx;
X    return entryPtr;
X
X} /* AllocEntry */
X
X/*=============================================================================
X * HandleDecode --
X *   Decode handle into an entry number.
X *
X * Parameters:
X *   o interp (I) - A error message may be returned in result.
X *   o tblHdrPtr (I) - A pointer to the table header.
X *   o handle (I) - Handle to decode.
X * Returns:
X *   The entry index decoded from the handle, or a negative number if an error
X *   occured.
X *-----------------------------------------------------------------------------
X */
Xstatic int
XHandleDecode (interp, tblHdrPtr, handle)
X    Tcl_Interp   *interp;
X    tblHeader_pt  tblHdrPtr;
X    CONST char   *handle;
X{
X    unsigned entryIdx;
X
X    if ((strncmp (tblHdrPtr->handleBase, (char *) handle,
X             tblHdrPtr->baseLength) != 0) ||
X             !Tcl_StrToUnsigned (&handle [tblHdrPtr->baseLength], 10,
X                                 &entryIdx)) {
X        Tcl_AppendResult (interp, "invalid ", tblHdrPtr->handleBase,
X                          " handle: ", handle, (char *) NULL);
X        return -1;
X    }
X    return entryIdx;
X
X} /* HandleDecode */
X
X/*=============================================================================
X * Tcl_HandleTblInit --
X *   Create and initialize a Tcl dynamic handle table.  The use count on the
X *   table is set to one.
X * Parameters:
X *   o handleBase(I) - The base name of the handle, the handle will be returned
X *     in the form "baseNN", where NN is the table entry number.
X *   o entrySize (I) - The size of an entry, in bytes.
X *   o initEntries (I) - Initial size of the table, in entries.
X * Returns:
X *   A pointer to the table header.
X *-----------------------------------------------------------------------------
X */
Xvoid_pt
XTcl_HandleTblInit (handleBase, entrySize, initEntries)
X    CONST char *handleBase;
X    int         entrySize;
X    int         initEntries;
X{
X    tblHeader_pt tblHdrPtr;
X    int          baseLength = strlen ((char *) handleBase);
X
X    tblHdrPtr = (tblHeader_pt) ckalloc (sizeof (tblHeader_t) + baseLength + 1);
X
X    tblHdrPtr->useCount = 1;
X    tblHdrPtr->baseLength = baseLength;
X    strcpy (tblHdrPtr->handleBase, (char *) handleBase);
X
X    /*
X     * Calculate entry size, including header, rounded up to sizeof (int).
X     */
X    tblHdrPtr->entrySize = entrySize + sizeof (entryHeader_t);
X    tblHdrPtr->entrySize = ((tblHdrPtr->entrySize + sizeof (int) - 1) /
X                          sizeof (int)) * sizeof (int);
X    tblHdrPtr->freeHeadIdx = NULL_IDX;
X    tblHdrPtr->tableSize = initEntries;
X    tblHdrPtr->bodyP = (ubyte_pt) ckalloc (initEntries * tblHdrPtr->entrySize);
X    LinkInNewEntries (tblHdrPtr, 0, initEntries);
X
X    return (void_pt) tblHdrPtr;
X
X} /* Tcl_HandleTblInit */
X
X/*=============================================================================
X * Tcl_HandleTblUseCount --
X *   Alter the handle table use count by the specified amount, which can be
X *   positive or negative.  Amount may be zero to retrieve the use count.
X * Parameters:
X *   o headerPtr (I) - Pointer to the table header.
X *   o amount (I) - The amount to alter the use count by.
X * Returns:
X *   The resulting use count.
X *-----------------------------------------------------------------------------
X */
Xint
XTcl_HandleTblUseCount (headerPtr, amount)
X    void_pt  headerPtr;
X    int      amount;
X{
X    tblHeader_pt   tblHdrPtr = (tblHeader_pt)headerPtr;
X
X    tblHdrPtr->useCount += amount;
X    return tblHdrPtr->useCount;
X}
X
X/*=============================================================================
X * Tcl_HandleTblRelease --
X *   Decrement the use count on a Tcl dynamic handle table.  If the count
X *   goes to zero or negative, then release the table.  It is designed to be
X *   called when a command is released.
X * Parameters:
X *   o headerPtr (I) - Pointer to the table header.
X *-----------------------------------------------------------------------------
X */
Xvoid
XTcl_HandleTblRelease (headerPtr)
X    ClientData headerPtr;
X{
X    tblHeader_pt   tblHdrPtr = (tblHeader_pt)headerPtr;
X
X    tblHdrPtr->useCount--;
X    if (tblHdrPtr->useCount <= 0) {
X        ckfree (tblHdrPtr->bodyP);
X        ckfree ((char *) tblHdrPtr);
X    }
X}
X
X/*=============================================================================
X * Tcl_HandleAlloc --
X *   Allocate an entry and associate a handle with it.
X *
X * Parameters:
X *   o headerPtr (I) - A pointer to the table header.
X *   o handlePtr (O) - Buffer to return handle in. It must be big enough to
X *     hold the name.
X * Returns:
X *   A pointer to the allocated entry (user part).
X *-----------------------------------------------------------------------------
X */
Xvoid_pt
XTcl_HandleAlloc (headerPtr, handlePtr)
X    void_pt   headerPtr;
X    char     *handlePtr;
X{
X    tblHeader_pt   tblHdrPtr = (tblHeader_pt)headerPtr;
X    entryHeader_pt entryPtr;
X    int            entryIdx;
X
X    entryPtr = AllocEntry ((tblHeader_pt) headerPtr, &entryIdx);
X    sprintf (handlePtr, "%s%d", tblHdrPtr->handleBase, entryIdx);
X
X    return USER_AREA (entryPtr);
X
X} /* Tcl_HandleAlloc */
X
X/*=============================================================================
X * Tcl_HandleXlate --
X *   Translate a handle to a entry pointer.
X *
X * Parameters:
X *   o interp (I) - A error message may be returned in result.
X *   o headerPtr (I) - A pointer to the table header.
X *   o handle (I) - The handle assigned to the entry.
X * Returns:
X *   A pointer to the entry, or NULL if an error occured.
X *-----------------------------------------------------------------------------
X */
Xvoid_pt
XTcl_HandleXlate (interp, headerPtr, handle)
X    Tcl_Interp *interp;
X    void_pt     headerPtr;
X    CONST char *handle;
X{
X    tblHeader_pt   tblHdrPtr = (tblHeader_pt)headerPtr;
X    entryHeader_pt entryPtr;
X    int            entryIdx;
X
X    if ((entryIdx = HandleDecode (interp, tblHdrPtr, handle)) < 0)
X        return NULL;
X    entryPtr = TBL_INDEX (tblHdrPtr, entryIdx);
X
X    if ((entryIdx >= tblHdrPtr->tableSize) ||
X            (entryPtr->freeLink != ALLOCATED_IDX)) {
X        Tcl_AppendResult (interp, tblHdrPtr->handleBase, " is not open",
X                          (char *) NULL);
X        return NULL;
X    }
X
X    return USER_AREA (entryPtr);
X
X} /* Tcl_HandleXlate */
X
X/*=============================================================================
X * Tcl_HandleWalk --
X *   Walk through and find every allocated entry in a table.  Entries may
X *   be deallocated during a walk, but should not be allocated.
X *
X * Parameters:
X *   o headerPtr (I) - A pointer to the table header.
X *   o walkKeyPtr (I/O) - Pointer to a variable to use to keep track of the
X *     place in the table.  The variable should be initialized to -1 before
X *     the first call.
X * Returns:
X *   A pointer to the next allocated entry, or NULL if there are not more.
X *-----------------------------------------------------------------------------
X */
Xvoid_pt
XTcl_HandleWalk (headerPtr, walkKeyPtr)
X    void_pt   headerPtr;
X    int      *walkKeyPtr;
X{
X    tblHeader_pt   tblHdrPtr = (tblHeader_pt)headerPtr;
X    int            entryIdx;
X    entryHeader_pt entryPtr;
X
X    if (*walkKeyPtr == -1)
X        entryIdx = 0;
X    else
X        entryIdx = *walkKeyPtr + 1;
X
X    while (entryIdx < tblHdrPtr->tableSize) {
X        entryPtr = TBL_INDEX (tblHdrPtr, entryIdx);
X        if (entryPtr->freeLink == ALLOCATED_IDX) {
X            *walkKeyPtr = entryIdx;
X            return USER_AREA (entryPtr);
X        }
X        entryIdx++;
X    }
X    return NULL;
X
X} /* Tcl_HandleWalk */
X
X/*=============================================================================
X * Tcl_WalkKeyToHandle --
X *   Convert a walk key, as returned from a call to Tcl_HandleWalk into a
X *   handle.  The Tcl_HandleWalk must have succeeded.
X * Parameters:
X *   o headerPtr (I) - A pointer to the table header.
X *   o walkKey (I) - The walk key.
X *   o handlePtr (O) - Buffer to return handle in. It must be big enough to
X *     hold the name.
X *-----------------------------------------------------------------------------
X */
Xvoid
XTcl_WalkKeyToHandle (headerPtr, walkKey, handlePtr)
X    void_pt   headerPtr;
X    int       walkKey;
X    char     *handlePtr;
X{
X    tblHeader_pt   tblHdrPtr = (tblHeader_pt)headerPtr;
X
X    sprintf (handlePtr, "%s%d", tblHdrPtr->handleBase, walkKey);
X
X} /* Tcl_WalkKeyToHandle */
X
X/*=============================================================================
X * Tcl_HandleFree --
X *   Frees a handle table entry.
X *
X * Parameters:
X *   o headerPtr (I) - A pointer to the table header.
X *   o entryPtr (I) - Entry to free.
X *-----------------------------------------------------------------------------
X */
Xvoid
XTcl_HandleFree (headerPtr, entryPtr)
X    void_pt headerPtr;
X    void_pt entryPtr;
X{
X    tblHeader_pt   tblHdrPtr = (tblHeader_pt)headerPtr;
X    entryHeader_pt freeentryPtr;
X
X    freeentryPtr = HEADER_AREA (entryPtr);
X    freeentryPtr->freeLink = tblHdrPtr->freeHeadIdx;
X    tblHdrPtr->freeHeadIdx = (((ubyte_pt) entryPtr) - tblHdrPtr->bodyP) /
X                           tblHdrPtr->entrySize;
X
X} /* Tcl_HandleFree */
X
END_OF_FILE
if test 15132 -ne `wc -c <'extended/src/handles.c'`; then
    echo shar: \"'extended/src/handles.c'\" unpacked with wrong size!
fi
# end of 'extended/src/handles.c'
fi
if test -f 'extended/src/tclstartup.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/src/tclstartup.c'\"
else
echo shar: Extracting \"'extended/src/tclstartup.c'\" \(15114 characters\)
sed "s/^X//" >'extended/src/tclstartup.c' <<'END_OF_FILE'
X/*
X * tclstartup.c --
X *
X * Startup code for the Tcl shell and other interactive applications.  Also
X * create special commands used just by Tcl shell features.
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
Xextern char * getenv ();
X
Xextern char *optarg;
Xextern int   optind, opterr;
X
Xtypedef struct tclParms_t {
X    int    execFile;      /* Run the specified file. (no searching)        */
X    int    execCommand;   /* Execute the specified command.                */
X    int    quickStartup;  /* Quick startup.                                */
X    char  *execStr;       /* Command file or command to execute.           */
X    char **tclArgv;       /* Arguments to pass to tcl script.              */
X    int    tclArgc;       /* Count of arguments to pass to tcl script.     */
X    char  *programName;   /* Name of program (less path).                  */
X    } tclParms_t;
X
X/*
X * Prototypes of internal functions.
X */
Xvoid
XDumpTclError _ANSI_ARGS_((Tcl_Interp  *interp));
X
Xvoid
XParseCmdArgs _ANSI_ARGS_((int          argc,
X                          char       **argv,
X                          tclParms_t  *tclParmsPtr));
X
Xint
XFindDefaultFile _ANSI_ARGS_((Tcl_Interp  *interp,
X                             char        *defaultFile));
X
Xvoid
XProcessDefaultFile _ANSI_ARGS_((Tcl_Interp  *interp,
X                                char        *defaultFile));
X
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_SourcepartCmd --
X *
X *    This procedure is invoked to process the "sourcepart" Tcl command:
X *          sourcepart fileName offset length
X *      which evaluates a range of a file.
X *
X * Results:
X *    A standard Tcl result.
X *
X *----------------------------------------------------------------------
X */
X
X    /* ARGSUSED */
Xstatic int
XTcl_SourcepartCmd(dummy, interp, argc, argv)
X    ClientData dummy;            /* Not used. */
X    Tcl_Interp *interp;            /* Current interpreter. */
X    int argc;                /* Number of arguments. */
X    char **argv;            /* Argument strings. */
X{
X    Interp       *iPtr = (Interp *) interp;
X    long          fileOffset;
X    int           bytesToRead;
X    int           fileId, result = TCL_ERROR;
X    struct stat   statBuf;
X    char         *oldScriptFile;
X    char         *fileName, *cmdBuffer = NULL, *end;
X
X    if (argc != 4) {
X    Tcl_AppendResult(interp, "wrong # args: should be \"",
X        argv[0], " fileName offset length\"", (char *) NULL);
X    return TCL_ERROR;
X    }
X
X    if (Tcl_GetLong (interp, argv[2], &fileOffset) != TCL_OK)
X        return TCL_ERROR;
X    if (Tcl_GetInt (interp, argv[3], &bytesToRead) != TCL_OK)
X        return TCL_ERROR;
X
X    fileName = argv [1];
X    if (fileName [0] == '~')
X        if ((fileName = Tcl_TildeSubst (interp, fileName)) == NULL)
X            return TCL_ERROR;
X
X    fileId = open (fileName, O_RDONLY, 0);
X    if (fileId < 0) {
X    Tcl_AppendResult (interp, "open failed on: ", argv [1], ": ",
X                          Tcl_UnixError (interp), (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (fstat(fileId, &statBuf) == -1) {
X    Tcl_AppendResult (interp, "stat failed on: ", argv [1], ": ",
X                          Tcl_UnixError (interp), (char *) NULL);
X        goto exitPoint;
X    }
X    if (statBuf.st_size < fileOffset + bytesToRead) {
X    Tcl_AppendResult (interp, "file not big enough for requested range: ",
X                          argv [1], (char *) NULL);
X        goto exitPoint;
X    }
X    if (lseek (fileId, fileOffset, 0) < 0) {
X    Tcl_AppendResult (interp, "seek failed on: ", argv [1], ": ",
X                          Tcl_UnixError (interp), (char *) NULL);
X        goto exitPoint;
X    }
X
X    cmdBuffer = (char *) ckalloc((unsigned) bytesToRead+1);
X    if (read(fileId, cmdBuffer, (int) bytesToRead) != bytesToRead) {
X    Tcl_AppendResult (interp, "read failed on: ", argv [1], ": ",
X                          Tcl_UnixError (interp), (char *) NULL);
X        goto exitPoint;
X    }
X    close(fileId);
X    fileId = -1;  /* Mark as closed */
X
X    cmdBuffer[bytesToRead] = '\0';
X
X    oldScriptFile = iPtr->scriptFile;
X    iPtr->scriptFile = fileName;
X
X    result = Tcl_Eval (interp, cmdBuffer, 0, &end);
X
X    iPtr->scriptFile = oldScriptFile;
X    if (result == TCL_RETURN) {
X    result = TCL_OK;
X    }
X    /*
X     * Record information telling where the error occurred.
X
X     */
X
X    if (result == TCL_ERROR) {
X        char buf [100];
X        sprintf (buf, "\n    (file \"%.50s\" line %d)", argv [1],
X                 interp->errorLine);
X    Tcl_AddErrorInfo(interp, buf);
X    }
XexitPoint:
X    if (cmdBuffer != NULL)
X        ckfree((char *)cmdBuffer);
X    if (fileId >= 0)
X        close (fileId);
X    return result;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * DumpTclError --
X *
X * Display error information and abort when an error is returned in the
X * interp->result.
X *
X * Parameters:
X *     o interp - A pointer to the interpreter, should contain the
X *       error message in `result'.
X *----------------------------------------------------------------------
X */
Xstatic void
XDumpTclError (interp)
X    Tcl_Interp  *interp;
X{
X    char *errorStack;
X
X    fflush (stdout);
X    fprintf (stderr, "Error: %s\n", interp->result);
X
X    errorStack = Tcl_GetVar (interp, "errorInfo", 1);
X    if (errorStack != NULL)
X        fprintf (stderr, "%s\n", errorStack);
X    exit (1);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * ParseCmdArgs --
X *
X * Parse the arguments passed to the Tcl shell
X *
X * Parameters:
X *     o argc, argv - Arguments passed to main.
X *     o tclParmsPtr - Results of the parsed Tcl shell command line.
X *----------------------------------------------------------------------
X */
Xstatic void
XParseCmdArgs (argc, argv, tclParmsPtr)
X    int          argc;
X    char       **argv;
X    tclParms_t  *tclParmsPtr;
X{
X    char   *scanPtr, *programName;
X    int     programNameLen;
X    int     option;
X
X    tclParmsPtr->execFile = FALSE;
X    tclParmsPtr->execCommand = FALSE;
X    tclParmsPtr->quickStartup = FALSE;
X    tclParmsPtr->execStr = NULL;
X
X    /*
X     * Determine file name (less directories) that the Tcl interpreter is
X     * being run under.
X     */
X    scanPtr = programName = argv[0];
X    while (*scanPtr != '\0') {
X        if (*scanPtr == '/')
X            programName = scanPtr + 1;
X        scanPtr++;
X    }
X    tclParmsPtr->programName = programName;
X    programNameLen = strlen (programName);
X
X    /*
X     * Scan arguments looking for flags to process here rather than to pass
X     * on to the scripts.  The '-c' or '-f' must also be the last option to
X     * allow for script arguments starting with `-'.
X     */
X    while ((option = getopt (argc, argv, "qc:f:u")) != -1) {
X        switch (option) {
X            case 'q':
X                if (tclParmsPtr->quickStartup)
X                    goto usageError;
X                tclParmsPtr->quickStartup = TRUE;
X                break;
X            case 'c':
X                tclParmsPtr->execCommand = TRUE;
X                tclParmsPtr->execStr = optarg;
X                goto exitParse;
X            case 'f':
X                tclParmsPtr->execFile = TRUE;
X                tclParmsPtr->execStr = optarg;
X                goto exitParse;
X            case 'u':
X            default:
X                goto usageError;
X        }
X    }
X    exitParse:
X
X    /*
X     * If neither `-c' nor `-f' were specified and at least one parameter
X     * is supplied, then if is the file to execute.  The rest of the arguments
X     * are passed to the script.  Check for '--' as the last option, this also
X     * is a terminator for the file to execute.
X     */
X    if ((!tclParmsPtr->execCommand) && (!tclParmsPtr->execFile) &&
X        (optind != argc) && !STREQU (argv [optind-1], "--")) {
X        tclParmsPtr->execFile = TRUE;
X        tclParmsPtr->execStr = argv [optind];
X        optind++;
X    }
X
X    tclParmsPtr->tclArgv = &argv [optind];
X    tclParmsPtr->tclArgc = argc - optind;
X    return;
X
XusageError:
X    fprintf (stderr, "usage: %s %s\n", argv [0],
X             "[-qu] [[-f] script]|[-c command] [args]");
X    exit (1);
X}
X
X/*
X *----------------------------------------------------------------------
X * FindDefaultFile --
X *
X *   Find the Tcl default file.  If is looked for in the following order:
X *       o A environment variable named `TCLDEFAULT'.
X *       o A file named `TCLDEFAULT'.
X *       o The specified defaultFile (which normally has an version number
X *         appended.
X *   A tcl variable `TCLDEFAULT', will contain the path of the default file
X *   to use after this procedure is executed, or a null string if it is not
X *   found.
X * Parameters
X *     o interp (I) - A pointer to the interpreter.
X *     o defaultFile (I) - The file name of the default file to use, it
X *       normally contains a version number.
X * Returns:
X *     TCL_OK if all is ok, TCL_ERROR if a error occured.
X *----------------------------------------------------------------------
X */
Xstatic int
XFindDefaultFile (interp, defaultFile)
X    Tcl_Interp  *interp;
X    char        *defaultFile;
X{
X    char        *defaultFileToUse;
X    struct stat  statBuf;
X
X    if ((defaultFileToUse = getenv ("TCLDEFAULT")) == NULL) {
X        defaultFileToUse = "TCLDEFAULT";
X        if (stat (defaultFileToUse, &statBuf) < 0) {
X            defaultFileToUse = defaultFile;
X        }
X    }
X    if (stat (defaultFileToUse, &statBuf) < 0)
X        defaultFileToUse = "";
X    if (Tcl_SetVar (interp, "TCLDEFAULT", defaultFileToUse,
X                    TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL)
X        return TCL_ERROR;
X    else
X        return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------------
X * ProcessDefaultFile --
X *
X *   Process the Tcl default file and TclInit files.  The default file
X * is the only file at a fixed path. It is a script file that usaually
X * defines a variable "TCLINIT", which has the path of the  full
X * initialization file. The default file can also set things such as path
X * variables.  If the TCLINIT variable is set, that file is then evaluated.
X * If usually does the full Tcl initialization.
X *
X * Parameters
X *     o interp  (I) - A pointer to the interpreter.
X *     o defaultFile (I) - The file name of the default file to use, it
X *       normally contains a version number.
X *----------------------------------------------------------------------
X */
Xstatic void
XProcessDefaultFile (interp, defaultFile)
X    Tcl_Interp  *interp;
X    char        *defaultFile;
X{
X    char *defaultFileToUse, *initFile;
X
X    defaultFileToUse = Tcl_GetVar (interp, "TCLDEFAULT", 1);
X    if (*defaultFileToUse == '\0') {
X        fflush (stdout);
X        fprintf (stderr, "Can't access Tcl default file,\n");
X        fprintf (stderr, "  Located in one of the following ways:\n");
X        fprintf (stderr, "    Environment variable: `%s',\n", "TCLDEFAULT");
X        fprintf (stderr, "    File in current directory: `TCLDEFAULT', or\n");
X        fprintf (stderr, "    File `%s'.\n", defaultFile);
X        exit (1);
X    }
X    if (Tcl_EvalFile (interp, defaultFileToUse) != TCL_OK)
X        goto errorAbort;
X    Tcl_ResetResult (interp);
X
X    initFile = Tcl_GetVar (interp, "TCLINIT", 1);
X    if (initFile != NULL) {
X        if (Tcl_EvalFile (interp, initFile) != TCL_OK)
X            goto errorAbort;
X        }
X    Tcl_ResetResult (interp);
X    return;
X
XerrorAbort:
X    DumpTclError (interp);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_Startup --
X *
X *      Initializes the Tcl extended environment.  This function runs the
X *      TclInit.tcl command file and optionally creates an interactive
X *      command loop. See the user documentation for a complete description
X *      of how this procedure works.
X *
X * Parameters
X *     o interp - A pointer to the interpreter.
X *     o argc, argv - Arguments passed to main.
X *     o defaultFile (I) - The file name of the default file to use, it
X *       normally contains a version number.
X * Returns:
X *   TCL_OK if all is ok, TCL_ERROR if an error occured.
X *----------------------------------------------------------------------
X */
Xvoid
XTcl_Startup (interp, argc, argv, defaultFile)
X    Tcl_Interp  *interp;
X    int          argc;
X    CONST char **argv;
X    CONST char  *defaultFile;
X{
X    int         result;
X    char       *args, *cmdBuf;
X    tclParms_t  tclParms;
X
X    /*
X     * Initialize special commands needed by the shell.
X     */
X    Tcl_CreateCommand (interp, "sourcepart", Tcl_SourcepartCmd,
X                      (ClientData)NULL, (void (*)())NULL);
X
X    /*
X     * Process the arguments.
X     */
X    ParseCmdArgs (argc, (char **) argv, &tclParms);
X
X    /*
X     * Set Tcl variables based on the arguments parsed.
X     */
X    if (Tcl_SetVar (interp, "programName", tclParms.programName,
X                    TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL)
X        goto errorAbort;
X
X
X    if (Tcl_SetVar (interp, "interactiveSession",
X                    (tclParms.execStr == NULL ? "1" : "0"),
X                    TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL)
X        goto errorAbort;
X
X    args = Tcl_Merge (tclParms.tclArgc, tclParms.tclArgv);
X    if (Tcl_SetVar (interp, "argv", args,
X                    TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL)
X        result = TCL_ERROR;
X    else
X        result = TCL_OK;
X    ckfree (args);
X    if (result != TCL_OK)
X        goto errorAbort;
X
X    if (Tcl_SetVar (interp, "scriptName",
X                    tclParms.execFile ? tclParms.execStr : "",
X                    TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL)
X        goto errorAbort;
X
X    /*
X     * Locate the default file and save in Tcl var TCLDEFAULT.
X     */
X    if (FindDefaultFile (interp, (char *) defaultFile) != TCL_OK)
X        goto errorAbort;
X
X    /*
X     * If not quick startup, process the Tcl default file and execute the
X     * Tcl initialization file.
X     */
X    if (!tclParms.quickStartup)
X        ProcessDefaultFile (interp, (char*) defaultFile);
X
X    /*
X     * If the invoked tcl interactively, give the user an interactive session,
X     * otherwise, source the command file or execute the specified command.
X     */
X    if (tclParms.execFile) {
X        result = Tcl_EvalFile (interp, tclParms.execStr);
X        if (result != TCL_OK)
X            goto errorAbort;
X        Tcl_ResetResult (interp);
X    } else if (tclParms.execCommand) {
X        result = Tcl_Eval (interp, tclParms.execStr, 0, NULL);
X        if (result != TCL_OK)
X            goto errorAbort;
X        Tcl_ResetResult (interp);
X    } else
X        Tcl_CommandLoop (interp, stdin, stdout, TRUE);
X    return;
X
XerrorAbort:
X    DumpTclError (interp);
X}
X
END_OF_FILE
if test 15114 -ne `wc -c <'extended/src/tclstartup.c'`; then
    echo shar: \"'extended/src/tclstartup.c'\" unpacked with wrong size!
fi
# end of 'extended/src/tclstartup.c'
fi
if test -f 'extended/tcllib/buildhelp.tcl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'extended/tcllib/buildhelp.tcl'\"
else
echo shar: Extracting \"'extended/tcllib/buildhelp.tcl'\" \(14897 characters\)
sed "s/^X//" >'extended/tcllib/buildhelp.tcl' <<'END_OF_FILE'
X#-----------------------------------------------------------------------------
X#                                buildhelp.tcl
X#-----------------------------------------------------------------------------
X#
X# Program to extract help files from TCL manual pages or TCL script files.
X# The help directories are built as a hierarchical tree of subjects and help
X# files.
X#
X# For nroff man pages, the areas of text to extract are delimited with:
X#
X#     '@help: subjectdir/helpfile
X#     '@endhelp
X#
X# start in column one. The text between these markers is extracted and stored
X# in help/subjectdir/help.  The file must not exists, this is done to enforced
X# cleaning out the directories before help file generation is started, thus
X# removing any stale files.  The extracted text is run through:
X#
X#     nroff -man|col -xb   {col -b on BSD derived systems}
X#
X# If there is other text to include in the helpfile, but not in the manual
X# page, the text, along with nroff formatting commands, may be included using:
X#
X#     '@:Other text to include in the help page.
X#
X# A entry in the brief file, used by apropos my be included by:
X#
X#     '@brief: Short, one line description
X#
X# These brief request must occur with in the bounds of a help section.
X#
X# If some header text, such as nroff macros, need to be preappended to the
X# text streem before it is run through nroff, then that text can be bracketed
X# with:
X#
X#     '@header
X#     '@endheader
X#
X# If multiple header blocks are encountered, they will all be preappended.
X#
X# A similar construct is used for manual page name index generation:
X#
X#      ;@index: subject1 subjectN
X#
X# This is used by `installTcl' to generate the name index files.  There should
X# be one per file, usuall right before the name line.  The subjects listed are
X# all of the procedures or commands to link to the manual page, usually the
X# same as on the .SH NAME line.
X#
X# For TCL script files, which are indentified because they end in ".tcl",
X# the text to be extracted is delimited by:
X#
X#    #@help: subjectdir/helpfile
X#    #@endhelp
X#
X# And brief lines are in the form:
X#
X#     #@brief: Short, one line description
X#
X# The only processing done on text extracted from .tcl files it to replace
X# the # in column one with a space.
X#
X#
X#-----------------------------------------------------------------------------
X#
X# To run this program:
X#
X#   tcl buildhelp.tcl [-m mergeTree] [-i nameindex] helpDir file-1 file-2 ...
X#
X# o -m mergeTree is a tree of help code, plus a brief file to merge with the
X#   help files that are to be extracted.  This will become part of the new
X#   help tree.  Used to merge in the documentation from UCB Tcl.
X# o -i nameindex is an name index file to create from the '@index markers in
X#   the man files.
X# o helpDir is the help tree root directory.  helpDir should  exists, but any
X#   subdirectories that don't exists will be created.  helpDir should be
X#   cleaned up before the start of manual page generation, as this program
X#   will not overwrite existing files.
X# o file-n are the nroff manual pages (.man) or .tcl or .tlib files to extract
X#   the help files from.
X#-----------------------------------------------------------------------------
X
X#-----------------------------------------------------------------------------
X# Truncate a file name of a help file if the system does not support long
X# file names.  If the name starts with `Tcl_', then this prefix is removed.
X# If the name is then over 14 characters, it is truncated to 14 charactes
X#
Xproc TruncFileName {pathName} {
X    global G_truncFileNames
X
X    if {!$G_truncFileNames} {
X        return $pathName}
X    set fileName [file tail $pathName]
X    if {"[crange $fileName 0 3]" == "Tcl_"} {
X        set fileName [crange $fileName 4 end]}
X    set fileName [crange $fileName 0 13]
X    return "[file dirname $pathName]/$fileName"
X}
X
X#-----------------------------------------------------------------------------
X# Proc to ensure that all directories for the specified file path exists,
X# and if they don't create them.
X
Xproc EnsureDirs {filePath} {
X    set dirPath [file dirname $filePath]
X    if {![file exists $dirPath]} {
X        mkdir -path $dirPath}
X}
X
X
X#-----------------------------------------------------------------------------
X#
X# Proc to extract nroff text to use as a header to all pass to nroff when
X# processing a help file.
X#    manPageFH - The file handle of the manual page.
X#
X
Xproc ExtractNroffHeader {manPageFH} {
X    global nroffHeader
X    while {[gets $manPageFH manLine] >= 0} {
X        if {[string first "'@endheader" $manLine] == 0} {
X            break;
X            }
X        if {[string first "'@:" $manLine] == 0} {
X            set manLine [csubstr manLine 3 end]
X            }
X        append nroffHeader "$manLine\n"
X        }
X}
X
X#-----------------------------------------------------------------------------
X#
X# Proc to extract a nroff help file when it is located in the text.
X#    manPageFH - The file handle of the manual page.
X#    manLine - The '@help: line starting the data to extract.
X#
X
Xproc ExtractNroffHelp {manPageFH manLine} {
X    global G_helpDir nroffHeader G_briefHelpFH G_colArgs
X
X    set helpName [string trim [csubstr $manLine 7 end]]
X    set helpFile [TruncFileName "$G_helpDir/$helpName"]
X    if {[file exists $helpFile]} {
X        error "Help file already exists: $helpFile"}
X    EnsureDirs $helpFile
X    set helpFH [open "| nroff -man | col $G_colArgs > $helpFile" w]
X    echo "    creating help file $helpName"
X
X    # Nroff commands from .TH macro to get the formatting right.  The `\n'
X    # are newline separators to output, the `\\n' become `\n' in the text.
X
X    puts $helpFH ".ad b\n.PD\n.nrIN \\n()Mu\n.nr)R 0\n.nr)I \\n()Mu"
X    puts $helpFH ".nr)R 0\n.\}E\n.DT\n.na\n.nh"
X    puts $helpFH $nroffHeader
X    set foundBrief 0
X    while {[gets $manPageFH manLine] >= 0} {
X        if {[string first "'@endhelp" $manLine] == 0} {
X            break;
X        }
X        if {[string first "'@brief:" $manLine] == 0} {
X            if $foundBrief {
X                error {Duplicate "'@brief" entry"}
X            }
X            set foundBrief 1
X        puts $G_briefHelpFH "$helpName\t[csubstr $manLine 8 end]"
X            continue;
X        }
X        if {[string first "'@:" $manLine] == 0} {
X            set manLine [csubstr $manLine 3 end]
X        }
X        if {[string first "'@help" $manLine] == 0} {
X            error {"'@help" found within another help section"}
X        }
X        puts $helpFH $manLine
X        }
X    close $helpFH
X    chmod a-w,a+r $helpFile
X}
X
X#-----------------------------------------------------------------------------
X#
X# Proc to extract a tcl script help file when it is located in the text.
X#    ScriptPageFH - The file handle of the .tcl file.
X#    ScriptLine - The #@help: line starting the data to extract.
X#
X
Xproc ExtractScriptHelp {ScriptPageFH ScriptLine} {
X    global G_helpDir G_briefHelpFH
X    set helpName [string trim [csubstr $ScriptLine 7 end]]
X    set helpFile "$G_helpDir/$helpName"
X    if {[file exists $helpFile]} {
X        error "Help file already exists: $helpFile"}
X    EnsureDirs $helpFile
X    set helpFH [open $helpFile w]
X    echo "    creating help file $helpName"
X    set foundBrief 0
X    while {[gets $ScriptPageFH ScriptLine] >= 0} {
X        if {[string first "#@endhelp" $ScriptLine] == 0} {
X            break;
X        }
X        if {[string first "#@brief:" $ScriptLine] == 0} {
X            if $foundBrief {
X                error {Duplicate "#@brief" entry"}
X            }
X            set foundBrief 1
X        puts $G_briefHelpFH "$helpName\t[csubstr $ScriptLine 8 end]"
X            continue;
X        }
X        if {[string first "#@help" $ScriptLine] == 0} {
X            error {"#@help" found within another help section"}
X        }
X        if {[clength $ScriptLine] > 1} {
X            set ScriptLine " [csubstr $ScriptLine 1 end]"
X        } else {
X            set ScriptLine ""
X        }
X        puts $helpFH $ScriptLine
X        }
X    close $helpFH
X    chmod a-w,a+r $helpFile
X}
X
X#-----------------------------------------------------------------------------
X#
X# Proc to scan a nroff manual file looking for the start of a help text
X# sections and extracting those sections.
X#    pathName - Full path name of file to extract documentation from.
X#
X
Xproc ProcessNroffFile {pathName} {
X   global G_nroffScanCT G_scriptScanCT nroffHeader
X
X   set fileName [file tail $pathName]
X
X   set nroffHeader {}
X   set manPageFH [open $pathName r]
X   echo "    scanning $pathName"
X   set matchInfo(fileName) [file tail $pathName]
X   scanfile $G_nroffScanCT $manPageFH
X   close $manPageFH
X}
X
X#-----------------------------------------------------------------------------
X#
X# Proc to scan a Tcl script file looking for the start of a
X# help text sections and extracting those sections.
X#    pathName - Full path name of file to extract documentation from.
X#
X
Xproc ProcessTclScript {pathName} {
X   global G_scriptScanCT nroffHeader
X
X   set scriptFH [open "$pathName" r]
X
X   echo "    scanning $pathName"
X   set matchInfo(fileName) [file tail $pathName]
X   scanfile $G_scriptScanCT $scriptFH
X   close $scriptFH
X}
X
X#-----------------------------------------------------------------------------
X# Proc to copy the help merge tree, excluding the brief file.
X#
X
Xproc CopyMergeTree {helpDirPath mergeTree} {
X    if {"[cindex $helpDirPath 0]" != "/"} {
X        set helpDirPath "[pwd]/$helpDirPath"
X    }
X    set oldDir [pwd]
X    cd $mergeTree
X
X    set curHelpDir "."
X
X    for_recursive_glob mergeFile {.} {
X        if {"$mergeFile" == "./brief"} {
X            continue}
X            set helpFile "$helpDirPath/$mergeFile"
X        if {[file isdirectory $mergeFile]} {
X            if ![file exists $helpFile] {
X                mkdir $helpFile
X                chmod go-w,a+rx $helpFile
X            }
X        } else {
X            if {[file exists $helpFile]} {
X                error "Help file already exists: $helpFile"}
X            set inFH [open $mergeFile r]
X            set outFH [open $helpFile w]
X            copyfile $inFH $outFH
X            close $outFH
X            close $inFH
X            chmod a-w,a+r $helpFile
X        }
X    }
X    cd $oldDir
X}
X
X#-----------------------------------------------------------------------------
X# GenerateHelp: main procedure.  Generates help from specified files.
X#    helpDirPath - Directory were the help files go.
X#    mergeTree - Help file tree to merge with the extracted help files.
X#    manIndexFile - Manual page index file to build, or {} to not build one.
X#    sourceFiles - List of files to extract help files from.
X
Xproc GenerateHelp {helpDirPath mergeTree manIndexFile sourceFiles} {
X    global G_helpDir G_truncFileNames G_manIndexFH G_nroffScanCT
X    global G_scriptScanCT G_briefHelpFH G_colArgs
X
X    echo ""
X    echo "Begin building help tree"
X
X    # Determine version of col command to use (no -x on BSD)
X    if {[system {col -bx </dev/null >/dev/null 2>&1}] != 0} {
X        set G_colArgs {-b}
X    } else {
X        set G_colArgs {-bx}
X    }
X    set G_helpDir [glob $helpDirPath]
X
X    if {![file isdirectory $G_helpDir]} {
X        error [concat "$G_helpDir is not a directory or does not exist. "
X                      "This should be the help root directory"]
X    }
X
X    set status [catch {set tmpFH [open xxx $G_helpDir/AVeryVeryBigFileName w]}]
X    if {$status != 0} {
X        set G_truncFileNames 1
X    } else {
X        close $tmpFH
X        unlink $G_helpDir/AVeryVeryBigFileName
X        set G_truncFileNames 0
X    }
X
X    set G_manIndexFH {}
X    if {![lempty $manIndexFile]} {
X        set G_manIndexFH [open $manIndexFile w]
X    }
X
X    set G_nroffScanCT [scancontext create]
X
X    scanmatch $G_nroffScanCT "^'@help:" {
X        ExtractNroffHelp $matchInfo(handle) $matchInfo(line)
X        continue
X    }
X
X    scanmatch $G_nroffScanCT "^'@header" {
X        ExtractNroffHeader $matchInfo(handle)
X        continue
X    }
X    scanmatch $G_nroffScanCT "^'@endhelp" {
X        error [concat {"'@endhelp" without corresponding "'@help:"} \
X                 ", offset = $matchInfo(offset)"]
X    }
X    scanmatch $G_nroffScanCT "^'@brief" {
X        error [concat {"'@brief" without corresponding "'@help:"}
X                 ", offset = $matchInfo(offset)"]
X    }
X
X    scanmatch $G_nroffScanCT "^'@index:" {
X        global G_manIndexFH
X        if {[llength $matchInfo(line)] == 1} {
X            error "no subjects specified in \"'@index:\" line"}
X        if {![lempty $G_manIndexFH]} {
X            puts $G_manIndexFH [concat $matchInfo(fileName) \
X                                       [list [lrange $matchInfo(line) 1 end]]]
X        }
X    }
X
X    set G_scriptScanCT [scancontext create]
X    scanmatch $G_scriptScanCT "^#@help:" {
X        ExtractScriptHelp $matchInfo(handle) $matchInfo(line)
X    }
X
X    if ![lempty $mergeTree] {
X        echo "    Merging tree: $mergeTree"
X        CopyMergeTree $helpDirPath $mergeTree
X    }
X
X    set G_briefHelpFH [open "|sort > $G_helpDir/brief" w]
X
X    if {(![lempty $mergeTree]) && [file exists $mergeTree/brief]} {
X        echo "    Merging file: $mergeTree/brief"
X        set mergeBriefFH [open $mergeTree/brief r]
X        puts $G_briefHelpFH [read $mergeBriefFH]
X        close $mergeBriefFH
X    }
X    foreach manFile $sourceFiles {
X        set manFile [glob $manFile]
X        set ext [file extension $manFile]
X        if {"$ext" == ".man"} {
X            set status [catch {ProcessNroffFile $manFile} msg]
X        } else {
X            set status [catch {ProcessTclScript $manFile} msg]
X        }
X        if {$status != 0} {
X            echo "Error extracting help from: $manFile"
X            echo $msg
X            global errorInfo interactiveSession
X            if {!$interactiveSession} {
X                echo $errorInfo
X                exit 1
X            }
X        }
X    }
X
X    close $G_briefHelpFH
X    chmod a-w,a+r $G_helpDir/brief
X    close $G_manIndexFH
X    echo "*** completed extraction of all help files"
X}
X
X#-----------------------------------------------------------------------------
X# Print a usage message and exit the program
Xproc Usage {} {
X    echo {Wrong args: [-m mergetree] [-i index] helpdir manfile1 [manfile2..]}
X    exit 1
X}
X
X#-----------------------------------------------------------------------------
X# Main program body, decides if help is interactive or batch.
X
Xif {$interactiveSession} {
X    echo "To extract help, use the command:"
X    echo "  GenerateHelp helpDirPath [mergetree|{}] [namefile|{}] sourceFiles"
X} else {
X    set mergeTree {}
X    set manIndexFile {}
X    while {[string match "-*" [lindex $argv 0]]} {
X        set flag [lvarpop argv 0]
X        case $flag in {
X            "-m" {set mergeTree [lvarpop argv 0]}
X            "-i" {set manIndexFile [lvarpop argv 0]}
X            default Usage
X        }
X    }
X    if {[llength $argv] < 2} {
X        Usage
X    }
X    GenerateHelp [lindex $argv 0] $mergeTree $manIndexFile [lrange $argv 1 end]
X
X}
END_OF_FILE
if test 14897 -ne `wc -c <'extended/tcllib/buildhelp.tcl'`; then
    echo shar: \"'extended/tcllib/buildhelp.tcl'\" unpacked with wrong size!
fi
# end of 'extended/tcllib/buildhelp.tcl'
fi
echo shar: End of archive 16 \(of 23\).
cp /dev/null ark16isdone
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].