diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/Makefile ./canvas-tcl8.2.2/Makefile --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/Makefile Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/Makefile Thu Dec 30 14:54:17 1999 @@ -0,0 +1,53 @@ +LIBCANVAS = libcanvas.a +TARGET = $(LIBCANVAS) +TCLSOURCES = +OBJECTS = tkCanvArc.o tkCanvLine.o tkCanvText.o tkCanvas.o \ + tkCanvBmap.o tkCanvPoly.o tkCanvUtil.o \ + tkCanvImg.o tkCanvPs.o tkCanvWind.o tkEvent.o \ + tkRectOval.o +CCSOURCES = +INCLUDES = tkCanvas.h tkInt.h tkPort.h +CSOURCES = tkCanvArc.c tkCanvLine.c tkCanvText.c tkCanvas.c \ + tkCanvBmap.c tkCanvPoly.c tkCanvUtil.c \ + tkCanvImg.c tkCanvPs.c tkCanvWind.c tkEvent.c \ + tkRectOval.c +SOURCES = $(CSOURCES) $(OTHERSOURCES) +XXL_LIBS = $(LIBDIR)/libcalc.a $(LIBDIR)/libio.a +LIBS = -ltk8.0 -ltcl8.0 -lX11 -ldl -lm + +include ../Makefile.options + +$(TARGET) : $(OBJECTS) + ar $(AROPTIONS) $(LIBCANVAS) $(OBJECTS) + ranlib $(LIBCANVAS) + +clean: + rm -f *.o nxlc *~ .depend $(LIBCANVAS) + +depend dep: + $(CPP) -M $(CCFLAGS) $(IFLAGS) $(CCSOURCES) $(CSOURCES) > .depend + +.cc.o: + $(CCC) $(CCFLAGS) $(IFLAGS) -c $< + +.c.o: + $(CC) $(CCFLAGS) $(IFLAGS) -c $< + +tkEvent.o: tkEvent.c + $(CC) $(IFLAGS) $(CCFLAGS) -DTK_FILE_READ_PTR=1 -c tkEvent.c + +scan.c: scan.l + $(LEX) -i -t scan.l > scan.c + +gram.o: gram.c + $(CCC) $(IFLAGS) -g -x c++ gram.c -o gram.o -c + +gram.c: gram.y scan.c + $(YACC) -d gram.y -o gram.c + +# +# include a dependency file if one exists +# +ifeq (.depend,$(wildcard .depend)) +include .depend +endif diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/dirent.h ./canvas-tcl8.2.2/compat/dirent.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/dirent.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/compat/dirent.h Thu Dec 30 14:55:23 1999 @@ -0,0 +1,23 @@ +/* + * dirent.h -- + * + * This file is a replacement for in systems that + * support the old BSD-style with a "struct direct". + * + * Copyright (c) 1991 The Regents of the University of California. + * Copyright (c) 1994 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: dirent.h,v 1.2 1998/09/14 18:39:44 stanton Exp $ + */ + +#ifndef _DIRENT +#define _DIRENT + +#include + +#define dirent direct + +#endif /* _DIRENT */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/dirent2.h ./canvas-tcl8.2.2/compat/dirent2.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/dirent2.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/compat/dirent2.h Thu Dec 30 14:55:27 1999 @@ -0,0 +1,59 @@ +/* + * dirent.h -- + * + * Declarations of a library of directory-reading procedures + * in the POSIX style ("struct dirent"). + * + * Copyright (c) 1991 The Regents of the University of California. + * Copyright (c) 1994 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: dirent2.h,v 1.2 1998/09/14 18:39:44 stanton Exp $ + */ + +#ifndef _DIRENT +#define _DIRENT + +#ifndef _TCL +#include +#endif + +/* + * Dirent structure, which holds information about a single + * directory entry. + */ + +#define MAXNAMLEN 255 +#define DIRBLKSIZ 512 + +struct dirent { + long d_ino; /* Inode number of entry */ + short d_reclen; /* Length of this record */ + short d_namlen; /* Length of string in d_name */ + char d_name[MAXNAMLEN + 1]; /* Name must be no longer than this */ +}; + +/* + * State that keeps track of the reading of a directory (clients + * should never look inside this structure; the fields should + * only be accessed by the library procedures). + */ + +typedef struct _dirdesc { + int dd_fd; + long dd_loc; + long dd_size; + char dd_buf[DIRBLKSIZ]; +} DIR; + +/* + * Procedures defined for reading directories: + */ + +extern void closedir _ANSI_ARGS_((DIR *dirp)); +extern DIR * opendir _ANSI_ARGS_((char *name)); +extern struct dirent * readdir _ANSI_ARGS_((DIR *dirp)); + +#endif /* _DIRENT */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/float.h ./canvas-tcl8.2.2/compat/float.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/float.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/compat/float.h Thu Dec 30 14:55:36 1999 @@ -0,0 +1,16 @@ +/* + * float.h -- + * + * This is a dummy header file to #include in Tcl when there + * is no float.h in /usr/include. Right now this file is empty: + * Tcl contains #ifdefs to deal with the lack of definitions; + * all it needs is for the #include statement to work. + * + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: float.h,v 1.2 1998/09/14 18:39:44 stanton Exp $ + */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/stdlib.h ./canvas-tcl8.2.2/compat/stdlib.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/stdlib.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/compat/stdlib.h Thu Dec 30 14:55:42 1999 @@ -0,0 +1,45 @@ +/* + * stdlib.h -- + * + * Declares facilities exported by the "stdlib" portion of + * the C library. This file isn't complete in the ANSI-C + * sense; it only declares things that are needed by Tcl. + * This file is needed even on many systems with their own + * stdlib.h (e.g. SunOS) because not all stdlib.h files + * declare all the procedures needed here (such as strtod). + * + * Copyright (c) 1991 The Regents of the University of California. + * Copyright (c) 1994-1998 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: stdlib.h,v 1.3 1999/04/16 00:46:30 stanton Exp $ + */ + +#ifndef _STDLIB +#define _STDLIB + +#include + +extern void abort _ANSI_ARGS_((void)); +extern double atof _ANSI_ARGS_((CONST char *string)); +extern int atoi _ANSI_ARGS_((CONST char *string)); +extern long atol _ANSI_ARGS_((CONST char *string)); +extern char * calloc _ANSI_ARGS_((unsigned int numElements, + unsigned int size)); +extern void exit _ANSI_ARGS_((int status)); +extern int free _ANSI_ARGS_((char *blockPtr)); +extern char * getenv _ANSI_ARGS_((CONST char *name)); +extern char * malloc _ANSI_ARGS_((unsigned int numBytes)); +extern void qsort _ANSI_ARGS_((VOID *base, int n, int size, + int (*compar)(CONST VOID *element1, CONST VOID + *element2))); +extern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes)); +extern double strtod _ANSI_ARGS_((CONST char *string, char **endPtr)); +extern long strtol _ANSI_ARGS_((CONST char *string, char **endPtr, + int base)); +extern unsigned long strtoul _ANSI_ARGS_((CONST char *string, + char **endPtr, int base)); + +#endif /* _STDLIB */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/string.h ./canvas-tcl8.2.2/compat/string.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/string.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/compat/string.h Thu Dec 30 14:59:40 1999 @@ -0,0 +1,68 @@ +/* + * string.h -- + * + * Declarations of ANSI C library procedures for string handling. + * + * Copyright (c) 1991-1993 The Regents of the University of California. + * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: string.h,v 1.3 1999/04/16 00:46:30 stanton Exp $ + */ + +#ifndef _STRING +#define _STRING + +#include + +/* + * The following #include is needed to define size_t. (This used to + * include sys/stdtypes.h but that doesn't exist on older versions + * of SunOS, e.g. 4.0.2, so I'm trying sys/types.h now.... hopefully + * it exists everywhere) + */ + +#include + +extern char * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n)); +extern int memcmp _ANSI_ARGS_((CONST VOID *s1, CONST VOID *s2, + size_t n)); +extern char * memcpy _ANSI_ARGS_((VOID *t, CONST VOID *f, size_t n)); +#ifdef NO_MEMMOVE +#define memmove(d, s, n) bcopy ((s), (d), (n)) +#else +extern char * memmove _ANSI_ARGS_((VOID *t, CONST VOID *f, + size_t n)); +#endif +extern char * memset _ANSI_ARGS_((VOID *s, int c, size_t n)); + +extern int strcasecmp _ANSI_ARGS_((CONST char *s1, + CONST char *s2)); +extern char * strcat _ANSI_ARGS_((char *dst, CONST char *src)); +extern char * strchr _ANSI_ARGS_((CONST char *string, int c)); +extern int strcmp _ANSI_ARGS_((CONST char *s1, CONST char *s2)); +extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src)); +extern size_t strcspn _ANSI_ARGS_((CONST char *string, + CONST char *chars)); +extern char * strdup _ANSI_ARGS_((CONST char *string)); +extern char * strerror _ANSI_ARGS_((int error)); +extern size_t strlen _ANSI_ARGS_((CONST char *string)); +extern int strncasecmp _ANSI_ARGS_((CONST char *s1, + CONST char *s2, size_t n)); +extern char * strncat _ANSI_ARGS_((char *dst, CONST char *src, + size_t numChars)); +extern int strncmp _ANSI_ARGS_((CONST char *s1, CONST char *s2, + size_t nChars)); +extern char * strncpy _ANSI_ARGS_((char *dst, CONST char *src, + size_t numChars)); +extern char * strpbrk _ANSI_ARGS_((CONST char *string, char *chars)); +extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); +extern size_t strspn _ANSI_ARGS_((CONST char *string, + CONST char *chars)); +extern char * strstr _ANSI_ARGS_((CONST char *string, + CONST char *substring)); +extern char * strtok _ANSI_ARGS_((CONST char *s, CONST char *delim)); + +#endif /* _STRING */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/unistd.h ./canvas-tcl8.2.2/compat/unistd.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/compat/unistd.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/compat/unistd.h Thu Dec 30 14:59:40 1999 @@ -0,0 +1,83 @@ +/* + * unistd.h -- + * + * Macros, CONSTants and prototypes for Posix conformance. + * + * Copyright 1989 Regents of the University of California + * Permission to use, copy, modify, and distribute this + * software and its documentation for any purpose and without + * fee is hereby granted, provided that the above copyright + * notice appear in all copies. The University of California + * makes no representations about the suitability of this + * software for any purpose. It is provided "as is" without + * express or implied warranty. + * + * RCS: @(#) $Id: unistd.h,v 1.2 1998/09/14 18:39:45 stanton Exp $ + */ + +#ifndef _UNISTD +#define _UNISTD + +#include +#ifndef _TCL +# include "tcl.h" +#endif + +#ifndef NULL +#define NULL 0 +#endif + +/* + * Strict POSIX stuff goes here. Extensions go down below, in the + * ifndef _POSIX_SOURCE section. + */ + +extern void _exit _ANSI_ARGS_((int status)); +extern int access _ANSI_ARGS_((CONST char *path, int mode)); +extern int chdir _ANSI_ARGS_((CONST char *path)); +extern int chown _ANSI_ARGS_((CONST char *path, uid_t owner, gid_t group)); +extern int close _ANSI_ARGS_((int fd)); +extern int dup _ANSI_ARGS_((int oldfd)); +extern int dup2 _ANSI_ARGS_((int oldfd, int newfd)); +extern int execl _ANSI_ARGS_((CONST char *path, ...)); +extern int execle _ANSI_ARGS_((CONST char *path, ...)); +extern int execlp _ANSI_ARGS_((CONST char *file, ...)); +extern int execv _ANSI_ARGS_((CONST char *path, char **argv)); +extern int execve _ANSI_ARGS_((CONST char *path, char **argv, char **envp)); +extern int execvp _ANSI_ARGS_((CONST char *file, char **argv)); +extern pid_t fork _ANSI_ARGS_((void)); +extern char *getcwd _ANSI_ARGS_((char *buf, size_t size)); +extern gid_t getegid _ANSI_ARGS_((void)); +extern uid_t geteuid _ANSI_ARGS_((void)); +extern gid_t getgid _ANSI_ARGS_((void)); +extern int getgroups _ANSI_ARGS_((int bufSize, int *buffer)); +extern pid_t getpid _ANSI_ARGS_((void)); +extern uid_t getuid _ANSI_ARGS_((void)); +extern int isatty _ANSI_ARGS_((int fd)); +extern long lseek _ANSI_ARGS_((int fd, long offset, int whence)); +extern int pipe _ANSI_ARGS_((int *fildes)); +extern int read _ANSI_ARGS_((int fd, char *buf, size_t size)); +extern int setgid _ANSI_ARGS_((gid_t group)); +extern int setuid _ANSI_ARGS_((uid_t user)); +extern unsigned sleep _ANSI_ARGS_ ((unsigned seconds)); +extern char *ttyname _ANSI_ARGS_((int fd)); +extern int unlink _ANSI_ARGS_((CONST char *path)); +extern int write _ANSI_ARGS_((int fd, CONST char *buf, size_t size)); + +#ifndef _POSIX_SOURCE +extern char *crypt _ANSI_ARGS_((CONST char *, CONST char *)); +extern int fchown _ANSI_ARGS_((int fd, uid_t owner, gid_t group)); +extern int flock _ANSI_ARGS_((int fd, int operation)); +extern int ftruncate _ANSI_ARGS_((int fd, unsigned long length)); +extern int readlink _ANSI_ARGS_((CONST char *path, char *buf, int bufsize)); +extern int setegid _ANSI_ARGS_((gid_t group)); +extern int seteuid _ANSI_ARGS_((uid_t user)); +extern int setreuid _ANSI_ARGS_((int ruid, int euid)); +extern int symlink _ANSI_ARGS_((CONST char *, CONST char *)); +extern int ttyslot _ANSI_ARGS_((void)); +extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length)); +extern int vfork _ANSI_ARGS_((void)); +#endif /* _POSIX_SOURCE */ + +#endif /* _UNISTD */ + diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/default.h ./canvas-tcl8.2.2/default.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/default.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/default.h Thu Dec 30 15:14:31 1999 @@ -0,0 +1,29 @@ +/* + * default.h -- + * + * This file defines the defaults for all options for all of + * the Tk widgets. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: default.h,v 1.2 1998/09/14 18:23:02 stanton Exp $ + */ + +#ifndef _DEFAULT +#define _DEFAULT + +#if defined(__WIN32__) || defined(_WIN32) +# include "tkWinDefault.h" +#else +# if defined(MAC_TCL) +# include "tkMacDefault.h" +# else +# include "tkUnixDefault.h" +# endif +#endif + +#endif /* _DEFAULT */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/exp.cc ./canvas-tcl8.2.2/exp.cc --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/exp.cc Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/exp.cc Thu Dec 30 14:54:22 1999 @@ -0,0 +1,20 @@ +/* + * tkCanvas.c -- + * + * This module implements canvas widgets for the Tk toolkit. + * A canvas displays a background and a collection of graphical + * objects such as rectangles, lines, and texts. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +static char sccsid[] = "@(#) tkCanvas.c 1.98 95/06/20 14:26:12"; + +#include "canvas.hh" + + + diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tclBasic.c ./canvas-tcl8.2.2/tclBasic.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tclBasic.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tclBasic.c Thu Dec 30 14:56:54 1999 @@ -0,0 +1,4219 @@ +/* + * tclBasic.c -- + * + * Contains the basic facilities for TCL command interpretation, + * including interpreter creation and deletion, command creation + * and deletion, and command parsing and execution. + * + * Copyright (c) 1987-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclBasic.c,v 1.21 1999/05/14 23:16:54 surles Exp $ + */ + +#include "tclInt.h" +#include "tclCompile.h" +#ifndef TCL_GENERIC_ONLY +# include "tclPort.h" +#endif + +/* + * Static procedures in this file: + */ + +static void DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp)); +static void ProcessUnexpectedResult _ANSI_ARGS_(( + Tcl_Interp *interp, int returnCode)); +static void RecordTracebackInfo _ANSI_ARGS_(( + Tcl_Interp *interp, Tcl_Obj *objPtr, + int numSrcBytes)); + +extern TclStubs tclStubs; + +/* + * The following structure defines the commands in the Tcl core. + */ + +typedef struct { + char *name; /* Name of object-based command. */ + Tcl_CmdProc *proc; /* String-based procedure for command. */ + Tcl_ObjCmdProc *objProc; /* Object-based procedure for command. */ + CompileProc *compileProc; /* Procedure called to compile command. */ + int isSafe; /* If non-zero, command will be present + * in safe interpreter. Otherwise it will + * be hidden. */ +} CmdInfo; + +/* + * The built-in commands, and the procedures that implement them: + */ + +static CmdInfo builtInCmds[] = { + /* + * Commands in the generic core. Note that at least one of the proc or + * objProc members should be non-NULL. This avoids infinitely recursive + * calls between TclInvokeObjectCommand and TclInvokeStringCommand if a + * command name is computed at runtime and results in the name of a + * compiled command. + */ + + {"append", (Tcl_CmdProc *) NULL, Tcl_AppendObjCmd, + (CompileProc *) NULL, 1}, + {"array", (Tcl_CmdProc *) NULL, Tcl_ArrayObjCmd, + (CompileProc *) NULL, 1}, + {"binary", (Tcl_CmdProc *) NULL, Tcl_BinaryObjCmd, + (CompileProc *) NULL, 1}, + {"break", (Tcl_CmdProc *) NULL, Tcl_BreakObjCmd, + TclCompileBreakCmd, 1}, + {"case", (Tcl_CmdProc *) NULL, Tcl_CaseObjCmd, + (CompileProc *) NULL, 1}, + {"catch", (Tcl_CmdProc *) NULL, Tcl_CatchObjCmd, + TclCompileCatchCmd, 1}, + {"clock", (Tcl_CmdProc *) NULL, Tcl_ClockObjCmd, + (CompileProc *) NULL, 1}, + {"concat", (Tcl_CmdProc *) NULL, Tcl_ConcatObjCmd, + (CompileProc *) NULL, 1}, + {"continue", (Tcl_CmdProc *) NULL, Tcl_ContinueObjCmd, + TclCompileContinueCmd, 1}, + {"encoding", (Tcl_CmdProc *) NULL, Tcl_EncodingObjCmd, + (CompileProc *) NULL, 0}, + {"error", (Tcl_CmdProc *) NULL, Tcl_ErrorObjCmd, + (CompileProc *) NULL, 1}, + {"eval", (Tcl_CmdProc *) NULL, Tcl_EvalObjCmd, + (CompileProc *) NULL, 1}, + {"exit", (Tcl_CmdProc *) NULL, Tcl_ExitObjCmd, + (CompileProc *) NULL, 0}, + {"expr", (Tcl_CmdProc *) NULL, Tcl_ExprObjCmd, + TclCompileExprCmd, 1}, + {"fcopy", (Tcl_CmdProc *) NULL, Tcl_FcopyObjCmd, + (CompileProc *) NULL, 1}, + {"fileevent", (Tcl_CmdProc *) NULL, Tcl_FileEventObjCmd, + (CompileProc *) NULL, 1}, + {"for", (Tcl_CmdProc *) NULL, Tcl_ForObjCmd, + TclCompileForCmd, 1}, + {"foreach", (Tcl_CmdProc *) NULL, Tcl_ForeachObjCmd, + TclCompileForeachCmd, 1}, + {"format", (Tcl_CmdProc *) NULL, Tcl_FormatObjCmd, + (CompileProc *) NULL, 1}, + {"global", (Tcl_CmdProc *) NULL, Tcl_GlobalObjCmd, + (CompileProc *) NULL, 1}, + {"if", (Tcl_CmdProc *) NULL, Tcl_IfObjCmd, + TclCompileIfCmd, 1}, + {"incr", (Tcl_CmdProc *) NULL, Tcl_IncrObjCmd, + TclCompileIncrCmd, 1}, + {"info", (Tcl_CmdProc *) NULL, Tcl_InfoObjCmd, + (CompileProc *) NULL, 1}, + {"join", (Tcl_CmdProc *) NULL, Tcl_JoinObjCmd, + (CompileProc *) NULL, 1}, + {"lappend", (Tcl_CmdProc *) NULL, Tcl_LappendObjCmd, + (CompileProc *) NULL, 1}, + {"lindex", (Tcl_CmdProc *) NULL, Tcl_LindexObjCmd, + (CompileProc *) NULL, 1}, + {"linsert", (Tcl_CmdProc *) NULL, Tcl_LinsertObjCmd, + (CompileProc *) NULL, 1}, + {"list", (Tcl_CmdProc *) NULL, Tcl_ListObjCmd, + (CompileProc *) NULL, 1}, + {"llength", (Tcl_CmdProc *) NULL, Tcl_LlengthObjCmd, + (CompileProc *) NULL, 1}, + {"load", (Tcl_CmdProc *) NULL, Tcl_LoadObjCmd, + (CompileProc *) NULL, 0}, + {"lrange", (Tcl_CmdProc *) NULL, Tcl_LrangeObjCmd, + (CompileProc *) NULL, 1}, + {"lreplace", (Tcl_CmdProc *) NULL, Tcl_LreplaceObjCmd, + (CompileProc *) NULL, 1}, + {"lsearch", (Tcl_CmdProc *) NULL, Tcl_LsearchObjCmd, + (CompileProc *) NULL, 1}, + {"lsort", (Tcl_CmdProc *) NULL, Tcl_LsortObjCmd, + (CompileProc *) NULL, 1}, + {"namespace", (Tcl_CmdProc *) NULL, Tcl_NamespaceObjCmd, + (CompileProc *) NULL, 1}, + {"package", (Tcl_CmdProc *) NULL, Tcl_PackageObjCmd, + (CompileProc *) NULL, 1}, + {"proc", (Tcl_CmdProc *) NULL, Tcl_ProcObjCmd, + (CompileProc *) NULL, 1}, + {"regexp", (Tcl_CmdProc *) NULL, Tcl_RegexpObjCmd, + (CompileProc *) NULL, 1}, + {"regsub", (Tcl_CmdProc *) NULL, Tcl_RegsubObjCmd, + (CompileProc *) NULL, 1}, + {"rename", (Tcl_CmdProc *) NULL, Tcl_RenameObjCmd, + (CompileProc *) NULL, 1}, + {"return", (Tcl_CmdProc *) NULL, Tcl_ReturnObjCmd, + (CompileProc *) NULL, 1}, + {"scan", (Tcl_CmdProc *) NULL, Tcl_ScanObjCmd, + (CompileProc *) NULL, 1}, + {"set", (Tcl_CmdProc *) NULL, Tcl_SetObjCmd, + TclCompileSetCmd, 1}, + {"split", (Tcl_CmdProc *) NULL, Tcl_SplitObjCmd, + (CompileProc *) NULL, 1}, + {"string", (Tcl_CmdProc *) NULL, Tcl_StringObjCmd, + (CompileProc *) NULL, 1}, + {"subst", (Tcl_CmdProc *) NULL, Tcl_SubstObjCmd, + (CompileProc *) NULL, 1}, + {"switch", (Tcl_CmdProc *) NULL, Tcl_SwitchObjCmd, + (CompileProc *) NULL, 1}, + {"trace", (Tcl_CmdProc *) NULL, Tcl_TraceObjCmd, + (CompileProc *) NULL, 1}, + {"unset", (Tcl_CmdProc *) NULL, Tcl_UnsetObjCmd, + (CompileProc *) NULL, 1}, + {"uplevel", (Tcl_CmdProc *) NULL, Tcl_UplevelObjCmd, + (CompileProc *) NULL, 1}, + {"upvar", (Tcl_CmdProc *) NULL, Tcl_UpvarObjCmd, + (CompileProc *) NULL, 1}, + {"variable", (Tcl_CmdProc *) NULL, Tcl_VariableObjCmd, + (CompileProc *) NULL, 1}, + {"while", (Tcl_CmdProc *) NULL, Tcl_WhileObjCmd, + TclCompileWhileCmd, 1}, + + /* + * Commands in the UNIX core: + */ + +#ifndef TCL_GENERIC_ONLY + {"after", (Tcl_CmdProc *) NULL, Tcl_AfterObjCmd, + (CompileProc *) NULL, 1}, + {"cd", (Tcl_CmdProc *) NULL, Tcl_CdObjCmd, + (CompileProc *) NULL, 0}, + {"close", (Tcl_CmdProc *) NULL, Tcl_CloseObjCmd, + (CompileProc *) NULL, 1}, + {"eof", (Tcl_CmdProc *) NULL, Tcl_EofObjCmd, + (CompileProc *) NULL, 1}, + {"fblocked", (Tcl_CmdProc *) NULL, Tcl_FblockedObjCmd, + (CompileProc *) NULL, 1}, + {"fconfigure", (Tcl_CmdProc *) NULL, Tcl_FconfigureObjCmd, + (CompileProc *) NULL, 0}, + {"file", (Tcl_CmdProc *) NULL, Tcl_FileObjCmd, + (CompileProc *) NULL, 0}, + {"flush", (Tcl_CmdProc *) NULL, Tcl_FlushObjCmd, + (CompileProc *) NULL, 1}, + {"gets", (Tcl_CmdProc *) NULL, Tcl_GetsObjCmd, + (CompileProc *) NULL, 1}, + {"glob", (Tcl_CmdProc *) NULL, Tcl_GlobObjCmd, + (CompileProc *) NULL, 0}, + {"open", (Tcl_CmdProc *) NULL, Tcl_OpenObjCmd, + (CompileProc *) NULL, 0}, + {"pid", (Tcl_CmdProc *) NULL, Tcl_PidObjCmd, + (CompileProc *) NULL, 1}, + {"puts", (Tcl_CmdProc *) NULL, Tcl_PutsObjCmd, + (CompileProc *) NULL, 1}, + {"pwd", (Tcl_CmdProc *) NULL, Tcl_PwdObjCmd, + (CompileProc *) NULL, 0}, + {"read", (Tcl_CmdProc *) NULL, Tcl_ReadObjCmd, + (CompileProc *) NULL, 1}, + {"seek", (Tcl_CmdProc *) NULL, Tcl_SeekObjCmd, + (CompileProc *) NULL, 1}, + {"socket", (Tcl_CmdProc *) NULL, Tcl_SocketObjCmd, + (CompileProc *) NULL, 0}, + {"tell", (Tcl_CmdProc *) NULL, Tcl_TellObjCmd, + (CompileProc *) NULL, 1}, + {"time", (Tcl_CmdProc *) NULL, Tcl_TimeObjCmd, + (CompileProc *) NULL, 1}, + {"update", (Tcl_CmdProc *) NULL, Tcl_UpdateObjCmd, + (CompileProc *) NULL, 1}, + {"vwait", (Tcl_CmdProc *) NULL, Tcl_VwaitObjCmd, + (CompileProc *) NULL, 1}, + +#ifdef MAC_TCL + {"beep", (Tcl_CmdProc *) NULL, Tcl_BeepObjCmd, + (CompileProc *) NULL, 0}, + {"echo", Tcl_EchoCmd, (Tcl_ObjCmdProc *) NULL, + (CompileProc *) NULL, 0}, + {"ls", (Tcl_CmdProc *) NULL, Tcl_LsObjCmd, + (CompileProc *) NULL, 0}, + {"resource", (Tcl_CmdProc *) NULL, Tcl_ResourceObjCmd, + (CompileProc *) NULL, 1}, + {"source", (Tcl_CmdProc *) NULL, Tcl_MacSourceObjCmd, + (CompileProc *) NULL, 0}, +#else + {"exec", (Tcl_CmdProc *) NULL, Tcl_ExecObjCmd, + (CompileProc *) NULL, 0}, + {"source", (Tcl_CmdProc *) NULL, Tcl_SourceObjCmd, + (CompileProc *) NULL, 0}, +#endif /* MAC_TCL */ + +#endif /* TCL_GENERIC_ONLY */ + {NULL, (Tcl_CmdProc *) NULL, (Tcl_ObjCmdProc *) NULL, + (CompileProc *) NULL, 0} +}; + + +/* + *---------------------------------------------------------------------- + * + * Tcl_CreateInterp -- + * + * Create a new TCL command interpreter. + * + * Results: + * The return value is a token for the interpreter, which may be + * used in calls to procedures like Tcl_CreateCmd, Tcl_Eval, or + * Tcl_DeleteInterp. + * + * Side effects: + * The command interpreter is initialized with an empty variable + * table and the built-in commands. + * + *---------------------------------------------------------------------- + */ + +Tcl_Interp * +Tcl_CreateInterp() +{ + Interp *iPtr; + Tcl_Interp *interp; + Command *cmdPtr; + BuiltinFunc *builtinFuncPtr; + MathFunc *mathFuncPtr; + Tcl_HashEntry *hPtr; + CmdInfo *cmdInfoPtr; + int i; + union { + char c[sizeof(short)]; + short s; + } order; +#ifdef TCL_COMPILE_STATS + ByteCodeStats *statsPtr; +#endif /* TCL_COMPILE_STATS */ + + TclInitSubsystems(NULL); + + /* + * Panic if someone updated the CallFrame structure without + * also updating the Tcl_CallFrame structure (or vice versa). + */ + + if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) { + /*NOTREACHED*/ + panic("Tcl_CallFrame and CallFrame are not the same size"); + } + + /* + * Initialize support for namespaces and create the global namespace + * (whose name is ""; an alias is "::"). This also initializes the + * Tcl object type table and other object management code. + */ + + iPtr = (Interp *) ckalloc(sizeof(Interp)); + interp = (Tcl_Interp *) iPtr; + + iPtr->result = iPtr->resultSpace; + iPtr->freeProc = NULL; + iPtr->errorLine = 0; + iPtr->objResultPtr = Tcl_NewObj(); + Tcl_IncrRefCount(iPtr->objResultPtr); + iPtr->handle = TclHandleCreate(iPtr); + iPtr->globalNsPtr = NULL; + iPtr->hiddenCmdTablePtr = NULL; + iPtr->interpInfo = NULL; + Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS); + + iPtr->numLevels = 0; + iPtr->maxNestingDepth = 1000; + iPtr->framePtr = NULL; + iPtr->varFramePtr = NULL; + iPtr->activeTracePtr = NULL; + iPtr->returnCode = TCL_OK; + iPtr->errorInfo = NULL; + iPtr->errorCode = NULL; + + iPtr->appendResult = NULL; + iPtr->appendAvl = 0; + iPtr->appendUsed = 0; + + Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); + iPtr->packageUnknown = NULL; + iPtr->cmdCount = 0; + iPtr->termOffset = 0; + TclInitLiteralTable(&(iPtr->literalTable)); + iPtr->compileEpoch = 0; + iPtr->compiledProcPtr = NULL; + iPtr->resolverPtr = NULL; + iPtr->evalFlags = 0; + iPtr->scriptFile = NULL; + iPtr->flags = 0; + iPtr->tracePtr = NULL; + iPtr->assocData = (Tcl_HashTable *) NULL; + iPtr->execEnvPtr = NULL; /* set after namespaces initialized */ + iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */ + Tcl_IncrRefCount(iPtr->emptyObjPtr); + iPtr->resultSpace[0] = 0; + + iPtr->globalNsPtr = NULL; /* force creation of global ns below */ + iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "", + (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL); + if (iPtr->globalNsPtr == NULL) { + panic("Tcl_CreateInterp: can't create global namespace"); + } + + /* + * Initialize support for code compilation and execution. We call + * TclCreateExecEnv after initializing namespaces since it tries to + * reference a Tcl variable (it links to the Tcl "tcl_traceExec" + * variable). + */ + + iPtr->execEnvPtr = TclCreateExecEnv(interp); + + /* + * Initialize the compilation and execution statistics kept for this + * interpreter. + */ + +#ifdef TCL_COMPILE_STATS + statsPtr = &(iPtr->stats); + statsPtr->numExecutions = 0; + statsPtr->numCompilations = 0; + statsPtr->numByteCodesFreed = 0; + (VOID *) memset(statsPtr->instructionCount, 0, + sizeof(statsPtr->instructionCount)); + + statsPtr->totalSrcBytes = 0.0; + statsPtr->totalByteCodeBytes = 0.0; + statsPtr->currentSrcBytes = 0.0; + statsPtr->currentByteCodeBytes = 0.0; + (VOID *) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount)); + (VOID *) memset(statsPtr->byteCodeCount, 0, + sizeof(statsPtr->byteCodeCount)); + (VOID *) memset(statsPtr->lifetimeCount, 0, + sizeof(statsPtr->lifetimeCount)); + + statsPtr->currentInstBytes = 0.0; + statsPtr->currentLitBytes = 0.0; + statsPtr->currentExceptBytes = 0.0; + statsPtr->currentAuxBytes = 0.0; + statsPtr->currentCmdMapBytes = 0.0; + + statsPtr->numLiteralsCreated = 0; + statsPtr->totalLitStringBytes = 0.0; + statsPtr->currentLitStringBytes = 0.0; + (VOID *) memset(statsPtr->literalCount, 0, + sizeof(statsPtr->literalCount)); +#endif /* TCL_COMPILE_STATS */ + + /* + * Initialise the stub table pointer. + */ + + iPtr->stubTable = &tclStubs; + + + /* + * Create the core commands. Do it here, rather than calling + * Tcl_CreateCommand, because it's faster (there's no need to check for + * a pre-existing command by the same name). If a command has a + * Tcl_CmdProc but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to + * TclInvokeStringCommand. This is an object-based wrapper procedure + * that extracts strings, calls the string procedure, and creates an + * object for the result. Similarly, if a command has a Tcl_ObjCmdProc + * but no Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand. + */ + + for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; + cmdInfoPtr++) { + int new; + Tcl_HashEntry *hPtr; + + if ((cmdInfoPtr->proc == (Tcl_CmdProc *) NULL) + && (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL) + && (cmdInfoPtr->compileProc == (CompileProc *) NULL)) { + panic("Tcl_CreateInterp: builtin command with NULL string and object command procs and a NULL compile proc\n"); + } + + hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, + cmdInfoPtr->name, &new); + if (new) { + cmdPtr = (Command *) ckalloc(sizeof(Command)); + cmdPtr->hPtr = hPtr; + cmdPtr->nsPtr = iPtr->globalNsPtr; + cmdPtr->refCount = 1; + cmdPtr->cmdEpoch = 0; + cmdPtr->compileProc = cmdInfoPtr->compileProc; + if (cmdInfoPtr->proc == (Tcl_CmdProc *) NULL) { + cmdPtr->proc = TclInvokeObjectCommand; + cmdPtr->clientData = (ClientData) cmdPtr; + } else { + cmdPtr->proc = cmdInfoPtr->proc; + cmdPtr->clientData = (ClientData) NULL; + } + if (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL) { + cmdPtr->objProc = TclInvokeStringCommand; + cmdPtr->objClientData = (ClientData) cmdPtr; + } else { + cmdPtr->objProc = cmdInfoPtr->objProc; + cmdPtr->objClientData = (ClientData) NULL; + } + cmdPtr->deleteProc = NULL; + cmdPtr->deleteData = (ClientData) NULL; + cmdPtr->deleted = 0; + cmdPtr->importRefPtr = NULL; + Tcl_SetHashValue(hPtr, cmdPtr); + } + } + + /* + * Register the builtin math functions. + */ + + i = 0; + for (builtinFuncPtr = builtinFuncTable; builtinFuncPtr->name != NULL; + builtinFuncPtr++) { + Tcl_CreateMathFunc((Tcl_Interp *) iPtr, builtinFuncPtr->name, + builtinFuncPtr->numArgs, builtinFuncPtr->argTypes, + (Tcl_MathProc *) NULL, (ClientData) 0); + hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, + builtinFuncPtr->name); + if (hPtr == NULL) { + panic("Tcl_CreateInterp: Tcl_CreateMathFunc incorrectly registered '%s'", builtinFuncPtr->name); + return NULL; + } + mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr); + mathFuncPtr->builtinFuncIndex = i; + i++; + } + iPtr->flags |= EXPR_INITIALIZED; + + /* + * Do Multiple/Safe Interps Tcl init stuff + */ + + TclInterpInit(interp); + + /* + * We used to create the "errorInfo" and "errorCode" global vars at this + * point because so much of the Tcl implementation assumes they already + * exist. This is not quite enough, however, since they can be unset + * at any time. + * + * There are 2 choices: + * + Check every place where a GetVar of those is used + * and the NULL result is not checked (like in tclLoad.c) + * + Make SetVar,... NULL friendly + * We choose the second option because : + * + It is easy and low cost to check for NULL pointer before + * calling strlen() + * + It can be helpfull to other people using those API + * + Passing a NULL value to those closest 'meaning' is empty string + * (specially with the new objects where 0 bytes strings are ok) + * So the following init is commented out: -- dl + * + * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL, + * "", TCL_GLOBAL_ONLY); + * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL, + * "NONE", TCL_GLOBAL_ONLY); + */ + +#ifndef TCL_GENERIC_ONLY + TclSetupEnv(interp); +#endif + + /* + * Compute the byte order of this machine. + */ + + order.s = 1; + Tcl_SetVar2(interp, "tcl_platform", "byteOrder", + ((order.c[0] == 1) ? "littleEndian" : "bigEndian"), + TCL_GLOBAL_ONLY); + + /* + * Set up other variables such as tcl_version and tcl_library + */ + + Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); + Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL, + TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + TclPrecTraceProc, (ClientData) NULL); + TclpSetVariables(interp); + +#ifdef TCL_THREADS + /* + * The existence of the "threaded" element of the tcl_platform array indicates + * that this particular Tcl shell has been compiled with threads turned on. + * Using "info exists tcl_platform(threaded)" a Tcl script can introspect on the + * interpreter level of thread safety. + */ + + + Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", + TCL_GLOBAL_ONLY); +#endif + + /* + * Register Tcl's version number. + */ + + Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs); + +#ifdef Tcl_InitStubs +#undef Tcl_InitStubs +#endif + Tcl_InitStubs(interp, TCL_VERSION, 1); + + return interp; +} + +/* + *---------------------------------------------------------------------- + * + * TclHideUnsafeCommands -- + * + * Hides base commands that are not marked as safe from this + * interpreter. + * + * Results: + * TCL_OK if it succeeds, TCL_ERROR else. + * + * Side effects: + * Hides functionality in an interpreter. + * + *---------------------------------------------------------------------- + */ + +int +TclHideUnsafeCommands(interp) + Tcl_Interp *interp; /* Hide commands in this interpreter. */ +{ + register CmdInfo *cmdInfoPtr; + + if (interp == (Tcl_Interp *) NULL) { + return TCL_ERROR; + } + for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { + if (!cmdInfoPtr->isSafe) { + Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); + } + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tcl_CallWhenDeleted -- + * + * Arrange for a procedure to be called before a given + * interpreter is deleted. The procedure is called as soon + * as Tcl_DeleteInterp is called; if Tcl_CallWhenDeleted is + * called on an interpreter that has already been deleted, + * the procedure will be called when the last Tcl_Release is + * done on the interpreter. + * + * Results: + * None. + * + * Side effects: + * When Tcl_DeleteInterp is invoked to delete interp, + * proc will be invoked. See the manual entry for + * details. + * + *-------------------------------------------------------------- + */ + +void +Tcl_CallWhenDeleted(interp, proc, clientData) + Tcl_Interp *interp; /* Interpreter to watch. */ + Tcl_InterpDeleteProc *proc; /* Procedure to call when interpreter + * is about to be deleted. */ + ClientData clientData; /* One-word value to pass to proc. */ +{ + Interp *iPtr = (Interp *) interp; + static int assocDataCounter = 0; +#ifdef TCL_THREADS + static Tcl_Mutex assocMutex; +#endif + int new; + char buffer[32 + TCL_INTEGER_SPACE]; + AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData)); + Tcl_HashEntry *hPtr; + + Tcl_MutexLock(&assocMutex); + sprintf(buffer, "Assoc Data Key #%d", assocDataCounter); + assocDataCounter++; + Tcl_MutexUnlock(&assocMutex); + + if (iPtr->assocData == (Tcl_HashTable *) NULL) { + iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); + } + hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new); + dPtr->proc = proc; + dPtr->clientData = clientData; + Tcl_SetHashValue(hPtr, dPtr); +} + +/* + *-------------------------------------------------------------- + * + * Tcl_DontCallWhenDeleted -- + * + * Cancel the arrangement for a procedure to be called when + * a given interpreter is deleted. + * + * Results: + * None. + * + * Side effects: + * If proc and clientData were previously registered as a + * callback via Tcl_CallWhenDeleted, they are unregistered. + * If they weren't previously registered then nothing + * happens. + * + *-------------------------------------------------------------- + */ + +void +Tcl_DontCallWhenDeleted(interp, proc, clientData) + Tcl_Interp *interp; /* Interpreter to watch. */ + Tcl_InterpDeleteProc *proc; /* Procedure to call when interpreter + * is about to be deleted. */ + ClientData clientData; /* One-word value to pass to proc. */ +{ + Interp *iPtr = (Interp *) interp; + Tcl_HashTable *hTablePtr; + Tcl_HashSearch hSearch; + Tcl_HashEntry *hPtr; + AssocData *dPtr; + + hTablePtr = iPtr->assocData; + if (hTablePtr == (Tcl_HashTable *) NULL) { + return; + } + for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { + ckfree((char *) dPtr); + Tcl_DeleteHashEntry(hPtr); + return; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetAssocData -- + * + * Creates a named association between user-specified data, a delete + * function and this interpreter. If the association already exists + * the data is overwritten with the new data. The delete function will + * be invoked when the interpreter is deleted. + * + * Results: + * None. + * + * Side effects: + * Sets the associated data, creates the association if needed. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetAssocData(interp, name, proc, clientData) + Tcl_Interp *interp; /* Interpreter to associate with. */ + char *name; /* Name for association. */ + Tcl_InterpDeleteProc *proc; /* Proc to call when interpreter is + * about to be deleted. */ + ClientData clientData; /* One-word value to pass to proc. */ +{ + Interp *iPtr = (Interp *) interp; + AssocData *dPtr; + Tcl_HashEntry *hPtr; + int new; + + if (iPtr->assocData == (Tcl_HashTable *) NULL) { + iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); + } + hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &new); + if (new == 0) { + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + } else { + dPtr = (AssocData *) ckalloc(sizeof(AssocData)); + } + dPtr->proc = proc; + dPtr->clientData = clientData; + + Tcl_SetHashValue(hPtr, dPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_DeleteAssocData -- + * + * Deletes a named association of user-specified data with + * the specified interpreter. + * + * Results: + * None. + * + * Side effects: + * Deletes the association. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_DeleteAssocData(interp, name) + Tcl_Interp *interp; /* Interpreter to associate with. */ + char *name; /* Name of association. */ +{ + Interp *iPtr = (Interp *) interp; + AssocData *dPtr; + Tcl_HashEntry *hPtr; + + if (iPtr->assocData == (Tcl_HashTable *) NULL) { + return; + } + hPtr = Tcl_FindHashEntry(iPtr->assocData, name); + if (hPtr == (Tcl_HashEntry *) NULL) { + return; + } + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + if (dPtr->proc != NULL) { + (dPtr->proc) (dPtr->clientData, interp); + } + ckfree((char *) dPtr); + Tcl_DeleteHashEntry(hPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetAssocData -- + * + * Returns the client data associated with this name in the + * specified interpreter. + * + * Results: + * The client data in the AssocData record denoted by the named + * association, or NULL. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +ClientData +Tcl_GetAssocData(interp, name, procPtr) + Tcl_Interp *interp; /* Interpreter associated with. */ + char *name; /* Name of association. */ + Tcl_InterpDeleteProc **procPtr; /* Pointer to place to store address + * of current deletion callback. */ +{ + Interp *iPtr = (Interp *) interp; + AssocData *dPtr; + Tcl_HashEntry *hPtr; + + if (iPtr->assocData == (Tcl_HashTable *) NULL) { + return (ClientData) NULL; + } + hPtr = Tcl_FindHashEntry(iPtr->assocData, name); + if (hPtr == (Tcl_HashEntry *) NULL) { + return (ClientData) NULL; + } + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + if (procPtr != (Tcl_InterpDeleteProc **) NULL) { + *procPtr = dPtr->proc; + } + return dPtr->clientData; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_InterpDeleted -- + * + * Returns nonzero if the interpreter has been deleted with a call + * to Tcl_DeleteInterp. + * + * Results: + * Nonzero if the interpreter is deleted, zero otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_InterpDeleted(interp) + Tcl_Interp *interp; +{ + return (((Interp *) interp)->flags & DELETED) ? 1 : 0; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_DeleteInterp -- + * + * Ensures that the interpreter will be deleted eventually. If there + * are no Tcl_Preserve calls in effect for this interpreter, it is + * deleted immediately, otherwise the interpreter is deleted when + * the last Tcl_Preserve is matched by a call to Tcl_Release. In either + * case, the procedure runs the currently registered deletion callbacks. + * + * Results: + * None. + * + * Side effects: + * The interpreter is marked as deleted. The caller may still use it + * safely if there are calls to Tcl_Preserve in effect for the + * interpreter, but further calls to Tcl_Eval etc in this interpreter + * will fail. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_DeleteInterp(interp) + Tcl_Interp *interp; /* Token for command interpreter (returned + * by a previous call to Tcl_CreateInterp). */ +{ + Interp *iPtr = (Interp *) interp; + + /* + * If the interpreter has already been marked deleted, just punt. + */ + + if (iPtr->flags & DELETED) { + return; + } + + /* + * Mark the interpreter as deleted. No further evals will be allowed. + */ + + iPtr->flags |= DELETED; + + /* + * Ensure that the interpreter is eventually deleted. + */ + + Tcl_EventuallyFree((ClientData) interp, + (Tcl_FreeProc *) DeleteInterpProc); +} + +/* + *---------------------------------------------------------------------- + * + * DeleteInterpProc -- + * + * Helper procedure to delete an interpreter. This procedure is + * called when the last call to Tcl_Preserve on this interpreter + * is matched by a call to Tcl_Release. The procedure cleans up + * all resources used in the interpreter and calls all currently + * registered interpreter deletion callbacks. + * + * Results: + * None. + * + * Side effects: + * Whatever the interpreter deletion callbacks do. Frees resources + * used by the interpreter. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteInterpProc(interp) + Tcl_Interp *interp; /* Interpreter to delete. */ +{ + Interp *iPtr = (Interp *) interp; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_HashTable *hTablePtr; + ResolverScheme *resPtr, *nextResPtr; + + /* + * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup. + */ + + if (iPtr->numLevels > 0) { + panic("DeleteInterpProc called with active evals"); + } + + /* + * The interpreter should already be marked deleted; otherwise how + * did we get here? + */ + + if (!(iPtr->flags & DELETED)) { + panic("DeleteInterpProc called on interpreter not marked deleted"); + } + + TclHandleFree(iPtr->handle); + + /* + * Dismantle everything in the global namespace except for the + * "errorInfo" and "errorCode" variables. These remain until the + * namespace is actually destroyed, in case any errors occur. + * + * Dismantle the namespace here, before we clear the assocData. If any + * background errors occur here, they will be deleted below. + */ + + TclTeardownNamespace(iPtr->globalNsPtr); + + /* + * Delete all the hidden commands. + */ + + hTablePtr = iPtr->hiddenCmdTablePtr; + if (hTablePtr != NULL) { + /* + * Non-pernicious deletion. The deletion callbacks will not be + * allowed to create any new hidden or non-hidden commands. + * Tcl_DeleteCommandFromToken() will remove the entry from the + * hiddenCmdTablePtr. + */ + + hPtr = Tcl_FirstHashEntry(hTablePtr, &search); + for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_DeleteCommandFromToken(interp, + (Tcl_Command) Tcl_GetHashValue(hPtr)); + } + Tcl_DeleteHashTable(hTablePtr); + ckfree((char *) hTablePtr); + } + /* + * Tear down the math function table. + */ + + for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search)) { + ckfree((char *) Tcl_GetHashValue(hPtr)); + } + Tcl_DeleteHashTable(&iPtr->mathFuncTable); + + /* + * Invoke deletion callbacks; note that a callback can create new + * callbacks, so we iterate. + */ + + while (iPtr->assocData != (Tcl_HashTable *) NULL) { + AssocData *dPtr; + + hTablePtr = iPtr->assocData; + iPtr->assocData = (Tcl_HashTable *) NULL; + for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search); + hPtr != NULL; + hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) { + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + Tcl_DeleteHashEntry(hPtr); + if (dPtr->proc != NULL) { + (*dPtr->proc)(dPtr->clientData, interp); + } + ckfree((char *) dPtr); + } + Tcl_DeleteHashTable(hTablePtr); + ckfree((char *) hTablePtr); + } + + /* + * Finish deleting the global namespace. + */ + + Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr); + + /* + * Free up the result *after* deleting variables, since variable + * deletion could have transferred ownership of the result string + * to Tcl. + */ + + Tcl_FreeResult(interp); + interp->result = NULL; + Tcl_DecrRefCount(iPtr->objResultPtr); + iPtr->objResultPtr = NULL; + if (iPtr->errorInfo != NULL) { + ckfree(iPtr->errorInfo); + iPtr->errorInfo = NULL; + } + if (iPtr->errorCode != NULL) { + ckfree(iPtr->errorCode); + iPtr->errorCode = NULL; + } + if (iPtr->appendResult != NULL) { + ckfree(iPtr->appendResult); + iPtr->appendResult = NULL; + } + TclFreePackageInfo(iPtr); + while (iPtr->tracePtr != NULL) { + Trace *nextPtr = iPtr->tracePtr->nextPtr; + + ckfree((char *) iPtr->tracePtr); + iPtr->tracePtr = nextPtr; + } + if (iPtr->execEnvPtr != NULL) { + TclDeleteExecEnv(iPtr->execEnvPtr); + } + Tcl_DecrRefCount(iPtr->emptyObjPtr); + iPtr->emptyObjPtr = NULL; + + resPtr = iPtr->resolverPtr; + while (resPtr) { + nextResPtr = resPtr->nextPtr; + ckfree(resPtr->name); + ckfree((char *) resPtr); + resPtr = nextResPtr; + } + + /* + * Free up literal objects created for scripts compiled by the + * interpreter. + */ + + TclDeleteLiteralTable(interp, &(iPtr->literalTable)); + ckfree((char *) iPtr); +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_HideCommand -- + * + * Makes a command hidden so that it cannot be invoked from within + * an interpreter, only from within an ancestor. + * + * Results: + * A standard Tcl result; also leaves a message in the interp's result + * if an error occurs. + * + * Side effects: + * Removes a command from the command table and create an entry + * into the hidden command table under the specified token name. + * + *--------------------------------------------------------------------------- + */ + +int +Tcl_HideCommand(interp, cmdName, hiddenCmdToken) + Tcl_Interp *interp; /* Interpreter in which to hide command. */ + char *cmdName; /* Name of command to hide. */ + char *hiddenCmdToken; /* Token name of the to-be-hidden command. */ +{ + Interp *iPtr = (Interp *) interp; + Tcl_Command cmd; + Command *cmdPtr; + Tcl_HashTable *hiddenCmdTablePtr; + Tcl_HashEntry *hPtr; + int new; + + if (iPtr->flags & DELETED) { + + /* + * The interpreter is being deleted. Do not create any new + * structures, because it is not safe to modify the interpreter. + */ + + return TCL_ERROR; + } + + /* + * Disallow hiding of commands that are currently in a namespace or + * renaming (as part of hiding) into a namespace. + * + * (because the current implementation with a single global table + * and the needed uniqueness of names cause problems with namespaces) + * + * we don't need to check for "::" in cmdName because the real check is + * on the nsPtr below. + * + * hiddenCmdToken is just a string which is not interpreted in any way. + * It may contain :: but the string is not interpreted as a namespace + * qualifier command name. Thus, hiding foo::bar to foo::bar and then + * trying to expose or invoke ::foo::bar will NOT work; but if the + * application always uses the same strings it will get consistent + * behaviour. + * + * But as we currently limit ourselves to the global namespace only + * for the source, in order to avoid potential confusion, + * lets prevent "::" in the token too. --dl + */ + + if (strstr(hiddenCmdToken, "::") != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "cannot use namespace qualifiers as hidden command", + "token (rename)", (char *) NULL); + return TCL_ERROR; + } + + /* + * Find the command to hide. An error is returned if cmdName can't + * be found. Look up the command only from the global namespace. + * Full path of the command must be given if using namespaces. + */ + + cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL, + /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY); + if (cmd == (Tcl_Command) NULL) { + return TCL_ERROR; + } + cmdPtr = (Command *) cmd; + + /* + * Check that the command is really in global namespace + */ + + if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "can only hide global namespace commands", + " (use rename then hide)", (char *) NULL); + return TCL_ERROR; + } + + /* + * Initialize the hidden command table if necessary. + */ + + hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; + if (hiddenCmdTablePtr == NULL) { + hiddenCmdTablePtr = (Tcl_HashTable *) + ckalloc((unsigned) sizeof(Tcl_HashTable)); + Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); + iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; + } + + /* + * It is an error to move an exposed command to a hidden command with + * hiddenCmdToken if a hidden command with the name hiddenCmdToken already + * exists. + */ + + hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &new); + if (!new) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "hidden command named \"", hiddenCmdToken, "\" already exists", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Nb : This code is currently 'like' a rename to a specialy set apart + * name table. Changes here and in TclRenameCommand must + * be kept in synch untill the common parts are actually + * factorized out. + */ + + /* + * Remove the hash entry for the command from the interpreter command + * table. This is like deleting the command, so bump its command epoch; + * this invalidates any cached references that point to the command. + */ + + if (cmdPtr->hPtr != NULL) { + Tcl_DeleteHashEntry(cmdPtr->hPtr); + cmdPtr->hPtr = (Tcl_HashEntry *) NULL; + cmdPtr->cmdEpoch++; + } + + /* + * Now link the hash table entry with the command structure. + * We ensured above that the nsPtr was right. + */ + + cmdPtr->hPtr = hPtr; + Tcl_SetHashValue(hPtr, (ClientData) cmdPtr); + + /* + * If the command being hidden has a compile procedure, increment the + * interpreter's compileEpoch to invalidate its compiled code. This + * makes sure that we don't later try to execute old code compiled with + * command-specific (i.e., inline) bytecodes for the now-hidden + * command. This field is checked in Tcl_EvalObj and ObjInterpProc, + * and code whose compilation epoch doesn't match is recompiled. + */ + + if (cmdPtr->compileProc != NULL) { + iPtr->compileEpoch++; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_ExposeCommand -- + * + * Makes a previously hidden command callable from inside the + * interpreter instead of only by its ancestors. + * + * Results: + * A standard Tcl result. If an error occurs, a message is left + * in the interp's result. + * + * Side effects: + * Moves commands from one hash table to another. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName) + Tcl_Interp *interp; /* Interpreter in which to make command + * callable. */ + char *hiddenCmdToken; /* Name of hidden command. */ + char *cmdName; /* Name of to-be-exposed command. */ +{ + Interp *iPtr = (Interp *) interp; + Command *cmdPtr; + Namespace *nsPtr; + Tcl_HashEntry *hPtr; + Tcl_HashTable *hiddenCmdTablePtr; + int new; + + if (iPtr->flags & DELETED) { + /* + * The interpreter is being deleted. Do not create any new + * structures, because it is not safe to modify the interpreter. + */ + + return TCL_ERROR; + } + + /* + * Check that we have a regular name for the command + * (that the user is not trying to do an expose and a rename + * (to another namespace) at the same time) + */ + + if (strstr(cmdName, "::") != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "can not expose to a namespace ", + "(use expose to toplevel, then rename)", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Get the command from the hidden command table: + */ + + hPtr = NULL; + hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; + if (hiddenCmdTablePtr != NULL) { + hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken); + } + if (hPtr == (Tcl_HashEntry *) NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "unknown hidden command \"", hiddenCmdToken, + "\"", (char *) NULL); + return TCL_ERROR; + } + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + + + /* + * Check that we have a true global namespace + * command (enforced by Tcl_HideCommand() but let's double + * check. (If it was not, we would not really know how to + * handle it). + */ + if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) { + /* + * This case is theoritically impossible, + * we might rather panic() than 'nicely' erroring out ? + */ + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "trying to expose a non global command name space command", + (char *) NULL); + return TCL_ERROR; + } + + /* This is the global table */ + nsPtr = cmdPtr->nsPtr; + + /* + * It is an error to overwrite an existing exposed command as a result + * of exposing a previously hidden command. + */ + + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &new); + if (!new) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "exposed command \"", cmdName, + "\" already exists", (char *) NULL); + return TCL_ERROR; + } + + /* + * Remove the hash entry for the command from the interpreter hidden + * command table. + */ + + if (cmdPtr->hPtr != NULL) { + Tcl_DeleteHashEntry(cmdPtr->hPtr); + cmdPtr->hPtr = NULL; + } + + /* + * Now link the hash table entry with the command structure. + * This is like creating a new command, so deal with any shadowing + * of commands in the global namespace. + */ + + cmdPtr->hPtr = hPtr; + + Tcl_SetHashValue(hPtr, (ClientData) cmdPtr); + + /* + * Not needed as we are only in the global namespace + * (but would be needed again if we supported namespace command hiding) + * + * TclResetShadowedCmdRefs(interp, cmdPtr); + */ + + + /* + * If the command being exposed has a compile procedure, increment + * interpreter's compileEpoch to invalidate its compiled code. This + * makes sure that we don't later try to execute old code compiled + * assuming the command is hidden. This field is checked in Tcl_EvalObj + * and ObjInterpProc, and code whose compilation epoch doesn't match is + * recompiled. + */ + + if (cmdPtr->compileProc != NULL) { + iPtr->compileEpoch++; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_CreateCommand -- + * + * Define a new command in a command table. + * + * Results: + * The return value is a token for the command, which can + * be used in future calls to Tcl_GetCommandName. + * + * Side effects: + * If a command named cmdName already exists for interp, it is deleted. + * In the future, when cmdName is seen as the name of a command by + * Tcl_Eval, proc will be called. To support the bytecode interpreter, + * the command is created with a wrapper Tcl_ObjCmdProc + * (TclInvokeStringCommand) that eventially calls proc. When the + * command is deleted from the table, deleteProc will be called. + * See the manual entry for details on the calling sequence. + * + *---------------------------------------------------------------------- + */ + +Tcl_Command +Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc) + Tcl_Interp *interp; /* Token for command interpreter returned by + * a previous call to Tcl_CreateInterp. */ + char *cmdName; /* Name of command. If it contains namespace + * qualifiers, the new command is put in the + * specified namespace; otherwise it is put + * in the global namespace. */ + Tcl_CmdProc *proc; /* Procedure to associate with cmdName. */ + ClientData clientData; /* Arbitrary value passed to string proc. */ + Tcl_CmdDeleteProc *deleteProc; + /* If not NULL, gives a procedure to call + * when this command is deleted. */ +{ + Interp *iPtr = (Interp *) interp; + ImportRef *oldRefPtr = NULL; + Namespace *nsPtr, *dummy1, *dummy2; + Command *cmdPtr, *refCmdPtr; + Tcl_HashEntry *hPtr; + char *tail; + int new; + ImportedCmdData *dataPtr; + + if (iPtr->flags & DELETED) { + /* + * The interpreter is being deleted. Don't create any new + * commands; it's not safe to muck with the interpreter anymore. + */ + + return (Tcl_Command) NULL; + } + + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; + * otherwise, we always put it in the global namespace. + */ + + if (strstr(cmdName, "::") != NULL) { + TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL, + CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); + if ((nsPtr == NULL) || (tail == NULL)) { + return (Tcl_Command) NULL; + } + } else { + nsPtr = iPtr->globalNsPtr; + tail = cmdName; + } + + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new); + if (!new) { + /* + * Command already exists. Delete the old one. + * Be careful to preserve any existing import links so we can + * restore them down below. That way, you can redefine a + * command and its import status will remain intact. + */ + + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + oldRefPtr = cmdPtr->importRefPtr; + cmdPtr->importRefPtr = NULL; + + Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new); + if (!new) { + /* + * If the deletion callback recreated the command, just throw + * away the new command (if we try to delete it again, we + * could get stuck in an infinite loop). + */ + + ckfree((char*) Tcl_GetHashValue(hPtr)); + } + } + cmdPtr = (Command *) ckalloc(sizeof(Command)); + Tcl_SetHashValue(hPtr, cmdPtr); + cmdPtr->hPtr = hPtr; + cmdPtr->nsPtr = nsPtr; + cmdPtr->refCount = 1; + cmdPtr->cmdEpoch = 0; + cmdPtr->compileProc = (CompileProc *) NULL; + cmdPtr->objProc = TclInvokeStringCommand; + cmdPtr->objClientData = (ClientData) cmdPtr; + cmdPtr->proc = proc; + cmdPtr->clientData = clientData; + cmdPtr->deleteProc = deleteProc; + cmdPtr->deleteData = clientData; + cmdPtr->deleted = 0; + cmdPtr->importRefPtr = NULL; + + /* + * Plug in any existing import references found above. Be sure + * to update all of these references to point to the new command. + */ + + if (oldRefPtr != NULL) { + cmdPtr->importRefPtr = oldRefPtr; + while (oldRefPtr != NULL) { + refCmdPtr = oldRefPtr->importedCmdPtr; + dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; + dataPtr->realCmdPtr = cmdPtr; + oldRefPtr = oldRefPtr->nextPtr; + } + } + + /* + * We just created a command, so in its namespace and all of its parent + * namespaces, it may shadow global commands with the same name. If any + * shadowed commands are found, invalidate all cached command references + * in the affected namespaces. + */ + + TclResetShadowedCmdRefs(interp, cmdPtr); + return (Tcl_Command) cmdPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_CreateObjCommand -- + * + * Define a new object-based command in a command table. + * + * Results: + * The return value is a token for the command, which can + * be used in future calls to Tcl_GetCommandName. + * + * Side effects: + * If no command named "cmdName" already exists for interp, one is + * created. Otherwise, if a command does exist, then if the + * object-based Tcl_ObjCmdProc is TclInvokeStringCommand, we assume + * Tcl_CreateCommand was called previously for the same command and + * just set its Tcl_ObjCmdProc to the argument "proc"; otherwise, we + * delete the old command. + * + * In the future, during bytecode evaluation when "cmdName" is seen as + * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based + * Tcl_ObjCmdProc proc will be called. When the command is deleted from + * the table, deleteProc will be called. See the manual entry for + * details on the calling sequence. + * + *---------------------------------------------------------------------- + */ + +Tcl_Command +Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc) + Tcl_Interp *interp; /* Token for command interpreter (returned + * by previous call to Tcl_CreateInterp). */ + char *cmdName; /* Name of command. If it contains namespace + * qualifiers, the new command is put in the + * specified namespace; otherwise it is put + * in the global namespace. */ + Tcl_ObjCmdProc *proc; /* Object-based procedure to associate with + * name. */ + ClientData clientData; /* Arbitrary value to pass to object + * procedure. */ + Tcl_CmdDeleteProc *deleteProc; + /* If not NULL, gives a procedure to call + * when this command is deleted. */ +{ + Interp *iPtr = (Interp *) interp; + ImportRef *oldRefPtr = NULL; + Namespace *nsPtr, *dummy1, *dummy2; + Command *cmdPtr, *refCmdPtr; + Tcl_HashEntry *hPtr; + char *tail; + int new; + ImportedCmdData *dataPtr; + + if (iPtr->flags & DELETED) { + /* + * The interpreter is being deleted. Don't create any new + * commands; it's not safe to muck with the interpreter anymore. + */ + + return (Tcl_Command) NULL; + } + + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; + * otherwise, we always put it in the global namespace. + */ + + if (strstr(cmdName, "::") != NULL) { + TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL, + CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); + if ((nsPtr == NULL) || (tail == NULL)) { + return (Tcl_Command) NULL; + } + } else { + nsPtr = iPtr->globalNsPtr; + tail = cmdName; + } + + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new); + if (!new) { + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + + /* + * Command already exists. If its object-based Tcl_ObjCmdProc is + * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the + * argument "proc". Otherwise, we delete the old command. + */ + + if (cmdPtr->objProc == TclInvokeStringCommand) { + cmdPtr->objProc = proc; + cmdPtr->objClientData = clientData; + cmdPtr->deleteProc = deleteProc; + cmdPtr->deleteData = clientData; + return (Tcl_Command) cmdPtr; + } + + /* + * Otherwise, we delete the old command. Be careful to preserve + * any existing import links so we can restore them down below. + * That way, you can redefine a command and its import status + * will remain intact. + */ + + oldRefPtr = cmdPtr->importRefPtr; + cmdPtr->importRefPtr = NULL; + + Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new); + if (!new) { + /* + * If the deletion callback recreated the command, just throw + * away the new command (if we try to delete it again, we + * could get stuck in an infinite loop). + */ + + ckfree((char *) Tcl_GetHashValue(hPtr)); + } + } + cmdPtr = (Command *) ckalloc(sizeof(Command)); + Tcl_SetHashValue(hPtr, cmdPtr); + cmdPtr->hPtr = hPtr; + cmdPtr->nsPtr = nsPtr; + cmdPtr->refCount = 1; + cmdPtr->cmdEpoch = 0; + cmdPtr->compileProc = (CompileProc *) NULL; + cmdPtr->objProc = proc; + cmdPtr->objClientData = clientData; + cmdPtr->proc = TclInvokeObjectCommand; + cmdPtr->clientData = (ClientData) cmdPtr; + cmdPtr->deleteProc = deleteProc; + cmdPtr->deleteData = clientData; + cmdPtr->deleted = 0; + cmdPtr->importRefPtr = NULL; + + /* + * Plug in any existing import references found above. Be sure + * to update all of these references to point to the new command. + */ + + if (oldRefPtr != NULL) { + cmdPtr->importRefPtr = oldRefPtr; + while (oldRefPtr != NULL) { + refCmdPtr = oldRefPtr->importedCmdPtr; + dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; + dataPtr->realCmdPtr = cmdPtr; + oldRefPtr = oldRefPtr->nextPtr; + } + } + + /* + * We just created a command, so in its namespace and all of its parent + * namespaces, it may shadow global commands with the same name. If any + * shadowed commands are found, invalidate all cached command references + * in the affected namespaces. + */ + + TclResetShadowedCmdRefs(interp, cmdPtr); + return (Tcl_Command) cmdPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclInvokeStringCommand -- + * + * "Wrapper" Tcl_ObjCmdProc used to call an existing string-based + * Tcl_CmdProc if no object-based procedure exists for a command. A + * pointer to this procedure is stored as the Tcl_ObjCmdProc in a + * Command structure. It simply turns around and calls the string + * Tcl_CmdProc in the Command structure. + * + * Results: + * A standard Tcl object result value. + * + * Side effects: + * Besides those side effects of the called Tcl_CmdProc, + * TclInvokeStringCommand allocates and frees storage. + * + *---------------------------------------------------------------------- + */ + +int +TclInvokeStringCommand(clientData, interp, objc, objv) + ClientData clientData; /* Points to command's Command structure. */ + Tcl_Interp *interp; /* Current interpreter. */ + register int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register Command *cmdPtr = (Command *) clientData; + register int i; + int result; + + /* + * This procedure generates an argv array for the string arguments. It + * starts out with stack-allocated space but uses dynamically-allocated + * storage if needed. + */ + +#define NUM_ARGS 20 + char *(argStorage[NUM_ARGS]); + char **argv = argStorage; + + /* + * Create the string argument array "argv". Make sure argv is large + * enough to hold the objc arguments plus 1 extra for the zero + * end-of-argv word. + */ + + if ((objc + 1) > NUM_ARGS) { + argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *)); + } + + for (i = 0; i < objc; i++) { + argv[i] = Tcl_GetString(objv[i]); + } + argv[objc] = 0; + + /* + * Invoke the command's string-based Tcl_CmdProc. + */ + + result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv); + + /* + * Free the argv array if malloc'ed storage was used. + */ + + if (argv != argStorage) { + ckfree((char *) argv); + } + return result; +#undef NUM_ARGS +} + +/* + *---------------------------------------------------------------------- + * + * TclInvokeObjectCommand -- + * + * "Wrapper" Tcl_CmdProc used to call an existing object-based + * Tcl_ObjCmdProc if no string-based procedure exists for a command. + * A pointer to this procedure is stored as the Tcl_CmdProc in a + * Command structure. It simply turns around and calls the object + * Tcl_ObjCmdProc in the Command structure. + * + * Results: + * A standard Tcl string result value. + * + * Side effects: + * Besides those side effects of the called Tcl_CmdProc, + * TclInvokeStringCommand allocates and frees storage. + * + *---------------------------------------------------------------------- + */ + +int +TclInvokeObjectCommand(clientData, interp, argc, argv) + ClientData clientData; /* Points to command's Command structure. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + register char **argv; /* Argument strings. */ +{ + Command *cmdPtr = (Command *) clientData; + register Tcl_Obj *objPtr; + register int i; + int length, result; + + /* + * This procedure generates an objv array for object arguments that hold + * the argv strings. It starts out with stack-allocated space but uses + * dynamically-allocated storage if needed. + */ + +#define NUM_ARGS 20 + Tcl_Obj *(argStorage[NUM_ARGS]); + register Tcl_Obj **objv = argStorage; + + /* + * Create the object argument array "objv". Make sure objv is large + * enough to hold the objc arguments plus 1 extra for the zero + * end-of-objv word. + */ + + if ((argc + 1) > NUM_ARGS) { + objv = (Tcl_Obj **) + ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *)); + } + + for (i = 0; i < argc; i++) { + length = strlen(argv[i]); + TclNewObj(objPtr); + TclInitStringRep(objPtr, argv[i], length); + Tcl_IncrRefCount(objPtr); + objv[i] = objPtr; + } + objv[argc] = 0; + + /* + * Invoke the command's object-based Tcl_ObjCmdProc. + */ + + result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv); + + /* + * Move the interpreter's object result to the string result, + * then reset the object result. + */ + + Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), + TCL_VOLATILE); + + /* + * Decrement the ref counts for the argument objects created above, + * then free the objv array if malloc'ed storage was used. + */ + + for (i = 0; i < argc; i++) { + objPtr = objv[i]; + Tcl_DecrRefCount(objPtr); + } + if (objv != argStorage) { + ckfree((char *) objv); + } + return result; +#undef NUM_ARGS +} + +/* + *---------------------------------------------------------------------- + * + * TclRenameCommand -- + * + * Called to give an existing Tcl command a different name. Both the + * old command name and the new command name can have "::" namespace + * qualifiers. If the new command has a different namespace context, + * the command will be moved to that namespace and will execute in + * the context of that new namespace. + * + * If the new command name is NULL or the null string, the command is + * deleted. + * + * Results: + * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. + * + * Side effects: + * If anything goes wrong, an error message is returned in the + * interpreter's result object. + * + *---------------------------------------------------------------------- + */ + +int +TclRenameCommand(interp, oldName, newName) + Tcl_Interp *interp; /* Current interpreter. */ + char *oldName; /* Existing command name. */ + char *newName; /* New command name. */ +{ + Interp *iPtr = (Interp *) interp; + char *newTail; + Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2; + Tcl_Command cmd; + Command *cmdPtr; + Tcl_HashEntry *hPtr, *oldHPtr; + int new, result; + + /* + * Find the existing command. An error is returned if cmdName can't + * be found. + */ + + cmd = Tcl_FindCommand(interp, oldName, (Tcl_Namespace *) NULL, + /*flags*/ 0); + cmdPtr = (Command *) cmd; + if (cmdPtr == NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't ", + ((newName == NULL)||(*newName == '\0'))? "delete":"rename", + " \"", oldName, "\": command doesn't exist", (char *) NULL); + return TCL_ERROR; + } + cmdNsPtr = cmdPtr->nsPtr; + + /* + * If the new command name is NULL or empty, delete the command. Do this + * with Tcl_DeleteCommandFromToken, since we already have the command. + */ + + if ((newName == NULL) || (*newName == '\0')) { + Tcl_DeleteCommandFromToken(interp, cmd); + return TCL_OK; + } + + /* + * Make sure that the destination command does not already exist. + * The rename operation is like creating a command, so we should + * automatically create the containing namespaces just like + * Tcl_CreateCommand would. + */ + + TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL, + CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail); + + if ((newNsPtr == NULL) || (newTail == NULL)) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "can't rename to \"", newName, "\": bad command name", + (char *) NULL); + return TCL_ERROR; + } + if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "can't rename to \"", newName, + "\": command already exists", (char *) NULL); + return TCL_ERROR; + } + + + /* + * Warning: any changes done in the code here are likely + * to be needed in Tcl_HideCommand() code too. + * (until the common parts are extracted out) --dl + */ + + /* + * Put the command in the new namespace so we can check for an alias + * loop. Since we are adding a new command to a namespace, we must + * handle any shadowing of the global commands that this might create. + */ + + oldHPtr = cmdPtr->hPtr; + hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &new); + Tcl_SetHashValue(hPtr, (ClientData) cmdPtr); + cmdPtr->hPtr = hPtr; + cmdPtr->nsPtr = newNsPtr; + TclResetShadowedCmdRefs(interp, cmdPtr); + + /* + * Now check for an alias loop. If we detect one, put everything back + * the way it was and report the error. + */ + + result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr); + if (result != TCL_OK) { + Tcl_DeleteHashEntry(cmdPtr->hPtr); + cmdPtr->hPtr = oldHPtr; + cmdPtr->nsPtr = cmdNsPtr; + return result; + } + + /* + * The new command name is okay, so remove the command from its + * current namespace. This is like deleting the command, so bump + * the cmdEpoch to invalidate any cached references to the command. + */ + + Tcl_DeleteHashEntry(oldHPtr); + cmdPtr->cmdEpoch++; + + /* + * If the command being renamed has a compile procedure, increment the + * interpreter's compileEpoch to invalidate its compiled code. This + * makes sure that we don't later try to execute old code compiled for + * the now-renamed command. + */ + + if (cmdPtr->compileProc != NULL) { + iPtr->compileEpoch++; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetCommandInfo -- + * + * Modifies various information about a Tcl command. Note that + * this procedure will not change a command's namespace; use + * Tcl_RenameCommand to do that. Also, the isNativeObjectProc + * member of *infoPtr is ignored. + * + * Results: + * If cmdName exists in interp, then the information at *infoPtr + * is stored with the command in place of the current information + * and 1 is returned. If the command doesn't exist then 0 is + * returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_SetCommandInfo(interp, cmdName, infoPtr) + Tcl_Interp *interp; /* Interpreter in which to look + * for command. */ + char *cmdName; /* Name of desired command. */ + Tcl_CmdInfo *infoPtr; /* Where to store information about + * command. */ +{ + Tcl_Command cmd; + Command *cmdPtr; + + cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL, + /*flags*/ 0); + if (cmd == (Tcl_Command) NULL) { + return 0; + } + + /* + * The isNativeObjectProc and nsPtr members of *infoPtr are ignored. + */ + + cmdPtr = (Command *) cmd; + cmdPtr->proc = infoPtr->proc; + cmdPtr->clientData = infoPtr->clientData; + if (infoPtr->objProc == (Tcl_ObjCmdProc *) NULL) { + cmdPtr->objProc = TclInvokeStringCommand; + cmdPtr->objClientData = (ClientData) cmdPtr; + } else { + cmdPtr->objProc = infoPtr->objProc; + cmdPtr->objClientData = infoPtr->objClientData; + } + cmdPtr->deleteProc = infoPtr->deleteProc; + cmdPtr->deleteData = infoPtr->deleteData; + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetCommandInfo -- + * + * Returns various information about a Tcl command. + * + * Results: + * If cmdName exists in interp, then *infoPtr is modified to + * hold information about cmdName and 1 is returned. If the + * command doesn't exist then 0 is returned and *infoPtr isn't + * modified. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_GetCommandInfo(interp, cmdName, infoPtr) + Tcl_Interp *interp; /* Interpreter in which to look + * for command. */ + char *cmdName; /* Name of desired command. */ + Tcl_CmdInfo *infoPtr; /* Where to store information about + * command. */ +{ + Tcl_Command cmd; + Command *cmdPtr; + + cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL, + /*flags*/ 0); + if (cmd == (Tcl_Command) NULL) { + return 0; + } + + /* + * Set isNativeObjectProc 1 if objProc was registered by a call to + * Tcl_CreateObjCommand. Otherwise set it to 0. + */ + + cmdPtr = (Command *) cmd; + infoPtr->isNativeObjectProc = + (cmdPtr->objProc != TclInvokeStringCommand); + infoPtr->objProc = cmdPtr->objProc; + infoPtr->objClientData = cmdPtr->objClientData; + infoPtr->proc = cmdPtr->proc; + infoPtr->clientData = cmdPtr->clientData; + infoPtr->deleteProc = cmdPtr->deleteProc; + infoPtr->deleteData = cmdPtr->deleteData; + infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr; + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetCommandName -- + * + * Given a token returned by Tcl_CreateCommand, this procedure + * returns the current name of the command (which may have changed + * due to renaming). + * + * Results: + * The return value is the name of the given command. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char * +Tcl_GetCommandName(interp, command) + Tcl_Interp *interp; /* Interpreter containing the command. */ + Tcl_Command command; /* Token for command returned by a previous + * call to Tcl_CreateCommand. The command + * must not have been deleted. */ +{ + Command *cmdPtr = (Command *) command; + + if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) { + + /* + * This should only happen if command was "created" after the + * interpreter began to be deleted, so there isn't really any + * command. Just return an empty string. + */ + + return ""; + } + return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetCommandFullName -- + * + * Given a token returned by, e.g., Tcl_CreateCommand or + * Tcl_FindCommand, this procedure appends to an object the command's + * full name, qualified by a sequence of parent namespace names. The + * command's fully-qualified name may have changed due to renaming. + * + * Results: + * None. + * + * Side effects: + * The command's fully-qualified name is appended to the string + * representation of objPtr. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_GetCommandFullName(interp, command, objPtr) + Tcl_Interp *interp; /* Interpreter containing the command. */ + Tcl_Command command; /* Token for command returned by a previous + * call to Tcl_CreateCommand. The command + * must not have been deleted. */ + Tcl_Obj *objPtr; /* Points to the object onto which the + * command's full name is appended. */ + +{ + Interp *iPtr = (Interp *) interp; + register Command *cmdPtr = (Command *) command; + char *name; + + /* + * Add the full name of the containing namespace, followed by the "::" + * separator, and the command name. + */ + + if (cmdPtr != NULL) { + if (cmdPtr->nsPtr != NULL) { + Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1); + if (cmdPtr->nsPtr != iPtr->globalNsPtr) { + Tcl_AppendToObj(objPtr, "::", 2); + } + } + if (cmdPtr->hPtr != NULL) { + name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + Tcl_AppendToObj(objPtr, name, -1); + } + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_DeleteCommand -- + * + * Remove the given command from the given interpreter. + * + * Results: + * 0 is returned if the command was deleted successfully. + * -1 is returned if there didn't exist a command by that name. + * + * Side effects: + * cmdName will no longer be recognized as a valid command for + * interp. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_DeleteCommand(interp, cmdName) + Tcl_Interp *interp; /* Token for command interpreter (returned + * by a previous Tcl_CreateInterp call). */ + char *cmdName; /* Name of command to remove. */ +{ + Tcl_Command cmd; + + /* + * Find the desired command and delete it. + */ + + cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL, + /*flags*/ 0); + if (cmd == (Tcl_Command) NULL) { + return -1; + } + return Tcl_DeleteCommandFromToken(interp, cmd); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_DeleteCommandFromToken -- + * + * Removes the given command from the given interpreter. This procedure + * resembles Tcl_DeleteCommand, but takes a Tcl_Command token instead + * of a command name for efficiency. + * + * Results: + * 0 is returned if the command was deleted successfully. + * -1 is returned if there didn't exist a command by that name. + * + * Side effects: + * The command specified by "cmd" will no longer be recognized as a + * valid command for "interp". + * + *---------------------------------------------------------------------- + */ + +int +Tcl_DeleteCommandFromToken(interp, cmd) + Tcl_Interp *interp; /* Token for command interpreter returned by + * a previous call to Tcl_CreateInterp. */ + Tcl_Command cmd; /* Token for command to delete. */ +{ + Interp *iPtr = (Interp *) interp; + Command *cmdPtr = (Command *) cmd; + ImportRef *refPtr, *nextRefPtr; + Tcl_Command importCmd; + + /* + * The code here is tricky. We can't delete the hash table entry + * before invoking the deletion callback because there are cases + * where the deletion callback needs to invoke the command (e.g. + * object systems such as OTcl). However, this means that the + * callback could try to delete or rename the command. The deleted + * flag allows us to detect these cases and skip nested deletes. + */ + + if (cmdPtr->deleted) { + /* + * Another deletion is already in progress. Remove the hash + * table entry now, but don't invoke a callback or free the + * command structure. + */ + + Tcl_DeleteHashEntry(cmdPtr->hPtr); + cmdPtr->hPtr = NULL; + return 0; + } + + /* + * If the command being deleted has a compile procedure, increment the + * interpreter's compileEpoch to invalidate its compiled code. This + * makes sure that we don't later try to execute old code compiled with + * command-specific (i.e., inline) bytecodes for the now-deleted + * command. This field is checked in Tcl_EvalObj and ObjInterpProc, and + * code whose compilation epoch doesn't match is recompiled. + */ + + if (cmdPtr->compileProc != NULL) { + iPtr->compileEpoch++; + } + + cmdPtr->deleted = 1; + if (cmdPtr->deleteProc != NULL) { + /* + * Delete the command's client data. If this was an imported command + * created when a command was imported into a namespace, this client + * data will be a pointer to a ImportedCmdData structure describing + * the "real" command that this imported command refers to. + */ + + (*cmdPtr->deleteProc)(cmdPtr->deleteData); + } + + /* + * Bump the command epoch counter. This will invalidate all cached + * references that point to this command. + */ + + cmdPtr->cmdEpoch++; + + /* + * If this command was imported into other namespaces, then imported + * commands were created that refer back to this command. Delete these + * imported commands now. + */ + + for (refPtr = cmdPtr->importRefPtr; refPtr != NULL; + refPtr = nextRefPtr) { + nextRefPtr = refPtr->nextPtr; + importCmd = (Tcl_Command) refPtr->importedCmdPtr; + Tcl_DeleteCommandFromToken(interp, importCmd); + } + + /* + * Don't use hPtr to delete the hash entry here, because it's + * possible that the deletion callback renamed the command. + * Instead, use cmdPtr->hptr, and make sure that no-one else + * has already deleted the hash entry. + */ + + if (cmdPtr->hPtr != NULL) { + Tcl_DeleteHashEntry(cmdPtr->hPtr); + } + + /* + * Mark the Command structure as no longer valid. This allows + * TclExecuteByteCode to recognize when a Command has logically been + * deleted and a pointer to this Command structure cached in a CmdName + * object is invalid. TclExecuteByteCode will look up the command again + * in the interpreter's command hashtable. + */ + + cmdPtr->objProc = NULL; + + /* + * Now free the Command structure, unless there is another reference to + * it from a CmdName Tcl object in some ByteCode code sequence. In that + * case, delay the cleanup until all references are either discarded + * (when a ByteCode is freed) or replaced by a new reference (when a + * cached CmdName Command reference is found to be invalid and + * TclExecuteByteCode looks up the command in the command hashtable). + */ + + TclCleanupCommand(cmdPtr); + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * TclCleanupCommand -- + * + * This procedure frees up a Command structure unless it is still + * referenced from an interpreter's command hashtable or from a CmdName + * Tcl object representing the name of a command in a ByteCode + * instruction sequence. + * + * Results: + * None. + * + * Side effects: + * Memory gets freed unless a reference to the Command structure still + * exists. In that case the cleanup is delayed until the command is + * deleted or when the last ByteCode referring to it is freed. + * + *---------------------------------------------------------------------- + */ + +void +TclCleanupCommand(cmdPtr) + register Command *cmdPtr; /* Points to the Command structure to + * be freed. */ +{ + cmdPtr->refCount--; + if (cmdPtr->refCount <= 0) { + ckfree((char *) cmdPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_CreateMathFunc -- + * + * Creates a new math function for expressions in a given + * interpreter. + * + * Results: + * None. + * + * Side effects: + * The function defined by "name" is created or redefined. If the + * function already exists then its definition is replaced; this + * includes the builtin functions. Redefining a builtin function forces + * all existing code to be invalidated since that code may be compiled + * using an instruction specific to the replaced function. In addition, + * redefioning a non-builtin function will force existing code to be + * invalidated if the number of arguments has changed. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData) + Tcl_Interp *interp; /* Interpreter in which function is + * to be available. */ + char *name; /* Name of function (e.g. "sin"). */ + int numArgs; /* Nnumber of arguments required by + * function. */ + Tcl_ValueType *argTypes; /* Array of types acceptable for + * each argument. */ + Tcl_MathProc *proc; /* Procedure that implements the + * math function. */ + ClientData clientData; /* Additional value to pass to the + * function. */ +{ + Interp *iPtr = (Interp *) interp; + Tcl_HashEntry *hPtr; + MathFunc *mathFuncPtr; + int new, i; + + hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new); + if (new) { + Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc))); + } + mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr); + + if (!new) { + if (mathFuncPtr->builtinFuncIndex >= 0) { + /* + * We are redefining a builtin math function. Invalidate the + * interpreter's existing code by incrementing its + * compileEpoch member. This field is checked in Tcl_EvalObj + * and ObjInterpProc, and code whose compilation epoch doesn't + * match is recompiled. Newly compiled code will no longer + * treat the function as builtin. + */ + + iPtr->compileEpoch++; + } else { + /* + * A non-builtin function is being redefined. We must invalidate + * existing code if the number of arguments has changed. This + * is because existing code was compiled assuming that number. + */ + + if (numArgs != mathFuncPtr->numArgs) { + iPtr->compileEpoch++; + } + } + } + + mathFuncPtr->builtinFuncIndex = -1; /* can't be a builtin function */ + if (numArgs > MAX_MATH_ARGS) { + numArgs = MAX_MATH_ARGS; + } + mathFuncPtr->numArgs = numArgs; + for (i = 0; i < numArgs; i++) { + mathFuncPtr->argTypes[i] = argTypes[i]; + } + mathFuncPtr->proc = proc; + mathFuncPtr->clientData = clientData; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_EvalObjEx -- + * + * Execute Tcl commands stored in a Tcl object. These commands are + * compiled into bytecodes if necessary. + * + * Results: + * The return value is one of the return codes defined in tcl.h + * (such as TCL_OK), and the interpreter's result contains a value + * to supplement the return code. + * + * Side effects: + * The object is converted, if necessary, to a ByteCode object that + * holds the bytecode instructions for the commands. Executing the + * commands will almost certainly have side effects that depend + * on those commands. + * + * Just as in Tcl_Eval, interp->termOffset is set to the offset of the + * last character executed in the objPtr's string. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_EvalObjEx(interp, objPtr, flags) + Tcl_Interp *interp; /* Token for command interpreter + * (returned by a previous call to + * Tcl_CreateInterp). */ + register Tcl_Obj *objPtr; /* Pointer to object containing + * commands to execute. */ + int flags; /* Collection of OR-ed bits that + * control the evaluation of the + * script. Supported values are + * TCL_EVAL_GLOBAL and + * TCL_EVAL_DIRECT. */ +{ + register Interp *iPtr = (Interp *) interp; + int evalFlags; /* Interp->evalFlags value when the + * procedure was called. */ + register ByteCode* codePtr; /* Tcl Internal type of bytecode. */ + int oldCount = iPtr->cmdCount; /* Used to tell whether any commands + * at all were executed. */ + int numSrcBytes; + int result; + CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr + * in case TCL_EVAL_GLOBAL was set. */ + Namespace *namespacePtr; + + /* + * Prevent the object from being deleted as a side effect of evaling it. + */ + + Tcl_IncrRefCount(objPtr); + + if ((iPtr->flags & USE_EVAL_DIRECT) || (flags & TCL_EVAL_DIRECT)) { + /* + * We're not supposed to use the compiler or byte-code interpreter. + * Let Tcl_EvalEx evaluate the command directly (and probably + * more slowly). + */ + + char *p; + int length; + + p = Tcl_GetStringFromObj(objPtr, &length); + result = Tcl_EvalEx(interp, p, length, flags); + Tcl_DecrRefCount(objPtr); + return result; + } + + savedVarFramePtr = iPtr->varFramePtr; + if (flags & TCL_EVAL_GLOBAL) { + iPtr->varFramePtr = NULL; + } + + /* + * Reset both the interpreter's string and object results and clear out + * any error information. This makes sure that we return an empty + * result if there are no commands in the command string. + */ + + Tcl_ResetResult(interp); + + /* + * Check depth of nested calls to Tcl_Eval: if this gets too large, + * it's probably because of an infinite loop somewhere. + */ + + iPtr->numLevels++; + if (iPtr->numLevels > iPtr->maxNestingDepth) { + iPtr->numLevels--; + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "too many nested calls to Tcl_EvalObj (infinite loop?)", -1); + result = TCL_ERROR; + goto done; + } + + /* + * On the Mac, we will never reach the default recursion limit before + * blowing the stack. So we need to do a check here. + */ + + if (TclpCheckStackSpace() == 0) { + /*NOTREACHED*/ + iPtr->numLevels--; + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "too many nested calls to Tcl_EvalObj (infinite loop?)", -1); + result = TCL_ERROR; + goto done; + } + + /* + * If the interpreter has been deleted, return an error. + */ + + if (iPtr->flags & DELETED) { + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "attempt to call eval in deleted interpreter", -1); + Tcl_SetErrorCode(interp, "CORE", "IDELETE", + "attempt to call eval in deleted interpreter", + (char *) NULL); + result = TCL_ERROR; + goto done; + } + + /* + * Get the ByteCode from the object. If it exists, make sure it hasn't + * been invalidated by, e.g., someone redefining a command with a + * compile procedure (this might make the compiled code wrong). If + * necessary, convert the object to be a ByteCode object and compile it. + * Also, if the code was compiled in/for a different interpreter, + * or for a different namespace, or for the same namespace but + * with different name resolution rules, we recompile it. + * + * Precompiled objects, however, are immutable and therefore + * they are not recompiled, even if the epoch has changed. + */ + + if (iPtr->varFramePtr != NULL) { + namespacePtr = iPtr->varFramePtr->nsPtr; + } else { + namespacePtr = iPtr->globalNsPtr; + } + + if (objPtr->typePtr == &tclByteCodeType) { + codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; + + if (((Interp *) *codePtr->interpHandle != iPtr) + || (codePtr->compileEpoch != iPtr->compileEpoch) + || (codePtr->nsPtr != namespacePtr) + || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) { + if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { + if ((Interp *) *codePtr->interpHandle != iPtr) { + panic("Tcl_EvalObj: compiled script jumped interps"); + } + codePtr->compileEpoch = iPtr->compileEpoch; + } else { + tclByteCodeType.freeIntRepProc(objPtr); + } + } + } + if (objPtr->typePtr != &tclByteCodeType) { + iPtr->errorLine = 1; + result = tclByteCodeType.setFromAnyProc(interp, objPtr); + if (result != TCL_OK) { + goto done; + } + } else { + codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; + if (((Interp *) *codePtr->interpHandle != iPtr) + || (codePtr->compileEpoch != iPtr->compileEpoch)) { + (*tclByteCodeType.freeIntRepProc)(objPtr); + iPtr->errorLine = 1; + result = (*tclByteCodeType.setFromAnyProc)(interp, objPtr); + if (result != TCL_OK) { + iPtr->numLevels--; + return result; + } + } + } + codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; + + /* + * Extract then reset the compilation flags in the interpreter. + * Resetting the flags must be done after any compilation. + */ + + evalFlags = iPtr->evalFlags; + iPtr->evalFlags = 0; + + /* + * Execute the commands. If the code was compiled from an empty string, + * don't bother executing the code. + */ + + numSrcBytes = codePtr->numSrcBytes; + if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { + /* + * Increment the code's ref count while it is being executed. If + * afterwards no references to it remain, free the code. + */ + + codePtr->refCount++; + result = TclExecuteByteCode(interp, codePtr); + codePtr->refCount--; + if (codePtr->refCount <= 0) { + TclCleanupByteCode(codePtr); + } + } else { + result = TCL_OK; + } + + /* + * If no commands at all were executed, check for asynchronous + * handlers so that they at least get one change to execute. + * This is needed to handle event loops written in Tcl with + * empty bodies. + */ + + if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) { + result = Tcl_AsyncInvoke(interp, result); + } + + /* + * Update the interpreter's evaluation level count. If we are again at + * the top level, process any unusual return code returned by the + * evaluated code. + */ + + if (iPtr->numLevels == 1) { + if (result == TCL_RETURN) { + result = TclUpdateReturnInfo(iPtr); + } + if ((result != TCL_OK) && (result != TCL_ERROR) + && ((evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) { + ProcessUnexpectedResult(interp, result); + result = TCL_ERROR; + } + } + + /* + * If an error occurred, record information about what was being + * executed when the error occurred. + */ + + if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { + RecordTracebackInfo(interp, objPtr, numSrcBytes); + } + + /* + * Set the interpreter's termOffset member to the offset of the + * character just after the last one executed. We approximate the offset + * of the last character executed by using the number of characters + * compiled. + */ + + iPtr->termOffset = numSrcBytes; + iPtr->flags &= ~ERR_ALREADY_LOGGED; + + done: + TclDecrRefCount(objPtr); + iPtr->varFramePtr = savedVarFramePtr; + iPtr->numLevels--; + return result; +} + +/* + *---------------------------------------------------------------------- + * + * ProcessUnexpectedResult -- + * + * Procedure called by Tcl_EvalObj to set the interpreter's result + * value to an appropriate error message when the code it evaluates + * returns an unexpected result code (not TCL_OK and not TCL_ERROR) to + * the topmost evaluation level. + * + * Results: + * None. + * + * Side effects: + * The interpreter result is set to an error message appropriate to + * the result code. + * + *---------------------------------------------------------------------- + */ + +static void +ProcessUnexpectedResult(interp, returnCode) + Tcl_Interp *interp; /* The interpreter in which the unexpected + * result code was returned. */ + int returnCode; /* The unexpected result code. */ +{ + Tcl_ResetResult(interp); + if (returnCode == TCL_BREAK) { + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "invoked \"break\" outside of a loop", -1); + } else if (returnCode == TCL_CONTINUE) { + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "invoked \"continue\" outside of a loop", -1); + } else { + char buf[30 + TCL_INTEGER_SPACE]; + + sprintf(buf, "command returned bad code: %d", returnCode); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } +} + +/* + *---------------------------------------------------------------------- + * + * RecordTracebackInfo -- + * + * Procedure called by Tcl_EvalObj to record information about what was + * being executed when the error occurred. + * + * Results: + * None. + * + * Side effects: + * Appends information about the script being evaluated to the + * interpreter's "errorInfo" variable. + * + *---------------------------------------------------------------------- + */ + +static void +RecordTracebackInfo(interp, objPtr, numSrcBytes) + Tcl_Interp *interp; /* The interpreter in which the error + * occurred. */ + Tcl_Obj *objPtr; /* Points to object containing script whose + * evaluation resulted in an error. */ + int numSrcBytes; /* Number of bytes compiled in script. */ +{ + Interp *iPtr = (Interp *) interp; + char buf[200]; + char *ellipsis, *bytes; + int length; + + /* + * Decide how much of the command to print in the error message + * (up to a certain number of bytes). + */ + + bytes = Tcl_GetStringFromObj(objPtr, &length); + length = TclMin(numSrcBytes, length); + + ellipsis = ""; + if (length > 150) { + length = 150; + ellipsis = " ..."; + } + + if (!(iPtr->flags & ERR_IN_PROGRESS)) { + sprintf(buf, "\n while executing\n\"%.*s%s\"", + length, bytes, ellipsis); + } else { + sprintf(buf, "\n invoked from within\n\"%.*s%s\"", + length, bytes, ellipsis); + } + Tcl_AddObjErrorInfo(interp, buf, -1); +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean -- + * + * Procedures to evaluate an expression and return its value in a + * particular form. + * + * Results: + * Each of the procedures below returns a standard Tcl result. If an + * error occurs then an error message is left in the interp's result. + * Otherwise the value of the expression, in the appropriate form, + * is stored at *ptr. If the expression had a result that was + * incompatible with the desired form then an error is returned. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +int +Tcl_ExprLong(interp, string, ptr) + Tcl_Interp *interp; /* Context in which to evaluate the + * expression. */ + char *string; /* Expression to evaluate. */ + long *ptr; /* Where to store result. */ +{ + register Tcl_Obj *exprPtr; + Tcl_Obj *resultPtr; + int length = strlen(string); + int result = TCL_OK; + + if (length > 0) { + exprPtr = Tcl_NewStringObj(string, length); + Tcl_IncrRefCount(exprPtr); + result = Tcl_ExprObj(interp, exprPtr, &resultPtr); + if (result == TCL_OK) { + /* + * Store an integer based on the expression result. + */ + + if (resultPtr->typePtr == &tclIntType) { + *ptr = resultPtr->internalRep.longValue; + } else if (resultPtr->typePtr == &tclDoubleType) { + *ptr = (long) resultPtr->internalRep.doubleValue; + } else { + Tcl_SetResult(interp, + "expression didn't have numeric value", TCL_STATIC); + result = TCL_ERROR; + } + Tcl_DecrRefCount(resultPtr); /* discard the result object */ + } else { + /* + * Move the interpreter's object result to the string result, + * then reset the object result. + */ + + Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), + TCL_VOLATILE); + } + Tcl_DecrRefCount(exprPtr); /* discard the expression object */ + } else { + /* + * An empty string. Just set the result integer to 0. + */ + + *ptr = 0; + } + return result; +} + +int +Tcl_ExprDouble(interp, string, ptr) + Tcl_Interp *interp; /* Context in which to evaluate the + * expression. */ + char *string; /* Expression to evaluate. */ + double *ptr; /* Where to store result. */ +{ + register Tcl_Obj *exprPtr; + Tcl_Obj *resultPtr; + int length = strlen(string); + int result = TCL_OK; + + if (length > 0) { + exprPtr = Tcl_NewStringObj(string, length); + Tcl_IncrRefCount(exprPtr); + result = Tcl_ExprObj(interp, exprPtr, &resultPtr); + if (result == TCL_OK) { + /* + * Store a double based on the expression result. + */ + + if (resultPtr->typePtr == &tclIntType) { + *ptr = (double) resultPtr->internalRep.longValue; + } else if (resultPtr->typePtr == &tclDoubleType) { + *ptr = resultPtr->internalRep.doubleValue; + } else { + Tcl_SetResult(interp, + "expression didn't have numeric value", TCL_STATIC); + result = TCL_ERROR; + } + Tcl_DecrRefCount(resultPtr); /* discard the result object */ + } else { + /* + * Move the interpreter's object result to the string result, + * then reset the object result. + */ + + Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), + TCL_VOLATILE); + } + Tcl_DecrRefCount(exprPtr); /* discard the expression object */ + } else { + /* + * An empty string. Just set the result double to 0.0. + */ + + *ptr = 0.0; + } + return result; +} + +int +Tcl_ExprBoolean(interp, string, ptr) + Tcl_Interp *interp; /* Context in which to evaluate the + * expression. */ + char *string; /* Expression to evaluate. */ + int *ptr; /* Where to store 0/1 result. */ +{ + register Tcl_Obj *exprPtr; + Tcl_Obj *resultPtr; + int length = strlen(string); + int result = TCL_OK; + + if (length > 0) { + exprPtr = Tcl_NewStringObj(string, length); + Tcl_IncrRefCount(exprPtr); + result = Tcl_ExprObj(interp, exprPtr, &resultPtr); + if (result == TCL_OK) { + /* + * Store a boolean based on the expression result. + */ + + if (resultPtr->typePtr == &tclIntType) { + *ptr = (resultPtr->internalRep.longValue != 0); + } else if (resultPtr->typePtr == &tclDoubleType) { + *ptr = (resultPtr->internalRep.doubleValue != 0.0); + } else { + result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); + } + Tcl_DecrRefCount(resultPtr); /* discard the result object */ + } + if (result != TCL_OK) { + /* + * Move the interpreter's object result to the string result, + * then reset the object result. + */ + + Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), + TCL_VOLATILE); + } + Tcl_DecrRefCount(exprPtr); /* discard the expression object */ + } else { + /* + * An empty string. Just set the result boolean to 0 (false). + */ + + *ptr = 0; + } + return result; +} + +/* + *-------------------------------------------------------------- + * + * Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj -- + * + * Procedures to evaluate an expression in an object and return its + * value in a particular form. + * + * Results: + * Each of the procedures below returns a standard Tcl result + * object. If an error occurs then an error message is left in the + * interpreter's result. Otherwise the value of the expression, in the + * appropriate form, is stored at *ptr. If the expression had a result + * that was incompatible with the desired form then an error is + * returned. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Tcl_ExprLongObj(interp, objPtr, ptr) + Tcl_Interp *interp; /* Context in which to evaluate the + * expression. */ + register Tcl_Obj *objPtr; /* Expression to evaluate. */ + long *ptr; /* Where to store long result. */ +{ + Tcl_Obj *resultPtr; + int result; + + result = Tcl_ExprObj(interp, objPtr, &resultPtr); + if (result == TCL_OK) { + if (resultPtr->typePtr == &tclIntType) { + *ptr = resultPtr->internalRep.longValue; + } else if (resultPtr->typePtr == &tclDoubleType) { + *ptr = (long) resultPtr->internalRep.doubleValue; + } else { + result = Tcl_GetLongFromObj(interp, resultPtr, ptr); + if (result != TCL_OK) { + return result; + } + } + Tcl_DecrRefCount(resultPtr); /* discard the result object */ + } + return result; +} + +int +Tcl_ExprDoubleObj(interp, objPtr, ptr) + Tcl_Interp *interp; /* Context in which to evaluate the + * expression. */ + register Tcl_Obj *objPtr; /* Expression to evaluate. */ + double *ptr; /* Where to store double result. */ +{ + Tcl_Obj *resultPtr; + int result; + + result = Tcl_ExprObj(interp, objPtr, &resultPtr); + if (result == TCL_OK) { + if (resultPtr->typePtr == &tclIntType) { + *ptr = (double) resultPtr->internalRep.longValue; + } else if (resultPtr->typePtr == &tclDoubleType) { + *ptr = resultPtr->internalRep.doubleValue; + } else { + result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr); + if (result != TCL_OK) { + return result; + } + } + Tcl_DecrRefCount(resultPtr); /* discard the result object */ + } + return result; +} + +int +Tcl_ExprBooleanObj(interp, objPtr, ptr) + Tcl_Interp *interp; /* Context in which to evaluate the + * expression. */ + register Tcl_Obj *objPtr; /* Expression to evaluate. */ + int *ptr; /* Where to store 0/1 result. */ +{ + Tcl_Obj *resultPtr; + int result; + + result = Tcl_ExprObj(interp, objPtr, &resultPtr); + if (result == TCL_OK) { + if (resultPtr->typePtr == &tclIntType) { + *ptr = (resultPtr->internalRep.longValue != 0); + } else if (resultPtr->typePtr == &tclDoubleType) { + *ptr = (resultPtr->internalRep.doubleValue != 0.0); + } else { + result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); + } + Tcl_DecrRefCount(resultPtr); /* discard the result object */ + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TclInvoke -- + * + * Invokes a Tcl command, given an argv/argc, from either the + * exposed or the hidden sets of commands in the given interpreter. + * NOTE: The command is invoked in the current stack frame of + * the interpreter, thus it can modify local variables. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Whatever the command does. + * + *---------------------------------------------------------------------- + */ + +int +TclInvoke(interp, argc, argv, flags) + Tcl_Interp *interp; /* Where to invoke the command. */ + int argc; /* Count of args. */ + register char **argv; /* The arg strings; argv[0] is the name of + * the command to invoke. */ + int flags; /* Combination of flags controlling the + * call: TCL_INVOKE_HIDDEN and + * TCL_INVOKE_NO_UNKNOWN. */ +{ + register Tcl_Obj *objPtr; + register int i; + int length, result; + + /* + * This procedure generates an objv array for object arguments that hold + * the argv strings. It starts out with stack-allocated space but uses + * dynamically-allocated storage if needed. + */ + +#define NUM_ARGS 20 + Tcl_Obj *(objStorage[NUM_ARGS]); + register Tcl_Obj **objv = objStorage; + + /* + * Create the object argument array "objv". Make sure objv is large + * enough to hold the objc arguments plus 1 extra for the zero + * end-of-objv word. + */ + + if ((argc + 1) > NUM_ARGS) { + objv = (Tcl_Obj **) + ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *)); + } + + for (i = 0; i < argc; i++) { + length = strlen(argv[i]); + objv[i] = Tcl_NewStringObj(argv[i], length); + Tcl_IncrRefCount(objv[i]); + } + objv[argc] = 0; + + /* + * Use TclObjInterpProc to actually invoke the command. + */ + + result = TclObjInvoke(interp, argc, objv, flags); + + /* + * Move the interpreter's object result to the string result, + * then reset the object result. + */ + + Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), + TCL_VOLATILE); + + /* + * Decrement the ref counts on the objv elements since we are done + * with them. + */ + + for (i = 0; i < argc; i++) { + objPtr = objv[i]; + Tcl_DecrRefCount(objPtr); + } + + /* + * Free the objv array if malloc'ed storage was used. + */ + + if (objv != objStorage) { + ckfree((char *) objv); + } + return result; +#undef NUM_ARGS +} + +/* + *---------------------------------------------------------------------- + * + * TclGlobalInvoke -- + * + * Invokes a Tcl command, given an argv/argc, from either the + * exposed or hidden sets of commands in the given interpreter. + * NOTE: The command is invoked in the global stack frame of + * the interpreter, thus it cannot see any current state on + * the stack for that interpreter. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Whatever the command does. + * + *---------------------------------------------------------------------- + */ + +int +TclGlobalInvoke(interp, argc, argv, flags) + Tcl_Interp *interp; /* Where to invoke the command. */ + int argc; /* Count of args. */ + register char **argv; /* The arg strings; argv[0] is the name of + * the command to invoke. */ + int flags; /* Combination of flags controlling the + * call: TCL_INVOKE_HIDDEN and + * TCL_INVOKE_NO_UNKNOWN. */ +{ + register Interp *iPtr = (Interp *) interp; + int result; + CallFrame *savedVarFramePtr; + + savedVarFramePtr = iPtr->varFramePtr; + iPtr->varFramePtr = NULL; + result = TclInvoke(interp, argc, argv, flags); + iPtr->varFramePtr = savedVarFramePtr; + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TclObjInvokeGlobal -- + * + * Object version: Invokes a Tcl command, given an objv/objc, from + * either the exposed or hidden set of commands in the given + * interpreter. + * NOTE: The command is invoked in the global stack frame of the + * interpreter, thus it cannot see any current state on the + * stack of that interpreter. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Whatever the command does. + * + *---------------------------------------------------------------------- + */ + +int +TclObjInvokeGlobal(interp, objc, objv, flags) + Tcl_Interp *interp; /* Interpreter in which command is to be + * invoked. */ + int objc; /* Count of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects; objv[0] points to the + * name of the command to invoke. */ + int flags; /* Combination of flags controlling the + * call: TCL_INVOKE_HIDDEN, + * TCL_INVOKE_NO_UNKNOWN, or + * TCL_INVOKE_NO_TRACEBACK. */ +{ + register Interp *iPtr = (Interp *) interp; + int result; + CallFrame *savedVarFramePtr; + + savedVarFramePtr = iPtr->varFramePtr; + iPtr->varFramePtr = NULL; + result = TclObjInvoke(interp, objc, objv, flags); + iPtr->varFramePtr = savedVarFramePtr; + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TclObjInvoke -- + * + * Invokes a Tcl command, given an objv/objc, from either the + * exposed or the hidden sets of commands in the given interpreter. + * + * Results: + * A standard Tcl object result. + * + * Side effects: + * Whatever the command does. + * + *---------------------------------------------------------------------- + */ + +int +TclObjInvoke(interp, objc, objv, flags) + Tcl_Interp *interp; /* Interpreter in which command is to be + * invoked. */ + int objc; /* Count of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects; objv[0] points to the + * name of the command to invoke. */ + int flags; /* Combination of flags controlling the + * call: TCL_INVOKE_HIDDEN, + * TCL_INVOKE_NO_UNKNOWN, or + * TCL_INVOKE_NO_TRACEBACK. */ +{ + register Interp *iPtr = (Interp *) interp; + Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ + char *cmdName; /* Name of the command from objv[0]. */ + register Tcl_HashEntry *hPtr; + Tcl_Command cmd; + Command *cmdPtr; + int localObjc; /* Used to invoke "unknown" if the */ + Tcl_Obj **localObjv = NULL; /* command is not found. */ + register int i; + int length, result; + char *bytes; + + if (interp == (Tcl_Interp *) NULL) { + return TCL_ERROR; + } + + if ((objc < 1) || (objv == (Tcl_Obj **) NULL)) { + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "illegal argument vector", -1); + return TCL_ERROR; + } + + cmdName = Tcl_GetString(objv[0]); + if (flags & TCL_INVOKE_HIDDEN) { + /* + * We never invoke "unknown" for hidden commands. + */ + + hPtr = NULL; + hTblPtr = ((Interp *) interp)->hiddenCmdTablePtr; + if (hTblPtr != NULL) { + hPtr = Tcl_FindHashEntry(hTblPtr, cmdName); + } + if (hPtr == NULL) { + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "invalid hidden command name \"", cmdName, "\"", + (char *) NULL); + return TCL_ERROR; + } + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + } else { + cmdPtr = NULL; + cmd = Tcl_FindCommand(interp, cmdName, + (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY); + if (cmd != (Tcl_Command) NULL) { + cmdPtr = (Command *) cmd; + } + if (cmdPtr == NULL) { + if (!(flags & TCL_INVOKE_NO_UNKNOWN)) { + cmd = Tcl_FindCommand(interp, "unknown", + (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY); + if (cmd != (Tcl_Command) NULL) { + cmdPtr = (Command *) cmd; + } + if (cmdPtr != NULL) { + localObjc = (objc + 1); + localObjv = (Tcl_Obj **) + ckalloc((unsigned) (sizeof(Tcl_Obj *) * localObjc)); + localObjv[0] = Tcl_NewStringObj("unknown", -1); + Tcl_IncrRefCount(localObjv[0]); + for (i = 0; i < objc; i++) { + localObjv[i+1] = objv[i]; + } + objc = localObjc; + objv = localObjv; + } + } + + /* + * Check again if we found the command. If not, "unknown" is + * not present and we cannot help, or the caller said not to + * call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN). + */ + + if (cmdPtr == NULL) { + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "invalid command name \"", cmdName, "\"", + (char *) NULL); + return TCL_ERROR; + } + } + } + + /* + * Invoke the command procedure. First reset the interpreter's string + * and object results to their default empty values since they could + * have gotten changed by earlier invocations. + */ + + Tcl_ResetResult(interp); + iPtr->cmdCount++; + result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); + + /* + * If an error occurred, record information about what was being + * executed when the error occurred. + */ + + if ((result == TCL_ERROR) + && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0) + && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) { + Tcl_DString ds; + + Tcl_DStringInit(&ds); + if (!(iPtr->flags & ERR_IN_PROGRESS)) { + Tcl_DStringAppend(&ds, "\n while invoking\n\"", -1); + } else { + Tcl_DStringAppend(&ds, "\n invoked from within\n\"", -1); + } + for (i = 0; i < objc; i++) { + bytes = Tcl_GetStringFromObj(objv[i], &length); + Tcl_DStringAppend(&ds, bytes, length); + if (i < (objc - 1)) { + Tcl_DStringAppend(&ds, " ", -1); + } else if (Tcl_DStringLength(&ds) > 100) { + Tcl_DStringSetLength(&ds, 100); + Tcl_DStringAppend(&ds, "...", -1); + break; + } + } + + Tcl_DStringAppend(&ds, "\"", -1); + Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + iPtr->flags &= ~ERR_ALREADY_LOGGED; + } + + /* + * Free any locally allocated storage used to call "unknown". + */ + + if (localObjv != (Tcl_Obj **) NULL) { + Tcl_DecrRefCount(localObjv[0]); + ckfree((char *) localObjv); + } + return result; +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_ExprString -- + * + * Evaluate an expression in a string and return its value in string + * form. + * + * Results: + * A standard Tcl result. If the result is TCL_OK, then the interp's + * result is set to the string value of the expression. If the result + * is TCL_ERROR, then the interp's result contains an error message. + * + * Side effects: + * A Tcl object is allocated to hold a copy of the expression string. + * This expression object is passed to Tcl_ExprObj and then + * deallocated. + * + *--------------------------------------------------------------------------- + */ + +int +Tcl_ExprString(interp, string) + Tcl_Interp *interp; /* Context in which to evaluate the + * expression. */ + char *string; /* Expression to evaluate. */ +{ + register Tcl_Obj *exprPtr; + Tcl_Obj *resultPtr; + int length = strlen(string); + char buf[TCL_DOUBLE_SPACE]; + int result = TCL_OK; + + if (length > 0) { + TclNewObj(exprPtr); + TclInitStringRep(exprPtr, string, length); + Tcl_IncrRefCount(exprPtr); + + result = Tcl_ExprObj(interp, exprPtr, &resultPtr); + if (result == TCL_OK) { + /* + * Set the interpreter's string result from the result object. + */ + + if (resultPtr->typePtr == &tclIntType) { + sprintf(buf, "%ld", resultPtr->internalRep.longValue); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } else if (resultPtr->typePtr == &tclDoubleType) { + Tcl_PrintDouble((Tcl_Interp *) NULL, + resultPtr->internalRep.doubleValue, buf); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } else { + /* + * Set interpreter's string result from the result object. + */ + + Tcl_SetResult(interp, TclGetString(resultPtr), + TCL_VOLATILE); + } + Tcl_DecrRefCount(resultPtr); /* discard the result object */ + } else { + /* + * Move the interpreter's object result to the string result, + * then reset the object result. + */ + + Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), + TCL_VOLATILE); + } + Tcl_DecrRefCount(exprPtr); /* discard the expression object */ + } else { + /* + * An empty string. Just set the interpreter's result to 0. + */ + + Tcl_SetResult(interp, "0", TCL_VOLATILE); + } + return result; +} + +/* + *-------------------------------------------------------------- + * + * Tcl_ExprObj -- + * + * Evaluate an expression in a Tcl_Obj. + * + * Results: + * A standard Tcl object result. If the result is other than TCL_OK, + * then the interpreter's result contains an error message. If the + * result is TCL_OK, then a pointer to the expression's result value + * object is stored in resultPtrPtr. In that case, the object's ref + * count is incremented to reflect the reference returned to the + * caller; the caller is then responsible for the resulting object + * and must, for example, decrement the ref count when it is finished + * with the object. + * + * Side effects: + * Any side effects caused by subcommands in the expression, if any. + * The interpreter result is not modified unless there is an error. + * + *-------------------------------------------------------------- + */ + +int +Tcl_ExprObj(interp, objPtr, resultPtrPtr) + Tcl_Interp *interp; /* Context in which to evaluate the + * expression. */ + register Tcl_Obj *objPtr; /* Points to Tcl object containing + * expression to evaluate. */ + Tcl_Obj **resultPtrPtr; /* Where the Tcl_Obj* that is the expression + * result is stored if no errors occur. */ +{ + Interp *iPtr = (Interp *) interp; + CompileEnv compEnv; /* Compilation environment structure + * allocated in frame. */ + LiteralTable *localTablePtr = &(compEnv.localLitTable); + register ByteCode *codePtr = NULL; + /* Tcl Internal type of bytecode. + * Initialized to avoid compiler warning. */ + AuxData *auxDataPtr; + LiteralEntry *entryPtr; + Tcl_Obj *saveObjPtr; + char *string; + int length, i, result; + + /* + * First handle some common expressions specially. + */ + + string = Tcl_GetStringFromObj(objPtr, &length); + if (length == 1) { + if (*string == '0') { + *resultPtrPtr = Tcl_NewLongObj(0); + Tcl_IncrRefCount(*resultPtrPtr); + return TCL_OK; + } else if (*string == '1') { + *resultPtrPtr = Tcl_NewLongObj(1); + Tcl_IncrRefCount(*resultPtrPtr); + return TCL_OK; + } + } else if ((length == 2) && (*string == '!')) { + if (*(string+1) == '0') { + *resultPtrPtr = Tcl_NewLongObj(1); + Tcl_IncrRefCount(*resultPtrPtr); + return TCL_OK; + } else if (*(string+1) == '1') { + *resultPtrPtr = Tcl_NewLongObj(0); + Tcl_IncrRefCount(*resultPtrPtr); + return TCL_OK; + } + } + + /* + * Get the ByteCode from the object. If it exists, make sure it hasn't + * been invalidated by, e.g., someone redefining a command with a + * compile procedure (this might make the compiled code wrong). If + * necessary, convert the object to be a ByteCode object and compile it. + * Also, if the code was compiled in/for a different interpreter, we + * recompile it. + * + * Precompiled expressions, however, are immutable and therefore + * they are not recompiled, even if the epoch has changed. + * + */ + + if (objPtr->typePtr == &tclByteCodeType) { + codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; + if (((Interp *) *codePtr->interpHandle != iPtr) + || (codePtr->compileEpoch != iPtr->compileEpoch)) { + if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { + if ((Interp *) *codePtr->interpHandle != iPtr) { + panic("Tcl_ExprObj: compiled expression jumped interps"); + } + codePtr->compileEpoch = iPtr->compileEpoch; + } else { + (*tclByteCodeType.freeIntRepProc)(objPtr); + objPtr->typePtr = (Tcl_ObjType *) NULL; + } + } + } + if (objPtr->typePtr != &tclByteCodeType) { + TclInitCompileEnv(interp, &compEnv, string, length); + result = TclCompileExpr(interp, string, length, &compEnv); + + /* + * Free the compilation environment's literal table bucket array if + * it was dynamically allocated. + */ + + if (localTablePtr->buckets != localTablePtr->staticBuckets) { + ckfree((char *) localTablePtr->buckets); + } + + if (result != TCL_OK) { + /* + * Compilation errors. Free storage allocated for compilation. + */ + +#ifdef TCL_COMPILE_DEBUG + TclVerifyLocalLiteralTable(&compEnv); +#endif /*TCL_COMPILE_DEBUG*/ + entryPtr = compEnv.literalArrayPtr; + for (i = 0; i < compEnv.literalArrayNext; i++) { + TclReleaseLiteral(interp, entryPtr->objPtr); + entryPtr++; + } +#ifdef TCL_COMPILE_DEBUG + TclVerifyGlobalLiteralTable(iPtr); +#endif /*TCL_COMPILE_DEBUG*/ + + auxDataPtr = compEnv.auxDataArrayPtr; + for (i = 0; i < compEnv.auxDataArrayNext; i++) { + if (auxDataPtr->type->freeProc != NULL) { + auxDataPtr->type->freeProc(auxDataPtr->clientData); + } + auxDataPtr++; + } + TclFreeCompileEnv(&compEnv); + return result; + } + + /* + * Successful compilation. If the expression yielded no + * instructions, push an zero object as the expression's result. + */ + + if (compEnv.codeNext == compEnv.codeStart) { + TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0), + &compEnv); + } + + /* + * Add a "done" instruction as the last instruction and change the + * object into a ByteCode object. Ownership of the literal objects + * and aux data items is given to the ByteCode object. + */ + + compEnv.numSrcBytes = iPtr->termOffset; + TclEmitOpcode(INST_DONE, &compEnv); + TclInitByteCodeObj(objPtr, &compEnv); + TclFreeCompileEnv(&compEnv); + codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; +#ifdef TCL_COMPILE_DEBUG + if (tclTraceCompile == 2) { + TclPrintByteCodeObj(interp, objPtr); + } +#endif /* TCL_COMPILE_DEBUG */ + } + + /* + * Execute the expression after first saving the interpreter's result. + */ + + saveObjPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(saveObjPtr); + Tcl_ResetResult(interp); + + /* + * Increment the code's ref count while it is being executed. If + * afterwards no references to it remain, free the code. + */ + + codePtr->refCount++; + result = TclExecuteByteCode(interp, codePtr); + codePtr->refCount--; + if (codePtr->refCount <= 0) { + TclCleanupByteCode(codePtr); + objPtr->typePtr = NULL; + objPtr->internalRep.otherValuePtr = NULL; + } + + /* + * If the expression evaluated successfully, store a pointer to its + * value object in resultPtrPtr then restore the old interpreter result. + * We increment the object's ref count to reflect the reference that we + * are returning to the caller. We also decrement the ref count of the + * interpreter's result object after calling Tcl_SetResult since we + * next store into that field directly. + */ + + if (result == TCL_OK) { + *resultPtrPtr = iPtr->objResultPtr; + Tcl_IncrRefCount(iPtr->objResultPtr); + + Tcl_SetObjResult(interp, saveObjPtr); + } + Tcl_DecrRefCount(saveObjPtr); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_CreateTrace -- + * + * Arrange for a procedure to be called to trace command execution. + * + * Results: + * The return value is a token for the trace, which may be passed + * to Tcl_DeleteTrace to eliminate the trace. + * + * Side effects: + * From now on, proc will be called just before a command procedure + * is called to execute a Tcl command. Calls to proc will have the + * following form: + * + * void + * proc(clientData, interp, level, command, cmdProc, cmdClientData, + * argc, argv) + * ClientData clientData; + * Tcl_Interp *interp; + * int level; + * char *command; + * int (*cmdProc)(); + * ClientData cmdClientData; + * int argc; + * char **argv; + * { + * } + * + * The clientData and interp arguments to proc will be the same + * as the corresponding arguments to this procedure. Level gives + * the nesting level of command interpretation for this interpreter + * (0 corresponds to top level). Command gives the ASCII text of + * the raw command, cmdProc and cmdClientData give the procedure that + * will be called to process the command and the ClientData value it + * will receive, and argc and argv give the arguments to the + * command, after any argument parsing and substitution. Proc + * does not return a value. + * + *---------------------------------------------------------------------- + */ + +Tcl_Trace +Tcl_CreateTrace(interp, level, proc, clientData) + Tcl_Interp *interp; /* Interpreter in which to create trace. */ + int level; /* Only call proc for commands at nesting + * level<=argument level (1=>top level). */ + Tcl_CmdTraceProc *proc; /* Procedure to call before executing each + * command. */ + ClientData clientData; /* Arbitrary value word to pass to proc. */ +{ + register Trace *tracePtr; + register Interp *iPtr = (Interp *) interp; + + /* + * Invalidate existing compiled code for this interpreter and arrange + * (by setting the DONT_COMPILE_CMDS_INLINE flag) that when compiling + * new code, no commands will be compiled inline (i.e., into an inline + * sequence of instructions). We do this because commands that were + * compiled inline will never result in a command trace being called. + */ + + iPtr->compileEpoch++; + iPtr->flags |= DONT_COMPILE_CMDS_INLINE; + + tracePtr = (Trace *) ckalloc(sizeof(Trace)); + tracePtr->level = level; + tracePtr->proc = proc; + tracePtr->clientData = clientData; + tracePtr->nextPtr = iPtr->tracePtr; + iPtr->tracePtr = tracePtr; + + return (Tcl_Trace) tracePtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_DeleteTrace -- + * + * Remove a trace. + * + * Results: + * None. + * + * Side effects: + * From now on there will be no more calls to the procedure given + * in trace. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_DeleteTrace(interp, trace) + Tcl_Interp *interp; /* Interpreter that contains trace. */ + Tcl_Trace trace; /* Token for trace (returned previously by + * Tcl_CreateTrace). */ +{ + register Interp *iPtr = (Interp *) interp; + register Trace *tracePtr = (Trace *) trace; + register Trace *tracePtr2; + + if (iPtr->tracePtr == tracePtr) { + iPtr->tracePtr = tracePtr->nextPtr; + ckfree((char *) tracePtr); + } else { + for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL; + tracePtr2 = tracePtr2->nextPtr) { + if (tracePtr2->nextPtr == tracePtr) { + tracePtr2->nextPtr = tracePtr->nextPtr; + ckfree((char *) tracePtr); + break; + } + } + } + + if (iPtr->tracePtr == NULL) { + /* + * When compiling new code, allow commands to be compiled inline. + */ + + iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE; + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AddErrorInfo -- + * + * Add information to the "errorInfo" variable that describes the + * current error. + * + * Results: + * None. + * + * Side effects: + * The contents of message are added to the "errorInfo" variable. + * If Tcl_Eval has been called since the current value of errorInfo + * was set, errorInfo is cleared before adding the new message. + * If we are just starting to log an error, errorInfo is initialized + * from the error message in the interpreter's result. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AddErrorInfo(interp, message) + Tcl_Interp *interp; /* Interpreter to which error information + * pertains. */ + CONST char *message; /* Message to record. */ +{ + Tcl_AddObjErrorInfo(interp, message, -1); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AddObjErrorInfo -- + * + * Add information to the "errorInfo" variable that describes the + * current error. This routine differs from Tcl_AddErrorInfo by + * taking a byte pointer and length. + * + * Results: + * None. + * + * Side effects: + * "length" bytes from "message" are added to the "errorInfo" variable. + * If "length" is negative, use bytes up to the first NULL byte. + * If Tcl_EvalObj has been called since the current value of errorInfo + * was set, errorInfo is cleared before adding the new message. + * If we are just starting to log an error, errorInfo is initialized + * from the error message in the interpreter's result. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AddObjErrorInfo(interp, message, length) + Tcl_Interp *interp; /* Interpreter to which error information + * pertains. */ + CONST char *message; /* Points to the first byte of an array of + * bytes of the message. */ + int length; /* The number of bytes in the message. + * If < 0, then append all bytes up to a + * NULL byte. */ +{ + register Interp *iPtr = (Interp *) interp; + Tcl_Obj *messagePtr; + + /* + * If we are just starting to log an error, errorInfo is initialized + * from the error message in the interpreter's result. + */ + + if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */ + iPtr->flags |= ERR_IN_PROGRESS; + + if (iPtr->result[0] == 0) { + (void) Tcl_SetVar2Ex(interp, "errorInfo", NULL, iPtr->objResultPtr, + TCL_GLOBAL_ONLY); + } else { /* use the string result */ + Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result, + TCL_GLOBAL_ONLY); + } + + /* + * If the errorCode variable wasn't set by the code that generated + * the error, set it to "NONE". + */ + + if (!(iPtr->flags & ERROR_CODE_SET)) { + (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE", + TCL_GLOBAL_ONLY); + } + } + + /* + * Now append "message" to the end of errorInfo. + */ + + if (length != 0) { + messagePtr = Tcl_NewStringObj(message, length); + Tcl_IncrRefCount(messagePtr); + Tcl_SetVar2Ex(interp, "errorInfo", NULL, messagePtr, + (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE)); + Tcl_DecrRefCount(messagePtr); /* free msg object appended above */ + } +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_VarEvalVA -- + * + * Given a variable number of string arguments, concatenate them + * all together and execute the result as a Tcl command. + * + * Results: + * A standard Tcl return result. An error message or other result may + * be left in the interp's result. + * + * Side effects: + * Depends on what was done by the command. + * + *--------------------------------------------------------------------------- + */ + +int +Tcl_VarEvalVA (interp, argList) + Tcl_Interp *interp; /* Interpreter in which to evaluate command. */ + va_list argList; /* Variable argument list. */ +{ + Tcl_DString buf; + char *string; + int result; + + /* + * Copy the strings one after the other into a single larger + * string. Use stack-allocated space for small commands, but if + * the command gets too large than call ckalloc to create the + * space. + */ + + Tcl_DStringInit(&buf); + while (1) { + string = va_arg(argList, char *); + if (string == NULL) { + break; + } + Tcl_DStringAppend(&buf, string, -1); + } + + result = Tcl_Eval(interp, Tcl_DStringValue(&buf)); + Tcl_DStringFree(&buf); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_VarEval -- + * + * Given a variable number of string arguments, concatenate them + * all together and execute the result as a Tcl command. + * + * Results: + * A standard Tcl return result. An error message or other + * result may be left in interp->result. + * + * Side effects: + * Depends on what was done by the command. + * + *---------------------------------------------------------------------- + */ + /* VARARGS2 */ /* ARGSUSED */ +int +Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1) +{ + Tcl_Interp *interp; + va_list argList; + int result; + + interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList); + result = Tcl_VarEvalVA(interp, argList); + va_end(argList); + + return result; +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_GlobalEval -- + * + * Evaluate a command at global level in an interpreter. + * + * Results: + * A standard Tcl result is returned, and the interp's result is + * modified accordingly. + * + * Side effects: + * The command string is executed in interp, and the execution + * is carried out in the variable context of global level (no + * procedures active), just as if an "uplevel #0" command were + * being executed. + * + --------------------------------------------------------------------------- + */ + +int +Tcl_GlobalEval(interp, command) + Tcl_Interp *interp; /* Interpreter in which to evaluate command. */ + char *command; /* Command to evaluate. */ +{ + register Interp *iPtr = (Interp *) interp; + int result; + CallFrame *savedVarFramePtr; + + savedVarFramePtr = iPtr->varFramePtr; + iPtr->varFramePtr = NULL; + result = Tcl_Eval(interp, command); + iPtr->varFramePtr = savedVarFramePtr; + return result; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetRecursionLimit -- + * + * Set the maximum number of recursive calls that may be active + * for an interpreter at once. + * + * Results: + * The return value is the old limit on nesting for interp. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_SetRecursionLimit(interp, depth) + Tcl_Interp *interp; /* Interpreter whose nesting limit + * is to be set. */ + int depth; /* New value for maximimum depth. */ +{ + Interp *iPtr = (Interp *) interp; + int old; + + old = iPtr->maxNestingDepth; + if (depth > 0) { + iPtr->maxNestingDepth = depth; + } + return old; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AllowExceptions -- + * + * Sets a flag in an interpreter so that exceptions can occur + * in the next call to Tcl_Eval without them being turned into + * errors. + * + * Results: + * None. + * + * Side effects: + * The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's + * evalFlags structure. See the reference documentation for + * more details. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AllowExceptions(interp) + Tcl_Interp *interp; /* Interpreter in which to set flag. */ +{ + Interp *iPtr = (Interp *) interp; + + iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS; +} + + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetVersion + * + * Get the Tcl major, minor, and patchlevel version numbers and + * the release type. A patch is a release type TCL_FINAL_RELEASE + * with a patchLevel > 0. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void Tcl_GetVersion(major, minor, patchLevel, type) + int *major; + int *minor; + int *patchLevel; + int *type; +{ + if (major != NULL) { + *major = TCL_MAJOR_VERSION; + } + if (minor != NULL) { + *minor = TCL_MINOR_VERSION; + } + if (patchLevel != NULL) { + *patchLevel = TCL_RELEASE_SERIAL; + } + if (type != NULL) { + *type = TCL_RELEASE_LEVEL; + } +} + diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tclInt.h ./canvas-tcl8.2.2/tclInt.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tclInt.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tclInt.h Thu Dec 30 14:57:00 1999 @@ -0,0 +1,2163 @@ +/* + * tclInt.h -- + * + * Declarations of things used internally by the Tcl interpreter. + * + * Copyright (c) 1987-1993 The Regents of the University of California. + * Copyright (c) 1993-1997 Lucent Technologies. + * Copyright (c) 1994-1998 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclInt.h,v 1.35 1999/08/02 17:45:37 redman Exp $ + */ + +#ifndef _TCLINT +#define _TCLINT + +/* + * Common include files needed by most of the Tcl source files are + * included here, so that system-dependent personalizations for the + * include files only have to be made in once place. This results + * in a few extra includes, but greater modularity. The order of + * the three groups of #includes is important. For example, stdio.h + * is needed by tcl.h, and the _ANSI_ARGS_ declaration in tcl.h is + * needed by stdlib.h in some configurations. + */ + +#include + +#ifndef _TCL +#include "tcl.h" +#endif + +#include +#ifdef NO_LIMITS_H +# include "../compat/limits.h" +#else +# include +#endif +#ifdef NO_STDLIB_H +# include "../compat/stdlib.h" +#else +# include +#endif +#ifdef NO_STRING_H +#include "../compat/string.h" +#else +#include +#endif + +#undef TCL_STORAGE_CLASS +#ifdef BUILD_tcl +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + +/* + * The following procedures allow namespaces to be customized to + * support special name resolution rules for commands/variables. + * + */ + +struct Tcl_ResolvedVarInfo; + +typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) _ANSI_ARGS_(( + Tcl_Interp* interp, struct Tcl_ResolvedVarInfo *vinfoPtr)); + +typedef void (Tcl_ResolveVarDeleteProc) _ANSI_ARGS_(( + struct Tcl_ResolvedVarInfo *vinfoPtr)); + +/* + * The following structure encapsulates the routines needed to resolve a + * variable reference at runtime. Any variable specific state will typically + * be appended to this structure. + */ + + +typedef struct Tcl_ResolvedVarInfo { + Tcl_ResolveRuntimeVarProc *fetchProc; + Tcl_ResolveVarDeleteProc *deleteProc; +} Tcl_ResolvedVarInfo; + + + +typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_(( + Tcl_Interp* interp, char* name, int length, + Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr)); + +typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_(( + Tcl_Interp* interp, char* name, Tcl_Namespace *context, + int flags, Tcl_Var *rPtr)); + +typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp, + char* name, Tcl_Namespace *context, int flags, + Tcl_Command *rPtr)); + +typedef struct Tcl_ResolverInfo { + Tcl_ResolveCmdProc *cmdResProc; /* Procedure handling command name + * resolution. */ + Tcl_ResolveVarProc *varResProc; /* Procedure handling variable name + * resolution for variables that + * can only be handled at runtime. */ + Tcl_ResolveCompiledVarProc *compiledVarResProc; + /* Procedure handling variable name + * resolution at compile time. */ +} Tcl_ResolverInfo; + +/* + *---------------------------------------------------------------- + * Data structures related to namespaces. + *---------------------------------------------------------------- + */ + +/* + * The structure below defines a namespace. + * Note: the first five fields must match exactly the fields in a + * Tcl_Namespace structure (see tcl.h). If you change one, be sure to + * change the other. + */ + +typedef struct Namespace { + char *name; /* The namespace's simple (unqualified) + * name. This contains no ::'s. The name of + * the global namespace is "" although "::" + * is an synonym. */ + char *fullName; /* The namespace's fully qualified name. + * This starts with ::. */ + ClientData clientData; /* An arbitrary value associated with this + * namespace. */ + Tcl_NamespaceDeleteProc *deleteProc; + /* Procedure invoked when deleting the + * namespace to, e.g., free clientData. */ + struct Namespace *parentPtr; /* Points to the namespace that contains + * this one. NULL if this is the global + * namespace. */ + Tcl_HashTable childTable; /* Contains any child namespaces. Indexed + * by strings; values have type + * (Namespace *). */ + long nsId; /* Unique id for the namespace. */ + Tcl_Interp *interp; /* The interpreter containing this + * namespace. */ + int flags; /* OR-ed combination of the namespace + * status flags NS_DYING and NS_DEAD + * listed below. */ + int activationCount; /* Number of "activations" or active call + * frames for this namespace that are on + * the Tcl call stack. The namespace won't + * be freed until activationCount becomes + * zero. */ + int refCount; /* Count of references by namespaceName * + * objects. The namespace can't be freed + * until refCount becomes zero. */ + Tcl_HashTable cmdTable; /* Contains all the commands currently + * registered in the namespace. Indexed by + * strings; values have type (Command *). + * Commands imported by Tcl_Import have + * Command structures that point (via an + * ImportedCmdRef structure) to the + * Command structure in the source + * namespace's command table. */ + Tcl_HashTable varTable; /* Contains all the (global) variables + * currently in this namespace. Indexed + * by strings; values have type (Var *). */ + char **exportArrayPtr; /* Points to an array of string patterns + * specifying which commands are exported. + * A pattern may include "string match" + * style wildcard characters to specify + * multiple commands; however, no namespace + * qualifiers are allowed. NULL if no + * export patterns are registered. */ + int numExportPatterns; /* Number of export patterns currently + * registered using "namespace export". */ + int maxExportPatterns; /* Mumber of export patterns for which + * space is currently allocated. */ + int cmdRefEpoch; /* Incremented if a newly added command + * shadows a command for which this + * namespace has already cached a Command * + * pointer; this causes all its cached + * Command* pointers to be invalidated. */ + int resolverEpoch; /* Incremented whenever the name resolution + * rules change for this namespace; this + * invalidates all byte codes compiled in + * the namespace, causing the code to be + * recompiled under the new rules. */ + Tcl_ResolveCmdProc *cmdResProc; + /* If non-null, this procedure overrides + * the usual command resolution mechanism + * in Tcl. This procedure is invoked + * within Tcl_FindCommand to resolve all + * command references within the namespace. */ + Tcl_ResolveVarProc *varResProc; + /* If non-null, this procedure overrides + * the usual variable resolution mechanism + * in Tcl. This procedure is invoked + * within Tcl_FindNamespaceVar to resolve all + * variable references within the namespace + * at runtime. */ + Tcl_ResolveCompiledVarProc *compiledVarResProc; + /* If non-null, this procedure overrides + * the usual variable resolution mechanism + * in Tcl. This procedure is invoked + * within LookupCompiledLocal to resolve + * variable references within the namespace + * at compile time. */ +} Namespace; + +/* + * Flags used to represent the status of a namespace: + * + * NS_DYING - 1 means Tcl_DeleteNamespace has been called to delete the + * namespace but there are still active call frames on the Tcl + * stack that refer to the namespace. When the last call frame + * referring to it has been popped, it's variables and command + * will be destroyed and it will be marked "dead" (NS_DEAD). + * The namespace can no longer be looked up by name. + * NS_DEAD - 1 means Tcl_DeleteNamespace has been called to delete the + * namespace and no call frames still refer to it. Its + * variables and command have already been destroyed. This bit + * allows the namespace resolution code to recognize that the + * namespace is "deleted". When the last namespaceName object + * in any byte code code unit that refers to the namespace has + * been freed (i.e., when the namespace's refCount is 0), the + * namespace's storage will be freed. + */ + +#define NS_DYING 0x01 +#define NS_DEAD 0x02 + +/* + * Flag passed to TclGetNamespaceForQualName to have it create all namespace + * components of a namespace-qualified name that cannot be found. The new + * namespaces are created within their specified parent. Note that this + * flag's value must not conflict with the values of the flags + * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, and FIND_ONLY_NS (defined in + * tclNamesp.c). + */ + +#define CREATE_NS_IF_UNKNOWN 0x800 + +/* + *---------------------------------------------------------------- + * Data structures related to variables. These are used primarily + * in tclVar.c + *---------------------------------------------------------------- + */ + +/* + * The following structure defines a variable trace, which is used to + * invoke a specific C procedure whenever certain operations are performed + * on a variable. + */ + +typedef struct VarTrace { + Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given + * by flags are performed on variable. */ + ClientData clientData; /* Argument to pass to proc. */ + int flags; /* What events the trace procedure is + * interested in: OR-ed combination of + * TCL_TRACE_READS, TCL_TRACE_WRITES, + * TCL_TRACE_UNSETS and TCL_TRACE_ARRAY. */ + struct VarTrace *nextPtr; /* Next in list of traces associated with + * a particular variable. */ +} VarTrace; + +/* + * When a variable trace is active (i.e. its associated procedure is + * executing), one of the following structures is linked into a list + * associated with the variable's interpreter. The information in + * the structure is needed in order for Tcl to behave reasonably + * if traces are deleted while traces are active. + */ + +typedef struct ActiveVarTrace { + struct Var *varPtr; /* Variable that's being traced. */ + struct ActiveVarTrace *nextPtr; + /* Next in list of all active variable + * traces for the interpreter, or NULL + * if no more. */ + VarTrace *nextTracePtr; /* Next trace to check after current + * trace procedure returns; if this + * trace gets deleted, must update pointer + * to avoid using free'd memory. */ +} ActiveVarTrace; + +/* + * The following structure describes an enumerative search in progress on + * an array variable; this are invoked with options to the "array" + * command. + */ + +typedef struct ArraySearch { + int id; /* Integer id used to distinguish among + * multiple concurrent searches for the + * same array. */ + struct Var *varPtr; /* Pointer to array variable that's being + * searched. */ + Tcl_HashSearch search; /* Info kept by the hash module about + * progress through the array. */ + Tcl_HashEntry *nextEntry; /* Non-null means this is the next element + * to be enumerated (it's leftover from + * the Tcl_FirstHashEntry call or from + * an "array anymore" command). NULL + * means must call Tcl_NextHashEntry + * to get value to return. */ + struct ArraySearch *nextPtr;/* Next in list of all active searches + * for this variable, or NULL if this is + * the last one. */ +} ArraySearch; + +/* + * The structure below defines a variable, which associates a string name + * with a Tcl_Obj value. These structures are kept in procedure call frames + * (for local variables recognized by the compiler) or in the heap (for + * global variables and any variable not known to the compiler). For each + * Var structure in the heap, a hash table entry holds the variable name and + * a pointer to the Var structure. + */ + +typedef struct Var { + union { + Tcl_Obj *objPtr; /* The variable's object value. Used for + * scalar variables and array elements. */ + Tcl_HashTable *tablePtr;/* For array variables, this points to + * information about the hash table used + * to implement the associative array. + * Points to malloc-ed data. */ + struct Var *linkPtr; /* If this is a global variable being + * referred to in a procedure, or a variable + * created by "upvar", this field points to + * the referenced variable's Var struct. */ + } value; + char *name; /* NULL if the variable is in a hashtable, + * otherwise points to the variable's + * name. It is used, e.g., by TclLookupVar + * and "info locals". The storage for the + * characters of the name is not owned by + * the Var and must not be freed when + * freeing the Var. */ + Namespace *nsPtr; /* Points to the namespace that contains + * this variable or NULL if the variable is + * a local variable in a Tcl procedure. */ + Tcl_HashEntry *hPtr; /* If variable is in a hashtable, either the + * hash table entry that refers to this + * variable or NULL if the variable has been + * detached from its hash table (e.g. an + * array is deleted, but some of its + * elements are still referred to in + * upvars). NULL if the variable is not in a + * hashtable. This is used to delete an + * variable from its hashtable if it is no + * longer needed. */ + int refCount; /* Counts number of active uses of this + * variable, not including its entry in the + * call frame or the hash table: 1 for each + * additional variable whose linkPtr points + * here, 1 for each nested trace active on + * variable, and 1 if the variable is a + * namespace variable. This record can't be + * deleted until refCount becomes 0. */ + VarTrace *tracePtr; /* First in list of all traces set for this + * variable. */ + ArraySearch *searchPtr; /* First in list of all searches active + * for this variable, or NULL if none. */ + int flags; /* Miscellaneous bits of information about + * variable. See below for definitions. */ +} Var; + +/* + * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and + * VAR_LINK) are mutually exclusive and give the "type" of the variable. + * VAR_UNDEFINED is independent of the variable's type. + * + * VAR_SCALAR - 1 means this is a scalar variable and not + * an array or link. The "objPtr" field points + * to the variable's value, a Tcl object. + * VAR_ARRAY - 1 means this is an array variable rather + * than a scalar variable or link. The + * "tablePtr" field points to the array's + * hashtable for its elements. + * VAR_LINK - 1 means this Var structure contains a + * pointer to another Var structure that + * either has the real value or is itself + * another VAR_LINK pointer. Variables like + * this come about through "upvar" and "global" + * commands, or through references to variables + * in enclosing namespaces. + * VAR_UNDEFINED - 1 means that the variable is in the process + * of being deleted. An undefined variable + * logically does not exist and survives only + * while it has a trace, or if it is a global + * variable currently being used by some + * procedure. + * VAR_IN_HASHTABLE - 1 means this variable is in a hashtable and + * the Var structure is malloced. 0 if it is + * a local variable that was assigned a slot + * in a procedure frame by the compiler so the + * Var storage is part of the call frame. + * VAR_TRACE_ACTIVE - 1 means that trace processing is currently + * underway for a read or write access, so + * new read or write accesses should not cause + * trace procedures to be called and the + * variable can't be deleted. + * VAR_ARRAY_ELEMENT - 1 means that this variable is an array + * element, so it is not legal for it to be + * an array itself (the VAR_ARRAY flag had + * better not be set). + * VAR_NAMESPACE_VAR - 1 means that this variable was declared + * as a namespace variable. This flag ensures + * it persists until its namespace is + * destroyed or until the variable is unset; + * it will persist even if it has not been + * initialized and is marked undefined. + * The variable's refCount is incremented to + * reflect the "reference" from its namespace. + * + * The following additional flags are used with the CompiledLocal type + * defined below: + * + * VAR_ARGUMENT - 1 means that this variable holds a procedure + * argument. + * VAR_TEMPORARY - 1 if the local variable is an anonymous + * temporary variable. Temporaries have a NULL + * name. + * VAR_RESOLVED - 1 if name resolution has been done for this + * variable. + */ + +#define VAR_SCALAR 0x1 +#define VAR_ARRAY 0x2 +#define VAR_LINK 0x4 +#define VAR_UNDEFINED 0x8 +#define VAR_IN_HASHTABLE 0x10 +#define VAR_TRACE_ACTIVE 0x20 +#define VAR_ARRAY_ELEMENT 0x40 +#define VAR_NAMESPACE_VAR 0x80 + +#define VAR_ARGUMENT 0x100 +#define VAR_TEMPORARY 0x200 +#define VAR_RESOLVED 0x400 + +/* + * Macros to ensure that various flag bits are set properly for variables. + * The ANSI C "prototypes" for these macros are: + * + * EXTERN void TclSetVarScalar _ANSI_ARGS_((Var *varPtr)); + * EXTERN void TclSetVarArray _ANSI_ARGS_((Var *varPtr)); + * EXTERN void TclSetVarLink _ANSI_ARGS_((Var *varPtr)); + * EXTERN void TclSetVarArrayElement _ANSI_ARGS_((Var *varPtr)); + * EXTERN void TclSetVarUndefined _ANSI_ARGS_((Var *varPtr)); + * EXTERN void TclClearVarUndefined _ANSI_ARGS_((Var *varPtr)); + */ + +#define TclSetVarScalar(varPtr) \ + (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR + +#define TclSetVarArray(varPtr) \ + (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY + +#define TclSetVarLink(varPtr) \ + (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK + +#define TclSetVarArrayElement(varPtr) \ + (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT + +#define TclSetVarUndefined(varPtr) \ + (varPtr)->flags |= VAR_UNDEFINED + +#define TclClearVarUndefined(varPtr) \ + (varPtr)->flags &= ~VAR_UNDEFINED + +/* + * Macros to read various flag bits of variables. + * The ANSI C "prototypes" for these macros are: + * + * EXTERN int TclIsVarScalar _ANSI_ARGS_((Var *varPtr)); + * EXTERN int TclIsVarLink _ANSI_ARGS_((Var *varPtr)); + * EXTERN int TclIsVarArray _ANSI_ARGS_((Var *varPtr)); + * EXTERN int TclIsVarUndefined _ANSI_ARGS_((Var *varPtr)); + * EXTERN int TclIsVarArrayElement _ANSI_ARGS_((Var *varPtr)); + * EXTERN int TclIsVarTemporary _ANSI_ARGS_((Var *varPtr)); + * EXTERN int TclIsVarArgument _ANSI_ARGS_((Var *varPtr)); + * EXTERN int TclIsVarResolved _ANSI_ARGS_((Var *varPtr)); + */ + +#define TclIsVarScalar(varPtr) \ + ((varPtr)->flags & VAR_SCALAR) + +#define TclIsVarLink(varPtr) \ + ((varPtr)->flags & VAR_LINK) + +#define TclIsVarArray(varPtr) \ + ((varPtr)->flags & VAR_ARRAY) + +#define TclIsVarUndefined(varPtr) \ + ((varPtr)->flags & VAR_UNDEFINED) + +#define TclIsVarArrayElement(varPtr) \ + ((varPtr)->flags & VAR_ARRAY_ELEMENT) + +#define TclIsVarTemporary(varPtr) \ + ((varPtr)->flags & VAR_TEMPORARY) + +#define TclIsVarArgument(varPtr) \ + ((varPtr)->flags & VAR_ARGUMENT) + +#define TclIsVarResolved(varPtr) \ + ((varPtr)->flags & VAR_RESOLVED) + +/* + *---------------------------------------------------------------- + * Data structures related to procedures. These are used primarily + * in tclProc.c, tclCompile.c, and tclExecute.c. + *---------------------------------------------------------------- + */ + +/* + * Forward declaration to prevent an error when the forward reference to + * Command is encountered in the Proc and ImportRef types declared below. + */ + +struct Command; + +/* + * The variable-length structure below describes a local variable of a + * procedure that was recognized by the compiler. These variables have a + * name, an element in the array of compiler-assigned local variables in the + * procedure's call frame, and various other items of information. If the + * local variable is a formal argument, it may also have a default value. + * The compiler can't recognize local variables whose names are + * expressions (these names are only known at runtime when the expressions + * are evaluated) or local variables that are created as a result of an + * "upvar" or "uplevel" command. These other local variables are kept + * separately in a hash table in the call frame. + */ + +typedef struct CompiledLocal { + struct CompiledLocal *nextPtr; + /* Next compiler-recognized local variable + * for this procedure, or NULL if this is + * the last local. */ + int nameLength; /* The number of characters in local + * variable's name. Used to speed up + * variable lookups. */ + int frameIndex; /* Index in the array of compiler-assigned + * variables in the procedure call frame. */ + int flags; /* Flag bits for the local variable. Same as + * the flags for the Var structure above, + * although only VAR_SCALAR, VAR_ARRAY, + * VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and + * VAR_RESOLVED make sense. */ + Tcl_Obj *defValuePtr; /* Pointer to the default value of an + * argument, if any. NULL if not an argument + * or, if an argument, no default value. */ + Tcl_ResolvedVarInfo *resolveInfo; + /* Customized variable resolution info + * supplied by the Tcl_ResolveCompiledVarProc + * associated with a namespace. Each variable + * is marked by a unique ClientData tag + * during compilation, and that same tag + * is used to find the variable at runtime. */ + char name[4]; /* Name of the local variable starts here. + * If the name is NULL, this will just be + * '\0'. The actual size of this field will + * be large enough to hold the name. MUST + * BE THE LAST FIELD IN THE STRUCTURE! */ +} CompiledLocal; + +/* + * The structure below defines a command procedure, which consists of a + * collection of Tcl commands plus information about arguments and other + * local variables recognized at compile time. + */ + +typedef struct Proc { + struct Interp *iPtr; /* Interpreter for which this command + * is defined. */ + int refCount; /* Reference count: 1 if still present + * in command table plus 1 for each call + * to the procedure that is currently + * active. This structure can be freed + * when refCount becomes zero. */ + struct Command *cmdPtr; /* Points to the Command structure for + * this procedure. This is used to get + * the namespace in which to execute + * the procedure. */ + Tcl_Obj *bodyPtr; /* Points to the ByteCode object for + * procedure's body command. */ + int numArgs; /* Number of formal parameters. */ + int numCompiledLocals; /* Count of local variables recognized by + * the compiler including arguments and + * temporaries. */ + CompiledLocal *firstLocalPtr; /* Pointer to first of the procedure's + * compiler-allocated local variables, or + * NULL if none. The first numArgs entries + * in this list describe the procedure's + * formal arguments. */ + CompiledLocal *lastLocalPtr; /* Pointer to the last allocated local + * variable or NULL if none. This has + * frame index (numCompiledLocals-1). */ +} Proc; + +/* + * The structure below defines a command trace. This is used to allow Tcl + * clients to find out whenever a command is about to be executed. + */ + +typedef struct Trace { + int level; /* Only trace commands at nesting level + * less than or equal to this. */ + Tcl_CmdTraceProc *proc; /* Procedure to call to trace command. */ + ClientData clientData; /* Arbitrary value to pass to proc. */ + struct Trace *nextPtr; /* Next in list of traces for this interp. */ +} Trace; + +/* + * The structure below defines an entry in the assocData hash table which + * is associated with an interpreter. The entry contains a pointer to a + * function to call when the interpreter is deleted, and a pointer to + * a user-defined piece of data. + */ + +typedef struct AssocData { + Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */ + ClientData clientData; /* Value to pass to proc. */ +} AssocData; + +/* + * The structure below defines a call frame. A call frame defines a naming + * context for a procedure call: its local naming scope (for local + * variables) and its global naming scope (a namespace, perhaps the global + * :: namespace). A call frame can also define the naming context for a + * namespace eval or namespace inscope command: the namespace in which the + * command's code should execute. The Tcl_CallFrame structures exist only + * while procedures or namespace eval/inscope's are being executed, and + * provide a kind of Tcl call stack. + * + * WARNING!! The structure definition must be kept consistent with the + * Tcl_CallFrame structure in tcl.h. If you change one, change the other. + */ + +typedef struct CallFrame { + Namespace *nsPtr; /* Points to the namespace used to resolve + * commands and global variables. */ + int isProcCallFrame; /* If nonzero, the frame was pushed to + * execute a Tcl procedure and may have + * local vars. If 0, the frame was pushed + * to execute a namespace command and var + * references are treated as references to + * namespace vars; varTablePtr and + * compiledLocals are ignored. */ + int objc; /* This and objv below describe the + * arguments for this procedure call. */ + Tcl_Obj *CONST *objv; /* Array of argument objects. */ + struct CallFrame *callerPtr; + /* Value of interp->framePtr when this + * procedure was invoked (i.e. next higher + * in stack of all active procedures). */ + struct CallFrame *callerVarPtr; + /* Value of interp->varFramePtr when this + * procedure was invoked (i.e. determines + * variable scoping within caller). Same + * as callerPtr unless an "uplevel" command + * or something equivalent was active in + * the caller). */ + int level; /* Level of this procedure, for "uplevel" + * purposes (i.e. corresponds to nesting of + * callerVarPtr's, not callerPtr's). 1 for + * outermost procedure, 0 for top-level. */ + Proc *procPtr; /* Points to the structure defining the + * called procedure. Used to get information + * such as the number of compiled local + * variables (local variables assigned + * entries ["slots"] in the compiledLocals + * array below). */ + Tcl_HashTable *varTablePtr; /* Hash table containing local variables not + * recognized by the compiler, or created at + * execution time through, e.g., upvar. + * Initially NULL and created if needed. */ + int numCompiledLocals; /* Count of local variables recognized by + * the compiler including arguments. */ + Var* compiledLocals; /* Points to the array of local variables + * recognized by the compiler. The compiler + * emits code that refers to these variables + * using an index into this array. */ +} CallFrame; + +/* + *---------------------------------------------------------------- + * Data structures and procedures related to TclHandles, which + * are a very lightweight method of preserving enough information + * to determine if an arbitrary malloc'd block has been deleted. + *---------------------------------------------------------------- + */ + +typedef VOID **TclHandle; + +EXTERN TclHandle TclHandleCreate _ANSI_ARGS_((VOID *ptr)); +EXTERN void TclHandleFree _ANSI_ARGS_((TclHandle handle)); +EXTERN TclHandle TclHandlePreserve _ANSI_ARGS_((TclHandle handle)); +EXTERN void TclHandleRelease _ANSI_ARGS_((TclHandle handle)); + +/* + *---------------------------------------------------------------- + * Data structures related to history. These are used primarily + * in tclHistory.c + *---------------------------------------------------------------- + */ + +/* + * The structure below defines one history event (a previously-executed + * command that can be re-executed in whole or in part). + */ + +typedef struct { + char *command; /* String containing previously-executed + * command. */ + int bytesAvl; /* Total # of bytes available at *event (not + * all are necessarily in use now). */ +} HistoryEvent; + +/* + * The structure below defines a pending revision to the most recent + * history event. Changes are linked together into a list and applied + * during the next call to Tcl_RecordHistory. See the comments at the + * beginning of tclHistory.c for information on revisions. + */ + +typedef struct HistoryRev { + int firstIndex; /* Index of the first byte to replace in + * current history event. */ + int lastIndex; /* Index of last byte to replace in + * current history event. */ + int newSize; /* Number of bytes in newBytes. */ + char *newBytes; /* Replacement for the range given by + * firstIndex and lastIndex (malloced). */ + struct HistoryRev *nextPtr; /* Next in chain of revisions to apply, or + * NULL for end of list. */ +} HistoryRev; + +/* + *---------------------------------------------------------------- + * Data structures related to expressions. These are used only in + * tclExpr.c. + *---------------------------------------------------------------- + */ + +/* + * The data structure below defines a math function (e.g. sin or hypot) + * for use in Tcl expressions. + */ + +#define MAX_MATH_ARGS 5 +typedef struct MathFunc { + int builtinFuncIndex; /* If this is a builtin math function, its + * index in the array of builtin functions. + * (tclCompilation.h lists these indices.) + * The value is -1 if this is a new function + * defined by Tcl_CreateMathFunc. The value + * is also -1 if a builtin function is + * replaced by a Tcl_CreateMathFunc call. */ + int numArgs; /* Number of arguments for function. */ + Tcl_ValueType argTypes[MAX_MATH_ARGS]; + /* Acceptable types for each argument. */ + Tcl_MathProc *proc; /* Procedure that implements this function. + * NULL if isBuiltinFunc is 1. */ + ClientData clientData; /* Additional argument to pass to the + * function when invoking it. NULL if + * isBuiltinFunc is 1. */ +} MathFunc; + +/* + * These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet + * when threads are used, or an emulation if there are no threads. These + * are really internal and Tcl clients should use Tcl_GetThreadData. + */ + +EXTERN VOID *TclThreadDataKeyGet _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr)); +EXTERN void TclThreadDataKeySet _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr, VOID *data)); + +/* + * This is a convenience macro used to initialize a thread local storage ptr. + */ +#define TCL_TSD_INIT(keyPtr) (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) + + +#ifdef MAC_TCL +typedef pascal void *(Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); +#else +typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); +#endif + +/* + *---------------------------------------------------------------- + * Data structures related to bytecode compilation and execution. + * These are used primarily in tclCompile.c, tclExecute.c, and + * tclBasic.c. + *---------------------------------------------------------------- + */ + +/* + * Forward declaration to prevent errors when the forward references to + * Tcl_Parse and CompileEnv are encountered in the procedure type + * CompileProc declared below. + */ + +struct CompileEnv; + +/* + * The type of procedures called by the Tcl bytecode compiler to compile + * commands. Pointers to these procedures are kept in the Command structure + * describing each command. When a CompileProc returns, the interpreter's + * result is set to error information, if any. In addition, the CompileProc + * returns an integer value, which is one of the following: + * + * TCL_OK Compilation completed normally. + * TCL_ERROR Compilation failed because of an error; + * the interpreter's result describes what went wrong. + * TCL_OUT_LINE_COMPILE Compilation failed because, e.g., the command is + * too complex for effective inline compilation. The + * CompileProc believes the command is legal but + * should be compiled "out of line" by emitting code + * to invoke its command procedure at runtime. + */ + +#define TCL_OUT_LINE_COMPILE (TCL_CONTINUE + 1) + +typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr)); + +/* + * The type of procedure called from the compilation hook point in + * SetByteCodeFromAny. + */ + +typedef int (CompileHookProc) _ANSI_ARGS_((Tcl_Interp *interp, + struct CompileEnv *compEnvPtr, ClientData clientData)); + +/* + * The data structure defining the execution environment for ByteCode's. + * There is one ExecEnv structure per Tcl interpreter. It holds the + * evaluation stack that holds command operands and results. The stack grows + * towards increasing addresses. The "stackTop" member is cached by + * TclExecuteByteCode in a local variable: it must be set before calling + * TclExecuteByteCode and will be restored by TclExecuteByteCode before it + * returns. + */ + +typedef struct ExecEnv { + Tcl_Obj **stackPtr; /* Points to the first item in the + * evaluation stack on the heap. */ + int stackTop; /* Index of current top of stack; -1 when + * the stack is empty. */ + int stackEnd; /* Index of last usable item in stack. */ +} ExecEnv; + +/* + * The definitions for the LiteralTable and LiteralEntry structures. Each + * interpreter contains a LiteralTable. It is used to reduce the storage + * needed for all the Tcl objects that hold the literals of scripts compiled + * by the interpreter. A literal's object is shared by all the ByteCodes + * that refer to the literal. Each distinct literal has one LiteralEntry + * entry in the LiteralTable. A literal table is a specialized hash table + * that is indexed by the literal's string representation, which may contain + * null characters. + * + * Note that we reduce the space needed for literals by sharing literal + * objects both within a ByteCode (each ByteCode contains a local + * LiteralTable) and across all an interpreter's ByteCodes (with the + * interpreter's global LiteralTable). + */ + +typedef struct LiteralEntry { + struct LiteralEntry *nextPtr; /* Points to next entry in this + * hash bucket or NULL if end of + * chain. */ + Tcl_Obj *objPtr; /* Points to Tcl object that + * holds the literal's bytes and + * length. */ + int refCount; /* If in an interpreter's global + * literal table, the number of + * ByteCode structures that share + * the literal object; the literal + * entry can be freed when refCount + * drops to 0. If in a local literal + * table, -1. */ +} LiteralEntry; + +typedef struct LiteralTable { + LiteralEntry **buckets; /* Pointer to bucket array. Each + * element points to first entry in + * bucket's hash chain, or NULL. */ + LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; + /* Bucket array used for small + * tables to avoid mallocs and + * frees. */ + int numBuckets; /* Total number of buckets allocated + * at **buckets. */ + int numEntries; /* Total number of entries present + * in table. */ + int rebuildSize; /* Enlarge table when numEntries + * gets to be this large. */ + int mask; /* Mask value used in hashing + * function. */ +} LiteralTable; + +/* + * The following structure defines for each Tcl interpreter various + * statistics-related information about the bytecode compiler and + * interpreter's operation in that interpreter. + */ + +#ifdef TCL_COMPILE_STATS +typedef struct ByteCodeStats { + long numExecutions; /* Number of ByteCodes executed. */ + long numCompilations; /* Number of ByteCodes created. */ + long numByteCodesFreed; /* Number of ByteCodes destroyed. */ + long instructionCount[256]; /* Number of times each instruction was + * executed. */ + + double totalSrcBytes; /* Total source bytes ever compiled. */ + double totalByteCodeBytes; /* Total bytes for all ByteCodes. */ + double currentSrcBytes; /* Src bytes for all current ByteCodes. */ + double currentByteCodeBytes; /* Code bytes in all current ByteCodes. */ + + long srcCount[32]; /* Source size distribution: # of srcs of + * size [2**(n-1)..2**n), n in [0..32). */ + long byteCodeCount[32]; /* ByteCode size distribution. */ + long lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ + + double currentInstBytes; /* Instruction bytes-current ByteCodes. */ + double currentLitBytes; /* Current literal bytes. */ + double currentExceptBytes; /* Current exception table bytes. */ + double currentAuxBytes; /* Current auxiliary information bytes. */ + double currentCmdMapBytes; /* Current src<->code map bytes. */ + + long numLiteralsCreated; /* Total literal objects ever compiled. */ + double totalLitStringBytes; /* Total string bytes in all literals. */ + double currentLitStringBytes; /* String bytes in current literals. */ + long literalCount[32]; /* Distribution of literal string sizes. */ +} ByteCodeStats; +#endif /* TCL_COMPILE_STATS */ + +/* + *---------------------------------------------------------------- + * Data structures related to commands. + *---------------------------------------------------------------- + */ + +/* + * An imported command is created in an namespace when it imports a "real" + * command from another namespace. An imported command has a Command + * structure that points (via its ClientData value) to the "real" Command + * structure in the source namespace's command table. The real command + * records all the imported commands that refer to it in a list of ImportRef + * structures so that they can be deleted when the real command is deleted. */ + +typedef struct ImportRef { + struct Command *importedCmdPtr; + /* Points to the imported command created in + * an importing namespace; this command + * redirects its invocations to the "real" + * command. */ + struct ImportRef *nextPtr; /* Next element on the linked list of + * imported commands that refer to the + * "real" command. The real command deletes + * these imported commands on this list when + * it is deleted. */ +} ImportRef; + +/* + * Data structure used as the ClientData of imported commands: commands + * created in an namespace when it imports a "real" command from another + * namespace. + */ + +typedef struct ImportedCmdData { + struct Command *realCmdPtr; /* "Real" command that this imported command + * refers to. */ + struct Command *selfPtr; /* Pointer to this imported command. Needed + * only when deleting it in order to remove + * it from the real command's linked list of + * imported commands that refer to it. */ +} ImportedCmdData; + +/* + * A Command structure exists for each command in a namespace. The + * Tcl_Command opaque type actually refers to these structures. + */ + +typedef struct Command { + Tcl_HashEntry *hPtr; /* Pointer to the hash table entry that + * refers to this command. The hash table is + * either a namespace's command table or an + * interpreter's hidden command table. This + * pointer is used to get a command's name + * from its Tcl_Command handle. NULL means + * that the hash table entry has been + * removed already (this can happen if + * deleteProc causes the command to be + * deleted or recreated). */ + Namespace *nsPtr; /* Points to the namespace containing this + * command. */ + int refCount; /* 1 if in command hashtable plus 1 for each + * reference from a CmdName Tcl object + * representing a command's name in a + * ByteCode instruction sequence. This + * structure can be freed when refCount + * becomes zero. */ + int cmdEpoch; /* Incremented to invalidate any references + * that point to this command when it is + * renamed, deleted, hidden, or exposed. */ + CompileProc *compileProc; /* Procedure called to compile command. NULL + * if no compile proc exists for command. */ + Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ + ClientData objClientData; /* Arbitrary value passed to object proc. */ + Tcl_CmdProc *proc; /* String-based command procedure. */ + ClientData clientData; /* Arbitrary value passed to string proc. */ + Tcl_CmdDeleteProc *deleteProc; + /* Procedure invoked when deleting command + * to, e.g., free all client data. */ + ClientData deleteData; /* Arbitrary value passed to deleteProc. */ + int deleted; /* Means that the command is in the process + * of being deleted (its deleteProc is + * currently executing). Other attempts to + * delete the command should be ignored. */ + ImportRef *importRefPtr; /* List of each imported Command created in + * another namespace when this command is + * imported. These imported commands + * redirect invocations back to this + * command. The list is used to remove all + * those imported commands when deleting + * this "real" command. */ +} Command; + +/* + *---------------------------------------------------------------- + * Data structures related to name resolution procedures. + *---------------------------------------------------------------- + */ + +/* + * The interpreter keeps a linked list of name resolution schemes. + * The scheme for a namespace is consulted first, followed by the + * list of schemes in an interpreter, followed by the default + * name resolution in Tcl. Schemes are added/removed from the + * interpreter's list by calling Tcl_AddInterpResolver and + * Tcl_RemoveInterpResolver. + */ + +typedef struct ResolverScheme { + char *name; /* Name identifying this scheme. */ + Tcl_ResolveCmdProc *cmdResProc; + /* Procedure handling command name + * resolution. */ + Tcl_ResolveVarProc *varResProc; + /* Procedure handling variable name + * resolution for variables that + * can only be handled at runtime. */ + Tcl_ResolveCompiledVarProc *compiledVarResProc; + /* Procedure handling variable name + * resolution at compile time. */ + + struct ResolverScheme *nextPtr; + /* Pointer to next record in linked list. */ +} ResolverScheme; + +/* + *---------------------------------------------------------------- + * This structure defines an interpreter, which is a collection of + * commands plus other state information related to interpreting + * commands, such as variable storage. Primary responsibility for + * this data structure is in tclBasic.c, but almost every Tcl + * source file uses something in here. + *---------------------------------------------------------------- + */ + +typedef struct Interp { + + /* + * Note: the first three fields must match exactly the fields in + * a Tcl_Interp struct (see tcl.h). If you change one, be sure to + * change the other. + * + * The interpreter's result is held in both the string and the + * objResultPtr fields. These fields hold, respectively, the result's + * string or object value. The interpreter's result is always in the + * result field if that is non-empty, otherwise it is in objResultPtr. + * The two fields are kept consistent unless some C code sets + * interp->result directly. Programs should not access result and + * objResultPtr directly; instead, they should always get and set the + * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, + * and Tcl_GetStringResult. See the SetResult man page for details. + */ + + char *result; /* If the last command returned a string + * result, this points to it. Should not be + * accessed directly; see comment above. */ + Tcl_FreeProc *freeProc; /* Zero means a string result is statically + * allocated. TCL_DYNAMIC means string + * result was allocated with ckalloc and + * should be freed with ckfree. Other values + * give address of procedure to invoke to + * free the string result. Tcl_Eval must + * free it before executing next command. */ + int errorLine; /* When TCL_ERROR is returned, this gives + * the line number in the command where the + * error occurred (1 means first line). */ + struct TclStubs *stubTable; + /* Pointer to the exported Tcl stub table. + * On previous versions of Tcl this is a + * pointer to the objResultPtr or a pointer + * to a buckets array in a hash table. We + * therefore have to do some careful checking + * before we can use this. */ + + TclHandle handle; /* Handle used to keep track of when this + * interp is deleted. */ + + Namespace *globalNsPtr; /* The interpreter's global namespace. */ + Tcl_HashTable *hiddenCmdTablePtr; + /* Hash table used by tclBasic.c to keep + * track of hidden commands on a per-interp + * basis. */ + ClientData interpInfo; /* Information used by tclInterp.c to keep + * track of master/slave interps on + * a per-interp basis. */ + Tcl_HashTable mathFuncTable;/* Contains all the math functions currently + * defined for the interpreter. Indexed by + * strings (function names); values have + * type (MathFunc *). */ + + + + /* + * Information related to procedures and variables. See tclProc.c + * and tclvar.c for usage. + */ + + int numLevels; /* Keeps track of how many nested calls to + * Tcl_Eval are in progress for this + * interpreter. It's used to delay deletion + * of the table until all Tcl_Eval + * invocations are completed. */ + int maxNestingDepth; /* If numLevels exceeds this value then Tcl + * assumes that infinite recursion has + * occurred and it generates an error. */ + CallFrame *framePtr; /* Points to top-most in stack of all nested + * procedure invocations. NULL means there + * are no active procedures. */ + CallFrame *varFramePtr; /* Points to the call frame whose variables + * are currently in use (same as framePtr + * unless an "uplevel" command is + * executing). NULL means no procedure is + * active or "uplevel 0" is executing. */ + ActiveVarTrace *activeTracePtr; + /* First in list of active traces for + * interp, or NULL if no active traces. */ + int returnCode; /* Completion code to return if current + * procedure exits with TCL_RETURN code. */ + char *errorInfo; /* Value to store in errorInfo if returnCode + * is TCL_ERROR. Malloc'ed, may be NULL */ + char *errorCode; /* Value to store in errorCode if returnCode + * is TCL_ERROR. Malloc'ed, may be NULL */ + + /* + * Information used by Tcl_AppendResult to keep track of partial + * results. See Tcl_AppendResult code for details. + */ + + char *appendResult; /* Storage space for results generated + * by Tcl_AppendResult. Malloc-ed. NULL + * means not yet allocated. */ + int appendAvl; /* Total amount of space available at + * partialResult. */ + int appendUsed; /* Number of non-null bytes currently + * stored at partialResult. */ + + /* + * Information about packages. Used only in tclPkg.c. + */ + + Tcl_HashTable packageTable; /* Describes all of the packages loaded + * in or available to this interpreter. + * Keys are package names, values are + * (Package *) pointers. */ + char *packageUnknown; /* Command to invoke during "package + * require" commands for packages that + * aren't described in packageTable. + * Malloc'ed, may be NULL. */ + + /* + * Miscellaneous information: + */ + + int cmdCount; /* Total number of times a command procedure + * has been called for this interpreter. */ + int evalFlags; /* Flags to control next call to Tcl_Eval. + * Normally zero, but may be set before + * calling Tcl_Eval. See below for valid + * values. */ + int termOffset; /* Offset of character just after last one + * compiled or executed by Tcl_EvalObj. */ + LiteralTable literalTable; /* Contains LiteralEntry's describing all + * Tcl objects holding literals of scripts + * compiled by the interpreter. Indexed by + * the string representations of literals. + * Used to avoid creating duplicate + * objects. */ + int compileEpoch; /* Holds the current "compilation epoch" + * for this interpreter. This is + * incremented to invalidate existing + * ByteCodes when, e.g., a command with a + * compile procedure is redefined. */ + Proc *compiledProcPtr; /* If a procedure is being compiled, a + * pointer to its Proc structure; otherwise, + * this is NULL. Set by ObjInterpProc in + * tclProc.c and used by tclCompile.c to + * process local variables appropriately. */ + ResolverScheme *resolverPtr; + /* Linked list of name resolution schemes + * added to this interpreter. Schemes + * are added/removed by calling + * Tcl_AddInterpResolvers and + * Tcl_RemoveInterpResolver. */ + char *scriptFile; /* NULL means there is no nested source + * command active; otherwise this points to + * the name of the file being sourced (it's + * not malloc-ed: it points to an argument + * to Tcl_EvalFile. */ + int flags; /* Various flag bits. See below. */ + long randSeed; /* Seed used for rand() function. */ + Trace *tracePtr; /* List of traces for this interpreter. */ + Tcl_HashTable *assocData; /* Hash table for associating data with + * this interpreter. Cleaned up when + * this interpreter is deleted. */ + struct ExecEnv *execEnvPtr; /* Execution environment for Tcl bytecode + * execution. Contains a pointer to the + * Tcl evaluation stack. */ + Tcl_Obj *emptyObjPtr; /* Points to an object holding an empty + * string. Returned by Tcl_ObjSetVar2 when + * variable traces change a variable in a + * gross way. */ + char resultSpace[TCL_RESULT_SIZE+1]; + /* Static space holding small results. */ + Tcl_Obj *objResultPtr; /* If the last command returned an object + * result, this points to it. Should not be + * accessed directly; see comment above. */ + Tcl_ThreadId threadId; /* ID of thread that owns the interpreter */ + + /* + * Statistical information about the bytecode compiler and interpreter's + * operation. + */ + +#ifdef TCL_COMPILE_STATS + ByteCodeStats stats; /* Holds compilation and execution + * statistics for this interpreter. */ +#endif /* TCL_COMPILE_STATS */ +} Interp; + +/* + * EvalFlag bits for Interp structures: + * + * TCL_BRACKET_TERM 1 means that the current script is terminated by + * a close bracket rather than the end of the string. + * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with + * a code other than TCL_OK or TCL_ERROR; 0 means + * codes other than these should be turned into errors. + */ + +#define TCL_BRACKET_TERM 1 +#define TCL_ALLOW_EXCEPTIONS 4 + +/* + * Flag bits for Interp structures: + * + * DELETED: Non-zero means the interpreter has been deleted: + * don't process any more commands for it, and destroy + * the structure as soon as all nested invocations of + * Tcl_Eval are done. + * ERR_IN_PROGRESS: Non-zero means an error unwind is already in + * progress. Zero means a command proc has been + * invoked since last error occured. + * ERR_ALREADY_LOGGED: Non-zero means information has already been logged + * in $errorInfo for the current Tcl_Eval instance, + * so Tcl_Eval needn't log it (used to implement the + * "error message log" command). + * ERROR_CODE_SET: Non-zero means that Tcl_SetErrorCode has been + * called to record information for the current + * error. Zero means Tcl_Eval must clear the + * errorCode variable if an error is returned. + * EXPR_INITIALIZED: Non-zero means initialization specific to + * expressions has been carried out. + * DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler + * should not compile any commands into an inline + * sequence of instructions. This is set 1, for + * example, when command traces are requested. + * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the + * interp has not be initialized. This is set 1 + * when we first use the rand() or srand() functions. + * SAFE_INTERP: Non zero means that the current interp is a + * safe interp (ie it has only the safe commands + * installed, less priviledge than a regular interp). + * USE_EVAL_DIRECT: Non-zero means don't use the compiler or byte-code + * interpreter; instead, have Tcl_EvalObj call + * Tcl_EvalEx. Used primarily for testing the + * new parser. + */ + +#define DELETED 1 +#define ERR_IN_PROGRESS 2 +#define ERR_ALREADY_LOGGED 4 +#define ERROR_CODE_SET 8 +#define EXPR_INITIALIZED 0x10 +#define DONT_COMPILE_CMDS_INLINE 0x20 +#define RAND_SEED_INITIALIZED 0x40 +#define SAFE_INTERP 0x80 +#define USE_EVAL_DIRECT 0x100 + +/* + *---------------------------------------------------------------- + * Data structures related to command parsing. These are used in + * tclParse.c and its clients. + *---------------------------------------------------------------- + */ + +/* + * The following data structure is used by various parsing procedures + * to hold information about where to store the results of parsing + * (e.g. the substituted contents of a quoted argument, or the result + * of a nested command). At any given time, the space available + * for output is fixed, but a procedure may be called to expand the + * space available if the current space runs out. + */ + +typedef struct ParseValue { + char *buffer; /* Address of first character in + * output buffer. */ + char *next; /* Place to store next character in + * output buffer. */ + char *end; /* Address of the last usable character + * in the buffer. */ + void (*expandProc) _ANSI_ARGS_((struct ParseValue *pvPtr, int needed)); + /* Procedure to call when space runs out; + * it will make more space. */ + ClientData clientData; /* Arbitrary information for use of + * expandProc. */ +} ParseValue; + + +/* + * Maximum number of levels of nesting permitted in Tcl commands (used + * to catch infinite recursion). + */ + +#define MAX_NESTING_DEPTH 1000 + +/* + * The macro below is used to modify a "char" value (e.g. by casting + * it to an unsigned character) so that it can be used safely with + * macros such as isspace. + */ + +#define UCHAR(c) ((unsigned char) (c)) + +/* + * This macro is used to determine the offset needed to safely allocate any + * data structure in memory. Given a starting offset or size, it "rounds up" + * or "aligns" the offset to the next 8-byte boundary so that any data + * structure can be placed at the resulting offset without fear of an + * alignment error. + * + * WARNING!! DO NOT USE THIS MACRO TO ALIGN POINTERS: it will produce + * the wrong result on platforms that allocate addresses that are divisible + * by 4 or 2. Only use it for offsets or sizes. + */ + +#define TCL_ALIGN(x) (((int)(x) + 7) & ~7) + +/* + * The following macros are used to specify the runtime platform + * setting of the tclPlatform variable. + */ + +typedef enum { + TCL_PLATFORM_UNIX, /* Any Unix-like OS. */ + TCL_PLATFORM_MAC, /* MacOS. */ + TCL_PLATFORM_WINDOWS /* Any Microsoft Windows OS. */ +} TclPlatformType; + +/* + * Flags for TclInvoke: + * + * TCL_INVOKE_HIDDEN Invoke a hidden command; if not set, + * invokes an exposed command. + * TCL_INVOKE_NO_UNKNOWN If set, "unknown" is not invoked if + * the command to be invoked is not found. + * Only has an effect if invoking an exposed + * command, i.e. if TCL_INVOKE_HIDDEN is not + * also set. + * TCL_INVOKE_NO_TRACEBACK Does not record traceback information if + * the invoked command returns an error. Used + * if the caller plans on recording its own + * traceback information. + */ + +#define TCL_INVOKE_HIDDEN (1<<0) +#define TCL_INVOKE_NO_UNKNOWN (1<<1) +#define TCL_INVOKE_NO_TRACEBACK (1<<2) + +/* + * The structure used as the internal representation of Tcl list + * objects. This is an array of pointers to the element objects. This array + * is grown (reallocated and copied) as necessary to hold all the list's + * element pointers. The array might contain more slots than currently used + * to hold all element pointers. This is done to make append operations + * faster. + */ + +typedef struct List { + int maxElemCount; /* Total number of element array slots. */ + int elemCount; /* Current number of list elements. */ + Tcl_Obj **elements; /* Array of pointers to element objects. */ +} List; + + +/* + * The following types are used for getting and storing platform-specific + * file attributes in tclFCmd.c and the various platform-versions of + * that file. This is done to have as much common code as possible + * in the file attributes code. For more information about the callbacks, + * see TclFileAttrsCmd in tclFCmd.c. + */ + +typedef int (TclGetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp, + int objIndex, CONST char *fileName, Tcl_Obj **attrObjPtrPtr)); +typedef int (TclSetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp, + int objIndex, CONST char *fileName, Tcl_Obj *attrObjPtr)); + +typedef struct TclFileAttrProcs { + TclGetFileAttrProc *getProc; /* The procedure for getting attrs. */ + TclSetFileAttrProc *setProc; /* The procedure for setting attrs. */ +} TclFileAttrProcs; + +/* + * Opaque handle used in pipeline routines to encapsulate platform-dependent + * state. + */ + +typedef struct TclFile_ *TclFile; + +/* + *---------------------------------------------------------------- + * Data structures related to hooking 'TclStat(...)' and + * 'TclAccess(...)'. + *---------------------------------------------------------------- + */ + +typedef int (TclStatProc_) _ANSI_ARGS_((CONST char *path, struct stat *buf)); +typedef int (TclAccessProc_) _ANSI_ARGS_((CONST char *path, int mode)); +typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp, + char *fileName, char *modeString, + int permissions)); + +typedef int (*TclCmdProcType) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char *argv[])); +typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[])); + +/* + * Opaque names for platform specific types. + */ + +typedef struct TclpTime_t_ *TclpTime_t; + +/* + *---------------------------------------------------------------- + * Variables shared among Tcl modules but not used by the outside world. + *---------------------------------------------------------------- + */ + +extern Tcl_Time tclBlockTime; +extern int tclBlockTimeSet; +extern char * tclExecutableName; +extern char * tclNativeExecutableName; +extern char * tclDefaultEncodingDir; +extern Tcl_ChannelType tclFileChannelType; +extern char * tclMemDumpFileName; +extern TclPlatformType tclPlatform; +extern char * tclpFileAttrStrings[]; +extern CONST TclFileAttrProcs tclpFileAttrProcs[]; + +/* + * Variables denoting the Tcl object types defined in the core. + */ + +extern Tcl_ObjType tclBooleanType; +extern Tcl_ObjType tclByteArrayType; +extern Tcl_ObjType tclByteCodeType; +extern Tcl_ObjType tclDoubleType; +extern Tcl_ObjType tclIntType; +extern Tcl_ObjType tclListType; +extern Tcl_ObjType tclProcBodyType; +extern Tcl_ObjType tclStringType; + +/* + * The head of the list of free Tcl objects, and the total number of Tcl + * objects ever allocated and freed. + */ + +extern Tcl_Obj * tclFreeObjList; + +#ifdef TCL_COMPILE_STATS +extern long tclObjsAlloced; +extern long tclObjsFreed; +#endif /* TCL_COMPILE_STATS */ + +/* + * Pointer to a heap-allocated string of length zero that the Tcl core uses + * as the value of an empty string representation for an object. This value + * is shared by all new objects allocated by Tcl_NewObj. + */ + +extern char * tclEmptyStringRep; + +/* + *---------------------------------------------------------------- + * Procedures shared among Tcl modules but not used by the outside + * world: + *---------------------------------------------------------------- + */ + +EXTERN int TclAccess _ANSI_ARGS_((CONST char *path, + int mode)); +EXTERN int TclAccessDeleteProc _ANSI_ARGS_((TclAccessProc_ *proc)); +EXTERN int TclAccessInsertProc _ANSI_ARGS_((TclAccessProc_ *proc)); +EXTERN void TclAllocateFreeObjects _ANSI_ARGS_((void)); +EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj)); +EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp, + int numPids, Tcl_Pid *pidPtr, + Tcl_Channel errorChan)); +EXTERN void TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr)); +EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Channel inChan, Tcl_Channel outChan, + int toRead, Tcl_Obj *cmdPtr)); +/* + * TclCreatePipeline unofficially exported for use by BLT. + */ +EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp, + int argc, char **argv, Tcl_Pid **pidArrayPtr, + TclFile *inPipePtr, TclFile *outPipePtr, + TclFile *errFilePtr)); +EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp, + Namespace *nsPtr, char *procName, + Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, + Proc **procPtrPtr)); +EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_(( + Interp *iPtr, CallFrame *framePtr)); +EXTERN void TclDeleteVars _ANSI_ARGS_((Interp *iPtr, + Tcl_HashTable *tablePtr)); +EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp *interp, + char *separators, Tcl_DString *headPtr, + char *tail)); +EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile)); +EXTERN void TclExpandTokenArray _ANSI_ARGS_(( + Tcl_Parse *parsePtr)); +EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp, + double value)); +EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); +EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp, + int argc, char **argv)) ; +EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp, + int argc, char **argv)); +EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp, + int argc, char **argv)) ; +EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp, + int argc, char **argv)) ; +EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_((void)); +EXTERN void TclFinalizeCompExecEnv _ANSI_ARGS_((void)); +EXTERN void TclFinalizeCondition _ANSI_ARGS_(( + Tcl_Condition *condPtr)); +EXTERN void TclFinalizeCompilation _ANSI_ARGS_((void)); +EXTERN void TclFinalizeEncodingSubsystem _ANSI_ARGS_((void)); +EXTERN void TclFinalizeEnvironment _ANSI_ARGS_((void)); +EXTERN void TclFinalizeExecution _ANSI_ARGS_((void)); +EXTERN void TclFinalizeIOSubsystem _ANSI_ARGS_((void)); +EXTERN void TclFinalizeLoad _ANSI_ARGS_((void)); +EXTERN void TclFinalizeMemorySubsystem _ANSI_ARGS_((void)); +EXTERN void TclFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutex)); +EXTERN void TclFinalizeNotifier _ANSI_ARGS_((void)); +EXTERN void TclFinalizeSynchronization _ANSI_ARGS_((void)); +EXTERN void TclFinalizeThreadData _ANSI_ARGS_((void)); +EXTERN void TclFindEncodings _ANSI_ARGS_((CONST char *argv0)); +EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp *iPtr, + char *procName)); +EXTERN int TclFormatInt _ANSI_ARGS_((char *buffer, long n)); +EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp *iPtr)); +EXTERN int TclGetDate _ANSI_ARGS_((char *p, + unsigned long now, long zone, + unsigned long *timePtr)); +EXTERN Tcl_Obj * TclGetElementOfIndexedArray _ANSI_ARGS_(( + Tcl_Interp *interp, int localIndex, + Tcl_Obj *elemPtr, int leaveErrorMsg)); +EXTERN char * TclGetExtension _ANSI_ARGS_((char *name)); +EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp, + char *string, CallFrame **framePtrPtr)); +EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void)); +EXTERN int TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr, int endValue, int *indexPtr)); +EXTERN Tcl_Obj * TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp, + int localIndex, int leaveErrorMsg)); +EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp *interp, + char *string, long *longPtr)); +EXTERN int TclGetLoadedPackages _ANSI_ARGS_(( + Tcl_Interp *interp, char *targetName)); +EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_(( + Tcl_Interp *interp, char *qualName, + Namespace *cxtNsPtr, int flags, + Namespace **nsPtrPtr, Namespace **altNsPtrPtr, + Namespace **actualCxtPtrPtr, + char **simpleNamePtr)); +EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void)); +EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp, + char *string, int *seekFlagPtr)); +EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_(( + Tcl_Command command)); +EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp, + char *pattern, int noComplain)); +EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp, + int argc, char **argv, int flags)); +EXTERN int TclGuessPackageName _ANSI_ARGS_((char *fileName, + Tcl_DString *bufPtr)); +EXTERN int TclHideUnsafeCommands _ANSI_ARGS_(( + Tcl_Interp *interp)); +EXTERN int TclInExit _ANSI_ARGS_((void)); +EXTERN Tcl_Obj * TclIncrElementOfIndexedArray _ANSI_ARGS_(( + Tcl_Interp *interp, int localIndex, + Tcl_Obj *elemPtr, long incrAmount)); +EXTERN Tcl_Obj * TclIncrIndexedScalar _ANSI_ARGS_(( + Tcl_Interp *interp, int localIndex, + long incrAmount)); +EXTERN Tcl_Obj * TclIncrVar2 _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, + long incrAmount, int flags)); +EXTERN void TclInitAlloc _ANSI_ARGS_((void)); +EXTERN void TclInitCompiledLocals _ANSI_ARGS_(( + Tcl_Interp *interp, CallFrame *framePtr, + Namespace *nsPtr)); +EXTERN void TclInitDbCkalloc _ANSI_ARGS_((void)); +EXTERN void TclInitEncodingSubsystem _ANSI_ARGS_((void)); +EXTERN void TclInitIOSubsystem _ANSI_ARGS_((void)); +EXTERN void TclInitNamespaceSubsystem _ANSI_ARGS_((void)); +EXTERN void TclInitNotifier _ANSI_ARGS_((void)); +EXTERN void TclInitObjSubsystem _ANSI_ARGS_((void)); +EXTERN void TclInitSubsystems _ANSI_ARGS_((CONST char *argv0)); +EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp *interp, + int argc, char **argv, int flags)); +EXTERN int TclInvokeObjectCommand _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int argc, char **argv)); +EXTERN int TclInvokeStringCommand _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); +EXTERN int TclIsLocalScalar _ANSI_ARGS_((CONST char *src, + int len)); +EXTERN Proc * TclIsProc _ANSI_ARGS_((Command *cmdPtr)); +EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp, + char *part1, char *part2, int flags, char *msg, + int createPart1, int createPart2, + Var **arrayPtrPtr)); +EXTERN int TclMathInProgress _ANSI_ARGS_((void)); +EXTERN int TclNeedSpace _ANSI_ARGS_((char *start, char *end)); +EXTERN Tcl_Obj * TclNewProcBodyObj _ANSI_ARGS_((Proc *procPtr)); +EXTERN int TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj *cmdPtr)); +EXTERN int TclObjInterpProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[], int flags)); +EXTERN int TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[], int flags)); +EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_(( + TclOpenFileChannelProc_ *proc)); +EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_(( + TclOpenFileChannelProc_ *proc)); +EXTERN int TclpAccess _ANSI_ARGS_((CONST char *filename, + int mode)); +EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size)); +EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); +EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char *source, + CONST char *dest)); +EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char *source, + CONST char *dest, Tcl_DString *errorPtr)); +EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char *path)); +EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path)); +EXTERN void TclpExit _ANSI_ARGS_((int status)); +EXTERN void TclpFinalizeCondition _ANSI_ARGS_(( + Tcl_Condition *condPtr)); +EXTERN void TclpFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutexPtr)); +EXTERN void TclpFinalizeThreadData _ANSI_ARGS_(( + Tcl_ThreadDataKey *keyPtr)); +EXTERN void TclpFinalizeThreadDataKey _ANSI_ARGS_(( + Tcl_ThreadDataKey *keyPtr)); +EXTERN char * TclpFindExecutable _ANSI_ARGS_(( + CONST char *argv0)); +EXTERN int TclpFindVariable _ANSI_ARGS_((CONST char *name, + int *lengthPtr)); +EXTERN void TclpFree _ANSI_ARGS_((char *ptr)); +EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void)); +EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type)); +EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void)); +EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time *time)); +EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time)); +EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char *name, + Tcl_DString *bufferPtr)); +EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN void TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0)); +EXTERN void TclpInitLock _ANSI_ARGS_((void)); +EXTERN void TclpInitPlatform _ANSI_ARGS_((void)); +EXTERN void TclpInitUnlock _ANSI_ARGS_((void)); +EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN void TclpMasterLock _ANSI_ARGS_((void)); +EXTERN void TclpMasterUnlock _ANSI_ARGS_((void)); +EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp *interp, + char *separators, Tcl_DString *dirPtr, + char *pattern, char *tail)); +EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, + char *fileName, char *modeString, + int permissions)); +EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName, + Tcl_DString *linkPtr)); +EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr, + unsigned int size)); +EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file)); +EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char *path, + int recursive, Tcl_DString *errorPtr)); +EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char *source, + CONST char *dest)); +EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void)); +EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin)); +EXTERN void TclpSysFree _ANSI_ARGS_((VOID *ptr)); +EXTERN VOID * TclpSysRealloc _ANSI_ARGS_((VOID *cp, + unsigned int size)); +EXTERN void TclpUnloadFile _ANSI_ARGS_((ClientData clientData)); +EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); +EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Interp *cmdInterp, Tcl_Command cmd)); +EXTERN void TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr)); +EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp, + Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, + CONST char *description, CONST char *procName)); +EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData)); +EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int TclpThreadCreate _ANSI_ARGS_((Tcl_ThreadId *idPtr, + Tcl_ThreadCreateProc proc, ClientData clientData)); +EXTERN VOID * TclpThreadDataKeyGet _ANSI_ARGS_(( + Tcl_ThreadDataKey *keyPtr)); +EXTERN void TclpThreadDataKeyInit _ANSI_ARGS_(( + Tcl_ThreadDataKey *keyPtr)); +EXTERN void TclpThreadDataKeySet _ANSI_ARGS_(( + Tcl_ThreadDataKey *keyPtr, VOID *data)); +EXTERN void TclpThreadExit _ANSI_ARGS_((int status)); +EXTERN void TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex)); +EXTERN void TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex)); +EXTERN void TclRememberMutex _ANSI_ARGS_((Tcl_Mutex *mutex)); +EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp, + char *oldName, char *newName)) ; +EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_(( + Tcl_Interp *interp, Command *newCmdPtr)); +EXTERN int TclServiceIdle _ANSI_ARGS_((void)); +EXTERN Tcl_Obj * TclSetElementOfIndexedArray _ANSI_ARGS_(( + Tcl_Interp *interp, int localIndex, + Tcl_Obj *elemPtr, Tcl_Obj *objPtr, + int leaveErrorMsg)); +EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp, + int localIndex, Tcl_Obj *objPtr, + int leaveErrorMsg)); +EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char *string)); +EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp, + char *string, char *proto, int *portPtr)); +EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock, + int size)); +EXTERN int TclStat _ANSI_ARGS_((CONST char *path, + struct stat *buf)); +EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ *proc)); +EXTERN int TclStatInsertProc _ANSI_ARGS_((TclStatProc_ *proc)); +EXTERN void TclTeardownNamespace _ANSI_ARGS_((Namespace *nsPtr)); +EXTERN void TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp, + int result, Tcl_Interp *targetInterp)); +EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr)); + +/* + *---------------------------------------------------------------- + * Command procedures in the generic core: + *---------------------------------------------------------------- + */ + +EXTERN int Tcl_AfterObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_AppendObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ArrayObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_BinaryObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_BreakObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_CaseObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_CatchObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_CdObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ClockObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_CloseObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ConcatObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ContinueObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_EncodingObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_EofObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ErrorObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_EvalObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ExecObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ExitObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ExprObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_FblockedObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_FconfigureObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_FcopyObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_FileObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_FileEventObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_FlushObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ForObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ForeachObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_FormatObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_GetsObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_GlobalObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_GlobObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_IfObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_IncrObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_InfoObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_InterpObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_JoinObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LappendObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LindexObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LinsertObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LlengthObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ListObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LoadObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LrangeObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LreplaceObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LsearchObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_LsortObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_OpenObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_PackageObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_PidObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_PutsObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_PwdObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ReadObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_RegexpObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_RegsubObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_RenameObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ReturnObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ScanObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_SeekObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_SetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_SplitObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_SocketObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_SourceObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_StringObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_SubstObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_SwitchObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_TellObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_TimeObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_TraceObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_UnsetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_UpdateObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_UplevelObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_UpvarObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_VariableObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_VwaitObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_WhileObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); + +/* + *---------------------------------------------------------------- + * Command procedures found only in the Mac version of the core: + *---------------------------------------------------------------- + */ + +#ifdef MAC_TCL +EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tcl_LsObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_MacSourceObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_ResourceObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +#endif + +/* + *---------------------------------------------------------------- + * Compilation procedures for commands in the generic core: + *---------------------------------------------------------------- + */ + +EXTERN int TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); +EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); + +/* + *---------------------------------------------------------------- + * Macros used by the Tcl core to create and release Tcl objects. + * TclNewObj(objPtr) creates a new object denoting an empty string. + * TclDecrRefCount(objPtr) decrements the object's reference count, + * and frees the object if its reference count is zero. + * These macros are inline versions of Tcl_NewObj() and + * Tcl_DecrRefCount(). Notice that the names differ in not having + * a "_" after the "Tcl". Notice also that these macros reference + * their argument more than once, so you should avoid calling them + * with an expression that is expensive to compute or has + * side effects. The ANSI C "prototypes" for these macros are: + * + * EXTERN void TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr)); + * EXTERN void TclDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr)); + *---------------------------------------------------------------- + */ + +#ifdef TCL_COMPILE_STATS +# define TclIncrObjsAllocated() \ + tclObjsAlloced++ +# define TclIncrObjsFreed() \ + tclObjsFreed++ +#else +# define TclIncrObjsAllocated() +# define TclIncrObjsFreed() +#endif /* TCL_COMPILE_STATS */ + +#ifdef TCL_MEM_DEBUG +# define TclNewObj(objPtr) \ + (objPtr) = (Tcl_Obj *) \ + Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = tclEmptyStringRep; \ + (objPtr)->length = 0; \ + (objPtr)->typePtr = NULL; \ + TclIncrObjsAllocated() + +# define TclDbNewObj(objPtr, file, line) \ + (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = tclEmptyStringRep; \ + (objPtr)->length = 0; \ + (objPtr)->typePtr = NULL; \ + TclIncrObjsAllocated() + +# define TclDecrRefCount(objPtr) \ + if (--(objPtr)->refCount <= 0) { \ + if ((objPtr)->refCount < -1) \ + panic("Reference count for %lx was negative: %s line %d", \ + (objPtr), __FILE__, __LINE__); \ + if (((objPtr)->bytes != NULL) \ + && ((objPtr)->bytes != tclEmptyStringRep)) { \ + ckfree((char *) (objPtr)->bytes); \ + } \ + if (((objPtr)->typePtr != NULL) \ + && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \ + (objPtr)->typePtr->freeIntRepProc(objPtr); \ + } \ + ckfree((char *) (objPtr)); \ + TclIncrObjsFreed(); \ + } + +#else /* not TCL_MEM_DEBUG */ + +#ifdef TCL_THREADS +extern Tcl_Mutex tclObjMutex; +#endif + +# define TclNewObj(objPtr) \ + Tcl_MutexLock(&tclObjMutex); \ + if (tclFreeObjList == NULL) { \ + TclAllocateFreeObjects(); \ + } \ + (objPtr) = tclFreeObjList; \ + tclFreeObjList = (Tcl_Obj *) \ + tclFreeObjList->internalRep.otherValuePtr; \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = tclEmptyStringRep; \ + (objPtr)->length = 0; \ + (objPtr)->typePtr = NULL; \ + TclIncrObjsAllocated(); \ + Tcl_MutexUnlock(&tclObjMutex) + +# define TclDecrRefCount(objPtr) \ + if (--(objPtr)->refCount <= 0) { \ + if (((objPtr)->bytes != NULL) \ + && ((objPtr)->bytes != tclEmptyStringRep)) { \ + ckfree((char *) (objPtr)->bytes); \ + } \ + if (((objPtr)->typePtr != NULL) \ + && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \ + (objPtr)->typePtr->freeIntRepProc(objPtr); \ + } \ + Tcl_MutexLock(&tclObjMutex); \ + (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \ + tclFreeObjList = (objPtr); \ + TclIncrObjsFreed(); \ + Tcl_MutexUnlock(&tclObjMutex); \ + } +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------- + * Macro used by the Tcl core to set a Tcl_Obj's string representation + * to a copy of the "len" bytes starting at "bytePtr". This code + * works even if the byte array contains NULLs as long as the length + * is correct. Because "len" is referenced multiple times, it should + * be as simple an expression as possible. The ANSI C "prototype" for + * this macro is: + * + * EXTERN void TclInitStringRep _ANSI_ARGS_((Tcl_Obj *objPtr, + * char *bytePtr, int len)); + *---------------------------------------------------------------- + */ + +#define TclInitStringRep(objPtr, bytePtr, len) \ + if ((len) == 0) { \ + (objPtr)->bytes = tclEmptyStringRep; \ + (objPtr)->length = 0; \ + } else { \ + (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \ + memcpy((VOID *) (objPtr)->bytes, (VOID *) (bytePtr), \ + (unsigned) (len)); \ + (objPtr)->bytes[len] = '\0'; \ + (objPtr)->length = (len); \ + } + +/* + *---------------------------------------------------------------- + * Macro used by the Tcl core to get the string representation's + * byte array pointer from a Tcl_Obj. This is an inline version + * of Tcl_GetString(). The macro's expression result is the string + * rep's byte pointer which might be NULL. The bytes referenced by + * this pointer must not be modified by the caller. + * The ANSI C "prototype" for this macro is: + * + * EXTERN char * TclGetString _ANSI_ARGS_((Tcl_Obj *objPtr)); + *---------------------------------------------------------------- + */ + +#define TclGetString(objPtr) \ + ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr))) + +#include "tclIntDecls.h" + +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLIMPORT + +#endif /* _TCLINT */ + diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tclIntDecls.h ./canvas-tcl8.2.2/tclIntDecls.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tclIntDecls.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tclIntDecls.h Thu Dec 30 15:13:21 1999 @@ -0,0 +1,1363 @@ +/* + * tclIntDecls.h -- + * + * This file contains the declarations for all unsupported + * functions that are exported by the Tcl library. These + * interfaces are not guaranteed to remain the same between + * versions. Use at your own risk. + * + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclIntDecls.h,v 1.17 1999/08/10 02:42:14 welch Exp $ + */ + +#ifndef _TCLINTDECLS +#define _TCLINTDECLS + +/* + * WARNING: This file is automatically generated by the tools/genStubs.tcl + * script. Any modifications to the function declarations below should be made + * in the generic/tclInt.decls script. + */ + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + +/* 0 */ +EXTERN int TclAccess _ANSI_ARGS_((CONST char * path, int mode)); +/* 1 */ +EXTERN int TclAccessDeleteProc _ANSI_ARGS_(( + TclAccessProc_ * proc)); +/* 2 */ +EXTERN int TclAccessInsertProc _ANSI_ARGS_(( + TclAccessProc_ * proc)); +/* 3 */ +EXTERN void TclAllocateFreeObjects _ANSI_ARGS_((void)); +/* Slot 4 is reserved */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +/* 5 */ +EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp * interp, + int numPids, Tcl_Pid * pidPtr, + Tcl_Channel errorChan)); +#endif /* UNIX */ +#ifdef __WIN32__ +/* 5 */ +EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp * interp, + int numPids, Tcl_Pid * pidPtr, + Tcl_Channel errorChan)); +#endif /* __WIN32__ */ +/* 6 */ +EXTERN void TclCleanupCommand _ANSI_ARGS_((Command * cmdPtr)); +/* 7 */ +EXTERN int TclCopyAndCollapse _ANSI_ARGS_((int count, + CONST char * src, char * dst)); +/* 8 */ +EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Channel inChan, Tcl_Channel outChan, + int toRead, Tcl_Obj * cmdPtr)); +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +/* 9 */ +EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp * interp, + int argc, char ** argv, + Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, + TclFile * outPipePtr, TclFile * errFilePtr)); +#endif /* UNIX */ +#ifdef __WIN32__ +/* 9 */ +EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp * interp, + int argc, char ** argv, + Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, + TclFile * outPipePtr, TclFile * errFilePtr)); +#endif /* __WIN32__ */ +/* 10 */ +EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp * interp, + Namespace * nsPtr, char * procName, + Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, + Proc ** procPtrPtr)); +/* 11 */ +EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_(( + Interp * iPtr, CallFrame * framePtr)); +/* 12 */ +EXTERN void TclDeleteVars _ANSI_ARGS_((Interp * iPtr, + Tcl_HashTable * tablePtr)); +/* 13 */ +EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp * interp, + char * separators, Tcl_DString * headPtr, + char * tail)); +/* 14 */ +EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE * outFile)); +/* Slot 15 is reserved */ +/* 16 */ +EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp * interp, + double value)); +/* 17 */ +EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp * interp, + int objc, Tcl_Obj *CONST objv[])); +/* 18 */ +EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp * interp, + int argc, char ** argv)); +/* 19 */ +EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp * interp, + int argc, char ** argv)); +/* 20 */ +EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp * interp, + int argc, char ** argv)); +/* 21 */ +EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp * interp, + int argc, char ** argv)); +/* 22 */ +EXTERN int TclFindElement _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * listStr, int listLength, + CONST char ** elementPtr, + CONST char ** nextPtr, int * sizePtr, + int * bracePtr)); +/* 23 */ +EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp * iPtr, + char * procName)); +/* 24 */ +EXTERN int TclFormatInt _ANSI_ARGS_((char * buffer, long n)); +/* 25 */ +EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp * iPtr)); +/* Slot 26 is reserved */ +/* 27 */ +EXTERN int TclGetDate _ANSI_ARGS_((char * p, unsigned long now, + long zone, unsigned long * timePtr)); +/* 28 */ +EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type)); +/* 29 */ +EXTERN Tcl_Obj * TclGetElementOfIndexedArray _ANSI_ARGS_(( + Tcl_Interp * interp, int localIndex, + Tcl_Obj * elemPtr, int leaveErrorMsg)); +/* Slot 30 is reserved */ +/* 31 */ +EXTERN char * TclGetExtension _ANSI_ARGS_((char * name)); +/* 32 */ +EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp * interp, + char * str, CallFrame ** framePtrPtr)); +/* 33 */ +EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void)); +/* 34 */ +EXTERN int TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Obj * objPtr, int endValue, + int * indexPtr)); +/* 35 */ +EXTERN Tcl_Obj * TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp, + int localIndex, int leaveErrorMsg)); +/* 36 */ +EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp * interp, + char * str, long * longPtr)); +/* 37 */ +EXTERN int TclGetLoadedPackages _ANSI_ARGS_(( + Tcl_Interp * interp, char * targetName)); +/* 38 */ +EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_(( + Tcl_Interp * interp, char * qualName, + Namespace * cxtNsPtr, int flags, + Namespace ** nsPtrPtr, + Namespace ** altNsPtrPtr, + Namespace ** actualCxtPtrPtr, + char ** simpleNamePtr)); +/* 39 */ +EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void)); +/* 40 */ +EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp * interp, + char * str, int * seekFlagPtr)); +/* 41 */ +EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_(( + Tcl_Command command)); +/* 42 */ +EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name, + Tcl_DString * bufferPtr)); +/* 43 */ +EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp * interp, + int argc, char ** argv, int flags)); +/* 44 */ +EXTERN int TclGuessPackageName _ANSI_ARGS_((char * fileName, + Tcl_DString * bufPtr)); +/* 45 */ +EXTERN int TclHideUnsafeCommands _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 46 */ +EXTERN int TclInExit _ANSI_ARGS_((void)); +/* 47 */ +EXTERN Tcl_Obj * TclIncrElementOfIndexedArray _ANSI_ARGS_(( + Tcl_Interp * interp, int localIndex, + Tcl_Obj * elemPtr, long incrAmount)); +/* 48 */ +EXTERN Tcl_Obj * TclIncrIndexedScalar _ANSI_ARGS_(( + Tcl_Interp * interp, int localIndex, + long incrAmount)); +/* 49 */ +EXTERN Tcl_Obj * TclIncrVar2 _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, + long incrAmount, int part1NotParsed)); +/* 50 */ +EXTERN void TclInitCompiledLocals _ANSI_ARGS_(( + Tcl_Interp * interp, CallFrame * framePtr, + Namespace * nsPtr)); +/* 51 */ +EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp * interp)); +/* 52 */ +EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp * interp, int argc, + char ** argv, int flags)); +/* 53 */ +EXTERN int TclInvokeObjectCommand _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int argc, char ** argv)); +/* 54 */ +EXTERN int TclInvokeStringCommand _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int objc, Tcl_Obj *CONST objv[])); +/* 55 */ +EXTERN Proc * TclIsProc _ANSI_ARGS_((Command * cmdPtr)); +/* Slot 56 is reserved */ +/* Slot 57 is reserved */ +/* 58 */ +EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp * interp, + char * part1, char * part2, int flags, + char * msg, int createPart1, int createPart2, + Var ** arrayPtrPtr)); +/* 59 */ +EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp * interp, + char * separators, Tcl_DString * dirPtr, + char * pattern, char * tail)); +/* 60 */ +EXTERN int TclNeedSpace _ANSI_ARGS_((char * start, char * end)); +/* 61 */ +EXTERN Tcl_Obj * TclNewProcBodyObj _ANSI_ARGS_((Proc * procPtr)); +/* 62 */ +EXTERN int TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj * cmdPtr)); +/* 63 */ +EXTERN int TclObjInterpProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int objc, + Tcl_Obj *CONST objv[])); +/* 64 */ +EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp * interp, + int objc, Tcl_Obj *CONST objv[], int flags)); +/* 65 */ +EXTERN int TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp * interp, + int objc, Tcl_Obj *CONST objv[], int flags)); +/* 66 */ +EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_(( + TclOpenFileChannelProc_ * proc)); +/* 67 */ +EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_(( + TclOpenFileChannelProc_ * proc)); +/* 68 */ +EXTERN int TclpAccess _ANSI_ARGS_((CONST char * path, int mode)); +/* 69 */ +EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size)); +/* 70 */ +EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char * source, + CONST char * dest)); +/* 71 */ +EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char * source, + CONST char * dest, Tcl_DString * errorPtr)); +/* 72 */ +EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char * path)); +/* 73 */ +EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char * path)); +/* 74 */ +EXTERN void TclpFree _ANSI_ARGS_((char * ptr)); +/* 75 */ +EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void)); +/* 76 */ +EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void)); +/* 77 */ +EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time * time)); +/* 78 */ +EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time)); +/* 79 */ +EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp * interp)); +/* 80 */ +EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp, + char * fileName, char * modeString, + int permissions)); +/* 81 */ +EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr, + unsigned int size)); +/* 82 */ +EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char * path, + int recursive, Tcl_DString * errorPtr)); +/* 83 */ +EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char * source, + CONST char * dest)); +/* Slot 84 is reserved */ +/* Slot 85 is reserved */ +/* Slot 86 is reserved */ +/* Slot 87 is reserved */ +/* 88 */ +EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, char * name1, + char * name2, int flags)); +/* 89 */ +EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Interp * cmdInterp, Tcl_Command cmd)); +/* Slot 90 is reserved */ +/* 91 */ +EXTERN void TclProcCleanupProc _ANSI_ARGS_((Proc * procPtr)); +/* 92 */ +EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp * interp, + Proc * procPtr, Tcl_Obj * bodyPtr, + Namespace * nsPtr, CONST char * description, + CONST char * procName)); +/* 93 */ +EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData)); +/* 94 */ +EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char ** argv)); +/* 95 */ +EXTERN int TclpStat _ANSI_ARGS_((CONST char * path, + struct stat * buf)); +/* 96 */ +EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp, + char * oldName, char * newName)); +/* 97 */ +EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_(( + Tcl_Interp * interp, Command * newCmdPtr)); +/* 98 */ +EXTERN int TclServiceIdle _ANSI_ARGS_((void)); +/* 99 */ +EXTERN Tcl_Obj * TclSetElementOfIndexedArray _ANSI_ARGS_(( + Tcl_Interp * interp, int localIndex, + Tcl_Obj * elemPtr, Tcl_Obj * objPtr, + int leaveErrorMsg)); +/* 100 */ +EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp, + int localIndex, Tcl_Obj * objPtr, + int leaveErrorMsg)); +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +/* 101 */ +EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string)); +#endif /* UNIX */ +#ifdef __WIN32__ +/* 101 */ +EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string)); +#endif /* __WIN32__ */ +/* 102 */ +EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp * interp)); +/* 103 */ +EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp * interp, + char * str, char * proto, int * portPtr)); +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +/* 104 */ +EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock, + int size)); +#endif /* UNIX */ +#ifdef __WIN32__ +/* 104 */ +EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock, + int size)); +#endif /* __WIN32__ */ +/* 105 */ +EXTERN int TclStat _ANSI_ARGS_((CONST char * path, + struct stat * buf)); +/* 106 */ +EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ * proc)); +/* 107 */ +EXTERN int TclStatInsertProc _ANSI_ARGS_((TclStatProc_ * proc)); +/* 108 */ +EXTERN void TclTeardownNamespace _ANSI_ARGS_((Namespace * nsPtr)); +/* 109 */ +EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp * iPtr)); +/* Slot 110 is reserved */ +/* 111 */ +EXTERN void Tcl_AddInterpResolvers _ANSI_ARGS_(( + Tcl_Interp * interp, char * name, + Tcl_ResolveCmdProc * cmdProc, + Tcl_ResolveVarProc * varProc, + Tcl_ResolveCompiledVarProc * compiledVarProc)); +/* 112 */ +EXTERN int Tcl_AppendExportList _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Namespace * nsPtr, + Tcl_Obj * objPtr)); +/* 113 */ +EXTERN Tcl_Namespace * Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp * interp, + char * name, ClientData clientData, + Tcl_NamespaceDeleteProc * deleteProc)); +/* 114 */ +EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_(( + Tcl_Namespace * nsPtr)); +/* 115 */ +EXTERN int Tcl_Export _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Namespace * nsPtr, char * pattern, + int resetListFirst)); +/* 116 */ +EXTERN Tcl_Command Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp * interp, + char * name, Tcl_Namespace * contextNsPtr, + int flags)); +/* 117 */ +EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp * interp, + char * name, Tcl_Namespace * contextNsPtr, + int flags)); +/* 118 */ +EXTERN int Tcl_GetInterpResolvers _ANSI_ARGS_(( + Tcl_Interp * interp, char * name, + Tcl_ResolverInfo * resInfo)); +/* 119 */ +EXTERN int Tcl_GetNamespaceResolvers _ANSI_ARGS_(( + Tcl_Namespace * namespacePtr, + Tcl_ResolverInfo * resInfo)); +/* 120 */ +EXTERN Tcl_Var Tcl_FindNamespaceVar _ANSI_ARGS_(( + Tcl_Interp * interp, char * name, + Tcl_Namespace * contextNsPtr, int flags)); +/* 121 */ +EXTERN int Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Namespace * nsPtr, char * pattern)); +/* 122 */ +EXTERN Tcl_Command Tcl_GetCommandFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Obj * objPtr)); +/* 123 */ +EXTERN void Tcl_GetCommandFullName _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Command command, + Tcl_Obj * objPtr)); +/* 124 */ +EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 125 */ +EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 126 */ +EXTERN void Tcl_GetVariableFullName _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Var variable, + Tcl_Obj * objPtr)); +/* 127 */ +EXTERN int Tcl_Import _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Namespace * nsPtr, char * pattern, + int allowOverwrite)); +/* 128 */ +EXTERN void Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp* interp)); +/* 129 */ +EXTERN int Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp* interp, + Tcl_CallFrame * framePtr, + Tcl_Namespace * nsPtr, int isProcCallFrame)); +/* 130 */ +EXTERN int Tcl_RemoveInterpResolvers _ANSI_ARGS_(( + Tcl_Interp * interp, char * name)); +/* 131 */ +EXTERN void Tcl_SetNamespaceResolvers _ANSI_ARGS_(( + Tcl_Namespace * namespacePtr, + Tcl_ResolveCmdProc * cmdProc, + Tcl_ResolveVarProc * varProc, + Tcl_ResolveCompiledVarProc * compiledVarProc)); +/* 132 */ +EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp * interp)); +/* 133 */ +EXTERN struct tm * TclpGetDate _ANSI_ARGS_((TclpTime_t time, int useGMT)); +/* 134 */ +EXTERN size_t TclpStrftime _ANSI_ARGS_((char * s, size_t maxsize, + CONST char * format, CONST struct tm * t)); +/* 135 */ +EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); +/* Slot 136 is reserved */ +/* 137 */ +EXTERN int TclpChdir _ANSI_ARGS_((CONST char * dirName)); +/* 138 */ +EXTERN char * TclGetEnv _ANSI_ARGS_((CONST char * name, + Tcl_DString * valuePtr)); +/* 139 */ +EXTERN int TclpLoadFile _ANSI_ARGS_((Tcl_Interp * interp, + char * fileName, char * sym1, char * sym2, + Tcl_PackageInitProc ** proc1Ptr, + Tcl_PackageInitProc ** proc2Ptr, + ClientData * clientDataPtr)); +/* 140 */ +EXTERN int TclLooksLikeInt _ANSI_ARGS_((char * bytes, + int length)); +/* 141 */ +EXTERN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_DString * cwdPtr)); +/* 142 */ +EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Obj * objPtr, + CompileHookProc * hookProc, + ClientData clientData)); +/* 143 */ +EXTERN int TclAddLiteralObj _ANSI_ARGS_(( + struct CompileEnv * envPtr, Tcl_Obj * objPtr, + LiteralEntry ** litPtrPtr)); +/* 144 */ +EXTERN void TclHideLiteral _ANSI_ARGS_((Tcl_Interp * interp, + struct CompileEnv * envPtr, int index)); +/* 145 */ +EXTERN struct AuxDataType * TclGetAuxDataType _ANSI_ARGS_((char * typeName)); +/* 146 */ +EXTERN TclHandle TclHandleCreate _ANSI_ARGS_((VOID * ptr)); +/* 147 */ +EXTERN void TclHandleFree _ANSI_ARGS_((TclHandle handle)); +/* 148 */ +EXTERN TclHandle TclHandlePreserve _ANSI_ARGS_((TclHandle handle)); +/* 149 */ +EXTERN void TclHandleRelease _ANSI_ARGS_((TclHandle handle)); +/* 150 */ +EXTERN int TclRegAbout _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_RegExp re)); +/* 151 */ +EXTERN void TclRegExpRangeUniChar _ANSI_ARGS_((Tcl_RegExp re, + int index, int * startPtr, int * endPtr)); +/* 152 */ +EXTERN void TclSetLibraryPath _ANSI_ARGS_((Tcl_Obj * pathPtr)); +/* 153 */ +EXTERN Tcl_Obj * TclGetLibraryPath _ANSI_ARGS_((void)); +/* 154 */ +EXTERN int TclTestChannelCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char ** argv)); +/* 155 */ +EXTERN int TclTestChannelEventCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int argc, char ** argv)); +/* 156 */ +EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp, + char * msg, int status)); +/* 157 */ +EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp, + char * varName)); + +typedef struct TclIntStubs { + int magic; + struct TclIntStubHooks *hooks; + + int (*tclAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 0 */ + int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 1 */ + int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 2 */ + void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */ + void *reserved4; +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp * interp, int numPids, Tcl_Pid * pidPtr, Tcl_Channel errorChan)); /* 5 */ +#endif /* UNIX */ +#ifdef __WIN32__ + int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp * interp, int numPids, Tcl_Pid * pidPtr, Tcl_Channel errorChan)); /* 5 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void *reserved5; +#endif /* MAC_TCL */ + void (*tclCleanupCommand) _ANSI_ARGS_((Command * cmdPtr)); /* 6 */ + int (*tclCopyAndCollapse) _ANSI_ARGS_((int count, CONST char * src, char * dst)); /* 7 */ + int (*tclCopyChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj * cmdPtr)); /* 8 */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */ +#endif /* UNIX */ +#ifdef __WIN32__ + int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void *reserved9; +#endif /* MAC_TCL */ + int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp * interp, Namespace * nsPtr, char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)); /* 10 */ + void (*tclDeleteCompiledLocalVars) _ANSI_ARGS_((Interp * iPtr, CallFrame * framePtr)); /* 11 */ + void (*tclDeleteVars) _ANSI_ARGS_((Interp * iPtr, Tcl_HashTable * tablePtr)); /* 12 */ + int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail)); /* 13 */ + void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */ + void *reserved15; + void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp * interp, double value)); /* 16 */ + int (*tclFileAttrsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 17 */ + int (*tclFileCopyCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 18 */ + int (*tclFileDeleteCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 19 */ + int (*tclFileMakeDirsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 20 */ + int (*tclFileRenameCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 21 */ + int (*tclFindElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int listLength, CONST char ** elementPtr, CONST char ** nextPtr, int * sizePtr, int * bracePtr)); /* 22 */ + Proc * (*tclFindProc) _ANSI_ARGS_((Interp * iPtr, char * procName)); /* 23 */ + int (*tclFormatInt) _ANSI_ARGS_((char * buffer, long n)); /* 24 */ + void (*tclFreePackageInfo) _ANSI_ARGS_((Interp * iPtr)); /* 25 */ + void *reserved26; + int (*tclGetDate) _ANSI_ARGS_((char * p, unsigned long now, long zone, unsigned long * timePtr)); /* 27 */ + Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */ + Tcl_Obj * (*tclGetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, int leaveErrorMsg)); /* 29 */ + void *reserved30; + char * (*tclGetExtension) _ANSI_ARGS_((char * name)); /* 31 */ + int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, char * str, CallFrame ** framePtrPtr)); /* 32 */ + TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */ + int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */ + Tcl_Obj * (*tclGetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, int leaveErrorMsg)); /* 35 */ + int (*tclGetLong) _ANSI_ARGS_((Tcl_Interp * interp, char * str, long * longPtr)); /* 36 */ + int (*tclGetLoadedPackages) _ANSI_ARGS_((Tcl_Interp * interp, char * targetName)); /* 37 */ + int (*tclGetNamespaceForQualName) _ANSI_ARGS_((Tcl_Interp * interp, char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, char ** simpleNamePtr)); /* 38 */ + TclObjCmdProcType (*tclGetObjInterpProc) _ANSI_ARGS_((void)); /* 39 */ + int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * seekFlagPtr)); /* 40 */ + Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */ + char * (*tclpGetUserHome) _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 42 */ + int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 43 */ + int (*tclGuessPackageName) _ANSI_ARGS_((char * fileName, Tcl_DString * bufPtr)); /* 44 */ + int (*tclHideUnsafeCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 45 */ + int (*tclInExit) _ANSI_ARGS_((void)); /* 46 */ + Tcl_Obj * (*tclIncrElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, long incrAmount)); /* 47 */ + Tcl_Obj * (*tclIncrIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, long incrAmount)); /* 48 */ + Tcl_Obj * (*tclIncrVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, long incrAmount, int part1NotParsed)); /* 49 */ + void (*tclInitCompiledLocals) _ANSI_ARGS_((Tcl_Interp * interp, CallFrame * framePtr, Namespace * nsPtr)); /* 50 */ + int (*tclInterpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 51 */ + int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 52 */ + int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 53 */ + int (*tclInvokeStringCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 54 */ + Proc * (*tclIsProc) _ANSI_ARGS_((Command * cmdPtr)); /* 55 */ + void *reserved56; + void *reserved57; + Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */ + int (*tclpMatchFiles) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * dirPtr, char * pattern, char * tail)); /* 59 */ + int (*tclNeedSpace) _ANSI_ARGS_((char * start, char * end)); /* 60 */ + Tcl_Obj * (*tclNewProcBodyObj) _ANSI_ARGS_((Proc * procPtr)); /* 61 */ + int (*tclObjCommandComplete) _ANSI_ARGS_((Tcl_Obj * cmdPtr)); /* 62 */ + int (*tclObjInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 63 */ + int (*tclObjInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 64 */ + int (*tclObjInvokeGlobal) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 65 */ + int (*tclOpenFileChannelDeleteProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 66 */ + int (*tclOpenFileChannelInsertProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 67 */ + int (*tclpAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 68 */ + char * (*tclpAlloc) _ANSI_ARGS_((unsigned int size)); /* 69 */ + int (*tclpCopyFile) _ANSI_ARGS_((CONST char * source, CONST char * dest)); /* 70 */ + int (*tclpCopyDirectory) _ANSI_ARGS_((CONST char * source, CONST char * dest, Tcl_DString * errorPtr)); /* 71 */ + int (*tclpCreateDirectory) _ANSI_ARGS_((CONST char * path)); /* 72 */ + int (*tclpDeleteFile) _ANSI_ARGS_((CONST char * path)); /* 73 */ + void (*tclpFree) _ANSI_ARGS_((char * ptr)); /* 74 */ + unsigned long (*tclpGetClicks) _ANSI_ARGS_((void)); /* 75 */ + unsigned long (*tclpGetSeconds) _ANSI_ARGS_((void)); /* 76 */ + void (*tclpGetTime) _ANSI_ARGS_((Tcl_Time * time)); /* 77 */ + int (*tclpGetTimeZone) _ANSI_ARGS_((unsigned long time)); /* 78 */ + int (*tclpListVolumes) _ANSI_ARGS_((Tcl_Interp * interp)); /* 79 */ + Tcl_Channel (*tclpOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 80 */ + char * (*tclpRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 81 */ + int (*tclpRemoveDirectory) _ANSI_ARGS_((CONST char * path, int recursive, Tcl_DString * errorPtr)); /* 82 */ + int (*tclpRenameFile) _ANSI_ARGS_((CONST char * source, CONST char * dest)); /* 83 */ + void *reserved84; + void *reserved85; + void *reserved86; + void *reserved87; + char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, char * name1, char * name2, int flags)); /* 88 */ + int (*tclPreventAliasLoop) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Interp * cmdInterp, Tcl_Command cmd)); /* 89 */ + void *reserved90; + void (*tclProcCleanupProc) _ANSI_ARGS_((Proc * procPtr)); /* 91 */ + int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */ + void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */ + int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 94 */ + int (*tclpStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 95 */ + int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */ + void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */ + int (*tclServiceIdle) _ANSI_ARGS_((void)); /* 98 */ + Tcl_Obj * (*tclSetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, Tcl_Obj * objPtr, int leaveErrorMsg)); /* 99 */ + Tcl_Obj * (*tclSetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * objPtr, int leaveErrorMsg)); /* 100 */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + char * (*tclSetPreInitScript) _ANSI_ARGS_((char * string)); /* 101 */ +#endif /* UNIX */ +#ifdef __WIN32__ + char * (*tclSetPreInitScript) _ANSI_ARGS_((char * string)); /* 101 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void *reserved101; +#endif /* MAC_TCL */ + void (*tclSetupEnv) _ANSI_ARGS_((Tcl_Interp * interp)); /* 102 */ + int (*tclSockGetPort) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char * proto, int * portPtr)); /* 103 */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + int (*tclSockMinimumBuffers) _ANSI_ARGS_((int sock, int size)); /* 104 */ +#endif /* UNIX */ +#ifdef __WIN32__ + int (*tclSockMinimumBuffers) _ANSI_ARGS_((int sock, int size)); /* 104 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void *reserved104; +#endif /* MAC_TCL */ + int (*tclStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 105 */ + int (*tclStatDeleteProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 106 */ + int (*tclStatInsertProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 107 */ + void (*tclTeardownNamespace) _ANSI_ARGS_((Namespace * nsPtr)); /* 108 */ + int (*tclUpdateReturnInfo) _ANSI_ARGS_((Interp * iPtr)); /* 109 */ + void *reserved110; + void (*tcl_AddInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)); /* 111 */ + int (*tcl_AppendExportList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, Tcl_Obj * objPtr)); /* 112 */ + Tcl_Namespace * (*tcl_CreateNamespace) _ANSI_ARGS_((Tcl_Interp * interp, char * name, ClientData clientData, Tcl_NamespaceDeleteProc * deleteProc)); /* 113 */ + void (*tcl_DeleteNamespace) _ANSI_ARGS_((Tcl_Namespace * nsPtr)); /* 114 */ + int (*tcl_Export) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, char * pattern, int resetListFirst)); /* 115 */ + Tcl_Command (*tcl_FindCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 116 */ + Tcl_Namespace * (*tcl_FindNamespace) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 117 */ + int (*tcl_GetInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_ResolverInfo * resInfo)); /* 118 */ + int (*tcl_GetNamespaceResolvers) _ANSI_ARGS_((Tcl_Namespace * namespacePtr, Tcl_ResolverInfo * resInfo)); /* 119 */ + Tcl_Var (*tcl_FindNamespaceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 120 */ + int (*tcl_ForgetImport) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, char * pattern)); /* 121 */ + Tcl_Command (*tcl_GetCommandFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 122 */ + void (*tcl_GetCommandFullName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command, Tcl_Obj * objPtr)); /* 123 */ + Tcl_Namespace * (*tcl_GetCurrentNamespace) _ANSI_ARGS_((Tcl_Interp * interp)); /* 124 */ + Tcl_Namespace * (*tcl_GetGlobalNamespace) _ANSI_ARGS_((Tcl_Interp * interp)); /* 125 */ + void (*tcl_GetVariableFullName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Var variable, Tcl_Obj * objPtr)); /* 126 */ + int (*tcl_Import) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, char * pattern, int allowOverwrite)); /* 127 */ + void (*tcl_PopCallFrame) _ANSI_ARGS_((Tcl_Interp* interp)); /* 128 */ + int (*tcl_PushCallFrame) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_CallFrame * framePtr, Tcl_Namespace * nsPtr, int isProcCallFrame)); /* 129 */ + int (*tcl_RemoveInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, char * name)); /* 130 */ + void (*tcl_SetNamespaceResolvers) _ANSI_ARGS_((Tcl_Namespace * namespacePtr, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)); /* 131 */ + int (*tclpHasSockets) _ANSI_ARGS_((Tcl_Interp * interp)); /* 132 */ + struct tm * (*tclpGetDate) _ANSI_ARGS_((TclpTime_t time, int useGMT)); /* 133 */ + size_t (*tclpStrftime) _ANSI_ARGS_((char * s, size_t maxsize, CONST char * format, CONST struct tm * t)); /* 134 */ + int (*tclpCheckStackSpace) _ANSI_ARGS_((void)); /* 135 */ + void *reserved136; + int (*tclpChdir) _ANSI_ARGS_((CONST char * dirName)); /* 137 */ + char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */ + int (*tclpLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr)); /* 139 */ + int (*tclLooksLikeInt) _ANSI_ARGS_((char * bytes, int length)); /* 140 */ + char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */ + int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)); /* 142 */ + int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)); /* 143 */ + void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp * interp, struct CompileEnv * envPtr, int index)); /* 144 */ + struct AuxDataType * (*tclGetAuxDataType) _ANSI_ARGS_((char * typeName)); /* 145 */ + TclHandle (*tclHandleCreate) _ANSI_ARGS_((VOID * ptr)); /* 146 */ + void (*tclHandleFree) _ANSI_ARGS_((TclHandle handle)); /* 147 */ + TclHandle (*tclHandlePreserve) _ANSI_ARGS_((TclHandle handle)); /* 148 */ + void (*tclHandleRelease) _ANSI_ARGS_((TclHandle handle)); /* 149 */ + int (*tclRegAbout) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp re)); /* 150 */ + void (*tclRegExpRangeUniChar) _ANSI_ARGS_((Tcl_RegExp re, int index, int * startPtr, int * endPtr)); /* 151 */ + void (*tclSetLibraryPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 152 */ + Tcl_Obj * (*tclGetLibraryPath) _ANSI_ARGS_((void)); /* 153 */ + int (*tclTestChannelCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 154 */ + int (*tclTestChannelEventCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 155 */ + void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, int status)); /* 156 */ + Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */ +} TclIntStubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern TclIntStubs *tclIntStubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) + +/* + * Inline function declarations: + */ + +#ifndef TclAccess +#define TclAccess \ + (tclIntStubsPtr->tclAccess) /* 0 */ +#endif +#ifndef TclAccessDeleteProc +#define TclAccessDeleteProc \ + (tclIntStubsPtr->tclAccessDeleteProc) /* 1 */ +#endif +#ifndef TclAccessInsertProc +#define TclAccessInsertProc \ + (tclIntStubsPtr->tclAccessInsertProc) /* 2 */ +#endif +#ifndef TclAllocateFreeObjects +#define TclAllocateFreeObjects \ + (tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */ +#endif +/* Slot 4 is reserved */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +#ifndef TclCleanupChildren +#define TclCleanupChildren \ + (tclIntStubsPtr->tclCleanupChildren) /* 5 */ +#endif +#endif /* UNIX */ +#ifdef __WIN32__ +#ifndef TclCleanupChildren +#define TclCleanupChildren \ + (tclIntStubsPtr->tclCleanupChildren) /* 5 */ +#endif +#endif /* __WIN32__ */ +#ifndef TclCleanupCommand +#define TclCleanupCommand \ + (tclIntStubsPtr->tclCleanupCommand) /* 6 */ +#endif +#ifndef TclCopyAndCollapse +#define TclCopyAndCollapse \ + (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ +#endif +#ifndef TclCopyChannel +#define TclCopyChannel \ + (tclIntStubsPtr->tclCopyChannel) /* 8 */ +#endif +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +#ifndef TclCreatePipeline +#define TclCreatePipeline \ + (tclIntStubsPtr->tclCreatePipeline) /* 9 */ +#endif +#endif /* UNIX */ +#ifdef __WIN32__ +#ifndef TclCreatePipeline +#define TclCreatePipeline \ + (tclIntStubsPtr->tclCreatePipeline) /* 9 */ +#endif +#endif /* __WIN32__ */ +#ifndef TclCreateProc +#define TclCreateProc \ + (tclIntStubsPtr->tclCreateProc) /* 10 */ +#endif +#ifndef TclDeleteCompiledLocalVars +#define TclDeleteCompiledLocalVars \ + (tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */ +#endif +#ifndef TclDeleteVars +#define TclDeleteVars \ + (tclIntStubsPtr->tclDeleteVars) /* 12 */ +#endif +#ifndef TclDoGlob +#define TclDoGlob \ + (tclIntStubsPtr->tclDoGlob) /* 13 */ +#endif +#ifndef TclDumpMemoryInfo +#define TclDumpMemoryInfo \ + (tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */ +#endif +/* Slot 15 is reserved */ +#ifndef TclExprFloatError +#define TclExprFloatError \ + (tclIntStubsPtr->tclExprFloatError) /* 16 */ +#endif +#ifndef TclFileAttrsCmd +#define TclFileAttrsCmd \ + (tclIntStubsPtr->tclFileAttrsCmd) /* 17 */ +#endif +#ifndef TclFileCopyCmd +#define TclFileCopyCmd \ + (tclIntStubsPtr->tclFileCopyCmd) /* 18 */ +#endif +#ifndef TclFileDeleteCmd +#define TclFileDeleteCmd \ + (tclIntStubsPtr->tclFileDeleteCmd) /* 19 */ +#endif +#ifndef TclFileMakeDirsCmd +#define TclFileMakeDirsCmd \ + (tclIntStubsPtr->tclFileMakeDirsCmd) /* 20 */ +#endif +#ifndef TclFileRenameCmd +#define TclFileRenameCmd \ + (tclIntStubsPtr->tclFileRenameCmd) /* 21 */ +#endif +#ifndef TclFindElement +#define TclFindElement \ + (tclIntStubsPtr->tclFindElement) /* 22 */ +#endif +#ifndef TclFindProc +#define TclFindProc \ + (tclIntStubsPtr->tclFindProc) /* 23 */ +#endif +#ifndef TclFormatInt +#define TclFormatInt \ + (tclIntStubsPtr->tclFormatInt) /* 24 */ +#endif +#ifndef TclFreePackageInfo +#define TclFreePackageInfo \ + (tclIntStubsPtr->tclFreePackageInfo) /* 25 */ +#endif +/* Slot 26 is reserved */ +#ifndef TclGetDate +#define TclGetDate \ + (tclIntStubsPtr->tclGetDate) /* 27 */ +#endif +#ifndef TclpGetDefaultStdChannel +#define TclpGetDefaultStdChannel \ + (tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */ +#endif +#ifndef TclGetElementOfIndexedArray +#define TclGetElementOfIndexedArray \ + (tclIntStubsPtr->tclGetElementOfIndexedArray) /* 29 */ +#endif +/* Slot 30 is reserved */ +#ifndef TclGetExtension +#define TclGetExtension \ + (tclIntStubsPtr->tclGetExtension) /* 31 */ +#endif +#ifndef TclGetFrame +#define TclGetFrame \ + (tclIntStubsPtr->tclGetFrame) /* 32 */ +#endif +#ifndef TclGetInterpProc +#define TclGetInterpProc \ + (tclIntStubsPtr->tclGetInterpProc) /* 33 */ +#endif +#ifndef TclGetIntForIndex +#define TclGetIntForIndex \ + (tclIntStubsPtr->tclGetIntForIndex) /* 34 */ +#endif +#ifndef TclGetIndexedScalar +#define TclGetIndexedScalar \ + (tclIntStubsPtr->tclGetIndexedScalar) /* 35 */ +#endif +#ifndef TclGetLong +#define TclGetLong \ + (tclIntStubsPtr->tclGetLong) /* 36 */ +#endif +#ifndef TclGetLoadedPackages +#define TclGetLoadedPackages \ + (tclIntStubsPtr->tclGetLoadedPackages) /* 37 */ +#endif +#ifndef TclGetNamespaceForQualName +#define TclGetNamespaceForQualName \ + (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ +#endif +#ifndef TclGetObjInterpProc +#define TclGetObjInterpProc \ + (tclIntStubsPtr->tclGetObjInterpProc) /* 39 */ +#endif +#ifndef TclGetOpenMode +#define TclGetOpenMode \ + (tclIntStubsPtr->tclGetOpenMode) /* 40 */ +#endif +#ifndef TclGetOriginalCommand +#define TclGetOriginalCommand \ + (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ +#endif +#ifndef TclpGetUserHome +#define TclpGetUserHome \ + (tclIntStubsPtr->tclpGetUserHome) /* 42 */ +#endif +#ifndef TclGlobalInvoke +#define TclGlobalInvoke \ + (tclIntStubsPtr->tclGlobalInvoke) /* 43 */ +#endif +#ifndef TclGuessPackageName +#define TclGuessPackageName \ + (tclIntStubsPtr->tclGuessPackageName) /* 44 */ +#endif +#ifndef TclHideUnsafeCommands +#define TclHideUnsafeCommands \ + (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */ +#endif +#ifndef TclInExit +#define TclInExit \ + (tclIntStubsPtr->tclInExit) /* 46 */ +#endif +#ifndef TclIncrElementOfIndexedArray +#define TclIncrElementOfIndexedArray \ + (tclIntStubsPtr->tclIncrElementOfIndexedArray) /* 47 */ +#endif +#ifndef TclIncrIndexedScalar +#define TclIncrIndexedScalar \ + (tclIntStubsPtr->tclIncrIndexedScalar) /* 48 */ +#endif +#ifndef TclIncrVar2 +#define TclIncrVar2 \ + (tclIntStubsPtr->tclIncrVar2) /* 49 */ +#endif +#ifndef TclInitCompiledLocals +#define TclInitCompiledLocals \ + (tclIntStubsPtr->tclInitCompiledLocals) /* 50 */ +#endif +#ifndef TclInterpInit +#define TclInterpInit \ + (tclIntStubsPtr->tclInterpInit) /* 51 */ +#endif +#ifndef TclInvoke +#define TclInvoke \ + (tclIntStubsPtr->tclInvoke) /* 52 */ +#endif +#ifndef TclInvokeObjectCommand +#define TclInvokeObjectCommand \ + (tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */ +#endif +#ifndef TclInvokeStringCommand +#define TclInvokeStringCommand \ + (tclIntStubsPtr->tclInvokeStringCommand) /* 54 */ +#endif +#ifndef TclIsProc +#define TclIsProc \ + (tclIntStubsPtr->tclIsProc) /* 55 */ +#endif +/* Slot 56 is reserved */ +/* Slot 57 is reserved */ +#ifndef TclLookupVar +#define TclLookupVar \ + (tclIntStubsPtr->tclLookupVar) /* 58 */ +#endif +#ifndef TclpMatchFiles +#define TclpMatchFiles \ + (tclIntStubsPtr->tclpMatchFiles) /* 59 */ +#endif +#ifndef TclNeedSpace +#define TclNeedSpace \ + (tclIntStubsPtr->tclNeedSpace) /* 60 */ +#endif +#ifndef TclNewProcBodyObj +#define TclNewProcBodyObj \ + (tclIntStubsPtr->tclNewProcBodyObj) /* 61 */ +#endif +#ifndef TclObjCommandComplete +#define TclObjCommandComplete \ + (tclIntStubsPtr->tclObjCommandComplete) /* 62 */ +#endif +#ifndef TclObjInterpProc +#define TclObjInterpProc \ + (tclIntStubsPtr->tclObjInterpProc) /* 63 */ +#endif +#ifndef TclObjInvoke +#define TclObjInvoke \ + (tclIntStubsPtr->tclObjInvoke) /* 64 */ +#endif +#ifndef TclObjInvokeGlobal +#define TclObjInvokeGlobal \ + (tclIntStubsPtr->tclObjInvokeGlobal) /* 65 */ +#endif +#ifndef TclOpenFileChannelDeleteProc +#define TclOpenFileChannelDeleteProc \ + (tclIntStubsPtr->tclOpenFileChannelDeleteProc) /* 66 */ +#endif +#ifndef TclOpenFileChannelInsertProc +#define TclOpenFileChannelInsertProc \ + (tclIntStubsPtr->tclOpenFileChannelInsertProc) /* 67 */ +#endif +#ifndef TclpAccess +#define TclpAccess \ + (tclIntStubsPtr->tclpAccess) /* 68 */ +#endif +#ifndef TclpAlloc +#define TclpAlloc \ + (tclIntStubsPtr->tclpAlloc) /* 69 */ +#endif +#ifndef TclpCopyFile +#define TclpCopyFile \ + (tclIntStubsPtr->tclpCopyFile) /* 70 */ +#endif +#ifndef TclpCopyDirectory +#define TclpCopyDirectory \ + (tclIntStubsPtr->tclpCopyDirectory) /* 71 */ +#endif +#ifndef TclpCreateDirectory +#define TclpCreateDirectory \ + (tclIntStubsPtr->tclpCreateDirectory) /* 72 */ +#endif +#ifndef TclpDeleteFile +#define TclpDeleteFile \ + (tclIntStubsPtr->tclpDeleteFile) /* 73 */ +#endif +#ifndef TclpFree +#define TclpFree \ + (tclIntStubsPtr->tclpFree) /* 74 */ +#endif +#ifndef TclpGetClicks +#define TclpGetClicks \ + (tclIntStubsPtr->tclpGetClicks) /* 75 */ +#endif +#ifndef TclpGetSeconds +#define TclpGetSeconds \ + (tclIntStubsPtr->tclpGetSeconds) /* 76 */ +#endif +#ifndef TclpGetTime +#define TclpGetTime \ + (tclIntStubsPtr->tclpGetTime) /* 77 */ +#endif +#ifndef TclpGetTimeZone +#define TclpGetTimeZone \ + (tclIntStubsPtr->tclpGetTimeZone) /* 78 */ +#endif +#ifndef TclpListVolumes +#define TclpListVolumes \ + (tclIntStubsPtr->tclpListVolumes) /* 79 */ +#endif +#ifndef TclpOpenFileChannel +#define TclpOpenFileChannel \ + (tclIntStubsPtr->tclpOpenFileChannel) /* 80 */ +#endif +#ifndef TclpRealloc +#define TclpRealloc \ + (tclIntStubsPtr->tclpRealloc) /* 81 */ +#endif +#ifndef TclpRemoveDirectory +#define TclpRemoveDirectory \ + (tclIntStubsPtr->tclpRemoveDirectory) /* 82 */ +#endif +#ifndef TclpRenameFile +#define TclpRenameFile \ + (tclIntStubsPtr->tclpRenameFile) /* 83 */ +#endif +/* Slot 84 is reserved */ +/* Slot 85 is reserved */ +/* Slot 86 is reserved */ +/* Slot 87 is reserved */ +#ifndef TclPrecTraceProc +#define TclPrecTraceProc \ + (tclIntStubsPtr->tclPrecTraceProc) /* 88 */ +#endif +#ifndef TclPreventAliasLoop +#define TclPreventAliasLoop \ + (tclIntStubsPtr->tclPreventAliasLoop) /* 89 */ +#endif +/* Slot 90 is reserved */ +#ifndef TclProcCleanupProc +#define TclProcCleanupProc \ + (tclIntStubsPtr->tclProcCleanupProc) /* 91 */ +#endif +#ifndef TclProcCompileProc +#define TclProcCompileProc \ + (tclIntStubsPtr->tclProcCompileProc) /* 92 */ +#endif +#ifndef TclProcDeleteProc +#define TclProcDeleteProc \ + (tclIntStubsPtr->tclProcDeleteProc) /* 93 */ +#endif +#ifndef TclProcInterpProc +#define TclProcInterpProc \ + (tclIntStubsPtr->tclProcInterpProc) /* 94 */ +#endif +#ifndef TclpStat +#define TclpStat \ + (tclIntStubsPtr->tclpStat) /* 95 */ +#endif +#ifndef TclRenameCommand +#define TclRenameCommand \ + (tclIntStubsPtr->tclRenameCommand) /* 96 */ +#endif +#ifndef TclResetShadowedCmdRefs +#define TclResetShadowedCmdRefs \ + (tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */ +#endif +#ifndef TclServiceIdle +#define TclServiceIdle \ + (tclIntStubsPtr->tclServiceIdle) /* 98 */ +#endif +#ifndef TclSetElementOfIndexedArray +#define TclSetElementOfIndexedArray \ + (tclIntStubsPtr->tclSetElementOfIndexedArray) /* 99 */ +#endif +#ifndef TclSetIndexedScalar +#define TclSetIndexedScalar \ + (tclIntStubsPtr->tclSetIndexedScalar) /* 100 */ +#endif +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +#ifndef TclSetPreInitScript +#define TclSetPreInitScript \ + (tclIntStubsPtr->tclSetPreInitScript) /* 101 */ +#endif +#endif /* UNIX */ +#ifdef __WIN32__ +#ifndef TclSetPreInitScript +#define TclSetPreInitScript \ + (tclIntStubsPtr->tclSetPreInitScript) /* 101 */ +#endif +#endif /* __WIN32__ */ +#ifndef TclSetupEnv +#define TclSetupEnv \ + (tclIntStubsPtr->tclSetupEnv) /* 102 */ +#endif +#ifndef TclSockGetPort +#define TclSockGetPort \ + (tclIntStubsPtr->tclSockGetPort) /* 103 */ +#endif +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +#ifndef TclSockMinimumBuffers +#define TclSockMinimumBuffers \ + (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */ +#endif +#endif /* UNIX */ +#ifdef __WIN32__ +#ifndef TclSockMinimumBuffers +#define TclSockMinimumBuffers \ + (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */ +#endif +#endif /* __WIN32__ */ +#ifndef TclStat +#define TclStat \ + (tclIntStubsPtr->tclStat) /* 105 */ +#endif +#ifndef TclStatDeleteProc +#define TclStatDeleteProc \ + (tclIntStubsPtr->tclStatDeleteProc) /* 106 */ +#endif +#ifndef TclStatInsertProc +#define TclStatInsertProc \ + (tclIntStubsPtr->tclStatInsertProc) /* 107 */ +#endif +#ifndef TclTeardownNamespace +#define TclTeardownNamespace \ + (tclIntStubsPtr->tclTeardownNamespace) /* 108 */ +#endif +#ifndef TclUpdateReturnInfo +#define TclUpdateReturnInfo \ + (tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */ +#endif +/* Slot 110 is reserved */ +#ifndef Tcl_AddInterpResolvers +#define Tcl_AddInterpResolvers \ + (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ +#endif +#ifndef Tcl_AppendExportList +#define Tcl_AppendExportList \ + (tclIntStubsPtr->tcl_AppendExportList) /* 112 */ +#endif +#ifndef Tcl_CreateNamespace +#define Tcl_CreateNamespace \ + (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */ +#endif +#ifndef Tcl_DeleteNamespace +#define Tcl_DeleteNamespace \ + (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */ +#endif +#ifndef Tcl_Export +#define Tcl_Export \ + (tclIntStubsPtr->tcl_Export) /* 115 */ +#endif +#ifndef Tcl_FindCommand +#define Tcl_FindCommand \ + (tclIntStubsPtr->tcl_FindCommand) /* 116 */ +#endif +#ifndef Tcl_FindNamespace +#define Tcl_FindNamespace \ + (tclIntStubsPtr->tcl_FindNamespace) /* 117 */ +#endif +#ifndef Tcl_GetInterpResolvers +#define Tcl_GetInterpResolvers \ + (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ +#endif +#ifndef Tcl_GetNamespaceResolvers +#define Tcl_GetNamespaceResolvers \ + (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ +#endif +#ifndef Tcl_FindNamespaceVar +#define Tcl_FindNamespaceVar \ + (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ +#endif +#ifndef Tcl_ForgetImport +#define Tcl_ForgetImport \ + (tclIntStubsPtr->tcl_ForgetImport) /* 121 */ +#endif +#ifndef Tcl_GetCommandFromObj +#define Tcl_GetCommandFromObj \ + (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */ +#endif +#ifndef Tcl_GetCommandFullName +#define Tcl_GetCommandFullName \ + (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */ +#endif +#ifndef Tcl_GetCurrentNamespace +#define Tcl_GetCurrentNamespace \ + (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */ +#endif +#ifndef Tcl_GetGlobalNamespace +#define Tcl_GetGlobalNamespace \ + (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */ +#endif +#ifndef Tcl_GetVariableFullName +#define Tcl_GetVariableFullName \ + (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ +#endif +#ifndef Tcl_Import +#define Tcl_Import \ + (tclIntStubsPtr->tcl_Import) /* 127 */ +#endif +#ifndef Tcl_PopCallFrame +#define Tcl_PopCallFrame \ + (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ +#endif +#ifndef Tcl_PushCallFrame +#define Tcl_PushCallFrame \ + (tclIntStubsPtr->tcl_PushCallFrame) /* 129 */ +#endif +#ifndef Tcl_RemoveInterpResolvers +#define Tcl_RemoveInterpResolvers \ + (tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */ +#endif +#ifndef Tcl_SetNamespaceResolvers +#define Tcl_SetNamespaceResolvers \ + (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ +#endif +#ifndef TclpHasSockets +#define TclpHasSockets \ + (tclIntStubsPtr->tclpHasSockets) /* 132 */ +#endif +#ifndef TclpGetDate +#define TclpGetDate \ + (tclIntStubsPtr->tclpGetDate) /* 133 */ +#endif +#ifndef TclpStrftime +#define TclpStrftime \ + (tclIntStubsPtr->tclpStrftime) /* 134 */ +#endif +#ifndef TclpCheckStackSpace +#define TclpCheckStackSpace \ + (tclIntStubsPtr->tclpCheckStackSpace) /* 135 */ +#endif +/* Slot 136 is reserved */ +#ifndef TclpChdir +#define TclpChdir \ + (tclIntStubsPtr->tclpChdir) /* 137 */ +#endif +#ifndef TclGetEnv +#define TclGetEnv \ + (tclIntStubsPtr->tclGetEnv) /* 138 */ +#endif +#ifndef TclpLoadFile +#define TclpLoadFile \ + (tclIntStubsPtr->tclpLoadFile) /* 139 */ +#endif +#ifndef TclLooksLikeInt +#define TclLooksLikeInt \ + (tclIntStubsPtr->tclLooksLikeInt) /* 140 */ +#endif +#ifndef TclpGetCwd +#define TclpGetCwd \ + (tclIntStubsPtr->tclpGetCwd) /* 141 */ +#endif +#ifndef TclSetByteCodeFromAny +#define TclSetByteCodeFromAny \ + (tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */ +#endif +#ifndef TclAddLiteralObj +#define TclAddLiteralObj \ + (tclIntStubsPtr->tclAddLiteralObj) /* 143 */ +#endif +#ifndef TclHideLiteral +#define TclHideLiteral \ + (tclIntStubsPtr->tclHideLiteral) /* 144 */ +#endif +#ifndef TclGetAuxDataType +#define TclGetAuxDataType \ + (tclIntStubsPtr->tclGetAuxDataType) /* 145 */ +#endif +#ifndef TclHandleCreate +#define TclHandleCreate \ + (tclIntStubsPtr->tclHandleCreate) /* 146 */ +#endif +#ifndef TclHandleFree +#define TclHandleFree \ + (tclIntStubsPtr->tclHandleFree) /* 147 */ +#endif +#ifndef TclHandlePreserve +#define TclHandlePreserve \ + (tclIntStubsPtr->tclHandlePreserve) /* 148 */ +#endif +#ifndef TclHandleRelease +#define TclHandleRelease \ + (tclIntStubsPtr->tclHandleRelease) /* 149 */ +#endif +#ifndef TclRegAbout +#define TclRegAbout \ + (tclIntStubsPtr->tclRegAbout) /* 150 */ +#endif +#ifndef TclRegExpRangeUniChar +#define TclRegExpRangeUniChar \ + (tclIntStubsPtr->tclRegExpRangeUniChar) /* 151 */ +#endif +#ifndef TclSetLibraryPath +#define TclSetLibraryPath \ + (tclIntStubsPtr->tclSetLibraryPath) /* 152 */ +#endif +#ifndef TclGetLibraryPath +#define TclGetLibraryPath \ + (tclIntStubsPtr->tclGetLibraryPath) /* 153 */ +#endif +#ifndef TclTestChannelCmd +#define TclTestChannelCmd \ + (tclIntStubsPtr->tclTestChannelCmd) /* 154 */ +#endif +#ifndef TclTestChannelEventCmd +#define TclTestChannelEventCmd \ + (tclIntStubsPtr->tclTestChannelEventCmd) /* 155 */ +#endif +#ifndef TclRegError +#define TclRegError \ + (tclIntStubsPtr->tclRegError) /* 156 */ +#endif +#ifndef TclVarTraceExists +#define TclVarTraceExists \ + (tclIntStubsPtr->tclVarTraceExists) /* 157 */ +#endif + +#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#endif /* _TCLINTDECLS */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tclRegexp.h ./canvas-tcl8.2.2/tclRegexp.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tclRegexp.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tclRegexp.h Thu Dec 30 14:57:08 1999 @@ -0,0 +1,51 @@ +/* + * tclRegexp.h -- + * + * This file contains definitions used internally by Henry + * Spencer's regular expression code. + * + * Copyright (c) 1998 by Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclRegexp.h,v 1.11 1999/08/02 17:45:38 redman Exp $ + */ + +#ifndef _TCLREGEXP +#define _TCLREGEXP + +#include "regex.h" + +#ifdef BUILD_tcl +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLEXPORT +#endif + +/* + * The TclRegexp structure encapsulates a compiled regex_t, + * the flags that were used to compile it, and an array of pointers + * that are used to indicate subexpressions after a call to Tcl_RegExpExec. + * Note that the string and objPtr are mutually exclusive. These values + * are needed by Tcl_RegExpRange in order to return pointers into the + * original string. + */ + +typedef struct TclRegexp { + int flags; /* Regexp compile flags. */ + regex_t re; /* Compiled re, includes number of + * subexpressions. */ + CONST char *string; /* Last string passed to Tcl_RegExpExec. */ + Tcl_Obj *objPtr; /* Last object passed to Tcl_RegExpExecObj. */ + regmatch_t *matches; /* Array of indices into the Tcl_UniChar + * representation of the last string matched + * with this regexp to indicate the location + * of subexpressions. */ + rm_detail_t details; /* Detailed information on match (currently + * used only for REG_EXPECT). */ + int refCount; /* Count of number of references to this + * compiled regexp. */ +} TclRegexp; + +#endif /* _TCLREGEXP */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tk.h ./canvas-tcl8.2.2/tk.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tk.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tk.h Thu Dec 30 14:57:23 1999 @@ -0,0 +1,1230 @@ +/* + * tk.h -- + * + * Declarations for Tk-related things that are visible + * outside of the Tk module itself. + * + * Copyright (c) 1989-1994 The Regents of the University of California. + * Copyright (c) 1994 The Australian National University. + * Copyright (c) 1994-1998 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tk.h,v 1.30.2.2 1999/10/30 09:35:56 hobbs Exp $ + */ + +#ifndef _TK +#define _TK + +/* + * For C++ compilers, use extern "C" + */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* + * When version numbers change here, you must also go into the following files + * and update the version numbers: + * + * unix/configure.in + * README + * win/configure.in + * win/makefile.vc (only if major.minor changes, not patchlevel) + * library/tk.tcl (only if major.minor changes, not patchlevel) + * mac/README (only if major.minor changes, not patchlevel) + * win/README (only if major.minor changes, not patchlevel) + * unix/README (only if major.minor changes, not patchlevel) + + * You may also need to update some of these files when the numbers change + * for the version of Tcl that this release of Tk is compiled against. + */ + +#define TK_MAJOR_VERSION 8 +#define TK_MINOR_VERSION 2 +#define TK_RELEASE_LEVEL TCL_FINAL_RELEASE +#define TK_RELEASE_SERIAL 2 + +#define TK_VERSION "8.2" +#define TK_PATCH_LEVEL "8.2.2" + +/* + * The following definitions set up the proper options for Macintosh + * compilers. We use this method because there is no autoconf equivalent. + */ + +#ifdef MAC_TCL +# ifndef REDO_KEYSYM_LOOKUP +# define REDO_KEYSYM_LOOKUP +# endif +#endif + +#ifndef _TCL +# include +#endif + +/* + * A special definition used to allow this header file to be included + * in resource files. + */ + +#ifndef RESOURCE_INCLUDED + +#ifndef _XLIB_H +# ifdef MAC_TCL +# include +# include +# else +# include +# endif +#endif +#ifdef __STDC__ +# include +#endif + +#ifdef BUILD_tk +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLEXPORT +#endif + +/* + * Decide whether or not to use input methods. + */ + +#ifdef XNQueryInputStyle +#define TK_USE_INPUT_METHODS +#endif + +/* + * Dummy types that are used by clients: + */ + +typedef struct Tk_BindingTable_ *Tk_BindingTable; +typedef struct Tk_Canvas_ *Tk_Canvas; +typedef struct Tk_Cursor_ *Tk_Cursor; +typedef struct Tk_ErrorHandler_ *Tk_ErrorHandler; +typedef struct Tk_Font_ *Tk_Font; +typedef struct Tk_Image__ *Tk_Image; +typedef struct Tk_ImageMaster_ *Tk_ImageMaster; +typedef struct Tk_OptionTable_ *Tk_OptionTable; +typedef struct Tk_TextLayout_ *Tk_TextLayout; +typedef struct Tk_Window_ *Tk_Window; +typedef struct Tk_3DBorder_ *Tk_3DBorder; + +/* + * Additional types exported to clients. + */ + +typedef char *Tk_Uid; + +/* + * The enum below defines the valid types for Tk configuration options + * as implemented by Tk_InitOptions, Tk_SetOptions, etc. + */ + +typedef enum { + TK_OPTION_BOOLEAN, + TK_OPTION_INT, + TK_OPTION_DOUBLE, + TK_OPTION_STRING, + TK_OPTION_STRING_TABLE, + TK_OPTION_COLOR, + TK_OPTION_FONT, + TK_OPTION_BITMAP, + TK_OPTION_BORDER, + TK_OPTION_RELIEF, + TK_OPTION_CURSOR, + TK_OPTION_JUSTIFY, + TK_OPTION_ANCHOR, + TK_OPTION_SYNONYM, + TK_OPTION_PIXELS, + TK_OPTION_WINDOW, + TK_OPTION_END +} Tk_OptionType; + +/* + * Structures of the following type are used by widgets to specify + * their configuration options. Typically each widget has a static + * array of these structures, where each element of the array describes + * a single configuration option. The array is passed to + * Tk_CreateOptionTable. + */ + +typedef struct Tk_OptionSpec { + Tk_OptionType type; /* Type of option, such as TK_OPTION_COLOR; + * see definitions above. Last option in + * table must have type TK_OPTION_END. */ + char *optionName; /* Name used to specify option in Tcl + * commands. */ + char *dbName; /* Name for option in option database. */ + char *dbClass; /* Class for option in database. */ + char *defValue; /* Default value for option if not specified + * in command line, the option database, + * or the system. */ + int objOffset; /* Where in record to store a Tcl_Obj * that + * holds the value of this option, specified + * as an offset in bytes from the start of + * the record. Use the Tk_Offset macro to + * generate values for this. -1 means don't + * store the Tcl_Obj in the record. */ + int internalOffset; /* Where in record to store the internal + * representation of the value of this option, + * such as an int or XColor *. This field + * is specified as an offset in bytes + * from the start of the record. Use the + * Tk_Offset macro to generate values for it. + * -1 means don't store the internal + * representation in the record. */ + int flags; /* Any combination of the values defined + * below. */ + ClientData clientData; /* An alternate place to put option-specific + * data. Used for the monochrome default value + * for colors, etc. */ + int typeMask; /* An arbitrary bit mask defined by the + * class manager; typically bits correspond + * to certain kinds of options such as all + * those that require a redisplay when they + * change. Tk_SetOptions returns the bit-wise + * OR of the typeMasks of all options that + * were changed. */ +} Tk_OptionSpec; + +/* + * Flag values for Tk_OptionSpec structures. These flags are shared by + * Tk_ConfigSpec structures, so be sure to coordinate any changes + * carefully. + */ + +#define TK_OPTION_NULL_OK 1 + +/* + * Macro to use to fill in "offset" fields of the Tk_OptionSpec. + * struct. Computes number of bytes from beginning of structure + * to a given field. + */ + +#ifdef offsetof +#define Tk_Offset(type, field) ((int) offsetof(type, field)) +#else +#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field)) +#endif + +/* + * The following two structures are used for error handling. When + * configuration options are being modified, the old values are + * saved in a Tk_SavedOptions structure. If an error occurs, then the + * contents of the structure can be used to restore all of the old + * values. The contents of this structure are for the private use + * Tk. No-one outside Tk should ever read or write any of the fields + * of these structures. + */ + +typedef struct Tk_SavedOption { + struct TkOption *optionPtr; /* Points to information that describes + * the option. */ + Tcl_Obj *valuePtr; /* The old value of the option, in + * the form of a Tcl object; may be + * NULL if the value wasn't saved as + * an object. */ + double internalForm; /* The old value of the option, in + * some internal representation such + * as an int or (XColor *). Valid + * only if optionPtr->specPtr->objOffset + * is < 0. The space must be large + * enough to accommodate a double, a + * long, or a pointer; right now it + * looks like a double is big + * enough. Also, using a double + * guarantees that the field is + * properly aligned for storing large + * values. */ +} Tk_SavedOption; + +#ifdef TCL_MEM_DEBUG +# define TK_NUM_SAVED_OPTIONS 2 +#else +# define TK_NUM_SAVED_OPTIONS 20 +#endif + +typedef struct Tk_SavedOptions { + char *recordPtr; /* The data structure in which to + * restore configuration options. */ + Tk_Window tkwin; /* Window associated with recordPtr; + * needed to restore certain options. */ + int numItems; /* The number of valid items in + * items field. */ + Tk_SavedOption items[TK_NUM_SAVED_OPTIONS]; + /* Items used to hold old values. */ + struct Tk_SavedOptions *nextPtr; /* Points to next structure in list; + * needed if too many options changed + * to hold all the old values in a + * single structure. NULL means no + * more structures. */ +} Tk_SavedOptions; + +/* + * Structure used to describe application-specific configuration + * options: indicates procedures to call to parse an option and + * to return a text string describing an option. THESE ARE + * DEPRECATED; PLEASE USE THE NEW STRUCTURES LISTED ABOVE. + */ + +/* + * This is a temporary flag used while tkObjConfig and new widgets + * are in development. + */ + +#ifndef __NO_OLD_CONFIG + +typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, Tk_Window tkwin, char *value, char *widgRec, + int offset)); +typedef char *(Tk_OptionPrintProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *widgRec, int offset, + Tcl_FreeProc **freeProcPtr)); + +typedef struct Tk_CustomOption { + Tk_OptionParseProc *parseProc; /* Procedure to call to parse an + * option and store it in converted + * form. */ + Tk_OptionPrintProc *printProc; /* Procedure to return a printable + * string describing an existing + * option. */ + ClientData clientData; /* Arbitrary one-word value used by + * option parser: passed to + * parseProc and printProc. */ +} Tk_CustomOption; + +/* + * Structure used to specify information for Tk_ConfigureWidget. Each + * structure gives complete information for one option, including + * how the option is specified on the command line, where it appears + * in the option database, etc. + */ + +typedef struct Tk_ConfigSpec { + int type; /* Type of option, such as TK_CONFIG_COLOR; + * see definitions below. Last option in + * table must have type TK_CONFIG_END. */ + char *argvName; /* Switch used to specify option in argv. + * NULL means this spec is part of a group. */ + char *dbName; /* Name for option in option database. */ + char *dbClass; /* Class for option in database. */ + char *defValue; /* Default value for option if not + * specified in command line or database. */ + int offset; /* Where in widget record to store value; + * use Tk_Offset macro to generate values + * for this. */ + int specFlags; /* Any combination of the values defined + * below; other bits are used internally + * by tkConfig.c. */ + Tk_CustomOption *customPtr; /* If type is TK_CONFIG_CUSTOM then this is + * a pointer to info about how to parse and + * print the option. Otherwise it is + * irrelevant. */ +} Tk_ConfigSpec; + +/* + * Type values for Tk_ConfigSpec structures. See the user + * documentation for details. + */ + +typedef enum { + TK_CONFIG_BOOLEAN, TK_CONFIG_INT, TK_CONFIG_DOUBLE, TK_CONFIG_STRING, + TK_CONFIG_UID, TK_CONFIG_COLOR, TK_CONFIG_FONT, TK_CONFIG_BITMAP, + TK_CONFIG_BORDER, TK_CONFIG_RELIEF, TK_CONFIG_CURSOR, + TK_CONFIG_ACTIVE_CURSOR, TK_CONFIG_JUSTIFY, TK_CONFIG_ANCHOR, + TK_CONFIG_SYNONYM, TK_CONFIG_CAP_STYLE, TK_CONFIG_JOIN_STYLE, + TK_CONFIG_PIXELS, TK_CONFIG_MM, TK_CONFIG_WINDOW, TK_CONFIG_CUSTOM, + TK_CONFIG_END +} Tk_ConfigTypes; + +/* + * Possible values for flags argument to Tk_ConfigureWidget: + */ + +#define TK_CONFIG_ARGV_ONLY 1 + +/* + * Possible flag values for Tk_ConfigSpec structures. Any bits at + * or above TK_CONFIG_USER_BIT may be used by clients for selecting + * certain entries. Before changing any values here, coordinate with + * tkOldConfig.c (internal-use-only flags are defined there). + */ + +#define TK_CONFIG_NULL_OK 1 +#define TK_CONFIG_COLOR_ONLY 2 +#define TK_CONFIG_MONO_ONLY 4 +#define TK_CONFIG_DONT_SET_DEFAULT 8 +#define TK_CONFIG_OPTION_SPECIFIED 0x10 +#define TK_CONFIG_USER_BIT 0x100 +#endif /* __NO_OLD_CONFIG */ + +/* + * Structure used to specify how to handle argv options. + */ + +typedef struct { + char *key; /* The key string that flags the option in the + * argv array. */ + int type; /* Indicates option type; see below. */ + char *src; /* Value to be used in setting dst; usage + * depends on type. */ + char *dst; /* Address of value to be modified; usage + * depends on type. */ + char *help; /* Documentation message describing this option. */ +} Tk_ArgvInfo; + +/* + * Legal values for the type field of a Tk_ArgvInfo: see the user + * documentation for details. + */ + +#define TK_ARGV_CONSTANT 15 +#define TK_ARGV_INT 16 +#define TK_ARGV_STRING 17 +#define TK_ARGV_UID 18 +#define TK_ARGV_REST 19 +#define TK_ARGV_FLOAT 20 +#define TK_ARGV_FUNC 21 +#define TK_ARGV_GENFUNC 22 +#define TK_ARGV_HELP 23 +#define TK_ARGV_CONST_OPTION 24 +#define TK_ARGV_OPTION_VALUE 25 +#define TK_ARGV_OPTION_NAME_VALUE 26 +#define TK_ARGV_END 27 + +/* + * Flag bits for passing to Tk_ParseArgv: + */ + +#define TK_ARGV_NO_DEFAULTS 0x1 +#define TK_ARGV_NO_LEFTOVERS 0x2 +#define TK_ARGV_NO_ABBREV 0x4 +#define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8 + +/* + * Enumerated type for describing actions to be taken in response + * to a restrictProc established by Tk_RestrictEvents. + */ + +typedef enum { + TK_DEFER_EVENT, TK_PROCESS_EVENT, TK_DISCARD_EVENT +} Tk_RestrictAction; + +/* + * Priority levels to pass to Tk_AddOption: + */ + +#define TK_WIDGET_DEFAULT_PRIO 20 +#define TK_STARTUP_FILE_PRIO 40 +#define TK_USER_DEFAULT_PRIO 60 +#define TK_INTERACTIVE_PRIO 80 +#define TK_MAX_PRIO 100 + +/* + * Relief values returned by Tk_GetRelief: + */ + +#define TK_RELIEF_FLAT 0 +#define TK_RELIEF_GROOVE 1 +#define TK_RELIEF_RAISED 2 +#define TK_RELIEF_RIDGE 3 +#define TK_RELIEF_SOLID 4 +#define TK_RELIEF_SUNKEN 5 + +/* + * "Which" argument values for Tk_3DBorderGC: + */ + +#define TK_3D_FLAT_GC 1 +#define TK_3D_LIGHT_GC 2 +#define TK_3D_DARK_GC 3 + +/* + * Special EnterNotify/LeaveNotify "mode" for use in events + * generated by tkShare.c. Pick a high enough value that it's + * unlikely to conflict with existing values (like NotifyNormal) + * or any new values defined in the future. + */ + +#define TK_NOTIFY_SHARE 20 + +/* + * Enumerated type for describing a point by which to anchor something: + */ + +typedef enum { + TK_ANCHOR_N, TK_ANCHOR_NE, TK_ANCHOR_E, TK_ANCHOR_SE, + TK_ANCHOR_S, TK_ANCHOR_SW, TK_ANCHOR_W, TK_ANCHOR_NW, + TK_ANCHOR_CENTER +} Tk_Anchor; + +/* + * Enumerated type for describing a style of justification: + */ + +typedef enum { + TK_JUSTIFY_LEFT, TK_JUSTIFY_RIGHT, TK_JUSTIFY_CENTER +} Tk_Justify; + +/* + * The following structure is used by Tk_GetFontMetrics() to return + * information about the properties of a Tk_Font. + */ + +typedef struct Tk_FontMetrics { + int ascent; /* The amount in pixels that the tallest + * letter sticks up above the baseline, plus + * any extra blank space added by the designer + * of the font. */ + int descent; /* The largest amount in pixels that any + * letter sticks below the baseline, plus any + * extra blank space added by the designer of + * the font. */ + int linespace; /* The sum of the ascent and descent. How + * far apart two lines of text in the same + * font should be placed so that none of the + * characters in one line overlap any of the + * characters in the other line. */ +} Tk_FontMetrics; + +/* + * Flags passed to Tk_MeasureChars: + */ + +#define TK_WHOLE_WORDS 1 +#define TK_AT_LEAST_ONE 2 +#define TK_PARTIAL_OK 4 + +/* + * Flags passed to Tk_ComputeTextLayout: + */ + +#define TK_IGNORE_TABS 8 +#define TK_IGNORE_NEWLINES 16 + +/* + * Each geometry manager (the packer, the placer, etc.) is represented + * by a structure of the following form, which indicates procedures + * to invoke in the geometry manager to carry out certain functions. + */ + +typedef void (Tk_GeomRequestProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin)); +typedef void (Tk_GeomLostSlaveProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin)); + +typedef struct Tk_GeomMgr { + char *name; /* Name of the geometry manager (command + * used to invoke it, or name of widget + * class that allows embedded widgets). */ + Tk_GeomRequestProc *requestProc; + /* Procedure to invoke when a slave's + * requested geometry changes. */ + Tk_GeomLostSlaveProc *lostSlaveProc; + /* Procedure to invoke when a slave is + * taken away from one geometry manager + * by another. NULL means geometry manager + * doesn't care when slaves are lost. */ +} Tk_GeomMgr; + +/* + * Result values returned by Tk_GetScrollInfo: + */ + +#define TK_SCROLL_MOVETO 1 +#define TK_SCROLL_PAGES 2 +#define TK_SCROLL_UNITS 3 +#define TK_SCROLL_ERROR 4 + +/* + *--------------------------------------------------------------------------- + * + * Extensions to the X event set + * + *--------------------------------------------------------------------------- + */ +#define VirtualEvent (LASTEvent) +#define ActivateNotify (LASTEvent + 1) +#define DeactivateNotify (LASTEvent + 2) +#define MouseWheelEvent (LASTEvent + 3) +#define TK_LASTEVENT (LASTEvent + 4) + +#define MouseWheelMask (1L << 28) + +#define ActivateMask (1L << 29) +#define VirtualEventMask (1L << 30) +#define TK_LASTEVENT (LASTEvent + 4) + + +/* + * A virtual event shares most of its fields with the XKeyEvent and + * XButtonEvent structures. 99% of the time a virtual event will be + * an abstraction of a key or button event, so this structure provides + * the most information to the user. The only difference is the changing + * of the detail field for a virtual event so that it holds the name of the + * virtual event being triggered. + */ + +typedef struct { + int type; + unsigned long serial; /* # of last request processed by server */ + Bool send_event; /* True if this came from a SendEvent request */ + Display *display; /* Display the event was read from */ + Window event; /* Window on which event was requested. */ + Window root; /* root window that the event occured on */ + Window subwindow; /* child window */ + Time time; /* milliseconds */ + int x, y; /* pointer x, y coordinates in event window */ + int x_root, y_root; /* coordinates relative to root */ + unsigned int state; /* key or button mask */ + Tk_Uid name; /* Name of virtual event. */ + Bool same_screen; /* same screen flag */ +} XVirtualEvent; + +typedef struct { + int type; + unsigned long serial; /* # of last request processed by server */ + Bool send_event; /* True if this came from a SendEvent request */ + Display *display; /* Display the event was read from */ + Window window; /* Window in which event occurred. */ +} XActivateDeactivateEvent; +typedef XActivateDeactivateEvent XActivateEvent; +typedef XActivateDeactivateEvent XDeactivateEvent; + +/* + *-------------------------------------------------------------- + * + * Macros for querying Tk_Window structures. See the + * manual entries for documentation. + * + *-------------------------------------------------------------- + */ + +#define Tk_Display(tkwin) (((Tk_FakeWin *) (tkwin))->display) +#define Tk_ScreenNumber(tkwin) (((Tk_FakeWin *) (tkwin))->screenNum) +#define Tk_Screen(tkwin) (ScreenOfDisplay(Tk_Display(tkwin), \ + Tk_ScreenNumber(tkwin))) +#define Tk_Depth(tkwin) (((Tk_FakeWin *) (tkwin))->depth) +#define Tk_Visual(tkwin) (((Tk_FakeWin *) (tkwin))->visual) +#define Tk_WindowId(tkwin) (((Tk_FakeWin *) (tkwin))->window) +#define Tk_PathName(tkwin) (((Tk_FakeWin *) (tkwin))->pathName) +#define Tk_Name(tkwin) (((Tk_FakeWin *) (tkwin))->nameUid) +#define Tk_Class(tkwin) (((Tk_FakeWin *) (tkwin))->classUid) +#define Tk_X(tkwin) (((Tk_FakeWin *) (tkwin))->changes.x) +#define Tk_Y(tkwin) (((Tk_FakeWin *) (tkwin))->changes.y) +#define Tk_Width(tkwin) (((Tk_FakeWin *) (tkwin))->changes.width) +#define Tk_Height(tkwin) \ + (((Tk_FakeWin *) (tkwin))->changes.height) +#define Tk_Changes(tkwin) (&((Tk_FakeWin *) (tkwin))->changes) +#define Tk_Attributes(tkwin) (&((Tk_FakeWin *) (tkwin))->atts) +#define Tk_IsEmbedded(tkwin) \ + (((Tk_FakeWin *) (tkwin))->flags & TK_EMBEDDED) +#define Tk_IsContainer(tkwin) \ + (((Tk_FakeWin *) (tkwin))->flags & TK_CONTAINER) +#define Tk_IsMapped(tkwin) \ + (((Tk_FakeWin *) (tkwin))->flags & TK_MAPPED) +#define Tk_IsTopLevel(tkwin) \ + (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_LEVEL) +#define Tk_ReqWidth(tkwin) (((Tk_FakeWin *) (tkwin))->reqWidth) +#define Tk_ReqHeight(tkwin) (((Tk_FakeWin *) (tkwin))->reqHeight) +#define Tk_InternalBorderWidth(tkwin) \ + (((Tk_FakeWin *) (tkwin))->internalBorderWidth) +#define Tk_Parent(tkwin) (((Tk_FakeWin *) (tkwin))->parentPtr) +#define Tk_Colormap(tkwin) (((Tk_FakeWin *) (tkwin))->atts.colormap) + +/* + * The structure below is needed by the macros above so that they can + * access the fields of a Tk_Window. The fields not needed by the macros + * are declared as "dummyX". The structure has its own type in order to + * prevent applications from accessing Tk_Window fields except using + * official macros. WARNING!! The structure definition must be kept + * consistent with the TkWindow structure in tkInt.h. If you change one, + * then change the other. See the declaration in tkInt.h for + * documentation on what the fields are used for internally. + */ + +typedef struct Tk_FakeWin { + Display *display; + char *dummy1; + int screenNum; + Visual *visual; + int depth; + Window window; + char *dummy2; + char *dummy3; + Tk_Window parentPtr; + char *dummy4; + char *dummy5; + char *pathName; + Tk_Uid nameUid; + Tk_Uid classUid; + XWindowChanges changes; + unsigned int dummy6; + XSetWindowAttributes atts; + unsigned long dummy7; + unsigned int flags; + char *dummy8; +#ifdef TK_USE_INPUT_METHODS + XIC dummy9; +#endif /* TK_USE_INPUT_METHODS */ + ClientData *dummy10; + int dummy11; + int dummy12; + char *dummy13; + char *dummy14; + ClientData dummy15; + int reqWidth, reqHeight; + int internalBorderWidth; + char *dummy16; + char *dummy17; + ClientData dummy18; + char *dummy19; +} Tk_FakeWin; + +/* + * Flag values for TkWindow (and Tk_FakeWin) structures are: + * + * TK_MAPPED: 1 means window is currently mapped, + * 0 means unmapped. + * TK_TOP_LEVEL: 1 means this is a top-level window (it + * was or will be created as a child of + * a root window). + * TK_ALREADY_DEAD: 1 means the window is in the process of + * being destroyed already. + * TK_NEED_CONFIG_NOTIFY: 1 means that the window has been reconfigured + * before it was made to exist. At the time of + * making it exist a ConfigureNotify event needs + * to be generated. + * TK_GRAB_FLAG: Used to manage grabs. See tkGrab.c for + * details. + * TK_CHECKED_IC: 1 means we've already tried to get an input + * context for this window; if the ic field + * is NULL it means that there isn't a context + * for the field. + * TK_DONT_DESTROY_WINDOW: 1 means that Tk_DestroyWindow should not + * invoke XDestroyWindow to destroy this widget's + * X window. The flag is set when the window + * has already been destroyed elsewhere (e.g. + * by another application) or when it will be + * destroyed later (e.g. by destroying its + * parent). + * TK_WM_COLORMAP_WINDOW: 1 means that this window has at some time + * appeared in the WM_COLORMAP_WINDOWS property + * for its toplevel, so we have to remove it + * from that property if the window is + * deleted and the toplevel isn't. + * TK_EMBEDDED: 1 means that this window (which must be a + * toplevel) is not a free-standing window but + * rather is embedded in some other application. + * TK_CONTAINER: 1 means that this window is a container, and + * that some other application (either in + * this process or elsewhere) may be + * embedding itself inside the window. + * TK_BOTH_HALVES: 1 means that this window is used for + * application embedding (either as + * container or embedded application), and + * both the containing and embedded halves + * are associated with windows in this + * particular process. + * TK_DEFER_MODAL: 1 means that this window has deferred a modal + * loop until all of the bindings for the current + * event have been invoked. + * TK_WRAPPER: 1 means that this window is the extra + * wrapper window created around a toplevel + * to hold the menubar under Unix. See + * tkUnixWm.c for more information. + * TK_REPARENTED: 1 means that this window has been reparented + * so that as far as the window system is + * concerned it isn't a child of its Tk + * parent. Initially this is used only for + * special Unix menubar windows. + */ + + +#define TK_MAPPED 1 +#define TK_TOP_LEVEL 2 +#define TK_ALREADY_DEAD 4 +#define TK_NEED_CONFIG_NOTIFY 8 +#define TK_GRAB_FLAG 0x10 +#define TK_CHECKED_IC 0x20 +#define TK_DONT_DESTROY_WINDOW 0x40 +#define TK_WM_COLORMAP_WINDOW 0x80 +#define TK_EMBEDDED 0x100 +#define TK_CONTAINER 0x200 +#define TK_BOTH_HALVES 0x400 +#define TK_DEFER_MODAL 0x800 +#define TK_WRAPPER 0x1000 +#define TK_REPARENTED 0x2000 + +/* + *-------------------------------------------------------------- + * + * Procedure prototypes and structures used for defining new canvas + * items: + * + *-------------------------------------------------------------- + */ + +/* + * For each item in a canvas widget there exists one record with + * the following structure. Each actual item is represented by + * a record with the following stuff at its beginning, plus additional + * type-specific stuff after that. + */ + +#define TK_TAG_SPACE 3 + +typedef struct Tk_Item { + int id; /* Unique identifier for this item + * (also serves as first tag for + * item). */ + struct Tk_Item *nextPtr; /* Next in display list of all + * items in this canvas. Later items + * in list are drawn on top of earlier + * ones. */ + Tk_Uid staticTagSpace[TK_TAG_SPACE];/* Built-in space for limited # of + * tags. */ + Tk_Uid *tagPtr; /* Pointer to array of tags. Usually + * points to staticTagSpace, but + * may point to malloc-ed space if + * there are lots of tags. */ + int tagSpace; /* Total amount of tag space available + * at tagPtr. */ + int numTags; /* Number of tag slots actually used + * at *tagPtr. */ + struct Tk_ItemType *typePtr; /* Table of procedures that implement + * this type of item. */ + int x1, y1, x2, y2; /* Bounding box for item, in integer + * canvas units. Set by item-specific + * code and guaranteed to contain every + * pixel drawn in item. Item area + * includes x1 and y1 but not x2 + * and y2. */ + struct Tk_Item *prevPtr; /* Previous in display list of all + * items in this canvas. Later items + * in list are drawn just below earlier + * ones. */ + int reserved1; /* This padding is for compatibility */ + char *reserved2; /* with Jan Nijtmans dash patch */ + int reserved3; + + /* + *------------------------------------------------------------------ + * Starting here is additional type-specific stuff; see the + * declarations for individual types to see what is part of + * each type. The actual space below is determined by the + * "itemInfoSize" of the type's Tk_ItemType record. + *------------------------------------------------------------------ + */ +} Tk_Item; + +/* + * Records of the following type are used to describe a type of + * item (e.g. lines, circles, etc.) that can form part of a + * canvas widget. + */ + +typedef int Tk_ItemCreateProc _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv)); +typedef int Tk_ItemConfigureProc _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +typedef int Tk_ItemCoordProc _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv)); +typedef void Tk_ItemDeleteProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +typedef void Tk_ItemDisplayProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +typedef double Tk_ItemPointProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *pointPtr)); +typedef int Tk_ItemAreaProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *rectPtr)); +typedef int Tk_ItemPostscriptProc _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); +typedef void Tk_ItemScaleProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +typedef void Tk_ItemTranslateProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); +typedef int Tk_ItemIndexProc _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, char *indexString, + int *indexPtr)); +typedef void Tk_ItemCursorProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, int index)); +typedef int Tk_ItemSelectionProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, int offset, char *buffer, + int maxBytes)); +typedef void Tk_ItemInsertProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, int beforeThis, char *string)); +typedef void Tk_ItemDCharsProc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, int first, int last)); + +#ifndef __NO_OLD_CONFIG + +typedef struct Tk_ItemType { + char *name; /* The name of this type of item, such + * as "line". */ + int itemSize; /* Total amount of space needed for + * item's record. */ + Tk_ItemCreateProc *createProc; /* Procedure to create a new item of + * this type. */ + Tk_ConfigSpec *configSpecs; /* Pointer to array of configuration + * specs for this type. Used for + * returning configuration info. */ + Tk_ItemConfigureProc *configProc; /* Procedure to call to change + * configuration options. */ + Tk_ItemCoordProc *coordProc; /* Procedure to call to get and set + * the item's coordinates. */ + Tk_ItemDeleteProc *deleteProc; /* Procedure to delete existing item of + * this type. */ + Tk_ItemDisplayProc *displayProc; /* Procedure to display items of + * this type. */ + int alwaysRedraw; /* Non-zero means displayProc should + * be called even when the item has + * been moved off-screen. */ + Tk_ItemPointProc *pointProc; /* Computes distance from item to + * a given point. */ + Tk_ItemAreaProc *areaProc; /* Computes whether item is inside, + * outside, or overlapping an area. */ + Tk_ItemPostscriptProc *postscriptProc; + /* Procedure to write a Postscript + * description for items of this + * type. */ + Tk_ItemScaleProc *scaleProc; /* Procedure to rescale items of + * this type. */ + Tk_ItemTranslateProc *translateProc;/* Procedure to translate items of + * this type. */ + Tk_ItemIndexProc *indexProc; /* Procedure to determine index of + * indicated character. NULL if + * item doesn't support indexing. */ + Tk_ItemCursorProc *icursorProc; /* Procedure to set insert cursor pos. + * to just before a given position. */ + Tk_ItemSelectionProc *selectionProc;/* Procedure to return selection (in + * STRING format) when it is in this + * item. */ + Tk_ItemInsertProc *insertProc; /* Procedure to insert something into + * an item. */ + Tk_ItemDCharsProc *dCharsProc; /* Procedure to delete characters + * from an item. */ + struct Tk_ItemType *nextPtr; /* Used to link types together into + * a list. */ + char *reserved1; /* Reserved for future extension. */ + int reserved2; /* Carefully compatible with */ + char *reserved3; /* Jan Nijtmans dash patch */ + char *reserved4; +} Tk_ItemType; + +#endif + +/* + * The following structure provides information about the selection and + * the insertion cursor. It is needed by only a few items, such as + * those that display text. It is shared by the generic canvas code + * and the item-specific code, but most of the fields should be written + * only by the canvas generic code. + */ + +typedef struct Tk_CanvasTextInfo { + Tk_3DBorder selBorder; /* Border and background for selected + * characters. Read-only to items.*/ + int selBorderWidth; /* Width of border around selection. + * Read-only to items. */ + XColor *selFgColorPtr; /* Foreground color for selected text. + * Read-only to items. */ + Tk_Item *selItemPtr; /* Pointer to selected item. NULL means + * selection isn't in this canvas. + * Writable by items. */ + int selectFirst; /* Character index of first selected + * character. Writable by items. */ + int selectLast; /* Character index of last selected + * character. Writable by items. */ + Tk_Item *anchorItemPtr; /* Item corresponding to "selectAnchor": + * not necessarily selItemPtr. Read-only + * to items. */ + int selectAnchor; /* Character index of fixed end of + * selection (i.e. "select to" operation will + * use this as one end of the selection). + * Writable by items. */ + Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion + * cursor. Read-only to items. */ + int insertWidth; /* Total width of insertion cursor. Read-only + * to items. */ + int insertBorderWidth; /* Width of 3-D border around insert cursor. + * Read-only to items. */ + Tk_Item *focusItemPtr; /* Item that currently has the input focus, + * or NULL if no such item. Read-only to + * items. */ + int gotFocus; /* Non-zero means that the canvas widget has + * the input focus. Read-only to items.*/ + int cursorOn; /* Non-zero means that an insertion cursor + * should be displayed in focusItemPtr. + * Read-only to items.*/ +} Tk_CanvasTextInfo; + +/* + *-------------------------------------------------------------- + * + * Procedure prototypes and structures used for managing images: + * + *-------------------------------------------------------------- + */ + +typedef struct Tk_ImageType Tk_ImageType; +typedef int (Tk_ImageCreateProc) _ANSI_ARGS_((Tcl_Interp *interp, + char *name, int argc, char **argv, Tk_ImageType *typePtr, + Tk_ImageMaster master, ClientData *masterDataPtr)); +typedef ClientData (Tk_ImageGetProc) _ANSI_ARGS_((Tk_Window tkwin, + ClientData masterData)); +typedef void (Tk_ImageDisplayProc) _ANSI_ARGS_((ClientData instanceData, + Display *display, Drawable drawable, int imageX, int imageY, + int width, int height, int drawableX, int drawableY)); +typedef void (Tk_ImageFreeProc) _ANSI_ARGS_((ClientData instanceData, + Display *display)); +typedef void (Tk_ImageDeleteProc) _ANSI_ARGS_((ClientData masterData)); +typedef void (Tk_ImageChangedProc) _ANSI_ARGS_((ClientData clientData, + int x, int y, int width, int height, int imageWidth, + int imageHeight)); + +/* + * The following structure represents a particular type of image + * (bitmap, xpm image, etc.). It provides information common to + * all images of that type, such as the type name and a collection + * of procedures in the image manager that respond to various + * events. Each image manager is represented by one of these + * structures. + */ + +struct Tk_ImageType { + char *name; /* Name of image type. */ + Tk_ImageCreateProc *createProc; + /* Procedure to call to create a new image + * of this type. */ + Tk_ImageGetProc *getProc; /* Procedure to call the first time + * Tk_GetImage is called in a new way + * (new visual or screen). */ + Tk_ImageDisplayProc *displayProc; + /* Call to draw image, in response to + * Tk_RedrawImage calls. */ + Tk_ImageFreeProc *freeProc; /* Procedure to call whenever Tk_FreeImage + * is called to release an instance of an + * image. */ + Tk_ImageDeleteProc *deleteProc; + /* Procedure to call to delete image. It + * will not be called until after freeProc + * has been called for each instance of the + * image. */ + struct Tk_ImageType *nextPtr; + /* Next in list of all image types currently + * known. Filled in by Tk, not by image + * manager. */ + char *reserved; /* reserved for future expansion */ +}; + +/* + *-------------------------------------------------------------- + * + * Additional definitions used to manage images of type "photo". + * + *-------------------------------------------------------------- + */ + +/* + * The following type is used to identify a particular photo image + * to be manipulated: + */ + +typedef void *Tk_PhotoHandle; + +/* + * The following structure describes a block of pixels in memory: + */ + +typedef struct Tk_PhotoImageBlock { + unsigned char *pixelPtr; /* Pointer to the first pixel. */ + int width; /* Width of block, in pixels. */ + int height; /* Height of block, in pixels. */ + int pitch; /* Address difference between corresponding + * pixels in successive lines. */ + int pixelSize; /* Address difference between successive + * pixels in the same line. */ + int offset[3]; /* Address differences between the red, green + * and blue components of the pixel and the + * pixel as a whole. */ + int reserved; /* Reserved for extensions (dash patch) */ +} Tk_PhotoImageBlock; + +/* + * Procedure prototypes and structures used in reading and + * writing photo images: + */ + +typedef struct Tk_PhotoImageFormat Tk_PhotoImageFormat; +typedef int (Tk_ImageFileMatchProc) _ANSI_ARGS_((Tcl_Channel chan, + char *fileName, char *formatString, int *widthPtr, int *heightPtr)); +typedef int (Tk_ImageStringMatchProc) _ANSI_ARGS_((char *string, + char *formatString, int *widthPtr, int *heightPtr)); +typedef int (Tk_ImageFileReadProc) _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Channel chan, char *fileName, char *formatString, + Tk_PhotoHandle imageHandle, int destX, int destY, + int width, int height, int srcX, int srcY)); +typedef int (Tk_ImageStringReadProc) _ANSI_ARGS_((Tcl_Interp *interp, + char *string, char *formatString, Tk_PhotoHandle imageHandle, + int destX, int destY, int width, int height, int srcX, int srcY)); +typedef int (Tk_ImageFileWriteProc) _ANSI_ARGS_((Tcl_Interp *interp, + char *fileName, char *formatString, Tk_PhotoImageBlock *blockPtr)); +typedef int (Tk_ImageStringWriteProc) _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_DString *dataPtr, char *formatString, + Tk_PhotoImageBlock *blockPtr)); + +/* + * The following structure represents a particular file format for + * storing images (e.g., PPM, GIF, JPEG, etc.). It provides information + * to allow image files of that format to be recognized and read into + * a photo image. + */ + +struct Tk_PhotoImageFormat { + char *name; /* Name of image file format */ + Tk_ImageFileMatchProc *fileMatchProc; + /* Procedure to call to determine whether + * an image file matches this format. */ + Tk_ImageStringMatchProc *stringMatchProc; + /* Procedure to call to determine whether + * the data in a string matches this format. */ + Tk_ImageFileReadProc *fileReadProc; + /* Procedure to call to read data from + * an image file into a photo image. */ + Tk_ImageStringReadProc *stringReadProc; + /* Procedure to call to read data from + * a string into a photo image. */ + Tk_ImageFileWriteProc *fileWriteProc; + /* Procedure to call to write data from + * a photo image to a file. */ + Tk_ImageStringWriteProc *stringWriteProc; + /* Procedure to call to obtain a string + * representation of the data in a photo + * image.*/ + struct Tk_PhotoImageFormat *nextPtr; + /* Next in list of all photo image formats + * currently known. Filled in by Tk, not + * by image format handler. */ +}; + +/* + *-------------------------------------------------------------- + * + * The definitions below provide backward compatibility for + * functions and types related to event handling that used to + * be in Tk but have moved to Tcl. + * + *-------------------------------------------------------------- + */ + +#define TK_READABLE TCL_READABLE +#define TK_WRITABLE TCL_WRITABLE +#define TK_EXCEPTION TCL_EXCEPTION + +#define TK_DONT_WAIT TCL_DONT_WAIT +#define TK_X_EVENTS TCL_WINDOW_EVENTS +#define TK_WINDOW_EVENTS TCL_WINDOW_EVENTS +#define TK_FILE_EVENTS TCL_FILE_EVENTS +#define TK_TIMER_EVENTS TCL_TIMER_EVENTS +#define TK_IDLE_EVENTS TCL_IDLE_EVENTS +#define TK_ALL_EVENTS TCL_ALL_EVENTS + +#define Tk_IdleProc Tcl_IdleProc +#define Tk_FileProc Tcl_FileProc +#define Tk_TimerProc Tcl_TimerProc +#define Tk_TimerToken Tcl_TimerToken + +#define Tk_BackgroundError Tcl_BackgroundError +#define Tk_CancelIdleCall Tcl_CancelIdleCall +#define Tk_CreateFileHandler Tcl_CreateFileHandler +#define Tk_CreateTimerHandler Tcl_CreateTimerHandler +#define Tk_DeleteFileHandler Tcl_DeleteFileHandler +#define Tk_DeleteTimerHandler Tcl_DeleteTimerHandler +#define Tk_DoOneEvent Tcl_DoOneEvent +#define Tk_DoWhenIdle Tcl_DoWhenIdle +#define Tk_Sleep Tcl_Sleep + +/* Additional stuff that has moved to Tcl: */ + +#define Tk_AfterCmd Tcl_AfterCmd +#define Tk_EventuallyFree Tcl_EventuallyFree +#define Tk_FreeProc Tcl_FreeProc +#define Tk_Preserve Tcl_Preserve +#define Tk_Release Tcl_Release + +/* Removed Tk_Main, use macro instead */ +#define Tk_Main(argc, argv, proc) \ + Tk_MainEx(argc, argv, proc, Tcl_CreateInterp()) + +char *Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, char *version, int exact)); + +#ifndef USE_TK_STUBS + +#define Tk_InitStubs(interp, version, exact) \ + Tcl_PkgRequire(interp, "Tk", version, exact) + +#endif + + +/* + *-------------------------------------------------------------- + * + * Additional procedure types defined by Tk. + * + *-------------------------------------------------------------- + */ + +typedef int (Tk_ErrorProc) _ANSI_ARGS_((ClientData clientData, + XErrorEvent *errEventPtr)); +typedef void (Tk_EventProc) _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); +typedef int (Tk_GenericProc) _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); +typedef int (Tk_GetSelProc) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *portion)); +typedef void (Tk_LostSelProc) _ANSI_ARGS_((ClientData clientData)); +typedef Tk_RestrictAction (Tk_RestrictProc) _ANSI_ARGS_(( + ClientData clientData, XEvent *eventPtr)); +typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData, + int offset, char *buffer, int maxBytes)); + +/* + *-------------------------------------------------------------- + * + * Exported procedures and variables. + * + *-------------------------------------------------------------- + */ + +#include "tkDecls.h" + +/* + * Tcl commands exported by Tk: + */ + + +#endif /* RESOURCE_INCLUDED */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +/* + * end block for C++ + */ + +#ifdef __cplusplus +} +#endif + +#endif /* _TK */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvArc.c ./canvas-tcl8.2.2/tkCanvArc.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvArc.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvArc.c Thu Dec 30 14:59:40 1999 @@ -0,0 +1,1705 @@ +/* + * tkCanvArc.c -- + * + * This file implements arc items for canvas widgets. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvArc.c,v 1.6 1999/04/21 21:53:24 rjohnson Exp $ + */ + +#include +#include "tkPort.h" +#include "tkInt.h" +#include "xxl_incs.h" + + + +/* + * The definitions below define the sizes of the polygons used to + * display outline information for various styles of arcs: + */ + +#define CHORD_OUTLINE_PTS 7 +#define PIE_OUTLINE1_PTS 6 +#define PIE_OUTLINE2_PTS 7 + +/* + * Information used for parsing configuration specs: + */ + +static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, + Tk_CanvasTagsPrintProc, (ClientData) NULL +}; + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_DOUBLE, "-extent", (char *) NULL, (char *) NULL, + "90", Tk_Offset(ArcItem, extent), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(ArcItem, fillColor), TK_CONFIG_NULL_OK}, + {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL, + "black", Tk_Offset(ArcItem, outlineColor), TK_CONFIG_NULL_OK}, + {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(ArcItem, outlineStipple), TK_CONFIG_NULL_OK}, + {TK_CONFIG_DOUBLE, "-start", (char *) NULL, (char *) NULL, + "0", Tk_Offset(ArcItem, start), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(ArcItem, fillStipple), TK_CONFIG_NULL_OK}, + {TK_CONFIG_UID, "-style", (char *) NULL, (char *) NULL, + "pieslice", Tk_Offset(ArcItem, style), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, + "1", Tk_Offset(ArcItem, width), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Prototypes for procedures defined in this file: + */ + +static void ComputeArcBbox _ANSI_ARGS_((Tk_Canvas canvas, + ArcItem *arcPtr)); +static int ConfigureArc _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +static int CreateArc _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, struct Tk_Item *itemPtr, + int argc, char **argv)); +static void DeleteArc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +static void DisplayArc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +static int ArcCoords _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv)); +static int ArcToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *rectPtr)); +static double ArcToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *coordPtr)); +static int ArcToPostscript _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); +static void ScaleArc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +static void TranslateArc _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); +static int AngleInRange _ANSI_ARGS_((double x, double y, + double start, double extent)); +static void ComputeArcOutline _ANSI_ARGS_((ArcItem *arcPtr)); +static int HorizLineToArc _ANSI_ARGS_((double x1, double x2, + double y, double rx, double ry, + double start, double extent)); +static int VertLineToArc _ANSI_ARGS_((double x, double y1, + double y2, double rx, double ry, + double start, double extent)); + +/* + * The structures below defines the arc item types by means of procedures + * that can be invoked by generic item code. + */ + +Tk_ItemType tkArcType = { + "arc", /* name */ + sizeof(ArcItem), /* itemSize */ + CreateArc, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureArc, /* configureProc */ + ArcCoords, /* coordProc */ + DeleteArc, /* deleteProc */ + DisplayArc, /* displayProc */ + 0, /* alwaysRedraw */ + ArcToPoint, /* pointProc */ + ArcToArea, /* areaProc */ + ArcToPostscript, /* postscriptProc */ + ScaleArc, /* scaleProc */ + TranslateArc, /* translateProc */ + (Tk_ItemIndexProc *) NULL, /* indexProc */ + (Tk_ItemCursorProc *) NULL, /* icursorProc */ + (Tk_ItemSelectionProc *) NULL, /* selectionProc */ + (Tk_ItemInsertProc *) NULL, /* insertProc */ + (Tk_ItemDCharsProc *) NULL, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + +#ifndef PI +# define PI 3.14159265358979323846 +#endif + + +/* + *-------------------------------------------------------------- + * + * CreateArc -- + * + * This procedure is invoked to create a new arc item in + * a canvas. + * + * Results: + * A standard Tcl return value. If an error occurred in + * creating the item, then an error message is left in + * the interp's result; in this case itemPtr is + * left uninitialized, so it can be safely freed by the + * caller. + * + * Side effects: + * A new arc item is created. + * + *-------------------------------------------------------------- + */ + +static int +CreateArc(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header + * has been initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing arc. */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", + itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Carry out initialization that is needed in order to clean + * up after errors during the the remainder of this procedure. + */ + + arcPtr->start = 0; + arcPtr->extent = 90; + arcPtr->outlinePtr = NULL; + arcPtr->numOutlinePoints = 0; + arcPtr->width = 1; + arcPtr->outlineColor = NULL; + arcPtr->fillColor = NULL; + arcPtr->fillStipple = None; + arcPtr->outlineStipple = None; + arcPtr->style = Tk_GetUid("pieslice"); + arcPtr->outlineGC = None; + arcPtr->fillGC = None; + + /* + * Process the arguments to fill in the item record. + */ + + if(argv[4][0]!= 'X') /* elementos normais */ + { + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], + &arcPtr->bbox[0]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], + &arcPtr->bbox[1]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[2], + &arcPtr->bbox[2]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[3], + &arcPtr->bbox[3]) != TCL_OK)) { + return TCL_ERROR; + } + + arcPtr->col1 = 0; + arcPtr->row1 = 0; + arcPtr->col2 = 0; + arcPtr->row2 = 0; + + if (ConfigureArc(interp, canvas, itemPtr, argc-4, argv+4, 0) != TCL_OK) { + DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; + } + + } + else /* elementos graficos */ + { + if ((Tk_CanvasGetCoord(interp, canvas, argv[5], + &arcPtr->bbox[0]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[6], + &arcPtr->bbox[1]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[7], + &arcPtr->bbox[2]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[8], + &arcPtr->bbox[3]) != TCL_OK)) { + return TCL_ERROR; + } + + arcPtr->col1 = atoi(argv[0]); + arcPtr->row1 = atoi(argv[1]); + arcPtr->col2 = atoi(argv[2]); + arcPtr->row2 = atoi(argv[3]); + + if (ConfigureArc(interp, canvas, itemPtr, argc-9, argv+9, 0) != TCL_OK) { + DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; + } + } + + return TCL_OK; + +} + +/* + *-------------------------------------------------------------- + * + * ArcCoords -- + * + * This procedure is invoked to process the "coords" widget + * command on arcs. See the user documentation for details + * on what it does. + * + * Results: + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. + * + * Side effects: + * The coordinates for the given item may be changed. + * + *-------------------------------------------------------------- + */ + +static int +ArcCoords(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be + * read or modified. */ + int argc; /* Number of coordinates supplied in + * argv. */ + char **argv; /* Array of coordinates: x1, y1, + * x2, y2, ... */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + char c0[TCL_DOUBLE_SPACE], c1[TCL_DOUBLE_SPACE]; + char c2[TCL_DOUBLE_SPACE], c3[TCL_DOUBLE_SPACE]; + + if (argc == 0) { + Tcl_PrintDouble(interp, arcPtr->bbox[0], c0); + Tcl_PrintDouble(interp, arcPtr->bbox[1], c1); + Tcl_PrintDouble(interp, arcPtr->bbox[2], c2); + Tcl_PrintDouble(interp, arcPtr->bbox[3], c3); + Tcl_AppendResult(interp, c0, " ", c1, " ", c2, " ", c3, + (char *) NULL); + } else if (argc == 4) { + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], + &arcPtr->bbox[0]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], + &arcPtr->bbox[1]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[2], + &arcPtr->bbox[2]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[3], + &arcPtr->bbox[3]) != TCL_OK)) { + return TCL_ERROR; + } + ComputeArcBbox(canvas, arcPtr); + } else { + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ConfigureArc -- + * + * This procedure is invoked to configure various aspects + * of a arc item, such as its outline and fill colors. + * + * Results: + * A standard Tcl result code. If an error occurs, then + * an error message is left in the interp's result. + * + * Side effects: + * Configuration information, such as colors and stipple + * patterns, may be set for itemPtr. + * + *-------------------------------------------------------------- + */ + +static int +ConfigureArc(interp, canvas, itemPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Arc item to reconfigure. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments describing things to configure. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + XGCValues gcValues; + GC newGC; + unsigned long mask; + int i; + Tk_Window tkwin; + + tkwin = Tk_CanvasTkwin(canvas); + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv, + (char *) arcPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few of the options require additional processing, such as + * style and graphics contexts. + */ + + i = (int) (arcPtr->start/360.0); + arcPtr->start -= i*360.0; + if (arcPtr->start < 0) { + arcPtr->start += 360.0; + } + i = (int) (arcPtr->extent/360.0); + arcPtr->extent -= i*360.0; + + if ((arcPtr->style != Tk_GetUid("arc")) + && (arcPtr->style != Tk_GetUid("chord")) + && (arcPtr->style != Tk_GetUid("pieslice"))) { + Tcl_AppendResult(interp, "bad -style option \"", + arcPtr->style, "\": must be arc, chord, or pieslice", + (char *) NULL); + arcPtr->style = Tk_GetUid("pieslice"); + return TCL_ERROR; + } + + if (arcPtr->width < 0) { + arcPtr->width = 1; + } + if (arcPtr->outlineColor == NULL) { + newGC = None; + } else { + gcValues.foreground = arcPtr->outlineColor->pixel; + gcValues.cap_style = CapButt; + gcValues.line_width = arcPtr->width; + mask = GCForeground|GCCapStyle|GCLineWidth; + if (arcPtr->outlineStipple != None) { + gcValues.stipple = arcPtr->outlineStipple; + gcValues.fill_style = FillStippled; + mask |= GCStipple|GCFillStyle; + } + newGC = Tk_GetGC(tkwin, mask, &gcValues); + } + if (arcPtr->outlineGC != None) { + Tk_FreeGC(Tk_Display(tkwin), arcPtr->outlineGC); + } + arcPtr->outlineGC = newGC; + + if ((arcPtr->fillColor == NULL) || (arcPtr->style == Tk_GetUid("arc"))) { + newGC = None; + } else { + gcValues.foreground = arcPtr->fillColor->pixel; + if (arcPtr->style == Tk_GetUid("chord")) { + gcValues.arc_mode = ArcChord; + } else { + gcValues.arc_mode = ArcPieSlice; + } + mask = GCForeground|GCArcMode; + if (arcPtr->fillStipple != None) { + gcValues.stipple = arcPtr->fillStipple; + gcValues.fill_style = FillStippled; + mask |= GCStipple|GCFillStyle; + } + newGC = Tk_GetGC(tkwin, mask, &gcValues); + } + if (arcPtr->fillGC != None) { + Tk_FreeGC(Tk_Display(tkwin), arcPtr->fillGC); + } + arcPtr->fillGC = newGC; + + ComputeArcBbox(canvas, arcPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeleteArc -- + * + * This procedure is called to clean up the data structure + * associated with a arc item. + * + * Results: + * None. + * + * Side effects: + * Resources associated with itemPtr are released. + * + *-------------------------------------------------------------- + */ + +static void +DeleteArc(canvas, itemPtr, display) + Tk_Canvas canvas; /* Info about overall canvas. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for + * canvas. */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + + if (arcPtr->numOutlinePoints != 0) { + ckfree((char *) arcPtr->outlinePtr); + } + if (arcPtr->outlineColor != NULL) { + Tk_FreeColor(arcPtr->outlineColor); + } + if (arcPtr->fillColor != NULL) { + Tk_FreeColor(arcPtr->fillColor); + } + if (arcPtr->fillStipple != None) { + Tk_FreeBitmap(display, arcPtr->fillStipple); + } + if (arcPtr->outlineStipple != None) { + Tk_FreeBitmap(display, arcPtr->outlineStipple); + } + if (arcPtr->outlineGC != None) { + Tk_FreeGC(display, arcPtr->outlineGC); + } + if (arcPtr->fillGC != None) { + Tk_FreeGC(display, arcPtr->fillGC); + } +} + +/* + *-------------------------------------------------------------- + * + * ComputeArcBbox -- + * + * This procedure is invoked to compute the bounding box of + * all the pixels that may be drawn as part of an arc. + * + * Results: + * None. + * + * Side effects: + * The fields x1, y1, x2, and y2 are updated in the header + * for itemPtr. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +ComputeArcBbox(canvas, arcPtr) + Tk_Canvas canvas; /* Canvas that contains item. */ + ArcItem *arcPtr; /* Item whose bbox is to be + * recomputed. */ +{ + double tmp, center[2], point[2]; + + /* + * Make sure that the first coordinates are the lowest ones. + */ + + if (arcPtr->bbox[1] > arcPtr->bbox[3]) { + double tmp; + tmp = arcPtr->bbox[3]; + arcPtr->bbox[3] = arcPtr->bbox[1]; + arcPtr->bbox[1] = tmp; + } + if (arcPtr->bbox[0] > arcPtr->bbox[2]) { + double tmp; + tmp = arcPtr->bbox[2]; + arcPtr->bbox[2] = arcPtr->bbox[0]; + arcPtr->bbox[0] = tmp; + } + + ComputeArcOutline(arcPtr); + + /* + * To compute the bounding box, start with the the bbox formed + * by the two endpoints of the arc. Then add in the center of + * the arc's oval (if relevant) and the 3-o'clock, 6-o'clock, + * 9-o'clock, and 12-o'clock positions, if they are relevant. + */ + + arcPtr->header.x1 = arcPtr->header.x2 = (int) arcPtr->center1[0]; + arcPtr->header.y1 = arcPtr->header.y2 = (int) arcPtr->center1[1]; + TkIncludePoint((Tk_Item *) arcPtr, arcPtr->center2); + center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2; + center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2; + if (arcPtr->style == Tk_GetUid("pieslice")) { + TkIncludePoint((Tk_Item *) arcPtr, center); + } + + tmp = -arcPtr->start; + if (tmp < 0) { + tmp += 360.0; + } + if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) { + point[0] = arcPtr->bbox[2]; + point[1] = center[1]; + TkIncludePoint((Tk_Item *) arcPtr, point); + } + tmp = 90.0 - arcPtr->start; + if (tmp < 0) { + tmp += 360.0; + } + if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) { + point[0] = center[0]; + point[1] = arcPtr->bbox[1]; + TkIncludePoint((Tk_Item *) arcPtr, point); + } + tmp = 180.0 - arcPtr->start; + if (tmp < 0) { + tmp += 360.0; + } + if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) { + point[0] = arcPtr->bbox[0]; + point[1] = center[1]; + TkIncludePoint((Tk_Item *) arcPtr, point); + } + tmp = 270.0 - arcPtr->start; + if (tmp < 0) { + tmp += 360.0; + } + if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) { + point[0] = center[0]; + point[1] = arcPtr->bbox[3]; + TkIncludePoint((Tk_Item *) arcPtr, point); + } + + /* + * Lastly, expand by the width of the arc (if the arc's outline is + * being drawn) and add one extra pixel just for safety. + */ + + if (arcPtr->outlineColor == NULL) { + tmp = 1; + } else { + tmp = (arcPtr->width + 1)/2 + 1; + } + arcPtr->header.x1 -= (int) tmp; + arcPtr->header.y1 -= (int) tmp; + arcPtr->header.x2 += (int) tmp; + arcPtr->header.y2 += (int) tmp; +} + +/* + *-------------------------------------------------------------- + * + * DisplayArc -- + * + * This procedure is invoked to draw an arc item in a given + * drawable. + * + * Results: + * None. + * + * Side effects: + * ItemPtr is drawn in drawable using the transformation + * information in canvas. + * + *-------------------------------------------------------------- + */ + +static void +DisplayArc(canvas, itemPtr, display, drawable, x, y, width, height) + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw + * item. */ + int x, y, width, height; /* Describes region of canvas that + * must be redisplayed (not used). */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + short x1, y1, x2, y2; + int start, extent; + + /* + * Compute the screen coordinates of the bounding box for the item, + * plus integer values for the angles. + */ + + Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[0], arcPtr->bbox[1], + &x1, &y1); + Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[2], arcPtr->bbox[3], + &x2, &y2); + if (x2 <= x1) { + x2 = x1+1; + } + if (y2 <= y1) { + y2 = y1+1; + } + start = (int) ((64*arcPtr->start) + 0.5); + extent = (int) ((64*arcPtr->extent) + 0.5); + + /* + * Display filled arc first (if wanted), then outline. If the extent + * is zero then don't invoke XFillArc or XDrawArc, since this causes + * some window servers to crash and should be a no-op anyway. + */ + + if ((arcPtr->fillGC != None) && (extent != 0)) { + if (arcPtr->fillStipple != None) { + Tk_CanvasSetStippleOrigin(canvas, arcPtr->fillGC); + } + XFillArc(display, drawable, arcPtr->fillGC, x1, y1, (unsigned) (x2-x1), + (unsigned) (y2-y1), start, extent); + if (arcPtr->fillStipple != None) { + XSetTSOrigin(display, arcPtr->fillGC, 0, 0); + } + } + if (arcPtr->outlineGC != None) { + if (arcPtr->outlineStipple != None) { + Tk_CanvasSetStippleOrigin(canvas, arcPtr->outlineGC); + } + if (extent != 0) { + XDrawArc(display, drawable, arcPtr->outlineGC, x1, y1, + (unsigned) (x2-x1), (unsigned) (y2-y1), start, extent); + } + + /* + * If the outline width is very thin, don't use polygons to draw + * the linear parts of the outline (this often results in nothing + * being displayed); just draw lines instead. + */ + + if (arcPtr->width <= 2) { + Tk_CanvasDrawableCoords(canvas, arcPtr->center1[0], + arcPtr->center1[1], &x1, &y1); + Tk_CanvasDrawableCoords(canvas, arcPtr->center2[0], + arcPtr->center2[1], &x2, &y2); + + if (arcPtr->style == Tk_GetUid("chord")) { + XDrawLine(display, drawable, arcPtr->outlineGC, + x1, y1, x2, y2); + } else if (arcPtr->style == Tk_GetUid("pieslice")) { + short cx, cy; + + Tk_CanvasDrawableCoords(canvas, + (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0, + (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0, &cx, &cy); + XDrawLine(display, drawable, arcPtr->outlineGC, + cx, cy, x1, y1); + XDrawLine(display, drawable, arcPtr->outlineGC, + cx, cy, x2, y2); + } + } else { + if (arcPtr->style == Tk_GetUid("chord")) { + TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS, + display, drawable, arcPtr->outlineGC, None); + } else if (arcPtr->style == Tk_GetUid("pieslice")) { + TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS, + display, drawable, arcPtr->outlineGC, None); + TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, + PIE_OUTLINE2_PTS, display, drawable, arcPtr->outlineGC, + None); + } + } + if (arcPtr->outlineStipple != None) { + XSetTSOrigin(display, arcPtr->outlineGC, 0, 0); + } + } +} + +/* + *-------------------------------------------------------------- + * + * ArcToPoint -- + * + * Computes the distance from a given point to a given + * arc, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are coordPtr[0] and coordPtr[1] is inside the arc. If the + * point isn't inside the arc then the return value is the + * distance from the point to the arc. If itemPtr is filled, + * then anywhere in the interior is considered "inside"; if + * itemPtr isn't filled, then "inside" means only the area + * occupied by the outline. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static double +ArcToPoint(canvas, itemPtr, pointPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *pointPtr; /* Pointer to x and y coordinates. */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + double vertex[2], pointAngle, diff, dist, newDist; + double poly[8], polyDist, width, t1, t2; + int filled, angleInRange; + + /* + * See if the point is within the angular range of the arc. + * Remember, X angles are backwards from the way we'd normally + * think of them. Also, compensate for any eccentricity of + * the oval. + */ + + vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0; + vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0; + t1 = arcPtr->bbox[3] - arcPtr->bbox[1]; + if (t1 != 0.0) { + t1 = (pointPtr[1] - vertex[1]) / t1; + } + t2 = arcPtr->bbox[2] - arcPtr->bbox[0]; + if (t2 != 0.0) { + t2 = (pointPtr[0] - vertex[0]) / t2; + } + if ((t1 == 0.0) && (t2 == 0.0)) { + pointAngle = 0; + } else { + pointAngle = -atan2(t1, t2)*180/PI; + } + diff = pointAngle - arcPtr->start; + diff -= ((int) (diff/360.0) * 360.0); + if (diff < 0) { + diff += 360.0; + } + angleInRange = (diff <= arcPtr->extent) || + ((arcPtr->extent < 0) && ((diff - 360.0) >= arcPtr->extent)); + + /* + * Now perform different tests depending on what kind of arc + * we're dealing with. + */ + + if (arcPtr->style == Tk_GetUid("arc")) { + if (angleInRange) { + return TkOvalToPoint(arcPtr->bbox, (double) arcPtr->width, + 0, pointPtr); + } + dist = hypot(pointPtr[0] - arcPtr->center1[0], + pointPtr[1] - arcPtr->center1[1]); + newDist = hypot(pointPtr[0] - arcPtr->center2[0], + pointPtr[1] - arcPtr->center2[1]); + if (newDist < dist) { + return newDist; + } + return dist; + } + + if ((arcPtr->fillGC != None) || (arcPtr->outlineGC == None)) { + filled = 1; + } else { + filled = 0; + } + if (arcPtr->outlineGC == None) { + width = 0.0; + } else { + width = arcPtr->width; + } + + if (arcPtr->style == Tk_GetUid("pieslice")) { + if (width > 1.0) { + dist = TkPolygonToPoint(arcPtr->outlinePtr, PIE_OUTLINE1_PTS, + pointPtr); + newDist = TkPolygonToPoint(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, + PIE_OUTLINE2_PTS, pointPtr); + } else { + dist = TkLineToPoint(vertex, arcPtr->center1, pointPtr); + newDist = TkLineToPoint(vertex, arcPtr->center2, pointPtr); + } + if (newDist < dist) { + dist = newDist; + } + if (angleInRange) { + newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr); + if (newDist < dist) { + dist = newDist; + } + } + return dist; + } + + /* + * This is a chord-style arc. We have to deal specially with the + * triangular piece that represents the difference between a + * chord-style arc and a pie-slice arc (for small angles this piece + * is excluded here where it would be included for pie slices; + * for large angles the piece is included here but would be + * excluded for pie slices). + */ + + if (width > 1.0) { + dist = TkPolygonToPoint(arcPtr->outlinePtr, CHORD_OUTLINE_PTS, + pointPtr); + } else { + dist = TkLineToPoint(arcPtr->center1, arcPtr->center2, pointPtr); + } + poly[0] = poly[6] = vertex[0]; + poly[1] = poly[7] = vertex[1]; + poly[2] = arcPtr->center1[0]; + poly[3] = arcPtr->center1[1]; + poly[4] = arcPtr->center2[0]; + poly[5] = arcPtr->center2[1]; + polyDist = TkPolygonToPoint(poly, 4, pointPtr); + if (angleInRange) { + if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0) + || (polyDist > 0.0)) { + newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr); + if (newDist < dist) { + dist = newDist; + } + } + } else { + if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)) { + if (filled && (polyDist < dist)) { + dist = polyDist; + } + } + } + return dist; +} + +/* + *-------------------------------------------------------------- + * + * ArcToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given area. + * + * Results: + * -1 is returned if the item is entirely outside the area + * given by rectPtr, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +ArcToArea(canvas, itemPtr, rectPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against arc. */ + double *rectPtr; /* Pointer to array of four coordinates + * (x1, y1, x2, y2) describing rectangular + * area. */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + double rx, ry; /* Radii for transformed oval: these define + * an oval centered at the origin. */ + double tRect[4]; /* Transformed version of x1, y1, x2, y2, + * for coord. system where arc is centered + * on the origin. */ + double center[2], width, angle, tmp; + double points[20], *pointPtr; + int numPoints, filled; + int inside; /* Non-zero means every test so far suggests + * that arc is inside rectangle. 0 means + * every test so far shows arc to be outside + * of rectangle. */ + int newInside; + + if ((arcPtr->fillGC != None) || (arcPtr->outlineGC == None)) { + filled = 1; + } else { + filled = 0; + } + if (arcPtr->outlineGC == None) { + width = 0.0; + } else { + width = arcPtr->width; + } + + /* + * Transform both the arc and the rectangle so that the arc's oval + * is centered on the origin. + */ + + center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0; + center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0; + tRect[0] = rectPtr[0] - center[0]; + tRect[1] = rectPtr[1] - center[1]; + tRect[2] = rectPtr[2] - center[0]; + tRect[3] = rectPtr[3] - center[1]; + rx = arcPtr->bbox[2] - center[0] + width/2.0; + ry = arcPtr->bbox[3] - center[1] + width/2.0; + + /* + * Find the extreme points of the arc and see whether these are all + * inside the rectangle (in which case we're done), partly in and + * partly out (in which case we're done), or all outside (in which + * case we have more work to do). The extreme points include the + * following, which are checked in order: + * + * 1. The outside points of the arc, corresponding to start and + * extent. + * 2. The center of the arc (but only in pie-slice mode). + * 3. The 12, 3, 6, and 9-o'clock positions (but only if the arc + * includes those angles). + */ + + pointPtr = points; + angle = -arcPtr->start*(PI/180.0); + pointPtr[0] = rx*cos(angle); + pointPtr[1] = ry*sin(angle); + angle += -arcPtr->extent*(PI/180.0); + pointPtr[2] = rx*cos(angle); + pointPtr[3] = ry*sin(angle); + numPoints = 2; + pointPtr += 4; + + if ((arcPtr->style == Tk_GetUid("pieslice")) && (arcPtr->extent < 180.0)) { + pointPtr[0] = 0.0; + pointPtr[1] = 0.0; + numPoints++; + pointPtr += 2; + } + + tmp = -arcPtr->start; + if (tmp < 0) { + tmp += 360.0; + } + if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) { + pointPtr[0] = rx; + pointPtr[1] = 0.0; + numPoints++; + pointPtr += 2; + } + tmp = 90.0 - arcPtr->start; + if (tmp < 0) { + tmp += 360.0; + } + if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) { + pointPtr[0] = 0.0; + pointPtr[1] = -ry; + numPoints++; + pointPtr += 2; + } + tmp = 180.0 - arcPtr->start; + if (tmp < 0) { + tmp += 360.0; + } + if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) { + pointPtr[0] = -rx; + pointPtr[1] = 0.0; + numPoints++; + pointPtr += 2; + } + tmp = 270.0 - arcPtr->start; + if (tmp < 0) { + tmp += 360.0; + } + if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) { + pointPtr[0] = 0.0; + pointPtr[1] = ry; + numPoints++; + } + + /* + * Now that we've located the extreme points, loop through them all + * to see which are inside the rectangle. + */ + + inside = (points[0] > tRect[0]) && (points[0] < tRect[2]) + && (points[1] > tRect[1]) && (points[1] < tRect[3]); + for (pointPtr = points+2; numPoints > 1; pointPtr += 2, numPoints--) { + newInside = (pointPtr[0] > tRect[0]) && (pointPtr[0] < tRect[2]) + && (pointPtr[1] > tRect[1]) && (pointPtr[1] < tRect[3]); + if (newInside != inside) { + return 0; + } + } + + if (inside) { + return 1; + } + + /* + * So far, oval appears to be outside rectangle, but can't yet tell + * for sure. Next, test each of the four sides of the rectangle + * against the bounding region for the arc. If any intersections + * are found, then return "overlapping". First, test against the + * polygon(s) forming the sides of a chord or pie-slice. + */ + + if (arcPtr->style == Tk_GetUid("pieslice")) { + if (width >= 1.0) { + if (TkPolygonToArea(arcPtr->outlinePtr, PIE_OUTLINE1_PTS, + rectPtr) != -1) { + return 0; + } + if (TkPolygonToArea(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, + PIE_OUTLINE2_PTS, rectPtr) != -1) { + return 0; + } + } else { + if ((TkLineToArea(center, arcPtr->center1, rectPtr) != -1) || + (TkLineToArea(center, arcPtr->center2, rectPtr) != -1)) { + return 0; + } + } + } else if (arcPtr->style == Tk_GetUid("chord")) { + if (width >= 1.0) { + if (TkPolygonToArea(arcPtr->outlinePtr, CHORD_OUTLINE_PTS, + rectPtr) != -1) { + return 0; + } + } else { + if (TkLineToArea(arcPtr->center1, arcPtr->center2, + rectPtr) != -1) { + return 0; + } + } + } + + /* + * Next check for overlap between each of the four sides and the + * outer perimiter of the arc. If the arc isn't filled, then also + * check the inner perimeter of the arc. + */ + + if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start, + arcPtr->extent) + || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry, + arcPtr->start, arcPtr->extent) + || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry, + arcPtr->start, arcPtr->extent) + || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry, + arcPtr->start, arcPtr->extent)) { + return 0; + } + if ((width > 1.0) && !filled) { + rx -= width; + ry -= width; + if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start, + arcPtr->extent) + || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry, + arcPtr->start, arcPtr->extent) + || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry, + arcPtr->start, arcPtr->extent) + || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry, + arcPtr->start, arcPtr->extent)) { + return 0; + } + } + + /* + * The arc still appears to be totally disjoint from the rectangle, + * but it's also possible that the rectangle is totally inside the arc. + * Do one last check, which is to check one point of the rectangle + * to see if it's inside the arc. If it is, we've got overlap. If + * it isn't, the arc's really outside the rectangle. + */ + + if (ArcToPoint(canvas, itemPtr, rectPtr) == 0.0) { + return 0; + } + return -1; +} + +/* + *-------------------------------------------------------------- + * + * ScaleArc -- + * + * This procedure is invoked to rescale an arc item. + * + * Results: + * None. + * + * Side effects: + * The arc referred to by itemPtr is rescaled so that the + * following transformation is applied to all point + * coordinates: + * x' = originX + scaleX*(x-originX) + * y' = originY + scaleY*(y-originY) + * + *-------------------------------------------------------------- + */ + +static void +ScaleArc(canvas, itemPtr, originX, originY, scaleX, scaleY) + Tk_Canvas canvas; /* Canvas containing arc. */ + Tk_Item *itemPtr; /* Arc to be scaled. */ + double originX, originY; /* Origin about which to scale rect. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + + arcPtr->bbox[0] = originX + scaleX*(arcPtr->bbox[0] - originX); + arcPtr->bbox[1] = originY + scaleY*(arcPtr->bbox[1] - originY); + arcPtr->bbox[2] = originX + scaleX*(arcPtr->bbox[2] - originX); + arcPtr->bbox[3] = originY + scaleY*(arcPtr->bbox[3] - originY); + ComputeArcBbox(canvas, arcPtr); +} + +/* + *-------------------------------------------------------------- + * + * TranslateArc -- + * + * This procedure is called to move an arc by a given amount. + * + * Results: + * None. + * + * Side effects: + * The position of the arc is offset by (xDelta, yDelta), and + * the bounding box is updated in the generic part of the item + * structure. + * + *-------------------------------------------------------------- + */ + +static void +TranslateArc(canvas, itemPtr, deltaX, deltaY) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be + * moved. */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + + arcPtr->bbox[0] += deltaX; + arcPtr->bbox[1] += deltaY; + arcPtr->bbox[2] += deltaX; + arcPtr->bbox[3] += deltaY; + ComputeArcBbox(canvas, arcPtr); +} + +/* + *-------------------------------------------------------------- + * + * ComputeArcOutline -- + * + * This procedure creates a polygon describing everything in + * the outline for an arc except what's in the curved part. + * For a "pie slice" arc this is a V-shaped chunk, and for + * a "chord" arc this is a linear chunk (with cutaway corners). + * For "arc" arcs, this stuff isn't relevant. + * + * Results: + * None. + * + * Side effects: + * The information at arcPtr->outlinePtr gets modified, and + * storage for arcPtr->outlinePtr may be allocated or freed. + * + *-------------------------------------------------------------- + */ + +static void +ComputeArcOutline(arcPtr) + ArcItem *arcPtr; /* Information about arc. */ +{ + double sin1, cos1, sin2, cos2, angle, halfWidth; + double boxWidth, boxHeight; + double vertex[2], corner1[2], corner2[2]; + double *outlinePtr; + + /* + * Make sure that the outlinePtr array is large enough to hold + * either a chord or pie-slice outline. + */ + + if (arcPtr->numOutlinePoints == 0) { + arcPtr->outlinePtr = (double *) ckalloc((unsigned) + (26 * sizeof(double))); + arcPtr->numOutlinePoints = 22; + } + outlinePtr = arcPtr->outlinePtr; + + /* + * First compute the two points that lie at the centers of + * the ends of the curved arc segment, which are marked with + * X's in the figure below: + * + * + * * * * + * * * + * * * * * + * * * * * + * * * * * + * X * * X + * + * The code is tricky because the arc can be ovular in shape. + * It computes the position for a unit circle, and then + * scales to fit the shape of the arc's bounding box. + * + * Also, watch out because angles go counter-clockwise like you + * might expect, but the y-coordinate system is inverted. To + * handle this, just negate the angles in all the computations. + */ + + boxWidth = arcPtr->bbox[2] - arcPtr->bbox[0]; + boxHeight = arcPtr->bbox[3] - arcPtr->bbox[1]; + angle = -arcPtr->start*PI/180.0; + sin1 = sin(angle); + cos1 = cos(angle); + angle -= arcPtr->extent*PI/180.0; + sin2 = sin(angle); + cos2 = cos(angle); + vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0; + vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0; + arcPtr->center1[0] = vertex[0] + cos1*boxWidth/2.0; + arcPtr->center1[1] = vertex[1] + sin1*boxHeight/2.0; + arcPtr->center2[0] = vertex[0] + cos2*boxWidth/2.0; + arcPtr->center2[1] = vertex[1] + sin2*boxHeight/2.0; + + /* + * Next compute the "outermost corners" of the arc, which are + * marked with X's in the figure below: + * + * * * * + * * * + * * * * * + * * * * * + * X * * X + * * * + * + * The code below is tricky because it has to handle eccentricity + * in the shape of the oval. The key in the code below is to + * realize that the slope of the line from arcPtr->center1 to corner1 + * is (boxWidth*sin1)/(boxHeight*cos1), and similarly for arcPtr->center2 + * and corner2. These formulas can be computed from the formula for + * the oval. + */ + + halfWidth = arcPtr->width/2.0; + if (((boxWidth*sin1) == 0.0) && ((boxHeight*cos1) == 0.0)) { + angle = 0.0; + } else { + angle = atan2(boxWidth*sin1, boxHeight*cos1); + } + corner1[0] = arcPtr->center1[0] + cos(angle)*halfWidth; + corner1[1] = arcPtr->center1[1] + sin(angle)*halfWidth; + if (((boxWidth*sin2) == 0.0) && ((boxHeight*cos2) == 0.0)) { + angle = 0.0; + } else { + angle = atan2(boxWidth*sin2, boxHeight*cos2); + } + corner2[0] = arcPtr->center2[0] + cos(angle)*halfWidth; + corner2[1] = arcPtr->center2[1] + sin(angle)*halfWidth; + + /* + * For a chord outline, generate a six-sided polygon with three + * points for each end of the chord. The first and third points + * for each end are butt points generated on either side of the + * center point. The second point is the corner point. + */ + + if (arcPtr->style == Tk_GetUid("chord")) { + outlinePtr[0] = outlinePtr[12] = corner1[0]; + outlinePtr[1] = outlinePtr[13] = corner1[1]; + TkGetButtPoints(arcPtr->center2, arcPtr->center1, + (double) arcPtr->width, 0, outlinePtr+10, outlinePtr+2); + outlinePtr[4] = arcPtr->center2[0] + outlinePtr[2] + - arcPtr->center1[0]; + outlinePtr[5] = arcPtr->center2[1] + outlinePtr[3] + - arcPtr->center1[1]; + outlinePtr[6] = corner2[0]; + outlinePtr[7] = corner2[1]; + outlinePtr[8] = arcPtr->center2[0] + outlinePtr[10] + - arcPtr->center1[0]; + outlinePtr[9] = arcPtr->center2[1] + outlinePtr[11] + - arcPtr->center1[1]; + } else if (arcPtr->style == Tk_GetUid("pieslice")) { + /* + * For pie slices, generate two polygons, one for each side + * of the pie slice. The first arm has a shape like this, + * where the center of the oval is X, arcPtr->center1 is at Y, and + * corner1 is at Z: + * + * _____________________ + * | \ + * | \ + * X Y Z + * | / + * |_____________________/ + * + */ + + TkGetButtPoints(arcPtr->center1, vertex, (double) arcPtr->width, 0, + outlinePtr, outlinePtr+2); + outlinePtr[4] = arcPtr->center1[0] + outlinePtr[2] - vertex[0]; + outlinePtr[5] = arcPtr->center1[1] + outlinePtr[3] - vertex[1]; + outlinePtr[6] = corner1[0]; + outlinePtr[7] = corner1[1]; + outlinePtr[8] = arcPtr->center1[0] + outlinePtr[0] - vertex[0]; + outlinePtr[9] = arcPtr->center1[1] + outlinePtr[1] - vertex[1]; + outlinePtr[10] = outlinePtr[0]; + outlinePtr[11] = outlinePtr[1]; + + /* + * The second arm has a shape like this: + * + * + * ______________________ + * / \ + * / \ + * Z Y X / + * \ / + * \______________________/ + * + * Similar to above X is the center of the oval/circle, Y is + * arcPtr->center2, and Z is corner2. The extra jog out to the left + * of X is needed in or to produce a butted joint with the + * first arm; the corner to the right of X is one of the + * first two points of the first arm, depending on extent. + */ + + TkGetButtPoints(arcPtr->center2, vertex, (double) arcPtr->width, 0, + outlinePtr+12, outlinePtr+16); + if ((arcPtr->extent > 180) || + ((arcPtr->extent < 0) && (arcPtr->extent > -180))) { + outlinePtr[14] = outlinePtr[0]; + outlinePtr[15] = outlinePtr[1]; + } else { + outlinePtr[14] = outlinePtr[2]; + outlinePtr[15] = outlinePtr[3]; + } + outlinePtr[18] = arcPtr->center2[0] + outlinePtr[16] - vertex[0]; + outlinePtr[19] = arcPtr->center2[1] + outlinePtr[17] - vertex[1]; + outlinePtr[20] = corner2[0]; + outlinePtr[21] = corner2[1]; + outlinePtr[22] = arcPtr->center2[0] + outlinePtr[12] - vertex[0]; + outlinePtr[23] = arcPtr->center2[1] + outlinePtr[13] - vertex[1]; + outlinePtr[24] = outlinePtr[12]; + outlinePtr[25] = outlinePtr[13]; + } +} + +/* + *-------------------------------------------------------------- + * + * HorizLineToArc -- + * + * Determines whether a horizontal line segment intersects + * a given arc. + * + * Results: + * The return value is 1 if the given line intersects the + * infinitely-thin arc section defined by rx, ry, start, + * and extent, and 0 otherwise. Only the perimeter of the + * arc is checked: interior areas (e.g. pie-slice or chord) + * are not checked. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +HorizLineToArc(x1, x2, y, rx, ry, start, extent) + double x1, x2; /* X-coords of endpoints of line segment. + * X1 must be <= x2. */ + double y; /* Y-coordinate of line segment. */ + double rx, ry; /* These x- and y-radii define an oval + * centered at the origin. */ + double start, extent; /* Angles that define extent of arc, in + * the standard fashion for this module. */ +{ + double tmp; + double tx, ty; /* Coordinates of intersection point in + * transformed coordinate system. */ + double x; + + /* + * Compute the x-coordinate of one possible intersection point + * between the arc and the line. Use a transformed coordinate + * system where the oval is a unit circle centered at the origin. + * Then scale back to get actual x-coordinate. + */ + + ty = y/ry; + tmp = 1 - ty*ty; + if (tmp < 0) { + return 0; + } + tx = sqrt(tmp); + x = tx*rx; + + /* + * Test both intersection points. + */ + + if ((x >= x1) && (x <= x2) && AngleInRange(tx, ty, start, extent)) { + return 1; + } + if ((-x >= x1) && (-x <= x2) && AngleInRange(-tx, ty, start, extent)) { + return 1; + } + return 0; +} + +/* + *-------------------------------------------------------------- + * + * VertLineToArc -- + * + * Determines whether a vertical line segment intersects + * a given arc. + * + * Results: + * The return value is 1 if the given line intersects the + * infinitely-thin arc section defined by rx, ry, start, + * and extent, and 0 otherwise. Only the perimeter of the + * arc is checked: interior areas (e.g. pie-slice or chord) + * are not checked. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +VertLineToArc(x, y1, y2, rx, ry, start, extent) + double x; /* X-coordinate of line segment. */ + double y1, y2; /* Y-coords of endpoints of line segment. + * Y1 must be <= y2. */ + double rx, ry; /* These x- and y-radii define an oval + * centered at the origin. */ + double start, extent; /* Angles that define extent of arc, in + * the standard fashion for this module. */ +{ + double tmp; + double tx, ty; /* Coordinates of intersection point in + * transformed coordinate system. */ + double y; + + /* + * Compute the y-coordinate of one possible intersection point + * between the arc and the line. Use a transformed coordinate + * system where the oval is a unit circle centered at the origin. + * Then scale back to get actual y-coordinate. + */ + + tx = x/rx; + tmp = 1 - tx*tx; + if (tmp < 0) { + return 0; + } + ty = sqrt(tmp); + y = ty*ry; + + /* + * Test both intersection points. + */ + + if ((y > y1) && (y < y2) && AngleInRange(tx, ty, start, extent)) { + return 1; + } + if ((-y > y1) && (-y < y2) && AngleInRange(tx, -ty, start, extent)) { + return 1; + } + return 0; +} + +/* + *-------------------------------------------------------------- + * + * AngleInRange -- + * + * Determine whether the angle from the origin to a given + * point is within a given range. + * + * Results: + * The return value is 1 if the angle from (0,0) to (x,y) + * is in the range given by start and extent, where angles + * are interpreted in the standard way for ovals (meaning + * backwards from normal interpretation). Otherwise the + * return value is 0. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +AngleInRange(x, y, start, extent) + double x, y; /* Coordinate of point; angle measured + * from origin to here, relative to x-axis. */ + double start; /* First angle, degrees, >=0, <=360. */ + double extent; /* Size of arc in degrees >=-360, <=360. */ +{ + double diff; + + if ((x == 0.0) && (y == 0.0)) { + return 1; + } + diff = -atan2(y, x); + diff = diff*(180.0/PI) - start; + while (diff > 360.0) { + diff -= 360.0; + } + while (diff < 0.0) { + diff += 360.0; + } + if (extent >= 0) { + return diff <= extent; + } + return (diff-360.0) >= extent; +} + +/* + *-------------------------------------------------------------- + * + * ArcToPostscript -- + * + * This procedure is called to generate Postscript for + * arc items. + * + * Results: + * The return value is a standard Tcl result. If an error + * occurs in generating Postscript then an error message is + * left in the interp's result, replacing whatever used + * to be there. If no error occurs, then Postscript for the + * item is appended to the result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +ArcToPostscript(interp, canvas, itemPtr, prepass) + Tcl_Interp *interp; /* Leave Postscript or error message + * here. */ + Tk_Canvas canvas; /* Information about overall canvas. */ + Tk_Item *itemPtr; /* Item for which Postscript is + * wanted. */ + int prepass; /* 1 means this is a prepass to + * collect font information; 0 means + * final Postscript is being created. */ +{ + ArcItem *arcPtr = (ArcItem *) itemPtr; + char buffer[400]; + double y1, y2, ang1, ang2; + + y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]); + y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]); + ang1 = arcPtr->start; + ang2 = ang1 + arcPtr->extent; + if (ang2 < ang1) { + ang1 = ang2; + ang2 = arcPtr->start; + } + + /* + * If the arc is filled, output Postscript for the interior region + * of the arc. + */ + + if (arcPtr->fillGC != None) { + sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, + (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); + Tcl_AppendResult(interp, buffer, (char *) NULL); + if (arcPtr->style == Tk_GetUid("chord")) { + sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", + ang1, ang2); + } else { + sprintf(buffer, + "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", + ang1, ang2); + } + Tcl_AppendResult(interp, buffer, (char *) NULL); + if (Tk_CanvasPsColor(interp, canvas, arcPtr->fillColor) != TCL_OK) { + return TCL_ERROR; + }; + if (arcPtr->fillStipple != None) { + Tcl_AppendResult(interp, "clip ", (char *) NULL); + if (Tk_CanvasPsStipple(interp, canvas, arcPtr->fillStipple) + != TCL_OK) { + return TCL_ERROR; + } + if (arcPtr->outlineGC != None) { + Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL); + } + } else { + Tcl_AppendResult(interp, "fill\n", (char *) NULL); + } + } + + /* + * If there's an outline for the arc, draw it. + */ + + if (arcPtr->outlineGC != None) { + sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, + (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); + Tcl_AppendResult(interp, buffer, (char *) NULL); + sprintf(buffer, "0 0 1 %.15g %.15g arc\nsetmatrix\n", ang1, ang2); + Tcl_AppendResult(interp, buffer, (char *) NULL); + sprintf(buffer, "%d setlinewidth\n0 setlinecap\n", arcPtr->width); + Tcl_AppendResult(interp, buffer, (char *) NULL); + if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor) + != TCL_OK) { + return TCL_ERROR; + } + if (arcPtr->outlineStipple != None) { + Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL); + if (Tk_CanvasPsStipple(interp, canvas, + arcPtr->outlineStipple) != TCL_OK) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "stroke\n", (char *) NULL); + } + if (arcPtr->style != Tk_GetUid("arc")) { + Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL); + if (arcPtr->style == Tk_GetUid("chord")) { + Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, + CHORD_OUTLINE_PTS); + } else { + Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, + PIE_OUTLINE1_PTS); + if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor) + != TCL_OK) { + return TCL_ERROR; + } + if (arcPtr->outlineStipple != None) { + Tcl_AppendResult(interp, "clip ", (char *) NULL); + if (Tk_CanvasPsStipple(interp, canvas, + arcPtr->outlineStipple) != TCL_OK) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "fill\n", (char *) NULL); + } + Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL); + Tk_CanvasPsPath(interp, canvas, + arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, + PIE_OUTLINE2_PTS); + } + if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor) + != TCL_OK) { + return TCL_ERROR; + } + if (arcPtr->outlineStipple != None) { + Tcl_AppendResult(interp, "clip ", (char *) NULL); + if (Tk_CanvasPsStipple(interp, canvas, + arcPtr->outlineStipple) != TCL_OK) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "fill\n", (char *) NULL); + } + } + } + + return TCL_OK; +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvBmap.c ./canvas-tcl8.2.2/tkCanvBmap.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvBmap.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvBmap.c Thu Dec 30 14:57:43 1999 @@ -0,0 +1,802 @@ +/* + * tkCanvBmap.c -- + * + * This file implements bitmap items for canvas widgets. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvBmap.c,v 1.3 1999/04/16 01:51:11 stanton Exp $ + */ + +#include +#include "tkInt.h" +#include "tkPort.h" +#include "tkCanvas.h" + +/* + * The structure below defines the record for each bitmap item. + */ + +typedef struct BitmapItem { + Tk_Item header; /* Generic stuff that's the same for all + * types. MUST BE FIRST IN STRUCTURE. */ + double x, y; /* Coordinates of positioning point for + * bitmap. */ + Tk_Anchor anchor; /* Where to anchor bitmap relative to + * (x,y). */ + Pixmap bitmap; /* Bitmap to display in window. */ + XColor *fgColor; /* Foreground color to use for bitmap. */ + XColor *bgColor; /* Background color to use for bitmap. */ + GC gc; /* Graphics context to use for drawing + * bitmap on screen. */ +} BitmapItem; + +/* + * Information used for parsing configuration specs: + */ + +static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, + Tk_CanvasTagsPrintProc, (ClientData) NULL +}; + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL, + "center", Tk_Offset(BitmapItem, anchor), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_COLOR, "-background", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(BitmapItem, bgColor), TK_CONFIG_NULL_OK}, + {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(BitmapItem, bitmap), TK_CONFIG_NULL_OK}, + {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL, + "black", Tk_Offset(BitmapItem, fgColor), 0}, + {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Prototypes for procedures defined in this file: + */ + +static int BitmapCoords _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv)); +static int BitmapToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *rectPtr)); +static double BitmapToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *coordPtr)); +static int BitmapToPostscript _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); +static void ComputeBitmapBbox _ANSI_ARGS_((Tk_Canvas canvas, + BitmapItem *bmapPtr)); +static int ConfigureBitmap _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +static int CreateBitmap _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, struct Tk_Item *itemPtr, + int argc, char **argv)); +static void DeleteBitmap _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +static void DisplayBitmap _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +static void ScaleBitmap _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +static void TranslateBitmap _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); + +/* + * The structures below defines the bitmap item type in terms of + * procedures that can be invoked by generic item code. + */ + +Tk_ItemType tkBitmapType = { + "bitmap", /* name */ + sizeof(BitmapItem), /* itemSize */ + CreateBitmap, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureBitmap, /* configureProc */ + BitmapCoords, /* coordProc */ + DeleteBitmap, /* deleteProc */ + DisplayBitmap, /* displayProc */ + 0, /* alwaysRedraw */ + BitmapToPoint, /* pointProc */ + BitmapToArea, /* areaProc */ + BitmapToPostscript, /* postscriptProc */ + ScaleBitmap, /* scaleProc */ + TranslateBitmap, /* translateProc */ + (Tk_ItemIndexProc *) NULL, /* indexProc */ + (Tk_ItemCursorProc *) NULL, /* icursorProc */ + (Tk_ItemSelectionProc *) NULL, /* selectionProc */ + (Tk_ItemInsertProc *) NULL, /* insertProc */ + (Tk_ItemDCharsProc *) NULL, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + +/* + *-------------------------------------------------------------- + * + * CreateBitmap -- + * + * This procedure is invoked to create a new bitmap + * item in a canvas. + * + * Results: + * A standard Tcl return value. If an error occurred in + * creating the item, then an error message is left in + * the interp's result; in this case itemPtr is left uninitialized, + * so it can be safely freed by the caller. + * + * Side effects: + * A new bitmap item is created. + * + *-------------------------------------------------------------- + */ + +static int +CreateBitmap(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header + * has been initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing rectangle. */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", + itemPtr->typePtr->name, " x y ?options?\"", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Initialize item's record. + */ + + bmapPtr->anchor = TK_ANCHOR_CENTER; + bmapPtr->bitmap = None; + bmapPtr->fgColor = NULL; + bmapPtr->bgColor = NULL; + bmapPtr->gc = None; + + /* + * Process the arguments to fill in the item record. + */ + + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y) + != TCL_OK)) { + return TCL_ERROR; + } + + if (ConfigureBitmap(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) { + DeleteBitmap(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * BitmapCoords -- + * + * This procedure is invoked to process the "coords" widget + * command on bitmap items. See the user documentation for + * details on what it does. + * + * Results: + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. + * + * Side effects: + * The coordinates for the given item may be changed. + * + *-------------------------------------------------------------- + */ + +static int +BitmapCoords(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be + * read or modified. */ + int argc; /* Number of coordinates supplied in + * argv. */ + char **argv; /* Array of coordinates: x1, y1, + * x2, y2, ... */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE]; + + if (argc == 0) { + Tcl_PrintDouble(interp, bmapPtr->x, x); + Tcl_PrintDouble(interp, bmapPtr->y, y); + Tcl_AppendResult(interp, x, " ", y, (char *) NULL); + } else if (argc == 2) { + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y) + != TCL_OK)) { + return TCL_ERROR; + } + ComputeBitmapBbox(canvas, bmapPtr); + } else { + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ConfigureBitmap -- + * + * This procedure is invoked to configure various aspects + * of a bitmap item, such as its anchor position. + * + * Results: + * A standard Tcl result code. If an error occurs, then + * an error message is left in the interp's result. + * + * Side effects: + * Configuration information may be set for itemPtr. + * + *-------------------------------------------------------------- + */ + +static int +ConfigureBitmap(interp, canvas, itemPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Bitmap item to reconfigure. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments describing things to configure. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + XGCValues gcValues; + GC newGC; + Tk_Window tkwin; + unsigned long mask; + + tkwin = Tk_CanvasTkwin(canvas); + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv, + (char *) bmapPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few of the options require additional processing, such as those + * that determine the graphics context. + */ + + gcValues.foreground = bmapPtr->fgColor->pixel; + mask = GCForeground; + if (bmapPtr->bgColor != NULL) { + gcValues.background = bmapPtr->bgColor->pixel; + mask |= GCBackground; + } else { + gcValues.clip_mask = bmapPtr->bitmap; + mask |= GCClipMask; + } + newGC = Tk_GetGC(tkwin, mask, &gcValues); + if (bmapPtr->gc != None) { + Tk_FreeGC(Tk_Display(tkwin), bmapPtr->gc); + } + bmapPtr->gc = newGC; + + ComputeBitmapBbox(canvas, bmapPtr); + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeleteBitmap -- + * + * This procedure is called to clean up the data structure + * associated with a bitmap item. + * + * Results: + * None. + * + * Side effects: + * Resources associated with itemPtr are released. + * + *-------------------------------------------------------------- + */ + +static void +DeleteBitmap(canvas, itemPtr, display) + Tk_Canvas canvas; /* Info about overall canvas widget. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for + * canvas. */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + + if (bmapPtr->bitmap != None) { + Tk_FreeBitmap(display, bmapPtr->bitmap); + } + if (bmapPtr->fgColor != NULL) { + Tk_FreeColor(bmapPtr->fgColor); + } + if (bmapPtr->bgColor != NULL) { + Tk_FreeColor(bmapPtr->bgColor); + } + if (bmapPtr->gc != NULL) { + Tk_FreeGC(display, bmapPtr->gc); + } +} + +/* + *-------------------------------------------------------------- + * + * ComputeBitmapBbox -- + * + * This procedure is invoked to compute the bounding box of + * all the pixels that may be drawn as part of a bitmap item. + * This procedure is where the child bitmap's placement is + * computed. + * + * Results: + * None. + * + * Side effects: + * The fields x1, y1, x2, and y2 are updated in the header + * for itemPtr. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +ComputeBitmapBbox(canvas, bmapPtr) + Tk_Canvas canvas; /* Canvas that contains item. */ + BitmapItem *bmapPtr; /* Item whose bbox is to be + * recomputed. */ +{ + int width, height; + int x, y; + + x = (int) (bmapPtr->x + ((bmapPtr->x >= 0) ? 0.5 : - 0.5)); + y = (int) (bmapPtr->y + ((bmapPtr->y >= 0) ? 0.5 : - 0.5)); + + if (bmapPtr->bitmap == None) { + bmapPtr->header.x1 = bmapPtr->header.x2 = x; + bmapPtr->header.y1 = bmapPtr->header.y2 = y; + return; + } + + /* + * Compute location and size of bitmap, using anchor information. + */ + + Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bmapPtr->bitmap, + &width, &height); + switch (bmapPtr->anchor) { + case TK_ANCHOR_N: + x -= width/2; + break; + case TK_ANCHOR_NE: + x -= width; + break; + case TK_ANCHOR_E: + x -= width; + y -= height/2; + break; + case TK_ANCHOR_SE: + x -= width; + y -= height; + break; + case TK_ANCHOR_S: + x -= width/2; + y -= height; + break; + case TK_ANCHOR_SW: + y -= height; + break; + case TK_ANCHOR_W: + y -= height/2; + break; + case TK_ANCHOR_NW: + break; + case TK_ANCHOR_CENTER: + x -= width/2; + y -= height/2; + break; + } + + /* + * Store the information in the item header. + */ + + bmapPtr->header.x1 = x; + bmapPtr->header.y1 = y; + bmapPtr->header.x2 = x + width; + bmapPtr->header.y2 = y + height; +} + +/* + *-------------------------------------------------------------- + * + * DisplayBitmap -- + * + * This procedure is invoked to draw a bitmap item in a given + * drawable. + * + * Results: + * None. + * + * Side effects: + * ItemPtr is drawn in drawable using the transformation + * information in canvas. + * + *-------------------------------------------------------------- + */ + +static void +DisplayBitmap(canvas, itemPtr, display, drawable, x, y, width, height) + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw + * item. */ + int x, y, width, height; /* Describes region of canvas that + * must be redisplayed (not used). */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + int bmapX, bmapY, bmapWidth, bmapHeight; + short drawableX, drawableY; + + /* + * If the area being displayed doesn't cover the whole bitmap, + * then only redisplay the part of the bitmap that needs + * redisplay. + */ + + if (bmapPtr->bitmap != None) { + if (x > bmapPtr->header.x1) { + bmapX = x - bmapPtr->header.x1; + bmapWidth = bmapPtr->header.x2 - x; + } else { + bmapX = 0; + if ((x+width) < bmapPtr->header.x2) { + bmapWidth = x + width - bmapPtr->header.x1; + } else { + bmapWidth = bmapPtr->header.x2 - bmapPtr->header.x1; + } + } + if (y > bmapPtr->header.y1) { + bmapY = y - bmapPtr->header.y1; + bmapHeight = bmapPtr->header.y2 - y; + } else { + bmapY = 0; + if ((y+height) < bmapPtr->header.y2) { + bmapHeight = y + height - bmapPtr->header.y1; + } else { + bmapHeight = bmapPtr->header.y2 - bmapPtr->header.y1; + } + } + Tk_CanvasDrawableCoords(canvas, + (double) (bmapPtr->header.x1 + bmapX), + (double) (bmapPtr->header.y1 + bmapY), + &drawableX, &drawableY); + + /* + * Must modify the mask origin within the graphics context + * to line up with the bitmap's origin (in order to make + * bitmaps with "-background {}" work right). + */ + + XSetClipOrigin(display, bmapPtr->gc, drawableX - bmapX, + drawableY - bmapY); + XCopyPlane(display, bmapPtr->bitmap, drawable, + bmapPtr->gc, bmapX, bmapY, (unsigned int) bmapWidth, + (unsigned int) bmapHeight, drawableX, drawableY, 1); + } +} + +/* + *-------------------------------------------------------------- + * + * BitmapToPoint -- + * + * Computes the distance from a given point to a given + * rectangle, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are coordPtr[0] and coordPtr[1] is inside the bitmap. If the + * point isn't inside the bitmap then the return value is the + * distance from the point to the bitmap. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static double +BitmapToPoint(canvas, itemPtr, coordPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *coordPtr; /* Pointer to x and y coordinates. */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + double x1, x2, y1, y2, xDiff, yDiff; + + x1 = bmapPtr->header.x1; + y1 = bmapPtr->header.y1; + x2 = bmapPtr->header.x2; + y2 = bmapPtr->header.y2; + + /* + * Point is outside rectangle. + */ + + if (coordPtr[0] < x1) { + xDiff = x1 - coordPtr[0]; + } else if (coordPtr[0] > x2) { + xDiff = coordPtr[0] - x2; + } else { + xDiff = 0; + } + + if (coordPtr[1] < y1) { + yDiff = y1 - coordPtr[1]; + } else if (coordPtr[1] > y2) { + yDiff = coordPtr[1] - y2; + } else { + yDiff = 0; + } + + return hypot(xDiff, yDiff); +} + +/* + *-------------------------------------------------------------- + * + * BitmapToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given rectangle. + * + * Results: + * -1 is returned if the item is entirely outside the area + * given by rectPtr, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +BitmapToArea(canvas, itemPtr, rectPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against rectangle. */ + double *rectPtr; /* Pointer to array of four coordinates + * (x1, y1, x2, y2) describing rectangular + * area. */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + + if ((rectPtr[2] <= bmapPtr->header.x1) + || (rectPtr[0] >= bmapPtr->header.x2) + || (rectPtr[3] <= bmapPtr->header.y1) + || (rectPtr[1] >= bmapPtr->header.y2)) { + return -1; + } + if ((rectPtr[0] <= bmapPtr->header.x1) + && (rectPtr[1] <= bmapPtr->header.y1) + && (rectPtr[2] >= bmapPtr->header.x2) + && (rectPtr[3] >= bmapPtr->header.y2)) { + return 1; + } + return 0; +} + +/* + *-------------------------------------------------------------- + * + * ScaleBitmap -- + * + * This procedure is invoked to rescale a bitmap item in a + * canvas. It is one of the standard item procedures for + * bitmap items, and is invoked by the generic canvas code. + * + * Results: + * None. + * + * Side effects: + * The item referred to by itemPtr is rescaled so that the + * following transformation is applied to all point coordinates: + * x' = originX + scaleX*(x-originX) + * y' = originY + scaleY*(y-originY) + * + *-------------------------------------------------------------- + */ + +static void +ScaleBitmap(canvas, itemPtr, originX, originY, scaleX, scaleY) + Tk_Canvas canvas; /* Canvas containing rectangle. */ + Tk_Item *itemPtr; /* Rectangle to be scaled. */ + double originX, originY; /* Origin about which to scale item. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + + bmapPtr->x = originX + scaleX*(bmapPtr->x - originX); + bmapPtr->y = originY + scaleY*(bmapPtr->y - originY); + ComputeBitmapBbox(canvas, bmapPtr); +} + +/* + *-------------------------------------------------------------- + * + * TranslateBitmap -- + * + * This procedure is called to move an item by a given amount. + * + * Results: + * None. + * + * Side effects: + * The position of the item is offset by (xDelta, yDelta), and + * the bounding box is updated in the generic part of the item + * structure. + * + *-------------------------------------------------------------- + */ + +static void +TranslateBitmap(canvas, itemPtr, deltaX, deltaY) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be + * moved. */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + + bmapPtr->x += deltaX; + bmapPtr->y += deltaY; + ComputeBitmapBbox(canvas, bmapPtr); +} + +/* + *-------------------------------------------------------------- + * + * BitmapToPostscript -- + * + * This procedure is called to generate Postscript for + * bitmap items. + * + * Results: + * The return value is a standard Tcl result. If an error + * occurs in generating Postscript then an error message is + * left in the interp's result, replacing whatever used to be there. + * If no error occurs, then Postscript for the item is appended + * to the result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +BitmapToPostscript(interp, canvas, itemPtr, prepass) + Tcl_Interp *interp; /* Leave Postscript or error message + * here. */ + Tk_Canvas canvas; /* Information about overall canvas. */ + Tk_Item *itemPtr; /* Item for which Postscript is + * wanted. */ + int prepass; /* 1 means this is a prepass to + * collect font information; 0 means + * final Postscript is being created. */ +{ + BitmapItem *bmapPtr = (BitmapItem *) itemPtr; + double x, y; + int width, height, rowsAtOnce, rowsThisTime; + int curRow; + char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4]; + + if (bmapPtr->bitmap == None) { + return TCL_OK; + } + + /* + * Compute the coordinates of the lower-left corner of the bitmap, + * taking into account the anchor position for the bitmp. + */ + + x = bmapPtr->x; + y = Tk_CanvasPsY(canvas, bmapPtr->y); + Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bmapPtr->bitmap, + &width, &height); + switch (bmapPtr->anchor) { + case TK_ANCHOR_NW: y -= height; break; + case TK_ANCHOR_N: x -= width/2.0; y -= height; break; + case TK_ANCHOR_NE: x -= width; y -= height; break; + case TK_ANCHOR_E: x -= width; y -= height/2.0; break; + case TK_ANCHOR_SE: x -= width; break; + case TK_ANCHOR_S: x -= width/2.0; break; + case TK_ANCHOR_SW: break; + case TK_ANCHOR_W: y -= height/2.0; break; + case TK_ANCHOR_CENTER: x -= width/2.0; y -= height/2.0; break; + } + + /* + * Color the background, if there is one. + */ + + if (bmapPtr->bgColor != NULL) { + sprintf(buffer, + "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n", + x, y, width, height, -width, "0 rlineto closepath"); + Tcl_AppendResult(interp, buffer, (char *) NULL); + if (Tk_CanvasPsColor(interp, canvas, bmapPtr->bgColor) != TCL_OK) { + return TCL_ERROR; + } + Tcl_AppendResult(interp, "fill\n", (char *) NULL); + } + + /* + * Draw the bitmap, if there is a foreground color. If the bitmap + * is very large, then chop it up into multiple bitmaps, each + * consisting of one or more rows. This is needed because Postscript + * can't handle single strings longer than 64 KBytes long. + */ + + if (bmapPtr->fgColor != NULL) { + if (Tk_CanvasPsColor(interp, canvas, bmapPtr->fgColor) != TCL_OK) { + return TCL_ERROR; + } + if (width > 60000) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "can't generate Postscript", + " for bitmaps more than 60000 pixels wide", + (char *) NULL); + return TCL_ERROR; + } + rowsAtOnce = 60000/width; + if (rowsAtOnce < 1) { + rowsAtOnce = 1; + } + sprintf(buffer, "%.15g %.15g translate\n", x, y+height); + Tcl_AppendResult(interp, buffer, (char *) NULL); + for (curRow = 0; curRow < height; curRow += rowsAtOnce) { + rowsThisTime = rowsAtOnce; + if (rowsThisTime > (height - curRow)) { + rowsThisTime = height - curRow; + } + sprintf(buffer, "0 -%.15g translate\n%d %d true matrix {\n", + (double) rowsThisTime, width, rowsThisTime); + Tcl_AppendResult(interp, buffer, (char *) NULL); + if (Tk_CanvasPsBitmap(interp, canvas, bmapPtr->bitmap, + 0, curRow, width, rowsThisTime) != TCL_OK) { + return TCL_ERROR; + } + Tcl_AppendResult(interp, "\n} imagemask\n", (char *) NULL); + } + } + return TCL_OK; +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvImg.c ./canvas-tcl8.2.2/tkCanvImg.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvImg.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvImg.c Thu Dec 30 14:59:40 1999 @@ -0,0 +1,679 @@ +/* + * tkCanvImg.c -- + * + * This file implements image items for canvas widgets. + * + * Copyright (c) 1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvImg.c,v 1.3 1999/04/16 01:51:11 stanton Exp $ + */ + +#include +#include "tkInt.h" +#include "tkPort.h" +#include "tkCanvas.h" + +/* + * The structure below defines the record for each image item. + */ + +typedef struct ImageItem { + Tk_Item header; /* Generic stuff that's the same for all + * types. MUST BE FIRST IN STRUCTURE. */ + Tk_Canvas canvas; /* Canvas containing the image. */ + double x, y; /* Coordinates of positioning point for + * image. */ + Tk_Anchor anchor; /* Where to anchor image relative to + * (x,y). */ + char *imageString; /* String describing -image option (malloc-ed). + * NULL means no image right now. */ + Tk_Image image; /* Image to display in window, or NULL if + * no image at present. */ +} ImageItem; + +/* + * Information used for parsing configuration specs: + */ + +static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, + Tk_CanvasTagsPrintProc, (ClientData) NULL +}; + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL, + "center", Tk_Offset(ImageItem, anchor), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(ImageItem, imageString), TK_CONFIG_NULL_OK}, + {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Prototypes for procedures defined in this file: + */ + +static void ImageChangedProc _ANSI_ARGS_((ClientData clientData, + int x, int y, int width, int height, int imgWidth, + int imgHeight)); +static int ImageCoords _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv)); +static int ImageToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *rectPtr)); +static double ImageToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *coordPtr)); +static void ComputeImageBbox _ANSI_ARGS_((Tk_Canvas canvas, + ImageItem *imgPtr)); +static int ConfigureImage _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +static int CreateImage _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, struct Tk_Item *itemPtr, + int argc, char **argv)); +static void DeleteImage _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +static void DisplayImage _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +static void ScaleImage _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +static void TranslateImage _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); + +/* + * The structures below defines the image item type in terms of + * procedures that can be invoked by generic item code. + */ + +Tk_ItemType tkImageType = { + "image", /* name */ + sizeof(ImageItem), /* itemSize */ + CreateImage, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureImage, /* configureProc */ + ImageCoords, /* coordProc */ + DeleteImage, /* deleteProc */ + DisplayImage, /* displayProc */ + 0, /* alwaysRedraw */ + ImageToPoint, /* pointProc */ + ImageToArea, /* areaProc */ + (Tk_ItemPostscriptProc *) NULL, /* postscriptProc */ + ScaleImage, /* scaleProc */ + TranslateImage, /* translateProc */ + (Tk_ItemIndexProc *) NULL, /* indexProc */ + (Tk_ItemCursorProc *) NULL, /* icursorProc */ + (Tk_ItemSelectionProc *) NULL, /* selectionProc */ + (Tk_ItemInsertProc *) NULL, /* insertProc */ + (Tk_ItemDCharsProc *) NULL, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + +/* + *-------------------------------------------------------------- + * + * CreateImage -- + * + * This procedure is invoked to create a new image + * item in a canvas. + * + * Results: + * A standard Tcl return value. If an error occurred in + * creating the item, then an error message is left in + * the interp's result; in this case itemPtr is left uninitialized, + * so it can be safely freed by the caller. + * + * Side effects: + * A new image item is created. + * + *-------------------------------------------------------------- + */ + +static int +CreateImage(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header + * has been initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing rectangle. */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", + itemPtr->typePtr->name, " x y ?options?\"", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Initialize item's record. + */ + + imgPtr->canvas = canvas; + imgPtr->anchor = TK_ANCHOR_CENTER; + imgPtr->imageString = NULL; + imgPtr->image = NULL; + + /* + * Process the arguments to fill in the item record. + */ + + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], &imgPtr->y) + != TCL_OK)) { + return TCL_ERROR; + } + + if (ConfigureImage(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) { + DeleteImage(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ImageCoords -- + * + * This procedure is invoked to process the "coords" widget + * command on image items. See the user documentation for + * details on what it does. + * + * Results: + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. + * + * Side effects: + * The coordinates for the given item may be changed. + * + *-------------------------------------------------------------- + */ + +static int +ImageCoords(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be + * read or modified. */ + int argc; /* Number of coordinates supplied in + * argv. */ + char **argv; /* Array of coordinates: x1, y1, + * x2, y2, ... */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE]; + + if (argc == 0) { + Tcl_PrintDouble(interp, imgPtr->x, x); + Tcl_PrintDouble(interp, imgPtr->y, y); + Tcl_AppendResult(interp, x, " ", y, (char *) NULL); + } else if (argc == 2) { + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], + &imgPtr->y) != TCL_OK)) { + return TCL_ERROR; + } + ComputeImageBbox(canvas, imgPtr); + } else { + char buf[64]; + + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ConfigureImage -- + * + * This procedure is invoked to configure various aspects + * of an image item, such as its anchor position. + * + * Results: + * A standard Tcl result code. If an error occurs, then + * an error message is left in the interp's result. + * + * Side effects: + * Configuration information may be set for itemPtr. + * + *-------------------------------------------------------------- + */ + +static int +ConfigureImage(interp, canvas, itemPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Image item to reconfigure. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments describing things to configure. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + Tk_Window tkwin; + Tk_Image image; + + tkwin = Tk_CanvasTkwin(canvas); + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, + argv, (char *) imgPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Create the image. Save the old image around and don't free it + * until after the new one is allocated. This keeps the reference + * count from going to zero so the image doesn't have to be recreated + * if it hasn't changed. + */ + + if (imgPtr->imageString != NULL) { + image = Tk_GetImage(interp, tkwin, imgPtr->imageString, + ImageChangedProc, (ClientData) imgPtr); + if (image == NULL) { + return TCL_ERROR; + } + } else { + image = NULL; + } + if (imgPtr->image != NULL) { + Tk_FreeImage(imgPtr->image); + } + imgPtr->image = image; + ComputeImageBbox(canvas, imgPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeleteImage -- + * + * This procedure is called to clean up the data structure + * associated with a image item. + * + * Results: + * None. + * + * Side effects: + * Resources associated with itemPtr are released. + * + *-------------------------------------------------------------- + */ + +static void +DeleteImage(canvas, itemPtr, display) + Tk_Canvas canvas; /* Info about overall canvas widget. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for + * canvas. */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + + if (imgPtr->imageString != NULL) { + ckfree(imgPtr->imageString); + } + if (imgPtr->image != NULL) { + Tk_FreeImage(imgPtr->image); + } +} + +/* + *-------------------------------------------------------------- + * + * ComputeImageBbox -- + * + * This procedure is invoked to compute the bounding box of + * all the pixels that may be drawn as part of a image item. + * This procedure is where the child image's placement is + * computed. + * + * Results: + * None. + * + * Side effects: + * The fields x1, y1, x2, and y2 are updated in the header + * for itemPtr. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +ComputeImageBbox(canvas, imgPtr) + Tk_Canvas canvas; /* Canvas that contains item. */ + ImageItem *imgPtr; /* Item whose bbox is to be + * recomputed. */ +{ + int width, height; + int x, y; + + x = (int) (imgPtr->x + ((imgPtr->x >= 0) ? 0.5 : - 0.5)); + y = (int) (imgPtr->y + ((imgPtr->y >= 0) ? 0.5 : - 0.5)); + + if (imgPtr->image == None) { + imgPtr->header.x1 = imgPtr->header.x2 = x; + imgPtr->header.y1 = imgPtr->header.y2 = y; + return; + } + + /* + * Compute location and size of image, using anchor information. + */ + + Tk_SizeOfImage(imgPtr->image, &width, &height); + switch (imgPtr->anchor) { + case TK_ANCHOR_N: + x -= width/2; + break; + case TK_ANCHOR_NE: + x -= width; + break; + case TK_ANCHOR_E: + x -= width; + y -= height/2; + break; + case TK_ANCHOR_SE: + x -= width; + y -= height; + break; + case TK_ANCHOR_S: + x -= width/2; + y -= height; + break; + case TK_ANCHOR_SW: + y -= height; + break; + case TK_ANCHOR_W: + y -= height/2; + break; + case TK_ANCHOR_NW: + break; + case TK_ANCHOR_CENTER: + x -= width/2; + y -= height/2; + break; + } + + /* + * Store the information in the item header. + */ + + imgPtr->header.x1 = x; + imgPtr->header.y1 = y; + imgPtr->header.x2 = x + width; + imgPtr->header.y2 = y + height; +} + +/* + *-------------------------------------------------------------- + * + * DisplayImage -- + * + * This procedure is invoked to draw a image item in a given + * drawable. + * + * Results: + * None. + * + * Side effects: + * ItemPtr is drawn in drawable using the transformation + * information in canvas. + * + *-------------------------------------------------------------- + */ + +static void +DisplayImage(canvas, itemPtr, display, drawable, x, y, width, height) + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw + * item. */ + int x, y, width, height; /* Describes region of canvas that + * must be redisplayed (not used). */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + short drawableX, drawableY; + + if (imgPtr->image == NULL) { + return; + } + + /* + * Translate the coordinates to those of the image, then redisplay it. + */ + + Tk_CanvasDrawableCoords(canvas, (double) x, (double) y, + &drawableX, &drawableY); + Tk_RedrawImage(imgPtr->image, x - imgPtr->header.x1, y - imgPtr->header.y1, + width, height, drawable, drawableX, drawableY); +} + +/* + *-------------------------------------------------------------- + * + * ImageToPoint -- + * + * Computes the distance from a given point to a given + * rectangle, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are coordPtr[0] and coordPtr[1] is inside the image. If the + * point isn't inside the image then the return value is the + * distance from the point to the image. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static double +ImageToPoint(canvas, itemPtr, coordPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *coordPtr; /* Pointer to x and y coordinates. */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + double x1, x2, y1, y2, xDiff, yDiff; + + x1 = imgPtr->header.x1; + y1 = imgPtr->header.y1; + x2 = imgPtr->header.x2; + y2 = imgPtr->header.y2; + + /* + * Point is outside rectangle. + */ + + if (coordPtr[0] < x1) { + xDiff = x1 - coordPtr[0]; + } else if (coordPtr[0] > x2) { + xDiff = coordPtr[0] - x2; + } else { + xDiff = 0; + } + + if (coordPtr[1] < y1) { + yDiff = y1 - coordPtr[1]; + } else if (coordPtr[1] > y2) { + yDiff = coordPtr[1] - y2; + } else { + yDiff = 0; + } + + return hypot(xDiff, yDiff); +} + +/* + *-------------------------------------------------------------- + * + * ImageToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given rectangle. + * + * Results: + * -1 is returned if the item is entirely outside the area + * given by rectPtr, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +ImageToArea(canvas, itemPtr, rectPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against rectangle. */ + double *rectPtr; /* Pointer to array of four coordinates + * (x1, y1, x2, y2) describing rectangular + * area. */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + + if ((rectPtr[2] <= imgPtr->header.x1) + || (rectPtr[0] >= imgPtr->header.x2) + || (rectPtr[3] <= imgPtr->header.y1) + || (rectPtr[1] >= imgPtr->header.y2)) { + return -1; + } + if ((rectPtr[0] <= imgPtr->header.x1) + && (rectPtr[1] <= imgPtr->header.y1) + && (rectPtr[2] >= imgPtr->header.x2) + && (rectPtr[3] >= imgPtr->header.y2)) { + return 1; + } + return 0; +} + +/* + *-------------------------------------------------------------- + * + * ScaleImage -- + * + * This procedure is invoked to rescale an item. + * + * Results: + * None. + * + * Side effects: + * The item referred to by itemPtr is rescaled so that the + * following transformation is applied to all point coordinates: + * x' = originX + scaleX*(x-originX) + * y' = originY + scaleY*(y-originY) + * + *-------------------------------------------------------------- + */ + +static void +ScaleImage(canvas, itemPtr, originX, originY, scaleX, scaleY) + Tk_Canvas canvas; /* Canvas containing rectangle. */ + Tk_Item *itemPtr; /* Rectangle to be scaled. */ + double originX, originY; /* Origin about which to scale rect. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + + imgPtr->x = originX + scaleX*(imgPtr->x - originX); + imgPtr->y = originY + scaleY*(imgPtr->y - originY); + ComputeImageBbox(canvas, imgPtr); +} + +/* + *-------------------------------------------------------------- + * + * TranslateImage -- + * + * This procedure is called to move an item by a given amount. + * + * Results: + * None. + * + * Side effects: + * The position of the item is offset by (xDelta, yDelta), and + * the bounding box is updated in the generic part of the item + * structure. + * + *-------------------------------------------------------------- + */ + +static void +TranslateImage(canvas, itemPtr, deltaX, deltaY) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be + * moved. */ +{ + ImageItem *imgPtr = (ImageItem *) itemPtr; + + imgPtr->x += deltaX; + imgPtr->y += deltaY; + ComputeImageBbox(canvas, imgPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ImageChangedProc -- + * + * This procedure is invoked by the image code whenever the manager + * for an image does something that affects the image's size or + * how it is displayed. + * + * Results: + * None. + * + * Side effects: + * Arranges for the canvas to get redisplayed. + * + *---------------------------------------------------------------------- + */ + +static void +ImageChangedProc(clientData, x, y, width, height, imgWidth, imgHeight) + ClientData clientData; /* Pointer to canvas item for image. */ + int x, y; /* Upper left pixel (within image) + * that must be redisplayed. */ + int width, height; /* Dimensions of area to redisplay + * (may be <= 0). */ + int imgWidth, imgHeight; /* New dimensions of image. */ +{ + ImageItem *imgPtr = (ImageItem *) clientData; + + /* + * If the image's size changed and it's not anchored at its + * northwest corner then just redisplay the entire area of the + * image. This is a bit over-conservative, but we need to do + * something because a size change also means a position change. + */ + + if (((imgPtr->header.x2 - imgPtr->header.x1) != imgWidth) + || ((imgPtr->header.y2 - imgPtr->header.y1) != imgHeight)) { + x = y = 0; + width = imgWidth; + height = imgHeight; + Xxl_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1, + imgPtr->header.y1, imgPtr->header.x2, imgPtr->header.y2); + } + ComputeImageBbox(imgPtr->canvas, imgPtr); + Xxl_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1 + x, + imgPtr->header.y1 + y, (int) (imgPtr->header.x1 + x + width), + (int) (imgPtr->header.y1 + y + height)); +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvLine.c ./canvas-tcl8.2.2/tkCanvLine.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvLine.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvLine.c Thu Dec 30 14:59:40 1999 @@ -0,0 +1,1582 @@ +/* + * tkCanvLine.c -- + * + * This file implements line items for canvas widgets. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvLine.c,v 1.4 1999/04/16 01:51:11 stanton Exp $ + */ + +#include +#include "tkInt.h" +#include "tkPort.h" +#include "xxl_incs.h" + +/* + * Number of points in an arrowHead: + */ + +#define PTS_IN_ARROW 6 + +/* + * Prototypes for procedures defined in this file: + */ + +static int ArrowheadPostscript _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, LineItem *linePtr, + double *arrowPtr)); +static void ComputeLineBbox _ANSI_ARGS_((Tk_Canvas canvas, + LineItem *linePtr)); +static int ConfigureLine _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +static int ConfigureArrows _ANSI_ARGS_((Tk_Canvas canvas, + LineItem *linePtr)); +static int CreateLine _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, struct Tk_Item *itemPtr, + int argc, char **argv)); +static void DeleteLine _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +static void DisplayLine _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +static int LineCoords _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, + int argc, char **argv)); +static int LineToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *rectPtr)); +static double LineToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *coordPtr)); +static int LineToPostscript _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); +static int ParseArrowShape _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, Tk_Window tkwin, char *value, + char *recordPtr, int offset)); +static char * PrintArrowShape _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *recordPtr, int offset, + Tcl_FreeProc **freeProcPtr)); +static void ScaleLine _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +static void TranslateLine _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); + +/* + * Information used for parsing configuration specs. If you change any + * of the default strings, be sure to change the corresponding default + * values in CreateLine. + */ + +static Tk_CustomOption arrowShapeOption = {ParseArrowShape, + PrintArrowShape, (ClientData) NULL}; +static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, + Tk_CanvasTagsPrintProc, (ClientData) NULL +}; + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_UID, "-arrow", (char *) NULL, (char *) NULL, + "none", Tk_Offset(LineItem, arrow), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_CUSTOM, "-arrowshape", (char *) NULL, (char *) NULL, + "8 10 3", Tk_Offset(LineItem, arrowShapeA), + TK_CONFIG_DONT_SET_DEFAULT, &arrowShapeOption}, + {TK_CONFIG_CAP_STYLE, "-capstyle", (char *) NULL, (char *) NULL, + "butt", Tk_Offset(LineItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, + "black", Tk_Offset(LineItem, fg), TK_CONFIG_NULL_OK}, + {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL, + "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL, + "0", Tk_Offset(LineItem, smooth), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL, + "12", Tk_Offset(LineItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(LineItem, fillStipple), TK_CONFIG_NULL_OK}, + {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, + "1", Tk_Offset(LineItem, width), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * The structures below defines the line item type by means + * of procedures that can be invoked by generic item code. + */ + +Tk_ItemType tkLineType = { + "line", /* name */ + sizeof(LineItem), /* itemSize */ + CreateLine, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureLine, /* configureProc */ + LineCoords, /* coordProc */ + DeleteLine, /* deleteProc */ + DisplayLine, /* displayProc */ + 0, /* alwaysRedraw */ + LineToPoint, /* pointProc */ + LineToArea, /* areaProc */ + LineToPostscript, /* postscriptProc */ + ScaleLine, /* scaleProc */ + TranslateLine, /* translateProc */ + (Tk_ItemIndexProc *) NULL, /* indexProc */ + (Tk_ItemCursorProc *) NULL, /* icursorProc */ + (Tk_ItemSelectionProc *) NULL, /* selectionProc */ + (Tk_ItemInsertProc *) NULL, /* insertProc */ + (Tk_ItemDCharsProc *) NULL, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + +/* + * The definition below determines how large are static arrays + * used to hold spline points (splines larger than this have to + * have their arrays malloc-ed). + */ + +#define MAX_STATIC_POINTS 200 + +/* + *-------------------------------------------------------------- + * + * CreateLine -- + * + * This procedure is invoked to create a new line item in + * a canvas. + * + * Results: + * A standard Tcl return value. If an error occurred in + * creating the item, then an error message is left in + * the interp's result; in this case itemPtr is left uninitialized, + * so it can be safely freed by the caller. + * + * Side effects: + * A new line item is created. + * + *-------------------------------------------------------------- + */ + +static int +CreateLine(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header + * has been initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing line. */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + int i; + + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", + itemPtr->typePtr->name, " x1 y1 x2 y2 ?x3 y3 ...? ?options?\"", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Carry out initialization that is needed to set defaults and to + * allow proper cleanup after errors during the the remainder of + * this procedure. + */ + + linePtr->canvas = canvas; + linePtr->numPoints = 0; + linePtr->coordPtr = NULL; + linePtr->width = 1; + linePtr->fg = None; + linePtr->fillStipple = None; + linePtr->capStyle = CapButt; + linePtr->joinStyle = JoinRound; + linePtr->gc = None; + linePtr->arrowGC = None; + linePtr->arrow = Tk_GetUid("none"); + linePtr->arrowShapeA = (float)8.0; + linePtr->arrowShapeB = (float)10.0; + linePtr->arrowShapeC = (float)3.0; + linePtr->firstArrowPtr = NULL; + linePtr->lastArrowPtr = NULL; + linePtr->smooth = 0; + linePtr->splineSteps = 12; + + /* + * Count the number of points and then parse them into a point + * array. Leading arguments are assumed to be points if they + * start with a digit or a minus sign followed by a digit. + */ + + for (i = 4; i < (argc-1); i+=2) { + if ((!isdigit(UCHAR(argv[i][0]))) && + ((argv[i][0] != '-') + || ((argv[i][1] != '.') && !isdigit(UCHAR(argv[i][1]))))) { + break; + } + } + if (LineCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) { + goto error; + } + if (argv[i][0] != 'X') + goto error; + i++; + linePtr->col1 = atoi(argv[i++]); + linePtr->row1 = atoi(argv[i++]); + linePtr->col2 = atoi(argv[i++]); + linePtr->row2 = atoi(argv[i++]); + if (ConfigureLine(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) + return TCL_OK; + error: + DeleteLine(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * LineCoords -- + * + * This procedure is invoked to process the "coords" widget + * command on lines. See the user documentation for details + * on what it does. + * + * Results: + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. + * + * Side effects: + * The coordinates for the given item may be changed. + * + *-------------------------------------------------------------- + */ + +static int +LineCoords(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be + * read or modified. */ + int argc; /* Number of coordinates supplied in + * argv. */ + char **argv; /* Array of coordinates: x1, y1, + * x2, y2, ... */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + char buffer[TCL_DOUBLE_SPACE]; + int i, numPoints; + + if (argc == 0) { + double *coordPtr; + int numCoords; + + numCoords = 2*linePtr->numPoints; + if (linePtr->firstArrowPtr != NULL) { + coordPtr = linePtr->firstArrowPtr; + } else { + coordPtr = linePtr->coordPtr; + } + for (i = 0; i < numCoords; i++, coordPtr++) { + if (i == 2) { + coordPtr = linePtr->coordPtr+2; + } + if ((linePtr->lastArrowPtr != NULL) && (i == (numCoords-2))) { + coordPtr = linePtr->lastArrowPtr; + } + Tcl_PrintDouble(interp, *coordPtr, buffer); + Tcl_AppendElement(interp, buffer); + } + } else if (argc < 4) { + Tcl_AppendResult(interp, + "too few coordinates for line: must have at least 4", + (char *) NULL); + return TCL_ERROR; + } else if (argc & 1) { + Tcl_AppendResult(interp, + "odd number of coordinates specified for line", + (char *) NULL); + return TCL_ERROR; + } else { + numPoints = argc/2; + if (linePtr->numPoints != numPoints) { + if (linePtr->coordPtr != NULL) { + ckfree((char *) linePtr->coordPtr); + } + linePtr->coordPtr = (double *) ckalloc((unsigned) + (sizeof(double) * argc)); + linePtr->numPoints = numPoints; + } + for (i = argc-1; i >= 0; i--) { + if (Tk_CanvasGetCoord(interp, canvas, argv[i], + &linePtr->coordPtr[i]) != TCL_OK) { + return TCL_ERROR; + } + } + + /* + * Update arrowheads by throwing away any existing arrow-head + * information and calling ConfigureArrows to recompute it. + */ + + if (linePtr->firstArrowPtr != NULL) { + ckfree((char *) linePtr->firstArrowPtr); + linePtr->firstArrowPtr = NULL; + } + if (linePtr->lastArrowPtr != NULL) { + ckfree((char *) linePtr->lastArrowPtr); + linePtr->lastArrowPtr = NULL; + } + if (linePtr->arrow != Tk_GetUid("none")) { + ConfigureArrows(canvas, linePtr); + } + ComputeLineBbox(canvas, linePtr); + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ConfigureLine -- + * + * This procedure is invoked to configure various aspects + * of a line item such as its background color. + * + * Results: + * A standard Tcl result code. If an error occurs, then + * an error message is left in the interp's result. + * + * Side effects: + * Configuration information, such as colors and stipple + * patterns, may be set for itemPtr. + * + *-------------------------------------------------------------- + */ + +static int +ConfigureLine(interp, canvas, itemPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Line item to reconfigure. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments describing things to configure. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + XGCValues gcValues; + GC newGC, arrowGC; + unsigned long mask; + Tk_Window tkwin; + Tk_Uid noneUid = Tk_GetUid("none"); + Tk_Uid bothUid = Tk_GetUid("both"); + Tk_Uid firstUid = Tk_GetUid("first"); + Tk_Uid lastUid = Tk_GetUid("last"); + + tkwin = Tk_CanvasTkwin(canvas); + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv, + (char *) linePtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few of the options require additional processing, such as + * graphics contexts. + */ + + if (linePtr->fg == NULL) { + newGC = arrowGC = None; + } else { + gcValues.foreground = linePtr->fg->pixel; + gcValues.join_style = linePtr->joinStyle; + if (linePtr->width < 0) { + linePtr->width = 1; + } + gcValues.line_width = linePtr->width; + mask = GCForeground|GCJoinStyle|GCLineWidth; + if (linePtr->fillStipple != None) { + gcValues.stipple = linePtr->fillStipple; + gcValues.fill_style = FillStippled; + mask |= GCStipple|GCFillStyle; + } + if (linePtr->arrow == noneUid) { + gcValues.cap_style = linePtr->capStyle; + mask |= GCCapStyle; + } + newGC = Tk_GetGC(tkwin, mask, &gcValues); + gcValues.line_width = 0; + arrowGC = Tk_GetGC(tkwin, mask, &gcValues); + } + if (linePtr->gc != None) { + Tk_FreeGC(Tk_Display(tkwin), linePtr->gc); + } + if (linePtr->arrowGC != None) { + Tk_FreeGC(Tk_Display(tkwin), linePtr->arrowGC); + } + linePtr->gc = newGC; + linePtr->arrowGC = arrowGC; + + /* + * Keep spline parameters within reasonable limits. + */ + + if (linePtr->splineSteps < 1) { + linePtr->splineSteps = 1; + } else if (linePtr->splineSteps > 100) { + linePtr->splineSteps = 100; + } + + /* + * Setup arrowheads, if needed. If arrowheads are turned off, + * restore the line's endpoints (they were shortened when the + * arrowheads were added). + */ + + if ((linePtr->firstArrowPtr != NULL) && (linePtr->arrow != firstUid) + && (linePtr->arrow != bothUid)) { + linePtr->coordPtr[0] = linePtr->firstArrowPtr[0]; + linePtr->coordPtr[1] = linePtr->firstArrowPtr[1]; + ckfree((char *) linePtr->firstArrowPtr); + linePtr->firstArrowPtr = NULL; + } + if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != lastUid) + && (linePtr->arrow != bothUid)) { + int i; + + i = 2*(linePtr->numPoints-1); + linePtr->coordPtr[i] = linePtr->lastArrowPtr[0]; + linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1]; + ckfree((char *) linePtr->lastArrowPtr); + linePtr->lastArrowPtr = NULL; + } + if (linePtr->arrow != noneUid) { + if ((linePtr->arrow != firstUid) && (linePtr->arrow != lastUid) + && (linePtr->arrow != bothUid)) { + Tcl_AppendResult(interp, "bad arrow spec \"", + linePtr->arrow, "\": must be none, first, last, or both", + (char *) NULL); + linePtr->arrow = noneUid; + return TCL_ERROR; + } + ConfigureArrows(canvas, linePtr); + } + + /* + * Recompute bounding box for line. + */ + + ComputeLineBbox(canvas, linePtr); + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeleteLine -- + * + * This procedure is called to clean up the data structure + * associated with a line item. + * + * Results: + * None. + * + * Side effects: + * Resources associated with itemPtr are released. + * + *-------------------------------------------------------------- + */ + +static void +DeleteLine(canvas, itemPtr, display) + Tk_Canvas canvas; /* Info about overall canvas widget. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for + * canvas. */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + + if (linePtr->coordPtr != NULL) { + ckfree((char *) linePtr->coordPtr); + } + if (linePtr->fg != NULL) { + Tk_FreeColor(linePtr->fg); + } + if (linePtr->fillStipple != None) { + Tk_FreeBitmap(display, linePtr->fillStipple); + } + if (linePtr->gc != None) { + Tk_FreeGC(display, linePtr->gc); + } + if (linePtr->arrowGC != None) { + Tk_FreeGC(display, linePtr->arrowGC); + } + if (linePtr->firstArrowPtr != NULL) { + ckfree((char *) linePtr->firstArrowPtr); + } + if (linePtr->lastArrowPtr != NULL) { + ckfree((char *) linePtr->lastArrowPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * ComputeLineBbox -- + * + * This procedure is invoked to compute the bounding box of + * all the pixels that may be drawn as part of a line. + * + * Results: + * None. + * + * Side effects: + * The fields x1, y1, x2, and y2 are updated in the header + * for itemPtr. + * + *-------------------------------------------------------------- + */ + +static void +ComputeLineBbox(canvas, linePtr) + Tk_Canvas canvas; /* Canvas that contains item. */ + LineItem *linePtr; /* Item whose bbos is to be + * recomputed. */ +{ + double *coordPtr; + int i, width; + + coordPtr = linePtr->coordPtr; + linePtr->header.x1 = linePtr->header.x2 = (int) *coordPtr; + linePtr->header.y1 = linePtr->header.y2 = (int) coordPtr[1]; + + /* + * Compute the bounding box of all the points in the line, + * then expand in all directions by the line's width to take + * care of butting or rounded corners and projecting or + * rounded caps. This expansion is an overestimate (worst-case + * is square root of two over two) but it's simple. Don't do + * anything special for curves. This causes an additional + * overestimate in the bounding box, but is faster. + */ + + for (i = 1, coordPtr = linePtr->coordPtr+2; i < linePtr->numPoints; + i++, coordPtr += 2) { + TkIncludePoint((Tk_Item *) linePtr, coordPtr); + } + width = linePtr->width; + if (width < 1) { + width = 1; + } + linePtr->header.x1 -= width; + linePtr->header.x2 += width; + linePtr->header.y1 -= width; + linePtr->header.y2 += width; + + /* + * For mitered lines, make a second pass through all the points. + * Compute the locations of the two miter vertex points and add + * those into the bounding box. + */ + + if (linePtr->joinStyle == JoinMiter) { + for (i = linePtr->numPoints, coordPtr = linePtr->coordPtr; i >= 3; + i--, coordPtr += 2) { + double miter[4]; + int j; + + if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, + (double) width, miter, miter+2)) { + for (j = 0; j < 4; j += 2) { + TkIncludePoint((Tk_Item *) linePtr, miter+j); + } + } + } + } + + /* + * Add in the sizes of arrowheads, if any. + */ + + if (linePtr->arrow != Tk_GetUid("none")) { + if (linePtr->arrow != Tk_GetUid("last")) { + for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW; + i++, coordPtr += 2) { + TkIncludePoint((Tk_Item *) linePtr, coordPtr); + } + } + if (linePtr->arrow != Tk_GetUid("first")) { + for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW; + i++, coordPtr += 2) { + TkIncludePoint((Tk_Item *) linePtr, coordPtr); + } + } + } + + /* + * Add one more pixel of fudge factor just to be safe (e.g. + * X may round differently than we do). + */ + + linePtr->header.x1 -= 1; + linePtr->header.x2 += 1; + linePtr->header.y1 -= 1; + linePtr->header.y2 += 1; +} + +/* + *-------------------------------------------------------------- + * + * DisplayLine -- + * + * This procedure is invoked to draw a line item in a given + * drawable. + * + * Results: + * None. + * + * Side effects: + * ItemPtr is drawn in drawable using the transformation + * information in canvas. + * + *-------------------------------------------------------------- + */ + +static void +DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height) + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw + * item. */ + int x, y, width, height; /* Describes region of canvas that + * must be redisplayed (not used). */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + XPoint staticPoints[MAX_STATIC_POINTS]; + XPoint *pointPtr; + XPoint *pPtr; + double *coordPtr; + int i, numPoints; + + if (linePtr->gc == None) { + return; + } + + /* + * Build up an array of points in screen coordinates. Use a + * static array unless the line has an enormous number of points; + * in this case, dynamically allocate an array. For smoothed lines, + * generate the curve points on each redisplay. + */ + + if ((linePtr->smooth) && (linePtr->numPoints > 2)) { + numPoints = 1 + linePtr->numPoints*linePtr->splineSteps; + } else { + numPoints = linePtr->numPoints; + } + + if (numPoints <= MAX_STATIC_POINTS) { + pointPtr = staticPoints; + } else { + pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint))); + } + + if ((linePtr->smooth) && (linePtr->numPoints > 2)) { + numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr, + linePtr->numPoints, linePtr->splineSteps, pointPtr, + (double *) NULL); + } else { + for (i = 0, coordPtr = linePtr->coordPtr, pPtr = pointPtr; + i < linePtr->numPoints; i += 1, coordPtr += 2, pPtr++) { + Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1], + &pPtr->x, &pPtr->y); + } + } + + /* + * Display line, the free up line storage if it was dynamically + * allocated. If we're stippling, then modify the stipple offset + * in the GC. Be sure to reset the offset when done, since the + * GC is supposed to be read-only. + */ + + if (linePtr->fillStipple != None) { + Tk_CanvasSetStippleOrigin(canvas, linePtr->gc); + Tk_CanvasSetStippleOrigin(canvas, linePtr->arrowGC); + } + XDrawLines(display, drawable, linePtr->gc, pointPtr, numPoints, + CoordModeOrigin); + if (pointPtr != staticPoints) { + ckfree((char *) pointPtr); + } + + /* + * Display arrowheads, if they are wanted. + */ + + if (linePtr->firstArrowPtr != NULL) { + TkFillPolygon(canvas, linePtr->firstArrowPtr, PTS_IN_ARROW, + display, drawable, linePtr->gc, NULL); + } + if (linePtr->lastArrowPtr != NULL) { + TkFillPolygon(canvas, linePtr->lastArrowPtr, PTS_IN_ARROW, + display, drawable, linePtr->gc, NULL); + } + if (linePtr->fillStipple != None) { + XSetTSOrigin(display, linePtr->gc, 0, 0); + XSetTSOrigin(display, linePtr->arrowGC, 0, 0); + } +} + +/* + *-------------------------------------------------------------- + * + * LineToPoint -- + * + * Computes the distance from a given point to a given + * line, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are pointPtr[0] and pointPtr[1] is inside the line. If the + * point isn't inside the line then the return value is the + * distance from the point to the line. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static double +LineToPoint(canvas, itemPtr, pointPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *pointPtr; /* Pointer to x and y coordinates. */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + double *coordPtr, *linePoints; + double staticSpace[2*MAX_STATIC_POINTS]; + double poly[10]; + double bestDist, dist, width; + int numPoints, count; + int changedMiterToBevel; /* Non-zero means that a mitered corner + * had to be treated as beveled after all + * because the angle was < 11 degrees. */ + + bestDist = 1.0e36; + + /* + * Handle smoothed lines by generating an expanded set of points + * against which to do the check. + */ + + if ((linePtr->smooth) && (linePtr->numPoints > 2)) { + numPoints = 1 + linePtr->numPoints*linePtr->splineSteps; + if (numPoints <= MAX_STATIC_POINTS) { + linePoints = staticSpace; + } else { + linePoints = (double *) ckalloc((unsigned) + (2*numPoints*sizeof(double))); + } + numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr, + linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL, + linePoints); + } else { + numPoints = linePtr->numPoints; + linePoints = linePtr->coordPtr; + } + + width = (double) linePtr->width; + if (width < 1.0) { + width = 1.0; + } + + /* + * The overall idea is to iterate through all of the edges of + * the line, computing a polygon for each edge and testing the + * point against that polygon. In addition, there are additional + * tests to deal with rounded joints and caps. + */ + + changedMiterToBevel = 0; + for (count = numPoints, coordPtr = linePoints; count >= 2; + count--, coordPtr += 2) { + + /* + * If rounding is done around the first point then compute + * the distance between the point and the point. + */ + + if (((linePtr->capStyle == CapRound) && (count == numPoints)) + || ((linePtr->joinStyle == JoinRound) + && (count != numPoints))) { + dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1]) + - width/2.0; + if (dist <= 0.0) { + bestDist = 0.0; + goto done; + } else if (dist < bestDist) { + bestDist = dist; + } + } + + /* + * Compute the polygonal shape corresponding to this edge, + * consisting of two points for the first point of the edge + * and two points for the last point of the edge. + */ + + if (count == numPoints) { + TkGetButtPoints(coordPtr+2, coordPtr, width, + linePtr->capStyle == CapProjecting, poly, poly+2); + } else if ((linePtr->joinStyle == JoinMiter) && !changedMiterToBevel) { + poly[0] = poly[6]; + poly[1] = poly[7]; + poly[2] = poly[4]; + poly[3] = poly[5]; + } else { + TkGetButtPoints(coordPtr+2, coordPtr, width, 0, + poly, poly+2); + + /* + * If this line uses beveled joints, then check the distance + * to a polygon comprising the last two points of the previous + * polygon and the first two from this polygon; this checks + * the wedges that fill the mitered joint. + */ + + if ((linePtr->joinStyle == JoinBevel) || changedMiterToBevel) { + poly[8] = poly[0]; + poly[9] = poly[1]; + dist = TkPolygonToPoint(poly, 5, pointPtr); + if (dist <= 0.0) { + bestDist = 0.0; + goto done; + } else if (dist < bestDist) { + bestDist = dist; + } + changedMiterToBevel = 0; + } + } + if (count == 2) { + TkGetButtPoints(coordPtr, coordPtr+2, width, + linePtr->capStyle == CapProjecting, poly+4, poly+6); + } else if (linePtr->joinStyle == JoinMiter) { + if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, + width, poly+4, poly+6) == 0) { + changedMiterToBevel = 1; + TkGetButtPoints(coordPtr, coordPtr+2, width, + 0, poly+4, poly+6); + } + } else { + TkGetButtPoints(coordPtr, coordPtr+2, width, 0, + poly+4, poly+6); + } + poly[8] = poly[0]; + poly[9] = poly[1]; + dist = TkPolygonToPoint(poly, 5, pointPtr); + if (dist <= 0.0) { + bestDist = 0.0; + goto done; + } else if (dist < bestDist) { + bestDist = dist; + } + } + + /* + * If caps are rounded, check the distance to the cap around the + * final end point of the line. + */ + + if (linePtr->capStyle == CapRound) { + dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1]) + - width/2.0; + if (dist <= 0.0) { + bestDist = 0.0; + goto done; + } else if (dist < bestDist) { + bestDist = dist; + } + } + + /* + * If there are arrowheads, check the distance to the arrowheads. + */ + + if (linePtr->arrow != Tk_GetUid("none")) { + if (linePtr->arrow != Tk_GetUid("last")) { + dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW, + pointPtr); + if (dist <= 0.0) { + bestDist = 0.0; + goto done; + } else if (dist < bestDist) { + bestDist = dist; + } + } + if (linePtr->arrow != Tk_GetUid("first")) { + dist = TkPolygonToPoint(linePtr->lastArrowPtr, PTS_IN_ARROW, + pointPtr); + if (dist <= 0.0) { + bestDist = 0.0; + goto done; + } else if (dist < bestDist) { + bestDist = dist; + } + } + } + + done: + if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) { + ckfree((char *) linePoints); + } + return bestDist; +} + +/* + *-------------------------------------------------------------- + * + * LineToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given rectangular area. + * + * Results: + * -1 is returned if the item is entirely outside the + * area, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +LineToArea(canvas, itemPtr, rectPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against line. */ + double *rectPtr; +{ + LineItem *linePtr = (LineItem *) itemPtr; + double staticSpace[2*MAX_STATIC_POINTS]; + double *linePoints; + double width; + int numPoints, result; + + /* + * Handle smoothed lines by generating an expanded set of points + * against which to do the check. + */ + + if ((linePtr->smooth) && (linePtr->numPoints > 2)) { + numPoints = 1 + linePtr->numPoints*linePtr->splineSteps; + if (numPoints <= MAX_STATIC_POINTS) { + linePoints = staticSpace; + } else { + linePoints = (double *) ckalloc((unsigned) + (2*numPoints*sizeof(double))); + } + numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr, + linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL, + linePoints); + } else { + numPoints = linePtr->numPoints; + linePoints = linePtr->coordPtr; + } + + /* + * Check the segments of the line. + */ + + width = (double) linePtr->width; + if (width < 1.0) { + width = 1.0; + } + + result = TkThickPolyLineToArea(linePoints, numPoints, + width, linePtr->capStyle, linePtr->joinStyle, + rectPtr); + if (result == 0) { + goto done; + } + + /* + * Check arrowheads, if any. + */ + + if (linePtr->arrow != Tk_GetUid("none")) { + if (linePtr->arrow != Tk_GetUid("last")) { + if (TkPolygonToArea(linePtr->firstArrowPtr, PTS_IN_ARROW, + rectPtr) != result) { + result = 0; + goto done; + } + } + if (linePtr->arrow != Tk_GetUid("first")) { + if (TkPolygonToArea(linePtr->lastArrowPtr, PTS_IN_ARROW, + rectPtr) != result) { + result = 0; + goto done; + } + } + } + + done: + if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) { + ckfree((char *) linePoints); + } + return result; +} + +/* + *-------------------------------------------------------------- + * + * ScaleLine -- + * + * This procedure is invoked to rescale a line item. + * + * Results: + * None. + * + * Side effects: + * The line referred to by itemPtr is rescaled so that the + * following transformation is applied to all point + * coordinates: + * x' = originX + scaleX*(x-originX) + * y' = originY + scaleY*(y-originY) + * + *-------------------------------------------------------------- + */ + +static void +ScaleLine(canvas, itemPtr, originX, originY, scaleX, scaleY) + Tk_Canvas canvas; /* Canvas containing line. */ + Tk_Item *itemPtr; /* Line to be scaled. */ + double originX, originY; /* Origin about which to scale rect. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + double *coordPtr; + int i; + + /* + * Delete any arrowheads before scaling all the points (so that + * the end-points of the line get restored). + */ + + if (linePtr->firstArrowPtr != NULL) { + linePtr->coordPtr[0] = linePtr->firstArrowPtr[0]; + linePtr->coordPtr[1] = linePtr->firstArrowPtr[1]; + ckfree((char *) linePtr->firstArrowPtr); + linePtr->firstArrowPtr = NULL; + } + if (linePtr->lastArrowPtr != NULL) { + int i; + + i = 2*(linePtr->numPoints-1); + linePtr->coordPtr[i] = linePtr->lastArrowPtr[0]; + linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1]; + ckfree((char *) linePtr->lastArrowPtr); + linePtr->lastArrowPtr = NULL; + } + for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints; + i++, coordPtr += 2) { + coordPtr[0] = originX + scaleX*(*coordPtr - originX); + coordPtr[1] = originY + scaleY*(coordPtr[1] - originY); + } + if (linePtr->arrow != Tk_GetUid("none")) { + ConfigureArrows(canvas, linePtr); + } + ComputeLineBbox(canvas, linePtr); +} + +/* + *-------------------------------------------------------------- + * + * TranslateLine -- + * + * This procedure is called to move a line by a given amount. + * + * Results: + * None. + * + * Side effects: + * The position of the line is offset by (xDelta, yDelta), and + * the bounding box is updated in the generic part of the item + * structure. + * + *-------------------------------------------------------------- + */ + +static void +TranslateLine(canvas, itemPtr, deltaX, deltaY) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be + * moved. */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + double *coordPtr; + int i; + + for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints; + i++, coordPtr += 2) { + coordPtr[0] += deltaX; + coordPtr[1] += deltaY; + } + if (linePtr->firstArrowPtr != NULL) { + for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW; + i++, coordPtr += 2) { + coordPtr[0] += deltaX; + coordPtr[1] += deltaY; + } + } + if (linePtr->lastArrowPtr != NULL) { + for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW; + i++, coordPtr += 2) { + coordPtr[0] += deltaX; + coordPtr[1] += deltaY; + } + } + ComputeLineBbox(canvas, linePtr); +} + +/* + *-------------------------------------------------------------- + * + * ParseArrowShape -- + * + * This procedure is called back during option parsing to + * parse arrow shape information. + * + * Results: + * The return value is a standard Tcl result: TCL_OK means + * that the arrow shape information was parsed ok, and + * TCL_ERROR means it couldn't be parsed. + * + * Side effects: + * Arrow information in recordPtr is updated. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +ParseArrowShape(clientData, interp, tkwin, value, recordPtr, offset) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Window tkwin; /* Not used. */ + char *value; /* Textual specification of arrow shape. */ + char *recordPtr; /* Pointer to item record in which to + * store arrow information. */ + int offset; /* Offset of shape information in widget + * record. */ +{ + LineItem *linePtr = (LineItem *) recordPtr; + double a, b, c; + int argc; + char **argv = NULL; + + if (offset != Tk_Offset(LineItem, arrowShapeA)) { + panic("ParseArrowShape received bogus offset"); + } + + if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) { + syntaxError: + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad arrow shape \"", value, + "\": must be list with three numbers", (char *) NULL); + if (argv != NULL) { + ckfree((char *) argv); + } + return TCL_ERROR; + } + if (argc != 3) { + goto syntaxError; + } + if ((Tk_CanvasGetCoord(interp, linePtr->canvas, argv[0], &a) != TCL_OK) + || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[1], &b) + != TCL_OK) + || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[2], &c) + != TCL_OK)) { + goto syntaxError; + } + linePtr->arrowShapeA = (float)a; + linePtr->arrowShapeB = (float)b; + linePtr->arrowShapeC = (float)c; + ckfree((char *) argv); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * PrintArrowShape -- + * + * This procedure is a callback invoked by the configuration + * code to return a printable value describing an arrow shape. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static char * +PrintArrowShape(clientData, tkwin, recordPtr, offset, freeProcPtr) + ClientData clientData; /* Not used. */ + Tk_Window tkwin; /* Window associated with linePtr's widget. */ + char *recordPtr; /* Pointer to item record containing current + * shape information. */ + int offset; /* Offset of arrow information in record. */ + Tcl_FreeProc **freeProcPtr; /* Store address of procedure to call to + * free string here. */ +{ + LineItem *linePtr = (LineItem *) recordPtr; + char *buffer; + + buffer = (char *) ckalloc(120); + sprintf(buffer, "%.5g %.5g %.5g", linePtr->arrowShapeA, + linePtr->arrowShapeB, linePtr->arrowShapeC); + *freeProcPtr = TCL_DYNAMIC; + return buffer; +} + +/* + *-------------------------------------------------------------- + * + * ConfigureArrows -- + * + * If arrowheads have been requested for a line, this + * procedure makes arrangements for the arrowheads. + * + * Results: + * Always returns TCL_OK. + * + * Side effects: + * Information in linePtr is set up for one or two arrowheads. + * the firstArrowPtr and lastArrowPtr polygons are allocated + * and initialized, if need be, and the end points of the line + * are adjusted so that a thick line doesn't stick out past + * the arrowheads. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +ConfigureArrows(canvas, linePtr) + Tk_Canvas canvas; /* Canvas in which arrows will be + * displayed (interp and tkwin + * fields are needed). */ + LineItem *linePtr; /* Item to configure for arrows. */ +{ + double *poly, *coordPtr; + double dx, dy, length, sinTheta, cosTheta, temp; + double fracHeight; /* Line width as fraction of + * arrowhead width. */ + double backup; /* Distance to backup end points + * so the line ends in the middle + * of the arrowhead. */ + double vertX, vertY; /* Position of arrowhead vertex. */ + double shapeA, shapeB, shapeC; /* Adjusted coordinates (see + * explanation below). */ + + /* + * The code below makes a tiny increase in the shape parameters + * for the line. This is a bit of a hack, but it seems to result + * in displays that more closely approximate the specified parameters. + * Without the adjustment, the arrows come out smaller than expected. + */ + + shapeA = linePtr->arrowShapeA + 0.001; + shapeB = linePtr->arrowShapeB + 0.001; + shapeC = linePtr->arrowShapeC + linePtr->width/2.0 + 0.001; + + /* + * If there's an arrowhead on the first point of the line, compute + * its polygon and adjust the first point of the line so that the + * line doesn't stick out past the leading edge of the arrowhead. + */ + + fracHeight = (linePtr->width/2.0)/shapeC; + backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0; + if (linePtr->arrow != Tk_GetUid("last")) { + poly = linePtr->firstArrowPtr; + if (poly == NULL) { + poly = (double *) ckalloc((unsigned) + (2*PTS_IN_ARROW*sizeof(double))); + poly[0] = poly[10] = linePtr->coordPtr[0]; + poly[1] = poly[11] = linePtr->coordPtr[1]; + linePtr->firstArrowPtr = poly; + } + dx = poly[0] - linePtr->coordPtr[2]; + dy = poly[1] - linePtr->coordPtr[3]; + length = hypot(dx, dy); + if (length == 0) { + sinTheta = cosTheta = 0.0; + } else { + sinTheta = dy/length; + cosTheta = dx/length; + } + vertX = poly[0] - shapeA*cosTheta; + vertY = poly[1] - shapeA*sinTheta; + temp = shapeC*sinTheta; + poly[2] = poly[0] - shapeB*cosTheta + temp; + poly[8] = poly[2] - 2*temp; + temp = shapeC*cosTheta; + poly[3] = poly[1] - shapeB*sinTheta - temp; + poly[9] = poly[3] + 2*temp; + poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight); + poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight); + poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight); + poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight); + + /* + * Polygon done. Now move the first point towards the second so + * that the corners at the end of the line are inside the + * arrowhead. + */ + + linePtr->coordPtr[0] = poly[0] - backup*cosTheta; + linePtr->coordPtr[1] = poly[1] - backup*sinTheta; + } + + /* + * Similar arrowhead calculation for the last point of the line. + */ + + if (linePtr->arrow != Tk_GetUid("first")) { + coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2); + poly = linePtr->lastArrowPtr; + if (poly == NULL) { + poly = (double *) ckalloc((unsigned) + (2*PTS_IN_ARROW*sizeof(double))); + poly[0] = poly[10] = coordPtr[2]; + poly[1] = poly[11] = coordPtr[3]; + linePtr->lastArrowPtr = poly; + } + dx = poly[0] - coordPtr[0]; + dy = poly[1] - coordPtr[1]; + length = hypot(dx, dy); + if (length == 0) { + sinTheta = cosTheta = 0.0; + } else { + sinTheta = dy/length; + cosTheta = dx/length; + } + vertX = poly[0] - shapeA*cosTheta; + vertY = poly[1] - shapeA*sinTheta; + temp = shapeC*sinTheta; + poly[2] = poly[0] - shapeB*cosTheta + temp; + poly[8] = poly[2] - 2*temp; + temp = shapeC*cosTheta; + poly[3] = poly[1] - shapeB*sinTheta - temp; + poly[9] = poly[3] + 2*temp; + poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight); + poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight); + poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight); + poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight); + coordPtr[2] = poly[0] - backup*cosTheta; + coordPtr[3] = poly[1] - backup*sinTheta; + } + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * LineToPostscript -- + * + * This procedure is called to generate Postscript for + * line items. + * + * Results: + * The return value is a standard Tcl result. If an error + * occurs in generating Postscript then an error message is + * left in the interp's result, replacing whatever used + * to be there. If no error occurs, then Postscript for the + * item is appended to the result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +LineToPostscript(interp, canvas, itemPtr, prepass) + Tcl_Interp *interp; /* Leave Postscript or error message + * here. */ + Tk_Canvas canvas; /* Information about overall canvas. */ + Tk_Item *itemPtr; /* Item for which Postscript is + * wanted. */ + int prepass; /* 1 means this is a prepass to + * collect font information; 0 means + * final Postscript is being created. */ +{ + LineItem *linePtr = (LineItem *) itemPtr; + char buffer[64 + TCL_INTEGER_SPACE]; + char *style; + + if (linePtr->fg == NULL) { + return TCL_OK; + } + + /* + * Generate a path for the line's center-line (do this differently + * for straight lines and smoothed lines). + */ + + if ((!linePtr->smooth) || (linePtr->numPoints <= 2)) { + Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints); + } else { + if (linePtr->fillStipple == None) { + TkMakeBezierPostscript(interp, canvas, linePtr->coordPtr, + linePtr->numPoints); + } else { + /* + * Special hack: Postscript printers don't appear to be able + * to turn a path drawn with "curveto"s into a clipping path + * without exceeding resource limits, so TkMakeBezierPostscript + * won't work for stippled curves. Instead, generate all of + * the intermediate points here and output them into the + * Postscript file with "lineto"s instead. + */ + + double staticPoints[2*MAX_STATIC_POINTS]; + double *pointPtr; + int numPoints; + + numPoints = 1 + linePtr->numPoints*linePtr->splineSteps; + pointPtr = staticPoints; + if (numPoints > MAX_STATIC_POINTS) { + pointPtr = (double *) ckalloc((unsigned) + (numPoints * 2 * sizeof(double))); + } + numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr, + linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL, + pointPtr); + Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints); + if (pointPtr != staticPoints) { + ckfree((char *) pointPtr); + } + } + } + + /* + * Set other line-drawing parameters and stroke out the line. + */ + + sprintf(buffer, "%d setlinewidth\n", linePtr->width); + Tcl_AppendResult(interp, buffer, (char *) NULL); + style = "0 setlinecap\n"; + if (linePtr->capStyle == CapRound) { + style = "1 setlinecap\n"; + } else if (linePtr->capStyle == CapProjecting) { + style = "2 setlinecap\n"; + } + Tcl_AppendResult(interp, style, (char *) NULL); + style = "0 setlinejoin\n"; + if (linePtr->joinStyle == JoinRound) { + style = "1 setlinejoin\n"; + } else if (linePtr->joinStyle == JoinBevel) { + style = "2 setlinejoin\n"; + } + Tcl_AppendResult(interp, style, (char *) NULL); + if (Tk_CanvasPsColor(interp, canvas, linePtr->fg) != TCL_OK) { + return TCL_ERROR; + }; + if (linePtr->fillStipple != None) { + Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL); + if (Tk_CanvasPsStipple(interp, canvas, linePtr->fillStipple) + != TCL_OK) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "stroke\n", (char *) NULL); + } + + /* + * Output polygons for the arrowheads, if there are any. + */ + + if (linePtr->firstArrowPtr != NULL) { + if (linePtr->fillStipple != None) { + Tcl_AppendResult(interp, "grestore gsave\n", + (char *) NULL); + } + if (ArrowheadPostscript(interp, canvas, linePtr, + linePtr->firstArrowPtr) != TCL_OK) { + return TCL_ERROR; + } + } + if (linePtr->lastArrowPtr != NULL) { + if (linePtr->fillStipple != None) { + Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL); + } + if (ArrowheadPostscript(interp, canvas, linePtr, + linePtr->lastArrowPtr) != TCL_OK) { + return TCL_ERROR; + } + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ArrowheadPostscript -- + * + * This procedure is called to generate Postscript for + * an arrowhead for a line item. + * + * Results: + * The return value is a standard Tcl result. If an error + * occurs in generating Postscript then an error message is + * left in the interp's result, replacing whatever used + * to be there. If no error occurs, then Postscript for the + * arrowhead is appended to the result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +ArrowheadPostscript(interp, canvas, linePtr, arrowPtr) + Tcl_Interp *interp; /* Leave Postscript or error message + * here. */ + Tk_Canvas canvas; /* Information about overall canvas. */ + LineItem *linePtr; /* Line item for which Postscript is + * being generated. */ + double *arrowPtr; /* Pointer to first of five points + * describing arrowhead polygon. */ +{ + Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW); + if (linePtr->fillStipple != None) { + Tcl_AppendResult(interp, "clip ", (char *) NULL); + if (Tk_CanvasPsStipple(interp, canvas, linePtr->fillStipple) + != TCL_OK) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "fill\n", (char *) NULL); + } + return TCL_OK; +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvPoly.c ./canvas-tcl8.2.2/tkCanvPoly.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvPoly.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvPoly.c Thu Dec 30 14:58:04 1999 @@ -0,0 +1,999 @@ +/* + * tkCanvPoly.c -- + * + * This file implements polygon items for canvas widgets. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvPoly.c,v 1.3 1999/04/16 01:51:11 stanton Exp $ + */ + +#include +#include "tkInt.h" +#include "tkPort.h" + +/* + * The structure below defines the record for each polygon item. + */ + +typedef struct PolygonItem { + Tk_Item header; /* Generic stuff that's the same for all + * types. MUST BE FIRST IN STRUCTURE. */ + int numPoints; /* Number of points in polygon (always >= 3). + * Polygon is always closed. */ + int pointsAllocated; /* Number of points for which space is + * allocated at *coordPtr. */ + double *coordPtr; /* Pointer to malloc-ed array containing + * x- and y-coords of all points in polygon. + * X-coords are even-valued indices, y-coords + * are corresponding odd-valued indices. */ + int width; /* Width of outline. */ + XColor *outlineColor; /* Color for outline. */ + GC outlineGC; /* Graphics context for drawing outline. */ + XColor *fillColor; /* Foreground color for polygon. */ + Pixmap fillStipple; /* Stipple bitmap for filling polygon. */ + GC fillGC; /* Graphics context for filling polygon. */ + int smooth; /* Non-zero means draw shape smoothed (i.e. + * with Bezier splines). */ + int splineSteps; /* Number of steps in each spline segment. */ + int autoClosed; /* Zero means the given polygon was closed, + one means that we auto closed it. */ +} PolygonItem; + +/* + * Information used for parsing configuration specs: + */ + +static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, + Tk_CanvasTagsPrintProc, (ClientData) NULL +}; + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, + "black", Tk_Offset(PolygonItem, fillColor), TK_CONFIG_NULL_OK}, + {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(PolygonItem, outlineColor), TK_CONFIG_NULL_OK}, + {TK_CONFIG_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL, + "0", Tk_Offset(PolygonItem, smooth), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL, + "12", Tk_Offset(PolygonItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(PolygonItem, fillStipple), TK_CONFIG_NULL_OK}, + {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, + "1", Tk_Offset(PolygonItem, width), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Prototypes for procedures defined in this file: + */ + +static void ComputePolygonBbox _ANSI_ARGS_((Tk_Canvas canvas, + PolygonItem *polyPtr)); +static int ConfigurePolygon _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +static int CreatePolygon _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, struct Tk_Item *itemPtr, + int argc, char **argv)); +static void DeletePolygon _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +static void DisplayPolygon _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +static int PolygonCoords _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, + int argc, char **argv)); +static int PolygonToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *rectPtr)); +static double PolygonToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *pointPtr)); +static int PolygonToPostscript _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); +static void ScalePolygon _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +static void TranslatePolygon _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); + +/* + * The structures below defines the polygon item type by means + * of procedures that can be invoked by generic item code. + */ + +Tk_ItemType tkPolygonType = { + "polygon", /* name */ + sizeof(PolygonItem), /* itemSize */ + CreatePolygon, /* createProc */ + configSpecs, /* configSpecs */ + ConfigurePolygon, /* configureProc */ + PolygonCoords, /* coordProc */ + DeletePolygon, /* deleteProc */ + DisplayPolygon, /* displayProc */ + 0, /* alwaysRedraw */ + PolygonToPoint, /* pointProc */ + PolygonToArea, /* areaProc */ + PolygonToPostscript, /* postscriptProc */ + ScalePolygon, /* scaleProc */ + TranslatePolygon, /* translateProc */ + (Tk_ItemIndexProc *) NULL, /* indexProc */ + (Tk_ItemCursorProc *) NULL, /* icursorProc */ + (Tk_ItemSelectionProc *) NULL, /* selectionProc */ + (Tk_ItemInsertProc *) NULL, /* insertProc */ + (Tk_ItemDCharsProc *) NULL, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + +/* + * The definition below determines how large are static arrays + * used to hold spline points (splines larger than this have to + * have their arrays malloc-ed). + */ + +#define MAX_STATIC_POINTS 200 + +/* + *-------------------------------------------------------------- + * + * CreatePolygon -- + * + * This procedure is invoked to create a new polygon item in + * a canvas. + * + * Results: + * A standard Tcl return value. If an error occurred in + * creating the item, then an error message is left in + * the interp's result; in this case itemPtr is + * left uninitialized, so it can be safely freed by the + * caller. + * + * Side effects: + * A new polygon item is created. + * + *-------------------------------------------------------------- + */ + +static int +CreatePolygon(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header + * has been initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing polygon. */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + int i; + + if (argc < 6) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", + itemPtr->typePtr->name, + " x1 y1 x2 y2 x3 y3 ?x4 y4 ...? ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Carry out initialization that is needed in order to clean + * up after errors during the the remainder of this procedure. + */ + + polyPtr->numPoints = 0; + polyPtr->pointsAllocated = 0; + polyPtr->coordPtr = NULL; + polyPtr->width = 1; + polyPtr->outlineColor = NULL; + polyPtr->outlineGC = None; + polyPtr->fillColor = NULL; + polyPtr->fillStipple = None; + polyPtr->fillGC = None; + polyPtr->smooth = 0; + polyPtr->splineSteps = 12; + polyPtr->autoClosed = 0; + + /* + * Count the number of points and then parse them into a point + * array. Leading arguments are assumed to be points if they + * start with a digit or a minus sign followed by a digit. + */ + + for (i = 4; i < (argc-1); i+=2) { + if ((!isdigit(UCHAR(argv[i][0]))) && + ((argv[i][0] != '-') || (!isdigit(UCHAR(argv[i][1]))))) { + break; + } + } + if (PolygonCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) { + goto error; + } + + if (ConfigurePolygon(interp, canvas, itemPtr, argc-i, argv+i, 0) + == TCL_OK) { + return TCL_OK; + } + + error: + DeletePolygon(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * PolygonCoords -- + * + * This procedure is invoked to process the "coords" widget + * command on polygons. See the user documentation for details + * on what it does. + * + * Results: + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. + * + * Side effects: + * The coordinates for the given item may be changed. + * + *-------------------------------------------------------------- + */ + +static int +PolygonCoords(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be + * read or modified. */ + int argc; /* Number of coordinates supplied in + * argv. */ + char **argv; /* Array of coordinates: x1, y1, + * x2, y2, ... */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + char buffer[TCL_DOUBLE_SPACE]; + int i, numPoints; + + if (argc == 0) { + /* + * Print the coords used to create the polygon. If we auto + * closed the polygon then we don't report the last point. + */ + for (i = 0; i < 2*(polyPtr->numPoints - polyPtr->autoClosed); i++) { + Tcl_PrintDouble(interp, polyPtr->coordPtr[i], buffer); + Tcl_AppendElement(interp, buffer); + } + } else if (argc < 6) { + Tcl_AppendResult(interp, + "too few coordinates for polygon: must have at least 6", + (char *) NULL); + return TCL_ERROR; + } else if (argc & 1) { + Tcl_AppendResult(interp, + "odd number of coordinates specified for polygon", + (char *) NULL); + return TCL_ERROR; + } else { + numPoints = argc/2; + if (polyPtr->pointsAllocated <= numPoints) { + if (polyPtr->coordPtr != NULL) { + ckfree((char *) polyPtr->coordPtr); + } + + /* + * One extra point gets allocated here, just in case we have + * to add another point to close the polygon. + */ + + polyPtr->coordPtr = (double *) ckalloc((unsigned) + (sizeof(double) * (argc+2))); + polyPtr->pointsAllocated = numPoints+1; + } + for (i = argc-1; i >= 0; i--) { + if (Tk_CanvasGetCoord(interp, canvas, argv[i], + &polyPtr->coordPtr[i]) != TCL_OK) { + return TCL_ERROR; + } + } + polyPtr->numPoints = numPoints; + polyPtr->autoClosed = 0; + + /* + * Close the polygon if it isn't already closed. + */ + + if ((polyPtr->coordPtr[argc-2] != polyPtr->coordPtr[0]) + || (polyPtr->coordPtr[argc-1] != polyPtr->coordPtr[1])) { + polyPtr->autoClosed = 1; + polyPtr->numPoints++; + polyPtr->coordPtr[argc] = polyPtr->coordPtr[0]; + polyPtr->coordPtr[argc+1] = polyPtr->coordPtr[1]; + } + ComputePolygonBbox(canvas, polyPtr); + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ConfigurePolygon -- + * + * This procedure is invoked to configure various aspects + * of a polygon item such as its background color. + * + * Results: + * A standard Tcl result code. If an error occurs, then + * an error message is left in the interp's result. + * + * Side effects: + * Configuration information, such as colors and stipple + * patterns, may be set for itemPtr. + * + *-------------------------------------------------------------- + */ + +static int +ConfigurePolygon(interp, canvas, itemPtr, argc, argv, flags) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Polygon item to reconfigure. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments describing things to configure. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + XGCValues gcValues; + GC newGC; + unsigned long mask; + Tk_Window tkwin; + + tkwin = Tk_CanvasTkwin(canvas); + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv, + (char *) polyPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few of the options require additional processing, such as + * graphics contexts. + */ + + if (polyPtr->width < 1) { + polyPtr->width = 1; + } + if (polyPtr->outlineColor == NULL) { + newGC = None; + } else { + gcValues.foreground = polyPtr->outlineColor->pixel; + gcValues.line_width = polyPtr->width; + gcValues.cap_style = CapRound; + gcValues.join_style = JoinRound; + mask = GCForeground|GCLineWidth|GCCapStyle|GCJoinStyle; + newGC = Tk_GetGC(tkwin, mask, &gcValues); + } + if (polyPtr->outlineGC != None) { + Tk_FreeGC(Tk_Display(tkwin), polyPtr->outlineGC); + } + polyPtr->outlineGC = newGC; + + if (polyPtr->fillColor == NULL) { + newGC = None; + } else { + gcValues.foreground = polyPtr->fillColor->pixel; + mask = GCForeground; + if (polyPtr->fillStipple != None) { + gcValues.stipple = polyPtr->fillStipple; + gcValues.fill_style = FillStippled; + mask |= GCStipple|GCFillStyle; + } + newGC = Tk_GetGC(tkwin, mask, &gcValues); + } + if (polyPtr->fillGC != None) { + Tk_FreeGC(Tk_Display(tkwin), polyPtr->fillGC); + } + polyPtr->fillGC = newGC; + + /* + * Keep spline parameters within reasonable limits. + */ + + if (polyPtr->splineSteps < 1) { + polyPtr->splineSteps = 1; + } else if (polyPtr->splineSteps > 100) { + polyPtr->splineSteps = 100; + } + + ComputePolygonBbox(canvas, polyPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeletePolygon -- + * + * This procedure is called to clean up the data structure + * associated with a polygon item. + * + * Results: + * None. + * + * Side effects: + * Resources associated with itemPtr are released. + * + *-------------------------------------------------------------- + */ + +static void +DeletePolygon(canvas, itemPtr, display) + Tk_Canvas canvas; /* Info about overall canvas widget. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for + * canvas. */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + + if (polyPtr->coordPtr != NULL) { + ckfree((char *) polyPtr->coordPtr); + } + if (polyPtr->fillColor != NULL) { + Tk_FreeColor(polyPtr->fillColor); + } + if (polyPtr->fillStipple != None) { + Tk_FreeBitmap(display, polyPtr->fillStipple); + } + if (polyPtr->outlineColor != NULL) { + Tk_FreeColor(polyPtr->outlineColor); + } + if (polyPtr->outlineGC != None) { + Tk_FreeGC(display, polyPtr->outlineGC); + } + if (polyPtr->fillGC != None) { + Tk_FreeGC(display, polyPtr->fillGC); + } +} + +/* + *-------------------------------------------------------------- + * + * ComputePolygonBbox -- + * + * This procedure is invoked to compute the bounding box of + * all the pixels that may be drawn as part of a polygon. + * + * Results: + * None. + * + * Side effects: + * The fields x1, y1, x2, and y2 are updated in the header + * for itemPtr. + * + *-------------------------------------------------------------- + */ + +static void +ComputePolygonBbox(canvas, polyPtr) + Tk_Canvas canvas; /* Canvas that contains item. */ + PolygonItem *polyPtr; /* Item whose bbox is to be + * recomputed. */ +{ + double *coordPtr; + int i; + + coordPtr = polyPtr->coordPtr; + polyPtr->header.x1 = polyPtr->header.x2 = (int) *coordPtr; + polyPtr->header.y1 = polyPtr->header.y2 = (int) coordPtr[1]; + + for (i = 1, coordPtr = polyPtr->coordPtr+2; i < polyPtr->numPoints; + i++, coordPtr += 2) { + TkIncludePoint((Tk_Item *) polyPtr, coordPtr); + } + + /* + * Expand bounding box in all directions to account for the outline, + * which can stick out beyond the polygon. Add one extra pixel of + * fudge, just in case X rounds differently than we do. + */ + + i = (polyPtr->width+1)/2 + 1; + polyPtr->header.x1 -= i; + polyPtr->header.x2 += i; + polyPtr->header.y1 -= i; + polyPtr->header.y2 += i; +} + +/* + *-------------------------------------------------------------- + * + * TkFillPolygon -- + * + * This procedure is invoked to convert a polygon to screen + * coordinates and display it using a particular GC. + * + * Results: + * None. + * + * Side effects: + * ItemPtr is drawn in drawable using the transformation + * information in canvas. + * + *-------------------------------------------------------------- + */ + +void +TkFillPolygon(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC) + Tk_Canvas canvas; /* Canvas whose coordinate system + * is to be used for drawing. */ + double *coordPtr; /* Array of coordinates for polygon: + * x1, y1, x2, y2, .... */ + int numPoints; /* Twice this many coordinates are + * present at *coordPtr. */ + Display *display; /* Display on which to draw polygon. */ + Drawable drawable; /* Pixmap or window in which to draw + * polygon. */ + GC gc; /* Graphics context for drawing. */ + GC outlineGC; /* If not None, use this to draw an + * outline around the polygon after + * filling it. */ +{ + XPoint staticPoints[MAX_STATIC_POINTS]; + XPoint *pointPtr; + XPoint *pPtr; + int i; + + /* + * Build up an array of points in screen coordinates. Use a + * static array unless the polygon has an enormous number of points; + * in this case, dynamically allocate an array. + */ + + if (numPoints <= MAX_STATIC_POINTS) { + pointPtr = staticPoints; + } else { + pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint))); + } + + for (i = 0, pPtr = pointPtr; i < numPoints; i += 1, coordPtr += 2, pPtr++) { + Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1], &pPtr->x, + &pPtr->y); + } + + /* + * Display polygon, then free up polygon storage if it was dynamically + * allocated. + */ + + if (gc != None) { + XFillPolygon(display, drawable, gc, pointPtr, numPoints, Complex, + CoordModeOrigin); + } + if (outlineGC != None) { + XDrawLines(display, drawable, outlineGC, pointPtr, + numPoints, CoordModeOrigin); + } + if (pointPtr != staticPoints) { + ckfree((char *) pointPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * DisplayPolygon -- + * + * This procedure is invoked to draw a polygon item in a given + * drawable. + * + * Results: + * None. + * + * Side effects: + * ItemPtr is drawn in drawable using the transformation + * information in canvas. + * + *-------------------------------------------------------------- + */ + +static void +DisplayPolygon(canvas, itemPtr, display, drawable, x, y, width, height) + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw + * item. */ + int x, y, width, height; /* Describes region of canvas that + * must be redisplayed (not used). */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + + if ((polyPtr->fillGC == None) && (polyPtr->outlineGC == None)) { + return; + } + + /* + * If we're stippling then modify the stipple offset in the GC. Be + * sure to reset the offset when done, since the GC is supposed to be + * read-only. + */ + + if ((polyPtr->fillStipple != None) && (polyPtr->fillGC != None)) { + Tk_CanvasSetStippleOrigin(canvas, polyPtr->fillGC); + } + + if (!polyPtr->smooth) { + TkFillPolygon(canvas, polyPtr->coordPtr, polyPtr->numPoints, + display, drawable, polyPtr->fillGC, polyPtr->outlineGC); + } else { + int numPoints; + XPoint staticPoints[MAX_STATIC_POINTS]; + XPoint *pointPtr; + + /* + * This is a smoothed polygon. Display using a set of generated + * spline points rather than the original points. + */ + + numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps; + if (numPoints <= MAX_STATIC_POINTS) { + pointPtr = staticPoints; + } else { + pointPtr = (XPoint *) ckalloc((unsigned) + (numPoints * sizeof(XPoint))); + } + numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr, + polyPtr->numPoints, polyPtr->splineSteps, pointPtr, + (double *) NULL); + if (polyPtr->fillGC != None) { + XFillPolygon(display, drawable, polyPtr->fillGC, pointPtr, + numPoints, Complex, CoordModeOrigin); + } + if (polyPtr->outlineGC != None) { + XDrawLines(display, drawable, polyPtr->outlineGC, pointPtr, + numPoints, CoordModeOrigin); + } + if (pointPtr != staticPoints) { + ckfree((char *) pointPtr); + } + } + if ((polyPtr->fillStipple != None) && (polyPtr->fillGC != None)) { + XSetTSOrigin(display, polyPtr->fillGC, 0, 0); + } +} + +/* + *-------------------------------------------------------------- + * + * PolygonToPoint -- + * + * Computes the distance from a given point to a given + * polygon, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are pointPtr[0] and pointPtr[1] is inside the polygon. If the + * point isn't inside the polygon then the return value is the + * distance from the point to the polygon. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static double +PolygonToPoint(canvas, itemPtr, pointPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *pointPtr; /* Pointer to x and y coordinates. */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + double *coordPtr, distance; + double staticSpace[2*MAX_STATIC_POINTS]; + int numPoints; + + if (!polyPtr->smooth) { + distance = TkPolygonToPoint(polyPtr->coordPtr, polyPtr->numPoints, + pointPtr); + } else { + /* + * Smoothed polygon. Generate a new set of points and use them + * for comparison. + */ + + numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps; + if (numPoints <= MAX_STATIC_POINTS) { + coordPtr = staticSpace; + } else { + coordPtr = (double *) ckalloc((unsigned) + (2*numPoints*sizeof(double))); + } + numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr, + polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL, + coordPtr); + distance = TkPolygonToPoint(coordPtr, numPoints, pointPtr); + if (coordPtr != staticSpace) { + ckfree((char *) coordPtr); + } + } + if (polyPtr->outlineColor != NULL) { + distance -= polyPtr->width/2.0; + if (distance < 0) { + distance = 0; + } + } + return distance; +} + +/* + *-------------------------------------------------------------- + * + * PolygonToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given rectangular area. + * + * Results: + * -1 is returned if the item is entirely outside the area + * given by rectPtr, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +PolygonToArea(canvas, itemPtr, rectPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against polygon. */ + double *rectPtr; /* Pointer to array of four coordinates + * (x1, y1, x2, y2) describing rectangular + * area. */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + double *coordPtr, rect2[4], halfWidth; + double staticSpace[2*MAX_STATIC_POINTS]; + int numPoints, result; + + /* + * Handle smoothed polygons by generating an expanded set of points + * against which to do the check. + */ + + if (polyPtr->smooth) { + numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps; + if (numPoints <= MAX_STATIC_POINTS) { + coordPtr = staticSpace; + } else { + coordPtr = (double *) ckalloc((unsigned) + (2*numPoints*sizeof(double))); + } + numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr, + polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL, + coordPtr); + } else { + numPoints = polyPtr->numPoints; + coordPtr = polyPtr->coordPtr; + } + + if (polyPtr->width <= 1) { + /* + * The outline of the polygon doesn't stick out, so we can + * do a simple check. + */ + + result = TkPolygonToArea(coordPtr, numPoints, rectPtr); + } else { + /* + * The polygon has a wide outline, so the check is more complicated. + * First, check the line segments to see if they overlap the area. + */ + + result = TkThickPolyLineToArea(coordPtr, numPoints, + (double) polyPtr->width, CapRound, JoinRound, rectPtr); + if (result >= 0) { + goto done; + } + + /* + * There is no overlap between the polygon's outline and the + * rectangle. This means either the rectangle is entirely outside + * the polygon or entirely inside. To tell the difference, + * see whether the polygon (with 0 outline width) overlaps the + * rectangle bloated by half the outline width. + */ + + halfWidth = polyPtr->width/2.0; + rect2[0] = rectPtr[0] - halfWidth; + rect2[1] = rectPtr[1] - halfWidth; + rect2[2] = rectPtr[2] + halfWidth; + rect2[3] = rectPtr[3] + halfWidth; + if (TkPolygonToArea(coordPtr, numPoints, rect2) == -1) { + result = -1; + } else { + result = 0; + } + } + + done: + if ((coordPtr != staticSpace) && (coordPtr != polyPtr->coordPtr)) { + ckfree((char *) coordPtr); + } + return result; +} + +/* + *-------------------------------------------------------------- + * + * ScalePolygon -- + * + * This procedure is invoked to rescale a polygon item. + * + * Results: + * None. + * + * Side effects: + * The polygon referred to by itemPtr is rescaled so that the + * following transformation is applied to all point + * coordinates: + * x' = originX + scaleX*(x-originX) + * y' = originY + scaleY*(y-originY) + * + *-------------------------------------------------------------- + */ + +static void +ScalePolygon(canvas, itemPtr, originX, originY, scaleX, scaleY) + Tk_Canvas canvas; /* Canvas containing polygon. */ + Tk_Item *itemPtr; /* Polygon to be scaled. */ + double originX, originY; /* Origin about which to scale rect. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + double *coordPtr; + int i; + + for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints; + i++, coordPtr += 2) { + *coordPtr = originX + scaleX*(*coordPtr - originX); + coordPtr[1] = originY + scaleY*(coordPtr[1] - originY); + } + ComputePolygonBbox(canvas, polyPtr); +} + +/* + *-------------------------------------------------------------- + * + * TranslatePolygon -- + * + * This procedure is called to move a polygon by a given + * amount. + * + * Results: + * None. + * + * Side effects: + * The position of the polygon is offset by (xDelta, yDelta), + * and the bounding box is updated in the generic part of the + * item structure. + * + *-------------------------------------------------------------- + */ + +static void +TranslatePolygon(canvas, itemPtr, deltaX, deltaY) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be + * moved. */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + double *coordPtr; + int i; + + for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints; + i++, coordPtr += 2) { + *coordPtr += deltaX; + coordPtr[1] += deltaY; + } + ComputePolygonBbox(canvas, polyPtr); +} + +/* + *-------------------------------------------------------------- + * + * PolygonToPostscript -- + * + * This procedure is called to generate Postscript for + * polygon items. + * + * Results: + * The return value is a standard Tcl result. If an error + * occurs in generating Postscript then an error message is + * left in the interp's result, replacing whatever used + * to be there. If no error occurs, then Postscript for the + * item is appended to the result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +PolygonToPostscript(interp, canvas, itemPtr, prepass) + Tcl_Interp *interp; /* Leave Postscript or error message + * here. */ + Tk_Canvas canvas; /* Information about overall canvas. */ + Tk_Item *itemPtr; /* Item for which Postscript is + * wanted. */ + int prepass; /* 1 means this is a prepass to + * collect font information; 0 means + * final Postscript is being created. */ +{ + PolygonItem *polyPtr = (PolygonItem *) itemPtr; + + /* + * Fill the area of the polygon. + */ + + if (polyPtr->fillColor != NULL) { + if (!polyPtr->smooth) { + Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, + polyPtr->numPoints); + } else { + TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr, + polyPtr->numPoints); + } + if (Tk_CanvasPsColor(interp, canvas, polyPtr->fillColor) != TCL_OK) { + return TCL_ERROR; + } + if (polyPtr->fillStipple != None) { + Tcl_AppendResult(interp, "eoclip ", (char *) NULL); + if (Tk_CanvasPsStipple(interp, canvas, polyPtr->fillStipple) + != TCL_OK) { + return TCL_ERROR; + } + if (polyPtr->outlineColor != NULL) { + Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL); + } + } else { + Tcl_AppendResult(interp, "eofill\n", (char *) NULL); + } + } + + /* + * Now draw the outline, if there is one. + */ + + if (polyPtr->outlineColor != NULL) { + char string[32 + TCL_INTEGER_SPACE]; + + if (!polyPtr->smooth) { + Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, + polyPtr->numPoints); + } else { + TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr, + polyPtr->numPoints); + } + + sprintf(string, "%d setlinewidth\n", polyPtr->width); + Tcl_AppendResult(interp, string, + "1 setlinecap\n1 setlinejoin\n", (char *) NULL); + if (Tk_CanvasPsColor(interp, canvas, polyPtr->outlineColor) + != TCL_OK) { + return TCL_ERROR; + } + Tcl_AppendResult(interp, "stroke\n", (char *) NULL); + } + return TCL_OK; +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvPs.c ./canvas-tcl8.2.2/tkCanvPs.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvPs.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvPs.c Thu Dec 30 14:59:40 1999 @@ -0,0 +1,1508 @@ +/* + * tkCanvPs.c -- + * + * This module provides Postscript output support for canvases, + * including the "postscript" widget command plus a few utility + * procedures used for generating Postscript. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvPs.c,v 1.5 1999/04/16 01:51:11 stanton Exp $ + */ + +#include "tkInt.h" +#include "tkCanvas.h" +#include "tkPort.h" +#include "xxl_incs.h" + +/* + * See tkCanvas.h for key data structures used to implement canvases. + */ + +/* + * One of the following structures is created to keep track of Postscript + * output being generated. It consists mostly of information provided on + * the widget command line. + */ + +typedef struct TkPostscriptInfo { + int x, y, width, height; /* Area to print, in canvas pixel + * coordinates. */ + int x2, y2; /* x+width and y+height. */ + char *pageXString; /* String value of "-pagex" option or NULL. */ + char *pageYString; /* String value of "-pagey" option or NULL. */ + double pageX, pageY; /* Postscript coordinates (in points) + * corresponding to pageXString and + * pageYString. Don't forget that y-values + * grow upwards for Postscript! */ + char *pageWidthString; /* Printed width of output. */ + char *pageHeightString; /* Printed height of output. */ + double scale; /* Scale factor for conversion: each pixel + * maps into this many points. */ + Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */ + int rotate; /* Non-zero means output should be rotated + * on page (landscape mode). */ + char *fontVar; /* If non-NULL, gives name of global variable + * containing font mapping information. + * Malloc'ed. */ + char *colorVar; /* If non-NULL, give name of global variable + * containing color mapping information. + * Malloc'ed. */ + char *colorMode; /* Mode for handling colors: "monochrome", + * "gray", or "color". Malloc'ed. */ + int colorLevel; /* Numeric value corresponding to colorMode: + * 0 for mono, 1 for gray, 2 for color. */ + char *fileName; /* Name of file in which to write Postscript; + * NULL means return Postscript info as + * result. Malloc'ed. */ + char *channelName; /* If -channel is specified, the name of + * the channel to use. */ + Tcl_Channel chan; /* Open channel corresponding to fileName. */ + Tcl_HashTable fontTable; /* Hash table containing names of all font + * families used in output. The hash table + * values are not used. */ + int prepass; /* Non-zero means that we're currently in + * the pre-pass that collects font information, + * so the Postscript generated isn't + * relevant. */ +} TkPostscriptInfo; + +/* + * The table below provides a template that's used to process arguments + * to the canvas "postscript" command and fill in TkPostscriptInfo + * structures. + */ + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, colorVar), 0}, + {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, colorMode), 0}, + {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, fileName), 0}, + {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, channelName), 0}, + {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, fontVar), 0}, + {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, height), 0}, + {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0}, + {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0}, + {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0}, + {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, pageXString), 0}, + {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, pageYString), 0}, + {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, rotate), 0}, + {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, width), 0}, + {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, x), 0}, + {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, y), 0}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * The prolog data. Generated by str2c from prolog.ps + * This was split in small chunks by str2c because + * some C compiler have limitations on the size of static strings. + * (str2c is a small tcl script in tcl's tool directory (source release)) + */ +static CONST char * CONST prolog[]= { + /* Start of part 1 (2000 characters) */ + "%%BeginProlog\n\ +50 dict begin\n\ +\n\ +% This is a standard prolog for Postscript generated by Tk's canvas\n\ +% widget.\n\ +% RCS: @(#) $Id: tkCanvPs.c,v 1.5 1999/04/16 01:51:11 stanton Exp $\n\ +\n\ +% The definitions below just define all of the variables used in\n\ +% any of the procedures here. This is needed for obscure reasons\n\ +% explained on p. 716 of the Postscript manual (Section H.2.7,\n\ +% \"Initializing Variables,\" in the section on Encapsulated Postscript).\n\ +\n\ +/baseline 0 def\n\ +/stipimage 0 def\n\ +/height 0 def\n\ +/justify 0 def\n\ +/lineLength 0 def\n\ +/spacing 0 def\n\ +/stipple 0 def\n\ +/strings 0 def\n\ +/xoffset 0 def\n\ +/yoffset 0 def\n\ +/tmpstip null def\n\ +\n\ +% Define the array ISOLatin1Encoding (which specifies how characters are\n\ +% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript\n\ +% level 2 is supposed to define it, but level 1 doesn't).\n\ +\n\ +systemdict /ISOLatin1Encoding known not {\n\ + /ISOLatin1Encoding [\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\ + /quoteright\n\ + /parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\ + /zero /one /two /three /four /five /six /seven\n\ + /eight /nine /colon /semicolon /less /equal /greater /question\n\ + /at /A /B /C /D /E /F /G\n\ + /H /I /J /K /L /M /N /O\n\ + /P /Q /R /S /T /U /V /W\n\ + /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\ + /quoteleft /a /b /c /d /e /f /g\n\ + /h /i /j /k /l /m /n /o\n\ + /p /q /r /s /t /u /v /w\n\ + /x /y /z /braceleft /bar /braceright /asciitilde /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\ + /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\ + /space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\ + /dieresis /copyright /ordfem", + /* End of part 1 */ + + /* Start of part 2 (2000 characters) */ + "inine /guillemotleft /logicalnot /hyphen\n\ + /registered /macron\n\ + /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\ + /periodcentered\n\ + /cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\ + /onehalf /threequarters /questiondown\n\ + /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\ + /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\ + /Idieresis\n\ + /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\ + /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\ + /germandbls\n\ + /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\ + /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\ + /idieresis\n\ + /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\ + /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\ + /ydieresis\n\ + ] def\n\ +} if\n\ +\n\ +% font ISOEncode font\n\ +% This procedure changes the encoding of a font from the default\n\ +% Postscript encoding to ISOLatin1. It's typically invoked just\n\ +% before invoking \"setfont\". The body of this procedure comes from\n\ +% Section 5.6.1 of the Postscript book.\n\ +\n\ +/ISOEncode {\n\ + dup length dict begin\n\ + {1 index /FID ne {def} {pop pop} ifelse} forall\n\ + /Encoding ISOLatin1Encoding def\n\ + currentdict\n\ + end\n\ +\n\ + % I'm not sure why it's necessary to use \"definefont\" on this new\n\ + % font, but it seems to be important; just use the name \"Temporary\"\n\ + % for the font.\n\ +\n\ + /Temporary exch definefont\n\ +} bind def\n\ +\n\ +% StrokeClip\n\ +%\n\ +% This procedure converts the current path into a clip area under\n\ +% the assumption of stroking. It's a bit tricky because some Postscript\n\ +% interpreters get errors during strokepath for dashed lines. If\n\ +% this happens then turn off dashes and try again.\n\ +\n\ +/StrokeClip {\n\ + {strokepath} stopped {\n\ + (This Postscript printer gets limitcheck overflows when) =\n\ + (stippling dashed lines; lines will be printed solid instead.) =\n\ + [] 0 setdash strokepath} if\n\ + clip\n\ +} bind def\n\ +\n\ +% d", + /* End of part 2 */ + + /* Start of part 3 (2000 characters) */ + "esiredSize EvenPixels closestSize\n\ +%\n\ +% The procedure below is used for stippling. Given the optimal size\n\ +% of a dot in a stipple pattern in the current user coordinate system,\n\ +% compute the closest size that is an exact multiple of the device's\n\ +% pixel size. This allows stipple patterns to be displayed without\n\ +% aliasing effects.\n\ +\n\ +/EvenPixels {\n\ + % Compute exact number of device pixels per stipple dot.\n\ + dup 0 matrix currentmatrix dtransform\n\ + dup mul exch dup mul add sqrt\n\ +\n\ + % Round to an integer, make sure the number is at least 1, and compute\n\ + % user coord distance corresponding to this.\n\ + dup round dup 1 lt {pop 1} if\n\ + exch div mul\n\ +} bind def\n\ +\n\ +% width height string StippleFill --\n\ +%\n\ +% Given a path already set up and a clipping region generated from\n\ +% it, this procedure will fill the clipping region with a stipple\n\ +% pattern. \"String\" contains a proper image description of the\n\ +% stipple pattern and \"width\" and \"height\" give its dimensions. Each\n\ +% stipple dot is assumed to be about one unit across in the current\n\ +% user coordinate system. This procedure trashes the graphics state.\n\ +\n\ +/StippleFill {\n\ + % The following code is needed to work around a NeWSprint bug.\n\ +\n\ + /tmpstip 1 index def\n\ +\n\ + % Change the scaling so that one user unit in user coordinates\n\ + % corresponds to the size of one stipple dot.\n\ + 1 EvenPixels dup scale\n\ +\n\ + % Compute the bounding box occupied by the path (which is now\n\ + % the clipping region), and round the lower coordinates down\n\ + % to the nearest starting point for the stipple pattern. Be\n\ + % careful about negative numbers, since the rounding works\n\ + % differently on them.\n\ +\n\ + pathbbox\n\ + 4 2 roll\n\ + 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n\ + 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n\ +\n\ + % Stack now: width height string y1 y2 x1 x2\n\ + % Below is a doubly-nested for loop to iterate across this area\n\ + % in units of the stipple pattern size, going up columns then\n\ + % acr", + /* End of part 3 */ + + /* Start of part 4 (2000 characters) */ + "oss rows, blasting out a stipple-pattern-sized rectangle at\n\ + % each position\n\ +\n\ + 6 index exch {\n\ + 2 index 5 index 3 index {\n\ + % Stack now: width height string y1 y2 x y\n\ +\n\ + gsave\n\ + 1 index exch translate\n\ + 5 index 5 index true matrix tmpstip imagemask\n\ + grestore\n\ + } for\n\ + pop\n\ + } for\n\ + pop pop pop pop pop\n\ +} bind def\n\ +\n\ +% -- AdjustColor --\n\ +% Given a color value already set for output by the caller, adjusts\n\ +% that value to a grayscale or mono value if requested by the CL\n\ +% variable.\n\ +\n\ +/AdjustColor {\n\ + CL 2 lt {\n\ + currentgray\n\ + CL 0 eq {\n\ + .5 lt {0} {1} ifelse\n\ + } if\n\ + setgray\n\ + } if\n\ +} bind def\n\ +\n\ +% x y strings spacing xoffset yoffset justify stipple DrawText --\n\ +% This procedure does all of the real work of drawing text. The\n\ +% color and font must already have been set by the caller, and the\n\ +% following arguments must be on the stack:\n\ +%\n\ +% x, y - Coordinates at which to draw text.\n\ +% strings - An array of strings, one for each line of the text item,\n\ +% in order from top to bottom.\n\ +% spacing - Spacing between lines.\n\ +% xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\ +% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\ +% yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\ +% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\ +% justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\ +% stipple - Boolean value indicating whether or not text is to be\n\ +% drawn in stippled fashion. If text is stippled,\n\ +% procedure StippleText must have been defined to call\n\ +% StippleFill in the right way.\n\ +%\n\ +% Also, when this procedure is invoked, the color and font must already\n\ +% have been set for the text.\n\ +\n\ +/DrawText {\n\ + /stipple exch def\n\ + /justify exch def\n\ + /yoffset exch def\n\ + /xoffset exch def\n\ + /spacing exch def\n\ + /strings exch def\n\ +\n\ + % First scan through all of the text to find the widest line.\n\ +\n\ + /lineLength 0 def\n\ + strings {\n\ + stringwidth pop\n\ + dup lineLength gt {/lineLength exch def}", + /* End of part 4 */ + + /* Start of part 5 (1546 characters) */ + " {pop} ifelse\n\ + newpath\n\ + } forall\n\ +\n\ + % Compute the baseline offset and the actual font height.\n\ +\n\ + 0 0 moveto (TXygqPZ) false charpath\n\ + pathbbox dup /baseline exch def\n\ + exch pop exch sub /height exch def pop\n\ + newpath\n\ +\n\ + % Translate coordinates first so that the origin is at the upper-left\n\ + % corner of the text's bounding box. Remember that x and y for\n\ + % positioning are still on the stack.\n\ +\n\ + translate\n\ + lineLength xoffset mul\n\ + strings length 1 sub spacing mul height add yoffset mul translate\n\ +\n\ + % Now use the baseline and justification information to translate so\n\ + % that the origin is at the baseline and positioning point for the\n\ + % first line of text.\n\ +\n\ + justify lineLength mul baseline neg translate\n\ +\n\ + % Iterate over each of the lines to output it. For each line,\n\ + % compute its width again so it can be properly justified, then\n\ + % display it.\n\ +\n\ + strings {\n\ + dup stringwidth pop\n\ + justify neg mul 0 moveto\n\ + stipple {\n\ +\n\ + % The text is stippled, so turn it into a path and print\n\ + % by calling StippledText, which in turn calls StippleFill.\n\ + % Unfortunately, many Postscript interpreters will get\n\ + % overflow errors if we try to do the whole string at\n\ + % once, so do it a character at a time.\n\ +\n\ + gsave\n\ + /char (X) def\n\ + {\n\ + char 0 3 -1 roll put\n\ + currentpoint\n\ + gsave\n\ + char true charpath clip StippleText\n\ + grestore\n\ + char stringwidth translate\n\ + moveto\n\ + } forall\n\ + grestore\n\ + } {show} ifelse\n\ + 0 spacing neg translate\n\ + } forall\n\ +} bind def\n\ +\n\ +%%EndProlog\n\ +", + /* End of part 5 */ + + NULL /* End of data marker */ +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp, + char *string, double *doublePtr)); + +/* + *-------------------------------------------------------------- + * + * TkCanvPostscriptCmd -- + * + * This procedure is invoked to process the "postscript" options + * of the widget command for canvas widgets. See the user + * documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +int +TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) + TkCanvas *canvasPtr; /* Information about canvas widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. Caller has + * already parsed this command enough + * to know that argv[1] is + * "postscript". */ +{ + TkPostscriptInfo psInfo, *oldInfoPtr; + int result; + Tk_Item *itemPtr; +#define STRING_LENGTH 400 + char string[STRING_LENGTH+1], *p; + time_t now; + size_t length; + int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of + * area to be marked up, measured + * in canvas units from the positioning + * point on the page (reflects + * anchor position). Initial values + * needed only to stop compiler + * warnings. */ + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + Tcl_DString buffer; + int dx1,dx2,dy1,dy2; + CONST char * CONST *chunk; + + /* + *---------------------------------------------------------------- + * Initialize the data structure describing Postscript generation, + * then process all the arguments to fill the data structure in. + *---------------------------------------------------------------- + */ + + oldInfoPtr = canvasPtr->psInfoPtr; + canvasPtr->psInfoPtr = &psInfo; + psInfo.x = canvasPtr->xOrigin; + psInfo.y = canvasPtr->yOrigin; + psInfo.width = -1; + psInfo.height = -1; + psInfo.pageXString = NULL; + psInfo.pageYString = NULL; + psInfo.pageX = 72*4.25; + psInfo.pageY = 72*5.5; + psInfo.pageWidthString = NULL; + psInfo.pageHeightString = NULL; + psInfo.scale = 1.0; + psInfo.pageAnchor = TK_ANCHOR_CENTER; + psInfo.rotate = 0; + psInfo.fontVar = NULL; + psInfo.colorVar = NULL; + psInfo.colorMode = NULL; + psInfo.colorLevel = 0; + psInfo.fileName = NULL; + psInfo.channelName = NULL; + psInfo.chan = NULL; + psInfo.prepass = 0; + Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS); + result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin, + configSpecs, argc-2, argv+2, (char *) &psInfo, + TK_CONFIG_ARGV_ONLY); + if (result != TCL_OK) { + goto cleanup; + } + + if (psInfo.width == -1) { + psInfo.width = Tk_Width(canvasPtr->tkwin); + } + if (psInfo.height == -1) { + psInfo.height = Tk_Height(canvasPtr->tkwin); + } + psInfo.x2 = psInfo.x + psInfo.width; + psInfo.y2 = psInfo.y + psInfo.height; + + if (psInfo.pageXString != NULL) { + if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString, + &psInfo.pageX) != TCL_OK) { + goto cleanup; + } + } + if (psInfo.pageYString != NULL) { + if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString, + &psInfo.pageY) != TCL_OK) { + goto cleanup; + } + } + if (psInfo.pageWidthString != NULL) { + if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString, + &psInfo.scale) != TCL_OK) { + goto cleanup; + } + psInfo.scale /= psInfo.width; + } else if (psInfo.pageHeightString != NULL) { + if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString, + &psInfo.scale) != TCL_OK) { + goto cleanup; + } + psInfo.scale /= psInfo.height; + } else { + psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(canvasPtr->tkwin)); + psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin)); + } + switch (psInfo.pageAnchor) { + case TK_ANCHOR_NW: + case TK_ANCHOR_W: + case TK_ANCHOR_SW: + deltaX = 0; + break; + case TK_ANCHOR_N: + case TK_ANCHOR_CENTER: + case TK_ANCHOR_S: + deltaX = -psInfo.width/2; + break; + case TK_ANCHOR_NE: + case TK_ANCHOR_E: + case TK_ANCHOR_SE: + deltaX = -psInfo.width; + break; + } + switch (psInfo.pageAnchor) { + case TK_ANCHOR_NW: + case TK_ANCHOR_N: + case TK_ANCHOR_NE: + deltaY = - psInfo.height; + break; + case TK_ANCHOR_W: + case TK_ANCHOR_CENTER: + case TK_ANCHOR_E: + deltaY = -psInfo.height/2; + break; + case TK_ANCHOR_SW: + case TK_ANCHOR_S: + case TK_ANCHOR_SE: + deltaY = 0; + break; + } + + if (psInfo.colorMode == NULL) { + psInfo.colorLevel = 2; + } else { + length = strlen(psInfo.colorMode); + if (strncmp(psInfo.colorMode, "monochrome", length) == 0) { + psInfo.colorLevel = 0; + } else if (strncmp(psInfo.colorMode, "gray", length) == 0) { + psInfo.colorLevel = 1; + } else if (strncmp(psInfo.colorMode, "color", length) == 0) { + psInfo.colorLevel = 2; + } else { + Tcl_AppendResult(canvasPtr->interp, "bad color mode \"", + psInfo.colorMode, "\": must be monochrome, ", + "gray, or color", (char *) NULL); + goto cleanup; + } + } + + if (psInfo.fileName != NULL) { + + /* + * Check that -file and -channel are not both specified. + */ + + if (psInfo.channelName != NULL) { + Tcl_AppendResult(canvasPtr->interp, "can't specify both -file", + " and -channel", (char *) NULL); + result = TCL_ERROR; + goto cleanup; + } + + /* + * Check that we are not in a safe interpreter. If we are, disallow + * the -file specification. + */ + + if (Tcl_IsSafe(canvasPtr->interp)) { + Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a", + " safe interpreter", (char *) NULL); + result = TCL_ERROR; + goto cleanup; + } + + p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer); + if (p == NULL) { + goto cleanup; + } + psInfo.chan = Tcl_OpenFileChannel(canvasPtr->interp, p, "w", 0666); + Tcl_DStringFree(&buffer); + if (psInfo.chan == NULL) { + goto cleanup; + } + } + + if (psInfo.channelName != NULL) { + int mode; + + /* + * Check that the channel is found in this interpreter and that it + * is open for writing. + */ + + psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName, + &mode); + if (psInfo.chan == (Tcl_Channel) NULL) { + result = TCL_ERROR; + goto cleanup; + } + if ((mode & TCL_WRITABLE) == 0) { + Tcl_AppendResult(canvasPtr->interp, "channel \"", + psInfo.channelName, "\" wasn't opened for writing", + (char *) NULL); + result = TCL_ERROR; + goto cleanup; + } + } + + /* + *-------------------------------------------------------- + * Make a pre-pass over all of the items, generating Postscript + * and then throwing it away. The purpose of this pass is just + * to collect information about all the fonts in use, so that + * we can output font information in the proper form required + * by the Document Structuring Conventions. + *-------------------------------------------------------- + */ + + psInfo.prepass = 1; + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + computeDxy(itemPtr,canvasPtr,&dx1,&dx2,&dy1,&dy2); + if ((itemPtr->x1+dx1 >= psInfo.x2) || (itemPtr->x2+dx2 < psInfo.x) + || (itemPtr->y1+dy1 >= psInfo.y2) || (itemPtr->y2+dy2 < psInfo.y)) + { + continue; + } + if (itemPtr->typePtr->postscriptProc == NULL) { + continue; + } + computeOffset(itemPtr,canvasPtr,dx1,dx2,dy1,dy2); + result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, + (Tk_Canvas) canvasPtr, itemPtr, 1); + decomputeOffset(itemPtr,canvasPtr,dx1,dx2,dy1,dy2); + Tcl_ResetResult(canvasPtr->interp); + if (result != TCL_OK) { + /* + * An error just occurred. Just skip out of this loop. + * There's no need to report the error now; it can be + * reported later (errors can happen later that don't + * happen now, so we still have to check for errors later + * anyway). + */ + break; + } + } + psInfo.prepass = 0; + + /* + *-------------------------------------------------------- + * Generate the header and prolog for the Postscript. + *-------------------------------------------------------- + */ + + Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n", + "%%Creator: Tk Canvas Widget\n", (char *) NULL); +#ifdef HAVE_PW_GECOS + if (!Tcl_IsSafe(interp)) { + struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ + Tcl_AppendResult(canvasPtr->interp, "%%For: ", + (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", + (char *) NULL); + endpwent(); + } +#endif /* HAVE_PW_GECOS */ + Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ", + Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL); + time(&now); + Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ", + ctime(&now), (char *) NULL); /* INTL: Native. */ + if (!psInfo.rotate) { + sprintf(string, "%d %d %d %d", + (int) (psInfo.pageX + psInfo.scale*deltaX), + (int) (psInfo.pageY + psInfo.scale*deltaY), + (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width) + + 1.0), + (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height) + + 1.0)); + } else { + sprintf(string, "%d %d %d %d", + (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)), + (int) (psInfo.pageY + psInfo.scale*deltaX), + (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0), + (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width) + + 1.0)); + } + Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string, + "\n", (char *) NULL); + Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n", + "%%DocumentData: Clean7Bit\n", (char *) NULL); + Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ", + psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL); + p = "%%DocumentNeededResources: font "; + for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_AppendResult(canvasPtr->interp, p, + Tcl_GetHashKey(&psInfo.fontTable, hPtr), + "\n", (char *) NULL); + p = "%%+ font "; + } + Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL); + + /* + * Insert the prolog + */ + for (chunk=prolog; *chunk; chunk++) { + Tcl_AppendResult(interp, *chunk, (char *) NULL); + } + + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); + Tcl_ResetResult(canvasPtr->interp); + } + + /* + *----------------------------------------------------------- + * Document setup: set the color level and include fonts. + *----------------------------------------------------------- + */ + + sprintf(string, "/CL %d def\n", psInfo.colorLevel); + Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string, + (char *) NULL); + for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ", + Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL); + } + Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL); + + /* + *----------------------------------------------------------- + * Page setup: move to page positioning point, rotate if + * needed, set scale factor, offset for proper anchor position, + * and set clip region. + *----------------------------------------------------------- + */ + + Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n", + (char *) NULL); + sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); + Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL); + if (psInfo.rotate) { + Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL); + } + sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); + Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL); + sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); + Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL); + sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", + psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y), + psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y), + psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2), + psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2)); + Tcl_AppendResult(canvasPtr->interp, string, + " lineto closepath clip newpath\n", (char *) NULL); + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); + Tcl_ResetResult(canvasPtr->interp); + } + + /* + *--------------------------------------------------------------------- + * Iterate through all the items, having each relevant one draw itself. + * Quit if any of the items returns an error. + *--------------------------------------------------------------------- + */ + /* + result = TCL_OK; + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x) + || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) { + continue; + } + if (itemPtr->typePtr->postscriptProc == NULL) { + continue; + } + Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL); + result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, + (Tk_Canvas) canvasPtr, itemPtr, 0); + if (result != TCL_OK) { + char msg[64 + TCL_INTEGER_SPACE]; + + sprintf(msg, "\n (generating Postscript for item %d)", + itemPtr->id); + Tcl_AddErrorInfo(canvasPtr->interp, msg); + goto cleanup; + } + Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL); + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); + Tcl_ResetResult(canvasPtr->interp); + } + } + */ + + result = TCL_OK; + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + if (itemPtr->staticTagSpace[0] && + itemPtr->staticTagSpace[0][0] == 'Z' ){ + + /* + Now, draw the cell dividing lines AML + */ + if(!strcmp(itemPtr->staticTagSpace[0],"Zcellborders")) { + int x,i,w; + LineItem *linePtr; + linePtr = (LineItem *) itemPtr; + w = linePtr->width; + linePtr->width = 0; + linePtr->coordPtr[1] = 0; + linePtr->coordPtr[3] = y_coord(8096,canvasPtr->canvas_info); + for ( i = cell_col(psInfo.x,canvasPtr->canvas_info), + x = x_coord(i,canvasPtr->canvas_info); + x <= psInfo.x2; + i++, x = x_coord(i,canvasPtr->canvas_info)) { + linePtr->coordPtr[0] = x; + linePtr->coordPtr[2] = x; + if (itemPtr->typePtr->postscriptProc == NULL) { + continue; + } + Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL); + result = + (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, + (Tk_Canvas) canvasPtr, + itemPtr, 0); + if (result != TCL_OK) { + char msg[100]; + sprintf(msg, "\n (generating Postscript for item %d)" + , + itemPtr->id); + Tcl_AddErrorInfo(canvasPtr->interp, msg); + goto cleanup; + } + Tcl_AppendResult(canvasPtr->interp, "grestore\n", + (char *) NULL); + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan,canvasPtr->interp->result,-1); + Tcl_ResetResult(canvasPtr->interp); + } + } + linePtr->coordPtr[0] = 0; + linePtr->coordPtr[2] = x_coord(256,canvasPtr->canvas_info); + for ( i = cell_col(psInfo.y,canvasPtr->canvas_info), + x = y_coord(i,canvasPtr->canvas_info); + x <= psInfo.y2; + i++, x = y_coord(i,canvasPtr->canvas_info)) { + linePtr->coordPtr[1] = x; + linePtr->coordPtr[3] = x; + if (itemPtr->typePtr->postscriptProc == NULL) { + continue; + } + Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL); + result = + (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, + (Tk_Canvas) canvasPtr, + itemPtr, 0); + if (result != TCL_OK) { + char msg[100]; + sprintf(msg, "\n (generating Postscript for item %d)" + , + itemPtr->id); + Tcl_AddErrorInfo(canvasPtr->interp, msg); + goto cleanup; + } + Tcl_AppendResult(canvasPtr->interp, "grestore\n", + (char *) NULL); + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan,canvasPtr->interp->result,-1); + Tcl_ResetResult(canvasPtr->interp); + } + } + linePtr->width = w; + } + } + + computeDxy(itemPtr,canvasPtr,&dx1,&dx2,&dy1,&dy2); + if ((itemPtr->x1+dx1 >= psInfo.x2) || (itemPtr->x2+dx2 < psInfo.x) + || (itemPtr->y1+dy1 >= psInfo.y2) + || (itemPtr->y2+dy2 < psInfo.y)) { + continue; + } + if (itemPtr->typePtr->postscriptProc == NULL) { + continue; + } + computeOffset(itemPtr,canvasPtr,dx1,dx2,dy1,dy2); + Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL); + result = + (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, + (Tk_Canvas) canvasPtr, + itemPtr, 0); + if (result != TCL_OK) { + char msg[100]; + + sprintf(msg, "\n (generating Postscript for item %d)", + itemPtr->id); + Tcl_AddErrorInfo(canvasPtr->interp, msg); + goto cleanup; + } + Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL); + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan,canvasPtr->interp->result,-1); + Tcl_ResetResult(canvasPtr->interp); + } + decomputeOffset(itemPtr,canvasPtr,dx1,dx2,dy1,dy2); + } + + + + /* + *--------------------------------------------------------------------- + * Output page-end information, such as commands to print the page + * and document trailer stuff. + *--------------------------------------------------------------------- + */ + + Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n", + "%%Trailer\nend\n%%EOF\n", (char *) NULL); + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); + Tcl_ResetResult(canvasPtr->interp); + } + + /* + * Clean up psInfo to release malloc'ed stuff. + */ + + cleanup: + if (psInfo.pageXString != NULL) { + ckfree(psInfo.pageXString); + } + if (psInfo.pageYString != NULL) { + ckfree(psInfo.pageYString); + } + if (psInfo.pageWidthString != NULL) { + ckfree(psInfo.pageWidthString); + } + if (psInfo.pageHeightString != NULL) { + ckfree(psInfo.pageHeightString); + } + if (psInfo.fontVar != NULL) { + ckfree(psInfo.fontVar); + } + if (psInfo.colorVar != NULL) { + ckfree(psInfo.colorVar); + } + if (psInfo.colorMode != NULL) { + ckfree(psInfo.colorMode); + } + if (psInfo.fileName != NULL) { + ckfree(psInfo.fileName); + } + if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) { + Tcl_Close(canvasPtr->interp, psInfo.chan); + } + if (psInfo.channelName != NULL) { + ckfree(psInfo.channelName); + } + Tcl_DeleteHashTable(&psInfo.fontTable); + canvasPtr->psInfoPtr = oldInfoPtr; + return result; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasPsColor -- + * + * This procedure is called by individual canvas items when + * they want to set a color value for output. Given information + * about an X color, this procedure will generate Postscript + * commands to set up an appropriate color in Postscript. + * + * Results: + * Returns a standard Tcl return value. If an error occurs + * then an error message will be left in the interp's result. + * If no error occurs, then additional Postscript will be + * appended to the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Tk_CanvasPsColor(interp, canvas, colorPtr) + Tcl_Interp *interp; /* Interpreter for returning Postscript + * or error message. */ + Tk_Canvas canvas; /* Information about canvas. */ + XColor *colorPtr; /* Information about color. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; + int tmp; + double red, green, blue; + char string[200]; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + /* + * If there is a color map defined, then look up the color's name + * in the map and use the Postscript commands found there, if there + * are any. + */ + + if (psInfoPtr->colorVar != NULL) { + char *cmdString; + + cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, + Tk_NameOfColor(colorPtr), 0); + if (cmdString != NULL) { + Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL); + return TCL_OK; + } + } + + /* + * No color map entry for this color. Grab the color's intensities + * and output Postscript commands for them. Special note: X uses + * a range of 0-65535 for intensities, but most displays only use + * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the + * X scale. This means that there's no way to get perfect white, + * since the highest intensity is only 65280 out of 65535. To + * work around this problem, rescale the X intensity to a 0-255 + * scale and use that as the basis for the Postscript colors. This + * scheme still won't work if the display only uses 4 bits per color, + * but most diplays use at least 8 bits. + */ + + tmp = colorPtr->red; + red = ((double) (tmp >> 8))/255.0; + tmp = colorPtr->green; + green = ((double) (tmp >> 8))/255.0; + tmp = colorPtr->blue; + blue = ((double) (tmp >> 8))/255.0; + sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n", + red, green, blue); + Tcl_AppendResult(interp, string, (char *) NULL); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasPsFont -- + * + * This procedure is called by individual canvas items when + * they want to output text. Given information about an X + * font, this procedure will generate Postscript commands + * to set up an appropriate font in Postscript. + * + * Results: + * Returns a standard Tcl return value. If an error occurs + * then an error message will be left in the interp's result. + * If no error occurs, then additional Postscript will be + * appended to the interp's result. + * + * Side effects: + * The Postscript font name is entered into psInfoPtr->fontTable + * if it wasn't already there. + * + *-------------------------------------------------------------- + */ + +int +Tk_CanvasPsFont(interp, canvas, tkfont) + Tcl_Interp *interp; /* Interpreter for returning Postscript + * or error message. */ + Tk_Canvas canvas; /* Information about canvas. */ + Tk_Font tkfont; /* Information about font in which text + * is to be printed. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; + char *end; + char pointString[TCL_INTEGER_SPACE]; + Tcl_DString ds; + int i, points; + + /* + * First, look up the font's name in the font map, if there is one. + * If there is an entry for this font, it consists of a list + * containing font name and size. Use this information. + */ + + Tcl_DStringInit(&ds); + + if (psInfoPtr->fontVar != NULL) { + char *list, **argv; + int argc; + double size; + char *name; + + name = Tk_NameOfFont(tkfont); + list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0); + if (list != NULL) { + if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) { + badMapEntry: + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad font map entry for \"", name, + "\": \"", list, "\"", (char *) NULL); + return TCL_ERROR; + } + if (argc != 2) { + goto badMapEntry; + } + size = strtod(argv[1], &end); + if ((size <= 0) || (*end != 0)) { + goto badMapEntry; + } + + Tcl_DStringAppend(&ds, argv[0], -1); + points = (int) size; + + ckfree((char *) argv); + goto findfont; + } + } + + points = Tk_PostscriptFontName(tkfont, &ds); + + findfont: + sprintf(pointString, "%d", points); + Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ", + pointString, " scalefont ", (char *) NULL); + if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) { + Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL); + } + Tcl_AppendResult(interp, "setfont\n", (char *) NULL); + Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); + Tcl_DStringFree(&ds); + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasPsBitmap -- + * + * This procedure is called to output the contents of a + * sub-region of a bitmap in proper image data format for + * Postscript (i.e. data between angle brackets, one bit + * per pixel). + * + * Results: + * Returns a standard Tcl return value. If an error occurs + * then an error message will be left in the interp's result. + * If no error occurs, then additional Postscript will be + * appended to the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height) + Tcl_Interp *interp; /* Interpreter for returning Postscript + * or error message. */ + Tk_Canvas canvas; /* Information about canvas. */ + Pixmap bitmap; /* Bitmap for which to generate + * Postscript. */ + int startX, startY; /* Coordinates of upper-left corner + * of rectangular region to output. */ + int width, height; /* Height of rectangular region. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; + XImage *imagePtr; + int charsInLine, x, y, lastX, lastY, value, mask; + unsigned int totalWidth, totalHeight; + char string[100]; + Window dummyRoot; + int dummyX, dummyY; + unsigned dummyBorderwidth, dummyDepth; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + /* + * The following call should probably be a call to Tk_SizeOfBitmap + * instead, but it seems that we are occasionally invoked by custom + * item types that create their own bitmaps without registering them + * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but + * it shouldn't matter here. + */ + + XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot, + (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth, + (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); + imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0, + totalWidth, totalHeight, 1, XYPixmap); + Tcl_AppendResult(interp, "<", (char *) NULL); + mask = 0x80; + value = 0; + charsInLine = 0; + lastX = startX + width - 1; + lastY = startY + height - 1; + for (y = lastY; y >= startY; y--) { + for (x = startX; x <= lastX; x++) { + if (XGetPixel(imagePtr, x, y)) { + value |= mask; + } + mask >>= 1; + if (mask == 0) { + sprintf(string, "%02x", value); + Tcl_AppendResult(interp, string, (char *) NULL); + mask = 0x80; + value = 0; + charsInLine += 2; + if (charsInLine >= 60) { + Tcl_AppendResult(interp, "\n", (char *) NULL); + charsInLine = 0; + } + } + } + if (mask != 0x80) { + sprintf(string, "%02x", value); + Tcl_AppendResult(interp, string, (char *) NULL); + mask = 0x80; + value = 0; + charsInLine += 2; + } + } + Tcl_AppendResult(interp, ">", (char *) NULL); + XDestroyImage(imagePtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasPsStipple -- + * + * This procedure is called by individual canvas items when + * they have created a path that they'd like to be filled with + * a stipple pattern. Given information about an X bitmap, + * this procedure will generate Postscript commands to fill + * the current clip region using a stipple pattern defined by the + * bitmap. + * + * Results: + * Returns a standard Tcl return value. If an error occurs + * then an error message will be left in the interp's result. + * If no error occurs, then additional Postscript will be + * appended to the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Tk_CanvasPsStipple(interp, canvas, bitmap) + Tcl_Interp *interp; /* Interpreter for returning Postscript + * or error message. */ + Tk_Canvas canvas; /* Information about canvas. */ + Pixmap bitmap; /* Bitmap to use for stippling. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; + int width, height; + char string[TCL_INTEGER_SPACE * 2]; + Window dummyRoot; + int dummyX, dummyY; + unsigned dummyBorderwidth, dummyDepth; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + /* + * The following call should probably be a call to Tk_SizeOfBitmap + * instead, but it seems that we are occasionally invoked by custom + * item types that create their own bitmaps without registering them + * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but + * it shouldn't matter here. + */ + + XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot, + (int *) &dummyX, (int *) &dummyY, (unsigned *) &width, + (unsigned *) &height, &dummyBorderwidth, &dummyDepth); + sprintf(string, "%d %d ", width, height); + Tcl_AppendResult(interp, string, (char *) NULL); + if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0, + width, height) != TCL_OK) { + return TCL_ERROR; + } + Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasPsY -- + * + * Given a y-coordinate in canvas coordinates, this procedure + * returns a y-coordinate to use for Postscript output. + * + * Results: + * Returns the Postscript coordinate that corresponds to + * "y". + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +double +Tk_CanvasPsY(canvas, y) + Tk_Canvas canvas; /* Token for canvas on whose behalf + * Postscript is being generated. */ + double y; /* Y-coordinate in canvas coords. */ +{ + TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr; + + return psInfoPtr->y2 - y; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasPsPath -- + * + * Given an array of points for a path, generate Postscript + * commands to create the path. + * + * Results: + * Postscript commands get appended to what's in the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints) + Tcl_Interp *interp; /* Put generated Postscript in this + * interpreter's result field. */ + Tk_Canvas canvas; /* Canvas on whose behalf Postscript + * is being generated. */ + double *coordPtr; /* Pointer to first in array of + * 2*numPoints coordinates giving + * points for path. */ + int numPoints; /* Number of points at *coordPtr. */ +{ + TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr; + char buffer[200]; + + if (psInfoPtr->prepass) { + return; + } + sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], + Tk_CanvasPsY(canvas, coordPtr[1])); + Tcl_AppendResult(interp, buffer, (char *) NULL); + for (numPoints--, coordPtr += 2; numPoints > 0; + numPoints--, coordPtr += 2) { + sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], + Tk_CanvasPsY(canvas, coordPtr[1])); + Tcl_AppendResult(interp, buffer, (char *) NULL); + } +} + +/* + *-------------------------------------------------------------- + * + * GetPostscriptPoints -- + * + * Given a string, returns the number of Postscript points + * corresponding to that string. + * + * Results: + * The return value is a standard Tcl return result. If + * TCL_OK is returned, then everything went well and the + * screen distance is stored at *doublePtr; otherwise + * TCL_ERROR is returned and an error message is left in + * the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +GetPostscriptPoints(interp, string, doublePtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + char *string; /* String describing a screen distance. */ + double *doublePtr; /* Place to store converted result. */ +{ + char *end; + double d; + + d = strtod(string, &end); + if (end == string) { + error: + Tcl_AppendResult(interp, "bad distance \"", string, + "\"", (char *) NULL); + return TCL_ERROR; + } + while ((*end != '\0') && isspace(UCHAR(*end))) { + end++; + } + switch (*end) { + case 'c': + d *= 72.0/2.54; + end++; + break; + case 'i': + d *= 72.0; + end++; + break; + case 'm': + d *= 72.0/25.4; + end++; + break; + case 0: + break; + case 'p': + end++; + break; + default: + goto error; + } + while ((*end != '\0') && isspace(UCHAR(*end))) { + end++; + } + if (*end != 0) { + goto error; + } + *doublePtr = d; + return TCL_OK; +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvText.c ./canvas-tcl8.2.2/tkCanvText.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvText.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvText.c Thu Dec 30 15:32:44 1999 @@ -0,0 +1,1302 @@ +/* + * tkCanvText.c -- + * + * This file implements text items for canvas widgets. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvText.c,v 1.6 1999/04/21 21:53:24 rjohnson Exp $ + */ + +#include +#include "tkInt.h" +#include "tkCanvas.h" +#include "tkPort.h" +#include "xxl_incs.h" +#include "default.h" + +/* + * Information used for parsing configuration specs: + */ + +static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, + Tk_CanvasTagsPrintProc, (ClientData) NULL +}; + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL, + "center", Tk_Offset(TextItem, anchor), + TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, + "black", Tk_Offset(TextItem, color), TK_CONFIG_NULL_OK}, + {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, + DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0}, + {TK_CONFIG_JUSTIFY, "-justify", (char *) NULL, (char *) NULL, + "left", Tk_Offset(TextItem, justify), + TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK}, + {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_STRING, "-text", (char *) NULL, (char *) NULL, + "", Tk_Offset(TextItem, text), 0}, + {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, + "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Prototypes for procedures defined in this file: + */ + +static void ComputeTextBbox _ANSI_ARGS_((Tk_Canvas canvas, + TextItem *textPtr)); +static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +static int CreateText _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, struct Tk_Item *itemPtr, + int argc, char **argv)); +static void DeleteText _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +static void DisplayCanvText _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +static int GetSelText _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, int offset, char *buffer, + int maxBytes)); +static int GetTextIndex _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, + char *indexString, int *indexPtr)); +static void ScaleText _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +static void SetTextCursor _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, int index)); +static int TextCoords _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, + int argc, char **argv)); +static void TextDeleteChars _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, int first, int last)); +static void TextInsert _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, int beforeThis, char *string)); +static int TextToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *rectPtr)); +static double TextToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *pointPtr)); +static int TextToPostscript _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); +static void TranslateText _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); + +/* + * The structures below defines the rectangle and oval item types + * by means of procedures that can be invoked by generic item code. + */ + +Tk_ItemType tkTextType = { + "text", /* name */ + sizeof(TextItem), /* itemSize */ + CreateText, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureText, /* configureProc */ + TextCoords, /* coordProc */ + DeleteText, /* deleteProc */ + DisplayCanvText, /* displayProc */ + 0, /* alwaysRedraw */ + TextToPoint, /* pointProc */ + TextToArea, /* areaProc */ + TextToPostscript, /* postscriptProc */ + ScaleText, /* scaleProc */ + TranslateText, /* translateProc */ + GetTextIndex, /* indexProc */ + SetTextCursor, /* icursorProc */ + GetSelText, /* selectionProc */ + TextInsert, /* insertProc */ + TextDeleteChars, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + +/* + *-------------------------------------------------------------- + * + * CreateText -- + * + * This procedure is invoked to create a new text item + * in a canvas. + * + * Results: + * A standard Tcl return value. If an error occurred in + * creating the item then an error message is left in + * the interp's result; in this case itemPtr is left uninitialized + * so it can be safely freed by the caller. + * + * Side effects: + * A new text item is created. + * + *-------------------------------------------------------------- + */ + +static int +CreateText(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header has been + * initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing rectangle. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", + itemPtr->typePtr->name, " x y ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Carry out initialization that is needed in order to clean up after + * errors during the the remainder of this procedure. + */ + + textPtr->textInfoPtr = Tk_CanvasGetTextInfo(canvas); + + textPtr->insertPos = 0; + + textPtr->anchor = TK_ANCHOR_CENTER; + textPtr->color = NULL; + textPtr->tkfont = NULL; + textPtr->justify = TK_JUSTIFY_LEFT; + textPtr->stipple = None; + textPtr->text = NULL; + textPtr->width = 0; + + textPtr->numChars = 0; + textPtr->numBytes = 0; + textPtr->textLayout = NULL; + textPtr->leftEdge = 0; + textPtr->rightEdge = 0; + textPtr->gc = None; + textPtr->selTextGC = None; + textPtr->cursorOffGC = None; + + /* + * Process the arguments to fill in the item record. + */ + + if(argv[2][0]!= 'X') /* elementos normais */ + { + if ((Tk_CanvasGetCoord(interp,canvas,argv[0],&textPtr->x)!=TCL_OK) + ||(Tk_CanvasGetCoord(interp,canvas,argv[1],&textPtr->y)!=TCL_OK)) + return TCL_ERROR; + + textPtr->col = atoi(argv[0]); + textPtr->row = atoi(argv[1]); + textPtr->x = 0; + textPtr->y = 0; + + if (ConfigureText(interp, canvas, itemPtr, argc-2, argv+2, 0)!=TCL_OK) + { + DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; + } + } + else /* elementos graficos */ + { + if ((Tk_CanvasGetCoord(interp, canvas, argv[3], &textPtr->x) != TCL_OK) + ||(Tk_CanvasGetCoord(interp,canvas,argv[4],&textPtr->y)!= TCL_OK)) + return TCL_ERROR; + + textPtr->col = atoi(argv[0]); + textPtr->row = atoi(argv[1]); + + if (ConfigureText(interp,canvas,itemPtr,argc-5,argv+5,0) != TCL_OK) + { + DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; + } + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * TextCoords -- + * + * This procedure is invoked to process the "coords" widget + * command on text items. See the user documentation for + * details on what it does. + * + * Results: + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. + * + * Side effects: + * The coordinates for the given item may be changed. + * + *-------------------------------------------------------------- + */ + +static int +TextCoords(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be read or + * modified. */ + int argc; /* Number of coordinates supplied in argv. */ + char **argv; /* Array of coordinates: x1, y1, x2, y2, ... */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE]; + + if (argc == 0) { + Tcl_PrintDouble(interp, textPtr->x, x); + Tcl_PrintDouble(interp, textPtr->y, y); + Tcl_AppendResult(interp, x, " ", y, (char *) NULL); + } else if (argc == 2) { + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &textPtr->x) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], + &textPtr->y) != TCL_OK)) { + return TCL_ERROR; + } + ComputeTextBbox(canvas, textPtr); + } else { + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ConfigureText -- + * + * This procedure is invoked to configure various aspects + * of a text item, such as its border and background colors. + * + * Results: + * A standard Tcl result code. If an error occurs, then + * an error message is left in the interp's result. + * + * Side effects: + * Configuration information, such as colors and stipple + * patterns, may be set for itemPtr. + * + *-------------------------------------------------------------- + */ + +static int +ConfigureText(interp, canvas, itemPtr, argc, argv, flags) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Rectangle item to reconfigure. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments describing things to configure. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + XGCValues gcValues; + GC newGC, newSelGC; + unsigned long mask; + Tk_Window tkwin; + Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; + XColor *selBgColorPtr; + + tkwin = Tk_CanvasTkwin(canvas); + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv, + (char *) textPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few of the options require additional processing, such as + * graphics contexts. + */ + + newGC = newSelGC = None; + if ((textPtr->color != NULL) && (textPtr->tkfont != NULL)) { + gcValues.foreground = textPtr->color->pixel; + gcValues.font = Tk_FontId(textPtr->tkfont); + mask = GCForeground|GCFont; + if (textPtr->stipple != None) { + gcValues.stipple = textPtr->stipple; + gcValues.fill_style = FillStippled; + mask |= GCForeground|GCStipple|GCFillStyle; + } + newGC = Tk_GetGC(tkwin, mask, &gcValues); + gcValues.foreground = textInfoPtr->selFgColorPtr->pixel; + newSelGC = Tk_GetGC(tkwin, mask, &gcValues); + } + if (textPtr->gc != None) { + Tk_FreeGC(Tk_Display(tkwin), textPtr->gc); + } + textPtr->gc = newGC; + if (textPtr->selTextGC != None) { + Tk_FreeGC(Tk_Display(tkwin), textPtr->selTextGC); + } + textPtr->selTextGC = newSelGC; + + selBgColorPtr = Tk_3DBorderColor(textInfoPtr->selBorder); + if (Tk_3DBorderColor(textInfoPtr->insertBorder)->pixel + == selBgColorPtr->pixel) { + if (selBgColorPtr->pixel == BlackPixelOfScreen(Tk_Screen(tkwin))) { + gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin)); + } else { + gcValues.foreground = BlackPixelOfScreen(Tk_Screen(tkwin)); + } + newGC = Tk_GetGC(tkwin, GCForeground, &gcValues); + } else { + newGC = None; + } + if (textPtr->cursorOffGC != None) { + Tk_FreeGC(Tk_Display(tkwin), textPtr->cursorOffGC); + } + textPtr->cursorOffGC = newGC; + + + /* + * If the text was changed, move the selection and insertion indices + * to keep them inside the item. + */ + + textPtr->numBytes = strlen(textPtr->text); + textPtr->numChars = Tcl_NumUtfChars(textPtr->text, textPtr->numBytes); + if (textInfoPtr->selItemPtr == itemPtr) { + + if (textInfoPtr->selectFirst >= textPtr->numChars) { + textInfoPtr->selItemPtr = NULL; + } else { + if (textInfoPtr->selectLast >= textPtr->numChars) { + textInfoPtr->selectLast = textPtr->numChars - 1; + } + if ((textInfoPtr->anchorItemPtr == itemPtr) + && (textInfoPtr->selectAnchor >= textPtr->numChars)) { + textInfoPtr->selectAnchor = textPtr->numChars - 1; + } + } + } + if (textPtr->insertPos >= textPtr->numChars) { + textPtr->insertPos = textPtr->numChars; + } + + ComputeTextBbox(canvas, textPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeleteText -- + * + * This procedure is called to clean up the data structure + * associated with a text item. + * + * Results: + * None. + * + * Side effects: + * Resources associated with itemPtr are released. + * + *-------------------------------------------------------------- + */ + +static void +DeleteText(canvas, itemPtr, display) + Tk_Canvas canvas; /* Info about overall canvas widget. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for canvas. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + + if (textPtr->color != NULL) { + Tk_FreeColor(textPtr->color); + } + Tk_FreeFont(textPtr->tkfont); + if (textPtr->stipple != None) { + Tk_FreeBitmap(display, textPtr->stipple); + } + if (textPtr->text != NULL) { + ckfree(textPtr->text); + } + + Tk_FreeTextLayout(textPtr->textLayout); + if (textPtr->gc != None) { + Tk_FreeGC(display, textPtr->gc); + } + if (textPtr->selTextGC != None) { + Tk_FreeGC(display, textPtr->selTextGC); + } + if (textPtr->cursorOffGC != None) { + Tk_FreeGC(display, textPtr->cursorOffGC); + } +} + +/* + *-------------------------------------------------------------- + * + * ComputeTextBbox -- + * + * This procedure is invoked to compute the bounding box of + * all the pixels that may be drawn as part of a text item. + * In addition, it recomputes all of the geometry information + * used to display a text item or check for mouse hits. + * + * Results: + * None. + * + * Side effects: + * The fields x1, y1, x2, and y2 are updated in the header + * for itemPtr, and the linePtr structure is regenerated + * for itemPtr. + * + *-------------------------------------------------------------- + */ + +static void +ComputeTextBbox(canvas, textPtr) + Tk_Canvas canvas; /* Canvas that contains item. */ + TextItem *textPtr; /* Item whose bbox is to be recomputed. */ +{ + Tk_CanvasTextInfo *textInfoPtr; + int leftX, topY, width, height, fudge; + + Tk_FreeTextLayout(textPtr->textLayout); + textPtr->textLayout = Tk_ComputeTextLayout(textPtr->tkfont, + textPtr->text, textPtr->numChars, textPtr->width, + textPtr->justify, 0, &width, &height); + + /* + * Use overall geometry information to compute the top-left corner + * of the bounding box for the text item. + */ + + leftX = (int) (textPtr->x + 0.5); + topY = (int) (textPtr->y + 0.5); + switch (textPtr->anchor) { + case TK_ANCHOR_NW: + case TK_ANCHOR_N: + case TK_ANCHOR_NE: + break; + + case TK_ANCHOR_W: + case TK_ANCHOR_CENTER: + case TK_ANCHOR_E: + topY -= height / 2; + break; + + case TK_ANCHOR_SW: + case TK_ANCHOR_S: + case TK_ANCHOR_SE: + topY -= height; + break; + } + switch (textPtr->anchor) { + case TK_ANCHOR_NW: + case TK_ANCHOR_W: + case TK_ANCHOR_SW: + break; + + case TK_ANCHOR_N: + case TK_ANCHOR_CENTER: + case TK_ANCHOR_S: + leftX -= width / 2; + break; + + case TK_ANCHOR_NE: + case TK_ANCHOR_E: + case TK_ANCHOR_SE: + leftX -= width; + break; + } + + textPtr->leftEdge = leftX; + textPtr->rightEdge = leftX + width; + + /* + * Last of all, update the bounding box for the item. The item's + * bounding box includes the bounding box of all its lines, plus + * an extra fudge factor for the cursor border (which could + * potentially be quite large). + */ + + textInfoPtr = textPtr->textInfoPtr; + fudge = (textInfoPtr->insertWidth + 1) / 2; + if (textInfoPtr->selBorderWidth > fudge) { + fudge = textInfoPtr->selBorderWidth; + } + textPtr->header.x1 = leftX - fudge; + textPtr->header.y1 = topY; + textPtr->header.x2 = leftX + width + fudge; + textPtr->header.y2 = topY + height; +} + +/* + *-------------------------------------------------------------- + * + * DisplayCanvText -- + * + * This procedure is invoked to draw a text item in a given + * drawable. + * + * Results: + * None. + * + * Side effects: + * ItemPtr is drawn in drawable using the transformation + * information in canvas. + * + *-------------------------------------------------------------- + */ + +static void +DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height) + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw item. */ + int x, y, width, height; /* Describes region of canvas that must be + * redisplayed (not used). */ +{ + TextItem *textPtr; + Tk_CanvasTextInfo *textInfoPtr; + int selFirstChar, selLastChar; + short drawableX, drawableY; + + textPtr = (TextItem *) itemPtr; + textInfoPtr = textPtr->textInfoPtr; + + if (textPtr->gc == None) { + return; + } + + /* + * If we're stippling, then modify the stipple offset in the GC. Be + * sure to reset the offset when done, since the GC is supposed to be + * read-only. + */ + + if (textPtr->stipple != None) { + Tk_CanvasSetStippleOrigin(canvas, textPtr->gc); + } + + selFirstChar = -1; + selLastChar = 0; /* lint. */ + + if (textInfoPtr->selItemPtr == itemPtr) { + char *text; + + text = textPtr->text; + selFirstChar = textInfoPtr->selectFirst; + selLastChar = textInfoPtr->selectLast; + if (selLastChar > textPtr->numChars) { + selLastChar = textPtr->numChars - 1; + } + if ((selFirstChar >= 0) && (selFirstChar <= selLastChar)) { + int xFirst, yFirst, hFirst; + int xLast, yLast; + + /* + * Draw a special background under the selection. + */ + + Tk_CharBbox(textPtr->textLayout, selFirstChar, &xFirst, &yFirst, + NULL, &hFirst); + Tk_CharBbox(textPtr->textLayout, selLastChar, &xLast, &yLast, + NULL, NULL); + + /* + * If the selection spans the end of this line, then display + * selection background all the way to the end of the line. + * However, for the last line we only want to display up to the + * last character, not the end of the line. + */ + + x = xFirst; + height = hFirst; + for (y = yFirst ; y <= yLast; y += height) { + if (y == yLast) { + width = xLast - x; + } else { + width = textPtr->rightEdge - textPtr->leftEdge - x; + } + Tk_CanvasDrawableCoords(canvas, + (double) (textPtr->leftEdge + x + - textInfoPtr->selBorderWidth), + (double) (textPtr->header.y1 + y), + &drawableX, &drawableY); + Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable, + textInfoPtr->selBorder, drawableX, drawableY, + width + 2 * textInfoPtr->selBorderWidth, + height, textInfoPtr->selBorderWidth, TK_RELIEF_RAISED); + x = 0; + } + } + } + + /* + * If the insertion point should be displayed, then draw a special + * background for the cursor before drawing the text. Note: if + * we're the cursor item but the cursor is turned off, then redraw + * background over the area of the cursor. This guarantees that + * the selection won't make the cursor invisible on mono displays, + * where both are drawn in the same color. + */ + + if ((textInfoPtr->focusItemPtr == itemPtr) && (textInfoPtr->gotFocus)) { + if (Tk_CharBbox(textPtr->textLayout, textPtr->insertPos, + &x, &y, NULL, &height)) { + Tk_CanvasDrawableCoords(canvas, + (double) (textPtr->leftEdge + x + - (textInfoPtr->insertWidth / 2)), + (double) (textPtr->header.y1 + y), + &drawableX, &drawableY); + if (textInfoPtr->cursorOn) { + Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable, + textInfoPtr->insertBorder, + drawableX, drawableY, + textInfoPtr->insertWidth, height, + textInfoPtr->insertBorderWidth, TK_RELIEF_RAISED); + } else if (textPtr->cursorOffGC != None) { + /* + * Redraw the background over the area of the cursor, + * even though the cursor is turned off. This + * guarantees that the selection won't make the cursor + * invisible on mono displays, where both may be drawn + * in the same color. + */ + + XFillRectangle(display, drawable, textPtr->cursorOffGC, + drawableX, drawableY, + (unsigned) textInfoPtr->insertWidth, + (unsigned) height); + } + } + } + + + /* + * Display the text in two pieces: draw the entire text item, then + * draw the selected text on top of it. The selected text then + * will only need to be drawn if it has different attributes (such + * as foreground color) than regular text. + */ + + Tk_CanvasDrawableCoords(canvas, (double) textPtr->leftEdge, + (double) textPtr->header.y1, &drawableX, &drawableY); + Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout, + drawableX, drawableY, 0, -1); + + if ((selFirstChar >= 0) && (textPtr->selTextGC != textPtr->gc)) { + Tk_DrawTextLayout(display, drawable, textPtr->selTextGC, + textPtr->textLayout, drawableX, drawableY, selFirstChar, + selLastChar + 1); + } + + if (textPtr->stipple != None) { + XSetTSOrigin(display, textPtr->gc, 0, 0); + } +} + +/* + *-------------------------------------------------------------- + * + * TextInsert -- + * + * Insert characters into a text item at a given position. + * + * Results: + * None. + * + * Side effects: + * The text in the given item is modified. The cursor and + * selection positions are also modified to reflect the + * insertion. + * + *-------------------------------------------------------------- + */ + +static void +TextInsert(canvas, itemPtr, index, string) + Tk_Canvas canvas; /* Canvas containing text item. */ + Tk_Item *itemPtr; /* Text item to be modified. */ + int index; /* Character index before which string is + * to be inserted. */ + char *string; /* New characters to be inserted. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + int byteIndex, byteCount, charsAdded; + char *new, *text; + Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; + + text = textPtr->text; + + if (index < 0) { + index = 0; + } + if (index > textPtr->numChars) { + index = textPtr->numChars; + } + byteIndex = Tcl_UtfAtIndex(text, index) - text; + byteCount = strlen(string); + if (byteCount == 0) { + return; + } + + new = (char *) ckalloc((unsigned) textPtr->numBytes + byteCount + 1); + memcpy(new, text, (size_t) byteIndex); + strcpy(new + byteIndex, string); + strcpy(new + byteIndex + byteCount, text + byteIndex); + + ckfree(text); + textPtr->text = new; + charsAdded = Tcl_NumUtfChars(string, byteCount); + textPtr->numChars += charsAdded; + textPtr->numBytes += byteCount; + + /* + * Inserting characters invalidates indices such as those for the + * selection and cursor. Update the indices appropriately. + */ + + if (textInfoPtr->selItemPtr == itemPtr) { + if (textInfoPtr->selectFirst >= index) { + textInfoPtr->selectFirst += charsAdded; + } + if (textInfoPtr->selectLast >= index) { + textInfoPtr->selectLast += charsAdded; + } + if ((textInfoPtr->anchorItemPtr == itemPtr) + && (textInfoPtr->selectAnchor >= index)) { + textInfoPtr->selectAnchor += charsAdded; + } + } + if (textPtr->insertPos >= index) { + textPtr->insertPos += charsAdded; + } + ComputeTextBbox(canvas, textPtr); +} + +/* + *-------------------------------------------------------------- + * + * TextDeleteChars -- + * + * Delete one or more characters from a text item. + * + * Results: + * None. + * + * Side effects: + * Characters between "first" and "last", inclusive, get + * deleted from itemPtr, and things like the selection + * position get updated. + * + *-------------------------------------------------------------- + */ + +static void +TextDeleteChars(canvas, itemPtr, first, last) + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Item in which to delete characters. */ + int first; /* Character index of first character to + * delete. */ + int last; /* Character index of last character to + * delete (inclusive). */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + int byteIndex, byteCount, charsRemoved; + char *new, *text; + Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; + + text = textPtr->text; + if (first < 0) { + first = 0; + } + if (last >= textPtr->numChars) { + last = textPtr->numChars - 1; + } + if (first > last) { + return; + } + charsRemoved = last + 1 - first; + + byteIndex = Tcl_UtfAtIndex(text, first) - text; + byteCount = Tcl_UtfAtIndex(text + byteIndex, charsRemoved) + - (text + byteIndex); + + new = (char *) ckalloc((unsigned) (textPtr->numBytes + 1 - byteCount)); + memcpy(new, text, (size_t) byteIndex); + strcpy(new + byteIndex, text + byteIndex + byteCount); + + ckfree(text); + textPtr->text = new; + textPtr->numChars -= charsRemoved; + textPtr->numBytes -= byteCount; + + /* + * Update indexes for the selection and cursor to reflect the + * renumbering of the remaining characters. + */ + + if (textInfoPtr->selItemPtr == itemPtr) { + if (textInfoPtr->selectFirst > first) { + textInfoPtr->selectFirst -= charsRemoved; + if (textInfoPtr->selectFirst < first) { + textInfoPtr->selectFirst = first; + } + } + if (textInfoPtr->selectLast >= first) { + textInfoPtr->selectLast -= charsRemoved; + if (textInfoPtr->selectLast < first - 1) { + textInfoPtr->selectLast = first - 1; + } + } + if (textInfoPtr->selectFirst > textInfoPtr->selectLast) { + textInfoPtr->selItemPtr = NULL; + } + if ((textInfoPtr->anchorItemPtr == itemPtr) + && (textInfoPtr->selectAnchor > first)) { + textInfoPtr->selectAnchor -= charsRemoved; + if (textInfoPtr->selectAnchor < first) { + textInfoPtr->selectAnchor = first; + } + } + } + if (textPtr->insertPos > first) { + textPtr->insertPos -= charsRemoved; + if (textPtr->insertPos < first) { + textPtr->insertPos = first; + } + } + ComputeTextBbox(canvas, textPtr); + return; +} + +/* + *-------------------------------------------------------------- + * + * TextToPoint -- + * + * Computes the distance from a given point to a given + * text item, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are pointPtr[0] and pointPtr[1] is inside the text item. If + * the point isn't inside the text item then the return value + * is the distance from the point to the text item. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static double +TextToPoint(canvas, itemPtr, pointPtr) + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *pointPtr; /* Pointer to x and y coordinates. */ +{ + TextItem *textPtr; + + textPtr = (TextItem *) itemPtr; + return (double) Tk_DistanceToTextLayout(textPtr->textLayout, + (int) pointPtr[0] - textPtr->leftEdge, + (int) pointPtr[1] - textPtr->header.y1); +} + +/* + *-------------------------------------------------------------- + * + * TextToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given rectangle. + * + * Results: + * -1 is returned if the item is entirely outside the area + * given by rectPtr, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +TextToArea(canvas, itemPtr, rectPtr) + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Item to check against rectangle. */ + double *rectPtr; /* Pointer to array of four coordinates + * (x1, y1, x2, y2) describing rectangular + * area. */ +{ + TextItem *textPtr; + + textPtr = (TextItem *) itemPtr; + return Tk_IntersectTextLayout(textPtr->textLayout, + (int) (rectPtr[0] + 0.5) - textPtr->leftEdge, + (int) (rectPtr[1] + 0.5) - textPtr->header.y1, + (int) (rectPtr[2] - rectPtr[0] + 0.5), + (int) (rectPtr[3] - rectPtr[1] + 0.5)); +} + +/* + *-------------------------------------------------------------- + * + * ScaleText -- + * + * This procedure is invoked to rescale a text item. + * + * Results: + * None. + * + * Side effects: + * Scales the position of the text, but not the size + * of the font for the text. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +ScaleText(canvas, itemPtr, originX, originY, scaleX, scaleY) + Tk_Canvas canvas; /* Canvas containing rectangle. */ + Tk_Item *itemPtr; /* Rectangle to be scaled. */ + double originX, originY; /* Origin about which to scale rect. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + + textPtr->x = originX + scaleX*(textPtr->x - originX); + textPtr->y = originY + scaleY*(textPtr->y - originY); + ComputeTextBbox(canvas, textPtr); + return; +} + +/* + *-------------------------------------------------------------- + * + * TranslateText -- + * + * This procedure is called to move a text item by a + * given amount. + * + * Results: + * None. + * + * Side effects: + * The position of the text item is offset by (xDelta, yDelta), + * and the bounding box is updated in the generic part of the + * item structure. + * + *-------------------------------------------------------------- + */ + +static void +TranslateText(canvas, itemPtr, deltaX, deltaY) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be moved. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + + textPtr->x += deltaX; + textPtr->y += deltaY; + ComputeTextBbox(canvas, textPtr); +} + +/* + *-------------------------------------------------------------- + * + * GetTextIndex -- + * + * Parse an index into a text item and return either its value + * or an error. + * + * Results: + * A standard Tcl result. If all went well, then *indexPtr is + * filled in with the index (into itemPtr) corresponding to + * string. Otherwise an error message is left in + * the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +GetTextIndex(interp, canvas, itemPtr, string, indexPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item for which the index is being + * specified. */ + char *string; /* Specification of a particular character + * in itemPtr's text. */ + int *indexPtr; /* Where to store converted character + * index. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + size_t length; + int c; + TkCanvas *canvasPtr = (TkCanvas *) canvas; + Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; + + c = string[0]; + length = strlen(string); + + if ((c == 'e') && (strncmp(string, "end", length) == 0)) { + *indexPtr = textPtr->numChars; + } else if ((c == 'i') && (strncmp(string, "insert", length) == 0)) { + *indexPtr = textPtr->insertPos; + } else if ((c == 's') && (strncmp(string, "sel.first", length) == 0) + && (length >= 5)) { + if (textInfoPtr->selItemPtr != itemPtr) { + Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + return TCL_ERROR; + } + *indexPtr = textInfoPtr->selectFirst; + } else if ((c == 's') && (strncmp(string, "sel.last", length) == 0) + && (length >= 5)) { + if (textInfoPtr->selItemPtr != itemPtr) { + Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + return TCL_ERROR; + } + *indexPtr = textInfoPtr->selectLast; + } else if (c == '@') { + int x, y; + double tmp; + char *end, *p; + + p = string+1; + tmp = strtod(p, &end); + if ((end == p) || (*end != ',')) { + goto badIndex; + } + x = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5); + p = end+1; + tmp = strtod(p, &end); + if ((end == p) || (*end != 0)) { + goto badIndex; + } + y = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5); + *indexPtr = Tk_PointToChar(textPtr->textLayout, + x + canvasPtr->scrollX1 - textPtr->leftEdge, + y + canvasPtr->scrollY1 - textPtr->header.y1); + } else if (Tcl_GetInt(interp, string, indexPtr) == TCL_OK) { + if (*indexPtr < 0){ + *indexPtr = 0; + } else if (*indexPtr > textPtr->numChars) { + *indexPtr = textPtr->numChars; + } + } else { + /* + * Some of the paths here leave messages in the interp's result, + * so we have to clear it out before storing our own message. + */ + + badIndex: + Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); + Tcl_AppendResult(interp, "bad index \"", string, "\"", + (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * SetTextCursor -- + * + * Set the position of the insertion cursor in this item. + * + * Results: + * None. + * + * Side effects: + * The cursor position will change. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +SetTextCursor(canvas, itemPtr, index) + Tk_Canvas canvas; /* Record describing canvas widget. */ + Tk_Item *itemPtr; /* Text item in which cursor position is to + * be set. */ + int index; /* Character index of character just before + * which cursor is to be positioned. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + + if (index < 0) { + textPtr->insertPos = 0; + } else if (index > textPtr->numChars) { + textPtr->insertPos = textPtr->numChars; + } else { + textPtr->insertPos = index; + } +} + +/* + *-------------------------------------------------------------- + * + * GetSelText -- + * + * This procedure is invoked to return the selected portion + * of a text item. It is only called when this item has + * the selection. + * + * Results: + * The return value is the number of non-NULL bytes stored + * at buffer. Buffer is filled (or partially filled) with a + * NULL-terminated string containing part or all of the selection, + * as given by offset and maxBytes. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +GetSelText(canvas, itemPtr, offset, buffer, maxBytes) + Tk_Canvas canvas; /* Canvas containing selection. */ + Tk_Item *itemPtr; /* Text item containing selection. */ + int offset; /* Byte offset within selection of first + * character to be returned. */ + char *buffer; /* Location in which to place selection. */ + int maxBytes; /* Maximum number of bytes to place at + * buffer, not including terminating NULL + * character. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + int byteCount; + char *text, *selStart, *selEnd; + Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; + + if ((textInfoPtr->selectFirst < 0) || + (textInfoPtr->selectFirst > textInfoPtr->selectLast)) { + return 0; + } + text = textPtr->text; + selStart = Tcl_UtfAtIndex(text, textInfoPtr->selectFirst); + selEnd = Tcl_UtfAtIndex(selStart, + textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst); + byteCount = selEnd - selStart - offset; + if (byteCount > maxBytes) { + byteCount = maxBytes; + } + if (byteCount <= 0) { + return 0; + } + memcpy(buffer, selStart + offset, (size_t) byteCount); + buffer[byteCount] = '\0'; + return byteCount; +} + +/* + *-------------------------------------------------------------- + * + * TextToPostscript -- + * + * This procedure is called to generate Postscript for + * text items. + * + * Results: + * The return value is a standard Tcl result. If an error + * occurs in generating Postscript then an error message is + * left in the interp's result, replacing whatever used + * to be there. If no error occurs, then Postscript for the + * item is appended to the result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +TextToPostscript(interp, canvas, itemPtr, prepass) + Tcl_Interp *interp; /* Leave Postscript or error message here. */ + Tk_Canvas canvas; /* Information about overall canvas. */ + Tk_Item *itemPtr; /* Item for which Postscript is wanted. */ + int prepass; /* 1 means this is a prepass to collect + * font information; 0 means final Postscript + * is being created. */ +{ + TextItem *textPtr = (TextItem *) itemPtr; + int x, y; + Tk_FontMetrics fm; + char *justify; + char buffer[500]; + + if (textPtr->color == NULL) { + return TCL_OK; + } + + if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) { + return TCL_ERROR; + } + if (prepass != 0) { + return TCL_OK; + } + if (Tk_CanvasPsColor(interp, canvas, textPtr->color) != TCL_OK) { + return TCL_ERROR; + } + if (textPtr->stipple != None) { + Tcl_AppendResult(interp, "/StippleText {\n ", + (char *) NULL); + Tk_CanvasPsStipple(interp, canvas, textPtr->stipple); + Tcl_AppendResult(interp, "} bind def\n", (char *) NULL); + } + + sprintf(buffer, "%.15g %.15g [\n", textPtr->x, + Tk_CanvasPsY(canvas, textPtr->y)); + Tcl_AppendResult(interp, buffer, (char *) NULL); + + Tk_TextLayoutToPostscript(interp, textPtr->textLayout); + + x = 0; y = 0; justify = NULL; /* lint. */ + switch (textPtr->anchor) { + case TK_ANCHOR_NW: x = 0; y = 0; break; + case TK_ANCHOR_N: x = 1; y = 0; break; + case TK_ANCHOR_NE: x = 2; y = 0; break; + case TK_ANCHOR_E: x = 2; y = 1; break; + case TK_ANCHOR_SE: x = 2; y = 2; break; + case TK_ANCHOR_S: x = 1; y = 2; break; + case TK_ANCHOR_SW: x = 0; y = 2; break; + case TK_ANCHOR_W: x = 0; y = 1; break; + case TK_ANCHOR_CENTER: x = 1; y = 1; break; + } + switch (textPtr->justify) { + case TK_JUSTIFY_LEFT: justify = "0"; break; + case TK_JUSTIFY_CENTER: justify = "0.5";break; + case TK_JUSTIFY_RIGHT: justify = "1"; break; + } + + Tk_GetFontMetrics(textPtr->tkfont, &fm); + sprintf(buffer, "] %d %g %g %s %s DrawText\n", + fm.linespace, x / -2.0, y / 2.0, justify, + ((textPtr->stipple == None) ? "false" : "true")); + Tcl_AppendResult(interp, buffer, (char *) NULL); + + return TCL_OK; +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvUtil.c ./canvas-tcl8.2.2/tkCanvUtil.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvUtil.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvUtil.c Thu Dec 30 14:58:22 1999 @@ -0,0 +1,376 @@ +/* + * tkCanvUtil.c -- + * + * This procedure contains a collection of utility procedures + * used by the implementations of various canvas item types. + * + * Copyright (c) 1994 Sun Microsystems, Inc. + * Copyright (c) 1994 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvUtil.c,v 1.3 1999/04/16 01:51:12 stanton Exp $ + */ + +#include "tk.h" +#include "tkCanvas.h" +#include "tkPort.h" + + +/* + *---------------------------------------------------------------------- + * + * Tk_CanvasTkwin -- + * + * Given a token for a canvas, this procedure returns the + * widget that represents the canvas. + * + * Results: + * The return value is a handle for the widget. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tk_Window +Tk_CanvasTkwin(canvas) + Tk_Canvas canvas; /* Token for the canvas. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + return canvasPtr->tkwin; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_CanvasDrawableCoords -- + * + * Given an (x,y) coordinate pair within a canvas, this procedure + * returns the corresponding coordinates at which the point should + * be drawn in the drawable used for display. + * + * Results: + * There is no return value. The values at *drawableXPtr and + * *drawableYPtr are filled in with the coordinates at which + * x and y should be drawn. These coordinates are clipped + * to fit within a "short", since this is what X uses in + * most cases for drawing. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Tk_CanvasDrawableCoords(canvas, x, y, drawableXPtr, drawableYPtr) + Tk_Canvas canvas; /* Token for the canvas. */ + double x, y; /* Coordinates in canvas space. */ + short *drawableXPtr, *drawableYPtr; /* Screen coordinates are stored + * here. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + double tmp; + + tmp = x - canvasPtr->drawableXOrigin; + if (tmp > 0) { + tmp += 0.5; + } else { + tmp -= 0.5; + } + if (tmp > 32767) { + *drawableXPtr = 32767; + } else if (tmp < -32768) { + *drawableXPtr = -32768; + } else { + *drawableXPtr = (short) tmp; + } + + tmp = y - canvasPtr->drawableYOrigin; + if (tmp > 0) { + tmp += 0.5; + } else { + tmp -= 0.5; + } + if (tmp > 32767) { + *drawableYPtr = 32767; + } else if (tmp < -32768) { + *drawableYPtr = -32768; + } else { + *drawableYPtr = (short) tmp; + } +} + +/* + *---------------------------------------------------------------------- + * + * Tk_CanvasWindowCoords -- + * + * Given an (x,y) coordinate pair within a canvas, this procedure + * returns the corresponding coordinates in the canvas's window. + * + * Results: + * There is no return value. The values at *screenXPtr and + * *screenYPtr are filled in with the coordinates at which + * (x,y) appears in the canvas's window. These coordinates + * are clipped to fit within a "short", since this is what X + * uses in most cases for drawing. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr) + Tk_Canvas canvas; /* Token for the canvas. */ + double x, y; /* Coordinates in canvas space. */ + short *screenXPtr, *screenYPtr; /* Screen coordinates are stored + * here. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + double tmp; + + tmp = x - canvasPtr->xOrigin; + if (tmp > 0) { + tmp += 0.5; + } else { + tmp -= 0.5; + } + if (tmp > 32767) { + *screenXPtr = 32767; + } else if (tmp < -32768) { + *screenXPtr = -32768; + } else { + *screenXPtr = (short) tmp; + } + + tmp = y - canvasPtr->yOrigin; + if (tmp > 0) { + tmp += 0.5; + } else { + tmp -= 0.5; + } + if (tmp > 32767) { + *screenYPtr = 32767; + } else if (tmp < -32768) { + *screenYPtr = -32768; + } else { + *screenYPtr = (short) tmp; + } +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasGetCoord -- + * + * Given a string, returns a floating-point canvas coordinate + * corresponding to that string. + * + * Results: + * The return value is a standard Tcl return result. If + * TCL_OK is returned, then everything went well and the + * canvas coordinate is stored at *doublePtr; otherwise + * TCL_ERROR is returned and an error message is left in + * the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Tk_CanvasGetCoord(interp, canvas, string, doublePtr) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to which coordinate applies. */ + char *string; /* Describes coordinate (any screen + * coordinate form may be used here). */ + double *doublePtr; /* Place to store converted coordinate. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + if (Tk_GetScreenMM(canvasPtr->interp, canvasPtr->tkwin, string, + doublePtr) != TCL_OK) { + return TCL_ERROR; + } + *doublePtr *= canvasPtr->pixelsPerMM; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_CanvasSetStippleOrigin -- + * + * This procedure sets the stipple origin in a graphics context + * so that stipples drawn with the GC will line up with other + * stipples previously drawn in the canvas. + * + * Results: + * None. + * + * Side effects: + * The graphics context is modified. + * + *---------------------------------------------------------------------- + */ + +void +Tk_CanvasSetStippleOrigin(canvas, gc) + Tk_Canvas canvas; /* Token for a canvas. */ + GC gc; /* Graphics context that is about to be + * used to draw a stippled pattern as + * part of redisplaying the canvas. */ + +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + + XSetTSOrigin(canvasPtr->display, gc, -canvasPtr->drawableXOrigin, + -canvasPtr->drawableYOrigin); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_CanvasGetTextInfo -- + * + * This procedure returns a pointer to a structure containing + * information about the selection and insertion cursor for + * a canvas widget. Items such as text items save the pointer + * and use it to share access to the information with the generic + * canvas code. + * + * Results: + * The return value is a pointer to the structure holding text + * information for the canvas. Most of the fields should not + * be modified outside the generic canvas code; see the user + * documentation for details. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tk_CanvasTextInfo * +Tk_CanvasGetTextInfo(canvas) + Tk_Canvas canvas; /* Token for the canvas widget. */ +{ + return &((TkCanvas *) canvas)->textInfo; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasTagsParseProc -- + * + * This procedure is invoked during option processing to handle + * "-tags" options for canvas items. + * + * Results: + * A standard Tcl return value. + * + * Side effects: + * The tags for a given item get replaced by those indicated + * in the value argument. + * + *-------------------------------------------------------------- + */ + +int +Tk_CanvasTagsParseProc(clientData, interp, tkwin, value, widgRec, offset) + ClientData clientData; /* Not used.*/ + Tcl_Interp *interp; /* Used for reporting errors. */ + Tk_Window tkwin; /* Window containing canvas widget. */ + char *value; /* Value of option (list of tag + * names). */ + char *widgRec; /* Pointer to record for item. */ + int offset; /* Offset into item (ignored). */ +{ + register Tk_Item *itemPtr = (Tk_Item *) widgRec; + int argc, i; + char **argv; + Tk_Uid *newPtr; + + /* + * Break the value up into the individual tag names. + */ + + if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Make sure that there's enough space in the item to hold the + * tag names. + */ + + if (itemPtr->tagSpace < argc) { + newPtr = (Tk_Uid *) ckalloc((unsigned) (argc * sizeof(Tk_Uid))); + for (i = itemPtr->numTags-1; i >= 0; i--) { + newPtr[i] = itemPtr->tagPtr[i]; + } + if (itemPtr->tagPtr != itemPtr->staticTagSpace) { + ckfree((char *) itemPtr->tagPtr); + } + itemPtr->tagPtr = newPtr; + itemPtr->tagSpace = argc; + } + itemPtr->numTags = argc; + for (i = 0; i < argc; i++) { + itemPtr->tagPtr[i] = Tk_GetUid(argv[i]); + } + ckfree((char *) argv); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasTagsPrintProc -- + * + * This procedure is invoked by the Tk configuration code + * to produce a printable string for the "-tags" configuration + * option for canvas items. + * + * Results: + * The return value is a string describing all the tags for + * the item referred to by "widgRec". In addition, *freeProcPtr + * is filled in with the address of a procedure to call to free + * the result string when it's no longer needed (or NULL to + * indicate that the string doesn't need to be freed). + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +char * +Tk_CanvasTagsPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) + ClientData clientData; /* Ignored. */ + Tk_Window tkwin; /* Window containing canvas widget. */ + char *widgRec; /* Pointer to record for item. */ + int offset; /* Ignored. */ + Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with + * information about how to reclaim + * storage for return string. */ +{ + register Tk_Item *itemPtr = (Tk_Item *) widgRec; + + if (itemPtr->numTags == 0) { + *freeProcPtr = (Tcl_FreeProc *) NULL; + return ""; + } + if (itemPtr->numTags == 1) { + *freeProcPtr = (Tcl_FreeProc *) NULL; + return (char *) itemPtr->tagPtr[0]; + } + *freeProcPtr = TCL_DYNAMIC; + return Tcl_Merge(itemPtr->numTags, (char **) itemPtr->tagPtr); +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvWind.c ./canvas-tcl8.2.2/tkCanvWind.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvWind.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvWind.c Thu Dec 30 14:58:29 1999 @@ -0,0 +1,864 @@ +/* + * tkCanvWind.c -- + * + * This file implements window items for canvas widgets. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvWind.c,v 1.3 1999/04/16 01:51:12 stanton Exp $ + */ + +#include +#include "tkInt.h" +#include "tkPort.h" +#include "tkCanvas.h" + +/* + * The structure below defines the record for each window item. + */ + +typedef struct WindowItem { + Tk_Item header; /* Generic stuff that's the same for all + * types. MUST BE FIRST IN STRUCTURE. */ + double x, y; /* Coordinates of positioning point for + * window. */ + Tk_Window tkwin; /* Window associated with item. NULL means + * window has been destroyed. */ + int width; /* Width to use for window (<= 0 means use + * window's requested width). */ + int height; /* Width to use for window (<= 0 means use + * window's requested width). */ + Tk_Anchor anchor; /* Where to anchor window relative to + * (x,y). */ + Tk_Canvas canvas; /* Canvas containing this item. */ +} WindowItem; + +/* + * Information used for parsing configuration specs: + */ + +static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, + Tk_CanvasTagsPrintProc, (ClientData) NULL +}; + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL, + "center", Tk_Offset(WindowItem, anchor), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL, + "0", Tk_Offset(WindowItem, height), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, + "0", Tk_Offset(WindowItem, width), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(WindowItem, tkwin), TK_CONFIG_NULL_OK}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Prototypes for procedures defined in this file: + */ + +static void ComputeWindowBbox _ANSI_ARGS_((Tk_Canvas canvas, + WindowItem *winItemPtr)); +static int ConfigureWinItem _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +static int CreateWinItem _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, struct Tk_Item *itemPtr, + int argc, char **argv)); +static void DeleteWinItem _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +static void DisplayWinItem _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +static void ScaleWinItem _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +static void TranslateWinItem _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); +static int WinItemCoords _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv)); +static void WinItemLostSlaveProc _ANSI_ARGS_(( + ClientData clientData, Tk_Window tkwin)); +static void WinItemRequestProc _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin)); +static void WinItemStructureProc _ANSI_ARGS_(( + ClientData clientData, XEvent *eventPtr)); +static int WinItemToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *rectPtr)); +static double WinItemToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *pointPtr)); + +/* + * The structure below defines the window item type by means of procedures + * that can be invoked by generic item code. + */ + +Tk_ItemType tkWindowType = { + "window", /* name */ + sizeof(WindowItem), /* itemSize */ + CreateWinItem, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureWinItem, /* configureProc */ + WinItemCoords, /* coordProc */ + DeleteWinItem, /* deleteProc */ + DisplayWinItem, /* displayProc */ + 1, /* alwaysRedraw */ + WinItemToPoint, /* pointProc */ + WinItemToArea, /* areaProc */ + (Tk_ItemPostscriptProc *) NULL, /* postscriptProc */ + ScaleWinItem, /* scaleProc */ + TranslateWinItem, /* translateProc */ + (Tk_ItemIndexProc *) NULL, /* indexProc */ + (Tk_ItemCursorProc *) NULL, /* cursorProc */ + (Tk_ItemSelectionProc *) NULL, /* selectionProc */ + (Tk_ItemInsertProc *) NULL, /* insertProc */ + (Tk_ItemDCharsProc *) NULL, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + + +/* + * The structure below defines the official type record for the + * placer: + */ + +static Tk_GeomMgr canvasGeomType = { + "canvas", /* name */ + WinItemRequestProc, /* requestProc */ + WinItemLostSlaveProc, /* lostSlaveProc */ +}; + +/* + *-------------------------------------------------------------- + * + * CreateWinItem -- + * + * This procedure is invoked to create a new window + * item in a canvas. + * + * Results: + * A standard Tcl return value. If an error occurred in + * creating the item, then an error message is left in + * the interp's result; in this case itemPtr is + * left uninitialized, so it can be safely freed by the + * caller. + * + * Side effects: + * A new window item is created. + * + *-------------------------------------------------------------- + */ + +static int +CreateWinItem(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header + * has been initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing rectangle. */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", + itemPtr->typePtr->name, " x y ?options?\"", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Initialize item's record. + */ + + winItemPtr->tkwin = NULL; + winItemPtr->width = 0; + winItemPtr->height = 0; + winItemPtr->anchor = TK_ANCHOR_CENTER; + winItemPtr->canvas = canvas; + + /* + * Process the arguments to fill in the item record. + */ + + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], + &winItemPtr->y) != TCL_OK)) { + return TCL_ERROR; + } + + if (ConfigureWinItem(interp, canvas, itemPtr, argc-2, argv+2, 0) + != TCL_OK) { + DeleteWinItem(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * WinItemCoords -- + * + * This procedure is invoked to process the "coords" widget + * command on window items. See the user documentation for + * details on what it does. + * + * Results: + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. + * + * Side effects: + * The coordinates for the given item may be changed. + * + *-------------------------------------------------------------- + */ + +static int +WinItemCoords(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be + * read or modified. */ + int argc; /* Number of coordinates supplied in + * argv. */ + char **argv; /* Array of coordinates: x1, y1, + * x2, y2, ... */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE]; + + if (argc == 0) { + Tcl_PrintDouble(interp, winItemPtr->x, x); + Tcl_PrintDouble(interp, winItemPtr->y, y); + Tcl_AppendResult(interp, x, " ", y, (char *) NULL); + } else if (argc == 2) { + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x) + != TCL_OK) || (Tk_CanvasGetCoord(interp, canvas, argv[1], + &winItemPtr->y) != TCL_OK)) { + return TCL_ERROR; + } + ComputeWindowBbox(canvas, winItemPtr); + } else { + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ConfigureWinItem -- + * + * This procedure is invoked to configure various aspects + * of a window item, such as its anchor position. + * + * Results: + * A standard Tcl result code. If an error occurs, then + * an error message is left in the interp's result. + * + * Side effects: + * Configuration information may be set for itemPtr. + * + *-------------------------------------------------------------- + */ + +static int +ConfigureWinItem(interp, canvas, itemPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Window item to reconfigure. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments describing things to configure. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + Tk_Window oldWindow; + Tk_Window canvasTkwin; + + oldWindow = winItemPtr->tkwin; + canvasTkwin = Tk_CanvasTkwin(canvas); + if (Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, argc, argv, + (char *) winItemPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few of the options require additional processing. + */ + + if (oldWindow != winItemPtr->tkwin) { + if (oldWindow != NULL) { + Tk_DeleteEventHandler(oldWindow, StructureNotifyMask, + WinItemStructureProc, (ClientData) winItemPtr); + Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL, + (ClientData) NULL); + Tk_UnmaintainGeometry(oldWindow, canvasTkwin); + Tk_UnmapWindow(oldWindow); + } + if (winItemPtr->tkwin != NULL) { + Tk_Window ancestor, parent; + + /* + * Make sure that the canvas is either the parent of the + * window associated with the item or a descendant of that + * parent. Also, don't allow a top-level window to be + * managed inside a canvas. + */ + + parent = Tk_Parent(winItemPtr->tkwin); + for (ancestor = canvasTkwin; ; + ancestor = Tk_Parent(ancestor)) { + if (ancestor == parent) { + break; + } + if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_LEVEL) { + badWindow: + Tcl_AppendResult(interp, "can't use ", + Tk_PathName(winItemPtr->tkwin), + " in a window item of this canvas", (char *) NULL); + winItemPtr->tkwin = NULL; + return TCL_ERROR; + } + } + if (((Tk_FakeWin *) (winItemPtr->tkwin))->flags & TK_TOP_LEVEL) { + goto badWindow; + } + if (winItemPtr->tkwin == canvasTkwin) { + goto badWindow; + } + Tk_CreateEventHandler(winItemPtr->tkwin, StructureNotifyMask, + WinItemStructureProc, (ClientData) winItemPtr); + Tk_ManageGeometry(winItemPtr->tkwin, &canvasGeomType, + (ClientData) winItemPtr); + } + } + + ComputeWindowBbox(canvas, winItemPtr); + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeleteWinItem -- + * + * This procedure is called to clean up the data structure + * associated with a window item. + * + * Results: + * None. + * + * Side effects: + * Resources associated with itemPtr are released. + * + *-------------------------------------------------------------- + */ + +static void +DeleteWinItem(canvas, itemPtr, display) + Tk_Canvas canvas; /* Overall info about widget. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for + * canvas. */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas); + + if (winItemPtr->tkwin != NULL) { + Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask, + WinItemStructureProc, (ClientData) winItemPtr); + Tk_ManageGeometry(winItemPtr->tkwin, (Tk_GeomMgr *) NULL, + (ClientData) NULL); + if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) { + Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin); + } + Tk_UnmapWindow(winItemPtr->tkwin); + } +} + +/* + *-------------------------------------------------------------- + * + * ComputeWindowBbox -- + * + * This procedure is invoked to compute the bounding box of + * all the pixels that may be drawn as part of a window item. + * This procedure is where the child window's placement is + * computed. + * + * Results: + * None. + * + * Side effects: + * The fields x1, y1, x2, and y2 are updated in the header + * for itemPtr. + * + *-------------------------------------------------------------- + */ + +static void +ComputeWindowBbox(canvas, winItemPtr) + Tk_Canvas canvas; /* Canvas that contains item. */ + WindowItem *winItemPtr; /* Item whose bbox is to be + * recomputed. */ +{ + int width, height, x, y; + + x = (int) (winItemPtr->x + ((winItemPtr->x >= 0) ? 0.5 : - 0.5)); + y = (int) (winItemPtr->y + ((winItemPtr->y >= 0) ? 0.5 : - 0.5)); + + if (winItemPtr->tkwin == NULL) { + /* + * There is no window for this item yet. Just give it a 1x1 + * bounding box. Don't give it a 0x0 bounding box; there are + * strange cases where this bounding box might be used as the + * dimensions of the window, and 0x0 causes problems under X. + */ + + winItemPtr->header.x1 = x; + winItemPtr->header.x2 = winItemPtr->header.x1 + 1; + winItemPtr->header.y1 = y; + winItemPtr->header.y2 = winItemPtr->header.y1 + 1; + return; + } + + /* + * Compute dimensions of window. + */ + + width = winItemPtr->width; + if (width <= 0) { + width = Tk_ReqWidth(winItemPtr->tkwin); + if (width <= 0) { + width = 1; + } + } + height = winItemPtr->height; + if (height <= 0) { + height = Tk_ReqHeight(winItemPtr->tkwin); + if (height <= 0) { + height = 1; + } + } + + /* + * Compute location of window, using anchor information. + */ + + switch (winItemPtr->anchor) { + case TK_ANCHOR_N: + x -= width/2; + break; + case TK_ANCHOR_NE: + x -= width; + break; + case TK_ANCHOR_E: + x -= width; + y -= height/2; + break; + case TK_ANCHOR_SE: + x -= width; + y -= height; + break; + case TK_ANCHOR_S: + x -= width/2; + y -= height; + break; + case TK_ANCHOR_SW: + y -= height; + break; + case TK_ANCHOR_W: + y -= height/2; + break; + case TK_ANCHOR_NW: + break; + case TK_ANCHOR_CENTER: + x -= width/2; + y -= height/2; + break; + } + + /* + * Store the information in the item header. + */ + + winItemPtr->header.x1 = x; + winItemPtr->header.y1 = y; + winItemPtr->header.x2 = x + width; + winItemPtr->header.y2 = y + height; +} + +/* + *-------------------------------------------------------------- + * + * DisplayWinItem -- + * + * This procedure is invoked to "draw" a window item in a given + * drawable. Since the window draws itself, we needn't do any + * actual redisplay here. However, this procedure takes care + * of actually repositioning the child window so that it occupies + * the correct screen position. + * + * Results: + * None. + * + * Side effects: + * The child window's position may get changed. Note: this + * procedure gets called both when a window needs to be displayed + * and when it ceases to be visible on the screen (e.g. it was + * scrolled or moved off-screen or the enclosing canvas is + * unmapped). + * + *-------------------------------------------------------------- + */ + +static void +DisplayWinItem(canvas, itemPtr, display, drawable, regionX, regionY, + regionWidth, regionHeight) + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw + * item. */ + int regionX, regionY, regionWidth, regionHeight; + /* Describes region of canvas that + * must be redisplayed (not used). */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + int width, height; + short x, y; + Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas); + + if (winItemPtr->tkwin == NULL) { + return; + } + + Tk_CanvasWindowCoords(canvas, (double) winItemPtr->header.x1, + (double) winItemPtr->header.y1, &x, &y); + width = winItemPtr->header.x2 - winItemPtr->header.x1; + height = winItemPtr->header.y2 - winItemPtr->header.y1; + + /* + * If the window is completely out of the visible area of the canvas + * then unmap it. This code used not to be present (why unmap the + * window if it isn't visible anyway?) but this could cause the + * window to suddenly reappear if the canvas window got resized. + */ + + if (((x + width) <= 0) || ((y + height) <= 0) + || (x >= Tk_Width(canvasTkwin)) || (y >= Tk_Height(canvasTkwin))) { + if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) { + Tk_UnmapWindow(winItemPtr->tkwin); + } else { + Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin); + } + return; + } + + /* + * Reposition and map the window (but in different ways depending + * on whether the canvas is the window's parent). + */ + + if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) { + if ((x != Tk_X(winItemPtr->tkwin)) || (y != Tk_Y(winItemPtr->tkwin)) + || (width != Tk_Width(winItemPtr->tkwin)) + || (height != Tk_Height(winItemPtr->tkwin))) { + Tk_MoveResizeWindow(winItemPtr->tkwin, x, y, width, height); + } + Tk_MapWindow(winItemPtr->tkwin); + } else { + Tk_MaintainGeometry(winItemPtr->tkwin, canvasTkwin, x, y, + width, height); + } +} + +/* + *-------------------------------------------------------------- + * + * WinItemToPoint -- + * + * Computes the distance from a given point to a given + * rectangle, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are coordPtr[0] and coordPtr[1] is inside the window. If the + * point isn't inside the window then the return value is the + * distance from the point to the window. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static double +WinItemToPoint(canvas, itemPtr, pointPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *pointPtr; /* Pointer to x and y coordinates. */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + double x1, x2, y1, y2, xDiff, yDiff; + + x1 = winItemPtr->header.x1; + y1 = winItemPtr->header.y1; + x2 = winItemPtr->header.x2; + y2 = winItemPtr->header.y2; + + /* + * Point is outside rectangle. + */ + + if (pointPtr[0] < x1) { + xDiff = x1 - pointPtr[0]; + } else if (pointPtr[0] >= x2) { + xDiff = pointPtr[0] + 1 - x2; + } else { + xDiff = 0; + } + + if (pointPtr[1] < y1) { + yDiff = y1 - pointPtr[1]; + } else if (pointPtr[1] >= y2) { + yDiff = pointPtr[1] + 1 - y2; + } else { + yDiff = 0; + } + + return hypot(xDiff, yDiff); +} + +/* + *-------------------------------------------------------------- + * + * WinItemToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given rectangle. + * + * Results: + * -1 is returned if the item is entirely outside the area + * given by rectPtr, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +WinItemToArea(canvas, itemPtr, rectPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against rectangle. */ + double *rectPtr; /* Pointer to array of four coordinates + * (x1, y1, x2, y2) describing rectangular + * area. */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + + if ((rectPtr[2] <= winItemPtr->header.x1) + || (rectPtr[0] >= winItemPtr->header.x2) + || (rectPtr[3] <= winItemPtr->header.y1) + || (rectPtr[1] >= winItemPtr->header.y2)) { + return -1; + } + if ((rectPtr[0] <= winItemPtr->header.x1) + && (rectPtr[1] <= winItemPtr->header.y1) + && (rectPtr[2] >= winItemPtr->header.x2) + && (rectPtr[3] >= winItemPtr->header.y2)) { + return 1; + } + return 0; +} + +/* + *-------------------------------------------------------------- + * + * ScaleWinItem -- + * + * This procedure is invoked to rescale a rectangle or oval + * item. + * + * Results: + * None. + * + * Side effects: + * The rectangle or oval referred to by itemPtr is rescaled + * so that the following transformation is applied to all + * point coordinates: + * x' = originX + scaleX*(x-originX) + * y' = originY + scaleY*(y-originY) + * + *-------------------------------------------------------------- + */ + +static void +ScaleWinItem(canvas, itemPtr, originX, originY, scaleX, scaleY) + Tk_Canvas canvas; /* Canvas containing rectangle. */ + Tk_Item *itemPtr; /* Rectangle to be scaled. */ + double originX, originY; /* Origin about which to scale rect. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + + winItemPtr->x = originX + scaleX*(winItemPtr->x - originX); + winItemPtr->y = originY + scaleY*(winItemPtr->y - originY); + if (winItemPtr->width > 0) { + winItemPtr->width = (int) (scaleX*winItemPtr->width); + } + if (winItemPtr->height > 0) { + winItemPtr->height = (int) (scaleY*winItemPtr->height); + } + ComputeWindowBbox(canvas, winItemPtr); +} + +/* + *-------------------------------------------------------------- + * + * TranslateWinItem -- + * + * This procedure is called to move a rectangle or oval by a + * given amount. + * + * Results: + * None. + * + * Side effects: + * The position of the rectangle or oval is offset by + * (xDelta, yDelta), and the bounding box is updated in the + * generic part of the item structure. + * + *-------------------------------------------------------------- + */ + +static void +TranslateWinItem(canvas, itemPtr, deltaX, deltaY) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be + * moved. */ +{ + WindowItem *winItemPtr = (WindowItem *) itemPtr; + + winItemPtr->x += deltaX; + winItemPtr->y += deltaY; + ComputeWindowBbox(canvas, winItemPtr); +} + +/* + *-------------------------------------------------------------- + * + * WinItemStructureProc -- + * + * This procedure is invoked whenever StructureNotify events + * occur for a window that's managed as part of a canvas window + * item. This procudure's only purpose is to clean up when + * windows are deleted. + * + * Results: + * None. + * + * Side effects: + * The window is disassociated from the window item when it is + * deleted. + * + *-------------------------------------------------------------- + */ + +static void +WinItemStructureProc(clientData, eventPtr) + ClientData clientData; /* Pointer to record describing window item. */ + XEvent *eventPtr; /* Describes what just happened. */ +{ + WindowItem *winItemPtr = (WindowItem *) clientData; + + if (eventPtr->type == DestroyNotify) { + winItemPtr->tkwin = NULL; + } +} + +/* + *-------------------------------------------------------------- + * + * WinItemRequestProc -- + * + * This procedure is invoked whenever a window that's associated + * with a window canvas item changes its requested dimensions. + * + * Results: + * None. + * + * Side effects: + * The size and location on the screen of the window may change, + * depending on the options specified for the window item. + * + *-------------------------------------------------------------- + */ + +static void +WinItemRequestProc(clientData, tkwin) + ClientData clientData; /* Pointer to record for window item. */ + Tk_Window tkwin; /* Window that changed its desired + * size. */ +{ + WindowItem *winItemPtr = (WindowItem *) clientData; + + ComputeWindowBbox(winItemPtr->canvas, winItemPtr); + DisplayWinItem(winItemPtr->canvas, (Tk_Item *) winItemPtr, + (Display *) NULL, (Drawable) None, 0, 0, 0, 0); +} + +/* + *-------------------------------------------------------------- + * + * WinItemLostSlaveProc -- + * + * This procedure is invoked by Tk whenever some other geometry + * claims control over a slave that used to be managed by us. + * + * Results: + * None. + * + * Side effects: + * Forgets all canvas-related information about the slave. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +WinItemLostSlaveProc(clientData, tkwin) + ClientData clientData; /* WindowItem structure for slave window that + * was stolen away. */ + Tk_Window tkwin; /* Tk's handle for the slave window. */ +{ + WindowItem *winItemPtr = (WindowItem *) clientData; + Tk_Window canvasTkwin = Tk_CanvasTkwin(winItemPtr->canvas); + + Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask, + WinItemStructureProc, (ClientData) winItemPtr); + if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) { + Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin); + } + Tk_UnmapWindow(winItemPtr->tkwin); + winItemPtr->tkwin = NULL; +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvas.c ./canvas-tcl8.2.2/tkCanvas.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvas.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvas.c Thu Dec 30 15:37:01 1999 @@ -0,0 +1,4190 @@ +/* + * tkCanvas.c -- + * + * This module implements canvas widgets for the Tk toolkit. + * A canvas displays a background and a collection of graphical + * objects such as rectangles, lines, and texts. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvas.c,v 1.7.4.1 1999/09/22 06:53:10 hobbs Exp $ + */ + +#include "default.h" +#include "tkInt.h" +#include "tkPort.h" +#include "tkCanvas.h" +#include "xxl_incs.h" +#include "defines.hh" + +Tk_Item *lastItemCreated; + +/* + * See tkCanvas.h for key data structures used to implement canvases. + */ + +/* + * The structure defined below is used to keep track of a tag search + * in progress. No field should be accessed by anyone other than + * StartTagSearch and NextItem. + */ + +typedef struct TagSearch { + TkCanvas *canvasPtr; /* Canvas widget being searched. */ + Tk_Uid tag; /* Tag to search for. 0 means return + * all items. */ + Tk_Item *currentPtr; /* Pointer to last item returned. */ + Tk_Item *lastPtr; /* The item right before the currentPtr + * is tracked so if the currentPtr is + * deleted we don't have to start from the + * beginning. */ + int searchOver; /* Non-zero means NextItem should always + * return NULL. */ +} TagSearch; + +/* + * Information used for argv parsing. + */ + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_BORDER, "-background", "background", "Background", + DEF_CANVAS_BG_COLOR, Tk_Offset(TkCanvas, bgBorder), + TK_CONFIG_COLOR_ONLY}, + {TK_CONFIG_BORDER, "-background", "background", "Background", + DEF_CANVAS_BG_MONO, Tk_Offset(TkCanvas, bgBorder), + TK_CONFIG_MONO_ONLY}, + {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, + (char *) NULL, 0, 0}, + {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_CANVAS_BORDER_WIDTH, Tk_Offset(TkCanvas, borderWidth), 0}, + {TK_CONFIG_DOUBLE, "-closeenough", "closeEnough", "CloseEnough", + DEF_CANVAS_CLOSE_ENOUGH, Tk_Offset(TkCanvas, closeEnough), 0}, + {TK_CONFIG_BOOLEAN, "-confine", "confine", "Confine", + DEF_CANVAS_CONFINE, Tk_Offset(TkCanvas, confine), 0}, + {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", + DEF_CANVAS_CURSOR, Tk_Offset(TkCanvas, cursor), TK_CONFIG_NULL_OK}, + {TK_CONFIG_PIXELS, "-height", "height", "Height", + DEF_CANVAS_HEIGHT, Tk_Offset(TkCanvas, height), 0}, + {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_CANVAS_HIGHLIGHT_BG, + Tk_Offset(TkCanvas, highlightBgColorPtr), 0}, + {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_CANVAS_HIGHLIGHT, Tk_Offset(TkCanvas, highlightColorPtr), 0}, + {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", + DEF_CANVAS_HIGHLIGHT_WIDTH, Tk_Offset(TkCanvas, highlightWidth), 0}, + {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground", + DEF_CANVAS_INSERT_BG, Tk_Offset(TkCanvas, textInfo.insertBorder), 0}, + {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth", + DEF_CANVAS_INSERT_BD_COLOR, + Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_COLOR_ONLY}, + {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth", + DEF_CANVAS_INSERT_BD_MONO, + Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_MONO_ONLY}, + {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime", + DEF_CANVAS_INSERT_OFF_TIME, Tk_Offset(TkCanvas, insertOffTime), 0}, + {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime", + DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0}, + {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", + DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0}, + {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", + DEF_CANVAS_RELIEF, Tk_Offset(TkCanvas, relief), 0}, + {TK_CONFIG_STRING, "-scrollregion", "scrollRegion", "ScrollRegion", + DEF_CANVAS_SCROLL_REGION, Tk_Offset(TkCanvas, regionString), + TK_CONFIG_NULL_OK}, + {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground", + DEF_CANVAS_SELECT_COLOR, Tk_Offset(TkCanvas, textInfo.selBorder), + TK_CONFIG_COLOR_ONLY}, + {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground", + DEF_CANVAS_SELECT_MONO, Tk_Offset(TkCanvas, textInfo.selBorder), + TK_CONFIG_MONO_ONLY}, + {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", + DEF_CANVAS_SELECT_BD_COLOR, + Tk_Offset(TkCanvas, textInfo.selBorderWidth), TK_CONFIG_COLOR_ONLY}, + {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", + DEF_CANVAS_SELECT_BD_MONO, Tk_Offset(TkCanvas, textInfo.selBorderWidth), + TK_CONFIG_MONO_ONLY}, + {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_CANVAS_SELECT_FG_COLOR, Tk_Offset(TkCanvas, textInfo.selFgColorPtr), + TK_CONFIG_COLOR_ONLY}, + {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_CANVAS_SELECT_FG_MONO, Tk_Offset(TkCanvas, textInfo.selFgColorPtr), + TK_CONFIG_MONO_ONLY}, + {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_CANVAS_TAKE_FOCUS, Tk_Offset(TkCanvas, takeFocus), + TK_CONFIG_NULL_OK}, + {TK_CONFIG_PIXELS, "-width", "width", "Width", + DEF_CANVAS_WIDTH, Tk_Offset(TkCanvas, width), 0}, + {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", + DEF_CANVAS_X_SCROLL_CMD, Tk_Offset(TkCanvas, xScrollCmd), + TK_CONFIG_NULL_OK}, + {TK_CONFIG_PIXELS, "-xscrollincrement", "xScrollIncrement", + "ScrollIncrement", + DEF_CANVAS_X_SCROLL_INCREMENT, Tk_Offset(TkCanvas, xScrollIncrement), + 0}, + {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", + DEF_CANVAS_Y_SCROLL_CMD, Tk_Offset(TkCanvas, yScrollCmd), + TK_CONFIG_NULL_OK}, + {TK_CONFIG_PIXELS, "-yscrollincrement", "yScrollIncrement", + "ScrollIncrement", + DEF_CANVAS_Y_SCROLL_INCREMENT, Tk_Offset(TkCanvas, yScrollIncrement), + 0}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * List of all the item types known at present: + */ + +static Tk_ItemType *typeList = NULL; /* NULL means initialization hasn't + * been done yet. */ + +/* + * Standard item types provided by Tk: + */ + +extern Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType; +extern Tk_ItemType tkOvalType, tkPolygonType; +extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType; + +/* + * Prototypes for procedures defined later in this file: + */ + +static void CanvasBindProc _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); +static void CanvasBlinkProc _ANSI_ARGS_((ClientData clientData)); +static void CanvasCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void CanvasDoEvent _ANSI_ARGS_((TkCanvas *canvasPtr, + XEvent *eventPtr)); +static void CanvasEventProc _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); +static int CanvasFetchSelection _ANSI_ARGS_(( + ClientData clientData, int offset, + char *buffer, int maxBytes)); +static Tk_Item * CanvasFindClosest _ANSI_ARGS_((TkCanvas *canvasPtr, + double coords[2])); +static void CanvasFocusProc _ANSI_ARGS_((TkCanvas *canvasPtr, + int gotFocus)); +static void CanvasLostSelection _ANSI_ARGS_(( + ClientData clientData)); +static void CanvasSelectTo _ANSI_ARGS_((TkCanvas *canvasPtr, + Tk_Item *itemPtr, int index)); +static void CanvasSetOrigin _ANSI_ARGS_((TkCanvas *canvasPtr, + int xOrigin, int yOrigin)); +static void CanvasUpdateScrollbars _ANSI_ARGS_(( + TkCanvas *canvasPtr)); +int CanvasWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static void CanvasWorldChanged _ANSI_ARGS_(( + ClientData instanceData)); +static int ConfigureCanvas _ANSI_ARGS_((Tcl_Interp *interp, + TkCanvas *canvasPtr, int argc, char **argv, + int flags)); +static void DestroyCanvas _ANSI_ARGS_((char *memPtr)); +static void DisplayCanvas _ANSI_ARGS_((ClientData clientData)); +static void DoItem _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Item *itemPtr, Tk_Uid tag)); +static int FindItems _ANSI_ARGS_((Tcl_Interp *interp, + TkCanvas *canvasPtr, int argc, char **argv, + char *newTag, char *cmdName, char *option)); +static int FindArea _ANSI_ARGS_((Tcl_Interp *interp, + TkCanvas *canvasPtr, char **argv, Tk_Uid uid, + int enclosed)); +static double GridAlign _ANSI_ARGS_((double coord, double spacing)); +static void InitCanvas _ANSI_ARGS_((void)); +static Tk_Item * NextItem _ANSI_ARGS_((TagSearch *searchPtr)); +static void PickCurrentItem _ANSI_ARGS_((TkCanvas *canvasPtr, + XEvent *eventPtr)); +static void PrintScrollFractions _ANSI_ARGS_((int screen1, + int screen2, int object1, int object2, + char *string)); +static void RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr, + char *tag, Tk_Item *prevPtr)); +static Tk_Item * StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr, + char *tag, TagSearch *searchPtr)); + +/* + * The structure below defines canvas class behavior by means of procedures + * that can be invoked from generic window code. + */ + +static TkClassProcs canvasClass = { + NULL, /* createProc. */ + CanvasWorldChanged, /* geometryProc. */ + NULL /* modalProc. */ +}; + + +/* + *-------------------------------------------------------------- + * + * Tk_CanvasCmd -- + * + * This procedure is invoked to process the "canvas" Tcl + * command. See the user documentation for details on what + * it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Xxl_CanvasCmd(clientData, interp, argc, argv) + ClientData clientData; /* Main window associated with + * interpreter. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + Tk_Window tkwin = (Tk_Window) clientData; + TkCanvas *canvasPtr; + Tk_Window new; + + if (typeList == NULL) { + InitCanvas(); + } + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL); + if (new == NULL) { + return TCL_ERROR; + } + + /* + * Initialize fields that won't be initialized by ConfigureCanvas, + * or which ConfigureCanvas expects to have reasonable values + * (e.g. resource pointers). + */ + + canvasPtr = (TkCanvas *) ckalloc(sizeof(TkCanvas)); + canvasPtr->tkwin = new; + canvasPtr->display = Tk_Display(new); + canvasPtr->interp = interp; + canvasPtr->widgetCmd = Tcl_CreateCommand(interp, + Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd, + (ClientData) canvasPtr, CanvasCmdDeletedProc); + canvasPtr->firstItemPtr = NULL; + canvasPtr->lastItemPtr = NULL; + canvasPtr->borderWidth = 0; + canvasPtr->bgBorder = NULL; + canvasPtr->relief = TK_RELIEF_FLAT; + canvasPtr->highlightWidth = 0; + canvasPtr->highlightBgColorPtr = NULL; + canvasPtr->highlightColorPtr = NULL; + canvasPtr->inset = 0; + canvasPtr->pixmapGC = None; + canvasPtr->width = None; + canvasPtr->height = None; + canvasPtr->confine = 0; + canvasPtr->textInfo.selBorder = NULL; + canvasPtr->textInfo.selBorderWidth = 0; + canvasPtr->textInfo.selFgColorPtr = NULL; + canvasPtr->textInfo.selItemPtr = NULL; + canvasPtr->textInfo.selectFirst = -1; + canvasPtr->textInfo.selectLast = -1; + canvasPtr->textInfo.anchorItemPtr = NULL; + canvasPtr->textInfo.selectAnchor = 0; + canvasPtr->textInfo.insertBorder = NULL; + canvasPtr->textInfo.insertWidth = 0; + canvasPtr->textInfo.insertBorderWidth = 0; + canvasPtr->textInfo.focusItemPtr = NULL; + canvasPtr->textInfo.gotFocus = 0; + canvasPtr->textInfo.cursorOn = 0; + canvasPtr->insertOnTime = 0; + canvasPtr->insertOffTime = 0; + canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL; + canvasPtr->xOrigin = canvasPtr->yOrigin = 0; + canvasPtr->drawableXOrigin = canvasPtr->drawableYOrigin = 0; + canvasPtr->bindingTable = NULL; + canvasPtr->currentItemPtr = NULL; + canvasPtr->newCurrentPtr = NULL; + canvasPtr->closeEnough = 0.0; + canvasPtr->pickEvent.type = LeaveNotify; + canvasPtr->pickEvent.xcrossing.x = 0; + canvasPtr->pickEvent.xcrossing.y = 0; + canvasPtr->state = 0; + canvasPtr->xScrollCmd = NULL; + canvasPtr->yScrollCmd = NULL; + canvasPtr->scrollX1 = 0; + canvasPtr->scrollY1 = 0; + canvasPtr->scrollX2 = 0; + canvasPtr->scrollY2 = 0; + canvasPtr->regionString = NULL; + canvasPtr->xScrollIncrement = 0; + canvasPtr->yScrollIncrement = 0; + canvasPtr->scanX = 0; + canvasPtr->scanXOrigin = 0; + canvasPtr->scanY = 0; + canvasPtr->scanYOrigin = 0; + canvasPtr->hotPtr = NULL; + canvasPtr->hotPrevPtr = NULL; + canvasPtr->cursor = None; + canvasPtr->takeFocus = NULL; + canvasPtr->pixelsPerMM = WidthOfScreen(Tk_Screen(new)); + canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(new)); + canvasPtr->flags = 0; + canvasPtr->nextId = 1; + canvasPtr->psInfoPtr = NULL; + canvasPtr->canvas_info = (void*)get_canvas_info(argv[1]); + Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS); + + Tk_SetClass(canvasPtr->tkwin, "Canvas"); + TkSetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr); + Tk_CreateEventHandler(canvasPtr->tkwin, + ExposureMask|StructureNotifyMask|FocusChangeMask, + CanvasEventProc, (ClientData) canvasPtr); + Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask + |ButtonPressMask|ButtonReleaseMask|EnterWindowMask + |LeaveWindowMask|PointerMotionMask|VirtualEventMask, + CanvasBindProc, (ClientData) canvasPtr); + Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING, + CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING); + if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) { + goto error; + } + + Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC); + return TCL_OK; + + error: + Tk_DestroyWindow(canvasPtr->tkwin); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * CanvasWidgetCmd -- + * + * This procedure is invoked to process the Tcl command + * that corresponds to a widget managed by this module. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +CanvasWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about canvas + * widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) clientData; + size_t length; + int c, result; + Tk_Item *itemPtr = NULL; /* Initialization needed only to + * prevent compiler warning. */ + TagSearch search; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Tcl_Preserve((ClientData) canvasPtr); + result = TCL_OK; + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'a') && (strncmp(argv[1], "addtag", length) == 0)) { + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " addtags tag searchCommand ?arg arg ...?\"", + (char *) NULL); + goto error; + } + result = FindItems(interp, canvasPtr, argc-3, argv+3, argv[2], argv[0], + " addtag tag"); + } else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0) + && (length >= 2)) { + int i, gotAny; + int x1 = 0, y1 = 0, x2 = 0, y2 = 0; /* Initializations needed + * only to prevent compiler + * warnings. */ + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " bbox tagOrId ?tagOrId ...?\"", + (char *) NULL); + goto error; + } + gotAny = 0; + for (i = 2; i < argc; i++) { + for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if ((itemPtr->x1 >= itemPtr->x2) + || (itemPtr->y1 >= itemPtr->y2)) { + continue; + } + if (!gotAny) { + x1 = itemPtr->x1; + y1 = itemPtr->y1; + x2 = itemPtr->x2; + y2 = itemPtr->y2; + gotAny = 1; + } else { + if (itemPtr->x1 < x1) { + x1 = itemPtr->x1; + } + if (itemPtr->y1 < y1) { + y1 = itemPtr->y1; + } + if (itemPtr->x2 > x2) { + x2 = itemPtr->x2; + } + if (itemPtr->y2 > y2) { + y2 = itemPtr->y2; + } + } + } + } + if (gotAny) { + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", x1, y1, x2, y2); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } + } else if ((c == 'b') && (strncmp(argv[1], "bind", length) == 0) + && (length >= 2)) { + ClientData object; + + if ((argc < 3) || (argc > 5)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " bind tagOrId ?sequence? ?command?\"", + (char *) NULL); + goto error; + } + + /* + * Figure out what object to use for the binding (individual + * item vs. tag). + */ + + object = 0; + if (isdigit(UCHAR(argv[2][0]))) { + int id; + char *end; + Tcl_HashEntry *entryPtr; + + id = strtoul(argv[2], &end, 0); + if (*end != 0) { + goto bindByTag; + } + entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); + if (entryPtr != NULL) { + itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr); + object = (ClientData) itemPtr; + } + + if (object == 0) { + Tcl_AppendResult(interp, "item \"", argv[2], + "\" doesn't exist", (char *) NULL); + goto error; + } + } else { + bindByTag: + object = (ClientData) Tk_GetUid(argv[2]); + } + + /* + * Make a binding table if the canvas doesn't already have + * one. + */ + + if (canvasPtr->bindingTable == NULL) { + canvasPtr->bindingTable = Tk_CreateBindingTable(interp); + } + + if (argc == 5) { + int append = 0; + unsigned long mask; + + if (argv[4][0] == 0) { + result = Tk_DeleteBinding(interp, canvasPtr->bindingTable, + object, argv[3]); + goto done; + } + if (argv[4][0] == '+') { + argv[4]++; + append = 1; + } + mask = Tk_CreateBinding(interp, canvasPtr->bindingTable, + object, argv[3], argv[4], append); + if (mask == 0) { + goto error; + } + if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask + |Button2MotionMask|Button3MotionMask|Button4MotionMask + |Button5MotionMask|ButtonPressMask|ButtonReleaseMask + |EnterWindowMask|LeaveWindowMask|KeyPressMask + |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { + Tk_DeleteBinding(interp, canvasPtr->bindingTable, + object, argv[3]); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "requested illegal events; ", + "only key, button, motion, enter, leave, and virtual ", + "events may be used", (char *) NULL); + goto error; + } + } else if (argc == 4) { + char *command; + + command = Tk_GetBinding(interp, canvasPtr->bindingTable, + object, argv[3]); + if (command == NULL) { + char *string; + + string = Tcl_GetStringResult(interp); + /* + * Ignore missing binding errors. This is a special hack + * that relies on the error message returned by FindSequence + * in tkBind.c. + */ + + if (string[0] != '\0') { + goto error; + } else { + Tcl_ResetResult(interp); + } + } else { + Tcl_SetResult(interp, command, TCL_STATIC); + } + } else { + Tk_GetAllBindings(interp, canvasPtr->bindingTable, object); + } + } else if ((c == 'c') && (strcmp(argv[1], "canvasx") == 0)) { + int x; + double grid; + char buf[TCL_DOUBLE_SPACE]; + + if ((argc < 3) || (argc > 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " canvasx screenx ?gridspacing?\"", + (char *) NULL); + goto error; + } + if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) { + goto error; + } + if (argc == 4) { + if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3], + &grid) != TCL_OK) { + goto error; + } + } else { + grid = 0.0; + } + x += canvasPtr->xOrigin; + Tcl_PrintDouble(interp, GridAlign((double) x, grid), buf); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } else if ((c == 'c') && (strcmp(argv[1], "canvasy") == 0)) { + int y; + double grid; + char buf[TCL_DOUBLE_SPACE]; + + if ((argc < 3) || (argc > 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " canvasy screeny ?gridspacing?\"", + (char *) NULL); + goto error; + } + if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) { + goto error; + } + if (argc == 4) { + if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, + argv[3], &grid) != TCL_OK) { + goto error; + } + } else { + grid = 0.0; + } + y += canvasPtr->yOrigin; + Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) + && (length >= 2)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " cget option\"", + (char *) NULL); + goto error; + } + result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs, + (char *) canvasPtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 3)) { + if (argc == 2) { + result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs, + (char *) canvasPtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs, + (char *) canvasPtr, argv[2], 0); + } else { + result = ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, + TK_CONFIG_ARGV_ONLY); + } + } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0) + && (length >= 3)) { + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " coords tagOrId ?x y x y ...?\"", + (char *) NULL); + goto error; + } + itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + if (itemPtr != NULL) { + if (argc != 3) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + } + if (itemPtr->typePtr->coordProc != NULL) { + result = (*itemPtr->typePtr->coordProc)(interp, + (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3); + } + if (argc != 3) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + } + } + } else if ((c == 'c') && (strncmp(argv[1], "create", length) == 0) + && (length >= 2)) { + Tk_ItemType *typePtr; + Tk_ItemType *matchPtr = NULL; + Tk_Item *itemPtr; + char buf[TCL_INTEGER_SPACE]; + int isNew = 0; + Tcl_HashEntry *entryPtr; + int dx1, dx2, dy1, dy2; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " create type ?arg arg ...?\"", (char *) NULL); + goto error; + } + c = argv[2][0]; + length = strlen(argv[2]); + for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) { + if ((c == typePtr->name[0]) + && (strncmp(argv[2], typePtr->name, length) == 0)) { + if (matchPtr != NULL) { + badType: + Tcl_AppendResult(interp, + "unknown or ambiguous item type \"", + argv[2], "\"", (char *) NULL); + goto error; + } + matchPtr = typePtr; + } + } + if (matchPtr == NULL) { + goto badType; + } + typePtr = matchPtr; + itemPtr = (Tk_Item *) ckalloc((unsigned) typePtr->itemSize); + itemPtr->id = canvasPtr->nextId; + canvasPtr->nextId++; + itemPtr->tagPtr = itemPtr->staticTagSpace; + itemPtr->tagSpace = TK_TAG_SPACE; + itemPtr->staticTagSpace[0] = 0; + itemPtr->numTags = 0; + itemPtr->typePtr = typePtr; + if ((*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr, + itemPtr, argc-3, argv+3) != TCL_OK) { + ckfree((char *) itemPtr); + goto error; + } + itemPtr->nextPtr = NULL; + entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable, + (char *) itemPtr->id, &isNew); + Tcl_SetHashValue(entryPtr, itemPtr); + itemPtr->prevPtr = canvasPtr->lastItemPtr; + canvasPtr->hotPtr = itemPtr; + canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr; + if (canvasPtr->lastItemPtr == NULL) { + canvasPtr->firstItemPtr = itemPtr; + } else { + canvasPtr->lastItemPtr->nextPtr = itemPtr; + } + canvasPtr->lastItemPtr = itemPtr; + computeDxy(itemPtr,canvasPtr,&dx1,&dx2,&dy1,&dy2); + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1+dx1, itemPtr->y1+dy1, + itemPtr->x2+dx2, itemPtr->y2+dy2); + canvasPtr->flags |= REPICK_NEEDED; + lastItemCreated = itemPtr; + sprintf(buf, "%d", itemPtr->id); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } else if ((c == 'd') && (strncmp(argv[1], "dchars", length) == 0) + && (length >= 2)) { + int first, last; + + if ((argc != 4) && (argc != 5)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " dchars tagOrId first ?last?\"", + (char *) NULL); + goto error; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if ((itemPtr->typePtr->indexProc == NULL) + || (itemPtr->typePtr->dCharsProc == NULL)) { + continue; + } + if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr, + itemPtr, argv[3], &first) != TCL_OK) { + goto error; + } + if (argc == 5) { + if ((*itemPtr->typePtr->indexProc)(interp, + (Tk_Canvas) canvasPtr, itemPtr, argv[4], &last) + != TCL_OK) { + goto error; + } + } else { + last = first; + } + + /* + * Redraw both item's old and new areas: it's possible + * that a delete could result in a new area larger than + * the old area. + */ + + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + (*itemPtr->typePtr->dCharsProc)((Tk_Canvas) canvasPtr, + itemPtr, first, last); + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + } + } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0) + && (length >= 2)) { + int i; + Tcl_HashEntry *entryPtr; + + for (i = 2; i < argc; i++) { + for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + int dx1,dx2,dy1,dy2; + + computeDxy(itemPtr,canvasPtr,&dx1,&dx2,&dy1,&dy2); + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1+dx1, itemPtr->y1+dy1, + itemPtr->x2+dx2, itemPtr->y2+dy2); + if (canvasPtr->bindingTable != NULL) { + Tk_DeleteAllBindings(canvasPtr->bindingTable, + (ClientData) itemPtr); + } + (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr, + canvasPtr->display); + if (itemPtr->tagPtr != itemPtr->staticTagSpace) { + ckfree((char *) itemPtr->tagPtr); + } + entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, + (char *) itemPtr->id); + Tcl_DeleteHashEntry(entryPtr); + if (itemPtr->nextPtr != NULL) { + itemPtr->nextPtr->prevPtr = itemPtr->prevPtr; + } + if (itemPtr->prevPtr != NULL) { + itemPtr->prevPtr->nextPtr = itemPtr->nextPtr; + } + if (canvasPtr->firstItemPtr == itemPtr) { + canvasPtr->firstItemPtr = itemPtr->nextPtr; + if (canvasPtr->firstItemPtr == NULL) { + canvasPtr->lastItemPtr = NULL; + } + } + if (canvasPtr->lastItemPtr == itemPtr) { + canvasPtr->lastItemPtr = itemPtr->prevPtr; + } + ckfree((char *) itemPtr); + if (itemPtr == canvasPtr->currentItemPtr) { + canvasPtr->currentItemPtr = NULL; + canvasPtr->flags |= REPICK_NEEDED; + } + if (itemPtr == canvasPtr->newCurrentPtr) { + canvasPtr->newCurrentPtr = NULL; + canvasPtr->flags |= REPICK_NEEDED; + } + if (itemPtr == canvasPtr->textInfo.focusItemPtr) { + canvasPtr->textInfo.focusItemPtr = NULL; + } + if (itemPtr == canvasPtr->textInfo.selItemPtr) { + canvasPtr->textInfo.selItemPtr = NULL; + } + if ((itemPtr == canvasPtr->hotPtr) + || (itemPtr == canvasPtr->hotPrevPtr)) { + canvasPtr->hotPtr = NULL; + } + } + } + } else if ((c == 'd') && (strncmp(argv[1], "dtag", length) == 0) + && (length >= 2)) { + Tk_Uid tag; + int i; + + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " dtag tagOrId ?tagToDelete?\"", + (char *) NULL); + goto error; + } + if (argc == 4) { + tag = Tk_GetUid(argv[3]); + } else { + tag = Tk_GetUid(argv[2]); + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + for (i = itemPtr->numTags-1; i >= 0; i--) { + if (itemPtr->tagPtr[i] == tag) { + itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1]; + itemPtr->numTags--; + } + } + } + } else if ((c == 'f') && (strncmp(argv[1], "find", length) == 0) + && (length >= 2)) { + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " find searchCommand ?arg arg ...?\"", + (char *) NULL); + goto error; + } + result = FindItems(interp, canvasPtr, argc-2, argv+2, (char *) NULL, + argv[0]," find"); + } else if ((c == 'f') && (strncmp(argv[1], "focus", length) == 0) + && (length >= 2)) { + if (argc > 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " focus ?tagOrId?\"", + (char *) NULL); + goto error; + } + itemPtr = canvasPtr->textInfo.focusItemPtr; + if (argc == 2) { + if (itemPtr != NULL) { + char buf[TCL_INTEGER_SPACE]; + + sprintf(buf, "%d", itemPtr->id); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } + goto done; + } + if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + } + if (argv[2][0] == 0) { + canvasPtr->textInfo.focusItemPtr = NULL; + goto done; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if (itemPtr->typePtr->icursorProc != NULL) { + break; + } + } + if (itemPtr == NULL) { + goto done; + } + canvasPtr->textInfo.focusItemPtr = itemPtr; + if (canvasPtr->textInfo.gotFocus) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + } + } else if ((c == 'g') && (strncmp(argv[1], "gettags", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " gettags tagOrId\"", (char *) NULL); + goto error; + } + itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + if (itemPtr != NULL) { + int i; + for (i = 0; i < itemPtr->numTags; i++) { + Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]); + } + } + } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0) + && (length >= 2)) { + int index; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " icursor tagOrId index\"", + (char *) NULL); + goto error; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if ((itemPtr->typePtr->indexProc == NULL) + || (itemPtr->typePtr->icursorProc == NULL)) { + goto done; + } + if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr, + itemPtr, argv[3], &index) != TCL_OK) { + goto error; + } + (*itemPtr->typePtr->icursorProc)((Tk_Canvas) canvasPtr, itemPtr, + index); + if ((itemPtr == canvasPtr->textInfo.focusItemPtr) + && (canvasPtr->textInfo.cursorOn)) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + } + } + } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) + && (length >= 3)) { + int index; + char buf[TCL_INTEGER_SPACE]; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " index tagOrId string\"", + (char *) NULL); + goto error; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if (itemPtr->typePtr->indexProc != NULL) { + break; + } + } + if (itemPtr == NULL) { + Tcl_AppendResult(interp, "can't find an indexable item \"", + argv[2], "\"", (char *) NULL); + goto error; + } + if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr, + itemPtr, argv[3], &index) != TCL_OK) { + goto error; + } + sprintf(buf, "%d", index); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) + && (length >= 3)) { + int beforeThis; + + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " insert tagOrId beforeThis string\"", + (char *) NULL); + goto error; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if ((itemPtr->typePtr->indexProc == NULL) + || (itemPtr->typePtr->insertProc == NULL)) { + continue; + } + if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr, + itemPtr, argv[3], &beforeThis) != TCL_OK) { + goto error; + } + + /* + * Redraw both item's old and new areas: it's possible + * that an insertion could result in a new area either + * larger or smaller than the old area. + */ + + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr, + itemPtr, beforeThis, argv[4]); + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1, + itemPtr->y1, itemPtr->x2, itemPtr->y2); + } + } else if ((c == 'i') && (strncmp(argv[1], "itemcget", length) == 0) + && (length >= 6)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " itemcget tagOrId option\"", + (char *) NULL); + return TCL_ERROR; + } + itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + if (itemPtr != NULL) { + result = Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin, + itemPtr->typePtr->configSpecs, (char *) itemPtr, + argv[3], 0); + } + } else if ((c == 'i') && (strncmp(argv[1], "itemconfigure", length) == 0) + && (length >= 6)) { + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " itemconfigure tagOrId ?option value ...?\"", + (char *) NULL); + goto error; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if (argc == 3) { + result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin, + itemPtr->typePtr->configSpecs, (char *) itemPtr, + (char *) NULL, 0); + } else if (argc == 4) { + result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin, + itemPtr->typePtr->configSpecs, (char *) itemPtr, + argv[3], 0); + } else { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + result = (*itemPtr->typePtr->configProc)(interp, + (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3, + TK_CONFIG_ARGV_ONLY); + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + canvasPtr->flags |= REPICK_NEEDED; + } + if ((result != TCL_OK) || (argc < 5)) { + break; + } + } + } else if ((c == 'l') && (strncmp(argv[1], "lower", length) == 0)) { + Tk_Item *itemPtr; + int dx1,dx2,dy1,dy2; + + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " lower tagOrId ?belowThis?\"", + (char *) NULL); + goto error; + } + + /* + * First find the item just after which we'll insert the + * named items. + */ + + if (argc == 3) { + itemPtr = NULL; + } else { + itemPtr = StartTagSearch(canvasPtr, argv[3], &search); + if (itemPtr == NULL) { + Tcl_AppendResult(interp, "tag \"", argv[3], + "\" doesn't match any items", (char *) NULL); + goto error; + } + itemPtr = itemPtr->prevPtr; + } + RelinkItems(canvasPtr, argv[2], itemPtr); + } else if ((c == 'm') && (strncmp(argv[1], "move", length) == 0)) { + double xAmount, yAmount; + + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " move tagOrId xAmount yAmount\"", + (char *) NULL); + goto error; + } + if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3], + &xAmount) != TCL_OK) || (Tk_CanvasGetCoord(interp, + (Tk_Canvas) canvasPtr, argv[4], &yAmount) != TCL_OK)) { + goto error; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + (void) (*itemPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr, + itemPtr, xAmount, yAmount); + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + canvasPtr->flags |= REPICK_NEEDED; + } + } else if ((c == 'p') && (strncmp(argv[1], "postscript", length) == 0)) { + result = TkCanvPostscriptCmd(canvasPtr, interp, argc, argv); + } else if ((c == 'r') && (strncmp(argv[1], "raise", length) == 0)) { + Tk_Item *prevPtr; + + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " raise tagOrId ?aboveThis?\"", + (char *) NULL); + goto error; + } + + /* + * First find the item just after which we'll insert the + * named items. + */ + + if (argc == 3) { + prevPtr = canvasPtr->lastItemPtr; + } else { + prevPtr = NULL; + for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + prevPtr = itemPtr; + } + if (prevPtr == NULL) { + Tcl_AppendResult(interp, "tagOrId \"", argv[3], + "\" doesn't match any items", (char *) NULL); + goto error; + } + } + RelinkItems(canvasPtr, argv[2], prevPtr); + } else if ((c == 's') && (strncmp(argv[1], "scale", length) == 0) + && (length >= 3)) { + double xOrigin, yOrigin, xScale, yScale; + + if (argc != 7) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " scale tagOrId xOrigin yOrigin xScale yScale\"", + (char *) NULL); + goto error; + } + if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, + argv[3], &xOrigin) != TCL_OK) + || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, + argv[4], &yOrigin) != TCL_OK) + || (Tcl_GetDouble(interp, argv[5], &xScale) != TCL_OK) + || (Tcl_GetDouble(interp, argv[6], &yScale) != TCL_OK)) { + goto error; + } + if ((xScale == 0.0) || (yScale == 0.0)) { + Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC); + goto error; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr, + itemPtr, xOrigin, yOrigin, xScale, yScale); + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + canvasPtr->flags |= REPICK_NEEDED; + } + } else if ((c == 's') && (strncmp(argv[1], "scan", length) == 0) + && (length >= 3)) { + int x, y; + + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " scan mark|dragto x y\"", (char *) NULL); + goto error; + } + if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK) + || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){ + goto error; + } + if ((argv[2][0] == 'm') + && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) { + canvasPtr->scanX = x; + canvasPtr->scanXOrigin = canvasPtr->xOrigin; + canvasPtr->scanY = y; + canvasPtr->scanYOrigin = canvasPtr->yOrigin; + } else if ((argv[2][0] == 'd') + && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) { + int newXOrigin, newYOrigin, tmp; + + /* + * Compute a new view origin for the canvas, amplifying the + * mouse motion. + */ + + tmp = canvasPtr->scanXOrigin - 10*(x - canvasPtr->scanX) + - canvasPtr->scrollX1; + newXOrigin = canvasPtr->scrollX1 + tmp; + tmp = canvasPtr->scanYOrigin - 10*(y - canvasPtr->scanY) + - canvasPtr->scrollY1; + newYOrigin = canvasPtr->scrollY1 + tmp; + CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin); + } else { + Tcl_AppendResult(interp, "bad scan option \"", argv[2], + "\": must be mark or dragto", (char *) NULL); + goto error; + } + } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0) + && (length >= 2)) { + int index; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " select option ?tagOrId? ?arg?\"", (char *) NULL); + goto error; + } + if (argc >= 4) { + for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if ((itemPtr->typePtr->indexProc != NULL) + && (itemPtr->typePtr->selectionProc != NULL)){ + break; + } + } + if (itemPtr == NULL) { + Tcl_AppendResult(interp, + "can't find an indexable and selectable item \"", + argv[3], "\"", (char *) NULL); + goto error; + } + } + if (argc == 5) { + if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr, + itemPtr, argv[4], &index) != TCL_OK) { + goto error; + } + } + length = strlen(argv[2]); + c = argv[2][0]; + if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " select adjust tagOrId index\"", + (char *) NULL); + goto error; + } + if (canvasPtr->textInfo.selItemPtr == itemPtr) { + if (index < (canvasPtr->textInfo.selectFirst + + canvasPtr->textInfo.selectLast)/2) { + canvasPtr->textInfo.selectAnchor = + canvasPtr->textInfo.selectLast + 1; + } else { + canvasPtr->textInfo.selectAnchor = + canvasPtr->textInfo.selectFirst; + } + } + CanvasSelectTo(canvasPtr, itemPtr, index); + } else if ((c == 'c') && (argv[2] != NULL) + && (strncmp(argv[2], "clear", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " select clear\"", (char *) NULL); + goto error; + } + if (canvasPtr->textInfo.selItemPtr != NULL) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->textInfo.selItemPtr->x1, + canvasPtr->textInfo.selItemPtr->y1, + canvasPtr->textInfo.selItemPtr->x2, + canvasPtr->textInfo.selItemPtr->y2); + canvasPtr->textInfo.selItemPtr = NULL; + } + goto done; + } else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " select from tagOrId index\"", + (char *) NULL); + goto error; + } + canvasPtr->textInfo.anchorItemPtr = itemPtr; + canvasPtr->textInfo.selectAnchor = index; + } else if ((c == 'i') && (strncmp(argv[2], "item", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " select item\"", (char *) NULL); + goto error; + } + if (canvasPtr->textInfo.selItemPtr != NULL) { + char buf[TCL_INTEGER_SPACE]; + + sprintf(buf, "%d", canvasPtr->textInfo.selItemPtr->id); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } + } else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " select to tagOrId index\"", + (char *) NULL); + goto error; + } + CanvasSelectTo(canvasPtr, itemPtr, index); + } else { + Tcl_AppendResult(interp, "bad select option \"", argv[2], + "\": must be adjust, clear, from, item, or to", + (char *) NULL); + goto error; + } + } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " type tag\"", (char *) NULL); + goto error; + } + itemPtr = StartTagSearch(canvasPtr, argv[2], &search); + if (itemPtr != NULL) { + Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC); + } + } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { + int count, type; + int newX = 0; /* Initialization needed only to prevent + * gcc warnings. */ + double fraction; + + if (argc == 2) { + PrintScrollFractions(canvasPtr->xOrigin + canvasPtr->inset, + canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin) + - canvasPtr->inset, canvasPtr->scrollX1, + canvasPtr->scrollX2, Tcl_GetStringResult(interp)); + } else { + type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count); + switch (type) { + case TK_SCROLL_ERROR: + goto error; + case TK_SCROLL_MOVETO: + newX = canvasPtr->scrollX1 - canvasPtr->inset + + (int) (fraction * (canvasPtr->scrollX2 + - canvasPtr->scrollX1) + 0.5); + break; + case TK_SCROLL_PAGES: + newX = (int) (canvasPtr->xOrigin + count * .9 + * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset)); + break; + case TK_SCROLL_UNITS: + if (canvasPtr->xScrollIncrement > 0) { + newX = canvasPtr->xOrigin + + count*canvasPtr->xScrollIncrement; + } else { + newX = (int) (canvasPtr->xOrigin + count * .1 + * (Tk_Width(canvasPtr->tkwin) + - 2*canvasPtr->inset)); + } + break; + } + CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin); + } + } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) { + int count, type; + int newY = 0; /* Initialization needed only to prevent + * gcc warnings. */ + double fraction; + + if (argc == 2) { + PrintScrollFractions(canvasPtr->yOrigin + canvasPtr->inset, + canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin) + - canvasPtr->inset, canvasPtr->scrollY1, + canvasPtr->scrollY2, Tcl_GetStringResult(interp)); + } else { + type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count); + switch (type) { + case TK_SCROLL_ERROR: + goto error; + case TK_SCROLL_MOVETO: + newY = canvasPtr->scrollY1 - canvasPtr->inset + + (int) (fraction*(canvasPtr->scrollY2 + - canvasPtr->scrollY1) + 0.5); + break; + case TK_SCROLL_PAGES: + newY = (int) (canvasPtr->yOrigin + count * .9 + * (Tk_Height(canvasPtr->tkwin) + - 2*canvasPtr->inset)); + break; + case TK_SCROLL_UNITS: + if (canvasPtr->yScrollIncrement > 0) { + newY = canvasPtr->yOrigin + + count*canvasPtr->yScrollIncrement; + } else { + newY = (int) (canvasPtr->yOrigin + count * .1 + * (Tk_Height(canvasPtr->tkwin) + - 2*canvasPtr->inset)); + } + break; + } + CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY); + } + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be addtag, bbox, bind, ", + "canvasx, canvasy, cget, configure, coords, create, ", + "dchars, delete, dtag, find, focus, ", + "gettags, icursor, index, insert, itemcget, itemconfigure, ", + "lower, move, postscript, raise, scale, scan, ", + "select, type, xview, or yview", + (char *) NULL); + goto error; + } + done: + Tcl_Release((ClientData) canvasPtr); + return result; + + error: + Tcl_Release((ClientData) canvasPtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyCanvas -- + * + * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release + * to clean up the internal structure of a canvas at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the canvas is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyCanvas(memPtr) + char *memPtr; /* Info about canvas widget. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) memPtr; + Tk_Item *itemPtr; + + /* + * Free up all of the items in the canvas. + */ + + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = canvasPtr->firstItemPtr) { + canvasPtr->firstItemPtr = itemPtr->nextPtr; + (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr, + canvasPtr->display); + if (itemPtr->tagPtr != itemPtr->staticTagSpace) { + ckfree((char *) itemPtr->tagPtr); + } + ckfree((char *) itemPtr); + } + + /* + * Free up all the stuff that requires special handling, + * then let Tk_FreeOptions handle all the standard option-related + * stuff. + */ + + Tcl_DeleteHashTable(&canvasPtr->idTable); + if (canvasPtr->pixmapGC != None) { + Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC); + } + Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler); + if (canvasPtr->bindingTable != NULL) { + Tk_DeleteBindingTable(canvasPtr->bindingTable); + } + Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0); + ckfree((char *) canvasPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureCanvas -- + * + * This procedure is called to process an argv/argc list, plus + * the Tk option database, in order to configure (or + * reconfigure) a canvas widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then the interp's result contains an error message. + * + * Side effects: + * Configuration information, such as colors, border width, + * etc. get set for canvasPtr; old resources get freed, + * if there were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureCanvas(interp, canvasPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + TkCanvas *canvasPtr; /* Information about widget; may or may + * not already have values for some fields. */ + int argc; /* Number of valid entries in argv. */ + char **argv; /* Arguments. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + XGCValues gcValues; + GC new; + + if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs, + argc, argv, (char *) canvasPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few options need special processing, such as setting the + * background from a 3-D border and creating a GC for copying + * bits to the screen. + */ + + Tk_SetBackgroundFromBorder(canvasPtr->tkwin, canvasPtr->bgBorder); + + if (canvasPtr->highlightWidth < 0) { + canvasPtr->highlightWidth = 0; + } + canvasPtr->inset = canvasPtr->borderWidth + canvasPtr->highlightWidth; + + gcValues.function = GXcopy; + gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel; + gcValues.graphics_exposures = False; + new = Tk_GetGC(canvasPtr->tkwin, + GCFunction|GCForeground|GCGraphicsExposures, &gcValues); + if (canvasPtr->pixmapGC != None) { + Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC); + } + canvasPtr->pixmapGC = new; + + /* + * Reset the desired dimensions for the window. + */ + + Tk_GeometryRequest(canvasPtr->tkwin, canvasPtr->width + 2*canvasPtr->inset, + canvasPtr->height + 2*canvasPtr->inset); + + /* + * Restart the cursor timing sequence in case the on-time or off-time + * just changed. + */ + + if (canvasPtr->textInfo.gotFocus) { + CanvasFocusProc(canvasPtr, 1); + } + + /* + * Recompute the scroll region. + */ + + canvasPtr->scrollX1 = 0; + canvasPtr->scrollY1 = 0; + canvasPtr->scrollX2 = 0; + canvasPtr->scrollY2 = 0; + if (canvasPtr->regionString != NULL) { + int argc2; + char **argv2; + + if (Tcl_SplitList(canvasPtr->interp, canvasPtr->regionString, + &argc2, &argv2) != TCL_OK) { + return TCL_ERROR; + } + if (argc2 != 4) { + Tcl_AppendResult(interp, "bad scrollRegion \"", + canvasPtr->regionString, "\"", (char *) NULL); + badRegion: + ckfree(canvasPtr->regionString); + ckfree((char *) argv2); + canvasPtr->regionString = NULL; + return TCL_ERROR; + } + if ((Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin, + argv2[0], &canvasPtr->scrollX1) != TCL_OK) + || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin, + argv2[1], &canvasPtr->scrollY1) != TCL_OK) + || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin, + argv2[2], &canvasPtr->scrollX2) != TCL_OK) + || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin, + argv2[3], &canvasPtr->scrollY2) != TCL_OK)) { + goto badRegion; + } + ckfree((char *) argv2); + } + + /* + * Reset the canvas's origin (this is a no-op unless confine + * mode has just been turned on or the scroll region has changed). + */ + + CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin); + canvasPtr->flags |= UPDATE_SCROLLBARS|REDRAW_BORDERS; + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->xOrigin, canvasPtr->yOrigin, + canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin), + canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)); + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * + * CanvasWorldChanged -- + * + * This procedure is called when the world has changed in some + * way and the widget needs to recompute all its graphics contexts + * and determine its new geometry. + * + * Results: + * None. + * + * Side effects: + * Configures all items in the canvas with a empty argc/argv, for + * the side effect of causing all the items to recompute their + * geometry and to be redisplayed. + * + *--------------------------------------------------------------------------- + */ + +static void +CanvasWorldChanged(instanceData) + ClientData instanceData; /* Information about widget. */ +{ + TkCanvas *canvasPtr; + Tk_Item *itemPtr; + int result; + + canvasPtr = (TkCanvas *) instanceData; + itemPtr = canvasPtr->firstItemPtr; + for ( ; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { + result = (*itemPtr->typePtr->configProc)(canvasPtr->interp, + (Tk_Canvas) canvasPtr, itemPtr, 0, NULL, + TK_CONFIG_ARGV_ONLY); + if (result != TCL_OK) { + Tcl_ResetResult(canvasPtr->interp); + } + } + canvasPtr->flags |= REPICK_NEEDED; + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->xOrigin, canvasPtr->yOrigin, + canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin), + canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)); +} + +/* + *-------------------------------------------------------------- + * + * DisplayCanvas -- + * + * This procedure redraws the contents of a canvas window. + * It is invoked as a do-when-idle handler, so it only runs + * when there's nothing else for the application to do. + * + * Results: + * None. + * + * Side effects: + * Information appears on the screen. + * + *-------------------------------------------------------------- + */ + +static void +DisplayCanvas(clientData) + ClientData clientData; /* Information about widget. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) clientData; + Tk_Window tkwin = canvasPtr->tkwin; + Tk_Item *itemPtr; + Pixmap pixmap; + int screenX1, screenX2, screenY1, screenY2, width, height; + int cnt; + + if (canvasPtr->tkwin == NULL) { + return; + } + if (!Tk_IsMapped(tkwin)) { + goto done; + } + + /* + * Choose a new current item if that is needed (this could cause + * event handlers to be invoked). + */ + + while (canvasPtr->flags & REPICK_NEEDED) { + Tcl_Preserve((ClientData) canvasPtr); + canvasPtr->flags &= ~REPICK_NEEDED; + PickCurrentItem(canvasPtr, &canvasPtr->pickEvent); + tkwin = canvasPtr->tkwin; + Tcl_Release((ClientData) canvasPtr); + if (tkwin == NULL) { + return; + } + } + + /* + * Compute the intersection between the area that needs redrawing + * and the area that's visible on the screen. + */ + + if ((canvasPtr->redrawX1 < canvasPtr->redrawX2) + && (canvasPtr->redrawY1 < canvasPtr->redrawY2)) { + screenX1 = canvasPtr->xOrigin + canvasPtr->inset; + screenY1 = canvasPtr->yOrigin + canvasPtr->inset; + screenX2 = canvasPtr->xOrigin + Tk_Width(tkwin) - canvasPtr->inset; + screenY2 = canvasPtr->yOrigin + Tk_Height(tkwin) - canvasPtr->inset; + if (canvasPtr->redrawX1 > screenX1) { + screenX1 = canvasPtr->redrawX1; + } + if (canvasPtr->redrawY1 > screenY1) { + screenY1 = canvasPtr->redrawY1; + } + if (canvasPtr->redrawX2 < screenX2) { + screenX2 = canvasPtr->redrawX2; + } + if (canvasPtr->redrawY2 < screenY2) { + screenY2 = canvasPtr->redrawY2; + } + if ((screenX1 >= screenX2) || (screenY1 >= screenY2)) { + goto borders; + } + + /* + * Redrawing is done in a temporary pixmap that is allocated + * here and freed at the end of the procedure. All drawing + * is done to the pixmap, and the pixmap is copied to the + * screen at the end of the procedure. The temporary pixmap + * serves two purposes: + * + * 1. It provides a smoother visual effect (no clearing and + * gradual redraw will be visible to users). + * 2. It allows us to redraw only the objects that overlap + * the redraw area. Otherwise incorrect results could + * occur from redrawing things that stick outside of + * the redraw area (we'd have to redraw everything in + * order to make the overlaps look right). + * + * Some tricky points about the pixmap: + * + * 1. We only allocate a large enough pixmap to hold the + * area that has to be redisplayed. This saves time in + * in the X server for large objects that cover much + * more than the area being redisplayed: only the area + * of the pixmap will actually have to be redrawn. + * 2. Some X servers (e.g. the one for DECstations) have troubles + * with characters that overlap an edge of the pixmap (on the + * DEC servers, as of 8/18/92, such characters are drawn one + * pixel too far to the right). To handle this problem, + * make the pixmap a bit larger than is absolutely needed + * so that for normal-sized fonts the characters that overlap + * the edge of the pixmap will be outside the area we care + * about. + */ + + canvasPtr->drawableXOrigin = screenX1 - 30; + canvasPtr->drawableYOrigin = screenY1 - 30; + pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin), + (screenX2 + 30 - canvasPtr->drawableXOrigin), + (screenY2 + 30 - canvasPtr->drawableYOrigin), + Tk_Depth(tkwin)); + + /* + * Clear the area to be redrawn. + */ + + width = screenX2 - screenX1; + height = screenY2 - screenY1; + + XFillRectangle(Tk_Display(tkwin), pixmap, canvasPtr->pixmapGC, + screenX1 - canvasPtr->drawableXOrigin, + screenY1 - canvasPtr->drawableYOrigin, (unsigned int) width, + (unsigned int) height); + + /* + * Scan through the item list, redrawing those items that need it. + * An item must be redraw if either (a) it intersects the smaller + * on-screen area or (b) it intersects the full canvas area and its + * type requests that it be redrawn always (e.g. so subwindows can + * be unmapped when they move off-screen). + */ + + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + + /* Now process the special items */ + + if (itemPtr->staticTagSpace[0] && + itemPtr->staticTagSpace[0][0] == 'Z' ){ + if (!strcmp(itemPtr->staticTagSpace[0],"Zcollabels")){ + int x,i,dx,dy; + TextItem *textPtr; + + textPtr = (TextItem *) itemPtr; + for ( i = cell_col(screenX1,canvasPtr->canvas_info), + x = x_coord(i,canvasPtr->canvas_info); + x < screenX2; + i++, x = x_coord(i,canvasPtr->canvas_info)) { + dx = (x+x_coord(i+1,canvasPtr->canvas_info))/2; + + textPtr->header.x1 = dx; + textPtr->header.x2 = dx; + textPtr->header.y1 = 8; + textPtr->header.y2 = 40; + textPtr->leftEdge=dx; + + /* sera que isto vale a pena??? */ + textPtr->textLayout= + Tk_ComputeTextLayout(textPtr->tkfont, + (char*)coltoa_formated(i),-1,-1, + TK_JUSTIFY_CENTER,0,NULL,NULL); + (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, + itemPtr, + canvasPtr->display,pixmap, + screenX1, screenY1, + width, + height); + } + } + if (!strcmp(itemPtr->staticTagSpace[0],"Zrowlabels")) { + int y,i,dx,dy; + char *aux; + TextItem *textPtr; + + textPtr = (TextItem *) itemPtr; + for ( i = cell_row(screenY1,canvasPtr->canvas_info), + y = y_coord(i,canvasPtr->canvas_info); + y < screenY2; + i++) { + y = (y_coord(i,canvasPtr->canvas_info)+ + y_coord(i+1,canvasPtr->canvas_info))/2.0; + dy = y-y_coord(0,canvasPtr->canvas_info); + + textPtr->header.x1 = 6; + textPtr->header.x2 = 20; + textPtr->header.y1 = dy-7; + textPtr->header.y2 = dy-7; + textPtr->leftEdge=6; + + aux=(char*) malloc(strlen(" ")+1); + sprintf(aux,"%4d",i+1); + + /* sera que isto vale a pena??? */ + textPtr->textLayout= + Tk_ComputeTextLayout(textPtr->tkfont,aux,-1,-1, + TK_JUSTIFY_CENTER,0,NULL,NULL); + (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, + itemPtr, + canvasPtr->display,pixmap, + screenX1, screenY1, width, + height); + } + free(aux); + } + if(!strcmp(itemPtr->staticTagSpace[0],"Zcellborders")) { + int x,i; + LineItem *linePtr; + + linePtr = (LineItem *) itemPtr; + linePtr->coordPtr[1] = 0; + linePtr->coordPtr[3] = y_coord(8096,canvasPtr->canvas_info); + for ( i = cell_col(screenX1,canvasPtr->canvas_info), + x = x_coord(i,canvasPtr->canvas_info); + x < screenX2; + i++, x = x_coord(i,canvasPtr->canvas_info)) { + linePtr->coordPtr[0] = x; + linePtr->coordPtr[2] = x; + (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, + itemPtr, + canvasPtr->display,pixmap, + screenX1, screenY1, width, + height); + } + linePtr->coordPtr[0] = 0; + linePtr->coordPtr[2] = x_coord(256,canvasPtr->canvas_info); + for ( i = cell_col(screenY1,canvasPtr->canvas_info), + x = y_coord(i,canvasPtr->canvas_info); + x < screenY2; + i++, x = y_coord(i,canvasPtr->canvas_info)) { + linePtr->coordPtr[1] = x; + linePtr->coordPtr[3] = x; + (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, + itemPtr, + canvasPtr->display,pixmap, + screenX1, screenY1, width, + height); + } + } + /* + (*itemPtr->typePtr->displayProc) + ((Tk_Canvas) canvasPtr, itemPtr,canvasPtr->display, pixmap, + screenX1, screenY1, width,height); + */ + } + else { + int dx1,dx2,dy1,dy2; + + computeDxy(itemPtr,canvasPtr,&dx1,&dx2,&dy1,&dy2); + if ((itemPtr->x1+dx1 >= screenX2) + || (itemPtr->y1+dy1 >= screenY2) + || (itemPtr->x2+dx2 < screenX1) + || (itemPtr->y2+dy2 < screenY1)) { + if (!itemPtr->typePtr->alwaysRedraw + || (itemPtr->x1+dx1 >= canvasPtr->redrawX2) + || (itemPtr->y1+dy1 >= canvasPtr->redrawY2) + || (itemPtr->x2+dx2 < canvasPtr->redrawX1) + || (itemPtr->y2+dy2 < canvasPtr->redrawY1)) { + continue; + } + } + computeOffset(itemPtr,canvasPtr,dx1,dx2,dy1,dy2); + (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr,itemPtr, + canvasPtr->display, pixmap, + screenX1, screenY1, width, + height); + decomputeOffset(itemPtr,canvasPtr,dx1,dx2,dy1,dy2); + } + } + + /* + * Copy from the temporary pixmap to the screen, then free up + * the temporary pixmap. + */ + + XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin), + canvasPtr->pixmapGC, + screenX1 - canvasPtr->drawableXOrigin, + screenY1 - canvasPtr->drawableYOrigin, + (unsigned) (screenX2 - screenX1), + (unsigned) (screenY2 - screenY1), + screenX1 - canvasPtr->xOrigin, screenY1 - canvasPtr->yOrigin); + Tk_FreePixmap(Tk_Display(tkwin), pixmap); + } + + /* + * Draw the window borders, if needed. + */ + + borders: + if (canvasPtr->flags & REDRAW_BORDERS) { + canvasPtr->flags &= ~REDRAW_BORDERS; + if (canvasPtr->borderWidth > 0) { + Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), + canvasPtr->bgBorder, canvasPtr->highlightWidth, + canvasPtr->highlightWidth, + Tk_Width(tkwin) - 2*canvasPtr->highlightWidth, + Tk_Height(tkwin) - 2*canvasPtr->highlightWidth, + canvasPtr->borderWidth, canvasPtr->relief); + } + if (canvasPtr->highlightWidth != 0) { + GC fgGC, bgGC; + + bgGC = Tk_GCForColor(canvasPtr->highlightBgColorPtr, + Tk_WindowId(tkwin)); + if (canvasPtr->textInfo.gotFocus) { + fgGC = Tk_GCForColor(canvasPtr->highlightColorPtr, + Tk_WindowId(tkwin)); + TkpDrawHighlightBorder(tkwin, fgGC, bgGC, + canvasPtr->highlightWidth, Tk_WindowId(tkwin)); + } else { + TkpDrawHighlightBorder(tkwin, bgGC, bgGC, + canvasPtr->highlightWidth, Tk_WindowId(tkwin)); + } + } + } + + done: + canvasPtr->flags &= ~REDRAW_PENDING; + canvasPtr->redrawX1 = canvasPtr->redrawX2 = 0; + canvasPtr->redrawY1 = canvasPtr->redrawY2 = 0; + if (canvasPtr->flags & UPDATE_SCROLLBARS) { + CanvasUpdateScrollbars(canvasPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * CanvasEventProc -- + * + * This procedure is invoked by the Tk dispatcher for various + * events on canvases. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +CanvasEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + XEvent *eventPtr; /* Information about event. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) clientData; + + if (eventPtr->type == Expose) { + int x, y; + + x = eventPtr->xexpose.x + canvasPtr->xOrigin; + y = eventPtr->xexpose.y + canvasPtr->yOrigin; + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x, y, + x + eventPtr->xexpose.width, + y + eventPtr->xexpose.height); + if ((eventPtr->xexpose.x < canvasPtr->inset) + || (eventPtr->xexpose.y < canvasPtr->inset) + || ((eventPtr->xexpose.x + eventPtr->xexpose.width) + > (Tk_Width(canvasPtr->tkwin) - canvasPtr->inset)) + || ((eventPtr->xexpose.y + eventPtr->xexpose.height) + > (Tk_Height(canvasPtr->tkwin) - canvasPtr->inset))) { + canvasPtr->flags |= REDRAW_BORDERS; + } + } else if (eventPtr->type == DestroyNotify) { + if (canvasPtr->tkwin != NULL) { + canvasPtr->tkwin = NULL; + Tcl_DeleteCommandFromToken(canvasPtr->interp, + canvasPtr->widgetCmd); + } + if (canvasPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr); + } + Tcl_EventuallyFree((ClientData) canvasPtr, DestroyCanvas); + } else if (eventPtr->type == ConfigureNotify) { + canvasPtr->flags |= UPDATE_SCROLLBARS; + + /* + * The call below is needed in order to recenter the canvas if + * it's confined and its scroll region is smaller than the window. + */ + + CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin); + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, canvasPtr->xOrigin, + canvasPtr->yOrigin, + canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin), + canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)); + canvasPtr->flags |= REDRAW_BORDERS; + } else if (eventPtr->type == FocusIn) { + if (eventPtr->xfocus.detail != NotifyInferior) { + CanvasFocusProc(canvasPtr, 1); + } + } else if (eventPtr->type == FocusOut) { + if (eventPtr->xfocus.detail != NotifyInferior) { + CanvasFocusProc(canvasPtr, 0); + } + } else if (eventPtr->type == UnmapNotify) { + Tk_Item *itemPtr; + + /* + * Special hack: if the canvas is unmapped, then must notify + * all items with "alwaysRedraw" set, so that they know that + * they are no longer displayed. + */ + + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + if (itemPtr->typePtr->alwaysRedraw) { + (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, + itemPtr, canvasPtr->display, None, 0, 0, 0, 0); + } + } + } +} + +/* + *---------------------------------------------------------------------- + * + * CanvasCmdDeletedProc -- + * + * This procedure is invoked when a widget command is deleted. If + * the widget isn't already in the process of being destroyed, + * this command destroys it. + * + * Results: + * None. + * + * Side effects: + * The widget is destroyed. + * + *---------------------------------------------------------------------- + */ + +static void +CanvasCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) clientData; + Tk_Window tkwin = canvasPtr->tkwin; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case tkwin + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (tkwin != NULL) { + canvasPtr->tkwin = NULL; + Tk_DestroyWindow(tkwin); + } +} + +/* + *-------------------------------------------------------------- + * + * Xxl_CanvasEventuallyRedraw -- + * + * Arrange for part or all of a canvas widget to redrawn at + * some convenient time in the future. + * + * Results: + * None. + * + * Side effects: + * The screen will eventually be refreshed. + * + *-------------------------------------------------------------- + */ + +void +Xxl_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2) + Tk_Canvas canvas; /* Information about widget. */ + int x1, y1; /* Upper left corner of area to redraw. + * Pixels on edge are redrawn. */ + int x2, y2; /* Lower right corner of area to redraw. + * Pixels on edge are not redrawn. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) canvas; + if ((x1 == x2) || (y1 == y2)) { + return; + } + if (canvasPtr->flags & REDRAW_PENDING) { + if (x1 <= canvasPtr->redrawX1) { + canvasPtr->redrawX1 = x1; + } + if (y1 <= canvasPtr->redrawY1) { + canvasPtr->redrawY1 = y1; + } + if (x2 >= canvasPtr->redrawX2) { + canvasPtr->redrawX2 = x2; + } + if (y2 >= canvasPtr->redrawY2) { + canvasPtr->redrawY2 = y2; + } + } else { + canvasPtr->redrawX1 = x1; + canvasPtr->redrawY1 = y1; + canvasPtr->redrawX2 = x2; + canvasPtr->redrawY2 = y2; + Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr); + canvasPtr->flags |= REDRAW_PENDING; + } +} + +/* + *-------------------------------------------------------------- + * + * Xxl_CreateItemType -- + * + * This procedure may be invoked to add a new kind of canvas + * element to the core item types supported by Tk. + * + * Results: + * None. + * + * Side effects: + * From now on, the new item type will be useable in canvas + * widgets (e.g. typePtr->name can be used as the item type + * in "create" widget commands). If there was already a + * type with the same name as in typePtr, it is replaced with + * the new type. + * + *-------------------------------------------------------------- + */ + +void +Xxl_CreateItemType(typePtr) + Tk_ItemType *typePtr; /* Information about item type; + * storage must be statically + * allocated (must live forever). */ +{ + Tk_ItemType *typePtr2, *prevPtr; + + if (typeList == NULL) { + InitCanvas(); + } + + /* + * If there's already an item type with the given name, remove it. + */ + + for (typePtr2 = typeList, prevPtr = NULL; typePtr2 != NULL; + prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) { + if (strcmp(typePtr2->name, typePtr->name) == 0) { + if (prevPtr == NULL) { + typeList = typePtr2->nextPtr; + } else { + prevPtr->nextPtr = typePtr2->nextPtr; + } + break; + } + } + typePtr->nextPtr = typeList; + typeList = typePtr; +} + +/* + *---------------------------------------------------------------------- + * + * Xxl_GetItemTypes -- + * + * This procedure returns a pointer to the list of all item + * types. + * + * Results: + * The return value is a pointer to the first in the list + * of item types currently supported by canvases. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tk_ItemType * +Xxl_GetItemTypes() +{ + if (typeList == NULL) { + InitCanvas(); + } + return typeList; +} + +/* + *-------------------------------------------------------------- + * + * InitCanvas -- + * + * This procedure is invoked to perform once-only-ever + * initialization for the module, such as setting up + * the type table. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +InitCanvas() +{ + if (typeList != NULL) { + return; + } + typeList = &tkRectangleType; + tkRectangleType.nextPtr = &tkTextType; + tkTextType.nextPtr = &tkLineType; + tkLineType.nextPtr = &tkPolygonType; + tkPolygonType.nextPtr = &tkImageType; + tkImageType.nextPtr = &tkOvalType; + tkOvalType.nextPtr = &tkBitmapType; + tkBitmapType.nextPtr = &tkArcType; + tkArcType.nextPtr = &tkWindowType; + tkWindowType.nextPtr = NULL; +} + +/* + *-------------------------------------------------------------- + * + * StartTagSearch -- + * + * This procedure is called to initiate an enumeration of + * all items in a given canvas that contain a given tag. + * + * Results: + * The return value is a pointer to the first item in + * canvasPtr that matches tag, or NULL if there is no + * such item. The information at *searchPtr is initialized + * such that successive calls to NextItem will return + * successive items that match tag. + * + * Side effects: + * SearchPtr is linked into a list of searches in progress + * on canvasPtr, so that elements can safely be deleted + * while the search is in progress. EndTagSearch must be + * called at the end of the search to unlink searchPtr from + * this list. + * + *-------------------------------------------------------------- + */ + +static Tk_Item * +StartTagSearch(canvasPtr, tag, searchPtr) + TkCanvas *canvasPtr; /* Canvas whose items are to be + * searched. */ + char *tag; /* String giving tag value. */ + TagSearch *searchPtr; /* Record describing tag search; + * will be initialized here. */ +{ + int id; + Tk_Item *itemPtr, *lastPtr; + Tk_Uid *tagPtr; + Tk_Uid uid; + int count; + TkWindow *tkwin; + TkDisplay *dispPtr; + + tkwin = (TkWindow *) canvasPtr->tkwin; + dispPtr = tkwin->dispPtr; + + /* + * Initialize the search. + */ + + searchPtr->canvasPtr = canvasPtr; + searchPtr->searchOver = 0; + + /* + * Find the first matching item in one of several ways. If the tag + * is a number then it selects the single item with the matching + * identifier. In this case see if the item being requested is the + * hot item, in which case the search can be skipped. + */ + + if (isdigit(UCHAR(*tag))) { + char *end; + Tcl_HashEntry *entryPtr; + + dispPtr->numIdSearches++; + id = strtoul(tag, &end, 0); + if (*end == 0) { + itemPtr = canvasPtr->hotPtr; + lastPtr = canvasPtr->hotPrevPtr; + if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL) + || (lastPtr->nextPtr != itemPtr)) { + dispPtr->numSlowSearches++; + entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); + if (entryPtr != NULL) { + itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr); + lastPtr = itemPtr->prevPtr; + } else { + lastPtr = itemPtr = NULL; + } + } + searchPtr->lastPtr = lastPtr; + searchPtr->searchOver = 1; + canvasPtr->hotPtr = itemPtr; + canvasPtr->hotPrevPtr = lastPtr; + return itemPtr; + } + } + + searchPtr->tag = uid = Tk_GetUid(tag); + if (uid == Tk_GetUid("all")) { + + /* + * All items match. + */ + + searchPtr->tag = NULL; + searchPtr->lastPtr = NULL; + searchPtr->currentPtr = canvasPtr->firstItemPtr; + return canvasPtr->firstItemPtr; + } + + /* + * None of the above. Search for an item with a matching tag. + */ + + for (lastPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) { + for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags; + count > 0; tagPtr++, count--) { + if (*tagPtr == uid) { + searchPtr->lastPtr = lastPtr; + searchPtr->currentPtr = itemPtr; + return itemPtr; + } + } + } + searchPtr->lastPtr = lastPtr; + searchPtr->searchOver = 1; + return NULL; +} + +/* + *-------------------------------------------------------------- + * + * NextItem -- + * + * This procedure returns successive items that match a given + * tag; it should be called only after StartTagSearch has been + * used to begin a search. + * + * Results: + * The return value is a pointer to the next item that matches + * the tag specified to StartTagSearch, or NULL if no such + * item exists. *SearchPtr is updated so that the next call + * to this procedure will return the next item. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static Tk_Item * +NextItem(searchPtr) + TagSearch *searchPtr; /* Record describing search in + * progress. */ +{ + Tk_Item *itemPtr, *lastPtr; + int count; + Tk_Uid uid; + Tk_Uid *tagPtr; + + /* + * Find next item in list (this may not actually be a suitable + * one to return), and return if there are no items left. + */ + + lastPtr = searchPtr->lastPtr; + if (lastPtr == NULL) { + itemPtr = searchPtr->canvasPtr->firstItemPtr; + } else { + itemPtr = lastPtr->nextPtr; + } + if ((itemPtr == NULL) || (searchPtr->searchOver)) { + searchPtr->searchOver = 1; + return NULL; + } + if (itemPtr != searchPtr->currentPtr) { + /* + * The structure of the list has changed. Probably the + * previously-returned item was removed from the list. + * In this case, don't advance lastPtr; just return + * its new successor (i.e. do nothing here). + */ + } else { + lastPtr = itemPtr; + itemPtr = lastPtr->nextPtr; + } + + /* + * Handle special case of "all" search by returning next item. + */ + + uid = searchPtr->tag; + if (uid == NULL) { + searchPtr->lastPtr = lastPtr; + searchPtr->currentPtr = itemPtr; + return itemPtr; + } + + /* + * Look for an item with a particular tag. + */ + + for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) { + for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags; + count > 0; tagPtr++, count--) { + if (*tagPtr == uid) { + searchPtr->lastPtr = lastPtr; + searchPtr->currentPtr = itemPtr; + return itemPtr; + } + } + } + searchPtr->lastPtr = lastPtr; + searchPtr->searchOver = 1; + return NULL; +} + +/* + *-------------------------------------------------------------- + * + * DoItem -- + * + * This is a utility procedure called by FindItems. It + * either adds itemPtr's id to the result forming in interp, + * or it adds a new tag to itemPtr, depending on the value + * of tag. + * + * Results: + * None. + * + * Side effects: + * If tag is NULL then itemPtr's id is added as a list element + * to the interp's result; otherwise tag is added to itemPtr's + * list of tags. + * + *-------------------------------------------------------------- + */ + +static void +DoItem(interp, itemPtr, tag) + Tcl_Interp *interp; /* Interpreter in which to (possibly) + * record item id. */ + Tk_Item *itemPtr; /* Item to (possibly) modify. */ + Tk_Uid tag; /* Tag to add to those already + * present for item, or NULL. */ +{ + Tk_Uid *tagPtr; + int count; + + /* + * Handle the "add-to-result" case and return, if appropriate. + */ + + if (tag == NULL) { + char msg[TCL_INTEGER_SPACE]; + + sprintf(msg, "%d", itemPtr->id); + Tcl_AppendElement(interp, msg); + return; + } + + for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags; + count > 0; tagPtr++, count--) { + if (tag == *tagPtr) { + return; + } + } + + /* + * Grow the tag space if there's no more room left in the current + * block. + */ + + if (itemPtr->tagSpace == itemPtr->numTags) { + Tk_Uid *newTagPtr; + + itemPtr->tagSpace += 5; + newTagPtr = (Tk_Uid *) ckalloc((unsigned) + (itemPtr->tagSpace * sizeof(Tk_Uid))); + memcpy((VOID *) newTagPtr, (VOID *) itemPtr->tagPtr, + (itemPtr->numTags * sizeof(Tk_Uid))); + if (itemPtr->tagPtr != itemPtr->staticTagSpace) { + ckfree((char *) itemPtr->tagPtr); + } + itemPtr->tagPtr = newTagPtr; + tagPtr = &itemPtr->tagPtr[itemPtr->numTags]; + } + + /* + * Add in the new tag. + */ + + *tagPtr = tag; + itemPtr->numTags++; +} + +/* + *-------------------------------------------------------------- + * + * FindItems -- + * + * This procedure does all the work of implementing the + * "find" and "addtag" options of the canvas widget command, + * which locate items that have certain features (location, + * tags, position in display list, etc.). + * + * Results: + * A standard Tcl return value. If newTag is NULL, then a + * list of ids from all the items that match argc/argv is + * returned in the interp's result. If newTag is NULL, then + * the normal the interp's result is an empty string. If an error + * occurs, then the interp's result will hold an error message. + * + * Side effects: + * If newTag is non-NULL, then all the items that match the + * information in argc/argv have that tag added to their + * lists of tags. + * + *-------------------------------------------------------------- + */ + +static int +FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + TkCanvas *canvasPtr; /* Canvas whose items are to be + * searched. */ + int argc; /* Number of entries in argv. Must be + * greater than zero. */ + char **argv; /* Arguments that describe what items + * to search for (see user doc on + * "find" and "addtag" options). */ + char *newTag; /* If non-NULL, gives new tag to set + * on all found items; if NULL, then + * ids of found items are returned + * in the interp's result. */ + char *cmdName; /* Name of original Tcl command, for + * use in error messages. */ + char *option; /* For error messages: gives option + * from Tcl command and other stuff + * up to what's in argc/argv. */ +{ + int c; + size_t length; + TagSearch search; + Tk_Item *itemPtr; + Tk_Uid uid; + + if (newTag != NULL) { + uid = Tk_GetUid(newTag); + } else { + uid = NULL; + } + c = argv[0][0]; + length = strlen(argv[0]); + if ((c == 'a') && (strncmp(argv[0], "above", length) == 0) + && (length >= 2)) { + Tk_Item *lastPtr = NULL; + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + cmdName, option, " above tagOrId", (char *) NULL); + return TCL_ERROR; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[1], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + lastPtr = itemPtr; + } + if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) { + DoItem(interp, lastPtr->nextPtr, uid); + } + } else if ((c == 'a') && (strncmp(argv[0], "all", length) == 0) + && (length >= 2)) { + if (argc != 1) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + cmdName, option, " all", (char *) NULL); + return TCL_ERROR; + } + + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + DoItem(interp, itemPtr, uid); + } + } else if ((c == 'b') && (strncmp(argv[0], "below", length) == 0)) { + Tk_Item *itemPtr; + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + cmdName, option, " below tagOrId", (char *) NULL); + return TCL_ERROR; + } + itemPtr = StartTagSearch(canvasPtr, argv[1], &search); + if (itemPtr != NULL) { + if (itemPtr->prevPtr != NULL) { + DoItem(interp, itemPtr->prevPtr, uid); + } + } + } else if ((c == 'c') && (strncmp(argv[0], "closest", length) == 0)) { + double closestDist; + Tk_Item *startPtr, *closestPtr; + double coords[2], halo; + int x1, y1, x2, y2; + + if ((argc < 3) || (argc > 5)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + cmdName, option, " closest x y ?halo? ?start?", + (char *) NULL); + return TCL_ERROR; + } + if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[1], + &coords[0]) != TCL_OK) || (Tk_CanvasGetCoord(interp, + (Tk_Canvas) canvasPtr, argv[2], &coords[1]) != TCL_OK)) { + return TCL_ERROR; + } + if (argc > 3) { + if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3], + &halo) != TCL_OK) { + return TCL_ERROR; + } + if (halo < 0.0) { + Tcl_AppendResult(interp, "can't have negative halo value \"", + argv[3], "\"", (char *) NULL); + return TCL_ERROR; + } + } else { + halo = 0.0; + } + + /* + * Find the item at which to start the search. + */ + + startPtr = canvasPtr->firstItemPtr; + if (argc == 5) { + itemPtr = StartTagSearch(canvasPtr, argv[4], &search); + if (itemPtr != NULL) { + startPtr = itemPtr; + } + } + + /* + * The code below is optimized so that it can eliminate most + * items without having to call their item-specific procedures. + * This is done by keeping a bounding box (x1, y1, x2, y2) that + * an item's bbox must overlap if the item is to have any + * chance of being closer than the closest so far. + */ + + itemPtr = startPtr; + if (itemPtr == NULL) { + return TCL_OK; + } + closestDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr, + itemPtr, coords) - halo; + if (closestDist < 0.0) { + closestDist = 0.0; + } + while (1) { + double newDist; + + /* + * Update the bounding box using itemPtr, which is the + * new closest item. + */ + + x1 = (int) (coords[0] - closestDist - halo - 1); + y1 = (int) (coords[1] - closestDist - halo - 1); + x2 = (int) (coords[0] + closestDist + halo + 1); + y2 = (int) (coords[1] + closestDist + halo + 1); + closestPtr = itemPtr; + + /* + * Search for an item that beats the current closest one. + * Work circularly through the canvas's item list until + * getting back to the starting item. + */ + + while (1) { + itemPtr = itemPtr->nextPtr; + if (itemPtr == NULL) { + itemPtr = canvasPtr->firstItemPtr; + } + if (itemPtr == startPtr) { + DoItem(interp, closestPtr, uid); + return TCL_OK; + } + if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1) + || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) { + continue; + } + newDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr, + itemPtr, coords) - halo; + if (newDist < 0.0) { + newDist = 0.0; + } + if (newDist <= closestDist) { + closestDist = newDist; + break; + } + } + } + } else if ((c == 'e') && (strncmp(argv[0], "enclosed", length) == 0)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + cmdName, option, " enclosed x1 y1 x2 y2", (char *) NULL); + return TCL_ERROR; + } + return FindArea(interp, canvasPtr, argv+1, uid, 1); + } else if ((c == 'o') && (strncmp(argv[0], "overlapping", length) == 0)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + cmdName, option, " overlapping x1 y1 x2 y2", + (char *) NULL); + return TCL_ERROR; + } + return FindArea(interp, canvasPtr, argv+1, uid, 0); + } else if ((c == 'w') && (strncmp(argv[0], "withtag", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + cmdName, option, " withtag tagOrId", (char *) NULL); + return TCL_ERROR; + } + for (itemPtr = StartTagSearch(canvasPtr, argv[1], &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + DoItem(interp, itemPtr, uid); + } + } else { + Tcl_AppendResult(interp, "bad search command \"", argv[0], + "\": must be above, all, below, closest, enclosed, ", + "overlapping, or withtag", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * FindArea -- + * + * This procedure implements area searches for the "find" + * and "addtag" options. + * + * Results: + * A standard Tcl return value. If newTag is NULL, then a + * list of ids from all the items overlapping or enclosed + * by the rectangle given by argc is returned in the interp's result. + * If newTag is NULL, then the normal the interp's result is an + * empty string. If an error occurs, then the interp's result will + * hold an error message. + * + * Side effects: + * If uid is non-NULL, then all the items overlapping + * or enclosed by the area in argv have that tag added to + * their lists of tags. + * + *-------------------------------------------------------------- + */ + +static int +FindArea(interp, canvasPtr, argv, uid, enclosed) + Tcl_Interp *interp; /* Interpreter for error reporting + * and result storing. */ + TkCanvas *canvasPtr; /* Canvas whose items are to be + * searched. */ + char **argv; /* Array of four arguments that + * give the coordinates of the + * rectangular area to search. */ + Tk_Uid uid; /* If non-NULL, gives new tag to set + * on all found items; if NULL, then + * ids of found items are returned + * in the interp's result. */ + int enclosed; /* 0 means overlapping or enclosed + * items are OK, 1 means only enclosed + * items are OK. */ +{ + double rect[4], tmp; + int x1, y1, x2, y2; + Tk_Item *itemPtr; + + if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[0], + &rect[0]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[1], + &rect[1]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[2], + &rect[2]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3], + &rect[3]) != TCL_OK)) { + return TCL_ERROR; + } + if (rect[0] > rect[2]) { + tmp = rect[0]; rect[0] = rect[2]; rect[2] = tmp; + } + if (rect[1] > rect[3]) { + tmp = rect[1]; rect[1] = rect[3]; rect[3] = tmp; + } + + /* + * Use an integer bounding box for a quick test, to avoid + * calling item-specific code except for items that are close. + */ + + x1 = (int) (rect[0]-1.0); + y1 = (int) (rect[1]-1.0); + x2 = (int) (rect[2]+1.0); + y2 = (int) (rect[3]+1.0); + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1) + || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) { + continue; + } + if ((*itemPtr->typePtr->areaProc)((Tk_Canvas) canvasPtr, itemPtr, rect) + >= enclosed) { + DoItem(interp, itemPtr, uid); + } + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * RelinkItems -- + * + * Move one or more items to a different place in the + * display order for a canvas. + * + * Results: + * None. + * + * Side effects: + * The items identified by "tag" are moved so that they + * are all together in the display list and immediately + * after prevPtr. The order of the moved items relative + * to each other is not changed. + * + *-------------------------------------------------------------- + */ + +static void +RelinkItems(canvasPtr, tag, prevPtr) + TkCanvas *canvasPtr; /* Canvas to be modified. */ + char *tag; /* Tag identifying items to be moved + * in the redisplay list. */ + Tk_Item *prevPtr; /* Reposition the items so that they + * go just after this item (NULL means + * put at beginning of list). */ +{ + Tk_Item *itemPtr; + TagSearch search; + Tk_Item *firstMovePtr, *lastMovePtr; + + /* + * Find all of the items to be moved and remove them from + * the list, making an auxiliary list running from firstMovePtr + * to lastMovePtr. Record their areas for redisplay. + */ + + firstMovePtr = lastMovePtr = NULL; + for (itemPtr = StartTagSearch(canvasPtr, tag, &search); + itemPtr != NULL; itemPtr = NextItem(&search)) { + if (itemPtr == prevPtr) { + /* + * Item after which insertion is to occur is being + * moved! Switch to insert after its predecessor. + */ + + prevPtr = prevPtr->prevPtr; + } + if (itemPtr->prevPtr == NULL) { + if (itemPtr->nextPtr != NULL) { + itemPtr->nextPtr->prevPtr = NULL; + } + canvasPtr->firstItemPtr = itemPtr->nextPtr; + } else { + if (itemPtr->nextPtr != NULL) { + itemPtr->nextPtr->prevPtr = itemPtr->prevPtr; + } + itemPtr->prevPtr->nextPtr = itemPtr->nextPtr; + } + if (canvasPtr->lastItemPtr == itemPtr) { + canvasPtr->lastItemPtr = itemPtr->prevPtr; + } + if (firstMovePtr == NULL) { + itemPtr->prevPtr = NULL; + firstMovePtr = itemPtr; + } else { + itemPtr->prevPtr = lastMovePtr; + lastMovePtr->nextPtr = itemPtr; + } + lastMovePtr = itemPtr; + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1, itemPtr->y1, + itemPtr->x2, itemPtr->y2); + canvasPtr->flags |= REPICK_NEEDED; + } + + /* + * Insert the list of to-be-moved items back into the canvas's + * at the desired position. + */ + + if (firstMovePtr == NULL) { + return; + } + if (prevPtr == NULL) { + if (canvasPtr->firstItemPtr != NULL) { + canvasPtr->firstItemPtr->prevPtr = lastMovePtr; + } + lastMovePtr->nextPtr = canvasPtr->firstItemPtr; + canvasPtr->firstItemPtr = firstMovePtr; + } else { + if (prevPtr->nextPtr != NULL) { + prevPtr->nextPtr->prevPtr = lastMovePtr; + } + lastMovePtr->nextPtr = prevPtr->nextPtr; + if (firstMovePtr != NULL) { + firstMovePtr->prevPtr = prevPtr; + } + prevPtr->nextPtr = firstMovePtr; + } + if (canvasPtr->lastItemPtr == prevPtr) { + canvasPtr->lastItemPtr = lastMovePtr; + } +} + +/* + *-------------------------------------------------------------- + * + * CanvasBindProc -- + * + * This procedure is invoked by the Tk dispatcher to handle + * events associated with bindings on items. + * + * Results: + * None. + * + * Side effects: + * Depends on the command invoked as part of the binding + * (if there was any). + * + *-------------------------------------------------------------- + */ + +static void +CanvasBindProc(clientData, eventPtr) + ClientData clientData; /* Pointer to canvas structure. */ + XEvent *eventPtr; /* Pointer to X event that just + * happened. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) clientData; + + Tcl_Preserve((ClientData) canvasPtr); + + /* + * This code below keeps track of the current modifier state in + * canvasPtr>state. This information is used to defer repicks of + * the current item while buttons are down. + */ + + if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) { + int mask; + + switch (eventPtr->xbutton.button) { + case Button1: + mask = Button1Mask; + break; + case Button2: + mask = Button2Mask; + break; + case Button3: + mask = Button3Mask; + break; + case Button4: + mask = Button4Mask; + break; + case Button5: + mask = Button5Mask; + break; + default: + mask = 0; + break; + } + + /* + * For button press events, repick the current item using the + * button state before the event, then process the event. For + * button release events, first process the event, then repick + * the current item using the button state *after* the event + * (the button has logically gone up before we change the + * current item). + */ + + if (eventPtr->type == ButtonPress) { + /* + * On a button press, first repick the current item using + * the button state before the event, the process the event. + */ + + canvasPtr->state = eventPtr->xbutton.state; + PickCurrentItem(canvasPtr, eventPtr); + canvasPtr->state ^= mask; + CanvasDoEvent(canvasPtr, eventPtr); + } else { + /* + * Button release: first process the event, with the button + * still considered to be down. Then repick the current + * item under the assumption that the button is no longer down. + */ + + canvasPtr->state = eventPtr->xbutton.state; + CanvasDoEvent(canvasPtr, eventPtr); + eventPtr->xbutton.state ^= mask; + canvasPtr->state = eventPtr->xbutton.state; + PickCurrentItem(canvasPtr, eventPtr); + eventPtr->xbutton.state ^= mask; + } + goto done; + } else if ((eventPtr->type == EnterNotify) + || (eventPtr->type == LeaveNotify)) { + canvasPtr->state = eventPtr->xcrossing.state; + PickCurrentItem(canvasPtr, eventPtr); + goto done; + } else if (eventPtr->type == MotionNotify) { + canvasPtr->state = eventPtr->xmotion.state; + PickCurrentItem(canvasPtr, eventPtr); + } + CanvasDoEvent(canvasPtr, eventPtr); + + done: + Tcl_Release((ClientData) canvasPtr); +} + +/* + *-------------------------------------------------------------- + * + * PickCurrentItem -- + * + * Find the topmost item in a canvas that contains a given + * location and mark the the current item. If the current + * item has changed, generate a fake exit event on the old + * current item and a fake enter event on the new current + * item. + * + * Results: + * None. + * + * Side effects: + * The current item for canvasPtr may change. If it does, + * then the commands associated with item entry and exit + * could do just about anything. A binding script could + * delete the canvas, so callers should protect themselves + * with Tcl_Preserve and Tcl_Release. + * + *-------------------------------------------------------------- + */ + +static void +PickCurrentItem(canvasPtr, eventPtr) + TkCanvas *canvasPtr; /* Canvas widget in which to select + * current item. */ + XEvent *eventPtr; /* Event describing location of + * mouse cursor. Must be EnterWindow, + * LeaveWindow, ButtonRelease, or + * MotionNotify. */ +{ + double coords[2]; + int buttonDown; + + /* + * Check whether or not a button is down. If so, we'll log entry + * and exit into and out of the current item, but not entry into + * any other item. This implements a form of grabbing equivalent + * to what the X server does for windows. + */ + + buttonDown = canvasPtr->state + & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask); + if (!buttonDown) { + canvasPtr->flags &= ~LEFT_GRABBED_ITEM; + } + + /* + * Save information about this event in the canvas. The event in + * the canvas is used for two purposes: + * + * 1. Event bindings: if the current item changes, fake events are + * generated to allow item-enter and item-leave bindings to trigger. + * 2. Reselection: if the current item gets deleted, can use the + * saved event to find a new current item. + * Translate MotionNotify events into EnterNotify events, since that's + * what gets reported to item handlers. + */ + + if (eventPtr != &canvasPtr->pickEvent) { + if ((eventPtr->type == MotionNotify) + || (eventPtr->type == ButtonRelease)) { + canvasPtr->pickEvent.xcrossing.type = EnterNotify; + canvasPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial; + canvasPtr->pickEvent.xcrossing.send_event + = eventPtr->xmotion.send_event; + canvasPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display; + canvasPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window; + canvasPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root; + canvasPtr->pickEvent.xcrossing.subwindow = None; + canvasPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time; + canvasPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x; + canvasPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y; + canvasPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root; + canvasPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root; + canvasPtr->pickEvent.xcrossing.mode = NotifyNormal; + canvasPtr->pickEvent.xcrossing.detail = NotifyNonlinear; + canvasPtr->pickEvent.xcrossing.same_screen + = eventPtr->xmotion.same_screen; + canvasPtr->pickEvent.xcrossing.focus = False; + canvasPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state; + } else { + canvasPtr->pickEvent = *eventPtr; + } + } + + /* + * If this is a recursive call (there's already a partially completed + * call pending on the stack; it's in the middle of processing a + * Leave event handler for the old current item) then just return; + * the pending call will do everything that's needed. + */ + + if (canvasPtr->flags & REPICK_IN_PROGRESS) { + return; + } + + /* + * A LeaveNotify event automatically means that there's no current + * object, so the check for closest item can be skipped. + */ + + coords[0] = canvasPtr->pickEvent.xcrossing.x + canvasPtr->xOrigin; + coords[1] = canvasPtr->pickEvent.xcrossing.y + canvasPtr->yOrigin; + if (canvasPtr->pickEvent.type != LeaveNotify) { + canvasPtr->newCurrentPtr = CanvasFindClosest(canvasPtr, coords); + } else { + canvasPtr->newCurrentPtr = NULL; + } + + if ((canvasPtr->newCurrentPtr == canvasPtr->currentItemPtr) + && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) { + /* + * Nothing to do: the current item hasn't changed. + */ + + return; + } + + /* + * Simulate a LeaveNotify event on the previous current item and + * an EnterNotify event on the new current item. Remove the "current" + * tag from the previous current item and place it on the new current + * item. + */ + + if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr) + && (canvasPtr->currentItemPtr != NULL) + && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) { + XEvent event; + Tk_Item *itemPtr = canvasPtr->currentItemPtr; + int i; + + event = canvasPtr->pickEvent; + event.type = LeaveNotify; + + /* + * If the event's detail happens to be NotifyInferior the + * binding mechanism will discard the event. To be consistent, + * always use NotifyAncestor. + */ + + event.xcrossing.detail = NotifyAncestor; + canvasPtr->flags |= REPICK_IN_PROGRESS; + CanvasDoEvent(canvasPtr, &event); + canvasPtr->flags &= ~REPICK_IN_PROGRESS; + + /* + * The check below is needed because there could be an event + * handler for that deletes the current item. + */ + + if ((itemPtr == canvasPtr->currentItemPtr) && !buttonDown) { + for (i = itemPtr->numTags-1; i >= 0; i--) { + if (itemPtr->tagPtr[i] == Tk_GetUid("current")) { + itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1]; + itemPtr->numTags--; + break; + } + } + } + + /* + * Note: during CanvasDoEvent above, it's possible that + * canvasPtr->newCurrentPtr got reset to NULL because the + * item was deleted. + */ + } + if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr) && buttonDown) { + canvasPtr->flags |= LEFT_GRABBED_ITEM; + return; + } + + /* + * Special note: it's possible that canvasPtr->newCurrentPtr == + * canvasPtr->currentItemPtr here. This can happen, for example, + * if LEFT_GRABBED_ITEM was set. + */ + + canvasPtr->flags &= ~LEFT_GRABBED_ITEM; + canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr; + if (canvasPtr->currentItemPtr != NULL) { + XEvent event; + + DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, + Tk_GetUid("current")); + event = canvasPtr->pickEvent; + event.type = EnterNotify; + event.xcrossing.detail = NotifyAncestor; + CanvasDoEvent(canvasPtr, &event); + } +} + +/* + *---------------------------------------------------------------------- + * + * CanvasFindClosest -- + * + * Given x and y coordinates, find the topmost canvas item that + * is "close" to the coordinates. + * + * Results: + * The return value is a pointer to the topmost item that is + * close to (x,y), or NULL if no item is close. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static Tk_Item * +CanvasFindClosest(canvasPtr, coords) + TkCanvas *canvasPtr; /* Canvas widget to search. */ + double coords[2]; /* Desired x,y position in canvas, + * not screen, coordinates.) */ +{ + Tk_Item *itemPtr; + Tk_Item *bestPtr; + int x1, y1, x2, y2; + + x1 = (int) (coords[0] - canvasPtr->closeEnough); + y1 = (int) (coords[1] - canvasPtr->closeEnough); + x2 = (int) (coords[0] + canvasPtr->closeEnough); + y2 = (int) (coords[1] + canvasPtr->closeEnough); + + bestPtr = NULL; + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + if ((itemPtr->x1 > x2) || (itemPtr->x2 < x1) + || (itemPtr->y1 > y2) || (itemPtr->y2 < y1)) { + continue; + } + if ((*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr, + itemPtr, coords) <= canvasPtr->closeEnough) { + bestPtr = itemPtr; + } + } + return bestPtr; +} + +/* + *-------------------------------------------------------------- + * + * CanvasDoEvent -- + * + * This procedure is called to invoke binding processing + * for a new event that is associated with the current item + * for a canvas. + * + * Results: + * None. + * + * Side effects: + * Depends on the bindings for the canvas. A binding script + * could delete the canvas, so callers should protect themselves + * with Tcl_Preserve and Tcl_Release. + * + *-------------------------------------------------------------- + */ + +static void +CanvasDoEvent(canvasPtr, eventPtr) + TkCanvas *canvasPtr; /* Canvas widget in which event + * occurred. */ + XEvent *eventPtr; /* Real or simulated X event that + * is to be processed. */ +{ +#define NUM_STATIC 3 + ClientData staticObjects[NUM_STATIC]; + ClientData *objectPtr; + int numObjects, i; + Tk_Item *itemPtr; + + if (canvasPtr->bindingTable == NULL) { + return; + } + + itemPtr = canvasPtr->currentItemPtr; + if ((eventPtr->type == KeyPress) || (eventPtr->type == KeyRelease)) { + itemPtr = canvasPtr->textInfo.focusItemPtr; + } + if (itemPtr == NULL) { + return; + } + + /* + * Set up an array with all the relevant objects for processing + * this event. The relevant objects are (a) the event's item, + * (b) the tags associated with the event's item, and (c) the + * tag "all". If there are a lot of tags then malloc an array + * to hold all of the objects. + */ + + numObjects = itemPtr->numTags + 2; + if (numObjects <= NUM_STATIC) { + objectPtr = staticObjects; + } else { + objectPtr = (ClientData *) ckalloc((unsigned) + (numObjects * sizeof(ClientData))); + } + objectPtr[0] = (ClientData) Tk_GetUid("all"); + for (i = itemPtr->numTags-1; i >= 0; i--) { + objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i]; + } + objectPtr[itemPtr->numTags+1] = (ClientData) itemPtr; + + /* + * Invoke the binding system, then free up the object array if + * it was malloc-ed. + */ + + if (canvasPtr->tkwin != NULL) { + Tk_BindEvent(canvasPtr->bindingTable, eventPtr, canvasPtr->tkwin, + numObjects, objectPtr); + } + if (objectPtr != staticObjects) { + ckfree((char *) objectPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * CanvasBlinkProc -- + * + * This procedure is called as a timer handler to blink the + * insertion cursor off and on. + * + * Results: + * None. + * + * Side effects: + * The cursor gets turned on or off, redisplay gets invoked, + * and this procedure reschedules itself. + * + *---------------------------------------------------------------------- + */ + +static void +CanvasBlinkProc(clientData) + ClientData clientData; /* Pointer to record describing entry. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) clientData; + + if (!canvasPtr->textInfo.gotFocus || (canvasPtr->insertOffTime == 0)) { + return; + } + if (canvasPtr->textInfo.cursorOn) { + canvasPtr->textInfo.cursorOn = 0; + canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler( + canvasPtr->insertOffTime, CanvasBlinkProc, + (ClientData) canvasPtr); + } else { + canvasPtr->textInfo.cursorOn = 1; + canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler( + canvasPtr->insertOnTime, CanvasBlinkProc, + (ClientData) canvasPtr); + } + if (canvasPtr->textInfo.focusItemPtr != NULL) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->textInfo.focusItemPtr->x1, + canvasPtr->textInfo.focusItemPtr->y1, + canvasPtr->textInfo.focusItemPtr->x2, + canvasPtr->textInfo.focusItemPtr->y2); + } +} + +/* + *---------------------------------------------------------------------- + * + * CanvasFocusProc -- + * + * This procedure is called whenever a canvas gets or loses the + * input focus. It's also called whenever the window is + * reconfigured while it has the focus. + * + * Results: + * None. + * + * Side effects: + * The cursor gets turned on or off. + * + *---------------------------------------------------------------------- + */ + +static void +CanvasFocusProc(canvasPtr, gotFocus) + TkCanvas *canvasPtr; /* Canvas that just got or lost focus. */ + int gotFocus; /* 1 means window is getting focus, 0 means + * it's losing it. */ +{ + Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler); + if (gotFocus) { + canvasPtr->textInfo.gotFocus = 1; + canvasPtr->textInfo.cursorOn = 1; + if (canvasPtr->insertOffTime != 0) { + canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler( + canvasPtr->insertOffTime, CanvasBlinkProc, + (ClientData) canvasPtr); + } + } else { + canvasPtr->textInfo.gotFocus = 0; + canvasPtr->textInfo.cursorOn = 0; + canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL; + } + if (canvasPtr->textInfo.focusItemPtr != NULL) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->textInfo.focusItemPtr->x1, + canvasPtr->textInfo.focusItemPtr->y1, + canvasPtr->textInfo.focusItemPtr->x2, + canvasPtr->textInfo.focusItemPtr->y2); + } + if (canvasPtr->highlightWidth > 0) { + canvasPtr->flags |= REDRAW_BORDERS; + if (!(canvasPtr->flags & REDRAW_PENDING)) { + Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr); + canvasPtr->flags |= REDRAW_PENDING; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * CanvasSelectTo -- + * + * Modify the selection by moving its un-anchored end. This could + * make the selection either larger or smaller. + * + * Results: + * None. + * + * Side effects: + * The selection changes. + * + *---------------------------------------------------------------------- + */ + +static void +CanvasSelectTo(canvasPtr, itemPtr, index) + TkCanvas *canvasPtr; /* Information about widget. */ + Tk_Item *itemPtr; /* Item that is to hold selection. */ + int index; /* Index of element that is to become the + * "other" end of the selection. */ +{ + int oldFirst, oldLast; + Tk_Item *oldSelPtr; + + oldFirst = canvasPtr->textInfo.selectFirst; + oldLast = canvasPtr->textInfo.selectLast; + oldSelPtr = canvasPtr->textInfo.selItemPtr; + + /* + * Grab the selection if we don't own it already. + */ + + if (canvasPtr->textInfo.selItemPtr == NULL) { + Tk_OwnSelection(canvasPtr->tkwin, XA_PRIMARY, CanvasLostSelection, + (ClientData) canvasPtr); + } else if (canvasPtr->textInfo.selItemPtr != itemPtr) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->textInfo.selItemPtr->x1, + canvasPtr->textInfo.selItemPtr->y1, + canvasPtr->textInfo.selItemPtr->x2, + canvasPtr->textInfo.selItemPtr->y2); + } + canvasPtr->textInfo.selItemPtr = itemPtr; + + if (canvasPtr->textInfo.anchorItemPtr != itemPtr) { + canvasPtr->textInfo.anchorItemPtr = itemPtr; + canvasPtr->textInfo.selectAnchor = index; + } + if (canvasPtr->textInfo.selectAnchor <= index) { + canvasPtr->textInfo.selectFirst = canvasPtr->textInfo.selectAnchor; + canvasPtr->textInfo.selectLast = index; + } else { + canvasPtr->textInfo.selectFirst = index; + canvasPtr->textInfo.selectLast = canvasPtr->textInfo.selectAnchor - 1; + } + if ((canvasPtr->textInfo.selectFirst != oldFirst) + || (canvasPtr->textInfo.selectLast != oldLast) + || (itemPtr != oldSelPtr)) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); + } +} + +/* + *-------------------------------------------------------------- + * + * CanvasFetchSelection -- + * + * This procedure is invoked by Tk to return part or all of + * the selection, when the selection is in a canvas widget. + * This procedure always returns the selection as a STRING. + * + * Results: + * The return value is the number of non-NULL bytes stored + * at buffer. Buffer is filled (or partially filled) with a + * NULL-terminated string containing part or all of the selection, + * as given by offset and maxBytes. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +CanvasFetchSelection(clientData, offset, buffer, maxBytes) + ClientData clientData; /* Information about canvas widget. */ + int offset; /* Offset within selection of first + * character to be returned. */ + char *buffer; /* Location in which to place + * selection. */ + int maxBytes; /* Maximum number of bytes to place + * at buffer, not including terminating + * NULL character. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) clientData; + + if (canvasPtr->textInfo.selItemPtr == NULL) { + return -1; + } + if (canvasPtr->textInfo.selItemPtr->typePtr->selectionProc == NULL) { + return -1; + } + return (*canvasPtr->textInfo.selItemPtr->typePtr->selectionProc)( + (Tk_Canvas) canvasPtr, canvasPtr->textInfo.selItemPtr, offset, + buffer, maxBytes); +} + +/* + *---------------------------------------------------------------------- + * + * CanvasLostSelection -- + * + * This procedure is called back by Tk when the selection is + * grabbed away from a canvas widget. + * + * Results: + * None. + * + * Side effects: + * The existing selection is unhighlighted, and the window is + * marked as not containing a selection. + * + *---------------------------------------------------------------------- + */ + +static void +CanvasLostSelection(clientData) + ClientData clientData; /* Information about entry widget. */ +{ + TkCanvas *canvasPtr = (TkCanvas *) clientData; + + if (canvasPtr->textInfo.selItemPtr != NULL) { + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->textInfo.selItemPtr->x1, + canvasPtr->textInfo.selItemPtr->y1, + canvasPtr->textInfo.selItemPtr->x2, + canvasPtr->textInfo.selItemPtr->y2); + } + canvasPtr->textInfo.selItemPtr = NULL; +} + +/* + *-------------------------------------------------------------- + * + * GridAlign -- + * + * Given a coordinate and a grid spacing, this procedure + * computes the location of the nearest grid line to the + * coordinate. + * + * Results: + * The return value is the location of the grid line nearest + * to coord. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static double +GridAlign(coord, spacing) + double coord; /* Coordinate to grid-align. */ + double spacing; /* Spacing between grid lines. If <= 0 + * then no alignment is done. */ +{ + if (spacing <= 0.0) { + return coord; + } + if (coord < 0) { + return -((int) ((-coord)/spacing + 0.5)) * spacing; + } + return ((int) (coord/spacing + 0.5)) * spacing; +} + +/* + *---------------------------------------------------------------------- + * + * PrintScrollFractions -- + * + * Given the range that's visible in the window and the "100% + * range" for what's in the canvas, print a string containing + * the scroll fractions. This procedure is used for both x + * and y scrolling. + * + * Results: + * The memory pointed to by string is modified to hold + * two real numbers containing the scroll fractions (between + * 0 and 1) corresponding to the other arguments. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +PrintScrollFractions(screen1, screen2, object1, object2, string) + int screen1; /* Lowest coordinate visible in the window. */ + int screen2; /* Highest coordinate visible in the window. */ + int object1; /* Lowest coordinate in the object. */ + int object2; /* Highest coordinate in the object. */ + char *string; /* Two real numbers get printed here. Must + * have enough storage for two %g + * conversions. */ +{ + double range, f1, f2; + + range = object2 - object1; + if (range <= 0) { + f1 = 0; + f2 = 1.0; + } else { + f1 = (screen1 - object1)/range; + if (f1 < 0) { + f1 = 0.0; + } + f2 = (screen2 - object1)/range; + if (f2 > 1.0) { + f2 = 1.0; + } + if (f2 < f1) { + f2 = f1; + } + } + sprintf(string, "%g %g", f1, f2); +} + +/* + *-------------------------------------------------------------- + * + * CanvasUpdateScrollbars -- + * + * This procedure is invoked whenever a canvas has changed in + * a way that requires scrollbars to be redisplayed (e.g. the + * view in the canvas has changed). + * + * Results: + * None. + * + * Side effects: + * If there are scrollbars associated with the canvas, then + * their scrolling commands are invoked to cause them to + * redisplay. If errors occur, additional Tcl commands may + * be invoked to process the errors. + * + *-------------------------------------------------------------- + */ + +static void +CanvasUpdateScrollbars(canvasPtr) + TkCanvas *canvasPtr; /* Information about canvas. */ +{ + int result; + char buffer[200]; + Tcl_Interp *interp; + int xOrigin, yOrigin, inset, width, height, scrollX1, scrollX2, + scrollY1, scrollY2; + char *xScrollCmd, *yScrollCmd; + + /* + * Save all the relevant values from the canvasPtr, because it might be + * deleted as part of either of the two calls to Tcl_VarEval below. + */ + + interp = canvasPtr->interp; + Tcl_Preserve((ClientData) interp); + xScrollCmd = canvasPtr->xScrollCmd; + if (xScrollCmd != (char *) NULL) { + Tcl_Preserve((ClientData) xScrollCmd); + } + yScrollCmd = canvasPtr->yScrollCmd; + if (yScrollCmd != (char *) NULL) { + Tcl_Preserve((ClientData) yScrollCmd); + } + xOrigin = canvasPtr->xOrigin; + yOrigin = canvasPtr->yOrigin; + inset = canvasPtr->inset; + width = Tk_Width(canvasPtr->tkwin); + height = Tk_Height(canvasPtr->tkwin); + scrollX1 = canvasPtr->scrollX1; + scrollX2 = canvasPtr->scrollX2; + scrollY1 = canvasPtr->scrollY1; + scrollY2 = canvasPtr->scrollY2; + canvasPtr->flags &= ~UPDATE_SCROLLBARS; + if (canvasPtr->xScrollCmd != NULL) { + PrintScrollFractions(xOrigin + inset, xOrigin + width - inset, + scrollX1, scrollX2, buffer); + result = Tcl_VarEval(interp, xScrollCmd, " ", buffer, (char *) NULL); + if (result != TCL_OK) { + Tcl_BackgroundError(interp); + } + Tcl_ResetResult(interp); + Tcl_Release((ClientData) xScrollCmd); + } + + if (yScrollCmd != NULL) { + PrintScrollFractions(yOrigin + inset, yOrigin + height - inset, + scrollY1, scrollY2, buffer); + result = Tcl_VarEval(interp, yScrollCmd, " ", buffer, (char *) NULL); + if (result != TCL_OK) { + Tcl_BackgroundError(interp); + } + Tcl_ResetResult(interp); + Tcl_Release((ClientData) yScrollCmd); + } + Tcl_Release((ClientData) interp); +} + +/* + *-------------------------------------------------------------- + * + * CanvasSetOrigin -- + * + * This procedure is invoked to change the mapping between + * canvas coordinates and screen coordinates in the canvas + * window. + * + * Results: + * None. + * + * Side effects: + * The canvas will be redisplayed to reflect the change in + * view. In addition, scrollbars will be updated if there + * are any. + * + *-------------------------------------------------------------- + */ + +static void +CanvasSetOrigin(canvasPtr, xOrigin, yOrigin) + TkCanvas *canvasPtr; /* Information about canvas. */ + int xOrigin; /* New X origin for canvas (canvas x-coord + * corresponding to left edge of canvas + * window). */ + int yOrigin; /* New Y origin for canvas (canvas y-coord + * corresponding to top edge of canvas + * window). */ +{ + int left, right, top, bottom, delta; + + /* + * If scroll increments have been set, round the window origin + * to the nearest multiple of the increments. Remember, the + * origin is the place just inside the borders, not the upper + * left corner. + */ + + if (canvasPtr->xScrollIncrement > 0) { + if (xOrigin >= 0) { + xOrigin += canvasPtr->xScrollIncrement/2; + xOrigin -= (xOrigin + canvasPtr->inset) + % canvasPtr->xScrollIncrement; + } else { + xOrigin = (-xOrigin) + canvasPtr->xScrollIncrement/2; + xOrigin = -(xOrigin - (xOrigin - canvasPtr->inset) + % canvasPtr->xScrollIncrement); + } + } + if (canvasPtr->yScrollIncrement > 0) { + if (yOrigin >= 0) { + yOrigin += canvasPtr->yScrollIncrement/2; + yOrigin -= (yOrigin + canvasPtr->inset) + % canvasPtr->yScrollIncrement; + } else { + yOrigin = (-yOrigin) + canvasPtr->yScrollIncrement/2; + yOrigin = -(yOrigin - (yOrigin - canvasPtr->inset) + % canvasPtr->yScrollIncrement); + } + } + + /* + * Adjust the origin if necessary to keep as much as possible of the + * canvas in the view. The variables left, right, etc. keep track of + * how much extra space there is on each side of the view before it + * will stick out past the scroll region. If one side sticks out past + * the edge of the scroll region, adjust the view to bring that side + * back to the edge of the scrollregion (but don't move it so much that + * the other side sticks out now). If scroll increments are in effect, + * be sure to adjust only by full increments. + */ + + if ((canvasPtr->confine) && (canvasPtr->regionString != NULL)) { + left = xOrigin + canvasPtr->inset - canvasPtr->scrollX1; + right = canvasPtr->scrollX2 + - (xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset); + top = yOrigin + canvasPtr->inset - canvasPtr->scrollY1; + bottom = canvasPtr->scrollY2 + - (yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset); + if ((left < 0) && (right > 0)) { + delta = (right > -left) ? -left : right; + if (canvasPtr->xScrollIncrement > 0) { + delta -= delta % canvasPtr->xScrollIncrement; + } + xOrigin += delta; + } else if ((right < 0) && (left > 0)) { + delta = (left > -right) ? -right : left; + if (canvasPtr->xScrollIncrement > 0) { + delta -= delta % canvasPtr->xScrollIncrement; + } + xOrigin -= delta; + } + if ((top < 0) && (bottom > 0)) { + delta = (bottom > -top) ? -top : bottom; + if (canvasPtr->yScrollIncrement > 0) { + delta -= delta % canvasPtr->yScrollIncrement; + } + yOrigin += delta; + } else if ((bottom < 0) && (top > 0)) { + delta = (top > -bottom) ? -bottom : top; + if (canvasPtr->yScrollIncrement > 0) { + delta -= delta % canvasPtr->yScrollIncrement; + } + yOrigin -= delta; + } + } + + if ((xOrigin == canvasPtr->xOrigin) && (yOrigin == canvasPtr->yOrigin)) { + return; + } + + /* + * Tricky point: must redisplay not only everything that's visible + * in the window's final configuration, but also everything that was + * visible in the initial configuration. This is needed because some + * item types, like windows, need to know when they move off-screen + * so they can explicitly undisplay themselves. + */ + + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->xOrigin, canvasPtr->yOrigin, + canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin), + canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)); + canvasPtr->xOrigin = xOrigin; + canvasPtr->yOrigin = yOrigin; + canvasPtr->flags |= UPDATE_SCROLLBARS; + Xxl_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + canvasPtr->xOrigin, canvasPtr->yOrigin, + canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin), + canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)); +} + +int computeDxy(Tk_Item *itemPtr, TkCanvas *canvasPtr, + int *pdx1, int *pdx2, int *pdy1, int *pdy2) { + ArcItem *arcPtr; + TextItem *textPtr; + LineItem *linePtr; + RectOvalItem *rectOvalPtr; + + switch(itemPtr->typePtr->name[0]) { + case 't': + textPtr = (TextItem *) itemPtr; + + *pdy1 = (y_coord(textPtr->row,canvasPtr->canvas_info)+ + y_coord(textPtr->row+1,canvasPtr->canvas_info))/2.0; + switch(textPtr->anchor) { + case TK_ANCHOR_E: + *pdx1=x_coord(textPtr->col,canvasPtr->canvas_info)+ + INTERNAL_CELL_BORDER; + *pdx1=x_coord(textPtr->col+1,canvasPtr->canvas_info)-3; + break; + case TK_ANCHOR_W: + *pdx1=x_coord(textPtr->col,canvasPtr->canvas_info)+3; + break; + case TK_ANCHOR_CENTER: + *pdx1=(x_coord(textPtr->col,canvasPtr->canvas_info)+ + x_coord(textPtr->col+1,canvasPtr->canvas_info))/2.0; + break; + } + *pdx2 = *pdx1+textPtr->width; + *pdy2 = *pdy1; + break; + case 'l': + linePtr = (LineItem *) itemPtr; + *pdx1 = x_coord(linePtr->col1,canvasPtr->canvas_info); + *pdx2 = x_coord(linePtr->col2,canvasPtr->canvas_info); + *pdy1 = y_coord(linePtr->row1,canvasPtr->canvas_info); + *pdy2 = y_coord(linePtr->row2,canvasPtr->canvas_info); + break; + case 'r': + rectOvalPtr = (RectOvalItem *) itemPtr; + *pdx1 = x_coord(rectOvalPtr->col1,canvasPtr->canvas_info); + *pdx2 = x_coord(rectOvalPtr->col2,canvasPtr->canvas_info); + *pdy1 = y_coord(rectOvalPtr->row1,canvasPtr->canvas_info); + *pdy2 = y_coord(rectOvalPtr->row2,canvasPtr->canvas_info); + break; + case 'a': + arcPtr = (ArcItem *) itemPtr; + *pdx1 = x_coord(arcPtr->col1,canvasPtr->canvas_info); + *pdx2 = x_coord(arcPtr->col2,canvasPtr->canvas_info); + *pdy1 = y_coord(arcPtr->row1,canvasPtr->canvas_info); + *pdy2 = y_coord(arcPtr->row2,canvasPtr->canvas_info); + break; + default: + *pdx1 = *pdx2 = *pdy1 = *pdy2 = 0; + } +} + +computeOffset(Tk_Item *itemPtr, TkCanvas *canvasPtr, + int dx1, int dx2, int dy1, int dy2) { + + if (itemPtr->typePtr->name[0] == 't' && + itemPtr->typePtr->name[2] == 'x' ) { /* text */ + + TextItem *textPtr; + textPtr = (TextItem *) itemPtr; + + textPtr->header.x1 += dx1; + textPtr->header.x2 += dx2; + textPtr->header.y1 += dy1; + textPtr->header.y2 += dy2; + + textPtr->x += dx1; + textPtr->y += dy1; + + textPtr->leftEdge+=dx1; + textPtr->rightEdge=textPtr->width+textPtr->leftEdge; + + } else if (itemPtr->typePtr->name[0] == 'l' && + itemPtr->typePtr->name[2] == 'n' ) { /* line */ + + LineItem *linePtr; + linePtr = (LineItem *) itemPtr; + + linePtr->header.x1 += dx1; + linePtr->header.x2 += dx2; + linePtr->header.y1 += dy1; + linePtr->header.y2 += dy2; + + linePtr->coordPtr[0] += dx1; + linePtr->coordPtr[1] += dy1; + linePtr->coordPtr[2] += dx2; + linePtr->coordPtr[3] += dy2; + + } else if (itemPtr->typePtr->name[0] == 'r' && + itemPtr->typePtr->name[2] == 'c' ) { /* rect */ + + + RectOvalItem *rectOvalPtr; + rectOvalPtr = (RectOvalItem *) itemPtr; + + rectOvalPtr->header.x1 += dx1; + rectOvalPtr->header.x2 += dx2; + rectOvalPtr->header.y1 += dy1; + rectOvalPtr->header.y2 += dy2; + + rectOvalPtr->bbox[0] += dx1; + rectOvalPtr->bbox[1] += dy1; + rectOvalPtr->bbox[2] += dx2; + rectOvalPtr->bbox[3] += dy2; + + } else if (itemPtr->typePtr->name[0] == 'a' && + itemPtr->typePtr->name[2] == 'c' ) { /* arc */ + + ArcItem *arcPtr; + arcPtr = (ArcItem *) itemPtr; + + arcPtr->bbox[0] += dx1; + arcPtr->bbox[1] += dy1; + arcPtr->bbox[2] += dx2; + arcPtr->bbox[3] += dy2; + + arcPtr->center1[0] += dx1; + arcPtr->center1[1] += dy1; + + arcPtr->center2[0] += dx2; + arcPtr->center2[1] += dy2; + + } +} + +decomputeOffset(Tk_Item *itemPtr, TkCanvas *canvasPtr, + int dx1, int dx2, int dy1, int dy2) { + + if (itemPtr->typePtr->name[0] == 't' && + itemPtr->typePtr->name[2] == 'x' ) { /* text */ + + TextItem *textPtr; + textPtr = (TextItem *) itemPtr; + + textPtr->header.x1 -= dx1; + textPtr->header.x2 -= dx2; + textPtr->header.y1 -= dy1; + textPtr->header.y2 -= dy1; + + textPtr->x -= dx1; + textPtr->y -= dy1; + + textPtr->leftEdge-=dx1; + textPtr->rightEdge-=dx1; + + } else if (itemPtr->typePtr->name[0] == 'l' && + itemPtr->typePtr->name[2] == 'n' ) { /* line */ + + LineItem *linePtr; + linePtr = (LineItem *) itemPtr; + + linePtr->header.x1 -= dx1; + linePtr->header.x2 -= dx2; + linePtr->header.y1 -= dy1; + linePtr->header.y2 -= dy1; + + linePtr->coordPtr[0] -= dx1; + linePtr->coordPtr[1] -= dy1; + linePtr->coordPtr[2] -= dx2; + linePtr->coordPtr[3] -= dy2; + + } else if (itemPtr->typePtr->name[0] == 'r' && + itemPtr->typePtr->name[2] == 'c' ) { /* rect */ + + + RectOvalItem *rectOvalPtr; + rectOvalPtr = (RectOvalItem *) itemPtr; + + rectOvalPtr->bbox[0] -= dx1; + rectOvalPtr->bbox[1] -= dy1; + rectOvalPtr->bbox[2] -= dx2; + rectOvalPtr->bbox[3] -= dy2; + + rectOvalPtr->header.x1 -= dx1; + rectOvalPtr->header.x2 -= dx2; + rectOvalPtr->header.y1 -= dy1; + rectOvalPtr->header.y2 -= dy2; + + } else if (itemPtr->typePtr->name[0] == 'a' && + itemPtr->typePtr->name[2] == 'c' ) { /* arc */ + + + ArcItem *arcPtr; + arcPtr = (ArcItem *) itemPtr; + + arcPtr->bbox[0] -= dx1; + arcPtr->bbox[1] -= dy1; + arcPtr->bbox[2] -= dx2; + arcPtr->bbox[3] -= dy2; + + arcPtr->center1[0] -= dx1; + arcPtr->center1[1] -= dy1; + + arcPtr->center2[0] -= dx2; + arcPtr->center2[1] -= dy2; + + } +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvas.h ./canvas-tcl8.2.2/tkCanvas.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkCanvas.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkCanvas.h Thu Dec 30 15:03:20 1999 @@ -0,0 +1,264 @@ +/* + * tkCanvas.h -- + * + * Declarations shared among all the files that implement + * canvas widgets. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkCanvas.h,v 1.3 1998/10/13 18:13:06 rjohnson Exp $ + */ + +#ifndef _TKCANVAS +#define _TKCANVAS + +#ifndef _TK +#include "tk.h" +#endif + +/* + * The record below describes a canvas widget. It is made available + * to the item procedures so they can access certain shared fields such + * as the overall displacement and scale factor for the canvas. + */ + +typedef struct TkCanvas { + Tk_Window tkwin; /* Window that embodies the canvas. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Display *display; /* Display containing widget; needed, among + * other things, to release resources after + * tkwin has already gone away. */ + Tcl_Interp *interp; /* Interpreter associated with canvas. */ + Tcl_Command widgetCmd; /* Token for canvas's widget command. */ + Tk_Item *firstItemPtr; /* First in list of all items in canvas, + * or NULL if canvas empty. */ + Tk_Item *lastItemPtr; /* Last in list of all items in canvas, + * or NULL if canvas empty. */ + + /* + * Information used when displaying widget: + */ + + int borderWidth; /* Width of 3-D border around window. */ + Tk_3DBorder bgBorder; /* Used for canvas background. */ + int relief; /* Indicates whether window as a whole is + * raised, sunken, or flat. */ + int highlightWidth; /* Width in pixels of highlight to draw + * around widget when it has the focus. + * <= 0 means don't draw a highlight. */ + XColor *highlightBgColorPtr; + /* Color for drawing traversal highlight + * area when highlight is off. */ + XColor *highlightColorPtr; /* Color for drawing traversal highlight. */ + int inset; /* Total width of all borders, including + * traversal highlight and 3-D border. + * Indicates how much interior stuff must + * be offset from outside edges to leave + * room for borders. */ + GC pixmapGC; /* Used to copy bits from a pixmap to the + * screen and also to clear the pixmap. */ + int width, height; /* Dimensions to request for canvas window, + * specified in pixels. */ + int redrawX1, redrawY1; /* Upper left corner of area to redraw, + * in pixel coordinates. Border pixels + * are included. Only valid if + * REDRAW_PENDING flag is set. */ + int redrawX2, redrawY2; /* Lower right corner of area to redraw, + * in integer canvas coordinates. Border + * pixels will *not* be redrawn. */ + int confine; /* Non-zero means constrain view to keep + * as much of canvas visible as possible. */ + + /* + * Information used to manage the selection and insertion cursor: + */ + + Tk_CanvasTextInfo textInfo; /* Contains lots of fields; see tk.h for + * details. This structure is shared with + * the code that implements individual items. */ + int insertOnTime; /* Number of milliseconds cursor should spend + * in "on" state for each blink. */ + int insertOffTime; /* Number of milliseconds cursor should spend + * in "off" state for each blink. */ + Tcl_TimerToken insertBlinkHandler; + /* Timer handler used to blink cursor on and + * off. */ + + /* + * Transformation applied to canvas as a whole: to compute screen + * coordinates (X,Y) from canvas coordinates (x,y), do the following: + * + * X = x - xOrigin; + * Y = y - yOrigin; + */ + + int xOrigin, yOrigin; /* Canvas coordinates corresponding to + * upper-left corner of window, given in + * canvas pixel units. */ + int drawableXOrigin, drawableYOrigin; + /* During redisplay, these fields give the + * canvas coordinates corresponding to + * the upper-left corner of the drawable + * where items are actually being drawn + * (typically a pixmap smaller than the + * whole window). */ + + /* + * Information used for event bindings associated with items. + */ + + Tk_BindingTable bindingTable; + /* Table of all bindings currently defined + * for this canvas. NULL means that no + * bindings exist, so the table hasn't been + * created. Each "object" used for this + * table is either a Tk_Uid for a tag or + * the address of an item named by id. */ + Tk_Item *currentItemPtr; /* The item currently containing the mouse + * pointer, or NULL if none. */ + Tk_Item *newCurrentPtr; /* The item that is about to become the + * current one, or NULL. This field is + * used to detect deletions of the new + * current item pointer that occur during + * Leave processing of the previous current + * item. */ + double closeEnough; /* The mouse is assumed to be inside an + * item if it is this close to it. */ + XEvent pickEvent; /* The event upon which the current choice + * of currentItem is based. Must be saved + * so that if the currentItem is deleted, + * can pick another. */ + int state; /* Last known modifier state. Used to + * defer picking a new current object + * while buttons are down. */ + + /* + * Information used for managing scrollbars: + */ + + char *xScrollCmd; /* Command prefix for communicating with + * horizontal scrollbar. NULL means no + * horizontal scrollbar. Malloc'ed*/ + char *yScrollCmd; /* Command prefix for communicating with + * vertical scrollbar. NULL means no + * vertical scrollbar. Malloc'ed*/ + int scrollX1, scrollY1, scrollX2, scrollY2; + /* These four coordinates define the region + * that is the 100% area for scrolling (i.e. + * these numbers determine the size and + * location of the sliders on scrollbars). + * Units are pixels in canvas coords. */ + char *regionString; /* The option string from which scrollX1 + * etc. are derived. Malloc'ed. */ + int xScrollIncrement; /* If >0, defines a grid for horizontal + * scrolling. This is the size of the "unit", + * and the left edge of the screen will always + * lie on an even unit boundary. */ + int yScrollIncrement; /* If >0, defines a grid for horizontal + * scrolling. This is the size of the "unit", + * and the left edge of the screen will always + * lie on an even unit boundary. */ + + /* + * Information used for scanning: + */ + + int scanX; /* X-position at which scan started (e.g. + * button was pressed here). */ + int scanXOrigin; /* Value of xOrigin field when scan started. */ + int scanY; /* Y-position at which scan started (e.g. + * button was pressed here). */ + int scanYOrigin; /* Value of yOrigin field when scan started. */ + + /* + * Information used to speed up searches by remembering the last item + * created or found with an item id search. + */ + + Tk_Item *hotPtr; /* Pointer to "hot" item (one that's been + * recently used. NULL means there's no + * hot item. */ + Tk_Item *hotPrevPtr; /* Pointer to predecessor to hotPtr (NULL + * means item is first in list). This is + * only a hint and may not really be hotPtr's + * predecessor. */ + + /* + * Miscellaneous information: + */ + + Tk_Cursor cursor; /* Current cursor for window, or None. */ + char *takeFocus; /* Value of -takefocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + double pixelsPerMM; /* Scale factor between MM and pixels; + * used when converting coordinates. */ + int flags; /* Various flags; see below for + * definitions. */ + int nextId; /* Number to use as id for next item + * created in widget. */ + struct TkPostscriptInfo *psInfoPtr; + /* Pointer to information used for generating + * Postscript for the canvas. NULL means + * no Postscript is currently being + * generated. */ + Tcl_HashTable idTable; /* Table of integer indices. */ + struct canvas *canvas_info; +} TkCanvas; + +/* + * Flag bits for canvases: + * + * REDRAW_PENDING - 1 means a DoWhenIdle handler has already + * been created to redraw some or all of the + * canvas. + * REDRAW_BORDERS - 1 means that the borders need to be redrawn + * during the next redisplay operation. + * REPICK_NEEDED - 1 means DisplayCanvas should pick a new + * current item before redrawing the canvas. + * GOT_FOCUS - 1 means the focus is currently in this + * widget, so should draw the insertion cursor + * and traversal highlight. + * CURSOR_ON - 1 means the insertion cursor is in the "on" + * phase of its blink cycle. 0 means either + * we don't have the focus or the cursor is in + * the "off" phase of its cycle. + * UPDATE_SCROLLBARS - 1 means the scrollbars should get updated + * as part of the next display operation. + * LEFT_GRABBED_ITEM - 1 means that the mouse left the current + * item while a grab was in effect, so we + * didn't change canvasPtr->currentItemPtr. + * REPICK_IN_PROGRESS - 1 means PickCurrentItem is currently + * executing. If it should be called recursively, + * it should simply return immediately. + */ + +#define REDRAW_PENDING 1 +#define REDRAW_BORDERS 2 +#define REPICK_NEEDED 4 +#define GOT_FOCUS 8 +#define CURSOR_ON 0x10 +#define UPDATE_SCROLLBARS 0x20 +#define LEFT_GRABBED_ITEM 0x40 +#define REPICK_IN_PROGRESS 0x100 + +/* + * Canvas-related procedures that are shared among Tk modules but not + * exported to the outside world: + */ + +extern int TkCanvPostscriptCmd _ANSI_ARGS_((TkCanvas *canvasPtr, + Tcl_Interp *interp, int argc, char **argv)); + +extern void Xxl_CanvasEventuallyRedraw _ANSI_ARGS_(( + Tk_Canvas canvas, int x1, int y1, int x2, + int y2)); + +#endif /* _TKCANVAS */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkEvent.c ./canvas-tcl8.2.2/tkEvent.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkEvent.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkEvent.c Thu Dec 30 14:58:46 1999 @@ -0,0 +1,1104 @@ +/* + * tkEvent.c -- + * + * This file provides basic low-level facilities for managing + * X events in Tk. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkEvent.c,v 1.5 1999/08/13 17:52:12 redman Exp $ + */ + +#include "tkPort.h" +#include "tkInt.h" +#include + +/* + * There's a potential problem if a handler is deleted while it's + * current (i.e. its procedure is executing), since Tk_HandleEvent + * will need to read the handler's "nextPtr" field when the procedure + * returns. To handle this problem, structures of the type below + * indicate the next handler to be processed for any (recursively + * nested) dispatches in progress. The nextHandler fields get + * updated if the handlers pointed to are deleted. Tk_HandleEvent + * also needs to know if the entire window gets deleted; the winPtr + * field is set to zero if that particular window gets deleted. + */ + +typedef struct InProgress { + XEvent *eventPtr; /* Event currently being handled. */ + TkWindow *winPtr; /* Window for event. Gets set to None if + * window is deleted while event is being + * handled. */ + TkEventHandler *nextHandler; /* Next handler in search. */ + struct InProgress *nextPtr; /* Next higher nested search. */ +} InProgress; + +/* + * For each call to Tk_CreateGenericHandler, an instance of the following + * structure will be created. All of the active handlers are linked into a + * list. + */ + +typedef struct GenericHandler { + Tk_GenericProc *proc; /* Procedure to dispatch on all X events. */ + ClientData clientData; /* Client data to pass to procedure. */ + int deleteFlag; /* Flag to set when this handler is deleted. */ + struct GenericHandler *nextPtr; + /* Next handler in list of all generic + * handlers, or NULL for end of list. */ +} GenericHandler; + +/* + * There's a potential problem if Tk_HandleEvent is entered recursively. + * A handler cannot be deleted physically until we have returned from + * calling it. Otherwise, we're looking at unallocated memory in advancing to + * its `next' entry. We deal with the problem by using the `delete flag' and + * deleting handlers only when it's known that there's no handler active. + * + */ + +/* + * The following structure is used for queueing X-style events on the + * Tcl event queue. + */ + +typedef struct TkWindowEvent { + Tcl_Event header; /* Standard information for all events. */ + XEvent event; /* The X event. */ +} TkWindowEvent; + +/* + * Array of event masks corresponding to each X event: + */ + +static unsigned long eventMasks[TK_LASTEVENT] = { + 0, + 0, + KeyPressMask, /* KeyPress */ + KeyReleaseMask, /* KeyRelease */ + ButtonPressMask, /* ButtonPress */ + ButtonReleaseMask, /* ButtonRelease */ + PointerMotionMask|PointerMotionHintMask|ButtonMotionMask + |Button1MotionMask|Button2MotionMask|Button3MotionMask + |Button4MotionMask|Button5MotionMask, + /* MotionNotify */ + EnterWindowMask, /* EnterNotify */ + LeaveWindowMask, /* LeaveNotify */ + FocusChangeMask, /* FocusIn */ + FocusChangeMask, /* FocusOut */ + KeymapStateMask, /* KeymapNotify */ + ExposureMask, /* Expose */ + ExposureMask, /* GraphicsExpose */ + ExposureMask, /* NoExpose */ + VisibilityChangeMask, /* VisibilityNotify */ + SubstructureNotifyMask, /* CreateNotify */ + StructureNotifyMask, /* DestroyNotify */ + StructureNotifyMask, /* UnmapNotify */ + StructureNotifyMask, /* MapNotify */ + SubstructureRedirectMask, /* MapRequest */ + StructureNotifyMask, /* ReparentNotify */ + StructureNotifyMask, /* ConfigureNotify */ + SubstructureRedirectMask, /* ConfigureRequest */ + StructureNotifyMask, /* GravityNotify */ + ResizeRedirectMask, /* ResizeRequest */ + StructureNotifyMask, /* CirculateNotify */ + SubstructureRedirectMask, /* CirculateRequest */ + PropertyChangeMask, /* PropertyNotify */ + 0, /* SelectionClear */ + 0, /* SelectionRequest */ + 0, /* SelectionNotify */ + ColormapChangeMask, /* ColormapNotify */ + 0, /* ClientMessage */ + 0, /* Mapping Notify */ + VirtualEventMask, /* VirtualEvents */ + ActivateMask, /* ActivateNotify */ + ActivateMask, /* DeactivateNotify */ + MouseWheelMask /* MouseWheelEvent */ +}; + + +/* + * The structure below is used to store Data for the Event module that + * must be kept thread-local. The "dataKey" is used to fetch the + * thread-specific storage for the current thread. + */ + +typedef struct ThreadSpecificData { + + int genericHandlersActive; + /* The following variable has a non-zero + * value when a handler is active. */ + InProgress *pendingPtr; + /* Topmost search in progress, or + * NULL if none. */ + GenericHandler *genericList; + /* First handler in the list, or NULL. */ + GenericHandler *lastGenericPtr; + /* Last handler in list. */ + + /* + * If someone has called Tk_RestrictEvents, the information below + * keeps track of it. + */ + + Tk_RestrictProc *restrictProc; + /* Procedure to call. NULL means no + * restrictProc is currently in effect. */ + ClientData restrictArg; /* Argument to pass to restrictProc. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * Prototypes for procedures that are only referenced locally within + * this file. + */ + +static void DelayedMotionProc _ANSI_ARGS_((ClientData clientData)); +static int WindowEventProc _ANSI_ARGS_((Tcl_Event *evPtr, + int flags)); + +/* + *-------------------------------------------------------------- + * + * Tk_CreateEventHandler -- + * + * Arrange for a given procedure to be invoked whenever + * events from a given class occur in a given window. + * + * Results: + * None. + * + * Side effects: + * From now on, whenever an event of the type given by + * mask occurs for token and is processed by Tk_HandleEvent, + * proc will be called. See the manual entry for details + * of the calling sequence and return value for proc. + * + *-------------------------------------------------------------- + */ + +void +Tk_CreateEventHandler(token, mask, proc, clientData) + Tk_Window token; /* Token for window in which to + * create handler. */ + unsigned long mask; /* Events for which proc should + * be called. */ + Tk_EventProc *proc; /* Procedure to call for each + * selected event */ + ClientData clientData; /* Arbitrary data to pass to proc. */ +{ + register TkEventHandler *handlerPtr; + register TkWindow *winPtr = (TkWindow *) token; + int found; + + /* + * Skim through the list of existing handlers to (a) compute the + * overall event mask for the window (so we can pass this new + * value to the X system) and (b) see if there's already a handler + * declared with the same callback and clientData (if so, just + * change the mask). If no existing handler matches, then create + * a new handler. + */ + + found = 0; + if (winPtr->handlerList == NULL) { + handlerPtr = (TkEventHandler *) ckalloc( + (unsigned) sizeof(TkEventHandler)); + winPtr->handlerList = handlerPtr; + goto initHandler; + } else { + for (handlerPtr = winPtr->handlerList; ; + handlerPtr = handlerPtr->nextPtr) { + if ((handlerPtr->proc == proc) + && (handlerPtr->clientData == clientData)) { + handlerPtr->mask = mask; + found = 1; + } + if (handlerPtr->nextPtr == NULL) { + break; + } + } + } + + /* + * Create a new handler if no matching old handler was found. + */ + + if (!found) { + handlerPtr->nextPtr = (TkEventHandler *) + ckalloc(sizeof(TkEventHandler)); + handlerPtr = handlerPtr->nextPtr; + initHandler: + handlerPtr->mask = mask; + handlerPtr->proc = proc; + handlerPtr->clientData = clientData; + handlerPtr->nextPtr = NULL; + } + + /* + * No need to call XSelectInput: Tk always selects on all events + * for all windows (needed to support bindings on classes and "all"). + */ +} + +/* + *-------------------------------------------------------------- + * + * Tk_DeleteEventHandler -- + * + * Delete a previously-created handler. + * + * Results: + * None. + * + * Side effects: + * If there existed a handler as described by the + * parameters, the handler is deleted so that proc + * will not be invoked again. + * + *-------------------------------------------------------------- + */ + +void +Tk_DeleteEventHandler(token, mask, proc, clientData) + Tk_Window token; /* Same as corresponding arguments passed */ + unsigned long mask; /* previously to Tk_CreateEventHandler. */ + Tk_EventProc *proc; + ClientData clientData; +{ + register TkEventHandler *handlerPtr; + register InProgress *ipPtr; + TkEventHandler *prevPtr; + register TkWindow *winPtr = (TkWindow *) token; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + /* + * Find the event handler to be deleted, or return + * immediately if it doesn't exist. + */ + + for (handlerPtr = winPtr->handlerList, prevPtr = NULL; ; + prevPtr = handlerPtr, handlerPtr = handlerPtr->nextPtr) { + if (handlerPtr == NULL) { + return; + } + if ((handlerPtr->mask == mask) && (handlerPtr->proc == proc) + && (handlerPtr->clientData == clientData)) { + break; + } + } + + /* + * If Tk_HandleEvent is about to process this handler, tell it to + * process the next one instead. + */ + + for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + if (ipPtr->nextHandler == handlerPtr) { + ipPtr->nextHandler = handlerPtr->nextPtr; + } + } + + /* + * Free resources associated with the handler. + */ + + if (prevPtr == NULL) { + winPtr->handlerList = handlerPtr->nextPtr; + } else { + prevPtr->nextPtr = handlerPtr->nextPtr; + } + ckfree((char *) handlerPtr); + + + /* + * No need to call XSelectInput: Tk always selects on all events + * for all windows (needed to support bindings on classes and "all"). + */ +} + +/*-------------------------------------------------------------- + * + * Tk_CreateGenericHandler -- + * + * Register a procedure to be called on each X event, regardless + * of display or window. Generic handlers are useful for capturing + * events that aren't associated with windows, or events for windows + * not managed by Tk. + * + * Results: + * None. + * + * Side Effects: + * From now on, whenever an X event is given to Tk_HandleEvent, + * invoke proc, giving it clientData and the event as arguments. + * + *-------------------------------------------------------------- + */ + +void +Tk_CreateGenericHandler(proc, clientData) + Tk_GenericProc *proc; /* Procedure to call on every event. */ + ClientData clientData; /* One-word value to pass to proc. */ +{ + GenericHandler *handlerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler)); + + handlerPtr->proc = proc; + handlerPtr->clientData = clientData; + handlerPtr->deleteFlag = 0; + handlerPtr->nextPtr = NULL; + if (tsdPtr->genericList == NULL) { + tsdPtr->genericList = handlerPtr; + } else { + tsdPtr->lastGenericPtr->nextPtr = handlerPtr; + } + tsdPtr->lastGenericPtr = handlerPtr; +} + +/* + *-------------------------------------------------------------- + * + * Tk_DeleteGenericHandler -- + * + * Delete a previously-created generic handler. + * + * Results: + * None. + * + * Side Effects: + * If there existed a handler as described by the parameters, + * that handler is logically deleted so that proc will not be + * invoked again. The physical deletion happens in the event + * loop in Tk_HandleEvent. + * + *-------------------------------------------------------------- + */ + +void +Tk_DeleteGenericHandler(proc, clientData) + Tk_GenericProc *proc; + ClientData clientData; +{ + GenericHandler * handler; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + for (handler = tsdPtr->genericList; handler; handler = handler->nextPtr) { + if ((handler->proc == proc) && (handler->clientData == clientData)) { + handler->deleteFlag = 1; + } + } +} + +/* + *-------------------------------------------------------------- + * + * TkEventInit -- + * + * This procedures initializes all the event module + * structures used by the current thread. It must be + * called before any other procedure in this file is + * called. + * + * Results: + * None. + * + * Side Effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +TkEventInit _ANSI_ARGS_((void)) +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + tsdPtr->genericHandlersActive = 0; + tsdPtr->pendingPtr = NULL; + tsdPtr->genericList = NULL; + tsdPtr->lastGenericPtr = NULL; + tsdPtr->restrictProc = NULL; + tsdPtr->restrictArg = NULL; +} + +/* + *-------------------------------------------------------------- + * + * Tk_HandleEvent -- + * + * Given an event, invoke all the handlers that have + * been registered for the event. + * + * Results: + * None. + * + * Side effects: + * Depends on the handlers. + * + *-------------------------------------------------------------- + */ + +void +Tk_HandleEvent(eventPtr) + XEvent *eventPtr; /* Event to dispatch. */ +{ + register TkEventHandler *handlerPtr; + register GenericHandler *genericPtr; + register GenericHandler *genPrevPtr; + TkWindow *winPtr; + unsigned long mask; + InProgress ip; + Window handlerWindow; + TkDisplay *dispPtr; + Tcl_Interp *interp = (Tcl_Interp *) NULL; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + /* + * Next, invoke all the generic event handlers (those that are + * invoked for all events). If a generic event handler reports that + * an event is fully processed, go no further. + */ + + for (genPrevPtr = NULL, genericPtr = tsdPtr->genericList; + genericPtr != NULL; ) { + if (genericPtr->deleteFlag) { + if (!tsdPtr->genericHandlersActive) { + GenericHandler *tmpPtr; + + /* + * This handler needs to be deleted and there are no + * calls pending through the handler, so now is a safe + * time to delete it. + */ + + tmpPtr = genericPtr->nextPtr; + if (genPrevPtr == NULL) { + tsdPtr->genericList = tmpPtr; + } else { + genPrevPtr->nextPtr = tmpPtr; + } + if (tmpPtr == NULL) { + tsdPtr->lastGenericPtr = genPrevPtr; + } + (void) ckfree((char *) genericPtr); + genericPtr = tmpPtr; + continue; + } + } else { + int done; + + tsdPtr->genericHandlersActive++; + done = (*genericPtr->proc)(genericPtr->clientData, eventPtr); + tsdPtr->genericHandlersActive--; + if (done) { + return; + } + } + genPrevPtr = genericPtr; + genericPtr = genPrevPtr->nextPtr; + } + + /* + * If the event is a MappingNotify event, find its display and + * refresh the keyboard mapping information for the display. + * After that there's nothing else to do with the event, so just + * quit. + */ + + if (eventPtr->type == MappingNotify) { + dispPtr = TkGetDisplay(eventPtr->xmapping.display); + if (dispPtr != NULL) { + XRefreshKeyboardMapping(&eventPtr->xmapping); + dispPtr->bindInfoStale = 1; + } + return; + } + + /* + * Events selected by StructureNotify require special handling. + * They look the same as those selected by SubstructureNotify. + * The only difference is whether the "event" and "window" fields + * are the same. Compare the two fields and convert StructureNotify + * to SubstructureNotify if necessary. + */ + + handlerWindow = eventPtr->xany.window; + mask = eventMasks[eventPtr->xany.type]; + if (mask == StructureNotifyMask) { + if (eventPtr->xmap.event != eventPtr->xmap.window) { + mask = SubstructureNotifyMask; + handlerWindow = eventPtr->xmap.event; + } + } + winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, handlerWindow); + if (winPtr == NULL) { + + /* + * There isn't a TkWindow structure for this window. + * However, if the event is a PropertyNotify event then call + * the selection manager (it deals beneath-the-table with + * certain properties). + */ + + if (eventPtr->type == PropertyNotify) { + TkSelPropProc(eventPtr); + } + return; + } + + /* + * Once a window has started getting deleted, don't process any more + * events for it except for the DestroyNotify event. This check is + * needed because a DestroyNotify handler could re-invoke the event + * loop, causing other pending events to be handled for the window + * (the window doesn't get totally expunged from our tables until + * after the DestroyNotify event has been completely handled). + */ + + if ((winPtr->flags & TK_ALREADY_DEAD) + && (eventPtr->type != DestroyNotify)) { + return; + } + + if (winPtr->mainPtr != NULL) { + + /* + * Protect interpreter for this window from possible deletion + * while we are dealing with the event for this window. Thus, + * widget writers do not have to worry about protecting the + * interpreter in their own code. + */ + + interp = winPtr->mainPtr->interp; + Tcl_Preserve((ClientData) interp); + + /* + * Call focus-related code to look at FocusIn, FocusOut, Enter, + * and Leave events; depending on its return value, ignore the + * event. + */ + + if ((mask & (FocusChangeMask|EnterWindowMask|LeaveWindowMask)) + && !TkFocusFilterEvent(winPtr, eventPtr)) { + Tcl_Release((ClientData) interp); + return; + } + + /* + * Redirect KeyPress and KeyRelease events to the focus window, + * or ignore them entirely if there is no focus window. We also + * route the MouseWheel event to the focus window. The MouseWheel + * event is an extension to the X event set. Currently, it is only + * available on the Windows version of Tk. + */ + + if (mask & (KeyPressMask|KeyReleaseMask|MouseWheelMask)) { + winPtr->dispPtr->lastEventTime = eventPtr->xkey.time; + winPtr = TkFocusKeyEvent(winPtr, eventPtr); + if (winPtr == NULL) { + Tcl_Release((ClientData) interp); + return; + } + } + + /* + * Call a grab-related procedure to do special processing on + * pointer events. + */ + + if (mask & (ButtonPressMask|ButtonReleaseMask|PointerMotionMask + |EnterWindowMask|LeaveWindowMask)) { + if (mask & (ButtonPressMask|ButtonReleaseMask)) { + winPtr->dispPtr->lastEventTime = eventPtr->xbutton.time; + } else if (mask & PointerMotionMask) { + winPtr->dispPtr->lastEventTime = eventPtr->xmotion.time; + } else { + winPtr->dispPtr->lastEventTime = eventPtr->xcrossing.time; + } + if (TkPointerEvent(eventPtr, winPtr) == 0) { + goto done; + } + } + } + +#ifdef TK_USE_INPUT_METHODS + /* + * Pass the event to the input method(s), if there are any, and + * discard the event if the input method(s) insist. Create the + * input context for the window if it hasn't already been done + * (XFilterEvent needs this context). + */ + + if (!(winPtr->flags & TK_CHECKED_IC)) { + if (winPtr->dispPtr->inputMethod != NULL) { + winPtr->inputContext = XCreateIC( + winPtr->dispPtr->inputMethod, XNInputStyle, + XIMPreeditNothing|XIMStatusNothing, + XNClientWindow, winPtr->window, + XNFocusWindow, winPtr->window, NULL); + } + winPtr->flags |= TK_CHECKED_IC; + } + if (XFilterEvent(eventPtr, None)) { + goto done; + } +#endif /* TK_USE_INPUT_METHODS */ + + /* + * For events where it hasn't already been done, update the current + * time in the display. + */ + + if (eventPtr->type == PropertyNotify) { + winPtr->dispPtr->lastEventTime = eventPtr->xproperty.time; + } + + /* + * There's a potential interaction here with Tk_DeleteEventHandler. + * Read the documentation for pendingPtr. + */ + + ip.eventPtr = eventPtr; + ip.winPtr = winPtr; + ip.nextHandler = NULL; + ip.nextPtr = tsdPtr->pendingPtr; + tsdPtr->pendingPtr = &ip; + if (mask == 0) { + if ((eventPtr->type == SelectionClear) + || (eventPtr->type == SelectionRequest) + || (eventPtr->type == SelectionNotify)) { + TkSelEventProc((Tk_Window) winPtr, eventPtr); + } else if ((eventPtr->type == ClientMessage) + && (eventPtr->xclient.message_type == + Tk_InternAtom((Tk_Window) winPtr, "WM_PROTOCOLS"))) { + TkWmProtocolEventProc(winPtr, eventPtr); + } + } else { + for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) { + if ((handlerPtr->mask & mask) != 0) { + ip.nextHandler = handlerPtr->nextPtr; + (*(handlerPtr->proc))(handlerPtr->clientData, eventPtr); + handlerPtr = ip.nextHandler; + } else { + handlerPtr = handlerPtr->nextPtr; + } + } + + /* + * Pass the event to the "bind" command mechanism. But, don't + * do this for SubstructureNotify events. The "bind" command + * doesn't support them anyway, and it's easier to filter out + * these events here than in the lower-level procedures. + */ + + if ((ip.winPtr != None) && (mask != SubstructureNotifyMask)) { + TkBindEventProc(winPtr, eventPtr); + } + } + tsdPtr->pendingPtr = ip.nextPtr; +done: + + /* + * Release the interpreter for this window so that it can be potentially + * deleted if requested. + */ + + if (interp != (Tcl_Interp *) NULL) { + Tcl_Release((ClientData) interp); + } +} + +/* + *-------------------------------------------------------------- + * + * TkEventDeadWindow -- + * + * This procedure is invoked when it is determined that + * a window is dead. It cleans up event-related information + * about the window. + * + * Results: + * None. + * + * Side effects: + * Various things get cleaned up and recycled. + * + *-------------------------------------------------------------- + */ + +void +TkEventDeadWindow(winPtr) + TkWindow *winPtr; /* Information about the window + * that is being deleted. */ +{ + register TkEventHandler *handlerPtr; + register InProgress *ipPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + /* + * While deleting all the handlers, be careful to check for + * Tk_HandleEvent being about to process one of the deleted + * handlers. If it is, tell it to quit (all of the handlers + * are being deleted). + */ + + while (winPtr->handlerList != NULL) { + handlerPtr = winPtr->handlerList; + winPtr->handlerList = handlerPtr->nextPtr; + for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; + ipPtr = ipPtr->nextPtr) { + if (ipPtr->nextHandler == handlerPtr) { + ipPtr->nextHandler = NULL; + } + if (ipPtr->winPtr == winPtr) { + ipPtr->winPtr = None; + } + } + ckfree((char *) handlerPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * TkCurrentTime -- + * + * Try to deduce the current time. "Current time" means the time + * of the event that led to the current code being executed, which + * means the time in the most recently-nested invocation of + * Tk_HandleEvent. + * + * Results: + * The return value is the time from the current event, or + * CurrentTime if there is no current event or if the current + * event contains no time. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Time +TkCurrentTime(dispPtr) + TkDisplay *dispPtr; /* Display for which the time is desired. */ +{ + register XEvent *eventPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (tsdPtr->pendingPtr == NULL) { + return dispPtr->lastEventTime; + } + eventPtr = tsdPtr->pendingPtr->eventPtr; + switch (eventPtr->type) { + case ButtonPress: + case ButtonRelease: + return eventPtr->xbutton.time; + case KeyPress: + case KeyRelease: + return eventPtr->xkey.time; + case MotionNotify: + return eventPtr->xmotion.time; + case EnterNotify: + case LeaveNotify: + return eventPtr->xcrossing.time; + case PropertyNotify: + return eventPtr->xproperty.time; + } + return dispPtr->lastEventTime; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_RestrictEvents -- + * + * This procedure is used to globally restrict the set of events + * that will be dispatched. The restriction is done by filtering + * all incoming X events through a procedure that determines + * whether they are to be processed immediately, deferred, or + * discarded. + * + * Results: + * The return value is the previous restriction procedure in effect, + * if there was one, or NULL if there wasn't. + * + * Side effects: + * From now on, proc will be called to determine whether to process, + * defer or discard each incoming X event. + * + *---------------------------------------------------------------------- + */ + +Tk_RestrictProc * +Tk_RestrictEvents(proc, arg, prevArgPtr) + Tk_RestrictProc *proc; /* Procedure to call for each incoming + * event. */ + ClientData arg; /* Arbitrary argument to pass to proc. */ + ClientData *prevArgPtr; /* Place to store information about previous + * argument. */ +{ + Tk_RestrictProc *prev; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + prev = tsdPtr->restrictProc; + *prevArgPtr = tsdPtr->restrictArg; + tsdPtr->restrictProc = proc; + tsdPtr->restrictArg = arg; + return prev; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_QueueWindowEvent -- + * + * Given an X-style window event, this procedure adds it to the + * Tcl event queue at the given position. This procedure also + * performs mouse motion event collapsing if possible. + * + * Results: + * None. + * + * Side effects: + * Adds stuff to the event queue, which will eventually be + * processed. + * + *---------------------------------------------------------------------- + */ + +void +Tk_QueueWindowEvent(eventPtr, position) + XEvent *eventPtr; /* Event to add to queue. This + * procedures copies it before adding + * it to the queue. */ + Tcl_QueuePosition position; /* Where to put it on the queue: + * TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, + * or TCL_QUEUE_MARK. */ +{ + TkWindowEvent *wevPtr; + TkDisplay *dispPtr; + + /* + * Find our display structure for the event's display. + */ + + for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) { + if (dispPtr == NULL) { + return; + } + if (dispPtr->display == eventPtr->xany.display) { + break; + } + } + + if ((dispPtr->delayedMotionPtr != NULL) && (position == TCL_QUEUE_TAIL)) { + if ((eventPtr->type == MotionNotify) && (eventPtr->xmotion.window + == dispPtr->delayedMotionPtr->event.xmotion.window)) { + /* + * The new event is a motion event in the same window as the + * saved motion event. Just replace the saved event with the + * new one. + */ + + dispPtr->delayedMotionPtr->event = *eventPtr; + return; + } else if ((eventPtr->type != GraphicsExpose) + && (eventPtr->type != NoExpose) + && (eventPtr->type != Expose)) { + /* + * The new event may conflict with the saved motion event. Queue + * the saved motion event now so that it will be processed before + * the new event. + */ + + Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, position); + dispPtr->delayedMotionPtr = NULL; + Tcl_CancelIdleCall(DelayedMotionProc, (ClientData) dispPtr); + } + } + + wevPtr = (TkWindowEvent *) ckalloc(sizeof(TkWindowEvent)); + wevPtr->header.proc = WindowEventProc; + wevPtr->event = *eventPtr; + if ((eventPtr->type == MotionNotify) && (position == TCL_QUEUE_TAIL)) { + /* + * The new event is a motion event so don't queue it immediately; + * save it around in case another motion event arrives that it can + * be collapsed with. + */ + + if (dispPtr->delayedMotionPtr != NULL) { + panic("Tk_QueueWindowEvent found unexpected delayed motion event"); + } + dispPtr->delayedMotionPtr = wevPtr; + Tcl_DoWhenIdle(DelayedMotionProc, (ClientData) dispPtr); + } else { + Tcl_QueueEvent(&wevPtr->header, position); + } +} + +/* + *--------------------------------------------------------------------------- + * + * TkQueueEventForAllChildren -- + * + * Given an XEvent, recursively queue the event for this window and + * all non-toplevel children of the given window. + * + * Results: + * None. + * + * Side effects: + * Events queued. + * + *--------------------------------------------------------------------------- + */ + +void +TkQueueEventForAllChildren(winPtr, eventPtr) + TkWindow *winPtr; /* Window to which event is sent. */ + XEvent *eventPtr; /* The event to be sent. */ +{ + TkWindow *childPtr; + + eventPtr->xany.window = winPtr->window; + Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_TAIL); + + childPtr = winPtr->childList; + while (childPtr != NULL) { + if (!Tk_IsTopLevel(childPtr)) { + TkQueueEventForAllChildren(childPtr, eventPtr); + } + childPtr = childPtr->nextPtr; + } +} + +/* + *---------------------------------------------------------------------- + * + * WindowEventProc -- + * + * This procedure is called by Tcl_DoOneEvent when a window event + * reaches the front of the event queue. This procedure is responsible + * for actually handling the event. + * + * Results: + * Returns 1 if the event was handled, meaning it should be removed + * from the queue. Returns 0 if the event was not handled, meaning + * it should stay on the queue. The event isn't handled if the + * TCL_WINDOW_EVENTS bit isn't set in flags, if a restrict proc + * prevents the event from being handled. + * + * Side effects: + * Whatever the event handlers for the event do. + * + *---------------------------------------------------------------------- + */ + +static int +WindowEventProc(evPtr, flags) + Tcl_Event *evPtr; /* Event to service. */ + int flags; /* Flags that indicate what events to + * handle, such as TCL_WINDOW_EVENTS. */ +{ + TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr; + Tk_RestrictAction result; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (!(flags & TCL_WINDOW_EVENTS)) { + return 0; + } + if (tsdPtr->restrictProc != NULL) { + result = (*tsdPtr->restrictProc)(tsdPtr->restrictArg, &wevPtr->event); + if (result != TK_PROCESS_EVENT) { + if (result == TK_DEFER_EVENT) { + return 0; + } else { + /* + * TK_DELETE_EVENT: return and say we processed the event, + * even though we didn't do anything at all. + */ + return 1; + } + } + } + Tk_HandleEvent(&wevPtr->event); + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * DelayedMotionProc -- + * + * This procedure is invoked as an idle handler when a mouse motion + * event has been delayed. It queues the delayed event so that it + * will finally be serviced. + * + * Results: + * None. + * + * Side effects: + * The delayed mouse motion event gets added to the Tcl event + * queue for servicing. + * + *---------------------------------------------------------------------- + */ + +static void +DelayedMotionProc(clientData) + ClientData clientData; /* Pointer to display containing a delayed + * motion event to be serviced. */ +{ + TkDisplay *dispPtr = (TkDisplay *) clientData; + + if (dispPtr->delayedMotionPtr == NULL) { + panic("DelayedMotionProc found no delayed mouse motion event"); + } + Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, TCL_QUEUE_TAIL); + dispPtr->delayedMotionPtr = NULL; +} + +/* + *-------------------------------------------------------------- + * + * Tk_MainLoop -- + * + * Call Tcl_DoOneEvent over and over again in an infinite + * loop as long as there exist any main windows. + * + * Results: + * None. + * + * Side effects: + * Arbitrary; depends on handlers for events. + * + *-------------------------------------------------------------- + */ + +void +Tk_MainLoop() +{ + while (Tk_GetNumMainWindows() > 0) { + Tcl_DoOneEvent(0); + } +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkInt.h ./canvas-tcl8.2.2/tkInt.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkInt.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkInt.h Thu Dec 30 14:59:40 1999 @@ -0,0 +1,1009 @@ +/* + * tkInt.h -- + * + * Declarations for things used internally by the Tk + * procedures but not exported outside the module. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: $Id: tkInt.h,v 1.15 1999/06/17 19:58:00 surles Exp $ + */ + +#ifndef _TKINT +#define _TKINT + +#ifndef _TK +#include "tk.h" +#endif +#ifndef _TCL +#include "tcl.h" +#endif +#ifndef _TKPORT +#include "tkPort.h" +#endif + +/* + * Opaque type declarations: + */ + +typedef struct TkColormap TkColormap; +typedef struct TkGrabEvent TkGrabEvent; +typedef struct Tk_PostscriptInfo Tk_PostscriptInfo; +typedef struct TkpCursor_ *TkpCursor; +typedef struct TkRegion_ *TkRegion; +typedef struct TkStressedCmap TkStressedCmap; +typedef struct TkBindInfo_ *TkBindInfo; + +/* + * Procedure types. + */ + +typedef int (TkBindEvalProc) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, XEvent *eventPtr, Tk_Window tkwin, + KeySym keySym)); +typedef void (TkBindFreeProc) _ANSI_ARGS_((ClientData clientData)); +typedef Window (TkClassCreateProc) _ANSI_ARGS_((Tk_Window tkwin, + Window parent, ClientData instanceData)); +typedef void (TkClassGeometryProc) _ANSI_ARGS_((ClientData instanceData)); +typedef void (TkClassModalProc) _ANSI_ARGS_((Tk_Window tkwin, + XEvent *eventPtr)); + + +/* + * Widget class procedures used to implement platform specific widget + * behavior. + */ + +typedef struct TkClassProcs { + TkClassCreateProc *createProc; + /* Procedure to invoke when the + platform-dependent window needs to be + created. */ + TkClassGeometryProc *geometryProc; + /* Procedure to invoke when the geometry of a + window needs to be recalculated as a result + of some change in the system. */ + TkClassModalProc *modalProc; + /* Procedure to invoke after all bindings on a + widget have been triggered in order to + handle a modal loop. */ +} TkClassProcs; + +/* + * One of the following structures is maintained for each cursor in + * use in the system. This structure is used by tkCursor.c and the + * various system specific cursor files. + */ + +typedef struct TkCursor { + Tk_Cursor cursor; /* System specific identifier for cursor. */ + Display *display; /* Display containing cursor. Needed for + * disposal and retrieval of cursors. */ + int resourceRefCount; /* Number of active uses of this cursor (each + * active use corresponds to a call to + * Tk_AllocPreserveFromObj or Tk_Preserve). + * If this count is 0, then this structure + * is no longer valid and it isn't present + * in a hash table: it is being kept around + * only because there are objects referring + * to it. The structure is freed when + * resourceRefCount and objRefCount are + * both 0. */ + int objRefCount; /* Number of Tcl objects that reference + * this structure.. */ + Tcl_HashTable *otherTable; /* Second table (other than idTable) used + * to index this entry. */ + Tcl_HashEntry *hashPtr; /* Entry in otherTable for this structure + * (needed when deleting). */ + Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure + * (needed when deleting). */ + struct TkCursor *nextPtr; /* Points to the next TkCursor structure with + * the same name. Cursors with the same + * name but different displays are chained + * together off a single hash table entry. */ +} TkCursor; + +/* + * One of the following structures is maintained for each display + * containing a window managed by Tk. In part, the structure is + * used to store thread-specific data, since each thread will have + * its own TkDisplay structure. + */ + +typedef struct TkDisplay { + Display *display; /* Xlib's info about display. */ + struct TkDisplay *nextPtr; /* Next in list of all displays. */ + char *name; /* Name of display (with any screen + * identifier removed). Malloc-ed. */ + Time lastEventTime; /* Time of last event received for this + * display. */ + + /* + * Information used primarily by tk3d.c: + */ + + int borderInit; /* 0 means borderTable needs initializing. */ + Tcl_HashTable borderTable; /* Maps from color name to TkBorder + * structure. */ + + /* + * Information used by tkAtom.c only: + */ + + int atomInit; /* 0 means stuff below hasn't been + * initialized yet. */ + Tcl_HashTable nameTable; /* Maps from names to Atom's. */ + Tcl_HashTable atomTable; /* Maps from Atom's back to names. */ + + /* + * Information used primarily by tkBind.c: + */ + + int bindInfoStale; /* Non-zero means the variables in this + * part of the structure are potentially + * incorrect and should be recomputed. */ + unsigned int modeModMask; /* Has one bit set to indicate the modifier + * corresponding to "mode shift". If no + * such modifier, than this is zero. */ + unsigned int metaModMask; /* Has one bit set to indicate the modifier + * corresponding to the "Meta" key. If no + * such modifier, then this is zero. */ + unsigned int altModMask; /* Has one bit set to indicate the modifier + * corresponding to the "Meta" key. If no + * such modifier, then this is zero. */ + enum {LU_IGNORE, LU_CAPS, LU_SHIFT} lockUsage; + /* Indicates how to interpret lock modifier. */ + int numModKeyCodes; /* Number of entries in modKeyCodes array + * below. */ + KeyCode *modKeyCodes; /* Pointer to an array giving keycodes for + * all of the keys that have modifiers + * associated with them. Malloc'ed, but + * may be NULL. */ + + /* + * Information used by tkBitmap.c only: + */ + + int bitmapInit; /* 0 means tables above need initializing. */ + int bitmapAutoNumber; /* Used to number bitmaps. */ + Tcl_HashTable bitmapNameTable; + /* Maps from name of bitmap to the first + * TkBitmap record for that name. */ + Tcl_HashTable bitmapIdTable;/* Maps from bitmap id to the TkBitmap + * structure for the bitmap. */ + Tcl_HashTable bitmapDataTable; + /* Used by Tk_GetBitmapFromData to map from + * a collection of in-core data about a + * bitmap to a reference giving an auto- + * matically-generated name for the bitmap. */ + + /* + * Information used by tkCanvas.c only: + */ + + int numIdSearches; + int numSlowSearches; + + /* + * Used by tkColor.c only: + */ + + int colorInit; /* 0 means color module needs initializing. */ + TkStressedCmap *stressPtr; /* First in list of colormaps that have + * filled up, so we have to pick an + * approximate color. */ + Tcl_HashTable colorNameTable; + /* Maps from color name to TkColor structure + * for that color. */ + Tcl_HashTable colorValueTable; + /* Maps from integer RGB values to TkColor + * structures. */ + + /* + * Used by tkCursor.c only: + */ + + int cursorInit; /* 0 means cursor module need initializing. */ + Tcl_HashTable cursorNameTable; + /* Maps from a string name to a cursor to the + * TkCursor record for the cursor. */ + Tcl_HashTable cursorDataTable; + /* Maps from a collection of in-core data + * about a cursor to a TkCursor structure. */ + Tcl_HashTable cursorIdTable; + /* Maps from a cursor id to the TkCursor + * structure for the cursor. */ + char cursorString[20]; /* Used to store a cursor id string. */ + Font cursorFont; /* Font to use for standard cursors. + * None means font not loaded yet. */ + + /* + * Information used by tkError.c only: + */ + + struct TkErrorHandler *errorPtr; + /* First in list of error handlers + * for this display. NULL means + * no handlers exist at present. */ + int deleteCount; /* Counts # of handlers deleted since + * last time inactive handlers were + * garbage-collected. When this number + * gets big, handlers get cleaned up. */ + + /* + * Used by tkEvent.c only: + */ + + struct TkWindowEvent *delayedMotionPtr; + /* Points to a malloc-ed motion event + * whose processing has been delayed in + * the hopes that another motion event + * will come along right away and we can + * merge the two of them together. NULL + * means that there is no delayed motion + * event. */ + + /* + * Information used by tkFocus.c only: + */ + + int focusDebug; /* 1 means collect focus debugging + * statistics. */ + struct TkWindow *implicitWinPtr; + /* If the focus arrived at a toplevel window + * implicitly via an Enter event (rather + * than via a FocusIn event), this points + * to the toplevel window. Otherwise it is + * NULL. */ + struct TkWindow *focusPtr; /* Points to the window on this display that + * should be receiving keyboard events. When + * multiple applications on the display have + * the focus, this will refer to the + * innermost window in the innermost + * application. This information isn't used + * under Unix or Windows, but it's needed on + * the Macintosh. */ + + /* + * Information used by tkGC.c only: + */ + + Tcl_HashTable gcValueTable; /* Maps from a GC's values to a TkGC structure + * describing a GC with those values. */ + Tcl_HashTable gcIdTable; /* Maps from a GC to a TkGC. */ + int gcInit; /* 0 means the tables below need + * initializing. */ + + /* + * Information used by tkGeometry.c only: + */ + + Tcl_HashTable maintainHashTable; + /* Hash table that maps from a master's + * Tk_Window token to a list of slaves + * managed by that master. */ + int geomInit; + + /* + * Information used by tkGet.c only: + */ + + Tcl_HashTable uidTable; /* Stores all Tk_Uid used in a thread. */ + int uidInit; /* 0 means uidTable needs initializing. */ + + /* + * Information used by tkGrab.c only: + */ + + struct TkWindow *grabWinPtr; + /* Window in which the pointer is currently + * grabbed, or NULL if none. */ + struct TkWindow *eventualGrabWinPtr; + /* Value that grabWinPtr will have once the + * grab event queue (below) has been + * completely emptied. */ + struct TkWindow *buttonWinPtr; + /* Window in which first mouse button was + * pressed while grab was in effect, or NULL + * if no such press in effect. */ + struct TkWindow *serverWinPtr; + /* If no application contains the pointer then + * this is NULL. Otherwise it contains the + * last window for which we've gotten an + * Enter or Leave event from the server (i.e. + * the last window known to have contained + * the pointer). Doesn't reflect events + * that were synthesized in tkGrab.c. */ + TkGrabEvent *firstGrabEventPtr; + /* First in list of enter/leave events + * synthesized by grab code. These events + * must be processed in order before any other + * events are processed. NULL means no such + * events. */ + TkGrabEvent *lastGrabEventPtr; + /* Last in list of synthesized events, or NULL + * if list is empty. */ + int grabFlags; /* Miscellaneous flag values. See definitions + * in tkGrab.c. */ + + /* + * Information used by tkGrid.c only: + */ + + int gridInit; /* 0 means table below needs initializing. */ + Tcl_HashTable gridHashTable;/* Maps from Tk_Window tokens to + * corresponding Grid structures. */ + + /* + * Information used by tkImage.c only: + */ + + int imageId; /* Value used to number image ids. */ + + /* + * Information used by tkMacWinMenu.c only: + */ + + int postCommandGeneration; + + /* + * Information used by tkOption.c only. + */ + + + + /* + * Information used by tkPack.c only. + */ + + int packInit; /* 0 means table below needs initializing. */ + Tcl_HashTable packerHashTable; + /* Maps from Tk_Window tokens to + * corresponding Packer structures. */ + + + /* + * Information used by tkPlace.c only. + */ + + int placeInit; /* 0 means tables below need initializing. */ + Tcl_HashTable masterTable; /* Maps from Tk_Window toke to the Master + * structure for the window, if it exists. */ + Tcl_HashTable slaveTable; /* Maps from Tk_Window toke to the Slave + * structure for the window, if it exists. */ + + /* + * Information used by tkSelect.c and tkClipboard.c only: + */ + + struct TkSelectionInfo *selectionInfoPtr; + /* First in list of selection information + * records. Each entry contains information + * about the current owner of a particular + * selection on this display. */ + Atom multipleAtom; /* Atom for MULTIPLE. None means + * selection stuff isn't initialized. */ + Atom incrAtom; /* Atom for INCR. */ + Atom targetsAtom; /* Atom for TARGETS. */ + Atom timestampAtom; /* Atom for TIMESTAMP. */ + Atom textAtom; /* Atom for TEXT. */ + Atom compoundTextAtom; /* Atom for COMPOUND_TEXT. */ + Atom applicationAtom; /* Atom for TK_APPLICATION. */ + Atom windowAtom; /* Atom for TK_WINDOW. */ + Atom clipboardAtom; /* Atom for CLIPBOARD. */ + + Tk_Window clipWindow; /* Window used for clipboard ownership and to + * retrieve selections between processes. NULL + * means clipboard info hasn't been + * initialized. */ + int clipboardActive; /* 1 means we currently own the clipboard + * selection, 0 means we don't. */ + struct TkMainInfo *clipboardAppPtr; + /* Last application that owned clipboard. */ + struct TkClipboardTarget *clipTargetPtr; + /* First in list of clipboard type information + * records. Each entry contains information + * about the buffers for a given selection + * target. */ + + /* + * Information used by tkSend.c only: + */ + + Tk_Window commTkwin; /* Window used for communication + * between interpreters during "send" + * commands. NULL means send info hasn't + * been initialized yet. */ + Atom commProperty; /* X's name for comm property. */ + Atom registryProperty; /* X's name for property containing + * registry of interpreter names. */ + Atom appNameProperty; /* X's name for property used to hold the + * application name on each comm window. */ + + /* + * Information used by tkXId.c only: + */ + + struct TkIdStack *idStackPtr; + /* First in list of chunks of free resource + * identifiers, or NULL if there are no free + * resources. */ + XID (*defaultAllocProc) _ANSI_ARGS_((Display *display)); + /* Default resource allocator for display. */ + struct TkIdStack *windowStackPtr; + /* First in list of chunks of window + * identifers that can't be reused right + * now. */ + int idCleanupScheduled; /* 1 means a call to WindowIdCleanup has + * already been scheduled, 0 means it + * hasn't. */ + + /* + * Information used by tkUnixWm.c and tkWinWm.c only: + */ + + int wmTracing; /* Used to enable or disable tracing in + * this module. If tracing is enabled, + * then information is printed on + * standard output about interesting + * interactions with the window manager. */ + struct TkWmInfo *firstWmPtr; /* Points to first top-level window. */ + struct TkWmInfo *foregroundWmPtr; + /* Points to the foreground window. */ + + /* + * Information maintained by tkWindow.c for use later on by tkXId.c: + */ + + + int destroyCount; /* Number of Tk_DestroyWindow operations + * in progress. */ + unsigned long lastDestroyRequest; + /* Id of most recent XDestroyWindow request; + * can re-use ids in windowStackPtr when + * server has seen this request and event + * queue is empty. */ + + /* + * Information used by tkVisual.c only: + */ + + TkColormap *cmapPtr; /* First in list of all non-default colormaps + * allocated for this display. */ + + /* + * Miscellaneous information: + */ + +#ifdef TK_USE_INPUT_METHODS + XIM inputMethod; /* Input method for this display */ +#endif /* TK_USE_INPUT_METHODS */ + Tcl_HashTable winTable; /* Maps from X window ids to TkWindow ptrs. */ + + int refCount; /* Reference count of how many Tk applications + * are using this display. Used to clean up + * the display when we no longer have any + * Tk applications using it. + */ +} TkDisplay; + +/* + * One of the following structures exists for each error handler + * created by a call to Tk_CreateErrorHandler. The structure + * is managed by tkError.c. + */ + +typedef struct TkErrorHandler { + TkDisplay *dispPtr; /* Display to which handler applies. */ + unsigned long firstRequest; /* Only errors with serial numbers + * >= to this are considered. */ + unsigned long lastRequest; /* Only errors with serial numbers + * <= to this are considered. This + * field is filled in when XUnhandle + * is called. -1 means XUnhandle + * hasn't been called yet. */ + int error; /* Consider only errors with this + * error_code (-1 means consider + * all errors). */ + int request; /* Consider only errors with this + * major request code (-1 means + * consider all major codes). */ + int minorCode; /* Consider only errors with this + * minor request code (-1 means + * consider all minor codes). */ + Tk_ErrorProc *errorProc; /* Procedure to invoke when a matching + * error occurs. NULL means just ignore + * errors. */ + ClientData clientData; /* Arbitrary value to pass to + * errorProc. */ + struct TkErrorHandler *nextPtr; + /* Pointer to next older handler for + * this display, or NULL for end of + * list. */ +} TkErrorHandler; + + + + +/* + * One of the following structures exists for each event handler + * created by calling Tk_CreateEventHandler. This information + * is used by tkEvent.c only. + */ + +typedef struct TkEventHandler { + unsigned long mask; /* Events for which to invoke + * proc. */ + Tk_EventProc *proc; /* Procedure to invoke when an event + * in mask occurs. */ + ClientData clientData; /* Argument to pass to proc. */ + struct TkEventHandler *nextPtr; + /* Next in list of handlers + * associated with window (NULL means + * end of list). */ +} TkEventHandler; + +/* + * Tk keeps one of the following data structures for each main + * window (created by a call to TkCreateMainWindow). It stores + * information that is shared by all of the windows associated + * with a particular main window. + */ + +typedef struct TkMainInfo { + int refCount; /* Number of windows whose "mainPtr" fields + * point here. When this becomes zero, can + * free up the structure (the reference + * count is zero because windows can get + * deleted in almost any order; the main + * window isn't necessarily the last one + * deleted). */ + struct TkWindow *winPtr; /* Pointer to main window. */ + Tcl_Interp *interp; /* Interpreter associated with application. */ + Tcl_HashTable nameTable; /* Hash table mapping path names to TkWindow + * structs for all windows related to this + * main window. Managed by tkWindow.c. */ + Tk_BindingTable bindingTable; + /* Used in conjunction with "bind" command + * to bind events to Tcl commands. */ + TkBindInfo bindInfo; /* Information used by tkBind.c on a per + * application basis. */ + struct TkFontInfo *fontInfoPtr; + /* Information used by tkFont.c on a per + * application basis. */ + + /* + * Information used only by tkFocus.c and tk*Embed.c: + */ + + struct TkToplevelFocusInfo *tlFocusPtr; + /* First in list of records containing focus + * information for each top-level in the + * application. Used only by tkFocus.c. */ + struct TkDisplayFocusInfo *displayFocusPtr; + /* First in list of records containing focus + * information for each display that this + * application has ever used. Used only + * by tkFocus.c. */ + + struct ElArray *optionRootPtr; + /* Top level of option hierarchy for this + * main window. NULL means uninitialized. + * Managed by tkOption.c. */ + Tcl_HashTable imageTable; /* Maps from image names to Tk_ImageMaster + * structures. Managed by tkImage.c. */ + int strictMotif; /* This is linked to the tk_strictMotif + * global variable. */ + struct TkMainInfo *nextPtr; /* Next in list of all main windows managed by + * this process. */ +} TkMainInfo; + +/* + * Tk keeps the following data structure for each of it's builtin + * bitmaps. This structure is only used by tkBitmap.c and other + * platform specific bitmap files. + */ + +typedef struct { + char *source; /* Bits for bitmap. */ + int width, height; /* Dimensions of bitmap. */ + int native; /* 0 means generic (X style) bitmap, + * 1 means native style bitmap. */ +} TkPredefBitmap; + +/* + * Tk keeps one of the following structures for each window. + * Some of the information (like size and location) is a shadow + * of information managed by the X server, and some is special + * information used here, such as event and geometry management + * information. This information is (mostly) managed by tkWindow.c. + * WARNING: the declaration below must be kept consistent with the + * Tk_FakeWin structure in tk.h. If you change one, be sure to + * change the other!! + */ + +typedef struct TkWindow { + + /* + * Structural information: + */ + + Display *display; /* Display containing window. */ + TkDisplay *dispPtr; /* Tk's information about display + * for window. */ + int screenNum; /* Index of screen for window, among all + * those for dispPtr. */ + Visual *visual; /* Visual to use for window. If not default, + * MUST be set before X window is created. */ + int depth; /* Number of bits/pixel. */ + Window window; /* X's id for window. NULL means window + * hasn't actually been created yet, or it's + * been deleted. */ + struct TkWindow *childList; /* First in list of child windows, + * or NULL if no children. List is in + * stacking order, lowest window first.*/ + struct TkWindow *lastChildPtr; + /* Last in list of child windows (highest + * in stacking order), or NULL if no + * children. */ + struct TkWindow *parentPtr; /* Pointer to parent window (logical + * parent, not necessarily X parent). NULL + * means either this is the main window, or + * the window's parent has already been + * deleted. */ + struct TkWindow *nextPtr; /* Next higher sibling (in stacking order) + * in list of children with same parent. NULL + * means end of list. */ + TkMainInfo *mainPtr; /* Information shared by all windows + * associated with a particular main + * window. NULL means this window is + * a rogue that isn't associated with + * any application (at present, this + * only happens for the dummy windows + * used for "send" communication). */ + + /* + * Name and type information for the window: + */ + + char *pathName; /* Path name of window (concatenation + * of all names between this window and + * its top-level ancestor). This is a + * pointer into an entry in + * mainPtr->nameTable. NULL means that + * the window hasn't been completely + * created yet. */ + Tk_Uid nameUid; /* Name of the window within its parent + * (unique within the parent). */ + Tk_Uid classUid; /* Class of the window. NULL means window + * hasn't been given a class yet. */ + + /* + * Geometry and other attributes of window. This information + * may not be updated on the server immediately; stuff that + * hasn't been reflected in the server yet is called "dirty". + * At present, information can be dirty only if the window + * hasn't yet been created. + */ + + XWindowChanges changes; /* Geometry and other info about + * window. */ + unsigned int dirtyChanges; /* Bits indicate fields of "changes" + * that are dirty. */ + XSetWindowAttributes atts; /* Current attributes of window. */ + unsigned long dirtyAtts; /* Bits indicate fields of "atts" + * that are dirty. */ + + unsigned int flags; /* Various flag values: these are all + * defined in tk.h (confusing, but they're + * needed there for some query macros). */ + + /* + * Information kept by the event manager (tkEvent.c): + */ + + TkEventHandler *handlerList;/* First in list of event handlers + * declared for this window, or + * NULL if none. */ +#ifdef TK_USE_INPUT_METHODS + XIC inputContext; /* Input context (for input methods). */ +#endif /* TK_USE_INPUT_METHODS */ + + /* + * Information used for event bindings (see "bind" and "bindtags" + * commands in tkCmds.c): + */ + + ClientData *tagPtr; /* Points to array of tags used for bindings + * on this window. Each tag is a Tk_Uid. + * Malloc'ed. NULL means no tags. */ + int numTags; /* Number of tags at *tagPtr. */ + + /* + * Information used by tkOption.c to manage options for the + * window. + */ + + int optionLevel; /* -1 means no option information is + * currently cached for this window. + * Otherwise this gives the level in + * the option stack at which info is + * cached. */ + /* + * Information used by tkSelect.c to manage the selection. + */ + + struct TkSelHandler *selHandlerList; + /* First in list of handlers for + * returning the selection in various + * forms. */ + + /* + * Information used by tkGeometry.c for geometry management. + */ + + Tk_GeomMgr *geomMgrPtr; /* Information about geometry manager for + * this window. */ + ClientData geomData; /* Argument for geometry manager procedures. */ + int reqWidth, reqHeight; /* Arguments from last call to + * Tk_GeometryRequest, or 0's if + * Tk_GeometryRequest hasn't been + * called. */ + int internalBorderWidth; /* Width of internal border of window + * (0 means no internal border). Geometry + * managers should not normally place children + * on top of the border. */ + + /* + * Information maintained by tkWm.c for window manager communication. + */ + + struct TkWmInfo *wmInfoPtr; /* For top-level windows (and also + * for special Unix menubar and wrapper + * windows), points to structure with + * wm-related info (see tkWm.c). For + * other windows, this is NULL. */ + + /* + * Information used by widget classes. + */ + + TkClassProcs *classProcsPtr; + ClientData instanceData; + + /* + * Platform specific information private to each port. + */ + + struct TkWindowPrivate *privatePtr; +} TkWindow; + +/* + * The following structure is used as a two way map between integers + * and strings, usually to map between an internal C representation + * and the strings used in Tcl. + */ + +typedef struct TkStateMap { + int numKey; /* Integer representation of a value. */ + char *strKey; /* String representation of a value. */ +} TkStateMap; + +/* + * This structure is used by the Mac and Window porting layers as + * the internal representation of a clip_mask in a GC. + */ + +typedef struct TkpClipMask { + int type; /* One of TKP_CLIP_PIXMAP or TKP_CLIP_REGION */ + union { + Pixmap pixmap; + TkRegion region; + } value; +} TkpClipMask; + +#define TKP_CLIP_PIXMAP 0 +#define TKP_CLIP_REGION 1 + +/* + * Pointer to first entry in list of all displays currently known. + */ + +extern TkDisplay *tkDisplayList; + +/* + * Return values from TkGrabState: + */ + +#define TK_GRAB_NONE 0 +#define TK_GRAB_IN_TREE 1 +#define TK_GRAB_ANCESTOR 2 +#define TK_GRAB_EXCLUDED 3 + +/* + * The macro below is used to modify a "char" value (e.g. by casting + * it to an unsigned character) so that it can be used safely with + * macros such as isspace. + */ + +#define UCHAR(c) ((unsigned char) (c)) + +/* + * The following symbol is used in the mode field of FocusIn events + * generated by an embedded application to request the input focus from + * its container. + */ + +#define EMBEDDED_APP_WANTS_FOCUS (NotifyNormal + 20) + +/* + * Miscellaneous variables shared among Tk modules but not exported + * to the outside world: + */ + +extern Tk_Uid tkActiveUid; +extern Tk_ImageType tkBitmapImageType; +extern Tk_Uid tkDisabledUid; +extern Tk_PhotoImageFormat tkImgFmtGIF; +extern void (*tkHandleEventProc) _ANSI_ARGS_(( + XEvent* eventPtr)); +extern Tk_PhotoImageFormat tkImgFmtPPM; +extern TkMainInfo *tkMainWindowList; +extern Tk_Uid tkNormalUid; +extern Tk_ImageType tkPhotoImageType; +extern Tcl_HashTable tkPredefBitmapTable; +extern int tkSendSerial; + +#include "tkIntDecls.h" + +#ifdef BUILD_tk +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLEXPORT +#endif + +/* + * Internal procedures shared among Tk modules but not exported + * to the outside world: + */ + +EXTERN int Tk_AfterCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_BellObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_BindCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_BindtagsCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ButtonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_CanvasCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_CheckbuttonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_ClipboardCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ChooseColorObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tk_ChooseDirectoryObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tk_ChooseFontObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_DestroyCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_EntryObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_EventObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_FileeventCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_FrameCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_FocusObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_FontObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_GetOpenFileObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_GetSaveFileObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_GrabCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_GridCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ImageCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_LabelObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_LowerCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_MenubuttonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_MessageBoxObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_MessageCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_OptionCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_PackCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_RadiobuttonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_RaiseCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ScaleObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_ScrollbarCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_SelectionCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_SendCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_TextCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_TkwaitCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ToplevelCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_UpdateObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_WinfoObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_WmCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp, + int devId, char *buffer, long size)); + +EXTERN void TkEventInit _ANSI_ARGS_((void)); + +EXTERN int TkCreateMenuCmd _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int TkDeadAppCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +EXTERN int TkpTestembedCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +/* + * Unsupported commands. + */ +EXTERN int TkUnsupported1Cmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLIMPORT + +#endif /* _TKINT */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkIntDecls.h ./canvas-tcl8.2.2/tkIntDecls.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkIntDecls.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkIntDecls.h Thu Dec 30 15:13:52 1999 @@ -0,0 +1,1460 @@ +/* + * tkIntDecls.h -- + * + * This file contains the declarations for all unsupported + * functions that are exported by the Tk library. These + * interfaces are not guaranteed to remain the same between + * versions. Use at your own risk. + * + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkIntDecls.h,v 1.8 1999/08/10 16:58:37 hobbs Exp $ + */ + +#ifndef _TKINTDECLS +#define _TKINTDECLS + +#ifdef BUILD_tk +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT +#endif + +/* + * WARNING: This file is automatically generated by the tools/genStubs.tcl + * script. Any modifications to the function declarations below should be made + * in the generic/tkInt.decls script. + */ + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + +/* 0 */ +EXTERN TkWindow * TkAllocWindow _ANSI_ARGS_((TkDisplay * dispPtr, + int screenNum, TkWindow * parentPtr)); +/* 1 */ +EXTERN void TkBezierPoints _ANSI_ARGS_((double control[], + int numSteps, double * coordPtr)); +/* 2 */ +EXTERN void TkBezierScreenPoints _ANSI_ARGS_((Tk_Canvas canvas, + double control[], int numSteps, + XPoint * xPointPtr)); +/* 3 */ +EXTERN void TkBindDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 4 */ +EXTERN void TkBindEventProc _ANSI_ARGS_((TkWindow * winPtr, + XEvent * eventPtr)); +/* 5 */ +EXTERN void TkBindFree _ANSI_ARGS_((TkMainInfo * mainPtr)); +/* 6 */ +EXTERN void TkBindInit _ANSI_ARGS_((TkMainInfo * mainPtr)); +/* 7 */ +EXTERN void TkChangeEventWindow _ANSI_ARGS_((XEvent * eventPtr, + TkWindow * winPtr)); +/* 8 */ +EXTERN int TkClipInit _ANSI_ARGS_((Tcl_Interp * interp, + TkDisplay * dispPtr)); +/* 9 */ +EXTERN void TkComputeAnchor _ANSI_ARGS_((Tk_Anchor anchor, + Tk_Window tkwin, int padX, int padY, + int innerWidth, int innerHeight, int * xPtr, + int * yPtr)); +/* 10 */ +EXTERN int TkCopyAndGlobalEval _ANSI_ARGS_((Tcl_Interp * interp, + char * script)); +/* 11 */ +EXTERN unsigned long TkCreateBindingProcedure _ANSI_ARGS_(( + Tcl_Interp * interp, + Tk_BindingTable bindingTable, + ClientData object, char * eventString, + TkBindEvalProc * evalProc, + TkBindFreeProc * freeProc, + ClientData clientData)); +/* 12 */ +EXTERN TkCursor * TkCreateCursorFromData _ANSI_ARGS_((Tk_Window tkwin, + char * source, char * mask, int width, + int height, int xHot, int yHot, XColor fg, + XColor bg)); +/* 13 */ +EXTERN int TkCreateFrame _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char ** argv, + int toplevel, char * appName)); +/* 14 */ +EXTERN Tk_Window TkCreateMainWindow _ANSI_ARGS_((Tcl_Interp * interp, + char * screenName, char * baseName)); +/* 15 */ +EXTERN Time TkCurrentTime _ANSI_ARGS_((TkDisplay * dispPtr)); +/* 16 */ +EXTERN void TkDeleteAllImages _ANSI_ARGS_((TkMainInfo * mainPtr)); +/* 17 */ +EXTERN void TkDoConfigureNotify _ANSI_ARGS_((TkWindow * winPtr)); +/* 18 */ +EXTERN void TkDrawInsetFocusHighlight _ANSI_ARGS_(( + Tk_Window tkwin, GC gc, int width, + Drawable drawable, int padding)); +/* 19 */ +EXTERN void TkEventDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 20 */ +EXTERN void TkFillPolygon _ANSI_ARGS_((Tk_Canvas canvas, + double * coordPtr, int numPoints, + Display * display, Drawable drawable, GC gc, + GC outlineGC)); +/* 21 */ +EXTERN int TkFindStateNum _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * option, + CONST TkStateMap * mapPtr, + CONST char * strKey)); +/* 22 */ +EXTERN char * TkFindStateString _ANSI_ARGS_(( + CONST TkStateMap * mapPtr, int numKey)); +/* 23 */ +EXTERN void TkFocusDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 24 */ +EXTERN int TkFocusFilterEvent _ANSI_ARGS_((TkWindow * winPtr, + XEvent * eventPtr)); +/* 25 */ +EXTERN TkWindow * TkFocusKeyEvent _ANSI_ARGS_((TkWindow * winPtr, + XEvent * eventPtr)); +/* 26 */ +EXTERN void TkFontPkgInit _ANSI_ARGS_((TkMainInfo * mainPtr)); +/* 27 */ +EXTERN void TkFontPkgFree _ANSI_ARGS_((TkMainInfo * mainPtr)); +/* 28 */ +EXTERN void TkFreeBindingTags _ANSI_ARGS_((TkWindow * winPtr)); +/* 29 */ +EXTERN void TkpFreeCursor _ANSI_ARGS_((TkCursor * cursorPtr)); +/* 30 */ +EXTERN char * TkGetBitmapData _ANSI_ARGS_((Tcl_Interp * interp, + char * string, char * fileName, + int * widthPtr, int * heightPtr, + int * hotXPtr, int * hotYPtr)); +/* 31 */ +EXTERN void TkGetButtPoints _ANSI_ARGS_((double p1[], + double p2[], double width, int project, + double m1[], double m2[])); +/* 32 */ +EXTERN TkCursor * TkGetCursorByName _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, Tk_Uid string)); +/* 33 */ +EXTERN char * TkGetDefaultScreenName _ANSI_ARGS_(( + Tcl_Interp * interp, char * screenName)); +/* 34 */ +EXTERN TkDisplay * TkGetDisplay _ANSI_ARGS_((Display * display)); +/* 35 */ +EXTERN int TkGetDisplayOf _ANSI_ARGS_((Tcl_Interp * interp, + int objc, Tcl_Obj *CONST objv[], + Tk_Window * tkwinPtr)); +/* 36 */ +EXTERN TkWindow * TkGetFocusWin _ANSI_ARGS_((TkWindow * winPtr)); +/* 37 */ +EXTERN int TkGetInterpNames _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin)); +/* 38 */ +EXTERN int TkGetMiterPoints _ANSI_ARGS_((double p1[], + double p2[], double p3[], double width, + double m1[], double m2[])); +/* 39 */ +EXTERN void TkGetPointerCoords _ANSI_ARGS_((Tk_Window tkwin, + int * xPtr, int * yPtr)); +/* 40 */ +EXTERN void TkGetServerInfo _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin)); +/* 41 */ +EXTERN void TkGrabDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 42 */ +EXTERN int TkGrabState _ANSI_ARGS_((TkWindow * winPtr)); +/* 43 */ +EXTERN void TkIncludePoint _ANSI_ARGS_((Tk_Item * itemPtr, + double * pointPtr)); +/* 44 */ +EXTERN void TkInOutEvents _ANSI_ARGS_((XEvent * eventPtr, + TkWindow * sourcePtr, TkWindow * destPtr, + int leaveType, int enterType, + Tcl_QueuePosition position)); +/* 45 */ +EXTERN void TkInstallFrameMenu _ANSI_ARGS_((Tk_Window tkwin)); +/* 46 */ +EXTERN char * TkKeysymToString _ANSI_ARGS_((KeySym keysym)); +/* 47 */ +EXTERN int TkLineToArea _ANSI_ARGS_((double end1Ptr[], + double end2Ptr[], double rectPtr[])); +/* 48 */ +EXTERN double TkLineToPoint _ANSI_ARGS_((double end1Ptr[], + double end2Ptr[], double pointPtr[])); +/* 49 */ +EXTERN int TkMakeBezierCurve _ANSI_ARGS_((Tk_Canvas canvas, + double * pointPtr, int numPoints, + int numSteps, XPoint xPoints[], + double dblPoints[])); +/* 50 */ +EXTERN void TkMakeBezierPostscript _ANSI_ARGS_(( + Tcl_Interp * interp, Tk_Canvas canvas, + double * pointPtr, int numPoints)); +/* 51 */ +EXTERN void TkOptionClassChanged _ANSI_ARGS_((TkWindow * winPtr)); +/* 52 */ +EXTERN void TkOptionDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 53 */ +EXTERN int TkOvalToArea _ANSI_ARGS_((double * ovalPtr, + double * rectPtr)); +/* 54 */ +EXTERN double TkOvalToPoint _ANSI_ARGS_((double ovalPtr[], + double width, int filled, double pointPtr[])); +/* 55 */ +EXTERN int TkpChangeFocus _ANSI_ARGS_((TkWindow * winPtr, + int force)); +/* 56 */ +EXTERN void TkpCloseDisplay _ANSI_ARGS_((TkDisplay * dispPtr)); +/* 57 */ +EXTERN void TkpClaimFocus _ANSI_ARGS_((TkWindow * topLevelPtr, + int force)); +/* 58 */ +EXTERN void TkpDisplayWarning _ANSI_ARGS_((char * msg, + char * title)); +/* 59 */ +EXTERN void TkpGetAppName _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_DString * name)); +/* 60 */ +EXTERN TkWindow * TkpGetOtherWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 61 */ +EXTERN TkWindow * TkpGetWrapperWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 62 */ +EXTERN int TkpInit _ANSI_ARGS_((Tcl_Interp * interp)); +/* 63 */ +EXTERN void TkpInitializeMenuBindings _ANSI_ARGS_(( + Tcl_Interp * interp, + Tk_BindingTable bindingTable)); +/* 64 */ +EXTERN void TkpMakeContainer _ANSI_ARGS_((Tk_Window tkwin)); +/* 65 */ +EXTERN void TkpMakeMenuWindow _ANSI_ARGS_((Tk_Window tkwin, + int transient)); +/* 66 */ +EXTERN Window TkpMakeWindow _ANSI_ARGS_((TkWindow * winPtr, + Window parent)); +/* 67 */ +EXTERN void TkpMenuNotifyToplevelCreate _ANSI_ARGS_(( + Tcl_Interp * interp1, char * menuName)); +/* 68 */ +EXTERN TkDisplay * TkpOpenDisplay _ANSI_ARGS_((char * display_name)); +/* 69 */ +EXTERN int TkPointerEvent _ANSI_ARGS_((XEvent * eventPtr, + TkWindow * winPtr)); +/* 70 */ +EXTERN int TkPolygonToArea _ANSI_ARGS_((double * polyPtr, + int numPoints, double * rectPtr)); +/* 71 */ +EXTERN double TkPolygonToPoint _ANSI_ARGS_((double * polyPtr, + int numPoints, double * pointPtr)); +/* 72 */ +EXTERN int TkPositionInTree _ANSI_ARGS_((TkWindow * winPtr, + TkWindow * treePtr)); +/* 73 */ +EXTERN void TkpRedirectKeyEvent _ANSI_ARGS_((TkWindow * winPtr, + XEvent * eventPtr)); +/* 74 */ +EXTERN void TkpSetMainMenubar _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, char * menuName)); +/* 75 */ +EXTERN int TkpUseWindow _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, char * string)); +/* 76 */ +EXTERN int TkpWindowWasRecentlyDeleted _ANSI_ARGS_((Window win, + TkDisplay * dispPtr)); +/* 77 */ +EXTERN void TkQueueEventForAllChildren _ANSI_ARGS_(( + TkWindow * winPtr, XEvent * eventPtr)); +/* 78 */ +EXTERN int TkReadBitmapFile _ANSI_ARGS_((Display* display, + Drawable d, CONST char* filename, + unsigned int* width_return, + unsigned int* height_return, + Pixmap* bitmap_return, int* x_hot_return, + int* y_hot_return)); +/* 79 */ +EXTERN int TkScrollWindow _ANSI_ARGS_((Tk_Window tkwin, GC gc, + int x, int y, int width, int height, int dx, + int dy, TkRegion damageRgn)); +/* 80 */ +EXTERN void TkSelDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 81 */ +EXTERN void TkSelEventProc _ANSI_ARGS_((Tk_Window tkwin, + XEvent * eventPtr)); +/* 82 */ +EXTERN void TkSelInit _ANSI_ARGS_((Tk_Window tkwin)); +/* 83 */ +EXTERN void TkSelPropProc _ANSI_ARGS_((XEvent * eventPtr)); +/* 84 */ +EXTERN void TkSetClassProcs _ANSI_ARGS_((Tk_Window tkwin, + TkClassProcs * procs, + ClientData instanceData)); +/* 85 */ +EXTERN void TkSetWindowMenuBar _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, char * oldMenuName, + char * menuName)); +/* 86 */ +EXTERN KeySym TkStringToKeysym _ANSI_ARGS_((char * name)); +/* 87 */ +EXTERN int TkThickPolyLineToArea _ANSI_ARGS_((double * coordPtr, + int numPoints, double width, int capStyle, + int joinStyle, double * rectPtr)); +/* 88 */ +EXTERN void TkWmAddToColormapWindows _ANSI_ARGS_(( + TkWindow * winPtr)); +/* 89 */ +EXTERN void TkWmDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 90 */ +EXTERN TkWindow * TkWmFocusToplevel _ANSI_ARGS_((TkWindow * winPtr)); +/* 91 */ +EXTERN void TkWmMapWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 92 */ +EXTERN void TkWmNewWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 93 */ +EXTERN void TkWmProtocolEventProc _ANSI_ARGS_((TkWindow * winPtr, + XEvent * evenvPtr)); +/* 94 */ +EXTERN void TkWmRemoveFromColormapWindows _ANSI_ARGS_(( + TkWindow * winPtr)); +/* 95 */ +EXTERN void TkWmRestackToplevel _ANSI_ARGS_((TkWindow * winPtr, + int aboveBelow, TkWindow * otherPtr)); +/* 96 */ +EXTERN void TkWmSetClass _ANSI_ARGS_((TkWindow * winPtr)); +/* 97 */ +EXTERN void TkWmUnmapWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 98 */ +EXTERN Tcl_Obj * TkDebugBitmap _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 99 */ +EXTERN Tcl_Obj * TkDebugBorder _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 100 */ +EXTERN Tcl_Obj * TkDebugCursor _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 101 */ +EXTERN Tcl_Obj * TkDebugColor _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 102 */ +EXTERN Tcl_Obj * TkDebugConfig _ANSI_ARGS_((Tcl_Interp * interp, + Tk_OptionTable table)); +/* 103 */ +EXTERN Tcl_Obj * TkDebugFont _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 104 */ +EXTERN int TkFindStateNumObj _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Obj * optionPtr, + CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr)); +/* 105 */ +EXTERN Tcl_HashTable * TkGetBitmapPredefTable _ANSI_ARGS_((void)); +/* 106 */ +EXTERN TkDisplay * TkGetDisplayList _ANSI_ARGS_((void)); +/* 107 */ +EXTERN TkMainInfo * TkGetMainInfoList _ANSI_ARGS_((void)); +/* 108 */ +EXTERN int TkGetWindowFromObj _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, Tcl_Obj * objPtr, + Tk_Window * windowPtr)); +/* 109 */ +EXTERN char * TkpGetString _ANSI_ARGS_((TkWindow * winPtr, + XEvent * eventPtr, Tcl_DString * dsPtr)); +/* 110 */ +EXTERN void TkpGetSubFonts _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Font tkfont)); +/* 111 */ +EXTERN Tcl_Obj * TkpGetSystemDefault _ANSI_ARGS_((Tk_Window tkwin, + char * dbName, char * className)); +/* 112 */ +EXTERN void TkpMenuThreadInit _ANSI_ARGS_((void)); +#ifdef __WIN32__ +/* 113 */ +EXTERN void TkClipBox _ANSI_ARGS_((TkRegion rgn, + XRectangle* rect_return)); +#endif /* __WIN32__ */ +#ifdef MAC_TCL +/* 113 */ +EXTERN void TkClipBox _ANSI_ARGS_((TkRegion rgn, + XRectangle* rect_return)); +#endif /* MAC_TCL */ +#ifdef __WIN32__ +/* 114 */ +EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void)); +#endif /* __WIN32__ */ +#ifdef MAC_TCL +/* 114 */ +EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void)); +#endif /* MAC_TCL */ +#ifdef __WIN32__ +/* 115 */ +EXTERN void TkDestroyRegion _ANSI_ARGS_((TkRegion rgn)); +#endif /* __WIN32__ */ +#ifdef MAC_TCL +/* 115 */ +EXTERN void TkDestroyRegion _ANSI_ARGS_((TkRegion rgn)); +#endif /* MAC_TCL */ +#ifdef __WIN32__ +/* 116 */ +EXTERN void TkIntersectRegion _ANSI_ARGS_((TkRegion sra, + TkRegion srcb, TkRegion dr_return)); +#endif /* __WIN32__ */ +#ifdef MAC_TCL +/* 116 */ +EXTERN void TkIntersectRegion _ANSI_ARGS_((TkRegion sra, + TkRegion srcb, TkRegion dr_return)); +#endif /* MAC_TCL */ +#ifdef __WIN32__ +/* 117 */ +EXTERN int TkRectInRegion _ANSI_ARGS_((TkRegion rgn, int x, + int y, unsigned int width, + unsigned int height)); +#endif /* __WIN32__ */ +#ifdef MAC_TCL +/* 117 */ +EXTERN int TkRectInRegion _ANSI_ARGS_((TkRegion rgn, int x, + int y, unsigned int width, + unsigned int height)); +#endif /* MAC_TCL */ +#ifdef __WIN32__ +/* 118 */ +EXTERN void TkSetRegion _ANSI_ARGS_((Display* display, GC gc, + TkRegion rgn)); +#endif /* __WIN32__ */ +#ifdef MAC_TCL +/* 118 */ +EXTERN void TkSetRegion _ANSI_ARGS_((Display* display, GC gc, + TkRegion rgn)); +#endif /* MAC_TCL */ +#ifdef __WIN32__ +/* 119 */ +EXTERN void TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect, + TkRegion src, TkRegion dr_return)); +#endif /* __WIN32__ */ +#ifdef MAC_TCL +/* 119 */ +EXTERN void TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect, + TkRegion src, TkRegion dr_return)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 120 */ +EXTERN void TkGenerateActivateEvents _ANSI_ARGS_(( + TkWindow * winPtr, int active)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 121 */ +EXTERN Pixmap TkpCreateNativeBitmap _ANSI_ARGS_((Display * display, + char * source)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 122 */ +EXTERN void TkpDefineNativeBitmaps _ANSI_ARGS_((void)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 123 */ +EXTERN unsigned long TkpGetMS _ANSI_ARGS_((void)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 124 */ +EXTERN Pixmap TkpGetNativeAppBitmap _ANSI_ARGS_((Display * display, + CONST char * name, int * width, int * height)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 125 */ +EXTERN void TkPointerDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 126 */ +EXTERN void TkpSetCapture _ANSI_ARGS_((TkWindow * winPtr)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 127 */ +EXTERN void TkpSetCursor _ANSI_ARGS_((TkpCursor cursor)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 128 */ +EXTERN void TkpWmSetState _ANSI_ARGS_((TkWindow * winPtr, + int state)); +#endif /* MAC_TCL */ +/* Slot 129 is reserved */ +#ifdef MAC_TCL +/* 130 */ +EXTERN Window TkGetTransientMaster _ANSI_ARGS_((TkWindow * winPtr)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 131 */ +EXTERN int TkGenerateButtonEvent _ANSI_ARGS_((int x, int y, + Window window, unsigned int state)); +#endif /* MAC_TCL */ +/* Slot 132 is reserved */ +#ifdef MAC_TCL +/* 133 */ +EXTERN void TkGenWMDestroyEvent _ANSI_ARGS_((Tk_Window tkwin)); +#endif /* MAC_TCL */ +#ifdef MAC_TCL +/* 134 */ +EXTERN void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin, + int x, int y, int width, int height, + int flags)); +#endif /* MAC_TCL */ +/* 135 */ +EXTERN void TkpDrawHighlightBorder _ANSI_ARGS_((Tk_Window tkwin, + GC fgGC, GC bgGC, int highlightWidth, + Drawable drawable)); +/* 136 */ +EXTERN void TkSetFocusWin _ANSI_ARGS_((TkWindow * winPtr, + int force)); + +typedef struct TkIntStubs { + int magic; + struct TkIntStubHooks *hooks; + + TkWindow * (*tkAllocWindow) _ANSI_ARGS_((TkDisplay * dispPtr, int screenNum, TkWindow * parentPtr)); /* 0 */ + void (*tkBezierPoints) _ANSI_ARGS_((double control[], int numSteps, double * coordPtr)); /* 1 */ + void (*tkBezierScreenPoints) _ANSI_ARGS_((Tk_Canvas canvas, double control[], int numSteps, XPoint * xPointPtr)); /* 2 */ + void (*tkBindDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 3 */ + void (*tkBindEventProc) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 4 */ + void (*tkBindFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 5 */ + void (*tkBindInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 6 */ + void (*tkChangeEventWindow) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * winPtr)); /* 7 */ + int (*tkClipInit) _ANSI_ARGS_((Tcl_Interp * interp, TkDisplay * dispPtr)); /* 8 */ + void (*tkComputeAnchor) _ANSI_ARGS_((Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int * xPtr, int * yPtr)); /* 9 */ + int (*tkCopyAndGlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * script)); /* 10 */ + unsigned long (*tkCreateBindingProcedure) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventString, TkBindEvalProc * evalProc, TkBindFreeProc * freeProc, ClientData clientData)); /* 11 */ + TkCursor * (*tkCreateCursorFromData) _ANSI_ARGS_((Tk_Window tkwin, char * source, char * mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg)); /* 12 */ + int (*tkCreateFrame) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv, int toplevel, char * appName)); /* 13 */ + Tk_Window (*tkCreateMainWindow) _ANSI_ARGS_((Tcl_Interp * interp, char * screenName, char * baseName)); /* 14 */ + Time (*tkCurrentTime) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 15 */ + void (*tkDeleteAllImages) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 16 */ + void (*tkDoConfigureNotify) _ANSI_ARGS_((TkWindow * winPtr)); /* 17 */ + void (*tkDrawInsetFocusHighlight) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int width, Drawable drawable, int padding)); /* 18 */ + void (*tkEventDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 19 */ + void (*tkFillPolygon) _ANSI_ARGS_((Tk_Canvas canvas, double * coordPtr, int numPoints, Display * display, Drawable drawable, GC gc, GC outlineGC)); /* 20 */ + int (*tkFindStateNum) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * option, CONST TkStateMap * mapPtr, CONST char * strKey)); /* 21 */ + char * (*tkFindStateString) _ANSI_ARGS_((CONST TkStateMap * mapPtr, int numKey)); /* 22 */ + void (*tkFocusDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 23 */ + int (*tkFocusFilterEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 24 */ + TkWindow * (*tkFocusKeyEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 25 */ + void (*tkFontPkgInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 26 */ + void (*tkFontPkgFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 27 */ + void (*tkFreeBindingTags) _ANSI_ARGS_((TkWindow * winPtr)); /* 28 */ + void (*tkpFreeCursor) _ANSI_ARGS_((TkCursor * cursorPtr)); /* 29 */ + char * (*tkGetBitmapData) _ANSI_ARGS_((Tcl_Interp * interp, char * string, char * fileName, int * widthPtr, int * heightPtr, int * hotXPtr, int * hotYPtr)); /* 30 */ + void (*tkGetButtPoints) _ANSI_ARGS_((double p1[], double p2[], double width, int project, double m1[], double m2[])); /* 31 */ + TkCursor * (*tkGetCursorByName) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid string)); /* 32 */ + char * (*tkGetDefaultScreenName) _ANSI_ARGS_((Tcl_Interp * interp, char * screenName)); /* 33 */ + TkDisplay * (*tkGetDisplay) _ANSI_ARGS_((Display * display)); /* 34 */ + int (*tkGetDisplayOf) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], Tk_Window * tkwinPtr)); /* 35 */ + TkWindow * (*tkGetFocusWin) _ANSI_ARGS_((TkWindow * winPtr)); /* 36 */ + int (*tkGetInterpNames) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 37 */ + int (*tkGetMiterPoints) _ANSI_ARGS_((double p1[], double p2[], double p3[], double width, double m1[], double m2[])); /* 38 */ + void (*tkGetPointerCoords) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr)); /* 39 */ + void (*tkGetServerInfo) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 40 */ + void (*tkGrabDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 41 */ + int (*tkGrabState) _ANSI_ARGS_((TkWindow * winPtr)); /* 42 */ + void (*tkIncludePoint) _ANSI_ARGS_((Tk_Item * itemPtr, double * pointPtr)); /* 43 */ + void (*tkInOutEvents) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * sourcePtr, TkWindow * destPtr, int leaveType, int enterType, Tcl_QueuePosition position)); /* 44 */ + void (*tkInstallFrameMenu) _ANSI_ARGS_((Tk_Window tkwin)); /* 45 */ + char * (*tkKeysymToString) _ANSI_ARGS_((KeySym keysym)); /* 46 */ + int (*tkLineToArea) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double rectPtr[])); /* 47 */ + double (*tkLineToPoint) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double pointPtr[])); /* 48 */ + int (*tkMakeBezierCurve) _ANSI_ARGS_((Tk_Canvas canvas, double * pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[])); /* 49 */ + void (*tkMakeBezierPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, double * pointPtr, int numPoints)); /* 50 */ + void (*tkOptionClassChanged) _ANSI_ARGS_((TkWindow * winPtr)); /* 51 */ + void (*tkOptionDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 52 */ + int (*tkOvalToArea) _ANSI_ARGS_((double * ovalPtr, double * rectPtr)); /* 53 */ + double (*tkOvalToPoint) _ANSI_ARGS_((double ovalPtr[], double width, int filled, double pointPtr[])); /* 54 */ + int (*tkpChangeFocus) _ANSI_ARGS_((TkWindow * winPtr, int force)); /* 55 */ + void (*tkpCloseDisplay) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 56 */ + void (*tkpClaimFocus) _ANSI_ARGS_((TkWindow * topLevelPtr, int force)); /* 57 */ + void (*tkpDisplayWarning) _ANSI_ARGS_((char * msg, char * title)); /* 58 */ + void (*tkpGetAppName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * name)); /* 59 */ + TkWindow * (*tkpGetOtherWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 60 */ + TkWindow * (*tkpGetWrapperWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 61 */ + int (*tkpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 62 */ + void (*tkpInitializeMenuBindings) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable)); /* 63 */ + void (*tkpMakeContainer) _ANSI_ARGS_((Tk_Window tkwin)); /* 64 */ + void (*tkpMakeMenuWindow) _ANSI_ARGS_((Tk_Window tkwin, int transient)); /* 65 */ + Window (*tkpMakeWindow) _ANSI_ARGS_((TkWindow * winPtr, Window parent)); /* 66 */ + void (*tkpMenuNotifyToplevelCreate) _ANSI_ARGS_((Tcl_Interp * interp1, char * menuName)); /* 67 */ + TkDisplay * (*tkpOpenDisplay) _ANSI_ARGS_((char * display_name)); /* 68 */ + int (*tkPointerEvent) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * winPtr)); /* 69 */ + int (*tkPolygonToArea) _ANSI_ARGS_((double * polyPtr, int numPoints, double * rectPtr)); /* 70 */ + double (*tkPolygonToPoint) _ANSI_ARGS_((double * polyPtr, int numPoints, double * pointPtr)); /* 71 */ + int (*tkPositionInTree) _ANSI_ARGS_((TkWindow * winPtr, TkWindow * treePtr)); /* 72 */ + void (*tkpRedirectKeyEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 73 */ + void (*tkpSetMainMenubar) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * menuName)); /* 74 */ + int (*tkpUseWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * string)); /* 75 */ + int (*tkpWindowWasRecentlyDeleted) _ANSI_ARGS_((Window win, TkDisplay * dispPtr)); /* 76 */ + void (*tkQueueEventForAllChildren) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 77 */ + int (*tkReadBitmapFile) _ANSI_ARGS_((Display* display, Drawable d, CONST char* filename, unsigned int* width_return, unsigned int* height_return, Pixmap* bitmap_return, int* x_hot_return, int* y_hot_return)); /* 78 */ + int (*tkScrollWindow) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int x, int y, int width, int height, int dx, int dy, TkRegion damageRgn)); /* 79 */ + void (*tkSelDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 80 */ + void (*tkSelEventProc) _ANSI_ARGS_((Tk_Window tkwin, XEvent * eventPtr)); /* 81 */ + void (*tkSelInit) _ANSI_ARGS_((Tk_Window tkwin)); /* 82 */ + void (*tkSelPropProc) _ANSI_ARGS_((XEvent * eventPtr)); /* 83 */ + void (*tkSetClassProcs) _ANSI_ARGS_((Tk_Window tkwin, TkClassProcs * procs, ClientData instanceData)); /* 84 */ + void (*tkSetWindowMenuBar) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * oldMenuName, char * menuName)); /* 85 */ + KeySym (*tkStringToKeysym) _ANSI_ARGS_((char * name)); /* 86 */ + int (*tkThickPolyLineToArea) _ANSI_ARGS_((double * coordPtr, int numPoints, double width, int capStyle, int joinStyle, double * rectPtr)); /* 87 */ + void (*tkWmAddToColormapWindows) _ANSI_ARGS_((TkWindow * winPtr)); /* 88 */ + void (*tkWmDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 89 */ + TkWindow * (*tkWmFocusToplevel) _ANSI_ARGS_((TkWindow * winPtr)); /* 90 */ + void (*tkWmMapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 91 */ + void (*tkWmNewWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 92 */ + void (*tkWmProtocolEventProc) _ANSI_ARGS_((TkWindow * winPtr, XEvent * evenvPtr)); /* 93 */ + void (*tkWmRemoveFromColormapWindows) _ANSI_ARGS_((TkWindow * winPtr)); /* 94 */ + void (*tkWmRestackToplevel) _ANSI_ARGS_((TkWindow * winPtr, int aboveBelow, TkWindow * otherPtr)); /* 95 */ + void (*tkWmSetClass) _ANSI_ARGS_((TkWindow * winPtr)); /* 96 */ + void (*tkWmUnmapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 97 */ + Tcl_Obj * (*tkDebugBitmap) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 98 */ + Tcl_Obj * (*tkDebugBorder) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 99 */ + Tcl_Obj * (*tkDebugCursor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 100 */ + Tcl_Obj * (*tkDebugColor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 101 */ + Tcl_Obj * (*tkDebugConfig) _ANSI_ARGS_((Tcl_Interp * interp, Tk_OptionTable table)); /* 102 */ + Tcl_Obj * (*tkDebugFont) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 103 */ + int (*tkFindStateNumObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * optionPtr, CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr)); /* 104 */ + Tcl_HashTable * (*tkGetBitmapPredefTable) _ANSI_ARGS_((void)); /* 105 */ + TkDisplay * (*tkGetDisplayList) _ANSI_ARGS_((void)); /* 106 */ + TkMainInfo * (*tkGetMainInfoList) _ANSI_ARGS_((void)); /* 107 */ + int (*tkGetWindowFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, Tk_Window * windowPtr)); /* 108 */ + char * (*tkpGetString) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr, Tcl_DString * dsPtr)); /* 109 */ + void (*tkpGetSubFonts) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Font tkfont)); /* 110 */ + Tcl_Obj * (*tkpGetSystemDefault) _ANSI_ARGS_((Tk_Window tkwin, char * dbName, char * className)); /* 111 */ + void (*tkpMenuThreadInit) _ANSI_ARGS_((void)); /* 112 */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved113; +#endif /* UNIX */ +#ifdef __WIN32__ + void (*tkClipBox) _ANSI_ARGS_((TkRegion rgn, XRectangle* rect_return)); /* 113 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkClipBox) _ANSI_ARGS_((TkRegion rgn, XRectangle* rect_return)); /* 113 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved114; +#endif /* UNIX */ +#ifdef __WIN32__ + TkRegion (*tkCreateRegion) _ANSI_ARGS_((void)); /* 114 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + TkRegion (*tkCreateRegion) _ANSI_ARGS_((void)); /* 114 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved115; +#endif /* UNIX */ +#ifdef __WIN32__ + void (*tkDestroyRegion) _ANSI_ARGS_((TkRegion rgn)); /* 115 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkDestroyRegion) _ANSI_ARGS_((TkRegion rgn)); /* 115 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved116; +#endif /* UNIX */ +#ifdef __WIN32__ + void (*tkIntersectRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 116 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkIntersectRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 116 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved117; +#endif /* UNIX */ +#ifdef __WIN32__ + int (*tkRectInRegion) _ANSI_ARGS_((TkRegion rgn, int x, int y, unsigned int width, unsigned int height)); /* 117 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + int (*tkRectInRegion) _ANSI_ARGS_((TkRegion rgn, int x, int y, unsigned int width, unsigned int height)); /* 117 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved118; +#endif /* UNIX */ +#ifdef __WIN32__ + void (*tkSetRegion) _ANSI_ARGS_((Display* display, GC gc, TkRegion rgn)); /* 118 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkSetRegion) _ANSI_ARGS_((Display* display, GC gc, TkRegion rgn)); /* 118 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved119; +#endif /* UNIX */ +#ifdef __WIN32__ + void (*tkUnionRectWithRegion) _ANSI_ARGS_((XRectangle* rect, TkRegion src, TkRegion dr_return)); /* 119 */ +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkUnionRectWithRegion) _ANSI_ARGS_((XRectangle* rect, TkRegion src, TkRegion dr_return)); /* 119 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved120; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved120; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkGenerateActivateEvents) _ANSI_ARGS_((TkWindow * winPtr, int active)); /* 120 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved121; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved121; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + Pixmap (*tkpCreateNativeBitmap) _ANSI_ARGS_((Display * display, char * source)); /* 121 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved122; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved122; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkpDefineNativeBitmaps) _ANSI_ARGS_((void)); /* 122 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved123; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved123; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + unsigned long (*tkpGetMS) _ANSI_ARGS_((void)); /* 123 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved124; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved124; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + Pixmap (*tkpGetNativeAppBitmap) _ANSI_ARGS_((Display * display, CONST char * name, int * width, int * height)); /* 124 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved125; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved125; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkPointerDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 125 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved126; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved126; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkpSetCapture) _ANSI_ARGS_((TkWindow * winPtr)); /* 126 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved127; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved127; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkpSetCursor) _ANSI_ARGS_((TkpCursor cursor)); /* 127 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved128; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved128; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkpWmSetState) _ANSI_ARGS_((TkWindow * winPtr, int state)); /* 128 */ +#endif /* MAC_TCL */ + void *reserved129; +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved130; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved130; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + Window (*tkGetTransientMaster) _ANSI_ARGS_((TkWindow * winPtr)); /* 130 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved131; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved131; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + int (*tkGenerateButtonEvent) _ANSI_ARGS_((int x, int y, Window window, unsigned int state)); /* 131 */ +#endif /* MAC_TCL */ + void *reserved132; +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved133; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved133; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkGenWMDestroyEvent) _ANSI_ARGS_((Tk_Window tkwin)); /* 133 */ +#endif /* MAC_TCL */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + void *reserved134; +#endif /* UNIX */ +#ifdef __WIN32__ + void *reserved134; +#endif /* __WIN32__ */ +#ifdef MAC_TCL + void (*tkGenWMConfigureEvent) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height, int flags)); /* 134 */ +#endif /* MAC_TCL */ + void (*tkpDrawHighlightBorder) _ANSI_ARGS_((Tk_Window tkwin, GC fgGC, GC bgGC, int highlightWidth, Drawable drawable)); /* 135 */ + void (*tkSetFocusWin) _ANSI_ARGS_((TkWindow * winPtr, int force)); /* 136 */ +} TkIntStubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern TkIntStubs *tkIntStubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) + +/* + * Inline function declarations: + */ + +#ifndef TkAllocWindow +#define TkAllocWindow \ + (tkIntStubsPtr->tkAllocWindow) /* 0 */ +#endif +#ifndef TkBezierPoints +#define TkBezierPoints \ + (tkIntStubsPtr->tkBezierPoints) /* 1 */ +#endif +#ifndef TkBezierScreenPoints +#define TkBezierScreenPoints \ + (tkIntStubsPtr->tkBezierScreenPoints) /* 2 */ +#endif +#ifndef TkBindDeadWindow +#define TkBindDeadWindow \ + (tkIntStubsPtr->tkBindDeadWindow) /* 3 */ +#endif +#ifndef TkBindEventProc +#define TkBindEventProc \ + (tkIntStubsPtr->tkBindEventProc) /* 4 */ +#endif +#ifndef TkBindFree +#define TkBindFree \ + (tkIntStubsPtr->tkBindFree) /* 5 */ +#endif +#ifndef TkBindInit +#define TkBindInit \ + (tkIntStubsPtr->tkBindInit) /* 6 */ +#endif +#ifndef TkChangeEventWindow +#define TkChangeEventWindow \ + (tkIntStubsPtr->tkChangeEventWindow) /* 7 */ +#endif +#ifndef TkClipInit +#define TkClipInit \ + (tkIntStubsPtr->tkClipInit) /* 8 */ +#endif +#ifndef TkComputeAnchor +#define TkComputeAnchor \ + (tkIntStubsPtr->tkComputeAnchor) /* 9 */ +#endif +#ifndef TkCopyAndGlobalEval +#define TkCopyAndGlobalEval \ + (tkIntStubsPtr->tkCopyAndGlobalEval) /* 10 */ +#endif +#ifndef TkCreateBindingProcedure +#define TkCreateBindingProcedure \ + (tkIntStubsPtr->tkCreateBindingProcedure) /* 11 */ +#endif +#ifndef TkCreateCursorFromData +#define TkCreateCursorFromData \ + (tkIntStubsPtr->tkCreateCursorFromData) /* 12 */ +#endif +#ifndef TkCreateFrame +#define TkCreateFrame \ + (tkIntStubsPtr->tkCreateFrame) /* 13 */ +#endif +#ifndef TkCreateMainWindow +#define TkCreateMainWindow \ + (tkIntStubsPtr->tkCreateMainWindow) /* 14 */ +#endif +#ifndef TkCurrentTime +#define TkCurrentTime \ + (tkIntStubsPtr->tkCurrentTime) /* 15 */ +#endif +#ifndef TkDeleteAllImages +#define TkDeleteAllImages \ + (tkIntStubsPtr->tkDeleteAllImages) /* 16 */ +#endif +#ifndef TkDoConfigureNotify +#define TkDoConfigureNotify \ + (tkIntStubsPtr->tkDoConfigureNotify) /* 17 */ +#endif +#ifndef TkDrawInsetFocusHighlight +#define TkDrawInsetFocusHighlight \ + (tkIntStubsPtr->tkDrawInsetFocusHighlight) /* 18 */ +#endif +#ifndef TkEventDeadWindow +#define TkEventDeadWindow \ + (tkIntStubsPtr->tkEventDeadWindow) /* 19 */ +#endif +#ifndef TkFillPolygon +#define TkFillPolygon \ + (tkIntStubsPtr->tkFillPolygon) /* 20 */ +#endif +#ifndef TkFindStateNum +#define TkFindStateNum \ + (tkIntStubsPtr->tkFindStateNum) /* 21 */ +#endif +#ifndef TkFindStateString +#define TkFindStateString \ + (tkIntStubsPtr->tkFindStateString) /* 22 */ +#endif +#ifndef TkFocusDeadWindow +#define TkFocusDeadWindow \ + (tkIntStubsPtr->tkFocusDeadWindow) /* 23 */ +#endif +#ifndef TkFocusFilterEvent +#define TkFocusFilterEvent \ + (tkIntStubsPtr->tkFocusFilterEvent) /* 24 */ +#endif +#ifndef TkFocusKeyEvent +#define TkFocusKeyEvent \ + (tkIntStubsPtr->tkFocusKeyEvent) /* 25 */ +#endif +#ifndef TkFontPkgInit +#define TkFontPkgInit \ + (tkIntStubsPtr->tkFontPkgInit) /* 26 */ +#endif +#ifndef TkFontPkgFree +#define TkFontPkgFree \ + (tkIntStubsPtr->tkFontPkgFree) /* 27 */ +#endif +#ifndef TkFreeBindingTags +#define TkFreeBindingTags \ + (tkIntStubsPtr->tkFreeBindingTags) /* 28 */ +#endif +#ifndef TkpFreeCursor +#define TkpFreeCursor \ + (tkIntStubsPtr->tkpFreeCursor) /* 29 */ +#endif +#ifndef TkGetBitmapData +#define TkGetBitmapData \ + (tkIntStubsPtr->tkGetBitmapData) /* 30 */ +#endif +#ifndef TkGetButtPoints +#define TkGetButtPoints \ + (tkIntStubsPtr->tkGetButtPoints) /* 31 */ +#endif +#ifndef TkGetCursorByName +#define TkGetCursorByName \ + (tkIntStubsPtr->tkGetCursorByName) /* 32 */ +#endif +#ifndef TkGetDefaultScreenName +#define TkGetDefaultScreenName \ + (tkIntStubsPtr->tkGetDefaultScreenName) /* 33 */ +#endif +#ifndef TkGetDisplay +#define TkGetDisplay \ + (tkIntStubsPtr->tkGetDisplay) /* 34 */ +#endif +#ifndef TkGetDisplayOf +#define TkGetDisplayOf \ + (tkIntStubsPtr->tkGetDisplayOf) /* 35 */ +#endif +#ifndef TkGetFocusWin +#define TkGetFocusWin \ + (tkIntStubsPtr->tkGetFocusWin) /* 36 */ +#endif +#ifndef TkGetInterpNames +#define TkGetInterpNames \ + (tkIntStubsPtr->tkGetInterpNames) /* 37 */ +#endif +#ifndef TkGetMiterPoints +#define TkGetMiterPoints \ + (tkIntStubsPtr->tkGetMiterPoints) /* 38 */ +#endif +#ifndef TkGetPointerCoords +#define TkGetPointerCoords \ + (tkIntStubsPtr->tkGetPointerCoords) /* 39 */ +#endif +#ifndef TkGetServerInfo +#define TkGetServerInfo \ + (tkIntStubsPtr->tkGetServerInfo) /* 40 */ +#endif +#ifndef TkGrabDeadWindow +#define TkGrabDeadWindow \ + (tkIntStubsPtr->tkGrabDeadWindow) /* 41 */ +#endif +#ifndef TkGrabState +#define TkGrabState \ + (tkIntStubsPtr->tkGrabState) /* 42 */ +#endif +#ifndef TkIncludePoint +#define TkIncludePoint \ + (tkIntStubsPtr->tkIncludePoint) /* 43 */ +#endif +#ifndef TkInOutEvents +#define TkInOutEvents \ + (tkIntStubsPtr->tkInOutEvents) /* 44 */ +#endif +#ifndef TkInstallFrameMenu +#define TkInstallFrameMenu \ + (tkIntStubsPtr->tkInstallFrameMenu) /* 45 */ +#endif +#ifndef TkKeysymToString +#define TkKeysymToString \ + (tkIntStubsPtr->tkKeysymToString) /* 46 */ +#endif +#ifndef TkLineToArea +#define TkLineToArea \ + (tkIntStubsPtr->tkLineToArea) /* 47 */ +#endif +#ifndef TkLineToPoint +#define TkLineToPoint \ + (tkIntStubsPtr->tkLineToPoint) /* 48 */ +#endif +#ifndef TkMakeBezierCurve +#define TkMakeBezierCurve \ + (tkIntStubsPtr->tkMakeBezierCurve) /* 49 */ +#endif +#ifndef TkMakeBezierPostscript +#define TkMakeBezierPostscript \ + (tkIntStubsPtr->tkMakeBezierPostscript) /* 50 */ +#endif +#ifndef TkOptionClassChanged +#define TkOptionClassChanged \ + (tkIntStubsPtr->tkOptionClassChanged) /* 51 */ +#endif +#ifndef TkOptionDeadWindow +#define TkOptionDeadWindow \ + (tkIntStubsPtr->tkOptionDeadWindow) /* 52 */ +#endif +#ifndef TkOvalToArea +#define TkOvalToArea \ + (tkIntStubsPtr->tkOvalToArea) /* 53 */ +#endif +#ifndef TkOvalToPoint +#define TkOvalToPoint \ + (tkIntStubsPtr->tkOvalToPoint) /* 54 */ +#endif +#ifndef TkpChangeFocus +#define TkpChangeFocus \ + (tkIntStubsPtr->tkpChangeFocus) /* 55 */ +#endif +#ifndef TkpCloseDisplay +#define TkpCloseDisplay \ + (tkIntStubsPtr->tkpCloseDisplay) /* 56 */ +#endif +#ifndef TkpClaimFocus +#define TkpClaimFocus \ + (tkIntStubsPtr->tkpClaimFocus) /* 57 */ +#endif +#ifndef TkpDisplayWarning +#define TkpDisplayWarning \ + (tkIntStubsPtr->tkpDisplayWarning) /* 58 */ +#endif +#ifndef TkpGetAppName +#define TkpGetAppName \ + (tkIntStubsPtr->tkpGetAppName) /* 59 */ +#endif +#ifndef TkpGetOtherWindow +#define TkpGetOtherWindow \ + (tkIntStubsPtr->tkpGetOtherWindow) /* 60 */ +#endif +#ifndef TkpGetWrapperWindow +#define TkpGetWrapperWindow \ + (tkIntStubsPtr->tkpGetWrapperWindow) /* 61 */ +#endif +#ifndef TkpInit +#define TkpInit \ + (tkIntStubsPtr->tkpInit) /* 62 */ +#endif +#ifndef TkpInitializeMenuBindings +#define TkpInitializeMenuBindings \ + (tkIntStubsPtr->tkpInitializeMenuBindings) /* 63 */ +#endif +#ifndef TkpMakeContainer +#define TkpMakeContainer \ + (tkIntStubsPtr->tkpMakeContainer) /* 64 */ +#endif +#ifndef TkpMakeMenuWindow +#define TkpMakeMenuWindow \ + (tkIntStubsPtr->tkpMakeMenuWindow) /* 65 */ +#endif +#ifndef TkpMakeWindow +#define TkpMakeWindow \ + (tkIntStubsPtr->tkpMakeWindow) /* 66 */ +#endif +#ifndef TkpMenuNotifyToplevelCreate +#define TkpMenuNotifyToplevelCreate \ + (tkIntStubsPtr->tkpMenuNotifyToplevelCreate) /* 67 */ +#endif +#ifndef TkpOpenDisplay +#define TkpOpenDisplay \ + (tkIntStubsPtr->tkpOpenDisplay) /* 68 */ +#endif +#ifndef TkPointerEvent +#define TkPointerEvent \ + (tkIntStubsPtr->tkPointerEvent) /* 69 */ +#endif +#ifndef TkPolygonToArea +#define TkPolygonToArea \ + (tkIntStubsPtr->tkPolygonToArea) /* 70 */ +#endif +#ifndef TkPolygonToPoint +#define TkPolygonToPoint \ + (tkIntStubsPtr->tkPolygonToPoint) /* 71 */ +#endif +#ifndef TkPositionInTree +#define TkPositionInTree \ + (tkIntStubsPtr->tkPositionInTree) /* 72 */ +#endif +#ifndef TkpRedirectKeyEvent +#define TkpRedirectKeyEvent \ + (tkIntStubsPtr->tkpRedirectKeyEvent) /* 73 */ +#endif +#ifndef TkpSetMainMenubar +#define TkpSetMainMenubar \ + (tkIntStubsPtr->tkpSetMainMenubar) /* 74 */ +#endif +#ifndef TkpUseWindow +#define TkpUseWindow \ + (tkIntStubsPtr->tkpUseWindow) /* 75 */ +#endif +#ifndef TkpWindowWasRecentlyDeleted +#define TkpWindowWasRecentlyDeleted \ + (tkIntStubsPtr->tkpWindowWasRecentlyDeleted) /* 76 */ +#endif +#ifndef TkQueueEventForAllChildren +#define TkQueueEventForAllChildren \ + (tkIntStubsPtr->tkQueueEventForAllChildren) /* 77 */ +#endif +#ifndef TkReadBitmapFile +#define TkReadBitmapFile \ + (tkIntStubsPtr->tkReadBitmapFile) /* 78 */ +#endif +#ifndef TkScrollWindow +#define TkScrollWindow \ + (tkIntStubsPtr->tkScrollWindow) /* 79 */ +#endif +#ifndef TkSelDeadWindow +#define TkSelDeadWindow \ + (tkIntStubsPtr->tkSelDeadWindow) /* 80 */ +#endif +#ifndef TkSelEventProc +#define TkSelEventProc \ + (tkIntStubsPtr->tkSelEventProc) /* 81 */ +#endif +#ifndef TkSelInit +#define TkSelInit \ + (tkIntStubsPtr->tkSelInit) /* 82 */ +#endif +#ifndef TkSelPropProc +#define TkSelPropProc \ + (tkIntStubsPtr->tkSelPropProc) /* 83 */ +#endif +#ifndef TkSetClassProcs +#define TkSetClassProcs \ + (tkIntStubsPtr->tkSetClassProcs) /* 84 */ +#endif +#ifndef TkSetWindowMenuBar +#define TkSetWindowMenuBar \ + (tkIntStubsPtr->tkSetWindowMenuBar) /* 85 */ +#endif +#ifndef TkStringToKeysym +#define TkStringToKeysym \ + (tkIntStubsPtr->tkStringToKeysym) /* 86 */ +#endif +#ifndef TkThickPolyLineToArea +#define TkThickPolyLineToArea \ + (tkIntStubsPtr->tkThickPolyLineToArea) /* 87 */ +#endif +#ifndef TkWmAddToColormapWindows +#define TkWmAddToColormapWindows \ + (tkIntStubsPtr->tkWmAddToColormapWindows) /* 88 */ +#endif +#ifndef TkWmDeadWindow +#define TkWmDeadWindow \ + (tkIntStubsPtr->tkWmDeadWindow) /* 89 */ +#endif +#ifndef TkWmFocusToplevel +#define TkWmFocusToplevel \ + (tkIntStubsPtr->tkWmFocusToplevel) /* 90 */ +#endif +#ifndef TkWmMapWindow +#define TkWmMapWindow \ + (tkIntStubsPtr->tkWmMapWindow) /* 91 */ +#endif +#ifndef TkWmNewWindow +#define TkWmNewWindow \ + (tkIntStubsPtr->tkWmNewWindow) /* 92 */ +#endif +#ifndef TkWmProtocolEventProc +#define TkWmProtocolEventProc \ + (tkIntStubsPtr->tkWmProtocolEventProc) /* 93 */ +#endif +#ifndef TkWmRemoveFromColormapWindows +#define TkWmRemoveFromColormapWindows \ + (tkIntStubsPtr->tkWmRemoveFromColormapWindows) /* 94 */ +#endif +#ifndef TkWmRestackToplevel +#define TkWmRestackToplevel \ + (tkIntStubsPtr->tkWmRestackToplevel) /* 95 */ +#endif +#ifndef TkWmSetClass +#define TkWmSetClass \ + (tkIntStubsPtr->tkWmSetClass) /* 96 */ +#endif +#ifndef TkWmUnmapWindow +#define TkWmUnmapWindow \ + (tkIntStubsPtr->tkWmUnmapWindow) /* 97 */ +#endif +#ifndef TkDebugBitmap +#define TkDebugBitmap \ + (tkIntStubsPtr->tkDebugBitmap) /* 98 */ +#endif +#ifndef TkDebugBorder +#define TkDebugBorder \ + (tkIntStubsPtr->tkDebugBorder) /* 99 */ +#endif +#ifndef TkDebugCursor +#define TkDebugCursor \ + (tkIntStubsPtr->tkDebugCursor) /* 100 */ +#endif +#ifndef TkDebugColor +#define TkDebugColor \ + (tkIntStubsPtr->tkDebugColor) /* 101 */ +#endif +#ifndef TkDebugConfig +#define TkDebugConfig \ + (tkIntStubsPtr->tkDebugConfig) /* 102 */ +#endif +#ifndef TkDebugFont +#define TkDebugFont \ + (tkIntStubsPtr->tkDebugFont) /* 103 */ +#endif +#ifndef TkFindStateNumObj +#define TkFindStateNumObj \ + (tkIntStubsPtr->tkFindStateNumObj) /* 104 */ +#endif +#ifndef TkGetBitmapPredefTable +#define TkGetBitmapPredefTable \ + (tkIntStubsPtr->tkGetBitmapPredefTable) /* 105 */ +#endif +#ifndef TkGetDisplayList +#define TkGetDisplayList \ + (tkIntStubsPtr->tkGetDisplayList) /* 106 */ +#endif +#ifndef TkGetMainInfoList +#define TkGetMainInfoList \ + (tkIntStubsPtr->tkGetMainInfoList) /* 107 */ +#endif +#ifndef TkGetWindowFromObj +#define TkGetWindowFromObj \ + (tkIntStubsPtr->tkGetWindowFromObj) /* 108 */ +#endif +#ifndef TkpGetString +#define TkpGetString \ + (tkIntStubsPtr->tkpGetString) /* 109 */ +#endif +#ifndef TkpGetSubFonts +#define TkpGetSubFonts \ + (tkIntStubsPtr->tkpGetSubFonts) /* 110 */ +#endif +#ifndef TkpGetSystemDefault +#define TkpGetSystemDefault \ + (tkIntStubsPtr->tkpGetSystemDefault) /* 111 */ +#endif +#ifndef TkpMenuThreadInit +#define TkpMenuThreadInit \ + (tkIntStubsPtr->tkpMenuThreadInit) /* 112 */ +#endif +#ifdef __WIN32__ +#ifndef TkClipBox +#define TkClipBox \ + (tkIntStubsPtr->tkClipBox) /* 113 */ +#endif +#endif /* __WIN32__ */ +#ifdef MAC_TCL +#ifndef TkClipBox +#define TkClipBox \ + (tkIntStubsPtr->tkClipBox) /* 113 */ +#endif +#endif /* MAC_TCL */ +#ifdef __WIN32__ +#ifndef TkCreateRegion +#define TkCreateRegion \ + (tkIntStubsPtr->tkCreateRegion) /* 114 */ +#endif +#endif /* __WIN32__ */ +#ifdef MAC_TCL +#ifndef TkCreateRegion +#define TkCreateRegion \ + (tkIntStubsPtr->tkCreateRegion) /* 114 */ +#endif +#endif /* MAC_TCL */ +#ifdef __WIN32__ +#ifndef TkDestroyRegion +#define TkDestroyRegion \ + (tkIntStubsPtr->tkDestroyRegion) /* 115 */ +#endif +#endif /* __WIN32__ */ +#ifdef MAC_TCL +#ifndef TkDestroyRegion +#define TkDestroyRegion \ + (tkIntStubsPtr->tkDestroyRegion) /* 115 */ +#endif +#endif /* MAC_TCL */ +#ifdef __WIN32__ +#ifndef TkIntersectRegion +#define TkIntersectRegion \ + (tkIntStubsPtr->tkIntersectRegion) /* 116 */ +#endif +#endif /* __WIN32__ */ +#ifdef MAC_TCL +#ifndef TkIntersectRegion +#define TkIntersectRegion \ + (tkIntStubsPtr->tkIntersectRegion) /* 116 */ +#endif +#endif /* MAC_TCL */ +#ifdef __WIN32__ +#ifndef TkRectInRegion +#define TkRectInRegion \ + (tkIntStubsPtr->tkRectInRegion) /* 117 */ +#endif +#endif /* __WIN32__ */ +#ifdef MAC_TCL +#ifndef TkRectInRegion +#define TkRectInRegion \ + (tkIntStubsPtr->tkRectInRegion) /* 117 */ +#endif +#endif /* MAC_TCL */ +#ifdef __WIN32__ +#ifndef TkSetRegion +#define TkSetRegion \ + (tkIntStubsPtr->tkSetRegion) /* 118 */ +#endif +#endif /* __WIN32__ */ +#ifdef MAC_TCL +#ifndef TkSetRegion +#define TkSetRegion \ + (tkIntStubsPtr->tkSetRegion) /* 118 */ +#endif +#endif /* MAC_TCL */ +#ifdef __WIN32__ +#ifndef TkUnionRectWithRegion +#define TkUnionRectWithRegion \ + (tkIntStubsPtr->tkUnionRectWithRegion) /* 119 */ +#endif +#endif /* __WIN32__ */ +#ifdef MAC_TCL +#ifndef TkUnionRectWithRegion +#define TkUnionRectWithRegion \ + (tkIntStubsPtr->tkUnionRectWithRegion) /* 119 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkGenerateActivateEvents +#define TkGenerateActivateEvents \ + (tkIntStubsPtr->tkGenerateActivateEvents) /* 120 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkpCreateNativeBitmap +#define TkpCreateNativeBitmap \ + (tkIntStubsPtr->tkpCreateNativeBitmap) /* 121 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkpDefineNativeBitmaps +#define TkpDefineNativeBitmaps \ + (tkIntStubsPtr->tkpDefineNativeBitmaps) /* 122 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkpGetMS +#define TkpGetMS \ + (tkIntStubsPtr->tkpGetMS) /* 123 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkpGetNativeAppBitmap +#define TkpGetNativeAppBitmap \ + (tkIntStubsPtr->tkpGetNativeAppBitmap) /* 124 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkPointerDeadWindow +#define TkPointerDeadWindow \ + (tkIntStubsPtr->tkPointerDeadWindow) /* 125 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkpSetCapture +#define TkpSetCapture \ + (tkIntStubsPtr->tkpSetCapture) /* 126 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkpSetCursor +#define TkpSetCursor \ + (tkIntStubsPtr->tkpSetCursor) /* 127 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkpWmSetState +#define TkpWmSetState \ + (tkIntStubsPtr->tkpWmSetState) /* 128 */ +#endif +#endif /* MAC_TCL */ +/* Slot 129 is reserved */ +#ifdef MAC_TCL +#ifndef TkGetTransientMaster +#define TkGetTransientMaster \ + (tkIntStubsPtr->tkGetTransientMaster) /* 130 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkGenerateButtonEvent +#define TkGenerateButtonEvent \ + (tkIntStubsPtr->tkGenerateButtonEvent) /* 131 */ +#endif +#endif /* MAC_TCL */ +/* Slot 132 is reserved */ +#ifdef MAC_TCL +#ifndef TkGenWMDestroyEvent +#define TkGenWMDestroyEvent \ + (tkIntStubsPtr->tkGenWMDestroyEvent) /* 133 */ +#endif +#endif /* MAC_TCL */ +#ifdef MAC_TCL +#ifndef TkGenWMConfigureEvent +#define TkGenWMConfigureEvent \ + (tkIntStubsPtr->tkGenWMConfigureEvent) /* 134 */ +#endif +#endif /* MAC_TCL */ +#ifndef TkpDrawHighlightBorder +#define TkpDrawHighlightBorder \ + (tkIntStubsPtr->tkpDrawHighlightBorder) /* 135 */ +#endif +#ifndef TkSetFocusWin +#define TkSetFocusWin \ + (tkIntStubsPtr->tkSetFocusWin) /* 136 */ +#endif + +#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +#endif /* _TKINTDECLS */ + diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkPort.h ./canvas-tcl8.2.2/tkPort.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkPort.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkPort.h Thu Dec 30 14:59:40 1999 @@ -0,0 +1,36 @@ +/* + * tkPort.h -- + * + * This header file handles porting issues that occur because of + * differences between systems. It reads in platform specific + * portability files. + * + * Copyright (c) 1995 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkPort.h,v 1.2 1998/09/14 18:23:16 stanton Exp $ + */ + +#ifndef _TKPORT +#define _TKPORT + +#ifndef _TK +#include "tk.h" +#endif +#ifndef _TCL +#include "tcl.h" +#endif + +#if defined(__WIN32__) || defined(_WIN32) +# include "tkWinPort.h" +#else +# if defined(MAC_TCL) +# include "tkMacPort.h" +# else +# include "tkUnixPort.h" +# endif +#endif + +#endif /* _TKPORT */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkRectOval.c ./canvas-tcl8.2.2/tkRectOval.c --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkRectOval.c Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkRectOval.c Thu Dec 30 14:59:40 1999 @@ -0,0 +1,1022 @@ +/* + * tkRectOval.c -- + * + * This file implements rectangle and oval items for canvas + * widgets. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkRectOval.c,v 1.3 1999/04/16 01:51:21 stanton Exp $ + */ + +#include +#include "tk.h" +#include "tkInt.h" +#include "tkPort.h" +#include "xxl_incs.h" + +/* + * Information used for parsing configuration specs: + */ + +static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, + Tk_CanvasTagsPrintProc, (ClientData) NULL +}; + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(RectOvalItem, fillColor), TK_CONFIG_NULL_OK}, + {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL, + "black", Tk_Offset(RectOvalItem, outlineColor), TK_CONFIG_NULL_OK}, + {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(RectOvalItem, fillStipple), TK_CONFIG_NULL_OK}, + {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, + "1", Tk_Offset(RectOvalItem, width), TK_CONFIG_DONT_SET_DEFAULT}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Prototypes for procedures defined in this file: + */ + +static void ComputeRectOvalBbox _ANSI_ARGS_((Tk_Canvas canvas, + RectOvalItem *rectOvalPtr)); +static int ConfigureRectOval _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv, int flags)); +static int CreateRectOval _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, struct Tk_Item *itemPtr, + int argc, char **argv)); +static void DeleteRectOval _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display)); +static void DisplayRectOval _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, Display *display, Drawable dst, + int x, int y, int width, int height)); +static int OvalToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *areaPtr)); +static double OvalToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *pointPtr)); +static int RectOvalCoords _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int argc, + char **argv)); +static int RectOvalToPostscript _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); +static int RectToArea _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *areaPtr)); +static double RectToPoint _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double *pointPtr)); +static void ScaleRectOval _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double originX, double originY, + double scaleX, double scaleY)); +static void TranslateRectOval _ANSI_ARGS_((Tk_Canvas canvas, + Tk_Item *itemPtr, double deltaX, double deltaY)); + +/* + * The structures below defines the rectangle and oval item types + * by means of procedures that can be invoked by generic item code. + */ + +Tk_ItemType tkRectangleType = { + "rectangle", /* name */ + sizeof(RectOvalItem), /* itemSize */ + CreateRectOval, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureRectOval, /* configureProc */ + RectOvalCoords, /* coordProc */ + DeleteRectOval, /* deleteProc */ + DisplayRectOval, /* displayProc */ + 0, /* alwaysRedraw */ + RectToPoint, /* pointProc */ + RectToArea, /* areaProc */ + RectOvalToPostscript, /* postscriptProc */ + ScaleRectOval, /* scaleProc */ + TranslateRectOval, /* translateProc */ + (Tk_ItemIndexProc *) NULL, /* indexProc */ + (Tk_ItemCursorProc *) NULL, /* icursorProc */ + (Tk_ItemSelectionProc *) NULL, /* selectionProc */ + (Tk_ItemInsertProc *) NULL, /* insertProc */ + (Tk_ItemDCharsProc *) NULL, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + +Tk_ItemType tkOvalType = { + "oval", /* name */ + sizeof(RectOvalItem), /* itemSize */ + CreateRectOval, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureRectOval, /* configureProc */ + RectOvalCoords, /* coordProc */ + DeleteRectOval, /* deleteProc */ + DisplayRectOval, /* displayProc */ + 0, /* alwaysRedraw */ + OvalToPoint, /* pointProc */ + OvalToArea, /* areaProc */ + RectOvalToPostscript, /* postscriptProc */ + ScaleRectOval, /* scaleProc */ + TranslateRectOval, /* translateProc */ + (Tk_ItemIndexProc *) NULL, /* indexProc */ + (Tk_ItemCursorProc *) NULL, /* cursorProc */ + (Tk_ItemSelectionProc *) NULL, /* selectionProc */ + (Tk_ItemInsertProc *) NULL, /* insertProc */ + (Tk_ItemDCharsProc *) NULL, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ +}; + +/* + *-------------------------------------------------------------- + * + * CreateRectOval -- + * + * This procedure is invoked to create a new rectangle + * or oval item in a canvas. + * + * Results: + * A standard Tcl return value. If an error occurred in + * creating the item, then an error message is left in + * the interp's result; in this case itemPtr is left uninitialized, + * so it can be safely freed by the caller. + * + * Side effects: + * A new rectangle or oval item is created. + * + *-------------------------------------------------------------- + */ + +static int +CreateRectOval(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* For error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header + * has been initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing rectangle. */ +{ + RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; + + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", + itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Carry out initialization that is needed in order to clean + * up after errors during the the remainder of this procedure. + */ + + rectOvalPtr->width = 1; + rectOvalPtr->outlineColor = NULL; + rectOvalPtr->fillColor = NULL; + rectOvalPtr->fillStipple = None; + rectOvalPtr->outlineGC = None; + rectOvalPtr->fillGC = None; + + /* + * Process the arguments to fill in the item record. + */ + + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], + &rectOvalPtr->bbox[0]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], + &rectOvalPtr->bbox[1]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[2], + &rectOvalPtr->bbox[2]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[3], + &rectOvalPtr->bbox[3]) != TCL_OK)) { + return TCL_ERROR; + } + + if (argv[4][0] != 'X') + return(TCL_ERROR); + rectOvalPtr->col1 = atoi(argv[5]); + rectOvalPtr->row1 = atoi(argv[6]); + rectOvalPtr->col2 = atoi(argv[7]); + rectOvalPtr->row2 = atoi(argv[8]); + if (ConfigureRectOval(interp, canvas, itemPtr, argc-9, argv+9, 0) + != TCL_OK) { + DeleteRectOval(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * RectOvalCoords -- + * + * This procedure is invoked to process the "coords" widget + * command on rectangles and ovals. See the user documentation + * for details on what it does. + * + * Results: + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. + * + * Side effects: + * The coordinates for the given item may be changed. + * + *-------------------------------------------------------------- + */ + +static int +RectOvalCoords(interp, canvas, itemPtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be + * read or modified. */ + int argc; /* Number of coordinates supplied in + * argv. */ + char **argv; /* Array of coordinates: x1, y1, + * x2, y2, ... */ +{ + RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; + char c0[TCL_DOUBLE_SPACE], c1[TCL_DOUBLE_SPACE]; + char c2[TCL_DOUBLE_SPACE], c3[TCL_DOUBLE_SPACE]; + + if (argc == 0) { + Tcl_PrintDouble(interp, rectOvalPtr->bbox[0], c0); + Tcl_PrintDouble(interp, rectOvalPtr->bbox[1], c1); + Tcl_PrintDouble(interp, rectOvalPtr->bbox[2], c2); + Tcl_PrintDouble(interp, rectOvalPtr->bbox[3], c3); + Tcl_AppendResult(interp, c0, " ", c1, " ", c2, " ", c3, + (char *) NULL); + } else if (argc == 4) { + if ((Tk_CanvasGetCoord(interp, canvas, argv[0], + &rectOvalPtr->bbox[0]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[1], + &rectOvalPtr->bbox[1]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[2], + &rectOvalPtr->bbox[2]) != TCL_OK) + || (Tk_CanvasGetCoord(interp, canvas, argv[3], + &rectOvalPtr->bbox[3]) != TCL_OK)) { + return TCL_ERROR; + } + ComputeRectOvalBbox(canvas, rectOvalPtr); + } else { + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ConfigureRectOval -- + * + * This procedure is invoked to configure various aspects + * of a rectangle or oval item, such as its border and + * background colors. + * + * Results: + * A standard Tcl result code. If an error occurs, then + * an error message is left in the interp's result. + * + * Side effects: + * Configuration information, such as colors and stipple + * patterns, may be set for itemPtr. + * + *-------------------------------------------------------------- + */ + +static int +ConfigureRectOval(interp, canvas, itemPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing itemPtr. */ + Tk_Item *itemPtr; /* Rectangle item to reconfigure. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments describing things to configure. */ + int flags; /* Flags to pass to Tk_ConfigureWidget. */ +{ + RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; + XGCValues gcValues; + GC newGC; + unsigned long mask; + Tk_Window tkwin; + + tkwin = Tk_CanvasTkwin(canvas); + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv, + (char *) rectOvalPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few of the options require additional processing, such as + * graphics contexts. + */ + + if (rectOvalPtr->width < 1) { + rectOvalPtr->width = 1; + } + if (rectOvalPtr->outlineColor == NULL) { + newGC = None; + } else { + gcValues.foreground = rectOvalPtr->outlineColor->pixel; + gcValues.cap_style = CapProjecting; + gcValues.line_width = rectOvalPtr->width; + mask = GCForeground|GCCapStyle|GCLineWidth; + newGC = Tk_GetGC(tkwin, mask, &gcValues); + } + if (rectOvalPtr->outlineGC != None) { + Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->outlineGC); + } + rectOvalPtr->outlineGC = newGC; + + if (rectOvalPtr->fillColor == NULL) { + newGC = None; + } else { + gcValues.foreground = rectOvalPtr->fillColor->pixel; + if (rectOvalPtr->fillStipple != None) { + gcValues.stipple = rectOvalPtr->fillStipple; + gcValues.fill_style = FillStippled; + mask = GCForeground|GCStipple|GCFillStyle; + } else { + mask = GCForeground; + } + newGC = Tk_GetGC(tkwin, mask, &gcValues); + } + if (rectOvalPtr->fillGC != None) { + Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->fillGC); + } + rectOvalPtr->fillGC = newGC; + ComputeRectOvalBbox(canvas, rectOvalPtr); + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeleteRectOval -- + * + * This procedure is called to clean up the data structure + * associated with a rectangle or oval item. + * + * Results: + * None. + * + * Side effects: + * Resources associated with itemPtr are released. + * + *-------------------------------------------------------------- + */ + +static void +DeleteRectOval(canvas, itemPtr, display) + Tk_Canvas canvas; /* Info about overall widget. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for + * canvas. */ +{ + RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; + + if (rectOvalPtr->outlineColor != NULL) { + Tk_FreeColor(rectOvalPtr->outlineColor); + } + if (rectOvalPtr->fillColor != NULL) { + Tk_FreeColor(rectOvalPtr->fillColor); + } + if (rectOvalPtr->fillStipple != None) { + Tk_FreeBitmap(display, rectOvalPtr->fillStipple); + } + if (rectOvalPtr->outlineGC != None) { + Tk_FreeGC(display, rectOvalPtr->outlineGC); + } + if (rectOvalPtr->fillGC != None) { + Tk_FreeGC(display, rectOvalPtr->fillGC); + } +} + +/* + *-------------------------------------------------------------- + * + * ComputeRectOvalBbox -- + * + * This procedure is invoked to compute the bounding box of + * all the pixels that may be drawn as part of a rectangle + * or oval. + * + * Results: + * None. + * + * Side effects: + * The fields x1, y1, x2, and y2 are updated in the header + * for itemPtr. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +ComputeRectOvalBbox(canvas, rectOvalPtr) + Tk_Canvas canvas; /* Canvas that contains item. */ + RectOvalItem *rectOvalPtr; /* Item whose bbox is to be + * recomputed. */ +{ + int bloat, tmp; + double dtmp; + + /* + * Make sure that the first coordinates are the lowest ones. + */ + + if (rectOvalPtr->bbox[1] > rectOvalPtr->bbox[3]) { + double tmp; + tmp = rectOvalPtr->bbox[3]; + rectOvalPtr->bbox[3] = rectOvalPtr->bbox[1]; + rectOvalPtr->bbox[1] = tmp; + } + if (rectOvalPtr->bbox[0] > rectOvalPtr->bbox[2]) { + double tmp; + tmp = rectOvalPtr->bbox[2]; + rectOvalPtr->bbox[2] = rectOvalPtr->bbox[0]; + rectOvalPtr->bbox[0] = tmp; + } + + if (rectOvalPtr->outlineColor == NULL) { + bloat = 0; + } else { + bloat = (rectOvalPtr->width+1)/2; + } + + /* + * Special note: the rectangle is always drawn at least 1x1 in + * size, so round up the upper coordinates to be at least 1 unit + * greater than the lower ones. + */ + + tmp = (int) ((rectOvalPtr->bbox[0] >= 0) ? rectOvalPtr->bbox[0] + .5 + : rectOvalPtr->bbox[0] - .5); + rectOvalPtr->header.x1 = tmp - bloat; + tmp = (int) ((rectOvalPtr->bbox[1] >= 0) ? rectOvalPtr->bbox[1] + .5 + : rectOvalPtr->bbox[1] - .5); + rectOvalPtr->header.y1 = tmp - bloat; + dtmp = rectOvalPtr->bbox[2]; + if (dtmp < (rectOvalPtr->bbox[0] + 1)) { + dtmp = rectOvalPtr->bbox[0] + 1; + } + tmp = (int) ((dtmp >= 0) ? dtmp + .5 : dtmp - .5); + rectOvalPtr->header.x2 = tmp + bloat; + dtmp = rectOvalPtr->bbox[3]; + if (dtmp < (rectOvalPtr->bbox[1] + 1)) { + dtmp = rectOvalPtr->bbox[1] + 1; + } + tmp = (int) ((dtmp >= 0) ? dtmp + .5 : dtmp - .5); + rectOvalPtr->header.y2 = tmp + bloat; +} + +/* + *-------------------------------------------------------------- + * + * DisplayRectOval -- + * + * This procedure is invoked to draw a rectangle or oval + * item in a given drawable. + * + * Results: + * None. + * + * Side effects: + * ItemPtr is drawn in drawable using the transformation + * information in canvas. + * + *-------------------------------------------------------------- + */ + +static void +DisplayRectOval(canvas, itemPtr, display, drawable, x, y, width, height) + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw + * item. */ + int x, y, width, height; /* Describes region of canvas that + * must be redisplayed (not used). */ +{ + RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; + short x1, y1, x2, y2; + + /* + * Compute the screen coordinates of the bounding box for the item. + * Make sure that the bbox is at least one pixel large, since some + * X servers will die if it isn't. + */ + + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0], rectOvalPtr->bbox[1], + &x1, &y1); + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2], rectOvalPtr->bbox[3], + &x2, &y2); + if (x2 <= x1) { + x2 = x1+1; + } + if (y2 <= y1) { + y2 = y1+1; + } + + /* + * Display filled part first (if wanted), then outline. If we're + * stippling, then modify the stipple offset in the GC. Be sure to + * reset the offset when done, since the GC is supposed to be + * read-only. + */ + + if (rectOvalPtr->fillGC != None) { + if (rectOvalPtr->fillStipple != None) { + Tk_CanvasSetStippleOrigin(canvas, rectOvalPtr->fillGC); + } + if (rectOvalPtr->header.typePtr == &tkRectangleType) { + XFillRectangle(display, drawable, rectOvalPtr->fillGC, + x1, y1, (unsigned int) (x2-x1), (unsigned int) (y2-y1)); + } else { + XFillArc(display, drawable, rectOvalPtr->fillGC, + x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1), + 0, 360*64); + } + if (rectOvalPtr->fillStipple != None) { + XSetTSOrigin(display, rectOvalPtr->fillGC, 0, 0); + } + } + if (rectOvalPtr->outlineGC != None) { + if (rectOvalPtr->header.typePtr == &tkRectangleType) { + XDrawRectangle(display, drawable, rectOvalPtr->outlineGC, + x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1)); + } else { + XDrawArc(display, drawable, rectOvalPtr->outlineGC, + x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1), 0, 360*64); + } + } +} + +/* + *-------------------------------------------------------------- + * + * RectToPoint -- + * + * Computes the distance from a given point to a given + * rectangle, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are coordPtr[0] and coordPtr[1] is inside the rectangle. If the + * point isn't inside the rectangle then the return value is the + * distance from the point to the rectangle. If itemPtr is filled, + * then anywhere in the interior is considered "inside"; if + * itemPtr isn't filled, then "inside" means only the area + * occupied by the outline. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static double +RectToPoint(canvas, itemPtr, pointPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *pointPtr; /* Pointer to x and y coordinates. */ +{ + RectOvalItem *rectPtr = (RectOvalItem *) itemPtr; + double xDiff, yDiff, x1, y1, x2, y2, inc, tmp; + + /* + * Generate a new larger rectangle that includes the border + * width, if there is one. + */ + + x1 = rectPtr->bbox[0]; + y1 = rectPtr->bbox[1]; + x2 = rectPtr->bbox[2]; + y2 = rectPtr->bbox[3]; + if (rectPtr->outlineGC != None) { + inc = rectPtr->width/2.0; + x1 -= inc; + y1 -= inc; + x2 += inc; + y2 += inc; + } + + /* + * If the point is inside the rectangle, handle specially: + * distance is 0 if rectangle is filled, otherwise compute + * distance to nearest edge of rectangle and subtract width + * of edge. + */ + + if ((pointPtr[0] >= x1) && (pointPtr[0] < x2) + && (pointPtr[1] >= y1) && (pointPtr[1] < y2)) { + if ((rectPtr->fillGC != None) || (rectPtr->outlineGC == None)) { + return 0.0; + } + xDiff = pointPtr[0] - x1; + tmp = x2 - pointPtr[0]; + if (tmp < xDiff) { + xDiff = tmp; + } + yDiff = pointPtr[1] - y1; + tmp = y2 - pointPtr[1]; + if (tmp < yDiff) { + yDiff = tmp; + } + if (yDiff < xDiff) { + xDiff = yDiff; + } + xDiff -= rectPtr->width; + if (xDiff < 0.0) { + return 0.0; + } + return xDiff; + } + + /* + * Point is outside rectangle. + */ + + if (pointPtr[0] < x1) { + xDiff = x1 - pointPtr[0]; + } else if (pointPtr[0] > x2) { + xDiff = pointPtr[0] - x2; + } else { + xDiff = 0; + } + + if (pointPtr[1] < y1) { + yDiff = y1 - pointPtr[1]; + } else if (pointPtr[1] > y2) { + yDiff = pointPtr[1] - y2; + } else { + yDiff = 0; + } + + return hypot(xDiff, yDiff); +} + +/* + *-------------------------------------------------------------- + * + * OvalToPoint -- + * + * Computes the distance from a given point to a given + * oval, in canvas units. + * + * Results: + * The return value is 0 if the point whose x and y coordinates + * are coordPtr[0] and coordPtr[1] is inside the oval. If the + * point isn't inside the oval then the return value is the + * distance from the point to the oval. If itemPtr is filled, + * then anywhere in the interior is considered "inside"; if + * itemPtr isn't filled, then "inside" means only the area + * occupied by the outline. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static double +OvalToPoint(canvas, itemPtr, pointPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against point. */ + double *pointPtr; /* Pointer to x and y coordinates. */ +{ + RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr; + double width; + int filled; + + width = ovalPtr->width; + filled = ovalPtr->fillGC != None; + if (ovalPtr->outlineGC == None) { + width = 0.0; + filled = 1; + } + return TkOvalToPoint(ovalPtr->bbox, width, filled, pointPtr); +} + +/* + *-------------------------------------------------------------- + * + * RectToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given rectangle. + * + * Results: + * -1 is returned if the item is entirely outside the area + * given by rectPtr, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +RectToArea(canvas, itemPtr, areaPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against rectangle. */ + double *areaPtr; /* Pointer to array of four coordinates + * (x1, y1, x2, y2) describing rectangular + * area. */ +{ + RectOvalItem *rectPtr = (RectOvalItem *) itemPtr; + double halfWidth; + + halfWidth = rectPtr->width/2.0; + if (rectPtr->outlineGC == None) { + halfWidth = 0.0; + } + + if ((areaPtr[2] <= (rectPtr->bbox[0] - halfWidth)) + || (areaPtr[0] >= (rectPtr->bbox[2] + halfWidth)) + || (areaPtr[3] <= (rectPtr->bbox[1] - halfWidth)) + || (areaPtr[1] >= (rectPtr->bbox[3] + halfWidth))) { + return -1; + } + if ((rectPtr->fillGC == None) && (rectPtr->outlineGC != None) + && (areaPtr[0] >= (rectPtr->bbox[0] + halfWidth)) + && (areaPtr[1] >= (rectPtr->bbox[1] + halfWidth)) + && (areaPtr[2] <= (rectPtr->bbox[2] - halfWidth)) + && (areaPtr[3] <= (rectPtr->bbox[3] - halfWidth))) { + return -1; + } + if ((areaPtr[0] <= (rectPtr->bbox[0] - halfWidth)) + && (areaPtr[1] <= (rectPtr->bbox[1] - halfWidth)) + && (areaPtr[2] >= (rectPtr->bbox[2] + halfWidth)) + && (areaPtr[3] >= (rectPtr->bbox[3] + halfWidth))) { + return 1; + } + return 0; +} + +/* + *-------------------------------------------------------------- + * + * OvalToArea -- + * + * This procedure is called to determine whether an item + * lies entirely inside, entirely outside, or overlapping + * a given rectangular area. + * + * Results: + * -1 is returned if the item is entirely outside the area + * given by rectPtr, 0 if it overlaps, and 1 if it is entirely + * inside the given area. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +OvalToArea(canvas, itemPtr, areaPtr) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item to check against oval. */ + double *areaPtr; /* Pointer to array of four coordinates + * (x1, y1, x2, y2) describing rectangular + * area. */ +{ + RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr; + double oval[4], halfWidth; + int result; + + /* + * Expand the oval to include the width of the outline, if any. + */ + + halfWidth = ovalPtr->width/2.0; + if (ovalPtr->outlineGC == None) { + halfWidth = 0.0; + } + oval[0] = ovalPtr->bbox[0] - halfWidth; + oval[1] = ovalPtr->bbox[1] - halfWidth; + oval[2] = ovalPtr->bbox[2] + halfWidth; + oval[3] = ovalPtr->bbox[3] + halfWidth; + + result = TkOvalToArea(oval, areaPtr); + + /* + * If the rectangle appears to overlap the oval and the oval + * isn't filled, do one more check to see if perhaps all four + * of the rectangle's corners are totally inside the oval's + * unfilled center, in which case we should return "outside". + */ + + if ((result == 0) && (ovalPtr->outlineGC != None) + && (ovalPtr->fillGC == None)) { + double centerX, centerY, width, height; + double xDelta1, yDelta1, xDelta2, yDelta2; + + centerX = (ovalPtr->bbox[0] + ovalPtr->bbox[2])/2.0; + centerY = (ovalPtr->bbox[1] + ovalPtr->bbox[3])/2.0; + width = (ovalPtr->bbox[2] - ovalPtr->bbox[0])/2.0 - halfWidth; + height = (ovalPtr->bbox[3] - ovalPtr->bbox[1])/2.0 - halfWidth; + xDelta1 = (areaPtr[0] - centerX)/width; + xDelta1 *= xDelta1; + yDelta1 = (areaPtr[1] - centerY)/height; + yDelta1 *= yDelta1; + xDelta2 = (areaPtr[2] - centerX)/width; + xDelta2 *= xDelta2; + yDelta2 = (areaPtr[3] - centerY)/height; + yDelta2 *= yDelta2; + if (((xDelta1 + yDelta1) < 1.0) + && ((xDelta1 + yDelta2) < 1.0) + && ((xDelta2 + yDelta1) < 1.0) + && ((xDelta2 + yDelta2) < 1.0)) { + return -1; + } + } + return result; +} + +/* + *-------------------------------------------------------------- + * + * ScaleRectOval -- + * + * This procedure is invoked to rescale a rectangle or oval + * item. + * + * Results: + * None. + * + * Side effects: + * The rectangle or oval referred to by itemPtr is rescaled + * so that the following transformation is applied to all + * point coordinates: + * x' = originX + scaleX*(x-originX) + * y' = originY + scaleY*(y-originY) + * + *-------------------------------------------------------------- + */ + +static void +ScaleRectOval(canvas, itemPtr, originX, originY, scaleX, scaleY) + Tk_Canvas canvas; /* Canvas containing rectangle. */ + Tk_Item *itemPtr; /* Rectangle to be scaled. */ + double originX, originY; /* Origin about which to scale rect. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ +{ + RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; + + rectOvalPtr->bbox[0] = originX + scaleX*(rectOvalPtr->bbox[0] - originX); + rectOvalPtr->bbox[1] = originY + scaleY*(rectOvalPtr->bbox[1] - originY); + rectOvalPtr->bbox[2] = originX + scaleX*(rectOvalPtr->bbox[2] - originX); + rectOvalPtr->bbox[3] = originY + scaleY*(rectOvalPtr->bbox[3] - originY); + ComputeRectOvalBbox(canvas, rectOvalPtr); +} + +/* + *-------------------------------------------------------------- + * + * TranslateRectOval -- + * + * This procedure is called to move a rectangle or oval by a + * given amount. + * + * Results: + * None. + * + * Side effects: + * The position of the rectangle or oval is offset by + * (xDelta, yDelta), and the bounding box is updated in the + * generic part of the item structure. + * + *-------------------------------------------------------------- + */ + +static void +TranslateRectOval(canvas, itemPtr, deltaX, deltaY) + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be + * moved. */ +{ + RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; + + rectOvalPtr->bbox[0] += deltaX; + rectOvalPtr->bbox[1] += deltaY; + rectOvalPtr->bbox[2] += deltaX; + rectOvalPtr->bbox[3] += deltaY; + ComputeRectOvalBbox(canvas, rectOvalPtr); +} + +/* + *-------------------------------------------------------------- + * + * RectOvalToPostscript -- + * + * This procedure is called to generate Postscript for + * rectangle and oval items. + * + * Results: + * The return value is a standard Tcl result. If an error + * occurs in generating Postscript then an error message is + * left in the interp's result, replacing whatever used to be there. + * If no error occurs, then Postscript for the rectangle is + * appended to the result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +RectOvalToPostscript(interp, canvas, itemPtr, prepass) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Information about overall canvas. */ + Tk_Item *itemPtr; /* Item for which Postscript is + * wanted. */ + int prepass; /* 1 means this is a prepass to + * collect font information; 0 means + * final Postscript is being created. */ +{ + char pathCmd[500]; + RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; + double y1, y2; + + y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]); + y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]); + + /* + * Generate a string that creates a path for the rectangle or oval. + * This is the only part of the procedure's code that is type- + * specific. + */ + + + if (rectOvalPtr->header.typePtr == &tkRectangleType) { + sprintf(pathCmd, "%.15g %.15g moveto %.15g 0 rlineto 0 %.15g rlineto %.15g 0 rlineto closepath\n", + rectOvalPtr->bbox[0], y1, + rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], y2-y1, + rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]); + } else { + sprintf(pathCmd, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", + (rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2, + (rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2); + } + + /* + * First draw the filled area of the rectangle. + */ + + if (rectOvalPtr->fillColor != NULL) { + Tcl_AppendResult(interp, pathCmd, (char *) NULL); + if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->fillColor) + != TCL_OK) { + return TCL_ERROR; + } + if (rectOvalPtr->fillStipple != None) { + Tcl_AppendResult(interp, "clip ", (char *) NULL); + if (Tk_CanvasPsStipple(interp, canvas, rectOvalPtr->fillStipple) + != TCL_OK) { + return TCL_ERROR; + } + if (rectOvalPtr->outlineColor != NULL) { + Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL); + } + } else { + Tcl_AppendResult(interp, "fill\n", (char *) NULL); + } + } + + /* + * Now draw the outline, if there is one. + */ + + if (rectOvalPtr->outlineColor != NULL) { + char string[32 + TCL_INTEGER_SPACE]; + + Tcl_AppendResult(interp, pathCmd, (char *) NULL); + sprintf(string, "%d setlinewidth", rectOvalPtr->width); + Tcl_AppendResult(interp, string, + " 0 setlinejoin 2 setlinecap\n", (char *) NULL); + if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->outlineColor) + != TCL_OK) { + return TCL_ERROR; + } + Tcl_AppendResult(interp, "stroke\n", (char *) NULL); + } + return TCL_OK; +} diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkUnixDefault.h ./canvas-tcl8.2.2/tkUnixDefault.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkUnixDefault.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkUnixDefault.h Thu Dec 30 14:59:22 1999 @@ -0,0 +1,453 @@ +/* + * tkUnixDefault.h -- + * + * This file defines the defaults for all options for all of + * the Tk widgets. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkUnixDefault.h,v 1.3 1999/04/16 01:51:45 stanton Exp $ + */ + +#ifndef _TKUNIXDEFAULT +#define _TKUNIXDEFAULT + +/* + * The definitions below provide symbolic names for the default colors. + * NORMAL_BG - Normal background color. + * ACTIVE_BG - Background color when widget is active. + * SELECT_BG - Background color for selected text. + * TROUGH - Background color for troughs in scales and scrollbars. + * INDICATOR - Color for indicator when button is selected. + * DISABLED - Foreground color when widget is disabled. + */ + +#define BLACK "Black" +#define WHITE "White" + +#define NORMAL_BG "#d9d9d9" +#define ACTIVE_BG "#ececec" +#define SELECT_BG "#c3c3c3" +#define TROUGH "#c3c3c3" +#define INDICATOR "#b03060" +#define DISABLED "#a3a3a3" + +/* + * Defaults for labels, buttons, checkbuttons, and radiobuttons: + */ + +#define DEF_BUTTON_ANCHOR "center" +#define DEF_BUTTON_ACTIVE_BG_COLOR ACTIVE_BG +#define DEF_BUTTON_ACTIVE_BG_MONO BLACK +#define DEF_BUTTON_ACTIVE_FG_COLOR BLACK +#define DEF_CHKRAD_ACTIVE_FG_COLOR DEF_BUTTON_ACTIVE_FG_COLOR +#define DEF_BUTTON_ACTIVE_FG_MONO WHITE +#define DEF_BUTTON_BG_COLOR NORMAL_BG +#define DEF_BUTTON_BG_MONO WHITE +#define DEF_BUTTON_BITMAP "" +#define DEF_BUTTON_BORDER_WIDTH "2" +#define DEF_BUTTON_CURSOR "" +#define DEF_BUTTON_COMMAND "" +#define DEF_BUTTON_DEFAULT "disabled" +#define DEF_BUTTON_DISABLED_FG_COLOR DISABLED +#define DEF_BUTTON_DISABLED_FG_MONO "" +#define DEF_BUTTON_FG BLACK +#define DEF_CHKRAD_FG DEF_BUTTON_FG +#define DEF_BUTTON_FONT "Helvetica -12 bold" +#define DEF_BUTTON_HEIGHT "0" +#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR +#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO +#define DEF_BUTTON_HIGHLIGHT BLACK +#define DEF_LABEL_HIGHLIGHT_WIDTH "0" +#define DEF_BUTTON_HIGHLIGHT_WIDTH "1" +#define DEF_BUTTON_IMAGE (char *) NULL +#define DEF_BUTTON_INDICATOR "1" +#define DEF_BUTTON_JUSTIFY "center" +#define DEF_BUTTON_OFF_VALUE "0" +#define DEF_BUTTON_ON_VALUE "1" +#define DEF_BUTTON_PADX "3m" +#define DEF_LABCHKRAD_PADX "1" +#define DEF_BUTTON_PADY "1m" +#define DEF_LABCHKRAD_PADY "1" +#define DEF_BUTTON_RELIEF "raised" +#define DEF_LABCHKRAD_RELIEF "flat" +#define DEF_BUTTON_SELECT_COLOR INDICATOR +#define DEF_BUTTON_SELECT_MONO BLACK +#define DEF_BUTTON_SELECT_IMAGE (char *) NULL +#define DEF_BUTTON_STATE "normal" +#define DEF_LABEL_TAKE_FOCUS "0" +#define DEF_BUTTON_TAKE_FOCUS (char *) NULL +#define DEF_BUTTON_TEXT "" +#define DEF_BUTTON_TEXT_VARIABLE "" +#define DEF_BUTTON_UNDERLINE "-1" +#define DEF_BUTTON_VALUE "" +#define DEF_BUTTON_WIDTH "0" +#define DEF_BUTTON_WRAP_LENGTH "0" +#define DEF_RADIOBUTTON_VARIABLE "selectedButton" +#define DEF_CHECKBUTTON_VARIABLE "" + +/* + * Defaults for canvases: + */ + +#define DEF_CANVAS_BG_COLOR NORMAL_BG +#define DEF_CANVAS_BG_MONO WHITE +#define DEF_CANVAS_BORDER_WIDTH "0" +#define DEF_CANVAS_CLOSE_ENOUGH "1" +#define DEF_CANVAS_CONFINE "1" +#define DEF_CANVAS_CURSOR "" +#define DEF_CANVAS_HEIGHT "7c" +#define DEF_CANVAS_HIGHLIGHT_BG NORMAL_BG +#define DEF_CANVAS_HIGHLIGHT BLACK +#define DEF_CANVAS_HIGHLIGHT_WIDTH "1" +#define DEF_CANVAS_INSERT_BG BLACK +#define DEF_CANVAS_INSERT_BD_COLOR "0" +#define DEF_CANVAS_INSERT_BD_MONO "0" +#define DEF_CANVAS_INSERT_OFF_TIME "300" +#define DEF_CANVAS_INSERT_ON_TIME "600" +#define DEF_CANVAS_INSERT_WIDTH "2" +#define DEF_CANVAS_RELIEF "flat" +#define DEF_CANVAS_SCROLL_REGION "" +#define DEF_CANVAS_SELECT_COLOR SELECT_BG +#define DEF_CANVAS_SELECT_MONO BLACK +#define DEF_CANVAS_SELECT_BD_COLOR "1" +#define DEF_CANVAS_SELECT_BD_MONO "0" +#define DEF_CANVAS_SELECT_FG_COLOR BLACK +#define DEF_CANVAS_SELECT_FG_MONO WHITE +#define DEF_CANVAS_TAKE_FOCUS (char *) NULL +#define DEF_CANVAS_WIDTH "10c" +#define DEF_CANVAS_X_SCROLL_CMD "" +#define DEF_CANVAS_X_SCROLL_INCREMENT "0" +#define DEF_CANVAS_Y_SCROLL_CMD "" +#define DEF_CANVAS_Y_SCROLL_INCREMENT "0" + +/* + * Defaults for entries: + */ + +#define DEF_ENTRY_BG_COLOR NORMAL_BG +#define DEF_ENTRY_BG_MONO WHITE +#define DEF_ENTRY_BORDER_WIDTH "2" +#define DEF_ENTRY_CURSOR "xterm" +#define DEF_ENTRY_EXPORT_SELECTION "1" +#define DEF_ENTRY_FONT "Helvetica -12" +#define DEF_ENTRY_FG BLACK +#define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG +#define DEF_ENTRY_HIGHLIGHT BLACK +#define DEF_ENTRY_HIGHLIGHT_WIDTH "1" +#define DEF_ENTRY_INSERT_BG BLACK +#define DEF_ENTRY_INSERT_BD_COLOR "0" +#define DEF_ENTRY_INSERT_BD_MONO "0" +#define DEF_ENTRY_INSERT_OFF_TIME "300" +#define DEF_ENTRY_INSERT_ON_TIME "600" +#define DEF_ENTRY_INSERT_WIDTH "2" +#define DEF_ENTRY_JUSTIFY "left" +#define DEF_ENTRY_RELIEF "sunken" +#define DEF_ENTRY_SCROLL_COMMAND "" +#define DEF_ENTRY_SELECT_COLOR SELECT_BG +#define DEF_ENTRY_SELECT_MONO BLACK +#define DEF_ENTRY_SELECT_BD_COLOR "1" +#define DEF_ENTRY_SELECT_BD_MONO "0" +#define DEF_ENTRY_SELECT_FG_COLOR BLACK +#define DEF_ENTRY_SELECT_FG_MONO WHITE +#define DEF_ENTRY_SHOW (char *) NULL +#define DEF_ENTRY_STATE "normal" +#define DEF_ENTRY_TAKE_FOCUS (char *) NULL +#define DEF_ENTRY_TEXT_VARIABLE "" +#define DEF_ENTRY_WIDTH "20" + +/* + * Defaults for frames: + */ + +#define DEF_FRAME_BG_COLOR NORMAL_BG +#define DEF_FRAME_BG_MONO WHITE +#define DEF_FRAME_BORDER_WIDTH "0" +#define DEF_FRAME_CLASS "Frame" +#define DEF_FRAME_COLORMAP "" +#define DEF_FRAME_CONTAINER "0" +#define DEF_FRAME_CURSOR "" +#define DEF_FRAME_HEIGHT "0" +#define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG +#define DEF_FRAME_HIGHLIGHT BLACK +#define DEF_FRAME_HIGHLIGHT_WIDTH "0" +#define DEF_FRAME_RELIEF "flat" +#define DEF_FRAME_TAKE_FOCUS "0" +#define DEF_FRAME_USE "" +#define DEF_FRAME_VISUAL "" +#define DEF_FRAME_WIDTH "0" + +/* + * Defaults for listboxes: + */ + +#define DEF_LISTBOX_BG_COLOR NORMAL_BG +#define DEF_LISTBOX_BG_MONO WHITE +#define DEF_LISTBOX_BORDER_WIDTH "2" +#define DEF_LISTBOX_CURSOR "" +#define DEF_LISTBOX_EXPORT_SELECTION "1" +#define DEF_LISTBOX_FONT "Helvetica -12 bold" +#define DEF_LISTBOX_FG BLACK +#define DEF_LISTBOX_HEIGHT "10" +#define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG +#define DEF_LISTBOX_HIGHLIGHT BLACK +#define DEF_LISTBOX_HIGHLIGHT_WIDTH "1" +#define DEF_LISTBOX_RELIEF "sunken" +#define DEF_LISTBOX_SCROLL_COMMAND "" +#define DEF_LISTBOX_SELECT_COLOR SELECT_BG +#define DEF_LISTBOX_SELECT_MONO BLACK +#define DEF_LISTBOX_SELECT_BD "1" +#define DEF_LISTBOX_SELECT_FG_COLOR BLACK +#define DEF_LISTBOX_SELECT_FG_MONO WHITE +#define DEF_LISTBOX_SELECT_MODE "browse" +#define DEF_LISTBOX_SET_GRID "0" +#define DEF_LISTBOX_TAKE_FOCUS (char *) NULL +#define DEF_LISTBOX_WIDTH "20" + +/* + * Defaults for individual entries of menus: + */ + +#define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL +#define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL +#define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL +#define DEF_MENU_ENTRY_BG (char *) NULL +#define DEF_MENU_ENTRY_BITMAP None +#define DEF_MENU_ENTRY_COLUMN_BREAK "0" +#define DEF_MENU_ENTRY_COMMAND (char *) NULL +#define DEF_MENU_ENTRY_FG (char *) NULL +#define DEF_MENU_ENTRY_FONT (char *) NULL +#define DEF_MENU_ENTRY_HIDE_MARGIN "0" +#define DEF_MENU_ENTRY_IMAGE (char *) NULL +#define DEF_MENU_ENTRY_INDICATOR "1" +#define DEF_MENU_ENTRY_LABEL (char *) NULL +#define DEF_MENU_ENTRY_MENU (char *) NULL +#define DEF_MENU_ENTRY_OFF_VALUE "0" +#define DEF_MENU_ENTRY_ON_VALUE "1" +#define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL +#define DEF_MENU_ENTRY_STATE "normal" +#define DEF_MENU_ENTRY_VALUE (char *) NULL +#define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL +#define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" +#define DEF_MENU_ENTRY_SELECT (char *) NULL +#define DEF_MENU_ENTRY_UNDERLINE "-1" + +/* + * Defaults for menus overall: + */ + +#define DEF_MENU_ACTIVE_BG_COLOR ACTIVE_BG +#define DEF_MENU_ACTIVE_BG_MONO BLACK +#define DEF_MENU_ACTIVE_BORDER_WIDTH "2" +#define DEF_MENU_ACTIVE_FG_COLOR BLACK +#define DEF_MENU_ACTIVE_FG_MONO WHITE +#define DEF_MENU_BG_COLOR NORMAL_BG +#define DEF_MENU_BG_MONO WHITE +#define DEF_MENU_BORDER_WIDTH "2" +#define DEF_MENU_CURSOR "arrow" +#define DEF_MENU_DISABLED_FG_COLOR DISABLED +#define DEF_MENU_DISABLED_FG_MONO "" +#define DEF_MENU_FONT "Helvetica -12 bold" +#define DEF_MENU_FG BLACK +#define DEF_MENU_POST_COMMAND "" +#define DEF_MENU_RELIEF "raised" +#define DEF_MENU_SELECT_COLOR INDICATOR +#define DEF_MENU_SELECT_MONO BLACK +#define DEF_MENU_TAKE_FOCUS "0" +#define DEF_MENU_TEAROFF "1" +#define DEF_MENU_TEAROFF_CMD (char *) NULL +#define DEF_MENU_TITLE "" +#define DEF_MENU_TYPE "normal" + +/* + * Defaults for menubuttons: + */ + +#define DEF_MENUBUTTON_ANCHOR "center" +#define DEF_MENUBUTTON_ACTIVE_BG_COLOR ACTIVE_BG +#define DEF_MENUBUTTON_ACTIVE_BG_MONO BLACK +#define DEF_MENUBUTTON_ACTIVE_FG_COLOR BLACK +#define DEF_MENUBUTTON_ACTIVE_FG_MONO WHITE +#define DEF_MENUBUTTON_BG_COLOR NORMAL_BG +#define DEF_MENUBUTTON_BG_MONO WHITE +#define DEF_MENUBUTTON_BITMAP "" +#define DEF_MENUBUTTON_BORDER_WIDTH "2" +#define DEF_MENUBUTTON_CURSOR "" +#define DEF_MENUBUTTON_DIRECTION "below" +#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED +#define DEF_MENUBUTTON_DISABLED_FG_MONO "" +#define DEF_MENUBUTTON_FONT "Helvetica -12 bold" +#define DEF_MENUBUTTON_FG BLACK +#define DEF_MENUBUTTON_HEIGHT "0" +#define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR +#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO +#define DEF_MENUBUTTON_HIGHLIGHT BLACK +#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0" +#define DEF_MENUBUTTON_IMAGE (char *) NULL +#define DEF_MENUBUTTON_INDICATOR "0" +#define DEF_MENUBUTTON_JUSTIFY "center" +#define DEF_MENUBUTTON_MENU "" +#define DEF_MENUBUTTON_PADX "4p" +#define DEF_MENUBUTTON_PADY "3p" +#define DEF_MENUBUTTON_RELIEF "flat" +#define DEF_MENUBUTTON_STATE "normal" +#define DEF_MENUBUTTON_TAKE_FOCUS "0" +#define DEF_MENUBUTTON_TEXT "" +#define DEF_MENUBUTTON_TEXT_VARIABLE "" +#define DEF_MENUBUTTON_UNDERLINE "-1" +#define DEF_MENUBUTTON_WIDTH "0" +#define DEF_MENUBUTTON_WRAP_LENGTH "0" + +/* + * Defaults for messages: + */ + +#define DEF_MESSAGE_ANCHOR "center" +#define DEF_MESSAGE_ASPECT "150" +#define DEF_MESSAGE_BG_COLOR NORMAL_BG +#define DEF_MESSAGE_BG_MONO WHITE +#define DEF_MESSAGE_BORDER_WIDTH "2" +#define DEF_MESSAGE_CURSOR "" +#define DEF_MESSAGE_FG BLACK +#define DEF_MESSAGE_FONT "Helvetica -12 bold" +#define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG +#define DEF_MESSAGE_HIGHLIGHT BLACK +#define DEF_MESSAGE_HIGHLIGHT_WIDTH "0" +#define DEF_MESSAGE_JUSTIFY "left" +#define DEF_MESSAGE_PADX "-1" +#define DEF_MESSAGE_PADY "-1" +#define DEF_MESSAGE_RELIEF "flat" +#define DEF_MESSAGE_TAKE_FOCUS "0" +#define DEF_MESSAGE_TEXT "" +#define DEF_MESSAGE_TEXT_VARIABLE "" +#define DEF_MESSAGE_WIDTH "0" + +/* + * Defaults for scales: + */ + +#define DEF_SCALE_ACTIVE_BG_COLOR ACTIVE_BG +#define DEF_SCALE_ACTIVE_BG_MONO BLACK +#define DEF_SCALE_BG_COLOR NORMAL_BG +#define DEF_SCALE_BG_MONO WHITE +#define DEF_SCALE_BIG_INCREMENT "0" +#define DEF_SCALE_BORDER_WIDTH "2" +#define DEF_SCALE_COMMAND "" +#define DEF_SCALE_CURSOR "" +#define DEF_SCALE_DIGITS "0" +#define DEF_SCALE_FONT "Helvetica -12 bold" +#define DEF_SCALE_FG_COLOR BLACK +#define DEF_SCALE_FG_MONO BLACK +#define DEF_SCALE_FROM "0" +#define DEF_SCALE_HIGHLIGHT_BG_COLOR DEF_SCALE_BG_COLOR +#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO +#define DEF_SCALE_HIGHLIGHT BLACK +#define DEF_SCALE_HIGHLIGHT_WIDTH "1" +#define DEF_SCALE_LABEL "" +#define DEF_SCALE_LENGTH "100" +#define DEF_SCALE_ORIENT "vertical" +#define DEF_SCALE_RELIEF "flat" +#define DEF_SCALE_REPEAT_DELAY "300" +#define DEF_SCALE_REPEAT_INTERVAL "100" +#define DEF_SCALE_RESOLUTION "1" +#define DEF_SCALE_TROUGH_COLOR TROUGH +#define DEF_SCALE_TROUGH_MONO WHITE +#define DEF_SCALE_SHOW_VALUE "1" +#define DEF_SCALE_SLIDER_LENGTH "30" +#define DEF_SCALE_SLIDER_RELIEF "raised" +#define DEF_SCALE_STATE "normal" +#define DEF_SCALE_TAKE_FOCUS (char *) NULL +#define DEF_SCALE_TICK_INTERVAL "0" +#define DEF_SCALE_TO "100" +#define DEF_SCALE_VARIABLE "" +#define DEF_SCALE_WIDTH "15" + +/* + * Defaults for scrollbars: + */ + +#define DEF_SCROLLBAR_ACTIVE_BG_COLOR ACTIVE_BG +#define DEF_SCROLLBAR_ACTIVE_BG_MONO BLACK +#define DEF_SCROLLBAR_ACTIVE_RELIEF "raised" +#define DEF_SCROLLBAR_BG_COLOR NORMAL_BG +#define DEF_SCROLLBAR_BG_MONO WHITE +#define DEF_SCROLLBAR_BORDER_WIDTH "2" +#define DEF_SCROLLBAR_COMMAND "" +#define DEF_SCROLLBAR_CURSOR "" +#define DEF_SCROLLBAR_EL_BORDER_WIDTH "-1" +#define DEF_SCROLLBAR_HIGHLIGHT_BG NORMAL_BG +#define DEF_SCROLLBAR_HIGHLIGHT BLACK +#define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "1" +#define DEF_SCROLLBAR_JUMP "0" +#define DEF_SCROLLBAR_ORIENT "vertical" +#define DEF_SCROLLBAR_RELIEF "sunken" +#define DEF_SCROLLBAR_REPEAT_DELAY "300" +#define DEF_SCROLLBAR_REPEAT_INTERVAL "100" +#define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL +#define DEF_SCROLLBAR_TROUGH_COLOR TROUGH +#define DEF_SCROLLBAR_TROUGH_MONO WHITE +#define DEF_SCROLLBAR_WIDTH "15" + +/* + * Defaults for texts: + */ + +#define DEF_TEXT_BG_COLOR NORMAL_BG +#define DEF_TEXT_BG_MONO WHITE +#define DEF_TEXT_BORDER_WIDTH "2" +#define DEF_TEXT_CURSOR "xterm" +#define DEF_TEXT_FG BLACK +#define DEF_TEXT_EXPORT_SELECTION "1" +#define DEF_TEXT_FONT "Courier -12" +#define DEF_TEXT_HEIGHT "24" +#define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG +#define DEF_TEXT_HIGHLIGHT BLACK +#define DEF_TEXT_HIGHLIGHT_WIDTH "1" +#define DEF_TEXT_INSERT_BG BLACK +#define DEF_TEXT_INSERT_BD_COLOR "0" +#define DEF_TEXT_INSERT_BD_MONO "0" +#define DEF_TEXT_INSERT_OFF_TIME "300" +#define DEF_TEXT_INSERT_ON_TIME "600" +#define DEF_TEXT_INSERT_WIDTH "2" +#define DEF_TEXT_PADX "1" +#define DEF_TEXT_PADY "1" +#define DEF_TEXT_RELIEF "sunken" +#define DEF_TEXT_SELECT_COLOR SELECT_BG +#define DEF_TEXT_SELECT_MONO BLACK +#define DEF_TEXT_SELECT_BD_COLOR "1" +#define DEF_TEXT_SELECT_BD_MONO "0" +#define DEF_TEXT_SELECT_FG_COLOR BLACK +#define DEF_TEXT_SELECT_FG_MONO WHITE +#define DEF_TEXT_SELECT_RELIEF "raised" +#define DEF_TEXT_SET_GRID "0" +#define DEF_TEXT_SPACING1 "0" +#define DEF_TEXT_SPACING2 "0" +#define DEF_TEXT_SPACING3 "0" +#define DEF_TEXT_STATE "normal" +#define DEF_TEXT_TABS "" +#define DEF_TEXT_TAKE_FOCUS (char *) NULL +#define DEF_TEXT_WIDTH "80" +#define DEF_TEXT_WRAP "char" +#define DEF_TEXT_XSCROLL_COMMAND "" +#define DEF_TEXT_YSCROLL_COMMAND "" + +/* + * Defaults for canvas text: + */ + +#define DEF_CANVTEXT_FONT "Helvetica -12" + +/* + * Defaults for toplevels (most of the defaults for frames also apply + * to toplevels): + */ + +#define DEF_TOPLEVEL_CLASS "Toplevel" +#define DEF_TOPLEVEL_MENU "" +#define DEF_TOPLEVEL_SCREEN "" + +#endif /* _TKUNIXDEFAULT */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkUnixPort.h ./canvas-tcl8.2.2/tkUnixPort.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/tkUnixPort.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/tkUnixPort.h Thu Dec 30 15:16:30 1999 @@ -0,0 +1,231 @@ +/* + * tkUnixPort.h -- + * + * This file is included by all of the Tk C files. It contains + * information that may be configuration-dependent, such as + * #includes for system include files and a few other things. + * + * Copyright (c) 1991-1993 The Regents of the University of California. + * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkUnixPort.h,v 1.5 1999/04/16 01:51:47 stanton Exp $ + */ + +#ifndef _UNIXPORT +#define _UNIXPORT + +#define __UNIX__ 1 + +/* + * Macro to use instead of "void" for arguments that must have + * type "void *" in ANSI C; maps them to type "char *" in + * non-ANSI systems. This macro may be used in some of the include + * files below, which is why it is defined here. + */ + +#ifndef VOID +# ifdef __STDC__ +# define VOID void +# else +# define VOID char +# endif +#endif + +#include +#include +#include +#ifdef HAVE_LIMITS_H +# include +#else +# include "limits.h" +#endif +#include +#include +#ifdef NO_STDLIB_H +# include "../compat/stdlib.h" +#else +# include +#endif +#include +#include +#include +#ifdef HAVE_SYS_SELECT_H +# include +#endif +#include +#ifndef _TCL +# include +#endif +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#ifdef HAVE_UNISTD_H +# include +#else +# include "unistd.h" +#endif +#include +#include +#include +#include +#include +#include +#include + +/* + * The following macro defines the type of the mask arguments to + * select: + */ + +#ifndef NO_FD_SET +# define SELECT_MASK fd_set +#else +# ifndef _AIX + typedef long fd_mask; +# endif +# if defined(_IBMR2) +# define SELECT_MASK void +# else +# define SELECT_MASK int +# endif +#endif + +/* + * The following macro defines the number of fd_masks in an fd_set: + */ + +#ifndef FD_SETSIZE +# ifdef OPEN_MAX +# define FD_SETSIZE OPEN_MAX +# else +# define FD_SETSIZE 256 +# endif +#endif +#if !defined(howmany) +# define howmany(x, y) (((x)+((y)-1))/(y)) +#endif +#ifndef NFDBITS +# define NFDBITS NBBY*sizeof(fd_mask) +#endif +#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS) + +/* + * Not all systems declare the errno variable in errno.h. so this + * file does it explicitly. + */ + +extern int errno; + +/* + * Define "NBBY" (number of bits per byte) if it's not already defined. + */ + +#ifndef NBBY +# define NBBY 8 +#endif + +/* + * These macros are just wrappers for the equivalent X Region calls. + */ + +#define TkClipBox(rgn, rect) XClipBox((Region) rgn, rect) +#define TkCreateRegion() (TkRegion) XCreateRegion() +#define TkDestroyRegion(rgn) XDestroyRegion((Region) rgn) +#define TkIntersectRegion(a, b, r) XIntersectRegion((Region) a, \ + (Region) b, (Region) r) +#define TkRectInRegion(r, x, y, w, h) XRectInRegion((Region) r, x, y, w, h) +#define TkSetRegion(d, gc, rgn) XSetRegion(d, gc, (Region) rgn) +#define TkUnionRectWithRegion(rect, src, ret) XUnionRectWithRegion(rect, \ + (Region) src, (Region) ret) + +/* + * The TkPutImage macro strips off the color table information, which isn't + * needed for X. + */ + +#define TkPutImage(colors, ncolors, display, pixels, gc, image, destx, desty, srcx, srcy, width, height) \ + XPutImage(display, pixels, gc, image, destx, desty, srcx, \ + srcy, width, height); + +/* + * Supply macros for seek offsets, if they're not already provided by + * an include file. + */ + +#ifndef SEEK_SET +# define SEEK_SET 0 +#endif + +#ifndef SEEK_CUR +# define SEEK_CUR 1 +#endif + +#ifndef SEEK_END +# define SEEK_END 2 +#endif + +/* + * Declarations for various library procedures that may not be declared + * in any other header file. + */ + + +/* + * These functions do nothing under Unix, so we just eliminate calls to them. + */ + +#define TkpButtonSetDefaults(specPtr) {} +#define TkpDestroyButton(butPtr) {} +#define TkSelUpdateClipboard(a,b) {} +#define TkSetPixmapColormap(p,c) {} + +/* + * These calls implement native bitmaps which are not supported under + * UNIX. The macros eliminate the calls. + */ + +#define TkpDefineNativeBitmaps() +#define TkpCreateNativeBitmap(display, source) None +#define TkpGetNativeAppBitmap(display, name, w, h) None + +/* + * This macro stores a representation of the window handle in a string. + */ + +#define TkpPrintWindowId(buf,w) \ + sprintf((buf), "0x%x", (unsigned int) (w)) + +/* + * TkpScanWindowId is just an alias for Tcl_GetInt on Unix. + */ + +#define TkpScanWindowId(i,s,wp) \ + Tcl_GetInt((i),(s),(wp)) + +/* + * This macro indicates that entry and text widgets should display + * the selection highlight regardless of which window has the focus. + */ + +#define ALWAYS_SHOW_SELECTION + +/* + * The following declaration is used to get access to a private Tcl interface + * that is needed for portability reasons. + */ + +#ifndef _TCLINT +#include "tclInt.h" +#endif + +#endif /* _UNIXPORT */ diff -urN ../abacus-0.9.13.orig/canvas-tcl8.2.2/xxl_incs.h ./canvas-tcl8.2.2/xxl_incs.h --- ../abacus-0.9.13.orig/canvas-tcl8.2.2/xxl_incs.h Wed Dec 31 18:00:00 1969 +++ ./canvas-tcl8.2.2/xxl_incs.h Thu Dec 30 15:29:53 1999 @@ -0,0 +1,181 @@ +/* $Id: xxl_incs.h,v 1.2 1998/09/30 00:50:44 cthulhu Exp $ */ + +typedef struct RectOvalItem { + Tk_Item header; /* Generic stuff that's the same for all + * types. MUST BE FIRST IN STRUCTURE. */ + double bbox[4]; /* Coordinates of bounding box for rectangle + * or oval (x1, y1, x2, y2). Item includes + * x1 and x2 but not y1 and y2. */ + int width; /* Width of outline. */ + XColor *outlineColor; /* Color for outline. */ + XColor *fillColor; /* Color for filling rectangle/oval. */ + Pixmap fillStipple; /* Stipple bitmap for filling item. */ + GC outlineGC; /* Graphics context for outline. */ + GC fillGC; /* Graphics context for filling item. */ + short col1, col2; + short row1, row2; +} RectOvalItem; + +typedef struct TextLine { + char *firstChar; /* Pointer to the first character in this + * line (in the "text" field of enclosing + * text item). */ + int numChars; /* Number of characters displayed in this + * line. */ + int totalChars; /* Total number of characters included as + * part of this line (may include an extra + * space character at the end that isn't + * displayed). */ + int x, y; /* Origin at which to draw line on screen + * (in integer pixel units, but in canvas + * coordinates, not screen coordinates). */ + int x1, y1; /* Upper-left pixel that is part of text + * line on screen (again, in integer canvas + * pixel units). */ + int x2, y2; /* Lower-left pixel that is part of text + * line on screen (again, in integer canvas + * pixel units). */ +} TextLine; + +typedef struct TextItem { + Tk_Item header; /* Generic stuff that's the same for all + * types. MUST BE FIRST IN STRUCTURE. */ + Tk_CanvasTextInfo *textInfoPtr; + /* Pointer to a structure containing + * information about the selection and + * insertion cursor. The structure is owned + * by (and shared with) the generic canvas + * code. */ + /* + * Fields that are set by widget commands other than "configure". + */ + + double x, y; /* Positioning point for text. */ + int insertPos; /* Character index of character just before + * which the insertion cursor is displayed. */ + + /* + * Configuration settings that are updated by Tk_ConfigureWidget. + */ + + Tk_Anchor anchor; /* Where to anchor text relative to (x,y). */ + XColor *color; /* Color for text. */ + Tk_Font tkfont; /* Font for drawing text. */ + Tk_Justify justify; /* Justification mode for text. */ + Pixmap stipple; /* Stipple bitmap for text, or None. */ + char *text; /* Text for item (malloc-ed). */ + int width; /* Width of lines for word-wrap, pixels. + * Zero means no word-wrap. */ + + /* + * Fields whose values are derived from the current values of the + * configuration settings above. + */ + + int numChars; /* Length of text in characters. */ + int numBytes; /* Length of text in bytes. */ + Tk_TextLayout textLayout; /* Cached text layout information. */ + int leftEdge; /* Pixel location of the left edge of the + * text item; where the left border of the + * text layout is drawn. */ + int rightEdge; /* Pixel just to right of right edge of + * area of text item. Used for selecting up + * to end of line. */ + GC gc; /* Graphics context for drawing text. */ + GC selTextGC; /* Graphics context for selected text. */ + GC cursorOffGC; /* If not None, this gives a graphics context + * to use to draw the insertion cursor when + * it's off. Used if the selection and + * insertion cursor colors are the same. */ + short col; + short row; +} TextItem; + +typedef struct LineItem { + Tk_Item header; /* Generic stuff that's the same for all + * types. MUST BE FIRST IN STRUCTURE. */ + Tk_Canvas canvas; /* Canvas containing item. Needed for + * parsing arrow shapes. */ + int numPoints; /* Number of points in line (always >= 2). */ + double *coordPtr; /* Pointer to malloc-ed array containing + * x- and y-coords of all points in line. + * X-coords are even-valued indices, y-coords + * are corresponding odd-valued indices. If + * the line has arrowheads then the first + * and last points have been adjusted to refer + * to the necks of the arrowheads rather than + * their tips. The actual endpoints are + * stored in the *firstArrowPtr and + * *lastArrowPtr, if they exist. */ + int width; /* Width of line. */ + XColor *fg; /* Foreground color for line. */ + Pixmap fillStipple; /* Stipple bitmap for filling line. */ + int capStyle; /* Cap style for line. */ + int joinStyle; /* Join style for line. */ + GC gc; /* Graphics context for filling line. */ + GC arrowGC; /* Graphics context for drawing arrowheads. */ + Tk_Uid arrow; /* Indicates whether or not to draw arrowheads: + * "none", "first", "last", or "both". */ + float arrowShapeA; /* Distance from tip of arrowhead to center. */ + float arrowShapeB; /* Distance from tip of arrowhead to trailing + * point, measured along shaft. */ + float arrowShapeC; /* Distance of trailing points from outside + * edge of shaft. */ + double *firstArrowPtr; /* Points to array of PTS_IN_ARROW points + * describing polygon for arrowhead at first + * point in line. First point of arrowhead + * is tip. Malloc'ed. NULL means no arrowhead + * at first point. */ + double *lastArrowPtr; /* Points to polygon for arrowhead at last + * point in line (PTS_IN_ARROW points, first + * of which is tip). Malloc'ed. NULL means + * no arrowhead at last point. */ + int smooth; /* Non-zero means draw line smoothed (i.e. + * with Bezier splines). */ + int splineSteps; /* Number of steps in each spline segment. */ + short col1, col2; + short row1, row2; +} LineItem; + +typedef struct ArcItem { + Tk_Item header; /* Generic stuff that's the same for all + * types. MUST BE FIRST IN STRUCTURE. */ + double bbox[4]; /* Coordinates (x1, y1, x2, y2) of bounding + * box for oval of which arc is a piece. */ + double start; /* Angle at which arc begins, in degrees + * between 0 and 360. */ + double extent; /* Extent of arc (angular distance from + * start to end of arc) in degrees between + * -360 and 360. */ + double *outlinePtr; /* Points to (x,y) coordinates for points + * that define one or two closed polygons + * representing the portion of the outline + * that isn't part of the arc (the V-shape + * for a pie slice or a line-like segment + * for a chord). Malloc'ed. */ + int numOutlinePoints; /* Number of points at outlinePtr. Zero + * means no space allocated. */ + int width; /* Width of outline (in pixels). */ + XColor *outlineColor; /* Color for outline. NULL means don't + * draw outline. */ + XColor *fillColor; /* Color for filling arc (used for drawing + * outline too when style is "arc"). NULL + * means don't fill arc. */ + Pixmap fillStipple; /* Stipple bitmap for filling item. */ + Pixmap outlineStipple; /* Stipple bitmap for outline. */ + Tk_Uid style; /* How to draw arc: arc, chord, or pieslice. */ + GC outlineGC; /* Graphics context for outline. */ + GC fillGC; /* Graphics context for filling item. */ + double center1[2]; /* Coordinates of center of arc outline at + * start (see ComputeArcOutline). */ + double center2[2]; /* Coordinates of center of arc outline at + * start+extent (see ComputeArcOutline). */ + short col1, col2; + short row1, row2; + +} ArcItem; + +/* $Log: xxl_incs.h,v $ + * Revision 1.2 1998/09/30 00:50:44 cthulhu + * Update for tcl/tk 8.0.3. + * */