From b6d0e8df2a36c2c588369036359615f7156d1ba2 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 2 Oct 2008 23:32:13 +0000 Subject: Implement TIP #265. [FRQ 1446696] --- ChangeLog | 27 ++-- doc/ParseArgs.3 | 200 ++++++++++++++++++++++++++ generic/tcl.decls | 7 +- generic/tcl.h | 61 +++++++- generic/tclIndexObj.c | 382 +++++++++++++++++++++++++++++++++++++++++++++++++- 5 files changed, 665 insertions(+), 12 deletions(-) create mode 100644 doc/ParseArgs.3 diff --git a/ChangeLog b/ChangeLog index 56b863a..3332bd0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,15 +1,26 @@ +2008-10-03 Donal K. Fellows + + 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 - * 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 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 \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 -- cgit v0.12