Attachment "lastresult.patch" to
ticket [2927535fff]
added by
ferrieux
2010-01-07 20:56:37.
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 7 Jan 2010 13:48:55 -0000
@@ -28,6 +28,8 @@ typedef struct {
} HistoryObjs;
#define HISTORY_OBJS_KEY "::tcl::HistoryObjs"
+#define HISTORY_RESULT_KEY "::tcl::HistResult"
+
/*
* Static functions in this file.
@@ -98,6 +100,108 @@ Tcl_RecordAndEval(
}
return result;
}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteHistoryResult --
+ *
+ * Called to delete the references to the last result.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The result object may be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteHistoryResult(
+ ClientData clientData,
+ Tcl_Interp *interp)
+{
+ Tcl_Obj *obj;
+
+ obj=(Tcl_Obj *)Tcl_GetAssocData(interp, HISTORY_RESULT_KEY, NULL);
+ if (obj != NULL) {
+ Tcl_DecrRefCount(obj);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StoreHistoryResult --
+ *
+ * This procedure keeps a reference to the interp's result in the
+ * interp's assoc table, for later retrieval by [interp result].
+ *
+ * Side effects:
+ *
+ * Refcounts are updated properly so that the previously stored value
+ * gets freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static
+void
+StoreHistoryResult(
+ Tcl_Interp *interp
+ )
+{
+ Tcl_Obj *obj;
+
+ obj=(Tcl_Obj *)Tcl_GetAssocData(interp, HISTORY_RESULT_KEY, NULL);
+ if (obj != NULL) {
+ Tcl_DecrRefCount(obj);
+ }
+ obj=Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(obj);
+ Tcl_SetAssocData(interp, HISTORY_RESULT_KEY, DeleteHistoryResult, obj);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HistResultObjCmd --
+ *
+ * This function is invoked to process the ::tcl::lastresult Tcl command.
+ *
+ *----------------------------------------------------------------------
+ */
+ /* ARGSUSED */
+int
+Tcl_HistResultObjCmd(
+ ClientData clientData, /* Unused. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *obj;
+
+ if (objc > 1)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+
+ obj = (Tcl_Obj *) Tcl_GetAssocData(interp, HISTORY_RESULT_KEY, NULL);
+ if (obj == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "no interactive command executed yet");
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, obj);
+
+ return TCL_OK;
+}
+
/*
*----------------------------------------------------------------------
@@ -190,6 +294,8 @@ Tcl_RecordAndEvalObj(
result = TCL_OK;
if (!(flags & TCL_NO_EVAL)) {
result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
+
+ StoreHistoryResult(interp);
}
return result;
}
@@ -228,5 +334,7 @@ DeleteHistoryObjs(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.453
diff -u -p -r1.453 tclInt.h
--- generic/tclInt.h 11 Dec 2009 04:47:13 -0000 1.453
+++ generic/tclInt.h 7 Jan 2010 13:48:55 -0000
@@ -3274,6 +3274,9 @@ MODULE_SCOPE int Tcl_VwaitObjCmd(ClientD
MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_HistResultObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
/*
*----------------------------------------------------------------
Index: generic/tclMain.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclMain.c,v
retrieving revision 1.47
diff -u -p -r1.47 tclMain.c
--- generic/tclMain.c 15 Dec 2008 15:48:33 -0000 1.47
+++ generic/tclMain.c 7 Jan 2010 13:48:56 -0000
@@ -219,6 +219,7 @@ Tcl_SourceRCFile(
Tcl_DStringFree(&temp);
}
}
+
/*----------------------------------------------------------------------
*
@@ -396,6 +397,9 @@ Tcl_Main(
*/
Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
+
+ Tcl_CreateObjCommand(interp, "::tcl::lastresult", Tcl_HistResultObjCmd, NULL, NULL);
+
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
while ((inChannel != NULL) && !Tcl_InterpDeleted(interp)) {
