Itk - the [incr Tk] extension

Check-in [0614e72ef9]
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:Revise cget method to direct C implementation.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-method-type
Files: files | file ages | folders
SHA1: 0614e72ef99e64ebf28609f988dcabfbee942108
User & Date: dgp 2015-10-22 15:48:03
Context
2016-02-11
21:00
merge trunk check-in: 47c1ffeb42 user: dgp tags: dgp-method-type
2015-10-22
15:48
Revise cget method to direct C implementation. check-in: 0614e72ef9 user: dgp tags: dgp-method-type
14:45
compiler warning check-in: ed627972ff user: dgp tags: dgp-method-type
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itkArchetype.c.

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
....
1213
1214
1215
1216
1217
1218
1219

1220
1221
1222
1223
1224
1225
1226
....
1249
1250
1251
1252
1253
1254
1255

1256

1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
struct NameProcMap { const char *name; Tcl_ObjCmdProc *proc; };

/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const struct NameProcMap archetypeCmds[] = {
    { "::itcl::builtin::Archetype::cget", Itk_ArchCgetCmd },
    { "::itcl::builtin::Archetype::delete", Itk_ArchDeleteOptsCmd },
    { "::itcl::builtin::Archetype::init", Itk_ArchInitOptsCmd },
    { NULL, NULL }
};

 
/*
................................................................................
    CONST char *token;
    CONST char *val;
    ItclClass *contextClass;
    ItclObject *contextObj;
    ArchInfo *info;
    Tcl_HashEntry *entry;
    ArchOption *archOpt;


    ItclShowArgs(2, "Itk_ArchCgetCmd", objc, objv);
    contextClass = NULL;
    if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
        !contextObj) {

        token = Tcl_GetString(objv[0]);
................................................................................
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "unknown option \"", token, "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    archOpt = (ArchOption*)Tcl_GetHashValue(entry);

    val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);

    if (!val) {
        Itk_ArchOptAccessError(interp, info, archOpt);
        return TCL_ERROR;
    }

    /*
     * Casting away CONST is safe because TCL_VOLATILE guarantees
     * CONST treatment.
     */
    Tcl_SetResult(interp, (char *) val, TCL_VOLATILE);
    return TCL_OK;
}






<







 







>







 







>

>












61
62
63
64
65
66
67

68
69
70
71
72
73
74
....
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
....
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
struct NameProcMap { const char *name; Tcl_ObjCmdProc *proc; };

/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const struct NameProcMap archetypeCmds[] = {

    { "::itcl::builtin::Archetype::delete", Itk_ArchDeleteOptsCmd },
    { "::itcl::builtin::Archetype::init", Itk_ArchInitOptsCmd },
    { NULL, NULL }
};

 
/*
................................................................................
    CONST char *token;
    CONST char *val;
    ItclClass *contextClass;
    ItclObject *contextObj;
    ArchInfo *info;
    Tcl_HashEntry *entry;
    ArchOption *archOpt;
    Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);

    ItclShowArgs(2, "Itk_ArchCgetCmd", objc, objv);
    contextClass = NULL;
    if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
        !contextObj) {

        token = Tcl_GetString(objv[0]);
................................................................................
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "unknown option \"", token, "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    archOpt = (ArchOption*)Tcl_GetHashValue(entry);
    Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
    val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
    Itcl_SetCallFrameNamespace(interp, save);
    if (!val) {
        Itk_ArchOptAccessError(interp, info, archOpt);
        return TCL_ERROR;
    }

    /*
     * Casting away CONST is safe because TCL_VOLATILE guarantees
     * CONST treatment.
     */
    Tcl_SetResult(interp, (char *) val, TCL_VOLATILE);
    return TCL_OK;
}

Changes to library/Archetype.itk.

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
        eval itk_initialize $args
    }

    destructor {
        ::itcl::builtin::Archetype delete
    }

    method cget {option} {
        ::itcl::builtin::Archetype cget $option
    }

    method configure {{option ""} args} @Archetype-configure

    method config {{option ""} args} @Archetype-configure

    method component {{name ""} args} @Archetype-component







|
<
<







58
59
60
61
62
63
64
65


66
67
68
69
70
71
72
        eval itk_initialize $args
    }

    destructor {
        ::itcl::builtin::Archetype delete
    }

    method cget {option} @Archetype-cget



    method configure {{option ""} args} @Archetype-configure

    method config {{option ""} args} @Archetype-configure

    method component {{name ""} args} @Archetype-component