1/* struct::tree - critcl - layer 1 definitions. 2 * (b) Node operations. 3 * Tcl_ObjType for nodes, and shimmering to it. 4 */ 5 6#include <string.h> 7#include <tn.h> 8 9/* .................................................. */ 10 11static void free_rep (Tcl_Obj* obj); 12static void dup_rep (Tcl_Obj* obj, Tcl_Obj* dup); 13static void string_rep (Tcl_Obj* obj); 14static int from_any (Tcl_Interp* ip, Tcl_Obj* obj); 15 16static 17Tcl_ObjType tn_type = { 18 "tcllib::struct::tree/critcl::node", 19 free_rep, 20 dup_rep, 21 string_rep, 22 from_any 23}; 24 25/* .................................................. */ 26 27static void 28free_rep (Tcl_Obj* obj) 29{ 30 /* Nothing to do. The rep is the TN in the T. */ 31} 32 33static void 34dup_rep (Tcl_Obj* obj, Tcl_Obj* dup) 35{ 36 TNPtr n = (TNPtr) obj->internalRep.otherValuePtr; 37 38 dup->internalRep.otherValuePtr = n; 39 dup->typePtr = &tn_type; 40} 41 42static void 43string_rep (Tcl_Obj* obj) 44{ 45 Tcl_Obj* temp; 46 char* str; 47 TNPtr n = (TNPtr) obj->internalRep.otherValuePtr; 48 49 obj->length = n->name->length; 50 obj->bytes = ckalloc (obj->length + 1); 51 52 memcpy (obj->bytes, n->name->bytes, obj->length + 1); 53} 54 55static int 56from_any (Tcl_Interp* ip, Tcl_Obj* obj) 57{ 58 Tcl_Panic ("Cannot create TDN structure via regular shimmering."); 59 return TCL_ERROR; 60} 61 62/* .................................................. */ 63 64void 65tn_shimmer (Tcl_Obj* o, TNPtr n) 66{ 67 /* Release an existing representation */ 68 69 if (o->typePtr && o->typePtr->freeIntRepProc) { 70 o->typePtr->freeIntRepProc (o); 71 } 72 73 o->typePtr = &tn_type; 74 o->internalRep.otherValuePtr = n; 75} 76 77/* .................................................. */ 78 79TNPtr 80tn_get_node (TPtr t, Tcl_Obj* node, Tcl_Interp* interp, Tcl_Obj* tree) 81{ 82 TN* n = NULL; 83 Tcl_HashEntry* he; 84 85 /* Check if we have a valid cached int.rep. */ 86 87#if 0 88 /* [x] TODO */ 89 /* Caching of handles implies that the trees have to */ 90 /* keep track of the tcl_obj pointing to them. So that */ 91 /* the int.rep can be invalidated upon tree deletion */ 92 93 if (node->typePtr == &tn_type) { 94 n = (TN*) node->internalRep.otherValuePtr; 95 if (n->tree == t) { 96#if 0 97 fprintf (stderr, "cached: %p (%p - %p)\n", n, t, n->tree); 98 fflush(stderr); 99#endif 100 return n; 101 } 102 } 103#endif 104 /* Incompatible int.rep, or refering to a different 105 * tree. We go through the hash table. 106 */ 107 108 he = Tcl_FindHashEntry (&t->node, Tcl_GetString (node)); 109 110 if (he != NULL) { 111 n = (TN*) Tcl_GetHashValue (he); 112 113 /* Shimmer the object, cache the node information. 114 */ 115 116 tn_shimmer (node, n); 117 return n; 118 } 119 120 /* Node handle not found. Leave an error message, 121 * if possible. 122 */ 123 124 if (interp != NULL) { 125 Tcl_Obj* err = Tcl_NewObj (); 126 127 /* Keep any prefix ... */ 128 Tcl_AppendObjToObj (err, Tcl_GetObjResult (interp)); 129 Tcl_AppendToObj (err, "node \"", -1); 130 Tcl_AppendObjToObj (err, node); 131 Tcl_AppendToObj (err, "\" does not exist in tree \"", -1); 132 Tcl_AppendObjToObj (err, tree); 133 Tcl_AppendToObj (err, "\"", -1); 134 135 Tcl_SetObjResult (interp, err); 136 } 137 return NULL; 138} 139 140 141/* 142 * Local Variables: 143 * mode: c 144 * c-basic-offset: 4 145 * fill-column: 78 146 * End: 147 */ 148