/*
+ * base code for various Tcl extensions
+ * Copyright 2006-2012 Ian Jackson
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this library; if not, see <http://www.gnu.org/licenses/>.
*/
#ifndef CHIARK_TCL_H
#include <errno.h>
#include <unistd.h>
#include <fcntl.h>
+#include <limits.h>
#include <sys/socket.h>
#include <sys/uio.h>
#include <sys/un.h>
#include <arpa/inet.h>
-#include <tcl8.3/tcl.h>
+#ifndef _TCL /* if someone already included some tcl.h, use that */
+#include <tcl.h>
+#endif /*_TCL*/
#include <adns.h>
/* from scriptinv.c */
-typedef struct { /* semi-opaque - read only, and then only where commented */
- Tcl_Interp *ip; /* valid, non-0 and useable if set */
- Tcl_Obj *obj; /* non-0 iff set (but only test for 0/non-0) */
- Tcl_Obj *xargs;
- int llength;
+typedef struct { /* opaque; comments are for scriptinv.c impl'n only */
+ /* states: Cancelled Set */
+ Tcl_Interp *ipq; /* 0 valid, non-0, useable */
+ Tcl_Obj *script; /* 0 valid, non-0 */
+ Tcl_Obj *xargs; /* 0 valid, may be 0 */
+ int llen; /* undefined llength of script + xargs */
} ScriptToInvoke;
-void cht_scriptinv_init(ScriptToInvoke *si);
+void cht_scriptinv_init(ScriptToInvoke *si); /* undefined -> Cancelled */
int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
- Tcl_Obj *newscript, Tcl_Obj *xargs);
-void cht_scriptinv_cancel(ScriptToInvoke *si); /* then don't invoke */
- /* no separate free function - just cancel */
+ Tcl_Obj *newscript, Tcl_Obj *xargs);
+ /* Cancelled/Set -> Set (newscript!=0, ok) / Cancelled (otherwise) */
+void cht_scriptinv_cancel(ScriptToInvoke *si);
+ /* Cancelled/Set -> Cancelled. No separate free function - just cancel. */
+#define cht_scriptinv_interp(si) ((si)->ipq)
+ /* int cht_scriptinv_interp(ScriptToInvoke *si); returns 0 if Cancelled */
+
+int cht_scriptinv_invoke_fg(ScriptToInvoke *si, int argc,
+ Tcl_Obj *const *argv);
+ /* is a no-op if Cancelled rather than Set */
+ /* if script fails, returns that error */
void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
+ /* if script fails, reports it with Tcl_BackgroundError */
/* from idtable.c */
/* from hook.c */
-int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
- int *donep /* or 0, meaning no types follow */,
- ... /* types, terminated by 0 */);
-
int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec);
int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m);
int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
void cht_objfreeir(Tcl_Obj *o);
int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l);
-void cht_obj_updatestr_array(Tcl_Obj *o, const Byte *array, int l);
-void cht_obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
- int l, const char *prefix);
-
void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...);
- /* const char*, int, const char*, int, ..., (const char*)0 */
+ /* const char*, size_t, const char*, size_t, ..., (const char*)0 */
void cht_obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
void cht_obj_updatestr_string(Tcl_Obj *o, const char *str);
+void cht_prepare__basic(Tcl_Interp *ip);
+void cht_setup__commands(Tcl_Interp *ip, const TopLevel_Command *cmds);
+ /* ... for use by CHT_INIT and CHTI_... macros only */
+
/* from parse.c */
typedef struct {
#define TFREE(f) (Tcl_Free((void*)(f)))
#define TREALLOC(p,l) ((void*)Tcl_Realloc((void*)(p),(l)))
+/* macros for Chiark_tcl_FOOBAR_Init et al */
+
+ /*
+ * use these macros like this:
+ * CHT_INIT(<extbase>,
+ * <preparations>,
+ * <results>)
+ * where
+ *
+ * <extbase> is the short name eg `hbytes'
+ * and should correspond to EXTBASE from the Makefile.
+ *
+ * <results> are the initialisations which cause new commands
+ * etc. to appear in the Tcl namespace. Eg, CHTI_COMMANDS,
+ * These initialisations are called only when a Tcl `load'
+ * command loads this extension.
+ *
+ * <preparations> are the initialisations that we need but which
+ * do not interfere with the Tcl namespaces. For example,
+ * OBJECT types we used (CHTI_TYPE), and other chiark_tcl
+ * extensions (CHTI_OTHER). These initialisations are called
+ * both as a result of Tcl `load' (before the <results>
+ * initialisations) and also when another extension declares a
+ * dependency on this one with CHTI_OTHER.
+ *
+ * Both <results> and <preparations> are whitespace-separated
+ * lists of calls to CHTI_... macros. If the list is to be empty,
+ * write `{ }' instead to prevent an empty macro argument. The
+ * preparations and results currently supported are:
+ *
+ * CHTI_COMMANDS(cht_<somethingtoplevel>_entries)
+ * where the .tct file contains
+ * Table *<somethingtoplevel> TopLevel_Command
+ *
+ * CHTI_OTHER(<extbase-of-underlying-extension>)
+ * which does the <preparations> of that extension
+ * (if they have not already been done).
+ *
+ * CHTI_TYPE(cht_<something>_type)
+ * where extern Tcl_ObjType cht_<something>_type;
+ * Note that CHTI_TYPE should only be called by the
+ * extension which actually implements the type. Other
+ * extensions which need it should use CHTI_OTHER to bring
+ * in the implementing extension.
+ */
+
+#define CHT_INIT(e, preparations, results) \
+ extern void cht_prepare_##e(Tcl_Interp *ip); \
+ void cht_prepare_##e(Tcl_Interp *ip) { \
+ static int prepared; \
+ if (prepared) return; \
+ cht_prepare__basic(ip); \
+ { preparations } \
+ prepared= 1; \
+ } \
+ extern int Chiark_tcl_##e##_Init(Tcl_Interp *ip); /*called by load(3tcl)*/ \
+ int Chiark_tcl_##e##_Init(Tcl_Interp *ip) { \
+ static int initd; \
+ if (initd) return TCL_OK; \
+ cht_prepare_##e(ip); \
+ { results } \
+ initd= 1; \
+ return TCL_OK; \
+ }
+
+#define CHTI_OTHER(e) \
+ { extern void cht_prepare_##e(Tcl_Interp *ip); cht_prepare_##e(ip); }
+
+#define CHTI_TYPE(ot) { Tcl_RegisterObjType(&(ot)); }
+
+#define CHTI_COMMANDS(cl) { cht_setup__commands(ip,cl); }
+
#endif /*CHIARK_TCL_H*/
~ian / chiark-tcl.git / blobdiff