Tcl8.0b1 patch to allow widget creation in namespaces 
Author Message
 Tcl8.0b1 patch to allow widget creation in namespaces

The following patch to Tcl8.0b1 allows Tk widgets to be created in
namespaces. Commands are now always created in the global namespace
unless their name is qualified with the name of a different namespace.
Procedures continue to be created in the current namespace by default.

As an example, these changes allow the following code (originally
written by Mike McLennan) to work properly:

namespace MyPackage {
    variable state 0
    proc report {msg} {
        puts "click: $msg"
    }

    checkbutton .b -text "Push Me" -variable ::MyPackage::state \
        -command [namespace code {report "Hello World"}]
    pack .b

Quote:
}

  Brian

--------------------------------------------------------------------

------- tclBasic.c -------
*** /tmp/da001wp        Wed Dec 31 16:00:00 1969
--- tclBasic.c  Wed Jun  4 13:41:14 1997
***************
*** 11,17 ****
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *
!  * SCCS: %Z% %M% %I% %E% %U%
   */

  #include "tclInt.h"
--- 11,17 ----
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *

   */

  #include "tclInt.h"
***************
*** 1377,1383 ****
  Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
      Tcl_Interp *interp;               /* Token for command interpreter returned by
                                 * a previous call to Tcl_CreateInterp. */
!     char *cmdName;            /* Name of command. */
      Tcl_CmdProc *proc;                /* Procedure to associate with cmdName. */
      ClientData clientData;    /* Arbitrary value passed to string proc. */
      Tcl_CmdDeleteProc *deleteProc;
--- 1377,1386 ----
  Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
      Tcl_Interp *interp;               /* Token for command interpreter returned by
                                 * a previous call to Tcl_CreateInterp. */
!     char *cmdName;            /* Name of command. If it contains namespace
!                                * qualifiers, the new command is put in the
!                                * specified namespace; otherwise it is put
!                                * in the global namespace. */
      Tcl_CmdProc *proc;                /* Procedure to associate with cmdName. */
      ClientData clientData;    /* Arbitrary value passed to string proc. */
      Tcl_CmdDeleteProc *deleteProc;
***************
*** 1401,1413 ****
      }

      /*
!      * Determine where the command should reside.
       */

!     result = TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
!             CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
!     if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
!       return (Tcl_Command) NULL;
      }

      /*
--- 1404,1424 ----
      }

      /*
!      * Determine where the command should reside. If its name contains
!      * namespace qualifiers, we put it in the specified namespace;
!      * otherwise, we always put it in the global namespace.
       */

!     if (strstr(cmdName, "::") != NULL) {
!       result = TclGetNamespaceForQualName(interp, cmdName,
!                 (Namespace *) NULL, CREATE_NS_IF_UNKNOWN, &nsPtr,
!                 &dummy1, &dummy2, &tail);
!       if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
!           return (Tcl_Command) NULL;
!       }
!     } else {
!       nsPtr = iPtr->globalNsPtr;
!       tail = cmdName;
      }

      /*
***************
*** 1517,1523 ****
  Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
      Tcl_Interp *interp;               /* Token for command interpreter (returned
                                 * by previous call to Tcl_CreateInterp). */
!     char *cmdName;            /* Points to first byte of command name. */
      Tcl_ObjCmdProc *proc;     /* Object-based procedure to associate with
                                 * name. */
      ClientData clientData;    /* Arbitrary value to pass to object
--- 1528,1537 ----
  Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
      Tcl_Interp *interp;               /* Token for command interpreter (returned
                                 * by previous call to Tcl_CreateInterp). */
!     char *cmdName;            /* Name of command. If it contains namespace
!                                * qualifiers, the new command is put in the
!                                * specified namespace; otherwise it is put
!                                * in the global namespace. */
      Tcl_ObjCmdProc *proc;     /* Object-based procedure to associate with
                                 * name. */
      ClientData clientData;    /* Arbitrary value to pass to object
***************
*** 1543,1555 ****
      }

      /*
!      * Determine where the command should reside.
       */

!     result = TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
!             CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
!     if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
!       return (Tcl_Command) NULL;
      }

      /*
--- 1557,1577 ----
      }

      /*
!      * Determine where the command should reside. If its name contains
!      * namespace qualifiers, we put it in the specified namespace;
!      * otherwise, we always put it in the global namespace.
       */

!     if (strstr(cmdName, "::") != NULL) {
!       result = TclGetNamespaceForQualName(interp, cmdName,
!                 (Namespace *) NULL, CREATE_NS_IF_UNKNOWN, &nsPtr,
!                 &dummy1, &dummy2, &tail);
!       if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
!           return (Tcl_Command) NULL;
!       }
!     } else {
!       nsPtr = iPtr->globalNsPtr;
!       tail = cmdName;
      }

      /*

------- tclNamesp.c -------
*** /tmp/da001wx        Wed Dec 31 16:00:00 1969
--- tclNamesp.c Wed Jun  4 13:40:27 1997
***************
*** 18,24 ****
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *
!  * SCCS: %Z% %M% %I% %E% %U%
   */

  #include "tclInt.h"
--- 18,24 ----
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *

   */

  #include "tclInt.h"
***************
*** 921,927 ****
--- 921,929 ----
                                  * If 0, return an error if an imported
                                  * cmd conflicts with an existing one. */
  {
+     Interp *iPtr = (Interp *) interp;
      Namespace *nsPtr, *importNsPtr, *dummyPtr, *actualCtxPtr;
+     Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
      char *simplePattern, *cmdName;
      register Tcl_HashEntry *hPtr;
      Tcl_HashSearch search;
***************
*** 1010,1023 ****
                    || allowOverwrite) {
                /*
                 * Create the imported command and its client data.
                 */

                cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
                dataPtr = (ImportedCmdData *)
                        ckalloc(sizeof(ImportedCmdData));
!                 importedCmd = Tcl_CreateObjCommand(interp, cmdName,
!                     InvokeImportedCmd, (ClientData) dataPtr,
!                   DeleteImportedCmd);
                dataPtr->realCmdPtr = cmdPtr;
                dataPtr->selfPtr = (Command *) importedCmd;

--- 1012,1036 ----
                    || allowOverwrite) {
                /*
                 * Create the imported command and its client data.
+                * To create the new command in the current namespace,
+                * generate a fully qualified name for it.
                 */
+
+               Tcl_DString ds;
+
+               Tcl_DStringInit(&ds);
+               Tcl_DStringAppend(&ds, currNsPtr->fullName, -1);
+               if (currNsPtr != iPtr->globalNsPtr) {
+                   Tcl_DStringAppend(&ds, "::", 2);
+               }
+               Tcl_DStringAppend(&ds, cmdName, -1);

                cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
                dataPtr = (ImportedCmdData *)
                        ckalloc(sizeof(ImportedCmdData));
!                 importedCmd = Tcl_CreateObjCommand(interp,
!                         Tcl_DStringValue(&ds), InvokeImportedCmd,
!                         (ClientData) dataPtr, DeleteImportedCmd);
                dataPtr->realCmdPtr = cmdPtr;
                dataPtr->selfPtr = (Command *) importedCmd;

------- tclProc.c -------
*** /tmp/da001x1        Wed Dec 31 16:00:00 1969
--- tclProc.c   Wed Jun  4 13:40:02 1997
***************
*** 10,16 ****
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *
!  * SCCS: %Z% %M% %I% %E% %U%
   */

  #include "tclInt.h"
--- 10,16 ----
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *

   */

  #include "tclInt.h"
***************
*** 56,61 ****
--- 56,62 ----
      char **argArray = NULL;
      Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
      Tcl_Obj *defPtr, *bodyPtr;
+     Tcl_DString ds;
      int numArgs, length, result, i;
      register CompiledLocal *localPtr;

***************
*** 65,71 ****
      }

      /*
!      * Determine the namespace where the procedure should reside.
       */

      fullName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
--- 66,74 ----
      }

      /*
!      * Determine the namespace where the procedure should reside. Unless
!      * the command name includes namespace qualifiers, this will be the
!      * current namespace.
       */

      fullName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
***************
*** 206,214 ****
        ckfree((char *) fieldValues);
      }

!     Tcl_CreateCommand(interp, fullName, InterpProc,
            (ClientData) procPtr, ProcDeleteProc);
!     Tcl_CreateObjCommand(interp, fullName, TclObjInterpProc,
            (ClientData) procPtr, ProcDeleteProc);
      ckfree((char *) argArray);
      return TCL_OK;
--- 209,231 ----
        ckfree((char *) fieldValues);
      }

!     /*
!      * Now create a command for the procedure. This will be in the current
!      * namespace unless the procedure's name included namespace qualifiers.
!      * To create the new command in the right namespace, we generate a
!      * fully qualified name for it.
!      */
!
!     Tcl_DStringInit(&ds);
!     Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
!     if (nsPtr != iPtr->globalNsPtr) {
!       Tcl_DStringAppend(&ds, "::", 2);
!     }
!     Tcl_DStringAppend(&ds, procName, -1);
!    
!     Tcl_CreateCommand(interp, Tcl_DStringValue(&ds), InterpProc,
            (ClientData) procPtr, ProcDeleteProc);
!     Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
            (ClientData) procPtr, ProcDeleteProc);
      ckfree((char *) argArray);
      return TCL_OK;

------- tclTest.c -------
*** /tmp/da001wt        Wed Dec 31 16:00:00 1969
--- tclTest.c   Wed Jun  4 13:40:54 1997
***************
*** 2065,2071 ****
--- 2065,2074 ----
  {
      char *name, *arg;
      int flags = 0;
+     Tcl_Namespace *namespacePtr;
+     Tcl_CallFrame frame;
      Tcl_Var variable;
+     int result;

      if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "name scope");
***************
*** 2080,2088 ****
--- 2083,2115 ----
      } else if (strcmp(arg, "namespace") == 0) {
        flags = TCL_NAMESPACE_ONLY;
      }
+
+     /*
+      * This command, like any other created with Tcl_Create[Obj]Command,
+      * runs in the global namespace. As a "namespace-aware" command that
+      * needs to run in a particular namespace, it must activate that
+      * namespace itself.
+      */
+
+     if (flags == TCL_NAMESPACE_ONLY) {
+       namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var",
+               (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG);
+       if (namespacePtr == NULL) {
+           return TCL_ERROR;
+       }
+       result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+                 /*isProcCallFrame*/ 0);
+       if (result != TCL_OK) {
+           return result;
+       }
+     }

      variable = Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *) NULL,
            (flags | TCL_LEAVE_ERR_MSG));
+
+     if (flags == TCL_NAMESPACE_ONLY) {
+       Tcl_PopCallFrame(interp);
+     }
      if (variable == (Tcl_Var) NULL) {
        return TCL_ERROR;
      }



Mon, 22 Nov 1999 03:00:00 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. BUG/PROBLEM: Tcl8.0b1 namespace children/delete {} in a namespace

2. tcl8.0b1/doc and tk8.0b1/doc patches

3. Possible Bug Report: Tcl8.0b1 namespaces

4. Tcl8.0p2, Tcl8.1a1: BUG+PATCH: lsort -dictionary compares signed chars

5. Difference between tcl8.0 and tcl8.3 entry widget

6. Q: Tcl8.1b1 w/ Threads - no Tk allowed?

7. Tcl8.0b1 Bug in Expression Evaluation

8. compilation of tcl8.0b1 on unix

9. BUG in tcl8.0b1: string first

10. BUG REPORT: Tcl8.0b1: Array as formal argument.

11. tcl8.0b1 nulls in strings in lists

12. Access to PostgreSQL from Tcl8.0b1

 

 
Powered by phpBB® Forum Software