summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/auto.tcl42
-rw-r--r--library/history.tcl17
-rw-r--r--library/init.tcl105
-rw-r--r--library/package.tcl37
-rw-r--r--library/safe.tcl28
-rw-r--r--library/word.tcl8
6 files changed, 115 insertions, 122 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
}
}
diff --git a/library/history.tcl b/library/history.tcl
index d75c354..b8e27ce 100644
--- a/library/history.tcl
+++ b/library/history.tcl
@@ -2,7 +2,7 @@
#
# Implementation of the history command.
#
-# RCS: @(#) $Id: history.tcl,v 1.5 2001/05/17 08:18:56 hobbs Exp $
+# RCS: @(#) $Id: history.tcl,v 1.5.14.1 2005/07/22 21:59:40 dgp Exp $
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
@@ -168,14 +168,14 @@ proc history {args} {
variable history
# Do not add empty commands to the history
- if {[string trim $command] == ""} {
+ if {[string trim $command] eq ""} {
return ""
}
set i [incr history(nextid)]
set history($i) $command
set j [incr history(oldest)]
- if {[info exists history($j)]} {unset history($j)}
+ unset -nocomplain history($j)
if {[string match e* $exec]} {
return [uplevel #0 $command]
} else {
@@ -198,13 +198,13 @@ proc history {args} {
proc tcl::HistKeep {{limit {}}} {
variable history
- if {[string length $limit] == 0} {
+ if {$limit eq ""} {
return $history(keep)
} else {
set oldold $history(oldest)
set history(oldest) [expr {$history(nextid) - $limit}]
for {} {$oldold <= $history(oldest)} {incr oldold} {
- if {[info exists history($oldold)]} {unset history($oldold)}
+ unset -nocomplain history($oldold)
}
set history(keep) $limit
}
@@ -246,7 +246,7 @@ proc history {args} {
proc tcl::HistInfo {{num {}}} {
variable history
- if {$num == {}} {
+ if {$num eq ""} {
set num [expr {$history(keep) + 1}]
}
set result {}
@@ -256,8 +256,7 @@ proc history {args} {
if {![info exists history($i)]} {
continue
}
- set cmd [string trimright $history($i) \ \n]
- regsub -all \n $cmd "\n\t" cmd
+ set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
append result $newline[format "%6d %s" $i $cmd]
set newline \n
}
@@ -281,7 +280,7 @@ proc history {args} {
proc tcl::HistRedo {{event -1}} {
variable history
- if {[string length $event] == 0} {
+ if {$event eq ""} {
set event -1
}
set i [HistIndex $event]
diff --git a/library/init.tcl b/library/init.tcl
index ea1cd85..8105642 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.55.2.5 2005/04/28 05:34:40 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.55.2.6 2005/07/22 21:59:40 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -48,7 +48,7 @@ if {![info exists auto_path]} {
}
namespace eval tcl {
variable Dir
- if {[info library] != ""} {
+ if {[info library] ne ""} {
foreach Dir [list [info library] [file dirname [info library]]] {
if {[lsearch -exact $::auto_path $Dir] < 0} {
lappend ::auto_path $Dir
@@ -71,7 +71,7 @@ namespace eval tcl {
# Windows specific end of initialization
-if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
+if {(![interp issafe]) && $tcl_platform(platform) eq "windows"} {
namespace eval tcl {
proc EnvTraceProc {lo n1 n2 op} {
set x $::env($n2)
@@ -82,23 +82,23 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
global env tcl_platform
foreach p [array names env] {
set u [string toupper $p]
- if {![string equal $u $p]} {
+ if {$u ne $p} {
switch -- $u {
COMSPEC -
PATH {
if {![info exists env($u)]} {
set env($u) $env($p)
}
- trace variable env($p) w \
+ trace add variable env($p) write \
[namespace code [list EnvTraceProc $p]]
- trace variable env($u) w \
+ trace add variable env($u) write \
[namespace code [list EnvTraceProc $p]]
}
}
}
}
if {![info exists env(COMSPEC)]} {
- if {[string equal $tcl_platform(os) "Windows NT"]} {
+ if {$tcl_platform(os) eq "Windows NT"} {
set env(COMSPEC) cmd.exe
} else {
set env(COMSPEC) command.com
@@ -115,18 +115,18 @@ package unknown tclPkgUnknown
if {![interp issafe]} {
# setup platform specific unknown package handlers
- if {[string equal $::tcl_platform(platform) "unix"] && \
- [string equal $::tcl_platform(os) "Darwin"]} {
+ if {$::tcl_platform(platform) eq "unix"
+ && $::tcl_platform(os) eq "Darwin"} {
package unknown [list tcl::MacOSXPkgUnknown [package unknown]]
}
- if {[string equal $::tcl_platform(platform) "macintosh"]} {
+ if {$::tcl_platform(platform) eq "macintosh"} {
package unknown [list tcl::MacPkgUnknown [package unknown]]
}
}
# Conditionalize for presence of exec.
-if {[llength [info commands exec]] == 0} {
+if {[namespace which -command exec] eq ""} {
# Some machines, such as the Macintosh, do not have exec. Also, on all
# platforms, safe interpreters do not have exec.
@@ -139,7 +139,7 @@ set errorInfo ""
# Define a log command (which can be overwitten to log errors
# differently, specially when stderr is not available)
-if {[llength [info commands tclLog]] == 0} {
+if {[namespace which -command tclLog] eq ""} {
proc tclLog {string} {
catch {puts stderr $string}
}
@@ -199,7 +199,7 @@ proc unknown args {
}
set savedErrorCode $errorCode
set savedErrorInfo $errorInfo
- set name [lindex $args 0]
+ set name $cmd
if {![info exists auto_noload]} {
#
# Make sure we're not trying to load the same proc twice.
@@ -273,15 +273,15 @@ proc unknown args {
}
}
- if {([info level] == 1) && [string equal [info script] ""] \
+ if {([info level] == 1) && [info script] eq "" \
&& [info exists tcl_interactive] && $tcl_interactive} {
if {![info exists auto_noexec]} {
set new [auto_execok $name]
- if {$new != ""} {
+ if {$new ne ""} {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set redir ""
- if {[string equal [info commands console] ""]} {
+ if {[namespace which -command console] eq ""} {
set redir ">&@stdout <@stdin"
}
return [uplevel 1 exec $redir $new [lrange $args 1 end]]
@@ -289,11 +289,11 @@ proc unknown args {
}
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
- if {[string equal $name "!!"]} {
+ if {$name eq "!!"} {
set newcmd [history event]
- } elseif {[regexp {^!(.+)$} $name dummy event]} {
+ } elseif {[regexp {^!(.+)$} $name -> event]} {
set newcmd [history event $event]
- } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
+ } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} {
set newcmd [history event -1]
catch {regsub -all -- $old $newcmd $new newcmd}
}
@@ -304,7 +304,7 @@ proc unknown args {
}
set ret [catch {set candidates [info commands $name*]} msg]
- if {[string equal $name "::"]} {
+ if {$name eq "::"} {
set name ""
}
if {$ret != 0} {
@@ -312,11 +312,18 @@ proc unknown args {
"error in unknown while checking if \"$name\" is\
a unique command abbreviation:\n$msg"
}
+ # Handle empty $name separately due to strangeness in [string first]
+ if {$name eq ""} {
+ if {[llength $candidates] != 1} {
+ return -code error "empty command name \"\""
+ }
+ return [uplevel 1 [lreplace $args 0 0 [lindex $candidates 0]]]
+ }
# Filter out bogus matches when $name contained
# a glob-special char [Bug 946952]
set cmds [list]
foreach x $candidates {
- if {[string range $x 0 [expr [string length $name]-1]] eq $name} {
+ if {[string first $name $x] == 0} {
lappend cmds $x
}
}
@@ -324,12 +331,7 @@ proc unknown args {
return [uplevel 1 [lreplace $args 0 0 [lindex $cmds 0]]]
}
if {[llength $cmds]} {
- if {[string equal $name ""]} {
- return -code error "empty command name \"\""
- } else {
- return -code error \
- "ambiguous command name \"$name\": [lsort $cmds]"
- }
+ return -code error "ambiguous command name \"$name\": [lsort $cmds]"
}
}
return -code error "invalid command name \"$name\""
@@ -350,7 +352,7 @@ proc unknown args {
proc auto_load {cmd {namespace {}}} {
global auto_index auto_oldpath auto_path
- if {[string length $namespace] == 0} {
+ if {$namespace eq ""} {
set namespace [uplevel 1 [list ::namespace current]]
}
set nameList [auto_qualify $cmd $namespace]
@@ -402,8 +404,7 @@ proc auto_load {cmd {namespace {}}} {
proc auto_load_index {} {
global auto_index auto_oldpath auto_path errorInfo errorCode
- if {[info exists auto_oldpath] && \
- [string equal $auto_oldpath $auto_path]} {
+ if {[info exists auto_oldpath] && $auto_oldpath eq $auto_path} {
return 0
}
set auto_oldpath $auto_path
@@ -422,12 +423,11 @@ proc auto_load_index {} {
} else {
set error [catch {
set id [gets $f]
- if {[string equal $id \
- "# Tcl autoload index file, version 2.0"]} {
+ if {$id eq "# Tcl autoload index file, version 2.0"} {
eval [read $f]
- } elseif {[string equal $id "# Tcl autoload index file: each line identifies a Tcl"]} {
+ } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} {
while {[gets $f line] >= 0} {
- if {[string equal [string index $line 0] "#"] \
+ if {[string index $line 0] eq "#"
|| ([llength $line] != 2)} {
continue
}
@@ -439,7 +439,7 @@ proc auto_load_index {} {
error "[file join $dir tclIndex] isn't a proper Tcl index file"
}
} msg]
- if {$f != ""} {
+ if {$f ne ""} {
close $f
}
if {$error} {
@@ -478,13 +478,13 @@ proc auto_qualify {cmd namespace} {
# with the following form :
# ( inputCmd, inputNameSpace) -> output
- if {[regexp {^::(.*)$} $cmd x tail]} {
+ if {[string match ::* $cmd]} {
if {$n > 1} {
# ( ::foo::bar , * ) -> ::foo::bar
return [list $cmd]
} else {
# ( ::global , * ) -> global
- return [list $tail]
+ return [list [string range $cmd 2 end]]
}
}
@@ -492,14 +492,14 @@ proc auto_qualify {cmd namespace} {
# (if the current namespace is not the global one)
if {$n == 0} {
- if {[string equal $namespace ::]} {
+ if {$namespace eq "::"} {
# ( nocolons , :: ) -> nocolons
return [list $cmd]
} else {
# ( nocolons , ::sub ) -> ::sub::nocolons nocolons
return [list ${namespace}::$cmd $cmd]
}
- } elseif {[string equal $namespace ::]} {
+ } elseif {$namespace eq "::"} {
# ( foo::bar , :: ) -> ::foo::bar
return [list ::$cmd]
} else {
@@ -554,7 +554,7 @@ proc auto_import {pattern} {
# Arguments:
# name - Name of a command.
-if {[string equal windows $tcl_platform(platform)]} {
+if {$tcl_platform(platform) eq "windows"} {
# Windows version.
#
# Note that info executable doesn't work under Windows, so we have to
@@ -572,7 +572,7 @@ proc auto_execok name {
set shellBuiltins [list cls copy date del erase dir echo mkdir \
md rename ren rmdir rd time type ver vol]
- if {[string equal $tcl_platform(os) "Windows NT"]} {
+ if {$tcl_platform(os) eq "Windows NT"} {
# NT includes the 'start' built-in
lappend shellBuiltins "start"
}
@@ -609,7 +609,7 @@ proc auto_execok name {
set windir $env(WINDIR)
}
if {[info exists windir]} {
- if {[string equal $tcl_platform(os) "Windows NT"]} {
+ if {$tcl_platform(os) eq "Windows NT"} {
append path "$windir/system32;"
}
append path "$windir/system;$windir;"
@@ -623,7 +623,7 @@ proc auto_execok name {
foreach dir [split $path {;}] {
# Skip already checked directories
- if {[info exists checked($dir)] || [string equal {} $dir]} { continue }
+ if {[info exists checked($dir)] || $dir eq {}} { continue }
set checked($dir) {}
foreach ext $execExtensions {
set file [file join $dir ${name}${ext}]
@@ -652,7 +652,7 @@ proc auto_execok name {
return $auto_execs($name)
}
foreach dir [split $env(PATH) :] {
- if {[string equal $dir ""]} {
+ if {$dir eq ""} {
set dir .
}
set file [file join $dir $name]
@@ -683,7 +683,7 @@ proc auto_execok name {
proc tcl::CopyDirectory {action src dest} {
set nsrc [file normalize $src]
set ndest [file normalize $dest]
- if {[string equal $action "renaming"]} {
+ if {$action eq "renaming"} {
# Can't rename volumes. We could give a more precise
# error message here, but that would break the test suite.
if {[lsearch -exact [file volumes] $nsrc] != -1} {
@@ -693,12 +693,12 @@ proc tcl::CopyDirectory {action src dest} {
}
}
if {[file exists $dest]} {
- if {$nsrc == $ndest} {
+ if {$nsrc eq $ndest} {
return -code error "error $action \"$src\" to\
\"$dest\": trying to rename a volume or move a directory\
into itself"
}
- if {[string equal $action "copying"]} {
+ if {$action eq "copying"} {
return -code error "error $action \"$src\" to\
\"$dest\": file already exists"
} else {
@@ -707,10 +707,11 @@ proc tcl::CopyDirectory {action src dest} {
# can be returned in various combinations. Anyway,
# if any other file is returned, we must signal an error.
set existing [glob -nocomplain -directory $dest * .*]
- eval [list lappend existing] \
- [glob -nocomplain -directory $dest -type hidden * .*]
+ eval [linsert \
+ [glob -nocomplain -directory $dest -type hidden * .*] 0 \
+ lappend existing]
foreach s $existing {
- if {([file tail $s] != ".") && ([file tail $s] != "..")} {
+ if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
return -code error "error $action \"$src\" to\
\"$dest\": file already exists"
}
@@ -720,7 +721,7 @@ proc tcl::CopyDirectory {action src dest} {
if {[string first $nsrc $ndest] != -1} {
set srclen [expr {[llength [file split $nsrc]] -1}]
set ndest [lindex [file split $ndest] $srclen]
- if {$ndest == [file tail $nsrc]} {
+ if {$ndest eq [file tail $nsrc]} {
return -code error "error $action \"$src\" to\
\"$dest\": trying to rename a volume or move a directory\
into itself"
@@ -738,7 +739,7 @@ proc tcl::CopyDirectory {action src dest} {
[glob -nocomplain -directory $src -types hidden *]]
foreach s [lsort -unique $filelist] {
- if {([file tail $s] != ".") && ([file tail $s] != "..")} {
+ if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
file copy $s [file join $dest [file tail $s]]
}
}
diff --git a/library/package.tcl b/library/package.tcl
index fa6f445..fa6b01c 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -3,7 +3,7 @@
# utility procs formerly in init.tcl which can be loaded on demand
# for package management.
#
-# RCS: @(#) $Id: package.tcl,v 1.23.2.2 2003/07/24 08:23:17 rmax Exp $
+# RCS: @(#) $Id: package.tcl,v 1.23.2.3 2005/07/22 21:59:41 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -33,8 +33,8 @@ namespace eval ::pkg {
proc pkg_compareExtension { fileName {ext {}} } {
global tcl_platform
- if {![string length $ext]} {set ext [info sharedlibextension]}
- if {[string equal $tcl_platform(platform) "windows"]} {
+ if {$ext eq ""} {set ext [info sharedlibextension]}
+ if {$tcl_platform(platform) eq "windows"} {
return [string equal -nocase [file extension $fileName] $ext]
} else {
# Some unices add trailing numbers after the .so, so
@@ -42,7 +42,7 @@ proc pkg_compareExtension { fileName {ext {}} } {
set root $fileName
while {1} {
set currExt [file extension $root]
- if {[string equal $currExt $ext]} {
+ if {$currExt eq $ext} {
return 1
}
@@ -140,7 +140,7 @@ proc pkg_mkIndex {args} {
set oldDir [pwd]
cd $dir
- if {[catch {eval glob $patternList} fileList]} {
+ if {[catch {eval [linsert $patternList 0 glob --]} fileList]} {
global errorCode errorInfo
cd $oldDir
return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
@@ -151,7 +151,7 @@ proc pkg_mkIndex {args} {
# interpreter, and get a list of the new commands and packages
# that are defined.
- if {[string equal $file "pkgIndex.tcl"]} {
+ if {$file eq "pkgIndex.tcl"} {
continue
}
@@ -165,7 +165,7 @@ proc pkg_mkIndex {args} {
# Load into the child any packages currently loaded in the parent
# interpreter that match the -load pattern.
- if {[string length $loadPat]} {
+ if {$loadPat ne ""} {
if {$doVerbose} {
tclLog "currently loaded packages: '[info loaded]'"
tclLog "trying to load all packages matching $loadPat"
@@ -191,7 +191,7 @@ proc pkg_mkIndex {args} {
} elseif {$doVerbose} {
tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
}
- if {[string equal [lindex $pkg 1] "Tk"]} {
+ if {[lindex $pkg 1] eq "Tk"} {
# Withdraw . if Tk was loaded, to avoid showing a window.
$c eval [list wm withdraw .]
}
@@ -206,7 +206,7 @@ proc pkg_mkIndex {args} {
proc package {what args} {
switch -- $what {
require { return ; # ignore transitive requires }
- default { eval __package_orig {$what} $args }
+ default { uplevel 1 [linsert $args 0 __package_orig $what] }
}
}
proc tclPkgUnknown args {}
@@ -261,7 +261,8 @@ proc pkg_mkIndex {args} {
proc ::tcl::GetAllNamespaces {{root ::}} {
set list $root
foreach ns [namespace children $root] {
- eval lappend list [::tcl::GetAllNamespaces $ns]
+ eval [linsert [::tcl::GetAllNamespaces $ns] 0 \
+ lappend list]
}
return $list
}
@@ -272,7 +273,7 @@ proc pkg_mkIndex {args} {
set ::tcl::namespaces($::tcl::x) 1
}
foreach ::tcl::x [package names] {
- if {[string compare [package provide $::tcl::x] ""]} {
+ if {[package provide $::tcl::x] ne ""} {
set ::tcl::packages($::tcl::x) 1
}
}
@@ -320,7 +321,7 @@ proc pkg_mkIndex {args} {
set ::tcl::newCmds($::tcl::x) 1
}
foreach ::tcl::x $::tcl::origCmds {
- catch {unset ::tcl::newCmds($::tcl::x)}
+ unset -nocomplain ::tcl::newCmds($::tcl::x)
}
foreach ::tcl::x [array names ::tcl::newCmds] {
# determine which namespace a command comes from
@@ -333,7 +334,7 @@ proc pkg_mkIndex {args} {
set ::tcl::abs \
[lindex [auto_qualify $::tcl::abs ::] 0]
- if {[string compare $::tcl::x $::tcl::abs]} {
+ if {$::tcl::x ne $::tcl::abs} {
# Name changed during qualification
set ::tcl::newCmds($::tcl::abs) 1
@@ -347,7 +348,7 @@ proc pkg_mkIndex {args} {
# a version provided, then record it
foreach ::tcl::x [package names] {
- if {[string compare [package provide $::tcl::x] ""] \
+ if {[package provide $::tcl::x] ne ""
&& ![info exists ::tcl::packages($::tcl::x)]} {
lappend ::tcl::newPkgs \
[list $::tcl::x [package provide $::tcl::x]]
@@ -447,7 +448,7 @@ proc tclPkgSetup {dir pkg version files} {
set f [lindex $fileInfo 0]
set type [lindex $fileInfo 1]
foreach cmd [lindex $fileInfo 2] {
- if {[string equal $type "load"]} {
+ if {$type eq "load"} {
set auto_index($cmd) [list load [file join $dir $f] $pkg]
} else {
set auto_index($cmd) [list source [file join $dir $f]]
@@ -595,7 +596,7 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
}
}
set use_path [lrange $use_path 0 end-1]
- if {[string compare $old_path $auto_path]} {
+ if {$old_path ne $auto_path} {
foreach dir $auto_path {
lappend use_path $dir
}
@@ -640,7 +641,7 @@ proc tcl::MacPkgUnknown {original name version {exact {}}} {
if {[file isfile $x]} {
set res [resource open $x]
foreach y [resource list TEXT $res] {
- if {[string equal $y "pkgIndex"]} {source -rsrc pkgIndex}
+ if {$y eq "pkgIndex"} {source -rsrc pkgIndex}
}
catch {resource close $res}
}
@@ -649,7 +650,7 @@ proc tcl::MacPkgUnknown {original name version {exact {}}} {
}
}
set use_path [lrange $use_path 0 end-1]
- if {[string compare $old_path $auto_path]} {
+ if {$old_path ne $auto_path} {
foreach dir $auto_path {
lappend use_path $dir
}
diff --git a/library/safe.tcl b/library/safe.tcl
index f34fea2..9c8aff5 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: safe.tcl,v 1.9.2.2 2004/06/29 09:39:01 dkf Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.9.2.3 2005/07/22 21:59:41 dgp Exp $
#
# The implementation is based on namespaces. These naming conventions
@@ -77,7 +77,7 @@ namespace eval ::safe {
upvar $v $v
}
set flag [::tcl::OptProcArgGiven -noStatics];
- if {$flag && ($noStatics == $statics)
+ if {$flag && (!$noStatics == !$statics)
&& ([::tcl::OptProcArgGiven -statics])} {
return -code error\
"conflicting values given for -statics and -noStatics"
@@ -98,7 +98,7 @@ namespace eval ::safe {
set flag [::tcl::OptProcArgGiven -nestedLoadOk];
# note that the test here is the opposite of the "InterpStatics"
# one (it is not -noNested... because of the wanted default value)
- if {$flag && ($nestedLoadOk != $nested)
+ if {$flag && (!$nestedLoadOk != !$nested)
&& ([::tcl::OptProcArgGiven -nested])} {
return -code error\
"conflicting values given for -nested and -nestedLoadOk"
@@ -324,7 +324,7 @@ namespace eval ::safe {
nestedok deletehook} {
# determine and store the access path if empty
- if {[string equal "" $access_path]} {
+ if {$access_path eq ""} {
set access_path [uplevel \#0 set auto_path]
# Make sure that tcl_library is in auto_path
# and at the first position (needed by setAccessPath)
@@ -640,15 +640,15 @@ proc ::safe::setLogCmd {args} {
}
# set/get values
proc Set {args} {
- eval [list Toplevel set] $args
+ eval [linsert $args 0 Toplevel set]
}
# lappend on toplevel vars
proc Lappend {args} {
- eval [list Toplevel lappend] $args
+ eval [linsert $args 0 Toplevel lappend]
}
# unset a var/token (currently just an global level eval)
proc Unset {args} {
- eval [list Toplevel unset] $args
+ eval [linsert $args 0 Toplevel unset]
}
# test existance
proc Exists {varname} {
@@ -778,7 +778,7 @@ proc ::safe::setLogCmd {args} {
# Determine where to load. load use a relative interp path
# and {} means self, so we can directly and safely use passed arg.
set target [lindex $args 1]
- if {[string length $target]} {
+ if {$target ne ""} {
# we will try to load into a sub sub interp
# check that we want to authorize that.
if {![NestedOk $slave]} {
@@ -790,9 +790,9 @@ proc ::safe::setLogCmd {args} {
}
# Determine what kind of load is requested
- if {[string length $file] == 0} {
+ if {$file eq ""} {
# static package loading
- if {[string length $package] == 0} {
+ if {$package eq ""} {
set msg "load error: empty filename and no package name"
Log $slave $msg
return -code error $msg
@@ -860,7 +860,7 @@ proc ::safe::setLogCmd {args} {
proc Subset {slave command okpat args} {
set subcommand [lindex $args 0]
if {[regexp $okpat $subcommand]} {
- return [eval [list $command $subcommand] [lrange $args 1 end]]
+ return [eval [linsert $args 0 $command]]
}
set msg "not allowed to invoke subcommand $subcommand of $command"
Log $slave $msg
@@ -895,11 +895,11 @@ proc ::safe::setLogCmd {args} {
set subcommand [lindex $args 0]
if {[regexp $okpat $subcommand]} {
- return [eval ::interp invokehidden $slave encoding $subcommand \
- [lrange $args 1 end]]
+ return [eval [linsert $args 0 \
+ ::interp invokehidden $slave encoding]]
}
- if {[string match $subcommand system]} {
+ if {[string first $subcommand system] == 0} {
if {$argc == 1} {
# passed all the tests , lets source it:
if {[catch {::interp invokehidden \
diff --git a/library/word.tcl b/library/word.tcl
index edcb93a..c18c961 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -10,12 +10,12 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: word.tcl,v 1.7 2002/11/01 00:28:51 andreas_kupries Exp $
+# RCS: @(#) $Id: word.tcl,v 1.7.2.1 2005/07/22 21:59:41 dgp Exp $
# The following variables are used to determine which characters are
# interpreted as white space.
-if {[string equal $::tcl_platform(platform) "windows"]} {
+if {$::tcl_platform(platform) eq "windows"} {
# Windows style - any but a unicode space char
set tcl_wordchars "\\S"
set tcl_nonwordchars "\\s"
@@ -58,7 +58,7 @@ proc tcl_wordBreakAfter {str start} {
proc tcl_wordBreakBefore {str start} {
global tcl_nonwordchars tcl_wordchars
- if {[string equal $start end]} {
+ if {$start eq "end"} {
set start [string length $str]
}
if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} {
@@ -120,7 +120,7 @@ proc tcl_startOfNextWord {str start} {
proc tcl_startOfPreviousWord {str start} {
global tcl_nonwordchars tcl_wordchars
- if {[string equal $start end]} {
+ if {$start eq "end"} {
set start [string length $str]
}
if {[regexp -indices \
generated by cgit v0.12 at 2024-11-05 09:31:54 (GMT)