Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # auto.tcl -- |
2 | # | |
3 | # utility procs formerly in init.tcl dealing with auto execution | |
4 | # of commands and can be auto loaded themselves. | |
5 | # | |
6 | # RCS: @(#) $Id: auto.tcl,v 1.12.2.8 2005/06/27 18:20:26 dgp Exp $ | |
7 | # | |
8 | # Copyright (c) 1991-1993 The Regents of the University of California. | |
9 | # Copyright (c) 1994-1998 Sun Microsystems, Inc. | |
10 | # | |
11 | # See the file "license.terms" for information on usage and redistribution | |
12 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | |
13 | # | |
14 | ||
15 | # auto_reset -- | |
16 | # | |
17 | # Destroy all cached information for auto-loading and auto-execution, | |
18 | # so that the information gets recomputed the next time it's needed. | |
19 | # Also delete any procedures that are listed in the auto-load index | |
20 | # except those defined in this file. | |
21 | # | |
22 | # Arguments: | |
23 | # None. | |
24 | ||
25 | proc auto_reset {} { | |
26 | global auto_execs auto_index auto_oldpath | |
27 | foreach p [info procs] { | |
28 | if {[info exists auto_index($p)] && ![string match auto_* $p] | |
29 | && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup | |
30 | tcl_findLibrary pkg_compareExtension | |
31 | tclPkgUnknown tcl::MacOSXPkgUnknown | |
32 | tcl::MacPkgUnknown} $p] < 0)} { | |
33 | rename $p {} | |
34 | } | |
35 | } | |
36 | catch {unset auto_execs} | |
37 | catch {unset auto_index} | |
38 | catch {unset auto_oldpath} | |
39 | } | |
40 | ||
41 | # tcl_findLibrary -- | |
42 | # | |
43 | # This is a utility for extensions that searches for a library directory | |
44 | # using a canonical searching algorithm. A side effect is to source | |
45 | # the initialization script and set a global library variable. | |
46 | # | |
47 | # Arguments: | |
48 | # basename Prefix of the directory name, (e.g., "tk") | |
49 | # version Version number of the package, (e.g., "8.0") | |
50 | # patch Patchlevel of the package, (e.g., "8.0.3") | |
51 | # initScript Initialization script to source (e.g., tk.tcl) | |
52 | # enVarName environment variable to honor (e.g., TK_LIBRARY) | |
53 | # varName Global variable to set when done (e.g., tk_library) | |
54 | ||
55 | proc tcl_findLibrary {basename version patch initScript enVarName varName} { | |
56 | upvar #0 $varName the_library | |
57 | global env errorInfo | |
58 | ||
59 | set dirs {} | |
60 | set errors {} | |
61 | ||
62 | # The C application may have hardwired a path, which we honor | |
63 | ||
64 | set variableSet [info exists the_library] | |
65 | if {$variableSet && $the_library ne ""} { | |
66 | lappend dirs $the_library | |
67 | } else { | |
68 | ||
69 | # Do the canonical search | |
70 | ||
71 | # 1. From an environment variable, if it exists. | |
72 | # Placing this first gives the end-user ultimate control | |
73 | # to work-around any bugs, or to customize. | |
74 | ||
75 | if {[info exists env($enVarName)]} { | |
76 | lappend dirs $env($enVarName) | |
77 | } | |
78 | ||
79 | # 2. In the package script directory registered within | |
80 | # the configuration of the package itself. | |
81 | # | |
82 | # Only do this for Tcl 8.5+, when Tcl_RegsiterConfig() is available. | |
83 | #if {[catch { | |
84 | # ::${basename}::pkgconfig get scriptdir,runtime | |
85 | #} value] == 0} { | |
86 | # lappend dirs $value | |
87 | #} | |
88 | ||
89 | # 3. Relative to auto_path directories. This checks relative to the | |
90 | # Tcl library as well as allowing loading of libraries added to the | |
91 | # auto_path that is not relative to the core library or binary paths. | |
92 | foreach d $::auto_path { | |
93 | lappend dirs [file join $d $basename$version] | |
94 | if {$::tcl_platform(platform) eq "unix" | |
95 | && $::tcl_platform(os) eq "Darwin"} { | |
96 | # 4. On MacOSX, check the Resources/Scripts subdir too | |
97 | lappend dirs [file join $d $basename$version Resources Scripts] | |
98 | } | |
99 | } | |
100 | ||
101 | # 3. Various locations relative to the executable | |
102 | # ../lib/foo1.0 (From bin directory in install hierarchy) | |
103 | # ../../lib/foo1.0 (From bin/arch directory in install hierarchy) | |
104 | # ../library (From unix directory in build hierarchy) | |
105 | set parentDir [file dirname [file dirname [info nameofexecutable]]] | |
106 | set grandParentDir [file dirname $parentDir] | |
107 | lappend dirs [file join $parentDir lib $basename$version] | |
108 | lappend dirs [file join $grandParentDir lib $basename$version] | |
109 | lappend dirs [file join $parentDir library] | |
110 | ||
111 | # Remaining locations are out of date (when relevant, they ought | |
112 | # to be covered by the $::auto_path seach above). | |
113 | # | |
114 | # ../../library (From unix/arch directory in build hierarchy) | |
115 | # ../../foo1.0.1/library | |
116 | # (From unix directory in parallel build hierarchy) | |
117 | # ../../../foo1.0.1/library | |
118 | # (From unix/arch directory in parallel build hierarchy) | |
119 | # | |
120 | # For the sake of extra compatibility safety, we keep adding these | |
121 | # paths during the 8.4.* release series. | |
122 | if {1} { | |
123 | lappend dirs [file join $grandParentDir library] | |
124 | lappend dirs [file join $grandParentDir $basename$patch library] | |
125 | lappend dirs [file join [file dirname $grandParentDir] \ | |
126 | $basename$patch library] | |
127 | } | |
128 | } | |
129 | # uniquify $dirs in order | |
130 | array set seen {} | |
131 | foreach i $dirs { | |
132 | # For Tcl 8.4.9, we've disabled the use of [file normalize] here. | |
133 | # This means that two different path names that are the same path | |
134 | # in normalized form, will both remain on the search path. There | |
135 | # should be no harm in that, just a bit more file system access | |
136 | # than is strictly necessary. | |
137 | # | |
138 | # [file normalize] has been disabled because of reports it has | |
139 | # caused difficulties with the freewrap utility. To keep | |
140 | # compatibility with freewrap's needs, we'll keep this disabled | |
141 | # throughout the 8.4.x (x >= 9) releases. See Bug 1072136. | |
142 | if {1 || [interp issafe]} { | |
143 | set norm $i | |
144 | } else { | |
145 | set norm [file normalize $i] | |
146 | } | |
147 | if {[info exists seen($norm)]} { continue } | |
148 | set seen($norm) "" | |
149 | lappend uniqdirs $i | |
150 | } | |
151 | set dirs $uniqdirs | |
152 | foreach i $dirs { | |
153 | set the_library $i | |
154 | set file [file join $i $initScript] | |
155 | ||
156 | # source everything when in a safe interpreter because | |
157 | # we have a source command, but no file exists command | |
158 | ||
159 | if {[interp issafe] || [file exists $file]} { | |
160 | if {![catch {uplevel #0 [list source $file]} msg]} { | |
161 | return | |
162 | } else { | |
163 | append errors "$file: $msg\n$errorInfo\n" | |
164 | } | |
165 | } | |
166 | } | |
167 | if {!$variableSet} { | |
168 | unset the_library | |
169 | } | |
170 | set msg "Can't find a usable $initScript in the following directories: \n" | |
171 | append msg " $dirs\n\n" | |
172 | append msg "$errors\n\n" | |
173 | append msg "This probably means that $basename wasn't installed properly.\n" | |
174 | error $msg | |
175 | } | |
176 | ||
177 | ||
178 | # ---------------------------------------------------------------------- | |
179 | # auto_mkindex | |
180 | # ---------------------------------------------------------------------- | |
181 | # The following procedures are used to generate the tclIndex file | |
182 | # from Tcl source files. They use a special safe interpreter to | |
183 | # parse Tcl source files, writing out index entries as "proc" | |
184 | # commands are encountered. This implementation won't work in a | |
185 | # safe interpreter, since a safe interpreter can't create the | |
186 | # special parser and mess with its commands. | |
187 | ||
188 | if {[interp issafe]} { | |
189 | return ;# Stop sourcing the file here | |
190 | } | |
191 | ||
192 | # auto_mkindex -- | |
193 | # Regenerate a tclIndex file from Tcl source files. Takes as argument | |
194 | # the name of the directory in which the tclIndex file is to be placed, | |
195 | # followed by any number of glob patterns to use in that directory to | |
196 | # locate all of the relevant files. | |
197 | # | |
198 | # Arguments: | |
199 | # dir - Name of the directory in which to create an index. | |
200 | # args - Any number of additional arguments giving the | |
201 | # names of files within dir. If no additional | |
202 | # are given auto_mkindex will look for *.tcl. | |
203 | ||
204 | proc auto_mkindex {dir args} { | |
205 | global errorCode errorInfo | |
206 | ||
207 | if {[interp issafe]} { | |
208 | error "can't generate index within safe interpreter" | |
209 | } | |
210 | ||
211 | set oldDir [pwd] | |
212 | cd $dir | |
213 | set dir [pwd] | |
214 | ||
215 | append index "# Tcl autoload index file, version 2.0\n" | |
216 | append index "# This file is generated by the \"auto_mkindex\" command\n" | |
217 | append index "# and sourced to set up indexing information for one or\n" | |
218 | append index "# more commands. Typically each line is a command that\n" | |
219 | append index "# sets an element in the auto_index array, where the\n" | |
220 | append index "# element name is the name of a command and the value is\n" | |
221 | append index "# a script that loads the command.\n\n" | |
222 | if {$args == ""} { | |
223 | set args *.tcl | |
224 | } | |
225 | ||
226 | auto_mkindex_parser::init | |
227 | foreach file [eval glob $args] { | |
228 | if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} { | |
229 | append index $msg | |
230 | } else { | |
231 | set code $errorCode | |
232 | set info $errorInfo | |
233 | cd $oldDir | |
234 | error $msg $info $code | |
235 | } | |
236 | } | |
237 | auto_mkindex_parser::cleanup | |
238 | ||
239 | set fid [open "tclIndex" w] | |
240 | puts -nonewline $fid $index | |
241 | close $fid | |
242 | cd $oldDir | |
243 | } | |
244 | ||
245 | # Original version of auto_mkindex that just searches the source | |
246 | # code for "proc" at the beginning of the line. | |
247 | ||
248 | proc auto_mkindex_old {dir args} { | |
249 | global errorCode errorInfo | |
250 | set oldDir [pwd] | |
251 | cd $dir | |
252 | set dir [pwd] | |
253 | append index "# Tcl autoload index file, version 2.0\n" | |
254 | append index "# This file is generated by the \"auto_mkindex\" command\n" | |
255 | append index "# and sourced to set up indexing information for one or\n" | |
256 | append index "# more commands. Typically each line is a command that\n" | |
257 | append index "# sets an element in the auto_index array, where the\n" | |
258 | append index "# element name is the name of a command and the value is\n" | |
259 | append index "# a script that loads the command.\n\n" | |
260 | if {[string equal $args ""]} { | |
261 | set args *.tcl | |
262 | } | |
263 | foreach file [eval glob $args] { | |
264 | set f "" | |
265 | set error [catch { | |
266 | set f [open $file] | |
267 | while {[gets $f line] >= 0} { | |
268 | if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { | |
269 | set procName [lindex [auto_qualify $procName "::"] 0] | |
270 | append index "set [list auto_index($procName)]" | |
271 | append index " \[list source \[file join \$dir [list $file]\]\]\n" | |
272 | } | |
273 | } | |
274 | close $f | |
275 | } msg] | |
276 | if {$error} { | |
277 | set code $errorCode | |
278 | set info $errorInfo | |
279 | catch {close $f} | |
280 | cd $oldDir | |
281 | error $msg $info $code | |
282 | } | |
283 | } | |
284 | set f "" | |
285 | set error [catch { | |
286 | set f [open tclIndex w] | |
287 | puts -nonewline $f $index | |
288 | close $f | |
289 | cd $oldDir | |
290 | } msg] | |
291 | if {$error} { | |
292 | set code $errorCode | |
293 | set info $errorInfo | |
294 | catch {close $f} | |
295 | cd $oldDir | |
296 | error $msg $info $code | |
297 | } | |
298 | } | |
299 | ||
300 | # Create a safe interpreter that can be used to parse Tcl source files | |
301 | # generate a tclIndex file for autoloading. This interp contains | |
302 | # commands for things that need index entries. Each time a command | |
303 | # is executed, it writes an entry out to the index file. | |
304 | ||
305 | namespace eval auto_mkindex_parser { | |
306 | variable parser "" ;# parser used to build index | |
307 | variable index "" ;# maintains index as it is built | |
308 | variable scriptFile "" ;# name of file being processed | |
309 | variable contextStack "" ;# stack of namespace scopes | |
310 | variable imports "" ;# keeps track of all imported cmds | |
311 | variable initCommands "" ;# list of commands that create aliases | |
312 | ||
313 | proc init {} { | |
314 | variable parser | |
315 | variable initCommands | |
316 | ||
317 | if {![interp issafe]} { | |
318 | set parser [interp create -safe] | |
319 | $parser hide info | |
320 | $parser hide rename | |
321 | $parser hide proc | |
322 | $parser hide namespace | |
323 | $parser hide eval | |
324 | $parser hide puts | |
325 | $parser invokehidden namespace delete :: | |
326 | $parser invokehidden proc unknown {args} {} | |
327 | ||
328 | # We'll need access to the "namespace" command within the | |
329 | # interp. Put it back, but move it out of the way. | |
330 | ||
331 | $parser expose namespace | |
332 | $parser invokehidden rename namespace _%@namespace | |
333 | $parser expose eval | |
334 | $parser invokehidden rename eval _%@eval | |
335 | ||
336 | # Install all the registered psuedo-command implementations | |
337 | ||
338 | foreach cmd $initCommands { | |
339 | eval $cmd | |
340 | } | |
341 | } | |
342 | } | |
343 | proc cleanup {} { | |
344 | variable parser | |
345 | interp delete $parser | |
346 | unset parser | |
347 | } | |
348 | } | |
349 | ||
350 | # auto_mkindex_parser::mkindex -- | |
351 | # | |
352 | # Used by the "auto_mkindex" command to create a "tclIndex" file for | |
353 | # the given Tcl source file. Executes the commands in the file, and | |
354 | # handles things like the "proc" command by adding an entry for the | |
355 | # index file. Returns a string that represents the index file. | |
356 | # | |
357 | # Arguments: | |
358 | # file Name of Tcl source file to be indexed. | |
359 | ||
360 | proc auto_mkindex_parser::mkindex {file} { | |
361 | variable parser | |
362 | variable index | |
363 | variable scriptFile | |
364 | variable contextStack | |
365 | variable imports | |
366 | ||
367 | set scriptFile $file | |
368 | ||
369 | set fid [open $file] | |
370 | set contents [read $fid] | |
371 | close $fid | |
372 | ||
373 | # There is one problem with sourcing files into the safe | |
374 | # interpreter: references like "$x" will fail since code is not | |
375 | # really being executed and variables do not really exist. | |
376 | # To avoid this, we replace all $ with \0 (literally, the null char) | |
377 | # later, when getting proc names we will have to reverse this replacement, | |
378 | # in case there were any $ in the proc name. This will cause a problem | |
379 | # if somebody actually tries to have a \0 in their proc name. Too bad | |
380 | # for them. | |
381 | regsub -all {\$} $contents "\0" contents | |
382 | ||
383 | set index "" | |
384 | set contextStack "" | |
385 | set imports "" | |
386 | ||
387 | $parser eval $contents | |
388 | ||
389 | foreach name $imports { | |
390 | catch {$parser eval [list _%@namespace forget $name]} | |
391 | } | |
392 | return $index | |
393 | } | |
394 | ||
395 | # auto_mkindex_parser::hook command | |
396 | # | |
397 | # Registers a Tcl command to evaluate when initializing the | |
398 | # slave interpreter used by the mkindex parser. | |
399 | # The command is evaluated in the master interpreter, and can | |
400 | # use the variable auto_mkindex_parser::parser to get to the slave | |
401 | ||
402 | proc auto_mkindex_parser::hook {cmd} { | |
403 | variable initCommands | |
404 | ||
405 | lappend initCommands $cmd | |
406 | } | |
407 | ||
408 | # auto_mkindex_parser::slavehook command | |
409 | # | |
410 | # Registers a Tcl command to evaluate when initializing the | |
411 | # slave interpreter used by the mkindex parser. | |
412 | # The command is evaluated in the slave interpreter. | |
413 | ||
414 | proc auto_mkindex_parser::slavehook {cmd} { | |
415 | variable initCommands | |
416 | ||
417 | # The $parser variable is defined to be the name of the | |
418 | # slave interpreter when this command is used later. | |
419 | ||
420 | lappend initCommands "\$parser eval [list $cmd]" | |
421 | } | |
422 | ||
423 | # auto_mkindex_parser::command -- | |
424 | # | |
425 | # Registers a new command with the "auto_mkindex_parser" interpreter | |
426 | # that parses Tcl files. These commands are fake versions of things | |
427 | # like the "proc" command. When you execute them, they simply write | |
428 | # out an entry to a "tclIndex" file for auto-loading. | |
429 | # | |
430 | # This procedure allows extensions to register their own commands | |
431 | # with the auto_mkindex facility. For example, a package like | |
432 | # [incr Tcl] might register a "class" command so that class definitions | |
433 | # could be added to a "tclIndex" file for auto-loading. | |
434 | # | |
435 | # Arguments: | |
436 | # name Name of command recognized in Tcl files. | |
437 | # arglist Argument list for command. | |
438 | # body Implementation of command to handle indexing. | |
439 | ||
440 | proc auto_mkindex_parser::command {name arglist body} { | |
441 | hook [list auto_mkindex_parser::commandInit $name $arglist $body] | |
442 | } | |
443 | ||
444 | # auto_mkindex_parser::commandInit -- | |
445 | # | |
446 | # This does the actual work set up by auto_mkindex_parser::command | |
447 | # This is called when the interpreter used by the parser is created. | |
448 | # | |
449 | # Arguments: | |
450 | # name Name of command recognized in Tcl files. | |
451 | # arglist Argument list for command. | |
452 | # body Implementation of command to handle indexing. | |
453 | ||
454 | proc auto_mkindex_parser::commandInit {name arglist body} { | |
455 | variable parser | |
456 | ||
457 | set ns [namespace qualifiers $name] | |
458 | set tail [namespace tail $name] | |
459 | if {[string equal $ns ""]} { | |
460 | set fakeName "[namespace current]::_%@fake_$tail" | |
461 | } else { | |
462 | set fakeName "_%@fake_$name" | |
463 | regsub -all {::} $fakeName "_" fakeName | |
464 | set fakeName "[namespace current]::$fakeName" | |
465 | } | |
466 | proc $fakeName $arglist $body | |
467 | ||
468 | # YUK! Tcl won't let us alias fully qualified command names, | |
469 | # so we can't handle names like "::itcl::class". Instead, | |
470 | # we have to build procs with the fully qualified names, and | |
471 | # have the procs point to the aliases. | |
472 | ||
473 | if {[regexp {::} $name]} { | |
474 | set exportCmd [list _%@namespace export [namespace tail $name]] | |
475 | $parser eval [list _%@namespace eval $ns $exportCmd] | |
476 | ||
477 | # The following proc definition does not work if you | |
478 | # want to tolerate space or something else diabolical | |
479 | # in the procedure name, (i.e., space in $alias) | |
480 | # The following does not work: | |
481 | # "_%@eval {$alias} \$args" | |
482 | # because $alias gets concat'ed to $args. | |
483 | # The following does not work because $cmd is somehow undefined | |
484 | # "set cmd {$alias} \; _%@eval {\$cmd} \$args" | |
485 | # A gold star to someone that can make test | |
486 | # autoMkindex-3.3 work properly | |
487 | ||
488 | set alias [namespace tail $fakeName] | |
489 | $parser invokehidden proc $name {args} "_%@eval {$alias} \$args" | |
490 | $parser alias $alias $fakeName | |
491 | } else { | |
492 | $parser alias $name $fakeName | |
493 | } | |
494 | return | |
495 | } | |
496 | ||
497 | # auto_mkindex_parser::fullname -- | |
498 | # Used by commands like "proc" within the auto_mkindex parser. | |
499 | # Returns the qualified namespace name for the "name" argument. | |
500 | # If the "name" does not start with "::", elements are added from | |
501 | # the current namespace stack to produce a qualified name. Then, | |
502 | # the name is examined to see whether or not it should really be | |
503 | # qualified. If the name has more than the leading "::", it is | |
504 | # returned as a fully qualified name. Otherwise, it is returned | |
505 | # as a simple name. That way, the Tcl autoloader will recognize | |
506 | # it properly. | |
507 | # | |
508 | # Arguments: | |
509 | # name - Name that is being added to index. | |
510 | ||
511 | proc auto_mkindex_parser::fullname {name} { | |
512 | variable contextStack | |
513 | ||
514 | if {![string match ::* $name]} { | |
515 | foreach ns $contextStack { | |
516 | set name "${ns}::$name" | |
517 | if {[string match ::* $name]} { | |
518 | break | |
519 | } | |
520 | } | |
521 | } | |
522 | ||
523 | if {[string equal [namespace qualifiers $name] ""]} { | |
524 | set name [namespace tail $name] | |
525 | } elseif {![string match ::* $name]} { | |
526 | set name "::$name" | |
527 | } | |
528 | ||
529 | # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse | |
530 | # that replacement. | |
531 | regsub -all "\0" $name "\$" name | |
532 | return $name | |
533 | } | |
534 | ||
535 | # Register all of the procedures for the auto_mkindex parser that | |
536 | # will build the "tclIndex" file. | |
537 | ||
538 | # AUTO MKINDEX: proc name arglist body | |
539 | # Adds an entry to the auto index list for the given procedure name. | |
540 | ||
541 | auto_mkindex_parser::command proc {name args} { | |
542 | variable index | |
543 | variable scriptFile | |
544 | # Do some fancy reformatting on the "source" call to handle platform | |
545 | # differences with respect to pathnames. Use format just so that the | |
546 | # command is a little easier to read (otherwise it'd be full of | |
547 | # backslashed dollar signs, etc. | |
548 | append index [list set auto_index([fullname $name])] \ | |
549 | [format { [list source [file join $dir %s]]} \ | |
550 | [file split $scriptFile]] "\n" | |
551 | } | |
552 | ||
553 | # Conditionally add support for Tcl byte code files. There are some | |
554 | # tricky details here. First, we need to get the tbcload library | |
555 | # initialized in the current interpreter. We cannot load tbcload into the | |
556 | # slave until we have done so because it needs access to the tcl_patchLevel | |
557 | # variable. Second, because the package index file may defer loading the | |
558 | # library until we invoke a command, we need to explicitly invoke auto_load | |
559 | # to force it to be loaded. This should be a noop if the package has | |
560 | # already been loaded | |
561 | ||
562 | auto_mkindex_parser::hook { | |
563 | if {![catch {package require tbcload}]} { | |
564 | if {[llength [info commands tbcload::bcproc]] == 0} { | |
565 | auto_load tbcload::bcproc | |
566 | } | |
567 | load {} tbcload $auto_mkindex_parser::parser | |
568 | ||
569 | # AUTO MKINDEX: tbcload::bcproc name arglist body | |
570 | # Adds an entry to the auto index list for the given pre-compiled | |
571 | # procedure name. | |
572 | ||
573 | auto_mkindex_parser::commandInit tbcload::bcproc {name args} { | |
574 | variable index | |
575 | variable scriptFile | |
576 | # Do some nice reformatting of the "source" call, to get around | |
577 | # path differences on different platforms. We use the format | |
578 | # command just so that the code is a little easier to read. | |
579 | append index [list set auto_index([fullname $name])] \ | |
580 | [format { [list source [file join $dir %s]]} \ | |
581 | [file split $scriptFile]] "\n" | |
582 | } | |
583 | } | |
584 | } | |
585 | ||
586 | # AUTO MKINDEX: namespace eval name command ?arg arg...? | |
587 | # Adds the namespace name onto the context stack and evaluates the | |
588 | # associated body of commands. | |
589 | # | |
590 | # AUTO MKINDEX: namespace import ?-force? pattern ?pattern...? | |
591 | # Performs the "import" action in the parser interpreter. This is | |
592 | # important for any commands contained in a namespace that affect | |
593 | # the index. For example, a script may say "itcl::class ...", | |
594 | # or it may import "itcl::*" and then say "class ...". This | |
595 | # procedure does the import operation, but keeps track of imported | |
596 | # patterns so we can remove the imports later. | |
597 | ||
598 | auto_mkindex_parser::command namespace {op args} { | |
599 | switch -- $op { | |
600 | eval { | |
601 | variable parser | |
602 | variable contextStack | |
603 | ||
604 | set name [lindex $args 0] | |
605 | set args [lrange $args 1 end] | |
606 | ||
607 | set contextStack [linsert $contextStack 0 $name] | |
608 | $parser eval [list _%@namespace eval $name] $args | |
609 | set contextStack [lrange $contextStack 1 end] | |
610 | } | |
611 | import { | |
612 | variable parser | |
613 | variable imports | |
614 | foreach pattern $args { | |
615 | if {[string compare $pattern "-force"]} { | |
616 | lappend imports $pattern | |
617 | } | |
618 | } | |
619 | catch {$parser eval "_%@namespace import $args"} | |
620 | } | |
621 | } | |
622 | } | |
623 | ||
624 | return |