Tcl Source Code

Artifact [6596b9cbab]
Login

Artifact 6596b9cbab1f8917d9fbe0ebf37251b3e78b2e59:

Attachment "histresult.patch" to ticket [2927535fff] added by ferrieux 2010-01-19 02:54:36.
Index: doc/history.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/history.n,v
retrieving revision 1.8
diff -u -p -r1.8 history.n
--- doc/history.n	13 Dec 2007 15:22:32 -0000	1.8
+++ doc/history.n	8 Jan 2010 13:55:40 -0000
@@ -76,6 +76,9 @@ This command may be used to change the s
 \fIcount\fR events.  Initially, 20 events are retained in the history
 list.  If \fIcount\fR is not specified, the current keep limit is returned.
 .TP
+\fBhistory lastresult\fR
+Retrieves the last interactive command's result previously stored through [history result $value].
+.TP
 \fBhistory nextid\fR
 Returns the number of the next event to be recorded
 in the history list.  It is useful for things like printing the
@@ -85,6 +88,9 @@ event number in command-line prompts.
 Re-executes the command indicated by \fIevent\fR and returns its result.
 \fIEvent\fR defaults to \fB\-1\fR.  This command results in history
 revision:  see below for details.
+.TP
+\fBhistory result\fI value \fR
+Stores the \fIvalue\fR argument for later retrieval by [history lastresult].
 .SH "HISTORY REVISION"
 .PP
 Pre-8.0 Tcl had a complex history revision mechanism.
Index: generic/tclHistory.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclHistory.c,v
retrieving revision 1.14
diff -u -p -r1.14 tclHistory.c
--- generic/tclHistory.c	29 Dec 2009 16:58:41 -0000	1.14
+++ generic/tclHistory.c	8 Jan 2010 13:55:40 -0000
@@ -25,6 +25,7 @@
 typedef struct {
     Tcl_Obj *historyObj;	/* == "::history" */
     Tcl_Obj *addObj;		/* == "add" */
+    Tcl_Obj *resultObj;		/* == "result" */
 } HistoryObjs;
 
 #define HISTORY_OBJS_KEY	"::tcl::HistoryObjs"
@@ -143,8 +144,10 @@ Tcl_RecordAndEvalObj(
 	histObjsPtr = (HistoryObjs *) ckalloc(sizeof(HistoryObjs));
 	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
 	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
+	TclNewLiteralStringObj(histObjsPtr->resultObj, "result");
 	Tcl_IncrRefCount(histObjsPtr->historyObj);
 	Tcl_IncrRefCount(histObjsPtr->addObj);
+	Tcl_IncrRefCount(histObjsPtr->resultObj);
 	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
 		histObjsPtr);
     }
@@ -190,6 +193,22 @@ Tcl_RecordAndEvalObj(
     result = TCL_OK;
     if (!(flags & TCL_NO_EVAL)) {
 	result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
+
+        /* Send  the interp's result  to [::history  result]. Interp  state is
+         * protected  during the  call, so  that  script errors  at this  spot
+         * cannot generate confusing error messages. */
+
+        if (call)           {
+            Tcl_Obj *list[3];
+            Tcl_InterpState state;
+
+            list[0] = histObjsPtr->historyObj;
+            list[1] = histObjsPtr->resultObj;
+            list[2] = Tcl_GetObjResult(interp);
+            state = Tcl_SaveInterpState(interp, 0 /* dummy */);
+            (void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
+            Tcl_RestoreInterpState(interp, state);
+        }
     }
     return result;
 }
@@ -228,5 +247,7 @@ DeleteHistoryObjs(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */
Index: library/history.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/history.tcl,v
retrieving revision 1.10
diff -u -p -r1.10 history.tcl
--- library/history.tcl	19 Nov 2009 11:59:54 -0000	1.10
+++ library/history.tcl	8 Jan 2010 13:55:40 -0000
@@ -36,6 +36,8 @@ namespace eval ::tcl {
 	keep	::tcl::HistKeep
 	nextid	::tcl::HistNextID
 	redo	::tcl::HistRedo
+	result  ::tcl::HistResult
+	lastresult  ::tcl::HistLastResult
     }
 }
 
@@ -305,6 +307,36 @@ proc ::tcl::HistNextID {} {
     return [expr {$history(nextid) + 1}]
 }
 
+# tcl::HistResult --
+#
+#	Called back by the C level (like HistAdd) to store the last interactive command's result.
+#
+# Parameters:
+#	The last command's result or error message.
+#
+# Side Effects:
+#	Stores it in a slot of the history array.
+
+proc ::tcl::HistResult res {
+    variable history
+	set history(lastresult) $res
+}
+
+# tcl::HistLastResult --
+#
+#	Retrieves the last interactive command's result.
+#
+# Parameters:
+#	None.
+#
+# Side Effects:
+#	None.
+
+proc ::tcl::HistLastResult {} {
+    variable history
+	return $history(lastresult)
+}
+
 return
 
 # Local Variables:
Index: tests/history.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/history.test,v
retrieving revision 1.7
diff -u -p -r1.7 history.test
--- tests/history.test	25 Jul 2009 21:51:02 -0000	1.7
+++ tests/history.test	8 Jan 2010 13:55:41 -0000
@@ -245,7 +245,20 @@ test history-9.1 {miscellaneous} history
 test history-9.2 {miscellaneous} history {
     catch {history gorp} msg
     set msg
-} {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
+} {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, lastresult, nextid, redo, or result}
+
+# "history lastresult"
+
+test history-10.1 {lastresult option} history {
+	exec [interpreter] << {
+		set ::tcl_interactive 1
+		expr 42
+		puts [history lastresult];exit
+	}
+} {1
+% 42
+% 42}
+
 
 # cleanup
 ::tcltest::cleanupTests