TIP#181 IMPLEMENTATION

        * doc/Namespace.3:      New command [namespace unknown].  New public
        * doc/namespace.n:      C routines Tcl_(Get|Set)NamespaceUnknownHandler.        * doc/unknown.n:        [Patch 958222].
        * generic/tcl.decls:
        * generic/tclBasic.c:
        * generic/tclInt.h:
        * generic/tclNamesp.c:
        * tests/namespace.test:

        * generic/tclDecls.h:   make genstubs
        * generic/tclStubInit.c:

6 files changed, 283 insertions, 20 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 410538d..6fe33f1 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -11,7 +11,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.118 2005/12/27 20:14:08 kennykb Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.119 2006/02/01 18:27:43 dgp Exp $
 
 library tcl
 
@@ -2037,7 +2037,17 @@ declare 566 generic {
     int Tcl_InitBignumFromDouble(Tcl_Interp* interp, double initval, 
 		mp_int *toInit)
 }
-  
+
+# TIP 181
+declare 567 generic {
+    Tcl_Obj *Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
+        Tcl_Namespace *nsPtr)
+}
+declare 568 generic {
+    int Tcl_SetNamespaceUnknownHandler(
+        Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+        Tcl_Obj *handlerPtr)
+}
 
 ##############################################################################
 
@@ -2078,6 +2088,7 @@ declare 1 macosx {
 	    char *libraryPath)
 }
 
+
 ##############################################################################
 
 # Public functions that are not accessible via the stubs table:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 735874b..cfd7e90 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -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: tclBasic.c,v 1.187 2006/01/11 17:34:53 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.188 2006/02/01 18:27:43 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3246,6 +3246,10 @@ TclEvalObjvInternal(
     int i;
     CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
 				 * TCL_EVAL_GLOBAL was set. */
+    Namespace *currNsPtr = NULL;/* Used to check for and invoke any
+                                 * registered unknown command
+                                 * handler for the current namespace
+                                 * (see TIP 181). */
     int code = TCL_OK;
     int traceCode = TCL_OK;
     int checkTraces = 1;
@@ -3260,9 +3264,10 @@ TclEvalObjvInternal(
 
     /*
      * Find the function to execute this command. If there isn't one, then see
-     * if there is a command "unknown". If so, create a new word array with
-     * "unknown" as the first word and the original command words as
-     * arguments. Then call ourselves recursively to execute it.
+     * if there is an unknown command handler registered for this namespace.
+     * If so, create a new word array with the handler as the first words and
+     * the original command words as arguments. Then call ourselves
+     * recursively to execute it.
      *
      * If caller requests, or if we're resolving the target end of an
      * interpeter alias (TCL_EVAL_INVOKE), be sure to do command name
@@ -3278,25 +3283,65 @@ TclEvalObjvInternal(
 	iPtr->varFramePtr = NULL;
     }
     cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+    /*
+     * Grab current namespace before restoring var frame, for unknown
+     * handler check below.
+     */
+    if (iPtr->varFramePtr != NULL && iPtr->varFramePtr->nsPtr != NULL) {
+        currNsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+        /* Note: assumes globalNsPtr can never be NULL. */
+        currNsPtr = iPtr->globalNsPtr;
+        if (currNsPtr == NULL) {
+            Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
+        }
+    }
     iPtr->varFramePtr = savedVarFramePtr;
 
     if (cmdPtr == NULL) {
-	newObjv = (Tcl_Obj **)
-		ckalloc((unsigned) ((objc + 1) * sizeof(Tcl_Obj *)));
-	for (i = objc-1; i >= 0; i--) {
-	    newObjv[i+1] = objv[i];
-	}
-	newObjv[0] = Tcl_NewStringObj("::unknown", -1);
+        int newObjc, handlerObjc;
+        Tcl_Obj **handlerObjv;
+        /*
+         * Check if there is an unknown handler registered for this namespace.
+         * Otherwise, use the global namespace unknown handler.
+         */
+        if (currNsPtr->unknownHandlerPtr == NULL) {
+            currNsPtr = iPtr->globalNsPtr;
+        }
+        if (currNsPtr == iPtr->globalNsPtr &&
+            currNsPtr->unknownHandlerPtr == NULL) {
+            /* Global namespace has lost unknown handler, reset. */
+            currNsPtr->unknownHandlerPtr =
+                Tcl_NewStringObj("::unknown", -1);
+            Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
+        }
+        if (Tcl_ListObjGetElements(interp,
+            currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv)
+            != TCL_OK) {
+            return TCL_ERROR;
+        }
+        newObjc = objc + handlerObjc;
+	newObjv = (Tcl_Obj **) ckalloc((unsigned)
+                (newObjc * sizeof(Tcl_Obj *)));
+        /* Copy command prefix from unknown handler. */
+        for (i = 0; i < handlerObjc; ++i) {
+            newObjv[i] = handlerObjv[i];
+        }
+        /* Add in command name and arguments. */
+        for (i = objc-1; i >= 0; --i) {
+            newObjv[i+handlerObjc] = objv[i];
+        }
 	Tcl_IncrRefCount(newObjv[0]);
 	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
+        
 	if (cmdPtr == NULL) {
 	    Tcl_AppendResult(interp, "invalid command name \"",
 		    TclGetString(objv[0]), "\"", NULL);
 	    code = TCL_ERROR;
 	} else {
 	    iPtr->numLevels++;
-	    code = TclEvalObjvInternal(interp, objc+1, newObjv,
-		    command, length, 0);
+	    code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
+			    length, 0);
 	    iPtr->numLevels--;
 	}
 	Tcl_DecrRefCount(newObjv[0]);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8802438..236a28d 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.120 2005/12/27 20:14:08 kennykb Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.121 2006/02/01 18:27:44 dgp Exp $
  */
 
 #ifndef _TCLDECLS
@@ -3534,6 +3534,19 @@ EXTERN int		Tcl_InitBignumFromDouble _ANSI_ARGS_((
 				Tcl_Interp* interp, double initval, 
 				mp_int * toInit));
 #endif
+#ifndef Tcl_GetNamespaceUnknownHandler_TCL_DECLARED
+#define Tcl_GetNamespaceUnknownHandler_TCL_DECLARED
+/* 567 */
+EXTERN Tcl_Obj *	Tcl_GetNamespaceUnknownHandler _ANSI_ARGS_((
+				Tcl_Interp * interp, Tcl_Namespace * nsPtr));
+#endif
+#ifndef Tcl_SetNamespaceUnknownHandler_TCL_DECLARED
+#define Tcl_SetNamespaceUnknownHandler_TCL_DECLARED
+/* 568 */
+EXTERN int		Tcl_SetNamespaceUnknownHandler _ANSI_ARGS_((
+				Tcl_Interp * interp, Tcl_Namespace * nsPtr, 
+				Tcl_Obj * handlerPtr));
+#endif
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -4142,6 +4155,8 @@ typedef struct TclStubs {
     void (*tcl_SetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj* msg)); /* 564 */
     void (*tcl_GetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj** msg)); /* 565 */
     int (*tcl_InitBignumFromDouble) _ANSI_ARGS_((Tcl_Interp* interp, double initval, mp_int * toInit)); /* 566 */
+    Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr)); /* 567 */
+    int (*tcl_SetNamespaceUnknownHandler) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, Tcl_Obj * handlerPtr)); /* 568 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -6450,6 +6465,14 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_InitBignumFromDouble \
 	(tclStubsPtr->tcl_InitBignumFromDouble) /* 566 */
 #endif
+#ifndef Tcl_GetNamespaceUnknownHandler
+#define Tcl_GetNamespaceUnknownHandler \
+	(tclStubsPtr->tcl_GetNamespaceUnknownHandler) /* 567 */
+#endif
+#ifndef Tcl_SetNamespaceUnknownHandler
+#define Tcl_SetNamespaceUnknownHandler \
+	(tclStubsPtr->tcl_SetNamespaceUnknownHandler) /* 568 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cd224de..0dbb1bd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.265 2006/02/01 17:48:10 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.266 2006/02/01 18:27:46 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -263,6 +263,9 @@ typedef struct Namespace {
     Tcl_Ensemble *ensembles;	/* List of structures that contain the details
 				 * of the ensembles that are implemented on
 				 * top of this namespace. */
+    Tcl_Obj *unknownHandlerPtr;	/* A script fragment to be used when command
+				 * resolution in this namespace fails. TIP
+				 * 181. */
     int commandPathLength;	/* The length of the explicit path. */
     NamespacePathEntry *commandPathArray;
 				/* The explicit path of the namespace as an
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 55b6dc1..cf83c02 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -12,6 +12,7 @@
  * Copyright (c) 1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  * Copyright (c) 2002-2005 Donal K. Fellows.
+ * Copyright (c) 2006 Neil Madden.
  *
  * Originally implemented by
  *   Michael J. McLennan
@@ -21,7 +22,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.92 2006/02/01 17:48:11 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.93 2006/02/01 18:27:47 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -230,6 +231,9 @@ static int		NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		NamespaceUpvarCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
+static int              NamespaceUnknownCmd(ClientData dummy, 
+                            Tcl_Interp *interp, int objc, 
+                            Tcl_Obj *CONST objv[]);
 static int		NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -816,6 +820,7 @@ Tcl_CreateNamespace(
     nsPtr->compiledVarResProc = NULL;
     nsPtr->exportLookupEpoch = 0;
     nsPtr->ensembles = NULL;
+    nsPtr->unknownHandlerPtr = NULL;
     nsPtr->commandPathLength = 0;
     nsPtr->commandPathArray = NULL;
     nsPtr->commandPathSourceList = NULL;
@@ -917,6 +922,15 @@ Tcl_DeleteNamespace(
     }
 
     /*
+     * If the namespace has a registered unknown handler (TIP 181), then free
+     * it here.
+     */
+    if (nsPtr->unknownHandlerPtr != NULL) {
+	Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
+        nsPtr->unknownHandlerPtr = NULL;
+    }
+
+    /*
      * If the namespace is on the call frame stack, it is marked as "dying"
      * (NS_DYING is OR'd into its flags): the namespace can't be looked up by
      * name but its commands and variables are still usable by those active
@@ -2898,13 +2912,13 @@ Tcl_NamespaceObjCmd(
 	"children", "code", "current", "delete", "ensemble",
 	"eval", "exists", "export", "forget", "import",
 	"inscope", "origin", "parent", "path", "qualifiers",
-	"tail", "upvar", "which", NULL
+	"tail", "unknown", "upvar", "which", NULL
     };
     enum NSSubCmdIdx {
 	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
 	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
 	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
-	NSTailIdx, NSUpvarIdx, NSWhichIdx
+	NSTailIdx, NSUnknownIdx, NSUpvarIdx, NSWhichIdx
     };
     int index, result;
 
@@ -2975,6 +2989,9 @@ Tcl_NamespaceObjCmd(
     case NSUpvarIdx:
 	result = NamespaceUpvarCmd(clientData, interp, objc, objv);
 	break;
+    case NSUnknownIdx:
+	result = NamespaceUnknownCmd(clientData, interp, objc, objv);
+	break;
     case NSWhichIdx:
 	result = NamespaceWhichCmd(clientData, interp, objc, objv);
 	break;
@@ -4275,6 +4292,168 @@ NamespaceQualifiersCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * NamespaceUnknownCmd --
+ *
+ *	Invoked to implement the "namespace unknown" command (TIP 181) that
+ *	sets or queries a per-namespace unknown command handler. This handler
+ *	is called when command lookup fails (current and global ns). The
+ *	default handler for the global namespace is ::unknown. The default
+ *	handler for other namespaces is to call the global namespace unknown
+ *	handler. Passing an empty list results in resetting the handler to
+ *	its default.
+ *
+ *	    namespace unknown ?handler?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If no handler is specified, returns a result in the interpreter's
+ *	result object, otherwise it sets the unknown handler pointer in the
+ *	current namespace to the script fragment provided. If anything goes
+ *	wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+NamespaceUnknownCmd(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_Namespace *currNsPtr;
+    Tcl_Obj *resultPtr;
+    int rc;
+
+    if (objc > 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "?script?");
+        return TCL_ERROR;
+    }
+
+    currNsPtr = Tcl_GetCurrentNamespace(interp);
+
+    if (objc == 2) {
+	/*
+	 * Introspection - return the current namespace handler.
+	 */
+	resultPtr = Tcl_GetNamespaceUnknownHandler(interp, currNsPtr);
+	if (resultPtr == NULL) {
+	    resultPtr = Tcl_NewObj();
+	}
+	Tcl_SetObjResult(interp, resultPtr);
+    } else {
+	rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[2]);
+	if (rc == TCL_OK) {
+	    Tcl_SetObjResult(interp, objv[2]);
+	}
+	return rc;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetNamespaceUnknownHandler --
+ *
+ *	Returns the unknown command handler registered for the given
+ *	namespace.
+ *
+ * Results:
+ *	Returns the current unknown command handler, or NULL if none
+ *	exists for the namespace.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+Tcl_GetNamespaceUnknownHandler(interp, nsPtr)
+    Tcl_Interp *interp;		/* The interpreter in which the namespace
+				 * exists. */
+    Tcl_Namespace *nsPtr;	/* The namespace. */
+{
+    Namespace *currNsPtr = (Namespace *)nsPtr;
+
+    if (currNsPtr->unknownHandlerPtr == NULL &&
+	currNsPtr == ((Interp *)interp)->globalNsPtr) {
+	/* Default handler for global namespace is "::unknown". For all
+	 * other namespaces, it is NULL (which falls back on the global
+	 * unknown handler).
+	 */
+	currNsPtr->unknownHandlerPtr =
+	    Tcl_NewStringObj("::unknown", -1);
+	Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
+    }
+    return currNsPtr->unknownHandlerPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetNamespaceUnknownHandler --
+ *
+ *	Sets the unknown command handler for the given namespace to the
+ *	command prefix passed.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes 
+ *	wrong.
+ *
+ * Side effects:
+ *	Sets the namespace unknown command handler. If the passed in
+ *	handler is NULL or an empty list, then the handler is reset to
+ *	its default. If an error occurs, then an error message is left
+ *	in the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_SetNamespaceUnknownHandler(interp, nsPtr, handlerPtr)
+    Tcl_Interp *interp;		/* Interpreter in which the namespace 
+				 * exists. */
+    Tcl_Namespace *nsPtr;	/* Namespace which is being updated. */
+    Tcl_Obj *handlerPtr;	/* The new handler, or NULL to reset. */
+{
+    int lstlen;
+    Namespace *currNsPtr = (Namespace *)nsPtr;
+
+    if (currNsPtr->unknownHandlerPtr != NULL) {
+	/* Remove old handler first. */
+	Tcl_DecrRefCount(currNsPtr->unknownHandlerPtr);
+        currNsPtr->unknownHandlerPtr = NULL;
+    }
+    /*
+     * If NULL or an empty list is passed, then reset to the default
+     * handler.
+     */
+    if (handlerPtr == NULL) {
+	currNsPtr->unknownHandlerPtr = NULL;
+    } else {
+	if (Tcl_ListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) {
+	    /* Not a list */
+	    return TCL_ERROR;
+	} else if (lstlen == 0) {
+	    /* Empty list - reset to default. */
+	    currNsPtr->unknownHandlerPtr = NULL;
+	} else {
+	    /* 
+	     * Increment ref count and store. The reference count is 
+	     * decremented either in the code above, or when the namespace 
+	     * is deleted.
+	     */
+	    Tcl_IncrRefCount(handlerPtr);
+	    currNsPtr->unknownHandlerPtr = handlerPtr;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * NamespaceTailCmd --
  *
  *	Invoked to implement the "namespace tail" command that returns the
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 88f59e0..7ccef4b 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.127 2005/12/27 20:14:09 kennykb Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.128 2006/02/01 18:27:48 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1063,6 +1063,8 @@ TclStubs tclStubs = {
     Tcl_SetChannelError, /* 564 */
     Tcl_GetChannelError, /* 565 */
     Tcl_InitBignumFromDouble, /* 566 */
+    Tcl_GetNamespaceUnknownHandler, /* 567 */
+    Tcl_SetNamespaceUnknownHandler, /* 568 */
 };
 
 /* !END!: Do not edit above this line. */