Itk - the [incr Tk] extension

Check-in [fd54e0d1dc]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Take care that the right commands are resolved in the right namespaces.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | experiment
Files: files | file ages | folders
SHA1:fd54e0d1dc5f3a1abc87f97fe17c2e0eaba1d5f6
User & Date: dgp 2017-07-28 15:57:51
Context
2017-07-28
16:57
Several revisions to get evaluation contexts more reliably correct. Closed-Leaf check-in: b46f3c3fe0 user: dgp tags: dgp-method-type
15:57
Take care that the right commands are resolved in the right namespaces. Closed-Leaf check-in: fd54e0d1dc user: dgp tags: experiment
2017-07-27
16:31
Similar changes to the PropagatePublicVariable machinery. check-in: 0bd0be830c user: dgp tags: experiment
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/itkArchBase.c.

   387    387            *  Add a binding onto the new component, so that when its
   388    388            *  window is destroyed, it will automatically remove itself
   389    389            *  from its parent's component list.  Avoid doing these things
   390    390            *  for the "hull" component, since it is a special case and
   391    391            *  these things are not really necessary.
   392    392            */
   393    393           Tcl_DStringSetLength(&buffer, 0);
   394         -        Tcl_DStringAppend(&buffer, "bindtags ", -1);
          394  +        Tcl_DStringAppend(&buffer, "::bindtags ", -1);
   395    395           Tcl_DStringAppend(&buffer, path, -1);
   396    396           if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
   397    397               goto compFail;
   398    398           }
   399    399   
          400  +	/*
          401  +	 * NOTE: We need the [::itcl::code] because the itk_component
          402  +	 * method is protected.
          403  +	 */
          404  +
   400    405           Tcl_DStringSetLength(&buffer, 0);
   401         -        Tcl_DStringAppend(&buffer, "bind itk-destroy-", -1);
          406  +        Tcl_DStringAppend(&buffer, "::bind itk-destroy-", -1);
   402    407           Tcl_DStringAppend(&buffer, path, -1);
   403         -        Tcl_DStringAppend(&buffer, " <Destroy> [itcl::code ", -1);
          408  +        Tcl_DStringAppend(&buffer, " <Destroy> [::itcl::code ", -1);
   404    409   
   405    410           Tcl_DStringAppend(&buffer,
   406    411               Tcl_GetStringFromObj(objNamePtr,(int*)NULL), -1);
   407    412   
   408    413           Tcl_DStringAppend(&buffer, " itk_component delete ", -1);
   409    414           Tcl_DStringAppend(&buffer, name, -1);
   410    415           Tcl_DStringAppend(&buffer, "]\n", -1);
   411         -        Tcl_DStringAppend(&buffer, "bindtags ", -1);
          416  +        Tcl_DStringAppend(&buffer, "::bindtags ", -1);
   412    417           Tcl_DStringAppend(&buffer, path, -1);
   413    418           Tcl_DStringAppend(&buffer, " {itk-destroy-", -1);
   414    419           Tcl_DStringAppend(&buffer, path, -1);
   415    420           Tcl_DStringAppend(&buffer, " ", -1);
   416    421           Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1);
   417    422           Tcl_DStringAppend(&buffer, "}", -1);
          423  +
   418    424           if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
   419    425               goto compFail;
   420    426           }
   421    427       }
   422    428   
   423    429       /*
   424    430        *  Query the list of configuration options for this widget,
................................................................................
   474    480       if (objc != 4) {
   475    481           objPtr = Tcl_NewStringObj("usual", -1);
   476    482           Tcl_IncrRefCount(objPtr);
   477    483       } else {
   478    484           objPtr = objv[3];
   479    485       }
   480    486   
   481         -    Tcl_Import(interp, NULL, "::itk::option-parser::*", 1);
   482         -
   483         -    if (result == TCL_OK) {
   484         -        result = Tcl_EvalObj(interp, objPtr);
   485         -	Tcl_ForgetImport(interp, NULL, "::itk::option-parser::*");
   486         -    }
          487  +    Tcl_Eval(interp, "::namespace path [::lreplace [::namespace path] end+1 end ::itk::option-parser]");
          488  +    result = Tcl_EvalObj(interp, objPtr);
          489  +    Tcl_Eval(interp, "::namespace path [::lrange [::namespace path] 0 end-1]");
   487    490   
   488    491       if (objc != 4) {
   489    492           Tcl_DecrRefCount(objPtr);
   490    493       }
   491    494       if (result != TCL_OK) {
   492    495           goto compFail;
   493    496       }
................................................................................
   643    646   
   644    647          /*
   645    648           *  Clean up the binding tag that causes the widget to
   646    649           *  call this method automatically when destroyed.
   647    650           *  Ignore errors if anything goes wrong.
   648    651           */
   649    652           Tcl_DStringInit(&buffer);
   650         -        Tcl_DStringAppend(&buffer, "itk::remove_destroy_hook ", -1);
          653  +        Tcl_DStringAppend(&buffer, "::itk::remove_destroy_hook ", -1);
   651    654           Tcl_DStringAppend(&buffer, archComp->pathName, -1);
   652    655           (void) Tcl_Eval(interp, Tcl_DStringValue(&buffer));
   653    656           Tcl_ResetResult(interp);
   654    657           Tcl_DStringFree(&buffer);
   655    658   
   656    659           Tcl_UnsetVar2(interp, "itk_component", token, 0);
   657    660           Tcl_DeleteHashEntry(entry);

Changes to generic/itkArchetype.c.

   162    162       if (!parserNs) {
   163    163           Itk_DelMergeInfo((char*)mergeInfo);
   164    164           Tcl_AddErrorInfo(interp, "\n    (while initializing itk)");
   165    165           return TCL_ERROR;
   166    166       }
   167    167       Itcl_PreserveData((ClientData)mergeInfo);
   168    168       Itcl_EventuallyFree((ClientData)mergeInfo, Itk_DelMergeInfo);
   169         -    Tcl_Export(interp, parserNs, "[a-z]*", 1);
   170    169   
   171    170       Tcl_CreateObjCommand(interp, "::itk::option-parser::keep",
   172    171           Itk_ArchOptKeepCmd,
   173    172           (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL);
   174    173   
   175    174       Tcl_CreateObjCommand(interp, "::itk::option-parser::ignore",
   176    175           Itk_ArchOptIgnoreCmd,