0000: 23 20 69 6e 69 74 2e 74 63 6c 20 2d 2d 0a 23 0a # init.tcl --.#.
0010: 23 20 44 65 66 61 75 6c 74 20 73 79 73 74 65 6d # Default system
0020: 20 73 74 61 72 74 75 70 20 66 69 6c 65 20 66 6f startup file fo
0030: 72 20 54 63 6c 2d 62 61 73 65 64 20 61 70 70 6c r Tcl-based appl
0040: 69 63 61 74 69 6f 6e 73 2e 20 20 44 65 66 69 6e ications. Defin
0050: 65 73 0a 23 20 22 75 6e 6b 6e 6f 77 6e 22 20 70 es.# "unknown" p
0060: 72 6f 63 65 64 75 72 65 20 61 6e 64 20 61 75 74 rocedure and aut
0070: 6f 2d 6c 6f 61 64 20 66 61 63 69 6c 69 74 69 65 o-load facilitie
0080: 73 2e 0a 23 0a 23 20 43 6f 70 79 72 69 67 68 74 s..#.# Copyright
0090: 20 c2 a9 20 31 39 39 31 2d 31 39 39 33 20 54 68 © 1991-1993 Th
00a0: 65 20 52 65 67 65 6e 74 73 20 6f 66 20 74 68 65 e Regents of the
00b0: 20 55 6e 69 76 65 72 73 69 74 79 20 6f 66 20 43 University of C
00c0: 61 6c 69 66 6f 72 6e 69 61 2e 0a 23 20 43 6f 70 alifornia..# Cop
00d0: 79 72 69 67 68 74 20 c2 a9 20 31 39 39 34 2d 31 yright © 1994-1
00e0: 39 39 36 20 53 75 6e 20 4d 69 63 72 6f 73 79 73 996 Sun Microsys
00f0: 74 65 6d 73 2c 20 49 6e 63 2e 0a 23 20 43 6f 70 tems, Inc..# Cop
0100: 79 72 69 67 68 74 20 c2 a9 20 31 39 39 38 2d 31 yright © 1998-1
0110: 39 39 39 20 53 63 72 69 70 74 69 63 73 20 43 6f 999 Scriptics Co
0120: 72 70 6f 72 61 74 69 6f 6e 2e 0a 23 20 43 6f 70 rporation..# Cop
0130: 79 72 69 67 68 74 20 c2 a9 20 32 30 30 34 20 4b yright © 2004 K
0140: 65 76 69 6e 20 42 2e 20 4b 65 6e 6e 79 2e 0a 23 evin B. Kenny..#
0150: 20 43 6f 70 79 72 69 67 68 74 20 c2 a9 20 32 30 Copyright © 20
0160: 31 38 20 53 65 61 6e 20 57 6f 6f 64 73 0a 23 0a 18 Sean Woods.#.
0170: 23 20 41 6c 6c 20 72 69 67 68 74 73 20 72 65 73 # All rights res
0180: 65 72 76 65 64 2e 0a 23 0a 23 20 53 65 65 20 74 erved..#.# See t
0190: 68 65 20 66 69 6c 65 20 22 6c 69 63 65 6e 73 65 he file "license
01a0: 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 6e 66 6f .terms" for info
01b0: 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 61 67 65 rmation on usage
01c0: 20 61 6e 64 20 72 65 64 69 73 74 72 69 62 75 74 and redistribut
01d0: 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 20 66 69 ion.# of this fi
01e0: 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 20 44 49 le, and for a DI
01f0: 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 4c 4c 20 SCLAIMER OF ALL
0200: 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 0a 0a 70 WARRANTIES..#..p
0210: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 2d ackage require -
0220: 65 78 61 63 74 20 74 63 6c 20 39 2e 31 62 31 0a exact tcl 9.1b1.
0230: 0a 23 20 43 6f 6d 70 75 74 65 20 74 68 65 20 61 .# Compute the a
0240: 75 74 6f 20 70 61 74 68 20 74 6f 20 75 73 65 20 uto path to use
0250: 69 6e 20 74 68 69 73 20 69 6e 74 65 72 70 72 65 in this interpre
0260: 74 65 72 2e 0a 23 20 54 68 65 20 76 61 6c 75 65 ter..# The value
0270: 73 20 6f 6e 20 74 68 65 20 70 61 74 68 20 63 6f s on the path co
0280: 6d 65 20 66 72 6f 6d 20 73 65 76 65 72 61 6c 20 me from several
0290: 6c 6f 63 61 74 69 6f 6e 73 3a 0a 23 0a 23 20 54 locations:.#.# T
02a0: 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 he environment v
02b0: 61 72 69 61 62 6c 65 20 54 43 4c 4c 49 42 50 41 ariable TCLLIBPA
02c0: 54 48 0a 23 0a 23 20 74 63 6c 5f 6c 69 62 72 61 TH.#.# tcl_libra
02d0: 72 79 2c 20 77 68 69 63 68 20 69 73 20 74 68 65 ry, which is the
02e0: 20 64 69 72 65 63 74 6f 72 79 20 63 6f 6e 74 61 directory conta
02f0: 69 6e 69 6e 67 20 74 68 69 73 20 69 6e 69 74 2e ining this init.
0300: 74 63 6c 20 73 63 72 69 70 74 2e 0a 23 0a 23 20 tcl script..#.#
0310: 54 68 65 20 70 61 72 65 6e 74 20 64 69 72 65 63 The parent direc
0320: 74 6f 72 79 20 6f 66 20 74 63 6c 5f 6c 69 62 72 tory of tcl_libr
0330: 61 72 79 2e 20 41 64 64 69 6e 67 20 74 68 65 20 ary. Adding the
0340: 70 61 72 65 6e 74 0a 23 20 6d 65 61 6e 73 20 74 parent.# means t
0350: 68 61 74 20 70 61 63 6b 61 67 65 73 20 69 6e 20 hat packages in
0360: 70 65 65 72 20 64 69 72 65 63 74 6f 72 69 65 73 peer directories
0370: 20 77 69 6c 6c 20 62 65 20 66 6f 75 6e 64 20 61 will be found a
0380: 75 74 6f 6d 61 74 69 63 61 6c 6c 79 2e 0a 23 0a utomatically..#.
0390: 23 20 41 6c 73 6f 20 61 64 64 20 74 68 65 20 64 # Also add the d
03a0: 69 72 65 63 74 6f 72 79 20 2e 2e 2f 6c 69 62 20 irectory ../lib
03b0: 72 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 relative to the
03c0: 64 69 72 65 63 74 6f 72 79 20 77 68 65 72 65 20 directory where
03d0: 74 68 65 0a 23 20 65 78 65 63 75 74 61 62 6c 65 the.# executable
03e0: 20 69 73 20 6c 6f 63 61 74 65 64 2e 20 20 54 68 is located. Th
03f0: 69 73 20 69 73 20 6d 65 61 6e 74 20 74 6f 20 66 is is meant to f
0400: 69 6e 64 20 62 69 6e 61 72 79 20 70 61 63 6b 61 ind binary packa
0410: 67 65 73 20 66 6f 72 20 74 68 65 0a 23 20 73 61 ges for the.# sa
0420: 6d 65 20 61 72 63 68 69 74 65 63 74 75 72 65 20 me architecture
0430: 61 73 20 74 68 65 20 63 75 72 72 65 6e 74 20 65 as the current e
0440: 78 65 63 75 74 61 62 6c 65 2e 0a 23 0a 23 20 74 xecutable..#.# t
0450: 63 6c 5f 70 6b 67 50 61 74 68 2c 20 77 68 69 63 cl_pkgPath, whic
0460: 68 20 69 73 20 73 65 74 20 62 79 20 74 68 65 20 h is set by the
0470: 70 6c 61 74 66 6f 72 6d 2d 73 70 65 63 69 66 69 platform-specifi
0480: 63 20 69 6e 69 74 69 61 6c 69 7a 61 74 69 6f 6e c initialization
0490: 20 72 6f 75 74 69 6e 65 73 0a 23 09 4f 6e 20 55 routines.#.On U
04a0: 4e 49 58 20 69 74 20 69 73 20 63 6f 6d 70 69 6c NIX it is compil
04b0: 65 64 20 69 6e 0a 23 20 20 20 20 20 20 20 4f 6e ed in.# On
04c0: 20 57 69 6e 64 6f 77 73 2c 20 69 74 20 69 73 20 Windows, it is
04d0: 6e 6f 74 20 75 73 65 64 0a 23 0a 23 20 28 54 69 not used.#.# (Ti
04e0: 63 6b 65 74 20 34 31 63 39 38 35 37 62 64 64 29 cket 41c9857bdd)
04f0: 20 49 6e 20 61 20 73 61 66 65 20 69 6e 74 65 72 In a safe inter
0500: 70 72 65 74 65 72 2c 20 74 68 69 73 20 66 69 6c preter, this fil
0510: 65 20 64 6f 65 73 20 6e 6f 74 20 73 65 74 0a 23 e does not set.#
0520: 20 3a 3a 61 75 74 6f 5f 70 61 74 68 20 28 6f 74 ::auto_path (ot
0530: 68 65 72 20 74 68 61 6e 20 74 6f 20 7b 7d 20 69 her than to {} i
0540: 66 20 69 74 20 69 73 20 75 6e 64 65 66 69 6e 65 f it is undefine
0550: 64 29 2e 20 54 68 65 20 63 61 6c 6c 65 72 2c 20 d). The caller,
0560: 74 79 70 69 63 61 6c 6c 79 0a 23 20 61 20 53 61 typically.# a Sa
0570: 66 65 20 42 61 73 65 20 63 6f 6d 6d 61 6e 64 2c fe Base command,
0580: 20 69 73 20 72 65 73 70 6f 6e 73 69 62 6c 65 20 is responsible
0590: 66 6f 72 20 73 65 74 74 69 6e 67 20 3a 3a 61 75 for setting ::au
05a0: 74 6f 5f 70 61 74 68 2e 0a 0a 74 63 6c 3a 3a 49 to_path...tcl::I
05b0: 6e 69 74 41 75 74 6f 50 61 74 68 0a 0a 6e 61 6d nitAutoPath..nam
05c0: 65 73 70 61 63 65 20 65 76 61 6c 20 74 63 6c 3a espace eval tcl:
05d0: 3a 50 6b 67 20 7b 7d 0a 0a 23 20 53 65 74 75 70 :Pkg {}..# Setup
05e0: 20 74 68 65 20 75 6e 6b 6e 6f 77 6e 20 70 61 63 the unknown pac
05f0: 6b 61 67 65 20 68 61 6e 64 6c 65 72 0a 69 66 20 kage handler.if
0600: 7b 5b 69 6e 74 65 72 70 20 69 73 73 61 66 65 5d {[interp issafe]
0610: 7d 20 7b 0a 20 20 20 20 70 61 63 6b 61 67 65 20 } {. package
0620: 75 6e 6b 6e 6f 77 6e 20 7b 3a 3a 74 63 6c 3a 3a unknown {::tcl::
0630: 74 6d 3a 3a 55 6e 6b 6e 6f 77 6e 48 61 6e 64 6c tm::UnknownHandl
0640: 65 72 20 3a 3a 74 63 6c 50 6b 67 55 6e 6b 6e 6f er ::tclPkgUnkno
0650: 77 6e 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 wn}.} else {.
0660: 20 23 20 53 65 74 20 75 70 20 73 65 61 72 63 68 # Set up search
0670: 20 66 6f 72 20 54 63 6c 20 4d 6f 64 75 6c 65 73 for Tcl Modules
0680: 20 28 54 49 50 20 23 31 38 39 29 2e 0a 20 20 20 (TIP #189)..
0690: 20 23 20 61 6e 64 20 73 65 74 75 70 20 70 6c 61 # and setup pla
06a0: 74 66 6f 72 6d 20 73 70 65 63 69 66 69 63 20 75 tform specific u
06b0: 6e 6b 6e 6f 77 6e 20 70 61 63 6b 61 67 65 20 68 nknown package h
06c0: 61 6e 64 6c 65 72 73 0a 20 20 20 20 69 66 20 7b andlers. if {
06d0: 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 6f 73 $tcl_platform(os
06e0: 29 20 65 71 20 22 44 61 72 77 69 6e 22 0a 09 20 ) eq "Darwin"..
06f0: 20 20 20 26 26 20 24 74 63 6c 5f 70 6c 61 74 66 && $tcl_platf
0700: 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65 71 orm(platform) eq
0710: 20 22 75 6e 69 78 22 7d 20 7b 0a 09 70 61 63 6b "unix"} {..pack
0720: 61 67 65 20 75 6e 6b 6e 6f 77 6e 20 7b 3a 3a 74 age unknown {::t
0730: 63 6c 3a 3a 74 6d 3a 3a 55 6e 6b 6e 6f 77 6e 48 cl::tm::UnknownH
0740: 61 6e 64 6c 65 72 20 5c 0a 09 09 7b 3a 3a 74 63 andler \...{::tc
0750: 6c 3a 3a 4d 61 63 4f 53 58 50 6b 67 55 6e 6b 6e l::MacOSXPkgUnkn
0760: 6f 77 6e 20 3a 3a 74 63 6c 50 6b 67 55 6e 6b 6e own ::tclPkgUnkn
0770: 6f 77 6e 7d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 own}}. } else
0780: 20 7b 0a 09 70 61 63 6b 61 67 65 20 75 6e 6b 6e {..package unkn
0790: 6f 77 6e 20 7b 3a 3a 74 63 6c 3a 3a 74 6d 3a 3a own {::tcl::tm::
07a0: 55 6e 6b 6e 6f 77 6e 48 61 6e 64 6c 65 72 20 3a UnknownHandler :
07b0: 3a 74 63 6c 50 6b 67 55 6e 6b 6e 6f 77 6e 7d 0a :tclPkgUnknown}.
07c0: 20 20 20 20 7d 0a 7d 0a 0a 23 20 43 6f 6e 64 69 }.}..# Condi
07d0: 74 69 6f 6e 61 6c 69 7a 65 20 66 6f 72 20 70 72 tionalize for pr
07e0: 65 73 65 6e 63 65 20 6f 66 20 65 78 65 63 2e 0a esence of exec..
07f0: 0a 69 66 20 7b 5b 6e 61 6d 65 73 70 61 63 65 20 .if {[namespace
0800: 77 68 69 63 68 20 2d 63 6f 6d 6d 61 6e 64 20 65 which -command e
0810: 78 65 63 5d 20 65 71 20 22 22 7d 20 7b 0a 0a 20 xec] eq ""} {..
0820: 20 20 20 23 20 53 6f 6d 65 20 6d 61 63 68 69 6e # Some machin
0830: 65 73 20 64 6f 20 6e 6f 74 20 68 61 76 65 20 65 es do not have e
0840: 78 65 63 2e 20 41 6c 73 6f 2c 20 6f 6e 20 61 6c xec. Also, on al
0850: 6c 0a 20 20 20 20 23 20 70 6c 61 74 66 6f 72 6d l. # platform
0860: 73 2c 20 73 61 66 65 20 69 6e 74 65 72 70 72 65 s, safe interpre
0870: 74 65 72 73 20 64 6f 20 6e 6f 74 20 68 61 76 65 ters do not have
0880: 20 65 78 65 63 2e 0a 0a 20 20 20 20 73 65 74 20 exec... set
0890: 61 75 74 6f 5f 6e 6f 65 78 65 63 20 31 0a 7d 0a auto_noexec 1.}.
08a0: 0a 23 20 44 65 66 69 6e 65 20 61 20 6c 6f 67 20 .# Define a log
08b0: 63 6f 6d 6d 61 6e 64 20 28 77 68 69 63 68 20 63 command (which c
08c0: 61 6e 20 62 65 20 6f 76 65 72 77 72 69 74 74 65 an be overwritte
08d0: 6e 20 74 6f 20 6c 6f 67 20 65 72 72 6f 72 73 0a n to log errors.
08e0: 23 20 64 69 66 66 65 72 65 6e 74 6c 79 2c 20 73 # differently, s
08f0: 70 65 63 69 61 6c 6c 79 20 77 68 65 6e 20 73 74 pecially when st
0900: 64 65 72 72 20 69 73 20 6e 6f 74 20 61 76 61 69 derr is not avai
0910: 6c 61 62 6c 65 29 0a 0a 69 66 20 7b 5b 6e 61 6d lable)..if {[nam
0920: 65 73 70 61 63 65 20 77 68 69 63 68 20 2d 63 6f espace which -co
0930: 6d 6d 61 6e 64 20 74 63 6c 4c 6f 67 5d 20 65 71 mmand tclLog] eq
0940: 20 22 22 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 ""} {. proc
0950: 74 63 6c 4c 6f 67 20 7b 73 74 72 69 6e 67 7d 20 tclLog {string}
0960: 7b 0a 09 63 61 74 63 68 20 7b 70 75 74 73 20 73 {..catch {puts s
0970: 74 64 65 72 72 20 24 73 74 72 69 6e 67 7d 0a 20 tderr $string}.
0980: 20 20 20 7d 0a 7d 0a 0a 23 20 75 6e 6b 6e 6f 77 }.}..# unknow
0990: 6e 20 2d 2d 0a 23 20 54 68 69 73 20 70 72 6f 63 n --.# This proc
09a0: 65 64 75 72 65 20 69 73 20 63 61 6c 6c 65 64 20 edure is called
09b0: 77 68 65 6e 20 61 20 54 63 6c 20 63 6f 6d 6d 61 when a Tcl comma
09c0: 6e 64 20 69 73 20 69 6e 76 6f 6b 65 64 20 74 68 nd is invoked th
09d0: 61 74 20 64 6f 65 73 6e 27 74 0a 23 20 65 78 69 at doesn't.# exi
09e0: 73 74 20 69 6e 20 74 68 65 20 69 6e 74 65 72 70 st in the interp
09f0: 72 65 74 65 72 2e 20 20 49 74 20 74 61 6b 65 73 reter. It takes
0a00: 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 73 the following s
0a10: 74 65 70 73 20 74 6f 20 6d 61 6b 65 20 74 68 65 teps to make the
0a20: 0a 23 20 63 6f 6d 6d 61 6e 64 20 61 76 61 69 6c .# command avail
0a30: 61 62 6c 65 3a 0a 23 0a 23 09 31 2e 20 53 65 65 able:.#.#.1. See
0a40: 20 69 66 20 74 68 65 20 61 75 74 6f 6c 6f 61 64 if the autoload
0a50: 20 66 61 63 69 6c 69 74 79 20 63 61 6e 20 6c 6f facility can lo
0a60: 63 61 74 65 20 74 68 65 20 63 6f 6d 6d 61 6e 64 cate the command
0a70: 20 69 6e 20 61 0a 23 09 20 20 20 54 63 6c 20 73 in a.#. Tcl s
0a80: 63 72 69 70 74 20 66 69 6c 65 2e 20 20 49 66 20 cript file. If
0a90: 73 6f 2c 20 6c 6f 61 64 20 69 74 20 61 6e 64 20 so, load it and
0aa0: 65 78 65 63 75 74 65 20 69 74 2e 0a 23 09 32 2e execute it..#.2.
0ab0: 20 49 66 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 If the command
0ac0: 77 61 73 20 69 6e 76 6f 6b 65 64 20 69 6e 74 65 was invoked inte
0ad0: 72 61 63 74 69 76 65 6c 79 20 61 74 20 74 6f 70 ractively at top
0ae0: 2d 6c 65 76 65 6c 3a 0a 23 09 20 20 20 20 28 61 -level:.#. (a
0af0: 29 20 73 65 65 20 69 66 20 74 68 65 20 63 6f 6d ) see if the com
0b00: 6d 61 6e 64 20 65 78 69 73 74 73 20 61 73 20 61 mand exists as a
0b10: 6e 20 65 78 65 63 75 74 61 62 6c 65 20 55 4e 49 n executable UNI
0b20: 58 20 70 72 6f 67 72 61 6d 2e 0a 23 09 09 49 66 X program..#..If
0b30: 20 73 6f 2c 20 22 65 78 65 63 22 20 74 68 65 20 so, "exec" the
0b40: 63 6f 6d 6d 61 6e 64 2e 0a 23 09 20 20 20 20 28 command..#. (
0b50: 62 29 20 73 65 65 20 69 66 20 74 68 65 20 63 6f b) see if the co
0b60: 6d 6d 61 6e 64 20 72 65 71 75 65 73 74 73 20 63 mmand requests c
0b70: 73 68 2d 6c 69 6b 65 20 68 69 73 74 6f 72 79 20 sh-like history
0b80: 73 75 62 73 74 69 74 75 74 69 6f 6e 0a 23 09 09 substitution.#..
0b90: 69 6e 20 6f 6e 65 20 6f 66 20 74 68 65 20 63 6f in one of the co
0ba0: 6d 6d 6f 6e 20 66 6f 72 6d 73 20 21 21 2c 20 21 mmon forms !!, !
0bb0: 3c 6e 75 6d 62 65 72 3e 2c 20 6f 72 20 5e 6f 6c <number>, or ^ol
0bc0: 64 5e 6e 65 77 2e 20 20 49 66 0a 23 09 09 73 6f d^new. If.#..so
0bd0: 2c 20 65 6d 75 6c 61 74 65 20 63 73 68 27 73 20 , emulate csh's
0be0: 68 69 73 74 6f 72 79 20 73 75 62 73 74 69 74 75 history substitu
0bf0: 74 69 6f 6e 2e 0a 23 09 20 20 20 20 28 63 29 20 tion..#. (c)
0c00: 73 65 65 20 69 66 20 74 68 65 20 63 6f 6d 6d 61 see if the comma
0c10: 6e 64 20 69 73 20 61 20 75 6e 69 71 75 65 20 61 nd is a unique a
0c20: 62 62 72 65 76 69 61 74 69 6f 6e 20 66 6f 72 20 bbreviation for
0c30: 61 6e 6f 74 68 65 72 0a 23 09 09 63 6f 6d 6d 61 another.#..comma
0c40: 6e 64 2e 20 20 49 66 20 73 6f 2c 20 69 6e 76 6f nd. If so, invo
0c50: 6b 65 20 74 68 65 20 63 6f 6d 6d 61 6e 64 2e 0a ke the command..
0c60: 23 0a 23 20 41 72 67 75 6d 65 6e 74 73 3a 0a 23 #.# Arguments:.#
0c70: 20 61 72 67 73 20 2d 09 41 20 6c 69 73 74 20 77 args -.A list w
0c80: 68 6f 73 65 20 65 6c 65 6d 65 6e 74 73 20 61 72 hose elements ar
0c90: 65 20 74 68 65 20 77 6f 72 64 73 20 6f 66 20 74 e the words of t
0ca0: 68 65 20 6f 72 69 67 69 6e 61 6c 0a 23 09 09 63 he original.#..c
0cb0: 6f 6d 6d 61 6e 64 2c 20 69 6e 63 6c 75 64 69 6e ommand, includin
0cc0: 67 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6e 61 g the command na
0cd0: 6d 65 2e 0a 0a 70 72 6f 63 20 75 6e 6b 6e 6f 77 me...proc unknow
0ce0: 6e 20 61 72 67 73 20 7b 0a 20 20 20 20 76 61 72 n args {. var
0cf0: 69 61 62 6c 65 20 3a 3a 74 63 6c 3a 3a 55 6e 6b iable ::tcl::Unk
0d00: 6e 6f 77 6e 50 65 6e 64 69 6e 67 0a 20 20 20 20 nownPending.
0d10: 67 6c 6f 62 61 6c 20 61 75 74 6f 5f 6e 6f 65 78 global auto_noex
0d20: 65 63 20 61 75 74 6f 5f 6e 6f 6c 6f 61 64 20 65 ec auto_noload e
0d30: 6e 76 20 74 63 6c 5f 69 6e 74 65 72 61 63 74 69 nv tcl_interacti
0d40: 76 65 20 65 72 72 6f 72 49 6e 66 6f 20 65 72 72 ve errorInfo err
0d50: 6f 72 43 6f 64 65 0a 0a 20 20 20 20 69 66 20 7b orCode.. if {
0d60: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 72 72 [info exists err
0d70: 6f 72 49 6e 66 6f 5d 7d 20 7b 0a 09 73 65 74 20 orInfo]} {..set
0d80: 73 61 76 65 64 45 72 72 6f 72 49 6e 66 6f 20 24 savedErrorInfo $
0d90: 65 72 72 6f 72 49 6e 66 6f 0a 20 20 20 20 7d 0a errorInfo. }.
0da0: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
0db0: 69 73 74 73 20 65 72 72 6f 72 43 6f 64 65 5d 7d ists errorCode]}
0dc0: 20 7b 0a 09 73 65 74 20 73 61 76 65 64 45 72 72 {..set savedErr
0dd0: 6f 72 43 6f 64 65 20 24 65 72 72 6f 72 43 6f 64 orCode $errorCod
0de0: 65 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 e. }.. set
0df0: 20 6e 61 6d 65 20 5b 6c 69 6e 64 65 78 20 24 61 name [lindex $a
0e00: 72 67 73 20 30 5d 0a 20 20 20 20 69 66 20 7b 21 rgs 0]. if {!
0e10: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 61 75 74 [info exists aut
0e20: 6f 5f 6e 6f 6c 6f 61 64 5d 7d 20 7b 0a 09 23 0a o_noload]} {..#.
0e30: 09 23 20 4d 61 6b 65 20 73 75 72 65 20 77 65 27 .# Make sure we'
0e40: 72 65 20 6e 6f 74 20 74 72 79 69 6e 67 20 74 6f re not trying to
0e50: 20 6c 6f 61 64 20 74 68 65 20 73 61 6d 65 20 70 load the same p
0e60: 72 6f 63 20 74 77 69 63 65 2e 0a 09 23 0a 09 69 roc twice...#..i
0e70: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0e80: 55 6e 6b 6e 6f 77 6e 50 65 6e 64 69 6e 67 28 24 UnknownPending($
0e90: 6e 61 6d 65 29 5d 7d 20 7b 0a 09 20 20 20 20 72 name)]} {.. r
0ea0: 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f eturn -code erro
0eb0: 72 20 22 73 65 6c 66 2d 72 65 66 65 72 65 6e 74 r "self-referent
0ec0: 69 61 6c 20 72 65 63 75 72 73 69 6f 6e 5c 0a 09 ial recursion\..
0ed0: 09 20 20 20 20 69 6e 20 5c 22 75 6e 6b 6e 6f 77 . in \"unknow
0ee0: 6e 5c 22 20 66 6f 72 20 63 6f 6d 6d 61 6e 64 20 n\" for command
0ef0: 5c 22 24 6e 61 6d 65 5c 22 22 0a 09 7d 0a 09 73 \"$name\""..}..s
0f00: 65 74 20 55 6e 6b 6e 6f 77 6e 50 65 6e 64 69 6e et UnknownPendin
0f10: 67 28 24 6e 61 6d 65 29 20 70 65 6e 64 69 6e 67 g($name) pending
0f20: 0a 09 73 65 74 20 72 65 74 20 5b 63 61 74 63 68 ..set ret [catch
0f30: 20 7b 0a 09 09 61 75 74 6f 5f 6c 6f 61 64 20 24 {...auto_load $
0f40: 6e 61 6d 65 20 5b 75 70 6c 65 76 65 6c 20 31 20 name [uplevel 1
0f50: 7b 3a 3a 6e 61 6d 65 73 70 61 63 65 20 63 75 72 {::namespace cur
0f60: 72 65 6e 74 7d 5d 0a 09 7d 20 6d 73 67 20 6f 70 rent}]..} msg op
0f70: 74 73 5d 0a 09 75 6e 73 65 74 20 55 6e 6b 6e 6f ts]..unset Unkno
0f80: 77 6e 50 65 6e 64 69 6e 67 28 24 6e 61 6d 65 29 wnPending($name)
0f90: 0a 09 69 66 20 7b 24 72 65 74 20 21 3d 20 30 7d ..if {$ret != 0}
0fa0: 20 7b 0a 09 20 20 20 20 64 69 63 74 20 61 70 70 {.. dict app
0fb0: 65 6e 64 20 6f 70 74 73 20 2d 65 72 72 6f 72 69 end opts -errori
0fc0: 6e 66 6f 20 22 5c 6e 20 20 20 20 28 61 75 74 6f nfo "\n (auto
0fd0: 6c 6f 61 64 69 6e 67 20 5c 22 24 6e 61 6d 65 5c loading \"$name\
0fe0: 22 29 22 0a 09 20 20 20 20 72 65 74 75 72 6e 20 ")".. return
0ff0: 2d 6f 70 74 69 6f 6e 73 20 24 6f 70 74 73 20 24 -options $opts $
1000: 6d 73 67 0a 09 7d 0a 09 69 66 20 7b 21 5b 61 72 msg..}..if {![ar
1010: 72 61 79 20 73 69 7a 65 20 55 6e 6b 6e 6f 77 6e ray size Unknown
1020: 50 65 6e 64 69 6e 67 5d 7d 20 7b 0a 09 20 20 20 Pending]} {..
1030: 20 75 6e 73 65 74 20 55 6e 6b 6e 6f 77 6e 50 65 unset UnknownPe
1040: 6e 64 69 6e 67 0a 09 7d 0a 09 69 66 20 7b 24 6d nding..}..if {$m
1050: 73 67 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b sg} {.. if {[
1060: 69 6e 66 6f 20 65 78 69 73 74 73 20 73 61 76 65 info exists save
1070: 64 45 72 72 6f 72 43 6f 64 65 5d 7d 20 7b 0a 09 dErrorCode]} {..
1080: 09 73 65 74 20 3a 3a 65 72 72 6f 72 43 6f 64 65 .set ::errorCode
1090: 20 24 73 61 76 65 64 45 72 72 6f 72 43 6f 64 65 $savedErrorCode
10a0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
10b0: 09 75 6e 73 65 74 20 2d 6e 6f 63 6f 6d 70 6c 61 .unset -nocompla
10c0: 69 6e 20 3a 3a 65 72 72 6f 72 43 6f 64 65 0a 09 in ::errorCode..
10d0: 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 5b }.. if {[
10e0: 69 6e 66 6f 20 65 78 69 73 74 73 20 73 61 76 65 info exists save
10f0: 64 45 72 72 6f 72 49 6e 66 6f 5d 7d 20 7b 0a 09 dErrorInfo]} {..
1100: 09 73 65 74 20 65 72 72 6f 72 49 6e 66 6f 20 24 .set errorInfo $
1110: 73 61 76 65 64 45 72 72 6f 72 49 6e 66 6f 0a 09 savedErrorInfo..
1120: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 75 } else {...u
1130: 6e 73 65 74 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e nset -nocomplain
1140: 20 65 72 72 6f 72 49 6e 66 6f 0a 09 20 20 20 20 errorInfo..
1150: 7d 0a 09 20 20 20 20 73 65 74 20 63 6f 64 65 20 }.. set code
1160: 5b 63 61 74 63 68 20 7b 75 70 6c 65 76 65 6c 20 [catch {uplevel
1170: 31 20 24 61 72 67 73 7d 20 6d 73 67 20 6f 70 74 1 $args} msg opt
1180: 73 5d 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 64 s].. if {$cod
1190: 65 20 3d 3d 20 20 31 7d 20 7b 0a 09 09 23 0a 09 e == 1} {...#..
11a0: 09 23 20 43 6f 6d 70 75 74 65 20 73 74 61 63 6b .# Compute stack
11b0: 20 74 72 61 63 65 20 63 6f 6e 74 72 69 62 75 74 trace contribut
11c0: 69 6f 6e 20 66 72 6f 6d 20 74 68 65 20 5b 75 70 ion from the [up
11d0: 6c 65 76 65 6c 5d 2e 0a 09 09 23 20 4e 6f 74 65 level]....# Note
11e0: 20 74 68 65 20 64 65 70 65 6e 64 65 6e 63 65 20 the dependence
11f0: 6f 6e 20 68 6f 77 20 54 63 6c 5f 41 64 64 45 72 on how Tcl_AddEr
1200: 72 6f 72 49 6e 66 6f 2c 20 65 74 63 2e 0a 09 09 rorInfo, etc....
1210: 23 20 63 6f 6e 73 74 72 75 63 74 20 74 68 65 20 # construct the
1220: 73 74 61 63 6b 20 74 72 61 63 65 2e 0a 09 09 23 stack trace....#
1230: 0a 09 09 73 65 74 20 65 72 72 49 6e 66 6f 20 5b ...set errInfo [
1240: 64 69 63 74 20 67 65 74 20 24 6f 70 74 73 20 2d dict get $opts -
1250: 65 72 72 6f 72 69 6e 66 6f 5d 0a 09 09 73 65 74 errorinfo]...set
1260: 20 65 72 72 43 6f 64 65 20 5b 64 69 63 74 20 67 errCode [dict g
1270: 65 74 20 24 6f 70 74 73 20 2d 65 72 72 6f 72 63 et $opts -errorc
1280: 6f 64 65 5d 0a 09 09 73 65 74 20 63 69 6e 66 6f ode]...set cinfo
1290: 20 24 61 72 67 73 0a 09 09 69 66 20 7b 5b 73 74 $args...if {[st
12a0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 5b 65 6e 63 ring length [enc
12b0: 6f 64 69 6e 67 20 63 6f 6e 76 65 72 74 74 6f 20 oding convertto
12c0: 75 74 66 2d 38 20 24 63 69 6e 66 6f 5d 5d 20 3e utf-8 $cinfo]] >
12d0: 20 31 35 30 7d 20 7b 0a 09 09 20 20 20 20 73 65 150} {... se
12e0: 74 20 63 69 6e 66 6f 20 5b 73 74 72 69 6e 67 20 t cinfo [string
12f0: 72 61 6e 67 65 20 24 63 69 6e 66 6f 20 30 20 31 range $cinfo 0 1
1300: 35 30 5d 0a 09 09 20 20 20 20 77 68 69 6c 65 20 50]... while
1310: 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 {[string length
1320: 5b 65 6e 63 6f 64 69 6e 67 20 63 6f 6e 76 65 72 [encoding conver
1330: 74 74 6f 20 75 74 66 2d 38 20 24 63 69 6e 66 6f tto utf-8 $cinfo
1340: 5d 5d 20 3e 20 31 35 30 7d 20 7b 0a 09 09 09 73 ]] > 150} {....s
1350: 65 74 20 63 69 6e 66 6f 20 5b 73 74 72 69 6e 67 et cinfo [string
1360: 20 72 61 6e 67 65 20 24 63 69 6e 66 6f 20 30 20 range $cinfo 0
1370: 65 6e 64 2d 31 5d 0a 09 09 20 20 20 20 7d 0a 09 end-1]... }..
1380: 09 20 20 20 20 61 70 70 65 6e 64 20 63 69 6e 66 . append cinf
1390: 6f 20 2e 2e 2e 0a 09 09 7d 0a 09 09 73 65 74 20 o ......}...set
13a0: 74 61 69 6c 20 22 5c 6e 20 20 20 20 28 5c 22 75 tail "\n (\"u
13b0: 70 6c 65 76 65 6c 5c 22 20 62 6f 64 79 20 6c 69 plevel\" body li
13c0: 6e 65 20 31 29 5c 6e 20 20 20 20 69 6e 76 6f 6b ne 1)\n invok
13d0: 65 64 5c 0a 09 09 09 66 72 6f 6d 20 77 69 74 68 ed\....from with
13e0: 69 6e 5c 6e 5c 22 75 70 6c 65 76 65 6c 20 31 20 in\n\"uplevel 1
13f0: 5c 24 61 72 67 73 5c 22 22 0a 09 09 73 65 74 20 \$args\""...set
1400: 65 78 70 65 63 74 20 22 24 6d 73 67 5c 6e 20 20 expect "$msg\n
1410: 20 20 77 68 69 6c 65 20 65 78 65 63 75 74 69 6e while executin
1420: 67 5c 6e 5c 22 24 63 69 6e 66 6f 5c 22 24 74 61 g\n\"$cinfo\"$ta
1430: 69 6c 22 0a 09 09 69 66 20 7b 24 65 72 72 49 6e il"...if {$errIn
1440: 66 6f 20 65 71 20 24 65 78 70 65 63 74 7d 20 7b fo eq $expect} {
1450: 0a 09 09 20 20 20 20 23 0a 09 09 20 20 20 20 23 ... #... #
1460: 20 54 68 65 20 73 74 61 63 6b 20 68 61 73 20 6f The stack has o
1470: 6e 6c 79 20 74 68 65 20 65 76 61 6c 20 66 72 6f nly the eval fro
1480: 6d 20 74 68 65 20 65 78 70 61 6e 64 65 64 20 63 m the expanded c
1490: 6f 6d 6d 61 6e 64 0a 09 09 20 20 20 20 23 20 44 ommand... # D
14a0: 6f 20 6e 6f 74 20 67 65 6e 65 72 61 74 65 20 61 o not generate a
14b0: 6e 79 20 73 74 61 63 6b 20 74 72 61 63 65 20 68 ny stack trace h
14c0: 65 72 65 2e 0a 09 09 20 20 20 20 23 0a 09 09 20 ere.... #...
14d0: 20 20 20 64 69 63 74 20 75 6e 73 65 74 20 6f 70 dict unset op
14e0: 74 73 20 2d 65 72 72 6f 72 69 6e 66 6f 0a 09 09 ts -errorinfo...
14f0: 20 20 20 20 64 69 63 74 20 69 6e 63 72 20 6f 70 dict incr op
1500: 74 73 20 2d 6c 65 76 65 6c 0a 09 09 20 20 20 20 ts -level...
1510: 72 65 74 75 72 6e 20 2d 6f 70 74 69 6f 6e 73 20 return -options
1520: 24 6f 70 74 73 20 24 6d 73 67 0a 09 09 7d 0a 09 $opts $msg...}..
1530: 09 23 0a 09 09 23 20 53 74 61 63 6b 20 74 72 61 .#...# Stack tra
1540: 63 65 20 69 73 20 6e 65 73 74 65 64 2c 20 74 72 ce is nested, tr
1550: 69 6d 20 6f 66 66 20 6a 75 73 74 20 74 68 65 20 im off just the
1560: 63 6f 6e 74 72 69 62 75 74 69 6f 6e 0a 09 09 23 contribution...#
1570: 20 66 72 6f 6d 20 74 68 65 20 65 78 74 72 61 20 from the extra
1580: 22 65 76 61 6c 22 20 6f 66 20 24 61 72 67 73 20 "eval" of $args
1590: 64 75 65 20 74 6f 20 74 68 65 20 22 63 61 74 63 due to the "catc
15a0: 68 22 20 61 62 6f 76 65 2e 0a 09 09 23 0a 09 09 h" above....#...
15b0: 73 65 74 20 6c 61 73 74 20 5b 73 74 72 69 6e 67 set last [string
15c0: 20 6c 61 73 74 20 24 74 61 69 6c 20 24 65 72 72 last $tail $err
15d0: 49 6e 66 6f 5d 0a 09 09 69 66 20 7b 24 6c 61 73 Info]...if {$las
15e0: 74 20 2b 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 t + [string leng
15f0: 74 68 20 24 74 61 69 6c 5d 20 21 3d 20 5b 73 74 th $tail] != [st
1600: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 65 72 72 ring length $err
1610: 49 6e 66 6f 5d 7d 20 7b 0a 09 09 20 20 20 20 23 Info]} {... #
1620: 20 56 65 72 79 20 6c 69 6b 65 6c 79 20 63 61 6e Very likely can
1630: 6e 6f 74 20 68 61 70 70 65 6e 0a 09 09 20 20 20 not happen...
1640: 20 72 65 74 75 72 6e 20 2d 6f 70 74 69 6f 6e 73 return -options
1650: 20 24 6f 70 74 73 20 24 6d 73 67 0a 09 09 7d 0a $opts $msg...}.
1660: 09 09 73 65 74 20 65 72 72 49 6e 66 6f 20 5b 73 ..set errInfo [s
1670: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 65 72 72 tring range $err
1680: 49 6e 66 6f 20 30 20 24 6c 61 73 74 2d 31 5d 0a Info 0 $last-1].
1690: 09 09 73 65 74 20 74 61 69 6c 20 22 5c 22 24 63 ..set tail "\"$c
16a0: 69 6e 66 6f 5c 22 22 0a 09 09 73 65 74 20 6c 61 info\""...set la
16b0: 73 74 20 5b 73 74 72 69 6e 67 20 6c 61 73 74 20 st [string last
16c0: 24 74 61 69 6c 20 24 65 72 72 49 6e 66 6f 5d 0a $tail $errInfo].
16d0: 09 09 69 66 20 7b 24 6c 61 73 74 20 3c 20 30 20 ..if {$last < 0
16e0: 7c 7c 20 24 6c 61 73 74 20 2b 20 5b 73 74 72 69 || $last + [stri
16f0: 6e 67 20 6c 65 6e 67 74 68 20 24 74 61 69 6c 5d ng length $tail]
1700: 20 21 3d 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 != [string leng
1710: 74 68 20 24 65 72 72 49 6e 66 6f 5d 7d 20 7b 0a th $errInfo]} {.
1720: 09 09 20 20 20 20 72 65 74 75 72 6e 20 2d 63 6f .. return -co
1730: 64 65 20 65 72 72 6f 72 20 2d 65 72 72 6f 72 63 de error -errorc
1740: 6f 64 65 20 24 65 72 72 43 6f 64 65 20 5c 0a 09 ode $errCode \..
1750: 09 09 20 20 20 20 2d 65 72 72 6f 72 69 6e 66 6f .. -errorinfo
1760: 20 24 65 72 72 49 6e 66 6f 20 24 6d 73 67 0a 09 $errInfo $msg..
1770: 09 7d 0a 09 09 73 65 74 20 65 72 72 49 6e 66 6f .}...set errInfo
1780: 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 [string range $
1790: 65 72 72 49 6e 66 6f 20 30 20 24 6c 61 73 74 2d errInfo 0 $last-
17a0: 31 5d 0a 09 09 73 65 74 20 74 61 69 6c 20 22 5c 1]...set tail "\
17b0: 6e 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f n invoked fro
17c0: 6d 20 77 69 74 68 69 6e 5c 6e 22 0a 09 09 73 65 m within\n"...se
17d0: 74 20 6c 61 73 74 20 5b 73 74 72 69 6e 67 20 6c t last [string l
17e0: 61 73 74 20 24 74 61 69 6c 20 24 65 72 72 49 6e ast $tail $errIn
17f0: 66 6f 5d 0a 09 09 69 66 20 7b 24 6c 61 73 74 20 fo]...if {$last
1800: 2b 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 + [string length
1810: 20 24 74 61 69 6c 5d 20 3d 3d 20 5b 73 74 72 69 $tail] == [stri
1820: 6e 67 20 6c 65 6e 67 74 68 20 24 65 72 72 49 6e ng length $errIn
1830: 66 6f 5d 7d 20 7b 0a 09 09 20 20 20 20 72 65 74 fo]} {... ret
1840: 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 urn -code error
1850: 2d 65 72 72 6f 72 63 6f 64 65 20 24 65 72 72 43 -errorcode $errC
1860: 6f 64 65 20 5c 0a 09 09 09 20 20 20 20 2d 65 72 ode \.... -er
1870: 72 6f 72 69 6e 66 6f 20 5b 73 74 72 69 6e 67 20 rorinfo [string
1880: 72 61 6e 67 65 20 24 65 72 72 49 6e 66 6f 20 30 range $errInfo 0
1890: 20 24 6c 61 73 74 2d 31 5d 20 24 6d 73 67 0a 09 $last-1] $msg..
18a0: 09 7d 0a 09 09 73 65 74 20 74 61 69 6c 20 22 5c .}...set tail "\
18b0: 6e 20 20 20 20 77 68 69 6c 65 20 65 78 65 63 75 n while execu
18c0: 74 69 6e 67 5c 6e 22 0a 09 09 73 65 74 20 6c 61 ting\n"...set la
18d0: 73 74 20 5b 73 74 72 69 6e 67 20 6c 61 73 74 20 st [string last
18e0: 24 74 61 69 6c 20 24 65 72 72 49 6e 66 6f 5d 0a $tail $errInfo].
18f0: 09 09 69 66 20 7b 24 6c 61 73 74 20 2b 20 5b 73 ..if {$last + [s
1900: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 74 61 tring length $ta
1910: 69 6c 5d 20 3d 3d 20 5b 73 74 72 69 6e 67 20 6c il] == [string l
1920: 65 6e 67 74 68 20 24 65 72 72 49 6e 66 6f 5d 7d ength $errInfo]}
1930: 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 {... return
1940: 2d 63 6f 64 65 20 65 72 72 6f 72 20 2d 65 72 72 -code error -err
1950: 6f 72 63 6f 64 65 20 24 65 72 72 43 6f 64 65 20 orcode $errCode
1960: 5c 0a 09 09 09 20 20 20 20 2d 65 72 72 6f 72 69 \.... -errori
1970: 6e 66 6f 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 nfo [string rang
1980: 65 20 24 65 72 72 49 6e 66 6f 20 30 20 24 6c 61 e $errInfo 0 $la
1990: 73 74 2d 31 5d 20 24 6d 73 67 0a 09 09 7d 0a 09 st-1] $msg...}..
19a0: 09 72 65 74 75 72 6e 20 2d 6f 70 74 69 6f 6e 73 .return -options
19b0: 20 24 6f 70 74 73 20 24 6d 73 67 0a 09 20 20 20 $opts $msg..
19c0: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 64 69 63 74 } else {...dict
19d0: 20 69 6e 63 72 20 6f 70 74 73 20 2d 6c 65 76 65 incr opts -leve
19e0: 6c 0a 09 09 72 65 74 75 72 6e 20 2d 6f 70 74 69 l...return -opti
19f0: 6f 6e 73 20 24 6f 70 74 73 20 24 6d 73 67 0a 09 ons $opts $msg..
1a00: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a }..}. }..
1a10: 20 20 20 20 69 66 20 7b 28 5b 69 6e 66 6f 20 6c if {([info l
1a20: 65 76 65 6c 5d 20 3d 3d 20 31 29 20 26 26 20 28 evel] == 1) && (
1a30: 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d 20 65 71 [info script] eq
1a40: 20 22 22 29 0a 09 20 20 20 20 26 26 20 5b 69 6e "").. && [in
1a50: 66 6f 20 65 78 69 73 74 73 20 74 63 6c 5f 69 6e fo exists tcl_in
1a60: 74 65 72 61 63 74 69 76 65 5d 20 26 26 20 24 74 teractive] && $t
1a70: 63 6c 5f 69 6e 74 65 72 61 63 74 69 76 65 7d 20 cl_interactive}
1a80: 7b 0a 09 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 {..if {![info ex
1a90: 69 73 74 73 20 61 75 74 6f 5f 6e 6f 65 78 65 63 ists auto_noexec
1aa0: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6e 65 ]} {.. set ne
1ab0: 77 20 5b 61 75 74 6f 5f 65 78 65 63 6f 6b 20 24 w [auto_execok $
1ac0: 6e 61 6d 65 5d 0a 09 20 20 20 20 69 66 20 7b 24 name].. if {$
1ad0: 6e 65 77 20 6e 65 20 22 22 7d 20 7b 0a 09 09 73 new ne ""} {...s
1ae0: 65 74 20 72 65 64 69 72 20 22 22 0a 09 09 69 66 et redir ""...if
1af0: 20 7b 5b 6e 61 6d 65 73 70 61 63 65 20 77 68 69 {[namespace whi
1b00: 63 68 20 2d 63 6f 6d 6d 61 6e 64 20 63 6f 6e 73 ch -command cons
1b10: 6f 6c 65 5d 20 65 71 20 22 22 7d 20 7b 0a 09 09 ole] eq ""} {...
1b20: 20 20 20 20 73 65 74 20 72 65 64 69 72 20 22 3e set redir ">
1b30: 26 40 73 74 64 6f 75 74 20 3c 40 73 74 64 69 6e &@stdout <@stdin
1b40: 22 0a 09 09 7d 0a 09 09 75 70 6c 65 76 65 6c 20 "...}...uplevel
1b50: 31 20 5b 6c 69 73 74 20 3a 3a 63 61 74 63 68 20 1 [list ::catch
1b60: 5c 0a 09 09 09 5b 63 6f 6e 63 61 74 20 65 78 65 \....[concat exe
1b70: 63 20 24 72 65 64 69 72 20 24 6e 65 77 20 5b 6c c $redir $new [l
1b80: 72 61 6e 67 65 20 24 61 72 67 73 20 31 20 65 6e range $args 1 en
1b90: 64 5d 5d 20 5c 0a 09 09 09 3a 3a 74 63 6c 3a 3a d]] \....::tcl::
1ba0: 55 6e 6b 6e 6f 77 6e 52 65 73 75 6c 74 20 3a 3a UnknownResult ::
1bb0: 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 4f 70 74 69 tcl::UnknownOpti
1bc0: 6f 6e 73 5d 0a 09 09 64 69 63 74 20 69 6e 63 72 ons]...dict incr
1bd0: 20 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 4f ::tcl::UnknownO
1be0: 70 74 69 6f 6e 73 20 2d 6c 65 76 65 6c 0a 09 09 ptions -level...
1bf0: 72 65 74 75 72 6e 20 2d 6f 70 74 69 6f 6e 73 20 return -options
1c00: 24 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 4f $::tcl::UnknownO
1c10: 70 74 69 6f 6e 73 20 24 3a 3a 74 63 6c 3a 3a 55 ptions $::tcl::U
1c20: 6e 6b 6e 6f 77 6e 52 65 73 75 6c 74 0a 09 20 20 nknownResult..
1c30: 20 20 7d 0a 09 7d 0a 09 69 66 20 7b 24 6e 61 6d }..}..if {$nam
1c40: 65 20 65 71 20 22 21 21 22 7d 20 7b 0a 09 20 20 e eq "!!"} {..
1c50: 20 20 73 65 74 20 6e 65 77 63 6d 64 20 5b 68 69 set newcmd [hi
1c60: 73 74 6f 72 79 20 65 76 65 6e 74 5d 0a 09 7d 20 story event]..}
1c70: 65 6c 73 65 69 66 20 7b 5b 72 65 67 65 78 70 20 elseif {[regexp
1c80: 7b 5e 21 28 2e 2b 29 24 7d 20 24 6e 61 6d 65 20 {^!(.+)$} $name
1c90: 2d 3e 20 65 76 65 6e 74 5d 7d 20 7b 0a 09 20 20 -> event]} {..
1ca0: 20 20 73 65 74 20 6e 65 77 63 6d 64 20 5b 68 69 set newcmd [hi
1cb0: 73 74 6f 72 79 20 65 76 65 6e 74 20 24 65 76 65 story event $eve
1cc0: 6e 74 5d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b nt]..} elseif {[
1cd0: 72 65 67 65 78 70 20 7b 5e 5c 5e 28 5b 5e 5e 5d regexp {^\^([^^]
1ce0: 2a 29 5c 5e 28 5b 5e 5e 5d 2a 29 5c 5e 3f 24 7d *)\^([^^]*)\^?$}
1cf0: 20 24 6e 61 6d 65 20 2d 3e 20 6f 6c 64 20 6e 65 $name -> old ne
1d00: 77 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6e w]} {.. set n
1d10: 65 77 63 6d 64 20 5b 68 69 73 74 6f 72 79 20 65 ewcmd [history e
1d20: 76 65 6e 74 20 2d 31 5d 0a 09 20 20 20 20 63 61 vent -1].. ca
1d30: 74 63 68 20 7b 72 65 67 73 75 62 20 2d 61 6c 6c tch {regsub -all
1d40: 20 2d 2d 20 24 6f 6c 64 20 24 6e 65 77 63 6d 64 -- $old $newcmd
1d50: 20 24 6e 65 77 20 6e 65 77 63 6d 64 7d 0a 09 7d $new newcmd}..}
1d60: 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 ..if {[info exis
1d70: 74 73 20 6e 65 77 63 6d 64 5d 7d 20 7b 0a 09 20 ts newcmd]} {..
1d80: 20 20 20 74 63 6c 4c 6f 67 20 24 6e 65 77 63 6d tclLog $newcm
1d90: 64 0a 09 20 20 20 20 68 69 73 74 6f 72 79 20 63 d.. history c
1da0: 68 61 6e 67 65 20 24 6e 65 77 63 6d 64 20 30 0a hange $newcmd 0.
1db0: 09 20 20 20 20 75 70 6c 65 76 65 6c 20 31 20 5b . uplevel 1 [
1dc0: 6c 69 73 74 20 3a 3a 63 61 74 63 68 20 24 6e 65 list ::catch $ne
1dd0: 77 63 6d 64 20 5c 0a 09 09 20 20 20 20 3a 3a 74 wcmd \... ::t
1de0: 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 52 65 73 75 6c cl::UnknownResul
1df0: 74 20 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e t ::tcl::Unknown
1e00: 4f 70 74 69 6f 6e 73 5d 0a 09 20 20 20 20 64 69 Options].. di
1e10: 63 74 20 69 6e 63 72 20 3a 3a 74 63 6c 3a 3a 55 ct incr ::tcl::U
1e20: 6e 6b 6e 6f 77 6e 4f 70 74 69 6f 6e 73 20 2d 6c nknownOptions -l
1e30: 65 76 65 6c 0a 09 20 20 20 20 72 65 74 75 72 6e evel.. return
1e40: 20 2d 6f 70 74 69 6f 6e 73 20 24 3a 3a 74 63 6c -options $::tcl
1e50: 3a 3a 55 6e 6b 6e 6f 77 6e 4f 70 74 69 6f 6e 73 ::UnknownOptions
1e60: 20 24 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e $::tcl::Unknown
1e70: 52 65 73 75 6c 74 0a 09 7d 0a 0a 09 73 65 74 20 Result..}...set
1e80: 72 65 74 20 5b 63 61 74 63 68 20 5b 6c 69 73 74 ret [catch [list
1e90: 20 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 uplevel 1 [list
1ea0: 20 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 24 info commands $
1eb0: 6e 61 6d 65 2a 5d 5d 20 63 61 6e 64 69 64 61 74 name*]] candidat
1ec0: 65 73 5d 0a 09 69 66 20 7b 24 6e 61 6d 65 20 65 es]..if {$name e
1ed0: 71 20 22 3a 3a 22 7d 20 7b 0a 09 20 20 20 20 73 q "::"} {.. s
1ee0: 65 74 20 6e 61 6d 65 20 22 22 0a 09 7d 0a 09 69 et name ""..}..i
1ef0: 66 20 7b 24 72 65 74 20 21 3d 20 30 7d 20 7b 0a f {$ret != 0} {.
1f00: 09 20 20 20 20 64 69 63 74 20 61 70 70 65 6e 64 . dict append
1f10: 20 6f 70 74 73 20 2d 65 72 72 6f 72 69 6e 66 6f opts -errorinfo
1f20: 20 5c 0a 09 09 20 20 20 20 22 5c 6e 20 20 20 20 \... "\n
1f30: 28 65 78 70 61 6e 64 69 6e 67 20 63 6f 6d 6d 61 (expanding comma
1f40: 6e 64 20 70 72 65 66 69 78 20 5c 22 24 6e 61 6d nd prefix \"$nam
1f50: 65 5c 22 20 69 6e 20 75 6e 6b 6e 6f 77 6e 29 22 e\" in unknown)"
1f60: 0a 09 20 20 20 20 72 65 74 75 72 6e 20 2d 6f 70 .. return -op
1f70: 74 69 6f 6e 73 20 24 6f 70 74 73 20 24 63 61 6e tions $opts $can
1f80: 64 69 64 61 74 65 73 0a 09 7d 0a 09 23 20 46 69 didates..}..# Fi
1f90: 6c 74 65 72 20 6f 75 74 20 62 6f 67 75 73 20 6d lter out bogus m
1fa0: 61 74 63 68 65 73 20 77 68 65 6e 20 24 6e 61 6d atches when $nam
1fb0: 65 20 63 6f 6e 74 61 69 6e 65 64 0a 09 23 20 61 e contained..# a
1fc0: 20 67 6c 6f 62 2d 73 70 65 63 69 61 6c 20 63 68 glob-special ch
1fd0: 61 72 20 5b 42 75 67 20 39 34 36 39 35 32 5d 0a ar [Bug 946952].
1fe0: 09 69 66 20 7b 24 6e 61 6d 65 20 65 71 20 22 22 .if {$name eq ""
1ff0: 7d 20 7b 0a 09 20 20 20 20 23 20 48 61 6e 64 6c } {.. # Handl
2000: 65 20 65 6d 70 74 79 20 24 6e 61 6d 65 20 73 65 e empty $name se
2010: 70 61 72 61 74 65 6c 79 20 64 75 65 20 74 6f 20 parately due to
2020: 73 74 72 61 6e 67 65 6e 65 73 73 0a 09 20 20 20 strangeness..
2030: 20 23 20 69 6e 20 5b 73 74 72 69 6e 67 20 66 69 # in [string fi
2040: 72 73 74 5d 20 28 53 65 65 20 52 46 45 20 31 32 rst] (See RFE 12
2050: 34 33 33 35 34 29 0a 09 20 20 20 20 73 65 74 20 43354).. set
2060: 63 6d 64 73 20 24 63 61 6e 64 69 64 61 74 65 73 cmds $candidates
2070: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
2080: 73 65 74 20 63 6d 64 73 20 5b 6c 69 73 74 5d 0a set cmds [list].
2090: 09 20 20 20 20 66 6f 72 65 61 63 68 20 78 20 24 . foreach x $
20a0: 63 61 6e 64 69 64 61 74 65 73 20 7b 0a 09 09 69 candidates {...i
20b0: 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 74 f {[string first
20c0: 20 24 6e 61 6d 65 20 24 78 5d 20 3d 3d 20 30 7d $name $x] == 0}
20d0: 20 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e 64 {... lappend
20e0: 20 63 6d 64 73 20 24 78 0a 09 09 7d 0a 09 20 20 cmds $x...}..
20f0: 20 20 7d 0a 09 7d 0a 09 69 66 20 7b 5b 6c 6c 65 }..}..if {[lle
2100: 6e 67 74 68 20 24 63 6d 64 73 5d 20 3d 3d 20 31 ngth $cmds] == 1
2110: 7d 20 7b 0a 09 20 20 20 20 75 70 6c 65 76 65 6c } {.. uplevel
2120: 20 31 20 5b 6c 69 73 74 20 3a 3a 63 61 74 63 68 1 [list ::catch
2130: 20 5b 6c 72 65 70 6c 61 63 65 20 24 61 72 67 73 [lreplace $args
2140: 20 30 20 30 20 5b 6c 69 6e 64 65 78 20 24 63 6d 0 0 [lindex $cm
2150: 64 73 20 30 5d 5d 20 5c 0a 09 09 20 20 20 20 3a ds 0]] \... :
2160: 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 52 65 73 :tcl::UnknownRes
2170: 75 6c 74 20 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f ult ::tcl::Unkno
2180: 77 6e 4f 70 74 69 6f 6e 73 5d 0a 09 20 20 20 20 wnOptions]..
2190: 64 69 63 74 20 69 6e 63 72 20 3a 3a 74 63 6c 3a dict incr ::tcl:
21a0: 3a 55 6e 6b 6e 6f 77 6e 4f 70 74 69 6f 6e 73 20 :UnknownOptions
21b0: 2d 6c 65 76 65 6c 0a 09 20 20 20 20 72 65 74 75 -level.. retu
21c0: 72 6e 20 2d 6f 70 74 69 6f 6e 73 20 24 3a 3a 74 rn -options $::t
21d0: 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 4f 70 74 69 6f cl::UnknownOptio
21e0: 6e 73 20 24 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f ns $::tcl::Unkno
21f0: 77 6e 52 65 73 75 6c 74 0a 09 7d 0a 09 69 66 20 wnResult..}..if
2200: 7b 5b 6c 6c 65 6e 67 74 68 20 24 63 6d 64 73 5d {[llength $cmds]
2210: 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 } {.. return
2220: 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 61 6d 62 -code error "amb
2230: 69 67 75 6f 75 73 20 63 6f 6d 6d 61 6e 64 20 6e iguous command n
2240: 61 6d 65 20 5c 22 24 6e 61 6d 65 5c 22 3a 20 5b ame \"$name\": [
2250: 6c 73 6f 72 74 20 24 63 6d 64 73 5d 22 0a 09 7d lsort $cmds]"..}
2260: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 . }. retur
2270: 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 2d 65 n -code error -e
2280: 72 72 6f 72 63 6f 64 65 20 5b 6c 69 73 74 20 54 rrorcode [list T
2290: 43 4c 20 4c 4f 4f 4b 55 50 20 43 4f 4d 4d 41 4e CL LOOKUP COMMAN
22a0: 44 20 24 6e 61 6d 65 5d 20 5c 0a 09 22 69 6e 76 D $name] \.."inv
22b0: 61 6c 69 64 20 63 6f 6d 6d 61 6e 64 20 6e 61 6d alid command nam
22c0: 65 20 5c 22 24 6e 61 6d 65 5c 22 22 0a 7d 0a 0a e \"$name\"".}..
22d0: 23 20 61 75 74 6f 5f 6c 6f 61 64 20 2d 2d 0a 23 # auto_load --.#
22e0: 20 43 68 65 63 6b 73 20 61 20 63 6f 6c 6c 65 63 Checks a collec
22f0: 74 69 6f 6e 20 6f 66 20 6c 69 62 72 61 72 79 20 tion of library
2300: 64 69 72 65 63 74 6f 72 69 65 73 20 74 6f 20 73 directories to s
2310: 65 65 20 69 66 20 61 20 70 72 6f 63 65 64 75 72 ee if a procedur
2320: 65 0a 23 20 69 73 20 64 65 66 69 6e 65 64 20 69 e.# is defined i
2330: 6e 20 6f 6e 65 20 6f 66 20 74 68 65 6d 2e 20 20 n one of them.
2340: 49 66 20 73 6f 2c 20 69 74 20 73 6f 75 72 63 65 If so, it source
2350: 73 20 74 68 65 20 61 70 70 72 6f 70 72 69 61 74 s the appropriat
2360: 65 0a 23 20 6c 69 62 72 61 72 79 20 66 69 6c 65 e.# library file
2370: 20 74 6f 20 63 72 65 61 74 65 20 74 68 65 20 70 to create the p
2380: 72 6f 63 65 64 75 72 65 2e 20 20 52 65 74 75 72 rocedure. Retur
2390: 6e 73 20 31 20 69 66 20 69 74 20 73 75 63 63 65 ns 1 if it succe
23a0: 73 73 66 75 6c 6c 79 0a 23 20 6c 6f 61 64 65 64 ssfully.# loaded
23b0: 20 74 68 65 20 70 72 6f 63 65 64 75 72 65 2c 20 the procedure,
23c0: 30 20 6f 74 68 65 72 77 69 73 65 2e 0a 23 0a 23 0 otherwise..#.#
23d0: 20 41 72 67 75 6d 65 6e 74 73 3a 0a 23 20 63 6d Arguments:.# cm
23e0: 64 20 2d 09 09 09 4e 61 6d 65 20 6f 66 20 74 68 d -...Name of th
23f0: 65 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 66 69 6e e command to fin
2400: 64 20 61 6e 64 20 6c 6f 61 64 2e 0a 23 20 6e 61 d and load..# na
2410: 6d 65 73 70 61 63 65 20 28 6f 70 74 69 6f 6e 61 mespace (optiona
2420: 6c 29 20 20 54 68 65 20 6e 61 6d 65 73 70 61 63 l) The namespac
2430: 65 20 77 68 65 72 65 20 74 68 65 20 63 6f 6d 6d e where the comm
2440: 61 6e 64 20 69 73 20 62 65 69 6e 67 20 75 73 65 and is being use
2450: 64 20 2d 20 6d 75 73 74 20 62 65 0a 23 20 20 20 d - must be.#
2460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2470: 20 20 20 20 61 20 63 61 6e 6f 6e 69 63 61 6c 20 a canonical
2480: 6e 61 6d 65 73 70 61 63 65 20 61 73 20 72 65 74 namespace as ret
2490: 75 72 6e 65 64 20 5b 6e 61 6d 65 73 70 61 63 65 urned [namespace
24a0: 20 63 75 72 72 65 6e 74 5d 0a 23 20 20 20 20 20 current].#
24b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24c0: 20 20 66 6f 72 20 69 6e 73 74 61 6e 63 65 2e 20 for instance.
24d0: 49 66 20 6e 6f 74 20 67 69 76 65 6e 2c 20 6e 61 If not given, na
24e0: 6d 65 73 70 61 63 65 20 63 75 72 72 65 6e 74 20 mespace current
24f0: 69 73 20 75 73 65 64 2e 0a 0a 70 72 6f 63 20 61 is used...proc a
2500: 75 74 6f 5f 6c 6f 61 64 20 7b 63 6d 64 20 7b 6e uto_load {cmd {n
2510: 61 6d 65 73 70 61 63 65 20 7b 7d 7d 7d 20 7b 0a amespace {}}} {.
2520: 20 20 20 20 67 6c 6f 62 61 6c 20 61 75 74 6f 5f global auto_
2530: 69 6e 64 65 78 20 61 75 74 6f 5f 70 61 74 68 0a index auto_path.
2540: 0a 20 20 20 20 23 20 71 75 61 6c 69 66 79 20 6e . # qualify n
2550: 61 6d 65 73 3a 0a 20 20 20 20 69 66 20 7b 24 6e ames:. if {$n
2560: 61 6d 65 73 70 61 63 65 20 65 71 20 22 22 7d 20 amespace eq ""}
2570: 7b 0a 09 73 65 74 20 6e 61 6d 65 73 70 61 63 65 {..set namespace
2580: 20 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 [uplevel 1 [lis
2590: 74 20 3a 3a 6e 61 6d 65 73 70 61 63 65 20 63 75 t ::namespace cu
25a0: 72 72 65 6e 74 5d 5d 0a 20 20 20 20 7d 0a 20 20 rrent]]. }.
25b0: 20 20 73 65 74 20 6e 61 6d 65 4c 69 73 74 20 5b set nameList [
25c0: 61 75 74 6f 5f 71 75 61 6c 69 66 79 20 24 63 6d auto_qualify $cm
25d0: 64 20 24 6e 61 6d 65 73 70 61 63 65 5d 0a 20 20 d $namespace].
25e0: 20 20 23 20 77 6f 72 6b 61 72 6f 75 6e 64 20 6e # workaround n
25f0: 6f 6e 20 63 61 6e 6f 6e 69 63 61 6c 20 61 75 74 on canonical aut
2600: 6f 5f 69 6e 64 65 78 20 65 6e 74 72 69 65 73 20 o_index entries
2610: 74 68 61 74 20 6d 69 67 68 74 20 62 65 20 61 72 that might be ar
2620: 6f 75 6e 64 0a 20 20 20 20 23 20 66 72 6f 6d 20 ound. # from
2630: 6f 6c 64 65 72 20 61 75 74 6f 5f 6d 6b 69 6e 64 older auto_mkind
2640: 65 78 20 76 65 72 73 69 6f 6e 73 0a 20 20 20 20 ex versions.
2650: 69 66 20 7b 24 63 6d 64 20 6e 69 20 24 6e 61 6d if {$cmd ni $nam
2660: 65 4c 69 73 74 7d 20 7b 6c 61 70 70 65 6e 64 20 eList} {lappend
2670: 6e 61 6d 65 4c 69 73 74 20 24 63 6d 64 7d 0a 0a nameList $cmd}..
2680: 20 20 20 20 23 20 74 72 79 20 74 6f 20 6c 6f 61 # try to loa
2690: 64 20 28 61 6e 64 20 63 72 65 61 74 65 20 73 75 d (and create su
26a0: 62 2d 63 6d 64 20 68 61 6e 64 6c 65 72 20 22 5f b-cmd handler "_
26b0: 73 75 62 5f 6c 6f 61 64 5f 63 6d 64 22 20 66 6f sub_load_cmd" fo
26c0: 72 20 66 75 72 74 68 65 72 20 75 73 61 67 65 29 r further usage)
26d0: 3a 0a 20 20 20 20 66 6f 72 65 61 63 68 20 6e 61 :. foreach na
26e0: 6d 65 20 24 6e 61 6d 65 4c 69 73 74 20 5b 73 65 me $nameList [se
26f0: 74 20 5f 73 75 62 5f 6c 6f 61 64 5f 63 6d 64 20 t _sub_load_cmd
2700: 7b 0a 09 23 20 76 69 61 20 61 75 74 6f 5f 69 6e {..# via auto_in
2710: 64 65 78 3a 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 dex:..if {[info
2720: 65 78 69 73 74 73 20 61 75 74 6f 5f 69 6e 64 65 exists auto_inde
2730: 78 28 24 6e 61 6d 65 29 5d 7d 20 7b 0a 09 20 20 x($name)]} {..
2740: 20 20 6e 61 6d 65 73 70 61 63 65 20 69 6e 73 63 namespace insc
2750: 6f 70 65 20 3a 3a 20 24 61 75 74 6f 5f 69 6e 64 ope :: $auto_ind
2760: 65 78 28 24 6e 61 6d 65 29 0a 09 20 20 20 20 23 ex($name).. #
2770: 20 54 68 65 72 65 27 73 20 61 20 63 6f 75 70 6c There's a coupl
2780: 65 20 6f 66 20 77 61 79 73 20 74 6f 20 6c 6f 6f e of ways to loo
2790: 6b 20 66 6f 72 20 61 20 63 6f 6d 6d 61 6e 64 20 k for a command
27a0: 6f 66 20 61 20 67 69 76 65 6e 0a 09 20 20 20 20 of a given..
27b0: 23 20 6e 61 6d 65 2e 20 20 4f 6e 65 20 69 73 20 # name. One is
27c0: 74 6f 20 75 73 65 0a 09 20 20 20 20 23 20 20 20 to use.. #
27d0: 20 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 24 info commands $
27e0: 6e 61 6d 65 0a 09 20 20 20 20 23 20 55 6e 66 6f name.. # Unfo
27f0: 72 74 75 6e 61 74 65 6c 79 2c 20 69 66 20 74 68 rtunately, if th
2800: 65 20 6e 61 6d 65 20 68 61 73 20 67 6c 6f 62 2d e name has glob-
2810: 6d 61 67 69 63 20 63 68 61 72 73 20 69 6e 20 69 magic chars in i
2820: 74 20 6c 69 6b 65 20 2a 0a 09 20 20 20 20 23 20 t like *.. #
2830: 6f 72 20 5b 5d 2c 20 69 74 20 6d 61 79 20 6e 6f or [], it may no
2840: 74 20 6d 61 74 63 68 2e 20 20 46 6f 72 20 6f 75 t match. For ou
2850: 72 20 70 75 72 70 6f 73 65 73 20 68 65 72 65 2c r purposes here,
2860: 20 61 20 62 65 74 74 65 72 0a 09 20 20 20 20 23 a better.. #
2870: 20 72 6f 75 74 65 20 69 73 20 74 6f 20 75 73 65 route is to use
2880: 0a 09 20 20 20 20 23 20 20 20 20 6e 61 6d 65 73 .. # names
2890: 70 61 63 65 20 77 68 69 63 68 20 2d 63 6f 6d 6d pace which -comm
28a0: 61 6e 64 20 24 6e 61 6d 65 0a 09 20 20 20 20 69 and $name.. i
28b0: 66 20 7b 5b 6e 61 6d 65 73 70 61 63 65 20 77 68 f {[namespace wh
28c0: 69 63 68 20 2d 63 6f 6d 6d 61 6e 64 20 24 6e 61 ich -command $na
28d0: 6d 65 5d 20 6e 65 20 22 22 7d 20 7b 0a 09 09 72 me] ne ""} {...r
28e0: 65 74 75 72 6e 20 31 0a 09 20 20 20 20 7d 0a 09 eturn 1.. }..
28f0: 7d 0a 20 20 20 20 7d 5d 0a 0a 20 20 20 20 23 20 }. }].. #
2900: 6c 6f 61 64 20 61 75 74 6f 5f 69 6e 64 65 78 20 load auto_index
2910: 69 66 20 70 6f 73 73 69 62 6c 65 3a 0a 20 20 20 if possible:.
2920: 20 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 if {![info exis
2930: 74 73 20 61 75 74 6f 5f 70 61 74 68 5d 7d 20 7b ts auto_path]} {
2940: 0a 09 72 65 74 75 72 6e 20 30 0a 20 20 20 20 7d ..return 0. }
2950: 0a 20 20 20 20 69 66 20 7b 21 5b 61 75 74 6f 5f . if {![auto_
2960: 6c 6f 61 64 5f 69 6e 64 65 78 5d 7d 20 7b 0a 09 load_index]} {..
2970: 72 65 74 75 72 6e 20 30 0a 20 20 20 20 7d 0a 0a return 0. }..
2980: 20 20 20 20 23 20 74 72 79 20 61 67 61 69 6e 20 # try again
2990: 28 73 6f 6d 65 74 68 69 6e 67 20 6e 65 77 20 63 (something new c
29a0: 6f 75 6c 64 20 62 65 20 6c 6f 61 64 65 64 29 3a ould be loaded):
29b0: 0a 20 20 20 20 66 6f 72 65 61 63 68 20 6e 61 6d . foreach nam
29c0: 65 20 24 6e 61 6d 65 4c 69 73 74 20 24 5f 73 75 e $nameList $_su
29d0: 62 5f 6c 6f 61 64 5f 63 6d 64 0a 0a 20 20 20 20 b_load_cmd..
29e0: 72 65 74 75 72 6e 20 30 0a 7d 0a 0a 23 20 3a 3a return 0.}..# ::
29f0: 74 63 6c 3a 3a 50 6b 67 3a 3a 73 6f 75 72 63 65 tcl::Pkg::source
2a00: 20 2d 2d 0a 23 20 54 68 69 73 20 70 72 6f 63 65 --.# This proce
2a10: 64 75 72 65 20 70 72 6f 76 69 64 65 73 20 61 6e dure provides an
2a20: 20 61 6c 74 65 72 6e 61 74 69 76 65 20 22 73 6f alternative "so
2a30: 75 72 63 65 22 20 63 6f 6d 6d 61 6e 64 2c 20 77 urce" command, w
2a40: 68 69 63 68 20 64 6f 65 73 6e 27 74 0a 23 20 72 hich doesn't.# r
2a50: 65 67 69 73 74 65 72 20 74 68 65 20 66 69 6c 65 egister the file
2a60: 20 66 6f 72 20 74 68 65 20 22 70 61 63 6b 61 67 for the "packag
2a70: 65 20 66 69 6c 65 73 22 20 63 6f 6d 6d 61 6e 64 e files" command
2a80: 2e 20 53 61 66 65 20 69 6e 74 65 72 70 72 65 74 . Safe interpret
2a90: 65 72 73 0a 23 20 64 6f 6e 27 74 20 68 61 76 65 ers.# don't have
2aa0: 20 74 6f 20 64 6f 20 61 6e 79 74 68 69 6e 67 20 to do anything
2ab0: 73 70 65 63 69 61 6c 2e 0a 23 0a 23 20 41 72 67 special..#.# Arg
2ac0: 75 6d 65 6e 74 73 3a 0a 23 20 66 69 6c 65 6e 61 uments:.# filena
2ad0: 6d 65 0a 0a 70 72 6f 63 20 3a 3a 74 63 6c 3a 3a me..proc ::tcl::
2ae0: 50 6b 67 3a 3a 73 6f 75 72 63 65 20 7b 66 69 6c Pkg::source {fil
2af0: 65 6e 61 6d 65 7d 20 7b 0a 20 20 20 20 69 66 20 ename} {. if
2b00: 7b 5b 69 6e 74 65 72 70 20 69 73 73 61 66 65 5d {[interp issafe]
2b10: 7d 20 7b 0a 09 75 70 6c 65 76 65 6c 20 31 20 5b } {..uplevel 1 [
2b20: 6c 69 73 74 20 3a 3a 73 6f 75 72 63 65 20 24 66 list ::source $f
2b30: 69 6c 65 6e 61 6d 65 5d 0a 20 20 20 20 7d 20 65 ilename]. } e
2b40: 6c 73 65 20 7b 0a 09 75 70 6c 65 76 65 6c 20 31 lse {..uplevel 1
2b50: 20 5b 6c 69 73 74 20 3a 3a 73 6f 75 72 63 65 20 [list ::source
2b60: 2d 6e 6f 70 6b 67 20 24 66 69 6c 65 6e 61 6d 65 -nopkg $filename
2b70: 5d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 61 75 74 ]. }.}..# aut
2b80: 6f 5f 6c 6f 61 64 5f 69 6e 64 65 78 20 2d 2d 0a o_load_index --.
2b90: 23 20 4c 6f 61 64 73 20 74 68 65 20 63 6f 6e 74 # Loads the cont
2ba0: 65 6e 74 73 20 6f 66 20 74 63 6c 49 6e 64 65 78 ents of tclIndex
2bb0: 20 66 69 6c 65 73 20 6f 6e 20 74 68 65 20 61 75 files on the au
2bc0: 74 6f 5f 70 61 74 68 20 64 69 72 65 63 74 6f 72 to_path director
2bd0: 79 0a 23 20 6c 69 73 74 2e 20 20 54 68 69 73 20 y.# list. This
2be0: 69 73 20 75 73 75 61 6c 6c 79 20 69 6e 76 6f 6b is usually invok
2bf0: 65 64 20 77 69 74 68 69 6e 20 61 75 74 6f 5f 6c ed within auto_l
2c00: 6f 61 64 20 74 6f 20 6c 6f 61 64 20 74 68 65 20 oad to load the
2c10: 69 6e 64 65 78 0a 23 20 6f 66 20 61 76 61 69 6c index.# of avail
2c20: 61 62 6c 65 20 63 6f 6d 6d 61 6e 64 73 2e 20 20 able commands.
2c30: 52 65 74 75 72 6e 73 20 31 20 69 66 20 74 68 65 Returns 1 if the
2c40: 20 69 6e 64 65 78 20 69 73 20 6c 6f 61 64 65 64 index is loaded
2c50: 2c 20 61 6e 64 20 30 20 69 66 0a 23 20 74 68 65 , and 0 if.# the
2c60: 20 69 6e 64 65 78 20 69 73 20 61 6c 72 65 61 64 index is alread
2c70: 79 20 6c 6f 61 64 65 64 20 61 6e 64 20 75 70 20 y loaded and up
2c80: 74 6f 20 64 61 74 65 2e 0a 23 0a 23 20 41 72 67 to date..#.# Arg
2c90: 75 6d 65 6e 74 73 3a 0a 23 20 4e 6f 6e 65 2e 0a uments:.# None..
2ca0: 0a 70 72 6f 63 20 61 75 74 6f 5f 6c 6f 61 64 5f .proc auto_load_
2cb0: 69 6e 64 65 78 20 7b 7d 20 7b 0a 20 20 20 20 76 index {} {. v
2cc0: 61 72 69 61 62 6c 65 20 3a 3a 74 63 6c 3a 3a 61 ariable ::tcl::a
2cd0: 75 74 6f 5f 6f 6c 64 70 61 74 68 0a 20 20 20 20 uto_oldpath.
2ce0: 67 6c 6f 62 61 6c 20 61 75 74 6f 5f 69 6e 64 65 global auto_inde
2cf0: 78 20 61 75 74 6f 5f 70 61 74 68 0a 0a 20 20 20 x auto_path..
2d00: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
2d10: 73 20 61 75 74 6f 5f 6f 6c 64 70 61 74 68 5d 20 s auto_oldpath]
2d20: 26 26 20 28 24 61 75 74 6f 5f 6f 6c 64 70 61 74 && ($auto_oldpat
2d30: 68 20 65 71 20 24 61 75 74 6f 5f 70 61 74 68 29 h eq $auto_path)
2d40: 7d 20 7b 0a 09 72 65 74 75 72 6e 20 30 0a 20 20 } {..return 0.
2d50: 20 20 7d 0a 20 20 20 20 73 65 74 20 61 75 74 6f }. set auto
2d60: 5f 6f 6c 64 70 61 74 68 20 24 61 75 74 6f 5f 70 _oldpath $auto_p
2d70: 61 74 68 0a 0a 20 20 20 20 23 20 43 68 65 63 6b ath.. # Check
2d80: 20 69 66 20 77 65 20 61 72 65 20 61 20 73 61 66 if we are a saf
2d90: 65 20 69 6e 74 65 72 70 72 65 74 65 72 2e 20 49 e interpreter. I
2da0: 6e 20 74 68 61 74 20 63 61 73 65 2c 20 77 65 20 n that case, we
2db0: 73 75 70 70 6f 72 74 20 6f 6e 6c 79 0a 20 20 20 support only.
2dc0: 20 23 20 6e 65 77 65 72 20 66 6f 72 6d 61 74 20 # newer format
2dd0: 74 63 6c 49 6e 64 65 78 20 66 69 6c 65 73 2e 0a tclIndex files..
2de0: 0a 20 20 20 20 73 65 74 20 69 73 73 61 66 65 20 . set issafe
2df0: 5b 69 6e 74 65 72 70 20 69 73 73 61 66 65 5d 0a [interp issafe].
2e00: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 5b for {set i [
2e10: 65 78 70 72 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 expr {[llength $
2e20: 61 75 74 6f 5f 70 61 74 68 5d 20 2d 20 31 7d 5d auto_path] - 1}]
2e30: 7d 20 7b 24 69 20 3e 3d 20 30 7d 20 7b 69 6e 63 } {$i >= 0} {inc
2e40: 72 20 69 20 2d 31 7d 20 7b 0a 09 73 65 74 20 64 r i -1} {..set d
2e50: 69 72 20 5b 6c 69 6e 64 65 78 20 24 61 75 74 6f ir [lindex $auto
2e60: 5f 70 61 74 68 20 24 69 5d 0a 09 73 65 74 20 66 _path $i]..set f
2e70: 20 22 22 0a 09 69 66 20 7b 24 69 73 73 61 66 65 ""..if {$issafe
2e80: 7d 20 7b 0a 09 20 20 20 20 63 61 74 63 68 20 7b } {.. catch {
2e90: 73 6f 75 72 63 65 20 5b 66 69 6c 65 20 6a 6f 69 source [file joi
2ea0: 6e 20 24 64 69 72 20 74 63 6c 49 6e 64 65 78 5d n $dir tclIndex]
2eb0: 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 }..} elseif {[ca
2ec0: 74 63 68 20 7b 73 65 74 20 66 20 5b 6f 70 65 6e tch {set f [open
2ed0: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 72 [file join $dir
2ee0: 20 74 63 6c 49 6e 64 65 78 5d 5d 7d 5d 7d 20 7b tclIndex]]}]} {
2ef0: 0a 09 20 20 20 20 63 6f 6e 74 69 6e 75 65 0a 09 .. continue..
2f00: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 } else {.. se
2f10: 74 20 65 72 72 6f 72 20 5b 63 61 74 63 68 20 7b t error [catch {
2f20: 0a 09 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 ...fconfigure $f
2f30: 20 2d 65 6e 63 6f 64 69 6e 67 20 75 74 66 2d 38 -encoding utf-8
2f40: 20 2d 65 6f 66 63 68 61 72 20 5c 78 31 41 0a 09 -eofchar \x1A..
2f50: 09 73 65 74 20 69 64 20 5b 67 65 74 73 20 24 66 .set id [gets $f
2f60: 5d 0a 09 09 69 66 20 7b 24 69 64 20 65 71 20 22 ]...if {$id eq "
2f70: 23 20 54 63 6c 20 61 75 74 6f 6c 6f 61 64 20 69 # Tcl autoload i
2f80: 6e 64 65 78 20 66 69 6c 65 2c 20 76 65 72 73 69 ndex file, versi
2f90: 6f 6e 20 32 2e 30 22 7d 20 7b 0a 09 09 20 20 20 on 2.0"} {...
2fa0: 20 65 76 61 6c 20 5b 72 65 61 64 20 24 66 5d 0a eval [read $f].
2fb0: 09 09 7d 20 65 6c 73 65 69 66 20 7b 24 69 64 20 ..} elseif {$id
2fc0: 65 71 20 22 23 20 54 63 6c 20 61 75 74 6f 6c 6f eq "# Tcl autolo
2fd0: 61 64 20 69 6e 64 65 78 20 66 69 6c 65 3a 20 65 ad index file: e
2fe0: 61 63 68 20 6c 69 6e 65 20 69 64 65 6e 74 69 66 ach line identif
2ff0: 69 65 73 20 61 20 54 63 6c 22 7d 20 7b 0a 09 09 ies a Tcl"} {...
3000: 20 20 20 20 77 68 69 6c 65 20 7b 5b 67 65 74 73 while {[gets
3010: 20 24 66 20 6c 69 6e 65 5d 20 3e 3d 20 30 7d 20 $f line] >= 0}
3020: 7b 0a 09 09 09 69 66 20 7b 28 5b 73 74 72 69 6e {....if {([strin
3030: 67 20 69 6e 64 65 78 20 24 6c 69 6e 65 20 30 5d g index $line 0]
3040: 20 65 71 20 22 23 22 29 20 5c 0a 09 09 09 09 7c eq "#") \.....|
3050: 7c 20 28 5b 6c 6c 65 6e 67 74 68 20 24 6c 69 6e | ([llength $lin
3060: 65 5d 20 21 3d 20 32 29 7d 20 7b 0a 09 09 09 20 e] != 2)} {....
3070: 20 20 20 63 6f 6e 74 69 6e 75 65 0a 09 09 09 7d continue....}
3080: 0a 09 09 09 73 65 74 20 6e 61 6d 65 20 5b 6c 69 ....set name [li
3090: 6e 64 65 78 20 24 6c 69 6e 65 20 30 5d 0a 09 09 ndex $line 0]...
30a0: 09 73 65 74 20 61 75 74 6f 5f 69 6e 64 65 78 28 .set auto_index(
30b0: 24 6e 61 6d 65 29 20 5c 0a 09 09 09 09 22 3a 3a $name) \....."::
30c0: 74 63 6c 3a 3a 50 6b 67 3a 3a 73 6f 75 72 63 65 tcl::Pkg::source
30d0: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 72 [file join $dir
30e0: 20 5b 6c 69 6e 64 65 78 20 24 6c 69 6e 65 20 31 [lindex $line 1
30f0: 5d 5d 22 0a 09 09 20 20 20 20 7d 0a 09 09 7d 20 ]]"... }...}
3100: 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 65 72 72 else {... err
3110: 6f 72 20 22 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 or "[file join $
3120: 64 69 72 20 74 63 6c 49 6e 64 65 78 5d 20 69 73 dir tclIndex] is
3130: 6e 27 74 20 61 20 70 72 6f 70 65 72 20 54 63 6c n't a proper Tcl
3140: 20 69 6e 64 65 78 20 66 69 6c 65 22 0a 09 09 7d index file"...}
3150: 0a 09 20 20 20 20 7d 20 6d 73 67 20 6f 70 74 73 .. } msg opts
3160: 5d 0a 09 20 20 20 20 69 66 20 7b 24 66 20 6e 65 ].. if {$f ne
3170: 20 22 22 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 ""} {...close $
3180: 66 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 f.. }.. if
3190: 20 7b 24 65 72 72 6f 72 7d 20 7b 0a 09 09 72 65 {$error} {...re
31a0: 74 75 72 6e 20 2d 6f 70 74 69 6f 6e 73 20 24 6f turn -options $o
31b0: 70 74 73 20 24 6d 73 67 0a 09 20 20 20 20 7d 0a pts $msg.. }.
31c0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 .}. }. ret
31d0: 75 72 6e 20 31 0a 7d 0a 0a 23 20 61 75 74 6f 5f urn 1.}..# auto_
31e0: 71 75 61 6c 69 66 79 20 2d 2d 0a 23 0a 23 20 43 qualify --.#.# C
31f0: 6f 6d 70 75 74 65 20 61 20 66 75 6c 6c 79 20 71 ompute a fully q
3200: 75 61 6c 69 66 69 65 64 20 6e 61 6d 65 73 20 6c ualified names l
3210: 69 73 74 20 66 6f 72 20 75 73 65 20 69 6e 20 74 ist for use in t
3220: 68 65 20 61 75 74 6f 5f 69 6e 64 65 78 20 61 72 he auto_index ar
3230: 72 61 79 2e 0a 23 20 46 6f 72 20 68 69 73 74 6f ray..# For histo
3240: 72 69 63 61 6c 20 72 65 61 73 6f 6e 73 2c 20 63 rical reasons, c
3250: 6f 6d 6d 61 6e 64 73 20 69 6e 20 74 68 65 20 67 ommands in the g
3260: 6c 6f 62 61 6c 20 6e 61 6d 65 73 70 61 63 65 20 lobal namespace
3270: 64 6f 20 6e 6f 74 20 68 61 76 65 20 6c 65 61 64 do not have lead
3280: 69 6e 67 0a 23 20 3a 3a 20 69 6e 20 74 68 65 20 ing.# :: in the
3290: 69 6e 64 65 78 20 6b 65 79 2e 20 54 68 65 20 6c index key. The l
32a0: 69 73 74 20 68 61 73 20 74 77 6f 20 65 6c 65 6d ist has two elem
32b0: 65 6e 74 73 20 77 68 65 6e 20 74 68 65 20 63 6f ents when the co
32c0: 6d 6d 61 6e 64 20 6e 61 6d 65 20 69 73 0a 23 20 mmand name is.#
32d0: 72 65 6c 61 74 69 76 65 20 28 6e 6f 20 6c 65 61 relative (no lea
32e0: 64 69 6e 67 20 3a 3a 29 20 61 6e 64 20 74 68 65 ding ::) and the
32f0: 20 6e 61 6d 65 73 70 61 63 65 20 69 73 20 6e 6f namespace is no
3300: 74 20 74 68 65 20 67 6c 6f 62 61 6c 20 6f 6e 65 t the global one
3310: 2e 20 4f 74 68 65 72 77 69 73 65 0a 23 20 6f 6e . Otherwise.# on
3320: 6c 79 20 6f 6e 65 20 6e 61 6d 65 20 69 73 20 72 ly one name is r
3330: 65 74 75 72 6e 65 64 20 28 61 6e 64 20 73 65 61 eturned (and sea
3340: 72 63 68 65 64 20 69 6e 20 74 68 65 20 61 75 74 rched in the aut
3350: 6f 5f 69 6e 64 65 78 29 2e 0a 23 0a 23 20 41 72 o_index)..#.# Ar
3360: 67 75 6d 65 6e 74 73 20 2d 0a 23 20 63 6d 64 09 guments -.# cmd.
3370: 09 54 68 65 20 63 6f 6d 6d 61 6e 64 20 6e 61 6d .The command nam
3380: 65 2e 20 43 61 6e 20 62 65 20 61 6e 79 20 6e 61 e. Can be any na
3390: 6d 65 20 61 63 63 65 70 74 65 64 20 66 6f 72 20 me accepted for
33a0: 63 6f 6d 6d 61 6e 64 0a 23 20 20 20 20 20 20 20 command.#
33b0: 20 20 20 20 20 20 20 20 69 6e 76 6f 63 61 74 69 invocati
33c0: 6f 6e 73 20 28 4c 69 6b 65 20 22 66 6f 6f 3a 3a ons (Like "foo::
33d0: 3a 3a 62 61 72 22 29 2e 0a 23 20 6e 61 6d 65 73 ::bar")..# names
33e0: 70 61 63 65 09 54 68 65 20 6e 61 6d 65 73 70 61 pace.The namespa
33f0: 63 65 20 77 68 65 72 65 20 74 68 65 20 63 6f 6d ce where the com
3400: 6d 61 6e 64 20 69 73 20 62 65 69 6e 67 20 75 73 mand is being us
3410: 65 64 20 2d 20 6d 75 73 74 20 62 65 0a 23 20 20 ed - must be.#
3420: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 20 63 a c
3430: 61 6e 6f 6e 69 63 61 6c 20 6e 61 6d 65 73 70 61 anonical namespa
3440: 63 65 20 61 73 20 72 65 74 75 72 6e 65 64 20 62 ce as returned b
3450: 79 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 75 72 y [namespace cur
3460: 72 65 6e 74 5d 0a 23 20 20 20 20 20 20 20 20 20 rent].#
3470: 20 20 20 20 20 20 66 6f 72 20 69 6e 73 74 61 6e for instan
3480: 63 65 2e 0a 0a 70 72 6f 63 20 61 75 74 6f 5f 71 ce...proc auto_q
3490: 75 61 6c 69 66 79 20 7b 63 6d 64 20 6e 61 6d 65 ualify {cmd name
34a0: 73 70 61 63 65 7d 20 7b 0a 0a 20 20 20 20 23 20 space} {.. #
34b0: 63 6f 75 6e 74 20 73 65 70 61 72 61 74 6f 72 73 count separators
34c0: 20 61 6e 64 20 63 6c 65 61 6e 20 74 68 65 6d 20 and clean them
34d0: 75 70 0a 20 20 20 20 23 20 28 6d 61 6b 69 6e 67 up. # (making
34e0: 20 73 75 72 65 20 74 68 61 74 20 66 6f 6f 3a 3a sure that foo::
34f0: 3a 3a 3a 62 61 72 20 77 69 6c 6c 20 62 65 20 74 :::bar will be t
3500: 72 65 61 74 65 64 20 61 73 20 66 6f 6f 3a 3a 62 reated as foo::b
3510: 61 72 29 0a 20 20 20 20 73 65 74 20 6e 20 5b 72 ar). set n [r
3520: 65 67 73 75 62 20 2d 61 6c 6c 20 7b 3a 3a 2b 7d egsub -all {::+}
3530: 20 24 63 6d 64 20 3a 3a 20 63 6d 64 5d 0a 0a 20 $cmd :: cmd]..
3540: 20 20 20 23 20 49 67 6e 6f 72 65 20 6e 61 6d 65 # Ignore name
3550: 73 70 61 63 65 20 69 66 20 74 68 65 20 6e 61 6d space if the nam
3560: 65 20 73 74 61 72 74 73 20 77 69 74 68 20 3a 3a e starts with ::
3570: 0a 20 20 20 20 23 20 48 61 6e 64 6c 65 20 73 70 . # Handle sp
3580: 65 63 69 61 6c 20 63 61 73 65 20 6f 66 20 6f 6e ecial case of on
3590: 6c 79 20 6c 65 61 64 69 6e 67 20 3a 3a 0a 0a 20 ly leading ::..
35a0: 20 20 20 23 20 42 65 66 6f 72 65 20 65 61 63 68 # Before each
35b0: 20 72 65 74 75 72 6e 20 63 61 73 65 20 77 65 20 return case we
35c0: 67 69 76 65 20 61 6e 20 65 78 61 6d 70 6c 65 20 give an example
35d0: 6f 66 20 77 68 69 63 68 20 63 61 74 65 67 6f 72 of which categor
35e0: 79 20 69 74 20 69 73 0a 20 20 20 20 23 20 77 69 y it is. # wi
35f0: 74 68 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 th the following
3600: 20 66 6f 72 6d 20 3a 0a 20 20 20 20 23 20 28 69 form :. # (i
3610: 6e 70 75 74 43 6d 64 2c 20 69 6e 70 75 74 4e 61 nputCmd, inputNa
3620: 6d 65 53 70 61 63 65 29 20 2d 3e 20 6f 75 74 70 meSpace) -> outp
3630: 75 74 0a 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 ut.. if {[str
3640: 69 6e 67 20 6d 61 74 63 68 20 3a 3a 2a 20 24 63 ing match ::* $c
3650: 6d 64 5d 7d 20 7b 0a 09 69 66 20 7b 24 6e 20 3e md]} {..if {$n >
3660: 20 31 7d 20 7b 0a 09 20 20 20 20 23 20 28 3a 3a 1} {.. # (::
3670: 66 6f 6f 3a 3a 62 61 72 20 2c 20 2a 29 20 2d 3e foo::bar , *) ->
3680: 20 3a 3a 66 6f 6f 3a 3a 62 61 72 0a 09 20 20 20 ::foo::bar..
3690: 20 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 63 return [list $c
36a0: 6d 64 5d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 md]..} else {..
36b0: 20 20 20 23 20 28 3a 3a 67 6c 6f 62 61 6c 20 2c # (::global ,
36c0: 20 2a 29 20 2d 3e 20 67 6c 6f 62 61 6c 0a 09 20 *) -> global..
36d0: 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 return [list
36e0: 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 63 [string range $c
36f0: 6d 64 20 32 20 65 6e 64 5d 5d 0a 09 7d 0a 20 20 md 2 end]]..}.
3700: 20 20 7d 0a 0a 20 20 20 20 23 20 50 6f 74 65 6e }.. # Poten
3710: 74 69 61 6c 6c 79 20 72 65 74 75 72 6e 69 6e 67 tially returning
3720: 20 32 20 65 6c 65 6d 65 6e 74 73 20 74 6f 20 74 2 elements to t
3730: 72 79 20 20 3a 0a 20 20 20 20 23 20 28 69 66 20 ry :. # (if
3740: 74 68 65 20 63 75 72 72 65 6e 74 20 6e 61 6d 65 the current name
3750: 73 70 61 63 65 20 69 73 20 6e 6f 74 20 74 68 65 space is not the
3760: 20 67 6c 6f 62 61 6c 20 6f 6e 65 29 0a 0a 20 20 global one)..
3770: 20 20 69 66 20 7b 24 6e 20 3d 3d 20 30 7d 20 7b if {$n == 0} {
3780: 0a 09 69 66 20 7b 24 6e 61 6d 65 73 70 61 63 65 ..if {$namespace
3790: 20 65 71 20 22 3a 3a 22 7d 20 7b 0a 09 20 20 20 eq "::"} {..
37a0: 20 23 20 28 6e 6f 63 6f 6c 6f 6e 73 20 2c 20 3a # (nocolons , :
37b0: 3a 29 20 2d 3e 20 6e 6f 63 6f 6c 6f 6e 73 0a 09 :) -> nocolons..
37c0: 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 73 74 return [list
37d0: 20 24 63 6d 64 5d 0a 09 7d 20 65 6c 73 65 20 7b $cmd]..} else {
37e0: 0a 09 20 20 20 20 23 20 28 6e 6f 63 6f 6c 6f 6e .. # (nocolon
37f0: 73 20 2c 20 3a 3a 73 75 62 29 20 2d 3e 20 3a 3a s , ::sub) -> ::
3800: 73 75 62 3a 3a 6e 6f 63 6f 6c 6f 6e 73 20 6e 6f sub::nocolons no
3810: 63 6f 6c 6f 6e 73 0a 09 20 20 20 20 72 65 74 75 colons.. retu
3820: 72 6e 20 5b 6c 69 73 74 20 24 7b 6e 61 6d 65 73 rn [list ${names
3830: 70 61 63 65 7d 3a 3a 24 63 6d 64 20 24 63 6d 64 pace}::$cmd $cmd
3840: 5d 0a 09 7d 0a 20 20 20 20 7d 20 65 6c 73 65 69 ]..}. } elsei
3850: 66 20 7b 24 6e 61 6d 65 73 70 61 63 65 20 65 71 f {$namespace eq
3860: 20 22 3a 3a 22 7d 20 7b 0a 09 23 20 20 28 66 6f "::"} {..# (fo
3870: 6f 3a 3a 62 61 72 20 2c 20 3a 3a 29 20 2d 3e 20 o::bar , ::) ->
3880: 3a 3a 66 6f 6f 3a 3a 62 61 72 0a 09 72 65 74 75 ::foo::bar..retu
3890: 72 6e 20 5b 6c 69 73 74 20 3a 3a 24 63 6d 64 5d rn [list ::$cmd]
38a0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 23 . } else {..#
38b0: 20 28 66 6f 6f 3a 3a 62 61 72 20 2c 20 3a 3a 73 (foo::bar , ::s
38c0: 75 62 29 20 2d 3e 20 3a 3a 73 75 62 3a 3a 66 6f ub) -> ::sub::fo
38d0: 6f 3a 3a 62 61 72 20 3a 3a 66 6f 6f 3a 3a 62 61 o::bar ::foo::ba
38e0: 72 0a 09 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 r..return [list
38f0: 24 7b 6e 61 6d 65 73 70 61 63 65 7d 3a 3a 24 63 ${namespace}::$c
3900: 6d 64 20 3a 3a 24 63 6d 64 5d 0a 20 20 20 20 7d md ::$cmd]. }
3910: 0a 7d 0a 0a 23 20 61 75 74 6f 5f 69 6d 70 6f 72 .}..# auto_impor
3920: 74 20 2d 2d 0a 23 0a 23 20 49 6e 76 6f 6b 65 64 t --.#.# Invoked
3930: 20 64 75 72 69 6e 67 20 22 6e 61 6d 65 73 70 61 during "namespa
3940: 63 65 20 69 6d 70 6f 72 74 22 20 74 6f 20 6d 61 ce import" to ma
3950: 6b 65 20 73 65 65 20 69 66 20 74 68 65 20 69 6d ke see if the im
3960: 70 6f 72 74 65 64 20 63 6f 6d 6d 61 6e 64 73 0a ported commands.
3970: 23 20 72 65 73 69 64 65 20 69 6e 20 61 6e 20 61 # reside in an a
3980: 75 74 6f 6c 6f 61 64 65 64 20 6c 69 62 72 61 72 utoloaded librar
3990: 79 2e 20 20 49 66 20 73 6f 2c 20 74 68 65 20 63 y. If so, the c
39a0: 6f 6d 6d 61 6e 64 73 20 61 72 65 20 6c 6f 61 64 ommands are load
39b0: 65 64 20 73 6f 0a 23 20 74 68 61 74 20 74 68 65 ed so.# that the
39c0: 79 20 77 69 6c 6c 20 62 65 20 61 76 61 69 6c 61 y will be availa
39d0: 62 6c 65 20 66 6f 72 20 74 68 65 20 69 6d 70 6f ble for the impo
39e0: 72 74 20 6c 69 6e 6b 73 2e 20 20 49 66 20 6e 6f rt links. If no
39f0: 74 2c 20 74 68 65 6e 20 74 68 69 73 0a 23 20 70 t, then this.# p
3a00: 72 6f 63 65 64 75 72 65 20 64 6f 65 73 20 6e 6f rocedure does no
3a10: 74 68 69 6e 67 2e 0a 23 0a 23 20 41 72 67 75 6d thing..#.# Argum
3a20: 65 6e 74 73 20 2d 0a 23 20 70 61 74 74 65 72 6e ents -.# pattern
3a30: 09 54 68 65 20 70 61 74 74 65 72 6e 20 6f 66 20 .The pattern of
3a40: 63 6f 6d 6d 61 6e 64 73 20 62 65 69 6e 67 20 69 commands being i
3a50: 6d 70 6f 72 74 65 64 20 28 6c 69 6b 65 20 22 66 mported (like "f
3a60: 6f 6f 3a 3a 2a 22 29 0a 23 20 20 20 20 20 20 20 oo::*").#
3a70: 20 20 20 20 20 20 20 20 61 20 63 61 6e 6f 6e 69 a canoni
3a80: 63 61 6c 20 6e 61 6d 65 73 70 61 63 65 20 61 73 cal namespace as
3a90: 20 72 65 74 75 72 6e 65 64 20 62 79 20 5b 6e 61 returned by [na
3aa0: 6d 65 73 70 61 63 65 20 63 75 72 72 65 6e 74 5d mespace current]
3ab0: 0a 0a 70 72 6f 63 20 61 75 74 6f 5f 69 6d 70 6f ..proc auto_impo
3ac0: 72 74 20 7b 70 61 74 74 65 72 6e 7d 20 7b 0a 20 rt {pattern} {.
3ad0: 20 20 20 67 6c 6f 62 61 6c 20 61 75 74 6f 5f 69 global auto_i
3ae0: 6e 64 65 78 0a 0a 20 20 20 20 23 20 49 66 20 6e ndex.. # If n
3af0: 6f 20 6e 61 6d 65 73 70 61 63 65 20 69 73 20 73 o namespace is s
3b00: 70 65 63 69 66 69 65 64 2c 20 74 68 69 73 20 77 pecified, this w
3b10: 69 6c 6c 20 62 65 20 61 6e 20 65 72 72 6f 72 20 ill be an error
3b20: 63 61 73 65 0a 0a 20 20 20 20 69 66 20 7b 21 5b case.. if {![
3b30: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2a 3a 3a string match *::
3b40: 2a 20 24 70 61 74 74 65 72 6e 5d 7d 20 7b 0a 09 * $pattern]} {..
3b50: 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 return. }..
3b60: 20 20 73 65 74 20 6e 73 20 5b 75 70 6c 65 76 65 set ns [upleve
3b70: 6c 20 31 20 5b 6c 69 73 74 20 3a 3a 6e 61 6d 65 l 1 [list ::name
3b80: 73 70 61 63 65 20 63 75 72 72 65 6e 74 5d 5d 0a space current]].
3b90: 20 20 20 20 73 65 74 20 70 61 74 74 65 72 6e 4c set patternL
3ba0: 69 73 74 20 5b 61 75 74 6f 5f 71 75 61 6c 69 66 ist [auto_qualif
3bb0: 79 20 24 70 61 74 74 65 72 6e 20 24 6e 73 5d 0a y $pattern $ns].
3bc0: 0a 20 20 20 20 61 75 74 6f 5f 6c 6f 61 64 5f 69 . auto_load_i
3bd0: 6e 64 65 78 0a 0a 20 20 20 20 66 6f 72 65 61 63 ndex.. foreac
3be0: 68 20 70 61 74 74 65 72 6e 20 24 70 61 74 74 65 h pattern $patte
3bf0: 72 6e 4c 69 73 74 20 7b 0a 09 66 6f 72 65 61 63 rnList {..foreac
3c00: 68 20 6e 61 6d 65 20 5b 61 72 72 61 79 20 6e 61 h name [array na
3c10: 6d 65 73 20 61 75 74 6f 5f 69 6e 64 65 78 20 24 mes auto_index $
3c20: 70 61 74 74 65 72 6e 5d 20 7b 0a 09 20 20 20 20 pattern] {..
3c30: 69 66 20 7b 28 5b 6e 61 6d 65 73 70 61 63 65 20 if {([namespace
3c40: 77 68 69 63 68 20 2d 63 6f 6d 6d 61 6e 64 20 24 which -command $
3c50: 6e 61 6d 65 5d 20 65 71 20 22 22 29 0a 09 09 20 name] eq "")...
3c60: 20 20 20 26 26 20 28 5b 6e 61 6d 65 73 70 61 63 && ([namespac
3c70: 65 20 71 75 61 6c 69 66 69 65 72 73 20 24 70 61 e qualifiers $pa
3c80: 74 74 65 72 6e 5d 20 65 71 20 5b 6e 61 6d 65 73 ttern] eq [names
3c90: 70 61 63 65 20 71 75 61 6c 69 66 69 65 72 73 20 pace qualifiers
3ca0: 24 6e 61 6d 65 5d 29 7d 20 7b 0a 09 09 6e 61 6d $name])} {...nam
3cb0: 65 73 70 61 63 65 20 69 6e 73 63 6f 70 65 20 3a espace inscope :
3cc0: 3a 20 24 61 75 74 6f 5f 69 6e 64 65 78 28 24 6e : $auto_index($n
3cd0: 61 6d 65 29 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 ame).. }..}.
3ce0: 20 20 20 7d 0a 7d 0a 0a 23 20 61 75 74 6f 5f 65 }.}..# auto_e
3cf0: 78 65 63 6f 6b 20 2d 2d 0a 23 20 4c 61 7a 79 20 xecok --.# Lazy
3d00: 6c 6f 61 64 65 64 20 66 6f 72 20 62 65 74 74 65 loaded for bette
3d10: 72 20 73 74 61 72 74 75 70 20 70 65 72 66 6f 72 r startup perfor
3d20: 6d 61 6e 63 65 2e 0a 70 72 6f 63 20 61 75 74 6f mance..proc auto
3d30: 5f 65 78 65 63 6f 6b 20 61 72 67 20 7b 0a 20 20 _execok arg {.
3d40: 20 20 75 70 6c 65 76 65 6c 20 23 30 20 5b 6c 69 uplevel #0 [li
3d50: 73 74 20 3a 3a 74 63 6c 3a 3a 50 6b 67 3a 3a 73 st ::tcl::Pkg::s
3d60: 6f 75 72 63 65 20 5b 66 69 6c 65 20 6a 6f 69 6e ource [file join
3d70: 20 5b 69 6e 66 6f 20 6c 69 62 72 61 72 79 5d 20 [info library]
3d80: 61 75 74 6f 65 78 65 63 6f 6b 2e 74 63 6c 5d 5d autoexecok.tcl]]
3d90: 0a 20 20 20 20 74 61 69 6c 63 61 6c 6c 20 61 75 . tailcall au
3da0: 74 6f 5f 65 78 65 63 6f 6b 20 24 61 72 67 0a 7d to_execok $arg.}
3db0: 0a 0a 23 20 3a 3a 74 63 6c 3a 3a 43 6f 70 79 44 ..# ::tcl::CopyD
3dc0: 69 72 65 63 74 6f 72 79 20 2d 2d 0a 23 0a 23 20 irectory --.#.#
3dd0: 54 68 69 73 20 70 72 6f 63 65 64 75 72 65 20 69 This procedure i
3de0: 73 20 63 61 6c 6c 65 64 20 62 79 20 54 63 6c 27 s called by Tcl'
3df0: 73 20 63 6f 72 65 20 77 68 65 6e 20 61 74 74 65 s core when atte
3e00: 6d 70 74 73 20 74 6f 20 63 61 6c 6c 20 74 68 65 mpts to call the
3e10: 0a 23 20 66 69 6c 65 73 79 73 74 65 6d 27 73 20 .# filesystem's
3e20: 63 6f 70 79 64 69 72 65 63 74 6f 72 79 20 66 75 copydirectory fu
3e30: 6e 63 74 69 6f 6e 20 66 61 69 6c 2e 20 20 54 68 nction fail. Th
3e40: 65 20 73 65 6d 61 6e 74 69 63 73 20 6f 66 20 74 e semantics of t
3e50: 68 65 20 63 61 6c 6c 0a 23 20 61 72 65 20 74 68 he call.# are th
3e60: 61 74 20 27 64 65 73 74 27 20 64 6f 65 73 20 6e at 'dest' does n
3e70: 6f 74 20 79 65 74 20 65 78 69 73 74 2c 20 69 2e ot yet exist, i.
3e80: 65 2e 20 64 65 73 74 20 73 68 6f 75 6c 64 20 62 e. dest should b
3e90: 65 63 6f 6d 65 20 74 68 65 20 65 78 61 63 74 0a ecome the exact.
3ea0: 23 20 69 6d 61 67 65 20 6f 66 20 73 72 63 2e 20 # image of src.
3eb0: 20 49 66 20 64 65 73 74 20 64 6f 65 73 20 65 78 If dest does ex
3ec0: 69 73 74 2c 20 77 65 20 74 68 72 6f 77 20 61 6e ist, we throw an
3ed0: 20 65 72 72 6f 72 2e 0a 23 0a 23 20 4e 6f 74 65 error..#.# Note
3ee0: 20 74 68 61 74 20 6d 61 6b 69 6e 67 20 63 68 61 that making cha
3ef0: 6e 67 65 73 20 74 6f 20 74 68 69 73 20 70 72 6f nges to this pro
3f00: 63 65 64 75 72 65 20 63 61 6e 20 63 68 61 6e 67 cedure can chang
3f10: 65 20 74 68 65 20 72 65 73 75 6c 74 73 0a 23 20 e the results.#
3f20: 6f 66 20 72 75 6e 6e 69 6e 67 20 54 63 6c 27 73 of running Tcl's
3f30: 20 74 65 73 74 73 2e 0a 23 0a 23 20 41 72 67 75 tests..#.# Argu
3f40: 6d 65 6e 74 73 3a 0a 23 20 61 63 74 69 6f 6e 20 ments:.# action
3f50: 2d 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 - "
3f60: 72 65 6e 61 6d 69 6e 67 22 20 6f 72 20 22 63 6f renaming" or "co
3f70: 70 79 69 6e 67 22 0a 23 20 73 72 63 20 2d 09 09 pying".# src -..
3f80: 09 73 6f 75 72 63 65 20 64 69 72 65 63 74 6f 72 .source director
3f90: 79 0a 23 20 64 65 73 74 20 2d 09 09 64 65 73 74 y.# dest -..dest
3fa0: 69 6e 61 74 69 6f 6e 20 64 69 72 65 63 74 6f 72 ination director
3fb0: 79 0a 70 72 6f 63 20 74 63 6c 3a 3a 43 6f 70 79 y.proc tcl::Copy
3fc0: 44 69 72 65 63 74 6f 72 79 20 7b 61 63 74 69 6f Directory {actio
3fd0: 6e 20 73 72 63 20 64 65 73 74 7d 20 7b 0a 20 20 n src dest} {.
3fe0: 20 20 73 65 74 20 6e 73 72 63 20 5b 66 69 6c 65 set nsrc [file
3ff0: 20 6e 6f 72 6d 61 6c 69 7a 65 20 24 73 72 63 5d normalize $src]
4000: 0a 20 20 20 20 73 65 74 20 6e 64 65 73 74 20 5b . set ndest [
4010: 66 69 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 24 file normalize $
4020: 64 65 73 74 5d 0a 0a 20 20 20 20 69 66 20 7b 24 dest].. if {$
4030: 61 63 74 69 6f 6e 20 65 71 20 22 72 65 6e 61 6d action eq "renam
4040: 69 6e 67 22 7d 20 7b 0a 09 23 20 43 61 6e 27 74 ing"} {..# Can't
4050: 20 72 65 6e 61 6d 65 20 76 6f 6c 75 6d 65 73 2e rename volumes.
4060: 20 20 57 65 20 63 6f 75 6c 64 20 67 69 76 65 20 We could give
4070: 61 20 6d 6f 72 65 20 70 72 65 63 69 73 65 0a 09 a more precise..
4080: 23 20 65 72 72 6f 72 20 6d 65 73 73 61 67 65 20 # error message
4090: 68 65 72 65 2c 20 62 75 74 20 74 68 61 74 20 77 here, but that w
40a0: 6f 75 6c 64 20 62 72 65 61 6b 20 74 68 65 20 74 ould break the t
40b0: 65 73 74 20 73 75 69 74 65 2e 0a 09 69 66 20 7b est suite...if {
40c0: 24 6e 73 72 63 20 69 6e 20 5b 66 69 6c 65 20 76 $nsrc in [file v
40d0: 6f 6c 75 6d 65 73 5d 7d 20 7b 0a 09 20 20 20 20 olumes]} {..
40e0: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err
40f0: 6f 72 20 22 65 72 72 6f 72 20 24 61 63 74 69 6f or "error $actio
4100: 6e 20 5c 22 24 73 72 63 5c 22 20 74 6f 5c 0a 09 n \"$src\" to\..
4110: 20 20 20 20 20 20 5c 22 24 64 65 73 74 5c 22 3a \"$dest\":
4120: 20 74 72 79 69 6e 67 20 74 6f 20 72 65 6e 61 6d trying to renam
4130: 65 20 61 20 76 6f 6c 75 6d 65 20 6f 72 20 6d 6f e a volume or mo
4140: 76 65 20 61 20 64 69 72 65 63 74 6f 72 79 5c 0a ve a directory\.
4150: 09 20 20 20 20 20 20 69 6e 74 6f 20 69 74 73 65 . into itse
4160: 6c 66 22 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 lf"..}. }.
4170: 20 69 66 20 7b 5b 66 69 6c 65 20 65 78 69 73 74 if {[file exist
4180: 73 20 24 64 65 73 74 5d 7d 20 7b 0a 09 69 66 20 s $dest]} {..if
4190: 7b 24 6e 73 72 63 20 65 71 20 24 6e 64 65 73 74 {$nsrc eq $ndest
41a0: 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 } {.. return
41b0: 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 65 72 72 -code error "err
41c0: 6f 72 20 24 61 63 74 69 6f 6e 20 5c 22 24 73 72 or $action \"$sr
41d0: 63 5c 22 20 74 6f 5c 0a 09 20 20 20 20 20 20 5c c\" to\.. \
41e0: 22 24 64 65 73 74 5c 22 3a 20 74 72 79 69 6e 67 "$dest\": trying
41f0: 20 74 6f 20 72 65 6e 61 6d 65 20 61 20 76 6f 6c to rename a vol
4200: 75 6d 65 20 6f 72 20 6d 6f 76 65 20 61 20 64 69 ume or move a di
4210: 72 65 63 74 6f 72 79 5c 0a 09 20 20 20 20 20 20 rectory\..
4220: 69 6e 74 6f 20 69 74 73 65 6c 66 22 0a 09 7d 0a into itself"..}.
4230: 09 69 66 20 7b 24 61 63 74 69 6f 6e 20 65 71 20 .if {$action eq
4240: 22 63 6f 70 79 69 6e 67 22 7d 20 7b 0a 09 20 20 "copying"} {..
4250: 20 20 23 20 57 65 20 75 73 65 64 20 74 6f 20 74 # We used to t
4260: 68 72 6f 77 20 61 6e 20 65 72 72 6f 72 20 68 65 hrow an error he
4270: 72 65 2c 20 62 75 74 2c 20 6c 6f 6f 6b 69 6e 67 re, but, looking
4280: 20 6d 6f 72 65 20 63 6c 6f 73 65 6c 79 0a 09 20 more closely..
4290: 20 20 20 23 20 61 74 20 74 68 65 20 63 6f 72 65 # at the core
42a0: 20 63 6f 70 79 20 63 6f 64 65 20 69 6e 20 74 63 copy code in tc
42b0: 6c 46 43 6d 64 2e 63 2c 20 69 66 20 74 68 65 20 lFCmd.c, if the
42c0: 64 65 73 74 69 6e 61 74 69 6f 6e 0a 09 20 20 20 destination..
42d0: 20 23 20 65 78 69 73 74 73 2c 20 74 68 65 6e 20 # exists, then
42e0: 77 65 20 73 68 6f 75 6c 64 20 6f 6e 6c 79 20 63 we should only c
42f0: 61 6c 6c 20 74 68 69 73 20 66 75 6e 63 74 69 6f all this functio
4300: 6e 20 69 66 20 2d 66 6f 72 63 65 0a 09 20 20 20 n if -force..
4310: 20 23 20 69 73 20 74 72 75 65 2c 20 77 68 69 63 # is true, whic
4320: 68 20 6d 65 61 6e 73 20 77 65 20 6a 75 73 74 20 h means we just
4330: 77 61 6e 74 20 74 6f 20 6f 76 65 72 2d 77 72 69 want to over-wri
4340: 74 65 2e 20 20 53 6f 2c 0a 09 20 20 20 20 23 20 te. So,.. #
4350: 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 63 6f the following co
4360: 64 65 20 69 73 20 6e 6f 77 20 63 6f 6d 6d 65 6e de is now commen
4370: 74 65 64 20 6f 75 74 2e 0a 09 20 20 20 20 23 0a ted out... #.
4380: 09 20 20 20 20 23 20 72 65 74 75 72 6e 20 2d 63 . # return -c
4390: 6f 64 65 20 65 72 72 6f 72 20 22 65 72 72 6f 72 ode error "error
43a0: 20 24 61 63 74 69 6f 6e 20 5c 22 24 73 72 63 5c $action \"$src\
43b0: 22 20 74 6f 5c 0a 09 20 20 20 20 23 20 5c 22 24 " to\.. # \"$
43c0: 64 65 73 74 5c 22 3a 20 66 69 6c 65 20 65 78 69 dest\": file exi
43d0: 73 74 73 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 sts"..} else {..
43e0: 20 20 20 20 23 20 44 65 70 65 6e 64 69 6e 67 20 # Depending
43f0: 6f 6e 20 74 68 65 20 70 6c 61 74 66 6f 72 6d 2c on the platform,
4400: 20 61 6e 64 20 6f 6e 20 74 68 65 20 63 75 72 72 and on the curr
4410: 65 6e 74 0a 09 20 20 20 20 23 20 77 6f 72 6b 69 ent.. # worki
4420: 6e 67 20 64 69 72 65 63 74 6f 72 79 2c 20 74 68 ng directory, th
4430: 65 20 64 69 72 65 63 74 6f 72 69 65 73 20 27 2e e directories '.
4440: 27 2c 20 27 2e 2e 27 0a 09 20 20 20 20 23 20 63 ', '..'.. # c
4450: 61 6e 20 62 65 20 72 65 74 75 72 6e 65 64 20 69 an be returned i
4460: 6e 20 76 61 72 69 6f 75 73 20 63 6f 6d 62 69 6e n various combin
4470: 61 74 69 6f 6e 73 2e 20 20 41 6e 79 77 61 79 2c ations. Anyway,
4480: 0a 09 20 20 20 20 23 20 69 66 20 61 6e 79 20 6f .. # if any o
4490: 74 68 65 72 20 66 69 6c 65 20 69 73 20 72 65 74 ther file is ret
44a0: 75 72 6e 65 64 2c 20 77 65 20 6d 75 73 74 20 73 urned, we must s
44b0: 69 67 6e 61 6c 20 61 6e 20 65 72 72 6f 72 2e 0a ignal an error..
44c0: 09 20 20 20 20 73 65 74 20 65 78 69 73 74 69 6e . set existin
44d0: 67 20 5b 67 6c 6f 62 20 2d 6e 6f 63 6f 6d 70 6c g [glob -nocompl
44e0: 61 69 6e 20 2d 64 69 72 65 63 74 6f 72 79 20 24 ain -directory $
44f0: 64 65 73 74 20 2a 20 2e 2a 5d 0a 09 20 20 20 20 dest * .*]..
4500: 6c 61 70 70 65 6e 64 20 65 78 69 73 74 69 6e 67 lappend existing
4510: 20 7b 2a 7d 5b 67 6c 6f 62 20 2d 6e 6f 63 6f 6d {*}[glob -nocom
4520: 70 6c 61 69 6e 20 2d 64 69 72 65 63 74 6f 72 79 plain -directory
4530: 20 24 64 65 73 74 20 5c 0a 09 09 20 20 20 20 2d $dest \... -
4540: 74 79 70 65 20 68 69 64 64 65 6e 20 2a 20 2e 2a type hidden * .*
4550: 5d 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 73 ].. foreach s
4560: 20 24 65 78 69 73 74 69 6e 67 20 7b 0a 09 09 69 $existing {...i
4570: 66 20 7b 5b 66 69 6c 65 20 74 61 69 6c 20 24 73 f {[file tail $s
4580: 5d 20 6e 69 20 7b 2e 20 2e 2e 7d 7d 20 7b 0a 09 ] ni {. ..}} {..
4590: 09 20 20 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 . return -cod
45a0: 65 20 65 72 72 6f 72 20 22 65 72 72 6f 72 20 24 e error "error $
45b0: 61 63 74 69 6f 6e 20 5c 22 24 73 72 63 5c 22 20 action \"$src\"
45c0: 74 6f 5c 0a 09 09 20 20 20 20 20 20 5c 22 24 64 to\... \"$d
45d0: 65 73 74 5c 22 3a 20 66 69 6c 65 20 65 78 69 73 est\": file exis
45e0: 74 73 22 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 ts"...}.. }..
45f0: 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 }. } else {..
4600: 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 if {[string firs
4610: 74 20 24 6e 73 72 63 20 24 6e 64 65 73 74 5d 20 t $nsrc $ndest]
4620: 3e 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 >= 0} {.. set
4630: 20 73 72 63 6c 65 6e 20 5b 65 78 70 72 20 7b 5b srclen [expr {[
4640: 6c 6c 65 6e 67 74 68 20 5b 66 69 6c 65 20 73 70 llength [file sp
4650: 6c 69 74 20 24 6e 73 72 63 5d 5d 20 2d 20 31 7d lit $nsrc]] - 1}
4660: 5d 0a 09 20 20 20 20 73 65 74 20 6e 64 65 73 74 ].. set ndest
4670: 20 5b 6c 69 6e 64 65 78 20 5b 66 69 6c 65 20 73 [lindex [file s
4680: 70 6c 69 74 20 24 6e 64 65 73 74 5d 20 24 73 72 plit $ndest] $sr
4690: 63 6c 65 6e 5d 0a 09 20 20 20 20 69 66 20 7b 24 clen].. if {$
46a0: 6e 64 65 73 74 20 65 71 20 5b 66 69 6c 65 20 74 ndest eq [file t
46b0: 61 69 6c 20 24 6e 73 72 63 5d 7d 20 7b 0a 09 09 ail $nsrc]} {...
46c0: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err
46d0: 6f 72 20 22 65 72 72 6f 72 20 24 61 63 74 69 6f or "error $actio
46e0: 6e 20 5c 22 24 73 72 63 5c 22 20 74 6f 5c 0a 09 n \"$src\" to\..
46f0: 09 20 20 5c 22 24 64 65 73 74 5c 22 3a 20 74 72 . \"$dest\": tr
4700: 79 69 6e 67 20 74 6f 20 72 65 6e 61 6d 65 20 61 ying to rename a
4710: 20 76 6f 6c 75 6d 65 20 6f 72 20 6d 6f 76 65 20 volume or move
4720: 61 20 64 69 72 65 63 74 6f 72 79 5c 0a 09 09 20 a directory\...
4730: 20 69 6e 74 6f 20 69 74 73 65 6c 66 22 0a 09 20 into itself"..
4740: 20 20 20 7d 0a 09 7d 0a 09 66 69 6c 65 20 6d 6b }..}..file mk
4750: 64 69 72 20 24 64 65 73 74 0a 20 20 20 20 7d 0a dir $dest. }.
4760: 20 20 20 20 23 20 48 61 76 65 20 74 6f 20 62 65 # Have to be
4770: 20 63 61 72 65 66 75 6c 20 74 6f 20 63 61 70 74 careful to capt
4780: 75 72 65 20 62 6f 74 68 20 76 69 73 69 62 6c 65 ure both visible
4790: 20 61 6e 64 20 68 69 64 64 65 6e 20 66 69 6c 65 and hidden file
47a0: 73 2e 0a 20 20 20 20 23 20 57 65 20 77 69 6c 6c s.. # We will
47b0: 20 61 6c 73 6f 20 62 65 20 6d 6f 72 65 20 67 65 also be more ge
47c0: 6e 65 72 6f 75 73 20 74 6f 20 74 68 65 20 66 69 nerous to the fi
47d0: 6c 65 20 73 79 73 74 65 6d 20 61 6e 64 20 6e 6f le system and no
47e0: 74 0a 20 20 20 20 23 20 61 73 73 75 6d 65 20 74 t. # assume t
47f0: 68 65 20 68 69 64 64 65 6e 20 61 6e 64 20 6e 6f he hidden and no
4800: 6e 2d 68 69 64 64 65 6e 20 6c 69 73 74 73 20 61 n-hidden lists a
4810: 72 65 20 6e 6f 6e 2d 6f 76 65 72 6c 61 70 70 69 re non-overlappi
4820: 6e 67 2e 0a 20 20 20 20 23 0a 20 20 20 20 23 20 ng.. #. #
4830: 4f 6e 20 55 6e 69 78 20 27 68 69 64 64 65 6e 27 On Unix 'hidden'
4840: 20 66 69 6c 65 73 20 62 65 67 69 6e 20 77 69 74 files begin wit
4850: 68 20 27 2e 27 2e 20 20 4f 6e 20 6f 74 68 65 72 h '.'. On other
4860: 20 70 6c 61 74 66 6f 72 6d 73 0a 20 20 20 20 23 platforms. #
4870: 20 6f 72 20 66 69 6c 65 73 79 73 74 65 6d 73 20 or filesystems
4880: 68 69 64 64 65 6e 20 66 69 6c 65 73 20 6d 61 79 hidden files may
4890: 20 68 61 76 65 20 6f 74 68 65 72 20 69 6e 74 65 have other inte
48a0: 72 70 72 65 74 61 74 69 6f 6e 73 2e 0a 20 20 20 rpretations..
48b0: 20 73 65 74 20 66 69 6c 65 6c 69 73 74 20 5b 63 set filelist [c
48c0: 6f 6e 63 61 74 20 5b 67 6c 6f 62 20 2d 6e 6f 63 oncat [glob -noc
48d0: 6f 6d 70 6c 61 69 6e 20 2d 64 69 72 65 63 74 6f omplain -directo
48e0: 72 79 20 24 73 72 63 20 2a 5d 20 5c 0a 20 20 20 ry $src *] \.
48f0: 20 20 20 5b 67 6c 6f 62 20 2d 6e 6f 63 6f 6d 70 [glob -nocomp
4900: 6c 61 69 6e 20 2d 64 69 72 65 63 74 6f 72 79 20 lain -directory
4910: 24 73 72 63 20 2d 74 79 70 65 73 20 68 69 64 64 $src -types hidd
4920: 65 6e 20 2a 5d 5d 0a 0a 20 20 20 20 66 6f 72 65 en *]].. fore
4930: 61 63 68 20 73 20 5b 6c 73 6f 72 74 20 2d 75 6e ach s [lsort -un
4940: 69 71 75 65 20 24 66 69 6c 65 6c 69 73 74 5d 20 ique $filelist]
4950: 7b 0a 09 69 66 20 7b 5b 66 69 6c 65 20 74 61 69 {..if {[file tai
4960: 6c 20 24 73 5d 20 6e 69 20 7b 2e 20 2e 2e 7d 7d l $s] ni {. ..}}
4970: 20 7b 0a 09 20 20 20 20 66 69 6c 65 20 63 6f 70 {.. file cop
4980: 79 20 2d 66 6f 72 63 65 20 2d 2d 20 24 73 20 5b y -force -- $s [
4990: 66 69 6c 65 20 6a 6f 69 6e 20 24 64 65 73 74 20 file join $dest
49a0: 5b 66 69 6c 65 20 74 61 69 6c 20 24 73 5d 5d 0a [file tail $s]].
49b0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 .}. }. ret
49c0: 75 72 6e 0a 7d 0a urn.}.
