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