}
namespace eval Toaster {
variable tokenCtr 0
namespace export unknown toaster
}
## genToken
# returns next free token
proc ::Toaster::genToken {} {
variable tokenCtr
return "_proc[incr tokenCtr]"
}
## errWidget
# std callback on error, signal an event to the widget.
proc ::Toaster::errWidget {widget} {
event generate $widget <<Errant>>
}
## toaster
# toaster wraps up the proc to something callable with a bit
# more state. A list of vars which has to be congruent with
# proc's arg list can be passed to associate info with the
# arguments.
proc ::Toaster::toaster {proc {vars {}} {callb {Toaster::errWidget}} } {
set argl [info args $proc]
set tok [genToken]
namespace eval [namespace current] [list namespace eval $tok {array set args {}}]
foreach v $vars a $argl {
set ${tok}::args($a) $v
}
set ${tok}::callb $callb
set ${tok}::proc $proc
set ${tok}::errI ""
set ${tok}::errC 0
return "${tok}::${proc}"
}
## unknown
# unknown makes the thingies returned by toaster callable.
# if it isn't something toasted, let tcl do its work.
proc ::Toaster::unknown {cmd args} {
if {[regexp {(_proc\d+)::(.+)} $cmd -> ns prc]} then {
call $ns $prc $args
} else {
uplevel [list ::tcl::unknown $cmd $args]
}
}
## call
# call the toasted thingie. If an error occurs, see if some
# argument was involved which has associated info, if there is
# one, call the callback which was toasted onto the thingie
# with that info.
proc ::Toaster::call {nspace proc argl} {
if {![string match {*unknown} [lindex [info level [expr {[info level] - 1}]] 0]]} then {
error {::Toaster::call not called from unknown!}
}
set val {}
# uplevel 2: call->unkown=1, unkown->orig context=2
if {[catch {uplevel 2 "$proc $argl"} val]} then {
set ${nspace}::errI $::errorInfo
set ${nspace}::errC $::errorCode
# Was one of our watched vars involved ?
foreach n [array names ${nspace}::args] {
if {[lindex [strInErr $::errorInfo $n] 0] == 2} then {
set a $n; set w [set ${nspace}::args($n)]
[set ${nspace}::callb] $w
}
}
return -code return
} else {
return $val
}
}
## strInErr
# Checks whether given regex happens to be in the cause of
# the error passed in err (procedure and 1st level of "while
# executing" is checked)
proc ::Toaster::strInErr {err regex} {
set v $err
set pat {.*\s+while executing\s*"(.*)"\s+\(procedure "(\w+)" line (\d+)\)}
if {![regexp $pat $v -> exec proc line]} then {
return [list 0]
}
if {[regexp $regex $exec]} then {
set kind 2
set matched $exec
} elseif {[regexp $regex $proc]} then {
set kind 3
set matched $proc
} else {
return [list 1]
}
return [list $kind $matched $exec $proc $line]
}if 0 {}
# test cases
if {[info script] == $argv0} then {
# make space for tcl's unknown:
if {[catch {rename unknown ::tcl::unknown} err]} then {
puts stderr "Toaster: Cannot rename unkown -> ::tcl::unkown:\n$err"
exit 1
}
# get things toasted:
namespace import Toaster::*
## #1: unknown testing
# the toasted thingies are callable, aren't they ?
proc bla {} {
return "bla!"
}
puts "Calling bla: [bla]"
set func [toaster bla [list]]
puts "Calling func $func: [$func]"
## #2: proc with an arg
# passing on of arguments works fine, too ?
proc bla2 {arg} {
return "bla: $arg!"
}
puts "Calling bla2 banzai: [bla2 banzai]"
set func [toaster bla2 [list]]
puts "Calling func $func banzai: [$func banzai]"
## #3: proc with an arg, triggering callback
# This time the toasted proc is triggering an
# error if the argument is not a number or outside
# the range [0; 3[. When the error occurs, the
# toasted thing should realize arg #1 is involed
# in the error message and thus call the callback
# "callb" with the stored info (when it was toasted)
proc callb tag {
puts stderr " ERROR! Tag=$tag"
}
proc bla3 {arg} {
if {![regexp {\d+} $arg]} then {
error "arg $arg not a number."
} elseif {$arg < 0 || $arg > 2} then {
error "arg $arg out of range."
}
lindex {banzai ayaken bla} $arg
}
puts "Calling bla3 1: [bla3 1]"
set func [toaster bla3 error-tag callb]
puts "Calling ${func}(0): [$func 0]"
puts "Calling ${func}(\"bla\"): [$func bla]"
puts "Calling ${func}(20): [$func 20]"
## #4: now with a widget.
# when you hit the button, the text from the entry widget below
# appears in the entry widget above, except when it's a number.
# Then the callback sends the <<Errant>> event to the widget,
# which makes it red.
package require Tk
proc bla4 {arg} {
if {[regexp {\d+} $arg]} then {
error "No numbers allowed, but passed $arg!"
}
.t1 delete 0 end
.t1 insert end $arg
}
entry .t1
.t1 insert end "text shows up here."
entry .t2
.t2 insert end "Enter text here."
button .b -command "[toaster bla4 .t2] \[.t2 get\]" -text "Hit me!"
pack .t1 .t2 .b
bind .t2 <<Errant>> {
.t2 configure -bg red
}
}if 0 { # Example test output:
# Calling bla: bla!
# Calling func _proc1::bla: bla!
# Calling bla2 banzai: bla: banzai!
# Calling func _proc2::bla2 banzai: bla: banzai!
# Calling bla3 1: ayaken
# Calling _proc3::bla3(0): banzai
# ERROR! Tag=error-tag
# Calling _proc3::bla3("bla"):
# ERROR! Tag=error-tag
# Calling _proc3::bla3(20):So what exactly is this good for ? I was thinking of writing wrappers for the functions, which do all of the argument checking, and are pretty clear in the error messages (like the above check for the lindex argument for bla3). You don't have to care how specifically the information will be carried to the user when writing these wrappers, but instead only concentrate on the pre- and post-conditions. All you have to take care of is that the parameter name must appear in the error message.The callback above is only a sketchy example, something more sophisticated could display the real error (e.g. "Argument must be a number between 0 and 3") as returned from the check-wrapper in some dialog box, while also generating <<Errant>> events to the widget(s) which would guide the User immediately to the errant place(s).The net effect is that the argument checking proc(s) can be bundled with the procs whose argument they check, and the proc(s) which handle errant user input can be bundled with the gui-implementation.
Caveats:
- Only sends stuff on errors, when it's successful, should tell the widget the callback was all fine so it can cleanup earlier modifications done as reaction on incoming <<Errant>> events.
- The name of the proc parameter must appear in the error message, else the callback isn't triggered (doesn't know which data it should select)
- There's more, I bet...
Category Example }
