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