home *** CD-ROM | disk | FTP | other *** search
Text File | 1991-11-14 | 44.9 KB | 1,379 lines |
- Newsgroups: comp.sources.misc
- From: karl@sugar.neosoft.com (Karl Lehenbauer)
- Subject: v25i079: tcl - tool command language, version 6.1, Part11/33
- Message-ID: <1991Nov14.202950.23876@sparky.imd.sterling.com>
- X-Md4-Signature: 6b5ec35237573b6980eb30503405c2bf
- Date: Thu, 14 Nov 1991 20:29:50 GMT
- Approved: kent@sparky.imd.sterling.com
-
- Submitted-by: karl@sugar.neosoft.com (Karl Lehenbauer)
- Posting-number: Volume 25, Issue 79
- Archive-name: tcl/part11
- 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 11 (of 33)."
- # Contents: tcl6.1/changes tcl6.1/tclGlob.c tcl6.1/tests/history.test
- # Wrapped by karl@one on Tue Nov 12 19:44:20 1991
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f 'tcl6.1/changes' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/changes'\"
- else
- echo shar: Extracting \"'tcl6.1/changes'\" \(14472 characters\)
- sed "s/^X//" >'tcl6.1/changes' <<'END_OF_FILE'
- XRecent user-visible changes to Tcl:
- X
- X1. No more [command1] [command2] construct for grouping multiple
- Xcommands on a single command line.
- X
- X2. Semi-colon now available for grouping commands on a line.
- X
- X3. For a command to span multiple lines, must now use backslash-return
- Xat the end of each line but the last.
- X
- X4. "Var" command has been changed to "set".
- X
- X5. Double-quotes now available as an argument grouping character.
- X
- X6. "Return" may be used at top-level.
- X
- X7. More backslash sequences available now. In particular, backslash-newline
- Xmay be used to join lines in command files.
- X
- X8. New or modified built-in commands: case, return, for, glob, info,
- Xprint, return, set, source, string, uplevel.
- X
- X9. After an error, the variable "errorInfo" is filled with a stack
- Xtrace showing what was being executed when the error occurred.
- X
- X10. Command abbreviations are accepted when parsing commands, but
- Xare not recommended except for purely-interactive commands.
- X
- X11. $, set, and expr all complain now if a non-existent variable is
- Xreferenced.
- X
- X12. History facilities exist now. See Tcl.man and Tcl_RecordAndEval.man.
- X
- X13. Changed to distinguish between empty variables and those that don't
- Xexist at all. Interfaces to Tcl_GetVar and Tcl_ParseVar have changed
- X(NULL return value is now possible). *** POTENTIAL INCOMPATIBILITY ***
- X
- X14. Changed meaning of "level" argument to "uplevel" command (1 now means
- X"go up one level", not "go to level 1"; "#1" means "go to level 1").
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X15. 3/19/90 Added "info exists" option to see if variable exists.
- X
- X16. 3/19/90 Added "noAbbrev" variable to prohibit command abbreviations.
- X
- X17. 3/19/90 Added extra errorInfo option to "error" command.
- X
- X18. 3/21/90 Double-quotes now only affect space: command, variable,
- Xand backslash substitutions still occur inside double-quotes.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X19. 3/21/90 Added support for \r.
- X
- X20. 3/21/90 List, concat, eval, and glob commands all expect at least
- Xone argument now. *** POTENTIAL INCOMPATIBILITY ***
- X
- X21. 3/22/90 Added "?:" operators to expressions.
- X
- X22. 3/25/90 Fixed bug in Tcl_Result that caused memory to get trashed.
- X
- X------------------- Released version 3.1 ---------------------
- X
- X23. 3/29/90 Fixed bug that caused "file a.b/c ext" to return ".b/c".
- X
- X24. 3/29/90 Semi-colon is not treated specially when enclosed in
- Xdouble-quotes.
- X
- X------------------- Released version 3.2 ---------------------
- X
- X25. 4/16/90 Rewrote "exec" not to use select or signals anymore.
- XShould be more Sys-V compatible, and no slower in the normal case.
- X
- X26. 4/18/90 Rewrote "glob" to eliminate GNU code (there's no GNU code
- Xleft in Tcl, now), and added Tcl_TildeSubst procedure. Added automatic
- Xtilde-substitution in many commands, including "glob".
- X
- X------------------- Released version 3.3 ---------------------
- X
- X27. 7/11/90 Added "Tcl_AppendResult" procedure.
- X
- X28. 7/20/90 "History" with no options now defaults to "history info"
- Xrather than to "history redo". Although this is a backward incompatibility,
- Xit should only be used interactively and thus shouldn't present any
- Xcompatibility problems with scripts.
- X
- X29. 7/20/90 Added "Tcl_GetInteger", "Tcl_GetDouble", and "Tcl_GetBoolean"
- Xprocedures.
- X
- X30. 7/22/90 Removed "Tcl_WatchInterp" procedure: doesn't seem to be
- Xnecessary, since the same effect can be achieved with the deletion
- Xcallbacks on individual commands. *** POTENTIAL INCOMPATIBILITY ***
- X
- X31. 7/23/90 Added variable tracing: Tcl_TraceVar, Tcl_UnTraceVar,
- Xand Tcl_VarTraceInfo procedures, "trace" command.
- X
- X32. 8/9/90 Mailed out list of all bug fixes since 3.3 release.
- X
- X33. 8/29/90 Fixed bugs in Tcl_Merge relating to backslashes and
- Xsemi-colons. Mailed out patch.
- X
- X34. 9/3/90 Fixed bug in tclBasic.c: quotes weren't quoting ]'s.
- XMailed out patch.
- X
- X35. 9/19/90 Rewrote exec to always use files both for input and
- Xoutput to the process. The old pipe-based version didn't work if
- Xthe exec'ed process forked a child and then exited: Tcl waited
- Xaround for stdout to get closed, which didn't happen until the
- Xgrandchild exited.
- X
- X36. 11/5/90 ERR_IN_PROGRESS flag wasn't being cleared soon enough
- Xin Tcl_Eval, allowing error messages from different commands to
- Xpile up in $errorInfo. Fixed by re-arranging code in Tcl_Eval that
- Xre-initializes result and ERR_IN_PROGRESS flag. Didn't mail out
- Xpatch: changes too complicated to describe.
- X
- X37. 12/19/90 Added Tcl_VarEval procedure as a convenience for
- Xassembling and executing Tcl commands.
- X
- X38. 1/29/91 Fixed core leak in Tcl_AddErrorInfo. Also changed procedure
- Xand Tcl_Eval so that first call to Tcl_AddErrorInfo need not come from
- XTcl_Eval.
- X
- X----------------- Released version 5.0 with Tk ------------------
- X
- X39. 4/3/91 Removed change bars from manual entries, leaving only those
- Xthat came after version 3.3 was released.
- X
- X40. 5/17/91 Changed tests to conform to Mary Ann May-Pumphrey's approach.
- X
- X41. 5/23/91 Massive revision to Tcl parser to simplify the implementation
- Xof string and floating-point support in expressions. Newlines inside
- X[] are now treated as command separators rather than word separators
- X(this makes newline treatment consistent throughout Tcl).
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X42. 5/23/91 Massive rewrite of expression code to support floating-point
- Xvalues and simple string comparisons. The C interfaces to expression
- Xroutines have changed (Tcl_Expr is replaced by Tcl_ExprLong, Tcl_ExprDouble,
- Xetc.), but all old Tcl expression strings should be accepted by the new
- Xexpression code.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X43. 5/23/91 Modified tclHistory.c to check for negative "keep" value.
- X
- X44. 5/23/91 Modified Tcl_Backslash to handle backslash-newline. It now
- Xreturns 0 to indicate that a backslash sequence should be replaced by
- Xno character at all.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X45. 5/29/91 Modified to use ANSI C function prototypes. Must set
- X"USE_ANSI" switch when compiling to get prototypes.
- X
- X46. 5/29/91 Completed test suite by providing tests for all of the
- Xbuilt-in Tcl commands.
- X
- X47. 5/29/91 Changed Tcl_Concat to eliminate leading and trailing
- Xwhite-space in each of the things it concatenates and to ignore
- Xelements that are empty or have only white space in them. This
- Xproduces cleaner output from the "concat" command.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X48. 5/31/91 Changed "set" command and Tcl_SetVar procedure to return
- Xnew value of variable.
- X
- X49. 6/1/91 Added "while" and "cd" commands.
- X
- X50. 6/1/91 Changed "exec" to delete the last character of program
- Xoutput if it is a newline. In most cases this makes it easier to
- Xprocess program-generated output.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X51. 6/1/91 Made sure that pointers are never used after freeing them.
- X
- X52. 6/1/91 Fixed bug in TclWordEnd where it wasn't dealing with
- X[] inside quotes correctly.
- X
- X53. 6/8/91 Fixed exec.test to accept return values of either 1 or
- X255 from "false" command.
- X
- X54. 7/6/91 Massive overhaul of variable management. Associative
- Xarrays now available, along with "unset" command (and Tcl_UnsetVar
- Xprocedure). Variable traces have been completely reworked:
- Xinterfaces different both from Tcl and C, and multiple traces may
- Xexist on same variable. Can no longer redefine existing local
- Xvariable to be global. Calling sequences have changed slightly
- Xfor Tcl_GetVar and Tcl_SetVar ("global" is now "flags"). Tcl_SetVar
- Xcan fail and return a NULL result. New forms of variable-manipulation
- Xprocedures: Tcl_GetVar2, Tcl_SetVar2, etc. Syntax of variable
- X$-notation changed to support array indexing.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X55. 7/6/91 Added new list-manipulation procedures: Tcl_ScanElement,
- XTcl_ConvertElement, Tcl_AppendElement.
- X
- X56. 7/12/91 Created new procedure Tcl_EvalFile, which does most of the
- Xwork of the "source" command.
- X
- X57. 7/20/91 Major reworking of "exec" command to allow pipelines,
- Xmore redirection, background. Added new procedures Tcl_Fork,
- XTcl_WaitPids, Tcl_DetachPids, and Tcl_CreatePipeline. The old
- X"< input" notation has been replaced by "<< input" ("<" is for
- Xredirection from a file). Also handles error returns and abnormal
- Xterminations (e.g. signals) differently.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X58. 7/21/91 Added "append" and "lappend" commands.
- X
- X59. 7/22/91 Reworked error messages and manual entries to use
- X?x? as the notation for an optional argument x, instead of [x]. The
- Xbracket notation was often confused with the use of brackets for
- Xcommand substitution. Also modified error messages to be more
- Xconsistent.
- X
- X60. 7/23/91 Tcl_DeleteCommand now returns an indication of whether
- Xor not the command actually existed, and the "rename" command uses
- Xthis information to return an error if an attempt is made to delete
- Xa non-existent command.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X61. 7/25/91 Added new "errorCode" mechanism, along with procedures
- XTcl_SetErrorCode, Tcl_UnixError, and Tcl_ResetResult. Renamed
- XTcl_Return to Tcl_SetResult, but left a #define for Tcl_Return to
- Xavoid compatibility problems.
- X
- X62. 7/26/91 Extended "case" command with alternate syntax where all
- Xpatterns and commands are together in a single list argument: makes
- Xit easier to write multi-line case statements.
- X
- X63. 7/27/91 Changed "print" command to perform tilde-substitution on
- Xthe file name.
- X
- X64. 7/27/91 Added "tolower", "toupper", "trim", "trimleft", and "trimright"
- Xoptions to "string" command.
- X
- X65. 7/29/91 Added "atime", "mtime", "size", and "stat" options to "file"
- Xcommand.
- X
- X66. 8/1/91 Added "split" and "join" commands.
- X
- X67. 8/11/91 Added commands for file I/O, including "open", "close",
- X"read", "gets", "puts", "flush", "eof", "seek", and "tell".
- X
- X68. 8/14/91 Switched to use a hash table for command lookups. Command
- Xabbreviations no longer have direct support in the Tcl interpreter, but
- Xit should be possible to simulate them with the auto-load features
- Xdescribed below. The "noAbbrev" variable is no longer used by Tcl.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X68.5 8/15/91 Added support for "unknown" command, which can be used to
- Xcomplete abbreviations, auto-load library files, auto-exec shell
- Xcommands, etc.
- X
- X69. 8/15/91 Added -nocomplain switch to "glob" command.
- X
- X70. 8/20/91 Added "info library" option and TCL_LIBRARY #define. Also
- Xadded "info script" option.
- X
- X71. 8/20/91 Changed "file" command to take "option" argument as first
- Xargument (before file name), for consistency with other Tcl commands.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X72. 8/20/91 Changed format of information in $errorInfo variable:
- Xcomments such as
- X ("while" body line 1)
- Xare now on separate lines from commands being executed.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X73. 8/20/91 Changed Tcl_AppendResult so that it (eventually) frees
- Xlarge buffers that it allocates.
- X
- X74. 8/21/91 Added "linsert", "lreplace", "lsearch", and "lsort"
- Xcommands.
- X
- X75. 8/28/91 Added "incr" and "exit" commands.
- X
- X76. 8/30/91 Added "regexp" and "regsub" commands.
- X
- X77. 9/4/91 Changed "dynamic" field in interpreters to "freeProc" (procedure
- Xaddress). This allows for alternative storage managers.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X78. 9/6/91 Added "index", "length", and "range" options to "string"
- Xcommand. Added "lindex", "llength", and "lrange" commands.
- X
- X79. 9/8/91 Removed "index", "length", "print" and "range" commands.
- X"Print" is redundant with "puts", but less general, and the other
- Xcommands are replaced with the new commands described in change 78
- Xabove.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X80. 9/8/91 Changed history revision to occur even when history command
- Xis nested; needed in order to allow "history" to be invoked from
- X"unknown" procedure.
- X
- X81. 9/13/91 Changed "panic" not to use vfprintf (it's uglier and less
- Xgeneral now, but makes it easier to run Tcl on systems that don't
- Xhave vfprintf). Also changed "strerror" not to reclare sys_errlist.
- X
- X82. 9/19/91 Lots of changes to improve portability to different UNIX
- Xsystems, including addition of "config" script to adapt Tcl to the
- Xconfiguration of the system it's being compiled on.
- X
- X83. 9/22/91 Added "pwd" command.
- X
- X84. 9/22/91 Renamed manual pages so that their filenames are no more
- Xthan 14 characters in length, moved to "doc" subdirectory.
- X
- X85. 9/24/91 Redid manual entries so they contain the supplemental
- Xmacros that they need; can just print with "troff -man" or "man"
- Xnow.
- X
- X86. 9/26/91 Created initial version of script library, including
- Xa version of "unknown" that does auto-loading, auto-execution, and
- Xabbreviation expansion. This library is used by tclTest
- Xautomatically. See the "library" manual entry for details.
- X
- X----------------- Released version 6.0, 9/26/91 ------------------
- X
- X87. 9/30/91 Made "string tolower" and "string toupper" check case
- Xbefore converting: on some systems, "tolower" and "toupper" assume
- Xthat character already has particular case.
- X
- X88. 9/30/91 Fixed bug in Tcl_SetResult: wasn't always setting freeProc
- Xcorrecly when called with NULL value. This tended to cause memory
- Xallocation errors later.
- X
- X89. 10/3/91 Added "upvar" command.
- X
- X90. 10/4/91 Changed "format" so that internally it converts %D to %ld,
- X%U to %lu, %O to %lo, and %F to %f. This eliminates some compatibility
- Xproblems on some machines without affecting behavior.
- X
- X91. 10/10/91 Fixed bug in "regsub" that caused core dumps with the -all
- Xoption when the last match wasn't at the end of the string.
- X
- X92. 10/17/91 Fixed problems with backslash sequences: \r support was
- Xincomplete and \f and \v weren't supported at all.
- X
- X93. 10/24/91 Added Tcl_InitHistory procedure.
- X
- X94. 10/24/91 Changed "regexp" to store "-1 -1" in subMatchVars that
- Xdon't match, rather than returning an error.
- X
- X95. 10/27/91 Modified "regexp" to return actual strings in matchVar
- Xand subMatchVars instead of indices. Added "-indices" switch to cause
- Xindices to be returned.
- X*** POTENTIAL INCOMPATIBILITY ***
- X
- X96. 10/27/91 Fixed bug in "scan" where it used hardwired constants for
- Xsizes of floats and doubles instead of using "sizeof".
- X
- X97. 10/31/91 Fixed bug in tclParse.c where parse-related error messages
- Xweren't being storage-managed correctly, causing spurious free's.
- X
- X98. 10/31/91 Form feed and vertical tab characters are now considered
- Xto be space characters by the parser.
- X
- X99. 10/31/91 Added TCL_LEAVE_ERR_MSG flag to procedures like Tcl_SetVar.
- X
- X100. 11/7/91 Fixed bug in "case" where "in" argument couldn't be ommitted
- Xif all case branches were embedded in a single list.
- X
- X101. 11/7/91 Switched to use "pid_t" and "uid_t" and other official
- XPOSIC types and function prototypes.
- END_OF_FILE
- if test 14472 -ne `wc -c <'tcl6.1/changes'`; then
- echo shar: \"'tcl6.1/changes'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/changes'
- fi
- if test -f 'tcl6.1/tclGlob.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tclGlob.c'\"
- else
- echo shar: Extracting \"'tcl6.1/tclGlob.c'\" \(14435 characters\)
- sed "s/^X//" >'tcl6.1/tclGlob.c' <<'END_OF_FILE'
- X/*
- X * tclGlob.c --
- X *
- X * This file provides procedures and commands for file name
- X * manipulation, such as tilde expansion and globbing.
- X *
- X * Copyright 1990-1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that the above copyright
- X * notice appear in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X */
- X
- X#ifndef lint
- Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclGlob.c,v 1.21 91/09/23 11:20:00 ouster Exp $ SPRITE (Berkeley)";
- X#endif /* not lint */
- X
- X#include "tclInt.h"
- X#include "tclUnix.h"
- X
- X/*
- X * The structure below is used to keep track of a globbing result
- X * being built up (i.e. a partial list of file names). The list
- X * grows dynamically to be as big as needed.
- X */
- X
- Xtypedef struct {
- X char *result; /* Pointer to result area. */
- X int totalSpace; /* Total number of characters allocated
- X * for result. */
- X int spaceUsed; /* Number of characters currently in use
- X * to hold the partial result (not including
- X * the terminating NULL). */
- X int dynamic; /* 0 means result is static space, 1 means
- X * it's dynamic. */
- X} GlobResult;
- X
- X/*
- X * Declarations for procedures local to this file:
- X */
- X
- Xstatic void AppendResult _ANSI_ARGS_((Tcl_Interp *interp,
- X char *dir, char *name, int nameLength));
- Xstatic int DoGlob _ANSI_ARGS_((Tcl_Interp *interp, char *dir,
- X char *rem));
- X
- X/*
- X *----------------------------------------------------------------------
- X *
- X * AppendResult --
- X *
- X * Given two parts of a file name (directory and element within
- X * directory), concatenate the two together and append them to
- X * the result building up in interp.
- X *
- X * Results:
- X * There is no return value.
- X *
- X * Side effects:
- X * Interp->result gets extended.
- X *
- X *----------------------------------------------------------------------
- X */
- X
- Xstatic void
- XAppendResult(interp, dir, name, nameLength)
- X Tcl_Interp *interp; /* Interpreter whose result should be
- X * appended to. */
- X char *dir; /* Name of directory, with trailing
- X * slash (unless the whole string is
- X * empty). */
- X char *name; /* Name of file withing directory (NOT
- X * necessarily null-terminated!). */
- X int nameLength; /* Number of characters in name. */
- X{
- X int dirLength, dirFlags, nameFlags;
- X char *p, saved;
- X
- X /*
- X * Next, see if we can put together a valid list element from dir
- X * and name by calling Tcl_AppendResult.
- X */
- X
- X if (*dir == 0) {
- X dirFlags = 0;
- X } else {
- X Tcl_ScanElement(dir, &dirFlags);
- X }
- X saved = name[nameLength];
- X name[nameLength] = 0;
- X Tcl_ScanElement(name, &nameFlags);
- X if ((dirFlags == 0) && (nameFlags == 0)) {
- X if (*interp->result != 0) {
- X Tcl_AppendResult(interp, " ", dir, name, (char *) NULL);
- X } else {
- X Tcl_AppendResult(interp, dir, name, (char *) NULL);
- X }
- X name[nameLength] = saved;
- X return;
- X }
- X
- X /*
- X * This name has weird characters in it, so we have to convert it to
- X * a list element. To do that, we have to merge the characters
- X * into a single name. To do that, malloc a buffer to hold everything.
- X */
- X
- X dirLength = strlen(dir);
- X p = (char *) ckalloc((unsigned) (dirLength + nameLength + 1));
- X strcpy(p, dir);
- X strcpy(p+dirLength, name);
- X name[nameLength] = saved;
- X Tcl_AppendElement(interp, p, 0);
- X ckfree(p);
- X}
- X
- X/*
- X *----------------------------------------------------------------------
- X *
- X * DoGlob --
- X *
- X * This recursive procedure forms the heart of the globbing
- X * code. It performs a depth-first traversal of the tree
- X * given by the path name to be globbed.
- X *
- X * Results:
- X * The return value is a standard Tcl result indicating whether
- X * an error occurred in globbing. After a normal return the
- X * result in interp will be set to hold all of the file names
- X * given by the dir and rem arguments. After an error the
- X * result in interp will hold an error message.
- X *
- X * Side effects:
- X * None.
- X *
- X *----------------------------------------------------------------------
- X */
- X
- Xstatic int
- XDoGlob(interp, dir, rem)
- X Tcl_Interp *interp; /* Interpreter to use for error
- X * reporting (e.g. unmatched brace). */
- X char *dir; /* Name of a directory at which to
- X * start glob expansion. This name
- X * is fixed: it doesn't contain any
- X * globbing chars. If it's non-empty
- X * then it should end with a slash. */
- X char *rem; /* Path to glob-expand. */
- X{
- X /*
- X * When this procedure is entered, the name to be globbed may
- X * already have been partly expanded by ancestor invocations of
- X * DoGlob. The part that's already been expanded is in "dir"
- X * (this may initially be empty), and the part still to expand
- X * is in "rem". This procedure expands "rem" one level, making
- X * recursive calls to itself if there's still more stuff left
- X * in the remainder.
- X */
- X
- X register char *p;
- X register char c;
- X char *openBrace, *closeBrace;
- X int gotSpecial, result;
- X
- X /*
- X * When generating information for the next lower call,
- X * use static areas if the name is short, and malloc if the name
- X * is longer.
- X */
- X
- X#define STATIC_SIZE 200
- X
- X /*
- X * First, find the end of the next element in rem, checking
- X * along the way for special globbing characters.
- X */
- X
- X gotSpecial = 0;
- X openBrace = closeBrace = NULL;
- X for (p = rem; ; p++) {
- X c = *p;
- X if ((c == '\0') || (c == '/')) {
- X break;
- X }
- X if ((c == '{') && (openBrace == NULL)) {
- X openBrace = p;
- X }
- X if ((c == '}') && (closeBrace == NULL)) {
- X closeBrace = p;
- X }
- X if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) {
- X gotSpecial = 1;
- X }
- X }
- X
- X /*
- X * If there is an open brace in the argument, then make a recursive
- X * call for each element between the braces. In this case, the
- X * recursive call to DoGlob uses the same "dir" that we got.
- X * If there are several brace-pairs in a single name, we just handle
- X * one here, and the others will be handled in recursive calls.
- X */
- X
- X if (openBrace != NULL) {
- X int remLength, l1, l2;
- X char static1[STATIC_SIZE];
- X char *element, *newRem;
- X
- X if (closeBrace == NULL) {
- X Tcl_ResetResult(interp);
- X interp->result = "unmatched open-brace in file name";
- X return TCL_ERROR;
- X }
- X remLength = strlen(rem) + 1;
- X if (remLength <= STATIC_SIZE) {
- X newRem = static1;
- X } else {
- X newRem = (char *) ckalloc((unsigned) remLength);
- X }
- X l1 = openBrace-rem;
- X strncpy(newRem, rem, l1);
- X p = openBrace;
- X for (p = openBrace; *p != '}'; ) {
- X element = p+1;
- X for (p = element; ((*p != '}') && (*p != ',')); p++) {
- X /* Empty loop body: just find end of this element. */
- X }
- X l2 = p - element;
- X strncpy(newRem+l1, element, l2);
- X strcpy(newRem+l1+l2, closeBrace+1);
- X if (DoGlob(interp, dir, newRem) != TCL_OK) {
- X return TCL_ERROR;
- X }
- X }
- X if (remLength > STATIC_SIZE) {
- X ckfree(newRem);
- X }
- X return TCL_OK;
- X }
- X
- X /*
- X * If there were any pattern-matching characters, then scan through
- X * the directory to find all the matching names.
- X */
- X
- X if (gotSpecial) {
- X DIR *d;
- X struct dirent *entryPtr;
- X int l1, l2;
- X char *pattern, *newDir, *dirName;
- X char static1[STATIC_SIZE], static2[STATIC_SIZE];
- X struct stat statBuf;
- X
- X /*
- X * Be careful not to do any actual file system operations on a
- X * directory named ""; instead, use ".". This is needed because
- X * some versions of UNIX don't treat "" like "." automatically.
- X */
- X
- X if (*dir == '\0') {
- X dirName = ".";
- X } else {
- X dirName = dir;
- X }
- X if ((stat(dirName, &statBuf) != 0)
- X || ((statBuf.st_mode & S_IFMT) != S_IFDIR)) {
- X return TCL_OK;
- X }
- X d = opendir(dirName);
- X if (d == NULL) {
- X Tcl_ResetResult(interp);
- X Tcl_AppendResult(interp, "couldn't read directory \"",
- X dirName, "\": ", Tcl_UnixError(interp), (char *) NULL);
- X return TCL_ERROR;
- X }
- X l1 = strlen(dir);
- X l2 = (p - rem);
- X if (l2 < STATIC_SIZE) {
- X pattern = static2;
- X } else {
- X pattern = (char *) ckalloc((unsigned) (l2+1));
- X }
- X strncpy(pattern, rem, l2);
- X pattern[l2] = '\0';
- X result = TCL_OK;
- X while (1) {
- X entryPtr = readdir(d);
- X if (entryPtr == NULL) {
- X break;
- X }
- X
- X /*
- X * Don't match names starting with "." unless the "." is
- X * present in the pattern.
- X */
- X
- X if ((*entryPtr->d_name == '.') && (*pattern != '.')) {
- X continue;
- X }
- X if (Tcl_StringMatch(entryPtr->d_name, pattern)) {
- X int nameLength = strlen(entryPtr->d_name);
- X
- X if (*p == 0) {
- X AppendResult(interp, dir, entryPtr->d_name, nameLength);
- X } else {
- X if ((l1+nameLength+2) <= STATIC_SIZE) {
- X newDir = static1;
- X } else {
- X newDir = (char *) ckalloc((unsigned) (l1+nameLength+2));
- X }
- X sprintf(newDir, "%s%s/", dir, entryPtr->d_name);
- X result = DoGlob(interp, newDir, p+1);
- X if (newDir != static1) {
- X ckfree(newDir);
- X }
- X if (result != TCL_OK) {
- X break;
- X }
- X }
- X }
- X }
- X closedir(d);
- X if (pattern != static2) {
- X ckfree(pattern);
- X }
- X return result;
- X }
- X
- X /*
- X * This is the simplest case: just another path element. Move
- X * it to the dir side and recurse (or just add the name to the
- X * list, if we're at the end of the path).
- X */
- X
- X if (*p == 0) {
- X AppendResult(interp, dir, rem, p-rem);
- X } else {
- X int l1, l2;
- X char *newDir;
- X char static1[STATIC_SIZE];
- X
- X l1 = strlen(dir);
- X l2 = l1 + (p - rem) + 2;
- X if (l2 <= STATIC_SIZE) {
- X newDir = static1;
- X } else {
- X newDir = (char *) ckalloc((unsigned) l2);
- X }
- X strcpy(newDir, dir);
- X strncpy(newDir+l1, rem, p-rem);
- X newDir[l2-2] = '/';
- X newDir[l2-1] = 0;
- X result = DoGlob(interp, newDir, p+1);
- X if (newDir != static1) {
- X ckfree(newDir);
- X }
- X if (result != TCL_OK) {
- X return TCL_ERROR;
- X }
- X }
- X return TCL_OK;
- X}
- X
- X/*
- X *----------------------------------------------------------------------
- X *
- X * Tcl_TildeSubst --
- X *
- X * Given a name starting with a tilde, produce a name where
- X * the tilde and following characters have been replaced by
- X * the home directory location for the named user.
- X *
- X * Results:
- X * The result is a pointer to a static string containing
- X * the new name. This name will only persist until the next
- X * call to Tcl_TildeSubst; save it if you care about it for
- X * the long term. If there was an error in processing the
- X * tilde, then an error message is left in interp->result
- X * and the return value is NULL.
- X *
- X * Side effects:
- X * None that the caller needs to worry about.
- X *
- X *----------------------------------------------------------------------
- X */
- X
- Xchar *
- XTcl_TildeSubst(interp, name)
- X Tcl_Interp *interp; /* Interpreter in which to store error
- X * message (if necessary). */
- X char *name; /* File name, which may begin with "~/"
- X * (to indicate current user's home directory)
- X * or "~<user>/" (to indicate any user's
- X * home directory). */
- X{
- X#define STATIC_BUF_SIZE 50
- X static char staticBuf[STATIC_BUF_SIZE];
- X static int curSize = STATIC_BUF_SIZE;
- X static char *curBuf = staticBuf;
- X char *dir;
- X int length;
- X int fromPw = 0;
- X register char *p;
- X
- X if (name[0] != '~') {
- X return name;
- X }
- X
- X /*
- X * First, find the directory name corresponding to the tilde entry.
- X */
- X
- X if ((name[1] == '/') || (name[1] == '\0')) {
- X dir = getenv("HOME");
- X if (dir == NULL) {
- X Tcl_ResetResult(interp);
- X Tcl_AppendResult(interp, "couldn't find HOME environment ",
- X "variable to expand \"", name, "\"", (char *) NULL);
- X return NULL;
- X }
- X p = name+1;
- X } else {
- X struct passwd *pwPtr;
- X
- X for (p = &name[1]; (*p != 0) && (*p != '/'); p++) {
- X /* Null body; just find end of name. */
- X }
- X length = p-&name[1];
- X if (length >= curSize) {
- X length = curSize-1;
- X }
- X memcpy((VOID *) curBuf, (VOID *) name+1, length);
- X curBuf[length] = '\0';
- X pwPtr = getpwnam(curBuf);
- X if (pwPtr == NULL) {
- X Tcl_ResetResult(interp);
- X Tcl_AppendResult(interp, "user \"", curBuf,
- X "\" doesn't exist", (char *) NULL);
- X return NULL;
- X }
- X dir = pwPtr->pw_dir;
- X fromPw = 1;
- X }
- X
- X /*
- X * Grow the buffer if necessary to make enough space for the
- X * full file name.
- X */
- X
- X length = strlen(dir) + strlen(p);
- X if (length >= curSize) {
- X if (curBuf != staticBuf) {
- X ckfree(curBuf);
- X }
- X curSize = length + 1;
- X curBuf = (char *) ckalloc((unsigned) curSize);
- X }
- X
- X /*
- X * Finally, concatenate the directory name with the remainder
- X * of the path in the buffer.
- X */
- X
- X strcpy(curBuf, dir);
- X strcat(curBuf, p);
- X if (fromPw) {
- X endpwent();
- X }
- X return curBuf;
- X}
- X
- X/*
- X *----------------------------------------------------------------------
- X *
- X * Tcl_GlobCmd --
- X *
- X * This procedure is invoked to process the "glob" Tcl command.
- X * See the user documentation for details on what it does.
- X *
- X * Results:
- X * A standard Tcl result.
- X *
- X * Side effects:
- X * See the user documentation.
- X *
- X *----------------------------------------------------------------------
- X */
- X
- X /* ARGSUSED */
- Xint
- XTcl_GlobCmd(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 int i, result, noComplain;
- X
- X if (argc < 2) {
- X notEnoughArgs:
- X Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- X " ?-nocomplain? name ?name ...?\"", (char *) NULL);
- X return TCL_ERROR;
- X }
- X noComplain = 0;
- X if ((argv[1][0] == '-') && (strcmp(argv[1], "-nocomplain") == 0)) {
- X if (argc < 3) {
- X goto notEnoughArgs;
- X }
- X noComplain = 1;
- X }
- X
- X for (i = 1 + noComplain; i < argc; i++) {
- X char *thisName;
- X
- X /*
- X * Do special checks for names starting at the root and for
- X * names beginning with ~. Then let DoGlob do the rest.
- X */
- X
- X thisName = argv[i];
- X if (*thisName == '~') {
- X thisName = Tcl_TildeSubst(interp, thisName);
- X if (thisName == NULL) {
- X return TCL_ERROR;
- X }
- X }
- X if (*thisName == '/') {
- X result = DoGlob(interp, "/", thisName+1);
- X } else {
- X result = DoGlob(interp, "", thisName);
- X }
- X if (result != TCL_OK) {
- X return result;
- X }
- X }
- X if ((*interp->result == 0) && !noComplain) {
- X interp->result = "no files matched glob pattern(s)";
- X return TCL_ERROR;
- X }
- X return TCL_OK;
- X}
- END_OF_FILE
- if test 14435 -ne `wc -c <'tcl6.1/tclGlob.c'`; then
- echo shar: \"'tcl6.1/tclGlob.c'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tclGlob.c'
- fi
- if test -f 'tcl6.1/tests/history.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/history.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/history.test'\" \(12710 characters\)
- sed "s/^X//" >'tcl6.1/tests/history.test' <<'END_OF_FILE'
- X# Commands covered: history
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/history.test,v 1.7 91/09/09 11:50:13 ouster Exp $ (Berkeley)
- X
- Xif {[info commands history] == ""} {
- X puts stdout "This version of Tcl was built without the history command;\n"
- X puts stdout "history tests will be skipped.\n"
- X return
- X}
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xset num [history nextid]
- Xhistory keep 3
- Xhistory add {set a 12345}
- Xhistory add {set b [format {A test %s} string]}
- Xhistory add {Another test}
- X
- X# "history event"
- X
- Xtest history-1.1 {event option} {history event -1} \
- X {set b [format {A test %s} string]}
- Xtest history-1.2 {event option} {history event $num} \
- X {set a 12345}
- Xtest history-1.3 {event option} {history event [expr $num+2]} \
- X {Another test}
- Xtest history-1.4 {event option} {history event set} \
- X {set b [format {A test %s} string]}
- Xtest history-1.5 {event option} {history e "* a*"} \
- X {set a 12345}
- Xtest history-1.6 {event option} {catch {history event *gorp} msg} 1
- Xtest history-1.7 {event option} {
- X catch {history event *gorp} msg
- X set msg
- X} {no event matches "*gorp"}
- Xtest history-1.8 {event option} {history event} \
- X {set b [format {A test %s} string]}
- Xtest history-1.9 {event option} {catch {history event 123 456} msg} 1
- Xtest history-1.10 {event option} {
- X catch {history event 123 456} msg
- X set msg
- X} {wrong # args: should be "history event ?event?"}
- X
- X# "history redo"
- X
- Xset a 0
- Xhistory redo -2
- Xtest history-2.1 {redo option} {set a} 12345
- Xset b 0
- Xhistory redo
- Xtest history-2.2 {redo option} {set b} {A test string}
- Xtest history-2.3 {redo option} {catch {history redo -3 -4}} 1
- Xtest history-2.4 {redo option} {
- X catch {history redo -3 -4} msg
- X set msg
- X} {wrong # args: should be "history redo ?event?"}
- X
- X# "history add"
- X
- Xhistory add "set a 444" exec
- Xtest history-3.1 {add option} {set a} 444
- Xtest history-3.2 {add option} {catch {history add "set a 444" execGorp}} 1
- Xtest history-3.3 {add option} {
- X catch {history add "set a 444" execGorp} msg
- X set msg
- X} {bad argument "execGorp": should be "exec"}
- Xtest history-3.4 {add option} {catch {history add "set a 444" a} msg} 1
- Xtest history-3.5 {add option} {
- X catch {history add "set a 444" a} msg
- X set msg
- X} {bad argument "a": should be "exec"}
- Xhistory add "set a 555" e
- Xtest history-3.6 {add option} {set a} 555
- Xhistory add "set a 666"
- Xtest history-3.7 {add option} {set a} 555
- Xtest history-3.8 {add option} {catch {history add "set a 666" e f} msg} 1
- Xtest history-3.9 {add option} {
- X catch {history add "set a 666" e f} msg
- X set msg
- X} {wrong # args: should be "history add event ?exec?"}
- X
- X# "history change"
- X
- Xhistory change "A test value"
- Xtest history-4.1 {change option} {history event [expr {[history n]-1}]} \
- X "A test value"
- Xhistory c "Another test" -1
- Xtest history-4.2 {change option} {history e} "Another test"
- Xtest history-4.3 {change option} {history event [expr {[history n]-1}]} \
- X "A test value"
- Xtest history-4.4 {change option} {catch {history change Foo 4 10}} 1
- Xtest history-4.5 {change option} {
- X catch {history change Foo 4 10} msg
- X set msg
- X} {wrong # args: should be "history change newValue ?event?"}
- Xtest history-4.6 {change option} {
- X catch {history change Foo [expr {[history n]-4}]}
- X} 1
- Xtest history-4.7 {change option} {
- X catch {history change Foo [expr {[history n]-4}]}
- X set msg
- X} {wrong # args: should be "history change newValue ?event?"}
- X
- X# "history info"
- X
- Xset num [history n]
- Xhistory add set\ a\ {b\nc\ d\ e}
- Xhistory add {set b 1234}
- Xhistory add set\ c\ {a\nb\nc}
- Xtest history-5.1 {info option} {history info} [format {%6d set a {b
- X c d e}
- X%6d set b 1234
- X%6d set c {a
- X b
- X c}} $num [expr $num+1] [expr $num+2]]
- Xtest history-5.2 {info option} {history i 2} [format {%6d set b 1234
- X%6d set c {a
- X b
- X c}} [expr $num+1] [expr $num+2]]
- Xtest history-5.3 {info option} {catch {history i 2 3}} 1
- Xtest history-5.4 {info option} {
- X catch {history i 2 3} msg
- X set msg
- X} {wrong # args: should be "history info ?count?"}
- Xtest history-5.5 {info option} {history} [format {%6d set a {b
- X c d e}
- X%6d set b 1234
- X%6d set c {a
- X b
- X c}} $num [expr $num+1] [expr $num+2]]
- X
- X# "history keep"
- X
- Xhistory add "foo1"
- Xhistory add "foo2"
- Xhistory add "foo3"
- Xhistory keep 2
- Xtest history-6.1 {keep option} {history event [expr [history n]-1]} foo3
- Xtest history-6.2 {keep option} {history event -1} foo2
- Xtest history-6.3 {keep option} {catch {history event -3}} 1
- Xtest history-6.4 {keep option} {
- X catch {history event -3} msg
- X set msg
- X} {event "-3" is too far in the past}
- Xhistory k 5
- Xtest history-6.5 {keep option} {history event -1} foo2
- Xtest history-6.6 {keep option} {history event -2} {}
- Xtest history-6.7 {keep option} {history event -3} {}
- Xtest history-6.8 {keep option} {history event -4} {}
- Xtest history-6.9 {keep option} {catch {history event -5}} 1
- Xtest history-6.10 {keep option} {catch {history keep 4 6}} 1
- Xtest history-6.11 {keep option} {
- X catch {history keep 4 6} msg
- X set msg
- X} {wrong # args: should be "history keep number"}
- Xtest history-6.12 {keep option} {catch {history keep}} 1
- Xtest history-6.13 {keep option} {
- X catch {history keep} msg
- X set msg
- X} {wrong # args: should be "history keep number"}
- Xtest history-6.14 {keep option} {catch {history keep -3}} 1
- Xtest history-6.15 {keep option} {
- X catch {history keep -3} msg
- X set msg
- X} {illegal keep count "-3"}
- X
- X# "history nextid"
- X
- Xset num [history n]
- Xhistory add "Testing"
- Xhistory add "Testing2"
- Xtest history-7.1 {nextid option} {history event} "Testing"
- Xtest history-7.2 {nextid option} {history next} [expr $num+2]
- Xtest history-7.3 {nextid option} {catch {history nextid garbage}} 1
- Xtest history-7.4 {nextid option} {
- X catch {history nextid garbage} msg
- X set msg
- X} {wrong # args: should be "history nextid"}
- X
- X# "history substitute"
- X
- Xtest history-8.1 {substitute option} {
- X history add "set a {test foo test b c test}"
- X history add "Test command 2"
- X set a 0
- X history substitute foo bar -1
- X set a
- X} {test bar test b c test}
- Xtest history-8.2 {substitute option} {
- X history add "set a {test foo test b c test}"
- X history add "Test command 2"
- X set a 0
- X history substitute test gorp
- X set a
- X} {gorp foo gorp b c gorp}
- Xtest history-8.3 {substitute option} {
- X history add "set a {test foo test b c test}"
- X history add "Test command 2"
- X set a 0
- X history sub " te" to
- X set a
- X} {test footost b ctost}
- Xtest history-8.4 {substitute option} {catch {history sub xxx yyy}} 1
- Xtest history-8.5 {substitute option} {
- X catch {history sub xxx yyy} msg
- X set msg
- X} {"xxx" doesn't appear in event}
- Xtest history-8.6 {substitute option} {catch {history s a b -10}} 1
- Xtest history-8.7 {substitute option} {
- X catch {history s a b -10} msg
- X set msg
- X} {event "-10" is too far in the past}
- Xtest history-8.8 {substitute option} {catch {history s a b -1 20}} 1
- Xtest history-8.9 {substitute option} {
- X catch {history s a b -1 20} msg
- X set msg
- X} {wrong # args: should be "history substitute old new ?event?"}
- X
- X# "history words"
- X
- Xtest history-9.1 {words option} {
- X history add {word0 word1 word2 a b c word6}
- X history add foo
- X history words 0-$
- X} {word0 word1 word2 a b c word6}
- Xtest history-9.2 {words option} {
- X history add {word0 word1 word2 a b c word6}
- X history add foo
- X history w 2 -1
- X} word2
- Xtest history-9.3 {words option} {
- X history add {word0 word1 word2 a b c word6}
- X history add foo
- X history wo $
- X} word6
- Xtest history-9.4 {words option} {catch {history w 1--1} msg} 1
- Xtest history-9.5 {words option} {
- X catch {history w 1--1} msg
- X set msg
- X} {bad word selector "1--1": should be num-num or pattern}
- Xtest history-9.6 {words option} {
- X history add {word0 word1 word2 a b c word6}
- X history add foo
- X history w w
- X} {}
- Xtest history-9.7 {words option} {
- X history add {word0 word1 word2 a b c word6}
- X history add foo
- X history w *2
- X} word2
- Xtest history-9.8 {words option} {
- X history add {word0 word1 word2 a b c word6}
- X history add foo
- X history w *or*
- X} {word0 word1 word2 word6}
- Xtest history-9.9 {words option} {catch {history words 10}} 1
- Xtest history-9.10 {words option} {
- X catch {history words 10} msg
- X set msg
- X} {word selector "10" specified non-existent words}
- Xtest history-9.11 {words option} {catch {history words 1 -1 20}} 1
- Xtest history-9.12 {words option} {
- X catch {history words 1 -1 20} msg
- X set msg
- X} {wrong # args: should be "history words num-num/pat ?event?"}
- X
- X# history revision
- X
- Xtest history-10.1 {history revision} {
- X set a 0
- X history a {set a 12345}
- X history a {set a [history e]} exec
- X set a
- X} {set a 12345}
- Xtest history-10.2 {history revision} {
- X set a 0
- X history a {set a 12345}
- X history a {set a [history e]} exec
- X history a foo
- X history ev -1
- X} {set a {set a 12345}}
- Xtest history-10.3 {history revision} {
- X set a 0
- X history a {set a 12345}
- X history a {set a [history e]} exec
- X history a foo
- X history a {history r -2} exec
- X history a {set a 12345}
- X history ev -1
- X} {set a {set a 12345}}
- Xtest history-10.4 {history revision} {
- X history a {set a 12345}
- X history a {history s 123 999} exec
- X history a foo
- X history ev -1
- X} {set a 99945}
- Xtest history-10.5 {history revision} {
- X history add {word0 word1 word2 a b c word6}
- X history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
- X set a
- X} {word0 {a b}}
- Xtest history-10.6 {history revision} {
- X history add {word0 word1 word2 a b c word6}
- X history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
- X history add foo
- X history ev
- X} {set a [list word0 {a b}]}
- Xtest history-10.7 {history revision} {
- X history add {word0 word1 word2 a b c word6}
- X history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
- X history add {format b}
- X history add {word0 word1 word2 a b c word6}
- X set a 0
- X history add {set [history subs b a -2] [list abc [history r -2] [history w 1-3]]} exec
- X history add foo
- X history ev
- X} {set [format a] [list abc [format b] {word1 word2 a}]}
- Xtest history-10.8 {history revision} {
- X history add {set a 12345}
- X concat a b c
- X history add {history redo; set b 44} exec
- X history add foo
- X history ev
- X} {set a 12345; set b 44}
- Xtest history-10.9 {history revision} {
- X history add {set a 12345}
- X history add {history redo; history change "A simple test"; history subs 45 xx} exec
- X set a
- X} 123xx
- Xtest history-10.10 {history revision} {
- X history add {set a 12345}
- X history add {history redo; history change "A simple test"; history subs 45 xx} exec
- X history add foo
- X history e
- X} {A simple test}
- Xtest history-10.11 {history revision} {
- X history add {word0 word1 $ a b c word6}
- X history add {set a [history w 4-[history word 2]]} exec
- X set a
- X} {b c word6}
- Xtest history-10.12 {history revision} {
- X history add {word0 word1 $ a b c word6}
- X history add {set a [history w 4-[history word 2]]} exec
- X history add foo
- X history e
- X} {set a {b c word6}}
- Xtest history-10.13 {history revision} {
- X history add {history word 0} exec
- X history add foo
- X history e
- X} {history word 0}
- Xtest history-10.14 {history revision} {
- X history add {set a [history word 0; format c]} exec
- X history add foo
- X history e
- X} {set a [history word 0; format c]}
- Xtest history-10.15 {history revision even when nested} {
- X proc x {a b} {history word $a $b}
- X history add {word1 word2 word3 word4}
- X history add {set a [x 1-3 -1]} exec
- X history add foo
- X history e
- X} {set a {word2 word3 word4}}
- Xtest history-10.16 {disable history revision in nested history evals} {
- X history add {word1 word2 word3 word4}
- X history add {set a [history words 0]; history add foo; set a [history words 0]} exec
- X history e
- X} {set a word1; history add foo; set a [history words 0]}
- X
- X# miscellaneous
- X
- Xtest history-11.1 {miscellaneous} {catch {history gorp} msg} 1
- Xtest history-11.2 {miscellaneous} {
- X catch {history gorp} msg
- X set msg
- X} {bad option "gorp": must be add, change, event, info, keep, nextid, redo, substitute, or words}
- END_OF_FILE
- if test 12710 -ne `wc -c <'tcl6.1/tests/history.test'`; then
- echo shar: \"'tcl6.1/tests/history.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/history.test'
- fi
- echo shar: End of archive 11 \(of 33\).
- cp /dev/null ark11isdone
- 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 24 25 26 27 28 29 30 31 32 33 ; do
- if test ! -f ark${I}isdone ; then
- MISSING="${MISSING} ${I}"
- fi
- done
- if test "${MISSING}" = "" ; then
- echo You have unpacked all 33 archives.
- 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: kent@sparky.IMD.Sterling.COM
- Sterling Software, IMD UUCP: uunet!sparky!kent
- Phone: (402) 291-8300 FAX: (402) 291-4362
- Please send comp.sources.misc-related mail to kent@uunet.uu.net.
-