diff options
author | dgp <dgp@users.sourceforge.net> | 2005-07-22 21:59:36 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2005-07-22 21:59:36 (GMT) |
commit | 14816591e601d46ce04cda2a9046995076aa51f5 (patch) | |
tree | 1afdc31e39babf2156e2ff5c0cbc65c505ed0116 /library/auto.tcl | |
parent | c7cbce40a31cd045bd4d15ebf401f13f6172ab2b (diff) | |
download | tcl-14816591e601d46ce04cda2a9046995076aa51f5.zip tcl-14816591e601d46ce04cda2a9046995076aa51f5.tar.gz tcl-14816591e601d46ce04cda2a9046995076aa51f5.tar.bz2 |
* library/auto.tcl: Updates to the Tcl script library to make
* library/history.tcl: use of Tcl 8.4 feautures. Thanks to
* library/init.tcl: Patrick Fradin for prompting on this.
* library/package.tcl: [Patch 1237755].
* library/safe.tcl:
* library/word.tcl:
Diffstat (limited to 'library/auto.tcl')
-rw-r--r-- | library/auto.tcl | 42 |
1 files changed, 17 insertions, 25 deletions
diff --git a/library/auto.tcl b/library/auto.tcl index b02b77f..90f8b14 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.12.2.8 2005/06/27 18:20:26 dgp Exp $ +# RCS: @(#) $Id: auto.tcl,v 1.12.2.9 2005/07/22 21:59:39 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -33,9 +33,7 @@ proc auto_reset {} { rename $p {} } } - catch {unset auto_execs} - catch {unset auto_index} - catch {unset auto_oldpath} + unset -nocomplain auto_execs auto_index auto_oldpath } # tcl_findLibrary -- @@ -61,8 +59,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 { @@ -164,9 +161,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" @@ -219,12 +214,12 @@ 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 {$args == ""} { + if {[llength $args] == 0} { set args *.tcl } auto_mkindex_parser::init - foreach file [eval glob $args] { + foreach file [eval [linsert $args 0 glob --]] { if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} { append index $msg } else { @@ -257,10 +252,10 @@ 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 {[string equal $args ""]} { + if {[llength $args] == 0} { set args *.tcl } - foreach file [eval glob $args] { + foreach file [eval [linsert $args 0 glob --]] { set f "" set error [catch { set f [open $file] @@ -378,7 +373,7 @@ proc auto_mkindex_parser::mkindex {file} { # 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. - regsub -all {\$} $contents "\0" contents + set contents [string map "$ \u0000" $contents] set index "" set contextStack "" @@ -456,12 +451,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 "_%@fake_$name" - regsub -all {::} $fakeName "_" fakeName - set fakeName "[namespace current]::$fakeName" + set fakeName [namespace current]::[string map {:: _} _%@fake_$name] } proc $fakeName $arglist $body @@ -470,7 +463,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 {[regexp {::} $name]} { + if {[string match *::* $name]} { set exportCmd [list _%@namespace export [namespace tail $name]] $parser eval [list _%@namespace eval $ns $exportCmd] @@ -520,7 +513,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" @@ -528,8 +521,7 @@ proc auto_mkindex_parser::fullname {name} { # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse # that replacement. - regsub -all "\0" $name "\$" name - return $name + return [string map "\u0000 $" $name] } # Register all of the procedures for the auto_mkindex parser that @@ -561,7 +553,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] ne ""} { auto_load tbcload::bcproc } load {} tbcload $auto_mkindex_parser::parser @@ -612,7 +604,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 } } |