From: Jeff Hobbs Date: Sat, 23 Jun 2007 00:53:41 +0000 (+0000) Subject: * tkcon.tcl (::tkcon::EvalCmd): add OPT(resultfilter) and 'tkcon X-Git-Tag: tkcon-2-5~5 X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=2a909641262cd8f56151854c9e6d9e47bd98d394;p=tkcon * tkcon.tcl (::tkcon::EvalCmd): add OPT(resultfilter) and 'tkcon resultfilter ?cmd?' to allow optional result filter command. Command will be passed result code and data and must return what tkcon will return to the user. Command is run in attached slave. Ensure that initial files are sources at level #0. Convert args after (--|-argv|-args) into slave arguments and set them as the main $::argv/$::argc for propagation. --- diff --git a/ChangeLog b/ChangeLog index 5a9340b..70c5eeb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2007-06-22 Jeff Hobbs + + * tkcon.tcl (::tkcon::EvalCmd): add OPT(resultfilter) and 'tkcon + resultfilter ?cmd?' to allow optional result filter command. + Command will be passed result code and data and must return what + tkcon will return to the user. Command is run in attached slave. + Ensure that initial files are sources at level #0. + Convert args after (--|-argv|-args) into slave arguments and set + them as the main $::argv/$::argc for propagation. + 2007-06-21 Jeff Hobbs * docs/tkcon.1.man, docs/tkcon.n.man, docs/tkconrc.5.man (new): diff --git a/tkcon.tcl b/tkcon.tcl index f65b391..3ae0fad 100755 --- a/tkcon.tcl +++ b/tkcon.tcl @@ -160,6 +160,7 @@ proc ::tkcon::Init {args} { gets {congets} overrideexit 1 usehistory 1 + resultfilter {} exec slave } { @@ -317,8 +318,9 @@ proc ::tkcon::Init {args} { ## Handle arg based options switch -glob -- $arg { -- - -argv - -args { - set argv [concat -- [lrange $argv $i end]] - set argc [llength $argv] + set slaveargs [concat $slaveargs [lrange $args $i end]] + set ::argv $slaveargs + set ::argc [llength $::argv] break } -color-* { set COLOR([string range $arg 7 end]) $val } @@ -420,7 +422,7 @@ proc ::tkcon::Init {args} { ## Source extra command line argument files into slave executable foreach fn $slavefiles { puts -nonewline "slave sourcing \"$fn\" ... " - if {[catch {EvalSlave source [list $fn]} fnerr]} { + if {[catch {EvalSlave uplevel \#0 [list source $fn]} fnerr]} { puts stderr "error:\n$fnerr" append PRIV(errorInfo) $errorInfo\n } else { puts "OK" } @@ -987,6 +989,16 @@ proc ::tkcon::EvalCmd {w cmd} { return } AddSlaveHistory $cmd + # Run any user defined result filter command. The command is + # passed result code and data. + if {[llength $OPT(resultfilter)]} { + set cmd [concat $OPT(resultfilter) [list $code $res]] + if {[catch {EvalAttached $cmd} res2]} { + $w insert output "Filter failed: $res2" stderr \n stdout + } else { + set res $res2 + } + } catch {EvalAttached [list set _ $res]} set maxlen $OPT(maxlinelen) set trailer "" @@ -3377,8 +3389,7 @@ proc tkcon {cmd args} { cons* { ## 'console' - passes the args to the text widget of the console. set result [uplevel 1 $PRIV(console) $args] - ::tkcon::ConstrainBuffer $PRIV(console) \ - $OPT(buffer) + ::tkcon::ConstrainBuffer $PRIV(console) $OPT(buffer) return $result } congets { @@ -3531,6 +3542,13 @@ proc tkcon {cmd args} { ## 'master' - evals contents in master interpreter uplevel \#0 $args } + result* { + ## 'resultfilter' Sets/queries the result filter command + if {[llength $args]} { + set OPT(resultfilter) $args + } + return $OPT(resultfilter) + } set { ## 'set' - set (or get, or unset) simple vars (not whole arrays) ## from the master console interpreter