TIP#136 IMPLEMENTATION. We now have an [lrepeat] command!

3 files changed, 95 insertions, 3 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cf8a758..30e2165 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.85 2003/06/25 23:02:11 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.86 2003/08/11 13:26:13 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -126,6 +126,8 @@ static CmdInfo builtInCmds[] = {
         (CompileProc *) NULL,		0},
     {"lrange",		(Tcl_CmdProc *) NULL,	Tcl_LrangeObjCmd,
         (CompileProc *) NULL,		1},
+    {"lrepeat",		(Tcl_CmdProc *) NULL,	Tcl_LrepeatObjCmd,
+        (CompileProc *) NULL,		1},
     {"lreplace",	(Tcl_CmdProc *) NULL,	Tcl_LreplaceObjCmd,
         (CompileProc *) NULL,		1},
     {"lsearch",		(Tcl_CmdProc *) NULL,	Tcl_LsearchObjCmd,
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 89c05af..467241d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.51 2003/07/15 15:42:05 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.52 2003/08/11 13:26:13 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2637,6 +2637,94 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_LrepeatObjCmd --
+ *
+ *	This procedure is invoked to process the "lrepeat" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    register int objc;			/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    int elementCount, i, j, k, result;
+    Tcl_Obj **dataArray;
+
+    /* 
+     * Check arguments for legality:
+     *		lrepeat posInt value ?value ...?
+     */
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "positiveCount value ?value ...?");
+	return TCL_ERROR;
+    }
+    elementCount = 0;
+    result = Tcl_GetIntFromObj(interp, objv[1], &elementCount);
+    if (result == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    if (elementCount < 1) {
+	Tcl_AppendResult(interp, "must have a count of at least 1", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Skip forward to the interesting arguments now we've finished
+     * parsing.
+     */
+
+    objc -= 2;
+    objv += 2;
+
+    /*
+     * Create workspace array large enough to hold each init value
+     * elementCount times.  Note that we don't bother with stack
+     * allocation for this, as we expect this function to be used
+     * mainly when stack allocation would be inappropriate anyway.
+     *
+     * POSSIBLE FUTURE ENHANCEMENT: Build the resulting list object
+     * directly and avoid a copy.
+     */
+
+    dataArray = (Tcl_Obj **) ckalloc(elementCount * objc * sizeof(Tcl_Obj));
+
+    /*
+     * Set the elements.  Note that this ends up setting k to the
+     * total number of elements.
+     */
+
+    k = 0;
+    for (i=0 ; i<elementCount ; i++) {
+	for (j=0 ; j<objc ; j++) {
+	    dataArray[k++] = objv[j];
+	}
+    }
+
+    /*
+     * Build the result list, clean up and return.
+     */
+
+    Tcl_SetObjResult(interp, Tcl_NewListObj(k, dataArray));
+    ckfree((char*) dataArray);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_LreplaceObjCmd --
  *
  *	This object-based procedure is invoked to process the "lreplace" 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e25d632..0da497b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.130 2003/07/24 18:16:30 mdejong Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.131 2003/08/11 13:26:13 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -1893,6 +1893,8 @@ EXTERN int	Tcl_LoadObjCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_LrangeObjCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LrepeatObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_LreplaceObjCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_LsearchObjCmd _ANSI_ARGS_((ClientData clientData,