View Source

[modwtcl]
apreq.h
dist/
libapreq1/
mod_wtcl.c
mod_wtcl.h
setupExclude.txt
util/
win.def
win.mak
wt1.1/
WtAppTable.c
WtAppTable.h
WtBasicCmds.c
WtBasicCmds.h
WtClientRequest.c
WtClientRequest.h
WtCollection.c
WtCollection.h
WtCollectionCmds.c
WtCollectionCmds.h
WtContext.c
WtContext.h
WtContextEvents.c
WtContextEvents.h
WtCookie.c
WtCookie.h
WtDbSession.c
WtDbSession.h
WtExecute.c
WtExecute.h
WtHtmlEntities.c
WtHtmlEntities.h
WtInitCmds.c
WtInitCmds.h
WtMtTable.c
WtMtTable.h
WtMultiTable.c
WtMultiTable.h
WtOS.h
WtProcSession.c
WtProcSession.h
WtResponse.c
WtResponse.h
WtServerCmds.c
WtServerCmds.h
WtSession.c
WtSession.h
WtSettings.c
WtSettings.h
WtTable.c
WtTable.h
WtTableCmds.c
WtTableCmds.h
WtTableUtil.c
WtTableUtil.h
WtUpload.c
WtUpload.h
WtUtil.c
WtUtil.h
WtWebErrors.c
WtWebErrors.h
WtWindows.h
File: / archive / modwtcl / WtTable.c

Lines Size Modified Created Owner MIME Types
1,093 22,518 2010/05/08 18:46:41 2011/06/13 15:35:15 BUILTIN\Administrators text/x-csrc

0001
/*
0002
 * Copyright 2001 Alexander Boverman and the original authors.
0003
 * 
0004
 * Licensed under the Apache License, Version 2.0 (the "License");
0005
 * you may not use this file except in compliance with the License.
0006
 * You may obtain a copy of the License at
0007
 * 
0008
 *      http://www.apache.org/licenses/LICENSE-2.0
0009
 * 
0010
 * Unless required by applicable law or agreed to in writing, software
0011
 * distributed under the License is distributed on an "AS IS" BASIS,
0012
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
0013
 * See the License for the specific language governing permissions and
0014
 * limitations under the License.
0015
 */
0016
0017
#include "WtTable.h"
0018
#include <ctype.h>
0019
0020
int WtTableSize(Tcl_Obj *tbl)
0021
{
0022
  return WtGetTableMap(tbl)->numEntries;
0023
}
0024
0025
int WtTableHas(Tcl_Obj *tbl, Tcl_Obj *key)
0026
{
0027
  return Tcl_FindHashEntry(WtGetTableMap(tbl), (char *)key) !=
0028
    NULL;
0029
}
0030
0031
Tcl_Obj *WtTableGet(Tcl_Obj *tbl, Tcl_Obj *key)
0032
{
0033
  Tcl_HashEntry *ent = Tcl_FindHashEntry(WtGetTableMap(tbl),
0034
    (char *)key);
0035
  return ent ? (Tcl_Obj *)Tcl_GetHashValue(ent) : NULL;
0036
}
0037
0038
Tcl_Obj *WtTableGetDefault(Tcl_Obj *tbl, Tcl_Obj *key,
0039
    Tcl_Obj *fallback)
0040
{
0041
  Tcl_Obj *val = WtTableGet(tbl, key);
0042
  return val ? val : fallback;
0043
}
0044
0045
int WtTableGetFirst(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj **val,
0046
    Tcl_Interp *interp)
0047
{
0048
  int ok = 1;
0049
  Tcl_Obj *list;
0050
0051
  *val = NULL;
0052
  list = WtTableGet(tbl, key);
0053
0054
  if (!list) {
0055
    ok = 1;
0056
  } else if (Tcl_ListObjIndex(interp, list, 0, val) == TCL_OK) {
0057
    ok = 1;
0058
  }
0059
0060
  return ok;
0061
}
0062
0063
int WtTableGetFirstDefault(Tcl_Obj *tbl, Tcl_Obj *key,
0064
    Tcl_Obj **val, Tcl_Obj *fallback, Tcl_Interp *interp)
0065
{
0066
  int ok = WtTableGetFirst(tbl, key, val, interp);
0067
  if (ok && !*val) {
0068
    *val = fallback;
0069
  }
0070
  return ok;
0071
}
0072
0073
int WtTableGetList(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj **list,
0074
    Tcl_Interp *interp)
0075
{
0076
  int ok = 1, len;
0077
0078
  *list = WtTableGet(tbl, key);
0079
0080
  if (*list) {
0081
    if (Tcl_ListObjLength(interp, *list, &len) != TCL_OK) {
0082
      *list = NULL;
0083
      ok = 0;
0084
    }
0085
  }
0086
0087
  return ok;
0088
}
0089
0090
int WtTableGetListDefault(Tcl_Obj *tbl, Tcl_Obj *key,
0091
    Tcl_Obj **list, Tcl_Obj *fallback, Tcl_Interp *interp)
0092
{
0093
  int ok = WtTableGetList(tbl, key, list, interp);
0094
  if (ok && !*list) {
0095
    *list = fallback;
0096
  }
0097
  return ok;
0098
}
0099
0100
/* Set a table entry */
0101
0102
void WtTableSet(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj *val)
0103
{
0104
  WtTableSetInternal(WtTableRep(tbl), key, val);
0105
  Tcl_InvalidateStringRep(tbl);
0106
}
0107
0108
void WtTableSetInternal(WtTable *tbl, Tcl_Obj *key, Tcl_Obj *val)
0109
{
0110
  int ok = 0, created;
0111
  Tcl_HashEntry *ent;
0112
0113
  ent = Tcl_CreateHashEntry(&tbl->items, (char *)key, &created);
0114
  if (ent) {
0115
    Tcl_IncrRefCount(val);
0116
    if (!created) {
0117
      Tcl_DecrRefCount((Tcl_Obj *)Tcl_GetHashValue(ent));
0118
    }
0119
    Tcl_SetHashValue(ent, val);
0120
  }
0121
}
0122
0123
void WtTableSetDefault(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj *val,
0124
    Tcl_Obj **result)
0125
{
0126
  Tcl_Obj *old;
0127
0128
  *result = NULL;
0129
  old = WtTableGet(tbl, key);
0130
0131
  if (old) {
0132
    *result = old;
0133
  } else {
0134
    WtTableSet(tbl, key, val);
0135
    *result = val;
0136
  }
0137
}
0138
0139
void WtTableSetOneValueList(Tcl_Obj *tbl, Tcl_Obj *key,
0140
    Tcl_Obj *val, Tcl_Obj **result)
0141
{
0142
  Tcl_Obj *list = Tcl_NewListObj(1, &val);
0143
0144
  WtTableSet(tbl, key, list);
0145
0146
  if (result) {
0147
    *result = list;
0148
  }
0149
}
0150
0151
void WtTableSetOneValueListDefault(Tcl_Obj *tbl, Tcl_Obj *key,
0152
    Tcl_Obj *val, Tcl_Obj **result)
0153
{
0154
  Tcl_Obj *old = WtTableGet(tbl, key);
0155
0156
  if (!old) {
0157
    WtTableSetOneValueList(tbl, key, val, &old);
0158
  }
0159
0160
  if (result) {
0161
    *result = old;
0162
  }
0163
}
0164
0165
int WtTableAppendToList(Tcl_Obj *tbl, Tcl_Obj *key,
0166
    Tcl_Obj *val, Tcl_Obj **list, Tcl_Interp *interp)
0167
{
0168
  return WtTableAppendToListInternal(tbl, key, val, 0,
0169
    list, interp);
0170
}
0171
0172
int WtTableAppendListToList(Tcl_Obj *tbl, Tcl_Obj *key,
0173
    Tcl_Obj *valList, Tcl_Obj **list, Tcl_Interp *interp)
0174
{
0175
  return WtTableAppendToListInternal(tbl, key, valList, 1,
0176
    list, interp);
0177
}
0178
0179
int WtTableAppendToListInternal(Tcl_Obj *tbl, Tcl_Obj *key,
0180
    Tcl_Obj *val, int multipleVals, Tcl_Obj **list,
0181
    Tcl_Interp *interp)
0182
{
0183
  int ok = 0, len;
0184
  Tcl_Obj *old, *result = NULL;
0185
0186
  old = WtTableGet(tbl, key);
0187
0188
  if (old) {
0189
    if (Tcl_ListObjLength(interp, old, &len) == TCL_OK) {
0190
      result = Tcl_IsShared(old) ? Tcl_DuplicateObj(old) : old;
0191
      if (result) {
0192
        if (multipleVals) {
0193
          ok = Tcl_ListObjAppendList(interp, result, val) == TCL_OK;
0194
        } else {
0195
          ok = Tcl_ListObjAppendElement(interp, result, val) == TCL_OK;
0196
        }
0197
0198
        if (ok && result != old) {
0199
          WtTableSet(tbl, key, result);
0200
        }
0201
0202
        if (!ok) {
0203
          if (result != old) {
0204
            Tcl_DecrRefCount(result);
0205
          }
0206
          result = NULL;
0207
        }
0208
      }
0209
    }
0210
  } else {
0211
    result = multipleVals ? val : Tcl_NewListObj(1, &val);
0212
    WtTableSet(tbl, key, result);
0213
    ok = 1;
0214
  }
0215
0216
  if (list) {
0217
    *list = result;
0218
  }
0219
0220
  return ok;
0221
}
0222
0223
int WtTableKeys(Tcl_Obj *tbl, Tcl_Obj **keys, Tcl_Interp *interp)
0224
{
0225
  int ok = 1;
0226
  Tcl_HashTable *hashTable;
0227
  Tcl_HashEntry *ent;
0228
  Tcl_HashSearch search;
0229
  Tcl_Obj *key;
0230
0231
  *keys = Tcl_NewListObj(0, NULL);
0232
  hashTable = WtGetTableMap(tbl);
0233
  ent = Tcl_FirstHashEntry(hashTable, &search);
0234
0235
  while (ent) {
0236
    key = (Tcl_Obj *)Tcl_GetHashKey(hashTable, ent);
0237
    if (key) {
0238
      if (Tcl_ListObjAppendElement(interp, *keys, key) != TCL_OK) {
0239
        ok = 0;
0240
        break;
0241
      }
0242
    }
0243
    ent = Tcl_NextHashEntry(&search);
0244
  }
0245
0246
  if (!ok && *keys) {
0247
    Tcl_DecrRefCount(*keys);
0248
    *keys = NULL;
0249
  }
0250
0251
  return ok;
0252
}
0253
0254
int WtTableValues(Tcl_Obj *tbl, Tcl_Obj **vals, Tcl_Interp *interp)
0255
{
0256
  int ok = 1;
0257
  Tcl_HashTable *hashTable;
0258
  Tcl_HashEntry *ent;
0259
  Tcl_HashSearch search;
0260
  Tcl_Obj *val;
0261
0262
  *vals = Tcl_NewListObj(0, NULL);
0263
  hashTable = WtGetTableMap(tbl);
0264
  ent = Tcl_FirstHashEntry(hashTable, &search);
0265
0266
  while (ent) {
0267
    val = (Tcl_Obj *)Tcl_GetHashValue(ent);
0268
    if (val) {
0269
      if (Tcl_ListObjAppendElement(interp, *vals, val) != TCL_OK) {
0270
        ok = 0;
0271
        break;
0272
      }
0273
    }
0274
    ent = Tcl_NextHashEntry(&search);
0275
  }
0276
0277
  if (!ok && *vals) {
0278
    Tcl_DecrRefCount(*vals);
0279
    *vals = NULL;
0280
  }
0281
0282
  return ok;
0283
}
0284
0285
int WtTableFirstValues(Tcl_Obj *tbl, Tcl_Obj **vals,
0286
    Tcl_Interp *interp)
0287
{
0288
  int ok = 1;
0289
  Tcl_HashTable *hashTable;
0290
  Tcl_HashEntry *ent;
0291
  Tcl_HashSearch search;
0292
  Tcl_Obj *val, *first;
0293
0294
  *vals = Tcl_NewListObj(0, NULL);
0295
  hashTable = WtGetTableMap(tbl);
0296
  ent = Tcl_FirstHashEntry(hashTable, &search);
0297
0298
  while (ent) {
0299
    val = (Tcl_Obj *)Tcl_GetHashValue(ent);
0300
    if (val) {
0301
      if (Tcl_ListObjIndex(interp, val, 0, &first) != TCL_OK) {
0302
        ok = 0;
0303
        break;
0304
      }
0305
      if (Tcl_ListObjAppendElement(interp, *vals, first) != TCL_OK) {
0306
        ok = 0;
0307
        break;
0308
      }
0309
    }
0310
    ent = Tcl_NextHashEntry(&search);
0311
  }
0312
0313
  if (!ok && *vals) {
0314
    Tcl_DecrRefCount(*vals);
0315
    *vals = NULL;
0316
  }
0317
0318
  return ok;
0319
}
0320
0321
void WtTableRemove(Tcl_Obj *tbl, Tcl_Obj *key)
0322
{
0323
  Tcl_Obj *val;
0324
  Tcl_HashEntry *ent;
0325
0326
  ent = Tcl_FindHashEntry(WtGetTableMap(tbl), (char *)key);
0327
0328
  if (ent) {
0329
    val = Tcl_GetHashValue(ent);
0330
    if (val) {
0331
      Tcl_DecrRefCount(val);
0332
    }    
0333
    Tcl_DeleteHashEntry(ent);
0334
    Tcl_InvalidateStringRep(tbl);
0335
  }
0336
}
0337
0338
int WtTableRemoveList(Tcl_Obj *tbl, Tcl_Obj *list,
0339
    Tcl_Interp *interp)
0340
{
0341
  int ok = 0, len, i;
0342
  Tcl_Obj *key;
0343
0344
  if (Tcl_ListObjLength(interp, list, &len) == TCL_OK) {
0345
    ok = 1;
0346
    for (i = 0; i < len; ++i) {
0347
      if (Tcl_ListObjIndex(NULL, list, i, &key) != TCL_OK) {
0348
        ok = 0;
0349
        break;
0350
      }
0351
      WtTableRemove(tbl, key);
0352
    }
0353
  }
0354
0355
  return ok;
0356
}
0357
0358
int WtUpdateTable(Tcl_Obj *dest, Tcl_Obj *src)
0359
{
0360
  int ok = 1;
0361
  Tcl_HashTable *hashTable;
0362
  Tcl_HashEntry *ent;
0363
  Tcl_HashSearch search;
0364
  Tcl_Obj *key, *val;
0365
0366
  hashTable = WtGetTableMap(src);
0367
  ent = Tcl_FirstHashEntry(hashTable, &search);
0368
  while (ent) {
0369
    key = (Tcl_Obj *)Tcl_GetHashKey(hashTable, ent);
0370
    val = (Tcl_Obj *)Tcl_GetHashValue(ent);
0371
    WtTableSet(dest, key, val);
0372
    ent = Tcl_NextHashEntry(&search);
0373
  }
0374
0375
  return ok;
0376
}
0377
0378
void WtClearTable(Tcl_Obj *tbl)
0379
{
0380
  WtDeleteTableItems(WtTableRep(tbl));
0381
  WtInitTableItems(WtTableRep(tbl), tbl->typePtr);
0382
  Tcl_InvalidateStringRep(tbl);
0383
}
0384
0385
/* Convert the object to a table if necessary */
0386
0387
int WtConvertToTableObj(Tcl_Obj *obj, Tcl_ObjType *type, Tcl_Interp *interp)
0388
{
0389
  int ok = 1, objc, i;
0390
  Tcl_Obj **objv, *tblObj = NULL;
0391
  WtTable *tbl;
0392
0393
  if (type != &WtCaselessTableType) {
0394
    type = &WtTableType;
0395
  }
0396
0397
  if (obj->typePtr != type) {
0398
    /* XXX: Use unserialization code from Tcl list obj instead */
0399
0400
    if (Tcl_ListObjGetElements(interp, obj, &objc, &objv) != TCL_OK) {
0401
      ok = 0;
0402
    } else if (objc & 1) {
0403
      if (interp) {
0404
        Tcl_AppendResult(interp, "Cannot create table from list "
0405
          "with odd number of elements.", NULL);
0406
      }
0407
      ok = 0;
0408
    }
0409
0410
    if (ok) {
0411
      if (tbl = (WtTable *)ckalloc(sizeof(WtTable))) {
0412
        WtInitTableItems(tbl, type);
0413
        for (i = 0; i < objc; i += 2) {
0414
          WtTableSetInternal(tbl, objv[i], objv[i + 1]);
0415
        }
0416
        if (!ok) {
0417
          WtDeleteTableItems(tbl);
0418
          ckfree((char *)tbl);
0419
        } else {
0420
          if (obj->typePtr && obj->typePtr->freeIntRepProc) {
0421
            obj->typePtr->freeIntRepProc(obj);
0422
          }
0423
          obj->internalRep.twoPtrValue.ptr1 = tbl;
0424
          obj->internalRep.twoPtrValue.ptr2 = NULL;
0425
          obj->typePtr = type;
0426
          Tcl_InvalidateStringRep(obj);
0427
        }
0428
      }
0429
    }
0430
  }
0431
0432
  return ok;
0433
}
0434
0435
/* Create the entry map */
0436
0437
void WtInitTableItems(WtTable *tbl, Tcl_ObjType *type)
0438
{
0439
  if (type == &WtCaselessTableType) {
0440
    Tcl_InitCustomHashTable(&tbl->items,
0441
      TCL_CUSTOM_PTR_KEYS, &WtCaselessHashKeyType);
0442
  } else {
0443
    Tcl_InitObjHashTable(&tbl->items);
0444
  }
0445
}
0446
0447
void WtDeleteTableItems(WtTable *tbl)
0448
{
0449
  Tcl_HashTable *hashTable;
0450
  Tcl_HashEntry *ent;
0451
  Tcl_HashSearch search;
0452
  Tcl_Obj *val;
0453
0454
  hashTable = &tbl->items;
0455
  ent = Tcl_FirstHashEntry(hashTable, &search);
0456
0457
  while (ent) {
0458
    val = (Tcl_Obj *)Tcl_GetHashValue(ent);
0459
    if (val) {
0460
      Tcl_DecrRefCount(val);
0461
    }
0462
    ent = Tcl_NextHashEntry(&search);
0463
  }
0464
0465
  Tcl_DeleteHashTable(hashTable);
0466
}
0467
0468
WtTable *WtTableRep(Tcl_Obj *tbl)
0469
{
0470
  return (WtTable *)(tbl->internalRep.twoPtrValue.ptr1);
0471
}
0472
0473
Tcl_HashTable *WtGetTableMap(Tcl_Obj *tbl)
0474
{
0475
  return &(WtTableRep(tbl)->items);
0476
}
0477
0478
int WtIsTableType(Tcl_ObjType *type)
0479
{
0480
  return type == &WtTableType || type == &WtCaselessTableType;
0481
}
0482
0483
/* Standard table object */
0484
0485
Tcl_Obj *WtNewTableObj()
0486
{
0487
  return WtNewTableObjWithType(&WtTableType);
0488
}
0489
0490
struct Tcl_ObjType WtTableType =
0491
{
0492
  "table",
0493
  WtFreeTable,
0494
  WtDupTable,
0495
  WtUpdateTableString,
0496
  WtSetTableFromAny
0497
};
0498
0499
void WtFreeTable(Tcl_Obj *tbl)
0500
{
0501
  WtFreeTableObj(tbl);
0502
}
0503
0504
void WtDupTable(Tcl_Obj *src, Tcl_Obj *dest)
0505
{
0506
  WtDupTableObj(src, dest);
0507
}
0508
0509
void WtUpdateTableString(Tcl_Obj *tbl)
0510
{
0511
  WtUpdateTableObjString(tbl);
0512
}
0513
0514
int WtSetTableFromAny(Tcl_Interp *interp, Tcl_Obj *obj)
0515
{
0516
  return WtSetTableObjFromAny(interp, obj, &WtTableType);
0517
}
0518
0519
int WtConvertToTable(Tcl_Obj *obj, Tcl_Interp *interp)
0520
{
0521
  return WtConvertToTableObj(obj, &WtTableType, interp);
0522
}
0523
0524
/* Case-insensitive table object */
0525
0526
Tcl_Obj *WtNewCaselessTableObj()
0527
{
0528
  return WtNewTableObjWithType(&WtCaselessTableType);
0529
}
0530
0531
struct Tcl_ObjType WtCaselessTableType =
0532
{
0533
  "itable",
0534
  WtFreeCaselessTable,
0535
  WtDupCaselessTable,
0536
  WtUpdateCaselessTableString,
0537
  WtSetCaselessTableFromAny
0538
};
0539
0540
void WtFreeCaselessTable(Tcl_Obj *tbl)
0541
{
0542
  WtFreeTableObj(tbl);
0543
}
0544
0545
void WtDupCaselessTable(Tcl_Obj *src, Tcl_Obj *dest)
0546
{
0547
  WtDupTableObj(src, dest);
0548
}
0549
0550
void WtUpdateCaselessTableString(Tcl_Obj *tbl)
0551
{
0552
  WtUpdateTableObjString(tbl);
0553
}
0554
0555
int WtSetCaselessTableFromAny(Tcl_Interp *interp, Tcl_Obj *obj)
0556
{
0557
  return WtSetTableObjFromAny(interp, obj, &WtCaselessTableType);
0558
}
0559
0560
int WtConvertToCaselessTable(Tcl_Obj *obj, Tcl_Interp *interp)
0561
{
0562
  return WtConvertToTableObj(obj, &WtCaselessTableType, interp);
0563
}
0564
0565
/* Custom hash table for case-insensitive tables */
0566
0567
Tcl_HashKeyType WtCaselessHashKeyType = {
0568
  TCL_HASH_KEY_TYPE_VERSION,          /* version */
0569
  0,                                  /* flags */
0570
  HashCaselessKey,                    /* hashKeyProc */
0571
  CompareCaselessKeys,                /* compareKeysProc */
0572
  AllocCaselessEntry ,                /* allocEntryProc */
0573
  FreeCaselessEntry                   /* freeEntryProc */
0574
};
0575
0576
/* Caseless hashKeyProc */
0577
0578
unsigned int HashCaselessKey(Tcl_HashTable *hashTable, void *keyPtr)
0579
{
0580
  Tcl_Obj *key = (Tcl_Obj *)keyPtr;
0581
  const char *string;
0582
  int length, i;
0583
  unsigned int result = 0;
0584
0585
  string = Tcl_GetString(key);
0586
  length = key->length;
0587
0588
  for (i = 0; i < length; i++) {
0589
    result += (result << 3) + tolower(string[i]);
0590
  }
0591
0592
  return result;  
0593
}
0594
0595
/* Caseless compareKeysProc */
0596
0597
int CompareCaselessKeys(void *keyPtr, Tcl_HashEntry *entry)
0598
{
0599
  Tcl_Obj *obj1 = (Tcl_Obj *)keyPtr;
0600
  Tcl_Obj *obj2 = (Tcl_Obj *)(entry->key.oneWordValue);
0601
  const char *p1, *p2;
0602
  int l1, l2;
0603
0604
  if (obj1 == obj2) {
0605
      return 1;
0606
  }
0607
0608
  p1 = Tcl_GetString(obj1);
0609
  l1 = obj1->length;
0610
0611
  p2 = Tcl_GetString(obj2);
0612
  l2 = obj2->length;
0613
0614
  if (l1 == l2) {
0615
    while (l1--) {
0616
      if (tolower(*p1) != tolower(*p2)) {
0617
        return 0;
0618
      }
0619
      p1++;
0620
      p2++;
0621
    }
0622
    return 1;
0623
  }
0624
0625
  return 0;
0626
}
0627
0628
/* Caseless allocEntryProc */
0629
0630
Tcl_HashEntry *AllocCaselessEntry(Tcl_HashTable *hashTable, void *keyPtr)
0631
{
0632
  Tcl_Obj *key = (Tcl_Obj *)keyPtr;
0633
  Tcl_HashEntry *ent;
0634
  ent = (Tcl_HashEntry *)ckalloc((unsigned)(sizeof(Tcl_HashEntry)));
0635
  ent->key.oneWordValue = (char *)key;
0636
  Tcl_IncrRefCount(key);
0637
  return ent;
0638
}
0639
0640
/* Caseless freeEntryProc */
0641
0642
void FreeCaselessEntry(Tcl_HashEntry *ent)
0643
{
0644
  Tcl_Obj *key = (Tcl_Obj *)ent->key.oneWordValue;
0645
  Tcl_DecrRefCount(key);
0646
  ckfree((char *)ent);
0647
}
0648
0649
/* Type-guarded table functions */
0650
0651
Tcl_Obj *WtNewTableObjWithType(Tcl_ObjType *type)
0652
{
0653
  WtTable *tbl;
0654
  Tcl_Obj *obj = NULL;
0655
0656
  tbl = (WtTable *)ckalloc(sizeof(WtTable));
0657
  if (tbl) {
0658
    obj = Tcl_NewObj();
0659
    obj->internalRep.twoPtrValue.ptr1 = tbl;
0660
    obj->internalRep.twoPtrValue.ptr2 = NULL;
0661
    obj->typePtr = type ? type : &WtTableType;
0662
    WtInitTableItems(tbl, type);
0663
    Tcl_InvalidateStringRep(obj);
0664
  }
0665
0666
  return obj;
0667
}
0668
0669
Tcl_Obj *WtNewTableObjWithElements(Tcl_ObjType *type,
0670
  int objc, const Tcl_Obj *objv[], Tcl_Interp *interp)
0671
{
0672
  Tcl_Obj *tbl = NULL;
0673
  int i;
0674
0675
  if (objc & 1) {
0676
    if (interp) {
0677
      Tcl_AppendResult(interp, "Cannot create table from odd "
0678
        "number of elements.", NULL);
0679
    }
0680
  } else {
0681
    tbl = WtNewTableObjWithType(type);
0682
    for (i = 0; i < objc; i += 2) {
0683
      WtTableSet(tbl, (Tcl_Obj *)objv[i], (Tcl_Obj *)objv[i + 1]);
0684
    }
0685
  }
0686
0687
  return tbl;
0688
}
0689
0690
int WtTableObjSize(Tcl_Obj *tbl, int *size, Tcl_ObjType *type,
0691
    Tcl_Interp *interp)
0692
{
0693
  int ok = 0;
0694
0695
  if (WtConvertToTableObj(tbl, type, interp)) {
0696
    *size = WtTableSize(tbl);
0697
    ok = 1;
0698
  }
0699
0700
  return ok;
0701
}
0702
0703
int WtTableObjHas(Tcl_Obj *tbl, Tcl_Obj *key, int *has,
0704
    Tcl_ObjType *type, Tcl_Interp *interp)
0705
{
0706
  int ok = 0;
0707
0708
  if (WtConvertToTableObj(tbl, type, interp)) {
0709
    *has = WtTableHas(tbl, key);
0710
    ok = 1;
0711
  } else {
0712
    *has = -1;
0713
  }
0714
0715
  return ok;
0716
}
0717
0718
int WtTableObjGet(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj **val,
0719
    Tcl_ObjType *type, Tcl_Interp *interp)
0720
{
0721
  int ok = 0;
0722
0723
  if (WtConvertToTableObj(tbl, type, interp)) {
0724
    *val = WtTableGet(tbl, key);
0725
    ok = 1;
0726
  } else {
0727
    *val = NULL;
0728
  }
0729
0730
  return ok;
0731
}
0732
0733
int WtTableObjGetDefault(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj **val,
0734
    Tcl_Obj *fallback, Tcl_ObjType *type, Tcl_Interp *interp)
0735
{
0736
  int ok = 0;
0737
0738
  if (WtConvertToTableObj(tbl, type, interp)) {
0739
    *val = WtTableGetDefault(tbl, key, fallback);
0740
    ok = 1;
0741
  } else {
0742
    *val = NULL;
0743
  }
0744
0745
  return ok;
0746
}
0747
0748
int WtTableObjGetFirst(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj **val,
0749
    Tcl_ObjType *type, Tcl_Interp *interp)
0750
{
0751
  int ok = 0;
0752
0753
  if (WtConvertToTableObj(tbl, type, interp)) {
0754
    ok = WtTableGetFirst(tbl, key, val, interp);
0755
  } else {
0756
    *val = NULL;
0757
  }
0758
0759
  return ok;
0760
}
0761
0762
int WtTableObjGetFirstDefault(Tcl_Obj *tbl, Tcl_Obj *key,
0763
    Tcl_Obj **val, Tcl_Obj *fallback, Tcl_ObjType *type,
0764
    Tcl_Interp *interp)
0765
{
0766
  int ok = 0;
0767
0768
  if (WtConvertToTableObj(tbl, type, interp)) {
0769
    ok = WtTableGetFirstDefault(tbl, key, val, fallback,
0770
      interp);
0771
  } else {
0772
    *val = NULL;
0773
  }
0774
0775
  return ok;
0776
}
0777
0778
int WtTableObjGetList(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj **list,
0779
    Tcl_ObjType *type, Tcl_Interp *interp)
0780
{
0781
  int ok = 0;
0782
0783
  if (WtConvertToTableObj(tbl, type, interp)) {
0784
    ok = WtTableGetList(tbl, key, list, interp);
0785
  } else {
0786
    *list = NULL;
0787
  }
0788
0789
  return ok;
0790
}
0791
0792
int WtTableObjGetListDefault(Tcl_Obj *tbl, Tcl_Obj *key,
0793
    Tcl_Obj **list, Tcl_Obj *fallback, Tcl_ObjType *type,
0794
    Tcl_Interp *interp)
0795
{
0796
  int ok = 0;
0797
0798
  if (WtConvertToTableObj(tbl, type, interp)) {
0799
    ok = WtTableGetListDefault(tbl, key, list, fallback, interp);
0800
  } else {
0801
    *list = NULL;
0802
  }
0803
0804
  return ok;
0805
}
0806
0807
/* Set a table entry */
0808
0809
int WtTableObjSet(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj *val,
0810
    Tcl_ObjType *type, Tcl_Interp *interp)
0811
{
0812
  int ok = 0;
0813
0814
  if (WtConvertToTableObj(tbl, type, interp)) {
0815
    WtTableSet(tbl, key, val);
0816
    ok = 1;
0817
  }
0818
0819
  return ok;
0820
}
0821
0822
/* Set a table entry if it doesn't exist */
0823
0824
int WtTableObjSetDefault(Tcl_Obj *tbl, Tcl_Obj *key, Tcl_Obj *val,
0825
    Tcl_Obj **result, Tcl_ObjType *type, Tcl_Interp *interp)
0826
{
0827
  int ok = 0;
0828
0829
  if (WtConvertToTableObj(tbl, type, interp)) {
0830
    WtTableSetDefault(tbl, key, val, result);
0831
    ok = 1;
0832
  } else {
0833
    *result = NULL;
0834
  }
0835
0836
  return ok;
0837
}
0838
0839
/* Insert a list with one element */
0840
0841
int WtTableObjSetOneValueList(Tcl_Obj *tbl, Tcl_Obj *key,
0842
    Tcl_Obj *val, Tcl_Obj **result, Tcl_ObjType *type,
0843
    Tcl_Interp *interp)
0844
{
0845
  int ok = 0;
0846
0847
  if (result) {
0848
    *result = NULL;
0849
  }
0850
0851
  if (WtConvertToTableObj(tbl, type, interp)) {
0852
    WtTableSetOneValueList(tbl, key, val, result);
0853
    ok = 1;
0854
  }
0855
0856
  return ok;
0857
}
0858
0859
/* Insert a list with one element if it doesn't exist */
0860
0861
int WtTableObjSetOneValueListDefault(Tcl_Obj *tbl, Tcl_Obj *key,
0862
    Tcl_Obj *val, Tcl_Obj **result, Tcl_ObjType *type,
0863
    Tcl_Interp *interp)
0864
{
0865
  int ok = 0;
0866
0867
  if (result) {
0868
    *result = NULL;
0869
  }
0870
0871
  if (WtConvertToTableObj(tbl, type, interp)) {
0872
    WtTableSetOneValueListDefault(tbl, key, val, result);
0873
    ok = 1;
0874
  }
0875
0876
  return ok;
0877
}
0878
0879
/* Append an element to a list */
0880
0881
int WtTableObjAppendToList(Tcl_Obj *tbl, Tcl_Obj *key,
0882
    Tcl_Obj *val, Tcl_Obj **list, Tcl_ObjType *type,
0883
    Tcl_Interp *interp)
0884
{
0885
  int ok = 0;
0886
0887
  if (WtConvertToTableObj(tbl, type, interp)) {
0888
    ok = WtTableAppendToList(tbl, key, val, list, interp);
0889
  }
0890
0891
  return ok;
0892
}
0893
0894
/* Append several elements to a list */
0895
0896
int WtTableObjAppendListToList(Tcl_Obj *tbl, Tcl_Obj *key,
0897
    Tcl_Obj *valList, Tcl_Obj **list, Tcl_ObjType *type,
0898
    Tcl_Interp *interp)
0899
{
0900
  int ok = 0;
0901
0902
  if (WtConvertToTableObj(tbl, type, interp)) {
0903
    ok = WtTableAppendListToList(tbl, key, valList, list, interp);
0904
  } else {
0905
    *list = NULL;
0906
  }
0907
0908
  return ok;
0909
}
0910
0911
/* Get keys */
0912
0913
int WtTableObjKeys(Tcl_Obj *tbl, Tcl_Obj **keys, Tcl_ObjType *type,
0914
    Tcl_Interp *interp)
0915
{
0916
  int ok = 0;
0917
0918
  if (WtConvertToTableObj(tbl, type, interp)) {
0919
    ok = WtTableKeys(tbl, keys, interp);
0920
  } else {
0921
    *keys = NULL;
0922
  }
0923
0924
  return ok;
0925
}
0926
0927
/* Get values */
0928
0929
int WtTableObjValues(Tcl_Obj *tbl, Tcl_Obj **vals,
0930
  Tcl_ObjType *type, Tcl_Interp *interp)
0931
{
0932
  int ok = 0;
0933
0934
  if (WtConvertToTableObj(tbl, type, interp)) {
0935
    ok = WtTableValues(tbl, vals, interp);
0936
  } else {
0937
    *vals = NULL;
0938
  }
0939
0940
  return ok;
0941
}
0942
0943
/* Get first values */
0944
0945
int WtTableObjFirstValues(Tcl_Obj *tbl, Tcl_Obj **vals,
0946
    Tcl_ObjType *type, Tcl_Interp *interp)
0947
{
0948
  int ok = 0;
0949
0950
  if (WtConvertToTableObj(tbl, type, interp)) {
0951
    ok = WtTableFirstValues(tbl, vals, interp);
0952
  } else {
0953
    *vals = NULL;
0954
  }
0955
0956
  return ok;
0957
}
0958
0959
/* Remove an entry */
0960
0961
int WtTableObjRemove(Tcl_Obj *tbl, Tcl_Obj *key,
0962
    Tcl_ObjType *type, Tcl_Interp *interp)
0963
{
0964
  int ok = 0;
0965
0966
  if (WtConvertToTableObj(tbl, type, interp)) {
0967
    WtTableRemove(tbl, key);
0968
    ok = 1;
0969
  }
0970
0971
  return ok;
0972
}
0973
0974
/* Remove a list of entries */
0975
0976
int WtTableObjRemoveList(Tcl_Obj *tbl, Tcl_Obj *list,
0977
    Tcl_ObjType *type, Tcl_Interp *interp)
0978
{
0979
  int ok = 0;
0980
0981
  if (WtConvertToTableObj(tbl, type, interp)) {
0982
    ok = WtTableRemoveList(tbl, list, interp);
0983
  }
0984
0985
  return ok;
0986
}
0987
0988
/* Clear the contents of a table */
0989
0990
int WtClearTableObj(Tcl_Obj *tbl, Tcl_ObjType *type, Tcl_Interp *interp)
0991
{
0992
  int ok = 0;
0993
0994
  if (WtConvertToTableObj(tbl, type, interp)) {
0995
    WtClearTable(tbl);
0996
    ok = 1;
0997
  }
0998
0999
  return ok;
1000
}
1001
1002
/* Type handlers */
1003
1004
void WtFreeTableObj(Tcl_Obj *tbl)
1005
{
1006
  WtDeleteTableItems(WtTableRep(tbl));
1007
  ckfree((char *)WtTableRep(tbl));
1008
}
1009
1010
void WtDupTableObj(Tcl_Obj *src, Tcl_Obj *dest)
1011
{
1012
  WtTable *srcTbl = WtTableRep(src), *destTbl;
1013
  Tcl_HashTable *srcMap = WtGetTableMap(src), *destMap;
1014
  Tcl_HashEntry *srcEnt, *destEnt;
1015
  Tcl_HashSearch search;
1016
  Tcl_Obj *val;
1017
  int created;
1018
1019
  destTbl = (WtTable *)ckalloc(sizeof(WtTable));
1020
  dest->internalRep.twoPtrValue.ptr1 = destTbl;
1021
  dest->internalRep.twoPtrValue.ptr2 = NULL;
1022
  dest->typePtr = src->typePtr;
1023
  WtInitTableItems(destTbl, dest->typePtr);
1024
  destMap = WtGetTableMap(dest);
1025
1026
  srcEnt = Tcl_FirstHashEntry(srcMap, &search);
1027
1028
  while (srcEnt) {
1029
    destEnt = Tcl_CreateHashEntry(destMap,
1030
      Tcl_GetHashKey(srcMap, srcEnt), &created);
1031
    val = (Tcl_Obj *)Tcl_GetHashValue(srcEnt);
1032
    Tcl_SetHashValue(destEnt, val);
1033
    Tcl_IncrRefCount(val);
1034
    srcEnt = Tcl_NextHashEntry(&search);
1035
  }
1036
1037
  Tcl_InvalidateStringRep(dest);
1038
}
1039
1040
void WtUpdateTableObjString(Tcl_Obj *tbl)
1041
{
1042
  int ok = 1, n;
1043
  Tcl_HashTable *hashTable;
1044
  Tcl_HashEntry *ent;
1045
  Tcl_HashSearch search;
1046
  Tcl_Obj *list, *key, *val;
1047
  const char *bytes;
1048
1049
  list = Tcl_NewListObj(0, NULL);
1050
  hashTable = WtGetTableMap(tbl);
1051
  ent = Tcl_FirstHashEntry(hashTable, &search);
1052
1053
  while (ent) {
1054
    key = (Tcl_Obj *)Tcl_GetHashKey(hashTable, ent);
1055
    val = (Tcl_Obj *)Tcl_GetHashValue(ent);
1056
    if (Tcl_ListObjAppendElement(NULL, list, key) != TCL_OK) {
1057
      ok = 0;
1058
      break;
1059
    }
1060
    if (Tcl_ListObjAppendElement(NULL, list, val) != TCL_OK) {
1061
      ok = 0;
1062
      break;
1063
    }
1064
    ent = Tcl_NextHashEntry(&search);
1065
  }
1066
1067
  if (ok) {
1068
    bytes = Tcl_GetStringFromObj(list, &n);
1069
    if (!bytes) {
1070
      ok = 0;
1071
    } else {
1072
      tbl->bytes = Tcl_Alloc(n + 1);
1073
      memcpy(tbl->bytes, bytes, n + 1);
1074
      tbl->length = n;
1075
    }
1076
  }
1077
1078
  if (list) {
1079
    Tcl_DecrRefCount(list);
1080
  }
1081
1082
  if (!ok) {
1083
    tbl->bytes = NULL;
1084
    tbl->length = 0;
1085
  }
1086
}
1087
1088
int WtSetTableObjFromAny(Tcl_Interp *interp, Tcl_Obj *obj,
1089
    Tcl_ObjType *type)
1090
{
1091
  return WtConvertToTableObj(obj, type, interp) ?
1092
    TCL_OK : TCL_ERROR;
1093
}