diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/auto.tcl | 29 | ||||
| -rw-r--r-- | library/clock.tcl | 72 | ||||
| -rw-r--r-- | library/init.tcl | 57 |
3 files changed, 65 insertions, 93 deletions
diff --git a/library/auto.tcl b/library/auto.tcl index c80e1ea..7552414 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.18 2004/08/23 17:40:27 dgp Exp $ +# RCS: @(#) $Id: auto.tcl,v 1.19 2004/10/25 17:24:39 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -51,7 +51,7 @@ proc auto_reset {} { proc tcl_findLibrary {basename version patch initScript enVarName varName} { upvar #0 $varName the_library - global env errorInfo + global env set dirs {} set errors {} @@ -141,10 +141,11 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { # we have a source command, but no file exists command if {[interp issafe] || [file exists $file]} { - if {![catch {uplevel #0 [list source $file]} msg]} { + if {![catch {uplevel #0 [list source $file]} msg opts]} { return } else { - append errors "$file: $msg\n$errorInfo\n" + append errors "$file: $msg\n" + append errors [dict get $opts -errorinfo]\n } } } @@ -186,8 +187,6 @@ if {[interp issafe]} { # are given auto_mkindex will look for *.tcl. proc auto_mkindex {dir args} { - global errorCode errorInfo - if {[interp issafe]} { error "can't generate index within safe interpreter" } @@ -209,13 +208,11 @@ proc auto_mkindex {dir args} { auto_mkindex_parser::init foreach file [glob {expand}$args] { - if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} { + if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} { append index $msg } else { - set code $errorCode - set info $errorInfo cd $oldDir - error $msg $info $code + return -options $opts $msg } } auto_mkindex_parser::cleanup @@ -230,7 +227,6 @@ proc auto_mkindex {dir args} { # code for "proc" at the beginning of the line. proc auto_mkindex_old {dir args} { - global errorCode errorInfo set oldDir [pwd] cd $dir set dir [pwd] @@ -256,13 +252,11 @@ proc auto_mkindex_old {dir args} { } } close $f - } msg] + } msg opts] if {$error} { - set code $errorCode - set info $errorInfo catch {close $f} cd $oldDir - error $msg $info $code + return -options $opts $msg } } set f "" @@ -271,13 +265,12 @@ proc auto_mkindex_old {dir args} { puts -nonewline $f $index close $f cd $oldDir - } msg] + } msg opts] if {$error} { - set code $errorCode - set info $errorInfo catch {close $f} cd $oldDir error $msg $info $code + return -options $opts $msg } } diff --git a/library/clock.tcl b/library/clock.tcl index 7fdc654..15456d2 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: clock.tcl,v 1.8 2004/10/22 14:27:39 kennykb Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.9 2004/10/25 17:24:39 dgp Exp $ # #---------------------------------------------------------------------- @@ -1036,7 +1036,7 @@ proc ::tcl::clock::format { args } { set retval - } result] + } result opts] # Restore the locale @@ -1045,12 +1045,10 @@ proc ::tcl::clock::format { args } { } if { $status == 1 } { - if { [lindex $::errorCode 0] eq {clock} } { + if { [lindex [dict get $opts -errorcode] 0] eq {clock} } { return -code error $result } else { - return -code error \ - -errorcode $::errorCode -errorinfo $::errorInfo \ - $result + return -options $opts $result } } else { return $result @@ -1153,15 +1151,7 @@ proc ::tcl::clock::scan { args } { "legacy \[clock scan\] does not support -locale" } - if { [catch { - FreeScan $string $base $timezone $locale - } retval] } { - return -code error \ - -errorcode $::errorCode -errorinfo $::errorInfo \ - $retval - } else { - return $retval - } + return [FreeScan $string $base $timezone $locale] } # Change locale if a fresh locale has been given on the command line. @@ -1176,7 +1166,7 @@ proc ::tcl::clock::scan { args } { set scanner [ParseClockScanFormat $format] $scanner $string $base $timezone - } result] + } result opts] # Restore the locale @@ -1185,12 +1175,10 @@ proc ::tcl::clock::scan { args } { } if { $status == 1 } { - if { [lindex $::errorCode 0] eq {clock} } { + if { [lindex [dict get $opts -errorcode] 0] eq {clock} } { return -code error $result } else { - return -code error \ - -errorcode $::errorCode -errorinfo $::errorInfo \ - $result + return -options $opts $result } } else { return $result @@ -2998,8 +2986,9 @@ proc ::tcl::clock::ConvertLocalToUTC { date } { if { [catch { ConvertLocalToUTCViaC [dict get $date localSeconds] - } result] } { - return -code error -errorcode $::errorCode $result + } result opts] } { + dict unset opts -errorinfo + return -options $opts $result } dict set date seconds $result return $date @@ -3008,8 +2997,9 @@ proc ::tcl::clock::ConvertLocalToUTC { date } { # Get the time zone data - if { [catch { SetupTimeZone $timezone } retval] } { - return -code error -errorcode $::errorCode $retval + if { [catch { SetupTimeZone $timezone } retval opts] } { + dict unset opts -errorinfo + return -options $opts $retval } # Initially assume that local == UTC, and locate the last time @@ -3103,8 +3093,9 @@ proc ::tcl::clock::ConvertUTCToLocal { date timezone } { # Get the data for time changes in the given zone - if { [catch { SetupTimeZone $timezone } retval] } { - return -code error -errorcode $::errorCode $retval + if { [catch { SetupTimeZone $timezone } retval opts] } { + dict unset opts -errorinfo + return -options $opts $retval } if { $timezone eq {:localtime} } { @@ -3113,8 +3104,9 @@ proc ::tcl::clock::ConvertUTCToLocal { date timezone } { if { [catch { ConvertUTCToLocalViaC $date - } retval] } { - return -code error -errorcode $::errorCode $retval + } retval opts] } { + dict unset opts -errorinfo + return -options $opts $retval } return $retval } @@ -3278,12 +3270,11 @@ proc ::tcl::clock::SetupTimeZone { timezone } { # This looks like a POSIX time zone - try to process it - if { [catch {ProcessPosixTimeZone $tzfields} data] } { - if { [lindex $::errorCode 0] eq {CLOCK} } { - return -code error -errorcode $::errorCode $data - } else { - error $tzfields $::errorInfo $::errorCode + if { [catch {ProcessPosixTimeZone $tzfields} data opts] } { + if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } { + dict unset opts -errorinfo } + return -options $opts $data } else { set TZData($timezone) $data } @@ -3294,9 +3285,9 @@ proc ::tcl::clock::SetupTimeZone { timezone } { # again with a time zone file - this time without a colon if { [catch { LoadTimeZoneFile $timezone }] - && [catch { LoadZoneinfoFile $timezone }] } { - return -code error -errorcode $::errorCode \ - "time zone $timezone not found" + && [catch { LoadZoneinfoFile $timezone } - opts] } { + dict unset opts -errorinfo + return -options $opts "time zone $timezone not found" } set TZData($timezone) $TZData(:$timezone) } @@ -4831,7 +4822,7 @@ proc ::tcl::clock::add { clockval args } { } } } - } result] + } result opts] # Restore the locale @@ -4840,11 +4831,10 @@ proc ::tcl::clock::add { clockval args } { } if { $status == 1 } { - if { [lindex $::errorCode 0] eq {CLOCK} } { - return -code error -errorcode $::errorCode $result - } else { - error $result $::errorInfo $::errorCode + if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } { + dict unset opts -errorinfo } + return -options $opts $result } else { return $clockval } diff --git a/library/init.tcl b/library/init.tcl index 7b8d4de..96a2bad 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.65 2004/08/18 22:03:32 andreas_kupries Exp $ +# RCS: @(#) $Id: init.tcl,v 1.66 2004/10/25 17:24:40 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -130,8 +130,6 @@ if {[llength [info commands exec]] == 0} { set auto_noexec 1 } -set errorCode "" -set errorInfo "" # Define a log command (which can be overwitten to log errors # differently, specially when stderr is not available) @@ -167,7 +165,6 @@ if {[llength [info commands tclLog]] == 0} { proc unknown args { variable ::tcl::UnknownPending global auto_noexec auto_noload env tcl_interactive - global errorCode errorInfo # If the command word has the form "namespace inscope ns cmd" # then concatenate its arguments onto the end and evaluate it. @@ -175,48 +172,42 @@ proc unknown args { set cmd [lindex $args 0] if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} { set arglist [lrange $args 1 end] - set ret [catch {uplevel 1 ::$cmd $arglist} result] - if {$ret == 0} { - return $result - } else { - return -code $ret -errorcode $errorCode $result - } + set ret [catch {uplevel 1 ::$cmd $arglist} result opts] + dict unset opts -errorinfo + return -options $opts $ret } - # Save the values of errorCode and errorInfo variables, since they - # may get modified if caught errors occur below. The variables will - # be restored just before re-executing the missing command. - - set savedErrorCode $errorCode - set savedErrorInfo $errorInfo set name [lindex $args 0] if {![info exists auto_noload]} { # # Make sure we're not trying to load the same proc twice. # if {[info exists UnknownPending($name)]} { - return -code error "self-referential recursion in \"unknown\" for command \"$name\""; + return -code error "self-referential recursion\ + in \"unknown\" for command \"$name\""; } set UnknownPending($name) pending; - set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg] + set ret [catch { + auto_load $name [uplevel 1 {::namespace current}] + } msg opts] unset UnknownPending($name); if {$ret != 0} { - append errorInfo "\n (autoloading \"$name\")" - return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg + dict append opts -errorinfo "\n (autoloading \"$name\")" + return -options $opts $msg } if {![array size UnknownPending]} { unset UnknownPending } if {$msg} { - set errorCode $savedErrorCode - set errorInfo $savedErrorInfo - set code [catch {uplevel 1 $args} msg] + set code [catch {uplevel 1 $args} msg opts] if {$code == 1} { # # Compute stack trace contribution from the [uplevel]. # Note the dependence on how Tcl_AddErrorInfo, etc. # construct the stack trace. # + set errorInfo [dict get $opts -errorinfo] + set errorCode [dict get $opts -errorcode] set cinfo $args if {[string bytelength $cinfo] > 153} { set cinfo [string range $cinfo 0 152] @@ -238,7 +229,9 @@ proc unknown args { # The stack has only the eval from the expanded command # Do not generate any stack trace here. # - return -code error -errorcode $errorCode $msg + dict unset opts -errorinfo + dict incr opts -level + return -options $opts $msg } # # Stack trace is nested, trim off just the contribution @@ -270,8 +263,6 @@ proc unknown args { if {![info exists auto_noexec]} { set new [auto_execok $name] if {$new != ""} { - set errorCode $savedErrorCode - set errorInfo $savedErrorInfo set redir "" if {[string equal [info commands console] ""]} { set redir ">&@stdout <@stdin" @@ -279,8 +270,6 @@ proc unknown args { return [uplevel 1 exec $redir $new [lrange $args 1 end]] } } - set errorCode $savedErrorCode - set errorInfo $savedErrorInfo if {[string equal $name "!!"]} { set newcmd [history event] } elseif {[regexp {^!(.+)$} $name dummy event]} { @@ -300,9 +289,9 @@ proc unknown args { set name "" } if {$ret != 0} { - return -code $ret -errorcode $errorCode \ - "error in unknown while checking if \"$name\" is\ - a unique command abbreviation:\n$msg" + dict append opts -errorinfo \ + "\n (expanding command prefix \"$name\" in unknown)" + return -options $opts $msg } # Filter out bogus matches when $name contained # a glob-special char [Bug 946952] @@ -393,7 +382,7 @@ proc auto_load {cmd {namespace {}}} { proc auto_load_index {} { variable ::tcl::auto_oldpath - global auto_index auto_path errorInfo errorCode + global auto_index auto_path if {[info exists auto_oldpath] && \ [string equal $auto_oldpath $auto_path]} { @@ -431,12 +420,12 @@ proc auto_load_index {} { } else { error "[file join $dir tclIndex] isn't a proper Tcl index file" } - } msg] + } msg opts] if {$f != ""} { close $f } if {$error} { - error $msg $errorInfo $errorCode + return -options $opts $msg } } } |