]>
Commit | Line | Data |
---|---|---|
6a5fa4e0 MG |
1 | # init.tcl -- |
2 | # | |
3 | # Default system startup file for Tcl-based applications. Defines | |
4 | # "unknown" procedure and auto-load facilities. | |
5 | # | |
6 | # $Header: /user6/ouster/tcl/scripts/RCS/init.tcl,v 1.7 92/07/25 16:29:36 ouster Exp $ SPRITE (Berkeley) | |
7 | # | |
8 | # Copyright 1991-1992 Regents of the University of California | |
9 | # Permission to use, copy, modify, and distribute this | |
10 | # software and its documentation for any purpose and without | |
11 | # fee is hereby granted, provided that this copyright | |
12 | # notice appears in all copies. The University of California | |
13 | # makes no representations about the suitability of this | |
14 | # software for any purpose. It is provided "as is" without | |
15 | # express or implied warranty. | |
16 | # | |
17 | ||
18 | # unknown: | |
19 | # Invoked when a Tcl command is invoked that doesn't exist in the | |
20 | # interpreter: | |
21 | # | |
22 | # 1. See if the autoload facility can locate the command in a | |
23 | # Tcl script file. If so, load it and execute it. | |
24 | # 2. See if the command exists as an executable UNIX program. | |
25 | # If so, "exec" the command. | |
26 | # 3. See if the command is a valid abbreviation for another command. | |
27 | # if so, invoke the command. However, only permit abbreviations | |
28 | # at top-level. | |
29 | ||
30 | proc unknown args { | |
31 | global auto_noexec auto_noload env unknown_active | |
32 | ||
33 | if [info exists unknown_active] { | |
34 | unset unknown_active | |
35 | error "unexpected recursion in \"unknown\" command" | |
36 | } | |
37 | set unknown_active 1 | |
38 | set name [lindex $args 0] | |
39 | if ![info exists auto_noload] { | |
40 | if [auto_load $name] { | |
41 | unset unknown_active | |
42 | return [uplevel $args] | |
43 | } | |
44 | } | |
45 | if ![info exists auto_noexec] { | |
46 | if [auto_execok $name] { | |
47 | unset unknown_active | |
48 | return [uplevel exec $args] | |
49 | } | |
50 | } | |
51 | if {([info level] == 1) && ([info script] == "")} { | |
52 | set cmds [info commands $name*] | |
53 | if {[llength $cmds] == 1} { | |
54 | unset unknown_active | |
55 | return [uplevel [lreplace $args 0 0 $cmds]] | |
56 | } | |
57 | if {[llength $cmds] != 0} { | |
58 | unset unknown_active | |
59 | if {$name == ""} { | |
60 | error "empty command name \"\"" | |
61 | } else { | |
62 | error "ambiguous command name \"$name\": [lsort $cmds]" | |
63 | } | |
64 | } | |
65 | } | |
66 | unset unknown_active | |
67 | error "invalid command name \"$name\"" | |
68 | } | |
69 | ||
70 | # auto_load: | |
71 | # Checks a collection of library directories to see if a procedure | |
72 | # is defined in one of them. If so, it sources the appropriate | |
73 | # library file to create the procedure. Returns 1 if it successfully | |
74 | # loaded the procedure, 0 otherwise. | |
75 | ||
76 | proc auto_load cmd { | |
77 | global auto_index auto_oldpath auto_path env | |
78 | ||
79 | if [info exists auto_index($cmd)] { | |
80 | uplevel #0 source $auto_index($cmd) | |
81 | return 1 | |
82 | } | |
83 | if [catch {set path $auto_path}] { | |
84 | if [catch {set path $env(TCLLIBPATH)}] { | |
85 | if [catch {set path [info library]}] { | |
86 | return 0 | |
87 | } | |
88 | } | |
89 | } | |
90 | if [info exists auto_oldpath] { | |
91 | if {$auto_oldpath == $path} { | |
92 | return 0 | |
93 | } | |
94 | } | |
95 | set auto_oldpath $path | |
96 | catch {unset auto_index} | |
97 | foreach dir $path { | |
98 | set f "" | |
99 | catch { | |
100 | set f [open $dir/tclindex] | |
101 | if {[gets $f] != "# Tcl autoload index file: each line identifies a Tcl"} { | |
102 | puts stdout "Bad id line in file $dir/tclindex" | |
103 | error done | |
104 | } | |
105 | while {[gets $f line] >= 0} { | |
106 | if {([string index $line 0] == "#") || ([llength $line] != 2)} { | |
107 | continue | |
108 | } | |
109 | set name [lindex $line 0] | |
110 | if {![info exists auto_index($name)]} { | |
111 | set auto_index($name) $dir/[lindex $line 1] | |
112 | } | |
113 | } | |
114 | } | |
115 | if {$f != ""} { | |
116 | close $f | |
117 | } | |
118 | } | |
119 | if [info exists auto_index($cmd)] { | |
120 | uplevel #0 source $auto_index($cmd) | |
121 | return 1 | |
122 | } | |
123 | return 0 | |
124 | } | |
125 | ||
126 | # auto_execok: | |
127 | # Returns 1 if there's an executable in the current path for the | |
128 | # given name, 0 otherwise. Builds an associative array auto_execs | |
129 | # that caches information about previous checks, for speed. | |
130 | ||
131 | proc auto_execok name { | |
132 | global auto_execs env | |
133 | ||
134 | if [info exists auto_execs($name)] { | |
135 | return $auto_execs($name) | |
136 | } | |
137 | set auto_execs($name) 0 | |
138 | foreach dir [split $env(PATH) :] { | |
139 | if {[file executable $dir/$name] && ![file isdirectory $dir/$name]} { | |
140 | set auto_execs($name) 1 | |
141 | return 1 | |
142 | } | |
143 | } | |
144 | return 0 | |
145 | } | |
146 | ||
147 | # auto_reset: | |
148 | # Destroy all cached information for auto-loading and auto-execution, | |
149 | # so that the information gets recomputed the next time it's needed. | |
150 | ||
151 | proc auto_reset {} { | |
152 | global auto_execs auto_index | |
153 | unset auto_execs auto_index | |
154 | } |