chiark / gitweb /
actually clean out unwanted file handlers; docuemtn -reverse options in right place
[chiark-tcl.git] / hbytes / parse.c
1 /*
2  */
3
4 #include "tables.h"
5
6 int pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val,
7                  const char *opts, const char *what) {
8   *val= enum1_lookup_cached_func(ip,obj,opts,what);
9   if (*val==-1) return TCL_ERROR;
10   return TCL_OK;
11 }
12
13 int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) {
14   return Tcl_GetIntFromObj(ip, obj, val);
15 }
16   
17 int pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) {
18   return Tcl_GetLongFromObj(ip, obj, val);
19 }
20   
21 int pat_string(Tcl_Interp *ip, Tcl_Obj *obj, const char **val) {
22   *val= Tcl_GetString(obj);
23   return TCL_OK;
24 }
25
26 int pat_constv(Tcl_Interp *ip, Tcl_Obj *var,
27                Tcl_Obj **val_r, Tcl_ObjType *type) {
28   int rc;
29   Tcl_Obj *val;
30   
31   val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
32   if (!val) return TCL_ERROR;
33
34   if (type) {
35     rc= Tcl_ConvertToType(ip,val,type);
36     if (rc) return rc;
37   }
38
39   *val_r= val;
40   return TCL_OK;
41 }
42
43 void init_somethingv(Something_Var *sth) {
44   sth->obj=0; sth->var=0; sth->copied=0;
45 }
46
47 int pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
48                    Something_Var *sth, Tcl_ObjType *type) {
49   int rc;
50   Tcl_Obj *val;
51
52   sth->var= var;
53
54   val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
55   if (!val) return TCL_ERROR;
56
57   rc= Tcl_ConvertToType(ip,val,type);
58   if (rc) return rc;
59
60   if (Tcl_IsShared(val)) {
61     val= Tcl_DuplicateObj(val);
62     sth->copied= 1;
63   }
64   Tcl_InvalidateStringRep(val);
65   sth->obj= val;
66
67   return TCL_OK;
68 }
69
70 int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
71   int rc;
72   rc= pat_somethingv(ip,var,&agg->sth,&hbytes_type);  if (rc) return rc;
73   agg->hb= OBJ_HBYTES(agg->sth.obj);
74   return TCL_OK;
75 }
76
77 void fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth) {
78   Tcl_Obj *ro;
79   
80   if (!rc) {
81     assert(sth->obj);
82     ro= Tcl_ObjSetVar2(ip,sth->var,0,sth->obj,TCL_LEAVE_ERR_MSG);
83     if (!ro) rc= TCL_ERROR;
84   }
85   if (rc && sth->copied)
86     Tcl_DecrRefCount(sth->obj);
87 }
88
89 int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
90   int rc;
91   rc= Tcl_ConvertToType(ip,obj,&hbytes_type);  if (rc) return rc;
92   *val= *OBJ_HBYTES(obj);
93   return TCL_OK;
94 }
95
96 Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
97   Tcl_Obj *obj;
98   obj= Tcl_NewObj();
99   Tcl_InvalidateStringRep(obj);
100   *OBJ_HBYTES(obj)= val;
101   obj->typePtr= &hbytes_type;
102   return obj;
103 }
104
105 Tcl_Obj *ret_long(Tcl_Interp *ip, long val) {
106   return Tcl_NewLongObj(val);
107 }
108
109 Tcl_Obj *ret_string(Tcl_Interp *ip, const char *val) {
110   return Tcl_NewStringObj(val,-1);
111 }