* 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 5a9340b37bf5a38c5cb21f5f0cbca675a4e05ca7..70c5eeb54387ff59d22de05bd944000e83c30263 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2007-06-22  Jeff Hobbs  <jeffh@ActiveState.com>
+
+       * 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  <jeffh@ActiveState.com>
 
        * docs/tkcon.1.man, docs/tkcon.n.man, docs/tkconrc.5.man (new): 

diff --git a/tkcon.tcl b/tkcon.tcl
index f65b3918782385a7938c629fe7e68888fb9f5b58..3ae0fade759892b42844fbe4860161c6146f8510 100755 (executable)
--- 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