1/* -*- Mode: c++ -*- 2 * $Id: xotclMetaData.c,v 1.5 2006/09/27 08:12:40 neumann Exp $ 3 * 4 * Extended Object Tcl (XOTcl) 5 * 6 * Copyright (C) 1999-2008 Gustaf Neumann, Uwe Zdun 7 * 8 * 9 * xotclReference.c -- 10 * 11 * XOTcl Object References 12 * 13 */ 14 15#include "xotclInt.h" 16 17#ifdef XOTCL_METADATA 18/* 19 * Meta Data 20 */ 21 22void 23XOTclMetaDataRemoveDepending(XOTclClass *cl, char *name) { 24 XOTclClasses *saved = cl->order, *clPtr; 25 cl->order = 0; 26 27 clPtr = XOTclComputeDependents(cl); 28 29 while (clPtr != 0) { 30 Tcl_HashSearch hSrch; 31 Tcl_HashEntry *hPtr = &clPtr->cl->instances ? 32 Tcl_FirstHashEntry(&clPtr->cl->instances, &hSrch) : 0; 33 for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { 34 XOTclObject *obj = (XOTclObject*) 35 Tcl_GetHashKey(&clPtr->cl->instances, hPtr); 36 Tcl_HashEntry *h1Ptr = 0; 37 if (obj->opt) 38 h1Ptr = Tcl_FindHashEntry(&obj->opt->metaData, name); 39 if (h1Ptr) { 40 Tcl_DeleteHashEntry(h1Ptr); 41 } 42 } 43 clPtr = clPtr->next; 44 } 45 46 XOTclRemoveClasses(cl->order); 47 cl->order = saved; 48} 49 50int 51XOTclMetaDataInheritance (XOTclObject *obj, char *name) { 52 XOTclClasses *clPtr; 53 assert(obj); 54 55 if (!obj->cl->order) 56 obj->cl->order = XOTclComputePrecedence(obj->cl); 57 clPtr = obj->cl->order; 58 if (clPtr) { 59 while (clPtr != 0) { 60 if (clPtr->cl->object.opt) { 61 if (Tcl_FindHashEntry(&clPtr->cl->object.opt->metaData, name)) { 62 return 1; 63 } 64 } 65 clPtr = clPtr->next; 66 } 67 } 68 return 0; 69} 70 71void 72XOTclMetaDataDestroy(XOTclObject *obj) { 73 if (obj->opt) 74 Tcl_DeleteHashTable(&obj->opt->metaData); 75} 76 77void 78XOTclMetaDataInit(XOTclObject *obj) { 79 XOTclRequireObjectOpt(obj); 80 Tcl_InitHashTable(&obj->opt->metaData, TCL_STRING_KEYS); 81} 82 83int 84XOTclOMetaDataMethod (ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { 85 XOTclObject *obj = (XOTclObject*)cd; 86 XOTclClass *cl = XOTclObjectToClass(cd); 87 char *option; int add = -1; 88 int result = TCL_OK; 89 int oc; Tcl_Obj* *ov; int i; 90 91 if (!obj) return XOTclObjErrType(interp, obj->cmdName, "Object"); 92 if (objc < 2) 93 return XOTclObjErrArgCnt(interp,obj->cmdName, 94 "metadata ?(add|remove)? metaDataList"); 95 96 option = ObjStr(objv[1]); 97 switch (*option) { 98 case 'a': 99 if (strcmp(option,"add") == 0) add = 1; break; 100 case 'r': 101 if (strcmp(option,"remove") == 0) add = 0; break; 102 } 103 if (add == -1) { 104 if (objc == 2) { 105 if (obj->opt) { 106 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&obj->opt->metaData, option); 107 if (hPtr) { 108 Tcl_Obj *entry = (Tcl_Obj *) Tcl_GetHashValue(hPtr); 109 if (entry) { 110 Tcl_SetObjResult(interp, (Tcl_Obj *) Tcl_GetHashValue(hPtr)); 111 } else { 112 Tcl_ResetResult(interp); 113 } 114 } 115 return TCL_OK; 116 } 117 } 118 if (objc == 3) { 119 if (obj->opt) { 120 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&obj->opt->metaData, option); 121 if (!hPtr) { 122 int nw; 123 if (XOTclMetaDataInheritance(obj, option)) { 124 hPtr = Tcl_CreateHashEntry(&obj->opt->metaData, option, &nw); 125 if (!nw) 126 return XOTclVarErrMsg(interp, 127 "MetaData: Can't create MetaData Entry: ", 128 option, (char*) NULL); 129 } 130 } 131 if (hPtr) { 132 Tcl_Obj *entry = (Tcl_Obj *) Tcl_GetHashValue(hPtr); 133 if (entry) 134 DECR_REF_COUNT(entry); 135 INCR_REF_COUNT(objv[2]); 136 Tcl_SetHashValue(hPtr, (ClientData) objv[2]); 137 return TCL_OK; 138 } 139 } 140 } 141 return XOTclVarErrMsg(interp,"MetaData: Unknown option; given Option: ", 142 option, (char*) NULL); 143 } 144 145 if (Tcl_ListObjGetElements(interp, objv[2], &oc, &ov) == TCL_OK) { 146 for (i = 0; i < oc; i ++) { 147 char *value = ObjStr (ov[i]); 148 if (obj->opt) { 149 if (add) { 150 int nw; 151 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&obj->opt->metaData, value); 152 if (hPtr) 153 return XOTclVarErrMsg(interp, 154 "Can't add MetaData, MetaData exists: ", 155 value, 156 (char*) NULL); 157 hPtr = Tcl_CreateHashEntry(&obj->opt->metaData, value, &nw); 158 if (!nw) 159 return XOTclVarErrMsg(interp, 160 "MetaData: Can't create MetaData Entry: ", 161 value,(char*) NULL); 162 } else { 163 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&obj->opt->metaData, value); 164 if (hPtr) { 165 Tcl_DeleteHashEntry(hPtr); 166 if (cl) { 167 XOTclMetaDataRemoveDepending(cl, value); 168 } 169 } 170 } 171 } 172 } 173 } 174 return result; 175} 176#endif 177