diff options
author | dgp <dgp@users.sourceforge.net> | 2005-07-23 04:12:46 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2005-07-23 04:12:46 (GMT) |
commit | 7bc20e13c9c5f3706c7f50ae52ff329de08f8782 (patch) | |
tree | 4d2d9275d5243ea9e69abc3b325fce1875cda4bd /library/auto.tcl | |
parent | 6f173b7f6fa783afed059c46c49241bebb0995b7 (diff) | |
download | tcl-7bc20e13c9c5f3706c7f50ae52ff329de08f8782.zip tcl-7bc20e13c9c5f3706c7f50ae52ff329de08f8782.tar.gz tcl-7bc20e13c9c5f3706c7f50ae52ff329de08f8782.tar.bz2 |
* library/auto.tcl: Updates to the Tcl script library to make
* library/history.tcl: use of Tcl 8.4 features. Forward port of
* library/init.tcl: appropriate portions of [Patch 1237755].
* library/package.tcl:
* library/safe.tcl:
* library/word.tcl:
Diffstat (limited to 'library/auto.tcl')
-rw-r--r-- | library/auto.tcl | 28 |
1 files changed, 12 insertions, 16 deletions
diff --git a/library/auto.tcl b/library/auto.tcl index 94d0628..63260e7 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -3,7 +3,7 @@ # utility procs formerly in init.tcl dealing with auto execution # of commands and can be auto loaded themselves. # -# RCS: @(#) $Id: auto.tcl,v 1.26 2005/06/24 23:32:26 dgp Exp $ +# RCS: @(#) $Id: auto.tcl,v 1.27 2005/07/23 04:12:48 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -62,8 +62,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { # The C application may have hardwired a path, which we honor - set variableSet [info exists the_library] - if {$variableSet && $the_library ne ""} { + if {[info exists the_library] && $the_library ne ""} { lappend dirs $the_library } else { @@ -157,9 +156,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { } } } - if {!$variableSet} { - unset the_library - } + unset -nocomplain the_library set msg "Can't find a usable $initScript in the following directories: \n" append msg " $dirs\n\n" append msg "$errors\n\n" @@ -215,7 +212,7 @@ proc auto_mkindex {dir args} { } auto_mkindex_parser::init - foreach file [glob {expand}$args] { + foreach file [glob -- {expand}$args] { if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} { append index $msg } else { @@ -248,7 +245,7 @@ proc auto_mkindex_old {dir args} { if {[llength $args] == 0} { set args *.tcl } - foreach file [glob {expand}$args] { + foreach file [glob -- {expand}$args] { set f "" set error [catch { set f [open $file] @@ -444,11 +441,10 @@ proc auto_mkindex_parser::commandInit {name arglist body} { set ns [namespace qualifiers $name] set tail [namespace tail $name] - if {[string equal $ns ""]} { - set fakeName "[namespace current]::_%@fake_$tail" + if {$ns eq ""} { + set fakeName [namespace current]::_%@fake_$tail } else { - set fakeName [string map {:: _} "_%@fake_$name"] - set fakeName "[namespace current]::$fakeName" + set fakeName [namespace current]::[string map {:: _} _%@fake_$name] } proc $fakeName $arglist $body @@ -457,7 +453,7 @@ proc auto_mkindex_parser::commandInit {name arglist body} { # we have to build procs with the fully qualified names, and # have the procs point to the aliases. - if {[string match "*::*" $name]} { + if {[string match *::* $name]} { set exportCmd [list _%@namespace export [namespace tail $name]] $parser eval [list _%@namespace eval $ns $exportCmd] @@ -507,7 +503,7 @@ proc auto_mkindex_parser::fullname {name} { } } - if {[string equal [namespace qualifiers $name] ""]} { + if {[namespace qualifiers $name] eq ""} { set name [namespace tail $name] } elseif {![string match ::* $name]} { set name "::$name" @@ -551,7 +547,7 @@ auto_mkindex_parser::command proc {name args} { auto_mkindex_parser::hook { if {![catch {package require tbcload}]} { - if {[llength [info commands tbcload::bcproc]] == 0} { + if {[namespace which -command tbcload::bcproc] eq ""} { auto_load tbcload::bcproc } load {} tbcload $auto_mkindex_parser::parser @@ -602,7 +598,7 @@ auto_mkindex_parser::command namespace {op args} { variable parser variable imports foreach pattern $args { - if {[string compare $pattern "-force"]} { + if {$pattern ne "-force"} { lappend imports $pattern } } |