chiark / gitweb /
341c389ad919b5919972b8f49ec58904615203b0
[chiark-tcl.git] / base / parse.c
1 /*
2  */
3
4 #include "chiark-tcl.h"
5 #include "tables.h"
6
7 int cht_pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val,
8                  const char *opts, const char *what) {
9   *val= cht_enum1_lookup_cached_func(ip,obj,opts,what);
10   if (*val==-1) return TCL_ERROR;
11   return TCL_OK;
12 }
13
14 int cht_pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) {
15   return Tcl_GetIntFromObj(ip, obj, val);
16 }
17   
18 int cht_pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) {
19   return Tcl_GetLongFromObj(ip, obj, val);
20 }
21   
22 int cht_pat_string(Tcl_Interp *ip, Tcl_Obj *obj, const char **val) {
23   *val= Tcl_GetString(obj);
24   return TCL_OK;
25 }
26
27 int cht_pat_constv(Tcl_Interp *ip, Tcl_Obj *var,
28                Tcl_Obj **val_r, Tcl_ObjType *type) {
29   int rc;
30   Tcl_Obj *val;
31   
32   val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
33   if (!val) return TCL_ERROR;
34
35   if (type) {
36     rc= Tcl_ConvertToType(ip,val,type);
37     if (rc) return rc;
38   }
39
40   *val_r= val;
41   return TCL_OK;
42 }
43
44 void cht_init_somethingv(Something_Var *sth) {
45   sth->obj=0; sth->var=0; sth->copied=0;
46 }
47
48 int cht_pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
49                    Something_Var *sth, Tcl_ObjType *type) {
50   int rc;
51   Tcl_Obj *val;
52
53   sth->var= var;
54
55   val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
56   if (!val) return TCL_ERROR;
57
58   rc= Tcl_ConvertToType(ip,val,type);
59   if (rc) return rc;
60
61   if (Tcl_IsShared(val)) {
62     val= Tcl_DuplicateObj(val);
63     sth->copied= 1;
64   }
65   Tcl_InvalidateStringRep(val);
66   sth->obj= val;
67
68   return TCL_OK;
69 }
70
71 void cht_fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth) {
72   Tcl_Obj *ro;
73   
74   if (!rc) {
75     assert(sth->obj);
76     ro= Tcl_ObjSetVar2(ip,sth->var,0,sth->obj,TCL_LEAVE_ERR_MSG);
77     if (!ro) rc= TCL_ERROR;
78   }
79   if (rc && sth->copied)
80     Tcl_DecrRefCount(sth->obj);
81 }
82
83 Tcl_Obj *cht_ret_long(Tcl_Interp *ip, long val) {
84   return Tcl_NewLongObj(val);
85 }
86
87 Tcl_Obj *cht_ret_string(Tcl_Interp *ip, const char *val) {
88   return Tcl_NewStringObj(val,-1);
89 }