home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume25 / tcl / part11 < prev    next >
Encoding:
Text File  |  1991-11-14  |  44.9 KB  |  1,379 lines

  1. Newsgroups: comp.sources.misc
  2. From: karl@sugar.neosoft.com (Karl Lehenbauer)
  3. Subject:  v25i079:  tcl - tool command language, version 6.1, Part11/33
  4. Message-ID: <1991Nov14.202950.23876@sparky.imd.sterling.com>
  5. X-Md4-Signature: 6b5ec35237573b6980eb30503405c2bf
  6. Date: Thu, 14 Nov 1991 20:29:50 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: karl@sugar.neosoft.com (Karl Lehenbauer)
  10. Posting-number: Volume 25, Issue 79
  11. Archive-name: tcl/part11
  12. Environment: UNIX
  13.  
  14. #! /bin/sh
  15. # This is a shell archive.  Remove anything before this line, then unpack
  16. # it by saving it into a file and typing "sh file".  To overwrite existing
  17. # files, type "sh file -c".  You can also feed this as standard input via
  18. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  19. # will see the following message at the end:
  20. #        "End of archive 11 (of 33)."
  21. # Contents:  tcl6.1/changes tcl6.1/tclGlob.c tcl6.1/tests/history.test
  22. # Wrapped by karl@one on Tue Nov 12 19:44:20 1991
  23. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  24. if test -f 'tcl6.1/changes' -a "${1}" != "-c" ; then 
  25.   echo shar: Will not clobber existing file \"'tcl6.1/changes'\"
  26. else
  27. echo shar: Extracting \"'tcl6.1/changes'\" \(14472 characters\)
  28. sed "s/^X//" >'tcl6.1/changes' <<'END_OF_FILE'
  29. XRecent user-visible changes to Tcl:
  30. X
  31. X1. No more [command1] [command2] construct for grouping multiple
  32. Xcommands on a single command line.
  33. X
  34. X2. Semi-colon now available for grouping commands on a line.
  35. X
  36. X3. For a command to span multiple lines, must now use backslash-return
  37. Xat the end of each line but the last.
  38. X
  39. X4. "Var" command has been changed to "set".
  40. X
  41. X5. Double-quotes now available as an argument grouping character.
  42. X
  43. X6. "Return" may be used at top-level.
  44. X
  45. X7. More backslash sequences available now.  In particular, backslash-newline
  46. Xmay be used to join lines in command files.
  47. X
  48. X8. New or modified built-in commands:  case, return, for, glob, info,
  49. Xprint, return, set, source, string, uplevel.
  50. X
  51. X9. After an error, the variable "errorInfo" is filled with a stack
  52. Xtrace showing what was being executed when the error occurred.
  53. X
  54. X10. Command abbreviations are accepted when parsing commands, but
  55. Xare not recommended except for purely-interactive commands.
  56. X
  57. X11. $, set, and expr all complain now if a non-existent variable is
  58. Xreferenced.
  59. X
  60. X12. History facilities exist now.  See Tcl.man and Tcl_RecordAndEval.man.
  61. X
  62. X13. Changed to distinguish between empty variables and those that don't
  63. Xexist at all.  Interfaces to Tcl_GetVar and Tcl_ParseVar have changed
  64. X(NULL return value is now possible).  *** POTENTIAL INCOMPATIBILITY ***
  65. X
  66. X14. Changed meaning of "level" argument to "uplevel" command (1 now means
  67. X"go up one level", not "go to level 1"; "#1" means "go to level 1").
  68. X*** POTENTIAL INCOMPATIBILITY ***
  69. X
  70. X15. 3/19/90 Added "info exists" option to see if variable exists.
  71. X
  72. X16. 3/19/90 Added "noAbbrev" variable to prohibit command abbreviations.
  73. X
  74. X17. 3/19/90 Added extra errorInfo option to "error" command.
  75. X
  76. X18. 3/21/90 Double-quotes now only affect space:  command, variable,
  77. Xand backslash substitutions still occur inside double-quotes.
  78. X*** POTENTIAL INCOMPATIBILITY ***
  79. X
  80. X19. 3/21/90 Added support for \r.
  81. X
  82. X20. 3/21/90 List, concat, eval, and glob commands all expect at least
  83. Xone argument now.  *** POTENTIAL INCOMPATIBILITY ***
  84. X
  85. X21. 3/22/90 Added "?:" operators to expressions.
  86. X
  87. X22. 3/25/90 Fixed bug in Tcl_Result that caused memory to get trashed.
  88. X
  89. X------------------- Released version 3.1 ---------------------
  90. X
  91. X23. 3/29/90 Fixed bug that caused "file a.b/c ext" to return ".b/c".
  92. X
  93. X24. 3/29/90 Semi-colon is not treated specially when enclosed in
  94. Xdouble-quotes.
  95. X
  96. X------------------- Released version 3.2 ---------------------
  97. X
  98. X25. 4/16/90 Rewrote "exec" not to use select or signals anymore.
  99. XShould be more Sys-V compatible, and no slower in the normal case.
  100. X
  101. X26. 4/18/90 Rewrote "glob" to eliminate GNU code (there's no GNU code
  102. Xleft in Tcl, now), and added Tcl_TildeSubst procedure.  Added automatic
  103. Xtilde-substitution in many commands, including "glob".
  104. X
  105. X------------------- Released version 3.3 ---------------------
  106. X
  107. X27. 7/11/90 Added "Tcl_AppendResult" procedure.
  108. X
  109. X28. 7/20/90 "History" with no options now defaults to "history info"
  110. Xrather than to "history redo".  Although this is a backward incompatibility,
  111. Xit should only be used interactively and thus shouldn't present any
  112. Xcompatibility problems with scripts.
  113. X
  114. X29. 7/20/90 Added "Tcl_GetInteger", "Tcl_GetDouble", and "Tcl_GetBoolean"
  115. Xprocedures.
  116. X
  117. X30. 7/22/90 Removed "Tcl_WatchInterp" procedure:  doesn't seem to be
  118. Xnecessary, since the same effect can be achieved with the deletion
  119. Xcallbacks on individual commands.  *** POTENTIAL INCOMPATIBILITY ***
  120. X
  121. X31. 7/23/90 Added variable tracing:  Tcl_TraceVar, Tcl_UnTraceVar,
  122. Xand Tcl_VarTraceInfo procedures, "trace" command.
  123. X
  124. X32. 8/9/90 Mailed out list of all bug fixes since 3.3 release.
  125. X
  126. X33. 8/29/90 Fixed bugs in Tcl_Merge relating to backslashes and
  127. Xsemi-colons.  Mailed out patch.
  128. X
  129. X34. 9/3/90 Fixed bug in tclBasic.c: quotes weren't quoting ]'s.
  130. XMailed out patch.
  131. X
  132. X35. 9/19/90 Rewrote exec to always use files both for input and
  133. Xoutput to the process.  The old pipe-based version didn't work if
  134. Xthe exec'ed process forked a child and then exited:  Tcl waited
  135. Xaround for stdout to get closed, which didn't happen until the
  136. Xgrandchild exited.
  137. X
  138. X36. 11/5/90 ERR_IN_PROGRESS flag wasn't being cleared soon enough
  139. Xin Tcl_Eval, allowing error messages from different commands to
  140. Xpile up in $errorInfo.  Fixed by re-arranging code in Tcl_Eval that
  141. Xre-initializes result and ERR_IN_PROGRESS flag.  Didn't mail out
  142. Xpatch:  changes too complicated to describe.
  143. X
  144. X37. 12/19/90 Added Tcl_VarEval procedure as a convenience for
  145. Xassembling and executing Tcl commands.
  146. X
  147. X38. 1/29/91 Fixed core leak in Tcl_AddErrorInfo.  Also changed procedure
  148. Xand Tcl_Eval so that first call to Tcl_AddErrorInfo need not come from
  149. XTcl_Eval.
  150. X
  151. X----------------- Released version 5.0 with Tk ------------------
  152. X
  153. X39. 4/3/91 Removed change bars from manual entries, leaving only those
  154. Xthat came after version 3.3 was released.
  155. X
  156. X40. 5/17/91 Changed tests to conform to Mary Ann May-Pumphrey's approach.
  157. X
  158. X41. 5/23/91 Massive revision to Tcl parser to simplify the implementation
  159. Xof string and floating-point support in expressions.  Newlines inside
  160. X[] are now treated as command separators rather than word separators
  161. X(this makes newline treatment consistent throughout Tcl).
  162. X*** POTENTIAL INCOMPATIBILITY ***
  163. X
  164. X42. 5/23/91 Massive rewrite of expression code to support floating-point
  165. Xvalues and simple string comparisons.  The C interfaces to expression
  166. Xroutines have changed (Tcl_Expr is replaced by Tcl_ExprLong, Tcl_ExprDouble,
  167. Xetc.), but all old Tcl expression strings should be accepted by the new
  168. Xexpression code.
  169. X*** POTENTIAL INCOMPATIBILITY ***
  170. X
  171. X43. 5/23/91 Modified tclHistory.c to check for negative "keep" value.
  172. X
  173. X44. 5/23/91 Modified Tcl_Backslash to handle backslash-newline.  It now
  174. Xreturns 0 to indicate that a backslash sequence should be replaced by
  175. Xno character at all.
  176. X*** POTENTIAL INCOMPATIBILITY ***
  177. X
  178. X45. 5/29/91 Modified to use ANSI C function prototypes.  Must set
  179. X"USE_ANSI" switch when compiling to get prototypes.
  180. X
  181. X46. 5/29/91 Completed test suite by providing tests for all of the
  182. Xbuilt-in Tcl commands.
  183. X
  184. X47. 5/29/91 Changed Tcl_Concat to eliminate leading and trailing
  185. Xwhite-space in each of the things it concatenates and to ignore
  186. Xelements that are empty or have only white space in them.  This
  187. Xproduces cleaner output from the "concat" command.
  188. X*** POTENTIAL INCOMPATIBILITY ***
  189. X
  190. X48. 5/31/91 Changed "set" command and Tcl_SetVar procedure to return
  191. Xnew value of variable.
  192. X
  193. X49. 6/1/91 Added "while" and "cd" commands.
  194. X
  195. X50. 6/1/91 Changed "exec" to delete the last character of program
  196. Xoutput if it is a newline.  In most cases this makes it easier to
  197. Xprocess program-generated output.
  198. X*** POTENTIAL INCOMPATIBILITY ***
  199. X
  200. X51. 6/1/91 Made sure that pointers are never used after freeing them.
  201. X
  202. X52. 6/1/91 Fixed bug in TclWordEnd where it wasn't dealing with
  203. X[] inside quotes correctly.
  204. X
  205. X53. 6/8/91 Fixed exec.test to accept return values of either 1 or
  206. X255 from "false" command.
  207. X
  208. X54. 7/6/91 Massive overhaul of variable management.  Associative
  209. Xarrays now available, along with "unset" command (and Tcl_UnsetVar
  210. Xprocedure).  Variable traces have been completely reworked:
  211. Xinterfaces different both from Tcl and C, and multiple traces may
  212. Xexist on same variable.  Can no longer redefine existing local
  213. Xvariable to be global.  Calling sequences have changed slightly
  214. Xfor Tcl_GetVar and Tcl_SetVar ("global" is now "flags"). Tcl_SetVar
  215. Xcan fail and return a NULL result.  New forms of variable-manipulation
  216. Xprocedures:  Tcl_GetVar2, Tcl_SetVar2, etc.  Syntax of variable
  217. X$-notation changed to support array indexing.
  218. X*** POTENTIAL INCOMPATIBILITY ***
  219. X
  220. X55. 7/6/91 Added new list-manipulation procedures:  Tcl_ScanElement,
  221. XTcl_ConvertElement, Tcl_AppendElement.
  222. X
  223. X56. 7/12/91 Created new procedure Tcl_EvalFile, which does most of the
  224. Xwork of the "source" command.
  225. X
  226. X57. 7/20/91 Major reworking of "exec" command to allow pipelines,
  227. Xmore redirection, background.  Added new procedures Tcl_Fork,
  228. XTcl_WaitPids, Tcl_DetachPids, and Tcl_CreatePipeline.  The old
  229. X"< input" notation has been replaced by "<< input" ("<" is for
  230. Xredirection from a file).  Also handles error returns and abnormal
  231. Xterminations (e.g. signals) differently.
  232. X*** POTENTIAL INCOMPATIBILITY ***
  233. X
  234. X58. 7/21/91 Added "append" and "lappend" commands.
  235. X
  236. X59. 7/22/91 Reworked error messages and manual entries to use
  237. X?x? as the notation for an optional argument x, instead of [x].  The
  238. Xbracket notation was often confused with the use of brackets for
  239. Xcommand substitution.  Also modified error messages to be more
  240. Xconsistent.
  241. X
  242. X60. 7/23/91 Tcl_DeleteCommand now returns an indication of whether
  243. Xor not the command actually existed, and the "rename" command uses
  244. Xthis information to return an error if an attempt is made to delete
  245. Xa non-existent command.
  246. X*** POTENTIAL INCOMPATIBILITY ***
  247. X
  248. X61. 7/25/91 Added new "errorCode" mechanism, along with procedures
  249. XTcl_SetErrorCode, Tcl_UnixError, and Tcl_ResetResult.  Renamed
  250. XTcl_Return to Tcl_SetResult, but left a #define for Tcl_Return to
  251. Xavoid compatibility problems.
  252. X
  253. X62. 7/26/91 Extended "case" command with alternate syntax where all
  254. Xpatterns and commands are together in a single list argument:  makes
  255. Xit easier to write multi-line case statements.
  256. X
  257. X63. 7/27/91 Changed "print" command to perform tilde-substitution on
  258. Xthe file name.
  259. X
  260. X64. 7/27/91 Added "tolower", "toupper", "trim", "trimleft", and "trimright"
  261. Xoptions to "string" command.
  262. X
  263. X65. 7/29/91 Added "atime", "mtime", "size", and "stat" options to "file"
  264. Xcommand.
  265. X
  266. X66. 8/1/91 Added "split" and "join" commands.
  267. X
  268. X67. 8/11/91 Added commands for file I/O, including "open", "close",
  269. X"read", "gets", "puts", "flush", "eof", "seek", and "tell".
  270. X
  271. X68. 8/14/91 Switched to use a hash table for command lookups.  Command
  272. Xabbreviations no longer have direct support in the Tcl interpreter, but
  273. Xit should be possible to simulate them with the auto-load features
  274. Xdescribed below.  The "noAbbrev" variable is no longer used by Tcl.
  275. X*** POTENTIAL INCOMPATIBILITY ***
  276. X
  277. X68.5 8/15/91 Added support for "unknown" command, which can be used to
  278. Xcomplete abbreviations, auto-load library files, auto-exec shell
  279. Xcommands, etc.
  280. X
  281. X69. 8/15/91 Added -nocomplain switch to "glob" command.
  282. X
  283. X70. 8/20/91 Added "info library" option and TCL_LIBRARY #define.  Also
  284. Xadded "info script" option.
  285. X
  286. X71. 8/20/91 Changed "file" command to take "option" argument as first
  287. Xargument (before file name), for consistency with other Tcl commands.
  288. X*** POTENTIAL INCOMPATIBILITY ***
  289. X
  290. X72. 8/20/91 Changed format of information in $errorInfo variable:
  291. Xcomments such as 
  292. X    ("while" body line 1)
  293. Xare now on separate lines from commands being executed.
  294. X*** POTENTIAL INCOMPATIBILITY ***
  295. X
  296. X73. 8/20/91 Changed Tcl_AppendResult so that it (eventually) frees
  297. Xlarge buffers that it allocates.
  298. X
  299. X74. 8/21/91 Added "linsert", "lreplace", "lsearch", and "lsort"
  300. Xcommands.
  301. X
  302. X75. 8/28/91 Added "incr" and "exit" commands.
  303. X
  304. X76. 8/30/91 Added "regexp" and "regsub" commands.
  305. X
  306. X77. 9/4/91 Changed "dynamic" field in interpreters to "freeProc" (procedure
  307. Xaddress).  This allows for alternative storage managers.
  308. X*** POTENTIAL INCOMPATIBILITY ***
  309. X
  310. X78. 9/6/91 Added "index", "length", and "range" options to "string"
  311. Xcommand.  Added "lindex", "llength", and "lrange" commands.
  312. X
  313. X79. 9/8/91 Removed "index", "length", "print" and "range" commands.
  314. X"Print" is redundant with "puts", but less general, and the other
  315. Xcommands are replaced with the new commands described in change 78
  316. Xabove.
  317. X*** POTENTIAL INCOMPATIBILITY ***
  318. X
  319. X80. 9/8/91 Changed history revision to occur even when history command
  320. Xis nested;  needed in order to allow "history" to be invoked from
  321. X"unknown" procedure.
  322. X
  323. X81. 9/13/91 Changed "panic" not to use vfprintf (it's uglier and less
  324. Xgeneral now, but makes it easier to run Tcl on systems that don't
  325. Xhave vfprintf).  Also changed "strerror" not to reclare sys_errlist.
  326. X
  327. X82. 9/19/91 Lots of changes to improve portability to different UNIX
  328. Xsystems, including addition of "config" script to adapt Tcl to the
  329. Xconfiguration of the system it's being compiled on.
  330. X
  331. X83. 9/22/91 Added "pwd" command.
  332. X
  333. X84. 9/22/91 Renamed manual pages so that their filenames are no more
  334. Xthan 14 characters in length, moved to "doc" subdirectory.
  335. X
  336. X85. 9/24/91 Redid manual entries so they contain the supplemental
  337. Xmacros that they need;  can just print with "troff -man" or "man"
  338. Xnow.
  339. X
  340. X86. 9/26/91 Created initial version of script library, including
  341. Xa version of "unknown" that does auto-loading, auto-execution, and
  342. Xabbreviation expansion.  This library is used by tclTest
  343. Xautomatically.  See the "library" manual entry for details.
  344. X
  345. X----------------- Released version 6.0, 9/26/91 ------------------
  346. X
  347. X87. 9/30/91 Made "string tolower" and "string toupper" check case
  348. Xbefore converting:  on some systems, "tolower" and "toupper" assume
  349. Xthat character already has particular case.
  350. X
  351. X88. 9/30/91 Fixed bug in Tcl_SetResult:  wasn't always setting freeProc
  352. Xcorrecly when called with NULL value.  This tended to cause memory
  353. Xallocation errors later.
  354. X
  355. X89. 10/3/91 Added "upvar" command.
  356. X
  357. X90. 10/4/91 Changed "format" so that internally it converts %D to %ld,
  358. X%U to %lu, %O to %lo, and %F to %f.  This eliminates some compatibility
  359. Xproblems on some machines without affecting behavior.
  360. X
  361. X91. 10/10/91 Fixed bug in "regsub" that caused core dumps with the -all
  362. Xoption when the last match wasn't at the end of the string.
  363. X
  364. X92. 10/17/91 Fixed problems with backslash sequences:  \r support was
  365. Xincomplete and \f and \v weren't supported at all.
  366. X
  367. X93. 10/24/91 Added Tcl_InitHistory procedure.
  368. X
  369. X94. 10/24/91 Changed "regexp" to store "-1 -1" in subMatchVars that
  370. Xdon't match, rather than returning an error.
  371. X
  372. X95. 10/27/91 Modified "regexp" to return actual strings in matchVar
  373. Xand subMatchVars instead of indices.  Added "-indices" switch to cause
  374. Xindices to be returned.
  375. X*** POTENTIAL INCOMPATIBILITY ***
  376. X
  377. X96. 10/27/91 Fixed bug in "scan" where it used hardwired constants for
  378. Xsizes of floats and doubles instead of using "sizeof".
  379. X
  380. X97. 10/31/91 Fixed bug in tclParse.c where parse-related error messages
  381. Xweren't being storage-managed correctly, causing spurious free's.
  382. X
  383. X98. 10/31/91 Form feed and vertical tab characters are now considered
  384. Xto be space characters by the parser.
  385. X
  386. X99. 10/31/91 Added TCL_LEAVE_ERR_MSG flag to procedures like Tcl_SetVar.
  387. X
  388. X100. 11/7/91 Fixed bug in "case" where "in" argument couldn't be ommitted
  389. Xif all case branches were embedded in a single list.
  390. X
  391. X101. 11/7/91 Switched to use "pid_t" and "uid_t" and other official
  392. XPOSIC types and function prototypes.
  393. END_OF_FILE
  394. if test 14472 -ne `wc -c <'tcl6.1/changes'`; then
  395.     echo shar: \"'tcl6.1/changes'\" unpacked with wrong size!
  396. fi
  397. # end of 'tcl6.1/changes'
  398. fi
  399. if test -f 'tcl6.1/tclGlob.c' -a "${1}" != "-c" ; then 
  400.   echo shar: Will not clobber existing file \"'tcl6.1/tclGlob.c'\"
  401. else
  402. echo shar: Extracting \"'tcl6.1/tclGlob.c'\" \(14435 characters\)
  403. sed "s/^X//" >'tcl6.1/tclGlob.c' <<'END_OF_FILE'
  404. X/* 
  405. X * tclGlob.c --
  406. X *
  407. X *    This file provides procedures and commands for file name
  408. X *    manipulation, such as tilde expansion and globbing.
  409. X *
  410. X * Copyright 1990-1991 Regents of the University of California
  411. X * Permission to use, copy, modify, and distribute this
  412. X * software and its documentation for any purpose and without
  413. X * fee is hereby granted, provided that the above copyright
  414. X * notice appear in all copies.  The University of California
  415. X * makes no representations about the suitability of this
  416. X * software for any purpose.  It is provided "as is" without
  417. X * express or implied warranty.
  418. X */
  419. X
  420. X#ifndef lint
  421. Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclGlob.c,v 1.21 91/09/23 11:20:00 ouster Exp $ SPRITE (Berkeley)";
  422. X#endif /* not lint */
  423. X
  424. X#include "tclInt.h"
  425. X#include "tclUnix.h"
  426. X
  427. X/*
  428. X * The structure below is used to keep track of a globbing result
  429. X * being built up (i.e. a partial list of file names).  The list
  430. X * grows dynamically to be as big as needed.
  431. X */
  432. X
  433. Xtypedef struct {
  434. X    char *result;        /* Pointer to result area. */
  435. X    int totalSpace;        /* Total number of characters allocated
  436. X                 * for result. */
  437. X    int spaceUsed;        /* Number of characters currently in use
  438. X                 * to hold the partial result (not including
  439. X                 * the terminating NULL). */
  440. X    int dynamic;        /* 0 means result is static space, 1 means
  441. X                 * it's dynamic. */
  442. X} GlobResult;
  443. X
  444. X/*
  445. X * Declarations for procedures local to this file:
  446. X */
  447. X
  448. Xstatic void        AppendResult _ANSI_ARGS_((Tcl_Interp *interp,
  449. X                char *dir, char *name, int nameLength));
  450. Xstatic int        DoGlob _ANSI_ARGS_((Tcl_Interp *interp, char *dir,
  451. X                char *rem));
  452. X
  453. X/*
  454. X *----------------------------------------------------------------------
  455. X *
  456. X * AppendResult --
  457. X *
  458. X *    Given two parts of a file name (directory and element within
  459. X *    directory), concatenate the two together and append them to
  460. X *    the result building up in interp.
  461. X *
  462. X * Results:
  463. X *    There is no return value.
  464. X *
  465. X * Side effects:
  466. X *    Interp->result gets extended.
  467. X *
  468. X *----------------------------------------------------------------------
  469. X */
  470. X
  471. Xstatic void
  472. XAppendResult(interp, dir, name, nameLength)
  473. X    Tcl_Interp *interp;        /* Interpreter whose result should be
  474. X                 * appended to. */
  475. X    char *dir;            /* Name of directory, with trailing
  476. X                 * slash (unless the whole string is
  477. X                 * empty). */
  478. X    char *name;            /* Name of file withing directory (NOT
  479. X                 * necessarily null-terminated!). */
  480. X    int nameLength;        /* Number of characters in name. */
  481. X{
  482. X    int dirLength, dirFlags, nameFlags;
  483. X    char *p, saved;
  484. X
  485. X    /*
  486. X     * Next, see if we can put together a valid list element from dir
  487. X     * and name by calling Tcl_AppendResult.
  488. X     */
  489. X
  490. X    if (*dir == 0) {
  491. X    dirFlags = 0;
  492. X    } else {
  493. X    Tcl_ScanElement(dir, &dirFlags);
  494. X    }
  495. X    saved = name[nameLength];
  496. X    name[nameLength] = 0;
  497. X    Tcl_ScanElement(name, &nameFlags);
  498. X    if ((dirFlags == 0) && (nameFlags == 0)) {
  499. X    if (*interp->result != 0) {
  500. X        Tcl_AppendResult(interp, " ", dir, name, (char *) NULL);
  501. X    } else {
  502. X        Tcl_AppendResult(interp, dir, name, (char *) NULL);
  503. X    }
  504. X    name[nameLength] = saved;
  505. X    return;
  506. X    }
  507. X
  508. X    /*
  509. X     * This name has weird characters in it, so we have to convert it to
  510. X     * a list element.  To do that, we have to merge the characters
  511. X     * into a single name.  To do that, malloc a buffer to hold everything.
  512. X     */
  513. X
  514. X    dirLength = strlen(dir);
  515. X    p = (char *) ckalloc((unsigned) (dirLength + nameLength + 1));
  516. X    strcpy(p, dir);
  517. X    strcpy(p+dirLength, name);
  518. X    name[nameLength] = saved;
  519. X    Tcl_AppendElement(interp, p, 0);
  520. X    ckfree(p);
  521. X}
  522. X
  523. X/*
  524. X *----------------------------------------------------------------------
  525. X *
  526. X * DoGlob --
  527. X *
  528. X *    This recursive procedure forms the heart of the globbing
  529. X *    code.  It performs a depth-first traversal of the tree
  530. X *    given by the path name to be globbed.
  531. X *
  532. X * Results:
  533. X *    The return value is a standard Tcl result indicating whether
  534. X *    an error occurred in globbing.  After a normal return the
  535. X *    result in interp will be set to hold all of the file names
  536. X *    given by the dir and rem arguments.  After an error the
  537. X *    result in interp will hold an error message.
  538. X *
  539. X * Side effects:
  540. X *    None.
  541. X *
  542. X *----------------------------------------------------------------------
  543. X */
  544. X
  545. Xstatic int
  546. XDoGlob(interp, dir, rem)
  547. X    Tcl_Interp *interp;            /* Interpreter to use for error
  548. X                     * reporting (e.g. unmatched brace). */
  549. X    char *dir;                /* Name of a directory at which to
  550. X                     * start glob expansion.  This name
  551. X                     * is fixed: it doesn't contain any
  552. X                     * globbing chars.  If it's non-empty
  553. X                     * then it should end with a slash. */
  554. X    char *rem;                /* Path to glob-expand. */
  555. X{
  556. X    /*
  557. X     * When this procedure is entered, the name to be globbed may
  558. X     * already have been partly expanded by ancestor invocations of
  559. X     * DoGlob.  The part that's already been expanded is in "dir"
  560. X     * (this may initially be empty), and the part still to expand
  561. X     * is in "rem".  This procedure expands "rem" one level, making
  562. X     * recursive calls to itself if there's still more stuff left
  563. X     * in the remainder.
  564. X     */
  565. X
  566. X    register char *p;
  567. X    register char c;
  568. X    char *openBrace, *closeBrace;
  569. X    int gotSpecial, result;
  570. X
  571. X    /*
  572. X     * When generating information for the next lower call,
  573. X     * use static areas if the name is short, and malloc if the name
  574. X     * is longer.
  575. X     */
  576. X
  577. X#define STATIC_SIZE 200
  578. X
  579. X    /*
  580. X     * First, find the end of the next element in rem, checking
  581. X     * along the way for special globbing characters.
  582. X     */
  583. X
  584. X    gotSpecial = 0;
  585. X    openBrace = closeBrace = NULL;
  586. X    for (p = rem; ; p++) {
  587. X    c = *p;
  588. X    if ((c == '\0') || (c == '/')) {
  589. X        break;
  590. X    }
  591. X    if ((c == '{') && (openBrace == NULL)) {
  592. X        openBrace = p;
  593. X    }
  594. X    if ((c == '}') && (closeBrace == NULL)) {
  595. X        closeBrace = p;
  596. X    }
  597. X    if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) {
  598. X        gotSpecial = 1;
  599. X    }
  600. X    }
  601. X
  602. X    /*
  603. X     * If there is an open brace in the argument, then make a recursive
  604. X     * call for each element between the braces.  In this case, the
  605. X     * recursive call to DoGlob uses the same "dir" that we got.
  606. X     * If there are several brace-pairs in a single name, we just handle
  607. X     * one here, and the others will be handled in recursive calls.
  608. X     */
  609. X
  610. X    if (openBrace != NULL) {
  611. X    int remLength, l1, l2;
  612. X    char static1[STATIC_SIZE];
  613. X    char *element, *newRem;
  614. X
  615. X    if (closeBrace == NULL) {
  616. X        Tcl_ResetResult(interp);
  617. X        interp->result = "unmatched open-brace in file name";
  618. X        return TCL_ERROR;
  619. X    }
  620. X    remLength = strlen(rem) + 1;
  621. X    if (remLength <= STATIC_SIZE) {
  622. X        newRem = static1;
  623. X    } else {
  624. X        newRem = (char *) ckalloc((unsigned) remLength);
  625. X    }
  626. X    l1 = openBrace-rem;
  627. X    strncpy(newRem, rem, l1);
  628. X    p = openBrace;
  629. X    for (p = openBrace; *p != '}'; ) {
  630. X        element = p+1;
  631. X        for (p = element; ((*p != '}') && (*p != ',')); p++) {
  632. X        /* Empty loop body:  just find end of this element. */
  633. X        }
  634. X        l2 = p - element;
  635. X        strncpy(newRem+l1, element, l2);
  636. X        strcpy(newRem+l1+l2, closeBrace+1);
  637. X        if (DoGlob(interp, dir, newRem) != TCL_OK) {
  638. X        return TCL_ERROR;
  639. X        }
  640. X    }
  641. X    if (remLength > STATIC_SIZE) {
  642. X        ckfree(newRem);
  643. X    }
  644. X    return TCL_OK;
  645. X    }
  646. X
  647. X    /*
  648. X     * If there were any pattern-matching characters, then scan through
  649. X     * the directory to find all the matching names.
  650. X     */
  651. X
  652. X    if (gotSpecial) {
  653. X    DIR *d;
  654. X    struct dirent *entryPtr;
  655. X    int l1, l2;
  656. X    char *pattern, *newDir, *dirName;
  657. X    char static1[STATIC_SIZE], static2[STATIC_SIZE];
  658. X    struct stat statBuf;
  659. X
  660. X    /*
  661. X     * Be careful not to do any actual file system operations on a
  662. X     * directory named "";  instead, use ".".  This is needed because
  663. X     * some versions of UNIX don't treat "" like "." automatically.
  664. X     */
  665. X
  666. X    if (*dir == '\0') {
  667. X        dirName = ".";
  668. X    } else {
  669. X        dirName = dir;
  670. X    }
  671. X    if ((stat(dirName, &statBuf) != 0)
  672. X        || ((statBuf.st_mode & S_IFMT) != S_IFDIR)) {
  673. X        return TCL_OK;
  674. X    }
  675. X    d = opendir(dirName);
  676. X    if (d == NULL) {
  677. X        Tcl_ResetResult(interp);
  678. X        Tcl_AppendResult(interp, "couldn't read directory \"",
  679. X            dirName, "\": ", Tcl_UnixError(interp), (char *) NULL);
  680. X        return TCL_ERROR;
  681. X    }
  682. X    l1 = strlen(dir);
  683. X    l2 = (p - rem);
  684. X    if (l2 < STATIC_SIZE) {
  685. X        pattern = static2;
  686. X    } else {
  687. X        pattern = (char *) ckalloc((unsigned) (l2+1));
  688. X    }
  689. X    strncpy(pattern, rem, l2);
  690. X    pattern[l2] = '\0';
  691. X    result = TCL_OK;
  692. X    while (1) {
  693. X        entryPtr = readdir(d);
  694. X        if (entryPtr == NULL) {
  695. X        break;
  696. X        }
  697. X
  698. X        /*
  699. X         * Don't match names starting with "." unless the "." is
  700. X         * present in the pattern.
  701. X         */
  702. X
  703. X        if ((*entryPtr->d_name == '.') && (*pattern != '.')) {
  704. X        continue;
  705. X        }
  706. X        if (Tcl_StringMatch(entryPtr->d_name, pattern)) {
  707. X        int nameLength = strlen(entryPtr->d_name);
  708. X
  709. X        if (*p == 0) {
  710. X            AppendResult(interp, dir, entryPtr->d_name, nameLength);
  711. X        } else {
  712. X            if ((l1+nameLength+2) <= STATIC_SIZE) {
  713. X            newDir = static1;
  714. X            } else {
  715. X            newDir = (char *) ckalloc((unsigned) (l1+nameLength+2));
  716. X            }
  717. X            sprintf(newDir, "%s%s/", dir, entryPtr->d_name);
  718. X            result = DoGlob(interp, newDir, p+1);
  719. X            if (newDir != static1) {
  720. X            ckfree(newDir);
  721. X            }
  722. X            if (result != TCL_OK) {
  723. X            break;
  724. X            }
  725. X        }
  726. X        }
  727. X    }
  728. X    closedir(d);
  729. X    if (pattern != static2) {
  730. X        ckfree(pattern);
  731. X    }
  732. X    return result;
  733. X    }
  734. X
  735. X    /*
  736. X     * This is the simplest case:  just another path element.  Move
  737. X     * it to the dir side and recurse (or just add the name to the
  738. X     * list, if we're at the end of the path).
  739. X     */
  740. X
  741. X    if (*p == 0) {
  742. X    AppendResult(interp, dir, rem, p-rem);
  743. X    } else {
  744. X    int l1, l2;
  745. X    char *newDir;
  746. X    char static1[STATIC_SIZE];
  747. X
  748. X    l1 = strlen(dir);
  749. X    l2 = l1 + (p - rem) + 2;
  750. X    if (l2 <= STATIC_SIZE) {
  751. X        newDir = static1;
  752. X    } else {
  753. X        newDir = (char *) ckalloc((unsigned) l2);
  754. X    }
  755. X    strcpy(newDir, dir);
  756. X    strncpy(newDir+l1, rem, p-rem);
  757. X    newDir[l2-2] = '/';
  758. X    newDir[l2-1] = 0;
  759. X    result = DoGlob(interp, newDir, p+1);
  760. X    if (newDir != static1) {
  761. X        ckfree(newDir);
  762. X    }
  763. X    if (result != TCL_OK) {
  764. X        return TCL_ERROR;
  765. X    }
  766. X    }
  767. X    return TCL_OK;
  768. X}
  769. X
  770. X/*
  771. X *----------------------------------------------------------------------
  772. X *
  773. X * Tcl_TildeSubst --
  774. X *
  775. X *    Given a name starting with a tilde, produce a name where
  776. X *    the tilde and following characters have been replaced by
  777. X *    the home directory location for the named user.
  778. X *
  779. X * Results:
  780. X *    The result is a pointer to a static string containing
  781. X *    the new name.  This name will only persist until the next
  782. X *    call to Tcl_TildeSubst;  save it if you care about it for
  783. X *    the long term.  If there was an error in processing the
  784. X *    tilde, then an error message is left in interp->result
  785. X *    and the return value is NULL.
  786. X *
  787. X * Side effects:
  788. X *    None that the caller needs to worry about.
  789. X *
  790. X *----------------------------------------------------------------------
  791. X */
  792. X
  793. Xchar *
  794. XTcl_TildeSubst(interp, name)
  795. X    Tcl_Interp *interp;        /* Interpreter in which to store error
  796. X                 * message (if necessary). */
  797. X    char *name;            /* File name, which may begin with "~/"
  798. X                 * (to indicate current user's home directory)
  799. X                 * or "~<user>/" (to indicate any user's
  800. X                 * home directory). */
  801. X{
  802. X#define STATIC_BUF_SIZE 50
  803. X    static char staticBuf[STATIC_BUF_SIZE];
  804. X    static int curSize = STATIC_BUF_SIZE;
  805. X    static char *curBuf = staticBuf;
  806. X    char *dir;
  807. X    int length;
  808. X    int fromPw = 0;
  809. X    register char *p;
  810. X
  811. X    if (name[0] != '~') {
  812. X    return name;
  813. X    }
  814. X
  815. X    /*
  816. X     * First, find the directory name corresponding to the tilde entry.
  817. X     */
  818. X
  819. X    if ((name[1] == '/') || (name[1] == '\0')) {
  820. X    dir = getenv("HOME");
  821. X    if (dir == NULL) {
  822. X        Tcl_ResetResult(interp);
  823. X        Tcl_AppendResult(interp, "couldn't find HOME environment ",
  824. X            "variable to expand \"", name, "\"", (char *) NULL);
  825. X        return NULL;
  826. X    }
  827. X    p = name+1;
  828. X    } else {
  829. X    struct passwd *pwPtr;
  830. X
  831. X    for (p = &name[1]; (*p != 0) && (*p != '/'); p++) {
  832. X        /* Null body;  just find end of name. */
  833. X    }
  834. X    length = p-&name[1];
  835. X    if (length >= curSize) {
  836. X        length = curSize-1;
  837. X    }
  838. X    memcpy((VOID *) curBuf, (VOID *) name+1, length);
  839. X    curBuf[length] = '\0';
  840. X    pwPtr = getpwnam(curBuf);
  841. X    if (pwPtr == NULL) {
  842. X        Tcl_ResetResult(interp);
  843. X        Tcl_AppendResult(interp, "user \"", curBuf,
  844. X            "\" doesn't exist", (char *) NULL);
  845. X        return NULL;
  846. X    }
  847. X    dir = pwPtr->pw_dir;
  848. X    fromPw = 1;
  849. X    }
  850. X
  851. X    /*
  852. X     * Grow the buffer if necessary to make enough space for the
  853. X     * full file name.
  854. X     */
  855. X
  856. X    length = strlen(dir) + strlen(p);
  857. X    if (length >= curSize) {
  858. X    if (curBuf != staticBuf) {
  859. X        ckfree(curBuf);
  860. X    }
  861. X    curSize = length + 1;
  862. X    curBuf = (char *) ckalloc((unsigned) curSize);
  863. X    }
  864. X
  865. X    /*
  866. X     * Finally, concatenate the directory name with the remainder
  867. X     * of the path in the buffer.
  868. X     */
  869. X
  870. X    strcpy(curBuf, dir);
  871. X    strcat(curBuf, p);
  872. X    if (fromPw) {
  873. X    endpwent();
  874. X    }
  875. X    return curBuf;
  876. X}
  877. X
  878. X/*
  879. X *----------------------------------------------------------------------
  880. X *
  881. X * Tcl_GlobCmd --
  882. X *
  883. X *    This procedure is invoked to process the "glob" Tcl command.
  884. X *    See the user documentation for details on what it does.
  885. X *
  886. X * Results:
  887. X *    A standard Tcl result.
  888. X *
  889. X * Side effects:
  890. X *    See the user documentation.
  891. X *
  892. X *----------------------------------------------------------------------
  893. X */
  894. X
  895. X    /* ARGSUSED */
  896. Xint
  897. XTcl_GlobCmd(dummy, interp, argc, argv)
  898. X    ClientData dummy;            /* Not used. */
  899. X    Tcl_Interp *interp;            /* Current interpreter. */
  900. X    int argc;                /* Number of arguments. */
  901. X    char **argv;            /* Argument strings. */
  902. X{
  903. X    int i, result, noComplain;
  904. X
  905. X    if (argc < 2) {
  906. X    notEnoughArgs:
  907. X    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  908. X        " ?-nocomplain? name ?name ...?\"", (char *) NULL);
  909. X    return TCL_ERROR;
  910. X    }
  911. X    noComplain = 0;
  912. X    if ((argv[1][0] == '-') && (strcmp(argv[1], "-nocomplain") == 0)) {
  913. X    if (argc < 3) {
  914. X        goto notEnoughArgs;
  915. X    }
  916. X    noComplain = 1;
  917. X    }
  918. X
  919. X    for (i = 1 + noComplain; i < argc; i++) {
  920. X    char *thisName;
  921. X
  922. X    /*
  923. X     * Do special checks for names starting at the root and for
  924. X     * names beginning with ~.  Then let DoGlob do the rest.
  925. X     */
  926. X
  927. X    thisName = argv[i];
  928. X    if (*thisName == '~') {
  929. X        thisName = Tcl_TildeSubst(interp, thisName);
  930. X        if (thisName == NULL) {
  931. X        return TCL_ERROR;
  932. X        }
  933. X    }
  934. X    if (*thisName == '/') {
  935. X        result = DoGlob(interp, "/", thisName+1);
  936. X    } else {
  937. X        result = DoGlob(interp, "", thisName);
  938. X    }
  939. X    if (result != TCL_OK) {
  940. X        return result;
  941. X    }
  942. X    }
  943. X    if ((*interp->result == 0) && !noComplain) {
  944. X    interp->result = "no files matched glob pattern(s)";
  945. X    return TCL_ERROR;
  946. X    }
  947. X    return TCL_OK;
  948. X}
  949. END_OF_FILE
  950. if test 14435 -ne `wc -c <'tcl6.1/tclGlob.c'`; then
  951.     echo shar: \"'tcl6.1/tclGlob.c'\" unpacked with wrong size!
  952. fi
  953. # end of 'tcl6.1/tclGlob.c'
  954. fi
  955. if test -f 'tcl6.1/tests/history.test' -a "${1}" != "-c" ; then 
  956.   echo shar: Will not clobber existing file \"'tcl6.1/tests/history.test'\"
  957. else
  958. echo shar: Extracting \"'tcl6.1/tests/history.test'\" \(12710 characters\)
  959. sed "s/^X//" >'tcl6.1/tests/history.test' <<'END_OF_FILE'
  960. X# Commands covered:  history
  961. X#
  962. X# This file contains a collection of tests for one or more of the Tcl
  963. X# built-in commands.  Sourcing this file into Tcl runs the tests and
  964. X# generates output for errors.  No output means no errors were found.
  965. X#
  966. X# Copyright 1991 Regents of the University of California
  967. X# Permission to use, copy, modify, and distribute this
  968. X# software and its documentation for any purpose and without
  969. X# fee is hereby granted, provided that this copyright notice
  970. X# appears in all copies.  The University of California makes no
  971. X# representations about the suitability of this software for any
  972. X# purpose.  It is provided "as is" without express or implied
  973. X# warranty.
  974. X#
  975. X# $Header: /sprite/src/lib/tcl/tests/RCS/history.test,v 1.7 91/09/09 11:50:13 ouster Exp $ (Berkeley)
  976. X  
  977. Xif {[info commands history] == ""} {
  978. X    puts stdout "This version of Tcl was built without the history command;\n"
  979. X    puts stdout "history tests will be skipped.\n"
  980. X    return
  981. X}
  982. X
  983. Xif {[string compare test [info procs test]] == 1} then {source defs}
  984. X
  985. Xset num [history nextid]
  986. Xhistory keep 3
  987. Xhistory add {set a 12345}
  988. Xhistory add {set b [format {A test %s} string]}
  989. Xhistory add {Another test}
  990. X
  991. X# "history event"
  992. X
  993. Xtest history-1.1 {event option} {history event -1} \
  994. X    {set b [format {A test %s} string]}
  995. Xtest history-1.2 {event option} {history event $num} \
  996. X    {set a 12345}
  997. Xtest history-1.3 {event option} {history event [expr $num+2]} \
  998. X    {Another test}
  999. Xtest history-1.4 {event option} {history event set} \
  1000. X    {set b [format {A test %s} string]}
  1001. Xtest history-1.5 {event option} {history e "* a*"} \
  1002. X    {set a 12345}
  1003. Xtest history-1.6 {event option} {catch {history event *gorp} msg} 1
  1004. Xtest history-1.7 {event option} {
  1005. X    catch {history event *gorp} msg
  1006. X    set msg
  1007. X} {no event matches "*gorp"}
  1008. Xtest history-1.8 {event option} {history event} \
  1009. X    {set b [format {A test %s} string]}
  1010. Xtest history-1.9 {event option} {catch {history event 123 456} msg} 1
  1011. Xtest history-1.10 {event option} {
  1012. X    catch {history event 123 456} msg
  1013. X    set msg
  1014. X} {wrong # args: should be "history event ?event?"}
  1015. X
  1016. X# "history redo"
  1017. X
  1018. Xset a 0
  1019. Xhistory redo -2
  1020. Xtest history-2.1 {redo option} {set a} 12345
  1021. Xset b 0
  1022. Xhistory redo
  1023. Xtest history-2.2 {redo option} {set b} {A test string}
  1024. Xtest history-2.3 {redo option} {catch {history redo -3 -4}} 1
  1025. Xtest history-2.4 {redo option} {
  1026. X    catch {history redo -3 -4} msg
  1027. X    set msg
  1028. X} {wrong # args: should be "history redo ?event?"}
  1029. X
  1030. X# "history add"
  1031. X
  1032. Xhistory add "set a 444" exec
  1033. Xtest history-3.1 {add option} {set a} 444
  1034. Xtest history-3.2 {add option} {catch {history add "set a 444" execGorp}} 1
  1035. Xtest history-3.3 {add option} {
  1036. X    catch {history add "set a 444" execGorp} msg
  1037. X    set msg
  1038. X} {bad argument "execGorp": should be "exec"}
  1039. Xtest history-3.4 {add option} {catch {history add "set a 444" a} msg} 1
  1040. Xtest history-3.5 {add option} {
  1041. X    catch {history add "set a 444" a} msg
  1042. X    set msg
  1043. X} {bad argument "a": should be "exec"}
  1044. Xhistory add "set a 555" e
  1045. Xtest history-3.6 {add option} {set a} 555
  1046. Xhistory add "set a 666"
  1047. Xtest history-3.7 {add option} {set a} 555
  1048. Xtest history-3.8 {add option} {catch {history add "set a 666" e f} msg} 1
  1049. Xtest history-3.9 {add option} {
  1050. X    catch {history add "set a 666" e f} msg
  1051. X    set msg
  1052. X} {wrong # args: should be "history add event ?exec?"}
  1053. X
  1054. X# "history change"
  1055. X
  1056. Xhistory change "A test value"
  1057. Xtest history-4.1 {change option} {history event [expr {[history n]-1}]} \
  1058. X    "A test value"
  1059. Xhistory c "Another test" -1
  1060. Xtest history-4.2 {change option} {history e} "Another test"
  1061. Xtest history-4.3 {change option} {history event [expr {[history n]-1}]} \
  1062. X    "A test value"
  1063. Xtest history-4.4 {change option} {catch {history change Foo 4 10}} 1
  1064. Xtest history-4.5 {change option} {
  1065. X    catch {history change Foo 4 10} msg
  1066. X    set msg
  1067. X} {wrong # args: should be "history change newValue ?event?"}
  1068. Xtest history-4.6 {change option} {
  1069. X    catch {history change Foo [expr {[history n]-4}]}
  1070. X} 1
  1071. Xtest history-4.7 {change option} {
  1072. X    catch {history change Foo [expr {[history n]-4}]}
  1073. X    set msg
  1074. X} {wrong # args: should be "history change newValue ?event?"}
  1075. X
  1076. X# "history info"
  1077. X
  1078. Xset num [history n]
  1079. Xhistory add set\ a\ {b\nc\ d\ e}
  1080. Xhistory add {set b 1234}
  1081. Xhistory add set\ c\ {a\nb\nc}
  1082. Xtest history-5.1 {info option} {history info} [format {%6d  set a {b
  1083. X    c d e}
  1084. X%6d  set b 1234
  1085. X%6d  set c {a
  1086. X    b
  1087. X    c}} $num [expr $num+1] [expr $num+2]]
  1088. Xtest history-5.2 {info option} {history i 2} [format {%6d  set b 1234
  1089. X%6d  set c {a
  1090. X    b
  1091. X    c}} [expr $num+1] [expr $num+2]]
  1092. Xtest history-5.3 {info option} {catch {history i 2 3}} 1
  1093. Xtest history-5.4 {info option} {
  1094. X    catch {history i 2 3} msg
  1095. X    set msg
  1096. X} {wrong # args: should be "history info ?count?"}
  1097. Xtest history-5.5 {info option} {history} [format {%6d  set a {b
  1098. X    c d e}
  1099. X%6d  set b 1234
  1100. X%6d  set c {a
  1101. X    b
  1102. X    c}} $num [expr $num+1] [expr $num+2]]
  1103. X
  1104. X# "history keep"
  1105. X
  1106. Xhistory add "foo1"
  1107. Xhistory add "foo2"
  1108. Xhistory add "foo3"
  1109. Xhistory keep 2
  1110. Xtest history-6.1 {keep option} {history event [expr [history n]-1]} foo3
  1111. Xtest history-6.2 {keep option} {history event -1} foo2
  1112. Xtest history-6.3 {keep option} {catch {history event -3}} 1
  1113. Xtest history-6.4 {keep option} {
  1114. X    catch {history event -3} msg
  1115. X    set msg
  1116. X} {event "-3" is too far in the past}
  1117. Xhistory k 5
  1118. Xtest history-6.5 {keep option} {history event -1} foo2
  1119. Xtest history-6.6 {keep option} {history event -2} {}
  1120. Xtest history-6.7 {keep option} {history event -3} {}
  1121. Xtest history-6.8 {keep option} {history event -4} {}
  1122. Xtest history-6.9 {keep option} {catch {history event -5}} 1
  1123. Xtest history-6.10 {keep option} {catch {history keep 4 6}} 1
  1124. Xtest history-6.11 {keep option} {
  1125. X    catch {history keep 4 6} msg
  1126. X    set msg
  1127. X} {wrong # args: should be "history keep number"}
  1128. Xtest history-6.12 {keep option} {catch {history keep}} 1
  1129. Xtest history-6.13 {keep option} {
  1130. X    catch {history keep} msg
  1131. X    set msg
  1132. X} {wrong # args: should be "history keep number"}
  1133. Xtest history-6.14 {keep option} {catch {history keep -3}} 1
  1134. Xtest history-6.15 {keep option} {
  1135. X    catch {history keep -3} msg
  1136. X    set msg
  1137. X} {illegal keep count "-3"}
  1138. X
  1139. X# "history nextid"
  1140. X
  1141. Xset num [history n]
  1142. Xhistory add "Testing"
  1143. Xhistory add "Testing2"
  1144. Xtest history-7.1 {nextid option} {history event} "Testing"
  1145. Xtest history-7.2 {nextid option} {history next} [expr $num+2]
  1146. Xtest history-7.3 {nextid option} {catch {history nextid garbage}} 1
  1147. Xtest history-7.4 {nextid option} {
  1148. X    catch {history nextid garbage} msg
  1149. X    set msg
  1150. X} {wrong # args: should be "history nextid"}
  1151. X
  1152. X# "history substitute"
  1153. X
  1154. Xtest history-8.1 {substitute option} {
  1155. X    history add "set a {test foo test b c test}"
  1156. X    history add "Test command 2"
  1157. X    set a 0
  1158. X    history substitute foo bar -1
  1159. X    set a
  1160. X} {test bar test b c test}
  1161. Xtest history-8.2 {substitute option} {
  1162. X    history add "set a {test foo test b c test}"
  1163. X    history add "Test command 2"
  1164. X    set a 0
  1165. X    history substitute test gorp
  1166. X    set a
  1167. X} {gorp foo gorp b c gorp}
  1168. Xtest history-8.3 {substitute option} {
  1169. X    history add "set a {test foo test b c test}"
  1170. X    history add "Test command 2"
  1171. X    set a 0
  1172. X    history sub " te" to
  1173. X    set a
  1174. X} {test footost b ctost}
  1175. Xtest history-8.4 {substitute option} {catch {history sub xxx yyy}} 1
  1176. Xtest history-8.5 {substitute option} {
  1177. X    catch {history sub xxx yyy} msg
  1178. X    set msg
  1179. X} {"xxx" doesn't appear in event}
  1180. Xtest history-8.6 {substitute option} {catch {history s a b -10}} 1
  1181. Xtest history-8.7 {substitute option} {
  1182. X    catch {history s a b -10} msg
  1183. X    set msg
  1184. X} {event "-10" is too far in the past}
  1185. Xtest history-8.8 {substitute option} {catch {history s a b -1 20}} 1
  1186. Xtest history-8.9 {substitute option} {
  1187. X    catch {history s a b -1 20} msg
  1188. X    set msg
  1189. X} {wrong # args: should be "history substitute old new ?event?"}
  1190. X
  1191. X# "history words"
  1192. X
  1193. Xtest history-9.1 {words option} {
  1194. X    history add {word0 word1 word2 a b c word6}
  1195. X    history add foo
  1196. X    history words 0-$
  1197. X} {word0 word1 word2 a b c word6}
  1198. Xtest history-9.2 {words option} {
  1199. X    history add {word0 word1 word2 a b c word6}
  1200. X    history add foo
  1201. X    history w 2 -1
  1202. X} word2
  1203. Xtest history-9.3 {words option} {
  1204. X    history add {word0 word1 word2 a b c word6}
  1205. X    history add foo
  1206. X    history wo $
  1207. X} word6
  1208. Xtest history-9.4 {words option} {catch {history w 1--1} msg} 1
  1209. Xtest history-9.5 {words option} {
  1210. X    catch {history w 1--1} msg
  1211. X    set msg
  1212. X} {bad word selector "1--1":  should be num-num or pattern}
  1213. Xtest history-9.6 {words option} {
  1214. X    history add {word0 word1 word2 a b c word6}
  1215. X    history add foo
  1216. X    history w w
  1217. X} {}
  1218. Xtest history-9.7 {words option} {
  1219. X    history add {word0 word1 word2 a b c word6}
  1220. X    history add foo
  1221. X    history w *2
  1222. X} word2
  1223. Xtest history-9.8 {words option} {
  1224. X    history add {word0 word1 word2 a b c word6}
  1225. X    history add foo
  1226. X    history w *or*
  1227. X} {word0 word1 word2 word6}
  1228. Xtest history-9.9 {words option} {catch {history words 10}} 1
  1229. Xtest history-9.10 {words option} {
  1230. X    catch {history words 10} msg
  1231. X    set msg
  1232. X} {word selector "10" specified non-existent words}
  1233. Xtest history-9.11 {words option} {catch {history words 1 -1 20}} 1
  1234. Xtest history-9.12 {words option} {
  1235. X    catch {history words 1 -1 20} msg
  1236. X    set msg
  1237. X} {wrong # args: should be "history words num-num/pat ?event?"}
  1238. X
  1239. X# history revision
  1240. X
  1241. Xtest history-10.1 {history revision} {
  1242. X    set a 0
  1243. X    history a {set a 12345}
  1244. X    history a {set a [history e]} exec
  1245. X    set a
  1246. X} {set a 12345}
  1247. Xtest history-10.2 {history revision} {
  1248. X    set a 0
  1249. X    history a {set a 12345}
  1250. X    history a {set a [history e]} exec
  1251. X    history a foo
  1252. X    history ev -1
  1253. X} {set a {set a 12345}}
  1254. Xtest history-10.3 {history revision} {
  1255. X    set a 0
  1256. X    history a {set a 12345}
  1257. X    history a {set a [history e]} exec
  1258. X    history a foo
  1259. X    history a {history r -2} exec
  1260. X    history a {set a 12345}
  1261. X    history ev -1
  1262. X} {set a {set a 12345}}
  1263. Xtest history-10.4 {history revision} {
  1264. X    history a {set a 12345}
  1265. X    history a {history s 123 999} exec
  1266. X    history a foo
  1267. X    history ev -1
  1268. X} {set a 99945}
  1269. Xtest history-10.5 {history revision} {
  1270. X    history add {word0 word1 word2 a b c word6}
  1271. X    history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
  1272. X    set a
  1273. X} {word0 {a b}}
  1274. Xtest history-10.6 {history revision} {
  1275. X    history add {word0 word1 word2 a b c word6}
  1276. X    history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
  1277. X    history add foo
  1278. X    history ev
  1279. X} {set a [list word0 {a b}]}
  1280. Xtest history-10.7 {history revision} {
  1281. X    history add {word0 word1 word2 a b c word6}
  1282. X    history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
  1283. X    history add {format b}
  1284. X    history add {word0 word1 word2 a b c word6}
  1285. X    set a 0
  1286. X    history add {set [history subs b a -2] [list abc [history r -2] [history w 1-3]]} exec
  1287. X    history add foo
  1288. X    history ev
  1289. X} {set [format a] [list abc [format b] {word1 word2 a}]}
  1290. Xtest history-10.8 {history revision} {
  1291. X    history add {set a 12345}
  1292. X    concat a b c
  1293. X    history add {history redo; set b 44} exec
  1294. X    history add foo
  1295. X    history ev
  1296. X} {set a 12345; set b 44}
  1297. Xtest history-10.9 {history revision} {
  1298. X    history add {set a 12345}
  1299. X    history add {history redo; history change "A simple test"; history subs 45 xx} exec
  1300. X    set a
  1301. X} 123xx
  1302. Xtest history-10.10 {history revision} {
  1303. X    history add {set a 12345}
  1304. X    history add {history redo; history change "A simple test"; history subs 45 xx} exec
  1305. X    history add foo
  1306. X    history e
  1307. X} {A simple test}
  1308. Xtest history-10.11 {history revision} {
  1309. X    history add {word0 word1 $ a b c word6}
  1310. X    history add {set a [history w 4-[history word 2]]} exec
  1311. X    set a
  1312. X} {b c word6}
  1313. Xtest history-10.12 {history revision} {
  1314. X    history add {word0 word1 $ a b c word6}
  1315. X    history add {set a [history w 4-[history word 2]]} exec
  1316. X    history add foo
  1317. X    history e
  1318. X} {set a {b c word6}}
  1319. Xtest history-10.13 {history revision} {
  1320. X    history add {history word 0} exec
  1321. X    history add foo
  1322. X    history e
  1323. X} {history word 0}
  1324. Xtest history-10.14 {history revision} {
  1325. X    history add {set a [history word 0; format c]} exec
  1326. X    history add foo
  1327. X    history e
  1328. X} {set a [history word 0; format c]}
  1329. Xtest history-10.15 {history revision even when nested} {
  1330. X    proc x {a b} {history word $a $b}
  1331. X    history add {word1 word2 word3 word4}
  1332. X    history add {set a [x 1-3 -1]} exec
  1333. X    history add foo
  1334. X    history e
  1335. X} {set a {word2 word3 word4}}
  1336. Xtest history-10.16 {disable history revision in nested history evals} {
  1337. X    history add {word1 word2 word3 word4}
  1338. X    history add {set a [history words 0]; history add foo; set a [history words 0]} exec
  1339. X    history e
  1340. X} {set a word1; history add foo; set a [history words 0]}
  1341. X
  1342. X# miscellaneous
  1343. X
  1344. Xtest history-11.1 {miscellaneous} {catch {history gorp} msg} 1
  1345. Xtest history-11.2 {miscellaneous} {
  1346. X    catch {history gorp} msg
  1347. X    set msg
  1348. X} {bad option "gorp": must be add, change, event, info, keep, nextid, redo, substitute, or words}
  1349. END_OF_FILE
  1350. if test 12710 -ne `wc -c <'tcl6.1/tests/history.test'`; then
  1351.     echo shar: \"'tcl6.1/tests/history.test'\" unpacked with wrong size!
  1352. fi
  1353. # end of 'tcl6.1/tests/history.test'
  1354. fi
  1355. echo shar: End of archive 11 \(of 33\).
  1356. cp /dev/null ark11isdone
  1357. MISSING=""
  1358. 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
  1359.     if test ! -f ark${I}isdone ; then
  1360.     MISSING="${MISSING} ${I}"
  1361.     fi
  1362. done
  1363. if test "${MISSING}" = "" ; then
  1364.     echo You have unpacked all 33 archives.
  1365.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1366. else
  1367.     echo You still need to unpack the following archives:
  1368.     echo "        " ${MISSING}
  1369. fi
  1370. ##  End of shell archive.
  1371. exit 0
  1372.  
  1373. exit 0 # Just in case...
  1374. -- 
  1375. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  1376. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  1377. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  1378. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  1379.