summaryrefslogtreecommitdiffstats
path: root/generic/tclOODefineCmds.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-09-23 05:05:41 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-09-23 05:05:41 (GMT)
commit282e134aeee90a7223dae8944b610c218aeaec78 (patch)
tree6be64065e9b0dc708cce2d80b40e8aa2bdad98b8 /generic/tclOODefineCmds.c
parent404405c0976f47e28629ed9441feaa565cf85d99 (diff)
downloadtcl-282e134aeee90a7223dae8944b610c218aeaec78.zip
tcl-282e134aeee90a7223dae8944b610c218aeaec78.tar.gz
tcl-282e134aeee90a7223dae8944b610c218aeaec78.tar.bz2
Implementation of TIP #320.#320.#320.
Diffstat (limited to 'generic/tclOODefineCmds.c')
-rw-r--r--generic/tclOODefineCmds.c96
1 files changed, 95 insertions, 1 deletions
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 77f9970..fe7e8de 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOODefineCmds.c,v 1.4 2008/05/31 11:42:18 dkf Exp $
+ * RCS: @(#) $Id: tclOODefineCmds.c,v 1.5 2008/09/23 05:05:54 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -1792,6 +1792,100 @@ TclOODefineUnexportObjCmd(
return TCL_OK;
}
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineVariablesObjCmd --
+ * Implementation of the "variable" subcommand of the "oo::define" and
+ * "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineVariablesObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstanceVars = (clientData != NULL);
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *variableObj;
+ int i;
+
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!isInstanceVars && !oPtr->classPtr) {
+ Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ return TCL_ERROR;
+ }
+
+ for (i=1 ; i<objc ; i++) {
+ const char *varName = Tcl_GetString(objv[i]);
+
+ if (strstr(varName, "::") != NULL) {
+ Tcl_AppendResult(interp, "invalid declared variable name \"",
+ varName, "\": must not contain namespace separators",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_StringMatch(varName, "*(*)")) {
+ Tcl_AppendResult(interp, "invalid declared variable name \"",
+ varName, "\": must not refer to an array element", NULL);
+ return TCL_ERROR;
+ }
+ }
+ for (i=1 ; i<objc ; i++) {
+ Tcl_IncrRefCount(objv[i]);
+ }
+
+ if (!isInstanceVars) {
+ FOREACH(variableObj, oPtr->classPtr->variables) {
+ Tcl_DecrRefCount(variableObj);
+ }
+ if (i != objc-1) {
+ if (objc == 1) {
+ ckfree((char *) oPtr->classPtr->variables.list);
+ } else if (i) {
+ oPtr->classPtr->variables.list = (Tcl_Obj **)
+ ckrealloc((char *) oPtr->classPtr->variables.list,
+ sizeof(Tcl_Obj *) * (objc-1));
+ } else {
+ oPtr->classPtr->variables.list = (Tcl_Obj **)
+ ckalloc(sizeof(Tcl_Obj *) * (objc-1));
+ }
+ }
+ if (objc > 1) {
+ memcpy(oPtr->classPtr->variables.list, objv+1,
+ sizeof(Tcl_Obj *) * (objc-1));
+ }
+ oPtr->classPtr->variables.num = objc-1;
+ } else {
+ FOREACH(variableObj, oPtr->variables) {
+ Tcl_DecrRefCount(variableObj);
+ }
+ if (i != objc-1) {
+ if (objc == 1) {
+ ckfree((char *) oPtr->variables.list);
+ } else if (i) {
+ oPtr->variables.list = (Tcl_Obj **)
+ ckrealloc((char *) oPtr->variables.list,
+ sizeof(Tcl_Obj *) * (objc-1));
+ } else {
+ oPtr->variables.list = (Tcl_Obj **)
+ ckalloc(sizeof(Tcl_Obj *) * (objc-1));
+ }
+ }
+ if (objc > 1) {
+ memcpy(oPtr->variables.list, objv+1, sizeof(Tcl_Obj *)*(objc-1));
+ }
+ oPtr->variables.num = objc-1;
+ }
+ return TCL_OK;
+}
+
void
Tcl_ClassSetConstructor(
Tcl_Interp *interp,