Index: xotcl/ChangeLog =================================================================== diff -u -rae1eaf81cb417f648c39d1de1152d15fbdf2d36e -r308ae099d8de5e6aee3e2baa61b8585c22660087 --- xotcl/ChangeLog (.../ChangeLog) (revision ae1eaf81cb417f648c39d1de1152d15fbdf2d36e) +++ xotcl/ChangeLog (.../ChangeLog) (revision 308ae099d8de5e6aee3e2baa61b8585c22660087) @@ -1,3 +1,9 @@ +2004-07-29 Gustaf.Neumann@wu-wien.ac.at + * changes to forward and instforward: + + %some-command executes some-command at invocation time and + substitutes result + + substitution extended to all arguments (also on callee) + 2004-07-28 Gustaf.Neumann@wu-wien.ac.at * yet another fixed access to freed memory (thanks to Zoran for his help with Purify ) Index: xotcl/Makefile =================================================================== diff -u -r225b8b992e16760eca2a7fa7bf51533499c7cc84 -r308ae099d8de5e6aee3e2baa61b8585c22660087 --- xotcl/Makefile (.../Makefile) (revision 225b8b992e16760eca2a7fa7bf51533499c7cc84) +++ xotcl/Makefile (.../Makefile) (revision 308ae099d8de5e6aee3e2baa61b8585c22660087) @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: Makefile,v 1.12 2004/07/20 12:57:59 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.13 2004/07/30 09:21:36 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that @@ -29,7 +29,7 @@ src_generic_dir = ${srcdir}/generic PLATFORM_DIR = $(srcdir)/unix TCL_LIB_SPEC = -L/home/neumann/tcl8.4.5/unix -ltcl8.4 -TK_LIB_SPEC = -L/usr/lib -ltk8.3 +TK_LIB_SPEC = -L/usr/lib -ltk8.4 subdirs = library/store/XOTclSdbm/ library/store/XOTclGdbm/ library/xml/TclExpat-1.1/ libdirs = comm lib serialize actiweb rdf registry store xml patterns @@ -118,7 +118,7 @@ PACKAGE_NAME = xotcl PACKAGE_VERSION = 1.2.1 CC = gcc -pipe -CFLAGS_DEFAULT = -O -g +CFLAGS_DEFAULT = -O CFLAGS_WARNING = -Wall -Wconversion -Wno-implicit-int CLEANFILES = *.o *.a *.so *~ core gmon.out config.* EXEEXT = @@ -133,7 +133,7 @@ SHLIB_CFLAGS = -fPIC SHLIB_LD = gcc -pipe -shared SHLIB_LD_FLAGS = -SHLIB_LD_LIBS = ${LIBS} -L/home/neumann/tcl8.4.5/unix -ltclstub8.4 -L/usr/lib -ltkstub8.3 +SHLIB_LD_LIBS = ${LIBS} -L/home/neumann/tcl8.4.5/unix -ltclstub8.4 -L/usr/lib -ltkstub8.4 STLIB_LD = ${AR} cr TCL_DEFS = -DHAVE_UNISTD_H=1 -DHAVE_LIMITS_H=1 -DTCL_THREADS=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_READDIR_R=1 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_TYPE=long\ long -DHAVE_STRUCT_STAT64=1 -DHAVE_TYPE_OFF64_T=1 -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1 -DHAVE_STRTOLL=1 -DHAVE_STRTOULL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DPEEK_XCLOSEIM=1 -DHAVE_SYS_IOCTL_H=1 TCL_BIN_DIR = /home/neumann/tcl8.4.5/unix Index: xotcl/generic/xotcl.c =================================================================== diff -u -rc9a2791779e55d0c6737e69256d0f71888bf9415 -r308ae099d8de5e6aee3e2baa61b8585c22660087 --- xotcl/generic/xotcl.c (.../xotcl.c) (revision c9a2791779e55d0c6737e69256d0f71888bf9415) +++ xotcl/generic/xotcl.c (.../xotcl.c) (revision 308ae099d8de5e6aee3e2baa61b8585c22660087) @@ -1,4 +1,4 @@ -/* $Id: xotcl.c,v 1.17 2004/07/28 08:18:47 neumann Exp $ +/* $Id: xotcl.c,v 1.18 2004/07/30 09:21:36 neumann Exp $ * * XOTcl - Extended OTcl * @@ -7375,7 +7375,58 @@ #endif static int -XOTclForwardMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj * CONST objv[]) { +forwardArg(Tcl_Interp *in, int objc, Tcl_Obj *o, forwardCmdClientData *tcd, + Tcl_Obj *CONST objv[], Tcl_Obj **out, Tcl_Obj **freeList, int *inputarg) { + char *element = ObjStr(o); + if (*element == '%') { + char c = *(++element); + if (c == 's' && !strcmp(element,"self")) { + *out = tcd->obj->cmdName; + } else if (c == 'p' && !strcmp(element,"proc")) { + *out = objv[0]; + } else if (c == '1' && (*(element+1) == '\0')) { + int nrargs = objc-1; + /*fprintf(stderr, " nrargs=%d, subcommands=%d inputarg=%d, objc=%d\n", + nrargs, tcd->nr_subcommands, inputarg, objc);*/ + if (tcd->nr_subcommands > nrargs) { + /* insert default subcommand depending on number of arguments */ + int rc = Tcl_ListObjIndex(in, tcd->subcommands, nrargs, out); + if (rc != TCL_OK) + return rc; + } else if (objc<=1) { + return XOTclObjErrArgCnt(in, objv[0], "no argument given"); + } else { + *out = objv[1]; + *inputarg = 2; + } + } else if (c == '%') { + Tcl_Obj *newarg = Tcl_NewStringObj(element,-1); + *out = newarg; + goto add_to_freelist; + } else { + int result; + /*fprintf(stderr,"evaluating '%s'\n",element);*/ + if ((result = Tcl_Eval(in, element)) != TCL_OK) + return result; + *out = Tcl_DuplicateObj(Tcl_GetObjResult(in)); + /*fprintf(stderr,"result = '%s'\n",ObjStr(*out));*/ + goto add_to_freelist; + } + } else { + *out = o; + } + return TCL_OK; + add_to_freelist: + if (!*freeList) { + *freeList = Tcl_NewListObj(1, out); + INCR_REF_COUNT(*freeList); + } else + Tcl_ListObjAppendElement(in, *freeList, *out); + return TCL_OK; +} + +static int +XOTclForwardMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) { forwardCmdClientData *tcd = (forwardCmdClientData *)cd; XOTcl_FrameDecls; int result, j, inputarg=1, outputarg=0; @@ -7404,55 +7455,25 @@ #endif /* the first argument is always the command, to which we forward */ - ov[outputarg++] = tcd->cmdName; + if ((result = forwardArg(in, objc, tcd->cmdName, tcd, objv, + &ov[outputarg++], &freeList, &inputarg)) != TCL_OK) { + if (freeList) {DECR_REF_COUNT(freeList);} + return result; + } + if (tcd->args) { /* copy argument list from definition */ Tcl_Obj **listElements; int nrElements; Tcl_ListObjGetElements(in, tcd->args, &nrElements, &listElements); for (j=0; jobj->cmdName; - continue; - } else if (c == 'p' && !strcmp(element,"%proc")) { - ov[outputarg++] = objv[0]; - continue; - } else if (c == '1' && (*(element+2) == '\0')) { - int nrargs = objc-1; - /*fprintf(stderr, " nrargs=%d, subcommands=%d inputarg=%d, objc=%d\n", - nrargs, tcd->nr_subcommands, inputarg, objc);*/ - if (tcd->nr_subcommands > nrargs) { - /* insert default subcommand depending on number of arguments */ - int rc = Tcl_ListObjIndex(in, tcd->subcommands, nrargs, &ov[outputarg]); - if (rc != TCL_OK) - return rc; - outputarg++; - } else if (objc<=1) { - if (freeList) {DECR_REF_COUNT(freeList);} - return XOTclObjErrArgCnt(in, objv[0], "no argument given"); - } else { - ov[outputarg++] = objv[1]; - inputarg = 2; - } - continue; - } else if (c == '%') { - Tcl_Obj *newarg = Tcl_NewStringObj(element+1,-1); - if (!freeList) { - freeList = Tcl_NewListObj(1, &newarg); - INCR_REF_COUNT(freeList); - } else { - Tcl_ListObjAppendElement(in, freeList, newarg); - } - ov[outputarg++] = newarg; - continue; - } + if ((result = forwardArg(in, objc, listElements[j], tcd, objv, + &ov[outputarg++], &freeList, &inputarg))!= TCL_OK) { + if (freeList) {DECR_REF_COUNT(freeList);} + return result; } - ov[outputarg++] = listElements[j]; } } /* Index: xotcl/library/store/XOTclGdbm/Makefile =================================================================== diff -u -r0fb94b7893b3423b536af13fa081e7190e0ec0a2 -r308ae099d8de5e6aee3e2baa61b8585c22660087 --- xotcl/library/store/XOTclGdbm/Makefile (.../Makefile) (revision 0fb94b7893b3423b536af13fa081e7190e0ec0a2) +++ xotcl/library/store/XOTclGdbm/Makefile (.../Makefile) (revision 308ae099d8de5e6aee3e2baa61b8585c22660087) @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: Makefile,v 1.11 2004/07/18 09:49:03 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.12 2004/07/30 09:21:36 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that @@ -109,11 +109,11 @@ SHLIB_CFLAGS = -fPIC SHLIB_LD = gcc -pipe -shared SHLIB_LD_FLAGS = -SHLIB_LD_LIBS = ${LIBS} -L/usr/lib -ltclstub8.3 +SHLIB_LD_LIBS = ${LIBS} -L/usr/lib -ltclstub8.4 STLIB_LD = ${AR} cr -TCL_DEFS = -DHAVE_UNISTD_H=1 -DHAVE_LIMITS_H=1 -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1 -DNEED_MATHERR=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_SYS_IOCTL_H=1 +TCL_DEFS = -DHAVE_UNISTD_H=1 -DHAVE_LIMITS_H=1 -DTCL_THREADS=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_READDIR_R=1 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_TYPE=long\ long -DHAVE_STRUCT_STAT64=1 -DHAVE_TYPE_OFF64_T=1 -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1 -DHAVE_STRTOLL=1 -DHAVE_STRTOULL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DPEEK_XCLOSEIM=1 -DHAVE_SYS_IOCTL_H=1 TCL_BIN_DIR = /usr/lib -TCL_SRC_DIR = /usr/src/build/420553-i386/BUILD/tcltk-8.3.5/tcl8.3.5 +TCL_SRC_DIR = /home/neumann/tcl8.4.5 # This is necessary for packages that use private Tcl headers #TCL_TOP_DIR_NATIVE = @TCL_TOP_DIR_NATIVE@ # Not used, but retained for reference of what libs Tcl required Index: xotcl/library/store/XOTclSdbm/Makefile =================================================================== diff -u -r0fb94b7893b3423b536af13fa081e7190e0ec0a2 -r308ae099d8de5e6aee3e2baa61b8585c22660087 --- xotcl/library/store/XOTclSdbm/Makefile (.../Makefile) (revision 0fb94b7893b3423b536af13fa081e7190e0ec0a2) +++ xotcl/library/store/XOTclSdbm/Makefile (.../Makefile) (revision 308ae099d8de5e6aee3e2baa61b8585c22660087) @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: Makefile,v 1.11 2004/07/18 09:49:03 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.12 2004/07/30 09:21:36 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that @@ -109,11 +109,11 @@ SHLIB_CFLAGS = -fPIC SHLIB_LD = gcc -pipe -shared SHLIB_LD_FLAGS = -SHLIB_LD_LIBS = ${LIBS} -L/usr/lib -ltclstub8.3 +SHLIB_LD_LIBS = ${LIBS} -L/usr/lib -ltclstub8.4 STLIB_LD = ${AR} cr -TCL_DEFS = -DHAVE_UNISTD_H=1 -DHAVE_LIMITS_H=1 -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1 -DNEED_MATHERR=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_SYS_IOCTL_H=1 +TCL_DEFS = -DHAVE_UNISTD_H=1 -DHAVE_LIMITS_H=1 -DTCL_THREADS=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_READDIR_R=1 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_TYPE=long\ long -DHAVE_STRUCT_STAT64=1 -DHAVE_TYPE_OFF64_T=1 -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1 -DHAVE_STRTOLL=1 -DHAVE_STRTOULL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DPEEK_XCLOSEIM=1 -DHAVE_SYS_IOCTL_H=1 TCL_BIN_DIR = /usr/lib -TCL_SRC_DIR = /usr/src/build/420553-i386/BUILD/tcltk-8.3.5/tcl8.3.5 +TCL_SRC_DIR = /home/neumann/tcl8.4.5 # This is necessary for packages that use private Tcl headers #TCL_TOP_DIR_NATIVE = @TCL_TOP_DIR_NATIVE@ # Not used, but retained for reference of what libs Tcl required Index: xotcl/library/xml/TclExpat-1.1/Makefile =================================================================== diff -u -r0fb94b7893b3423b536af13fa081e7190e0ec0a2 -r308ae099d8de5e6aee3e2baa61b8585c22660087 --- xotcl/library/xml/TclExpat-1.1/Makefile (.../Makefile) (revision 0fb94b7893b3423b536af13fa081e7190e0ec0a2) +++ xotcl/library/xml/TclExpat-1.1/Makefile (.../Makefile) (revision 308ae099d8de5e6aee3e2baa61b8585c22660087) @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: Makefile,v 1.11 2004/07/18 09:49:03 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.12 2004/07/30 09:21:36 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that @@ -109,11 +109,11 @@ SHLIB_CFLAGS = -fPIC SHLIB_LD = gcc -pipe -shared SHLIB_LD_FLAGS = -SHLIB_LD_LIBS = ${LIBS} -L/usr/lib -ltclstub8.3 +SHLIB_LD_LIBS = ${LIBS} -L/usr/lib -ltclstub8.4 STLIB_LD = ${AR} cr -TCL_DEFS = -DHAVE_UNISTD_H=1 -DHAVE_LIMITS_H=1 -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1 -DNEED_MATHERR=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_SYS_IOCTL_H=1 +TCL_DEFS = -DHAVE_UNISTD_H=1 -DHAVE_LIMITS_H=1 -DTCL_THREADS=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_READDIR_R=1 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_TYPE=long\ long -DHAVE_STRUCT_STAT64=1 -DHAVE_TYPE_OFF64_T=1 -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1 -DHAVE_STRTOLL=1 -DHAVE_STRTOULL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DPEEK_XCLOSEIM=1 -DHAVE_SYS_IOCTL_H=1 TCL_BIN_DIR = /usr/lib -TCL_SRC_DIR = /usr/src/build/420553-i386/BUILD/tcltk-8.3.5/tcl8.3.5 +TCL_SRC_DIR = /home/neumann/tcl8.4.5 # This is necessary for packages that use private Tcl headers #TCL_TOP_DIR_NATIVE = @TCL_TOP_DIR_NATIVE@ # Not used, but retained for reference of what libs Tcl required