From: Jeff Hobbs <hobbs@users.sourceforge.net>
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: https://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  <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 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