home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume25 / tcl / part09 < prev    next >
Encoding:
Text File  |  1991-11-14  |  48.8 KB  |  1,610 lines
  1. Newsgroups: comp.sources.misc
  2. From: karl@sugar.neosoft.com (Karl Lehenbauer)
  3. Subject:  v25i077:  tcl - tool command language, version 6.1, Part09/33
  4. Message-ID: <1991Nov14.202859.23738@sparky.imd.sterling.com>
  5. X-Md4-Signature: a1f8db06c7db444232fb176a01e9bd61
  6. Date: Thu, 14 Nov 1991 20:28:59 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: karl@sugar.neosoft.com (Karl Lehenbauer)
  10. Posting-number: Volume 25, Issue 77
  11. Archive-name: tcl/part09
  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 9 (of 33)."
  21. # Contents:  tcl6.1/doc/library.man tcl6.1/tcl.h tcl6.1/tclEnv.c
  22. #   tcl6.1/tests/info.test
  23. # Wrapped by karl@one on Tue Nov 12 19:44:18 1991
  24. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  25. if test -f 'tcl6.1/doc/library.man' -a "${1}" != "-c" ; then 
  26.   echo shar: Will not clobber existing file \"'tcl6.1/doc/library.man'\"
  27. else
  28. echo shar: Extracting \"'tcl6.1/doc/library.man'\" \(11210 characters\)
  29. sed "s/^X//" >'tcl6.1/doc/library.man' <<'END_OF_FILE'
  30. X'\" Copyright 1991 Regents of the University of California
  31. X'\" Permission to use, copy, modify, and distribute this
  32. X'\" documentation for any purpose and without fee is hereby
  33. X'\" granted, provided that this notice appears in all copies.
  34. X'\" The University of California makes no representations about
  35. X'\" the suitability of this material for any purpose.  It is
  36. X'\" provided "as is" without express or implied warranty.
  37. X'\" 
  38. X'\" $Header: /user6/ouster/tcl/doc/RCS/library.man,v 1.1 91/09/26 11:12:39 ouster Exp $ SPRITE (Berkeley)
  39. X'
  40. X.\" The definitions below are for supplemental macros used in Sprite
  41. X.\" manual entries.
  42. X.\"
  43. X.\" .HS name section [date [version]]
  44. X.\"    Replacement for .TH in other man pages.  See below for valid
  45. X.\"    section names.
  46. X.\"
  47. X.\" .AP type name in/out [indent]
  48. X.\"    Start paragraph describing an argument to a library procedure.
  49. X.\"    type is type of argument (int, etc.), in/out is either "in", "out",
  50. X.\"    or "in/out" to describe whether procedure reads or modifies arg,
  51. X.\"    and indent is equivalent to second arg of .IP (shouldn't ever be
  52. X.\"    needed;  use .AS below instead)
  53. X.\"
  54. X.\" .AS [type [name]]
  55. X.\"    Give maximum sizes of arguments for setting tab stops.  Type and
  56. X.\"    name are examples of largest possible arguments that will be passed
  57. X.\"    to .AP later.  If args are omitted, default tab stops are used.
  58. X.\"
  59. X.\" .BS
  60. X.\"    Start box enclosure.  From here until next .BE, everything will be
  61. X.\"    enclosed in one large box.
  62. X.\"
  63. X.\" .BE
  64. X.\"    End of box enclosure.
  65. X.\"
  66. X.\" .VS
  67. X.\"    Begin vertical sidebar, for use in marking newly-changed parts
  68. X.\"    of man pages.
  69. X.\"
  70. X.\" .VE
  71. X.\"    End of vertical sidebar.
  72. X.\"
  73. X.\" .DS
  74. X.\"    Begin an indented unfilled display.
  75. X.\"
  76. X.\" .DE
  77. X.\"    End of indented unfilled display.
  78. X.\"
  79. X'    # Heading for Sprite man pages
  80. X.de HS
  81. X.if '\\$2'cmds'       .TH \\$1 1 \\$3 \\$4
  82. X.if '\\$2'lib'        .TH \\$1 3 \\$3 \\$4
  83. X.if '\\$2'tcl'        .TH \\$1 3 \\$3 \\$4
  84. X.if '\\$2'tk'         .TH \\$1 3 \\$3 \\$4
  85. X.if t .wh -1.3i ^B
  86. X.nr ^l \\n(.l
  87. X.ad b
  88. X..
  89. X'    # Start an argument description
  90. X.de AP
  91. X.ie !"\\$4"" .TP \\$4
  92. X.el \{\
  93. X.   ie !"\\$2"" .TP \\n()Cu
  94. X.   el          .TP 15
  95. X.\}
  96. X.ie !"\\$3"" \{\
  97. X.ta \\n()Au \\n()Bu
  98. X\&\\$1    \\fI\\$2\\fP    (\\$3)
  99. X.\".b
  100. X.\}
  101. X.el \{\
  102. X.br
  103. X.ie !"\\$2"" \{\
  104. X\&\\$1    \\fI\\$2\\fP
  105. X.\}
  106. X.el \{\
  107. X\&\\fI\\$1\\fP
  108. X.\}
  109. X.\}
  110. X..
  111. X'    # define tabbing values for .AP
  112. X.de AS
  113. X.nr )A 10n
  114. X.if !"\\$1"" .nr )A \\w'\\$1'u+3n
  115. X.nr )B \\n()Au+15n
  116. X.\"
  117. X.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
  118. X.nr )C \\n()Bu+\\w'(in/out)'u+2n
  119. X..
  120. X'    # BS - start boxed text
  121. X'    # ^y = starting y location
  122. X'    # ^b = 1
  123. X.de BS
  124. X.br
  125. X.mk ^y
  126. X.nr ^b 1u
  127. X.if n .nf
  128. X.if n .ti 0
  129. X.if n \l'\\n(.lu\(ul'
  130. X.if n .fi
  131. X..
  132. X'    # BE - end boxed text (draw box now)
  133. X.de BE
  134. X.nf
  135. X.ti 0
  136. X.mk ^t
  137. X.ie n \l'\\n(^lu\(ul'
  138. X.el \{\
  139. X.\"    Draw four-sided box normally, but don't draw top of
  140. X.\"    box if the box started on an earlier page.
  141. X.ie !\\n(^b-1 \{\
  142. X\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
  143. X.\}
  144. X.el \}\
  145. X\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
  146. X.\}
  147. X.\}
  148. X.fi
  149. X.br
  150. X.nr ^b 0
  151. X..
  152. X'    # VS - start vertical sidebar
  153. X'    # ^Y = starting y location
  154. X'    # ^v = 1 (for troff;  for nroff this doesn't matter)
  155. X.de VS
  156. X.mk ^Y
  157. X.ie n 'mc \s12\(br\s0
  158. X.el .nr ^v 1u
  159. X..
  160. X'    # VE - end of vertical sidebar
  161. X.de VE
  162. X.ie n 'mc
  163. X.el \{\
  164. X.ev 2
  165. X.nf
  166. X.ti 0
  167. X.mk ^t
  168. X\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
  169. X.sp -1
  170. X.fi
  171. X.ev
  172. X.\}
  173. X.nr ^v 0
  174. X..
  175. X'    # Special macro to handle page bottom:  finish off current
  176. X'    # box/sidebar if in box/sidebar mode, then invoked standard
  177. X'    # page bottom macro.
  178. X.de ^B
  179. X.ev 2
  180. X'ti 0
  181. X'nf
  182. X.mk ^t
  183. X.if \\n(^b \{\
  184. X.\"    Draw three-sided box if this is the box's first page,
  185. X.\"    draw two sides but no top otherwise.
  186. X.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
  187. X.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
  188. X.\}
  189. X.if \\n(^v \{\
  190. X.nr ^x \\n(^tu+1v-\\n(^Yu
  191. X\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
  192. X.\}
  193. X.bp
  194. X'fi
  195. X.ev
  196. X.if \\n(^b \{\
  197. X.mk ^y
  198. X.nr ^b 2
  199. X.\}
  200. X.if \\n(^v \{\
  201. X.mk ^Y
  202. X.\}
  203. X..
  204. X'    # DS - begin display
  205. X.de DS
  206. X.RS
  207. X.nf
  208. X.sp
  209. X..
  210. X'    # DE - end display
  211. X.de DE
  212. X.fi
  213. X.RE
  214. X.sp .5
  215. X..
  216. X.de UL
  217. X\\$1\l'|0\(ul'\\$2
  218. X..
  219. X.HS library tcl
  220. X.BS
  221. X.SH NAME
  222. Xlibrary \- standard library of Tcl procedures
  223. X.SH SYNOPSIS
  224. X.VS
  225. X.nf
  226. X\fBauto_execok \fIcmd\fR
  227. X\fBauto_load \fIcmd\fR
  228. X\fBauto_mkindex \fIdir pattern\fR
  229. X\fBauto_reset\fR
  230. X\fBparray \fIarrayName\fR
  231. X\fBunknown \fIcmd \fR?\fIarg arg ...\fR?
  232. X.fi
  233. X.BE
  234. X
  235. X.SH INTRODUCTION
  236. X.PP
  237. XTcl includes a library of Tcl procedures for commonly-needed functions.
  238. XThe procedures defined in the Tcl library are generic ones suitable
  239. Xfor use by many different applications.
  240. XThe location of the Tcl library is returned by the \fBinfo library\fR
  241. Xcommand.
  242. XIn addition to the Tcl library, each application will normally have
  243. Xits own library of support procedures as well;  the location of this
  244. Xlibrary is normally given by the value of the \fB$appLibrary\fR
  245. Xglobal variable.
  246. X.PP
  247. XTo access the procedures in the Tcl library, an application should
  248. Xsource the file \fBinit.tcl\fR in the library, for example with
  249. Xthe Tcl command
  250. X.DS
  251. X\fBsource [info library]/init.tcl
  252. X.DE
  253. XThis will define the \fBunknown\fR procedure and arrange for the
  254. Xother procedures to be loaded on-demand using the auto-load
  255. Xmechanism defined below.
  256. X
  257. X.SH "COMMAND PROCEDURES"
  258. X.PP
  259. XThe following procedures are provided in the Tcl library:
  260. X.TP
  261. X\fBauto_execok \fIcmd\fR
  262. XDetermines whether there is an executable file by the name \fIcmd\fR.
  263. XThis command examines the directories in the current search path
  264. X(given by the PATH enviornment variable) to see if there is an
  265. Xexecutable file named \fIcmd\fR in any of those directories.
  266. XIf so, it returns 1;  if not it returns 0.  \fBAuto_exec\fR
  267. Xremembers information about previous searches in an array
  268. Xnamed \fBauto_execs\fR;  this avoids the path search in
  269. Xfuture calls for the same \fIcmd\fR.  The command \fBauto_reset\fR
  270. Xmay be used to force \fBauto_execok\fR to forget its cached
  271. Xinformation.
  272. X.TP
  273. X\fBauto_load \fIcmd\fR
  274. XThis command attempts to load the definition for a Tcl procedure named
  275. X\fIcmd\fR.
  276. XTo do this, it searches an \fIauto-load path\fR, which is a list of
  277. Xone or more directories.
  278. XThe auto-load path is given by the global variable \fB$auto_path\fR
  279. Xif it exists.
  280. XIf there is no \fB$auto_path\fR variable, then the TCLLIBPATH environment
  281. Xvariable is used, if it exists.
  282. XOtherwise the auto-load path consists of just the Tcl library directory.
  283. XWithin each directory in the auto-load path there must be a file
  284. X\fBtclIndex\fR that describes the procedures defined in that directory
  285. Xand the file in which each procedure is defined.  The \fBtclIndex\fR
  286. Xfile should be generated with the \fBauto_mkindex\fR command.
  287. XIf \fIcmd\fR is found in an index file, then the appropriate
  288. Xscript is \fBsource\fRd to create the procedure.
  289. XThe \fBauto_load\fR command returns 1 if the script was successfully
  290. Xsourced and \fIcmd\fR now exists.
  291. XThe command returns 0 if there was no index entry for \fIcmd\fR
  292. Xor if the script didn't actually define \fIcmd\fR (e.g. because
  293. Xindex information is out of date).
  294. XIf an error occurs while processing the script, then that error
  295. Xis returned.
  296. X\fBAuto_load\fR only reads the index information once and saves it
  297. Xin the array \fBauto_index\fR;  future calls to \fBauto_load\fR
  298. Xcheck for \fIcmd\fR in the array rather than re-reading the index
  299. Xfiles.
  300. XThe cached index information may be deleted with the command
  301. X\fBauto_reset\fR.
  302. XThis will force the next \fBauto_load\fR command to reload the
  303. Xindex database from disk.
  304. X.TP
  305. X\fBauto_mkindex \fIdir pattern\fR
  306. XGenerates an index suitable for use by \fBauto_load\fR.
  307. XThe command searches \fIdir\fR for all files whose names match
  308. X\fIpattern\fR (matching is done with the \fBglob\fR command),
  309. Xgenerates an index of all the Tcl command
  310. Xprocedures defined in all the matching files, and stores the
  311. Xindex information in a file named \fBtclIndex\fR in \fIdir\fR.
  312. XFor example, the command
  313. X.RS
  314. X.DS
  315. X\fBauto_mkindex foo *.tcl\fR
  316. X.DE
  317. X.LP
  318. Xwill read all the \fB.tcl\fR files in subdirectory \fBfoo\fR
  319. Xand generate a new index file \fBfoo/tclIndex\fR.
  320. X.PP
  321. X\fBAuto_mkindex\fR parses the Tcl scripts in a relatively
  322. Xunsophisticated way:  if any line contains the word \fBproc\fR
  323. Xas its first characters then it is assumed to be a procedure
  324. Xdefinition and the next word of the line is taken as the
  325. Xprocedure's name.
  326. XProcedure definitions that don't appear in this way (e.g. they
  327. Xhave spaces before the \fBproc\fR) will not be indexed.
  328. X.RE
  329. X.TP
  330. X\fBauto_reset\fR
  331. XDestroys all the information cached by \fBauto_execok\fR and
  332. X\fBauto_load\fR.
  333. XThis information will be re-read from disk the next time it is
  334. Xneeded.
  335. X.TP
  336. X\fBparray \fIarrayName\fR
  337. XPrints on standard output the names and values of all the elements
  338. Xin the array \fIarrayName\fR.
  339. X\fBArrayName\fR must be a global array.
  340. X.TP
  341. X\fBunknown \fIcmd \fR?\fIarg arg ...\fR?
  342. XThis procedure is invoked automatically by the Tcl interpreter
  343. Xwhenever the name of a command doesn't exist.
  344. XThe \fBunknown\fR procedure receives as its arguments the
  345. Xname and arguments of the missing command.
  346. X\fBUnknown\fR first calls \fBauto_load\fR to load a procedure for
  347. Xthe command.
  348. XIf this succeeds, then it executes the original command with its
  349. Xoriginal arguments.
  350. XIf the auto-load fails then \fBunknown\fR calls \fBauto_execok\fR
  351. Xto see if there is an executable file by the name \fIcmd\fR.
  352. XIf so, it invokes the Tcl \fBexec\fR command
  353. Xwith \fIcmd\fR and all the \fIargs\fR as arguments.
  354. XIf \fIcmd\fR can't be auto-executed, \fBunknown\fR checks to see if \fIcmd\fR is
  355. Xa unique abbreviation for an existing Tcl command.
  356. XIf so, it expands the command name and executes the command with
  357. Xthe original arguments.
  358. XFinally, if none of the above efforts has been able to execute
  359. Xthe command, \fBunknown\fR generates an error return.
  360. XIf the global variable \fBauto_noload\fR is defined, then the auto-load
  361. Xstep is skipped.
  362. XIf the global variable \fBauto_noexec\fR is defined then the
  363. Xauto-exec step is skipped.
  364. XUnder normal circumstances the return value from \fBunknown\fR
  365. Xis the return value from the command that was eventually
  366. Xexecuted.
  367. X
  368. X.SH "VARIABLES"
  369. X.PP
  370. XThe following global variables are defined or used by the procedures in
  371. Xthe Tcl library:
  372. X.TP
  373. X\fBauto_execs\fR
  374. XUsed by \fBauto_execok\fR to record information about whether
  375. Xparticular commands exist as executable files.
  376. X.TP
  377. X\fBauto_index\fR
  378. XUsed by \fBauto_load\fR to save the index information read from
  379. Xdisk.
  380. X.TP
  381. X\fBauto_noexec\fR
  382. XIf set to any value, then \fBunknown\fR will not attempt to auto-exec
  383. Xany commands.
  384. X.TP
  385. X\fBauto_noload\fR
  386. XIf set to any value, then \fBunknown\fR will not attempt to auto-load
  387. Xany commands.
  388. X.TP
  389. X\fBauto_path\fR
  390. XIf set, then it must contain a valid Tcl list giving directories to
  391. Xsearch during auto-load operations.
  392. X.TP
  393. X\fBenv(TCLLIBPATH)\fR
  394. XIf set, then it must contain a valid Tcl list giving directories to
  395. Xsearch during auto-load operations.
  396. XThis variable is only used if \fBauto_path\fR is not defined.
  397. X.TP
  398. X\fBunknown_active\fR
  399. XThis variable is set by \fBunknown\fR to indicate that it is active.
  400. XIt is used to detect errors where \fBunknown\fR recurses on itself
  401. Xinfinitely.
  402. XThe variable is unset before \fBunknown\fR returns.
  403. X
  404. X.SH KEYWORDS
  405. Xauto-exec, auto-load, library, unknown
  406. X.VE
  407. END_OF_FILE
  408. if test 11210 -ne `wc -c <'tcl6.1/doc/library.man'`; then
  409.     echo shar: \"'tcl6.1/doc/library.man'\" unpacked with wrong size!
  410. fi
  411. # end of 'tcl6.1/doc/library.man'
  412. fi
  413. if test -f 'tcl6.1/tcl.h' -a "${1}" != "-c" ; then 
  414.   echo shar: Will not clobber existing file \"'tcl6.1/tcl.h'\"
  415. else
  416. echo shar: Extracting \"'tcl6.1/tcl.h'\" \(11364 characters\)
  417. sed "s/^X//" >'tcl6.1/tcl.h' <<'END_OF_FILE'
  418. X/*
  419. X * tcl.h --
  420. X *
  421. X *    This header file describes the externally-visible facilities
  422. X *    of the Tcl interpreter.
  423. X *
  424. X * Copyright 1987-1991 Regents of the University of California
  425. X * Permission to use, copy, modify, and distribute this
  426. X * software and its documentation for any purpose and without
  427. X * fee is hereby granted, provided that the above copyright
  428. X * notice appear in all copies.  The University of California
  429. X * makes no representations about the suitability of this
  430. X * software for any purpose.  It is provided "as is" without
  431. X * express or implied warranty.
  432. X *
  433. X * $Header: /user6/ouster/tcl/RCS/tcl.h,v 1.76 91/11/05 10:12:30 ouster Exp $ SPRITE (Berkeley)
  434. X */
  435. X
  436. X#ifndef _TCL
  437. X#define _TCL
  438. X
  439. X#define TCL_VERSION "6.1"
  440. X
  441. X/*
  442. X * Definitions that allow this header file to be used either with or
  443. X * without ANSI C features like function prototypes.
  444. X */
  445. X
  446. X#undef _ANSI_ARGS_
  447. X#undef const
  448. X#if (defined(__STDC__) && !defined(NO_PROTOTYPE)) || defined(__cplusplus)
  449. X#   define _ANSI_ARGS_(x)    x
  450. X#   define CONST const
  451. X#   ifdef __cplusplus
  452. X#       define VARARGS (...)
  453. X#   else
  454. X#       define VARARGS ()
  455. X#   endif
  456. X#else
  457. X#   define _ANSI_ARGS_(x)    ()
  458. X#   define CONST
  459. X#endif
  460. X
  461. X#ifdef __cplusplus
  462. X#   define EXTERN extern "C"
  463. X#else
  464. X#   define EXTERN extern
  465. X#endif
  466. X
  467. X/*
  468. X * Miscellaneous declarations (to allow Tcl to be used stand-alone,
  469. X * without the rest of Sprite).
  470. X */
  471. X
  472. X#ifndef NULL
  473. X#define NULL 0
  474. X#endif
  475. X
  476. X#ifndef _CLIENTDATA
  477. Xtypedef int *ClientData;
  478. X#define _CLIENTDATA
  479. X#endif
  480. X
  481. X/*
  482. X * Data structures defined opaquely in this module.  The definitions
  483. X * below just provide dummy types.  A few fields are made visible in
  484. X * Tcl_Interp structures, namely those for returning string values.
  485. X * Note:  any change to the Tcl_Interp definition below must be mirrored
  486. X * in the "real" definition in tclInt.h.
  487. X */
  488. X
  489. Xtypedef struct Tcl_Interp{
  490. X    char *result;        /* Points to result string returned by last
  491. X                 * command. */
  492. X    void (*freeProc) _ANSI_ARGS_((char *blockPtr));
  493. X                /* Zero means result is statically allocated.
  494. X                 * If non-zero, gives address of procedure
  495. X                 * to invoke to free the result.  Must be
  496. X                 * freed by Tcl_Eval before executing next
  497. X                 * command. */
  498. X    int errorLine;        /* When TCL_ERROR is returned, this gives
  499. X                 * the line number within the command where
  500. X                 * the error occurred (1 means first line). */
  501. X} Tcl_Interp;
  502. X
  503. Xtypedef int *Tcl_Trace;
  504. Xtypedef int *Tcl_CmdBuf;
  505. X
  506. X/*
  507. X * When a TCL command returns, the string pointer interp->result points to
  508. X * a string containing return information from the command.  In addition,
  509. X * the command procedure returns an integer value, which is one of the
  510. X * following:
  511. X *
  512. X * TCL_OK        Command completed normally;  interp->result contains
  513. X *            the command's result.
  514. X * TCL_ERROR        The command couldn't be completed successfully;
  515. X *            interp->result describes what went wrong.
  516. X * TCL_RETURN        The command requests that the current procedure
  517. X *            return;  interp->result contains the procedure's
  518. X *            return value.
  519. X * TCL_BREAK        The command requests that the innermost loop
  520. X *            be exited;  interp->result is meaningless.
  521. X * TCL_CONTINUE        Go on to the next iteration of the current loop;
  522. X *            interp->result is meaninless.
  523. X */
  524. X
  525. X#define TCL_OK        0
  526. X#define TCL_ERROR    1
  527. X#define TCL_RETURN    2
  528. X#define TCL_BREAK    3
  529. X#define TCL_CONTINUE    4
  530. X
  531. X#define TCL_RESULT_SIZE 199
  532. X
  533. X/*
  534. X * Procedure types defined by Tcl:
  535. X */
  536. X
  537. Xtypedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
  538. Xtypedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
  539. X    Tcl_Interp *interp, int argc, char *argv[]));
  540. Xtypedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
  541. X    Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
  542. X    ClientData cmdClientData, int argc, char *argv[]));
  543. Xtypedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
  544. Xtypedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
  545. X    Tcl_Interp *interp, char *name1, char *name2, int flags));
  546. X
  547. X/*
  548. X * Flag values passed to Tcl_Eval (see the man page for details;  also
  549. X * see tclInt.h for additional flags that are only used internally by
  550. X * Tcl):
  551. X */
  552. X
  553. X#define TCL_BRACKET_TERM    1
  554. X
  555. X/*
  556. X * Flag value passed to Tcl_RecordAndEval to request no evaluation
  557. X * (record only).
  558. X */
  559. X
  560. X#define TCL_NO_EVAL        -1
  561. X
  562. X/*
  563. X * Specil freeProc values that may be passed to Tcl_SetResult (see
  564. X * the man page for details):
  565. X */
  566. X
  567. X#define TCL_VOLATILE    ((Tcl_FreeProc *) -1)
  568. X#define TCL_STATIC    ((Tcl_FreeProc *) 0)
  569. X#define TCL_DYNAMIC    ((Tcl_FreeProc *) free)
  570. X
  571. X/*
  572. X * Flag values passed to variable-related procedures.
  573. X */
  574. X
  575. X#define TCL_GLOBAL_ONLY        1
  576. X#define TCL_APPEND_VALUE    2
  577. X#define TCL_LIST_ELEMENT    4
  578. X#define TCL_NO_SPACE        8
  579. X#define TCL_TRACE_READS        0x10
  580. X#define TCL_TRACE_WRITES    0x20
  581. X#define TCL_TRACE_UNSETS    0x40
  582. X#define TCL_TRACE_DESTROYED    0x80
  583. X#define TCL_INTERP_DESTROYED    0x100
  584. X#define TCL_LEAVE_ERR_MSG    0x200
  585. X
  586. X/*
  587. X * Additional flag passed back to variable watchers.  This flag must
  588. X * not overlap any of the TCL_TRACE_* flags defined above or the
  589. X * TRACE_* flags defined in tclInt.h.
  590. X */
  591. X
  592. X#define TCL_VARIABLE_UNDEFINED    8
  593. X
  594. X/*
  595. X * The following declarations either map ckalloc and ckfree to
  596. X * malloc and free, or they map them to procedures with all sorts
  597. X * of debugging hooks defined in tclCkalloc.c.
  598. X */
  599. X
  600. X#ifdef TCL_MEM_DEBUG
  601. X
  602. XEXTERN char *        Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
  603. X                char *file, int line));
  604. XEXTERN int        Tcl_DbCkfree _ANSI_ARGS_((char *ptr,
  605. X                char *file, int line));
  606. X#  define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
  607. X#  define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
  608. X
  609. X#else
  610. X
  611. X#  define ckalloc(x) malloc(x)
  612. X#  define ckfree(x)  free(x)
  613. X
  614. X#endif /* TCL_MEM_DEBUG */
  615. X
  616. X/*
  617. X * Macro to free up result of interpreter.
  618. X */
  619. X
  620. X#define Tcl_FreeResult(interp)                    \
  621. X    if ((interp)->freeProc != 0) {                \
  622. X    if ((interp)->freeProc == (Tcl_FreeProc *) free) {    \
  623. X        ckfree((interp)->result);                \
  624. X    } else {                        \
  625. X        (*(interp)->freeProc)((interp)->result);        \
  626. X    }                            \
  627. X    (interp)->freeProc = 0;                    \
  628. X    }
  629. X
  630. X/*
  631. X * Exported Tcl procedures:
  632. X */
  633. X
  634. XEXTERN void        Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp *interp,
  635. X                char *string, int noSep));
  636. XEXTERN void        Tcl_AppendResult _ANSI_ARGS_(VARARGS);
  637. XEXTERN char *        Tcl_AssembleCmd _ANSI_ARGS_((Tcl_CmdBuf buffer,
  638. X                char *string));
  639. XEXTERN void        Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
  640. X                char *message));
  641. XEXTERN char        Tcl_Backslash _ANSI_ARGS_((char *src,
  642. X                int *readPtr));
  643. XEXTERN char *        Tcl_Concat _ANSI_ARGS_((int argc, char **argv));
  644. XEXTERN int        Tcl_ConvertElement _ANSI_ARGS_((char *src,
  645. X                char *dst, int flags));
  646. XEXTERN Tcl_CmdBuf    Tcl_CreateCmdBuf _ANSI_ARGS_((void));
  647. XEXTERN void        Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
  648. X                char *cmdName, Tcl_CmdProc *proc,
  649. X                ClientData clientData,
  650. X                Tcl_CmdDeleteProc *deleteProc));
  651. XEXTERN Tcl_Interp *    Tcl_CreateInterp _ANSI_ARGS_((void));
  652. XEXTERN int        Tcl_CreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
  653. X                int argc, char **argv, int **pidArrayPtr,
  654. X                int *inPipePtr, int *outPipePtr,
  655. X                int *errFilePtr));
  656. XEXTERN Tcl_Trace    Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp *interp,
  657. X                int level, Tcl_CmdTraceProc *proc,
  658. X                ClientData clientData));
  659. XEXTERN void        Tcl_DeleteCmdBuf _ANSI_ARGS_((Tcl_CmdBuf buffer));
  660. XEXTERN int        Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp *interp,
  661. X                char *cmdName));
  662. XEXTERN void        Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp *interp));
  663. XEXTERN void        Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp *interp,
  664. X                Tcl_Trace trace));
  665. XEXTERN void        Tcl_DetachPids _ANSI_ARGS_((int numPids, int *pidPtr));
  666. XEXTERN char *        Tcl_ErrnoId _ANSI_ARGS_((void));
  667. XEXTERN int        Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp, char *cmd,
  668. X                int flags, char **termPtr));
  669. XEXTERN int        Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp *interp,
  670. X                char *fileName));
  671. XEXTERN int        Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp *interp,
  672. X                char *string, int *ptr));
  673. XEXTERN int        Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp *interp,
  674. X                char *string, double *ptr));
  675. XEXTERN int        Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp *interp,
  676. X                char *string, long *ptr));
  677. XEXTERN int        Tcl_ExprString _ANSI_ARGS_((Tcl_Interp *interp,
  678. X                char *string));
  679. XEXTERN int        Tcl_Fork _ANSI_ARGS_((void));
  680. XEXTERN int        Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp,
  681. X                char *string, int *boolPtr));
  682. XEXTERN int        Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp,
  683. X                char *string, double *doublePtr));
  684. XEXTERN int        Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
  685. X                char *string, int *intPtr));
  686. XEXTERN char *        Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp,
  687. X                char *varName, int flags));
  688. XEXTERN char *        Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
  689. X                char *name1, char *name2, int flags));
  690. XEXTERN void        Tcl_InitHistory _ANSI_ARGS_((Tcl_Interp *interp));
  691. XEXTERN void        Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
  692. XEXTERN char *        Tcl_Merge _ANSI_ARGS_((int argc, char **argv));
  693. XEXTERN char *        Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp *interp,
  694. X                char *string, char **termPtr));
  695. XEXTERN int        Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp *interp,
  696. X                char *cmd, int flags));
  697. XEXTERN void        Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
  698. X#define Tcl_Return Tcl_SetResult
  699. XEXTERN int        Tcl_ScanElement _ANSI_ARGS_((char *string,
  700. X                int *flagPtr));
  701. XEXTERN void        Tcl_SetErrorCode _ANSI_ARGS_(VARARGS);
  702. XEXTERN void        Tcl_SetResult _ANSI_ARGS_((Tcl_Interp *interp,
  703. X                char *string, Tcl_FreeProc *freeProc));
  704. XEXTERN char *        Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp,
  705. X                char *varName, char *newValue, int flags));
  706. XEXTERN char *        Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
  707. X                char *name1, char *name2, char *newValue,
  708. X                int flags));
  709. XEXTERN char *        Tcl_SignalId _ANSI_ARGS_((int sig));
  710. XEXTERN char *        Tcl_SignalMsg _ANSI_ARGS_((int sig));
  711. XEXTERN int        Tcl_SplitList _ANSI_ARGS_((Tcl_Interp *interp,
  712. X                char *list, int *argcPtr, char ***argvPtr));
  713. XEXTERN int        Tcl_StringMatch _ANSI_ARGS_((char *string,
  714. X                char *pattern));
  715. XEXTERN char *        Tcl_TildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
  716. X                char *name));
  717. XEXTERN int        Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp *interp,
  718. X                char *varName, int flags, Tcl_VarTraceProc *proc,
  719. X                ClientData clientData));
  720. XEXTERN int        Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
  721. X                char *name1, char *name2, int flags,
  722. X                Tcl_VarTraceProc *proc, ClientData clientData));
  723. XEXTERN char *        Tcl_UnixError _ANSI_ARGS_((Tcl_Interp *interp));
  724. XEXTERN int        Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp *interp,
  725. X                char *varName, int flags));
  726. XEXTERN int        Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
  727. X                char *name1, char *name2, int flags));
  728. XEXTERN void        Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp *interp,
  729. X                char *varName, int flags, Tcl_VarTraceProc *proc,
  730. X                ClientData clientData));
  731. XEXTERN void        Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
  732. X                char *name1, char *name2, int flags,
  733. X                Tcl_VarTraceProc *proc, ClientData clientData));
  734. XEXTERN int        Tcl_VarEval _ANSI_ARGS_(VARARGS);
  735. XEXTERN ClientData    Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
  736. X                char *varName, int flags,
  737. X                Tcl_VarTraceProc *procPtr,
  738. X                ClientData prevClientData));
  739. XEXTERN ClientData    Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
  740. X                char *name1, char *name2, int flags,
  741. X                Tcl_VarTraceProc *procPtr,
  742. X                ClientData prevClientData));
  743. XEXTERN int        Tcl_WaitPids _ANSI_ARGS_((int numPids, int *pidPtr,
  744. X                int *statusPtr));
  745. X
  746. X#endif /* _TCL */
  747. END_OF_FILE
  748. if test 11364 -ne `wc -c <'tcl6.1/tcl.h'`; then
  749.     echo shar: \"'tcl6.1/tcl.h'\" unpacked with wrong size!
  750. fi
  751. # end of 'tcl6.1/tcl.h'
  752. fi
  753. if test -f 'tcl6.1/tclEnv.c' -a "${1}" != "-c" ; then 
  754.   echo shar: Will not clobber existing file \"'tcl6.1/tclEnv.c'\"
  755. else
  756. echo shar: Extracting \"'tcl6.1/tclEnv.c'\" \(11191 characters\)
  757. sed "s/^X//" >'tcl6.1/tclEnv.c' <<'END_OF_FILE'
  758. X/* 
  759. X * tclEnv.c --
  760. X *
  761. X *    Tcl support for environment variables, including a setenv
  762. X *    procedure.
  763. X *
  764. X * Copyright 1991 Regents of the University of California
  765. X * Permission to use, copy, modify, and distribute this
  766. X * software and its documentation for any purpose and without
  767. X * fee is hereby granted, provided that this copyright
  768. X * notice appears in all copies.  The University of California
  769. X * makes no representations about the suitability of this
  770. X * software for any purpose.  It is provided "as is" without
  771. X * express or implied warranty.
  772. X */
  773. X
  774. X#ifndef lint
  775. Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclEnv.c,v 1.7 91/09/23 11:22:21 ouster Exp $ SPRITE (Berkeley)";
  776. X#endif /* not lint */
  777. X
  778. X#include "tclInt.h"
  779. X#include "tclUnix.h"
  780. X
  781. X/*
  782. X * The structure below is used to keep track of all of the interpereters
  783. X * for which we're managing the "env" array.  It's needed so that they
  784. X * can all be updated whenever an environment variable is changed
  785. X * anywhere.
  786. X */
  787. X
  788. Xtypedef struct EnvInterp {
  789. X    Tcl_Interp *interp;        /* Interpreter for which we're managing
  790. X                 * the env array. */
  791. X    struct EnvInterp *nextPtr;    /* Next in list of all such interpreters,
  792. X                 * or zero. */
  793. X} EnvInterp;
  794. X
  795. Xstatic EnvInterp *firstInterpPtr;
  796. X                /* First in list of all managed interpreters,
  797. X                 * or NULL if none. */
  798. X
  799. Xstatic int environSize = 0;    /* Non-zero means that the all of the
  800. X                 * environ-related information is malloc-ed
  801. X                 * and the environ array itself has this
  802. X                 * many total entries allocated to it (not
  803. X                 * all may be in use at once).  Zero means
  804. X                 * that the environment array is in its
  805. X                 * original static state. */
  806. X
  807. X/*
  808. X * Declarations for local procedures defined in this file:
  809. X */
  810. X
  811. Xstatic void        EnvInit _ANSI_ARGS_((void));
  812. Xstatic char *        EnvTraceProc _ANSI_ARGS_((ClientData clientData,
  813. X                Tcl_Interp *interp, char *name1, char *name2,
  814. X                int flags));
  815. Xstatic int        FindVariable _ANSI_ARGS_((char *name, int *lengthPtr));
  816. Xvoid            setenv _ANSI_ARGS_((char *name, char *value));
  817. Xvoid            unsetenv _ANSI_ARGS_((char *name));
  818. X
  819. X/*
  820. X *----------------------------------------------------------------------
  821. X *
  822. X * TclSetupEnv --
  823. X *
  824. X *    This procedure is invoked for an interpreter to make environment
  825. X *    variables accessible from that interpreter via the "env"
  826. X *    associative array.
  827. X *
  828. X * Results:
  829. X *    None.
  830. X *
  831. X * Side effects:
  832. X *    The interpreter is added to a list of interpreters managed
  833. X *    by us, so that its view of envariables can be kept consistent
  834. X *    with the view in other interpreters.  If this is the first
  835. X *    call to Tcl_SetupEnv, then additional initialization happens,
  836. X *    such as copying the environment to dynamically-allocated space
  837. X *    for ease of management.
  838. X *
  839. X *----------------------------------------------------------------------
  840. X */
  841. X
  842. Xvoid
  843. XTclSetupEnv(interp)
  844. X    Tcl_Interp *interp;        /* Interpreter whose "env" array is to be
  845. X                 * managed. */
  846. X{
  847. X    EnvInterp *eiPtr;
  848. X    int i;
  849. X
  850. X    /*
  851. X     * First, initialize our environment-related information, if
  852. X     * necessary.
  853. X     */
  854. X
  855. X    if (environSize == 0) {
  856. X    EnvInit();
  857. X    }
  858. X
  859. X    /*
  860. X     * Next, add the interpreter to the list of those that we manage.
  861. X     */
  862. X
  863. X    eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
  864. X    eiPtr->interp = interp;
  865. X    eiPtr->nextPtr = firstInterpPtr;
  866. X    firstInterpPtr = eiPtr;
  867. X
  868. X    /*
  869. X     * Store the environment variable values into the interpreter's
  870. X     * "env" array, and arrange for us to be notified on future
  871. X     * writes and unsets to that array.
  872. X     */
  873. X
  874. X    (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
  875. X    for (i = 0; ; i++) {
  876. X    char *p, *p2;
  877. X
  878. X    p = environ[i];
  879. X    if (p == NULL) {
  880. X        break;
  881. X    }
  882. X    for (p2 = p; *p2 != '='; p2++) {
  883. X        /* Empty loop body. */
  884. X    }
  885. X    *p2 = 0;
  886. X    (void) Tcl_SetVar2(interp, "env", p, p2+1, TCL_GLOBAL_ONLY);
  887. X    *p2 = '=';
  888. X    }
  889. X    Tcl_TraceVar2(interp, "env", (char *) NULL,
  890. X        TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
  891. X        EnvTraceProc, (ClientData) NULL);
  892. X}
  893. X
  894. X/*
  895. X *----------------------------------------------------------------------
  896. X *
  897. X * FindVariable --
  898. X *
  899. X *    Locate the entry in environ for a given name.
  900. X *
  901. X * Results:
  902. X *    The return value is the index in environ of an entry with the
  903. X *    name "name", or -1 if there is no such entry.   The integer at
  904. X *    *lengthPtr is filled in with the length of name (if a matching
  905. X *    entry is found) or the length of the environ array (if no matching
  906. X *    entry is found).
  907. X *
  908. X * Side effects:
  909. X *    None.
  910. X *
  911. X *----------------------------------------------------------------------
  912. X */
  913. X
  914. Xstatic int
  915. XFindVariable(name, lengthPtr)
  916. X    char *name;            /* Name of desired environment variable. */
  917. X    int *lengthPtr;        /* Used to return length of name (for
  918. X                 * successful searches) or number of non-NULL
  919. X                 * entries in environ (for unsuccessful
  920. X                 * searches). */
  921. X{
  922. X    int i;
  923. X    register char *p1, *p2;
  924. X
  925. X    for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
  926. X    for (p2 = name; *p2 == *p1; p1++, p2++) {
  927. X        /* NULL loop body. */
  928. X    }
  929. X    if ((*p1 == '=') && (*p2 == '\0')) {
  930. X        *lengthPtr = p2-name;
  931. X        return i;
  932. X    }
  933. X    }
  934. X    *lengthPtr = i;
  935. X    return -1;
  936. X}
  937. X
  938. X/*
  939. X *----------------------------------------------------------------------
  940. X *
  941. X * setenv --
  942. X *
  943. X *    Set an environment variable, replacing an existing value
  944. X *    or creating a new variable if there doesn't exist a variable
  945. X *    by the given name.
  946. X *
  947. X * Results:
  948. X *    None.
  949. X *
  950. X * Side effects:
  951. X *    The environ array gets updated, as do all of the interpreters
  952. X *    that we manage.
  953. X *
  954. X *----------------------------------------------------------------------
  955. X */
  956. X
  957. Xvoid
  958. Xsetenv(name, value)
  959. X    char *name;            /* Name of variable whose value is to be
  960. X                 * set. */
  961. X    char *value;        /* New value for variable. */
  962. X{
  963. X    int index, length, nameLength;
  964. X    char *p;
  965. X    EnvInterp *eiPtr;
  966. X
  967. X    if (environSize == 0) {
  968. X    EnvInit();
  969. X    }
  970. X
  971. X    /*
  972. X     * Figure out where the entry is going to go.  If the name doesn't
  973. X     * already exist, enlarge the array if necessary to make room.  If
  974. X     * the name exists, free its old entry.
  975. X     */
  976. X
  977. X    index = FindVariable(name, &length);
  978. X    if (index == -1) {
  979. X    if ((length+2) > environSize) {
  980. X        char **newEnviron;
  981. X
  982. X        newEnviron = (char **) ckalloc((unsigned)
  983. X            ((length+5) * sizeof(char *)));
  984. X        memcpy((VOID *) newEnviron, (VOID *) environ,
  985. X            length*sizeof(char *));
  986. X        ckfree((char *) environ);
  987. X        environ = newEnviron;
  988. X        environSize = length+5;
  989. X    }
  990. X    index = length;
  991. X    environ[index+1] = NULL;
  992. X    nameLength = strlen(name);
  993. X    } else {
  994. X    ckfree(environ[index]);
  995. X    nameLength = length;
  996. X    }
  997. X
  998. X    /*
  999. X     * Create a new entry and enter it into the table.
  1000. X     */
  1001. X
  1002. X    p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
  1003. X    environ[index] = p;
  1004. X    strcpy(p, name);
  1005. X    p += nameLength;
  1006. X    *p = '=';
  1007. X    strcpy(p+1, value);
  1008. X
  1009. X    /*
  1010. X     * Update all of the interpreters.
  1011. X     */
  1012. X
  1013. X    for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
  1014. X    (void) Tcl_SetVar2(eiPtr->interp, "env", name, p+1, TCL_GLOBAL_ONLY);
  1015. X    }
  1016. X}
  1017. X
  1018. X/*
  1019. X *----------------------------------------------------------------------
  1020. X *
  1021. X * unsetenv --
  1022. X *
  1023. X *    Remove an environment variable, updating the "env" arrays
  1024. X *    in all interpreters managed by us.
  1025. X *
  1026. X * Results:
  1027. X *    None.
  1028. X *
  1029. X * Side effects:
  1030. X *    Interpreters are updated, as is environ.
  1031. X *
  1032. X *----------------------------------------------------------------------
  1033. X */
  1034. X
  1035. Xvoid
  1036. Xunsetenv(name)
  1037. X    char *name;            /* Name of variable to remove. */
  1038. X{
  1039. X    int index, dummy;
  1040. X    char **envPtr;
  1041. X    EnvInterp *eiPtr;
  1042. X
  1043. X    if (environSize == 0) {
  1044. X    EnvInit();
  1045. X    }
  1046. X
  1047. X    /*
  1048. X     * Update the environ array.
  1049. X     */
  1050. X
  1051. X    index = FindVariable(name, &dummy);
  1052. X    if (index == -1) {
  1053. X    return;
  1054. X    }
  1055. X    ckfree(environ[index]);
  1056. X    for (envPtr = environ+index+1; ; envPtr++) {
  1057. X    envPtr[-1] = *envPtr;
  1058. X    if (*envPtr == NULL) {
  1059. X        break;
  1060. X       }
  1061. X    }
  1062. X
  1063. X    /*
  1064. X     * Update all of the interpreters.
  1065. X     */
  1066. X
  1067. X    for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
  1068. X    (void) Tcl_UnsetVar2(eiPtr->interp, "env", name, TCL_GLOBAL_ONLY);
  1069. X    }
  1070. X}
  1071. X
  1072. X/*
  1073. X *----------------------------------------------------------------------
  1074. X *
  1075. X * EnvTraceProc --
  1076. X *
  1077. X *    This procedure is invoked whenever an environment variable
  1078. X *    is modified or deleted.  It propagates the change to the
  1079. X *    "environ" array and to any other interpreters for whom
  1080. X *    we're managing an "env" array.
  1081. X *
  1082. X * Results:
  1083. X *    Always returns NULL to indicate success.
  1084. X *
  1085. X * Side effects:
  1086. X *    Environment variable changes get propagated.  If the whole
  1087. X *    "env" array is deleted, then we stop managing things for
  1088. X *    this interpreter (usually this happens because the whole
  1089. X *    interpreter is being deleted).
  1090. X *
  1091. X *----------------------------------------------------------------------
  1092. X */
  1093. X
  1094. X    /* ARGSUSED */
  1095. Xstatic char *
  1096. XEnvTraceProc(clientData, interp, name1, name2, flags)
  1097. X    ClientData clientData;    /* Not used. */
  1098. X    Tcl_Interp *interp;        /* Interpreter whose "env" variable is
  1099. X                 * being modified. */
  1100. X    char *name1;        /* Better be "env". */
  1101. X    char *name2;        /* Name of variable being modified, or
  1102. X                 * NULL if whole array is being deleted. */
  1103. X    int flags;            /* Indicates what's happening. */
  1104. X{
  1105. X    /*
  1106. X     * First see if the whole "env" variable is being deleted.  If
  1107. X     * so, just forget about this interpreter.
  1108. X     */
  1109. X
  1110. X    if (name2 == NULL) {
  1111. X    register EnvInterp *eiPtr, *prevPtr;
  1112. X
  1113. X    if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
  1114. X        != (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
  1115. X        panic("EnvTraceProc called with confusing arguments");
  1116. X    }
  1117. X    eiPtr = firstInterpPtr;
  1118. X    if (eiPtr->interp == interp) {
  1119. X        firstInterpPtr = eiPtr->nextPtr;
  1120. X    } else {
  1121. X        for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
  1122. X            prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
  1123. X        if (eiPtr == NULL) {
  1124. X            panic("EnvTraceProc couldn't find interpreter");
  1125. X        }
  1126. X        if (eiPtr->interp == interp) {
  1127. X            prevPtr->nextPtr = eiPtr->nextPtr;
  1128. X            break;
  1129. X        }
  1130. X        }
  1131. X    }
  1132. X    ckfree((char *) eiPtr);
  1133. X    return NULL;
  1134. X    }
  1135. X
  1136. X    /*
  1137. X     * If a value is being set, call setenv to do all of the work.
  1138. X     */
  1139. X
  1140. X    if (flags & TCL_TRACE_WRITES) {
  1141. X    setenv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
  1142. X    }
  1143. X
  1144. X    if (flags & TCL_TRACE_UNSETS) {
  1145. X    unsetenv(name2);
  1146. X    }
  1147. X    return NULL;
  1148. X}
  1149. X
  1150. X/*
  1151. X *----------------------------------------------------------------------
  1152. X *
  1153. X * EnvInit --
  1154. X *
  1155. X *    This procedure is called to initialize our management
  1156. X *    of the environ array.
  1157. X *
  1158. X * Results:
  1159. X *    None.
  1160. X *
  1161. X * Side effects:
  1162. X *    Environ gets copied to malloc-ed storage, so that in
  1163. X *    the future we don't have to worry about which entries
  1164. X *    are malloc-ed and which are static.
  1165. X *
  1166. X *----------------------------------------------------------------------
  1167. X */
  1168. X
  1169. Xstatic void
  1170. XEnvInit()
  1171. X{
  1172. X    char **newEnviron;
  1173. X    int i, length;
  1174. X
  1175. X    if (environSize != 0) {
  1176. X    return;
  1177. X    }
  1178. X    for (length = 0; environ[length] != NULL; length++) {
  1179. X    /* Empty loop body. */
  1180. X    }
  1181. X    environSize = length+5;
  1182. X    newEnviron = (char **) ckalloc((unsigned)
  1183. X        (environSize * sizeof(char *)));
  1184. X    for (i = 0; i < length; i++) {
  1185. X    newEnviron[i] = (char *) ckalloc((unsigned) (strlen(environ[i]) + 1));
  1186. X    strcpy(newEnviron[i], environ[i]);
  1187. X    }
  1188. X    newEnviron[length] = NULL;
  1189. X    environ = newEnviron;
  1190. X}
  1191. END_OF_FILE
  1192. if test 11191 -ne `wc -c <'tcl6.1/tclEnv.c'`; then
  1193.     echo shar: \"'tcl6.1/tclEnv.c'\" unpacked with wrong size!
  1194. fi
  1195. # end of 'tcl6.1/tclEnv.c'
  1196. fi
  1197. if test -f 'tcl6.1/tests/info.test' -a "${1}" != "-c" ; then 
  1198.   echo shar: Will not clobber existing file \"'tcl6.1/tests/info.test'\"
  1199. else
  1200. echo shar: Extracting \"'tcl6.1/tests/info.test'\" \(11222 characters\)
  1201. sed "s/^X//" >'tcl6.1/tests/info.test' <<'END_OF_FILE'
  1202. X# Commands covered:  info
  1203. X#
  1204. X# This file contains a collection of tests for one or more of the Tcl
  1205. X# built-in commands.  Sourcing this file into Tcl runs the tests and
  1206. X# generates output for errors.  No output means no errors were found.
  1207. X#
  1208. X# Copyright 1991 Regents of the University of California
  1209. X# Permission to use, copy, modify, and distribute this
  1210. X# software and its documentation for any purpose and without
  1211. X# fee is hereby granted, provided that this copyright notice
  1212. X# appears in all copies.  The University of California makes no
  1213. X# representations about the suitability of this software for any
  1214. X# purpose.  It is provided "as is" without express or implied
  1215. X# warranty.
  1216. X#
  1217. X# $Header: /sprite/src/lib/tcl/tests/RCS/info.test,v 1.10 91/09/23 13:06:05 ouster Exp $ (Berkeley)
  1218. X
  1219. Xif {[string compare test [info procs test]] == 1} then {source defs}
  1220. X
  1221. Xtest info-1.1 {info args option} {
  1222. X    proc t1 {a bbb c} {return foo}
  1223. X    info args t1
  1224. X} {a bbb c}
  1225. Xtest info-1.2 {info args option} {
  1226. X    proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
  1227. X    info a t1
  1228. X} {a bbb c args}
  1229. Xtest info-1.3 {info args option} {
  1230. X    proc t1 "" {return foo}
  1231. X    info args t1
  1232. X} {}
  1233. Xtest info-1.4 {info args option} {
  1234. X    catch {rename t1 {}}
  1235. X    list [catch {info args t1} msg] $msg
  1236. X} {1 {"t1" isn't a procedure}}
  1237. Xtest info-1.5 {info args option} {
  1238. X    list [catch {info args set} msg] $msg
  1239. X} {1 {"set" isn't a procedure}}
  1240. X
  1241. Xtest info-2.1 {info body option} {
  1242. X    proc t1 {} {body of t1}
  1243. X    info body t1
  1244. X} {body of t1}
  1245. Xtest info-2.2 {info body option} {
  1246. X    list [catch {info body set} msg] $msg
  1247. X} {1 {"set" isn't a procedure}}
  1248. Xtest info-2.3 {info body option} {
  1249. X    list [catch {info args set 1} msg] $msg
  1250. X} {1 {wrong # args: should be "info args procname"}}
  1251. X
  1252. Xtest info-3.1 {info cmdcount option} {
  1253. X    set x [info cmdcount]
  1254. X    set y 12345
  1255. X    set z [info cm]
  1256. X    expr $z-$x
  1257. X} 3
  1258. Xtest info-3.2 {info body option} {
  1259. X    list [catch {info cmdcount 1} msg] $msg
  1260. X} {1 {wrong # args: should be "info cmdcount"}}
  1261. X
  1262. Xtest info-4.1 {info commands option} {
  1263. X    proc t1 {} {}
  1264. X    proc t2 {} {}
  1265. X    set x " [info commands] "
  1266. X    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  1267. X            [string match {* set *} $x] [string match {* list *} $x]
  1268. X} {1 1 1 1}
  1269. Xtest info-4.2 {info commands option} {
  1270. X    proc t1 {} {}
  1271. X    rename t1 {}
  1272. X    set x [info co]
  1273. X    string match {* t1 *} $x
  1274. X} 0
  1275. Xtest info-4.3 {info commands option} {
  1276. X    proc _t1_ {} {}
  1277. X    proc _t2_ {} {}
  1278. X    info commands _t1_
  1279. X} _t1_
  1280. Xtest info-4.4 {info commands option} {
  1281. X    proc _t1_ {} {}
  1282. X    proc _t2_ {} {}
  1283. X    lsort [info commands _t*]
  1284. X} {_t1_ _t2_}
  1285. Xcatch {rename _t1_ {}}
  1286. Xcatch {rename _t2_ {}}
  1287. Xtest info-4.5 {info commands option} {
  1288. X    list [catch {info commands a b} msg] $msg
  1289. X} {1 {wrong # args: should be "info commands [pattern]"}}
  1290. X
  1291. Xtest info-5.1 {info default option} {
  1292. X    proc t1 {a b {c d} {e "long default value"}} {}
  1293. X    info default t1 a value
  1294. X} 0
  1295. Xtest info-5.2 {info default option} {
  1296. X    proc t1 {a b {c d} {e "long default value"}} {}
  1297. X    set value 12345
  1298. X    info d t1 a value
  1299. X    set value
  1300. X} {}
  1301. Xtest info-5.3 {info default option} {
  1302. X    proc t1 {a b {c d} {e "long default value"}} {}
  1303. X    info default t1 c value
  1304. X} 1
  1305. Xtest info-5.4 {info default option} {
  1306. X    proc t1 {a b {c d} {e "long default value"}} {}
  1307. X    set value 12345
  1308. X    info default t1 c value
  1309. X    set value
  1310. X} d
  1311. Xtest info-5.5 {info default option} {
  1312. X    proc t1 {a b {c d} {e "long default value"}} {}
  1313. X    set value 12345
  1314. X    set x [info default t1 e value]
  1315. X    list $x $value
  1316. X} {1 {long default value}}
  1317. Xtest info-5.6 {info default option} {
  1318. X    list [catch {info default a b} msg] $msg
  1319. X} {1 {wrong # args: should be "info default procname arg varname"}}
  1320. Xtest info-5.7 {info default option} {
  1321. X    list [catch {info default _nonexistent_ a b} msg] $msg
  1322. X} {1 {"_nonexistent_" isn't a procedure}}
  1323. Xtest info-5.8 {info default option} {
  1324. X    proc t1 {a b} {}
  1325. X    list [catch {info default t1 x value} msg] $msg
  1326. X} {1 {procedure "t1" doesn't have an argument "x"}}
  1327. Xtest info-5.9 {info default option} {
  1328. X    catch {unset a}
  1329. X    set a(0) 88
  1330. X    proc t1 {a b} {}
  1331. X    list [catch {info default t1 a a} msg] $msg
  1332. X} {1 {couldn't store default value in variable "a"}}
  1333. Xtest info-5.10 {info default option} {
  1334. X    catch {unset a}
  1335. X    set a(0) 88
  1336. X    proc t1 {{a 18} b} {}
  1337. X    list [catch {info default t1 a a} msg] $msg
  1338. X} {1 {couldn't store default value in variable "a"}}
  1339. Xcatch {unset a}
  1340. X
  1341. Xtest info-6.1 {info exists option} {
  1342. X    set value foo
  1343. X    info exists value
  1344. X} 1
  1345. Xcatch {unset _nonexistent_}
  1346. Xtest info-6.2 {info exists option} {
  1347. X    info exists _nonexistent_
  1348. X} 0
  1349. Xtest info-6.3 {info exists option} {
  1350. X    proc t1 {x} {return [info exists x]}
  1351. X    t1 2
  1352. X} 1
  1353. Xtest info-6.4 {info exists option} {
  1354. X    proc t1 {x} {
  1355. X        global _nonexistent_
  1356. X        return [info exists _nonexistent_]
  1357. X    }
  1358. X    t1 2
  1359. X} 0
  1360. Xtest info-6.5 {info exists option} {
  1361. X    proc t1 {x} {
  1362. X        set y 47
  1363. X        return [info exists y]
  1364. X    }
  1365. X    t1 2
  1366. X} 1
  1367. Xtest info-6.6 {info exists option} {
  1368. X    proc t1 {x} {return [info exists value]}
  1369. X    t1 2
  1370. X} 0
  1371. Xtest info-6.7 {info exists option} {
  1372. X    catch {unset x}
  1373. X    set x(2) 44
  1374. X    list [info exists x] [info exists x(1)] [info exists x(2)]
  1375. X} {1 0 1}
  1376. Xcatch {unset x}
  1377. Xtest info-6.8 {info exists option} {
  1378. X    list [catch {info exists} msg] $msg
  1379. X} {1 {wrong # args: should be "info exists varName"}}
  1380. Xtest info-6.9 {info exists option} {
  1381. X    list [catch {info exists 1 2} msg] $msg
  1382. X} {1 {wrong # args: should be "info exists varName"}}
  1383. X
  1384. Xtest info-7.1 {info globals option} {
  1385. X    set x 1
  1386. X    set y 2
  1387. X    set value 23
  1388. X    set a " [info globals] "
  1389. X    list [string match {* x *} $a] [string match {* y *} $a] \
  1390. X            [string match {* value *} $a] [string match {* _foobar_ *} $a]
  1391. X} {1 1 1 0}
  1392. Xtest info-7.2 {info globals option} {
  1393. X    set _xxx1 1
  1394. X    set _xxx2 2
  1395. X    lsort [info g _xxx*]
  1396. X} {_xxx1 _xxx2}
  1397. Xtest info-7.3 {info globals option} {
  1398. X    list [catch {info globals 1 2} msg] $msg
  1399. X} {1 {wrong # args: should be "info globals [pattern]"}}
  1400. X
  1401. Xtest info-8.1 {info level option} {
  1402. X    info level
  1403. X} 0
  1404. Xtest info-8.2 {info level option} {
  1405. X    proc t1 {a b} {
  1406. X        set x [info le]
  1407. X        set y [info level 1]
  1408. X        list $x $y
  1409. X    }
  1410. X    t1 146 testString
  1411. X} {1 {t1 146 testString}}
  1412. Xtest info-8.3 {info level option} {
  1413. X    proc t1 {a b} {
  1414. X        t2 [expr $a*2] $b
  1415. X    }
  1416. X    proc t2 {x y} {
  1417. X        list [info level] [info level 1] [info level 2] [info level -1] \
  1418. X                [info level 0]
  1419. X    }
  1420. X    t1 146 {a {b c} {{{c}}}}
  1421. X} {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
  1422. Xtest info-8.4 {info level option} {
  1423. X    proc t1 {} {
  1424. X        set x [info level]
  1425. X        set y [info level 1]
  1426. X        list $x $y
  1427. X    }
  1428. X    t1
  1429. X} {1 t1}
  1430. Xtest info-8.5 {info level option} {
  1431. X    list [catch {info level 1 2} msg] $msg
  1432. X} {1 {wrong # args: should be "info level [number]"}}
  1433. Xtest info-8.6 {info level option} {
  1434. X    list [catch {info level 123a} msg] $msg
  1435. X} {1 {expected integer but got "123a"}}
  1436. Xtest info-8.7 {info level option} {
  1437. X    list [catch {info level 0} msg] $msg
  1438. X} {1 {bad level "0"}}
  1439. Xtest info-8.8 {info level option} {
  1440. X    proc t1 {} {info level -1}
  1441. X    list [catch {t1} msg] $msg
  1442. X} {1 {bad level "-1"}}
  1443. Xtest info-8.9 {info level option} {
  1444. X    proc t1 {x} {info level $x}
  1445. X    list [catch {t1 -3} msg] $msg
  1446. X} {1 {bad level "-3"}}
  1447. X
  1448. Xtest info-9.1 {info library option} {
  1449. X    list [catch {info library x} msg] $msg
  1450. X} {1 {wrong # args: should be "info library"}}
  1451. X
  1452. X# The following check can only be done at Berkeley, where the exact
  1453. X# location of the library is known.
  1454. X
  1455. Xif {[glob ~] == "/users/ouster"} {
  1456. X    test info-9.2 {info library option} {
  1457. X    info li
  1458. X    } /sprite/lib/tcl
  1459. X}
  1460. X
  1461. Xtest info-10.1 {info locals option} {
  1462. X    set a 22
  1463. X    proc t1 {x y} {
  1464. X        set b 13
  1465. X        set c testing
  1466. X        global a
  1467. X        return [info locals]
  1468. X    }
  1469. X    lsort [t1 23 24]
  1470. X} {b c x y}
  1471. Xtest info-10.2 {info locals option} {
  1472. X    proc t1 {x y} {
  1473. X        set xx1 2
  1474. X        set xx2 3
  1475. X        set y 4
  1476. X        return [info lo x*]
  1477. X    }
  1478. X    lsort [t1 2 3]
  1479. X} {x xx1 xx2}
  1480. Xtest info-10.3 {info locals option} {
  1481. X    list [catch {info locals 1 2} msg] $msg
  1482. X} {1 {wrong # args: should be "info locals [pattern]"}}
  1483. Xtest info-10.4 {info locals option} {
  1484. X    info locals
  1485. X} {}
  1486. Xtest info-10.5 {info locals option} {
  1487. X    proc t1 {} {return [info locals]}
  1488. X    t1
  1489. X} {}
  1490. X
  1491. Xtest info-11.1 {info procs option} {
  1492. X    proc t1 {} {}
  1493. X    proc t2 {} {}
  1494. X    set x " [info procs] "
  1495. X    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  1496. X            [string match {* _undefined_ *} $x]
  1497. X} {1 1 0}
  1498. Xtest info-11.2 {info procs option} {
  1499. X    proc _tt1 {} {}
  1500. X    proc _tt2 {} {}
  1501. X    lsort [info p _tt*]
  1502. X} {_tt1 _tt2}
  1503. Xcatch {rename _tt1 {}}
  1504. Xcatch {rename _tt2 {}}
  1505. Xtest info-11.3 {info procs option} {
  1506. X    list [catch {info procs 2 3} msg] $msg
  1507. X} {1 {wrong # args: should be "info procs [pattern]"}}
  1508. X
  1509. Xtest info-12.1 {info script option} {
  1510. X    list [catch {info script x} msg] $msg
  1511. X} {1 {wrong # args: should be "info script"}}
  1512. Xtest info-12.2 {info script option} {
  1513. X    file tail [info s]
  1514. X} info.test
  1515. Xcatch {exec rm -f gorp.info}
  1516. Xexec cat > gorp.info << "info script\n"
  1517. Xtest info-12.3 {info script option} {
  1518. X    list [source gorp.info] [file tail [info script]]
  1519. X} {gorp.info info.test}
  1520. Xtest info-12.4 {resetting "info script" after errors} {
  1521. X    catch {source ~_nobody_/foo}
  1522. X    file tail [info script]
  1523. X} {info.test}
  1524. Xtest info-12.5 {resetting "info script" after errors} {
  1525. X    catch {source _nonexistent_}
  1526. X    file tail [info script]
  1527. X} {info.test}
  1528. Xexec rm -f gorp.info
  1529. X
  1530. Xtest info-13.1 {info tclversion option} {
  1531. X    set x [info tclversion]
  1532. X    scan $x "%d.%d%c" a b c
  1533. X} 2
  1534. Xtest info-13.2 {info tclversion option} {
  1535. X    list [catch {info t 2} msg] $msg
  1536. X} {1 {wrong # args: should be "info tclversion"}}
  1537. X
  1538. Xtest info-14.1 {info vars option} {
  1539. X    set a 1
  1540. X    set b 2
  1541. X    proc t1 {x y} {
  1542. X        global a b
  1543. X        set c 33
  1544. X        return [info vars]
  1545. X    }
  1546. X    lsort [t1 18 19]
  1547. X} {a b c x y}
  1548. Xtest info-14.2 {info vars option} {
  1549. X    set xxx1 1
  1550. X    set xxx2 2
  1551. X    proc t1 {xxa y} {
  1552. X        global xxx1 xxx2
  1553. X        set c 33
  1554. X        return [info vars x*]
  1555. X    }
  1556. X    lsort [t1 18 19]
  1557. X} {xxa xxx1 xxx2}
  1558. Xtest info-14.3 {info vars option} {
  1559. X    lsort [info vars]
  1560. X} [lsort [info globals]]
  1561. Xtest info-14.4 {info vars option} {
  1562. X    list [catch {info vars a b} msg] $msg
  1563. X} {1 {wrong # args: should be "info vars [pattern]"}}
  1564. X
  1565. Xtest info-15.1 {miscellaneous error conditions} {
  1566. X    list [catch {info} msg] $msg
  1567. X} {1 {wrong # args: should be "info option ?arg arg ...?"}}
  1568. Xtest info-15.2 {miscellaneous error conditions} {
  1569. X    list [catch {info gorp} msg] $msg
  1570. X} {1 {bad option "gorp": should be args, body, commands, cmdcount, default, \
  1571. Xexists, globals, level, library, locals, procs, script, tclversion, or vars}}
  1572. Xtest info-15.3 {miscellaneous error conditions} {
  1573. X    list [catch {info c} msg] $msg
  1574. X} {1 {bad option "c": should be args, body, commands, cmdcount, default, \
  1575. Xexists, globals, level, library, locals, procs, script, tclversion, or vars}}
  1576. Xtest info-15.4 {miscellaneous error conditions} {
  1577. X    list [catch {info l} msg] $msg
  1578. X} {1 {bad option "l": should be args, body, commands, cmdcount, default, \
  1579. Xexists, globals, level, library, locals, procs, script, tclversion, or vars}}
  1580. END_OF_FILE
  1581. if test 11222 -ne `wc -c <'tcl6.1/tests/info.test'`; then
  1582.     echo shar: \"'tcl6.1/tests/info.test'\" unpacked with wrong size!
  1583. fi
  1584. # end of 'tcl6.1/tests/info.test'
  1585. fi
  1586. echo shar: End of archive 9 \(of 33\).
  1587. cp /dev/null ark9isdone
  1588. MISSING=""
  1589. 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
  1590.     if test ! -f ark${I}isdone ; then
  1591.     MISSING="${MISSING} ${I}"
  1592.     fi
  1593. done
  1594. if test "${MISSING}" = "" ; then
  1595.     echo You have unpacked all 33 archives.
  1596.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1597. else
  1598.     echo You still need to unpack the following archives:
  1599.     echo "        " ${MISSING}
  1600. fi
  1601. ##  End of shell archive.
  1602. exit 0
  1603.  
  1604. exit 0 # Just in case...
  1605. -- 
  1606. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  1607. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  1608. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  1609. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  1610.