summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/CrtAlias.325
-rw-r--r--generic/tcl.decls17
-rw-r--r--generic/tclDecls.h48
-rw-r--r--generic/tclInterp.c81
-rw-r--r--generic/tclStubInit.c24
5 files changed, 72 insertions, 123 deletions
diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3
index eece208..ba2e415 100644
--- a/doc/CrtAlias.3
+++ b/doc/CrtAlias.3
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
-Tcl_IsSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
+Tcl_IsSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -37,10 +37,6 @@ int
objc, objv\fR)
.sp
int
-\fBTcl_GetAlias\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
- argcPtr, argvPtr\fR)
-.sp
-int
\fBTcl_GetAliasObj\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
objcPtr, objvPtr\fR)
.sp
@@ -87,16 +83,13 @@ command is defined for an alias.
.AP "const char" **targetCmdPtr out
Pointer to location to store the address of the name of the target command
for an alias.
-.AP int *argcPtr out
-Pointer to location to store count of additional arguments to be passed to
-the alias. The location is in storage owned by the caller.
-.AP "const char" ***argvPtr out
-Pointer to location to store a vector of strings, the additional arguments
-to pass to an alias. The location is in storage owned by the caller, the
-vector of strings is owned by the called function.
-.AP int *objcPtr out
+.AP "Tcl_Size \&| int" *objcPtr out
Pointer to location to store count of additional value arguments to be
passed to the alias. The location is in storage owned by the caller.
+If it points to a variable which type is not \fBTcl_Size\fR, a compiler
+warning will be generated. If your extensions is compiled with -DTCL_8_API,
+this function will return TCL_ERROR for aliases with more than INT_MAX
+value arguments, otherwise expect it to crash
.AP Tcl_Obj ***objvPtr out
Pointer to location to store a vector of Tcl_Obj structures, the additional
arguments to pass to an alias command. The location is in storage
@@ -173,13 +166,9 @@ a vector of Tcl_Obj structures about an alias \fIaliasName\fR
in \fIinterp\fR. Any of the result fields can be \fBNULL\fR, in
which case the corresponding datum is not returned. If a result field is
non\-\fBNULL\fR, the address indicated is set to the corresponding datum.
-For example, if \fItargetNamePtr\fR is non\-\fBNULL\fR it is set to a
+For example, if \fItargetCmdPtr\fR is non\-\fBNULL\fR it is set to a
pointer to the string containing the name of the target command.
.PP
-\fBTcl_GetAlias\fR is similar to \fBTcl_GetAliasObj\fR except that it
-returns a pointer to a vector of string instead of a vector of
-Tcl_Obj structures. \fBTcl_GetAlias\fR is deprecated.
-.PP
\fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from
the set of hidden commands to the set of exposed commands, putting
it under the name
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 641d2b1..ffcc510 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -470,15 +470,10 @@ declare 145 {
declare 146 {
int Tcl_Flush(Tcl_Channel chan)
}
-declare 148 {deprecated {Use Tcl_GetAliasObj}} {
- int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
- Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
- int *argcPtr, const char ***argvPtr)
-}
declare 149 {
- int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
+ int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
- int *objcPtr, Tcl_Obj ***objv)
+ int *objcPtr, Tcl_Obj ***objvPtr)
}
declare 150 {
void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
@@ -880,9 +875,11 @@ declare 284 {
void Tcl_SetMainLoop(Tcl_MainLoopProc *proc)
}
-# Reserved for future use (8.0.x vs. 8.1)
-# declare 285 {
-# }
+declare 285 {
+ int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
+ Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
+ Tcl_Size *objcPtr, Tcl_Obj ***objvPtr)
+}
# Added in 8.1:
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index d4fee5e..46d35c6 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -427,19 +427,13 @@ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
/* 146 */
EXTERN int Tcl_Flush(Tcl_Channel chan);
/* Slot 147 is reserved */
-/* 148 */
-TCL_DEPRECATED("Use Tcl_GetAliasObj")
-int Tcl_GetAlias(Tcl_Interp *interp,
- const char *childCmd,
- Tcl_Interp **targetInterpPtr,
- const char **targetCmdPtr, int *argcPtr,
- const char ***argvPtr);
+/* Slot 148 is reserved */
/* 149 */
-EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
+EXTERN int TclGetAliasObj(Tcl_Interp *interp,
const char *childCmd,
Tcl_Interp **targetInterpPtr,
const char **targetCmdPtr, int *objcPtr,
- Tcl_Obj ***objv);
+ Tcl_Obj ***objvPtr);
/* 150 */
EXTERN void * Tcl_GetAssocData(Tcl_Interp *interp,
const char *name,
@@ -762,7 +756,12 @@ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp,
EXTERN Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan);
/* 284 */
EXTERN void Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
-/* Slot 285 is reserved */
+/* 285 */
+EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
+ const char *childCmd,
+ Tcl_Interp **targetInterpPtr,
+ const char **targetCmdPtr, Tcl_Size *objcPtr,
+ Tcl_Obj ***objvPtr);
/* 286 */
EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr,
Tcl_Obj *appendObjPtr);
@@ -2030,8 +2029,8 @@ typedef struct TclStubs {
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
void (*reserved147)(void);
- TCL_DEPRECATED_API("Use Tcl_GetAliasObj") int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
- int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
+ void (*reserved148)(void);
+ int (*tclGetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 149 */
void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
Tcl_Size (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
@@ -2167,7 +2166,7 @@ typedef struct TclStubs {
int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
- void (*reserved285)(void);
+ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 285 */
void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */
void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */
@@ -2865,10 +2864,9 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_Flush \
(tclStubsPtr->tcl_Flush) /* 146 */
/* Slot 147 is reserved */
-#define Tcl_GetAlias \
- (tclStubsPtr->tcl_GetAlias) /* 148 */
-#define Tcl_GetAliasObj \
- (tclStubsPtr->tcl_GetAliasObj) /* 149 */
+/* Slot 148 is reserved */
+#define TclGetAliasObj \
+ (tclStubsPtr->tclGetAliasObj) /* 149 */
#define Tcl_GetAssocData \
(tclStubsPtr->tcl_GetAssocData) /* 150 */
#define Tcl_GetChannel \
@@ -3113,7 +3111,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetStackedChannel) /* 283 */
#define Tcl_SetMainLoop \
(tclStubsPtr->tcl_SetMainLoop) /* 284 */
-/* Slot 285 is reserved */
+#define Tcl_GetAliasObj \
+ (tclStubsPtr->tcl_GetAliasObj) /* 285 */
#define Tcl_AppendObjToObj \
(tclStubsPtr->tcl_AppendObjToObj) /* 286 */
#define Tcl_CreateEncoding \
@@ -4165,7 +4164,7 @@ extern const TclStubs *tclStubsPtr;
# define Tcl_GetMaster Tcl_GetParent
#endif
-/* Protect those 10 functions, make them useless through the stub table */
+/* Protect those 11 functions, make them useless through the stub table */
#undef TclGetStringFromObj
#undef TclGetBytesFromObj
#undef TclGetUnicodeFromObj
@@ -4176,6 +4175,7 @@ extern const TclStubs *tclStubsPtr;
#undef TclSplitPath
#undef TclFSSplitPath
#undef TclParseArgsObjv
+#undef TclGetAliasObj
#if TCL_MAJOR_VERSION < 9
/* TIP #627 for 8.7 */
@@ -4221,6 +4221,9 @@ extern const TclStubs *tclStubsPtr;
# undef Tcl_ParseArgsObjv
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) \
tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv))
+# undef Tcl_GetAliasObj
+# define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) \
+ tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv))
#elif defined(TCL_8_API)
# undef Tcl_GetByteArrayFromObj
# undef Tcl_GetBytesFromObj
@@ -4233,6 +4236,7 @@ extern const TclStubs *tclStubsPtr;
# undef Tcl_SplitPath
# undef Tcl_FSSplitPath
# undef Tcl_ParseArgsObjv
+# undef Tcl_GetAliasObj
# if !defined(USE_TCL_STUBS)
# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \
@@ -4267,6 +4271,9 @@ extern const TclStubs *tclStubsPtr;
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \
(Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
+# define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
+ TclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \
+ (Tcl_GetAliasObj)((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv)))
# elif !defined(BUILD_tcl)
# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \
@@ -4301,6 +4308,9 @@ extern const TclStubs *tclStubsPtr;
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \
tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
+# define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
+ tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \
+ tclStubsPtr->tcl_GetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv)))
# endif /* defined(USE_TCL_STUBS) */
#else /* !defined(TCL_8_API) */
# undef Tcl_GetByteArrayFromObj
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index d953bc0..b9e4e86 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1276,69 +1276,6 @@ Tcl_CreateAliasObj(
/*
*----------------------------------------------------------------------
*
- * Tcl_GetAlias --
- *
- * Gets information about an alias.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-#ifndef TCL_NO_DEPRECATED
-int
-Tcl_GetAlias(
- Tcl_Interp *interp, /* Interp to start search from. */
- const char *aliasName, /* Name of alias to find. */
- Tcl_Interp **targetInterpPtr,
- /* (Return) target interpreter. */
- const char **targetNamePtr, /* (Return) name of target command. */
- int *argcPtr, /* (Return) count of addnl args. */
- const char ***argvPtr) /* (Return) additional arguments. */
-{
- InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
- Tcl_HashEntry *hPtr;
- Alias *aliasPtr;
- int i, objc;
- Tcl_Obj **objv;
-
- hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
- if (hPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "alias \"%s\" not found", aliasName));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, (char *)NULL);
- return TCL_ERROR;
- }
- aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
- objc = aliasPtr->objc;
- objv = &aliasPtr->objPtr;
-
- if (targetInterpPtr != NULL) {
- *targetInterpPtr = aliasPtr->targetInterp;
- }
- if (targetNamePtr != NULL) {
- *targetNamePtr = TclGetString(objv[0]);
- }
- if (argcPtr != NULL) {
- *argcPtr = objc - 1;
- }
- if (argvPtr != NULL) {
- *argvPtr = (const char **)
- Tcl_Alloc(sizeof(const char *) * (objc - 1));
- for (i = 1; i < objc; i++) {
- (*argvPtr)[i - 1] = TclGetString(objv[i]);
- }
- }
- return TCL_OK;
-}
-#endif /* TCL_NO_DEPRECATED */
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetAliasObj --
*
* Object version: Gets information about an alias.
@@ -1358,14 +1295,14 @@ Tcl_GetAliasObj(
const char *aliasName, /* Name of alias to find. */
Tcl_Interp **targetInterpPtr,
/* (Return) target interpreter. */
- const char **targetNamePtr, /* (Return) name of target command. */
- int *objcPtr, /* (Return) count of addnl args. */
+ const char **targetCmdPtr, /* (Return) name of target command. */
+ Tcl_Size *objcPtr, /* (Return) count of addnl args. */
Tcl_Obj ***objvPtr) /* (Return) additional args. */
{
InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
- int objc;
+ Tcl_Size objc;
Tcl_Obj **objv;
hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
@@ -1382,8 +1319,8 @@ Tcl_GetAliasObj(
if (targetInterpPtr != NULL) {
*targetInterpPtr = aliasPtr->targetInterp;
}
- if (targetNamePtr != NULL) {
- *targetNamePtr = TclGetString(objv[0]);
+ if (targetCmdPtr != NULL) {
+ *targetCmdPtr = TclGetString(objv[0]);
}
if (objcPtr != NULL) {
*objcPtr = objc - 1;
@@ -1522,7 +1459,7 @@ AliasCreate(
Tcl_Interp *parentInterp, /* Interp in which target command will be
* invoked. */
Tcl_Obj *namePtr, /* Name of alias cmd. */
- Tcl_Obj *targetNamePtr, /* Name of target cmd. */
+ Tcl_Obj *targetCmdPtr, /* Name of target cmd. */
int objc, /* Additional arguments to store */
Tcl_Obj *const objv[]) /* with alias. */
{
@@ -1542,8 +1479,8 @@ AliasCreate(
aliasPtr->objc = objc + 1;
prefv = &aliasPtr->objPtr;
- *prefv = targetNamePtr;
- Tcl_IncrRefCount(targetNamePtr);
+ *prefv = targetCmdPtr;
+ Tcl_IncrRefCount(targetCmdPtr);
for (i = 0; i < objc; i++) {
*(++prefv) = objv[i];
Tcl_IncrRefCount(objv[i]);
@@ -1574,7 +1511,7 @@ AliasCreate(
Command *cmdPtr;
Tcl_DecrRefCount(aliasPtr->token);
- Tcl_DecrRefCount(targetNamePtr);
+ Tcl_DecrRefCount(targetCmdPtr);
for (i = 0; i < objc; i++) {
Tcl_DecrRefCount(objv[i]);
}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index fc0f6fa..7c1aea8 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -74,7 +74,6 @@
# define TclGetStringFromObj 0
# define TclGetBytesFromObj 0
# define TclGetUnicodeFromObj 0
-# define Tcl_GetAlias 0
#endif
#undef Tcl_Close
#define Tcl_Close 0
@@ -95,6 +94,7 @@
# define TclSplitPath 0
# define TclFSSplitPath 0
# define TclParseArgsObjv 0
+# define TclGetAliasObj 0
#else /* !defined(TCL_NO_DEPRECATED) */
int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
void *objcPtr, Tcl_Obj ***objvPtr) {
@@ -189,6 +189,22 @@ int TclParseArgsObjv(Tcl_Interp *interp,
*(int *)objcPtr = (int)n;
return result;
}
+int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd,
+ Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
+ int *objcPtr, Tcl_Obj ***objv) {
+ Tcl_Size n = TCL_INDEX_NONE;
+ int result = Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, objv);
+ if (objcPtr) {
+ if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
+ if (interp) {
+ Tcl_AppendResult(interp, "List too large to be processed", NULL);
+ }
+ return TCL_ERROR;
+ }
+ *objcPtr = (int)n;
+ }
+ return result;
+}
#endif /* !defined(TCL_NO_DEPRECATED) */
#define TclBN_mp_add mp_add
@@ -951,8 +967,8 @@ const TclStubs tclStubs = {
Tcl_FirstHashEntry, /* 145 */
Tcl_Flush, /* 146 */
0, /* 147 */
- Tcl_GetAlias, /* 148 */
- Tcl_GetAliasObj, /* 149 */
+ 0, /* 148 */
+ TclGetAliasObj, /* 149 */
Tcl_GetAssocData, /* 150 */
Tcl_GetChannel, /* 151 */
Tcl_GetChannelBufferSize, /* 152 */
@@ -1088,7 +1104,7 @@ const TclStubs tclStubs = {
Tcl_UnstackChannel, /* 282 */
Tcl_GetStackedChannel, /* 283 */
Tcl_SetMainLoop, /* 284 */
- 0, /* 285 */
+ Tcl_GetAliasObj, /* 285 */
Tcl_AppendObjToObj, /* 286 */
Tcl_CreateEncoding, /* 287 */
Tcl_CreateThreadExitHandler, /* 288 */
generated by cgit v0.12 at 2026-01-06 12:20:49 (GMT)