X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl.git;a=blobdiff_plain;f=base%2Fhook.c;h=0cb2f9d47961615e8dfde1af3966e2198401edcf;hp=9243724ecc91b3deaf08976949f6a6fa86a3be11;hb=ca8b96bf81245f21fe3906c71dc2994bfc5e516f;hpb=82f88c53ddb84e42c770c23feb9bb0ee18341188 diff --git a/base/hook.c b/base/hook.c index 9243724..0cb2f9d 100644 --- a/base/hook.c +++ b/base/hook.c @@ -1,4 +1,21 @@ /* + * 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, write to the Free Software + * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA + * 02110-1301, USA. */ #include "chiark-tcl-base.h" @@ -36,11 +53,15 @@ void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...) { va_list al; char *p; const char *part; - int l, pl; + int l; + size_t pl; va_start(al,o); - for (l=0; (part= va_arg(al, const char*)); ) - l+= va_arg(al, int); + for (l=0; (part= va_arg(al, const char*)); ) { + pl= va_arg(al, size_t); + assert(pl <= INT_MAX/2 - l); + l += pl; + } va_end(al); o->length= l; @@ -48,7 +69,7 @@ void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...) { va_start(al,o); for (p= o->bytes; (part= va_arg(al, const char*)); p += pl) { - pl= va_arg(al, int); + pl= va_arg(al, size_t); memcpy(p, part, pl); } va_end(al); @@ -85,34 +106,21 @@ int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l) { } } -int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds, - int *donep /* or 0, meaning no types follow */, - ... /* types, terminated by 0 */) { - static int cht_initd; - - const TopLevel_Command *cmd; - Tcl_ObjType *ot; - - va_list al; - - if (!cht_initd) { - cht_initd= 1; - Tcl_RegisterObjType(&cht_tabledataid_nearlytype); - Tcl_RegisterObjType(&cht_enum_nearlytype); - Tcl_RegisterObjType(&cht_enum1_nearlytype); - } +void cht_prepare__basic(Tcl_Interp *ip) { + static int prepared; - if (donep && !*donep) { - *donep= 1; - va_start(al, donep); - while ((ot= va_arg(al, Tcl_ObjType*))) - Tcl_RegisterObjType(ot); - } + if (prepared) return; + Tcl_RegisterObjType(&cht_tabledataid_nearlytype); + Tcl_RegisterObjType(&cht_enum_nearlytype); + Tcl_RegisterObjType(&cht_enum1_nearlytype); + prepared= 1; +} +void cht_setup__commands(Tcl_Interp *ip, const TopLevel_Command *cmds) { + const TopLevel_Command *cmd; + for (cmd= cmds; cmd->name; cmd++) Tcl_CreateObjCommand(ip, (char*)cmd->name, cmd->func, 0,0); - - return TCL_OK; }