Implement TIP #265. [FRQ 1446696]

5 files changed, 665 insertions, 12 deletions

diff --git a/ChangeLog b/ChangeLog
index 56b863a..3332bd0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,15 +1,26 @@
+2008-10-03  Donal K. Fellows  <dkf@users.sf.net>
+
+	TIP #265 IMPLEMENTATION
+
+	* generic/tclIndexObj.c (Tcl_ParseArgsObjv, PrintUsage):
+	* generic/tcl.h (Tcl_ArgvInfo):	Added function for simple parsing of
+	* doc/ParseArgs.3 (new file):	optional arguments to commands. Still
+	needs tests and the like. [FRQ 1446696] Note that some of the type
+	signatures are changed a bit from the proposed implementation so that
+	they better reflect codified good practice for argument order.
+
 2008-10-02  Andreas Kupries  <andreask@activestate.com>
 
-	* tests/info.test (info-23.3): See [SF Bug 2017632]. Updated
-	  output of the test to handle the NRE-enabled eval and the proper
-	  propagation of location information through it.
+	* tests/info.test (info-23.3): Updated output of the test to handle
+	the NRE-enabled eval and the proper propagation of location
+	information through it. [Bug 2017632]
 
-	* doc/info.n: Fixed [SF Bug 2134049]. Rephrased the documentation
-	  of 'info frame' for positive numbers as level argument.
+	* doc/info.n: Rephrased the documentation of 'info frame' for positive
+	numbers as level argument. [Bug 2134049]
 
-	* tests/info.test (info-22.8): Fixed [SF Bug 2129828]. Made
-	  pattern for file containing tcltest less specific to accept both
-	  .tcl and .tm variants of the file during matching.
+	* tests/info.test (info-22.8): Made pattern for file containing
+	tcltest less specific to accept both .tcl and .tm variants of the file
+	during matching. [Bug 2129828]
 
 2008-10-02  Don Porter  <dgp@users.sourceforge.net>
 
diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3
new file mode 100644
index 0000000..524e2f2
--- /dev/null
+++ b/doc/ParseArgs.3
@@ -0,0 +1,200 @@
+'\"
+'\" Copyright (c) 2008 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" RCS: @(#) $Id: ParseArgs.3,v 1.1 2008/10/02 23:32:13 dkf Exp $
+'\" 
+.so man.macros
+.TH Tcl_ParseArgsObjv 3 8.6 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ParseArgsObjv \- parse arguments according to a tabular description
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_ParseArgsObjv\fR(\fIinterp, argTable, objcPtr, objv, remObjv\fR)
+.SH ARGUMENTS
+.AS "const Tcl_ArgvInfo" ***remObjv in/out
+.AP Tcl_Interp *interp out
+Where to store error messages.
+.AP "const Tcl_ArgvInfo" *argTable in
+Pointer to array of option descriptors.
+.AP int *objcPtr in/out
+A pointer to variable holding number of arguments in \fIobjv\fR. Will be
+modified to hold number of arguments left in the unprocessed argument list
+stored in \fIremObjv\fR.
+.AP "Tcl_Obj *const" *objv in
+The array of arguments to be parsed.
+.AP Tcl_Obj ***remObjv out
+Pointer to a variable that will hold the array of unprocessed arguments.
+Should be NULL if no return of unprocessed arguments is required. If
+\fIobjcPtr\fR is updated to a non-zero value, the array returned through this
+must be deallocated using \fBckfree\fR.
+.BE
+.SH DESCRIPTION
+.PP
+The \fBTcl_ParseArgsObjv\fR function provides a system for parsing argument
+lists of the form
+.QW "\fB\-someName \fIsomeValue\fR ..." .
+Such argument lists are commonly found both in the arguments to a program and
+in the arguments to an individual Tcl command. This parser assumes that the
+order of the arguments does not matter, other than in so far as later copies
+of a duplicated option overriding earlier ones.
+.PP
+The argument array is described by the \fIobjcPtr\fR and \fIobjv\fR
+parameters, and an array of unprocessed arguments is returned through the
+\fIobjcPtr\fR and \fIremObjv\fR parameters; if no return of unprocessed
+arguments is desired, the \fIremObjv\fR parameter should be NULL. If any
+problems happen, including if the
+.QW "generate help"
+option is selected, an error message is left in the interpreter result and
+TCL_ERROR is returned. Otherwise, the interpreter result is left unchanged and
+TCL_OK is returned.
+.PP
+The collection of arguments to be parsed is described by the \fIargTable\fR
+parameter. This points to a table of descriptor structures that is terminated
+by an entry with the \fItype\fR field set to TCL_ARGV_END. As convenience, the
+following prototypical entries are provided:
+.TP
+\fBTCL_ARGV_AUTO_HELP\fR
+.
+Enables the argument processor to provide help when passed the argument
+.QW \fB\-help\fR .
+.TP
+\fBTCL_ARGV_AUTO_REST\fR
+.
+Instructs the argument processor that arguments after
+.QW \fB\-\-\fR
+are to be unprocessed.
+.TP
+\fBTCL_ARGV_TABLE_END\fR
+.
+Marks the end of the table of argument descriptors.
+.SS "ARGUMENT DESCRIPTOR ENTRIES"
+.PP
+Each entry of the argument descriptor table must be a structure of type
+\fBTcl_ArgvInfo\fR. The structure is defined as this:
+.PP
+.CS
+typedef struct {
+    int \fItype\fR;
+    const char *\fIkeyStr\fR;
+    void *\fIsrcPtr\fR;
+    void *\fIdstPtr\fR;
+    const char *\fIhelpStr\fR;
+    ClientData \fIclientData\fR;
+} \fBTcl_ArgvInfo\fR;
+.CE
+.PP
+The \fIkeyStr\fR field contains the name of the option; by convention, this
+will normally begin with a
+.QW \fB\-\fR
+character. The \fItype\fR, \fIsrcPtr\fR, \fIdstPtr\fR and \fIclientData\fR
+fields describe the interpretation of the value of the argument, as described
+below. The \fIhelpStr\fR field gives some text that is used to provide help to
+users when they request it.
+.PP
+As noted above, the \fItype\fR field is used to describe the interpretation of
+the argument's value. The following values are acceptable values for
+\fItype\fR:
+.TP
+\fBTCL_ARGV_CONSTANT\fR
+.
+The argument does not take any following value argument. If this argument is
+present, the int pointed to by the \fIsrcPtr\fR field is copied to the
+\fIdstPtr\fR field. The \fIclientData\fR field is ignored.
+.TP
+\fBTCL_ARGV_END\fR
+.
+This value marks the end of all option descriptors in the table. All other
+fields are ignored.
+.TP
+\fBTCL_ARGV_FLOAT\fR
+.
+This argument takes a following floating point value argument. The value (once
+parsed by \fBTcl_GetDoubleFromObj\fR) will be stored as a double-precision
+value in the variable pointed to by the \fIdstPtr\fR field. The \fIsrcPtr\fR
+and \fIclientData\fR fields are ignored.
+.TP
+\fBTCL_ARGV_FUNC\fR
+.
+This argument optionally takes a following value argument; it is up to the
+handler callback function passed in \fIsrcPtr\fR to decide. That function will
+have the following signature:
+.RS
+.PP
+.CS
+typedef int (*\fBTcl_ArgvFuncProc\fR)(
+        ClientData \fIclientData\fR,
+        Tcl_Obj *\fIobjPtr\fR,
+        void *\fIdstPtr\fR);
+.CE
+.PP
+The result is a boolean value indicating whether to consume the following
+argument. The \fIclientData\fR is the value from the table entry, the
+\fIobjPtr\fR is the object that represents the following argument or NULL if
+there are no following arguments at all, and the \fIdstPtr\fR argument to the
+\fBTcl_ArgvFuncProc\fR is the location to write the parsed value to.
+.RE
+.TP
+\fBTCL_ARGV_GENFUNC\fR
+.
+This argument takes zero or more following arguments; the handler callback
+function passed in \fIsrcPtr\fR returns how many (or a negative number to
+signal an error, in which case it should also set the interpreter result). The
+function will have the following signature:
+.RS
+.PP
+.CS
+typedef int (*\fBTcl_ArgvGenFuncProc\fR)(
+        ClientData \fIclientData\fR,
+        Tcl_Interp *\fIinterp\fR,
+        int \fIobjc\fR,
+        Tcl_Obj *const *\fIobjv\fR,
+        void *\fIdstPtr\fR);
+.CE
+.PP
+The \fIclientData\fR is the value from the table entry, the \fIinterp\fR is
+where to store any error messages, the \fIkeyStr\fR is the name of the
+argument, \fIobjc\fR and \fIobjv\fR describe an array of all the remaining
+arguments, and \fIdstPtr\fR argument to the \fBTcl_ArgvGenFuncProc\fR is the
+location to write the parsed value (or values) to.
+.RE
+.TP
+\fBTCL_ARGV_HELP\fR
+.
+This special argument does not take any following value argument, but instead
+causes \fBTcl_ParseArgsObjv\fR to generate an error message describing the
+arguments supported. All other fields except the \fIhelpStr\fR field are
+ignored.
+.TP
+\fBTCL_ARGV_INT\fR
+.
+This argument takes a following integer value argument. The value (once parsed
+by \fBTcl_GetIntFromObj\fR) will be stored as an int in the variable pointed
+to by the \fIdstPtr\fR field. The \fIsrcPtr\fR field is ignored.
+.TP
+\fBTCL_ARGV_REST\fR
+.
+This special argument does not take any following value argument, but instead
+marks all following arguments to be left unprocessed. The \fIsrcPtr\fR,
+\fIdstPtr\fR and \fIclientData\fR fields are ignored.
+.TP
+\fBTCL_ARGV_STRING\fR
+.
+This argument takes a following string value argument. A pointer to the string
+will be stored at \fIdstPtr\fR; the string inside will have a lifetime linked
+to the lifetime of the string representation of the argument object that it
+came from, and so should be copied if it needs to be retained. The
+\fIsrcPtr\fR and \fIclientData\fR fields are ignored.
+.SH "SEE ALSO"
+Tcl_GetIndexFromObj(3), Tcl_Main(3), Tcl_CreateObjCommand(3)
+.SH KEYWORDS
+argument, parse
+'\" Local Variables:
+'\" fill-column: 78
+'\" End:
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 8a65b76..a8bd083 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -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: tcl.decls,v 1.145 2008/09/28 22:17:39 dkf Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.146 2008/10/02 23:32:13 dkf Exp $
 
 library tcl
 
@@ -2197,6 +2197,11 @@ declare 603 generic {
 	    Tcl_Obj **paramListPtr)
 }
 
+# TIP#265 (option parser)
+declare 604 generic {
+    int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
+	    int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
+}
 
 ##############################################################################
 
diff --git a/generic/tcl.h b/generic/tcl.h
index abe1157..d7b5ec7 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -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: tcl.h,v 1.271 2008/10/02 20:59:45 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.272 2008/10/02 23:32:13 dkf Exp $
  */
 
 #ifndef _TCL
@@ -2186,6 +2186,65 @@ typedef unsigned long mp_digit;
 #endif
 
 /*
+ *----------------------------------------------------------------------------
+ * Definitions needed for Tcl_ParseArgvObj routines.
+ * Based on tkArgv.c.
+ * Modifications from the original are copyright (c) Sam Bromley 2006
+ *----------------------------------------------------------------------------
+ */
+
+typedef struct {
+    int type;			/* Indicates the option type; see below. */
+    const char *keyStr;		/* The key string that flags the option in the
+				 * argv array. */
+    void *srcPtr;		/* Value to be used in setting dst; usage
+				 * depends on type.*/
+    void *dstPtr;		/* Address of value to be modified; usage
+				 * depends on type.*/
+    const char *helpStr;	/* Documentation message describing this
+				 * option. */
+    ClientData clientData;	/* Word to pass to function callbacks. */
+} Tcl_ArgvInfo;
+
+/*
+ * Legal values for the type field of a Tcl_ArgInfo: see the user
+ * documentation for details.
+ */
+
+#define TCL_ARGV_CONSTANT	15
+#define TCL_ARGV_INT		16
+#define TCL_ARGV_STRING		17
+#define TCL_ARGV_REST		18
+#define TCL_ARGV_FLOAT		19
+#define TCL_ARGV_FUNC		20
+#define TCL_ARGV_GENFUNC	21
+#define TCL_ARGV_HELP		22
+#define TCL_ARGV_END		23
+
+/*
+ * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC
+ * argument types:
+ */
+
+typedef int (*Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr,
+	void *dstPtr);
+typedef int (*Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
+	int objc, Tcl_Obj *const *objv, void *dstPtr);
+
+/*
+ * Shorthand for commonly used argTable entries.
+ */
+
+#define TCL_ARGV_AUTO_HELP \
+    {TCL_ARGV_HELP,	"-help",	NULL,	NULL, \
+	    "Print summary of command-line options and abort"}
+#define TCL_ARGV_AUTO_REST \
+    {TCL_ARGV_REST,	"--",		NULL,	NULL, \
+	    "Marks the end of the options"}
+#define TCL_ARGV_TABLE_END \
+    {TCL_ARGV_END}
+
+/*
  * The following constant is used to test for older versions of Tcl in the
  * stubs tables.
  *
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 0633cfd..144503f 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -3,14 +3,16 @@
  *
  *	This file implements objects of type "index". This object type is used
  *	to lookup a keyword in a table of valid values and cache the index of
- *	the matching entry.
+ *	the matching entry. Also provides table-based argv/argc processing.
  *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
  * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 2006 Sam Bromley.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIndexObj.c,v 1.38 2007/12/13 15:23:18 dgp Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.39 2008/10/02 23:32:13 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -23,6 +25,8 @@ static int		SetIndexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		UpdateStringOfIndex(Tcl_Obj *objPtr);
 static void		DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
 static void		FreeIndex(Tcl_Obj *objPtr);
+static void		PrintUsage(Tcl_Interp *interp,
+			    const Tcl_ArgvInfo *argTable);
 
 /*
  * The structure below defines the index Tcl object type by means of functions
@@ -632,6 +636,380 @@ Tcl_WrongNumArgs(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseArgsObjv --
+ *
+ *	Process an objv array according to a table of expected command-line
+ *	options. See the manual page for more details.
+ *
+ * Results:
+ *	The return value is a standard Tcl return value. If an error occurs
+ *	then an error message is left in the interp's result. Under normal
+ *	conditions, both *objcPtr and *objv are modified to return the
+ *	arguments that couldn't be processed here (they didn't match the
+ *	option table, or followed an TCL_ARGV_REST argument).
+ *
+ * Side effects:
+ *	Variables may be modified, or procedures may be called. It all depends
+ *	on the arguments and their entries in argTable. See the user
+ *	documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ParseArgsObjv(
+    Tcl_Interp *interp,		/* Place to store error message. */
+    const Tcl_ArgvInfo *argTable,
+				/* Array of option descriptions. */
+    int *objcPtr,		/* Number of arguments in objv. Modified to
+				 * hold # args left in objv at end. */
+    Tcl_Obj *const *objv,	/* Array of arguments to be parsed. */
+    Tcl_Obj ***remObjv)		/* Pointer to array of arguments that were not
+				 * processed here. Should be NULL if no return
+				 * of arguments is desired. */
+{
+    Tcl_Obj **leftovers;	/* Array to write back to remObjv on
+				 * successful exit. Will include the name of
+				 * the command. */
+    int nrem;			/* Size of leftovers.*/
+    register const Tcl_ArgvInfo *infoPtr;
+				/* Pointer to the current entry in the table
+				 * of argument descriptions. */
+    const Tcl_ArgvInfo *matchPtr;
+				/* Descriptor that matches current argument. */
+    Tcl_Obj *curArg;		/* Current argument */
+    char *str = NULL;
+    register char c;		/* Second character of current arg (used for
+				 * quick check for matching; use 2nd char.
+				 * because first char. will almost always be
+				 * '-'). */
+    int srcIndex;		/* Location from which to read next argument
+				 * from objv. */
+    int dstIndex;		/* Used to keep track of current arguments
+				 * being processed, primarily for error
+				 * reporting. */
+    int objc;			/* # arguments in objv still to process. */
+    int length;			/* Number of characters in current argument. */
+
+    if (remObjv != NULL) {
+	/*
+	 * Then we should copy the name of the command (0th argument).
+	 */
+
+	nrem = 1;
+	leftovers = (Tcl_Obj **) ckalloc((nrem+1) * sizeof(Tcl_Obj *));
+	leftovers[nrem-1] = objv[0];
+	leftovers[nrem] = NULL;
+    } else {
+	nrem = 0;
+	leftovers = NULL;
+    }
+
+    /*
+     * OK, now start processing from the second element (1st argument).
+     */
+
+    srcIndex = dstIndex = 1;
+    objc = *objcPtr-1;
+
+    while (objc > 0) {
+	curArg = objv[srcIndex];
+	srcIndex++;
+	objc--;
+	str = Tcl_GetStringFromObj(curArg, &length);
+	if (length > 0) {
+	    c = str[1];
+	} else {
+	    c = 0;
+	}
+
+	/*
+	 * Loop throught the argument descriptors searching for one with the
+	 * matching key string. If found, leave a pointer to it in matchPtr.
+	 */
+
+	matchPtr = NULL;
+	infoPtr = argTable;
+	for (; (infoPtr != NULL) && (infoPtr->type != TCL_ARGV_END);
+		infoPtr++) {
+	    if (infoPtr->keyStr == NULL) {
+		continue;
+	    }
+	    if ((infoPtr->keyStr[1] != c)
+		    || (strncmp(infoPtr->keyStr, str, length) != 0)) {
+		continue;
+	    }
+	    if (infoPtr->keyStr[length] == 0) {
+		matchPtr = infoPtr;
+		goto gotMatch;
+	    }
+	    if (matchPtr != NULL) {
+		Tcl_AppendResult(interp, "ambiguous option \"", str, "\"",
+			NULL);
+		goto error;
+	    }
+	    matchPtr = infoPtr;
+	}
+	if (matchPtr == NULL) {
+	    /*
+	     * Unrecognized argument. Just copy it down, unless the caller
+	     * prefers an error to be registered.
+	     */
+
+	    if (remObjv == NULL) {
+		Tcl_AppendResult(interp, "unrecognized argument \"", str,
+			"\"", NULL);
+		goto error;
+	    }
+
+	    dstIndex++;		/* This argument is now handled */
+	    nrem++;
+
+	    /*
+	     * Allocate nrem (+1 extra for NULL terminator) pointers.
+	     */
+
+	    leftovers = (Tcl_Obj **) ckrealloc((void *) leftovers,
+		    (nrem+1) * sizeof(Tcl_Obj *));
+	    leftovers[nrem-1] = curArg;
+	    continue;
+	}
+
+	/*
+	 * Take the appropriate action based on the option type
+	 */
+
+    gotMatch:
+	infoPtr = matchPtr;
+	switch (infoPtr->type) {
+	case TCL_ARGV_CONSTANT:
+	    *((int *) infoPtr->dstPtr) = (int) infoPtr->srcPtr;
+	    break;
+	case TCL_ARGV_INT:
+	    if (objc == 0) {
+		goto missingArg;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[srcIndex],
+		    (int *) infoPtr->dstPtr) == TCL_ERROR) {
+		Tcl_AppendResult(interp, "expected integer argument for \"",
+			infoPtr->keyStr, "\" but got \"",
+			Tcl_GetString(objv[srcIndex]), "\"", NULL);
+		goto error;
+	    }
+	    srcIndex++;
+	    objc--;
+	    break;
+	case TCL_ARGV_STRING:
+	    if (objc == 0) {
+		goto missingArg;
+	    }
+	    *((const char **) infoPtr->dstPtr) =
+		    Tcl_GetString(objv[srcIndex]);
+	    srcIndex++;
+	    objc--;
+	    break;
+	case TCL_ARGV_REST:
+	    *((int *) infoPtr->dstPtr) = dstIndex;
+	    goto argsDone;
+	case TCL_ARGV_FLOAT:
+	    if (objc == 0) {
+		goto missingArg;
+	    }
+	    if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
+		    (double *) infoPtr->dstPtr) == TCL_ERROR) {
+		Tcl_AppendResult(interp, "expected floating-point argument ",
+			"for \"", infoPtr->keyStr, "\" but got \"",
+			Tcl_GetString((Tcl_Obj *) objv[srcIndex]),"\"", NULL);
+		goto error;
+	    }
+	    srcIndex++;
+	    objc--;
+	    break;
+	case TCL_ARGV_FUNC: {
+	    Tcl_ArgvFuncProc handlerProc;
+	    Tcl_Obj *argObj;
+
+	    if (objc == 0) {
+		argObj = NULL;
+	    } else {
+		argObj = objv[srcIndex];
+	    }
+	    handlerProc = (Tcl_ArgvFuncProc) infoPtr->srcPtr;
+	    if (handlerProc(infoPtr->clientData, infoPtr->dstPtr, argObj)) {
+		srcIndex++;
+		objc--;
+	    }
+	    break;
+	}
+	case TCL_ARGV_GENFUNC: {
+	    Tcl_ArgvGenFuncProc handlerProc;
+
+	    handlerProc = (Tcl_ArgvGenFuncProc) infoPtr->srcPtr;
+	    objc = handlerProc(infoPtr->clientData, infoPtr->dstPtr, interp,
+		    objc, &objv[srcIndex]);
+	    if (objc < 0) {
+		goto error;
+	    }
+	    break;
+	}
+	case TCL_ARGV_HELP:
+	    PrintUsage(interp, argTable);
+	    goto error;
+	default: {
+	    char buf[64 + TCL_INTEGER_SPACE];
+
+	    sprintf(buf, "bad argument type %d in Tcl_ArgvInfo",
+		    infoPtr->type);
+	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    goto error;
+	}
+	}
+    }
+
+    /*
+     * If we broke out of the loop because of an OPT_REST argument, copy the
+     * remaining arguments down.
+     */
+
+  argsDone:
+    if (remObjv==NULL) {
+	/*
+	 * Nothing to do.
+	 */
+
+	return TCL_OK;
+    }
+
+    if (objc > 0) {
+	leftovers = (Tcl_Obj **) ckrealloc((void *) leftovers,
+		(nrem+objc+1) * sizeof(Tcl_Obj*));
+	while (objc) {
+	    leftovers[nrem]=objv[srcIndex];
+	    nrem++;
+	    srcIndex++;
+	    objc--;
+	}
+    } else if (leftovers != NULL) {
+	ckfree((char *) leftovers);
+    }
+    leftovers[nrem] = NULL;
+    *objcPtr = nrem;
+    *remObjv = leftovers;
+    return TCL_OK;
+
+    /*
+     * Make sure to handle freeing any temporary space we've allocated on the
+     * way to an error.
+     */
+
+  missingArg:
+    Tcl_AppendResult(interp, "\"", str,
+	    "\" option requires an additional argument", NULL);
+  error:
+    if (leftovers != NULL) {
+	ckfree((char *) leftovers);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintUsage --
+ *
+ *	Generate a help string describing command-line options.
+ *
+ * Results:
+ *	The interp's result will be modified to hold a help string describing
+ *	all the options in argTable.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintUsage(
+    Tcl_Interp *interp,		/* Place information in this interp's result
+				 * area. */
+    const Tcl_ArgvInfo *argTable)
+				/* Array of command-specific argument
+				 * descriptions. */
+{
+    register const Tcl_ArgvInfo *infoPtr;
+    int width, numSpaces;
+#define NUM_SPACES 20
+    static char spaces[] = "                    ";
+    char tmp[TCL_DOUBLE_SPACE];
+
+    /*
+     * First, compute the width of the widest option key, so that we can make
+     * everything line up.
+     */
+
+    width = 4;
+    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
+	int length;
+
+	if (infoPtr->keyStr == NULL) {
+	    continue;
+	}
+	length = strlen(infoPtr->keyStr);
+	if (length > width) {
+	    width = length;
+	}
+    }
+
+    /*
+     * Now add the option information, with pretty-printing.
+     */
+
+    Tcl_AppendResult(interp, "Command-specific options:", NULL);
+    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
+	if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) {
+	    Tcl_AppendResult(interp, "\n", infoPtr->helpStr, NULL);
+	    continue;
+	}
+	Tcl_AppendResult(interp, "\n ", infoPtr->keyStr, ":", NULL);
+	numSpaces = width + 1 - strlen(infoPtr->keyStr);
+	while (numSpaces > 0) {
+	    if (numSpaces >= NUM_SPACES) {
+		Tcl_AppendResult(interp, spaces, NULL);
+	    } else {
+		Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces, NULL);
+	    }
+	    numSpaces -= NUM_SPACES;
+	}
+	Tcl_AppendResult(interp, infoPtr->helpStr, NULL);
+	switch (infoPtr->type) {
+	case TCL_ARGV_INT:
+	    sprintf(tmp, "%d", *((int *) infoPtr->dstPtr));
+	    Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL);
+	    break;
+	case TCL_ARGV_FLOAT:
+	    sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
+	    Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL);
+	    break;
+	case TCL_ARGV_STRING: {
+	    char *string;
+
+	    string = *((char **) infoPtr->dstPtr);
+	    if (string != NULL) {
+		Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string,
+			"\"", NULL);
+	    }
+	    break;
+	}
+	default:
+	    break;
+	}
+    }
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4