2 * base code for various Tcl extensions
3 * Copyright 2006 Ian Jackson
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License as
7 * published by the Free Software Foundation; either version 2 of the
8 * License, or (at your option) any later version.
10 * This program is distributed in the hope that it will be useful, but
11 * WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this library; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
29 #include <sys/socket.h>
32 #include <arpa/inet.h>
34 #ifndef _TCL /* if someone already included some tcl.h, use that */
40 typedef unsigned char Byte;
42 /* for assisting tcmdifgen and tcmdiflib.c */
44 typedef struct TopLevel_Command TopLevel_Command;
46 struct TopLevel_Command {
51 void cht_setstringresult(Tcl_Interp*, const char*);
52 int cht_pat_enum(Tcl_Interp*, Tcl_Obj*, const void**,
53 const void*, size_t, const char *what);
55 /* from scriptinv.c */
57 typedef struct { /* opaque; comments are for scriptinv.c impl'n only */
58 /* states: Cancelled Set */
59 Tcl_Interp *ipq; /* 0 valid, non-0, useable */
60 Tcl_Obj *script; /* 0 valid, non-0 */
61 Tcl_Obj *xargs; /* 0 valid, may be 0 */
62 int llen; /* undefined llength of script + xargs */
65 void cht_scriptinv_init(ScriptToInvoke *si); /* undefined -> Cancelled */
66 int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
67 Tcl_Obj *newscript, Tcl_Obj *xargs);
68 /* Cancelled/Set -> Set (newscript!=0, ok) / Cancelled (otherwise) */
69 void cht_scriptinv_cancel(ScriptToInvoke *si);
70 /* Cancelled/Set -> Cancelled. No separate free function - just cancel. */
71 #define cht_scriptinv_interp(si) ((si)->ipq)
72 /* int cht_scriptinv_interp(ScriptToInvoke *si); returns 0 if Cancelled */
74 int cht_scriptinv_invoke_fg(ScriptToInvoke *si, int argc,
75 Tcl_Obj *const *argv);
76 /* is a no-op if Cancelled rather than Set */
77 /* if script fails, returns that error */
79 void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
80 /* if script fails, reports it with Tcl_BackgroundError */
85 const char *valprefix, *assockey;
86 void (*destroyitem)(Tcl_Interp *ip, void *val);
89 /* The stored struct must start with a single int, conventionally
90 * named `ix'. When the struct is returned for the first time ix must
91 * be -1; on subsequent occasions it must be >=0. ix will be -1 iff
92 * the struct is registered by the iddatatable machinery. */
94 extern Tcl_ObjType cht_tabledataid_nearlytype;
95 int cht_tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds);
96 void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds);
97 /* call this when you destroy the struct, to remove its name;
98 * _disposing is idempotent */
102 int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec);
103 int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m);
104 int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
105 void cht_objfreeir(Tcl_Obj *o);
106 int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l);
108 void cht_obj_updatestr_array(Tcl_Obj *o, const Byte *array, int l);
109 void cht_obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
110 int l, const char *prefix);
112 void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...);
113 /* const char*, int, const char*, int, ..., (const char*)0 */
114 void cht_obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
115 void cht_obj_updatestr_string(Tcl_Obj *o, const char *str);
117 void cht_prepare__basic(Tcl_Interp *ip);
118 void cht_setup__commands(Tcl_Interp *ip, const TopLevel_Command *cmds);
119 /* ... for use by CHT_INIT and CHTI_... macros only */
128 void cht_init_somethingv(Something_Var *sth);
129 void cht_fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth);
130 int cht_pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
131 Something_Var *sth, Tcl_ObjType *type);
135 extern Tcl_ObjType cht_enum_nearlytype;
136 extern Tcl_ObjType cht_enum1_nearlytype;
138 const void *cht_enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
139 const void *firstentry, size_t entrysize,
141 #define enum_lookup_cached(ip,o,table,what) \
142 (cht_enum_lookup_cached_func((ip),(o), \
143 &(table)[0],sizeof((table)[0]), \
145 /* table should be a pointer to an array of structs of size
146 * entrysize, the first member of which should be a const char*.
147 * The table should finish with a null const char *.
148 * On error, 0 is returned and the ip->result will have been
149 * set to the error message.
152 int cht_enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
153 const char *opts, const char *what);
158 #define TALLOC(s) ((void*)Tcl_Alloc((s)))
159 #define TFREE(f) (Tcl_Free((void*)(f)))
160 #define TREALLOC(p,l) ((void*)Tcl_Realloc((void*)(p),(l)))
162 /* macros for Chiark_tcl_FOOBAR_Init et al */
165 * use these macros like this:
166 * CHT_INIT(<extbase>,
171 * <extbase> is the short name eg `hbytes'
172 * and should correspond to EXTBASE from the Makefile.
174 * <results> are the initialisations which cause new commands
175 * etc. to appear in the Tcl namespace. Eg, CHTI_COMMANDS,
176 * These initialisations are called only when a Tcl `load'
177 * command loads this extension.
179 * <preparations> are the initialisations that we need but which
180 * do not interfere with the Tcl namespaces. For example,
181 * OBJECT types we used (CHTI_TYPE), and other chiark_tcl
182 * extensions (CHTI_OTHER). These initialisations are called
183 * both as a result of Tcl `load' (before the <results>
184 * initialisations) and also when another extension declares a
185 * dependency on this one with CHTI_OTHER.
187 * Both <results> and <preparations> are whitespace-separated
188 * lists of calls to CHTI_... macros. If the list is to be empty,
189 * write `{ }' instead to prevent an empty macro argument. The
190 * preparations and results currently supported are:
192 * CHTI_COMMANDS(cht_<somethingtoplevel>_entries)
193 * where the .tct file contains
194 * Table *<somethingtoplevel> TopLevel_Command
196 * CHTI_OTHER(<extbase-of-underlying-extension>)
197 * which does the <preparations> of that extension
198 * (if they have not already been done).
200 * CHTI_TYPE(cht_<something>_type)
201 * where extern Tcl_ObjType cht_<something>_type;
202 * Note that CHTI_TYPE should only be called by the
203 * extension which actually implements the type. Other
204 * extensions which need it should use CHTI_OTHER to bring
205 * in the implementing extension.
208 #define CHT_INIT(e, preparations, results) \
209 extern void cht_prepare_##e(Tcl_Interp *ip); \
210 void cht_prepare_##e(Tcl_Interp *ip) { \
211 static int prepared; \
212 if (prepared) return; \
213 cht_prepare__basic(ip); \
217 extern int Chiark_tcl_##e##_Init(Tcl_Interp *ip); /*called by load(3tcl)*/ \
218 int Chiark_tcl_##e##_Init(Tcl_Interp *ip) { \
220 if (initd) return TCL_OK; \
221 cht_prepare_##e(ip); \
227 #define CHTI_OTHER(e) \
228 { extern void cht_prepare_##e(Tcl_Interp *ip); cht_prepare_##e(ip); }
230 #define CHTI_TYPE(ot) { Tcl_RegisterObjType(&(ot)); }
231 #define CHTI_COMMANDS(cl) { cht_setup__commands(ip,cl); }
233 #endif /*CHIARK_TCL_H*/