summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2021-07-16 06:04:38 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2021-07-16 06:04:38 (GMT)
commit1523ce53c14f5ee915c69aa29b75395a1a5286de (patch)
tree072b7739452454026e41e521934a00800b91a334 /library
parent68dc740f26b2dcfa851eccb83abe9dbddd557518 (diff)
downloadtcl-1523ce53c14f5ee915c69aa29b75395a1a5286de.zip
tcl-1523ce53c14f5ee915c69aa29b75395a1a5286de.tar.gz
tcl-1523ce53c14f5ee915c69aa29b75395a1a5286de.tar.bz2
comment clean-up
Diffstat (limited to 'library')
-rw-r--r--library/auto.tcl340
-rw-r--r--library/safe.tcl2
2 files changed, 169 insertions, 173 deletions
diff --git a/library/auto.tcl b/library/auto.tcl
index 32a5f52..1b8ad44 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -1,20 +1,20 @@
# auto.tcl --
#
-# utility procs formerly in init.tcl dealing with auto execution
-# of commands and can be auto loaded themselves.
+# utility procs formerly in init.tcl dealing with auto execution of commands
+# and can be auto loaded themselves.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# auto_reset --
#
-# Destroy all cached information for auto-loading and auto-execution,
-# so that the information gets recomputed the next time it's needed.
-# Also delete any commands that are listed in the auto-load index.
+# Destroy all cached information for auto-loading and auto-execution, so that
+# the information gets recomputed the next time it's needed. Also delete any
+# commands that are listed in the auto-load index.
#
# Arguments:
# None.
@@ -24,25 +24,25 @@ proc auto_reset {} {
if {[array exists auto_index]} {
foreach cmdName [array names auto_index] {
set fqcn [namespace which $cmdName]
- if {$fqcn eq ""} {continue}
+ if {$fqcn eq ""} {
+ continue
+ }
rename $fqcn {}
}
}
unset -nocomplain auto_execs auto_index ::tcl::auto_oldpath
if {[catch {llength $auto_path}]} {
set auto_path [list [info library]]
- } else {
- if {[info library] ni $auto_path} {
- lappend auto_path [info library]
- }
+ } elseif {[info library] ni $auto_path} {
+ lappend auto_path [info library]
}
}
# tcl_findLibrary --
#
# This is a utility for extensions that searches for a library directory
-# using a canonical searching algorithm. A side effect is to source
-# the initialization script and set a global library variable.
+# using a canonical searching algorithm. A side effect is to source the
+# initialization script and set a global library variable.
#
# Arguments:
# basename Prefix of the directory name, (e.g., "tk")
@@ -64,19 +64,18 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
if {[info exists the_library] && $the_library ne ""} {
lappend dirs $the_library
} else {
-
# Do the canonical search
- # 1. From an environment variable, if it exists.
- # Placing this first gives the end-user ultimate control
- # to work-around any bugs, or to customize.
+ # 1. From an environment variable, if it exists. Placing this first
+ # gives the end-user ultimate control to work-around any bugs, or
+ # to customize.
- if {[info exists env($enVarName)]} {
- lappend dirs $env($enVarName)
- }
+ if {[info exists env($enVarName)]} {
+ lappend dirs $env($enVarName)
+ }
- # 2. In the package script directory registered within
- # the configuration of the package itself.
+ # 2. In the package script directory registered within the
+ # configuration of the package itself.
if {[catch {
::${basename}::pkgconfig get scriptdir,runtime
@@ -101,8 +100,8 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
# ../../lib/foo1.0 (From bin/arch directory in install hierarchy)
# ../library (From unix directory in build hierarchy)
#
- # Remaining locations are out of date (when relevant, they ought
- # to be covered by the $::auto_path seach above) and disabled.
+ # Remaining locations are out of date (when relevant, they ought to be
+ # covered by the $::auto_path seach above) and disabled.
#
# ../../library (From unix/arch directory in build hierarchy)
# ../../foo1.0.1/library
@@ -110,11 +109,11 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
# ../../../foo1.0.1/library
# (From unix/arch directory in parallel build hierarchy)
- set parentDir [file dirname [file dirname [info nameofexecutable]]]
- set grandParentDir [file dirname $parentDir]
- lappend dirs [file join $parentDir lib $basename$version]
- lappend dirs [file join $grandParentDir lib $basename$version]
- lappend dirs [file join $parentDir library]
+ set parentDir [file dirname [file dirname [info nameofexecutable]]]
+ set grandParentDir [file dirname $parentDir]
+ lappend dirs [file join $parentDir lib $basename$version]
+ lappend dirs [file join $grandParentDir lib $basename$version]
+ lappend dirs [file join $parentDir library]
if {0} {
lappend dirs [file join $grandParentDir library]
lappend dirs [file join $grandParentDir $basename$patch library]
@@ -134,26 +133,29 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
} else {
set norm [file normalize $i]
}
- if {[info exists seen($norm)]} { continue }
- set seen($norm) ""
+ if {[info exists seen($norm)]} {
+ continue
+ }
+ set seen($norm) {}
+
lappend uniqdirs $i
}
set dirs $uniqdirs
foreach i $dirs {
- set the_library $i
- set file [file join $i $initScript]
+ set the_library $i
+ set file [file join $i $initScript]
# source everything when in a safe interpreter because
# we have a source command, but no file exists command
- if {[interp issafe] || [file exists $file]} {
- if {![catch {uplevel #0 [list source $file]} msg opts]} {
- return
- } else {
- append errors "$file: $msg\n"
+ if {[interp issafe] || [file exists $file]} {
+ if {![catch {uplevel #0 [list source $file]} msg opts]} {
+ return
+ } else {
+ append errors "$file: $msg\n"
append errors [dict get $opts -errorinfo]\n
- }
- }
+ }
+ }
}
unset -nocomplain the_library
set msg "Can't find a usable $initScript in the following directories: \n"
@@ -167,32 +169,32 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
# ----------------------------------------------------------------------
# auto_mkindex
# ----------------------------------------------------------------------
-# The following procedures are used to generate the tclIndex file
-# from Tcl source files. They use a special safe interpreter to
-# parse Tcl source files, writing out index entries as "proc"
-# commands are encountered. This implementation won't work in a
-# safe interpreter, since a safe interpreter can't create the
-# special parser and mess with its commands.
+# The following procedures are used to generate the tclIndex file from Tcl
+# source files. They use a special safe interpreter to parse Tcl source
+# files, writing out index entries as "proc" commands are encountered. This
+# implementation won't work in a safe interpreter, since a safe interpreter
+# can't create the special parser and mess with its commands.
if {[interp issafe]} {
return ;# Stop sourcing the file here
}
# auto_mkindex --
-# Regenerate a tclIndex file from Tcl source files. Takes as argument
-# the name of the directory in which the tclIndex file is to be placed,
-# followed by any number of glob patterns to use in that directory to
-# locate all of the relevant files.
+# Regenerate a tclIndex file from Tcl source files. Takes as argument the
+# name of the directory in which the tclIndex file is to be placed, followed
+# by any number of glob patterns to use in that directory to locate all of the
+# relevant files.
#
# Arguments:
# dir - Name of the directory in which to create an index.
-# args - Any number of additional arguments giving the
-# names of files within dir. If no additional
-# are given auto_mkindex will look for *.tcl.
+
+# args - Any number of additional arguments giving the names of files
+# within dir. If no additional are given auto_mkindex will look
+# for *.tcl.
proc auto_mkindex {dir args} {
if {[interp issafe]} {
- error "can't generate index within safe interpreter"
+ error "can't generate index within safe interpreter"
}
set oldDir [pwd]
@@ -206,18 +208,18 @@ proc auto_mkindex {dir args} {
append index "# sets an element in the auto_index array, where the\n"
append index "# element name is the name of a command and the value is\n"
append index "# a script that loads the command.\n\n"
- if {[llength $args] == 0} {
+ if {![llength $args]} {
set args *.tcl
}
auto_mkindex_parser::init
foreach file [lsort [glob -- {*}$args]] {
- if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} {
- append index $msg
- } else {
- cd $oldDir
+ if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} {
+ append index $msg
+ } else {
+ cd $oldDir
return -options $opts $msg
- }
+ }
}
auto_mkindex_parser::cleanup
@@ -227,8 +229,8 @@ proc auto_mkindex {dir args} {
cd $oldDir
}
-# Original version of auto_mkindex that just searches the source
-# code for "proc" at the beginning of the line.
+# Original version of auto_mkindex that just searches the source code for
+# "proc" at the beginning of the line.
proc auto_mkindex_old {dir args} {
set oldDir [pwd]
@@ -241,7 +243,7 @@ proc auto_mkindex_old {dir args} {
append index "# sets an element in the auto_index array, where the\n"
append index "# element name is the name of a command and the value is\n"
append index "# a script that loads the command.\n\n"
- if {[llength $args] == 0} {
+ if {![llength $args]} {
set args *.tcl
}
foreach file [lsort [glob -- {*}$args]] {
@@ -280,9 +282,9 @@ proc auto_mkindex_old {dir args} {
}
# Create a safe interpreter that can be used to parse Tcl source files
-# generate a tclIndex file for autoloading. This interp contains
-# commands for things that need index entries. Each time a command
-# is executed, it writes an entry out to the index file.
+# generate a tclIndex file for autoloading. This interp contains commands for
+# things that need index entries. Each time a command is executed, it writes
+# an entry out to the index file.
namespace eval auto_mkindex_parser {
variable parser "" ;# parser used to build index
@@ -334,10 +336,10 @@ namespace eval auto_mkindex_parser {
# auto_mkindex_parser::mkindex --
#
-# Used by the "auto_mkindex" command to create a "tclIndex" file for
-# the given Tcl source file. Executes the commands in the file, and
-# handles things like the "proc" command by adding an entry for the
-# index file. Returns a string that represents the index file.
+# Used by the "auto_mkindex" command to create a "tclIndex" file for the given
+# Tcl source file. Executes the commands in the file, and handles things like
+# the "proc" command by adding an entry for the index file. Returns a string
+# that represents the index file.
#
# Arguments:
# file Name of Tcl source file to be indexed.
@@ -356,14 +358,13 @@ proc auto_mkindex_parser::mkindex {file} {
set contents [read $fid]
close $fid
- # There is one problem with sourcing files into the safe
- # interpreter: references like "$x" will fail since code is not
- # really being executed and variables do not really exist.
- # To avoid this, we replace all $ with \0 (literally, the null char)
- # later, when getting proc names we will have to reverse this replacement,
- # in case there were any $ in the proc name. This will cause a problem
- # if somebody actually tries to have a \0 in their proc name. Too bad
- # for them.
+ # There is one problem with sourcing files into the safe interpreter:
+ # references like "$x" will fail since code is not really being executed
+ # and variables do not really exist. To avoid this, we replace all $ with
+ # \0 (literally, the null char) later, when getting proc names we will
+ # have to reverse this replacement, in case there were any $ in the proc
+ # name. This will cause a problem if somebody actually tries to have a \0
+ # in their proc name. Too bad for them.
set contents [string map [list \$ \0] $contents]
set index ""
@@ -373,17 +374,17 @@ proc auto_mkindex_parser::mkindex {file} {
$parser eval $contents
foreach name $imports {
- catch {$parser eval [list _%@namespace forget $name]}
+ catch {$parser eval [list _%@namespace forget $name]}
}
return $index
}
# auto_mkindex_parser::hook command
#
-# Registers a Tcl command to evaluate when initializing the
-# slave interpreter used by the mkindex parser.
-# The command is evaluated in the master interpreter, and can
-# use the variable auto_mkindex_parser::parser to get to the slave
+# Registers a Tcl command to evaluate when initializing the slave interpreter
+# used by the mkindex parser. The command is evaluated in the master
+# interpreter, and can use the variable auto_mkindex_parser::parser to get to
+# the slave
proc auto_mkindex_parser::hook {cmd} {
variable initCommands
@@ -393,30 +394,30 @@ proc auto_mkindex_parser::hook {cmd} {
# auto_mkindex_parser::slavehook command
#
-# Registers a Tcl command to evaluate when initializing the
-# slave interpreter used by the mkindex parser.
-# The command is evaluated in the slave interpreter.
+# Registers a Tcl command to evaluate when initializing the slave interpreter
+# used by the mkindex parser. The command is evaluated in the slave
+# interpreter.
proc auto_mkindex_parser::slavehook {cmd} {
variable initCommands
- # The $parser variable is defined to be the name of the
- # slave interpreter when this command is used later.
+ # The $parser variable is defined to be the name of the slave interpreter
+ # when this command is used later.
lappend initCommands "\$parser eval [list $cmd]"
}
# auto_mkindex_parser::command --
#
-# Registers a new command with the "auto_mkindex_parser" interpreter
-# that parses Tcl files. These commands are fake versions of things
-# like the "proc" command. When you execute them, they simply write
-# out an entry to a "tclIndex" file for auto-loading.
+# Registers a new command with the "auto_mkindex_parser" interpreter that
+# parses Tcl files. These commands are fake versions of things like the
+# "proc" command. When you execute them, they simply write out an entry to a
+# "tclIndex" file for auto-loading.
#
-# This procedure allows extensions to register their own commands
-# with the auto_mkindex facility. For example, a package like
-# [incr Tcl] might register a "class" command so that class definitions
-# could be added to a "tclIndex" file for auto-loading.
+# This procedure allows extensions to register their own commands with the
+# auto_mkindex facility. For example, a package like [incr Tcl] might
+# register a "class" command so that class definitions could be added to a
+# "tclIndex" file for auto-loading.
#
# Arguments:
# name Name of command recognized in Tcl files.
@@ -429,8 +430,8 @@ proc auto_mkindex_parser::command {name arglist body} {
# auto_mkindex_parser::commandInit --
#
-# This does the actual work set up by auto_mkindex_parser::command
-# This is called when the interpreter used by the parser is created.
+# This does the actual work set up by auto_mkindex_parser::command. This is
+# called when the interpreter used by the parser is created.
#
# Arguments:
# name Name of command recognized in Tcl files.
@@ -443,51 +444,48 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
set ns [namespace qualifiers $name]
set tail [namespace tail $name]
if {$ns eq ""} {
- set fakeName [namespace current]::_%@fake_$tail
+ set fakeName [namespace current]::_%@fake_$tail
} else {
- set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
+ set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
}
proc $fakeName $arglist $body
- # YUK! Tcl won't let us alias fully qualified command names,
- # so we can't handle names like "::itcl::class". Instead,
- # we have to build procs with the fully qualified names, and
- # have the procs point to the aliases.
+ # YUK! Tcl won't let us alias fully qualified command names, so we can't
+ # handle names like "::itcl::class". Instead, we have to build procs with
+ # the fully qualified names, and have the procs point to the aliases.
if {[string match *::* $name]} {
- set exportCmd [list _%@namespace export [namespace tail $name]]
- $parser eval [list _%@namespace eval $ns $exportCmd]
+ set exportCmd [list _%@namespace export [namespace tail $name]]
+ $parser eval [list _%@namespace eval $ns $exportCmd]
- # The following proc definition does not work if you
- # want to tolerate space or something else diabolical
- # in the procedure name, (i.e., space in $alias)
- # The following does not work:
+ # The following proc definition does not work if you want to tolerate
+ # space or something else diabolical in the procedure name, (i.e.,
+ # space in $alias). The following does not work:
# "_%@eval {$alias} \$args"
- # because $alias gets concat'ed to $args.
- # The following does not work because $cmd is somehow undefined
+ # because $alias gets concat'ed to $args. The following does not work
+ # because $cmd is somehow undefined
# "set cmd {$alias} \; _%@eval {\$cmd} \$args"
- # A gold star to someone that can make test
- # autoMkindex-3.3 work properly
+ # A gold star to someone that can make test autoMkindex-3.3 work
+ # properly
- set alias [namespace tail $fakeName]
- $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
- $parser alias $alias $fakeName
+ set alias [namespace tail $fakeName]
+ $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
+ $parser alias $alias $fakeName
} else {
- $parser alias $name $fakeName
+ $parser alias $name $fakeName
}
return
}
# auto_mkindex_parser::fullname --
-# Used by commands like "proc" within the auto_mkindex parser.
-# Returns the qualified namespace name for the "name" argument.
-# If the "name" does not start with "::", elements are added from
-# the current namespace stack to produce a qualified name. Then,
-# the name is examined to see whether or not it should really be
-# qualified. If the name has more than the leading "::", it is
-# returned as a fully qualified name. Otherwise, it is returned
-# as a simple name. That way, the Tcl autoloader will recognize
-# it properly.
+#
+# Used by commands like "proc" within the auto_mkindex parser. Returns the
+# qualified namespace name for the "name" argument. If the "name" does not
+# start with "::", elements are added from the current namespace stack to
+# produce a qualified name. Then, the name is examined to see whether or not
+# it should really be qualified. If the name has more than the leading "::",
+# it is returned as a fully qualified name. Otherwise, it is returned as a
+# simple name. That way, the Tcl autoloader will recognize it properly.
#
# Arguments:
# name - Name that is being added to index.
@@ -496,22 +494,22 @@ proc auto_mkindex_parser::fullname {name} {
variable contextStack
if {![string match ::* $name]} {
- foreach ns $contextStack {
- set name "${ns}::$name"
- if {[string match ::* $name]} {
- break
- }
- }
+ foreach ns $contextStack {
+ set name "${ns}::$name"
+ if {[string match ::* $name]} {
+ break
+ }
+ }
}
if {[namespace qualifiers $name] eq ""} {
- set name [namespace tail $name]
+ set name [namespace tail $name]
} elseif {![string match ::* $name]} {
- set name "::$name"
+ set name "::$name"
}
- # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse
- # that replacement.
+ # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse that
+ # replacement.
return [string map [list \0 \$] $name]
}
@@ -537,14 +535,13 @@ auto_mkindex_parser::command proc {name args} {
[file split $scriptFile]] "\n"
}
-# Conditionally add support for Tcl byte code files. There are some
-# tricky details here. First, we need to get the tbcload library
-# initialized in the current interpreter. We cannot load tbcload into the
-# slave until we have done so because it needs access to the tcl_patchLevel
-# variable. Second, because the package index file may defer loading the
-# library until we invoke a command, we need to explicitly invoke auto_load
-# to force it to be loaded. This should be a noop if the package has
-# already been loaded
+# Conditionally add support for Tcl byte code files. There are some tricky
+# details here. First, we need to get the tbcload library initialized in the
+# current interpreter. We cannot load tbcload into the slave until we have
+# done so because it needs access to the tcl_patchLevel variable. Second,
+# because the package index file may defer loading the library until we invoke
+# a command, we need to explicitly invoke auto_load to force it to be loaded.
+# This should be a noop if the package has already been loaded
auto_mkindex_parser::hook {
if {![catch {package require tbcload}]} {
@@ -571,40 +568,39 @@ auto_mkindex_parser::hook {
}
# AUTO MKINDEX: namespace eval name command ?arg arg...?
-# Adds the namespace name onto the context stack and evaluates the
-# associated body of commands.
+# Adds the namespace name onto the context stack and evaluates the associated
+# body of commands.
#
# AUTO MKINDEX: namespace import ?-force? pattern ?pattern...?
-# Performs the "import" action in the parser interpreter. This is
-# important for any commands contained in a namespace that affect
-# the index. For example, a script may say "itcl::class ...",
-# or it may import "itcl::*" and then say "class ...". This
-# procedure does the import operation, but keeps track of imported
-# patterns so we can remove the imports later.
+# Performs the "import" action in the parser interpreter. This is important
+# for any commands contained in a namespace that affect the index. For
+# example, a script may say "itcl::class ...", or it may import "itcl::*" and
+# then say "class ...". This procedure does the import operation, but keeps
+# track of imported patterns so we can remove the imports later.
auto_mkindex_parser::command namespace {op args} {
switch -- $op {
- eval {
- variable parser
- variable contextStack
+ eval {
+ variable parser
+ variable contextStack
- set name [lindex $args 0]
- set args [lrange $args 1 end]
+ set name [lindex $args 0]
+ set args [lrange $args 1 end]
- set contextStack [linsert $contextStack 0 $name]
+ set contextStack [linsert $contextStack 0 $name]
$parser eval [list _%@namespace eval $name] $args
- set contextStack [lrange $contextStack 1 end]
- }
- import {
- variable parser
- variable imports
- foreach pattern $args {
- if {$pattern ne "-force"} {
- lappend imports $pattern
- }
- }
- catch {$parser eval "_%@namespace import $args"}
- }
+ set contextStack [lrange $contextStack 1 end]
+ }
+ import {
+ variable parser
+ variable imports
+ foreach pattern $args {
+ if {$pattern ne "-force"} {
+ lappend imports $pattern
+ }
+ }
+ catch {$parser eval "_%@namespace import $args"}
+ }
ensemble {
variable parser
variable contextStack
diff --git a/library/safe.tcl b/library/safe.tcl
index 2dd4aed..92cd6d1 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -129,7 +129,7 @@ proc ::safe::interpConfigure {args} {
[list -accessPath $state(access_path)] \
[list -statics $state(staticsok)] \
[list -nested $state(nestedok)] \
- [list -deleteHook $state(cleanupHook)]]]
+ [list -deleteHook $state(cleanupHook)]]]
}
2 {
# If we have exactly 2 arguments the semantic is a "configure