os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/library/auto.tcl
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/library/auto.tcl Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,616 @@
1.4 +# auto.tcl --
1.5 +#
1.6 +# utility procs formerly in init.tcl dealing with auto execution
1.7 +# of commands and can be auto loaded themselves.
1.8 +#
1.9 +# RCS: @(#) $Id: auto.tcl,v 1.12.2.10 2005/07/23 03:31:41 dgp Exp $
1.10 +#
1.11 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.12 +# Copyright (c) 1994-1998 Sun Microsystems, Inc.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +
1.18 +# auto_reset --
1.19 +#
1.20 +# Destroy all cached information for auto-loading and auto-execution,
1.21 +# so that the information gets recomputed the next time it's needed.
1.22 +# Also delete any procedures that are listed in the auto-load index
1.23 +# except those defined in this file.
1.24 +#
1.25 +# Arguments:
1.26 +# None.
1.27 +
1.28 +proc auto_reset {} {
1.29 + global auto_execs auto_index auto_oldpath
1.30 + foreach p [info procs] {
1.31 + if {[info exists auto_index($p)] && ![string match auto_* $p]
1.32 + && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
1.33 + tcl_findLibrary pkg_compareExtension
1.34 + tclPkgUnknown tcl::MacOSXPkgUnknown
1.35 + tcl::MacPkgUnknown} $p] < 0)} {
1.36 + rename $p {}
1.37 + }
1.38 + }
1.39 + unset -nocomplain auto_execs auto_index auto_oldpath
1.40 +}
1.41 +
1.42 +# tcl_findLibrary --
1.43 +#
1.44 +# This is a utility for extensions that searches for a library directory
1.45 +# using a canonical searching algorithm. A side effect is to source
1.46 +# the initialization script and set a global library variable.
1.47 +#
1.48 +# Arguments:
1.49 +# basename Prefix of the directory name, (e.g., "tk")
1.50 +# version Version number of the package, (e.g., "8.0")
1.51 +# patch Patchlevel of the package, (e.g., "8.0.3")
1.52 +# initScript Initialization script to source (e.g., tk.tcl)
1.53 +# enVarName environment variable to honor (e.g., TK_LIBRARY)
1.54 +# varName Global variable to set when done (e.g., tk_library)
1.55 +
1.56 +proc tcl_findLibrary {basename version patch initScript enVarName varName} {
1.57 + upvar #0 $varName the_library
1.58 + global env errorInfo
1.59 +
1.60 + set dirs {}
1.61 + set errors {}
1.62 +
1.63 + # The C application may have hardwired a path, which we honor
1.64 +
1.65 + if {[info exists the_library] && $the_library ne ""} {
1.66 + lappend dirs $the_library
1.67 + } else {
1.68 +
1.69 + # Do the canonical search
1.70 +
1.71 + # 1. From an environment variable, if it exists.
1.72 + # Placing this first gives the end-user ultimate control
1.73 + # to work-around any bugs, or to customize.
1.74 +
1.75 + if {[info exists env($enVarName)]} {
1.76 + lappend dirs $env($enVarName)
1.77 + }
1.78 +
1.79 + # 2. In the package script directory registered within
1.80 + # the configuration of the package itself.
1.81 + #
1.82 + # Only do this for Tcl 8.5+, when Tcl_RegsiterConfig() is available.
1.83 + #if {[catch {
1.84 + # ::${basename}::pkgconfig get scriptdir,runtime
1.85 + #} value] == 0} {
1.86 + # lappend dirs $value
1.87 + #}
1.88 +
1.89 + # 3. Relative to auto_path directories. This checks relative to the
1.90 + # Tcl library as well as allowing loading of libraries added to the
1.91 + # auto_path that is not relative to the core library or binary paths.
1.92 + foreach d $::auto_path {
1.93 + lappend dirs [file join $d $basename$version]
1.94 + if {$::tcl_platform(platform) eq "unix"
1.95 + && $::tcl_platform(os) eq "Darwin"} {
1.96 + # 4. On MacOSX, check the Resources/Scripts subdir too
1.97 + lappend dirs [file join $d $basename$version Resources Scripts]
1.98 + }
1.99 + }
1.100 +
1.101 + # 3. Various locations relative to the executable
1.102 + # ../lib/foo1.0 (From bin directory in install hierarchy)
1.103 + # ../../lib/foo1.0 (From bin/arch directory in install hierarchy)
1.104 + # ../library (From unix directory in build hierarchy)
1.105 + set parentDir [file dirname [file dirname [info nameofexecutable]]]
1.106 + set grandParentDir [file dirname $parentDir]
1.107 + lappend dirs [file join $parentDir lib $basename$version]
1.108 + lappend dirs [file join $grandParentDir lib $basename$version]
1.109 + lappend dirs [file join $parentDir library]
1.110 +
1.111 + # Remaining locations are out of date (when relevant, they ought
1.112 + # to be covered by the $::auto_path seach above).
1.113 + #
1.114 + # ../../library (From unix/arch directory in build hierarchy)
1.115 + # ../../foo1.0.1/library
1.116 + # (From unix directory in parallel build hierarchy)
1.117 + # ../../../foo1.0.1/library
1.118 + # (From unix/arch directory in parallel build hierarchy)
1.119 + #
1.120 + # For the sake of extra compatibility safety, we keep adding these
1.121 + # paths during the 8.4.* release series.
1.122 + if {1} {
1.123 + lappend dirs [file join $grandParentDir library]
1.124 + lappend dirs [file join $grandParentDir $basename$patch library]
1.125 + lappend dirs [file join [file dirname $grandParentDir] \
1.126 + $basename$patch library]
1.127 + }
1.128 + }
1.129 + # uniquify $dirs in order
1.130 + array set seen {}
1.131 + foreach i $dirs {
1.132 + # For Tcl 8.4.9, we've disabled the use of [file normalize] here.
1.133 + # This means that two different path names that are the same path
1.134 + # in normalized form, will both remain on the search path. There
1.135 + # should be no harm in that, just a bit more file system access
1.136 + # than is strictly necessary.
1.137 + #
1.138 + # [file normalize] has been disabled because of reports it has
1.139 + # caused difficulties with the freewrap utility. To keep
1.140 + # compatibility with freewrap's needs, we'll keep this disabled
1.141 + # throughout the 8.4.x (x >= 9) releases. See Bug 1072136.
1.142 + if {1 || [interp issafe]} {
1.143 + set norm $i
1.144 + } else {
1.145 + set norm [file normalize $i]
1.146 + }
1.147 + if {[info exists seen($norm)]} { continue }
1.148 + set seen($norm) ""
1.149 + lappend uniqdirs $i
1.150 + }
1.151 + set dirs $uniqdirs
1.152 + foreach i $dirs {
1.153 + set the_library $i
1.154 + set file [file join $i $initScript]
1.155 +
1.156 + # source everything when in a safe interpreter because
1.157 + # we have a source command, but no file exists command
1.158 +
1.159 + if {[interp issafe] || [file exists $file]} {
1.160 + if {![catch {uplevel #0 [list source $file]} msg]} {
1.161 + return
1.162 + } else {
1.163 + append errors "$file: $msg\n$errorInfo\n"
1.164 + }
1.165 + }
1.166 + }
1.167 + unset -nocomplain the_library
1.168 + set msg "Can't find a usable $initScript in the following directories: \n"
1.169 + append msg " $dirs\n\n"
1.170 + append msg "$errors\n\n"
1.171 + append msg "This probably means that $basename wasn't installed properly.\n"
1.172 + error $msg
1.173 +}
1.174 +
1.175 +
1.176 +# ----------------------------------------------------------------------
1.177 +# auto_mkindex
1.178 +# ----------------------------------------------------------------------
1.179 +# The following procedures are used to generate the tclIndex file
1.180 +# from Tcl source files. They use a special safe interpreter to
1.181 +# parse Tcl source files, writing out index entries as "proc"
1.182 +# commands are encountered. This implementation won't work in a
1.183 +# safe interpreter, since a safe interpreter can't create the
1.184 +# special parser and mess with its commands.
1.185 +
1.186 +if {[interp issafe]} {
1.187 + return ;# Stop sourcing the file here
1.188 +}
1.189 +
1.190 +# auto_mkindex --
1.191 +# Regenerate a tclIndex file from Tcl source files. Takes as argument
1.192 +# the name of the directory in which the tclIndex file is to be placed,
1.193 +# followed by any number of glob patterns to use in that directory to
1.194 +# locate all of the relevant files.
1.195 +#
1.196 +# Arguments:
1.197 +# dir - Name of the directory in which to create an index.
1.198 +# args - Any number of additional arguments giving the
1.199 +# names of files within dir. If no additional
1.200 +# are given auto_mkindex will look for *.tcl.
1.201 +
1.202 +proc auto_mkindex {dir args} {
1.203 + global errorCode errorInfo
1.204 +
1.205 + if {[interp issafe]} {
1.206 + error "can't generate index within safe interpreter"
1.207 + }
1.208 +
1.209 + set oldDir [pwd]
1.210 + cd $dir
1.211 + set dir [pwd]
1.212 +
1.213 + append index "# Tcl autoload index file, version 2.0\n"
1.214 + append index "# This file is generated by the \"auto_mkindex\" command\n"
1.215 + append index "# and sourced to set up indexing information for one or\n"
1.216 + append index "# more commands. Typically each line is a command that\n"
1.217 + append index "# sets an element in the auto_index array, where the\n"
1.218 + append index "# element name is the name of a command and the value is\n"
1.219 + append index "# a script that loads the command.\n\n"
1.220 + if {[llength $args] == 0} {
1.221 + set args *.tcl
1.222 + }
1.223 +
1.224 + auto_mkindex_parser::init
1.225 + foreach file [eval [linsert $args 0 glob --]] {
1.226 + if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
1.227 + append index $msg
1.228 + } else {
1.229 + set code $errorCode
1.230 + set info $errorInfo
1.231 + cd $oldDir
1.232 + error $msg $info $code
1.233 + }
1.234 + }
1.235 + auto_mkindex_parser::cleanup
1.236 +
1.237 + set fid [open "tclIndex" w]
1.238 + puts -nonewline $fid $index
1.239 + close $fid
1.240 + cd $oldDir
1.241 +}
1.242 +
1.243 +# Original version of auto_mkindex that just searches the source
1.244 +# code for "proc" at the beginning of the line.
1.245 +
1.246 +proc auto_mkindex_old {dir args} {
1.247 + global errorCode errorInfo
1.248 + set oldDir [pwd]
1.249 + cd $dir
1.250 + set dir [pwd]
1.251 + append index "# Tcl autoload index file, version 2.0\n"
1.252 + append index "# This file is generated by the \"auto_mkindex\" command\n"
1.253 + append index "# and sourced to set up indexing information for one or\n"
1.254 + append index "# more commands. Typically each line is a command that\n"
1.255 + append index "# sets an element in the auto_index array, where the\n"
1.256 + append index "# element name is the name of a command and the value is\n"
1.257 + append index "# a script that loads the command.\n\n"
1.258 + if {[llength $args] == 0} {
1.259 + set args *.tcl
1.260 + }
1.261 + foreach file [eval [linsert $args 0 glob --]] {
1.262 + set f ""
1.263 + set error [catch {
1.264 + set f [open $file]
1.265 + while {[gets $f line] >= 0} {
1.266 + if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
1.267 + set procName [lindex [auto_qualify $procName "::"] 0]
1.268 + append index "set [list auto_index($procName)]"
1.269 + append index " \[list source \[file join \$dir [list $file]\]\]\n"
1.270 + }
1.271 + }
1.272 + close $f
1.273 + } msg]
1.274 + if {$error} {
1.275 + set code $errorCode
1.276 + set info $errorInfo
1.277 + catch {close $f}
1.278 + cd $oldDir
1.279 + error $msg $info $code
1.280 + }
1.281 + }
1.282 + set f ""
1.283 + set error [catch {
1.284 + set f [open tclIndex w]
1.285 + puts -nonewline $f $index
1.286 + close $f
1.287 + cd $oldDir
1.288 + } msg]
1.289 + if {$error} {
1.290 + set code $errorCode
1.291 + set info $errorInfo
1.292 + catch {close $f}
1.293 + cd $oldDir
1.294 + error $msg $info $code
1.295 + }
1.296 +}
1.297 +
1.298 +# Create a safe interpreter that can be used to parse Tcl source files
1.299 +# generate a tclIndex file for autoloading. This interp contains
1.300 +# commands for things that need index entries. Each time a command
1.301 +# is executed, it writes an entry out to the index file.
1.302 +
1.303 +namespace eval auto_mkindex_parser {
1.304 + variable parser "" ;# parser used to build index
1.305 + variable index "" ;# maintains index as it is built
1.306 + variable scriptFile "" ;# name of file being processed
1.307 + variable contextStack "" ;# stack of namespace scopes
1.308 + variable imports "" ;# keeps track of all imported cmds
1.309 + variable initCommands "" ;# list of commands that create aliases
1.310 +
1.311 + proc init {} {
1.312 + variable parser
1.313 + variable initCommands
1.314 +
1.315 + if {![interp issafe]} {
1.316 + set parser [interp create -safe]
1.317 + $parser hide info
1.318 + $parser hide rename
1.319 + $parser hide proc
1.320 + $parser hide namespace
1.321 + $parser hide eval
1.322 + $parser hide puts
1.323 + $parser invokehidden namespace delete ::
1.324 + $parser invokehidden proc unknown {args} {}
1.325 +
1.326 + # We'll need access to the "namespace" command within the
1.327 + # interp. Put it back, but move it out of the way.
1.328 +
1.329 + $parser expose namespace
1.330 + $parser invokehidden rename namespace _%@namespace
1.331 + $parser expose eval
1.332 + $parser invokehidden rename eval _%@eval
1.333 +
1.334 + # Install all the registered psuedo-command implementations
1.335 +
1.336 + foreach cmd $initCommands {
1.337 + eval $cmd
1.338 + }
1.339 + }
1.340 + }
1.341 + proc cleanup {} {
1.342 + variable parser
1.343 + interp delete $parser
1.344 + unset parser
1.345 + }
1.346 +}
1.347 +
1.348 +# auto_mkindex_parser::mkindex --
1.349 +#
1.350 +# Used by the "auto_mkindex" command to create a "tclIndex" file for
1.351 +# the given Tcl source file. Executes the commands in the file, and
1.352 +# handles things like the "proc" command by adding an entry for the
1.353 +# index file. Returns a string that represents the index file.
1.354 +#
1.355 +# Arguments:
1.356 +# file Name of Tcl source file to be indexed.
1.357 +
1.358 +proc auto_mkindex_parser::mkindex {file} {
1.359 + variable parser
1.360 + variable index
1.361 + variable scriptFile
1.362 + variable contextStack
1.363 + variable imports
1.364 +
1.365 + set scriptFile $file
1.366 +
1.367 + set fid [open $file]
1.368 + set contents [read $fid]
1.369 + close $fid
1.370 +
1.371 + # There is one problem with sourcing files into the safe
1.372 + # interpreter: references like "$x" will fail since code is not
1.373 + # really being executed and variables do not really exist.
1.374 + # To avoid this, we replace all $ with \0 (literally, the null char)
1.375 + # later, when getting proc names we will have to reverse this replacement,
1.376 + # in case there were any $ in the proc name. This will cause a problem
1.377 + # if somebody actually tries to have a \0 in their proc name. Too bad
1.378 + # for them.
1.379 + set contents [string map "$ \u0000" $contents]
1.380 +
1.381 + set index ""
1.382 + set contextStack ""
1.383 + set imports ""
1.384 +
1.385 + $parser eval $contents
1.386 +
1.387 + foreach name $imports {
1.388 + catch {$parser eval [list _%@namespace forget $name]}
1.389 + }
1.390 + return $index
1.391 +}
1.392 +
1.393 +# auto_mkindex_parser::hook command
1.394 +#
1.395 +# Registers a Tcl command to evaluate when initializing the
1.396 +# slave interpreter used by the mkindex parser.
1.397 +# The command is evaluated in the master interpreter, and can
1.398 +# use the variable auto_mkindex_parser::parser to get to the slave
1.399 +
1.400 +proc auto_mkindex_parser::hook {cmd} {
1.401 + variable initCommands
1.402 +
1.403 + lappend initCommands $cmd
1.404 +}
1.405 +
1.406 +# auto_mkindex_parser::slavehook command
1.407 +#
1.408 +# Registers a Tcl command to evaluate when initializing the
1.409 +# slave interpreter used by the mkindex parser.
1.410 +# The command is evaluated in the slave interpreter.
1.411 +
1.412 +proc auto_mkindex_parser::slavehook {cmd} {
1.413 + variable initCommands
1.414 +
1.415 + # The $parser variable is defined to be the name of the
1.416 + # slave interpreter when this command is used later.
1.417 +
1.418 + lappend initCommands "\$parser eval [list $cmd]"
1.419 +}
1.420 +
1.421 +# auto_mkindex_parser::command --
1.422 +#
1.423 +# Registers a new command with the "auto_mkindex_parser" interpreter
1.424 +# that parses Tcl files. These commands are fake versions of things
1.425 +# like the "proc" command. When you execute them, they simply write
1.426 +# out an entry to a "tclIndex" file for auto-loading.
1.427 +#
1.428 +# This procedure allows extensions to register their own commands
1.429 +# with the auto_mkindex facility. For example, a package like
1.430 +# [incr Tcl] might register a "class" command so that class definitions
1.431 +# could be added to a "tclIndex" file for auto-loading.
1.432 +#
1.433 +# Arguments:
1.434 +# name Name of command recognized in Tcl files.
1.435 +# arglist Argument list for command.
1.436 +# body Implementation of command to handle indexing.
1.437 +
1.438 +proc auto_mkindex_parser::command {name arglist body} {
1.439 + hook [list auto_mkindex_parser::commandInit $name $arglist $body]
1.440 +}
1.441 +
1.442 +# auto_mkindex_parser::commandInit --
1.443 +#
1.444 +# This does the actual work set up by auto_mkindex_parser::command
1.445 +# This is called when the interpreter used by the parser is created.
1.446 +#
1.447 +# Arguments:
1.448 +# name Name of command recognized in Tcl files.
1.449 +# arglist Argument list for command.
1.450 +# body Implementation of command to handle indexing.
1.451 +
1.452 +proc auto_mkindex_parser::commandInit {name arglist body} {
1.453 + variable parser
1.454 +
1.455 + set ns [namespace qualifiers $name]
1.456 + set tail [namespace tail $name]
1.457 + if {$ns eq ""} {
1.458 + set fakeName [namespace current]::_%@fake_$tail
1.459 + } else {
1.460 + set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
1.461 + }
1.462 + proc $fakeName $arglist $body
1.463 +
1.464 + # YUK! Tcl won't let us alias fully qualified command names,
1.465 + # so we can't handle names like "::itcl::class". Instead,
1.466 + # we have to build procs with the fully qualified names, and
1.467 + # have the procs point to the aliases.
1.468 +
1.469 + if {[string match *::* $name]} {
1.470 + set exportCmd [list _%@namespace export [namespace tail $name]]
1.471 + $parser eval [list _%@namespace eval $ns $exportCmd]
1.472 +
1.473 + # The following proc definition does not work if you
1.474 + # want to tolerate space or something else diabolical
1.475 + # in the procedure name, (i.e., space in $alias)
1.476 + # The following does not work:
1.477 + # "_%@eval {$alias} \$args"
1.478 + # because $alias gets concat'ed to $args.
1.479 + # The following does not work because $cmd is somehow undefined
1.480 + # "set cmd {$alias} \; _%@eval {\$cmd} \$args"
1.481 + # A gold star to someone that can make test
1.482 + # autoMkindex-3.3 work properly
1.483 +
1.484 + set alias [namespace tail $fakeName]
1.485 + $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
1.486 + $parser alias $alias $fakeName
1.487 + } else {
1.488 + $parser alias $name $fakeName
1.489 + }
1.490 + return
1.491 +}
1.492 +
1.493 +# auto_mkindex_parser::fullname --
1.494 +# Used by commands like "proc" within the auto_mkindex parser.
1.495 +# Returns the qualified namespace name for the "name" argument.
1.496 +# If the "name" does not start with "::", elements are added from
1.497 +# the current namespace stack to produce a qualified name. Then,
1.498 +# the name is examined to see whether or not it should really be
1.499 +# qualified. If the name has more than the leading "::", it is
1.500 +# returned as a fully qualified name. Otherwise, it is returned
1.501 +# as a simple name. That way, the Tcl autoloader will recognize
1.502 +# it properly.
1.503 +#
1.504 +# Arguments:
1.505 +# name - Name that is being added to index.
1.506 +
1.507 +proc auto_mkindex_parser::fullname {name} {
1.508 + variable contextStack
1.509 +
1.510 + if {![string match ::* $name]} {
1.511 + foreach ns $contextStack {
1.512 + set name "${ns}::$name"
1.513 + if {[string match ::* $name]} {
1.514 + break
1.515 + }
1.516 + }
1.517 + }
1.518 +
1.519 + if {[namespace qualifiers $name] eq ""} {
1.520 + set name [namespace tail $name]
1.521 + } elseif {![string match ::* $name]} {
1.522 + set name "::$name"
1.523 + }
1.524 +
1.525 + # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse
1.526 + # that replacement.
1.527 + return [string map "\u0000 $" $name]
1.528 +}
1.529 +
1.530 +# Register all of the procedures for the auto_mkindex parser that
1.531 +# will build the "tclIndex" file.
1.532 +
1.533 +# AUTO MKINDEX: proc name arglist body
1.534 +# Adds an entry to the auto index list for the given procedure name.
1.535 +
1.536 +auto_mkindex_parser::command proc {name args} {
1.537 + variable index
1.538 + variable scriptFile
1.539 + # Do some fancy reformatting on the "source" call to handle platform
1.540 + # differences with respect to pathnames. Use format just so that the
1.541 + # command is a little easier to read (otherwise it'd be full of
1.542 + # backslashed dollar signs, etc.
1.543 + append index [list set auto_index([fullname $name])] \
1.544 + [format { [list source [file join $dir %s]]} \
1.545 + [file split $scriptFile]] "\n"
1.546 +}
1.547 +
1.548 +# Conditionally add support for Tcl byte code files. There are some
1.549 +# tricky details here. First, we need to get the tbcload library
1.550 +# initialized in the current interpreter. We cannot load tbcload into the
1.551 +# slave until we have done so because it needs access to the tcl_patchLevel
1.552 +# variable. Second, because the package index file may defer loading the
1.553 +# library until we invoke a command, we need to explicitly invoke auto_load
1.554 +# to force it to be loaded. This should be a noop if the package has
1.555 +# already been loaded
1.556 +
1.557 +auto_mkindex_parser::hook {
1.558 + if {![catch {package require tbcload}]} {
1.559 + if {[namespace which -command tbcload::bcproc] eq ""} {
1.560 + auto_load tbcload::bcproc
1.561 + }
1.562 + load {} tbcload $auto_mkindex_parser::parser
1.563 +
1.564 + # AUTO MKINDEX: tbcload::bcproc name arglist body
1.565 + # Adds an entry to the auto index list for the given pre-compiled
1.566 + # procedure name.
1.567 +
1.568 + auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
1.569 + variable index
1.570 + variable scriptFile
1.571 + # Do some nice reformatting of the "source" call, to get around
1.572 + # path differences on different platforms. We use the format
1.573 + # command just so that the code is a little easier to read.
1.574 + append index [list set auto_index([fullname $name])] \
1.575 + [format { [list source [file join $dir %s]]} \
1.576 + [file split $scriptFile]] "\n"
1.577 + }
1.578 + }
1.579 +}
1.580 +
1.581 +# AUTO MKINDEX: namespace eval name command ?arg arg...?
1.582 +# Adds the namespace name onto the context stack and evaluates the
1.583 +# associated body of commands.
1.584 +#
1.585 +# AUTO MKINDEX: namespace import ?-force? pattern ?pattern...?
1.586 +# Performs the "import" action in the parser interpreter. This is
1.587 +# important for any commands contained in a namespace that affect
1.588 +# the index. For example, a script may say "itcl::class ...",
1.589 +# or it may import "itcl::*" and then say "class ...". This
1.590 +# procedure does the import operation, but keeps track of imported
1.591 +# patterns so we can remove the imports later.
1.592 +
1.593 +auto_mkindex_parser::command namespace {op args} {
1.594 + switch -- $op {
1.595 + eval {
1.596 + variable parser
1.597 + variable contextStack
1.598 +
1.599 + set name [lindex $args 0]
1.600 + set args [lrange $args 1 end]
1.601 +
1.602 + set contextStack [linsert $contextStack 0 $name]
1.603 + $parser eval [list _%@namespace eval $name] $args
1.604 + set contextStack [lrange $contextStack 1 end]
1.605 + }
1.606 + import {
1.607 + variable parser
1.608 + variable imports
1.609 + foreach pattern $args {
1.610 + if {$pattern ne "-force"} {
1.611 + lappend imports $pattern
1.612 + }
1.613 + }
1.614 + catch {$parser eval "_%@namespace import $args"}
1.615 + }
1.616 + }
1.617 +}
1.618 +
1.619 +return