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 23 WARRANTIES..#..#
0210: 20 54 68 69 73 20 74 65 73 74 20 69 6e 74 65 6e This test inten
0220: 74 69 6f 6e 61 6c 6c 79 20 77 72 69 74 74 65 6e tionally written
0230: 20 69 6e 20 70 72 65 2d 37 2e 35 20 54 63 6c 0a in pre-7.5 Tcl.
0240: 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e if {[info comman
0250: 64 73 20 70 61 63 6b 61 67 65 5d 20 3d 3d 20 22 ds package] == "
0260: 22 7d 20 7b 0a 20 20 20 20 65 72 72 6f 72 20 22 "} {. error "
0270: 76 65 72 73 69 6f 6e 20 6d 69 73 6d 61 74 63 68 version mismatch
0280: 3a 20 6c 69 62 72 61 72 79 5c 6e 73 63 72 69 70 : library\nscrip
0290: 74 73 20 65 78 70 65 63 74 20 54 63 6c 20 76 65 ts expect Tcl ve
02a0: 72 73 69 6f 6e 20 37 2e 35 62 31 20 6f 72 20 6c rsion 7.5b1 or l
02b0: 61 74 65 72 20 62 75 74 20 74 68 65 20 6c 6f 61 ater but the loa
02c0: 64 65 64 20 76 65 72 73 69 6f 6e 20 69 73 5c 6e ded version is\n
02d0: 6f 6e 6c 79 20 5b 69 6e 66 6f 20 70 61 74 63 68 only [info patch
02e0: 6c 65 76 65 6c 5d 22 0a 7d 0a 70 61 63 6b 61 67 level]".}.packag
02f0: 65 20 72 65 71 75 69 72 65 20 2d 65 78 61 63 74 e require -exact
0300: 20 74 63 6c 20 39 2e 30 61 34 0a 0a 23 20 43 6f tcl 9.0a4..# Co
0310: 6d 70 75 74 65 20 74 68 65 20 61 75 74 6f 20 70 mpute the auto p
0320: 61 74 68 20 74 6f 20 75 73 65 20 69 6e 20 74 68 ath to use in th
0330: 69 73 20 69 6e 74 65 72 70 72 65 74 65 72 2e 0a is interpreter..
0340: 23 20 54 68 65 20 76 61 6c 75 65 73 20 6f 6e 20 # The values on
0350: 74 68 65 20 70 61 74 68 20 63 6f 6d 65 20 66 72 the path come fr
0360: 6f 6d 20 73 65 76 65 72 61 6c 20 6c 6f 63 61 74 om several locat
0370: 69 6f 6e 73 3a 0a 23 0a 23 20 54 68 65 20 65 6e ions:.#.# The en
0380: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
0390: 6c 65 20 54 43 4c 4c 49 42 50 41 54 48 0a 23 0a le TCLLIBPATH.#.
03a0: 23 20 74 63 6c 5f 6c 69 62 72 61 72 79 2c 20 77 # tcl_library, w
03b0: 68 69 63 68 20 69 73 20 74 68 65 20 64 69 72 65 hich is the dire
03c0: 63 74 6f 72 79 20 63 6f 6e 74 61 69 6e 69 6e 67 ctory containing
03d0: 20 74 68 69 73 20 69 6e 69 74 2e 74 63 6c 20 73 this init.tcl s
03e0: 63 72 69 70 74 2e 0a 23 20 5b 74 63 6c 49 6e 69 cript..# [tclIni
03f0: 74 5d 20 28 54 63 6c 5f 49 6e 69 74 28 29 29 20 t] (Tcl_Init())
0400: 73 65 61 72 63 68 65 73 20 61 72 6f 75 6e 64 20 searches around
0410: 66 6f 72 20 74 68 65 20 64 69 72 65 63 74 6f 72 for the director
0420: 79 20 63 6f 6e 74 61 69 6e 69 6e 67 20 74 68 69 y containing thi
0430: 73 0a 23 20 69 6e 69 74 2e 74 63 6c 20 61 6e 64 s.# init.tcl and
0440: 20 64 65 66 69 6e 65 73 20 74 63 6c 5f 6c 69 62 defines tcl_lib
0450: 72 61 72 79 20 74 6f 20 74 68 61 74 20 6c 6f 63 rary to that loc
0460: 61 74 69 6f 6e 20 62 65 66 6f 72 65 20 73 6f 75 ation before sou
0470: 72 63 69 6e 67 20 69 74 2e 0a 23 0a 23 20 54 68 rcing it..#.# Th
0480: 65 20 70 61 72 65 6e 74 20 64 69 72 65 63 74 6f e parent directo
0490: 72 79 20 6f 66 20 74 63 6c 5f 6c 69 62 72 61 72 ry of tcl_librar
04a0: 79 2e 20 41 64 64 69 6e 67 20 74 68 65 20 70 61 y. Adding the pa
04b0: 72 65 6e 74 0a 23 20 6d 65 61 6e 73 20 74 68 61 rent.# means tha
04c0: 74 20 70 61 63 6b 61 67 65 73 20 69 6e 20 70 65 t packages in pe
04d0: 65 72 20 64 69 72 65 63 74 6f 72 69 65 73 20 77 er directories w
04e0: 69 6c 6c 20 62 65 20 66 6f 75 6e 64 20 61 75 74 ill be found aut
04f0: 6f 6d 61 74 69 63 61 6c 6c 79 2e 0a 23 0a 23 20 omatically..#.#
0500: 41 6c 73 6f 20 61 64 64 20 74 68 65 20 64 69 72 Also add the dir
0510: 65 63 74 6f 72 79 20 2e 2e 2f 6c 69 62 20 72 65 ectory ../lib re
0520: 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 64 69 lative to the di
0530: 72 65 63 74 6f 72 79 20 77 68 65 72 65 20 74 68 rectory where th
0540: 65 0a 23 20 65 78 65 63 75 74 61 62 6c 65 20 69 e.# executable i
0550: 73 20 6c 6f 63 61 74 65 64 2e 20 20 54 68 69 73 s located. This
0560: 20 69 73 20 6d 65 61 6e 74 20 74 6f 20 66 69 6e is meant to fin
0570: 64 20 62 69 6e 61 72 79 20 70 61 63 6b 61 67 65 d binary package
0580: 73 20 66 6f 72 20 74 68 65 0a 23 20 73 61 6d 65 s for the.# same
0590: 20 61 72 63 68 69 74 65 63 74 75 72 65 20 61 73 architecture as
05a0: 20 74 68 65 20 63 75 72 72 65 6e 74 20 65 78 65 the current exe
05b0: 63 75 74 61 62 6c 65 2e 0a 23 0a 23 20 74 63 6c cutable..#.# tcl
05c0: 5f 70 6b 67 50 61 74 68 2c 20 77 68 69 63 68 20 _pkgPath, which
05d0: 69 73 20 73 65 74 20 62 79 20 74 68 65 20 70 6c is set by the pl
05e0: 61 74 66 6f 72 6d 2d 73 70 65 63 69 66 69 63 20 atform-specific
05f0: 69 6e 69 74 69 61 6c 69 7a 61 74 69 6f 6e 20 72 initialization r
0600: 6f 75 74 69 6e 65 73 0a 23 09 4f 6e 20 55 4e 49 outines.#.On UNI
0610: 58 20 69 74 20 69 73 20 63 6f 6d 70 69 6c 65 64 X it is compiled
0620: 20 69 6e 0a 23 20 20 20 20 20 20 20 4f 6e 20 57 in.# On W
0630: 69 6e 64 6f 77 73 2c 20 69 74 20 69 73 20 6e 6f indows, it is no
0640: 74 20 75 73 65 64 0a 23 0a 23 20 28 54 69 63 6b t used.#.# (Tick
0650: 65 74 20 34 31 63 39 38 35 37 62 64 64 29 20 49 et 41c9857bdd) I
0660: 6e 20 61 20 73 61 66 65 20 69 6e 74 65 72 70 72 n a safe interpr
0670: 65 74 65 72 2c 20 74 68 69 73 20 66 69 6c 65 20 eter, this file
0680: 64 6f 65 73 20 6e 6f 74 20 73 65 74 0a 23 20 3a does not set.# :
0690: 3a 61 75 74 6f 5f 70 61 74 68 20 28 6f 74 68 65 :auto_path (othe
06a0: 72 20 74 68 61 6e 20 74 6f 20 7b 7d 20 69 66 20 r than to {} if
06b0: 69 74 20 69 73 20 75 6e 64 65 66 69 6e 65 64 29 it is undefined)
06c0: 2e 20 54 68 65 20 63 61 6c 6c 65 72 2c 20 74 79 . The caller, ty
06d0: 70 69 63 61 6c 6c 79 0a 23 20 61 20 53 61 66 65 pically.# a Safe
06e0: 20 42 61 73 65 20 63 6f 6d 6d 61 6e 64 2c 20 69 Base command, i
06f0: 73 20 72 65 73 70 6f 6e 73 69 62 6c 65 20 66 6f s responsible fo
0700: 72 20 73 65 74 74 69 6e 67 20 3a 3a 61 75 74 6f r setting ::auto
0710: 5f 70 61 74 68 2e 0a 0a 69 66 20 7b 21 5b 69 6e _path...if {![in
0720: 66 6f 20 65 78 69 73 74 73 20 61 75 74 6f 5f 70 fo exists auto_p
0730: 61 74 68 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b ath]} {. if {
0740: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 [info exists env
0750: 28 54 43 4c 4c 49 42 50 41 54 48 29 5d 20 26 26 (TCLLIBPATH)] &&
0760: 20 28 21 5b 69 6e 74 65 72 70 20 69 73 73 61 66 (![interp issaf
0770: 65 5d 29 7d 20 7b 0a 09 73 65 74 20 61 75 74 6f e])} {..set auto
0780: 5f 70 61 74 68 20 24 65 6e 76 28 54 43 4c 4c 49 _path $env(TCLLI
0790: 42 50 41 54 48 29 0a 20 20 20 20 7d 20 65 6c 73 BPATH). } els
07a0: 65 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 e {..set auto_pa
07b0: 74 68 20 22 22 0a 20 20 20 20 7d 0a 7d 0a 6e 61 th "". }.}.na
07c0: 6d 65 73 70 61 63 65 20 65 76 61 6c 20 74 63 6c mespace eval tcl
07d0: 20 7b 0a 20 20 20 20 69 66 20 7b 21 5b 69 6e 74 {. if {![int
07e0: 65 72 70 20 69 73 73 61 66 65 5d 7d 20 7b 0a 09 erp issafe]} {..
07f0: 76 61 72 69 61 62 6c 65 20 44 69 72 0a 09 66 6f variable Dir..fo
0800: 72 65 61 63 68 20 44 69 72 20 5b 6c 69 73 74 20 reach Dir [list
0810: 24 3a 3a 74 63 6c 5f 6c 69 62 72 61 72 79 20 5b $::tcl_library [
0820: 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 24 3a 3a file dirname $::
0830: 74 63 6c 5f 6c 69 62 72 61 72 79 5d 5d 20 7b 0a tcl_library]] {.
0840: 09 20 20 20 20 69 66 20 7b 24 44 69 72 20 6e 69 . if {$Dir ni
0850: 20 24 3a 3a 61 75 74 6f 5f 70 61 74 68 7d 20 7b $::auto_path} {
0860: 0a 09 09 6c 61 70 70 65 6e 64 20 3a 3a 61 75 74 ...lappend ::aut
0870: 6f 5f 70 61 74 68 20 24 44 69 72 0a 09 20 20 20 o_path $Dir..
0880: 20 7d 0a 09 7d 0a 09 73 65 74 20 44 69 72 20 5b }..}..set Dir [
0890: 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 file join [file
08a0: 64 69 72 6e 61 6d 65 20 5b 66 69 6c 65 20 64 69 dirname [file di
08b0: 72 6e 61 6d 65 20 5c 0a 09 09 5b 69 6e 66 6f 20 rname \...[info
08c0: 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 nameofexecutable
08d0: 5d 5d 5d 20 6c 69 62 5d 0a 09 69 66 20 7b 24 44 ]]] lib]..if {$D
08e0: 69 72 20 6e 69 20 24 3a 3a 61 75 74 6f 5f 70 61 ir ni $::auto_pa
08f0: 74 68 7d 20 7b 0a 09 20 20 20 20 6c 61 70 70 65 th} {.. lappe
0900: 6e 64 20 3a 3a 61 75 74 6f 5f 70 61 74 68 20 24 nd ::auto_path $
0910: 44 69 72 0a 09 7d 0a 09 69 66 20 7b 5b 69 6e 66 Dir..}..if {[inf
0920: 6f 20 65 78 69 73 74 73 20 3a 3a 74 63 6c 5f 70 o exists ::tcl_p
0930: 6b 67 50 61 74 68 5d 7d 20 7b 20 63 61 74 63 68 kgPath]} { catch
0940: 20 7b 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 {.. foreach
0950: 44 69 72 20 24 3a 3a 74 63 6c 5f 70 6b 67 50 61 Dir $::tcl_pkgPa
0960: 74 68 20 7b 0a 09 09 69 66 20 7b 24 44 69 72 20 th {...if {$Dir
0970: 6e 69 20 24 3a 3a 61 75 74 6f 5f 70 61 74 68 7d ni $::auto_path}
0980: 20 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e 64 {... lappend
0990: 20 3a 3a 61 75 74 6f 5f 70 61 74 68 20 24 44 69 ::auto_path $Di
09a0: 72 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 7d 7d r...}.. }..}}
09b0: 0a 0a 09 76 61 72 69 61 62 6c 65 20 50 61 74 68 ...variable Path
09c0: 20 5b 65 6e 63 6f 64 69 6e 67 20 64 69 72 73 5d [encoding dirs]
09d0: 0a 09 73 65 74 20 44 69 72 20 5b 66 69 6c 65 20 ..set Dir [file
09e0: 6a 6f 69 6e 20 24 3a 3a 74 63 6c 5f 6c 69 62 72 join $::tcl_libr
09f0: 61 72 79 20 65 6e 63 6f 64 69 6e 67 5d 0a 09 69 ary encoding]..i
0a00: 66 20 7b 24 44 69 72 20 6e 69 20 24 50 61 74 68 f {$Dir ni $Path
0a10: 7d 20 7b 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 } {.. lappend
0a20: 20 50 61 74 68 20 24 44 69 72 0a 09 20 20 20 20 Path $Dir..
0a30: 65 6e 63 6f 64 69 6e 67 20 64 69 72 73 20 24 50 encoding dirs $P
0a40: 61 74 68 0a 09 7d 0a 09 75 6e 73 65 74 20 44 69 ath..}..unset Di
0a50: 72 20 50 61 74 68 0a 20 20 20 20 7d 0a 7d 0a 0a r Path. }.}..
0a60: 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20 74 namespace eval t
0a70: 63 6c 3a 3a 50 6b 67 20 7b 7d 0a 0a 0a 23 20 53 cl::Pkg {}...# S
0a80: 65 74 75 70 20 74 68 65 20 75 6e 6b 6e 6f 77 6e etup the unknown
0a90: 20 70 61 63 6b 61 67 65 20 68 61 6e 64 6c 65 72 package handler
0aa0: 0a 0a 0a 69 66 20 7b 5b 69 6e 74 65 72 70 20 69 ...if {[interp i
0ab0: 73 73 61 66 65 5d 7d 20 7b 0a 20 20 20 20 70 61 ssafe]} {. pa
0ac0: 63 6b 61 67 65 20 75 6e 6b 6e 6f 77 6e 20 7b 3a ckage unknown {:
0ad0: 3a 74 63 6c 3a 3a 74 6d 3a 3a 55 6e 6b 6e 6f 77 :tcl::tm::Unknow
0ae0: 6e 48 61 6e 64 6c 65 72 20 3a 3a 74 63 6c 50 6b nHandler ::tclPk
0af0: 67 55 6e 6b 6e 6f 77 6e 7d 0a 7d 20 65 6c 73 65 gUnknown}.} else
0b00: 20 7b 0a 20 20 20 20 23 20 53 65 74 20 75 70 20 {. # Set up
0b10: 73 65 61 72 63 68 20 66 6f 72 20 54 63 6c 20 4d search for Tcl M
0b20: 6f 64 75 6c 65 73 20 28 54 49 50 20 23 31 38 39 odules (TIP #189
0b30: 29 2e 0a 20 20 20 20 23 20 61 6e 64 20 73 65 74 ).. # and set
0b40: 75 70 20 70 6c 61 74 66 6f 72 6d 20 73 70 65 63 up platform spec
0b50: 69 66 69 63 20 75 6e 6b 6e 6f 77 6e 20 70 61 63 ific unknown pac
0b60: 6b 61 67 65 20 68 61 6e 64 6c 65 72 73 0a 20 20 kage handlers.
0b70: 20 20 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 if {$tcl_platf
0b80: 6f 72 6d 28 6f 73 29 20 65 71 20 22 44 61 72 77 orm(os) eq "Darw
0b90: 69 6e 22 0a 09 20 20 20 20 26 26 20 24 74 63 6c in".. && $tcl
0ba0: 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f _platform(platfo
0bb0: 72 6d 29 20 65 71 20 22 75 6e 69 78 22 7d 20 7b rm) eq "unix"} {
0bc0: 0a 09 70 61 63 6b 61 67 65 20 75 6e 6b 6e 6f 77 ..package unknow
0bd0: 6e 20 7b 3a 3a 74 63 6c 3a 3a 74 6d 3a 3a 55 6e n {::tcl::tm::Un
0be0: 6b 6e 6f 77 6e 48 61 6e 64 6c 65 72 20 5c 0a 09 knownHandler \..
0bf0: 09 7b 3a 3a 74 63 6c 3a 3a 4d 61 63 4f 53 58 50 .{::tcl::MacOSXP
0c00: 6b 67 55 6e 6b 6e 6f 77 6e 20 3a 3a 74 63 6c 50 kgUnknown ::tclP
0c10: 6b 67 55 6e 6b 6e 6f 77 6e 7d 7d 0a 20 20 20 20 kgUnknown}}.
0c20: 7d 20 65 6c 73 65 20 7b 0a 09 70 61 63 6b 61 67 } else {..packag
0c30: 65 20 75 6e 6b 6e 6f 77 6e 20 7b 3a 3a 74 63 6c e unknown {::tcl
0c40: 3a 3a 74 6d 3a 3a 55 6e 6b 6e 6f 77 6e 48 61 6e ::tm::UnknownHan
0c50: 64 6c 65 72 20 3a 3a 74 63 6c 50 6b 67 55 6e 6b dler ::tclPkgUnk
0c60: 6e 6f 77 6e 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 nown}. }..
0c70: 20 23 20 53 65 74 20 75 70 20 74 68 65 20 27 63 # Set up the 'c
0c80: 6c 6f 63 6b 27 20 65 6e 73 65 6d 62 6c 65 0a 0a lock' ensemble..
0c90: 20 20 20 20 6e 61 6d 65 73 70 61 63 65 20 65 76 namespace ev
0ca0: 61 6c 20 3a 3a 74 63 6c 3a 3a 63 6c 6f 63 6b 20 al ::tcl::clock
0cb0: 5b 6c 69 73 74 20 76 61 72 69 61 62 6c 65 20 54 [list variable T
0cc0: 63 6c 4c 69 62 44 69 72 20 24 3a 3a 74 63 6c 5f clLibDir $::tcl_
0cd0: 6c 69 62 72 61 72 79 5d 0a 0a 20 20 20 20 70 72 library].. pr
0ce0: 6f 63 20 3a 3a 74 63 6c 3a 3a 69 6e 69 74 43 6c oc ::tcl::initCl
0cf0: 6f 63 6b 20 7b 7d 20 7b 0a 09 23 20 41 75 74 6f ock {} {..# Auto
0d00: 2d 6c 6f 61 64 69 6e 67 20 73 74 75 62 73 20 66 -loading stubs f
0d10: 6f 72 20 27 63 6c 6f 63 6b 2e 74 63 6c 27 0a 0a or 'clock.tcl'..
0d20: 09 66 6f 72 65 61 63 68 20 63 6d 64 20 7b 61 64 .foreach cmd {ad
0d30: 64 20 66 6f 72 6d 61 74 20 73 63 61 6e 7d 20 7b d format scan} {
0d40: 0a 09 20 20 20 20 70 72 6f 63 20 3a 3a 74 63 6c .. proc ::tcl
0d50: 3a 3a 63 6c 6f 63 6b 3a 3a 24 63 6d 64 20 61 72 ::clock::$cmd ar
0d60: 67 73 20 7b 0a 09 09 76 61 72 69 61 62 6c 65 20 gs {...variable
0d70: 54 63 6c 4c 69 62 44 69 72 0a 09 09 73 6f 75 72 TclLibDir...sour
0d80: 63 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 54 ce [file join $T
0d90: 63 6c 4c 69 62 44 69 72 20 63 6c 6f 63 6b 2e 74 clLibDir clock.t
0da0: 63 6c 5d 0a 09 09 72 65 74 75 72 6e 20 5b 75 70 cl]...return [up
0db0: 6c 65 76 65 6c 20 31 20 5b 69 6e 66 6f 20 6c 65 level 1 [info le
0dc0: 76 65 6c 20 30 5d 5d 0a 09 20 20 20 20 7d 0a 09 vel 0]].. }..
0dd0: 7d 0a 0a 09 72 65 6e 61 6d 65 20 3a 3a 74 63 6c }...rename ::tcl
0de0: 3a 3a 69 6e 69 74 43 6c 6f 63 6b 20 7b 7d 0a 20 ::initClock {}.
0df0: 20 20 20 7d 0a 20 20 20 20 3a 3a 74 63 6c 3a 3a }. ::tcl::
0e00: 69 6e 69 74 43 6c 6f 63 6b 0a 7d 0a 0a 23 20 43 initClock.}..# C
0e10: 6f 6e 64 69 74 69 6f 6e 61 6c 69 7a 65 20 66 6f onditionalize fo
0e20: 72 20 70 72 65 73 65 6e 63 65 20 6f 66 20 65 78 r presence of ex
0e30: 65 63 2e 0a 0a 69 66 20 7b 5b 6e 61 6d 65 73 70 ec...if {[namesp
0e40: 61 63 65 20 77 68 69 63 68 20 2d 63 6f 6d 6d 61 ace which -comma
0e50: 6e 64 20 65 78 65 63 5d 20 65 71 20 22 22 7d 20 nd exec] eq ""}
0e60: 7b 0a 0a 20 20 20 20 23 20 53 6f 6d 65 20 6d 61 {.. # Some ma
0e70: 63 68 69 6e 65 73 20 64 6f 20 6e 6f 74 20 68 61 chines do not ha
0e80: 76 65 20 65 78 65 63 2e 20 41 6c 73 6f 2c 20 6f ve exec. Also, o
0e90: 6e 20 61 6c 6c 0a 20 20 20 20 23 20 70 6c 61 74 n all. # plat
0ea0: 66 6f 72 6d 73 2c 20 73 61 66 65 20 69 6e 74 65 forms, safe inte
0eb0: 72 70 72 65 74 65 72 73 20 64 6f 20 6e 6f 74 20 rpreters do not
0ec0: 68 61 76 65 20 65 78 65 63 2e 0a 0a 20 20 20 20 have exec...
0ed0: 73 65 74 20 61 75 74 6f 5f 6e 6f 65 78 65 63 20 set auto_noexec
0ee0: 31 0a 7d 0a 0a 23 20 44 65 66 69 6e 65 20 61 20 1.}..# Define a
0ef0: 6c 6f 67 20 63 6f 6d 6d 61 6e 64 20 28 77 68 69 log command (whi
0f00: 63 68 20 63 61 6e 20 62 65 20 6f 76 65 72 77 69 ch can be overwi
0f10: 74 74 65 6e 20 74 6f 20 6c 6f 67 20 65 72 72 6f tten to log erro
0f20: 72 73 0a 23 20 64 69 66 66 65 72 65 6e 74 6c 79 rs.# differently
0f30: 2c 20 73 70 65 63 69 61 6c 6c 79 20 77 68 65 6e , specially when
0f40: 20 73 74 64 65 72 72 20 69 73 20 6e 6f 74 20 61 stderr is not a
0f50: 76 61 69 6c 61 62 6c 65 29 0a 0a 69 66 20 7b 5b vailable)..if {[
0f60: 6e 61 6d 65 73 70 61 63 65 20 77 68 69 63 68 20 namespace which
0f70: 2d 63 6f 6d 6d 61 6e 64 20 74 63 6c 4c 6f 67 5d -command tclLog]
0f80: 20 65 71 20 22 22 7d 20 7b 0a 20 20 20 20 70 72 eq ""} {. pr
0f90: 6f 63 20 74 63 6c 4c 6f 67 20 7b 73 74 72 69 6e oc tclLog {strin
0fa0: 67 7d 20 7b 0a 09 63 61 74 63 68 20 7b 70 75 74 g} {..catch {put
0fb0: 73 20 73 74 64 65 72 72 20 24 73 74 72 69 6e 67 s stderr $string
0fc0: 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 75 6e 6b }. }.}..# unk
0fd0: 6e 6f 77 6e 20 2d 2d 0a 23 20 54 68 69 73 20 70 nown --.# This p
0fe0: 72 6f 63 65 64 75 72 65 20 69 73 20 63 61 6c 6c rocedure is call
0ff0: 65 64 20 77 68 65 6e 20 61 20 54 63 6c 20 63 6f ed when a Tcl co
1000: 6d 6d 61 6e 64 20 69 73 20 69 6e 76 6f 6b 65 64 mmand is invoked
1010: 20 74 68 61 74 20 64 6f 65 73 6e 27 74 0a 23 20 that doesn't.#
1020: 65 78 69 73 74 20 69 6e 20 74 68 65 20 69 6e 74 exist in the int
1030: 65 72 70 72 65 74 65 72 2e 20 20 49 74 20 74 61 erpreter. It ta
1040: 6b 65 73 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e kes the followin
1050: 67 20 73 74 65 70 73 20 74 6f 20 6d 61 6b 65 20 g steps to make
1060: 74 68 65 0a 23 20 63 6f 6d 6d 61 6e 64 20 61 76 the.# command av
1070: 61 69 6c 61 62 6c 65 3a 0a 23 0a 23 09 31 2e 20 ailable:.#.#.1.
1080: 53 65 65 20 69 66 20 74 68 65 20 61 75 74 6f 6c See if the autol
1090: 6f 61 64 20 66 61 63 69 6c 69 74 79 20 63 61 6e oad facility can
10a0: 20 6c 6f 63 61 74 65 20 74 68 65 20 63 6f 6d 6d locate the comm
10b0: 61 6e 64 20 69 6e 20 61 0a 23 09 20 20 20 54 63 and in a.#. Tc
10c0: 6c 20 73 63 72 69 70 74 20 66 69 6c 65 2e 20 20 l script file.
10d0: 49 66 20 73 6f 2c 20 6c 6f 61 64 20 69 74 20 61 If so, load it a
10e0: 6e 64 20 65 78 65 63 75 74 65 20 69 74 2e 0a 23 nd execute it..#
10f0: 09 32 2e 20 49 66 20 74 68 65 20 63 6f 6d 6d 61 .2. If the comma
1100: 6e 64 20 77 61 73 20 69 6e 76 6f 6b 65 64 20 69 nd was invoked i
1110: 6e 74 65 72 61 63 74 69 76 65 6c 79 20 61 74 20 nteractively at
1120: 74 6f 70 2d 6c 65 76 65 6c 3a 0a 23 09 20 20 20 top-level:.#.
1130: 20 28 61 29 20 73 65 65 20 69 66 20 74 68 65 20 (a) see if the
1140: 63 6f 6d 6d 61 6e 64 20 65 78 69 73 74 73 20 61 command exists a
1150: 73 20 61 6e 20 65 78 65 63 75 74 61 62 6c 65 20 s an executable
1160: 55 4e 49 58 20 70 72 6f 67 72 61 6d 2e 0a 23 09 UNIX program..#.
1170: 09 49 66 20 73 6f 2c 20 22 65 78 65 63 22 20 74 .If so, "exec" t
1180: 68 65 20 63 6f 6d 6d 61 6e 64 2e 0a 23 09 20 20 he command..#.
1190: 20 20 28 62 29 20 73 65 65 20 69 66 20 74 68 65 (b) see if the
11a0: 20 63 6f 6d 6d 61 6e 64 20 72 65 71 75 65 73 74 command request
11b0: 73 20 63 73 68 2d 6c 69 6b 65 20 68 69 73 74 6f s csh-like histo
11c0: 72 79 20 73 75 62 73 74 69 74 75 74 69 6f 6e 0a ry substitution.
11d0: 23 09 09 69 6e 20 6f 6e 65 20 6f 66 20 74 68 65 #..in one of the
11e0: 20 63 6f 6d 6d 6f 6e 20 66 6f 72 6d 73 20 21 21 common forms !!
11f0: 2c 20 21 3c 6e 75 6d 62 65 72 3e 2c 20 6f 72 20 , !<number>, or
1200: 5e 6f 6c 64 5e 6e 65 77 2e 20 20 49 66 0a 23 09 ^old^new. If.#.
1210: 09 73 6f 2c 20 65 6d 75 6c 61 74 65 20 63 73 68 .so, emulate csh
1220: 27 73 20 68 69 73 74 6f 72 79 20 73 75 62 73 74 's history subst
1230: 69 74 75 74 69 6f 6e 2e 0a 23 09 20 20 20 20 28 itution..#. (
1240: 63 29 20 73 65 65 20 69 66 20 74 68 65 20 63 6f c) see if the co
1250: 6d 6d 61 6e 64 20 69 73 20 61 20 75 6e 69 71 75 mmand is a uniqu
1260: 65 20 61 62 62 72 65 76 69 61 74 69 6f 6e 20 66 e abbreviation f
1270: 6f 72 20 61 6e 6f 74 68 65 72 0a 23 09 09 63 6f or another.#..co
1280: 6d 6d 61 6e 64 2e 20 20 49 66 20 73 6f 2c 20 69 mmand. If so, i
1290: 6e 76 6f 6b 65 20 74 68 65 20 63 6f 6d 6d 61 6e nvoke the comman
12a0: 64 2e 0a 23 0a 23 20 41 72 67 75 6d 65 6e 74 73 d..#.# Arguments
12b0: 3a 0a 23 20 61 72 67 73 20 2d 09 41 20 6c 69 73 :.# args -.A lis
12c0: 74 20 77 68 6f 73 65 20 65 6c 65 6d 65 6e 74 73 t whose elements
12d0: 20 61 72 65 20 74 68 65 20 77 6f 72 64 73 20 6f are the words o
12e0: 66 20 74 68 65 20 6f 72 69 67 69 6e 61 6c 0a 23 f the original.#
12f0: 09 09 63 6f 6d 6d 61 6e 64 2c 20 69 6e 63 6c 75 ..command, inclu
1300: 64 69 6e 67 20 74 68 65 20 63 6f 6d 6d 61 6e 64 ding the command
1310: 20 6e 61 6d 65 2e 0a 0a 70 72 6f 63 20 75 6e 6b name...proc unk
1320: 6e 6f 77 6e 20 61 72 67 73 20 7b 0a 20 20 20 20 nown args {.
1330: 76 61 72 69 61 62 6c 65 20 3a 3a 74 63 6c 3a 3a variable ::tcl::
1340: 55 6e 6b 6e 6f 77 6e 50 65 6e 64 69 6e 67 0a 20 UnknownPending.
1350: 20 20 20 67 6c 6f 62 61 6c 20 61 75 74 6f 5f 6e global auto_n
1360: 6f 65 78 65 63 20 61 75 74 6f 5f 6e 6f 6c 6f 61 oexec auto_noloa
1370: 64 20 65 6e 76 20 74 63 6c 5f 69 6e 74 65 72 61 d env tcl_intera
1380: 63 74 69 76 65 20 65 72 72 6f 72 49 6e 66 6f 20 ctive errorInfo
1390: 65 72 72 6f 72 43 6f 64 65 0a 0a 20 20 20 20 69 errorCode.. i
13a0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
13b0: 65 72 72 6f 72 49 6e 66 6f 5d 7d 20 7b 0a 09 73 errorInfo]} {..s
13c0: 65 74 20 73 61 76 65 64 45 72 72 6f 72 49 6e 66 et savedErrorInf
13d0: 6f 20 24 65 72 72 6f 72 49 6e 66 6f 0a 20 20 20 o $errorInfo.
13e0: 20 7d 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f }. if {[info
13f0: 20 65 78 69 73 74 73 20 65 72 72 6f 72 43 6f 64 exists errorCod
1400: 65 5d 7d 20 7b 0a 09 73 65 74 20 73 61 76 65 64 e]} {..set saved
1410: 45 72 72 6f 72 43 6f 64 65 20 24 65 72 72 6f 72 ErrorCode $error
1420: 43 6f 64 65 0a 20 20 20 20 7d 0a 0a 20 20 20 20 Code. }..
1430: 73 65 74 20 6e 61 6d 65 20 5b 6c 69 6e 64 65 78 set name [lindex
1440: 20 24 61 72 67 73 20 30 5d 0a 20 20 20 20 69 66 $args 0]. if
1450: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
1460: 61 75 74 6f 5f 6e 6f 6c 6f 61 64 5d 7d 20 7b 0a auto_noload]} {.
1470: 09 23 0a 09 23 20 4d 61 6b 65 20 73 75 72 65 20 .#..# Make sure
1480: 77 65 27 72 65 20 6e 6f 74 20 74 72 79 69 6e 67 we're not trying
1490: 20 74 6f 20 6c 6f 61 64 20 74 68 65 20 73 61 6d to load the sam
14a0: 65 20 70 72 6f 63 20 74 77 69 63 65 2e 0a 09 23 e proc twice...#
14b0: 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 ..if {[info exis
14c0: 74 73 20 55 6e 6b 6e 6f 77 6e 50 65 6e 64 69 6e ts UnknownPendin
14d0: 67 28 24 6e 61 6d 65 29 5d 7d 20 7b 0a 09 20 20 g($name)]} {..
14e0: 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 return -code e
14f0: 72 72 6f 72 20 22 73 65 6c 66 2d 72 65 66 65 72 rror "self-refer
1500: 65 6e 74 69 61 6c 20 72 65 63 75 72 73 69 6f 6e ential recursion
1510: 5c 0a 09 09 20 20 20 20 69 6e 20 5c 22 75 6e 6b \... in \"unk
1520: 6e 6f 77 6e 5c 22 20 66 6f 72 20 63 6f 6d 6d 61 nown\" for comma
1530: 6e 64 20 5c 22 24 6e 61 6d 65 5c 22 22 0a 09 7d nd \"$name\""..}
1540: 0a 09 73 65 74 20 55 6e 6b 6e 6f 77 6e 50 65 6e ..set UnknownPen
1550: 64 69 6e 67 28 24 6e 61 6d 65 29 20 70 65 6e 64 ding($name) pend
1560: 69 6e 67 0a 09 73 65 74 20 72 65 74 20 5b 63 61 ing..set ret [ca
1570: 74 63 68 20 7b 0a 09 09 61 75 74 6f 5f 6c 6f 61 tch {...auto_loa
1580: 64 20 24 6e 61 6d 65 20 5b 75 70 6c 65 76 65 6c d $name [uplevel
1590: 20 31 20 7b 3a 3a 6e 61 6d 65 73 70 61 63 65 20 1 {::namespace
15a0: 63 75 72 72 65 6e 74 7d 5d 0a 09 7d 20 6d 73 67 current}]..} msg
15b0: 20 6f 70 74 73 5d 0a 09 75 6e 73 65 74 20 55 6e opts]..unset Un
15c0: 6b 6e 6f 77 6e 50 65 6e 64 69 6e 67 28 24 6e 61 knownPending($na
15d0: 6d 65 29 0a 09 69 66 20 7b 24 72 65 74 20 21 3d me)..if {$ret !=
15e0: 20 30 7d 20 7b 0a 09 20 20 20 20 64 69 63 74 20 0} {.. dict
15f0: 61 70 70 65 6e 64 20 6f 70 74 73 20 2d 65 72 72 append opts -err
1600: 6f 72 69 6e 66 6f 20 22 5c 6e 20 20 20 20 28 61 orinfo "\n (a
1610: 75 74 6f 6c 6f 61 64 69 6e 67 20 5c 22 24 6e 61 utoloading \"$na
1620: 6d 65 5c 22 29 22 0a 09 20 20 20 20 72 65 74 75 me\")".. retu
1630: 72 6e 20 2d 6f 70 74 69 6f 6e 73 20 24 6f 70 74 rn -options $opt
1640: 73 20 24 6d 73 67 0a 09 7d 0a 09 69 66 20 7b 21 s $msg..}..if {!
1650: 5b 61 72 72 61 79 20 73 69 7a 65 20 55 6e 6b 6e [array size Unkn
1660: 6f 77 6e 50 65 6e 64 69 6e 67 5d 7d 20 7b 0a 09 ownPending]} {..
1670: 20 20 20 20 75 6e 73 65 74 20 55 6e 6b 6e 6f 77 unset Unknow
1680: 6e 50 65 6e 64 69 6e 67 0a 09 7d 0a 09 69 66 20 nPending..}..if
1690: 7b 24 6d 73 67 7d 20 7b 0a 09 20 20 20 20 69 66 {$msg} {.. if
16a0: 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 {[info exists s
16b0: 61 76 65 64 45 72 72 6f 72 43 6f 64 65 5d 7d 20 avedErrorCode]}
16c0: 7b 0a 09 09 73 65 74 20 3a 3a 65 72 72 6f 72 43 {...set ::errorC
16d0: 6f 64 65 20 24 73 61 76 65 64 45 72 72 6f 72 43 ode $savedErrorC
16e0: 6f 64 65 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ode.. } else
16f0: 7b 0a 09 09 75 6e 73 65 74 20 2d 6e 6f 63 6f 6d {...unset -nocom
1700: 70 6c 61 69 6e 20 3a 3a 65 72 72 6f 72 43 6f 64 plain ::errorCod
1710: 65 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 e.. }.. if
1720: 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 {[info exists s
1730: 61 76 65 64 45 72 72 6f 72 49 6e 66 6f 5d 7d 20 avedErrorInfo]}
1740: 7b 0a 09 09 73 65 74 20 65 72 72 6f 72 49 6e 66 {...set errorInf
1750: 6f 20 24 73 61 76 65 64 45 72 72 6f 72 49 6e 66 o $savedErrorInf
1760: 6f 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a o.. } else {.
1770: 09 09 75 6e 73 65 74 20 2d 6e 6f 63 6f 6d 70 6c ..unset -nocompl
1780: 61 69 6e 20 65 72 72 6f 72 49 6e 66 6f 0a 09 20 ain errorInfo..
1790: 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20 63 6f }.. set co
17a0: 64 65 20 5b 63 61 74 63 68 20 7b 75 70 6c 65 76 de [catch {uplev
17b0: 65 6c 20 31 20 24 61 72 67 73 7d 20 6d 73 67 20 el 1 $args} msg
17c0: 6f 70 74 73 5d 0a 09 20 20 20 20 69 66 20 7b 24 opts].. if {$
17d0: 63 6f 64 65 20 3d 3d 20 20 31 7d 20 7b 0a 09 09 code == 1} {...
17e0: 23 0a 09 09 23 20 43 6f 6d 70 75 74 65 20 73 74 #...# Compute st
17f0: 61 63 6b 20 74 72 61 63 65 20 63 6f 6e 74 72 69 ack trace contri
1800: 62 75 74 69 6f 6e 20 66 72 6f 6d 20 74 68 65 20 bution from the
1810: 5b 75 70 6c 65 76 65 6c 5d 2e 0a 09 09 23 20 4e [uplevel]....# N
1820: 6f 74 65 20 74 68 65 20 64 65 70 65 6e 64 65 6e ote the dependen
1830: 63 65 20 6f 6e 20 68 6f 77 20 54 63 6c 5f 41 64 ce on how Tcl_Ad
1840: 64 45 72 72 6f 72 49 6e 66 6f 2c 20 65 74 63 2e dErrorInfo, etc.
1850: 0a 09 09 23 20 63 6f 6e 73 74 72 75 63 74 20 74 ...# construct t
1860: 68 65 20 73 74 61 63 6b 20 74 72 61 63 65 2e 0a he stack trace..
1870: 09 09 23 0a 09 09 73 65 74 20 65 72 72 49 6e 66 ..#...set errInf
1880: 6f 20 5b 64 69 63 74 20 67 65 74 20 24 6f 70 74 o [dict get $opt
1890: 73 20 2d 65 72 72 6f 72 69 6e 66 6f 5d 0a 09 09 s -errorinfo]...
18a0: 73 65 74 20 65 72 72 43 6f 64 65 20 5b 64 69 63 set errCode [dic
18b0: 74 20 67 65 74 20 24 6f 70 74 73 20 2d 65 72 72 t get $opts -err
18c0: 6f 72 63 6f 64 65 5d 0a 09 09 73 65 74 20 63 69 orcode]...set ci
18d0: 6e 66 6f 20 24 61 72 67 73 0a 09 09 69 66 20 7b nfo $args...if {
18e0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 5b [string length [
18f0: 65 6e 63 6f 64 69 6e 67 20 63 6f 6e 76 65 72 74 encoding convert
1900: 74 6f 20 75 74 66 2d 38 20 24 63 69 6e 66 6f 5d to utf-8 $cinfo]
1910: 5d 20 3e 20 31 35 30 7d 20 7b 0a 09 09 20 20 20 ] > 150} {...
1920: 20 73 65 74 20 63 69 6e 66 6f 20 5b 73 74 72 69 set cinfo [stri
1930: 6e 67 20 72 61 6e 67 65 20 24 63 69 6e 66 6f 20 ng range $cinfo
1940: 30 20 31 35 30 5d 0a 09 09 20 20 20 20 77 68 69 0 150]... whi
1950: 6c 65 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 le {[string leng
1960: 74 68 20 5b 65 6e 63 6f 64 69 6e 67 20 63 6f 6e th [encoding con
1970: 76 65 72 74 74 6f 20 75 74 66 2d 38 20 24 63 69 vertto utf-8 $ci
1980: 6e 66 6f 5d 5d 20 3e 20 31 35 30 7d 20 7b 0a 09 nfo]] > 150} {..
1990: 09 09 73 65 74 20 63 69 6e 66 6f 20 5b 73 74 72 ..set cinfo [str
19a0: 69 6e 67 20 72 61 6e 67 65 20 24 63 69 6e 66 6f ing range $cinfo
19b0: 20 30 20 65 6e 64 2d 31 5d 0a 09 09 20 20 20 20 0 end-1]...
19c0: 7d 0a 09 09 20 20 20 20 61 70 70 65 6e 64 20 63 }... append c
19d0: 69 6e 66 6f 20 2e 2e 2e 0a 09 09 7d 0a 09 09 73 info ......}...s
19e0: 65 74 20 74 61 69 6c 20 22 5c 6e 20 20 20 20 28 et tail "\n (
19f0: 5c 22 75 70 6c 65 76 65 6c 5c 22 20 62 6f 64 79 \"uplevel\" body
1a00: 20 6c 69 6e 65 20 31 29 5c 6e 20 20 20 20 69 6e line 1)\n in
1a10: 76 6f 6b 65 64 5c 0a 09 09 09 66 72 6f 6d 20 77 voked\....from w
1a20: 69 74 68 69 6e 5c 6e 5c 22 75 70 6c 65 76 65 6c ithin\n\"uplevel
1a30: 20 31 20 5c 24 61 72 67 73 5c 22 22 0a 09 09 73 1 \$args\""...s
1a40: 65 74 20 65 78 70 65 63 74 20 22 24 6d 73 67 5c et expect "$msg\
1a50: 6e 20 20 20 20 77 68 69 6c 65 20 65 78 65 63 75 n while execu
1a60: 74 69 6e 67 5c 6e 5c 22 24 63 69 6e 66 6f 5c 22 ting\n\"$cinfo\"
1a70: 24 74 61 69 6c 22 0a 09 09 69 66 20 7b 24 65 72 $tail"...if {$er
1a80: 72 49 6e 66 6f 20 65 71 20 24 65 78 70 65 63 74 rInfo eq $expect
1a90: 7d 20 7b 0a 09 09 20 20 20 20 23 0a 09 09 20 20 } {... #...
1aa0: 20 20 23 20 54 68 65 20 73 74 61 63 6b 20 68 61 # The stack ha
1ab0: 73 20 6f 6e 6c 79 20 74 68 65 20 65 76 61 6c 20 s only the eval
1ac0: 66 72 6f 6d 20 74 68 65 20 65 78 70 61 6e 64 65 from the expande
1ad0: 64 20 63 6f 6d 6d 61 6e 64 0a 09 09 20 20 20 20 d command...
1ae0: 23 20 44 6f 20 6e 6f 74 20 67 65 6e 65 72 61 74 # Do not generat
1af0: 65 20 61 6e 79 20 73 74 61 63 6b 20 74 72 61 63 e any stack trac
1b00: 65 20 68 65 72 65 2e 0a 09 09 20 20 20 20 23 0a e here.... #.
1b10: 09 09 20 20 20 20 64 69 63 74 20 75 6e 73 65 74 .. dict unset
1b20: 20 6f 70 74 73 20 2d 65 72 72 6f 72 69 6e 66 6f opts -errorinfo
1b30: 0a 09 09 20 20 20 20 64 69 63 74 20 69 6e 63 72 ... dict incr
1b40: 20 6f 70 74 73 20 2d 6c 65 76 65 6c 0a 09 09 20 opts -level...
1b50: 20 20 20 72 65 74 75 72 6e 20 2d 6f 70 74 69 6f return -optio
1b60: 6e 73 20 24 6f 70 74 73 20 24 6d 73 67 0a 09 09 ns $opts $msg...
1b70: 7d 0a 09 09 23 0a 09 09 23 20 53 74 61 63 6b 20 }...#...# Stack
1b80: 74 72 61 63 65 20 69 73 20 6e 65 73 74 65 64 2c trace is nested,
1b90: 20 74 72 69 6d 20 6f 66 66 20 6a 75 73 74 20 74 trim off just t
1ba0: 68 65 20 63 6f 6e 74 72 69 62 75 74 69 6f 6e 0a he contribution.
1bb0: 09 09 23 20 66 72 6f 6d 20 74 68 65 20 65 78 74 ..# from the ext
1bc0: 72 61 20 22 65 76 61 6c 22 20 6f 66 20 24 61 72 ra "eval" of $ar
1bd0: 67 73 20 64 75 65 20 74 6f 20 74 68 65 20 22 63 gs due to the "c
1be0: 61 74 63 68 22 20 61 62 6f 76 65 2e 0a 09 09 23 atch" above....#
1bf0: 0a 09 09 73 65 74 20 6c 61 73 74 20 5b 73 74 72 ...set last [str
1c00: 69 6e 67 20 6c 61 73 74 20 24 74 61 69 6c 20 24 ing last $tail $
1c10: 65 72 72 49 6e 66 6f 5d 0a 09 09 69 66 20 7b 24 errInfo]...if {$
1c20: 6c 61 73 74 20 2b 20 5b 73 74 72 69 6e 67 20 6c last + [string l
1c30: 65 6e 67 74 68 20 24 74 61 69 6c 5d 20 21 3d 20 ength $tail] !=
1c40: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
1c50: 65 72 72 49 6e 66 6f 5d 7d 20 7b 0a 09 09 20 20 errInfo]} {...
1c60: 20 20 23 20 56 65 72 79 20 6c 69 6b 65 6c 79 20 # Very likely
1c70: 63 61 6e 6e 6f 74 20 68 61 70 70 65 6e 0a 09 09 cannot happen...
1c80: 20 20 20 20 72 65 74 75 72 6e 20 2d 6f 70 74 69 return -opti
1c90: 6f 6e 73 20 24 6f 70 74 73 20 24 6d 73 67 0a 09 ons $opts $msg..
1ca0: 09 7d 0a 09 09 73 65 74 20 65 72 72 49 6e 66 6f .}...set errInfo
1cb0: 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 [string range $
1cc0: 65 72 72 49 6e 66 6f 20 30 20 24 6c 61 73 74 2d errInfo 0 $last-
1cd0: 31 5d 0a 09 09 73 65 74 20 74 61 69 6c 20 22 5c 1]...set tail "\
1ce0: 22 24 63 69 6e 66 6f 5c 22 22 0a 09 09 73 65 74 "$cinfo\""...set
1cf0: 20 6c 61 73 74 20 5b 73 74 72 69 6e 67 20 6c 61 last [string la
1d00: 73 74 20 24 74 61 69 6c 20 24 65 72 72 49 6e 66 st $tail $errInf
1d10: 6f 5d 0a 09 09 69 66 20 7b 24 6c 61 73 74 20 3c o]...if {$last <
1d20: 20 30 20 7c 7c 20 24 6c 61 73 74 20 2b 20 5b 73 0 || $last + [s
1d30: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 74 61 tring length $ta
1d40: 69 6c 5d 20 21 3d 20 5b 73 74 72 69 6e 67 20 6c il] != [string l
1d50: 65 6e 67 74 68 20 24 65 72 72 49 6e 66 6f 5d 7d ength $errInfo]}
1d60: 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 {... return
1d70: 2d 63 6f 64 65 20 65 72 72 6f 72 20 2d 65 72 72 -code error -err
1d80: 6f 72 63 6f 64 65 20 24 65 72 72 43 6f 64 65 20 orcode $errCode
1d90: 5c 0a 09 09 09 20 20 20 20 2d 65 72 72 6f 72 69 \.... -errori
1da0: 6e 66 6f 20 24 65 72 72 49 6e 66 6f 20 24 6d 73 nfo $errInfo $ms
1db0: 67 0a 09 09 7d 0a 09 09 73 65 74 20 65 72 72 49 g...}...set errI
1dc0: 6e 66 6f 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 nfo [string rang
1dd0: 65 20 24 65 72 72 49 6e 66 6f 20 30 20 24 6c 61 e $errInfo 0 $la
1de0: 73 74 2d 31 5d 0a 09 09 73 65 74 20 74 61 69 6c st-1]...set tail
1df0: 20 22 5c 6e 20 20 20 20 69 6e 76 6f 6b 65 64 20 "\n invoked
1e00: 66 72 6f 6d 20 77 69 74 68 69 6e 5c 6e 22 0a 09 from within\n"..
1e10: 09 73 65 74 20 6c 61 73 74 20 5b 73 74 72 69 6e .set last [strin
1e20: 67 20 6c 61 73 74 20 24 74 61 69 6c 20 24 65 72 g last $tail $er
1e30: 72 49 6e 66 6f 5d 0a 09 09 69 66 20 7b 24 6c 61 rInfo]...if {$la
1e40: 73 74 20 2b 20 5b 73 74 72 69 6e 67 20 6c 65 6e st + [string len
1e50: 67 74 68 20 24 74 61 69 6c 5d 20 3d 3d 20 5b 73 gth $tail] == [s
1e60: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 65 72 tring length $er
1e70: 72 49 6e 66 6f 5d 7d 20 7b 0a 09 09 20 20 20 20 rInfo]} {...
1e80: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err
1e90: 6f 72 20 2d 65 72 72 6f 72 63 6f 64 65 20 24 65 or -errorcode $e
1ea0: 72 72 43 6f 64 65 20 5c 0a 09 09 09 20 20 20 20 rrCode \....
1eb0: 2d 65 72 72 6f 72 69 6e 66 6f 20 5b 73 74 72 69 -errorinfo [stri
1ec0: 6e 67 20 72 61 6e 67 65 20 24 65 72 72 49 6e 66 ng range $errInf
1ed0: 6f 20 30 20 24 6c 61 73 74 2d 31 5d 20 24 6d 73 o 0 $last-1] $ms
1ee0: 67 0a 09 09 7d 0a 09 09 73 65 74 20 74 61 69 6c g...}...set tail
1ef0: 20 22 5c 6e 20 20 20 20 77 68 69 6c 65 20 65 78 "\n while ex
1f00: 65 63 75 74 69 6e 67 5c 6e 22 0a 09 09 73 65 74 ecuting\n"...set
1f10: 20 6c 61 73 74 20 5b 73 74 72 69 6e 67 20 6c 61 last [string la
1f20: 73 74 20 24 74 61 69 6c 20 24 65 72 72 49 6e 66 st $tail $errInf
1f30: 6f 5d 0a 09 09 69 66 20 7b 24 6c 61 73 74 20 2b o]...if {$last +
1f40: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
1f50: 24 74 61 69 6c 5d 20 3d 3d 20 5b 73 74 72 69 6e $tail] == [strin
1f60: 67 20 6c 65 6e 67 74 68 20 24 65 72 72 49 6e 66 g length $errInf
1f70: 6f 5d 7d 20 7b 0a 09 09 20 20 20 20 72 65 74 75 o]} {... retu
1f80: 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 2d rn -code error -
1f90: 65 72 72 6f 72 63 6f 64 65 20 24 65 72 72 43 6f errorcode $errCo
1fa0: 64 65 20 5c 0a 09 09 09 20 20 20 20 2d 65 72 72 de \.... -err
1fb0: 6f 72 69 6e 66 6f 20 5b 73 74 72 69 6e 67 20 72 orinfo [string r
1fc0: 61 6e 67 65 20 24 65 72 72 49 6e 66 6f 20 30 20 ange $errInfo 0
1fd0: 24 6c 61 73 74 2d 31 5d 20 24 6d 73 67 0a 09 09 $last-1] $msg...
1fe0: 7d 0a 09 09 72 65 74 75 72 6e 20 2d 6f 70 74 69 }...return -opti
1ff0: 6f 6e 73 20 24 6f 70 74 73 20 24 6d 73 67 0a 09 ons $opts $msg..
2000: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 64 } else {...d
2010: 69 63 74 20 69 6e 63 72 20 6f 70 74 73 20 2d 6c ict incr opts -l
2020: 65 76 65 6c 0a 09 09 72 65 74 75 72 6e 20 2d 6f evel...return -o
2030: 70 74 69 6f 6e 73 20 24 6f 70 74 73 20 24 6d 73 ptions $opts $ms
2040: 67 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 g.. }..}.
2050: 7d 0a 0a 20 20 20 20 69 66 20 7b 28 5b 69 6e 66 }.. if {([inf
2060: 6f 20 6c 65 76 65 6c 5d 20 3d 3d 20 31 29 20 26 o level] == 1) &
2070: 26 20 28 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d & ([info script]
2080: 20 65 71 20 22 22 29 0a 09 20 20 20 20 26 26 20 eq "").. &&
2090: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 74 63 6c [info exists tcl
20a0: 5f 69 6e 74 65 72 61 63 74 69 76 65 5d 20 26 26 _interactive] &&
20b0: 20 24 74 63 6c 5f 69 6e 74 65 72 61 63 74 69 76 $tcl_interactiv
20c0: 65 7d 20 7b 0a 09 69 66 20 7b 21 5b 69 6e 66 6f e} {..if {![info
20d0: 20 65 78 69 73 74 73 20 61 75 74 6f 5f 6e 6f 65 exists auto_noe
20e0: 78 65 63 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 xec]} {.. set
20f0: 20 6e 65 77 20 5b 61 75 74 6f 5f 65 78 65 63 6f new [auto_execo
2100: 6b 20 24 6e 61 6d 65 5d 0a 09 20 20 20 20 69 66 k $name].. if
2110: 20 7b 24 6e 65 77 20 6e 65 20 22 22 7d 20 7b 0a {$new ne ""} {.
2120: 09 09 73 65 74 20 72 65 64 69 72 20 22 22 0a 09 ..set redir ""..
2130: 09 69 66 20 7b 5b 6e 61 6d 65 73 70 61 63 65 20 .if {[namespace
2140: 77 68 69 63 68 20 2d 63 6f 6d 6d 61 6e 64 20 63 which -command c
2150: 6f 6e 73 6f 6c 65 5d 20 65 71 20 22 22 7d 20 7b onsole] eq ""} {
2160: 0a 09 09 20 20 20 20 73 65 74 20 72 65 64 69 72 ... set redir
2170: 20 22 3e 26 40 73 74 64 6f 75 74 20 3c 40 73 74 ">&@stdout <@st
2180: 64 69 6e 22 0a 09 09 7d 0a 09 09 75 70 6c 65 76 din"...}...uplev
2190: 65 6c 20 31 20 5b 6c 69 73 74 20 3a 3a 63 61 74 el 1 [list ::cat
21a0: 63 68 20 5c 0a 09 09 09 5b 63 6f 6e 63 61 74 20 ch \....[concat
21b0: 65 78 65 63 20 24 72 65 64 69 72 20 24 6e 65 77 exec $redir $new
21c0: 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 73 20 31 [lrange $args 1
21d0: 20 65 6e 64 5d 5d 20 5c 0a 09 09 09 3a 3a 74 63 end]] \....::tc
21e0: 6c 3a 3a 55 6e 6b 6e 6f 77 6e 52 65 73 75 6c 74 l::UnknownResult
21f0: 20 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 4f ::tcl::UnknownO
2200: 70 74 69 6f 6e 73 5d 0a 09 09 64 69 63 74 20 69 ptions]...dict i
2210: 6e 63 72 20 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f ncr ::tcl::Unkno
2220: 77 6e 4f 70 74 69 6f 6e 73 20 2d 6c 65 76 65 6c wnOptions -level
2230: 0a 09 09 72 65 74 75 72 6e 20 2d 6f 70 74 69 6f ...return -optio
2240: 6e 73 20 24 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f ns $::tcl::Unkno
2250: 77 6e 4f 70 74 69 6f 6e 73 20 24 3a 3a 74 63 6c wnOptions $::tcl
2260: 3a 3a 55 6e 6b 6e 6f 77 6e 52 65 73 75 6c 74 0a ::UnknownResult.
2270: 09 20 20 20 20 7d 0a 09 7d 0a 09 69 66 20 7b 24 . }..}..if {$
2280: 6e 61 6d 65 20 65 71 20 22 21 21 22 7d 20 7b 0a name eq "!!"} {.
2290: 09 20 20 20 20 73 65 74 20 6e 65 77 63 6d 64 20 . set newcmd
22a0: 5b 68 69 73 74 6f 72 79 20 65 76 65 6e 74 5d 0a [history event].
22b0: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 72 65 67 65 .} elseif {[rege
22c0: 78 70 20 7b 5e 21 28 2e 2b 29 24 7d 20 24 6e 61 xp {^!(.+)$} $na
22d0: 6d 65 20 2d 3e 20 65 76 65 6e 74 5d 7d 20 7b 0a me -> event]} {.
22e0: 09 20 20 20 20 73 65 74 20 6e 65 77 63 6d 64 20 . set newcmd
22f0: 5b 68 69 73 74 6f 72 79 20 65 76 65 6e 74 20 24 [history event $
2300: 65 76 65 6e 74 5d 0a 09 7d 20 65 6c 73 65 69 66 event]..} elseif
2310: 20 7b 5b 72 65 67 65 78 70 20 7b 5e 5c 5e 28 5b {[regexp {^\^([
2320: 5e 5e 5d 2a 29 5c 5e 28 5b 5e 5e 5d 2a 29 5c 5e ^^]*)\^([^^]*)\^
2330: 3f 24 7d 20 24 6e 61 6d 65 20 2d 3e 20 6f 6c 64 ?$} $name -> old
2340: 20 6e 65 77 5d 7d 20 7b 0a 09 20 20 20 20 73 65 new]} {.. se
2350: 74 20 6e 65 77 63 6d 64 20 5b 68 69 73 74 6f 72 t newcmd [histor
2360: 79 20 65 76 65 6e 74 20 2d 31 5d 0a 09 20 20 20 y event -1]..
2370: 20 63 61 74 63 68 20 7b 72 65 67 73 75 62 20 2d catch {regsub -
2380: 61 6c 6c 20 2d 2d 20 24 6f 6c 64 20 24 6e 65 77 all -- $old $new
2390: 63 6d 64 20 24 6e 65 77 20 6e 65 77 63 6d 64 7d cmd $new newcmd}
23a0: 0a 09 7d 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 ..}..if {[info e
23b0: 78 69 73 74 73 20 6e 65 77 63 6d 64 5d 7d 20 7b xists newcmd]} {
23c0: 0a 09 20 20 20 20 74 63 6c 4c 6f 67 20 24 6e 65 .. tclLog $ne
23d0: 77 63 6d 64 0a 09 20 20 20 20 68 69 73 74 6f 72 wcmd.. histor
23e0: 79 20 63 68 61 6e 67 65 20 24 6e 65 77 63 6d 64 y change $newcmd
23f0: 20 30 0a 09 20 20 20 20 75 70 6c 65 76 65 6c 20 0.. uplevel
2400: 31 20 5b 6c 69 73 74 20 3a 3a 63 61 74 63 68 20 1 [list ::catch
2410: 24 6e 65 77 63 6d 64 20 5c 0a 09 09 20 20 20 20 $newcmd \...
2420: 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 52 65 ::tcl::UnknownRe
2430: 73 75 6c 74 20 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e sult ::tcl::Unkn
2440: 6f 77 6e 4f 70 74 69 6f 6e 73 5d 0a 09 20 20 20 ownOptions]..
2450: 20 64 69 63 74 20 69 6e 63 72 20 3a 3a 74 63 6c dict incr ::tcl
2460: 3a 3a 55 6e 6b 6e 6f 77 6e 4f 70 74 69 6f 6e 73 ::UnknownOptions
2470: 20 2d 6c 65 76 65 6c 0a 09 20 20 20 20 72 65 74 -level.. ret
2480: 75 72 6e 20 2d 6f 70 74 69 6f 6e 73 20 24 3a 3a urn -options $::
2490: 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 4f 70 74 69 tcl::UnknownOpti
24a0: 6f 6e 73 20 24 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e ons $::tcl::Unkn
24b0: 6f 77 6e 52 65 73 75 6c 74 0a 09 7d 0a 0a 09 73 ownResult..}...s
24c0: 65 74 20 72 65 74 20 5b 63 61 74 63 68 20 7b 73 et ret [catch {s
24d0: 65 74 20 63 61 6e 64 69 64 61 74 65 73 20 5b 69 et candidates [i
24e0: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 24 6e 61 nfo commands $na
24f0: 6d 65 2a 5d 7d 20 6d 73 67 5d 0a 09 69 66 20 7b me*]} msg]..if {
2500: 24 6e 61 6d 65 20 65 71 20 22 3a 3a 22 7d 20 7b $name eq "::"} {
2510: 0a 09 20 20 20 20 73 65 74 20 6e 61 6d 65 20 22 .. set name "
2520: 22 0a 09 7d 0a 09 69 66 20 7b 24 72 65 74 20 21 "..}..if {$ret !
2530: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 64 69 63 74 = 0} {.. dict
2540: 20 61 70 70 65 6e 64 20 6f 70 74 73 20 2d 65 72 append opts -er
2550: 72 6f 72 69 6e 66 6f 20 5c 0a 09 09 20 20 20 20 rorinfo \...
2560: 22 5c 6e 20 20 20 20 28 65 78 70 61 6e 64 69 6e "\n (expandin
2570: 67 20 63 6f 6d 6d 61 6e 64 20 70 72 65 66 69 78 g command prefix
2580: 20 5c 22 24 6e 61 6d 65 5c 22 20 69 6e 20 75 6e \"$name\" in un
2590: 6b 6e 6f 77 6e 29 22 0a 09 20 20 20 20 72 65 74 known)".. ret
25a0: 75 72 6e 20 2d 6f 70 74 69 6f 6e 73 20 24 6f 70 urn -options $op
25b0: 74 73 20 24 6d 73 67 0a 09 7d 0a 09 23 20 46 69 ts $msg..}..# Fi
25c0: 6c 74 65 72 20 6f 75 74 20 62 6f 67 75 73 20 6d lter out bogus m
25d0: 61 74 63 68 65 73 20 77 68 65 6e 20 24 6e 61 6d atches when $nam
25e0: 65 20 63 6f 6e 74 61 69 6e 65 64 0a 09 23 20 61 e contained..# a
25f0: 20 67 6c 6f 62 2d 73 70 65 63 69 61 6c 20 63 68 glob-special ch
2600: 61 72 20 5b 42 75 67 20 39 34 36 39 35 32 5d 0a ar [Bug 946952].
2610: 09 69 66 20 7b 24 6e 61 6d 65 20 65 71 20 22 22 .if {$name eq ""
2620: 7d 20 7b 0a 09 20 20 20 20 23 20 48 61 6e 64 6c } {.. # Handl
2630: 65 20 65 6d 70 74 79 20 24 6e 61 6d 65 20 73 65 e empty $name se
2640: 70 61 72 61 74 65 6c 79 20 64 75 65 20 74 6f 20 parately due to
2650: 73 74 72 61 6e 67 65 6e 65 73 73 0a 09 20 20 20 strangeness..
2660: 20 23 20 69 6e 20 5b 73 74 72 69 6e 67 20 66 69 # in [string fi
2670: 72 73 74 5d 20 28 53 65 65 20 52 46 45 20 31 32 rst] (See RFE 12
2680: 34 33 33 35 34 29 0a 09 20 20 20 20 73 65 74 20 43354).. set
2690: 63 6d 64 73 20 24 63 61 6e 64 69 64 61 74 65 73 cmds $candidates
26a0: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
26b0: 73 65 74 20 63 6d 64 73 20 5b 6c 69 73 74 5d 0a set cmds [list].
26c0: 09 20 20 20 20 66 6f 72 65 61 63 68 20 78 20 24 . foreach x $
26d0: 63 61 6e 64 69 64 61 74 65 73 20 7b 0a 09 09 69 candidates {...i
26e0: 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 74 f {[string first
26f0: 20 24 6e 61 6d 65 20 24 78 5d 20 3d 3d 20 30 7d $name $x] == 0}
2700: 20 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e 64 {... lappend
2710: 20 63 6d 64 73 20 24 78 0a 09 09 7d 0a 09 20 20 cmds $x...}..
2720: 20 20 7d 0a 09 7d 0a 09 69 66 20 7b 5b 6c 6c 65 }..}..if {[lle
2730: 6e 67 74 68 20 24 63 6d 64 73 5d 20 3d 3d 20 31 ngth $cmds] == 1
2740: 7d 20 7b 0a 09 20 20 20 20 75 70 6c 65 76 65 6c } {.. uplevel
2750: 20 31 20 5b 6c 69 73 74 20 3a 3a 63 61 74 63 68 1 [list ::catch
2760: 20 5b 6c 72 65 70 6c 61 63 65 20 24 61 72 67 73 [lreplace $args
2770: 20 30 20 30 20 5b 6c 69 6e 64 65 78 20 24 63 6d 0 0 [lindex $cm
2780: 64 73 20 30 5d 5d 20 5c 0a 09 09 20 20 20 20 3a ds 0]] \... :
2790: 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 52 65 73 :tcl::UnknownRes
27a0: 75 6c 74 20 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f ult ::tcl::Unkno
27b0: 77 6e 4f 70 74 69 6f 6e 73 5d 0a 09 20 20 20 20 wnOptions]..
27c0: 64 69 63 74 20 69 6e 63 72 20 3a 3a 74 63 6c 3a dict incr ::tcl:
27d0: 3a 55 6e 6b 6e 6f 77 6e 4f 70 74 69 6f 6e 73 20 :UnknownOptions
27e0: 2d 6c 65 76 65 6c 0a 09 20 20 20 20 72 65 74 75 -level.. retu
27f0: 72 6e 20 2d 6f 70 74 69 6f 6e 73 20 24 3a 3a 74 rn -options $::t
2800: 63 6c 3a 3a 55 6e 6b 6e 6f 77 6e 4f 70 74 69 6f cl::UnknownOptio
2810: 6e 73 20 24 3a 3a 74 63 6c 3a 3a 55 6e 6b 6e 6f ns $::tcl::Unkno
2820: 77 6e 52 65 73 75 6c 74 0a 09 7d 0a 09 69 66 20 wnResult..}..if
2830: 7b 5b 6c 6c 65 6e 67 74 68 20 24 63 6d 64 73 5d {[llength $cmds]
2840: 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 } {.. return
2850: 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 61 6d 62 -code error "amb
2860: 69 67 75 6f 75 73 20 63 6f 6d 6d 61 6e 64 20 6e iguous command n
2870: 61 6d 65 20 5c 22 24 6e 61 6d 65 5c 22 3a 20 5b ame \"$name\": [
2880: 6c 73 6f 72 74 20 24 63 6d 64 73 5d 22 0a 09 7d lsort $cmds]"..}
2890: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 . }. retur
28a0: 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 2d 65 n -code error -e
28b0: 72 72 6f 72 63 6f 64 65 20 5b 6c 69 73 74 20 54 rrorcode [list T
28c0: 43 4c 20 4c 4f 4f 4b 55 50 20 43 4f 4d 4d 41 4e CL LOOKUP COMMAN
28d0: 44 20 24 6e 61 6d 65 5d 20 5c 0a 09 22 69 6e 76 D $name] \.."inv
28e0: 61 6c 69 64 20 63 6f 6d 6d 61 6e 64 20 6e 61 6d alid command nam
28f0: 65 20 5c 22 24 6e 61 6d 65 5c 22 22 0a 7d 0a 0a e \"$name\"".}..
2900: 23 20 61 75 74 6f 5f 6c 6f 61 64 20 2d 2d 0a 23 # auto_load --.#
2910: 20 43 68 65 63 6b 73 20 61 20 63 6f 6c 6c 65 63 Checks a collec
2920: 74 69 6f 6e 20 6f 66 20 6c 69 62 72 61 72 79 20 tion of library
2930: 64 69 72 65 63 74 6f 72 69 65 73 20 74 6f 20 73 directories to s
2940: 65 65 20 69 66 20 61 20 70 72 6f 63 65 64 75 72 ee if a procedur
2950: 65 0a 23 20 69 73 20 64 65 66 69 6e 65 64 20 69 e.# is defined i
2960: 6e 20 6f 6e 65 20 6f 66 20 74 68 65 6d 2e 20 20 n one of them.
2970: 49 66 20 73 6f 2c 20 69 74 20 73 6f 75 72 63 65 If so, it source
2980: 73 20 74 68 65 20 61 70 70 72 6f 70 72 69 61 74 s the appropriat
2990: 65 0a 23 20 6c 69 62 72 61 72 79 20 66 69 6c 65 e.# library file
29a0: 20 74 6f 20 63 72 65 61 74 65 20 74 68 65 20 70 to create the p
29b0: 72 6f 63 65 64 75 72 65 2e 20 20 52 65 74 75 72 rocedure. Retur
29c0: 6e 73 20 31 20 69 66 20 69 74 20 73 75 63 63 65 ns 1 if it succe
29d0: 73 73 66 75 6c 6c 79 0a 23 20 6c 6f 61 64 65 64 ssfully.# loaded
29e0: 20 74 68 65 20 70 72 6f 63 65 64 75 72 65 2c 20 the procedure,
29f0: 30 20 6f 74 68 65 72 77 69 73 65 2e 0a 23 0a 23 0 otherwise..#.#
2a00: 20 41 72 67 75 6d 65 6e 74 73 3a 0a 23 20 63 6d Arguments:.# cm
2a10: 64 20 2d 09 09 09 4e 61 6d 65 20 6f 66 20 74 68 d -...Name of th
2a20: 65 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 66 69 6e e command to fin
2a30: 64 20 61 6e 64 20 6c 6f 61 64 2e 0a 23 20 6e 61 d and load..# na
2a40: 6d 65 73 70 61 63 65 20 28 6f 70 74 69 6f 6e 61 mespace (optiona
2a50: 6c 29 20 20 54 68 65 20 6e 61 6d 65 73 70 61 63 l) The namespac
2a60: 65 20 77 68 65 72 65 20 74 68 65 20 63 6f 6d 6d e where the comm
2a70: 61 6e 64 20 69 73 20 62 65 69 6e 67 20 75 73 65 and is being use
2a80: 64 20 2d 20 6d 75 73 74 20 62 65 0a 23 20 20 20 d - must be.#
2a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2aa0: 20 20 20 20 61 20 63 61 6e 6f 6e 69 63 61 6c 20 a canonical
2ab0: 6e 61 6d 65 73 70 61 63 65 20 61 73 20 72 65 74 namespace as ret
2ac0: 75 72 6e 65 64 20 5b 6e 61 6d 65 73 70 61 63 65 urned [namespace
2ad0: 20 63 75 72 72 65 6e 74 5d 0a 23 20 20 20 20 20 current].#
2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2af0: 20 20 66 6f 72 20 69 6e 73 74 61 6e 63 65 2e 20 for instance.
2b00: 49 66 20 6e 6f 74 20 67 69 76 65 6e 2c 20 6e 61 If not given, na
2b10: 6d 65 73 70 61 63 65 20 63 75 72 72 65 6e 74 20 mespace current
2b20: 69 73 20 75 73 65 64 2e 0a 0a 70 72 6f 63 20 61 is used...proc a
2b30: 75 74 6f 5f 6c 6f 61 64 20 7b 63 6d 64 20 7b 6e uto_load {cmd {n
2b40: 61 6d 65 73 70 61 63 65 20 7b 7d 7d 7d 20 7b 0a amespace {}}} {.
2b50: 20 20 20 20 67 6c 6f 62 61 6c 20 61 75 74 6f 5f global auto_
2b60: 69 6e 64 65 78 20 61 75 74 6f 5f 70 61 74 68 0a index auto_path.
2b70: 0a 20 20 20 20 69 66 20 7b 24 6e 61 6d 65 73 70 . if {$namesp
2b80: 61 63 65 20 65 71 20 22 22 7d 20 7b 0a 09 73 65 ace eq ""} {..se
2b90: 74 20 6e 61 6d 65 73 70 61 63 65 20 5b 75 70 6c t namespace [upl
2ba0: 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 3a 3a 6e evel 1 [list ::n
2bb0: 61 6d 65 73 70 61 63 65 20 63 75 72 72 65 6e 74 amespace current
2bc0: 5d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ]]. }. set
2bd0: 20 6e 61 6d 65 4c 69 73 74 20 5b 61 75 74 6f 5f nameList [auto_
2be0: 71 75 61 6c 69 66 79 20 24 63 6d 64 20 24 6e 61 qualify $cmd $na
2bf0: 6d 65 73 70 61 63 65 5d 0a 20 20 20 20 23 20 77 mespace]. # w
2c00: 6f 72 6b 61 72 6f 75 6e 64 20 6e 6f 6e 20 63 61 orkaround non ca
2c10: 6e 6f 6e 69 63 61 6c 20 61 75 74 6f 5f 69 6e 64 nonical auto_ind
2c20: 65 78 20 65 6e 74 72 69 65 73 20 74 68 61 74 20 ex entries that
2c30: 6d 69 67 68 74 20 62 65 20 61 72 6f 75 6e 64 0a might be around.
2c40: 20 20 20 20 23 20 66 72 6f 6d 20 6f 6c 64 65 72 # from older
2c50: 20 61 75 74 6f 5f 6d 6b 69 6e 64 65 78 20 76 65 auto_mkindex ve
2c60: 72 73 69 6f 6e 73 0a 20 20 20 20 6c 61 70 70 65 rsions. lappe
2c70: 6e 64 20 6e 61 6d 65 4c 69 73 74 20 24 63 6d 64 nd nameList $cmd
2c80: 0a 20 20 20 20 66 6f 72 65 61 63 68 20 6e 61 6d . foreach nam
2c90: 65 20 24 6e 61 6d 65 4c 69 73 74 20 7b 0a 09 69 e $nameList {..i
2ca0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
2cb0: 61 75 74 6f 5f 69 6e 64 65 78 28 24 6e 61 6d 65 auto_index($name
2cc0: 29 5d 7d 20 7b 0a 09 20 20 20 20 6e 61 6d 65 73 )]} {.. names
2cd0: 70 61 63 65 20 65 76 61 6c 20 3a 3a 20 24 61 75 pace eval :: $au
2ce0: 74 6f 5f 69 6e 64 65 78 28 24 6e 61 6d 65 29 0a to_index($name).
2cf0: 09 20 20 20 20 23 20 54 68 65 72 65 27 73 20 61 . # There's a
2d00: 20 63 6f 75 70 6c 65 20 6f 66 20 77 61 79 73 20 couple of ways
2d10: 74 6f 20 6c 6f 6f 6b 20 66 6f 72 20 61 20 63 6f to look for a co
2d20: 6d 6d 61 6e 64 20 6f 66 20 61 20 67 69 76 65 6e mmand of a given
2d30: 0a 09 20 20 20 20 23 20 6e 61 6d 65 2e 20 20 4f .. # name. O
2d40: 6e 65 20 69 73 20 74 6f 20 75 73 65 0a 09 20 20 ne is to use..
2d50: 20 20 23 20 20 20 20 69 6e 66 6f 20 63 6f 6d 6d # info comm
2d60: 61 6e 64 73 20 24 6e 61 6d 65 0a 09 20 20 20 20 ands $name..
2d70: 23 20 55 6e 66 6f 72 74 75 6e 61 74 65 6c 79 2c # Unfortunately,
2d80: 20 69 66 20 74 68 65 20 6e 61 6d 65 20 68 61 73 if the name has
2d90: 20 67 6c 6f 62 2d 6d 61 67 69 63 20 63 68 61 72 glob-magic char
2da0: 73 20 69 6e 20 69 74 20 6c 69 6b 65 20 2a 0a 09 s in it like *..
2db0: 20 20 20 20 23 20 6f 72 20 5b 5d 2c 20 69 74 20 # or [], it
2dc0: 6d 61 79 20 6e 6f 74 20 6d 61 74 63 68 2e 20 20 may not match.
2dd0: 46 6f 72 20 6f 75 72 20 70 75 72 70 6f 73 65 73 For our purposes
2de0: 20 68 65 72 65 2c 20 61 20 62 65 74 74 65 72 0a here, a better.
2df0: 09 20 20 20 20 23 20 72 6f 75 74 65 20 69 73 20 . # route is
2e00: 74 6f 20 75 73 65 0a 09 20 20 20 20 23 20 20 20 to use.. #
2e10: 20 6e 61 6d 65 73 70 61 63 65 20 77 68 69 63 68 namespace which
2e20: 20 2d 63 6f 6d 6d 61 6e 64 20 24 6e 61 6d 65 0a -command $name.
2e30: 09 20 20 20 20 69 66 20 7b 5b 6e 61 6d 65 73 70 . if {[namesp
2e40: 61 63 65 20 77 68 69 63 68 20 2d 63 6f 6d 6d 61 ace which -comma
2e50: 6e 64 20 24 6e 61 6d 65 5d 20 6e 65 20 22 22 7d nd $name] ne ""}
2e60: 20 7b 0a 09 09 72 65 74 75 72 6e 20 31 0a 09 20 {...return 1..
2e70: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
2e80: 20 20 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 if {![info exi
2e90: 73 74 73 20 61 75 74 6f 5f 70 61 74 68 5d 7d 20 sts auto_path]}
2ea0: 7b 0a 09 72 65 74 75 72 6e 20 30 0a 20 20 20 20 {..return 0.
2eb0: 7d 0a 0a 20 20 20 20 69 66 20 7b 21 5b 61 75 74 }.. if {![aut
2ec0: 6f 5f 6c 6f 61 64 5f 69 6e 64 65 78 5d 7d 20 7b o_load_index]} {
2ed0: 0a 09 72 65 74 75 72 6e 20 30 0a 20 20 20 20 7d ..return 0. }
2ee0: 0a 20 20 20 20 66 6f 72 65 61 63 68 20 6e 61 6d . foreach nam
2ef0: 65 20 24 6e 61 6d 65 4c 69 73 74 20 7b 0a 09 69 e $nameList {..i
2f00: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
2f10: 61 75 74 6f 5f 69 6e 64 65 78 28 24 6e 61 6d 65 auto_index($name
2f20: 29 5d 7d 20 7b 0a 09 20 20 20 20 6e 61 6d 65 73 )]} {.. names
2f30: 70 61 63 65 20 65 76 61 6c 20 3a 3a 20 24 61 75 pace eval :: $au
2f40: 74 6f 5f 69 6e 64 65 78 28 24 6e 61 6d 65 29 0a to_index($name).
2f50: 09 20 20 20 20 69 66 20 7b 5b 6e 61 6d 65 73 70 . if {[namesp
2f60: 61 63 65 20 77 68 69 63 68 20 2d 63 6f 6d 6d 61 ace which -comma
2f70: 6e 64 20 24 6e 61 6d 65 5d 20 6e 65 20 22 22 7d nd $name] ne ""}
2f80: 20 7b 0a 09 09 72 65 74 75 72 6e 20 31 0a 09 20 {...return 1..
2f90: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
2fa0: 20 20 72 65 74 75 72 6e 20 30 0a 7d 0a 0a 23 20 return 0.}..#
2fb0: 3a 3a 74 63 6c 3a 3a 50 6b 67 3a 3a 73 6f 75 72 ::tcl::Pkg::sour
2fc0: 63 65 20 2d 2d 0a 23 20 54 68 69 73 20 70 72 6f ce --.# This pro
2fd0: 63 65 64 75 72 65 20 70 72 6f 76 69 64 65 73 20 cedure provides
2fe0: 61 6e 20 61 6c 74 65 72 6e 61 74 69 76 65 20 22 an alternative "
2ff0: 73 6f 75 72 63 65 22 20 63 6f 6d 6d 61 6e 64 2c source" command,
3000: 20 77 68 69 63 68 20 64 6f 65 73 6e 27 74 0a 23 which doesn't.#
3010: 20 72 65 67 69 73 74 65 72 20 74 68 65 20 66 69 register the fi
3020: 6c 65 20 66 6f 72 20 74 68 65 20 22 70 61 63 6b le for the "pack
3030: 61 67 65 20 66 69 6c 65 73 22 20 63 6f 6d 6d 61 age files" comma
3040: 6e 64 2e 20 53 61 66 65 20 69 6e 74 65 72 70 72 nd. Safe interpr
3050: 65 74 65 72 73 0a 23 20 64 6f 6e 27 74 20 68 61 eters.# don't ha
3060: 76 65 20 74 6f 20 64 6f 20 61 6e 79 74 68 69 6e ve to do anythin
3070: 67 20 73 70 65 63 69 61 6c 2e 0a 23 0a 23 20 41 g special..#.# A
3080: 72 67 75 6d 65 6e 74 73 3a 0a 23 20 66 69 6c 65 rguments:.# file
3090: 6e 61 6d 65 0a 0a 70 72 6f 63 20 3a 3a 74 63 6c name..proc ::tcl
30a0: 3a 3a 50 6b 67 3a 3a 73 6f 75 72 63 65 20 7b 66 ::Pkg::source {f
30b0: 69 6c 65 6e 61 6d 65 7d 20 7b 0a 20 20 20 20 69 ilename} {. i
30c0: 66 20 7b 5b 69 6e 74 65 72 70 20 69 73 73 61 66 f {[interp issaf
30d0: 65 5d 7d 20 7b 0a 09 75 70 6c 65 76 65 6c 20 31 e]} {..uplevel 1
30e0: 20 5b 6c 69 73 74 20 3a 3a 73 6f 75 72 63 65 20 [list ::source
30f0: 24 66 69 6c 65 6e 61 6d 65 5d 0a 20 20 20 20 7d $filename]. }
3100: 20 65 6c 73 65 20 7b 0a 09 75 70 6c 65 76 65 6c else {..uplevel
3110: 20 31 20 5b 6c 69 73 74 20 3a 3a 73 6f 75 72 63 1 [list ::sourc
3120: 65 20 2d 6e 6f 70 6b 67 20 24 66 69 6c 65 6e 61 e -nopkg $filena
3130: 6d 65 5d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 61 me]. }.}..# a
3140: 75 74 6f 5f 6c 6f 61 64 5f 69 6e 64 65 78 20 2d uto_load_index -
3150: 2d 0a 23 20 4c 6f 61 64 73 20 74 68 65 20 63 6f -.# Loads the co
3160: 6e 74 65 6e 74 73 20 6f 66 20 74 63 6c 49 6e 64 ntents of tclInd
3170: 65 78 20 66 69 6c 65 73 20 6f 6e 20 74 68 65 20 ex files on the
3180: 61 75 74 6f 5f 70 61 74 68 20 64 69 72 65 63 74 auto_path direct
3190: 6f 72 79 0a 23 20 6c 69 73 74 2e 20 20 54 68 69 ory.# list. Thi
31a0: 73 20 69 73 20 75 73 75 61 6c 6c 79 20 69 6e 76 s is usually inv
31b0: 6f 6b 65 64 20 77 69 74 68 69 6e 20 61 75 74 6f oked within auto
31c0: 5f 6c 6f 61 64 20 74 6f 20 6c 6f 61 64 20 74 68 _load to load th
31d0: 65 20 69 6e 64 65 78 0a 23 20 6f 66 20 61 76 61 e index.# of ava
31e0: 69 6c 61 62 6c 65 20 63 6f 6d 6d 61 6e 64 73 2e ilable commands.
31f0: 20 20 52 65 74 75 72 6e 73 20 31 20 69 66 20 74 Returns 1 if t
3200: 68 65 20 69 6e 64 65 78 20 69 73 20 6c 6f 61 64 he index is load
3210: 65 64 2c 20 61 6e 64 20 30 20 69 66 0a 23 20 74 ed, and 0 if.# t
3220: 68 65 20 69 6e 64 65 78 20 69 73 20 61 6c 72 65 he index is alre
3230: 61 64 79 20 6c 6f 61 64 65 64 20 61 6e 64 20 75 ady loaded and u
3240: 70 20 74 6f 20 64 61 74 65 2e 0a 23 0a 23 20 41 p to date..#.# A
3250: 72 67 75 6d 65 6e 74 73 3a 0a 23 20 4e 6f 6e 65 rguments:.# None
3260: 2e 0a 0a 70 72 6f 63 20 61 75 74 6f 5f 6c 6f 61 ...proc auto_loa
3270: 64 5f 69 6e 64 65 78 20 7b 7d 20 7b 0a 20 20 20 d_index {} {.
3280: 20 76 61 72 69 61 62 6c 65 20 3a 3a 74 63 6c 3a variable ::tcl:
3290: 3a 61 75 74 6f 5f 6f 6c 64 70 61 74 68 0a 20 20 :auto_oldpath.
32a0: 20 20 67 6c 6f 62 61 6c 20 61 75 74 6f 5f 69 6e global auto_in
32b0: 64 65 78 20 61 75 74 6f 5f 70 61 74 68 0a 0a 20 dex auto_path..
32c0: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
32d0: 73 74 73 20 61 75 74 6f 5f 6f 6c 64 70 61 74 68 sts auto_oldpath
32e0: 5d 20 26 26 20 28 24 61 75 74 6f 5f 6f 6c 64 70 ] && ($auto_oldp
32f0: 61 74 68 20 65 71 20 24 61 75 74 6f 5f 70 61 74 ath eq $auto_pat
3300: 68 29 7d 20 7b 0a 09 72 65 74 75 72 6e 20 30 0a h)} {..return 0.
3310: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 61 75 }. set au
3320: 74 6f 5f 6f 6c 64 70 61 74 68 20 24 61 75 74 6f to_oldpath $auto
3330: 5f 70 61 74 68 0a 0a 20 20 20 20 23 20 43 68 65 _path.. # Che
3340: 63 6b 20 69 66 20 77 65 20 61 72 65 20 61 20 73 ck if we are a s
3350: 61 66 65 20 69 6e 74 65 72 70 72 65 74 65 72 2e afe interpreter.
3360: 20 49 6e 20 74 68 61 74 20 63 61 73 65 2c 20 77 In that case, w
3370: 65 20 73 75 70 70 6f 72 74 20 6f 6e 6c 79 0a 20 e support only.
3380: 20 20 20 23 20 6e 65 77 65 72 20 66 6f 72 6d 61 # newer forma
3390: 74 20 74 63 6c 49 6e 64 65 78 20 66 69 6c 65 73 t tclIndex files
33a0: 2e 0a 0a 20 20 20 20 73 65 74 20 69 73 73 61 66 ... set issaf
33b0: 65 20 5b 69 6e 74 65 72 70 20 69 73 73 61 66 65 e [interp issafe
33c0: 5d 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 ]. for {set i
33d0: 20 5b 65 78 70 72 20 7b 5b 6c 6c 65 6e 67 74 68 [expr {[llength
33e0: 20 24 61 75 74 6f 5f 70 61 74 68 5d 20 2d 20 31 $auto_path] - 1
33f0: 7d 5d 7d 20 7b 24 69 20 3e 3d 20 30 7d 20 7b 69 }]} {$i >= 0} {i
3400: 6e 63 72 20 69 20 2d 31 7d 20 7b 0a 09 73 65 74 ncr i -1} {..set
3410: 20 64 69 72 20 5b 6c 69 6e 64 65 78 20 24 61 75 dir [lindex $au
3420: 74 6f 5f 70 61 74 68 20 24 69 5d 0a 09 73 65 74 to_path $i]..set
3430: 20 66 20 22 22 0a 09 69 66 20 7b 24 69 73 73 61 f ""..if {$issa
3440: 66 65 7d 20 7b 0a 09 20 20 20 20 63 61 74 63 68 fe} {.. catch
3450: 20 7b 73 6f 75 72 63 65 20 5b 66 69 6c 65 20 6a {source [file j
3460: 6f 69 6e 20 24 64 69 72 20 74 63 6c 49 6e 64 65 oin $dir tclInde
3470: 78 5d 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b x]}..} elseif {[
3480: 63 61 74 63 68 20 7b 73 65 74 20 66 20 5b 6f 70 catch {set f [op
3490: 65 6e 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 en [file join $d
34a0: 69 72 20 74 63 6c 49 6e 64 65 78 5d 5d 7d 5d 7d ir tclIndex]]}]}
34b0: 20 7b 0a 09 20 20 20 20 63 6f 6e 74 69 6e 75 65 {.. continue
34c0: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
34d0: 73 65 74 20 65 72 72 6f 72 20 5b 63 61 74 63 68 set error [catch
34e0: 20 7b 0a 09 09 66 63 6f 6e 66 69 67 75 72 65 20 {...fconfigure
34f0: 24 66 20 2d 65 6e 63 6f 64 69 6e 67 20 75 74 66 $f -encoding utf
3500: 2d 38 20 2d 65 6f 66 63 68 61 72 20 22 5c 30 33 -8 -eofchar "\03
3510: 32 20 7b 7d 22 0a 09 09 73 65 74 20 69 64 20 5b 2 {}"...set id [
3520: 67 65 74 73 20 24 66 5d 0a 09 09 69 66 20 7b 24 gets $f]...if {$
3530: 69 64 20 65 71 20 22 23 20 54 63 6c 20 61 75 74 id eq "# Tcl aut
3540: 6f 6c 6f 61 64 20 69 6e 64 65 78 20 66 69 6c 65 oload index file
3550: 2c 20 76 65 72 73 69 6f 6e 20 32 2e 30 22 7d 20 , version 2.0"}
3560: 7b 0a 09 09 20 20 20 20 65 76 61 6c 20 5b 72 65 {... eval [re
3570: 61 64 20 24 66 5d 0a 09 09 7d 20 65 6c 73 65 69 ad $f]...} elsei
3580: 66 20 7b 24 69 64 20 65 71 20 22 23 20 54 63 6c f {$id eq "# Tcl
3590: 20 61 75 74 6f 6c 6f 61 64 20 69 6e 64 65 78 20 autoload index
35a0: 66 69 6c 65 3a 20 65 61 63 68 20 6c 69 6e 65 20 file: each line
35b0: 69 64 65 6e 74 69 66 69 65 73 20 61 20 54 63 6c identifies a Tcl
35c0: 22 7d 20 7b 0a 09 09 20 20 20 20 77 68 69 6c 65 "} {... while
35d0: 20 7b 5b 67 65 74 73 20 24 66 20 6c 69 6e 65 5d {[gets $f line]
35e0: 20 3e 3d 20 30 7d 20 7b 0a 09 09 09 69 66 20 7b >= 0} {....if {
35f0: 28 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24 ([string index $
3600: 6c 69 6e 65 20 30 5d 20 65 71 20 22 23 22 29 20 line 0] eq "#")
3610: 5c 0a 09 09 09 09 7c 7c 20 28 5b 6c 6c 65 6e 67 \.....|| ([lleng
3620: 74 68 20 24 6c 69 6e 65 5d 20 21 3d 20 32 29 7d th $line] != 2)}
3630: 20 7b 0a 09 09 09 20 20 20 20 63 6f 6e 74 69 6e {.... contin
3640: 75 65 0a 09 09 09 7d 0a 09 09 09 73 65 74 20 6e ue....}....set n
3650: 61 6d 65 20 5b 6c 69 6e 64 65 78 20 24 6c 69 6e ame [lindex $lin
3660: 65 20 30 5d 0a 09 09 09 73 65 74 20 61 75 74 6f e 0]....set auto
3670: 5f 69 6e 64 65 78 28 24 6e 61 6d 65 29 20 5c 0a _index($name) \.
3680: 09 09 09 09 22 3a 3a 74 63 6c 3a 3a 50 6b 67 3a ...."::tcl::Pkg:
3690: 3a 73 6f 75 72 63 65 20 5b 66 69 6c 65 20 6a 6f :source [file jo
36a0: 69 6e 20 24 64 69 72 20 5b 6c 69 6e 64 65 78 20 in $dir [lindex
36b0: 24 6c 69 6e 65 20 31 5d 5d 22 0a 09 09 20 20 20 $line 1]]"...
36c0: 20 7d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 }...} else {...
36d0: 20 20 20 20 65 72 72 6f 72 20 22 5b 66 69 6c 65 error "[file
36e0: 20 6a 6f 69 6e 20 24 64 69 72 20 74 63 6c 49 6e join $dir tclIn
36f0: 64 65 78 5d 20 69 73 6e 27 74 20 61 20 70 72 6f dex] isn't a pro
3700: 70 65 72 20 54 63 6c 20 69 6e 64 65 78 20 66 69 per Tcl index fi
3710: 6c 65 22 0a 09 09 7d 0a 09 20 20 20 20 7d 20 6d le"...}.. } m
3720: 73 67 20 6f 70 74 73 5d 0a 09 20 20 20 20 69 66 sg opts].. if
3730: 20 7b 24 66 20 6e 65 20 22 22 7d 20 7b 0a 09 09 {$f ne ""} {...
3740: 63 6c 6f 73 65 20 24 66 0a 09 20 20 20 20 7d 0a close $f.. }.
3750: 09 20 20 20 20 69 66 20 7b 24 65 72 72 6f 72 7d . if {$error}
3760: 20 7b 0a 09 09 72 65 74 75 72 6e 20 2d 6f 70 74 {...return -opt
3770: 69 6f 6e 73 20 24 6f 70 74 73 20 24 6d 73 67 0a ions $opts $msg.
3780: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
3790: 20 20 20 20 72 65 74 75 72 6e 20 31 0a 7d 0a 0a return 1.}..
37a0: 23 20 61 75 74 6f 5f 71 75 61 6c 69 66 79 20 2d # auto_qualify -
37b0: 2d 0a 23 0a 23 20 43 6f 6d 70 75 74 65 20 61 20 -.#.# Compute a
37c0: 66 75 6c 6c 79 20 71 75 61 6c 69 66 69 65 64 20 fully qualified
37d0: 6e 61 6d 65 73 20 6c 69 73 74 20 66 6f 72 20 75 names list for u
37e0: 73 65 20 69 6e 20 74 68 65 20 61 75 74 6f 5f 69 se in the auto_i
37f0: 6e 64 65 78 20 61 72 72 61 79 2e 0a 23 20 46 6f ndex array..# Fo
3800: 72 20 68 69 73 74 6f 72 69 63 61 6c 20 72 65 61 r historical rea
3810: 73 6f 6e 73 2c 20 63 6f 6d 6d 61 6e 64 73 20 69 sons, commands i
3820: 6e 20 74 68 65 20 67 6c 6f 62 61 6c 20 6e 61 6d n the global nam
3830: 65 73 70 61 63 65 20 64 6f 20 6e 6f 74 20 68 61 espace do not ha
3840: 76 65 20 6c 65 61 64 69 6e 67 0a 23 20 3a 3a 20 ve leading.# ::
3850: 69 6e 20 74 68 65 20 69 6e 64 65 78 20 6b 65 79 in the index key
3860: 2e 20 54 68 65 20 6c 69 73 74 20 68 61 73 20 74 . The list has t
3870: 77 6f 20 65 6c 65 6d 65 6e 74 73 20 77 68 65 6e wo elements when
3880: 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6e 61 6d the command nam
3890: 65 20 69 73 0a 23 20 72 65 6c 61 74 69 76 65 20 e is.# relative
38a0: 28 6e 6f 20 6c 65 61 64 69 6e 67 20 3a 3a 29 20 (no leading ::)
38b0: 61 6e 64 20 74 68 65 20 6e 61 6d 65 73 70 61 63 and the namespac
38c0: 65 20 69 73 20 6e 6f 74 20 74 68 65 20 67 6c 6f e is not the glo
38d0: 62 61 6c 20 6f 6e 65 2e 20 4f 74 68 65 72 77 69 bal one. Otherwi
38e0: 73 65 0a 23 20 6f 6e 6c 79 20 6f 6e 65 20 6e 61 se.# only one na
38f0: 6d 65 20 69 73 20 72 65 74 75 72 6e 65 64 20 28 me is returned (
3900: 61 6e 64 20 73 65 61 72 63 68 65 64 20 69 6e 20 and searched in
3910: 74 68 65 20 61 75 74 6f 5f 69 6e 64 65 78 29 2e the auto_index).
3920: 0a 23 0a 23 20 41 72 67 75 6d 65 6e 74 73 20 2d .#.# Arguments -
3930: 0a 23 20 63 6d 64 09 09 54 68 65 20 63 6f 6d 6d .# cmd..The comm
3940: 61 6e 64 20 6e 61 6d 65 2e 20 43 61 6e 20 62 65 and name. Can be
3950: 20 61 6e 79 20 6e 61 6d 65 20 61 63 63 65 70 74 any name accept
3960: 65 64 20 66 6f 72 20 63 6f 6d 6d 61 6e 64 0a 23 ed for command.#
3970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
3980: 6e 76 6f 63 61 74 69 6f 6e 73 20 28 4c 69 6b 65 nvocations (Like
3990: 20 22 66 6f 6f 3a 3a 3a 3a 62 61 72 22 29 2e 0a "foo::::bar")..
39a0: 23 20 6e 61 6d 65 73 70 61 63 65 09 54 68 65 20 # namespace.The
39b0: 6e 61 6d 65 73 70 61 63 65 20 77 68 65 72 65 20 namespace where
39c0: 74 68 65 20 63 6f 6d 6d 61 6e 64 20 69 73 20 62 the command is b
39d0: 65 69 6e 67 20 75 73 65 64 20 2d 20 6d 75 73 74 eing used - must
39e0: 20 62 65 0a 23 20 20 20 20 20 20 20 20 20 20 20 be.#
39f0: 20 20 20 20 61 20 63 61 6e 6f 6e 69 63 61 6c 20 a canonical
3a00: 6e 61 6d 65 73 70 61 63 65 20 61 73 20 72 65 74 namespace as ret
3a10: 75 72 6e 65 64 20 62 79 20 5b 6e 61 6d 65 73 70 urned by [namesp
3a20: 61 63 65 20 63 75 72 72 65 6e 74 5d 0a 23 20 20 ace current].#
3a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 6f 72 for
3a40: 20 69 6e 73 74 61 6e 63 65 2e 0a 0a 70 72 6f 63 instance...proc
3a50: 20 61 75 74 6f 5f 71 75 61 6c 69 66 79 20 7b 63 auto_qualify {c
3a60: 6d 64 20 6e 61 6d 65 73 70 61 63 65 7d 20 7b 0a md namespace} {.
3a70: 0a 20 20 20 20 23 20 63 6f 75 6e 74 20 73 65 70 . # count sep
3a80: 61 72 61 74 6f 72 73 20 61 6e 64 20 63 6c 65 61 arators and clea
3a90: 6e 20 74 68 65 6d 20 75 70 0a 20 20 20 20 23 20 n them up. #
3aa0: 28 6d 61 6b 69 6e 67 20 73 75 72 65 20 74 68 61 (making sure tha
3ab0: 74 20 66 6f 6f 3a 3a 3a 3a 3a 62 61 72 20 77 69 t foo:::::bar wi
3ac0: 6c 6c 20 62 65 20 74 72 65 61 74 65 64 20 61 73 ll be treated as
3ad0: 20 66 6f 6f 3a 3a 62 61 72 29 0a 20 20 20 20 73 foo::bar). s
3ae0: 65 74 20 6e 20 5b 72 65 67 73 75 62 20 2d 61 6c et n [regsub -al
3af0: 6c 20 7b 3a 3a 2b 7d 20 24 63 6d 64 20 3a 3a 20 l {::+} $cmd ::
3b00: 63 6d 64 5d 0a 0a 20 20 20 20 23 20 49 67 6e 6f cmd].. # Igno
3b10: 72 65 20 6e 61 6d 65 73 70 61 63 65 20 69 66 20 re namespace if
3b20: 74 68 65 20 6e 61 6d 65 20 73 74 61 72 74 73 20 the name starts
3b30: 77 69 74 68 20 3a 3a 0a 20 20 20 20 23 20 48 61 with ::. # Ha
3b40: 6e 64 6c 65 20 73 70 65 63 69 61 6c 20 63 61 73 ndle special cas
3b50: 65 20 6f 66 20 6f 6e 6c 79 20 6c 65 61 64 69 6e e of only leadin
3b60: 67 20 3a 3a 0a 0a 20 20 20 20 23 20 42 65 66 6f g ::.. # Befo
3b70: 72 65 20 65 61 63 68 20 72 65 74 75 72 6e 20 63 re each return c
3b80: 61 73 65 20 77 65 20 67 69 76 65 20 61 6e 20 65 ase we give an e
3b90: 78 61 6d 70 6c 65 20 6f 66 20 77 68 69 63 68 20 xample of which
3ba0: 63 61 74 65 67 6f 72 79 20 69 74 20 69 73 0a 20 category it is.
3bb0: 20 20 20 23 20 77 69 74 68 20 74 68 65 20 66 6f # with the fo
3bc0: 6c 6c 6f 77 69 6e 67 20 66 6f 72 6d 20 3a 0a 20 llowing form :.
3bd0: 20 20 20 23 20 28 69 6e 70 75 74 43 6d 64 2c 20 # (inputCmd,
3be0: 69 6e 70 75 74 4e 61 6d 65 53 70 61 63 65 29 20 inputNameSpace)
3bf0: 2d 3e 20 6f 75 74 70 75 74 0a 0a 20 20 20 20 69 -> output.. i
3c00: 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 f {[string match
3c10: 20 3a 3a 2a 20 24 63 6d 64 5d 7d 20 7b 0a 09 69 ::* $cmd]} {..i
3c20: 66 20 7b 24 6e 20 3e 20 31 7d 20 7b 0a 09 20 20 f {$n > 1} {..
3c30: 20 20 23 20 28 3a 3a 66 6f 6f 3a 3a 62 61 72 20 # (::foo::bar
3c40: 2c 20 2a 29 20 2d 3e 20 3a 3a 66 6f 6f 3a 3a 62 , *) -> ::foo::b
3c50: 61 72 0a 09 20 20 20 20 72 65 74 75 72 6e 20 5b ar.. return [
3c60: 6c 69 73 74 20 24 63 6d 64 5d 0a 09 7d 20 65 6c list $cmd]..} el
3c70: 73 65 20 7b 0a 09 20 20 20 20 23 20 28 3a 3a 67 se {.. # (::g
3c80: 6c 6f 62 61 6c 20 2c 20 2a 29 20 2d 3e 20 67 6c lobal , *) -> gl
3c90: 6f 62 61 6c 0a 09 20 20 20 20 72 65 74 75 72 6e obal.. return
3ca0: 20 5b 6c 69 73 74 20 5b 73 74 72 69 6e 67 20 72 [list [string r
3cb0: 61 6e 67 65 20 24 63 6d 64 20 32 20 65 6e 64 5d ange $cmd 2 end]
3cc0: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 ]..}. }..
3cd0: 23 20 50 6f 74 65 6e 74 69 61 6c 6c 79 20 72 65 # Potentially re
3ce0: 74 75 72 6e 69 6e 67 20 32 20 65 6c 65 6d 65 6e turning 2 elemen
3cf0: 74 73 20 74 6f 20 74 72 79 20 20 3a 0a 20 20 20 ts to try :.
3d00: 20 23 20 28 69 66 20 74 68 65 20 63 75 72 72 65 # (if the curre
3d10: 6e 74 20 6e 61 6d 65 73 70 61 63 65 20 69 73 20 nt namespace is
3d20: 6e 6f 74 20 74 68 65 20 67 6c 6f 62 61 6c 20 6f not the global o
3d30: 6e 65 29 0a 0a 20 20 20 20 69 66 20 7b 24 6e 20 ne).. if {$n
3d40: 3d 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 24 6e 61 == 0} {..if {$na
3d50: 6d 65 73 70 61 63 65 20 65 71 20 22 3a 3a 22 7d mespace eq "::"}
3d60: 20 7b 0a 09 20 20 20 20 23 20 28 6e 6f 63 6f 6c {.. # (nocol
3d70: 6f 6e 73 20 2c 20 3a 3a 29 20 2d 3e 20 6e 6f 63 ons , ::) -> noc
3d80: 6f 6c 6f 6e 73 0a 09 20 20 20 20 72 65 74 75 72 olons.. retur
3d90: 6e 20 5b 6c 69 73 74 20 24 63 6d 64 5d 0a 09 7d n [list $cmd]..}
3da0: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 23 20 28 else {.. # (
3db0: 6e 6f 63 6f 6c 6f 6e 73 20 2c 20 3a 3a 73 75 62 nocolons , ::sub
3dc0: 29 20 2d 3e 20 3a 3a 73 75 62 3a 3a 6e 6f 63 6f ) -> ::sub::noco
3dd0: 6c 6f 6e 73 20 6e 6f 63 6f 6c 6f 6e 73 0a 09 20 lons nocolons..
3de0: 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 return [list
3df0: 24 7b 6e 61 6d 65 73 70 61 63 65 7d 3a 3a 24 63 ${namespace}::$c
3e00: 6d 64 20 24 63 6d 64 5d 0a 09 7d 0a 20 20 20 20 md $cmd]..}.
3e10: 7d 20 65 6c 73 65 69 66 20 7b 24 6e 61 6d 65 73 } elseif {$names
3e20: 70 61 63 65 20 65 71 20 22 3a 3a 22 7d 20 7b 0a pace eq "::"} {.
3e30: 09 23 20 20 28 66 6f 6f 3a 3a 62 61 72 20 2c 20 .# (foo::bar ,
3e40: 3a 3a 29 20 2d 3e 20 3a 3a 66 6f 6f 3a 3a 62 61 ::) -> ::foo::ba
3e50: 72 0a 09 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 r..return [list
3e60: 3a 3a 24 63 6d 64 5d 0a 20 20 20 20 7d 20 65 6c ::$cmd]. } el
3e70: 73 65 20 7b 0a 09 23 20 28 66 6f 6f 3a 3a 62 61 se {..# (foo::ba
3e80: 72 20 2c 20 3a 3a 73 75 62 29 20 2d 3e 20 3a 3a r , ::sub) -> ::
3e90: 73 75 62 3a 3a 66 6f 6f 3a 3a 62 61 72 20 3a 3a sub::foo::bar ::
3ea0: 66 6f 6f 3a 3a 62 61 72 0a 09 72 65 74 75 72 6e foo::bar..return
3eb0: 20 5b 6c 69 73 74 20 24 7b 6e 61 6d 65 73 70 61 [list ${namespa
3ec0: 63 65 7d 3a 3a 24 63 6d 64 20 3a 3a 24 63 6d 64 ce}::$cmd ::$cmd
3ed0: 5d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 61 75 74 ]. }.}..# aut
3ee0: 6f 5f 69 6d 70 6f 72 74 20 2d 2d 0a 23 0a 23 20 o_import --.#.#
3ef0: 49 6e 76 6f 6b 65 64 20 64 75 72 69 6e 67 20 22 Invoked during "
3f00: 6e 61 6d 65 73 70 61 63 65 20 69 6d 70 6f 72 74 namespace import
3f10: 22 20 74 6f 20 6d 61 6b 65 20 73 65 65 20 69 66 " to make see if
3f20: 20 74 68 65 20 69 6d 70 6f 72 74 65 64 20 63 6f the imported co
3f30: 6d 6d 61 6e 64 73 0a 23 20 72 65 73 69 64 65 20 mmands.# reside
3f40: 69 6e 20 61 6e 20 61 75 74 6f 6c 6f 61 64 65 64 in an autoloaded
3f50: 20 6c 69 62 72 61 72 79 2e 20 20 49 66 20 73 6f library. If so
3f60: 2c 20 74 68 65 20 63 6f 6d 6d 61 6e 64 73 20 61 , the commands a
3f70: 72 65 20 6c 6f 61 64 65 64 20 73 6f 0a 23 20 74 re loaded so.# t
3f80: 68 61 74 20 74 68 65 79 20 77 69 6c 6c 20 62 65 hat they will be
3f90: 20 61 76 61 69 6c 61 62 6c 65 20 66 6f 72 20 74 available for t
3fa0: 68 65 20 69 6d 70 6f 72 74 20 6c 69 6e 6b 73 2e he import links.
3fb0: 20 20 49 66 20 6e 6f 74 2c 20 74 68 65 6e 20 74 If not, then t
3fc0: 68 69 73 0a 23 20 70 72 6f 63 65 64 75 72 65 20 his.# procedure
3fd0: 64 6f 65 73 20 6e 6f 74 68 69 6e 67 2e 0a 23 0a does nothing..#.
3fe0: 23 20 41 72 67 75 6d 65 6e 74 73 20 2d 0a 23 20 # Arguments -.#
3ff0: 70 61 74 74 65 72 6e 09 54 68 65 20 70 61 74 74 pattern.The patt
4000: 65 72 6e 20 6f 66 20 63 6f 6d 6d 61 6e 64 73 20 ern of commands
4010: 62 65 69 6e 67 20 69 6d 70 6f 72 74 65 64 20 28 being imported (
4020: 6c 69 6b 65 20 22 66 6f 6f 3a 3a 2a 22 29 0a 23 like "foo::*").#
4030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
4040: 20 63 61 6e 6f 6e 69 63 61 6c 20 6e 61 6d 65 73 canonical names
4050: 70 61 63 65 20 61 73 20 72 65 74 75 72 6e 65 64 pace as returned
4060: 20 62 79 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 by [namespace c
4070: 75 72 72 65 6e 74 5d 0a 0a 70 72 6f 63 20 61 75 urrent]..proc au
4080: 74 6f 5f 69 6d 70 6f 72 74 20 7b 70 61 74 74 65 to_import {patte
4090: 72 6e 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c rn} {. global
40a0: 20 61 75 74 6f 5f 69 6e 64 65 78 0a 0a 20 20 20 auto_index..
40b0: 20 23 20 49 66 20 6e 6f 20 6e 61 6d 65 73 70 61 # If no namespa
40c0: 63 65 20 69 73 20 73 70 65 63 69 66 69 65 64 2c ce is specified,
40d0: 20 74 68 69 73 20 77 69 6c 6c 20 62 65 20 61 6e this will be an
40e0: 20 65 72 72 6f 72 20 63 61 73 65 0a 0a 20 20 20 error case..
40f0: 20 69 66 20 7b 21 5b 73 74 72 69 6e 67 20 6d 61 if {![string ma
4100: 74 63 68 20 2a 3a 3a 2a 20 24 70 61 74 74 65 72 tch *::* $patter
4110: 6e 5d 7d 20 7b 0a 09 72 65 74 75 72 6e 0a 20 20 n]} {..return.
4120: 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 6e 73 20 }.. set ns
4130: 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 [uplevel 1 [list
4140: 20 3a 3a 6e 61 6d 65 73 70 61 63 65 20 63 75 72 ::namespace cur
4150: 72 65 6e 74 5d 5d 0a 20 20 20 20 73 65 74 20 70 rent]]. set p
4160: 61 74 74 65 72 6e 4c 69 73 74 20 5b 61 75 74 6f atternList [auto
4170: 5f 71 75 61 6c 69 66 79 20 24 70 61 74 74 65 72 _qualify $patter
4180: 6e 20 24 6e 73 5d 0a 0a 20 20 20 20 61 75 74 6f n $ns].. auto
4190: 5f 6c 6f 61 64 5f 69 6e 64 65 78 0a 0a 20 20 20 _load_index..
41a0: 20 66 6f 72 65 61 63 68 20 70 61 74 74 65 72 6e foreach pattern
41b0: 20 24 70 61 74 74 65 72 6e 4c 69 73 74 20 7b 0a $patternList {.
41c0: 20 20 20 20 20 20 20 20 66 6f 72 65 61 63 68 20 foreach
41d0: 6e 61 6d 65 20 5b 61 72 72 61 79 20 6e 61 6d 65 name [array name
41e0: 73 20 61 75 74 6f 5f 69 6e 64 65 78 20 24 70 61 s auto_index $pa
41f0: 74 74 65 72 6e 5d 20 7b 0a 20 20 20 20 20 20 20 ttern] {.
4200: 20 20 20 20 20 69 66 20 7b 28 5b 6e 61 6d 65 73 if {([names
4210: 70 61 63 65 20 77 68 69 63 68 20 2d 63 6f 6d 6d pace which -comm
4220: 61 6e 64 20 24 6e 61 6d 65 5d 20 65 71 20 22 22 and $name] eq ""
4230: 29 0a 09 09 20 20 20 20 26 26 20 28 5b 6e 61 6d )... && ([nam
4240: 65 73 70 61 63 65 20 71 75 61 6c 69 66 69 65 72 espace qualifier
4250: 73 20 24 70 61 74 74 65 72 6e 5d 20 65 71 20 5b s $pattern] eq [
4260: 6e 61 6d 65 73 70 61 63 65 20 71 75 61 6c 69 66 namespace qualif
4270: 69 65 72 73 20 24 6e 61 6d 65 5d 29 7d 20 7b 0a iers $name])} {.
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4290: 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20 3a namespace eval :
42a0: 3a 20 24 61 75 74 6f 5f 69 6e 64 65 78 28 24 6e : $auto_index($n
42b0: 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 ame).
42c0: 20 7d 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 }. }.
42d0: 20 7d 0a 7d 0a 0a 23 20 61 75 74 6f 5f 65 78 65 }.}..# auto_exe
42e0: 63 6f 6b 20 2d 2d 0a 23 0a 23 20 52 65 74 75 72 cok --.#.# Retur
42f0: 6e 73 20 73 74 72 69 6e 67 20 74 68 61 74 20 69 ns string that i
4300: 6e 64 69 63 61 74 65 73 20 6e 61 6d 65 20 6f 66 ndicates name of
4310: 20 70 72 6f 67 72 61 6d 20 74 6f 20 65 78 65 63 program to exec
4320: 75 74 65 20 69 66 0a 23 20 6e 61 6d 65 20 63 6f ute if.# name co
4330: 72 72 65 73 70 6f 6e 64 73 20 74 6f 20 61 20 73 rresponds to a s
4340: 68 65 6c 6c 20 62 75 69 6c 74 69 6e 20 6f 72 20 hell builtin or
4350: 61 6e 20 65 78 65 63 75 74 61 62 6c 65 20 69 6e an executable in
4360: 20 74 68 65 0a 23 20 57 69 6e 64 6f 77 73 20 73 the.# Windows s
4370: 65 61 72 63 68 20 70 61 74 68 2c 20 6f 72 20 22 earch path, or "
4380: 22 20 6f 74 68 65 72 77 69 73 65 2e 20 20 42 75 " otherwise. Bu
4390: 69 6c 64 73 20 61 6e 20 61 73 73 6f 63 69 61 74 ilds an associat
43a0: 69 76 65 0a 23 20 61 72 72 61 79 20 61 75 74 6f ive.# array auto
43b0: 5f 65 78 65 63 73 20 74 68 61 74 20 63 61 63 68 _execs that cach
43c0: 65 73 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 61 es information a
43d0: 62 6f 75 74 20 70 72 65 76 69 6f 75 73 20 63 68 bout previous ch
43e0: 65 63 6b 73 2c 0a 23 20 66 6f 72 20 73 70 65 65 ecks,.# for spee
43f0: 64 2e 0a 23 0a 23 20 41 72 67 75 6d 65 6e 74 73 d..#.# Arguments
4400: 3a 0a 23 20 6e 61 6d 65 20 2d 09 09 09 4e 61 6d :.# name -...Nam
4410: 65 20 6f 66 20 61 20 63 6f 6d 6d 61 6e 64 2e 0a e of a command..
4420: 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f .if {$tcl_platfo
4430: 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 rm(platform) eq
4440: 22 77 69 6e 64 6f 77 73 22 7d 20 7b 0a 23 20 57 "windows"} {.# W
4450: 69 6e 64 6f 77 73 20 76 65 72 73 69 6f 6e 2e 0a indows version..
4460: 23 0a 23 20 4e 6f 74 65 20 74 68 61 74 20 66 69 #.# Note that fi
4470: 6c 65 20 65 78 65 63 75 74 61 62 6c 65 20 64 6f le executable do
4480: 65 73 6e 27 74 20 77 6f 72 6b 20 75 6e 64 65 72 esn't work under
4490: 20 57 69 6e 64 6f 77 73 2c 20 73 6f 20 77 65 20 Windows, so we
44a0: 68 61 76 65 20 74 6f 0a 23 20 6c 6f 6f 6b 20 66 have to.# look f
44b0: 6f 72 20 66 69 6c 65 73 20 77 69 74 68 20 2e 65 or files with .e
44c0: 78 65 2c 20 2e 63 6f 6d 2c 20 6f 72 20 2e 62 61 xe, .com, or .ba
44d0: 74 20 65 78 74 65 6e 73 69 6f 6e 73 2e 20 20 41 t extensions. A
44e0: 6c 73 6f 2c 20 74 68 65 20 70 61 74 68 0a 23 20 lso, the path.#
44f0: 6d 61 79 20 62 65 20 69 6e 20 74 68 65 20 50 61 may be in the Pa
4500: 74 68 20 6f 72 20 50 41 54 48 20 65 6e 76 69 72 th or PATH envir
4510: 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 onment variables
4520: 2c 20 61 6e 64 20 70 61 74 68 0a 23 20 63 6f 6d , and path.# com
4530: 70 6f 6e 65 6e 74 73 20 61 72 65 20 73 65 70 61 ponents are sepa
4540: 72 61 74 65 64 20 77 69 74 68 20 73 65 6d 69 63 rated with semic
4550: 6f 6c 6f 6e 73 2c 20 6e 6f 74 20 63 6f 6c 6f 6e olons, not colon
4560: 73 20 61 73 20 75 6e 64 65 72 20 55 6e 69 78 2e s as under Unix.
4570: 0a 23 0a 70 72 6f 63 20 61 75 74 6f 5f 65 78 65 .#.proc auto_exe
4580: 63 6f 6b 20 6e 61 6d 65 20 7b 0a 20 20 20 20 67 cok name {. g
4590: 6c 6f 62 61 6c 20 61 75 74 6f 5f 65 78 65 63 73 lobal auto_execs
45a0: 20 65 6e 76 20 74 63 6c 5f 70 6c 61 74 66 6f 72 env tcl_platfor
45b0: 6d 0a 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f m.. if {[info
45c0: 20 65 78 69 73 74 73 20 61 75 74 6f 5f 65 78 65 exists auto_exe
45d0: 63 73 28 24 6e 61 6d 65 29 5d 7d 20 7b 0a 09 72 cs($name)]} {..r
45e0: 65 74 75 72 6e 20 24 61 75 74 6f 5f 65 78 65 63 eturn $auto_exec
45f0: 73 28 24 6e 61 6d 65 29 0a 20 20 20 20 7d 0a 20 s($name). }.
4600: 20 20 20 73 65 74 20 61 75 74 6f 5f 65 78 65 63 set auto_exec
4610: 73 28 24 6e 61 6d 65 29 20 22 22 0a 0a 20 20 20 s($name) ""..
4620: 20 73 65 74 20 73 68 65 6c 6c 42 75 69 6c 74 69 set shellBuilti
4630: 6e 73 20 5b 6c 69 73 74 20 61 73 73 6f 63 20 63 ns [list assoc c
4640: 6c 73 20 63 6f 70 79 20 64 61 74 65 20 64 65 6c ls copy date del
4650: 20 64 69 72 20 65 63 68 6f 20 65 72 61 73 65 20 dir echo erase
4660: 65 78 69 74 20 66 74 79 70 65 20 5c 0a 09 20 20 exit ftype \..
4670: 20 20 6d 64 20 6d 6b 64 69 72 20 6d 6b 6c 69 6e md mkdir mklin
4680: 6b 20 6d 6f 76 65 20 72 64 20 72 65 6e 20 72 65 k move rd ren re
4690: 6e 61 6d 65 20 72 6d 64 69 72 20 73 74 61 72 74 name rmdir start
46a0: 20 74 69 6d 65 20 74 79 70 65 20 76 65 72 20 76 time type ver v
46b0: 6f 6c 5d 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 ol]. if {[inf
46c0: 6f 20 65 78 69 73 74 73 20 65 6e 76 28 50 41 54 o exists env(PAT
46d0: 48 45 58 54 29 5d 7d 20 7b 0a 09 23 20 41 64 64 HEXT)]} {..# Add
46e0: 20 61 6e 20 69 6e 69 74 69 61 6c 20 3b 20 74 6f an initial ; to
46f0: 20 68 61 76 65 20 74 68 65 20 7b 7d 20 65 78 74 have the {} ext
4700: 65 6e 73 69 6f 6e 20 63 68 65 63 6b 20 66 69 72 ension check fir
4710: 73 74 2e 0a 09 73 65 74 20 65 78 65 63 45 78 74 st...set execExt
4720: 65 6e 73 69 6f 6e 73 20 5b 73 70 6c 69 74 20 22 ensions [split "
4730: 3b 24 65 6e 76 28 50 41 54 48 45 58 54 29 22 20 ;$env(PATHEXT)"
4740: 22 3b 22 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 ";"]. } else
4750: 7b 0a 09 73 65 74 20 65 78 65 63 45 78 74 65 6e {..set execExten
4760: 73 69 6f 6e 73 20 5b 6c 69 73 74 20 7b 7d 20 2e sions [list {} .
4770: 63 6f 6d 20 2e 65 78 65 20 2e 62 61 74 20 2e 63 com .exe .bat .c
4780: 6d 64 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 69 md]. }.. i
4790: 66 20 7b 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 f {[string tolow
47a0: 65 72 20 24 6e 61 6d 65 5d 20 69 6e 20 24 73 68 er $name] in $sh
47b0: 65 6c 6c 42 75 69 6c 74 69 6e 73 7d 20 7b 0a 09 ellBuiltins} {..
47c0: 23 20 57 68 65 6e 20 74 68 69 73 20 69 73 20 63 # When this is c
47d0: 6f 6d 6d 61 6e 64 2e 63 6f 6d 20 66 6f 72 20 73 ommand.com for s
47e0: 6f 6d 65 20 72 65 61 73 6f 6e 20 6f 6e 20 57 69 ome reason on Wi
47f0: 6e 32 4b 2c 20 54 63 6c 20 77 6f 6e 27 74 0a 09 n2K, Tcl won't..
4800: 23 20 65 78 65 63 20 69 74 20 75 6e 6c 65 73 73 # exec it unless
4810: 20 74 68 65 20 63 61 73 65 20 69 73 20 72 69 67 the case is rig
4820: 68 74 2c 20 77 68 69 63 68 20 74 68 69 73 20 63 ht, which this c
4830: 6f 72 72 65 63 74 73 2e 20 20 43 4f 4d 53 50 45 orrects. COMSPE
4840: 43 0a 09 23 20 6d 61 79 20 6e 6f 74 20 70 6f 69 C..# may not poi
4850: 6e 74 20 74 6f 20 61 20 72 65 61 6c 20 66 69 6c nt to a real fil
4860: 65 2c 20 73 6f 20 64 6f 20 74 68 65 20 63 68 65 e, so do the che
4870: 63 6b 2e 0a 09 73 65 74 20 63 6d 64 20 24 65 6e ck...set cmd $en
4880: 76 28 43 4f 4d 53 50 45 43 29 0a 09 69 66 20 7b v(COMSPEC)..if {
4890: 5b 66 69 6c 65 20 65 78 69 73 74 73 20 24 63 6d [file exists $cm
48a0: 64 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 63 d]} {.. set c
48b0: 6d 64 20 5b 66 69 6c 65 20 61 74 74 72 69 62 75 md [file attribu
48c0: 74 65 73 20 24 63 6d 64 20 2d 73 68 6f 72 74 6e tes $cmd -shortn
48d0: 61 6d 65 5d 0a 09 7d 0a 09 72 65 74 75 72 6e 20 ame]..}..return
48e0: 5b 73 65 74 20 61 75 74 6f 5f 65 78 65 63 73 28 [set auto_execs(
48f0: 24 6e 61 6d 65 29 20 5b 6c 69 73 74 20 24 63 6d $name) [list $cm
4900: 64 20 2f 63 20 24 6e 61 6d 65 5d 5d 0a 20 20 20 d /c $name]].
4910: 20 7d 0a 0a 20 20 20 20 69 66 20 7b 5b 6c 6c 65 }.. if {[lle
4920: 6e 67 74 68 20 5b 66 69 6c 65 20 73 70 6c 69 74 ngth [file split
4930: 20 24 6e 61 6d 65 5d 5d 20 21 3d 20 31 7d 20 7b $name]] != 1} {
4940: 0a 09 66 6f 72 65 61 63 68 20 65 78 74 20 24 65 ..foreach ext $e
4950: 78 65 63 45 78 74 65 6e 73 69 6f 6e 73 20 7b 0a xecExtensions {.
4960: 09 20 20 20 20 73 65 74 20 66 69 6c 65 20 24 7b . set file ${
4970: 6e 61 6d 65 7d 24 7b 65 78 74 7d 0a 09 20 20 20 name}${ext}..
4980: 20 69 66 20 7b 5b 66 69 6c 65 20 65 78 69 73 74 if {[file exist
4990: 73 20 24 66 69 6c 65 5d 20 26 26 20 21 5b 66 69 s $file] && ![fi
49a0: 6c 65 20 69 73 64 69 72 65 63 74 6f 72 79 20 24 le isdirectory $
49b0: 66 69 6c 65 5d 7d 20 7b 0a 09 09 72 65 74 75 72 file]} {...retur
49c0: 6e 20 5b 73 65 74 20 61 75 74 6f 5f 65 78 65 63 n [set auto_exec
49d0: 73 28 24 6e 61 6d 65 29 20 5b 6c 69 73 74 20 24 s($name) [list $
49e0: 66 69 6c 65 5d 5d 0a 09 20 20 20 20 7d 0a 09 7d file]].. }..}
49f0: 0a 09 72 65 74 75 72 6e 20 22 22 0a 20 20 20 20 ..return "".
4a00: 7d 0a 0a 20 20 20 20 73 65 74 20 70 61 74 68 20 }.. set path
4a10: 22 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b "[file dirname [
4a20: 69 6e 66 6f 20 6e 61 6d 65 6f 66 5d 5d 3b 2e 3b info nameof]];.;
4a30: 22 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 ". if {[info
4a40: 65 78 69 73 74 73 20 65 6e 76 28 53 79 73 74 65 exists env(Syste
4a50: 6d 52 6f 6f 74 29 5d 7d 20 7b 0a 09 73 65 74 20 mRoot)]} {..set
4a60: 77 69 6e 64 69 72 20 24 65 6e 76 28 53 79 73 74 windir $env(Syst
4a70: 65 6d 52 6f 6f 74 29 0a 20 20 20 20 7d 20 65 6c emRoot). } el
4a80: 73 65 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 seif {[info exis
4a90: 74 73 20 65 6e 76 28 57 49 4e 44 49 52 29 5d 7d ts env(WINDIR)]}
4aa0: 20 7b 0a 09 73 65 74 20 77 69 6e 64 69 72 20 24 {..set windir $
4ab0: 65 6e 76 28 57 49 4e 44 49 52 29 0a 20 20 20 20 env(WINDIR).
4ac0: 7d 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 }. if {[info
4ad0: 65 78 69 73 74 73 20 77 69 6e 64 69 72 5d 7d 20 exists windir]}
4ae0: 7b 0a 09 61 70 70 65 6e 64 20 70 61 74 68 20 22 {..append path "
4af0: 24 77 69 6e 64 69 72 2f 73 79 73 74 65 6d 33 32 $windir/system32
4b00: 3b 24 77 69 6e 64 69 72 2f 73 79 73 74 65 6d 3b ;$windir/system;
4b10: 24 77 69 6e 64 69 72 3b 22 0a 20 20 20 20 7d 0a $windir;". }.
4b20: 0a 20 20 20 20 66 6f 72 65 61 63 68 20 76 61 72 . foreach var
4b30: 20 7b 50 41 54 48 20 50 61 74 68 20 70 61 74 68 {PATH Path path
4b40: 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 } {..if {[info e
4b50: 78 69 73 74 73 20 65 6e 76 28 24 76 61 72 29 5d xists env($var)]
4b60: 7d 20 7b 0a 09 20 20 20 20 61 70 70 65 6e 64 20 } {.. append
4b70: 70 61 74 68 20 22 3b 24 65 6e 76 28 24 76 61 72 path ";$env($var
4b80: 29 22 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 )"..}. }..
4b90: 20 66 6f 72 65 61 63 68 20 65 78 74 20 24 65 78 foreach ext $ex
4ba0: 65 63 45 78 74 65 6e 73 69 6f 6e 73 20 7b 0a 09 ecExtensions {..
4bb0: 75 6e 73 65 74 20 2d 6e 6f 63 6f 6d 70 6c 61 69 unset -nocomplai
4bc0: 6e 20 63 68 65 63 6b 65 64 0a 09 66 6f 72 65 61 n checked..forea
4bd0: 63 68 20 64 69 72 20 5b 73 70 6c 69 74 20 24 70 ch dir [split $p
4be0: 61 74 68 20 7b 3b 7d 5d 20 7b 0a 09 20 20 20 20 ath {;}] {..
4bf0: 23 20 53 6b 69 70 20 61 6c 72 65 61 64 79 20 63 # Skip already c
4c00: 68 65 63 6b 65 64 20 64 69 72 65 63 74 6f 72 69 hecked directori
4c10: 65 73 0a 09 20 20 20 20 69 66 20 7b 5b 69 6e 66 es.. if {[inf
4c20: 6f 20 65 78 69 73 74 73 20 63 68 65 63 6b 65 64 o exists checked
4c30: 28 24 64 69 72 29 5d 20 7c 7c 20 28 24 64 69 72 ($dir)] || ($dir
4c40: 20 65 71 20 22 22 29 7d 20 7b 0a 09 09 63 6f 6e eq "")} {...con
4c50: 74 69 6e 75 65 0a 09 20 20 20 20 7d 0a 09 20 20 tinue.. }..
4c60: 20 20 73 65 74 20 63 68 65 63 6b 65 64 28 24 64 set checked($d
4c70: 69 72 29 20 7b 7d 0a 09 20 20 20 20 73 65 74 20 ir) {}.. set
4c80: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
4c90: 24 64 69 72 20 24 7b 6e 61 6d 65 7d 24 7b 65 78 $dir ${name}${ex
4ca0: 74 7d 5d 0a 09 20 20 20 20 69 66 20 7b 5b 66 69 t}].. if {[fi
4cb0: 6c 65 20 65 78 69 73 74 73 20 24 66 69 6c 65 5d le exists $file]
4cc0: 20 26 26 20 21 5b 66 69 6c 65 20 69 73 64 69 72 && ![file isdir
4cd0: 65 63 74 6f 72 79 20 24 66 69 6c 65 5d 7d 20 7b ectory $file]} {
4ce0: 0a 09 09 72 65 74 75 72 6e 20 5b 73 65 74 20 61 ...return [set a
4cf0: 75 74 6f 5f 65 78 65 63 73 28 24 6e 61 6d 65 29 uto_execs($name)
4d00: 20 5b 6c 69 73 74 20 24 66 69 6c 65 5d 5d 0a 09 [list $file]]..
4d10: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
4d20: 20 20 20 72 65 74 75 72 6e 20 22 22 0a 7d 0a 0a return "".}..
4d30: 7d 20 65 6c 73 65 20 7b 0a 23 20 55 6e 69 78 20 } else {.# Unix
4d40: 76 65 72 73 69 6f 6e 2e 0a 23 0a 70 72 6f 63 20 version..#.proc
4d50: 61 75 74 6f 5f 65 78 65 63 6f 6b 20 6e 61 6d 65 auto_execok name
4d60: 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c 20 61 75 {. global au
4d70: 74 6f 5f 65 78 65 63 73 20 65 6e 76 0a 0a 20 20 to_execs env..
4d80: 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 if {[info exis
4d90: 74 73 20 61 75 74 6f 5f 65 78 65 63 73 28 24 6e ts auto_execs($n
4da0: 61 6d 65 29 5d 7d 20 7b 0a 09 72 65 74 75 72 6e ame)]} {..return
4db0: 20 24 61 75 74 6f 5f 65 78 65 63 73 28 24 6e 61 $auto_execs($na
4dc0: 6d 65 29 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 me). }. se
4dd0: 74 20 61 75 74 6f 5f 65 78 65 63 73 28 24 6e 61 t auto_execs($na
4de0: 6d 65 29 20 22 22 0a 20 20 20 20 69 66 20 7b 5b me) "". if {[
4df0: 6c 6c 65 6e 67 74 68 20 5b 66 69 6c 65 20 73 70 llength [file sp
4e00: 6c 69 74 20 24 6e 61 6d 65 5d 5d 20 21 3d 20 31 lit $name]] != 1
4e10: 7d 20 7b 0a 09 69 66 20 7b 5b 66 69 6c 65 20 65 } {..if {[file e
4e20: 78 65 63 75 74 61 62 6c 65 20 24 6e 61 6d 65 5d xecutable $name]
4e30: 20 26 26 20 21 5b 66 69 6c 65 20 69 73 64 69 72 && ![file isdir
4e40: 65 63 74 6f 72 79 20 24 6e 61 6d 65 5d 7d 20 7b ectory $name]} {
4e50: 0a 09 20 20 20 20 73 65 74 20 61 75 74 6f 5f 65 .. set auto_e
4e60: 78 65 63 73 28 24 6e 61 6d 65 29 20 5b 6c 69 73 xecs($name) [lis
4e70: 74 20 24 6e 61 6d 65 5d 0a 09 7d 0a 09 72 65 74 t $name]..}..ret
4e80: 75 72 6e 20 24 61 75 74 6f 5f 65 78 65 63 73 28 urn $auto_execs(
4e90: 24 6e 61 6d 65 29 0a 20 20 20 20 7d 0a 20 20 20 $name). }.
4ea0: 20 66 6f 72 65 61 63 68 20 64 69 72 20 5b 73 70 foreach dir [sp
4eb0: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 3a lit $env(PATH) :
4ec0: 5d 20 7b 0a 09 69 66 20 7b 24 64 69 72 20 65 71 ] {..if {$dir eq
4ed0: 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 ""} {.. set
4ee0: 64 69 72 20 2e 0a 09 7d 0a 09 73 65 74 20 66 69 dir ...}..set fi
4ef0: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 le [file join $d
4f00: 69 72 20 24 6e 61 6d 65 5d 0a 09 69 66 20 7b 5b ir $name]..if {[
4f10: 66 69 6c 65 20 65 78 65 63 75 74 61 62 6c 65 20 file executable
4f20: 24 66 69 6c 65 5d 20 26 26 20 21 5b 66 69 6c 65 $file] && ![file
4f30: 20 69 73 64 69 72 65 63 74 6f 72 79 20 24 66 69 isdirectory $fi
4f40: 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 le]} {.. set
4f50: 61 75 74 6f 5f 65 78 65 63 73 28 24 6e 61 6d 65 auto_execs($name
4f60: 29 20 5b 6c 69 73 74 20 24 66 69 6c 65 5d 0a 09 ) [list $file]..
4f70: 20 20 20 20 72 65 74 75 72 6e 20 24 61 75 74 6f return $auto
4f80: 5f 65 78 65 63 73 28 24 6e 61 6d 65 29 0a 09 7d _execs($name)..}
4f90: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 . }. retur
4fa0: 6e 20 22 22 0a 7d 0a 0a 7d 0a 0a 23 20 3a 3a 74 n "".}..}..# ::t
4fb0: 63 6c 3a 3a 43 6f 70 79 44 69 72 65 63 74 6f 72 cl::CopyDirector
4fc0: 79 20 2d 2d 0a 23 0a 23 20 54 68 69 73 20 70 72 y --.#.# This pr
4fd0: 6f 63 65 64 75 72 65 20 69 73 20 63 61 6c 6c 65 ocedure is calle
4fe0: 64 20 62 79 20 54 63 6c 27 73 20 63 6f 72 65 20 d by Tcl's core
4ff0: 77 68 65 6e 20 61 74 74 65 6d 70 74 73 20 74 6f when attempts to
5000: 20 63 61 6c 6c 20 74 68 65 0a 23 20 66 69 6c 65 call the.# file
5010: 73 79 73 74 65 6d 27 73 20 63 6f 70 79 64 69 72 system's copydir
5020: 65 63 74 6f 72 79 20 66 75 6e 63 74 69 6f 6e 20 ectory function
5030: 66 61 69 6c 2e 20 20 54 68 65 20 73 65 6d 61 6e fail. The seman
5040: 74 69 63 73 20 6f 66 20 74 68 65 20 63 61 6c 6c tics of the call
5050: 0a 23 20 61 72 65 20 74 68 61 74 20 27 64 65 73 .# are that 'des
5060: 74 27 20 64 6f 65 73 20 6e 6f 74 20 79 65 74 20 t' does not yet
5070: 65 78 69 73 74 2c 20 69 2e 65 2e 20 64 65 73 74 exist, i.e. dest
5080: 20 73 68 6f 75 6c 64 20 62 65 63 6f 6d 65 20 74 should become t
5090: 68 65 20 65 78 61 63 74 0a 23 20 69 6d 61 67 65 he exact.# image
50a0: 20 6f 66 20 73 72 63 2e 20 20 49 66 20 64 65 73 of src. If des
50b0: 74 20 64 6f 65 73 20 65 78 69 73 74 2c 20 77 65 t does exist, we
50c0: 20 74 68 72 6f 77 20 61 6e 20 65 72 72 6f 72 2e throw an error.
50d0: 0a 23 0a 23 20 4e 6f 74 65 20 74 68 61 74 20 6d .#.# Note that m
50e0: 61 6b 69 6e 67 20 63 68 61 6e 67 65 73 20 74 6f aking changes to
50f0: 20 74 68 69 73 20 70 72 6f 63 65 64 75 72 65 20 this procedure
5100: 63 61 6e 20 63 68 61 6e 67 65 20 74 68 65 20 72 can change the r
5110: 65 73 75 6c 74 73 0a 23 20 6f 66 20 72 75 6e 6e esults.# of runn
5120: 69 6e 67 20 54 63 6c 27 73 20 74 65 73 74 73 2e ing Tcl's tests.
5130: 0a 23 0a 23 20 41 72 67 75 6d 65 6e 74 73 3a 0a .#.# Arguments:.
5140: 23 20 61 63 74 69 6f 6e 20 2d 20 20 20 20 20 20 # action -
5150: 20 20 20 20 20 20 20 20 22 72 65 6e 61 6d 69 6e "renamin
5160: 67 22 20 6f 72 20 22 63 6f 70 79 69 6e 67 22 0a g" or "copying".
5170: 23 20 73 72 63 20 2d 09 09 09 73 6f 75 72 63 65 # src -...source
5180: 20 64 69 72 65 63 74 6f 72 79 0a 23 20 64 65 73 directory.# des
5190: 74 20 2d 09 09 64 65 73 74 69 6e 61 74 69 6f 6e t -..destination
51a0: 20 64 69 72 65 63 74 6f 72 79 0a 70 72 6f 63 20 directory.proc
51b0: 74 63 6c 3a 3a 43 6f 70 79 44 69 72 65 63 74 6f tcl::CopyDirecto
51c0: 72 79 20 7b 61 63 74 69 6f 6e 20 73 72 63 20 64 ry {action src d
51d0: 65 73 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 6e est} {. set n
51e0: 73 72 63 20 5b 66 69 6c 65 20 6e 6f 72 6d 61 6c src [file normal
51f0: 69 7a 65 20 24 73 72 63 5d 0a 20 20 20 20 73 65 ize $src]. se
5200: 74 20 6e 64 65 73 74 20 5b 66 69 6c 65 20 6e 6f t ndest [file no
5210: 72 6d 61 6c 69 7a 65 20 24 64 65 73 74 5d 0a 0a rmalize $dest]..
5220: 20 20 20 20 69 66 20 7b 24 61 63 74 69 6f 6e 20 if {$action
5230: 65 71 20 22 72 65 6e 61 6d 69 6e 67 22 7d 20 7b eq "renaming"} {
5240: 0a 09 23 20 43 61 6e 27 74 20 72 65 6e 61 6d 65 ..# Can't rename
5250: 20 76 6f 6c 75 6d 65 73 2e 20 20 57 65 20 63 6f volumes. We co
5260: 75 6c 64 20 67 69 76 65 20 61 20 6d 6f 72 65 20 uld give a more
5270: 70 72 65 63 69 73 65 0a 09 23 20 65 72 72 6f 72 precise..# error
5280: 20 6d 65 73 73 61 67 65 20 68 65 72 65 2c 20 62 message here, b
5290: 75 74 20 74 68 61 74 20 77 6f 75 6c 64 20 62 72 ut that would br
52a0: 65 61 6b 20 74 68 65 20 74 65 73 74 20 73 75 69 eak the test sui
52b0: 74 65 2e 0a 09 69 66 20 7b 24 6e 73 72 63 20 69 te...if {$nsrc i
52c0: 6e 20 5b 66 69 6c 65 20 76 6f 6c 75 6d 65 73 5d n [file volumes]
52d0: 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 } {.. return
52e0: 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 65 72 72 -code error "err
52f0: 6f 72 20 24 61 63 74 69 6f 6e 20 5c 22 24 73 72 or $action \"$sr
5300: 63 5c 22 20 74 6f 5c 0a 09 20 20 20 20 20 20 5c c\" to\.. \
5310: 22 24 64 65 73 74 5c 22 3a 20 74 72 79 69 6e 67 "$dest\": trying
5320: 20 74 6f 20 72 65 6e 61 6d 65 20 61 20 76 6f 6c to rename a vol
5330: 75 6d 65 20 6f 72 20 6d 6f 76 65 20 61 20 64 69 ume or move a di
5340: 72 65 63 74 6f 72 79 5c 0a 09 20 20 20 20 20 20 rectory\..
5350: 69 6e 74 6f 20 69 74 73 65 6c 66 22 0a 09 7d 0a into itself"..}.
5360: 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 5b 66 }. if {[f
5370: 69 6c 65 20 65 78 69 73 74 73 20 24 64 65 73 74 ile exists $dest
5380: 5d 7d 20 7b 0a 09 69 66 20 7b 24 6e 73 72 63 20 ]} {..if {$nsrc
5390: 65 71 20 24 6e 64 65 73 74 7d 20 7b 0a 09 20 20 eq $ndest} {..
53a0: 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 return -code e
53b0: 72 72 6f 72 20 22 65 72 72 6f 72 20 24 61 63 74 rror "error $act
53c0: 69 6f 6e 20 5c 22 24 73 72 63 5c 22 20 74 6f 5c ion \"$src\" to\
53d0: 0a 09 20 20 20 20 20 20 5c 22 24 64 65 73 74 5c .. \"$dest\
53e0: 22 3a 20 74 72 79 69 6e 67 20 74 6f 20 72 65 6e ": trying to ren
53f0: 61 6d 65 20 61 20 76 6f 6c 75 6d 65 20 6f 72 20 ame a volume or
5400: 6d 6f 76 65 20 61 20 64 69 72 65 63 74 6f 72 79 move a directory
5410: 5c 0a 09 20 20 20 20 20 20 69 6e 74 6f 20 69 74 \.. into it
5420: 73 65 6c 66 22 0a 09 7d 0a 09 69 66 20 7b 24 61 self"..}..if {$a
5430: 63 74 69 6f 6e 20 65 71 20 22 63 6f 70 79 69 6e ction eq "copyin
5440: 67 22 7d 20 7b 0a 09 20 20 20 20 23 20 57 65 20 g"} {.. # We
5450: 75 73 65 64 20 74 6f 20 74 68 72 6f 77 20 61 6e used to throw an
5460: 20 65 72 72 6f 72 20 68 65 72 65 2c 20 62 75 74 error here, but
5470: 2c 20 6c 6f 6f 6b 69 6e 67 20 6d 6f 72 65 20 63 , looking more c
5480: 6c 6f 73 65 6c 79 0a 09 20 20 20 20 23 20 61 74 losely.. # at
5490: 20 74 68 65 20 63 6f 72 65 20 63 6f 70 79 20 63 the core copy c
54a0: 6f 64 65 20 69 6e 20 74 63 6c 46 43 6d 64 2e 63 ode in tclFCmd.c
54b0: 2c 20 69 66 20 74 68 65 20 64 65 73 74 69 6e 61 , if the destina
54c0: 74 69 6f 6e 0a 09 20 20 20 20 23 20 65 78 69 73 tion.. # exis
54d0: 74 73 2c 20 74 68 65 6e 20 77 65 20 73 68 6f 75 ts, then we shou
54e0: 6c 64 20 6f 6e 6c 79 20 63 61 6c 6c 20 74 68 69 ld only call thi
54f0: 73 20 66 75 6e 63 74 69 6f 6e 20 69 66 20 2d 66 s function if -f
5500: 6f 72 63 65 0a 09 20 20 20 20 23 20 69 73 20 74 orce.. # is t
5510: 72 75 65 2c 20 77 68 69 63 68 20 6d 65 61 6e 73 rue, which means
5520: 20 77 65 20 6a 75 73 74 20 77 61 6e 74 20 74 6f we just want to
5530: 20 6f 76 65 72 2d 77 72 69 74 65 2e 20 20 53 6f over-write. So
5540: 2c 0a 09 20 20 20 20 23 20 74 68 65 20 66 6f 6c ,.. # the fol
5550: 6c 6f 77 69 6e 67 20 63 6f 64 65 20 69 73 20 6e lowing code is n
5560: 6f 77 20 63 6f 6d 6d 65 6e 74 65 64 20 6f 75 74 ow commented out
5570: 2e 0a 09 20 20 20 20 23 0a 09 20 20 20 20 23 20 ... #.. #
5580: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err
5590: 6f 72 20 22 65 72 72 6f 72 20 24 61 63 74 69 6f or "error $actio
55a0: 6e 20 5c 22 24 73 72 63 5c 22 20 74 6f 5c 0a 09 n \"$src\" to\..
55b0: 20 20 20 20 23 20 5c 22 24 64 65 73 74 5c 22 3a # \"$dest\":
55c0: 20 66 69 6c 65 20 61 6c 72 65 61 64 79 20 65 78 file already ex
55d0: 69 73 74 73 22 0a 09 7d 20 65 6c 73 65 20 7b 0a ists"..} else {.
55e0: 09 20 20 20 20 23 20 44 65 70 65 6e 64 69 6e 67 . # Depending
55f0: 20 6f 6e 20 74 68 65 20 70 6c 61 74 66 6f 72 6d on the platform
5600: 2c 20 61 6e 64 20 6f 6e 20 74 68 65 20 63 75 72 , and on the cur
5610: 72 65 6e 74 0a 09 20 20 20 20 23 20 77 6f 72 6b rent.. # work
5620: 69 6e 67 20 64 69 72 65 63 74 6f 72 79 2c 20 74 ing directory, t
5630: 68 65 20 64 69 72 65 63 74 6f 72 69 65 73 20 27 he directories '
5640: 2e 27 2c 20 27 2e 2e 27 0a 09 20 20 20 20 23 20 .', '..'.. #
5650: 63 61 6e 20 62 65 20 72 65 74 75 72 6e 65 64 20 can be returned
5660: 69 6e 20 76 61 72 69 6f 75 73 20 63 6f 6d 62 69 in various combi
5670: 6e 61 74 69 6f 6e 73 2e 20 20 41 6e 79 77 61 79 nations. Anyway
5680: 2c 0a 09 20 20 20 20 23 20 69 66 20 61 6e 79 20 ,.. # if any
5690: 6f 74 68 65 72 20 66 69 6c 65 20 69 73 20 72 65 other file is re
56a0: 74 75 72 6e 65 64 2c 20 77 65 20 6d 75 73 74 20 turned, we must
56b0: 73 69 67 6e 61 6c 20 61 6e 20 65 72 72 6f 72 2e signal an error.
56c0: 0a 09 20 20 20 20 73 65 74 20 65 78 69 73 74 69 .. set existi
56d0: 6e 67 20 5b 67 6c 6f 62 20 2d 6e 6f 63 6f 6d 70 ng [glob -nocomp
56e0: 6c 61 69 6e 20 2d 64 69 72 65 63 74 6f 72 79 20 lain -directory
56f0: 24 64 65 73 74 20 2a 20 2e 2a 5d 0a 09 20 20 20 $dest * .*]..
5700: 20 6c 61 70 70 65 6e 64 20 65 78 69 73 74 69 6e lappend existin
5710: 67 20 7b 2a 7d 5b 67 6c 6f 62 20 2d 6e 6f 63 6f g {*}[glob -noco
5720: 6d 70 6c 61 69 6e 20 2d 64 69 72 65 63 74 6f 72 mplain -director
5730: 79 20 24 64 65 73 74 20 5c 0a 09 09 20 20 20 20 y $dest \...
5740: 2d 74 79 70 65 20 68 69 64 64 65 6e 20 2a 20 2e -type hidden * .
5750: 2a 5d 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 *].. foreach
5760: 73 20 24 65 78 69 73 74 69 6e 67 20 7b 0a 09 09 s $existing {...
5770: 69 66 20 7b 5b 66 69 6c 65 20 74 61 69 6c 20 24 if {[file tail $
5780: 73 5d 20 6e 69 20 7b 2e 20 2e 2e 7d 7d 20 7b 0a s] ni {. ..}} {.
5790: 09 09 20 20 20 20 72 65 74 75 72 6e 20 2d 63 6f .. return -co
57a0: 64 65 20 65 72 72 6f 72 20 22 65 72 72 6f 72 20 de error "error
57b0: 24 61 63 74 69 6f 6e 20 5c 22 24 73 72 63 5c 22 $action \"$src\"
57c0: 20 74 6f 5c 0a 09 09 20 20 20 20 20 20 5c 22 24 to\... \"$
57d0: 64 65 73 74 5c 22 3a 20 66 69 6c 65 20 61 6c 72 dest\": file alr
57e0: 65 61 64 79 20 65 78 69 73 74 73 22 0a 09 09 7d eady exists"...}
57f0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
5800: 20 65 6c 73 65 20 7b 0a 09 69 66 20 7b 5b 73 74 else {..if {[st
5810: 72 69 6e 67 20 66 69 72 73 74 20 24 6e 73 72 63 ring first $nsrc
5820: 20 24 6e 64 65 73 74 5d 20 3e 3d 20 30 7d 20 7b $ndest] >= 0} {
5830: 0a 09 20 20 20 20 73 65 74 20 73 72 63 6c 65 6e .. set srclen
5840: 20 5b 65 78 70 72 20 7b 5b 6c 6c 65 6e 67 74 68 [expr {[llength
5850: 20 5b 66 69 6c 65 20 73 70 6c 69 74 20 24 6e 73 [file split $ns
5860: 72 63 5d 5d 20 2d 20 31 7d 5d 0a 09 20 20 20 20 rc]] - 1}]..
5870: 73 65 74 20 6e 64 65 73 74 20 5b 6c 69 6e 64 65 set ndest [linde
5880: 78 20 5b 66 69 6c 65 20 73 70 6c 69 74 20 24 6e x [file split $n
5890: 64 65 73 74 5d 20 24 73 72 63 6c 65 6e 5d 0a 09 dest] $srclen]..
58a0: 20 20 20 20 69 66 20 7b 24 6e 64 65 73 74 20 65 if {$ndest e
58b0: 71 20 5b 66 69 6c 65 20 74 61 69 6c 20 24 6e 73 q [file tail $ns
58c0: 72 63 5d 7d 20 7b 0a 09 09 72 65 74 75 72 6e 20 rc]} {...return
58d0: 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 65 72 72 -code error "err
58e0: 6f 72 20 24 61 63 74 69 6f 6e 20 5c 22 24 73 72 or $action \"$sr
58f0: 63 5c 22 20 74 6f 5c 0a 09 09 20 20 5c 22 24 64 c\" to\... \"$d
5900: 65 73 74 5c 22 3a 20 74 72 79 69 6e 67 20 74 6f est\": trying to
5910: 20 72 65 6e 61 6d 65 20 61 20 76 6f 6c 75 6d 65 rename a volume
5920: 20 6f 72 20 6d 6f 76 65 20 61 20 64 69 72 65 63 or move a direc
5930: 74 6f 72 79 5c 0a 09 09 20 20 69 6e 74 6f 20 69 tory\... into i
5940: 74 73 65 6c 66 22 0a 09 20 20 20 20 7d 0a 09 7d tself".. }..}
5950: 0a 09 66 69 6c 65 20 6d 6b 64 69 72 20 24 64 65 ..file mkdir $de
5960: 73 74 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 48 st. }. # H
5970: 61 76 65 20 74 6f 20 62 65 20 63 61 72 65 66 75 ave to be carefu
5980: 6c 20 74 6f 20 63 61 70 74 75 72 65 20 62 6f 74 l to capture bot
5990: 68 20 76 69 73 69 62 6c 65 20 61 6e 64 20 68 69 h visible and hi
59a0: 64 64 65 6e 20 66 69 6c 65 73 2e 0a 20 20 20 20 dden files..
59b0: 23 20 57 65 20 77 69 6c 6c 20 61 6c 73 6f 20 62 # We will also b
59c0: 65 20 6d 6f 72 65 20 67 65 6e 65 72 6f 75 73 20 e more generous
59d0: 74 6f 20 74 68 65 20 66 69 6c 65 20 73 79 73 74 to the file syst
59e0: 65 6d 20 61 6e 64 20 6e 6f 74 0a 20 20 20 20 23 em and not. #
59f0: 20 61 73 73 75 6d 65 20 74 68 65 20 68 69 64 64 assume the hidd
5a00: 65 6e 20 61 6e 64 20 6e 6f 6e 2d 68 69 64 64 65 en and non-hidde
5a10: 6e 20 6c 69 73 74 73 20 61 72 65 20 6e 6f 6e 2d n lists are non-
5a20: 6f 76 65 72 6c 61 70 70 69 6e 67 2e 0a 20 20 20 overlapping..
5a30: 20 23 0a 20 20 20 20 23 20 4f 6e 20 55 6e 69 78 #. # On Unix
5a40: 20 27 68 69 64 64 65 6e 27 20 66 69 6c 65 73 20 'hidden' files
5a50: 62 65 67 69 6e 20 77 69 74 68 20 27 2e 27 2e 20 begin with '.'.
5a60: 20 4f 6e 20 6f 74 68 65 72 20 70 6c 61 74 66 6f On other platfo
5a70: 72 6d 73 0a 20 20 20 20 23 20 6f 72 20 66 69 6c rms. # or fil
5a80: 65 73 79 73 74 65 6d 73 20 68 69 64 64 65 6e 20 esystems hidden
5a90: 66 69 6c 65 73 20 6d 61 79 20 68 61 76 65 20 6f files may have o
5aa0: 74 68 65 72 20 69 6e 74 65 72 70 72 65 74 61 74 ther interpretat
5ab0: 69 6f 6e 73 2e 0a 20 20 20 20 73 65 74 20 66 69 ions.. set fi
5ac0: 6c 65 6c 69 73 74 20 5b 63 6f 6e 63 61 74 20 5b lelist [concat [
5ad0: 67 6c 6f 62 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e glob -nocomplain
5ae0: 20 2d 64 69 72 65 63 74 6f 72 79 20 24 73 72 63 -directory $src
5af0: 20 2a 5d 20 5c 0a 20 20 20 20 20 20 5b 67 6c 6f *] \. [glo
5b00: 62 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 2d 64 b -nocomplain -d
5b10: 69 72 65 63 74 6f 72 79 20 24 73 72 63 20 2d 74 irectory $src -t
5b20: 79 70 65 73 20 68 69 64 64 65 6e 20 2a 5d 5d 0a ypes hidden *]].
5b30: 0a 20 20 20 20 66 6f 72 65 61 63 68 20 73 20 5b . foreach s [
5b40: 6c 73 6f 72 74 20 2d 75 6e 69 71 75 65 20 24 66 lsort -unique $f
5b50: 69 6c 65 6c 69 73 74 5d 20 7b 0a 09 69 66 20 7b ilelist] {..if {
5b60: 5b 66 69 6c 65 20 74 61 69 6c 20 24 73 5d 20 6e [file tail $s] n
5b70: 69 20 7b 2e 20 2e 2e 7d 7d 20 7b 0a 09 20 20 20 i {. ..}} {..
5b80: 20 66 69 6c 65 20 63 6f 70 79 20 2d 66 6f 72 63 file copy -forc
5b90: 65 20 2d 2d 20 24 73 20 5b 66 69 6c 65 20 6a 6f e -- $s [file jo
5ba0: 69 6e 20 24 64 65 73 74 20 5b 66 69 6c 65 20 74 in $dest [file t
5bb0: 61 69 6c 20 24 73 5d 5d 0a 09 7d 0a 20 20 20 20 ail $s]]..}.
5bc0: 7d 0a 20 20 20 20 72 65 74 75 72 6e 0a 7d 0a }. return.}.
