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 [email protected]
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 Unified Diffs Show Whitespace Changes Patch

Changes to generic/itkArchBase.c.

387
388
389
390
391
392
393
394
395
396
397
398
399





400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417

418
419
420
421
422
423
424
...
474
475
476
477
478
479
480
481
482
483
484
485
486

487
488
489
490
491
492
493
...
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
         *  Add a binding onto the new component, so that when its
         *  window is destroyed, it will automatically remove itself
         *  from its parent's component list.  Avoid doing these things
         *  for the "hull" component, since it is a special case and
         *  these things are not really necessary.
         */
        Tcl_DStringSetLength(&buffer, 0);
        Tcl_DStringAppend(&buffer, "bindtags ", -1);
        Tcl_DStringAppend(&buffer, path, -1);
        if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
            goto compFail;
        }






        Tcl_DStringSetLength(&buffer, 0);
        Tcl_DStringAppend(&buffer, "bind itk-destroy-", -1);
        Tcl_DStringAppend(&buffer, path, -1);
        Tcl_DStringAppend(&buffer, " <Destroy> [itcl::code ", -1);

        Tcl_DStringAppend(&buffer,
            Tcl_GetStringFromObj(objNamePtr,(int*)NULL), -1);

        Tcl_DStringAppend(&buffer, " itk_component delete ", -1);
        Tcl_DStringAppend(&buffer, name, -1);
        Tcl_DStringAppend(&buffer, "]\n", -1);
        Tcl_DStringAppend(&buffer, "bindtags ", -1);
        Tcl_DStringAppend(&buffer, path, -1);
        Tcl_DStringAppend(&buffer, " {itk-destroy-", -1);
        Tcl_DStringAppend(&buffer, path, -1);
        Tcl_DStringAppend(&buffer, " ", -1);
        Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1);
        Tcl_DStringAppend(&buffer, "}", -1);

        if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
            goto compFail;
        }
    }

    /*
     *  Query the list of configuration options for this widget,
................................................................................
    if (objc != 4) {
        objPtr = Tcl_NewStringObj("usual", -1);
        Tcl_IncrRefCount(objPtr);
    } else {
        objPtr = objv[3];
    }

    Tcl_Import(interp, NULL, "::itk::option-parser::*", 1);

    if (result == TCL_OK) {
        result = Tcl_EvalObj(interp, objPtr);
	Tcl_ForgetImport(interp, NULL, "::itk::option-parser::*");
    }


    if (objc != 4) {
        Tcl_DecrRefCount(objPtr);
    }
    if (result != TCL_OK) {
        goto compFail;
    }
................................................................................

       /*
        *  Clean up the binding tag that causes the widget to
        *  call this method automatically when destroyed.
        *  Ignore errors if anything goes wrong.
        */
        Tcl_DStringInit(&buffer);
        Tcl_DStringAppend(&buffer, "itk::remove_destroy_hook ", -1);
        Tcl_DStringAppend(&buffer, archComp->pathName, -1);
        (void) Tcl_Eval(interp, Tcl_DStringValue(&buffer));
        Tcl_ResetResult(interp);
        Tcl_DStringFree(&buffer);

        Tcl_UnsetVar2(interp, "itk_component", token, 0);
        Tcl_DeleteHashEntry(entry);






|





>
>
>
>
>

|

|







|






>







 







|
<
<
|
<
<
>







 







|







387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
...
480
481
482
483
484
485
486
487


488


489
490
491
492
493
494
495
496
...
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
         *  Add a binding onto the new component, so that when its
         *  window is destroyed, it will automatically remove itself
         *  from its parent's component list.  Avoid doing these things
         *  for the "hull" component, since it is a special case and
         *  these things are not really necessary.
         */
        Tcl_DStringSetLength(&buffer, 0);
        Tcl_DStringAppend(&buffer, "::bindtags ", -1);
        Tcl_DStringAppend(&buffer, path, -1);
        if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
            goto compFail;
        }

	/*
	 * NOTE: We need the [::itcl::code] because the itk_component
	 * method is protected.
	 */

        Tcl_DStringSetLength(&buffer, 0);
        Tcl_DStringAppend(&buffer, "::bind itk-destroy-", -1);
        Tcl_DStringAppend(&buffer, path, -1);
        Tcl_DStringAppend(&buffer, " <Destroy> [::itcl::code ", -1);

        Tcl_DStringAppend(&buffer,
            Tcl_GetStringFromObj(objNamePtr,(int*)NULL), -1);

        Tcl_DStringAppend(&buffer, " itk_component delete ", -1);
        Tcl_DStringAppend(&buffer, name, -1);
        Tcl_DStringAppend(&buffer, "]\n", -1);
        Tcl_DStringAppend(&buffer, "::bindtags ", -1);
        Tcl_DStringAppend(&buffer, path, -1);
        Tcl_DStringAppend(&buffer, " {itk-destroy-", -1);
        Tcl_DStringAppend(&buffer, path, -1);
        Tcl_DStringAppend(&buffer, " ", -1);
        Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1);
        Tcl_DStringAppend(&buffer, "}", -1);

        if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
            goto compFail;
        }
    }

    /*
     *  Query the list of configuration options for this widget,
................................................................................
    if (objc != 4) {
        objPtr = Tcl_NewStringObj("usual", -1);
        Tcl_IncrRefCount(objPtr);
    } else {
        objPtr = objv[3];
    }

    Tcl_Eval(interp, "::namespace path [::lreplace [::namespace path] end+1 end ::itk::option-parser]");


    result = Tcl_EvalObj(interp, objPtr);


    Tcl_Eval(interp, "::namespace path [::lrange [::namespace path] 0 end-1]");

    if (objc != 4) {
        Tcl_DecrRefCount(objPtr);
    }
    if (result != TCL_OK) {
        goto compFail;
    }
................................................................................

       /*
        *  Clean up the binding tag that causes the widget to
        *  call this method automatically when destroyed.
        *  Ignore errors if anything goes wrong.
        */
        Tcl_DStringInit(&buffer);
        Tcl_DStringAppend(&buffer, "::itk::remove_destroy_hook ", -1);
        Tcl_DStringAppend(&buffer, archComp->pathName, -1);
        (void) Tcl_Eval(interp, Tcl_DStringValue(&buffer));
        Tcl_ResetResult(interp);
        Tcl_DStringFree(&buffer);

        Tcl_UnsetVar2(interp, "itk_component", token, 0);
        Tcl_DeleteHashEntry(entry);

Changes to generic/itkArchetype.c.

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

    Tcl_CreateObjCommand(interp, "::itk::option-parser::keep",
        Itk_ArchOptKeepCmd,
        (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(interp, "::itk::option-parser::ignore",
        Itk_ArchOptIgnoreCmd,






<







162
163
164
165
166
167
168

169
170
171
172
173
174
175
    if (!parserNs) {
        Itk_DelMergeInfo((char*)mergeInfo);
        Tcl_AddErrorInfo(interp, "\n    (while initializing itk)");
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)mergeInfo);
    Itcl_EventuallyFree((ClientData)mergeInfo, Itk_DelMergeInfo);


    Tcl_CreateObjCommand(interp, "::itk::option-parser::keep",
        Itk_ArchOptKeepCmd,
        (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(interp, "::itk::option-parser::ignore",
        Itk_ArchOptIgnoreCmd,