summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdIL.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdIL.c')
-rw-r--r--generic/tclCmdIL.c130
1 files changed, 124 insertions, 6 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 7f67180..b68f7ba 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -11,11 +11,12 @@
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2005 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: tclCmdIL.c,v 1.74 2005/05/10 18:34:08 kennykb Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.75 2005/05/30 00:04:46 dkf Exp $
*/
#include "tclInt.h"
@@ -712,6 +713,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
Tcl_Obj *listPtr, *elemObjPtr;
int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
Tcl_Command cmd;
+ int i;
/*
* Get the pattern and find the "effective namespace" in which to
@@ -779,16 +781,43 @@ InfoCommandsCmd(dummy, interp, objc, objv)
elemObjPtr = Tcl_NewStringObj(cmdName, -1);
}
Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
- } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
- entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable,
- simplePattern);
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+ }
+ if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+ Tcl_HashTable *tablePtr;
+
+ for (i=0 ; i<nsPtr->commandPathLength ; i++) {
+ Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;
+
+ if (pathNsPtr == NULL) {
+ continue;
+ }
+ tablePtr = &pathNsPtr->cmdTable;
+ entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
+ if (entryPtr != NULL) {
+ break;
+ }
+ }
+ if (entryPtr == NULL) {
+ tablePtr = &globalNsPtr->cmdTable;
+ entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
+ }
if (entryPtr != NULL) {
- cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
+ cmdName = Tcl_GetHashKey(tablePtr, entryPtr);
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(cmdName, -1));
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
}
}
- } else {
+ } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) {
+ /*
+ * The pattern is non-trivial, but either there is no explicit
+ * path or there is an explicit namespace in the pattern. In
+ * both cases, the old matching scheme is perfect.
+ */
+
entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
while (entryPtr != NULL) {
cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
@@ -828,6 +857,95 @@ InfoCommandsCmd(dummy, interp, objc, objv)
entryPtr = Tcl_NextHashEntry(&search);
}
}
+ } else {
+ /*
+ * The pattern is non-trivial (can match more than one command
+ * name), there is an explicit path, and there is no explicit
+ * namespace in the pattern. This means that we have to
+ * traverse the path to discover all the commands defined.
+ */
+
+ Tcl_HashTable addedCommandsTable;
+ int isNew;
+ int foundGlobal = (nsPtr == globalNsPtr);
+
+ /*
+ * We keep a hash of the objects already added to the result
+ * list.
+ */
+ Tcl_InitObjHashTable(&addedCommandsTable);
+
+ entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ while (entryPtr != NULL) {
+ cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
+ if ((simplePattern == NULL)
+ || Tcl_StringMatch(cmdName, simplePattern)) {
+ elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+ Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+ (void) Tcl_CreateHashEntry(&addedCommandsTable,
+ (char *)elemObjPtr, &isNew);
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ /*
+ * Search the path next.
+ */
+
+ for (i=0 ; i<nsPtr->commandPathLength ; i++) {
+ Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;
+
+ if (pathNsPtr == NULL) {
+ continue;
+ }
+ if (pathNsPtr == globalNsPtr) {
+ foundGlobal = 1;
+ }
+ entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search);
+ while (entryPtr != NULL) {
+ cmdName = Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr);
+ if ((simplePattern == NULL)
+ || Tcl_StringMatch(cmdName, simplePattern)) {
+ elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+ (void) Tcl_CreateHashEntry(&addedCommandsTable,
+ (char *) elemObjPtr, &isNew);
+ if (isNew) {
+ Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+ } else {
+ TclDecrRefCount(elemObjPtr);
+ }
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ }
+
+ /*
+ * If the effective namespace isn't the global :: namespace, and a
+ * specific namespace wasn't requested in the pattern, then add in
+ * all global :: commands that match the simple pattern. Of course,
+ * we add in only those commands that aren't hidden by a command in
+ * the effective namespace.
+ */
+
+ if (!foundGlobal) {
+ entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
+ while (entryPtr != NULL) {
+ cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
+ if ((simplePattern == NULL)
+ || Tcl_StringMatch(cmdName, simplePattern)) {
+ elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+ if (Tcl_FindHashEntry(&addedCommandsTable,
+ (char *) elemObjPtr) == NULL) {
+ Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+ } else {
+ TclDecrRefCount(elemObjPtr);
+ }
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ }
+
+ Tcl_DeleteHashTable(&addedCommandsTable);
}
Tcl_SetObjResult(interp, listPtr);