summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorhobbs <hobbs>2002-11-23 01:41:35 (GMT)
committerhobbs <hobbs>2002-11-23 01:41:35 (GMT)
commit55839b9b99968c33bd68a097248240de88dfd51b (patch)
treebc34776564b54866ca3e0b4c292037c4b4504402 /library
parentb56bfc9dd2b0556ccc280a089ad5f815b86cae2d (diff)
downloadtcl-55839b9b99968c33bd68a097248240de88dfd51b.zip
tcl-55839b9b99968c33bd68a097248240de88dfd51b.tar.gz
tcl-55839b9b99968c33bd68a097248240de88dfd51b.tar.bz2
* library/init.tcl: code cleanup to reduce use of
* library/opt/optparse.tcl: string compare
Diffstat (limited to 'library')
-rw-r--r--library/init.tcl10
-rw-r--r--library/opt/optparse.tcl54
2 files changed, 23 insertions, 41 deletions
diff --git a/library/init.tcl b/library/init.tcl
index 10d0f3c..e5a5d0f 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.54 2002/10/28 16:34:25 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.55 2002/11/23 01:41:35 hobbs 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 {[string compare [info library] {}]} {
+ if {[info library] != ""} {
foreach Dir [list [info library] [file dirname [info library]]] {
if {[lsearch -exact $::auto_path $Dir] < 0} {
lappend ::auto_path $Dir
@@ -82,7 +82,7 @@ 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 compare $u $p]} {
+ if {![string equal $u $p]} {
switch -- $u {
COMSPEC -
PATH {
@@ -267,7 +267,7 @@ proc unknown args {
&& [info exists tcl_interactive] && $tcl_interactive} {
if {![info exists auto_noexec]} {
set new [auto_execok $name]
- if {[string compare {} $new]} {
+ if {$new != ""} {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set redir ""
@@ -418,7 +418,7 @@ proc auto_load_index {} {
error "[file join $dir tclIndex] isn't a proper Tcl index file"
}
} msg]
- if {[string compare $f ""]} {
+ if {$f != ""} {
close $f
}
if {$error} {
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index b329190..8a86dfe 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -8,12 +8,12 @@
# on it. If your code does rely on this package you
# may directly incorporate this code into your application.
#
-# RCS: @(#) $Id: optparse.tcl,v 1.7 2002/08/20 15:33:32 dgp Exp $
+# RCS: @(#) $Id: optparse.tcl,v 1.8 2002/11/23 01:41:35 hobbs Exp $
package require Tcl 8
# When this version number changes, update the pkgIndex.tcl file
# and the install directory in the Makefiles.
-package provide opt 0.4.3
+package provide opt 0.4.4
namespace eval ::tcl {
@@ -69,13 +69,6 @@ namespace eval ::tcl {
}
################### No User serviceable part below ! ###############
-# You should really not look any further :
-# The following is private unexported undocumented unblessed... code
-# time to hit "q" ;-) !
-
-# Hmmm... ok, you really want to know ?
-
-# You've been warned... Here it is...
# Array storing the parsed descriptions
variable OptDesc;
@@ -154,7 +147,7 @@ namespace eval ::tcl {
proc ::tcl::OptKeyRegister {desc {key ""}} {
variable OptDesc;
variable OptDescN;
- if {[string compare $key ""] == 0} {
+ if {[string equal $key ""]} {
# in case a key given to us as a parameter was a number
while {[info exists OptDesc($OptDescN)]} {incr OptDescN}
set key $OptDescN;
@@ -256,8 +249,7 @@ proc ::tcl::OptParse {desc arglist} {
# into local variable named "Args".
proc ::tcl::OptProc {name desc body} {
set namespace [uplevel 1 [list ::namespace current]];
- if { ([string match "::*" $name])
- || ([string compare $namespace "::"]==0)} {
+ if {[string match "::*" $name] || [string equal $namespace "::"]} {
# absolute name or global namespace, name is the key
set key $name;
} else {
@@ -464,7 +456,7 @@ proc ::tcl::OptProcArgGiven {argname} {
}
# consume the flag
OptNextArg arguments;
- if {[string compare "--" $arg] == 0} {
+ if {[string equal "--" $arg]} {
# return from 'flags' state
return -code return;
}
@@ -536,7 +528,7 @@ proc ::tcl::OptKeyParse {descKey arglist} {
set desc [OptKeyGetDesc $descKey];
# make sure -help always give usage
- if {[string compare "-help" [string tolower $arglist]] == 0} {
+ if {[string equal -nocase "-help" $arglist]} {
return -code error [OptError "Usage information:" $desc 1];
}
@@ -587,7 +579,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
switch -exact -- $type {
int {
- if {![regexp {^(-+)?[0-9]+$} $arg]} {
+ if {![string is integer -strict $arg]} {
error "not an integer"
}
return $arg;
@@ -598,23 +590,17 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
script -
list {
# if llength fail : malformed list
- if {[llength $arg]==0} {
- if {[OptIsFlag $arg]} {
- error "no values with leading -"
- }
+ if {[llength $arg]==0 && [OptIsFlag $arg]} {
+ error "no values with leading -"
}
return $arg;
}
boolean {
- if {![regexp -nocase {^(true|false|0|1)$} $arg]} {
+ if {![string is boolean -strict $arg]} {
error "non canonic boolean"
}
# convert true/false because expr/if is broken with "!,...
- if {$arg} {
- return 1
- } else {
- return 0
- }
+ return [expr {$arg ? 1 : 0}]
}
choice {
if {[lsearch -exact $typeArgs $arg] < 0} {
@@ -656,16 +642,14 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
# (string length ought to be cheap)
set lflag [string tolower $flag];
if {$len == [string length $lflag]} {
- if {[string compare $larg $lflag]==0} {
+ if {[string equal $larg $lflag]} {
# Exact match case
OptSetPrgCounter desc $i;
return 1;
}
- } else {
- if {[string compare $larg [string range $lflag 0 $last]]==0} {
- lappend hitems $i;
- incr hits;
- }
+ } elseif {[string equal $larg [string range $lflag 0 $last]]} {
+ lappend hitems $i;
+ incr hits;
}
incr i;
}
@@ -680,11 +664,9 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
proc OptName {item} {
lindex $item 1;
}
- #
proc OptHasBeenSet {item} {
Lget $item {2 0};
}
- #
proc OptValue {item} {
Lget $item {2 1};
}
@@ -715,7 +697,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
lindex $item 5
}
proc OptNeedValue {item} {
- string compare [OptType $item] boolflag
+ expr {![string equal [OptType $item] boolflag]}
}
proc OptDefaultValue {item} {
set val [OptTypeArgs $item]
@@ -761,7 +743,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
set state "flags";
} elseif {$isopt} {
set state "optValue";
- } elseif {[string compare $varname "args"]} {
+ } elseif {![string equal $varname "args"]} {
set state "value";
} else {
set state "args";
@@ -783,7 +765,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
# varname default
# varname help
set type [OptGuessType $arg1]
- if {[string compare $type "string"] == 0} {
+ if {[string equal $type "string"]} {
if {$isflag} {
set type boolflag
set def false