Attachment "lexpandv2.diff" to
ticket [781929ffff]
added by
muonics
2003-08-10 03:18:40.
Index: tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.75.2.5
diff -r1.75.2.5 tclBasic.c
122a123,124
> {"lexpand", (Tcl_CmdProc *) NULL, Tcl_LexpandObjCmd,
> (CompileProc *) NULL, 0},
2985a2988
> Tcl_Obj *expandListObj;
2989a2993,3022
>
> /*
> * Handle the case of arguments that are the result of [lexpand]
> */
>
> expandListObj = Tcl_NewListObj(0, NULL);
>
> for (i = 0 ; i < objc ; i++) {
> if (objv[i] -> typePtr == &tclExpandListType) {
> Tcl_Obj **elemv, *argObj = objv[i];
> int elemc, elemNum;
>
> if (Tcl_IsShared(argObj))
> argObj = Tcl_DuplicateObj(argObj);
>
> Tcl_ListObjGetElements(interp, argObj, &elemc, &elemv);
>
> for (elemNum = 0 ; elemNum < elemc ; elemNum++) {
> Tcl_ListObjAppendElement(interp, expandListObj, elemv[elemNum]);
> }
> } else {
> Tcl_ListObjAppendElement(interp, expandListObj, objv[i]);
> }
> }
>
> /*
> * Extract the new argument array from the list object
> */
>
> Tcl_ListObjGetElements(interp, expandListObj, &objc, (Tcl_Obj ***)&objv);
Index: tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.47.2.2
diff -r1.47.2.2 tclCmdIL.c
2012a2013,2082
> /*----------------------------------------------------------------------
> *
> * Tcl_LexpandObjCmd --
> *
> * This object-based procedure is invoked to process the "lexpand" 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_LexpandObjCmd(dummy, interp, objc, objv)
> ClientData dummy; /* Not used. */
> Tcl_Interp *interp; /* Current interpreter. */
> int objc; /* Number of arguments. */
> Tcl_Obj *CONST objv[]; /* Argument objects. */
> {
>
> Tcl_Obj *objResult; /* Pointer to expand-list object result */
> int i;
>
> objc--; objv++;
>
> objResult = Tcl_NewListObj(0, NULL);
>
> for (i = 0 ; i < objc ; i++) {
> Tcl_Obj *argObj = objv[i];
> Tcl_Obj **elemv;
> int elemc, elemNum;
>
> if (Tcl_IsShared(argObj))
> argObj = Tcl_DuplicateObj(objv[i]);
>
> Tcl_ListObjGetElements(interp, argObj, &elemc, &elemv);
>
> for (elemNum = 0 ; elemNum < elemc ; elemNum++) {
> Tcl_ListObjAppendElement(interp, objResult, elemv[elemNum]);
> }
> }
>
> /*
> * This is a workaround for the fact that Tcl seems to create empty
> * list objects as strings instead of list objects with zero elements,
> * to force the result to have a list representation. Otherwise, a
> * crash would occur later on when trying to extract the elements as
> * Tcl would try to free a non-existant list representation.
> */
>
> Tcl_ListObjLength(interp, objResult, &objc);
>
> /*
> * Mark the object has having the to-be-expanded type list (which is just
> * a list by another name). Handling of the actual expansion will
> * be handled elsewhere (e.g. TclEvalObjvInternal).
> */
>
> objResult -> typePtr = &tclExpandListType;
>
> Tcl_SetObjResult(interp, objResult);
>
> return TCL_OK;
> }
>
Index: tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.118.2.3
diff -r1.118.2.3 tclInt.h
1561a1562
> extern Tcl_ObjType tclExpandListType;
1867a1869,1870
> Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
> EXTERN int Tcl_LexpandObjCmd _ANSI_ARGS_((ClientData clientData,
Index: tclListObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclListObj.c,v
retrieving revision 1.13
diff -r1.13 tclListObj.c
50a51,58
>
> Tcl_ObjType tclExpandListType = {
> "lexpand", /* name */
> FreeListInternalRep, /* freeIntRepProc */
> DupListInternalRep, /* dupIntRepProc */
> UpdateStringOfList, /* updateStringProc */
> SetListFromAny /* setFromAnyProc */
> };
