diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | library/auto.tcl | 16 | ||||
| -rw-r--r-- | library/history.tcl | 5 | ||||
| -rw-r--r-- | library/http/http.tcl | 17 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 2 | ||||
| -rw-r--r-- | library/ldAout.tcl | 10 | ||||
| -rw-r--r-- | library/opt/optparse.tcl | 14 | ||||
| -rw-r--r-- | library/opt/pkgIndex.tcl | 4 | ||||
| -rw-r--r-- | library/safe.tcl | 4 | ||||
| -rw-r--r-- | library/tcltest/pkgIndex.tcl | 2 | ||||
| -rw-r--r-- | library/tcltest/tcltest.tcl | 17 | ||||
| -rw-r--r-- | tools/genStubs.tcl | 6 | ||||
| -rwxr-xr-x | tools/tcltk-man2html.tcl | 2 | ||||
| -rw-r--r-- | unix/mkLinks.tcl | 2 |
14 files changed, 62 insertions, 53 deletions
@@ -1,5 +1,19 @@ 2003-03-19 Don Porter <dgp@users.sourceforge.net> + * library/auto.tcl: Replaced [regexp] and [regsub] with + * library/history.tcl: [string map] where possible. Thanks + * library/ldAout.tcl: to David Welton. [Bugs 667456,667558] + * library/safe.tcl: Bumped to http 2.4.3, opt 0.4.5, and + * library/http/http.tcl: tcltest 2.2.3. + * library/http/pkgIndex.tcl: + * library/opt/optparse.tcl: + * library/opt/pkgIndex.tcl: + * library/tcltest/tcltest.tcl: + * library/tcltest/pkgIndex.tcl: + * tools/genStubs.tcl: + * tools/tcltk-man2html.tcl: + * unix/mkLinks.tcl: + * doc/Eval.3 (Tcl_EvalObjEx): Corrected CONST and * doc/ParseCmd.3 (Tcl_EvalTokensStandard): return type errors in documentation. [Bug 683994] diff --git a/library/auto.tcl b/library/auto.tcl index 4c736fe..217d1c4 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 2002/10/28 16:34:25 dgp Exp $ +# RCS: @(#) $Id: auto.tcl,v 1.13 2003/03/19 21:57:40 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -337,8 +337,8 @@ 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 [list \$ \0] $contents] + set index "" set contextStack "" set imports "" @@ -418,8 +418,7 @@ proc auto_mkindex_parser::commandInit {name arglist body} { if {[string equal $ns ""]} { set fakeName "[namespace current]::_%@fake_$tail" } else { - set fakeName "_%@fake_$name" - regsub -all {::} $fakeName "_" fakeName + set fakeName [string map {:: _} "_%@fake_$name"] set fakeName "[namespace current]::$fakeName" } proc $fakeName $arglist $body @@ -429,7 +428,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] @@ -484,11 +483,10 @@ proc auto_mkindex_parser::fullname {name} { } elseif {![string match ::* $name]} { set name "::$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 [list \0 \$] $name] } # Register all of the procedures for the auto_mkindex parser that diff --git a/library/history.tcl b/library/history.tcl index d75c354..7304d2a 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.6 2003/03/19 21:57:42 dgp Exp $ # # Copyright (c) 1997 Sun Microsystems, Inc. # @@ -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 } diff --git a/library/http/http.tcl b/library/http/http.tcl index 7ae2286..3e6f8ec 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: http.tcl,v 1.43 2002/10/03 13:34:32 dkf Exp $ +# RCS: @(#) $Id: http.tcl,v 1.44 2003/03/19 21:57:47 dgp Exp $ # Rough version history: # 1.0 Old http_get interface @@ -25,7 +25,7 @@ package require Tcl 8.2 # keep this in sync with pkgIndex.tcl # and with the install directories in Makefiles -package provide http 2.4.2 +package provide http 2.4.3 namespace eval http { variable http @@ -119,7 +119,7 @@ proc http::config {args} { } return $result } - regsub -all -- - $options {} options + set options [string map {- ""} $options] set pat ^-([join $options |])$ if {[llength $args] == 1} { set flag [lindex $args 0] @@ -260,7 +260,7 @@ proc http::geturl { url args } { -progress -query -queryblocksize -querychannel -queryprogress\ -validate -timeout -type} set usage [join $options ", "] - regsub -all -- - $options {} options + set options [string map {- ""} $options] set pat ^-([join $options |])$ foreach {flag value} $args { if {[regexp $pat $flag]} { @@ -414,7 +414,7 @@ proc http::geturl { url args } { } puts $s "User-Agent: $http(-useragent)" foreach {key value} $state(-headers) { - regsub -all \[\n\r\] $value {} value + set value [string map [list \n "" \r ""] $value] set key [string trim $key] if {[string equal $key "Content-Length"]} { set contDone 1 @@ -678,8 +678,9 @@ proc http::Event {token} { } elseif {$n == 0} { variable encodings set state(state) body - if {$state(-binary) || ![regexp -nocase ^text $state(type)] || \ - [regexp gzip|compress $state(coding)]} { + if {$state(-binary) || ![string match -nocase text* $state(type)] + || [string match *gzip* $state(coding)] + || [string match *compress* $state(coding)]} { # Turn off conversions for non-text data fconfigure $s -translation binary if {[info exists state(-channel)]} { @@ -716,7 +717,7 @@ proc http::Event {token} { } if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} { lappend state(meta) $key [string trim $value] - } elseif {[regexp ^HTTP $line]} { + } elseif {[string match HTTP* $line]} { set state(http) $line } } diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 8461a67..3adc591 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.2]} {return} -package ifneeded http 2.4.2 [list tclPkgSetup $dir http 2.4.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}] +package ifneeded http 2.4.3 [list tclPkgSetup $dir http 2.4.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}] diff --git a/library/ldAout.tcl b/library/ldAout.tcl index 243c6d4..c32f174 100644 --- a/library/ldAout.tcl +++ b/library/ldAout.tcl @@ -18,7 +18,7 @@ # its .o file placed before all others in the command; then # "ld" is executed to bind the objects together. # -# RCS: @(#) $Id: ldAout.tcl,v 1.5 2001/09/28 01:21:53 dgp Exp $ +# RCS: @(#) $Id: ldAout.tcl,v 1.6 2003/03/19 21:57:42 dgp Exp $ # # Copyright (c) 1995, by General Electric Company. All rights reserved. # @@ -88,9 +88,9 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { } elseif {![string compare $a -o]} { set minusO 1 } - if {[regexp {^-[lL]} $a]} { + if {[string match -nocase "-l*" $a]} { lappend libraries $a - if {[regexp {^-L} $a]} { + if {[string match "-L*" $a]} { lappend libdirs [string range $a 2 end] } } elseif {$seenDotO} { @@ -106,7 +106,7 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { set libs {} foreach lib $libraries { - if {[regexp {^-l} $lib]} { + if {[string match "-l*" $lib]} { set lname [string range $lib 2 end] foreach dir $libdirs { if {[file exists [file join $dir lib${lname}_G0.a]]} { @@ -138,7 +138,7 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { error "Output file does not appear to have a suffix" } set modName [string tolower $m 0 [expr {$l-1}]] - if {[regexp {^lib} $modName]} { + if {[string match "lib*" $modName]} { set modName [string range $modName 3 end] } if {[regexp {[0-9\.]*(_g0)?$} $modName match]} { diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl index 8a86dfe..e01b7e8 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.8 2002/11/23 01:41:35 hobbs Exp $ +# RCS: @(#) $Id: optparse.tcl,v 1.9 2003/03/19 21:57:52 dgp Exp $ -package require Tcl 8 +package require Tcl 8.2 # When this version number changes, update the pkgIndex.tcl file # and the install directory in the Makefiles. -package provide opt 0.4.4 +package provide opt 0.4.5 namespace eval ::tcl { @@ -811,15 +811,15 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} { } } - # Auto magic lasy type determination + # Auto magic lazy type determination proc OptGuessType {arg} { - if {[regexp -nocase {^(true|false)$} $arg]} { + if { $arg == "true" || $arg == "false" } { return boolean } - if {[regexp {^(-+)?[0-9]+$} $arg]} { + if {[string is integer $arg]} { return int } - if {![catch {expr {double($arg)}}]} { + if {[string is double $arg]} { return float } return string diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl index 252cab5..c5d3635 100644 --- a/library/opt/pkgIndex.tcl +++ b/library/opt/pkgIndex.tcl @@ -8,5 +8,5 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -if {![package vsatisfies [package provide Tcl] 8]} {return} -package ifneeded opt 0.4.4 [list source [file join $dir optparse.tcl]] +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded opt 0.4.5 [list source [file join $dir optparse.tcl]] diff --git a/library/safe.tcl b/library/safe.tcl index a259bdb..6646962 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 2003/02/08 22:03:20 hobbs Exp $ +# RCS: @(#) $Id: safe.tcl,v 1.10 2003/03/19 21:57:44 dgp Exp $ # # The implementation is based on namespaces. These naming conventions @@ -673,7 +673,7 @@ proc ::safe::setLogCmd {args} { proc TranslatePath {slave path} { # somehow strip the namespaces 'functionality' out (the danger # is that we would strip valid macintosh "../" queries... : - if {[regexp {(::)|(\.\.)} $path]} { + if {[string match "*::*" $path] || [string match "*..*" $path]} { error "invalid characters in path $path" } set n [expr {[Set [PathNumberName $slave]]-1}] diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 345740a..b91babd 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.3]} {return} -package ifneeded tcltest 2.2.2 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.2.3 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 7d119c7..3131104 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.78 2003/02/17 19:12:06 dgp Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.79 2003/03/19 21:57:57 dgp Exp $ package require Tcl 8.3 ;# uses [glob -directory] namespace eval tcltest { @@ -24,7 +24,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.2.2 + variable Version 2.2.3 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -1912,11 +1912,9 @@ proc tcltest::test {name description args} { } # Replace symbolic valies supplied for -returnCodes - regsub -nocase normal $returnCodes 0 returnCodes - regsub -nocase error $returnCodes 1 returnCodes - regsub -nocase return $returnCodes 2 returnCodes - regsub -nocase break $returnCodes 3 returnCodes - regsub -nocase continue $returnCodes 4 returnCodes + foreach {strcode numcode} {normal 0 error 1 return 2 break 3 continue 4} { + set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes] + } } else { # This is parsing for the old test command format; it is here # for backward compatibility. @@ -2882,9 +2880,8 @@ proc tcltest::restoreState {} { proc tcltest::normalizeMsg {msg} { regsub "\n$" [string tolower $msg] "" msg - regsub -all "\n\n" $msg "\n" msg - regsub -all "\n\}" $msg "\}" msg - return $msg + set msg [string map [list "\n\n" "\n"] $msg] + return [string map [list "\n\}" "\}"] $msg] } # tcltest::makeFile -- diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 8a10cba..9911fd2 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: genStubs.tcl,v 1.13 2002/10/04 08:25:14 dkf Exp $ +# RCS: @(#) $Id: genStubs.tcl,v 1.14 2003/03/19 21:58:01 dgp Exp $ package require Tcl 8 @@ -184,7 +184,7 @@ proc genStubs::rewriteFile {file text} { while {![eof $in]} { set line [gets $in] - if {[regexp {!BEGIN!} $line]} { + if {[string match "*!BEGIN!*" $line]} { break } puts $out $line @@ -193,7 +193,7 @@ proc genStubs::rewriteFile {file text} { puts $out $text while {![eof $in]} { set line [gets $in] - if {[regexp {!END!} $line]} { + if {[string match "*!END!*" $line]} { break } } diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 42f0e58..221dc63 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -1572,7 +1572,7 @@ proc make-man-pages {html args} { } puts $afp "</H2><HR><DL>" foreach k $keys { - if {[regexp -nocase -- "^keyword-$a" $k]} { + if {[string match -nocase "keyword-${a}*" $k]} { set k [string range $k 8 end] puts $afp "<DT><A NAME=\"$k\">$k</A><DD>" set refs {} diff --git a/unix/mkLinks.tcl b/unix/mkLinks.tcl index b0a4a6a..85ef575 100644 --- a/unix/mkLinks.tcl +++ b/unix/mkLinks.tcl @@ -75,7 +75,7 @@ foreach file $argv { while {[gets $in line] >= 0} { switch $state { begin { - if {[regexp "^.SH NAME" $line]} { + if {[string match ".SH NAME*" $line]} { set state name } } |