10 const IdDataSpec *idds;
17 IdDataAssocData *assoc;
21 static void assoc_del(ClientData assoc_cd, Tcl_Interp *ip) {
22 IdDataAssocData *assoc;
27 for (ix=0, p=assoc->a; ix<assoc->n; ix++, p++) {
30 assert(*(int*)v == ix);
32 assoc->idds->destroyitem(ip,v);
39 static void setobjdataid(Tcl_Interp *interp, Tcl_Obj *o,
40 int ix, const IdDataSpec *idds) {
42 IdDataAssocData *assoc;
44 assoc= Tcl_GetAssocData(interp, (char*)idds->assockey, 0);
46 assoc= TALLOC(sizeof(*assoc));
50 Tcl_SetAssocData(interp, (char*)idds->assockey, assoc_del, assoc);
53 dv= TALLOC(sizeof(*dv));
58 o->typePtr= &tabledataid_nearlytype;
59 o->internalRep.otherValuePtr= dv;
62 int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds) {
66 IdDataAssocData *assoc;
69 if (o->typePtr != &tabledataid_nearlytype) goto convert;
71 dv= o->internalRep.otherValuePtr;
72 if (dv->interp != ip) goto convert;
74 if (dv->assoc->idds != idds) goto convert;
79 l= strlen(idds->valprefix);
80 str= Tcl_GetStringFromObj(o,0);
81 if (memcmp(str,idds->valprefix,l))
82 return staticerr(ip,"bad id (wrong prefix)",0);
84 errno=0; ul=strtoul(str+l,&ep,10);
85 if (errno || *ep) return staticerr(ip,"bad id number",0);
86 if (ul > INT_MAX) return staticerr(ip,"out of range id number",0);
89 setobjdataid(ip,o,ul,idds);
93 int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, const IdDataSpec *idds) {
96 IdDataAssocData *assoc;
99 rc= tabledataid_parse(ip,o,idds);
102 dv= o->internalRep.otherValuePtr;
106 if (ix >= assoc->n || !(r= assoc->a[ix]))
107 return staticerr(ip,"id not in use",0);
109 assert(*(int*)r == ix);
115 Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
116 /* Command procedure implementation may set val->ix,
117 * ie *(int*)val, to -1, to mean it's a new struct. Otherwise
118 * it had better be an old one !
122 IdDataAssocData *assoc;
126 setobjdataid(ip,o,0,idds);
127 dv= o->internalRep.otherValuePtr;
132 for (ix=0; ix<assoc->n && assoc->a[ix]; ix++);
136 assoc->a= TREALLOC(assoc->a, assoc->n*sizeof(*assoc->a));
137 while (ix<assoc->n) assoc->a[ix++]=0;
143 assert(val == assoc->a[ix]);
146 Tcl_InvalidateStringRep(o);
150 void tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
151 IdDataAssocData *assoc;
157 assoc= Tcl_GetAssocData(ip, (char*)idds->assockey, 0);
158 assert(assoc->a[ix] == val);
163 static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
167 static void tabledataid_nt_free(Tcl_Obj *o) {
168 TFREE(o->internalRep.otherValuePtr);
169 o->internalRep.otherValuePtr= 0;
172 static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
173 IdDataValue *sv, *dv;
175 sv= src->internalRep.otherValuePtr;
176 dv= TALLOC(sizeof(*dv));
178 dup->typePtr= &tabledataid_nearlytype;
179 dup->internalRep.otherValuePtr= dv;
182 static void tabledataid_nt_ustr(Tcl_Obj *o) {
183 const IdDataValue *dv;
184 const IdDataAssocData *assoc;
185 const IdDataSpec *idds;
188 dv= o->internalRep.otherValuePtr;
192 snprintf(buf,sizeof(buf), "%d", dv->ix);
193 obj_updatestr_vstringls(o,
194 idds->valprefix, strlen(idds->valprefix),
199 Tcl_ObjType tabledataid_nearlytype = {
201 tabledataid_nt_free, tabledataid_nt_dup,
202 tabledataid_nt_ustr, tabledataid_nt_sfa