Builds a working plugin.

[chiark-tcl.git] / base / enum.c

diff --git a/base/enum.c b/base/enum.c
new file mode 100644 (file)
index 0000000..1a66aa3
--- /dev/null
+++ b/base/enum.c
@@ -0,0 +1,54 @@
+/*
+ *
+ */
+
+#include "hbytes.h"
+
+static void enum_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
+  dup->internalRep= src->internalRep;
+}
+
+static void enum_nt_ustr(Tcl_Obj *o) {
+  abort();
+}
+
+static int enum_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
+  abort();
+}
+
+Tcl_ObjType enum_nearlytype = {
+  "enum-nearly",
+  0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
+};
+
+const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+                                   size_t entrysize, const void *firstentry,
+                                   const char *what) {
+  const char *supplied, *found;
+  const char *ep;
+  
+  if (o->typePtr == &enum_nearlytype &&
+      o->internalRep.twoPtrValue.ptr1 == firstentry)
+    return o->internalRep.twoPtrValue.ptr2;
+
+  supplied= Tcl_GetStringFromObj(o,0);  assert(supplied);
+  for (ep= firstentry;
+       (found= *(const char*const*)ep) && strcmp(supplied,found);
+       ep += entrysize);
+
+  if (found) {
+    objfreeir(o);
+    o->typePtr= &enum_nearlytype;
+    o->internalRep.twoPtrValue.ptr1= (void*)firstentry;
+    o->internalRep.twoPtrValue.ptr2= (void*)ep;
+    return ep;
+  }
+
+  Tcl_ResetResult(ip);
+  Tcl_AppendResult(ip, "invalid ",what," - must be one of:",(char*)0);
+  for (ep= firstentry;
+       (found= *(const char*const*)ep);
+       ep += entrysize)
+    Tcl_AppendResult(ip, " ",found,(char*)0);
+  return 0;
+}