1 files changed, 71 insertions, 8 deletions

diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 5ca5cf8..14951e4 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -32,6 +32,9 @@ struct ForeachState {
     int *argcList;		/* Array of value list sizes. */
     Tcl_Obj ***argvList;	/* Array of value lists. */
     Tcl_Obj **aCopyList;	/* Copies of value list arguments. */
+    Tcl_Obj *resultList;	/* List of result values from the loop body,
+				 * or NULL if we're not collecting them
+				 * ([lmap] vs [foreach]). */
 };
 
 /*
@@ -52,6 +55,8 @@ static int		GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 static const char *	GetTypeFromMode(int mode);
 static int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
 			    Tcl_StatBuf *statPtr);
+static inline int	EachloopCmd(Tcl_Interp *interp, int collect,
+			    int objc, Tcl_Obj *const objv[]);
 static Tcl_NRPostProc	CatchObjCmdCallback;
 static Tcl_NRPostProc	ExprCallback;
 static Tcl_NRPostProc	ForSetupCallback;
@@ -2565,7 +2570,7 @@ ForPostNextCallback(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ForeachObjCmd, TclNRForeachCmd --
+ * Tcl_ForeachObjCmd, TclNRForeachCmd, EachloopCmd --
  *
  *	This object-based procedure is invoked to process the "foreach" Tcl
  *	command. See the user documentation for details on what it does.
@@ -2597,6 +2602,38 @@ TclNRForeachCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
+    return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv);
+}
+
+int
+Tcl_LmapObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    return Tcl_NRCallObjProc(interp, TclNRLmapCmd, dummy, objc, objv);
+}
+
+int
+TclNRLmapCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
+}
+
+static inline int
+EachloopCmd(
+    Tcl_Interp *interp,		/* Our context for variables and script
+				 * evaluation. */
+    int collect,		/* Select collecting or accumulating mode
+				 * (TCL_EACH_*) */
+    int objc,			/* The arguments being passed in... */
+    Tcl_Obj *const objv[])
+{
     int numLists = (objc-2) / 2;
     register struct ForeachState *statePtr;
     int i, j, result;
@@ -2640,6 +2677,12 @@ TclNRForeachCmd(
     statePtr->bodyPtr = objv[objc - 1];
     statePtr->bodyIdx = objc - 1;
 
+    if (collect == TCL_EACH_COLLECT) {
+	statePtr->resultList = Tcl_NewListObj(0, NULL);
+    } else {
+	statePtr->resultList = NULL;
+    }
+
     /*
      * Break up the value lists and variable lists into elements.
      */
@@ -2653,9 +2696,11 @@ TclNRForeachCmd(
 	TclListObjGetElements(NULL, statePtr->vCopyList[i],
 		&statePtr->varcList[i], &statePtr->varvList[i]);
 	if (statePtr->varcList[i] < 1) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "foreach varlist is empty", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH",
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s varlist is empty",
+		    (statePtr->resultList != NULL ? "lmap" : "foreach")));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+		    (statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
 		    "NEEDVARS", NULL);
 	    result = TCL_ERROR;
 	    goto done;
@@ -2725,14 +2770,21 @@ ForeachLoopStep(
     switch (result) {
     case TCL_CONTINUE:
 	result = TCL_OK;
+	break;
     case TCL_OK:
+	if (statePtr->resultList != NULL) {
+	    Tcl_ListObjAppendElement(interp, statePtr->resultList,
+		    Tcl_GetObjResult(interp));
+	}
 	break;
     case TCL_BREAK:
 	result = TCL_OK;
-	goto done;
+	goto finish;
     case TCL_ERROR:
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"foreach\" body line %d)", Tcl_GetErrorLine(interp)));
+		"\n    (\"%s\" body line %d)",
+		(statePtr->resultList != NULL ? "lmap" : "foreach"),
+		Tcl_GetErrorLine(interp)));
     default:
 	goto done;
     }
@@ -2757,7 +2809,14 @@ ForeachLoopStep(
      * We're done. Tidy up our work space and finish off.
      */
 
-    Tcl_ResetResult(interp);
+  finish:
+    if (statePtr->resultList == NULL) {
+	Tcl_ResetResult(interp);
+    } else {
+	Tcl_SetObjResult(interp, statePtr->resultList);
+	statePtr->resultList = NULL;	/* Don't clean it up */
+    }
+
   done:
     ForeachCleanup(interp, statePtr);
     return result;
@@ -2790,7 +2849,8 @@ ForeachAssignments(
 
 	    if (varValuePtr == NULL) {
 		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (setting foreach loop variable \"%s\")",
+			"\n    (setting %s loop variable \"%s\")",
+			(statePtr->resultList != NULL ? "lmap" : "foreach"),
 			TclGetString(statePtr->varvList[i][v])));
 		return TCL_ERROR;
 	    }
@@ -2819,6 +2879,9 @@ ForeachCleanup(
 	    TclDecrRefCount(statePtr->aCopyList[i]);
 	}
     }
+    if (statePtr->resultList != NULL) {
+	TclDecrRefCount(statePtr->resultList);
+    }
     TclStackFree(interp, statePtr);
 }