base/enum.c

   1 /*
   2  *
   3  */
   4
   5 #include <string.h>
   6
   7 #include "hbytes.h"
   8
   9 static void enum_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
  10   dup->internalRep= src->internalRep;
  11 }
  12
  13 static void enum_nt_ustr(Tcl_Obj *o) {
  14   abort();
  15 }
  16
  17 static int enum_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  18   abort();
  19 }
  20
  21 Tcl_ObjType enum_nearlytype = {
  22   "enum-nearly",
  23   0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
  24 };
  25
  26 Tcl_ObjType enum1_nearlytype = {
  27   "enum1-nearly",
  28   0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
  29 };
  30
  31 const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
  32                                     const void *firstentry, size_t entrysize,
  33                                     const char *what) {
  34   const char *supplied, *found;
  35   const char *ep;
  36
  37   if (o->typePtr == &enum_nearlytype &&
  38       o->internalRep.twoPtrValue.ptr1 == firstentry)
  39     return o->internalRep.twoPtrValue.ptr2;
  40
  41   supplied= Tcl_GetStringFromObj(o,0);  assert(supplied);
  42   for (ep= firstentry;
  43        (found= *(const char*const*)ep) && strcmp(supplied,found);
  44        ep += entrysize);
  45
  46   if (found) {
  47     objfreeir(o);
  48     o->typePtr= &enum_nearlytype;
  49     o->internalRep.twoPtrValue.ptr1= (void*)firstentry;
  50     o->internalRep.twoPtrValue.ptr2= (void*)ep;
  51     return ep;
  52   }
  53
  54   Tcl_ResetResult(ip);
  55   Tcl_AppendResult(ip, "invalid ",what," - must be one of:",(char*)0);
  56   for (ep= firstentry;
  57        (found= *(const char*const*)ep);
  58        ep += entrysize)
  59     Tcl_AppendResult(ip, " ",found,(char*)0);
  60   return 0;
  61 }
  62
  63 int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
  64                              const char *opts, const char *what) {
  65   const char *supplied, *fp;
  66
  67   if (o->typePtr != &enum1_nearlytype ||
  68       o->internalRep.twoPtrValue.ptr1 != opts) {
  69
  70     supplied= Tcl_GetStringFromObj(o,0);  assert(supplied);
  71
  72     if (!(strlen(supplied) == 1 &&
  73           (fp= strchr(opts, supplied[0])))) {
  74       Tcl_ResetResult(ip);
  75       Tcl_AppendResult(ip, "invalid ",what,
  76                        " - must be one character from: ", opts);
  77       return -1;
  78     }
  79
  80     objfreeir(o);
  81     o->typePtr= &enum1_nearlytype;
  82     o->internalRep.twoPtrValue.ptr1= (void*)opts;
  83     o->internalRep.twoPtrValue.ptr2= (void*)fp;
  84   }
  85   return (const char*)o->internalRep.twoPtrValue.ptr2 - opts;
  86 }