1/* struct::graph - critcl - layer 1 definitions
2 * (c) Graph functions
3 */
4
5#include <nacommon.h>
6#include <util.h>
7#include <node.h>
8
9/* .................................................. */
10
11void
12gc_add (GC* c, GCC* gx)
13{
14    GC* first = gx->first;
15
16    gx->n ++;
17
18    c->next   = first;
19    c->prev   = NULL;
20    gx->first = c;
21
22    if (!first) return;
23    first->prev = c;
24}
25
26/* .................................................. */
27
28void
29gc_remove (GC* c, GCC* gx)
30{
31    if ((gx->first == c) || c->prev || c->next) {
32
33	if (gx->first == c) {
34	    gx->first = c->next;
35	}
36
37	if (c->prev) { c->prev->next = c->next; }
38	if (c->next) { c->next->prev = c->prev; }
39
40	c->prev = NULL;
41	c->next = NULL;
42
43	gx->n --;
44    }
45}
46
47/* .................................................. */
48
49void
50gc_setup (GC* c, GCC* gx, const char* name, G* g)
51{
52    int new;
53
54    c->name = Tcl_NewStringObj (name, -1);
55    Tcl_IncrRefCount (c->name);
56
57    c->he = Tcl_CreateHashEntry(gx->map, name, &new);
58    Tcl_SetHashValue (c->he, (ClientData) c);
59
60    c->graph = g;
61    c->attr  = NULL;
62}
63
64/* .................................................. */
65
66void
67gc_delete (GC* c)
68{
69    Tcl_DecrRefCount	(c->name); c->name = NULL;
70    Tcl_DeleteHashEntry (c->he);   c->he   = NULL;
71    g_attr_delete       (&c->attr);
72    c->graph = NULL;
73
74    /* next/prev are not handled here, but via
75     * gc_remove, as type-dependent information
76     * is manipulated (node/arc data in the graph).
77     */
78}
79
80/* .................................................. */
81
82void
83gc_rename (GC* c, GCC* gx, Tcl_Obj* newname, Tcl_Interp* interp)
84{
85    int nnew;
86
87    /* Release current name, ... */
88    Tcl_DecrRefCount (c->name);
89
90    /* ... and create a new one, by taking the argument and shimmering it */
91
92    c->name = newname;
93    Tcl_IncrRefCount (c->name);
94
95    /* Update the global name mapping as well */
96
97    Tcl_DeleteHashEntry (c->he);
98    c->he = Tcl_CreateHashEntry(gx->map, Tcl_GetString (c->name), &nnew);
99    Tcl_SetHashValue (c->he, (ClientData) c);
100
101    Tcl_SetObjResult (interp, c->name);
102}
103
104/* .................................................. */
105
106int
107gc_attr (GCC* gx, int mode, Tcl_Obj* detail, Tcl_Interp* interp, Tcl_Obj* key,
108	 GN_GET_GC* gf, G* g)
109{
110    const char* ky = Tcl_GetString (key);
111    int         listc;
112    Tcl_Obj**   listv;
113
114    /* Allocate result space, max needed: All nodes */
115
116    ASSERT (gx->map->numEntries == gx->n, "Inconsistent #elements in graph");
117
118    switch (mode) {
119    case A_GLOB: {
120	/* Iterate over all nodes. Ignore nodes without attributes. Ignore
121	 * nodes not matching the pattern (glob). Ignore nodes not having the
122	 * attribute.
123	 */
124
125	int	       i;
126	GC*	       iter;
127	const char*    pattern = Tcl_GetString (detail);
128	Tcl_HashEntry* he;
129
130	listc = 2 * gx->map->numEntries;
131	listv = NALLOC (listc, Tcl_Obj*);
132
133	for (i = 0, iter = gx->first;
134	     iter != NULL;
135	     iter= iter->next) {
136
137	    if (!iter->attr) continue;
138	    if (!iter->attr->numEntries) continue;
139	    if (!Tcl_StringMatch(Tcl_GetString (iter->name), pattern)) continue;
140
141	    he = Tcl_FindHashEntry (iter->attr, ky);
142	    if (!he) continue;
143
144	    ASSERT_BOUNDS (i,   listc);
145	    ASSERT_BOUNDS (i+1, listc);
146
147	    listv [i++] = iter->name;
148	    listv [i++] = (Tcl_Obj*) Tcl_GetHashValue(he);
149	}
150
151	listc = i;
152    }
153    break;
154
155    case A_LIST: {
156	/* Iterate over the specified nodes. Ignore nodes which are not known.
157	 * Ignore nodes without attributes. Ignore nodes not having the
158	 * attribute. Many occurrences of the same node cause repeated
159	 * results.
160	 */
161
162	GC*	       iter;
163	int	       ec;
164	Tcl_Obj**      ev;
165	int	       i, j;
166	Tcl_HashEntry* he;
167
168	if (Tcl_ListObjGetElements (interp, detail, &ec, &ev) != TCL_OK) {
169	    return TCL_ERROR;
170	}
171
172	listc = 2 * ((ec > gx->n) ? ec : gx->n);
173	listv = NALLOC (listc, Tcl_Obj*);
174
175	for (i = 0, j = 0; i < ec; i++) {
176	    ASSERT_BOUNDS (i, ec);
177
178	    iter = (*gf) (g, ev [i], NULL, NULL);
179
180	    if (iter == NULL) continue;
181	    if (!iter->attr) continue;
182	    if (!iter->attr->numEntries) continue;
183
184	    he = Tcl_FindHashEntry (iter->attr, ky);
185	    if (!he) continue;
186
187	    ASSERT_BOUNDS (j,   listc);
188	    ASSERT_BOUNDS (j+1, listc);
189
190	    listv [j++] = iter->name;
191	    listv [j++] = (Tcl_Obj*) Tcl_GetHashValue(he);
192	}
193
194	listc = j;
195    }
196    break;
197
198    case A_REGEXP: {
199	/* Iterate over all nodes. Ignore nodes without attributes. Ignore
200	 * nodes not matching the pattern (re). Ignore nodes not having the
201	 * attribute.
202	 */
203
204	int	       i;
205	GC*	       iter;
206	const char*    pattern = Tcl_GetString (detail);
207	Tcl_HashEntry* he;
208
209	listc = 2 * gx->map->numEntries;
210	listv = NALLOC (listc, Tcl_Obj*);
211
212	for (i = 0, iter = gx->first;
213	     iter != NULL;
214	     iter= iter->next) {
215
216	    if (!iter->attr) continue;
217	    if (!iter->attr->numEntries) continue;
218	    if (Tcl_RegExpMatch(interp, Tcl_GetString (iter->name), pattern) < 1) continue;
219
220	    he = Tcl_FindHashEntry (iter->attr, ky);
221	    if (!he) continue;
222
223	    ASSERT_BOUNDS (i,   listc);
224	    ASSERT_BOUNDS (i+1, listc);
225
226	    listv [i++] = iter->name;
227	    listv [i++] = (Tcl_Obj*) Tcl_GetHashValue(he);
228	}
229
230	listc = i;
231    }
232    break;
233
234    case A_NONE: {
235	/* Iterate over all nodes. Ignore nodes without attributes. Ignore
236	 * nodes not having the attribute.
237	 */
238
239	int	       i;
240	GC*	       iter;
241	Tcl_HashEntry* he;
242
243	listc = 2 * gx->map->numEntries;
244	listv = NALLOC (listc, Tcl_Obj*);
245
246	for (i = 0, iter = gx->first;
247	     iter != NULL;
248	     iter= iter->next) {
249
250	    if (!iter->attr) continue;
251	    if (!iter->attr->numEntries) continue;
252
253	    he = Tcl_FindHashEntry (iter->attr, ky);
254	    if (!he) continue;
255
256	    ASSERT_BOUNDS (i,   listc);
257	    ASSERT_BOUNDS (i+1, listc);
258
259	    listv [i++] = iter->name;
260	    listv [i++] = (Tcl_Obj*) Tcl_GetHashValue(he);
261	}
262
263	listc = i;
264    }
265    break;
266    default:
267	Tcl_Panic ("Bad attr search mode");
268	break;
269    }
270
271    if (listc) {
272	Tcl_SetObjResult (interp, Tcl_NewListObj (listc, listv));
273    } else {
274	Tcl_SetObjResult (interp, Tcl_NewListObj (0, NULL));
275    }
276
277    ckfree ((char*) listv);
278    return TCL_OK;
279}
280
281/* .................................................. */
282
283/*
284 * Local Variables:
285 * mode: c
286 * c-basic-offset: 4
287 * fill-column: 78
288 * End:
289 */
290