Attachment "snit.diff" to
ticket [1390477fff]
added by
amonarch
2005-12-26 18:06:59.
--- /usr/local/lib/tcllib1.8/snit/snit84.tcl 2005-12-09 17:39:33.000000000 +0300
+++ snit.tcl 2005-12-26 13:07:29.000000000 +0300
@@ -220,11 +220,13 @@
}
# Next, retrieve the command.
variable %TYPE%::Snit_typemethodCache
while 1 {
- if {[catch {set Snit_typemethodCache($method)} commandRec]} {
+ if {[info exists Snit_typemethodCache($method)]} {
+ set commandRec $Snit_typemethodCache($method)
+ } else {
set commandRec [::snit::RT.CacheTypemethodCommand %TYPE% $method]
if {[llength $commandRec] == 0} {
return -code error "\"%TYPE% $method\" is not defined"
}
@@ -324,11 +326,13 @@
# proc $instanceName {method args} ....
set ::snit::nominalInstanceProc {
set self [set %SELFNS%::Snit_instance]
while {1} {
- if {[catch {set %SELFNS%::Snit_methodCache($method)} commandRec]} {
+ if {[info exists %SELFNS%::Snit_methodCache($method)]} {
+ set commandRec [set %SELFNS%::Snit_methodCache($method)]
+ } else {
set commandRec [snit::RT.CacheMethodCommand %TYPE% %SELFNS% %WIN% $self $method]
if {[llength $commandRec] == 0} {
return -code error \
"\"$self $method\" is not defined"
@@ -828,11 +832,14 @@
# Execute the type definition script.
# Consider using namespace eval %TYPE%. See if it's faster.
if {[catch {eval $defscript} result]} {
namespace delete $type
- catch {rename $type ""}
+ set ei $::errorInfo; set ec $::errorCode
+ if {[catch {rename $type ""}]} {
+ set ::errorInfo $ei; set ::errorCode $ec
+ }
error $result
}
return $type
}
@@ -1148,11 +1155,12 @@
if {[catch {lindex $method 0}]} {
error "$errRoot, the name \"$method\" must have list syntax."
}
# NEXT, check whether we can define it.
- if {![catch {set methodInfo($method)} data]} {
+ if {[info exists methodInfo($method)]} {
+ set data $methodInfo($method)
# We can't redefine methods with submethods.
if {[lindex $data 0] == 1} {
error "$errRoot, \"$method\" has submethods."
}
@@ -1171,11 +1179,12 @@
set tokens $method
while {[llength $tokens] > 1} {
lappend prefix [lindex $tokens 0]
set tokens [lrange $tokens 1 end]
- if {![catch {set methodInfo($prefix)} result]} {
+ if {[info exists methodInfo($prefix)]} {
+ set result $methodInfo($prefix)
# Prefix is known. If it's not a prefix, throw an
# error.
if {[lindex $result 0] == 0} {
error "$errRoot, \"$prefix\" has no submethods."
}
@@ -2261,12 +2270,14 @@
}
} result]} {
global errorInfo
# Pop up the console on Windows wish, to enable stdout.
# This clobbers errorInfo on unix, so save it so we can print it.
- set ei $errorInfo
- catch {console show}
+ set ei $::errorInfo; set ec $::errorCode
+ if {[catch {console show}]} {
+ set ::errorInfo $ei; set ::errorCode $ec
+ }
puts "Error in ::snit::RT.InstanceTrace $type $selfns $win $old $new $op:"
puts $ei
}
}
@@ -2409,11 +2420,14 @@
# Next, delete the hull component's instance command,
# if there is one.
if {$Snit_info(isWidget)} {
set hullcmd [::snit::RT.Component $type $selfns hull]
- catch {rename $instance ""}
+ set ei $::errorInfo; set ec $::errorCode
+ if {[catch {rename $instance ""}]} {
+ set ::errorInfo $ei; set ::errorCode $ec
+ }
# Clear the bind event
bind Snit$type$win <Destroy> ""
if {[llength [info commands $hullcmd]]} {
@@ -2425,11 +2439,14 @@
# NEXT, destroy it.
destroy $instance
}
} else {
- catch {rename $instance ""}
+ set ei $::errorInfo; set ec $::errorCode
+ if {[catch {rename $instance ""}]} {
+ set ::errorInfo $ei; set ::errorCode $ec
+ }
}
}
# Next, delete the instance's namespace. This kills any
# instance variables.
@@ -2451,14 +2468,18 @@
} else {
set procname $instance
}
# NEXT, remove any trace on this name
- catch {
+
+ set ei $::errorInfo; set ec $::errorCode
+ if {[catch {
trace remove command $procname {rename delete} \
[list ::snit::RT.InstanceTrace $type $selfns $win]
- }
+ }]} {
+ set ::errorInfo $ei; set ::errorCode $ec
+ }
}
#-----------------------------------------------------------------------
# Typecomponent Management and Method Caching
@@ -2584,11 +2605,13 @@
# Retrieves the object name given the component name.
proc ::snit::RT.Component {type selfns name} {
variable ${selfns}::Snit_components
- if {[catch {set Snit_components($name)} result]} {
+ if {[info exists Snit_components($name)]} {
+ set result $Snit_components($name)
+ } else {
variable ${selfns}::Snit_instance
error "component \"$name\" is undefined in $type $Snit_instance"
}
@@ -2896,11 +2919,13 @@
# NEXT, handle the option database for "delegate option *",
# in widgets only.
if {$Snit_info(isWidget) && $Snit_optionInfo(starcomp) eq $compName} {
# FIRST, get the list of option specs from the widget.
# If configure doesn't work, skip it.
+ set ei $::errorInfo; set ec $::errorCode
if {[catch {$comp configure} specs]} {
+ set ::errorInfo $ei; set ::errorCode $ec
return
}
# NEXT, get the set of explicitly used options from args
set usedOpts {}
@@ -3129,11 +3154,13 @@
# win The instance's original name
# self The instance's current name
# option The name of the option
proc ::snit::RT.method.cget {type selfns win self option} {
- if {[catch {set ${selfns}::Snit_cgetCache($option)} command]} {
+ if {[info exists ${selfns}::Snit_cgetCache($option) ]} {
+ set command [set ${selfns}::Snit_cgetCache($option)]
+ } else {
set command [snit::RT.CacheCgetCommand $type $selfns $win $self $option]
if {[llength $command] == 0} {
return -code error "unknown option \"$option\""
}
@@ -3208,11 +3235,13 @@
proc ::snit::RT.method.configurelist {type selfns win self optionlist} {
variable ${type}::Snit_optionInfo
foreach {option value} $optionlist {
# FIRST, get the configure command, caching it if need be.
- if {[catch {set ${selfns}::Snit_configureCache($option)} command]} {
+ if {[info exists ${selfns}::Snit_configureCache($option)]} {
+ set command [set ${selfns}::Snit_configureCache($option)]
+ } else {
set command [snit::RT.CacheConfigureCommand \
$type $selfns $win $self $option]
if {[llength $command] == 0} {
return -code error "unknown option \"$option\""
@@ -3391,11 +3420,13 @@
# Get the default
set logicalName [lindex $Snit_optionInfo(target-$opt) 0]
set comp $Snit_components($logicalName)
set target [lindex $Snit_optionInfo(target-$opt) 1]
+ set ei $::errorInfo; set ec $::errorCode
if {[catch {$comp configure $target} result]} {
+ set ::errorInfo $ei; set ::errorCode $ec
set defValue {}
} else {
set defValue [lindex $result 3]
}
@@ -3408,14 +3439,17 @@
if {[catch {set value [$comp cget $target]} result]} {
error "unknown option \"$opt\""
}
+ set ei $::errorInfo; set ec $::errorCode
if {![catch {$comp configure $target} result]} {
# Replace the delegated option name with the local name.
return [::snit::Expand $result $target $opt]
- }
+ } else {
+ set ::errorInfo $ei; set ::errorCode $ec
+ }
# configure didn't work; return simple form.
return [list $opt "" "" "" $value]
} else {
error "unknown option \"$opt\""
@@ -3672,19 +3706,22 @@
if {$Snit_optionInfo(starcomp) ne ""} {
upvar ${selfns}::Snit_components Snit_components
set logicalName $Snit_optionInfo(starcomp)
set comp $Snit_components($logicalName)
+ set ei $::errorInfo; set ec $::errorCode
if {![catch {$comp configure} records]} {
foreach record $records {
set opt [lindex $record 0]
if {[lsearch -exact $result $opt] == -1 &&
[lsearch -exact $Snit_optionInfo(except) $opt] == -1} {
lappend result $opt
}
}
- }
+ } else {
+ set ::errorInfo $ei; set ::errorCode $ec
+ }
}
# Next, apply the pattern
set names {}
