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