1/* struct::graph - critcl - layer 1 definitions 2 * (c) Graph functions 3 */ 4 5#include <attr.h> 6#include <util.h> 7 8/* .................................................. */ 9 10Tcl_Obj* 11g_attr_serial (Tcl_HashTable* attr, Tcl_Obj* empty) 12{ 13 int i; 14 Tcl_Obj* res; 15 int listc; 16 Tcl_Obj** listv; 17 Tcl_HashSearch hs; 18 Tcl_HashEntry* he; 19 const char* key; 20 21 if ((attr == NULL) || (attr->numEntries == 0)) { 22 return empty; 23 } 24 25 listc = 2 * attr->numEntries; 26 listv = NALLOC (listc, Tcl_Obj*); 27 28 for(i = 0, he = Tcl_FirstHashEntry(attr, &hs); 29 he != NULL; 30 he = Tcl_NextHashEntry(&hs)) { 31 32 key = Tcl_GetHashKey (attr, he); 33 34 ASSERT_BOUNDS (i, listc); 35 ASSERT_BOUNDS (i+1, listc); 36 37 listv [i] = Tcl_NewStringObj (key, -1); i++; 38 listv [i] = (Tcl_Obj*) Tcl_GetHashValue(he); i++; 39 } 40 41 res = Tcl_NewListObj (listc, listv); 42 ckfree ((char*) listv); 43 return res; 44} 45 46/* .................................................. */ 47 48int 49g_attr_serok (Tcl_Interp* interp, Tcl_Obj* aserial, const char* what) 50{ 51 int lc; 52 Tcl_Obj** lv; 53 54 if (Tcl_ListObjGetElements (interp, aserial, &lc, &lv) != TCL_OK) { 55 return 0; 56 } 57 if ((lc % 2) != 0) { 58 Tcl_AppendResult (interp, 59 "error in serialization: malformed ", 60 what, " attribute dictionary.", 61 NULL); 62 return 0; 63 } 64 return 1; 65} 66 67/* .................................................. */ 68 69void 70g_attr_deserial (Tcl_HashTable** Astar, Tcl_Obj* dict) 71{ 72 Tcl_HashEntry* he; 73 CONST char* key; 74 Tcl_Obj* val; 75 int new, i; 76 int listc; 77 Tcl_Obj** listv; 78 Tcl_HashTable* attr; 79 80 /* NULL can happen via 'g_attr_dup' */ 81 if (!dict) return; 82 83 Tcl_ListObjGetElements (NULL, dict, &listc, &listv); 84 85 if (!listc) return; 86 87 g_attr_extend (Astar); 88 attr = *Astar; 89 90 for (i = 0; i < listc; i+= 2) { 91 ASSERT_BOUNDS (i, listc); 92 ASSERT_BOUNDS (i+1, listc); 93 94 key = Tcl_GetString (listv [i]); 95 val = listv [i+1]; 96 97 he = Tcl_CreateHashEntry(attr, key, &new); 98 99 Tcl_IncrRefCount (val); 100 Tcl_SetHashValue (he, (ClientData) val); 101 } 102} 103 104/* .................................................. */ 105 106void 107g_attr_delete (Tcl_HashTable** Astar) 108{ 109 Tcl_HashTable* A = *Astar; 110 Tcl_HashSearch hs; 111 Tcl_HashEntry* he; 112 113 if (!A) return; 114 Astar = NULL; 115 116 for(he = Tcl_FirstHashEntry(A, &hs); 117 he != NULL; 118 he = Tcl_NextHashEntry(&hs)) { 119 Tcl_DecrRefCount ((Tcl_Obj*) Tcl_GetHashValue(he)); 120 } 121 Tcl_DeleteHashTable(A); 122 ckfree ((char*) A); 123} 124 125/* .................................................. */ 126 127void 128g_attr_keys (Tcl_HashTable* attr, Tcl_Interp* interp, int pc, Tcl_Obj* const* pv) 129{ 130 int listc; 131 Tcl_Obj** listv; 132 Tcl_HashEntry* he; 133 Tcl_HashSearch hs; 134 const char* key; 135 int i; 136 const char* pattern; 137 int matchall = 0; 138 139 if ((attr == NULL) || (attr->numEntries == 0)) { 140 Tcl_SetObjResult (interp, Tcl_NewListObj (0, NULL)); 141 return; 142 } 143 144 listc = attr->numEntries; 145 listv = NALLOC (listc, Tcl_Obj*); 146 147 if (pc) { 148 pattern = Tcl_GetString(pv[0]); 149 matchall = (strcmp (pattern, "*") == 0); 150 } 151 152 if (!pc || matchall) { 153 /* Unpatterned retrieval, or pattern '*' */ 154 155 for (i = 0, he = Tcl_FirstHashEntry(attr, &hs); 156 he != NULL; 157 he = Tcl_NextHashEntry(&hs)) { 158 159 ASSERT_BOUNDS (i, listc); 160 listv [i++] = Tcl_NewStringObj (Tcl_GetHashKey (attr, he), -1); 161 } 162 163 ASSERT (i == listc, "Bad key retrieval"); 164 165 } else { 166 /* Filtered retrieval, glob pattern */ 167 168 for (i = 0, he = Tcl_FirstHashEntry(attr, &hs); 169 he != NULL; 170 he = Tcl_NextHashEntry(&hs)) { 171 172 key = Tcl_GetHashKey (attr, he); 173 if (Tcl_StringMatch(key, pattern)) { 174 ASSERT_BOUNDS (i, listc); 175 176 listv [i++] = Tcl_NewStringObj (key, -1); 177 } 178 } 179 180 ASSERT (i <= listc, "Bad key glob retrieval"); 181 listc = i; 182 } 183 184 if (listc) { 185 Tcl_SetObjResult (interp, Tcl_NewListObj (listc, listv)); 186 } else { 187 Tcl_SetObjResult (interp, Tcl_NewListObj (0, NULL)); 188 } 189 190 ckfree ((char*) listv); 191} 192 193/* .................................................. */ 194 195void 196g_attr_kexists (Tcl_HashTable* attr, Tcl_Interp* interp, Tcl_Obj* key) 197{ 198 Tcl_HashEntry* he; 199 const char* ky = Tcl_GetString (key); 200 201 if ((attr == NULL) || (attr->numEntries == 0)) { 202 Tcl_SetObjResult (interp, Tcl_NewIntObj (0)); 203 return; 204 } 205 206 he = Tcl_FindHashEntry (attr, ky); 207 208 Tcl_SetObjResult (interp, Tcl_NewIntObj (he != NULL)); 209} 210 211/* .................................................. */ 212 213int 214g_attr_get (Tcl_HashTable* attr, Tcl_Interp* interp, Tcl_Obj* key, Tcl_Obj* o, const char* sep) 215{ 216 Tcl_Obj* av; 217 Tcl_HashEntry* he = (attr 218 ? Tcl_FindHashEntry (attr, Tcl_GetString (key)) 219 : NULL); 220 221 if (!he) { 222 Tcl_Obj* err = Tcl_NewObj (); 223 224 Tcl_AppendToObj (err, "invalid key \"", -1); 225 Tcl_AppendObjToObj (err, key); 226 Tcl_AppendToObj (err, sep, -1); 227 Tcl_AppendObjToObj (err, o); 228 Tcl_AppendToObj (err, "\"", -1); 229 230 Tcl_SetObjResult (interp, err); 231 return TCL_ERROR; 232 } 233 234 av = (Tcl_Obj*) Tcl_GetHashValue(he); 235 Tcl_SetObjResult (interp, av); 236 return TCL_OK; 237} 238 239/* .................................................. */ 240 241void 242g_attr_getall (Tcl_HashTable* attr, Tcl_Interp* interp, int pc, Tcl_Obj* const* pv) 243{ 244 Tcl_HashEntry* he; 245 Tcl_HashSearch hs; 246 const char* key; 247 int i; 248 int listc; 249 Tcl_Obj** listv; 250 const char* pattern = NULL; 251 int matchall = 0; 252 253 if ((attr == NULL) || (attr->numEntries == 0)) { 254 Tcl_SetObjResult (interp, Tcl_NewListObj (0, NULL)); 255 return; 256 } 257 258 if (pc) { 259 pattern = Tcl_GetString (pv [0]); 260 matchall = (strcmp (pattern, "*") == 0); 261 } 262 263 listc = 2 * attr->numEntries; 264 listv = NALLOC (listc, Tcl_Obj*); 265 266 if (!pc || matchall) { 267 /* Unpatterned retrieval, or pattern '*' */ 268 269 for (i = 0, he = Tcl_FirstHashEntry(attr, &hs); 270 he != NULL; 271 he = Tcl_NextHashEntry(&hs)) { 272 273 key = Tcl_GetHashKey (attr, he); 274 275 ASSERT_BOUNDS (i, listc); 276 ASSERT_BOUNDS (i+1, listc); 277 278 listv [i++] = Tcl_NewStringObj (key, -1); 279 listv [i++] = (Tcl_Obj*) Tcl_GetHashValue(he); 280 } 281 282 ASSERT (i == listc, "Bad attribute retrieval"); 283 } else { 284 /* Filtered retrieval, glob pattern */ 285 286 for (i = 0, he = Tcl_FirstHashEntry(attr, &hs); 287 he != NULL; 288 he = Tcl_NextHashEntry(&hs)) { 289 290 key = Tcl_GetHashKey (attr, he); 291 292 if (Tcl_StringMatch(key, pattern)) { 293 ASSERT_BOUNDS (i, listc); 294 ASSERT_BOUNDS (i+1, listc); 295 296 listv [i++] = Tcl_NewStringObj (key, -1); 297 listv [i++] = (Tcl_Obj*) Tcl_GetHashValue(he); 298 } 299 } 300 301 ASSERT (i <= listc, "Bad attribute glob retrieval"); 302 listc = i; 303 } 304 305 if (listc) { 306 Tcl_SetObjResult (interp, Tcl_NewListObj (listc, listv)); 307 } else { 308 Tcl_SetObjResult (interp, Tcl_NewListObj (0, NULL)); 309 } 310 311 ckfree ((char*) listv); 312} 313 314/* .................................................. */ 315 316void 317g_attr_unset (Tcl_HashTable* attr, Tcl_Obj* key) 318{ 319 const char* ky = Tcl_GetString (key); 320 321 if (attr) { 322 Tcl_HashEntry* he = Tcl_FindHashEntry (attr, ky); 323 if (he) { 324 Tcl_DecrRefCount ((Tcl_Obj*) Tcl_GetHashValue(he)); 325 Tcl_DeleteHashEntry (he); 326 } 327 } 328} 329 330/* .................................................. */ 331 332void 333g_attr_set (Tcl_HashTable* attr, Tcl_Interp* interp, Tcl_Obj* key, Tcl_Obj* value) 334{ 335 const char* ky = Tcl_GetString (key); 336 Tcl_HashEntry* he = Tcl_FindHashEntry (attr, ky); 337 338 if (he == NULL) { 339 int new; 340 he = Tcl_CreateHashEntry(attr, ky, &new); 341 } else { 342 Tcl_DecrRefCount ((Tcl_Obj*) Tcl_GetHashValue(he)); 343 } 344 345 Tcl_IncrRefCount (value); 346 Tcl_SetHashValue (he, (ClientData) value); 347 Tcl_SetObjResult (interp, value); 348} 349 350/* .................................................. */ 351 352void 353g_attr_append (Tcl_HashTable* attr, Tcl_Interp* interp, Tcl_Obj* key, Tcl_Obj* value) 354{ 355 const char* ky = Tcl_GetString (key); 356 Tcl_HashEntry* he = Tcl_FindHashEntry (attr, ky); 357 358 if (he == NULL) { 359 int new; 360 he = Tcl_CreateHashEntry(attr, ky, &new); 361 362 Tcl_IncrRefCount (value); 363 Tcl_SetHashValue (he, (ClientData) value); 364 } else { 365 Tcl_Obj* av = (Tcl_Obj*) Tcl_GetHashValue(he); 366 367 if (Tcl_IsShared (av)) { 368 Tcl_DecrRefCount (av); 369 av = Tcl_DuplicateObj (av); 370 Tcl_IncrRefCount (av); 371 372 Tcl_SetHashValue (he, (ClientData) av); 373 } 374 375 Tcl_AppendObjToObj (av, value); 376 value = av; 377 } 378 379 Tcl_SetObjResult (interp, value); 380} 381 382/* .................................................. */ 383 384void 385g_attr_lappend (Tcl_HashTable* attr, Tcl_Interp* interp, Tcl_Obj* key, Tcl_Obj* value) 386{ 387 const char* ky = Tcl_GetString (key); 388 Tcl_HashEntry* he = Tcl_FindHashEntry (attr, ky); 389 Tcl_Obj* av; 390 391 if (he == NULL) { 392 int new; 393 he = Tcl_CreateHashEntry(attr, ky, &new); 394 395 av = Tcl_NewListObj (0,NULL); 396 Tcl_IncrRefCount (av); 397 Tcl_SetHashValue (he, (ClientData) av); 398 399 } else { 400 av = (Tcl_Obj*) Tcl_GetHashValue(he); 401 402 if (Tcl_IsShared (av)) { 403 Tcl_DecrRefCount (av); 404 av = Tcl_DuplicateObj (av); 405 Tcl_IncrRefCount (av); 406 407 Tcl_SetHashValue (he, (ClientData) av); 408 } 409 } 410 411 Tcl_ListObjAppendElement (interp, av, value); 412 Tcl_SetObjResult (interp, av); 413} 414 415/* .................................................. */ 416 417void 418g_attr_extend (Tcl_HashTable** Astar) 419{ 420 if (*Astar) return; 421 422 *Astar = ALLOC (Tcl_HashTable); 423 Tcl_InitHashTable (*Astar, TCL_STRING_KEYS); 424} 425 426/* .................................................. */ 427 428void 429g_attr_dup (Tcl_HashTable** Astar, Tcl_HashTable* src) 430{ 431 g_attr_deserial (Astar, 432 g_attr_serial (src, NULL)); 433} 434 435/* .................................................. */ 436 437/* 438 * Local Variables: 439 * mode: c 440 * c-basic-offset: 4 441 * fill-column: 78 442 * End: 443 */ 444