From fd8067d2421d7975e2c7acf19bc335c24b600e1a Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 16 Jun 2024 15:12:28 +0000 Subject: Some more improvements --- generic/tclEnsemble.c | 96 +++++++++++++++++++++++++++++++++++++++++++++------ generic/tclInt.h | 18 +++++----- 2 files changed, 94 insertions(+), 20 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 711d59d..d3a84fc 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -166,7 +166,6 @@ TclNamespaceEnsembleCmd( int objc, Tcl_Obj *const objv[]) { - Tcl_Namespace *namespacePtr; Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); Tcl_Command token; int index; @@ -184,8 +183,7 @@ TclNamespaceEnsembleCmd( if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?"); return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands, + } else if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands, "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -248,7 +246,24 @@ TclNamespaceEnsembleCmd( } return TCL_OK; } - + +/* + *---------------------------------------------------------------------- + * + * InitEnsembleFromOptions -- + * + * Core of implementation of "namespace ensemble create". + * + * Results: + * Returns created ensemble's command token if successful, and NULL if + * anything goes wrong. + * + * Side effects: + * Creates the ensemble for the namespace if one did not previously + * exist. + * + *---------------------------------------------------------------------- + */ static Tcl_Command InitEnsembleFromOptions( Tcl_Interp *interp, @@ -408,7 +423,23 @@ InitEnsembleFromOptions( } return NULL; } - + +/* + *---------------------------------------------------------------------- + * + * ReadOneEnsembleOption -- + * + * Core of implementation of "namespace ensemble configure" with just a + * single option name. + * + * Results: + * Tcl result code. Modifies the interpreter result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ static int ReadOneEnsembleOption( Tcl_Interp *interp, @@ -464,7 +495,22 @@ ReadOneEnsembleOption( } return TCL_OK; } - +/* + *---------------------------------------------------------------------- + * + * ReadAllEnsembleOptions -- + * + * Core of implementation of "namespace ensemble configure" without + * option names. + * + * Results: + * Tcl result code. Modifies the interpreter result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ static int ReadAllEnsembleOptions( Tcl_Interp *interp, @@ -526,7 +572,22 @@ ReadAllEnsembleOptions( Tcl_SetObjResult(interp, resultObj); return TCL_OK; } - +/* + *---------------------------------------------------------------------- + * + * SetEnsembleConfigOptions -- + * + * Core of implementation of "namespace ensemble configure" with even + * number of arguments (where there is at least one pair). + * + * Results: + * Tcl result code. Modifies the interpreter result. + * + * Side effects: + * Modifies the ensemble's configuration. + * + *---------------------------------------------------------------------- + */ static int SetEnsembleConfigOptions( Tcl_Interp *interp, @@ -2194,12 +2255,24 @@ TclSpellFix( TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL); } -Tcl_Obj *const *TclEnsembleGetRewriteValues( - Tcl_Interp *interp /* Current interpreter. */ -) +/* + *---------------------------------------------------------------------- + * + * TclEnsembleGetRewriteValues -- + * + * Get the original arguments to the current command before any rewrite + * rules (from aliases, ensembles, and method forwards) were applied. + * + *---------------------------------------------------------------------- + */ +Tcl_Obj *const * +TclEnsembleGetRewriteValues( + Tcl_Interp *interp) /* Current interpreter. */ + { Interp *iPtr = (Interp *) interp; Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs; + if (origObjv[0] == NULL) { origObjv = (Tcl_Obj *const *) origObjv[2]; } @@ -3448,7 +3521,8 @@ CompileToInvokedCommand( * Do the replacing dispatch. */ - TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1); + TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords, + numWords + 1); } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 5a09f34..6221792 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1968,7 +1968,7 @@ typedef struct Interp { * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ - Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for + Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is @@ -1978,8 +1978,7 @@ typedef struct Interp { * NULL. Set by ObjInterpProc in tclProc.c and * used by tclCompile.c to process local * variables appropriately. */ - ResolverScheme *resolverPtr; - /* Linked list of name resolution schemes + ResolverScheme *resolverPtr;/* Linked list of name resolution schemes * added to this interpreter. Schemes are * added and removed by calling * Tcl_AddInterpResolvers and @@ -2018,7 +2017,8 @@ typedef struct Interp { /* First in list of active traces for interp, * or NULL if no active traces. */ - Tcl_Size tracesForbiddingInline; /* Count of traces (in the list headed by + Tcl_Size tracesForbiddingInline; + /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation. */ @@ -2048,7 +2048,7 @@ typedef struct Interp { * as flag values the same as the 'active' * field. */ - Tcl_Size cmdCount; /* Limit for how many commands to execute in + Tcl_Size cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is @@ -2084,9 +2084,10 @@ typedef struct Interp { * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - Tcl_Size numRemovedObjs; /* How many arguments have been stripped off + Tcl_Size numRemovedObjs;/* How many arguments have been stripped off * because of ensemble processing. */ - Tcl_Size numInsertedObjs; /* How many of the current arguments were + Tcl_Size numInsertedObjs; + /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; @@ -2146,8 +2147,7 @@ typedef struct Interp { * used by function ...() in the same file. * It does for the eval/direct path of script * execution what CompileEnv.clLoc does for - * the bytecode compiler. - */ + * the bytecode compiler. */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. -- cgit v0.12