From: Victor Wagner Date: Fri, 24 Feb 2006 18:59:53 +0000 (+0000) Subject: Ck console graphics toolkit X-Git-Url: http://www.wagner.pp.ru/gitweb/?p=oss%2Fck.git;a=commitdiff_plain;h=HEAD Ck console graphics toolkit --- 140ece19beeab6d1610c106b9dc5da93c97f0a74 diff --git a/Makefile.in b/Makefile.in new file mode 100644 index 0000000..ea699cc --- /dev/null +++ b/Makefile.in @@ -0,0 +1,364 @@ +# +# This file is a Makefile for curses wish. If it has the name "Makefile.in" +# then it is a template for a Makefile; to generate the actual Makefile, +# run "./configure", which is a configuration script generated by the +# "autoconf" program (constructs like "@foo@" will get replaced in the +# actual Makefile. +# + +# Current Ck version; used in various names. + +VERSION = @CK_VERSION@ + +# What I suppose version of Ck itself, regardless of used Tcl + +SRCVERSION=8.1.2 + + +#---------------------------------------------------------------- +# Things you can change to personalize the Makefile for your own +# site (you can make these changes in either Makefile.in or +# Makefile, but changes to Makefile will get lost if you re-run +# the configuration script). +#---------------------------------------------------------------- + +# Default top-level directories in which to install architecture- +# specific files (exec_prefix) and machine-independent files such +# as scripts (prefix). The values specified here may be overridden +# at configure-time with the --exec-prefix and --prefix options +# to the "configure" script. + +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +# The following definition can be set to non-null for special systems +# like AFS with replication. It allows the pathnames used for installation +# to be different than those used for actually reference files at +# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix +# when installing files. +INSTALL_ROOT = + +# Directory from which applications will reference the library of Tcl +# scripts (note: you can set the CK_LIBRARY environment variable at +# run-time to override the compiled-in location): +CK_LIBRARY = $(prefix)/lib/ck$(VERSION) + +# Path name to use when installing library scripts: +SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(CK_LIBRARY) + +# Directory in which to install the archive libck*: +LIB_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/lib + +# Directory in which to install the program cwsh: +BIN_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/bin + +# Directory from which the program cwsh should be referenced by scripts: +BIN_DIR = $(exec_prefix)/bin + +# Directory in which to install the include file ck.h: +INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/include + +# Top-level directory for manual entries: +MAN_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/man + +# Directory in which to install manual entry for cwsh: +MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 + +# Directory in which to install manual entries for C library +# procedures: +MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 + +# Directory in which to install manual entries for the built-in +# Tcl commands implemented by Ck: +MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann + +# The directory containing the Tcl headers appropriate +# for this version ("srcdir" will be replaced or has already +# been replaced by the configure script): +TCL_VERSION = @TCL_VERSION@ +TCL_DIR = @TCL_DIR@ + +# The directory containing the Tcl library archive file appropriate +# for this version: +TCL_BIN_DIR = @TCL_BIN_DIR@ + +# A "-I" switch that can be used when compiling to make curses.h +# accessible (the configure script will try to set this value, and +# will cause it to be an empty string if the include file is accessible +# via /usr/include). +CURSES_INCLUDES = @CURSESINCLUDES@ @USE_NCURSES@ + +# Linker switch(es) to use to link with the curses library archive (the +# configure script will try to set this value automatically, but you +# can override it). +CURSES_LIB_SWITCHES = @CURSESLIBSW@ + +# Libraries to use when linking: must include at least Ck, Tcl, curses, +# and the math library (in that order). The "LIBS" part will be +# replaced (or has already been replaced) with relevant libraries as +# determined by the configure script. +LIBS = @TCL_BUILD_LIB_SPEC@ @LIBS@ $(CURSES_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc + +# To change the compiler switches, for example to change from -O +# to -g, change the following line: +CFLAGS = -O @TCL_INCLUDE_SPEC@ + +# To disable ANSI-C procedure prototypes reverse the comment characters +# on the following lines: +PROTO_FLAGS = +#PROTO_FLAGS = -DNO_PROTOTYPE + +# To enable memory debugging reverse the comment characters on the following +# lines. Warning: if you enable memory debugging, you must do it +# *everywhere*, including all the code that calls Tcl, and you must use +# ckalloc and ckfree everywhere instead of malloc and free. +MEM_DEBUG_FLAGS = +#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG + +# Some versions of make, like SGI's, use the following variable to +# determine which shell to use for executing commands: +SHELL = /bin/sh + +# Ck used to let the configure script choose which program to use +# for installing, but there are just too many different versions of +# "install" around; better to use the install-sh script that comes +# with the distribution, which is slower but guaranteed to work. + +INSTALL = @srcdir@/install-sh -c + +#---------------------------------------------------------------- +# The symbols below provide support for dynamic loading and shared +# libraries. The values of the symbols are normally set by the +# configure script. You shouldn't normally need to modify any of +# these definitions by hand. However, you can reverse the comments +# on the pairs of lines to force "no dynamic loading or shared +# libraries". +#---------------------------------------------------------------- + +# Additional cc flags needed in order to compile Ck as a shared library. +# This will be an empty string if Ck isn't configured as a shared library. +CK_SHLIB_CFLAGS = @CK_SHLIB_CFLAGS@ +#CK_SHLIB_CFLAGS = + +# Base command to use for combining object files into a shared +# library: +SHLIB_LD = @SHLIB_LD@ + +# Suffix to use for the name of the shared library. An empty string +# means we don't know how to use shared libraries on this platform. +SHLIB_SUFFIX = @SHLIB_SUFFIX@ +#SHLIB_SUFFIX = + +# Version string to tack onto the name of shared libraries (after the +# suffix), if it is needed for -lxxx to work during linking (e.g. on +# FreeBSD and NetBSD). +SHLIB_VERSION = @SHLIB_VERSION@ +#SHLIB_VERSION = + +# Library file(s) to include in cwsh and other base applications +# in order for the the "load" command to work (e.g. "-ldl"). +DL_LIBS = @DL_LIBS@ +#DL_LIBS = + +# Flags to pass to the compiler when linking object files into +# an executable cwsh. +LD_FLAGS = @LD_FLAGS@ @CK_LD_SEARCH_FLAGS@ +#LD_FLAGS = + +CK_LIB_FILE = @CK_LIB_FILE@ +#CK_LIB_FILE = libck.a + +#---------------------------------------------------------------- +# The information below is modified by the configure script when +# Makefile is generated from Makefile.in. You shouldn't normally +# modify any of this stuff by hand. +#---------------------------------------------------------------- + +AC_FLAGS = @DEFS@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_DATA = @INSTALL_DATA@ +RANLIB = @RANLIB@ +SRC_DIR = @srcdir@ +VPATH = @srcdir@ + +#---------------------------------------------------------------- +# The information below should be usable as is. The configure +# script won't modify it and you shouldn't need to modify it +# either. +#---------------------------------------------------------------- + +CC = @CC@ +CC_SWITCHES = ${CFLAGS} ${CK_SHLIB_CFLAGS} -I${SRC_DIR} -I${TCL_DIR} \ + ${CURSES_INCLUDES} ${AC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \ + -DCK_LIBRARY=\"${CK_LIBRARY}\" + +WIDGOBJS = ckButton.o ckEntry.o ckFrame.o ckListbox.o \ + ckMenu.o ckMenubutton.o ckMessage.o ckScrollbar.o ckTree.o + +TEXTOBJS = ckText.o ckTextBTree.o ckTextDisp.o ckTextIndex.o \ + ckTextMark.o ckTextTag.o + +OBJS = ckBind.o ckBorder.o ckCmds.o ckConfig.o ckEvent.o ckFocus.o \ + ckGeometry.o ckGet.o ckGrid.o ckMain.o ckOption.o ckPack.o ckPlace.o \ + ckPreserve.o ckRecorder.o ckUtil.o ckWindow.o tkEvent.o \ + $(WIDGOBJS) $(TEXTOBJS) + +SRCS = ckBind.c ckBorder.c ckCmds.c ckConfig.c ckEvent.c ckFocus.c \ + ckGeometry.c ckGet.c ckGrid.c ckMain.c ckOption.c ckPack.c ckPlace.c \ + ckPreserve.c ckRecorder.c ckUtil.c ckWindow.c tkEvent.c \ + ckButton.c ckEntry.c ckFrame.c ckListbox.c \ + ckMenu.c ckMenubutton.c ckMessage.c ckScrollbar.o \ + ckText.c ckTextBTree.c ckTextDisp.c ckTextIndex.c \ + ckTextMark.c ckTextTag.c ckTree.c \ + ckAppInit.c + +HDRS = default.h ks_names.h ck.h ckPort.h ckText.h + +all: cwsh + +@CK_LIB_FILE@: $(OBJS) + rm -f @CK_LIB_FILE@ + @MAKE_LIB@ + $(RANLIB) @CK_LIB_FILE@ + +cwsh: ckAppInit.o $(CK_LIB_FILE) + $(CC) $(LD_FLAGS) ckAppInit.o @CK_BUILD_LIB_SPEC@ $(LIBS) -o cwsh + +configInfo: Makefile + @rm -f configInfo + @echo "# Definitions and libraries needed to build Ck applications" >> configInfo + @echo "# (generated by the configure script):" >> configInfo + @echo "CK_CC_SWITCHES = ${AC_FLAGS} ${MEM_DEBUG_FLAGS}" >> configInfo + @echo "CK_CURSES_INCLUDES = ${CURSES_INCLUDES}" >> configInfo + @echo "CK_LIBS = ${CURSES_LIB_SWITCHES} @LIBS@" >> configInfo + +install: install-binaries install-libraries + +install-binaries: $(CK_LIB_FILE) cwsh + @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) $(LIB_INSTALL_DIR)/ck$(CK_VERSION) ; \ + do \ + if [ ! -d $$i ] ; then \ + echo "Making directory $$i"; \ + mkdir $$i; \ + chmod 755 $$i; \ + else true; \ + fi; \ + done; + @echo "Installing $(CK_LIB_FILE)" + @$(INSTALL_DATA) $(CK_LIB_FILE) $(LIB_INSTALL_DIR)/$(CK_LIB_FILE) + @$(INSTALL_DATA) pkgIndex.tcl $(LIB_INSTALL_DIR)/ck$(CK_VERSION)/pkgIndex.tcl + @$(RANLIB) $(LIB_INSTALL_DIR)/$(CK_LIB_FILE) + chmod 555 $(LIB_INSTALL_DIR)/$(CK_LIB_FILE) + @echo "Installing cwsh" + @$(INSTALL_PROGRAM) cwsh $(BIN_INSTALL_DIR)/cwsh + +install-libraries: + @for i in $(INSTALL_ROOT)$(prefix)/lib $(INCLUDE_INSTALL_DIR) \ + $(SCRIPT_INSTALL_DIR) ; \ + do \ + if [ ! -d $$i ] ; then \ + echo "Making directory $$i"; \ + mkdir $$i; \ + chmod 755 $$i; \ + else true; \ + fi; \ + done; + @echo "Installing ck.h" + @$(INSTALL_DATA) $(SRC_DIR)/ck.h $(INCLUDE_INSTALL_DIR) + for i in $(SRC_DIR)/library/*.tcl $(SRC_DIR)/library/tclIndex \ + $(SRC_DIR)/ckAppInit.c; do \ + echo "Installing $$i"; \ + $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \ + done; + +install-demos: + @for i in $(INSTALL_ROOT)$(prefix)/lib $(SCRIPT_INSTALL_DIR) \ + $(SCRIPT_INSTALL_DIR)/demos \ + $(SCRIPT_INSTALL_DIR)/demos/images ; \ + do \ + if [ ! -d $$i ] ; then \ + echo "Making directory $$i"; \ + mkdir $$i; \ + chmod 755 $$i; \ + else true; \ + fi; \ + done; + @for i in $(SRC_DIR)/library/demos/*; \ + do \ + if [ -f $$i ] ; then \ + echo "Installing $$i"; \ + $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos; \ + fi; \ + done; + @for i in $(DEMOPROGS); \ + do \ + chmod 755 $(SCRIPT_INSTALL_DIR)/demos/$$i; \ + done; + @for i in $(SRC_DIR)/library/demos/images/*; \ + do \ + if [ -f $$i ] ; then \ + echo "Installing $$i"; \ + $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \ + fi; \ + done; + +install-man: + @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) $(MANN_INSTALL_DIR) ; \ + do \ + if [ ! -d $$i ] ; then \ + echo "Making directory $$i"; \ + mkdir $$i; \ + chmod 755 $$i; \ + else true; \ + fi; \ + done; + @cd $(SRC_DIR)/doc; for i in *.1; \ + do \ + echo "Installing doc/$$i"; \ + rm -f $(MAN1_INSTALL_DIR)/$$i; \ + sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \ + $$i > $(MAN1_INSTALL_DIR)/$$i; \ + chmod 444 $(MAN1_INSTALL_DIR)/$$i; \ + done; + @cd $(SRC_DIR)/doc; for i in *.3; \ + do \ + echo "Installing doc/$$i"; \ + rm -f $(MAN3_INSTALL_DIR)/$$i; \ + sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \ + $$i > $(MAN3_INSTALL_DIR)/$$i; \ + chmod 444 $(MAN3_INSTALL_DIR)/$$i; \ + done; + @cd $(SRC_DIR)/doc; for i in *.n; \ + do \ + echo "Installing doc/$$i"; \ + rm -f $(MANN_INSTALL_DIR)/$$i; \ + sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \ + $$i > $(MANN_INSTALL_DIR)/$$i; \ + chmod 444 $(MANN_INSTALL_DIR)/$$i; \ + done; + +Makefile: $(SRC_DIR)/Makefile.in + $(SHELL) config.status + +clean: + rm -f *.a *.o core errs *~ ./.#* \#* TAGS *.E a.out errors cwsh \ + config.info libck*.so libck*.a + +distclean: clean + rm -f Makefile config.status config.cache config.log config.sub ckConfig.sh + +depend: + makedepend -- $(CC_SWITCHES) -- $(SRCS) + +orig: ../libck-tcl_$(SRCVERSION).orig.tar.gz + +../libck-tcl_$(SRCVERSION).orig.tar.gz: distclean + tar -C .. -czf $@ --exclude "*/debian*" --exclude "*.3ck" --exclude "*/CVS*" `basename \`pwd\`` + +deb: orig + debuild + +.c.o: + $(CC) -c $(CC_SWITCHES) $< + +# DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/README b/README new file mode 100644 index 0000000..2b48bbe --- /dev/null +++ b/README @@ -0,0 +1,46 @@ +How to compile and install Ck8.0 +-------------------------------- + +1. Type "./configure". This runs a configuration script made by GNU + autoconf, which configures Ck for your system and creates a Makefile. + The configure script allows you to customize the configuration to + your local needs; for details how to do this, type "./configure --help" + or refer to the autoconf documentation (not included here). + The following special switches are supported by "configure": + --enable-shared If this switch is specified Ck will + compile itself as a shared library if + configure can figure out how to do this + on this platform. + --with-tcl Specifies the directory containing the + Tcl binaries and Tcl's platform-dependent + configuration information. By default the + Tcl distribution is assumed to be in + "../../tcl8.0". + +2. Type "make". This will create a library called "libck.a" or "libck8.0.so" + and an interpreter application called "cwsh" that allows you to type + Tcl commands interactively or execute scripts. + +3. Type "make install" to install Ck's binaries, script files, and man + pages in standard places. You'll need write permission on the install + directories to do this. If you plan to install the libraries, executables, + and script files whitout documentation, use "make install-binaries" and + "make install-libraries". + +4. Now you should be able to execute "cwsh". However, if you haven't installed + Ck then you'll need to set the CK_LIBRARY environment variable to hold the + full path name of the "library" subdirectory. If Ck has been built as + shared library, you have to set the LD_LIBRARY_PATH to include the directory + where "libck8.0.so" resides. + + +So far, Ck8.0 has been successfully tested on various Linux distributions, +on FreeBSD 3.3 with manually adapted Makefile, and on Windows NT 4.0 with +a modified PDCURSES library. The Ck8.0 source tree should be able to be +combined with Tcl7.4, 7.5, 7.6, and 8.0. +Older version of Ck (which use Tcl7.4 or Tcl7.5) are in use for several +years on HP-UX, AIX, and DEC Unix. + + +Christian Werner, December 1999 +mailto:Christian.Werner@t-online.de diff --git a/build-stamp b/build-stamp new file mode 100644 index 0000000..e69de29 diff --git a/ck.h b/ck.h new file mode 100644 index 0000000..c6f4b83 --- /dev/null +++ b/ck.h @@ -0,0 +1,897 @@ +/* + * ck.h -- + * + * Declaration of all curses wish related things. + * + * Copyright (c) 1989-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995-2001 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _CK_H +#define _CK_H + +#ifndef _TCL +#include +#endif + +#if (TCL_MAJOR_VERSION < 7) +#error Tcl major version must be 7 or greater +#endif + +#if (TCL_MAJOR_VERSION >= 8) +#define CK_MAJOR_VERSION 8 +#if (TCL_MINOR_VERSION == 5) +#define CK_VERSION "8.5" +#define CK_MINOR_VERSION 5 +#define CK_USE_UTF 1 +#elif (TCL_MINOR_VERSION == 4) +#define CK_VERSION "8.4" +#define CK_MINOR_VERSION 4 +#define CK_USE_UTF 1 +#elif (TCL_MINOR_VERSION == 3) +#define CK_VERSION "8.3" +#define CK_MINOR_VERSION 3 +#define CK_USE_UTF 1 +#elif (TCL_MINOR_VERSION == 2) +#define CK_VERSION "8.2" +#define CK_MINOR_VERSION 2 +#define CK_USE_UTF 1 +#elif (TCL_MINOR_VERSION == 1) +#define CK_VERSION "8.1" +#define CK_MINOR_VERSION 1 +#define CK_USE_UTF 1 +#else +#define CK_VERSION "8.0" +#define CK_MINOR_VERSION 0 +#define CK_USE_UTF 0 +#endif +#else + +#define CK_MAJOR_VERSION 4 +#define CK_USE_UTF 0 + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +#define CK_VERSION "4.0" +#define CK_MINOR_VERSION 0 +#else +#define CK_VERSION "4.1" +#define CK_MINOR_VERSION 1 +#endif +#endif + +#ifndef RESOURCE_INCLUDED + +#ifdef __STDC__ +#include +#endif + +#ifdef USE_NCURSES +#include +#else +#include +#endif + +/* + * Keyboard symbols (KeySym) + */ + +typedef int KeySym; +#define NoSymbol (-2) + +/* + * Event structures. + */ + +typedef struct { + long type; + struct CkWindow *winPtr; +} CkAnyEvent; + +typedef struct { + long type; + struct CkWindow *winPtr; + int keycode; +} CkKeyEvent; + +typedef struct { + long type; + struct CkWindow *winPtr; + int button, x, y, rootx, rooty; +} CkMouseEvent; + +typedef struct { + long type; + struct CkWindow *winPtr; +} CkWindowEvent; + +typedef union { + long type; + CkAnyEvent any; + CkKeyEvent key; + CkMouseEvent mouse; + CkWindowEvent win; +} CkEvent; + +/* + * Event types/masks + */ + +#define CK_EV_KEYPRESS 0x00000001 +#define CK_EV_MOUSE_DOWN 0x00000002 +#define CK_EV_MOUSE_UP 0x00000004 +#define CK_EV_UNMAP 0x00000010 +#define CK_EV_MAP 0x00000020 +#define CK_EV_EXPOSE 0x00000040 +#define CK_EV_DESTROY 0x00000080 +#define CK_EV_FOCUSIN 0x00000100 +#define CK_EV_FOCUSOUT 0x00000200 +#define CK_EV_BARCODE 0x10000000 +#define CK_EV_ALL 0xffffffff + +/* + * Additional types exported to clients. + */ + +typedef char *Ck_Uid; +typedef char *Ck_BindingTable; + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +typedef char *Tk_TimerToken; +#else +#define Tk_TimerToken Tcl_TimerToken +#endif + +/* + *-------------------------------------------------------------- + * + * Additional procedure types defined by curses wish. + * + *-------------------------------------------------------------- + */ + +typedef void (Ck_EventProc) _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +typedef int (Ck_GenericProc) _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +typedef void (Ck_FreeProc) _ANSI_ARGS_((ClientData clientData)); +#else +#define Ck_FreeProc Tcl_FreeProc +#endif + +typedef void (Tk_FileProc) _ANSI_ARGS_((ClientData clientData, int mask)); +typedef int (Tk_FileProc2) _ANSI_ARGS_((ClientData clientData, int mask, + int flags)); +typedef void (Tk_IdleProc) _ANSI_ARGS_((ClientData clientData)); +typedef void (Tk_TimerProc) _ANSI_ARGS_((ClientData clientData)); + +/* + * 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 (Ck_GeomRequestProc) _ANSI_ARGS_((ClientData clientData, + struct CkWindow *winPtr)); +typedef void (Ck_GeomLostSlaveProc) _ANSI_ARGS_((ClientData clientData, + struct CkWindow *winPtr)); + +typedef struct Ck_GeomMgr { + char *name; /* Name of the geometry manager (command + * used to invoke it, or name of widget + * class that allows embedded widgets). */ + Ck_GeomRequestProc *requestProc; + /* Procedure to invoke when a slave's + * requested geometry changes. */ + Ck_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. */ +} Ck_GeomMgr; + + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + +/* + * Bits to pass to Tk_CreateFileHandler to indicate what sorts + * of events are of interest: (must be synced w/ tk.h !!!) + */ + +#define TK_READABLE 1 +#define TK_WRITABLE 2 +#define TK_EXCEPTION 4 + +/* + * Special return value from Tk_FileProc2 procedures indicating that + * an event was successfully processed. + */ + +#define TK_FILE_HANDLED -1 + +/* + * Flag values to pass to Tk_DoOneEvent to disable searches + * for some kinds of events: + */ + +#define TK_DONT_WAIT 1 +#define TK_X_EVENTS 2 +#define TK_FILE_EVENTS 4 +#define TK_TIMER_EVENTS 8 +#define TK_IDLE_EVENTS 0x10 +#define TK_ALL_EVENTS 0x1e + +#else + +/* + * Flag values to pass to Tk_DoOneEvent to disable searches + * for some kinds of events: + */ + +#define TK_DONT_WAIT TCL_DONT_WAIT +#define TK_X_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 + +#endif + +/* + * One of the following structures exists for each event handler + * created by calling Ck_CreateEventHandler. This information + * is used by ckEvent.c only. + */ + +typedef struct CkEventHandler { + long mask; /* Events for which to invoke proc. */ + Ck_EventProc *proc; /* Procedure to invoke when an event + * in mask occurs. */ + ClientData clientData; /* Argument to pass to proc. */ + struct CkEventHandler *nextPtr; /* Next in list of handlers + * associated with window (NULL means + * end of list). */ +} CkEventHandler; + +/* + * Ck keeps the following data structure for the main + * window (created by a call to Ck_CreateMainWindow). It stores + * information that is shared by all of the windows associated + * with the application. + */ + +typedef struct CkMainInfo { + struct CkWindow *winPtr; /* Pointer to main window. */ + Tcl_Interp *interp; /* Interpreter associated with application. */ + Tcl_HashTable nameTable; /* Hash table mapping path names to CkWindow + * structs for all windows related to this + * main window. Managed by ckWindow.c. */ + Tcl_HashTable winTable; /* Ditto, for event handling. */ + struct CkWindow *topLevPtr; /* Anchor for toplevel window list. */ + struct CkWindow *focusPtr; /* Identifies window that currently has the + * focus. NULL means nobody has the focus. + * Managed by ckFocus.c. */ + Ck_BindingTable bindingTable; + /* Used in conjunction with "bind" command + * to bind events to Tcl commands. */ + struct ElArray *optionRootPtr; + /* Top level of option hierarchy for this + * main window. NULL means uninitialized. + * Managed by ckOption.c. */ + int maxWidth, maxHeight; /* Max dimensions of curses screen. */ + int refreshCount; /* Counts number of calls + * to Ck_EventuallyRefresh. */ + int refreshDelay; /* Delay in milliseconds between updates; + * see comment in ckWindow.c. */ + double lastRefresh; /* Delay computation for updates. */ + Tk_TimerToken refreshTimer; /* Timer for delayed updates. */ + ClientData mouseData; /* Value used by mouse handling code. */ + ClientData barcodeData; /* Value used by bar code handling code. */ + int flags; /* See definitions below. */ +#if CK_USE_UTF + Tcl_Encoding isoEncoding; + Tcl_DString isoBuffer; +#endif +} CkMainInfo; + +#define CK_HAS_COLOR 1 +#define CK_REVERSE_KLUDGE 2 +#define CK_HAS_MOUSE 4 +#define CK_MOUSE_XTERM 8 +#define CK_REFRESH_TIMER 16 +#define CK_HAS_BARCODE 32 +#define CK_NOCLR_ON_EXIT 64 + +/* + * Ck keeps one of the following structures for each window. + * This information is (mostly) managed by ckWindow.c. + */ + +typedef struct CkWindow { + + /* + * Structural information: + */ + + WINDOW *window; /* Curses window. NULL means window + * hasn't actually been created yet, or it's + * been deleted. */ + struct CkWindow *childList; /* First in list of child windows, + * or NULL if no children. */ + struct CkWindow *lastChildPtr; + /* Last in list of child windows, or NULL + * if no children. */ + struct CkWindow *parentPtr; /* Pointer to parent window. */ + struct CkWindow *nextPtr; /* Next in list of children with + * same parent (NULL if end of list). */ + struct CkWindow *topLevPtr; /* Next toplevel if this is toplevel. */ + CkMainInfo *mainPtr; /* Information shared by all windows + * associated with the main window. */ + + /* + * 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. + */ + Ck_Uid nameUid; /* Name of the window within its parent + * (unique within the parent). */ + Ck_Uid classUid; /* Class of the window. NULL means window + * hasn't been given a class yet. */ + + /* + * Information kept by the event manager (ckEvent.c): + */ + + CkEventHandler *handlerList;/* First in list of event handlers + * declared for this window, or + * NULL if none. */ + + /* + * Information kept by the bind/bindtags mechanism (ckCmds.c): + */ + + ClientData *tagPtr; /* Points to array of tags used for bindings + * on this window. Each tag is a Ck_Uid. + * Malloc'ed. NULL means no tags. */ + int numTags; /* Number of tags at *tagPtr. */ + + /* + * Information used by ckFocus.c for toplevel windows. + */ + + struct CkWindow *focusPtr; /* If toplevel, this was the last child + * which had the focus. */ + + /* + * Information used by ckGeometry.c for geometry managers. + */ + + Ck_GeomMgr *geomMgrPtr; /* Procedure to manage geometry, NULL + * means unmanaged. */ + ClientData geomData; /* Argument for geomProc. */ + int reqWidth, reqHeight; /* Requested width/height of window. */ + + /* + * Information used by ckOption.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. */ + + /* + * Geometry and other attributes of window. + */ + + int x, y; /* Top-left corner with respect to + * parent window. */ + int width, height; /* Width and height of window. */ + int fg, bg; /* Foreground/background colors. */ + int attr; /* Video attributes. */ + int flags; /* Various flag values, see below. */ + + +} CkWindow; + +/* + * Flag values for CkWindow structures are: + * + * CK_MAPPED: 1 means window is currently mapped, + * 0 means unmapped. + * CK_BORDER: 1 means the window has a one character + * cell wide border around it. + * 0 means no border. + * CK_TOPLEVEL: 1 means this is a toplevel window. + * CK_SHOW_CURSOR: 1 means show the terminal's cursor if + * this window has the focus. + * CK_RECURSIVE_DESTROY: 1 means a recursive destroy is in + * progress, so some cleanup operations + * can be omitted. + * CK_ALREADY_DEAD: 1 means the window is in the process of + * being destroyed already. + */ + +#define CK_MAPPED 1 +#define CK_BORDER 2 +#define CK_TOPLEVEL 4 +#define CK_SHOW_CURSOR 8 +#define CK_RECURSIVE_DESTROY 16 +#define CK_ALREADY_DEAD 32 +#define CK_DONTRESTRICTSIZE 64 + +/* + * Window stacking literals + */ + +#define CK_ABOVE 0 +#define CK_BELOW 1 + +/* + * Window border structure. + */ + +typedef struct { + char *name; /* Name of border, malloc'ed. */ + int gchar[9]; /* ACS chars making up border. */ +} CkBorder; + +/* + * Enumerated type for describing a point by which to anchor something: + */ + +typedef enum { + CK_ANCHOR_N, CK_ANCHOR_NE, CK_ANCHOR_E, CK_ANCHOR_SE, + CK_ANCHOR_S, CK_ANCHOR_SW, CK_ANCHOR_W, CK_ANCHOR_NW, + CK_ANCHOR_CENTER +} Ck_Anchor; + +/* + * Enumerated type for describing a style of justification: + */ + +typedef enum { + CK_JUSTIFY_LEFT, CK_JUSTIFY_RIGHT, + CK_JUSTIFY_CENTER, CK_JUSTIFY_FILL +} Ck_Justify; + +/* + * Result values returned by Ck_GetScrollInfo: + */ + +#define CK_SCROLL_MOVETO 1 +#define CK_SCROLL_PAGES 2 +#define CK_SCROLL_UNITS 3 +#define CK_SCROLL_ERROR 4 + +/* + * Flags passed to CkMeasureChars/CkDisplayChars: + */ + +#define CK_WHOLE_WORDS 1 +#define CK_AT_LEAST_ONE 2 +#define CK_PARTIAL_OK 4 +#define CK_NEWLINES_NOT_SPECIAL 8 +#define CK_IGNORE_TABS 16 +#define CK_FILL_UNTIL_EOL 32 + +/* + * Priority levels to pass to Tk_AddOption: + */ + +#define CK_WIDGET_DEFAULT_PRIO 20 +#define CK_STARTUP_FILE_PRIO 40 +#define CK_USER_DEFAULT_PRIO 60 +#define CK_INTERACTIVE_PRIO 80 +#define CK_MAX_PRIO 100 + +/* + * 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. + */ + +typedef int (Ck_OptionParseProc) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, CkWindow *winPtr, char *value, char *widgRec, + int offset)); +typedef char *(Ck_OptionPrintProc) _ANSI_ARGS_((ClientData clientData, + CkWindow *winPtr, char *widgRec, int offset, + Tcl_FreeProc **freeProcPtr)); + +typedef struct Ck_CustomOption { + Ck_OptionParseProc *parseProc; /* Procedure to call to parse an + * option and store it in converted + * form. */ + Ck_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. */ +} Ck_CustomOption; + +/* + * Structure used to specify information for Ck_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 Ck_ConfigSpec { + int type; /* Type of option, such as CK_CONFIG_COLOR; + * see definitions below. Last option in + * table must have type CK_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 Ck_Offset macro to generate values + * for this. */ + int specFlags; /* Any combination of the values defined + * below; other bits are used internally + * by ckConfig.c. */ + Ck_CustomOption *customPtr; /* If type is CK_CONFIG_CUSTOM then this is + * a pointer to info about how to parse and + * print the option. Otherwise it is + * irrelevant. */ +} Ck_ConfigSpec; + +/* + * Type values for Ck_ConfigSpec structures. See the user + * documentation for details. + */ + +#define CK_CONFIG_BOOLEAN 1 +#define CK_CONFIG_INT 2 +#define CK_CONFIG_DOUBLE 3 +#define CK_CONFIG_STRING 4 +#define CK_CONFIG_UID 5 +#define CK_CONFIG_COLOR 6 +#define CK_CONFIG_BORDER 7 +#define CK_CONFIG_JUSTIFY 8 +#define CK_CONFIG_ANCHOR 9 +#define CK_CONFIG_SYNONYM 10 +#define CK_CONFIG_WINDOW 11 +#define CK_CONFIG_COORD 12 +#define CK_CONFIG_ATTR 13 +#define CK_CONFIG_CUSTOM 14 +#define CK_CONFIG_END 15 + +/* + * Macro to use to fill in "offset" fields of Ck_ConfigInfos. + * Computes number of bytes from beginning of structure to a + * given field. + */ + +#ifdef offsetof +#define Ck_Offset(type, field) ((int) offsetof(type, field)) +#else +#define Ck_Offset(type, field) ((int) ((char *) &((type *) 0)->field)) +#endif + +/* + * Possible values for flags argument to Ck_ConfigureWidget: + */ + +#define CK_CONFIG_ARGV_ONLY 1 + +/* + * Possible flag values for Ck_ConfigInfo structures. Any bits at + * or above CK_CONFIG_USER_BIT may be used by clients for selecting + * certain entries. Before changing any values here, coordinate with + * tkConfig.c (internal-use-only flags are defined there). + */ + +#define CK_CONFIG_COLOR_ONLY 1 +#define CK_CONFIG_MONO_ONLY 2 +#define CK_CONFIG_NULL_OK 4 +#define CK_CONFIG_DONT_SET_DEFAULT 8 +#define CK_CONFIG_OPTION_SPECIFIED 0x10 +#define CK_CONFIG_USER_BIT 0x100 + +extern Ck_Uid ckNormalUid; +extern Ck_Uid ckActiveUid; +extern Ck_Uid ckDisabledUid; + +/* + * Internal procedures. + */ + +#if defined(_WIN32) || defined(WIN32) +# ifdef BUILD_ck +# undef EXTERN +# define EXTERN __declspec(dllexport) +# endif +#endif + + +EXTERN int CkAllKeyNames _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int CkBarcodeCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN void CkBindEventProc _ANSI_ARGS_((CkWindow *winPtr, + CkEvent *eventPtr)); +EXTERN int CkCopyAndGlobalEval _ANSI_ARGS_((Tcl_Interp *interp, + char *string)); +EXTERN void CkDisplayChars _ANSI_ARGS_((CkMainInfo *mainPtr, + WINDOW *window, char *string, + int numChars, int x, int y, int tabOrigin, int flags)); +EXTERN void CkEventDeadWindow _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN void CkFreeBindingTags _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN char * CkGetBarcodeData _ANSI_ARGS_((CkMainInfo *mainPtr)); + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +EXTERN int CkHandleInput _ANSI_ARGS_((ClientData clientData, int mask, + int flags)); +#else +EXTERN void CkHandleInput _ANSI_ARGS_((ClientData clientData, int mask)); +#endif + +EXTERN int CkInitFrame _ANSI_ARGS_((Tcl_Interp *interp, CkWindow *winPtr, + int argc, char **argv)); +EXTERN char * CkKeysymToString _ANSI_ARGS_((KeySym keySym, int printControl)); +EXTERN int CkMeasureChars _ANSI_ARGS_((CkMainInfo *mainPtr, + char *source, int maxChars, + int startX, int maxX, int tabOrigin, int flags, + int *nextPtr, int *nextCPtr)); +EXTERN void CkOptionClassChanged _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN void CkOptionDeadWindow _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN KeySym CkStringToKeysym _ANSI_ARGS_((char *name)); +EXTERN int CkTermHasKey _ANSI_ARGS_((Tcl_Interp *interp, char *name)); +EXTERN void CkUnderlineChars _ANSI_ARGS_((CkMainInfo *mainPtr, + WINDOW *window, char *string, + int numChars, int x, int y, int tabOrigin, int flags, + int first, int last)); + +#if !((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)) + +/* + * Resource tracking from tkPreserve.c has moved to Tcl version 7.5: + */ + +#define Ck_EventuallyFree Tcl_EventuallyFree +#define Ck_Preserve Tcl_Preserve +#define Ck_Release Tcl_Release + +#endif + +/* + * Exported procedures. + */ + +EXTERN void Ck_AddOption _ANSI_ARGS_((CkWindow *winPtr, char *name, + char *value, int priority)); +EXTERN void Ck_BindEvent _ANSI_ARGS_((Ck_BindingTable bindingTable, + CkEvent *eventPtr, CkWindow *winPtr, int numObjects, + ClientData *objectPtr)); +EXTERN void Ck_ClearToBot _ANSI_ARGS_((CkWindow *winPtr, int x, int y)); +EXTERN void Ck_ClearToEol _ANSI_ARGS_((CkWindow *winPtr, int x, int y)); +EXTERN int Ck_ConfigureInfo _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, Ck_ConfigSpec *specs, char *widgRec, + char *argvName, int flags)); +EXTERN int Ck_ConfigureValue _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, Ck_ConfigSpec *specs, char *widgRec, + char *argvName, int flags)); +EXTERN int Ck_ConfigureWidget _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, Ck_ConfigSpec *specs, + int argc, char **argv, char *widgRec, int flags)); +EXTERN int Ck_CreateBinding _ANSI_ARGS_((Tcl_Interp *interp, + Ck_BindingTable bindingTable, ClientData object, + char *eventString, char *command, int append)); +EXTERN Ck_BindingTable Ck_CreateBindingTable _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN void Ck_CreateEventHandler _ANSI_ARGS_((CkWindow *winPtr, long mask, + Ck_EventProc *proc, ClientData clientData)); +EXTERN void Ck_CreateGenericHandler _ANSI_ARGS_((Ck_GenericProc *proc, + ClientData clientData)); +EXTERN CkWindow *Ck_CreateMainWindow _ANSI_ARGS_((Tcl_Interp *interp, + char *className)); +EXTERN CkWindow *Ck_CreateWindow _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *parentPtr, char *name, int toplevel)); +EXTERN CkWindow *Ck_CreateWindowFromPath _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *anywin, char *pathName, int toplevel)); +EXTERN void Ck_DeleteAllBindings _ANSI_ARGS_((Ck_BindingTable bindingTable, + ClientData object)); +EXTERN int Ck_DeleteBinding _ANSI_ARGS_((Tcl_Interp *interp, + Ck_BindingTable bindingTable, ClientData object, + char *eventString)); +EXTERN void Ck_DeleteBindingTable + _ANSI_ARGS_((Ck_BindingTable bindingTable)); +EXTERN void Ck_DeleteEventHandler _ANSI_ARGS_((CkWindow *winPtr, long mask, + Ck_EventProc *proc, ClientData clientData)); +EXTERN void Ck_DeleteGenericHandler _ANSI_ARGS_((Ck_GenericProc *proc, + ClientData clientData)); +EXTERN void Ck_DestroyWindow _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN void Ck_DrawBorder _ANSI_ARGS_((CkWindow *winPtr, + CkBorder *borderPtr, int x, int y, int width, int height)); +#if ((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)) +EXTERN void Ck_EventuallyFree _ANSI_ARGS_((ClientData clientData, + Ck_FreeProc *freeProc)); +#endif +EXTERN void Ck_EventuallyRefresh _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN void Ck_FreeBorder _ANSI_ARGS_((CkBorder *borderPtr)); +EXTERN void Ck_FreeOptions _ANSI_ARGS_((Ck_ConfigSpec *specs, + char *widgrec, int needFlags)); +EXTERN void Ck_GeometryRequest _ANSI_ARGS_((CkWindow *winPtr, + int reqWidth, int reqHeight)); +EXTERN void Ck_GetAllBindings _ANSI_ARGS_((Tcl_Interp *interp, + Ck_BindingTable bindingTable, ClientData object)); +EXTERN int Ck_GetAnchor _ANSI_ARGS_((Tcl_Interp *interp, char *string, + Ck_Anchor *anchorPtr)); +EXTERN int Ck_GetAttr _ANSI_ARGS_((Tcl_Interp *interp, char *name, + int *attrPtr)); +EXTERN char * Ck_GetBinding _ANSI_ARGS_((Tcl_Interp *inter, + Ck_BindingTable bindingTable, ClientData object, + char *eventString)); +EXTERN CkBorder *Ck_GetBorder _ANSI_ARGS_((Tcl_Interp *interp, + char *string)); +EXTERN int Ck_GetColor _ANSI_ARGS_((Tcl_Interp *interp, char *name, + int *colorPtr)); +EXTERN int Ck_GetCoord _ANSI_ARGS_((Tcl_Interp *interp, CkWindow *winPtr, + char *string, int *intPtr)); +EXTERN int Ck_GetEncoding _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int Ck_GetGChar _ANSI_ARGS_((Tcl_Interp *interp, char *name, + int *gchar)); +EXTERN int Ck_GetJustify _ANSI_ARGS_((Tcl_Interp *interp, char *string, + Ck_Justify *justifyPtr)); +EXTERN Ck_Uid Ck_GetOption _ANSI_ARGS_((CkWindow *winPtr, char *name, + char *class)); +EXTERN int Ck_GetPair _ANSI_ARGS_((CkWindow *winPtr, int fg, int bg)); +EXTERN void Ck_GetRootGeometry _ANSI_ARGS_((CkWindow *winPtr, int *xPtr, + int *yPtr, int *widthPtr, int *heightPtr)); +EXTERN int Ck_GetScrollInfo _ANSI_ARGS_((Tcl_Interp *interp, + int argc, char **argv, double *dblPtr, int *intPtr)); +EXTERN Ck_Uid Ck_GetUid _ANSI_ARGS_((char *string)); +EXTERN CkWindow *Ck_GetWindowXY _ANSI_ARGS_((CkMainInfo *mainPtr, int *xPtr, + int *yPtr, int mode)); +EXTERN void Ck_HandleEvent _ANSI_ARGS_((CkMainInfo *mainPtr, + CkEvent *eventPtr)); +EXTERN int Ck_Init _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN void Ck_Main _ANSI_ARGS_((int argc, char **argv, + int (*appInitProc)())); +EXTERN void Ck_MainLoop _ANSI_ARGS_((void)); +EXTERN CkWindow *Ck_MainWindow _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN void Ck_MaintainGeometry _ANSI_ARGS_((CkWindow *slave, + CkWindow *master, int x, int y, int width, + int height)); +EXTERN void Ck_MakeWindowExist _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN void Ck_ManageGeometry _ANSI_ARGS_((CkWindow *winPtr, + Ck_GeomMgr *mgrPtr, ClientData clientData)); +EXTERN void Ck_MapWindow _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN void Ck_MoveWindow _ANSI_ARGS_((CkWindow *winPtr, int x, int y)); +EXTERN char * Ck_NameOfAnchor _ANSI_ARGS_((Ck_Anchor anchor)); +EXTERN char * Ck_NameOfAttr _ANSI_ARGS_((int attr)); +EXTERN char * Ck_NameOfBorder _ANSI_ARGS_((CkBorder *borderPtr)); +EXTERN char * Ck_NameOfColor _ANSI_ARGS_((int color)); +EXTERN char * Ck_NameOfJustify _ANSI_ARGS_((Ck_Justify justify)); +EXTERN CkWindow *Ck_NameToWindow _ANSI_ARGS_((Tcl_Interp *interp, + char *pathName, CkWindow *winPtr)); +#if ((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)) +EXTERN void Ck_Preserve _ANSI_ARGS_((ClientData clientData)); +EXTERN void Ck_Release _ANSI_ARGS_((ClientData clientData)); +#endif +EXTERN void Ck_ResizeWindow _ANSI_ARGS_((CkWindow *winPtr, int width, + int height)); +EXTERN int Ck_RestackWindow _ANSI_ARGS_((CkWindow *winPtr, int aboveBelow, + CkWindow *otherPtr)); +EXTERN void Ck_SetClass _ANSI_ARGS_((CkWindow *winPtr, char *className)); +EXTERN int Ck_SetEncoding _ANSI_ARGS_((Tcl_Interp *interp, char *name)); +EXTERN void Ck_SetFocus _ANSI_ARGS_((CkWindow *winPtr)); +EXTERN int Ck_SetGChar _ANSI_ARGS_((Tcl_Interp *interp, char *name, + int gchar)); +EXTERN void Ck_SetHWCursor _ANSI_ARGS_((CkWindow *winPtr, int newState)); +EXTERN void Ck_SetInternalBorder _ANSI_ARGS_((CkWindow *winPtr, + int onoff)); +EXTERN void Ck_SetWindowAttr _ANSI_ARGS_((CkWindow *winPtr, int fg, + int bg, int attr)); +EXTERN void Ck_UnmaintainGeometry _ANSI_ARGS_((CkWindow *slave, + CkWindow *master)); +EXTERN void Ck_UnmapWindow _ANSI_ARGS_((CkWindow *winPtr)); + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +/* + * Event handling procedures. + */ + +EXTERN void Tk_BackgroundError _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN void Tk_CancelIdleCall _ANSI_ARGS_((Tk_IdleProc *proc, + ClientData clientData)); +EXTERN void Tk_CreateFileHandler _ANSI_ARGS_((int fd, int mask, + Tk_FileProc *proc, ClientData clientData)); +EXTERN void Tk_CreateFileHandler2 _ANSI_ARGS_((int fd, + Tk_FileProc2 *proc, ClientData clientData)); +EXTERN Tk_TimerToken Tk_CreateTimerHandler _ANSI_ARGS_((int milliseconds, + Tk_TimerProc *proc, ClientData clientData)); +EXTERN void Tk_DeleteFileHandler _ANSI_ARGS_((int fd)); +EXTERN void Tk_DeleteTimerHandler _ANSI_ARGS_((Tk_TimerToken token)); +EXTERN int Tk_DoOneEvent _ANSI_ARGS_((int flags)); +EXTERN void Tk_DoWhenIdle _ANSI_ARGS_((Tk_IdleProc *proc, + ClientData clientData)); +EXTERN void Tk_DoWhenIdle2 _ANSI_ARGS_((Tk_IdleProc *proc, + ClientData clientData)); +EXTERN void Tk_Sleep _ANSI_ARGS_((int ms)); + +#endif + +/* + * Command procedures. + */ + +EXTERN int Ck_BellCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_BindCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_BindtagsCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_CursesCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_DestroyCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_ExitCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_FocusCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_GridCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_LowerCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_OptionCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_PackCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_PlaceCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_RaiseCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_RecorderCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_TkwaitCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_UpdateCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_WinfoCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +EXTERN int Tk_AfterCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_FileeventCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +/* + * Widget creation procedures. + */ + +EXTERN int Ck_ButtonCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_EntryCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_FrameCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_ListboxCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_MenuCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_MenubuttonCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_MessageCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_ScrollbarCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_TextCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Ck_TreeCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +#endif /* RESOURCE_INCLUDED */ +#endif /* _CK_H */ diff --git a/ck.spec b/ck.spec new file mode 100644 index 0000000..2b23100 --- /dev/null +++ b/ck.spec @@ -0,0 +1,93 @@ +%define version 8.0 + +Name: ck +Version: %{version} +Release: 7 +Group: Programming/Interpreter +Summary: Tk-like Curses toolkit on top of Tcl +Copyright: BSD +Packager: +URL: http://www.ch-werner.de/ck +BuildRoot: /var/tmp/%{name}%{version} +Source: http://www.ch-werner.de/ck/ck%{version}.tar.gz +Requires: tcl >= %{version} + +%description +Ck is a (XPG4|n)curses widget set modelled after Tk designed to work +closely with the tcl scripting language. It allows you to write simple +programs with full featured console mode UIs. Tcl/Ck applications can +also be run on Windows platforms in console mode. + +%prep +%setup -n %{name}%{version} + +%build +./configure --prefix=/usr --disable-shared --enable-gcc --with-tcl=/usr/lib +ckversion=`. ckConfig.sh ; echo $CK_VERSION` +make CFLAGS="$RPM_OPT_FLAGS" libck${ckversion}.a +mv libck${ckversion}.a /tmp +make distclean +mv /tmp/libck${ckversion}.a . +./configure --prefix=/usr --enable-shared --enable-gcc --with-tcl=/usr/lib +make CFLAGS="$RPM_OPT_FLAGS" + +%install +rm -rf $RPM_BUILD_ROOT +mkdir -p $RPM_BUILD_ROOT/usr/bin +mkdir -p $RPM_BUILD_ROOT/usr/lib +mkdir -p $RPM_BUILD_ROOT/usr/man/man1 +mkdir -p $RPM_BUILD_ROOT/usr/man/mann +make INSTALL_ROOT=$RPM_BUILD_ROOT install install-man +cp -p ckConfig.sh $RPM_BUILD_ROOT/usr/lib +ckversion=`. ckConfig.sh ; echo $CK_VERSION` +ln -sf libck${ckversion}.so $RPM_BUILD_ROOT/usr/lib/libck.so +cp -p libck${ckversion}.a $RPM_BUILD_ROOT/usr/lib +ln -sf libck${ckversion}.a $RPM_BUILD_ROOT/usr/lib/libck.a +mv $RPM_BUILD_ROOT/usr/bin/cwsh $RPM_BUILD_ROOT/usr/bin/cwsh${ckversion} +ln -sf cwsh${ckversion} $RPM_BUILD_ROOT/usr/bin/cwsh +mkdir -p $RPM_BUILD_ROOT/usr/share/ck-${ckversion}/man +mv $RPM_BUILD_ROOT/usr/man/mann $RPM_BUILD_ROOT/usr/share/ck-${ckversion}/man +find $RPM_BUILD_ROOT/usr/share/ck-${ckversion}/man -type f -exec gzip {} \; +find $RPM_BUILD_ROOT/usr/man -type f -exec gzip {} \; + +%clean +rm -rf $RPM_BUILD_ROOT + +%post +/sbin/ldconfig + +%postun +/sbin/ldconfig + +%files +%defattr(-,root,root) +/usr/bin/* +/usr/lib/lib* +/usr/lib/ck* +/usr/man/man1/* +/usr/share/ck-* + +%changelog +* Sun Aug 26 2001 +- environment variables CK_USE_ENCODING and CK_USE_GPM for + controlling standard encoding (Tcl >= 8.1) and GPM usage, + various fixes for UTF-8 handling and Win32 code pages. + +* Tue May 15 2001 +- fixed initial screen flashing, added -noclear option in exit cmd + +* Thu Dec 07 2000 +- fixes for Tcl versions >= 8.1 (UTF8 handling) + +* Fri Nov 24 2000 +- fixed Tcl version handling in configure + +* Wed Sep 20 2000 +- rebuilt with ckEvent fixes + +* Sun Aug 27 2000 +- repackaged with new Ck distrib + +* Fri Aug 25 2000 +- created + diff --git a/ckAppInit.c b/ckAppInit.c new file mode 100644 index 0000000..229b911 --- /dev/null +++ b/ckAppInit.c @@ -0,0 +1,124 @@ +/* + * ckAppInit.c -- + * + * Provides a default version of the Tcl_AppInit procedure for + * use in curses wish. + * + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ck.h" + +/* + * The following variable is a special hack that is needed in order for + * Sun shared libraries to be used for Tcl. + */ + +#ifndef __WIN32__ +extern int matherr(); +int *tclDummyMathPtr = (int *) matherr; +#endif + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This is the main program for the application. + * + * Results: + * None: Ck_Main never returns here, so this procedure never + * returns either. + * + * Side effects: + * Whatever the application does. + * + *---------------------------------------------------------------------- + */ + +int +main(argc, argv) + int argc; /* Number of command-line arguments. */ + char **argv; /* Values of command-line arguments. */ +{ + Ck_Main(argc, argv, Tcl_AppInit); + return 0; /* Needed only to prevent compiler warning. */ +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in interp->result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_AppInit(interp) + Tcl_Interp *interp; /* Interpreter for application. */ +{ + if (Tcl_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + if (Ck_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + +#if !((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)) + Tcl_StaticPackage(interp, "Ck", Ck_Init, (Tcl_PackageInitProc *) NULL); +#endif + + /* + * Call the init procedures for included packages. Each call should + * look like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. + */ + + /* + * Call Tcl_CreateCommand for application-specific commands, if + * they weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application + * is run interactively. Typically the startup file is "~/.apprc" + * where "app" is the name of the application. If this line is deleted + * then no user-specific startup file will be run under any conditions. + */ +#ifndef CWSHRC +#ifdef DJGPP +# define CWSHRC "cwsh.rc" +#else +# define CWSHRC ".cwshrc" +#endif +#endif +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + tcl_RcFileName = "~/" CWSHRC; +#else + Tcl_SetVar(interp, "tcl_rcFileName", "~/" CWSHRC, TCL_GLOBAL_ONLY); +#endif + return TCL_OK; +} + diff --git a/ckBind.c b/ckBind.c new file mode 100644 index 0000000..8938cc8 --- /dev/null +++ b/ckBind.c @@ -0,0 +1,1646 @@ +/* + * ckBind.c -- + * + * This file provides procedures that associate Tcl commands + * with events or sequences of events. + * + * Copyright (c) 1989-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * The structure below represents a binding table. A binding table + * represents a domain in which event bindings may occur. It includes + * a space of objects relative to which events occur (usually windows, + * but not always), a history of recent events in the domain, and + * a set of mappings that associate particular Tcl commands with sequences + * of events in the domain. Multiple binding tables may exist at once, + * either because there are multiple applications open, or because there + * are multiple domains within an application with separate event + * bindings for each (for example, each canvas widget has a separate + * binding table for associating events with the items in the canvas). + * + * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much + * below 30. To see this, consider a triple mouse button click while + * the Shift key is down (and auto-repeating). There may be as many + * as 3 auto-repeat events after each mouse button press or release + * (see the first large comment block within Ck_BindEvent for more on + * this), for a total of 20 events to cover the three button presses + * and two intervening releases. If you reduce EVENT_BUFFER_SIZE too + * much, shift multi-clicks will be lost. + * + */ + +#define EVENT_BUFFER_SIZE 30 +typedef struct BindingTable { + CkEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events + * (higher indices are for more recent + * events). */ + int detailRing[EVENT_BUFFER_SIZE]; /* "Detail" information (keycodes for + * each entry in eventRing. */ + int curEvent; /* Index in eventRing of most recent + * event. Newer events have higher + * indices. */ + Tcl_HashTable patternTable; /* Used to map from an event to a list + * of patterns that may match that + * event. Keys are PatternTableKey + * structs, values are (PatSeq *). */ + Tcl_HashTable objectTable; /* Used to map from an object to a list + * of patterns associated with that + * object. Keys are ClientData, + * values are (PatSeq *). */ + Tcl_Interp *interp; /* Interpreter in which commands are + * executed. */ +} BindingTable; + +/* + * Structures of the following form are used as keys in the patternTable + * for a binding table: + */ + +typedef struct PatternTableKey { + ClientData object; /* Identifies object (or class of objects) + * relative to which event occurred. For + * example, in the widget binding table for + * an application this is the path name of + * a widget, or a widget class, or "all". */ + int type; /* Type of event. */ + int detail; /* Additional information, such as + * keycode, or 0 if nothing + * additional.*/ +} PatternTableKey; + +/* + * The following structure defines a pattern, which is matched + * against events as part of the process of converting events + * into Tcl commands. + */ + +typedef struct Pattern { + int eventType; /* Type of event. */ + int detail; /* Additional information that must + * match event. Normally this is 0, + * meaning no additional information + * must match. For keystrokes this + * is the keycode. Keycode 0 means + * any keystroke, keycode -1 means + * control keystroke. */ +} Pattern; + +/* + * The structure below defines a pattern sequence, which consists + * of one or more patterns. In order to trigger, a pattern + * sequence must match the most recent X events (first pattern + * to most recent event, next pattern to next event, and so on). + */ + +typedef struct PatSeq { + int numPats; /* Number of patterns in sequence + * (usually 1). */ + char *command; /* Command to invoke when this + * pattern sequence matches (malloc-ed). */ + struct PatSeq *nextSeqPtr; + /* Next in list of all pattern + * sequences that have the same + * initial pattern. NULL means + * end of list. */ + Tcl_HashEntry *hPtr; /* Pointer to hash table entry for + * the initial pattern. This is the + * head of the list of which nextSeqPtr + * forms a part. */ + ClientData object; /* Identifies object with which event is + * associated (e.g. window). */ + struct PatSeq *nextObjPtr; + /* Next in list of all pattern + * sequences for the same object + * (NULL for end of list). Needed to + * implement Tk_DeleteAllBindings. */ + Pattern pats[1]; /* Array of "numPats" patterns. Only + * one element is declared here but + * in actuality enough space will be + * allocated for "numPats" patterns. + * To match, pats[0] must match event + * n, pats[1] must match event n-1, + * etc. */ +} PatSeq; + +typedef struct { + char *name; /* Name of keysym. */ + KeySym value; /* Numeric identifier for keysym. */ + char *tiname; /* Terminfo name of keysym. */ +} KeySymInfo; +static KeySymInfo keyArray[] = { +#include "ks_names.h" + {(char *) NULL, 0} +}; +static Tcl_HashTable keySymTable; /* Hashed form of above structure. */ +static Tcl_HashTable revKeySymTable; /* Ditto, reversed. */ + +static int initialized = 0; + +/* + * This module also keeps a hash table mapping from event names + * to information about those events. The structure, an array + * to use to initialize the hash table, and the hash table are + * all defined below. + */ + +typedef struct { + char *name; /* Name of event. */ + int type; /* Event type for X, such as + * ButtonPress. */ + int eventMask; /* Mask bits for this event type. */ +} EventInfo; + +static EventInfo eventArray[] = { + {"Expose", CK_EV_EXPOSE, CK_EV_EXPOSE}, + {"FocusIn", CK_EV_FOCUSIN, CK_EV_FOCUSIN}, + {"FocusOut", CK_EV_FOCUSOUT, CK_EV_FOCUSOUT}, + {"Key", CK_EV_KEYPRESS, CK_EV_KEYPRESS}, + {"KeyPress", CK_EV_KEYPRESS, CK_EV_KEYPRESS}, + {"Control", CK_EV_KEYPRESS, CK_EV_KEYPRESS}, + {"Destroy", CK_EV_DESTROY, CK_EV_DESTROY}, + {"Map", CK_EV_MAP, CK_EV_MAP}, + {"Unmap", CK_EV_UNMAP, CK_EV_UNMAP}, + {"Button", CK_EV_MOUSE_DOWN, CK_EV_MOUSE_DOWN}, + {"ButtonPress", CK_EV_MOUSE_DOWN, CK_EV_MOUSE_DOWN}, + {"ButtonRelease", CK_EV_MOUSE_UP, CK_EV_MOUSE_UP}, + {"BarCode", CK_EV_BARCODE, CK_EV_BARCODE}, + {(char *) NULL, 0, 0} +}; +static Tcl_HashTable eventTable; + +/* + * Prototypes for local procedures defined in this file: + */ + +static void ExpandPercents _ANSI_ARGS_((CkWindow *winPtr, + char *before, CkEvent *eventPtr, KeySym keySym, + Tcl_DString *dsPtr)); +static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp, + BindingTable *bindPtr, ClientData object, + char *eventString, int create)); +static char * GetField _ANSI_ARGS_((char *p, char *copy, int size)); +static PatSeq * MatchPatterns _ANSI_ARGS_((BindingTable *bindPtr, + PatSeq *psPtr)); + +/* + *-------------------------------------------------------------- + * + * Ck_CreateBindingTable -- + * + * Set up a new domain in which event bindings may be created. + * + * Results: + * The return value is a token for the new table, which must + * be passed to procedures like Ck_CreateBinding. + * + * Side effects: + * Memory is allocated for the new table. + * + *-------------------------------------------------------------- + */ + +Ck_BindingTable +Ck_CreateBindingTable(interp) + Tcl_Interp *interp; /* Interpreter to associate with the binding + * table: commands are executed in this + * interpreter. */ +{ + BindingTable *bindPtr; + int i; + + /* + * If this is the first time a binding table has been created, + * initialize the global data structures. + */ + + if (!initialized) { + Tcl_HashEntry *hPtr; + EventInfo *eiPtr; + KeySymInfo *kPtr; + int dummy; + + Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&revKeySymTable, TCL_ONE_WORD_KEYS); + for (kPtr = keyArray; kPtr->name != NULL; kPtr++) { + hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy); + Tcl_SetHashValue(hPtr, (char *) kPtr); + hPtr = Tcl_CreateHashEntry(&revKeySymTable, (char *) kPtr->value, + &dummy); + Tcl_SetHashValue(hPtr, (char *) kPtr); + } + Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS); + for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { + hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy); + Tcl_SetHashValue(hPtr, eiPtr); + } + initialized = 1; + } + + /* + * Create and initialize a new binding table. + */ + + bindPtr = (BindingTable *) ckalloc(sizeof (BindingTable)); + for (i = 0; i < EVENT_BUFFER_SIZE; i++) { + bindPtr->eventRing[i].type = -1; + } + bindPtr->curEvent = 0; + Tcl_InitHashTable(&bindPtr->patternTable, + sizeof(PatternTableKey)/sizeof(int)); + Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS); + bindPtr->interp = interp; + return (Ck_BindingTable) bindPtr; +} + +/* + *-------------------------------------------------------------- + * + * Ck_DeleteBindingTable -- + * + * Destroy a binding table and free up all its memory. + * The caller should not use bindingTable again after + * this procedure returns. + * + * Results: + * None. + * + * Side effects: + * Memory is freed. + * + *-------------------------------------------------------------- + */ + +void +Ck_DeleteBindingTable(bindingTable) + Ck_BindingTable bindingTable; /* Token for the binding table to + * destroy. */ +{ + BindingTable *bindPtr = (BindingTable *) bindingTable; + PatSeq *psPtr, *nextPtr; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + + /* + * Find and delete all of the patterns associated with the binding + * table. + */ + + for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + psPtr != NULL; psPtr = nextPtr) { + nextPtr = psPtr->nextSeqPtr; + ckfree((char *) psPtr->command); + ckfree((char *) psPtr); + } + } + + /* + * Clean up the rest of the information associated with the + * binding table. + */ + + Tcl_DeleteHashTable(&bindPtr->patternTable); + Tcl_DeleteHashTable(&bindPtr->objectTable); + ckfree((char *) bindPtr); +} + +/* + *-------------------------------------------------------------- + * + * Ck_CreateBinding -- + * + * Add a binding to a binding table, so that future calls to + * Ck_BindEvent may execute the command in the binding. + * + * Results: + * The return value is TCL_ERROR if an error occurred while setting + * up the binding. In this case, an error message will be + * left in interp->result. If all went well then the return + * value is TCL_OK. + * + * Side effects: + * The new binding may cause future calls to Ck_BindEvent to + * behave differently than they did previously. + * + *-------------------------------------------------------------- + */ + +int +Ck_CreateBinding(interp, bindingTable, object, eventString, command, append) + Tcl_Interp *interp; /* Used for error reporting. */ + Ck_BindingTable bindingTable; /* Table in which to create binding. */ + ClientData object; /* Token for object with which binding + * is associated. */ + char *eventString; /* String describing event sequence + * that triggers binding. */ + char *command; /* Contains Tcl command to execute + * when binding triggers. */ + int append; /* 0 means replace any existing + * binding for eventString; 1 means + * append to that binding. */ +{ + BindingTable *bindPtr = (BindingTable *) bindingTable; + PatSeq *psPtr; + + psPtr = FindSequence(interp, bindPtr, object, eventString, 1); + if (psPtr == NULL) + return TCL_ERROR; + if (append && (psPtr->command != NULL)) { + int length; + char *new; + + length = strlen(psPtr->command) + strlen(command) + 2; + new = (char *) ckalloc((unsigned) length); + sprintf(new, "%s\n%s", psPtr->command, command); + ckfree((char *) psPtr->command); + psPtr->command = new; + } else { + if (psPtr->command != NULL) { + ckfree((char *) psPtr->command); + } + psPtr->command = (char *) ckalloc((unsigned) (strlen(command) + 1)); + strcpy(psPtr->command, command); + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Ck_DeleteBinding -- + * + * Remove an event binding from a binding table. + * + * Results: + * The result is a standard Tcl return value. If an error + * occurs then interp->result will contain an error message. + * + * Side effects: + * The binding given by object and eventString is removed + * from bindingTable. + * + *-------------------------------------------------------------- + */ + +int +Ck_DeleteBinding(interp, bindingTable, object, eventString) + Tcl_Interp *interp; /* Used for error reporting. */ + Ck_BindingTable bindingTable; /* Table in which to delete binding. */ + ClientData object; /* Token for object with which binding + * is associated. */ + char *eventString; /* String describing event sequence + * that triggers binding. */ +{ + BindingTable *bindPtr = (BindingTable *) bindingTable; + register PatSeq *psPtr, *prevPtr; + Tcl_HashEntry *hPtr; + + psPtr = FindSequence(interp, bindPtr, object, eventString, 0); + if (psPtr == NULL) { + Tcl_ResetResult(interp); + return TCL_OK; + } + + /* + * Unlink the binding from the list for its object, then from the + * list for its pattern. + */ + + hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); + if (hPtr == NULL) { + panic("Ck_DeleteBinding couldn't find object table entry"); + } + prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + if (prevPtr == psPtr) { + Tcl_SetHashValue(hPtr, psPtr->nextObjPtr); + } else { + for ( ; ; prevPtr = prevPtr->nextObjPtr) { + if (prevPtr == NULL) { + panic("Ck_DeleteBinding couldn't find on object list"); + } + if (prevPtr->nextObjPtr == psPtr) { + prevPtr->nextObjPtr = psPtr->nextObjPtr; + break; + } + } + } + prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr); + if (prevPtr == psPtr) { + if (psPtr->nextSeqPtr == NULL) { + Tcl_DeleteHashEntry(psPtr->hPtr); + } else { + Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr); + } + } else { + for ( ; ; prevPtr = prevPtr->nextSeqPtr) { + if (prevPtr == NULL) { + panic("Tk_DeleteBinding couldn't find on hash chain"); + } + if (prevPtr->nextSeqPtr == psPtr) { + prevPtr->nextSeqPtr = psPtr->nextSeqPtr; + break; + } + } + } + ckfree((char *) psPtr->command); + ckfree((char *) psPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Ck_GetBinding -- + * + * Return the command associated with a given event string. + * + * Results: + * The return value is a pointer to the command string + * associated with eventString for object in the domain + * given by bindingTable. If there is no binding for + * eventString, or if eventString is improperly formed, + * then NULL is returned and an error message is left in + * interp->result. The return value is semi-static: it + * will persist until the binding is changed or deleted. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +char * +Ck_GetBinding(interp, bindingTable, object, eventString) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Ck_BindingTable bindingTable; /* Table in which to look for + * binding. */ + ClientData object; /* Token for object with which binding + * is associated. */ + char *eventString; /* String describing event sequence + * that triggers binding. */ +{ + BindingTable *bindPtr = (BindingTable *) bindingTable; + PatSeq *psPtr; + + psPtr = FindSequence(interp, bindPtr, object, eventString, 0); + if (psPtr == NULL) { + return NULL; + } + return psPtr->command; +} + +/* + *-------------------------------------------------------------- + * + * Ck_GetAllBindings -- + * + * Return a list of event strings for all the bindings + * associated with a given object. + * + * Results: + * There is no return value. Interp->result is modified to + * hold a Tcl list with one entry for each binding associated + * with object in bindingTable. Each entry in the list + * contains the event string associated with one binding. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +Ck_GetAllBindings(interp, bindingTable, object) + Tcl_Interp *interp; /* Interpreter returning result or + * error. */ + Ck_BindingTable bindingTable; /* Table in which to look for + * bindings. */ + ClientData object; /* Token for object. */ + +{ + BindingTable *bindPtr = (BindingTable *) bindingTable; + register PatSeq *psPtr; + register Pattern *patPtr; + Tcl_HashEntry *hPtr; + Tcl_DString ds; + char c, buffer[10]; + int patsLeft; + register EventInfo *eiPtr; + + hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); + if (hPtr == NULL) { + return; + } + Tcl_DStringInit(&ds); + for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; + psPtr = psPtr->nextObjPtr) { + Tcl_DStringTrunc(&ds, 0); + + /* + * For each binding, output information about each of the + * patterns in its sequence. The order of the patterns in + * the sequence is backwards from the order in which they + * must be output. + */ + + for (patsLeft = psPtr->numPats, + patPtr = &psPtr->pats[psPtr->numPats - 1]; + patsLeft > 0; patsLeft--, patPtr--) { + + /* + * Check for button presses. + */ + + if ((patPtr->eventType == CK_EV_MOUSE_DOWN) + && (patPtr->detail != 0)) { + sprintf(buffer, "<%d>", patPtr->detail); + Tcl_DStringAppend(&ds, buffer, -1); + continue; + } + + /* + * Check for simple case of an ASCII character. + */ + + if ((patPtr->eventType == CK_EV_KEYPRESS) + && (patPtr->detail < 128) + && isprint((unsigned char) patPtr->detail) + && (patPtr->detail != '<') + && (patPtr->detail != ' ')) { + c = patPtr->detail; + Tcl_DStringAppend(&ds, &c, 1); + continue; + } + + /* + * It's a more general event specification. First check + * event type, then keysym or button detail. + */ + + Tcl_DStringAppend(&ds, "<", 1); + + for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { + if (eiPtr->type == patPtr->eventType) { + if (patPtr->eventType == CK_EV_KEYPRESS && + patPtr->detail == -1) { + Tcl_DStringAppend(&ds, "Control", -1); + goto endPat; + } + if (patPtr->eventType == CK_EV_KEYPRESS && + patPtr->detail > 0 && patPtr->detail < 0x20) { + char *string; + + string = CkKeysymToString((KeySym) patPtr->detail, 0); + if (string == NULL) { + sprintf(buffer, "Control-%c", + patPtr->detail + 0x40); + string = buffer; + } + Tcl_DStringAppend(&ds, string, -1); + goto endPat; + } + Tcl_DStringAppend(&ds, eiPtr->name, -1); + if (patPtr->detail != 0) { + Tcl_DStringAppend(&ds, "-", 1); + } + break; + } + } + + if (patPtr->detail != 0) { + if (patPtr->eventType == CK_EV_KEYPRESS) { + char *string; + + string = CkKeysymToString((KeySym) patPtr->detail, 0); + if (string != NULL) { + Tcl_DStringAppend(&ds, string, -1); + } + } else { + sprintf(buffer, "%d", patPtr->detail); + Tcl_DStringAppend(&ds, buffer, -1); + } + } +endPat: + Tcl_DStringAppend(&ds, ">", 1); + } + Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + } + Tcl_DStringFree(&ds); +} + +/* + *-------------------------------------------------------------- + * + * Ck_DeleteAllBindings -- + * + * Remove all bindings associated with a given object in a + * given binding table. + * + * Results: + * All bindings associated with object are removed from + * bindingTable. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +Ck_DeleteAllBindings(bindingTable, object) + Ck_BindingTable bindingTable; /* Table in which to delete + * bindings. */ + ClientData object; /* Token for object. */ +{ + BindingTable *bindPtr = (BindingTable *) bindingTable; + PatSeq *psPtr, *prevPtr; + PatSeq *nextPtr; + Tcl_HashEntry *hPtr; + + hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); + if (hPtr == NULL) { + return; + } + for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; + psPtr = nextPtr) { + nextPtr = psPtr->nextObjPtr; + + /* + * Be sure to remove each binding from its hash chain in the + * pattern table. If this is the last pattern in the chain, + * then delete the hash entry too. + */ + + prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr); + if (prevPtr == psPtr) { + if (psPtr->nextSeqPtr == NULL) { + Tcl_DeleteHashEntry(psPtr->hPtr); + } else { + Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr); + } + } else { + for ( ; ; prevPtr = prevPtr->nextSeqPtr) { + if (prevPtr == NULL) { + panic("Ck_DeleteAllBindings couldn't find on hash chain"); + } + if (prevPtr->nextSeqPtr == psPtr) { + prevPtr->nextSeqPtr = psPtr->nextSeqPtr; + break; + } + } + } + ckfree((char *) psPtr->command); + ckfree((char *) psPtr); + } + Tcl_DeleteHashEntry(hPtr); +} + +/* + *-------------------------------------------------------------- + * + * Ck_BindEvent -- + * + * This procedure is invoked to process an event. The + * event is added to those recorded for the binding table. + * Then each of the objects at *objectPtr is checked in + * order to see if it has a binding that matches the recent + * events. If so, that binding is invoked and the rest of + * objects are skipped. + * + * Results: + * None. + * + * Side effects: + * Depends on the command associated with the matching + * binding. + * + *-------------------------------------------------------------- + */ + +void +Ck_BindEvent(bindingTable, eventPtr, winPtr, numObjects, objectPtr) + Ck_BindingTable bindingTable; /* Table in which to look for + * bindings. */ + CkEvent *eventPtr; /* What actually happened. */ + CkWindow *winPtr; /* Window where event occurred. */ + int numObjects; /* Number of objects at *objectPtr. */ + ClientData *objectPtr; /* Array of one or more objects + * to check for a matching binding. */ +{ + BindingTable *bindPtr = (BindingTable *) bindingTable; + CkMainInfo *mainPtr; + CkEvent *ringPtr; + PatSeq *matchPtr; + PatternTableKey key; + Tcl_HashEntry *hPtr; + int detail, code; + Tcl_Interp *interp; + Tcl_DString scripts, savedResult; + char *p, *end; + + /* + * Add the new event to the ring of saved events for the + * binding table. + */ + + bindPtr->curEvent++; + if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) + bindPtr->curEvent = 0; + ringPtr = &bindPtr->eventRing[bindPtr->curEvent]; + memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof (CkEvent)); + detail = 0; + bindPtr->detailRing[bindPtr->curEvent] = 0; + if (ringPtr->type == CK_EV_KEYPRESS) + detail = ringPtr->key.keycode; + else if (ringPtr->type == CK_EV_MOUSE_DOWN || + ringPtr->type == CK_EV_MOUSE_UP) + detail = ringPtr->mouse.button; + bindPtr->detailRing[bindPtr->curEvent] = detail; + + /* + * Loop over all the objects, finding the binding script for each + * one. Append all of the binding scripts, with %-sequences expanded, + * to "scripts", with null characters separating the scripts for + * each object. + */ + + Tcl_DStringInit(&scripts); + for ( ; numObjects > 0; numObjects--, objectPtr++) { + + /* + * Match the new event against those recorded in the + * pattern table, saving the longest matching pattern. + * For events with details (key events) first + * look for a binding for the specific key or button. + * If none is found, then look for a binding for all + * control-keys (detail of -1, if the keycode is a control + * character), else look for a binding for all keys + * (detail of 0). + */ + + matchPtr = NULL; + key.object = *objectPtr; + key.type = ringPtr->type; + key.detail = detail; + hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); + if (hPtr != NULL) { + matchPtr = MatchPatterns(bindPtr, + (PatSeq *) Tcl_GetHashValue(hPtr)); + } + if (ringPtr->type == CK_EV_KEYPRESS && detail > 0 && detail < 0x20 && + matchPtr == NULL) { + key.detail = -1; + hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); + if (hPtr != NULL) { + matchPtr = MatchPatterns(bindPtr, + (PatSeq *) Tcl_GetHashValue(hPtr)); + } + } + if (detail != 0 && matchPtr == NULL) { + key.detail = 0; + hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); + if (hPtr != NULL) { + matchPtr = MatchPatterns(bindPtr, + (PatSeq *) Tcl_GetHashValue(hPtr)); + } + } + + if (matchPtr != NULL) { + ExpandPercents(winPtr, matchPtr->command, eventPtr, + (KeySym) detail, &scripts); + Tcl_DStringAppend(&scripts, "", 1); + } + } + + /* + * Now go back through and evaluate the script for each object, + * in order, dealing with "break" and "continue" exceptions + * appropriately. + * + * There are two tricks here: + * 1. Bindings can be invoked from in the middle of Tcl commands, + * where interp->result is significant (for example, a widget + * might be deleted because of an error in creating it, so the + * result contains an error message that is eventually going to + * be returned by the creating command). To preserve the result, + * we save it in a dynamic string. + * 2. The binding's action can potentially delete the binding, + * so bindPtr may not point to anything valid once the action + * completes. Thus we have to save bindPtr->interp in a + * local variable in order to restore the result. + * 3. When the screen changes, must invoke a Tcl script to update + * Tcl level information such as tkPriv. + */ + + mainPtr = winPtr->mainPtr; + interp = bindPtr->interp; + Tcl_DStringInit(&savedResult); + Tcl_DStringGetResult(interp, &savedResult); + p = Tcl_DStringValue(&scripts); + end = p + Tcl_DStringLength(&scripts); + while (p != end) { + Tcl_AllowExceptions(interp); + code = Tcl_GlobalEval(interp, p); + if (code != TCL_OK) { + if (code == TCL_CONTINUE) { + /* + * Do nothing: just go on to the next script. + */ + } else if (code == TCL_BREAK) { + break; + } else { + Tcl_AddErrorInfo(interp, "\n (command bound to event)"); + Tk_BackgroundError(interp); + break; + } + } + + /* + * Skip over the current script and its terminating null character. + */ + + while (*p != 0) { + p++; + } + p++; + } + Tcl_DStringResult(interp, &savedResult); + Tcl_DStringFree(&scripts); +} + +/* + *---------------------------------------------------------------------- + * + * FindSequence -- + * + * Find the entry in a binding table that corresponds to a + * particular pattern string, and return a pointer to that + * entry. + * + * Results: + * The return value is normally a pointer to the PatSeq + * in patternTable that corresponds to eventString. If an error + * was found while parsing eventString, or if "create" is 0 and + * no pattern sequence previously existed, then NULL is returned + * and interp->result contains a message describing the problem. + * If no pattern sequence previously existed for eventString, then + * a new one is created with a NULL command field. In a successful + * return, *maskPtr is filled in with a mask of the event types + * on which the pattern sequence depends. + * + * Side effects: + * A new pattern sequence may be created. + * + *---------------------------------------------------------------------- + */ + +static PatSeq * +FindSequence(interp, bindPtr, object, eventString, create) + Tcl_Interp *interp; /* Interpreter to use for error + * reporting. */ + BindingTable *bindPtr; /* Table to use for lookup. */ + ClientData object; /* Token for object(s) with which binding + * is associated. */ + char *eventString; /* String description of pattern to + * match on. See user documentation + * for details. */ + int create; /* 0 means don't create the entry if + * it doesn't already exist. Non-zero + * means create. */ + +{ + Pattern pats[EVENT_BUFFER_SIZE]; + int numPats, isCtrl; + register char *p; + register Pattern *patPtr; + register PatSeq *psPtr; + register Tcl_HashEntry *hPtr; +#define FIELD_SIZE 48 + char field[FIELD_SIZE]; + int new; + size_t sequenceSize; + unsigned long eventMask; + PatternTableKey key; + + /* + *------------------------------------------------------------- + * Step 1: parse the pattern string to produce an array + * of Patterns. The array is generated backwards, so + * that the lowest-indexed pattern corresponds to the last + * event that must occur. + *------------------------------------------------------------- + */ + + p = eventString; + eventMask = 0; + for (numPats = 0, patPtr = &pats[EVENT_BUFFER_SIZE-1]; + numPats < EVENT_BUFFER_SIZE; + numPats++, patPtr--) { + patPtr->eventType = -1; + patPtr->detail = 0; + while (isspace((unsigned char) *p)) { + p++; + } + if (*p == '\0') { + break; + } + + /* + * Handle simple ASCII characters. + */ + + if (*p != '<') { + char string[2]; + + patPtr->eventType = CK_EV_KEYPRESS; + string[0] = *p; + string[1] = 0; + patPtr->detail = CkStringToKeysym(string); + if (patPtr->detail == NoSymbol) { + if (isprint((unsigned char) *p)) { + patPtr->detail = *p; + } else { + sprintf(interp->result, + "bad ASCII character 0x%x", (unsigned char) *p); + return NULL; + } + } + p++; + continue; + } + + p++; + + /* + * Abbrevated button press event. + */ + + if (isdigit((unsigned char) *p) && p[1] == '>') { + register EventInfo *eiPtr; + + hPtr = Tcl_FindHashEntry(&eventTable, "ButtonPress"); + eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr); + patPtr->eventType = eiPtr->type; + eventMask |= eiPtr->eventMask; + patPtr->detail = *p - '0'; + p += 2; + continue; + } + + /* + * A fancier event description. Must consist of + * 1. open angle bracket. + * 2. optional event name. + * 3. an option keysym name. Either this or + * item 2 *must* be present; if both are present + * then they are separated by spaces or dashes. + * 4. a close angle bracket. + */ + + isCtrl = 0; + p = GetField(p, field, FIELD_SIZE); + hPtr = Tcl_FindHashEntry(&eventTable, field); + if (hPtr != NULL) { + register EventInfo *eiPtr; + + eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr); + patPtr->eventType = eiPtr->type; + eventMask |= eiPtr->eventMask; + isCtrl = strcmp(eiPtr->name, "Control") == 0; + if (isCtrl) { + patPtr->detail = -1; + } + while ((*p == '-') || isspace((unsigned char) *p)) { + p++; + } + p = GetField(p, field, FIELD_SIZE); + } + if (*field != '\0') { + if (patPtr->eventType == CK_EV_MOUSE_DOWN || + patPtr->eventType == CK_EV_MOUSE_UP) { + if (!isdigit((unsigned char) *field) && field[1] != '\0') { + Tcl_AppendResult(interp, "bad mouse button \"", + field, "\"", (char *) NULL); + return NULL; + } + patPtr->detail = field[0] - '0'; + goto closeAngle; + } + + patPtr->detail = CkStringToKeysym(field); + if (patPtr->detail == NoSymbol) { +badKeySym: + Tcl_AppendResult(interp, "bad event type or keysym \"", + field, "\"", (char *) NULL); + return NULL; + } else if (patPtr->eventType == CK_EV_KEYPRESS && isCtrl) { + patPtr->detail -= 0x40; + if (patPtr->detail >= 0x20) + patPtr->detail -= 0x20; + if (patPtr->detail < 0 || patPtr->detail >= 0x20) + goto badKeySym; + } + if (patPtr->eventType == -1) { + patPtr->eventType = CK_EV_KEYPRESS; + } else if (patPtr->eventType != CK_EV_KEYPRESS) { + Tcl_AppendResult(interp, "specified keysym \"", field, + "\" for non-key event", (char *) NULL); + return NULL; + } + } else if (patPtr->eventType == -1) { + interp->result = "no event type or keysym"; + return NULL; + } + while ((*p == '-') || isspace((unsigned char) *p)) { + p++; + } +closeAngle: + if (*p != '>') { + interp->result = "missing \">\" in binding"; + return NULL; + } + p++; + + } + + /* + *------------------------------------------------------------- + * Step 2: find the sequence in the binding table if it exists, + * and add a new sequence to the table if it doesn't. + *------------------------------------------------------------- + */ + + if (numPats == 0) { + interp->result = "no events specified in binding"; + return NULL; + } + patPtr = &pats[EVENT_BUFFER_SIZE-numPats]; + key.object = object; + key.type = patPtr->eventType; + key.detail = patPtr->detail; + hPtr = Tcl_CreateHashEntry(&bindPtr->patternTable, (char *) &key, &new); + sequenceSize = numPats*sizeof(Pattern); + if (!new) { + for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; + psPtr = psPtr->nextSeqPtr) { + if ((numPats == psPtr->numPats) + && (memcmp((char *) patPtr, (char *) psPtr->pats, + sequenceSize) == 0)) { + goto done; + } + } + } + if (!create) { + if (new) { + Tcl_DeleteHashEntry(hPtr); + } + Tcl_AppendResult(interp, "no binding exists for \"", + eventString, "\"", (char *) NULL); + return NULL; + } + psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq) + + (numPats-1)*sizeof(Pattern))); + psPtr->numPats = numPats; + psPtr->command = NULL; + psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + psPtr->hPtr = hPtr; + Tcl_SetHashValue(hPtr, psPtr); + + /* + * Link the pattern into the list associated with the object. + */ + + psPtr->object = object; + hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object, &new); + if (new) { + psPtr->nextObjPtr = NULL; + } else { + psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + } + Tcl_SetHashValue(hPtr, psPtr); + + memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize); + +done: + return psPtr; +} + +/* + *---------------------------------------------------------------------- + * + * GetField -- + * + * Used to parse pattern descriptions. Copies up to + * size characters from p to copy, stopping at end of + * string, space, "-", ">", or whenever size is + * exceeded. + * + * Results: + * The return value is a pointer to the character just + * after the last one copied (usually "-" or space or + * ">", but could be anything if size was exceeded). + * Also places NULL-terminated string (up to size + * character, including NULL), at copy. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static char * +GetField(p, copy, size) + register char *p; /* Pointer to part of pattern. */ + register char *copy; /* Place to copy field. */ + int size; /* Maximum number of characters to + * copy. */ +{ + while ((*p != '\0') && !isspace((unsigned char) *p) && (*p != '>') + && (*p != '-') && (size > 1)) { + *copy = *p; + p++; + copy++; + size--; + } + *copy = '\0'; + return p; +} + +/* + *---------------------------------------------------------------------- + * + * MatchPatterns -- + * + * Given a list of pattern sequences and a list of + * recent events, return a pattern sequence that matches + * the event list. + * + * Results: + * The return value is NULL if no pattern matches the + * recent events from bindPtr. If one or more patterns + * matches, then the longest (or most specific) matching + * pattern is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static PatSeq * +MatchPatterns(bindPtr, psPtr) + BindingTable *bindPtr; /* Information about binding table, such + * as ring of recent events. */ + register PatSeq *psPtr; /* List of pattern sequences. */ +{ + register PatSeq *bestPtr = NULL; + + /* + * Iterate over all the pattern sequences. + */ + + for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) { + register CkEvent *eventPtr; + register Pattern *patPtr; + CkWindow *winPtr; + int *detailPtr; + int patCount, ringCount; + + /* + * Iterate over all the patterns in a sequence to be + * sure that they all match. + */ + + eventPtr = &bindPtr->eventRing[bindPtr->curEvent]; + detailPtr = &bindPtr->detailRing[bindPtr->curEvent]; + winPtr = eventPtr->any.winPtr; + patPtr = psPtr->pats; + patCount = psPtr->numPats; + ringCount = EVENT_BUFFER_SIZE; + while (patCount > 0) { + if (ringCount <= 0) { + goto nextSequence; + } + if (eventPtr->any.type != patPtr->eventType) { + if (patPtr->eventType == CK_EV_KEYPRESS) + goto nextEvent; + } + if (eventPtr->any.winPtr != winPtr) + goto nextSequence; + + /* + * Note: it's important for the keysym check to go before + * the modifier check, so we can ignore unwanted modifier + * keys before choking on the modifier check. + */ + + if ((patPtr->detail != 0) && (patPtr->detail != -1) + && (patPtr->detail != *detailPtr)) + goto nextSequence; + + if ((patPtr->detail == -1) && (*detailPtr >= 0x20)) + goto nextSequence; + + patPtr++; + patCount--; + nextEvent: + if (eventPtr == bindPtr->eventRing) { + eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1]; + detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1]; + } else { + eventPtr--; + detailPtr--; + } + ringCount--; + } + + /* + * This sequence matches. If we've already got another match, + * pick whichever is most specific. + */ + + if (bestPtr != NULL) { + register Pattern *patPtr2; + int i; + + if (psPtr->numPats != bestPtr->numPats) { + if (bestPtr->numPats > psPtr->numPats) { + goto nextSequence; + } else { + goto newBest; + } + } + for (i = 0, patPtr = psPtr->pats, patPtr2 = bestPtr->pats; + i < psPtr->numPats; i++, patPtr++, patPtr2++) { + if (patPtr->detail != patPtr2->detail) { + if (patPtr->detail == -1 && patPtr2->detail == 0) { + goto newBest; + } else if (patPtr->detail == 0 || patPtr->detail == -1) { + goto nextSequence; + } else { + goto newBest; + } + } + } + goto nextSequence; /* Tie goes to newest pattern. */ + } + newBest: + bestPtr = psPtr; + + nextSequence: continue; + } + return bestPtr; +} + +/* + *-------------------------------------------------------------- + * + * ExpandPercents -- + * + * Given a command and an event, produce a new command + * by replacing % constructs in the original command + * with information from the X event. + * + * Results: + * The new expanded command is appended to the dynamic string + * given by dsPtr. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) + CkWindow *winPtr; /* Window where event occurred: needed to + * get input context. */ + register char *before; /* Command containing percent + * expressions to be replaced. */ + register CkEvent *eventPtr; /* Event containing information + * to be used in % replacements. */ + KeySym keySym; /* KeySym: only relevant for + * CK_EV_KEYPRESS events). */ + Tcl_DString *dsPtr; /* Dynamic string in which to append + * new command. */ +{ + int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl + * list element. */ + int number; +#define NUM_SIZE 40 + char *string, *string2; + char numStorage[NUM_SIZE+1]; + + while (1) { + /* + * Find everything up to the next % character and append it + * to the result string. + */ + + for (string = before; (*string != 0) && (*string != '%'); string++) { + /* Empty loop body. */ + } + if (string != before) { + Tcl_DStringAppend(dsPtr, before, string-before); + before = string; + } + if (*before == 0) { + break; + } + + /* + * There's a percent sequence here. Process it. + */ + + number = 0; + string = "??"; + switch (before[1]) { + case 'k': + number = eventPtr->key.keycode; + goto doNumber; + case 'A': + if (eventPtr->type == CK_EV_KEYPRESS) { + int numChars = 0; + + if ((eventPtr->key.keycode & ~0xff) == 0 && + eventPtr->key.keycode != 0) { +#if CK_USE_UTF + char c = eventPtr->key.keycode; + int numc = 0; + + Tcl_ExternalToUtf(NULL, winPtr->mainPtr->isoEncoding, + &c, 1, 0, NULL, + numStorage + numChars, + sizeof (numStorage) - numChars, + NULL, &numc, NULL); + numChars += numc; +#else + numStorage[numChars++] = eventPtr->key.keycode; +#endif + } + numStorage[numChars] = '\0'; + string = numStorage; + } else if (eventPtr->type == CK_EV_BARCODE) { + string = CkGetBarcodeData(winPtr->mainPtr); + if (string == NULL) { + numStorage[0] = '\0'; + string = numStorage; + } + } + goto doString; + case 'K': + if (eventPtr->type == CK_EV_KEYPRESS) { + char *name; + + name = CkKeysymToString(keySym, 1); + if (name != NULL) { + string = name; + } + } + goto doString; + case 'N': + number = (int) keySym; + goto doNumber; + case 'W': + if (Tcl_FindHashEntry(&winPtr->mainPtr->winTable, + (char *) eventPtr->any.winPtr) != NULL) { + string = eventPtr->any.winPtr->pathName; + } else { + string = "??"; + } + goto doString; + case 'x': + if (eventPtr->type == CK_EV_MOUSE_UP || + eventPtr->type == CK_EV_MOUSE_DOWN) { + number = eventPtr->mouse.x; + } + goto doNumber; + case 'y': + if (eventPtr->type == CK_EV_MOUSE_UP || + eventPtr->type == CK_EV_MOUSE_DOWN) { + number = eventPtr->mouse.y; + } + goto doNumber; + case 'b': + if (eventPtr->type == CK_EV_MOUSE_UP || + eventPtr->type == CK_EV_MOUSE_DOWN) { + number = eventPtr->mouse.button; + } + goto doNumber; + case 'X': + if (eventPtr->type == CK_EV_MOUSE_UP || + eventPtr->type == CK_EV_MOUSE_DOWN) { + number = eventPtr->mouse.rootx; + } + goto doNumber; + case 'Y': + if (eventPtr->type == CK_EV_MOUSE_UP || + eventPtr->type == CK_EV_MOUSE_DOWN) { + number = eventPtr->mouse.rooty; + } + goto doNumber; + default: + numStorage[0] = before[1]; + numStorage[1] = '\0'; + string = numStorage; + goto doString; + } + + doNumber: + sprintf(numStorage, "%d", number); + string = numStorage; + + doString: + spaceNeeded = Tcl_ScanElement(string, &cvtFlags); + string2 = ckalloc(spaceNeeded + 1); + spaceNeeded = Tcl_ConvertElement(string, string2, + cvtFlags | TCL_DONT_USE_BRACES); + Tcl_DStringAppend(dsPtr, string2, -1); + ckfree((char *) string2); + before += 2; + } +} + +/* + *---------------------------------------------------------------------- + * + * CkStringToKeysym -- + * + * This procedure finds the keysym associated with a given keysym + * name. + * + * Results: + * The return value is the keysym that corresponds to name, or + * NoSymbol if there is no such keysym. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +KeySym +CkStringToKeysym(name) + char *name; /* Name of a keysym. */ +{ + Tcl_HashEntry *hPtr; + + hPtr = Tcl_FindHashEntry(&keySymTable, name); + if (hPtr != NULL) { + return ((KeySymInfo *) Tcl_GetHashValue(hPtr))->value; + } + return NoSymbol; +} + +/* + *---------------------------------------------------------------------- + * + * CkKeysymToString -- + * + * This procedure finds the keysym name associated with a given + * keysym. + * + * Results: + * The return value is the keysym name that corresponds to name, + * or NoSymbol if there is no name. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char * +CkKeysymToString(keySym, printControl) + KeySym keySym; + int printControl; +{ + Tcl_HashEntry *hPtr; + static char buffer[64]; + + hPtr = Tcl_FindHashEntry(&revKeySymTable, (char *) keySym); + if (hPtr != NULL) { + return ((KeySymInfo *) Tcl_GetHashValue(hPtr))->name; + } + if (printControl && keySym >= 0x00 && keySym < 0x20) { + keySym += 0x40; + sprintf(buffer, "Control-%c", keySym); + return buffer; + } + return printControl ? "NoSymbol" : NULL; +} + +/* + *---------------------------------------------------------------------- + * + * CkTermHasKey -- + * + * This procedure checks if the terminal has a key for given keysym. + * + * Results: + * TCL_OK or TCL_ERROR, a string is left in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkTermHasKey(interp, name) + Tcl_Interp *interp; /* Interpreter used for result. */ + char *name; /* Name of a keysym. */ +{ +#if !defined(__WIN32__) && !defined(DJGPP) + Tcl_HashEntry *hPtr; + char *tiname, *tivalue; + extern char *tigetstr(); +#endif + char buf[8]; + + if (strncmp("Control-", name, 8) == 0) { + if (sscanf(name, "Control-%7s", buf) != 1 || strlen(buf) != 1) + goto error; + if (buf[0] < 'A' && buf[0] > 'z') + goto error; + interp->result = "1"; + return TCL_OK; + } +#if defined(__WIN32__) || defined(DJGPP) + interp->result = "1"; + return TCL_OK; +#else + hPtr = Tcl_FindHashEntry(&keySymTable, name); + if (hPtr != NULL) { +tifind: + tiname = ((KeySymInfo *) Tcl_GetHashValue(hPtr))->tiname; + if (tiname == NULL || ((tivalue = tigetstr(tiname)) != NULL && + tivalue != (char *) -1)) + interp->result = "1"; + else + interp->result = "0"; + return TCL_OK; + } + if (strlen(name) == 1) { + if (name[0] > 0x01 && name[0] < ' ') { + interp->result = "1"; + return TCL_OK; + } + hPtr = Tcl_FindHashEntry(&revKeySymTable, (char *) + ((int) ((unsigned char) name[0]))); + if (hPtr != NULL) + goto tifind; + } +#endif +error: + Tcl_AppendResult(interp, "invalid key symbol \"", name, + "\"", (char *) NULL); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * CkAllKeyNames -- + * + * This procedure returns a list of all key names. + * + * Results: + * Always TCL_OK and list in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkAllKeyNames(interp) + Tcl_Interp *interp; /* Interpreter used for result. */ +{ + KeySymInfo *kPtr; + int i; + + for (i = 0x01; i < ' '; i++) { + unsigned code; + char buf[16]; + + code = i + 'A' - 1; + sprintf(buf, "Control-%c", tolower(code)); + Tcl_AppendElement(interp, buf); + } + for (kPtr = keyArray; kPtr->name != NULL; kPtr++) { + Tcl_AppendElement(interp, kPtr->name); + } + return TCL_OK; +} diff --git a/ckBorder.c b/ckBorder.c new file mode 100644 index 0000000..ba15207 --- /dev/null +++ b/ckBorder.c @@ -0,0 +1,303 @@ +/* + * ckBorder.c -- + * + * Manage borders by using alternate character set. + * + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * Variables used in this module. + */ + +static Tcl_HashTable gCharTable; /* Maps gChar names to values. */ +static int initialized = 0; /* gCharTable initialized. */ + + +/* + *------------------------------------------------------------------------ + * + * Ck_GetGChar -- + * + * Return curses ACS character given string. + * + *------------------------------------------------------------------------ + */ + +int +Ck_GetGChar(interp, name, gchar) + Tcl_Interp *interp; + char *name; + int *gchar; +{ + Tcl_HashEntry *hPtr; + + if (!initialized) { + int new; + + Tcl_InitHashTable(&gCharTable, TCL_STRING_KEYS); + hPtr = Tcl_CreateHashEntry(&gCharTable, "ulcorner", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_ULCORNER); + hPtr = Tcl_CreateHashEntry(&gCharTable, "urcorner", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_URCORNER); + hPtr = Tcl_CreateHashEntry(&gCharTable, "llcorner", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_LLCORNER); + hPtr = Tcl_CreateHashEntry(&gCharTable, "lrcorner", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_LRCORNER); + hPtr = Tcl_CreateHashEntry(&gCharTable, "rtee", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_RTEE); + hPtr = Tcl_CreateHashEntry(&gCharTable, "ltee", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_LTEE); + hPtr = Tcl_CreateHashEntry(&gCharTable, "btee", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_BTEE); + hPtr = Tcl_CreateHashEntry(&gCharTable, "ttee", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_TTEE); + hPtr = Tcl_CreateHashEntry(&gCharTable, "hline", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_HLINE); + hPtr = Tcl_CreateHashEntry(&gCharTable, "vline", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_VLINE); + hPtr = Tcl_CreateHashEntry(&gCharTable, "plus", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_PLUS); + hPtr = Tcl_CreateHashEntry(&gCharTable, "s1", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_S1); + hPtr = Tcl_CreateHashEntry(&gCharTable, "s9", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_S9); + hPtr = Tcl_CreateHashEntry(&gCharTable, "diamond", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_DIAMOND); + hPtr = Tcl_CreateHashEntry(&gCharTable, "ckboard", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_CKBOARD); + hPtr = Tcl_CreateHashEntry(&gCharTable, "degree", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_DEGREE); + hPtr = Tcl_CreateHashEntry(&gCharTable, "plminus", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_PLMINUS); + hPtr = Tcl_CreateHashEntry(&gCharTable, "bullet", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_BULLET); + hPtr = Tcl_CreateHashEntry(&gCharTable, "larrow", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_LARROW); + hPtr = Tcl_CreateHashEntry(&gCharTable, "rarrow", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_RARROW); + hPtr = Tcl_CreateHashEntry(&gCharTable, "darrow", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_DARROW); + hPtr = Tcl_CreateHashEntry(&gCharTable, "uarrow", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_UARROW); + hPtr = Tcl_CreateHashEntry(&gCharTable, "board", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_BOARD); + hPtr = Tcl_CreateHashEntry(&gCharTable, "lantern", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_LANTERN); + hPtr = Tcl_CreateHashEntry(&gCharTable, "block", &new); + Tcl_SetHashValue(hPtr, (ClientData) ACS_BLOCK); + + initialized = 1; + } + + hPtr = Tcl_FindHashEntry(&gCharTable, name); + if (hPtr == NULL) { + if (interp != NULL) + Tcl_AppendResult(interp, + "bad gchar \"", name, "\"", (char *) NULL); + return TCL_ERROR; + } + if (gchar != NULL) + *gchar = (int) Tcl_GetHashValue(hPtr); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------ + * + * Ck_SetGChar -- + * + * Modify ACS mapping. + * + *------------------------------------------------------------------------ + */ + +int +Ck_SetGChar(interp, name, gchar) + Tcl_Interp *interp; + char *name; + int gchar; +{ + Tcl_HashEntry *hPtr; + + if (!initialized) + Ck_GetGChar(interp, "ulcorner", NULL); + hPtr = Tcl_FindHashEntry(&gCharTable, name); + if (hPtr == NULL) { + Tcl_AppendResult(interp, "bad gchar \"", name, "\"", (char *) NULL); + return TCL_ERROR; + } + Tcl_SetHashValue(hPtr, (ClientData) gchar); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------ + * + * Ck_GetBorder -- + * + * Create border from string. + * + *------------------------------------------------------------------------ + */ + +CkBorder * +Ck_GetBorder(interp, string) + Tcl_Interp *interp; + char *string; +{ + int i, largc, bchar[8]; + char **largv; + CkBorder *borderPtr; + + if (Tcl_SplitList(interp, string, &largc, &largv) != TCL_OK) + return NULL; + if (largc != 1 && largc != 3 && largc != 6 && largc != 8) { + ckfree((char *) largv); + Tcl_AppendResult(interp, "illegal number of box characters", + (char *) NULL); + return NULL; + } + for (i = 0; i < sizeof (bchar) / sizeof (bchar[0]); i++) + bchar[i] = ' '; + for (i = 0; i < largc; i++) { + if (strlen(largv[i]) == 1) + bchar[i] = (unsigned char) largv[i][0]; + else if (Ck_GetGChar(interp, largv[i], &bchar[i]) != TCL_OK) { + ckfree((char *) largv); + return NULL; + } + } + if (largc == 1) { + for (i = 1; i < sizeof (bchar) / sizeof (bchar[0]); i++) + bchar[i] = bchar[0]; + } else if (largc == 3) { + bchar[3] = bchar[7] = bchar[2]; + bchar[2] = bchar[4] = bchar[6] = bchar[0]; + bchar[5] = bchar[1]; + } else if (largc == 6) { + bchar[6] = bchar[5]; + bchar[5] = bchar[1]; + bchar[7] = bchar[3]; + } + ckfree((char *) largv); + borderPtr = (CkBorder *) ckalloc(sizeof (CkBorder)); + memset(borderPtr, 0, sizeof (CkBorder)); + for (i = 0; i < 8; i++) + borderPtr->gchar[i] = bchar[i]; + borderPtr->name = ckalloc(strlen(string) + 1); + strcpy(borderPtr->name, string); + return borderPtr; +} + +/* + *------------------------------------------------------------------------ + * + * Ck_FreeBorder -- + * + * Release memory related to border. + * + *------------------------------------------------------------------------ + */ + +void +Ck_FreeBorder(borderPtr) + CkBorder *borderPtr; +{ + ckfree(borderPtr->name); + ckfree((char *) borderPtr); +} + +/* + *------------------------------------------------------------------------ + * + * Ck_NameOfBorder -- + * + * Create border from string. + * + *------------------------------------------------------------------------ + */ + +char * +Ck_NameOfBorder(borderPtr) + CkBorder *borderPtr; +{ + return borderPtr->name; +} + +/* + *------------------------------------------------------------------------ + * + * Ck_DrawBorder -- + * + * Given window, border and bounding box, draw border. + * + *------------------------------------------------------------------------ + */ + +void +Ck_DrawBorder(winPtr, borderPtr, x, y, width, height) + CkWindow *winPtr; + CkBorder *borderPtr; + int x, y, width, height; +{ + int i, *gchar; + WINDOW *w; + + if (winPtr->window == NULL) + return; + w = winPtr->window; + gchar = borderPtr->gchar; + if (width < 1 || height < 1) + return; + if (width == 1) { + for (i = y; i < height + y; i++) + mvwaddch(w, i, x, gchar[3]); + return; + } + if (height == 1) { + for (i = x; i < width + x; i++) + mvwaddch(w, y, i, gchar[1]); + return; + } + if (width == 2) { + mvwaddch(w, y, x, gchar[0]); + mvwaddch(w, y, x + 1, gchar[2]); + for (i = y + 1; i < height - 1 + y; i++) + mvwaddch(w, i, x, gchar[7]); + for (i = y + 1; i < height - 1 + y; i++) + mvwaddch(w, i, x + 1, gchar[3]); + mvwaddch(w, height - 1 + y, x, gchar[6]); + mvwaddch(w, height - 1 + y, x + 1, gchar[4]); + return; + } + if (height == 2) { + mvwaddch(w, y, x, gchar[0]); + mvwaddch(w, y + 1, x, gchar[6]); + for (i = x + 1; i < width - 1 + x; i++) + mvwaddch(w, y, i, gchar[1]); + for (i = x + 1; i < width - 1 + x; i++) + mvwaddch(w, y + 1, i, gchar[5]); + mvwaddch(w, y, width - 1 + x, gchar[2]); + mvwaddch(w, y + 1, width - 1 + x, gchar[4]); + return; + } + mvwaddch(w, y, x, gchar[0]); + for (i = x + 1; i < width - 1 + x; i++) + mvwaddch(w, y, i, gchar[1]); + mvwaddch(w, y, width - 1 + x, gchar[2]); + for (i = y + 1; i < height - 1 + y; i++) + mvwaddch(w, i, width - 1 + x, gchar[3]); + mvwaddch(w, height - 1 + y, width - 1 + x, gchar[4]); + for (i = x + 1; i < width - 1 + x; i++) + mvwaddch(w, height - 1 + y, i, gchar[5]); + mvwaddch(w, height - 1 + y, x, gchar[6]); + for (i = y + 1; i < height - 1 + y; i++) + mvwaddch(w, i, x, gchar[7]); +} diff --git a/ckButton.c b/ckButton.c new file mode 100644 index 0000000..0ec9e2a --- /dev/null +++ b/ckButton.c @@ -0,0 +1,1184 @@ +/* + * ckButton.c -- + * + * This module implements a collection of button-like + * widgets for the Ck toolkit. The widgets implemented + * include labels, buttons, check buttons, and radio + * buttons. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +/* + * A data structure of the following type is kept for each + * widget managed by this file: + */ + +typedef struct { + CkWindow *winPtr; /* Window that embodies the button. NULL + * means that the window has been destroyed. */ + Tcl_Interp *interp; /* Interpreter associated with button. */ + Tcl_Command widgetCmd; /* Token for button's widget command. */ + int type; /* Type of widget: restricts operations + * that may be performed on widget. See + * below for possible values. */ + + /* + * Information about what's in the button. + */ + + char *text; /* Text to display in button (malloc'ed) + * or NULL. */ + int textLength; /* # of characters in text. */ + char *textVarName; /* Name of variable (malloc'ed) or NULL. + * If non-NULL, button displays the contents + * of this variable. */ + + /* + * Information used when displaying widget: + */ + + Ck_Uid state; /* State of button for display purposes: + * normal, active, or disabled. */ + int normalFg; /* Foreground color in normal mode. */ + int normalBg; /* Background color in normal mode. */ + int normalAttr; /* Attributes in normal mode. */ + int activeFg; /* Foreground color in active mode. */ + int activeBg; /* Ditto, background color. */ + int activeAttr; /* Attributes in active mode. */ + int disabledBg; /* Background color when disabled. */ + int disabledFg; /* Foreground color when disabled. */ + int disabledAttr; /* Attributes when disabled. */ + int underline; /* Index of underlined character, < 0 if + * no underlining. */ + int underlineFg; /* Foreground for underlined character. */ + int underlineAttr; /* Attribute for underlined character. */ + int selectFg; /* Foreground color for selector. */ + int width, height; /* If > 0, these specify dimensions to request + * for window, in characters for text. */ + Ck_Anchor anchor; /* Where text should be displayed + * inside button region. */ + + /* + * For check and radio buttons, the fields below are used + * to manage the variable indicating the button's state. + */ + + char *selVarName; /* Name of variable used to control selected + * state of button. Malloc'ed (if + * not NULL). */ + char *onValue; /* Value to store in variable when + * this button is selected. Malloc'ed (if + * not NULL). */ + char *offValue; /* Value to store in variable when this + * button isn't selected. Malloc'ed + * (if not NULL). Valid only for check + * buttons. */ + + /* + * Miscellaneous information: + */ + + char *command; /* Command to execute when button is + * invoked; valid for buttons only. + * If not NULL, it's malloc-ed. */ + char *takeFocus; /* Tk 4.0 like. */ + int flags; /* Various flags; see below for + * definitions. */ +} Button; + +/* + * Possible "type" values for buttons. These are the kinds of + * widgets supported by this file. The ordering of the type + * numbers is significant: greater means more features and is + * used in the code. + */ + +#define TYPE_LABEL 0 +#define TYPE_BUTTON 1 +#define TYPE_CHECK_BUTTON 2 +#define TYPE_RADIO_BUTTON 3 + +/* + * Class names for buttons, indexed by one of the type values above. + */ + +static char *classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"}; + +/* + * Flag bits for buttons: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler + * has already been queued to redraw + * this window. + * SELECTED: Non-zero means this button is selected, + * so special highlight should be drawn. + */ + +#define REDRAW_PENDING 1 +#define SELECTED 2 + +/* + * Mask values used to selectively enable entries in the + * configuration specs: + */ + +#define LABEL_MASK CK_CONFIG_USER_BIT +#define BUTTON_MASK CK_CONFIG_USER_BIT << 1 +#define CHECK_BUTTON_MASK CK_CONFIG_USER_BIT << 2 +#define RADIO_BUTTON_MASK CK_CONFIG_USER_BIT << 3 +#define ALL_MASK (LABEL_MASK | BUTTON_MASK \ + | CHECK_BUTTON_MASK | RADIO_BUTTON_MASK) + +static int configFlags[] = {LABEL_MASK, BUTTON_MASK, + CHECK_BUTTON_MASK, RADIO_BUTTON_MASK}; +/* + * Information used for parsing configuration specs: + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_BUTTON_ACTIVE_ATTR_COLOR, + Ck_Offset(Button, activeAttr), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_BUTTON_ACTIVE_ATTR_MONO, + Ck_Offset(Button, activeAttr), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_BUTTON_ACTIVE_BG_COLOR, Ck_Offset(Button, activeBg), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_BUTTON_ACTIVE_BG_MONO, Ck_Offset(Button, activeBg), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_BUTTON_ACTIVE_FG_COLOR, Ck_Offset(Button, activeFg), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_BUTTON_ACTIVE_FG_MONO, Ck_Offset(Button, activeFg), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", + DEF_BUTTON_ANCHOR, Ck_Offset(Button, anchor), ALL_MASK}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_BUTTON_ATTR, Ck_Offset(Button, normalAttr), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_LABEL_ATTR, Ck_Offset(Button, normalAttr), LABEL_MASK}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_BUTTON_BG_COLOR, Ck_Offset(Button, normalBg), + ALL_MASK | CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_BUTTON_BG_MONO, Ck_Offset(Button, normalBg), + ALL_MASK | CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, ALL_MASK}, + {CK_CONFIG_STRING, "-command", "command", "Command", + DEF_BUTTON_COMMAND, Ck_Offset(Button, command), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_ATTR, "-disabledattributes", "disabledAttributes", + "DisabledAttributes", DEF_BUTTON_DISABLED_ATTR, + Ck_Offset(Button, disabledAttr), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, + {CK_CONFIG_COLOR, "-disabledbackground", "disabledBackground", + "DisabledBackground", DEF_BUTTON_DISABLED_BG_COLOR, + Ck_Offset(Button, disabledBg), BUTTON_MASK|CHECK_BUTTON_MASK + |RADIO_BUTTON_MASK|CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-disabledbackground", "disabledBackground", + "DisabledBackground", DEF_BUTTON_DISABLED_BG_MONO, + Ck_Offset(Button, disabledBg), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", + "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR, + Ck_Offset(Button, disabledFg), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", + "DisabledForeground", DEF_BUTTON_DISABLED_FG_MONO, + Ck_Offset(Button, disabledFg), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, ALL_MASK}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_BUTTON_FG, Ck_Offset(Button, normalFg), ALL_MASK}, + {CK_CONFIG_INT, "-height", "height", "Height", + DEF_BUTTON_HEIGHT, Ck_Offset(Button, height), ALL_MASK}, + {CK_CONFIG_STRING, "-offvalue", "offValue", "Value", + DEF_BUTTON_OFF_VALUE, Ck_Offset(Button, offValue), + CHECK_BUTTON_MASK}, + {CK_CONFIG_STRING, "-onvalue", "onValue", "Value", + DEF_BUTTON_ON_VALUE, Ck_Offset(Button, onValue), + CHECK_BUTTON_MASK}, + {CK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background", + DEF_BUTTON_SELECT_COLOR, Ck_Offset(Button, selectFg), + CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background", + DEF_BUTTON_SELECT_MONO, Ck_Offset(Button, selectFg), + CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_UID, "-state", "state", "State", + DEF_BUTTON_STATE, Ck_Offset(Button, state), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_BUTTON_TAKE_FOCUS, Ck_Offset(Button, takeFocus), + BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_LABEL_TAKE_FOCUS, Ck_Offset(Button, takeFocus), + LABEL_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-text", "text", "Text", + DEF_BUTTON_TEXT, Ck_Offset(Button, text), ALL_MASK}, + {CK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", + DEF_BUTTON_TEXT_VARIABLE, Ck_Offset(Button, textVarName), + ALL_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_INT, "-underline", "underline", "Underline", + DEF_BUTTON_UNDERLINE, Ck_Offset(Button, underline), + ALL_MASK}, + {CK_CONFIG_ATTR, "-underlineattributes", "underlineAttributes", + "UnderlineAttributes", DEF_BUTTON_UNDERLINE_ATTR, + Ck_Offset(Button, underlineAttr), ALL_MASK}, + {CK_CONFIG_COLOR, "-underlineforeground", "underlineForeground", + "UnderlineForeground", DEF_BUTTON_UNDERLINE_FG_COLOR, + Ck_Offset(Button, underlineFg), ALL_MASK|CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-underlineforeground", "underlineForeground", + "UnderlineForeground", DEF_BUTTON_UNDERLINE_FG_MONO, + Ck_Offset(Button, underlineFg), ALL_MASK|CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_STRING, "-value", "value", "Value", + DEF_BUTTON_VALUE, Ck_Offset(Button, onValue), + RADIO_BUTTON_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-variable", "variable", "Variable", + DEF_RADIOBUTTON_VARIABLE, Ck_Offset(Button, selVarName), + RADIO_BUTTON_MASK}, + {CK_CONFIG_STRING, "-variable", "variable", "Variable", + DEF_CHECKBUTTON_VARIABLE, Ck_Offset(Button, selVarName), + CHECK_BUTTON_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_INT, "-width", "width", "Width", + DEF_BUTTON_WIDTH, Ck_Offset(Button, width), ALL_MASK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * String to print out in error messages, identifying options for + * widget commands for different types of labels or buttons: + */ + +static char *optionStrings[] = { + "cget or configure", + "activate, cget, configure, deactivate, flash, or invoke", + "activate, cget, configure, deactivate, deselect, flash, invoke, select, or toggle", + "activate, cget, configure, deactivate, deselect, flash, invoke, or select" +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void ButtonCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void ButtonEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static char * ButtonTextVarProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); +static char * ButtonVarProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); +static int ButtonWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static void ComputeButtonGeometry _ANSI_ARGS_((Button *butPtr)); +static int ConfigureButton _ANSI_ARGS_((Tcl_Interp *interp, + Button *butPtr, int argc, char **argv, + int flags)); +static void DestroyButton _ANSI_ARGS_((ClientData clientData)); +static void DisplayButton _ANSI_ARGS_((ClientData clientData)); +static int InvokeButton _ANSI_ARGS_((Button *butPtr)); + +/* + *-------------------------------------------------------------- + * + * Ck_ButtonCmd -- + * + * This procedure is invoked to process the "button", "label", + * "radiobutton", and "checkbutton" Tcl commands. See the + * user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_ButtonCmd(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. */ +{ + Button *butPtr; + int type; + CkWindow *winPtr = (CkWindow *) clientData; + CkWindow *new; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + switch (argv[0][0]) { + case 'l': + type = TYPE_LABEL; + break; + case 'b': + type = TYPE_BUTTON; + break; + case 'c': + type = TYPE_CHECK_BUTTON; + break; + case 'r': + type = TYPE_RADIO_BUTTON; + break; + default: + sprintf(interp->result, + "unknown button-creation command \"%.50s\"", argv[0]); + return TCL_ERROR; + } + + /* + * Create the new window. + */ + + new = Ck_CreateWindowFromPath(interp, winPtr, argv[1], 0); + if (new == NULL) { + return TCL_ERROR; + } + + /* + * Initialize the data structure for the button. + */ + + butPtr = (Button *) ckalloc(sizeof (Button)); + butPtr->winPtr = new; + butPtr->interp = interp; + butPtr->widgetCmd = Tcl_CreateCommand(interp, + butPtr->winPtr->pathName, ButtonWidgetCmd, + (ClientData) butPtr, ButtonCmdDeletedProc); + butPtr->type = type; + butPtr->text = NULL; + butPtr->textLength = 0; + butPtr->textVarName = NULL; + butPtr->state = ckNormalUid; + butPtr->normalFg = 0; + butPtr->normalBg = 0; + butPtr->normalAttr = 0; + butPtr->activeFg = 0; + butPtr->activeBg = 0; + butPtr->activeAttr = 0; + butPtr->disabledFg = 0; + butPtr->disabledBg = 0; + butPtr->disabledAttr = 0; + butPtr->underline = -1; + butPtr->underlineFg = 0; + butPtr->underlineAttr = 0; + butPtr->selectFg = 0; + butPtr->width = 0; + butPtr->height = 0; + butPtr->anchor = CK_ANCHOR_CENTER; + butPtr->selVarName = NULL; + butPtr->onValue = NULL; + butPtr->offValue = NULL; + butPtr->command = NULL; + butPtr->takeFocus = NULL; + butPtr->flags = 0; + + Ck_SetClass(new, classNames[type]); + Ck_CreateEventHandler(butPtr->winPtr, + CK_EV_EXPOSE | CK_EV_MAP | CK_EV_DESTROY, + ButtonEventProc, (ClientData) butPtr); + if (ConfigureButton(interp, butPtr, argc-2, argv+2, + configFlags[type]) != TCL_OK) { + Ck_DestroyWindow(butPtr->winPtr); + return TCL_ERROR; + } + + interp->result = butPtr->winPtr->pathName; + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ButtonWidgetCmd -- + * + * 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. + * + *-------------------------------------------------------------- + */ + +static int +ButtonWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about button widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + Button *butPtr = (Button *) clientData; + int result = TCL_OK; + int length; + char c; + + if (argc < 2) { + sprintf(interp->result, + "wrong # args: should be \"%.50s option [arg arg ...]\"", + argv[0]); + return TCL_ERROR; + } + Ck_Preserve((ClientData) butPtr); + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0) + && (butPtr->type != TYPE_LABEL)) { + if (argc > 2) { + sprintf(interp->result, + "wrong # args: should be \"%.50s activate\"", + argv[0]); + goto error; + } + if (butPtr->state != ckDisabledUid) { + butPtr->state = ckActiveUid; + goto redisplay; + } + } 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 = Ck_ConfigureValue(interp, butPtr->winPtr, configSpecs, + (char *) butPtr, argv[2], configFlags[butPtr->type]); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, butPtr->winPtr, configSpecs, + (char *) butPtr, (char *) NULL, configFlags[butPtr->type]); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, butPtr->winPtr, configSpecs, + (char *) butPtr, argv[2], + configFlags[butPtr->type]); + } else { + result = ConfigureButton(interp, butPtr, argc-2, argv+2, + configFlags[butPtr->type] | CK_CONFIG_ARGV_ONLY); + } + } else if ((c == 'd') && (strncmp(argv[1], "deactivate", length) == 0) + && (length > 2) && (butPtr->type != TYPE_LABEL)) { + if (argc > 2) { + sprintf(interp->result, + "wrong # args: should be \"%.50s deactivate\"", + argv[0]); + goto error; + } + if (butPtr->state != ckDisabledUid) { + butPtr->state = ckNormalUid; + goto redisplay; + } + } else if ((c == 'd') && (strncmp(argv[1], "deselect", length) == 0) + && (length > 2) && (butPtr->type >= TYPE_CHECK_BUTTON)) { + if (argc > 2) { + sprintf(interp->result, + "wrong # args: should be \"%.50s deselect\"", + argv[0]); + goto error; + } + if (butPtr->type == TYPE_CHECK_BUTTON) { + Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue, + TCL_GLOBAL_ONLY); + } else if (butPtr->flags & SELECTED) { + Tcl_SetVar(interp, butPtr->selVarName, "", TCL_GLOBAL_ONLY); + } + } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0) + && (butPtr->type > TYPE_LABEL)) { + if (argc > 2) { + sprintf(interp->result, + "wrong # args: should be \"%.50s invoke\"", + argv[0]); + goto error; + } + if (butPtr->state != ckDisabledUid) { + result = InvokeButton(butPtr); + } + } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0) + && (butPtr->type >= TYPE_CHECK_BUTTON)) { + if (argc > 2) { + sprintf(interp->result, + "wrong # args: should be \"%.50s select\"", + argv[0]); + goto error; + } + Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue, TCL_GLOBAL_ONLY); + } else if ((c == 't') && (strncmp(argv[1], "toggle", length) == 0) + && (length >= 2) && (butPtr->type == TYPE_CHECK_BUTTON)) { + if (argc > 2) { + sprintf(interp->result, + "wrong # args: should be \"%.50s select\"", + argv[0]); + goto error; + } + if (butPtr->flags & SELECTED) { + Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue, TCL_GLOBAL_ONLY); + } else { + Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue, TCL_GLOBAL_ONLY); + } + } else { + sprintf(interp->result, + "bad option \"%.50s\": must be %s", argv[1], + optionStrings[butPtr->type]); + goto error; + } + Ck_Release((ClientData) butPtr); + return result; + + redisplay: + if ((butPtr->winPtr->flags & CK_MAPPED) && + !(butPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayButton, (ClientData) butPtr); + butPtr->flags |= REDRAW_PENDING; + } + Ck_Release((ClientData) butPtr); + return TCL_OK; + + error: + Ck_Release((ClientData) butPtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyButton -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a button at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the widget is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyButton(clientData) + ClientData clientData; /* Info about entry widget. */ +{ + Button *butPtr = (Button *) clientData; + + /* + * Free up all the stuff that requires special handling, then + * let Tk_FreeOptions handle all the standard option-related + * stuff. + */ + + if (butPtr->textVarName != NULL) { + Tcl_UntraceVar(butPtr->interp, butPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, (ClientData) butPtr); + } + if (butPtr->selVarName != NULL) { + Tcl_UntraceVar(butPtr->interp, butPtr->selVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, (ClientData) butPtr); + } + Ck_FreeOptions(configSpecs, (char *) butPtr, configFlags[butPtr->type]); + ckfree((char *) butPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ButtonCmdDeletedProc -- + * + * 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 +ButtonCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + Button *butPtr = (Button *) clientData; + CkWindow *winPtr = butPtr->winPtr; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case winPtr + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (winPtr != NULL) { + butPtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureButton -- + * + * This procedure is called to process an argv/argc list, plus + * the Tk option database, in order to configure (or + * reconfigure) a button widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as text string, colors, font, + * etc. get set for butPtr; old resources get freed, if there + * were any. The button is redisplayed. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureButton(interp, butPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Button *butPtr; /* 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. */ +{ + /* + * Eliminate any existing trace on variables monitored by the button. + */ + + if (butPtr->textVarName != NULL) { + Tcl_UntraceVar(interp, butPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, (ClientData) butPtr); + } + if (butPtr->selVarName != NULL) { + Tcl_UntraceVar(interp, butPtr->selVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, (ClientData) butPtr); + } + + if (Ck_ConfigureWidget(interp, butPtr->winPtr, configSpecs, + argc, argv, (char *) butPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few options need special processing. + */ + + if (butPtr->state != ckActiveUid && butPtr->state != ckDisabledUid) + butPtr->state = ckNormalUid; + + if (butPtr->type >= TYPE_CHECK_BUTTON) { + char *value; + + if (butPtr->selVarName == NULL) { + butPtr->selVarName = (char *) ckalloc( + strlen((char *) butPtr->winPtr->nameUid) + 1); + strcpy(butPtr->selVarName, (char *) butPtr->winPtr->nameUid); + } + if (butPtr->onValue == NULL) { + butPtr->onValue = (char *) ckalloc( + strlen((char *) butPtr->winPtr->nameUid) + 1); + strcpy(butPtr->onValue, (char *) butPtr->winPtr->nameUid); + } + + /* + * Select the button if the associated variable has the + * appropriate value, initialize the variable if it doesn't + * exist, then set a trace on the variable to monitor future + * changes to its value. + */ + + value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY); + butPtr->flags &= ~SELECTED; + if (value != NULL) { + if (strcmp(value, butPtr->onValue) == 0) { + butPtr->flags |= SELECTED; + } + } else { + Tcl_SetVar(interp, butPtr->selVarName, + (butPtr->type == TYPE_CHECK_BUTTON) ? butPtr->offValue : "", + TCL_GLOBAL_ONLY); + } + Tcl_TraceVar(interp, butPtr->selVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, (ClientData) butPtr); + } + + /* + * If the button is to display the value of a variable, then set up + * a trace on the variable's value, create the variable if it doesn't + * exist, and fetch its current value. + */ + + if (butPtr->textVarName != NULL) { + char *value; + + value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY); + if (value == NULL) { + Tcl_SetVar(interp, butPtr->textVarName, + butPtr->text != NULL ? butPtr->text : "", + TCL_GLOBAL_ONLY); + } else { + if (butPtr->text != NULL) { + ckfree(butPtr->text); + } + butPtr->text = ckalloc((unsigned) (strlen(value) + 1)); + strcpy(butPtr->text, value); + } + Tcl_TraceVar(interp, butPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, (ClientData) butPtr); + } + + ComputeButtonGeometry(butPtr); + + /* + * Lastly, arrange for the button to be redisplayed. + */ + + if ((butPtr->winPtr->flags & CK_MAPPED) + && !(butPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayButton, (ClientData) butPtr); + butPtr->flags |= REDRAW_PENDING; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * DisplayButton -- + * + * This procedure is invoked to display a button widget. + * + * Results: + * None. + * + * Side effects: + * Commands are output to display the button in its + * current mode. + * + *---------------------------------------------------------------------- + */ + +static void +DisplayButton(clientData) + ClientData clientData; /* Information about widget. */ +{ + Button *butPtr = (Button *) clientData; + int x, y, fg, bg, attr, textWidth, charWidth; + CkWindow *winPtr = butPtr->winPtr; + + butPtr->flags &= ~REDRAW_PENDING; + if ((butPtr->winPtr == NULL) || !(winPtr->flags & CK_MAPPED)) { + return; + } + + if (butPtr->state == ckDisabledUid) { + fg = butPtr->disabledFg; + bg = butPtr->disabledBg; + attr = butPtr->disabledAttr; + } else if (butPtr->state == ckActiveUid) { + fg = butPtr->activeFg; + bg = butPtr->activeBg; + attr = butPtr->activeAttr; + } else { + fg = butPtr->normalFg; + bg = butPtr->normalBg; + attr = butPtr->normalAttr; + } + + /* + * Display text for button. + */ + + if (butPtr->text != NULL) + CkMeasureChars(winPtr->mainPtr, butPtr->text, butPtr->textLength, + 0, winPtr->width, 0, CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS, + &textWidth, &charWidth); + else + textWidth = 0; + + switch (butPtr->anchor) { + case CK_ANCHOR_NW: case CK_ANCHOR_W: case CK_ANCHOR_SW: + x = butPtr->type >= TYPE_CHECK_BUTTON ? 4 : 0; + break; + case CK_ANCHOR_N: case CK_ANCHOR_CENTER: case CK_ANCHOR_S: + x = (winPtr->width - textWidth) / 2; + if (butPtr->type >= TYPE_CHECK_BUTTON) + x += 2; + break; + default: + x = winPtr->width - textWidth; + if (butPtr->type >= TYPE_CHECK_BUTTON && x < 4) + x = 4; + break; + } + if (x + textWidth > winPtr->width) + textWidth = winPtr->width - x; + + switch (butPtr->anchor) { + case CK_ANCHOR_NW: case CK_ANCHOR_N: case CK_ANCHOR_NE: + y = 0; + break; + case CK_ANCHOR_W: case CK_ANCHOR_CENTER: case CK_ANCHOR_E: + y = (winPtr->height - 1) / 2; + break; + default: + y = winPtr->height - 1; + if (y < 0) + y = 0; + break; + } + + Ck_SetWindowAttr(winPtr, fg, bg, attr); + Ck_ClearToBot(winPtr, 0, 0); + if (butPtr->text != NULL) { + CkDisplayChars(winPtr->mainPtr, + winPtr->window, butPtr->text, charWidth, x, y, + 0, CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS); + if (butPtr->underline >= 0 && butPtr->state == ckNormalUid) { + Ck_SetWindowAttr(winPtr, butPtr->underlineFg, bg, + butPtr->underlineAttr); + CkUnderlineChars(winPtr->mainPtr, + winPtr->window, butPtr->text, charWidth, x, y, + 0, CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS, + butPtr->underline, butPtr->underline); + Ck_SetWindowAttr(winPtr, fg, bg, attr); + } + } + if (butPtr->type >= TYPE_CHECK_BUTTON) { + int gchar; + + mvwaddstr(winPtr->window, y, 0, butPtr->type == TYPE_CHECK_BUTTON ? + "[ ]" : "( )"); + Ck_SetWindowAttr(winPtr, butPtr->selectFg, bg, attr); + if (!(butPtr->flags & SELECTED)) { + mvwaddch(winPtr->window, y, 1, (unsigned char) ' '); + } else if (butPtr->type == TYPE_CHECK_BUTTON) { + Ck_GetGChar(butPtr->interp, "diamond", &gchar); + mvwaddch(winPtr->window, y, 1, gchar); + } else if (butPtr->type == TYPE_RADIO_BUTTON) { + Ck_GetGChar(butPtr->interp, "bullet", &gchar); + mvwaddch(winPtr->window, y, 1, gchar); + } + } + Ck_SetWindowAttr(winPtr, fg, bg, attr); + wmove(winPtr->window, y, (butPtr->type >= TYPE_CHECK_BUTTON) ? 1 : x); + Ck_EventuallyRefresh(winPtr); +} + +/* + *-------------------------------------------------------------- + * + * ButtonEventProc -- + * + * This procedure is invoked by the dispatcher for various + * events on buttons. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +ButtonEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + Button *butPtr = (Button *) clientData; + + if (eventPtr->type == CK_EV_EXPOSE || eventPtr->type == CK_EV_MAP) { + if ((butPtr->winPtr != NULL) && !(butPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayButton, (ClientData) butPtr); + butPtr->flags |= REDRAW_PENDING; + } + } else if (eventPtr->type == CK_EV_DESTROY) { + if (butPtr->winPtr != NULL) { + butPtr->winPtr = NULL; + Tcl_DeleteCommand(butPtr->interp, + Tcl_GetCommandName(butPtr->interp, butPtr->widgetCmd)); + } + if (butPtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayButton, (ClientData) butPtr); + } + Ck_EventuallyFree((ClientData) butPtr, (Ck_FreeProc *) DestroyButton); + } +} + +/* + *---------------------------------------------------------------------- + * + * ComputeButtonGeometry -- + * + * After changes in a button's text or bitmap, this procedure + * recomputes the button's geometry and passes this information + * along to the geometry manager for the window. + * + * Results: + * None. + * + * Side effects: + * The button's window may change size. + * + *---------------------------------------------------------------------- + */ + +static void +ComputeButtonGeometry(butPtr) + Button *butPtr; /* Button whose geometry may have changed. */ +{ + int width, height, dummy; + CkWindow *winPtr = butPtr->winPtr; + + butPtr->textLength = butPtr->text == NULL ? 0 : strlen(butPtr->text); + if (butPtr->height > 0) + height = butPtr->height; + else + height = 1; + if (butPtr->width > 0) + width = butPtr->width; + else + CkMeasureChars(winPtr->mainPtr, + butPtr->text == NULL ? "" : butPtr->text, + butPtr->textLength, 0, 100000, 0, + CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS, + &width, &dummy); + + /* + * When issuing the geometry request, add extra space for the selector, + * if any. + */ + + if (butPtr->type >= TYPE_CHECK_BUTTON) + width += 4; + + Ck_GeometryRequest(butPtr->winPtr, width, height); +} + +/* + *---------------------------------------------------------------------- + * + * InvokeButton -- + * + * This procedure is called to carry out the actions associated + * with a button, such as invoking a Tcl command or setting a + * variable. This procedure is invoked, for example, when the + * button is invoked via the mouse. + * + * Results: + * A standard Tcl return value. Information is also left in + * interp->result. + * + * Side effects: + * Depends on the button and its associated command. + * + *---------------------------------------------------------------------- + */ + +static int +InvokeButton(butPtr) + Button *butPtr; /* Information about button. */ +{ + if (butPtr->type == TYPE_CHECK_BUTTON) { + if (butPtr->flags & SELECTED) { + Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->offValue, + TCL_GLOBAL_ONLY); + } else { + Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue, + TCL_GLOBAL_ONLY); + } + } else if (butPtr->type == TYPE_RADIO_BUTTON) { + Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue, + TCL_GLOBAL_ONLY); + } + if ((butPtr->type != TYPE_LABEL) && (butPtr->command != NULL)) { + return CkCopyAndGlobalEval(butPtr->interp, butPtr->command); + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ButtonVarProc -- + * + * This procedure is invoked when someone changes the + * state variable associated with a radio button. Depending + * on the new value of the button's variable, the button + * may be selected or deselected. + * + * Results: + * NULL is always returned. + * + * Side effects: + * The button may become selected or deselected. + * + *-------------------------------------------------------------- + */ + +static char * +ButtonVarProc(clientData, interp, name1, name2, flags) + ClientData clientData; /* Information about button. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Name of variable. */ + char *name2; /* Second part of variable name. */ + int flags; /* Information about what happened. */ +{ + Button *butPtr = (Button *) clientData; + char *value; + + /* + * If the variable is being unset, then just re-establish the + * trace unless the whole interpreter is going away. + */ + + if (flags & TCL_TRACE_UNSETS) { + butPtr->flags &= ~SELECTED; + if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + Tcl_TraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, clientData); + } + goto redisplay; + } + + /* + * Use the value of the variable to update the selected status of + * the button. + */ + + value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY); + if (strcmp(value, butPtr->onValue) == 0) { + if (butPtr->flags & SELECTED) { + return (char *) NULL; + } + butPtr->flags |= SELECTED; + } else if (butPtr->flags & SELECTED) { + butPtr->flags &= ~SELECTED; + } else { + return (char *) NULL; + } + + redisplay: + if ((butPtr->winPtr != NULL) && (butPtr->winPtr->flags & CK_MAPPED) + && !(butPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayButton, (ClientData) butPtr); + butPtr->flags |= REDRAW_PENDING; + } + return (char *) NULL; +} + +/* + *-------------------------------------------------------------- + * + * ButtonTextVarProc -- + * + * This procedure is invoked when someone changes the variable + * whose contents are to be displayed in a button. + * + * Results: + * NULL is always returned. + * + * Side effects: + * The text displayed in the button will change to match the + * variable. + * + *-------------------------------------------------------------- + */ + +static char * +ButtonTextVarProc(clientData, interp, name1, name2, flags) + ClientData clientData; /* Information about button. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Name of variable. */ + char *name2; /* Second part of variable name. */ + int flags; /* Information about what happened. */ +{ + Button *butPtr = (Button *) clientData; + char *value; + + /* + * If the variable is unset, then immediately recreate it unless + * the whole interpreter is going away. + */ + + if (flags & TCL_TRACE_UNSETS) { + if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + Tcl_SetVar2(interp, name1, name2, + butPtr->text != NULL ? butPtr->text : "", + flags & TCL_GLOBAL_ONLY); + Tcl_TraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, clientData); + } + return (char *) NULL; + } + + value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY); + if (value == NULL) { + value = ""; + } + if (butPtr->text != NULL) { + ckfree(butPtr->text); + } + butPtr->text = ckalloc((unsigned) (strlen(value) + 1)); + strcpy(butPtr->text, value); + ComputeButtonGeometry(butPtr); + + if ((butPtr->winPtr != NULL) && (butPtr->winPtr->flags & CK_MAPPED) + && !(butPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayButton, (ClientData) butPtr); + butPtr->flags |= REDRAW_PENDING; + } + return (char *) NULL; +} diff --git a/ckCmds.c b/ckCmds.c new file mode 100644 index 0000000..f3e09eb --- /dev/null +++ b/ckCmds.c @@ -0,0 +1,1112 @@ +/* + * ckCmds.c -- + * + * This file contains a collection of Ck-related Tcl commands + * that didn't fit in any particular file of the toolkit. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +static char * WaitVariableProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); +static void WaitVisibilityProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static void WaitWindowProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); + + +/* + *---------------------------------------------------------------------- + * + * Ck_DestroyCmd -- + * + * This procedure is invoked to process the "destroy" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_DestroyCmd(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. */ +{ + CkWindow *winPtr; + CkWindow *mainPtr = (CkWindow *) clientData; + int i; + + for (i = 1; i < argc; i++) { + winPtr = Ck_NameToWindow(interp, argv[i], mainPtr); + if (winPtr == NULL) + return TCL_ERROR; + Ck_DestroyWindow(winPtr); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_ExitCmd -- + * + * This procedure is invoked to process the "exit" Tcl command. + * See the user documentation for details on what it does. + * Note: this command replaces the Tcl "exit" command in order + * to properly destroy all windows. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_ExitCmd(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. */ +{ + extern CkMainInfo *ckMainInfo; + int index = 1, noclear = 0, value = 0; + + if (argc > 3) { +badArgs: + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ?-noclear? ?returnCode?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc > 1 && strcmp(argv[1], "-noclear") == 0) { + index++; + noclear++; + } + if (argc > index && + Tcl_GetInt(interp, argv[index], &value) != TCL_OK) { + return TCL_ERROR; + } + + if (ckMainInfo != NULL) { + if (noclear) { + ckMainInfo->flags |= CK_NOCLR_ON_EXIT; + } else { + ckMainInfo->flags &= ~CK_NOCLR_ON_EXIT; + } + Ck_DestroyWindow((CkWindow *) clientData); + } + endwin(); /* just in case */ +#if (TCL_MAJOR_VERSION >= 8) + Tcl_Exit(value); +#else + exit(value); +#endif + /* NOTREACHED */ + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_LowerCmd -- + * + * This procedure is invoked to process the "lower" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_LowerCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + CkWindow *winPtr, *other; + + if ((argc != 2) && (argc != 3)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " window ?belowThis?\"", (char *) NULL); + return TCL_ERROR; + } + + winPtr = Ck_NameToWindow(interp, argv[1], mainPtr); + if (winPtr == NULL) + return TCL_ERROR; + if (argc == 2) + other = NULL; + else { + other = Ck_NameToWindow(interp, argv[2], mainPtr); + if (other == NULL) + return TCL_ERROR; + } + if (Ck_RestackWindow(winPtr, CK_BELOW, other) != TCL_OK) { + Tcl_AppendResult(interp, "can't lower \"", argv[1], "\" below \"", + argv[2], "\"", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_RaiseCmd -- + * + * This procedure is invoked to process the "raise" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_RaiseCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + CkWindow *winPtr, *other; + + if ((argc != 2) && (argc != 3)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " window ?aboveThis?\"", (char *) NULL); + return TCL_ERROR; + } + + winPtr = Ck_NameToWindow(interp, argv[1], mainPtr); + if (winPtr == NULL) + return TCL_ERROR; + if (argc == 2) + other = NULL; + else { + other = Ck_NameToWindow(interp, argv[2], mainPtr); + if (other == NULL) + return TCL_ERROR; + } + if (Ck_RestackWindow(winPtr, CK_ABOVE, other) != TCL_OK) { + Tcl_AppendResult(interp, "can't raise \"", argv[1], "\" above \"", + argv[2], "\"", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_BellCmd -- + * + * This procedure is invoked to process the "bell" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_BellCmd(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. */ +{ + beep(); + doupdate(); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_UpdateCmd -- + * + * This procedure is invoked to process the "update" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_UpdateCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + int flags; + + if (argc == 1) + flags = TK_DONT_WAIT; + else if (argc == 2) { + if (strncmp(argv[1], "screen", strlen(argv[1])) == 0) { + wrefresh(curscr); + Ck_EventuallyRefresh(mainPtr); + return TCL_OK; + } + if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) { + Tcl_AppendResult(interp, "bad argument \"", argv[1], + "\": must be idletasks or screen", (char *) NULL); + return TCL_ERROR; + } + flags = TK_IDLE_EVENTS; + } else { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " ?idletasks|screen?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Handle all pending events, and repeat over and over + * again until all pending events have been handled. + */ + + while (Tk_DoOneEvent(flags) != 0) { + /* Empty loop body */ + } + + /* + * Must clear the interpreter's result because event handlers could + * have executed commands. + */ + + Tcl_ResetResult(interp); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_CursesCmd -- + * + * This procedure is invoked to process the "curses" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_CursesCmd(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. */ +{ + CkWindow *winPtr = (CkWindow *) clientData; + CkMainInfo *mainPtr = winPtr->mainPtr; + int length; + char c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'b') && (strncmp(argv[1], "barcode", length) == 0)) { + return CkBarcodeCmd(clientData, interp, argc, argv); + } else if ((c == 'b') && (strncmp(argv[1], "baudrate", length) == 0)) { + char buf[32]; + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0], + " ", argv[1], "\"", (char *) NULL); + return TCL_ERROR; + } + sprintf(buf, "%d", baudrate()); + Tcl_AppendResult(interp, buf, (char *) NULL); + return TCL_OK; + } else if ((c == 'e') && (strncmp(argv[1], "encoding", length) == 0)) { + if (argc == 2) + return Ck_GetEncoding(interp); + else if (argc == 3) + return Ck_SetEncoding(interp, argv[2]); + else { + Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0], + " ", argv[1], " ?name?\"", (char *) NULL); + return TCL_ERROR; + } + } else if ((c == 'g') && (strncmp(argv[1], "gchar", length) == 0)) { + int gchar; + + if (argc == 3) { + if (Ck_GetGChar(interp, argv[2], &gchar) != TCL_OK) + return TCL_ERROR; + sprintf(interp->result, "%d", gchar); + } else if (argc == 4) { + if (Tcl_GetInt(interp, argv[3], &gchar) != TCL_OK) + return TCL_ERROR; + if (Ck_SetGChar(interp, argv[2], gchar) != TCL_OK) + return TCL_ERROR; + } else { + Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0], + " ", argv[1], " charName ?value?\"", (char *) NULL); + return TCL_ERROR; + } + } else if ((c == 'h') && (strncmp(argv[1], "haskey", length) == 0)) { + if (argc > 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " haskey ?keySym?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 2) + return CkAllKeyNames(interp); + return CkTermHasKey(interp, argv[2]); + } else if ((c == 'p') && (strncmp(argv[1], "purgeinput", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " purgeinput\"", (char *) NULL); + return TCL_ERROR; + } + while (getch() != ERR) { + /* Empty loop body. */ + } + return TCL_OK; + } else if ((c == 'r') && (strncmp(argv[1], "refreshdelay", length) == 0)) { + if (argc == 2) { + char buf[32]; + + sprintf(buf, "%d", mainPtr->refreshDelay); + Tcl_AppendResult(interp, buf, (char *) NULL); + return TCL_OK; + } else if (argc == 3) { + int delay; + + if (Tcl_GetInt(interp, argv[2], &delay) != TCL_OK) + return TCL_ERROR; + mainPtr->refreshDelay = delay < 0 ? 0 : delay; + return TCL_OK; + } else { + Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0], + " ", argv[1], " ?milliseconds?\"", (char *) NULL); + return TCL_ERROR; + } + } else if ((c == 'r') && (strncmp(argv[1], "reversekludge", length) + == 0)) { + int onoff; + + if (argc == 2) { + interp->result = (mainPtr->flags & CK_REVERSE_KLUDGE) ? + "1" : "0"; + } else if (argc == 3) { + if (Tcl_GetBoolean(interp, argv[2], &onoff) != TCL_OK) + return TCL_ERROR; + mainPtr->flags |= CK_REVERSE_KLUDGE; + } else { + Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0], + " ", argv[1], " ?bool?\"", (char *) NULL); + return TCL_ERROR; + } + } else if ((c == 's') && (strncmp(argv[1], "screendump", length) == 0)) { + Tcl_DString buffer; + char *fileName; +#ifdef HAVE_SCR_DUMP + int ret; +#endif + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0], + " ", argv[1], " filename\"", (char *) NULL); + return TCL_ERROR; + } + fileName = Tcl_TildeSubst(interp, argv[2], &buffer); + if (fileName == NULL) { + Tcl_DStringFree(&buffer); + return TCL_ERROR; + } +#ifdef HAVE_SCR_DUMP + ret = scr_dump(fileName); + Tcl_DStringFree(&buffer); + if (ret != OK) { + interp->result = "screen dump failed"; + return TCL_ERROR; + } + return TCL_OK; +#else + interp->result = "screen dump not supported by this curses"; + return TCL_ERROR; +#endif + } else if ((c == 's') && (strncmp(argv[1], "suspend", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0], + " ", argv[1], "\"", (char *) NULL); + return TCL_ERROR; + } +#if !defined(__WIN32__) && !defined(DJGPP) + curs_set(1); + endwin(); +#ifdef SIGTSTP + kill(getpid(), SIGTSTP); +#else + kill(getpid(), SIGSTOP); +#endif + Ck_EventuallyRefresh(winPtr); +#endif + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be barcode, baudrate, encoding, gchar, haskey, ", + "purgeinput, refreshdelay, reversekludge, screendump or suspend", + (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_WinfoCmd -- + * + * This procedure is invoked to process the "winfo" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_WinfoCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + int length; + char c, *argName; + CkWindow *winPtr; + +#define SETUP(name) \ + if (argc != 3) {\ + argName = name; \ + goto wrongArgs; \ + } \ + winPtr = Ck_NameToWindow(interp, argv[2], mainPtr); \ + if (winPtr == NULL) { \ + return TCL_ERROR; \ + } + + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'c') && (strncmp(argv[1], "children", length) == 0) + && (length >= 2)) { + SETUP("children"); + for (winPtr = winPtr->childList; winPtr != NULL; + winPtr = winPtr->nextPtr) { + Tcl_AppendElement(interp, winPtr->pathName); + } + } else if ((c == 'c') && (strncmp(argv[1], "containing", length) == 0) + && (length >= 2)) { + int x, y; + + argName = "containing"; + if (argc != 4) + goto wrongArgs; + if (Tcl_GetInt(interp, argv[2], &x) != TCL_OK || + Tcl_GetInt(interp, argv[3], &y) != TCL_OK) { + return TCL_ERROR; + } + winPtr = Ck_GetWindowXY(mainPtr->mainPtr, &x, &y, 0); + if (winPtr != NULL) { + interp->result = winPtr->pathName; + } + } else if ((c == 'd') && (strncmp(argv[1], "depth", length) == 0)) { + SETUP("depth"); + interp->result = (winPtr->mainPtr->flags & CK_HAS_COLOR) ? "3" : "1"; + } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)) { + if (argc != 3) { + argName = "exists"; + goto wrongArgs; + } + if (Ck_NameToWindow(interp, argv[2], mainPtr) == NULL) { + interp->result = "0"; + } else { + interp->result = "1"; + } + } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)) { + SETUP("geometry"); + sprintf(interp->result, "%dx%d+%d+%d", winPtr->width, + winPtr->height, winPtr->x, winPtr->y); + } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) { + SETUP("height"); + sprintf(interp->result, "%d", winPtr->height); + } else if ((c == 'i') && (strncmp(argv[1], "ismapped", length) == 0) + && (length >= 2)) { + SETUP("ismapped"); + interp->result = (winPtr->flags & CK_MAPPED) ? "1" : "0"; + } else if ((c == 'm') && (strncmp(argv[1], "manager", length) == 0)) { + SETUP("manager"); + if (winPtr->geomMgrPtr != NULL) + interp->result = winPtr->geomMgrPtr->name; + } else if ((c == 'n') && (strncmp(argv[1], "name", length) == 0)) { + SETUP("name"); + interp->result = (char *) winPtr->nameUid; + } else if ((c == 'c') && (strncmp(argv[1], "class", length) == 0)) { + SETUP("class"); + interp->result = (char *) winPtr->classUid; + } else if ((c == 'p') && (strncmp(argv[1], "parent", length) == 0)) { + SETUP("parent"); + if (winPtr->parentPtr != NULL) + interp->result = winPtr->parentPtr->pathName; + } else if ((c == 'r') && (strncmp(argv[1], "reqheight", length) == 0) + && (length >= 4)) { + SETUP("reqheight"); + sprintf(interp->result, "%d", winPtr->reqHeight); + } else if ((c == 'r') && (strncmp(argv[1], "reqwidth", length) == 0) + && (length >= 4)) { + SETUP("reqwidth"); + sprintf(interp->result, "%d", winPtr->reqWidth); + } else if ((c == 'r') && (strncmp(argv[1], "rootx", length) == 0) + && (length >= 4)) { + int x; + + SETUP("rootx"); + Ck_GetRootGeometry(winPtr, &x, NULL, NULL, NULL); + sprintf(interp->result, "%d", x); + } else if ((c == 'r') && (strncmp(argv[1], "rooty", length) == 0) + && (length >= 4)) { + int y; + + SETUP("rooty"); + Ck_GetRootGeometry(winPtr, NULL, &y, NULL, NULL); + sprintf(interp->result, "%d", y); + } else if ((c == 's') && (strncmp(argv[1], "screenheight", length) == 0) + && (length >= 7)) { + SETUP("screenheight"); + sprintf(interp->result, "%d", winPtr->mainPtr->winPtr->height); + } else if ((c == 's') && (strncmp(argv[1], "screenwidth", length) == 0) + && (length >= 7)) { + SETUP("screenwidth"); + sprintf(interp->result, "%d", winPtr->mainPtr->winPtr->width); + } else if ((c == 't') && (strncmp(argv[1], "toplevel", length) == 0)) { + SETUP("toplevel"); + for (; winPtr != NULL; winPtr = winPtr->parentPtr) { + if (winPtr->flags & CK_TOPLEVEL) { + interp->result = winPtr->pathName; + break; + } + } + } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) { + SETUP("width"); + sprintf(interp->result, "%d", winPtr->width); + } else if ((c == 'x') && (argv[1][1] == '\0')) { + SETUP("x"); + sprintf(interp->result, "%d", winPtr->x); + } else if ((c == 'y') && (argv[1][1] == '\0')) { + SETUP("y"); + sprintf(interp->result, "%d", winPtr->y); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be children, class, containing, depth ", + "exists, geometry, height, ", + "ismapped, manager, name, parent, ", + "reqheight, reqwidth, rootx, rooty, ", + "screenheight, screenwidth, ", + "toplevel, width, x, or y", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; + + wrongArgs: + Tcl_AppendResult(interp, "wrong # arguments: must be \"", + argv[0], " ", argName, " window\"", (char *) NULL); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_BindCmd -- + * + * This procedure is invoked to process the "bind" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_BindCmd(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. */ +{ + CkWindow *mainWin = (CkWindow *) clientData; + CkWindow *winPtr; + ClientData object; + + if ((argc < 2) || (argc > 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " window ?pattern? ?command?\"", (char *) NULL); + return TCL_ERROR; + } + if (argv[1][0] == '.') { + winPtr = (CkWindow *) Ck_NameToWindow(interp, argv[1], mainWin); + if (winPtr == NULL) { + return TCL_ERROR; + } + object = (ClientData) winPtr->pathName; + } else { + winPtr = (CkWindow *) clientData; + object = (ClientData) Ck_GetUid(argv[1]); + } + + if (argc == 4) { + int append = 0; + + if (argv[3][0] == 0) { + return Ck_DeleteBinding(interp, winPtr->mainPtr->bindingTable, + object, argv[2]); + } + if (argv[3][0] == '+') { + argv[3]++; + append = 1; + } + if (Ck_CreateBinding(interp, winPtr->mainPtr->bindingTable, + object, argv[2], argv[3], append) != TCL_OK) { + return TCL_ERROR; + } + } else if (argc == 3) { + char *command; + + command = Ck_GetBinding(interp, winPtr->mainPtr->bindingTable, + object, argv[2]); + if (command == NULL) { + Tcl_ResetResult(interp); + return TCL_OK; + } + interp->result = command; + } else { + Ck_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CkBindEventProc -- + * + * This procedure is invoked by Ck_HandleEvent for each event; it + * causes any appropriate bindings for that event to be invoked. + * + * Results: + * None. + * + * Side effects: + * Depends on what bindings have been established with the "bind" + * command. + * + *---------------------------------------------------------------------- + */ + +void +CkBindEventProc(winPtr, eventPtr) + CkWindow *winPtr; /* Pointer to info about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ +#define MAX_OBJS 20 + ClientData objects[MAX_OBJS], *objPtr; + static Ck_Uid allUid = NULL; + int i, count; + char *p; + Tcl_HashEntry *hPtr; + CkWindow *topLevPtr; + + if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) { + return; + } + + objPtr = objects; + if (winPtr->numTags != 0) { + /* + * Make a copy of the tags for the window, replacing window names + * with pointers to the pathName from the appropriate window. + */ + + if (winPtr->numTags > MAX_OBJS) { + objPtr = (ClientData *) ckalloc(winPtr->numTags * + sizeof (ClientData)); + } + for (i = 0; i < winPtr->numTags; i++) { + p = (char *) winPtr->tagPtr[i]; + if (*p == '.') { + hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p); + if (hPtr != NULL) { + p = ((CkWindow *) Tcl_GetHashValue(hPtr))->pathName; + } else { + p = NULL; + } + } + objPtr[i] = (ClientData) p; + } + count = winPtr->numTags; + } else { + objPtr[0] = (ClientData) winPtr->pathName; + objPtr[1] = (ClientData) winPtr->classUid; + for (topLevPtr = winPtr; topLevPtr != NULL && + !(topLevPtr->flags & CK_TOPLEVEL); + topLevPtr = topLevPtr->parentPtr) { + /* Empty loop body. */ + } + if (winPtr != topLevPtr && topLevPtr != NULL) { + objPtr[2] = (ClientData) topLevPtr->pathName; + count = 4; + } else + count = 3; + if (allUid == NULL) { + allUid = Ck_GetUid("all"); + } + objPtr[count - 1] = (ClientData) allUid; + } + Ck_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, winPtr, + count, objPtr); + if (objPtr != objects) { + ckfree((char *) objPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * Ck_BindtagsCmd -- + * + * This procedure is invoked to process the "bindtags" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_BindtagsCmd(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. */ +{ + CkWindow *mainWin = (CkWindow *) clientData; + CkWindow *winPtr, *winPtr2; + int i, tagArgc; + char *p, **tagArgv; + + if ((argc < 2) || (argc > 3)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " window ?tags?\"", (char *) NULL); + return TCL_ERROR; + } + winPtr = (CkWindow *) Ck_NameToWindow(interp, argv[1], mainWin); + if (winPtr == NULL) { + return TCL_ERROR; + } + if (argc == 2) { + if (winPtr->numTags == 0) { + Tcl_AppendElement(interp, winPtr->pathName); + Tcl_AppendElement(interp, winPtr->classUid); + for (winPtr2 = winPtr; winPtr2 != NULL && + !(winPtr2->flags & CK_TOPLEVEL); + winPtr2 = winPtr2->parentPtr) { + /* Empty loop body. */ + } + if (winPtr != winPtr2 && winPtr2 != NULL) + Tcl_AppendElement(interp, winPtr2->pathName); + Tcl_AppendElement(interp, "all"); + } else { + for (i = 0; i < winPtr->numTags; i++) { + Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]); + } + } + return TCL_OK; + } + if (winPtr->tagPtr != NULL) { + CkFreeBindingTags(winPtr); + } + if (argv[2][0] == 0) { + return TCL_OK; + } + if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) { + return TCL_ERROR; + } + winPtr->numTags = tagArgc; + winPtr->tagPtr = (ClientData *) ckalloc(tagArgc * sizeof(ClientData)); + for (i = 0; i < tagArgc; i++) { + p = tagArgv[i]; + if (p[0] == '.') { + char *copy; + + /* + * Handle names starting with "." specially: store a malloc'ed + * string, rather than a Uid; at event time we'll look up the + * name in the window table and use the corresponding window, + * if there is one. + */ + + copy = (char *) ckalloc((unsigned) (strlen(p) + 1)); + strcpy(copy, p); + winPtr->tagPtr[i] = (ClientData) copy; + } else { + winPtr->tagPtr[i] = (ClientData) Ck_GetUid(p); + } + } + ckfree((char *) tagArgv); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CkFreeBindingTags -- + * + * This procedure is called to free all of the binding tags + * associated with a window; typically it is only invoked where + * there are window-specific tags. + * + * Results: + * None. + * + * Side effects: + * Any binding tags for winPtr are freed. + * + *---------------------------------------------------------------------- + */ + +void +CkFreeBindingTags(winPtr) + CkWindow *winPtr; /* Window whose tags are to be released. */ +{ + int i; + char *p; + + for (i = 0; i < winPtr->numTags; i++) { + p = (char *) (winPtr->tagPtr[i]); + if (*p == '.') { + /* + * Names starting with "." are malloced rather than Uids, so + * they have to be freed. + */ + + ckfree(p); + } + } + ckfree((char *) winPtr->tagPtr); + winPtr->numTags = 0; + winPtr->tagPtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_TkwaitCmd -- + * + * This procedure is invoked to process the "tkwait" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_TkwaitCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + int c, done; + size_t length; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " variable|visible|window name\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0) + && (length >= 2)) { + if (Tcl_TraceVar(interp, argv[2], + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc, (ClientData) &done) != TCL_OK) { + return TCL_ERROR; + } + done = 0; + while (!done) { + Tk_DoOneEvent(0); + } + Tcl_UntraceVar(interp, argv[2], + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc, (ClientData) &done); + } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0) + && (length >= 2)) { + CkWindow *winPtr; + + winPtr = Ck_NameToWindow(interp, argv[2], mainPtr); + if (winPtr == NULL) { + return TCL_ERROR; + } + Ck_CreateEventHandler(winPtr, + CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY, + WaitVisibilityProc, (ClientData) &done); + done = 0; + while (!done) { + Tk_DoOneEvent(0); + } + Ck_DeleteEventHandler(winPtr, + CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY, + WaitVisibilityProc, (ClientData) &done); + } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) { + CkWindow *winPtr; + + winPtr = Ck_NameToWindow(interp, argv[2], mainPtr); + if (winPtr == NULL) { + return TCL_ERROR; + } + Ck_CreateEventHandler(winPtr, CK_EV_DESTROY, + WaitWindowProc, (ClientData) &done); + done = 0; + while (!done) { + Tk_DoOneEvent(0); + } + /* + * Note: there's no need to delete the event handler. It was + * deleted automatically when the window was destroyed. + */ + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be variable, visibility, or window", (char *) NULL); + return TCL_ERROR; + } + + /* + * Clear out the interpreter's result, since it may have been set + * by event handlers. + */ + + Tcl_ResetResult(interp); + return TCL_OK; +} + +static char * +WaitVariableProc(clientData, interp, name1, name2, flags) + ClientData clientData; /* Pointer to integer to set to 1. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Name of variable. */ + char *name2; /* Second part of variable name. */ + int flags; /* Information about what happened. */ +{ + int *donePtr = (int *) clientData; + + *donePtr = 1; + return (char *) NULL; +} + +static void +WaitVisibilityProc(clientData, eventPtr) + ClientData clientData; /* Pointer to integer to set to 1. */ + CkEvent *eventPtr; /* Information about event (not used). */ +{ + int *donePtr = (int *) clientData; + + *donePtr = 1; +} + +static void +WaitWindowProc(clientData, eventPtr) + ClientData clientData; /* Pointer to integer to set to 1. */ + CkEvent *eventPtr; /* Information about event. */ +{ + int *donePtr = (int *) clientData; + + if (eventPtr->type == CK_EV_DESTROY) { + *donePtr = 1; + } +} diff --git a/ckConfig.c b/ckConfig.c new file mode 100644 index 0000000..3c39676 --- /dev/null +++ b/ckConfig.c @@ -0,0 +1,831 @@ +/* + * ckConfig.c -- + * + * This file contains the Ck_ConfigureWidget procedure. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * Values for "flags" field of Ck_ConfigSpec structures. Be sure + * to coordinate these values with those defined in ck.h + * (CK_CONFIG_*). There must not be overlap! + * + * INIT - Non-zero means (char *) things have been + * converted to Ck_Uid's. + */ + +#define INIT 0x20 + +/* + * Forward declarations for procedures defined later in this file: + */ + +static int DoConfig _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, Ck_ConfigSpec *specPtr, + Ck_Uid value, int valueIsUid, char *widgRec)); +static Ck_ConfigSpec * FindConfigSpec _ANSI_ARGS_ ((Tcl_Interp *interp, + Ck_ConfigSpec *specs, char *argvName, + int needFlags, int hateFlags)); +static char * FormatConfigInfo _ANSI_ARGS_ ((Tcl_Interp *interp, + CkWindow *winPtr, Ck_ConfigSpec *specPtr, + char *widgRec)); +static char * FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *tkwin, Ck_ConfigSpec *specPtr, + char *widgRec, char *buffer, + Tcl_FreeProc **freeProcPtr)); + +/* + *-------------------------------------------------------------- + * + * Ck_ConfigureWidget -- + * + * Process command-line options to fill in fields of a + * widget record with resources and other parameters. + * + * Results: + * A standard Tcl return value. In case of an error, + * interp->result will hold an error message. + * + * Side effects: + * The fields of widgRec get filled in with information + * from argc/argv. Old information in widgRec's fields + * gets recycled. + * + *-------------------------------------------------------------- + */ + +int +Ck_ConfigureWidget(interp, winPtr, specs, argc, argv, widgRec, flags) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + CkWindow *winPtr; /* Window containing widget. */ + Ck_ConfigSpec *specs; /* Describes legal options. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Command-line options. */ + char *widgRec; /* Record whose fields are to be + * modified. Values must be properly + * initialized. */ + int flags; /* Used to specify additional flags + * that must be present in config specs + * for them to be considered. Also, + * may have CK_CONFIG_ARGV_ONLY set. */ +{ + Ck_ConfigSpec *specPtr; + Ck_Uid value; /* Value of option from database. */ + int needFlags; /* Specs must contain this set of flags + * or else they are not considered. */ + int hateFlags; /* If a spec contains any bits here, it's + * not considered. */ + + needFlags = flags & ~(CK_CONFIG_USER_BIT - 1); + if (!(winPtr->mainPtr->flags & CK_HAS_COLOR)) { + hateFlags = CK_CONFIG_COLOR_ONLY; + } else { + hateFlags = CK_CONFIG_MONO_ONLY; + } + + /* + * Pass one: scan through all the option specs, replacing strings + * with Ck_Uids (if this hasn't been done already) and clearing + * the CK_CONFIG_OPTION_SPECIFIED flags. + */ + + for (specPtr = specs; specPtr->type != CK_CONFIG_END; specPtr++) { + if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) { + if (specPtr->dbName != NULL) { + specPtr->dbName = Ck_GetUid(specPtr->dbName); + } + if (specPtr->dbClass != NULL) { + specPtr->dbClass = Ck_GetUid(specPtr->dbClass); + } + if (specPtr->defValue != NULL) { + specPtr->defValue = Ck_GetUid(specPtr->defValue); + } + } + specPtr->specFlags = (specPtr->specFlags & ~CK_CONFIG_OPTION_SPECIFIED) + | INIT; + } + + /* + * Pass two: scan through all of the arguments, processing those + * that match entries in the specs. + */ + + for ( ; argc > 0; argc -= 2, argv += 2) { + specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags); + if (specPtr == NULL) { + return TCL_ERROR; + } + + /* + * Process the entry. + */ + + if (argc < 2) { + Tcl_AppendResult(interp, "value for \"", *argv, + "\" missing", (char *) NULL); + return TCL_ERROR; + } + if (DoConfig(interp, winPtr, specPtr, argv[1], 0, widgRec) != TCL_OK) { + char msg[100]; + + sprintf(msg, "\n (processing \"%.40s\" option)", + specPtr->argvName); + Tcl_AddErrorInfo(interp, msg); + return TCL_ERROR; + } + specPtr->specFlags |= CK_CONFIG_OPTION_SPECIFIED; + } + + /* + * Pass three: scan through all of the specs again; if no + * command-line argument matched a spec, then check for info + * in the option database. If there was nothing in the + * database, then use the default. + */ + + if (!(flags & CK_CONFIG_ARGV_ONLY)) { + for (specPtr = specs; specPtr->type != CK_CONFIG_END; specPtr++) { + if ((specPtr->specFlags & CK_CONFIG_OPTION_SPECIFIED) + || (specPtr->argvName == NULL) + || (specPtr->type == CK_CONFIG_SYNONYM)) { + continue; + } + if (((specPtr->specFlags & needFlags) != needFlags) + || (specPtr->specFlags & hateFlags)) { + continue; + } + value = NULL; + if (specPtr->dbName != NULL) { + value = Ck_GetOption(winPtr, specPtr->dbName, + specPtr->dbClass); + } + if (value != NULL) { + if (DoConfig(interp, winPtr, specPtr, value, 1, widgRec) != + TCL_OK) { + char msg[200]; + + sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", + "database entry for", + specPtr->dbName, winPtr->pathName); + Tcl_AddErrorInfo(interp, msg); + return TCL_ERROR; + } + } else { + value = specPtr->defValue; + if ((value != NULL) && !(specPtr->specFlags + & CK_CONFIG_DONT_SET_DEFAULT)) { + if (DoConfig(interp, winPtr, specPtr, value, 1, widgRec) != + TCL_OK) { + char msg[200]; + + sprintf(msg, + "\n (%s \"%.50s\" in widget \"%.50s\")", + "default value for", + specPtr->dbName, winPtr->pathName); + Tcl_AddErrorInfo(interp, msg); + return TCL_ERROR; + } + } + } + } + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * FindConfigSpec -- + * + * Search through a table of configuration specs, looking for + * one that matches a given argvName. + * + * Results: + * The return value is a pointer to the matching entry, or NULL + * if nothing matched. In that case an error message is left + * in interp->result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static Ck_ConfigSpec * +FindConfigSpec(interp, specs, argvName, needFlags, hateFlags) + Tcl_Interp *interp; /* Used for reporting errors. */ + Ck_ConfigSpec *specs; /* Pointer to table of configuration + * specifications for a widget. */ + char *argvName; /* Name (suitable for use in a "config" + * command) identifying particular option. */ + int needFlags; /* Flags that must be present in matching + * entry. */ + int hateFlags; /* Flags that must NOT be present in + * matching entry. */ +{ + Ck_ConfigSpec *specPtr; + char c; /* First character of current argument. */ + Ck_ConfigSpec *matchPtr; /* Matching spec, or NULL. */ + int length; + + c = argvName[1]; + length = strlen(argvName); + matchPtr = NULL; + for (specPtr = specs; specPtr->type != CK_CONFIG_END; specPtr++) { + if (specPtr->argvName == NULL) { + continue; + } + if ((specPtr->argvName[1] != c) + || (strncmp(specPtr->argvName, argvName, length) != 0)) { + continue; + } + if (((specPtr->specFlags & needFlags) != needFlags) + || (specPtr->specFlags & hateFlags)) { + continue; + } + if (specPtr->argvName[length] == 0) { + matchPtr = specPtr; + goto gotMatch; + } + if (matchPtr != NULL) { + Tcl_AppendResult(interp, "ambiguous option \"", argvName, + "\"", (char *) NULL); + return (Ck_ConfigSpec *) NULL; + } + matchPtr = specPtr; + } + + if (matchPtr == NULL) { + Tcl_AppendResult(interp, "unknown option \"", argvName, + "\"", (char *) NULL); + return (Ck_ConfigSpec *) NULL; + } + + /* + * Found a matching entry. If it's a synonym, then find the + * entry that it's a synonym for. + */ + + gotMatch: + specPtr = matchPtr; + if (specPtr->type == CK_CONFIG_SYNONYM) { + for (specPtr = specs; ; specPtr++) { + if (specPtr->type == CK_CONFIG_END) { + Tcl_AppendResult(interp, + "couldn't find synonym for option \"", + argvName, "\"", (char *) NULL); + return (Ck_ConfigSpec *) NULL; + } + if ((specPtr->dbName == matchPtr->dbName) + && (specPtr->type != CK_CONFIG_SYNONYM) + && ((specPtr->specFlags & needFlags) == needFlags) + && !(specPtr->specFlags & hateFlags)) { + break; + } + } + } + return specPtr; +} + +/* + *-------------------------------------------------------------- + * + * DoConfig -- + * + * This procedure applies a single configuration option + * to a widget record. + * + * Results: + * A standard Tcl return value. + * + * Side effects: + * WidgRec is modified as indicated by specPtr and value. + * The old value is recycled, if that is appropriate for + * the value type. + * + *-------------------------------------------------------------- + */ + +static int +DoConfig(interp, winPtr, specPtr, value, valueIsUid, widgRec) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + CkWindow *winPtr; /* Window containing widget. */ + Ck_ConfigSpec *specPtr; /* Specifier to apply. */ + char *value; /* Value to use to fill in widgRec. */ + int valueIsUid; /* Non-zero means value is a Tk_Uid; + * zero means it's an ordinary string. */ + char *widgRec; /* Record whose fields are to be + * modified. Values must be properly + * initialized. */ +{ + char *ptr; + Ck_Uid uid; + int nullValue; + + nullValue = 0; + if ((*value == 0) && (specPtr->specFlags & CK_CONFIG_NULL_OK)) { + nullValue = 1; + } + + do { + ptr = widgRec + specPtr->offset; + switch (specPtr->type) { + case CK_CONFIG_BOOLEAN: + if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case CK_CONFIG_INT: + if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case CK_CONFIG_DOUBLE: + if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case CK_CONFIG_STRING: { + char *old, *new; + + if (nullValue) { + new = NULL; + } else { + new = (char *) ckalloc((unsigned) (strlen(value) + 1)); + strcpy(new, value); + } + old = *((char **) ptr); + if (old != NULL) { + ckfree(old); + } + *((char **) ptr) = new; + break; + } + case CK_CONFIG_UID: + if (nullValue) { + *((Ck_Uid *) ptr) = NULL; + } else { + uid = valueIsUid ? (Ck_Uid) value : Ck_GetUid(value); + *((Ck_Uid *) ptr) = uid; + } + break; + case CK_CONFIG_COLOR: { + int color; + + uid = valueIsUid ? (Ck_Uid) value : Ck_GetUid(value); + if (Ck_GetColor(interp, (char *) value, &color) != TCL_OK) + return TCL_ERROR; + *((int *) ptr) = color; + break; + } + case CK_CONFIG_BORDER: { + CkBorder *new, *old; + + if (nullValue) { + new = NULL; + } else { + uid = valueIsUid ? (Ck_Uid) value : Ck_GetUid(value); + new = Ck_GetBorder(interp, uid); + if (new == NULL) { + return TCL_ERROR; + } + } + old = *((CkBorder **) ptr); + if (old != NULL) { + Ck_FreeBorder(old); + } + *((CkBorder **) ptr) = new; + break; + } + case CK_CONFIG_JUSTIFY: + uid = valueIsUid ? (Ck_Uid) value : Ck_GetUid(value); + if (Ck_GetJustify(interp, uid, (Ck_Justify *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case CK_CONFIG_ANCHOR: + uid = valueIsUid ? (Ck_Uid) value : Ck_GetUid(value); + if (Ck_GetAnchor(interp, uid, (Ck_Anchor *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case CK_CONFIG_COORD: + if (Ck_GetCoord(interp, winPtr, value, (int *) ptr) != TCL_OK) + return TCL_ERROR; + break; + case CK_CONFIG_ATTR: + if (Ck_GetAttr(interp, value, (int *) ptr) != TCL_OK) + return TCL_ERROR; + break; + case CK_CONFIG_WINDOW: { + CkWindow *winPtr2; + + if (nullValue) { + winPtr2 = NULL; + } else { + winPtr2 = Ck_NameToWindow(interp, value, winPtr); + if (winPtr2 == NULL) { + return TCL_ERROR; + } + } + *((CkWindow **) ptr) = winPtr2; + break; + } + case CK_CONFIG_CUSTOM: + if ((*specPtr->customPtr->parseProc)( + specPtr->customPtr->clientData, interp, winPtr, + value, widgRec, specPtr->offset) != TCL_OK) { + return TCL_ERROR; + } + break; + default: { + sprintf(interp->result, "bad config table: unknown type %d", + specPtr->type); + return TCL_ERROR; + } + } + specPtr++; + } while ((specPtr->argvName == NULL) && (specPtr->type != CK_CONFIG_END)); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Ck_ConfigureInfo -- + * + * Return information about the configuration options + * for a window, and their current values. + * + * Results: + * Always returns TCL_OK. Interp->result will be modified + * hold a description of either a single configuration option + * available for "widgRec" via "specs", or all the configuration + * options available. In the "all" case, the result will + * available for "widgRec" via "specs". The result will + * be a list, each of whose entries describes one option. + * Each entry will itself be a list containing the option's + * name for use on command lines, database name, database + * class, default value, and current value (empty string + * if none). For options that are synonyms, the list will + * contain only two values: name and synonym name. If the + * "name" argument is non-NULL, then the only information + * returned is that for the named argument (i.e. the corresponding + * entry in the overall list is returned). + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Ck_ConfigureInfo(interp, winPtr, specs, widgRec, argvName, flags) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + CkWindow *winPtr; /* Window corresponding to widgRec. */ + Ck_ConfigSpec *specs; /* Describes legal options. */ + char *widgRec; /* Record whose fields contain current + * values for options. */ + char *argvName; /* If non-NULL, indicates a single option + * whose info is to be returned. Otherwise + * info is returned for all options. */ + int flags; /* Used to specify additional flags + * that must be present in config specs + * for them to be considered. */ +{ + Ck_ConfigSpec *specPtr; + int needFlags, hateFlags; + char *list; + char *leader = "{"; + + needFlags = flags & ~(CK_CONFIG_USER_BIT - 1); + if (!(winPtr->mainPtr->flags & CK_HAS_COLOR)) { + hateFlags = CK_CONFIG_COLOR_ONLY; + } else { + hateFlags = CK_CONFIG_MONO_ONLY; + } + + /* + * If information is only wanted for a single configuration + * spec, then handle that one spec specially. + */ + + Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); + if (argvName != NULL) { + specPtr = FindConfigSpec(interp, specs, argvName, needFlags, + hateFlags); + if (specPtr == NULL) { + return TCL_ERROR; + } + interp->result = FormatConfigInfo(interp, winPtr, specPtr, widgRec); + interp->freeProc = (Tcl_FreeProc *) free; + return TCL_OK; + } + + /* + * Loop through all the specs, creating a big list with all + * their information. + */ + + for (specPtr = specs; specPtr->type != CK_CONFIG_END; specPtr++) { + if ((argvName != NULL) && (specPtr->argvName != argvName)) { + continue; + } + if (((specPtr->specFlags & needFlags) != needFlags) + || (specPtr->specFlags & hateFlags)) { + continue; + } + if (specPtr->argvName == NULL) { + continue; + } + list = FormatConfigInfo(interp, winPtr, specPtr, widgRec); + Tcl_AppendResult(interp, leader, list, "}", (char *) NULL); + ckfree(list); + leader = " {"; + } + return TCL_OK; +} +/* + *---------------------------------------------------------------------- + * + * Ck_ConfigureValue -- + * + * This procedure returns the current value of a configuration + * option for a widget. + * + * Results: + * The return value is a standard Tcl completion code (TCL_OK or + * TCL_ERROR). Interp->result will be set to hold either the value + * of the option given by argvName (if TCL_OK is returned) or + * an error message (if TCL_ERROR is returned). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Ck_ConfigureValue(interp, winPtr, specs, widgRec, argvName, flags) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + CkWindow *winPtr; /* Window corresponding to widgRec. */ + Ck_ConfigSpec *specs; /* Describes legal options. */ + char *widgRec; /* Record whose fields contain current + * values for options. */ + char *argvName; /* Gives the command-line name for the + * option whose value is to be returned. */ + int flags; /* Used to specify additional flags + * that must be present in config specs + * for them to be considered. */ +{ + Ck_ConfigSpec *specPtr; + int needFlags, hateFlags; + + needFlags = flags & ~(CK_CONFIG_USER_BIT - 1); + if (winPtr->mainPtr->flags & CK_HAS_COLOR) + hateFlags = CK_CONFIG_MONO_ONLY; + else + hateFlags = CK_CONFIG_COLOR_ONLY; + specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags); + if (specPtr == NULL) { + return TCL_ERROR; + } + interp->result = FormatConfigValue(interp, winPtr, specPtr, widgRec, + interp->result, &interp->freeProc); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * FormatConfigInfo -- + * + * Create a valid Tcl list holding the configuration information + * for a single configuration option. + * + * Results: + * A Tcl list, dynamically allocated. The caller is expected to + * arrange for this list to be freed eventually. + * + * Side effects: + * Memory is allocated. + * + *-------------------------------------------------------------- + */ + +static char * +FormatConfigInfo(interp, winPtr, specPtr, widgRec) + Tcl_Interp *interp; /* Interpreter to use for things + * like floating-point precision. */ + CkWindow *winPtr; /* Window corresponding to widget. */ + Ck_ConfigSpec *specPtr; /* Pointer to information describing + * option. */ + char *widgRec; /* Pointer to record holding current + * values of info for widget. */ +{ + char *argv[6], *result; + char buffer[200]; + Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL; + + argv[0] = specPtr->argvName; + argv[1] = specPtr->dbName; + argv[2] = specPtr->dbClass; + argv[3] = specPtr->defValue; + if (specPtr->type == CK_CONFIG_SYNONYM) { + return Tcl_Merge(2, argv); + } + argv[4] = FormatConfigValue(interp, winPtr, specPtr, widgRec, buffer, + &freeProc); + if (argv[1] == NULL) { + argv[1] = ""; + } + if (argv[2] == NULL) { + argv[2] = ""; + } + if (argv[3] == NULL) { + argv[3] = ""; + } + if (argv[4] == NULL) { + argv[4] = ""; + } + result = Tcl_Merge(5, argv); + if (freeProc != NULL) { + if (freeProc == (Tcl_FreeProc *) free) { + ckfree(argv[4]); + } else { + (*freeProc)(argv[4]); + } + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * FormatConfigValue -- + * + * This procedure formats the current value of a configuration + * option. + * + * Results: + * The return value is the formatted value of the option given + * by specPtr and widgRec. If the value is static, so that it + * need not be freed, *freeProcPtr will be set to NULL; otherwise + * *freeProcPtr will be set to the address of a procedure to + * free the result, and the caller must invoke this procedure + * when it is finished with the result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static char * +FormatConfigValue(interp, winPtr, specPtr, widgRec, buffer, freeProcPtr) + Tcl_Interp *interp; /* Interpreter for use in real conversions. */ + CkWindow *winPtr; /* Window corresponding to widget. */ + Ck_ConfigSpec *specPtr; /* Pointer to information describing option. + * Must not point to a synonym option. */ + char *widgRec; /* Pointer to record holding current + * values of info for widget. */ + char *buffer; /* Static buffer to use for small values. + * Must have at least 200 bytes of storage. */ + Tcl_FreeProc **freeProcPtr; /* Pointer to word to fill in with address + * of procedure to free the result, or NULL + * if result is static. */ +{ + char *ptr, *result; + + *freeProcPtr = NULL; + ptr = widgRec + specPtr->offset; + result = ""; + switch (specPtr->type) { + case CK_CONFIG_BOOLEAN: + if (*((int *) ptr) == 0) { + result = "0"; + } else { + result = "1"; + } + break; + case CK_CONFIG_INT: + case CK_CONFIG_COORD: + sprintf(buffer, "%d", *((int *) ptr)); + result = buffer; + break; + case CK_CONFIG_DOUBLE: + Tcl_PrintDouble(interp, *((double *) ptr), buffer); + result = buffer; + break; + case CK_CONFIG_STRING: + result = (*(char **) ptr); + if (result == NULL) + result = ""; + break; + case CK_CONFIG_UID: { + Ck_Uid uid = *((Ck_Uid *) ptr); + if (uid != NULL) { + result = uid; + } + break; + } + case CK_CONFIG_COLOR: { + result = Ck_NameOfColor(*((int *) ptr)); + break; + } + case CK_CONFIG_BORDER: { + CkBorder *borderPtr = *((CkBorder **) ptr); + if (borderPtr != NULL) { + result = Ck_NameOfBorder(borderPtr); + } + break; + } + case CK_CONFIG_JUSTIFY: + result = Ck_NameOfJustify(*((Ck_Justify *) ptr)); + break; + case CK_CONFIG_ANCHOR: + result = Ck_NameOfAnchor(*((Ck_Anchor *) ptr)); + break; + case CK_CONFIG_ATTR: + result = Ck_NameOfAttr(*(int *) ptr); + *freeProcPtr = (Tcl_FreeProc *) free; + break; + case CK_CONFIG_WINDOW: { + CkWindow *winPtr2; + + winPtr2 = *((CkWindow **) ptr); + if (winPtr2 != NULL) { + result = winPtr2->pathName; + } + break; + } + case CK_CONFIG_CUSTOM: + result = (*specPtr->customPtr->printProc)( + specPtr->customPtr->clientData, winPtr, widgRec, + specPtr->offset, freeProcPtr); + break; + default: + result = "?? unknown type ??"; + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_FreeOptions -- + * + * Free up all resources associated with configuration options. + * + * Results: + * None. + * + * Side effects: + * Any resource in widgRec that is controlled by a configuration + * option is freed in the appropriate fashion. + * + *---------------------------------------------------------------------- + */ + +void +Ck_FreeOptions(specs, widgRec, needFlags) + Ck_ConfigSpec *specs; /* Describes legal options. */ + char *widgRec; /* Record whose fields contain current + * values for options. */ + int needFlags; /* Used to specify additional flags + * that must be present in config specs + * for them to be considered. */ +{ + Ck_ConfigSpec *specPtr; + char *ptr; + + for (specPtr = specs; specPtr->type != CK_CONFIG_END; specPtr++) { + if ((specPtr->specFlags & needFlags) != needFlags) { + continue; + } + ptr = widgRec + specPtr->offset; + switch (specPtr->type) { + case CK_CONFIG_STRING: + if (*((char **) ptr) != NULL) { + ckfree(*((char **) ptr)); + *((char **) ptr) = NULL; + } + break; + case CK_CONFIG_BORDER: + if (*((CkBorder **) ptr) != NULL) { + Ck_FreeBorder(*((CkBorder **) ptr)); + *((CkBorder **) ptr) = NULL; + } + break; + } + } +} diff --git a/ckConfig.sh.in b/ckConfig.sh.in new file mode 100644 index 0000000..7d7e17f --- /dev/null +++ b/ckConfig.sh.in @@ -0,0 +1,39 @@ +# ckConfig.sh -- +# +# This shell script (for sh) is generated automatically by Ck's +# configure script. It will create shell variables for most of +# the configuration options discovered by the configure script. +# This script is intended to be included by the configure scripts +# for Ck extensions so that they don't have to figure this all +# out for themselves. +# +# The information in this file is specific to a single platform. +# +# $Id: ckConfig.sh.in,v 1.1 2006-02-24 18:59:53 vitus Exp $ + +# Ck's version number. +CK_VERSION='@CK_VERSION@' +CK_MAJOR_VERSION='@CK_MAJOR_VERSION@' +CK_MINOR_VERSION='@CK_MINOR_VERSION@' + +# -D flags for use with the C compiler. +CK_DEFS='@DEFS@' + +# The name of the Ck library (may be either a .a file or a shared library): +CK_LIB_FILE=@CK_LIB_FILE@ + +# Additional libraries to use when linking Ck. +CK_LIBS='@CURSESLIBSW@ @DL_LIBS@ @LIBS@ @MATH_LIBS@' + +# Top-level directory in which Ck's files are installed. +CK_PREFIX='@prefix@' + +# Top-level directory in which Tcl's platform-specific files (e.g. +# executables) are installed. +CK_EXEC_PREFIX='@exec_prefix@' + +# -I switch(es) where to find curses include files +CK_CURSESINCLUDES='@CURSESINCLUDES@ @USE_NCURSES@' + +# Linker switch(es) to use when linking with curses +CK_CURSESLIBSW='@CURSESLIBSW@' diff --git a/ckEntry.c b/ckEntry.c new file mode 100644 index 0000000..51a2300 --- /dev/null +++ b/ckEntry.c @@ -0,0 +1,1724 @@ +/* + * ckEntry.c -- + * + * This module implements entry widgets for the + * toolkit. An entry displays a string and allows + * the string to be edited. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +/* + * A data structure of the following type is kept for each entry + * widget managed by this file: + */ + +typedef struct { + CkWindow *winPtr; /* Window that embodies the entry. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with entry. */ + Tcl_Command widgetCmd; /* Token for entry's widget command. */ +#if CK_USE_UTF + int numBytes; /* Number of bytes in string. */ +#endif + int numChars; /* Number of non-NULL characters in + * string (may be 0). */ + char *string; /* Pointer to storage for string; + * NULL-terminated; malloc-ed. */ + char *textVarName; /* Name of variable (malloc'ed) or NULL. + * If non-NULL, entry's string tracks the + * contents of this variable and vice versa. */ + Ck_Uid state; /* Normal or disabled. Entry is read-only + * when disabled. */ + + /* + * Information used when displaying widget: + */ + + int normalBg; /* Normal background color. */ + int normalFg; /* Normal foreground color. */ + int normalAttr; /* Normal video attributes. */ + int selBg; /* Select background color. */ + int selFg; /* Select foreground color. */ + int selAttr; /* Select video attributes. */ + Ck_Justify justify; /* Justification to use for text within + * window. */ + int leftX; /* X position at which leftIndex is drawn + * (varies depending on justify). */ + int leftIndex; /* Index of left-most character visible in + * window. */ + int tabOrigin; /* Origin for tabs (left edge of string[0]). */ + int insertPos; /* Index of character before which next + * typed character will be inserted. */ + char *showChar; /* Value of -show option. If non-NULL, first + * character is used for displaying all + * characters in entry. Malloc'ed. */ + char *displayString; /* If non-NULL, points to string with same + * length as string but whose characters + * are all equal to showChar. Malloc'ed. */ + int prefWidth; /* Preferred width for window. */ + + /* + * Information about what's selected, if any. + */ + + int selectFirst; /* Index of first selected character (-1 means + * nothing selected. */ + int selectLast; /* Index of last selected character (-1 means + * nothing selected. */ + int selectAnchor; /* Fixed end of selection (i.e. "select to" + * operation will use this as one end of the + * selection). */ + + /* + * Miscellaneous information: + */ + + char *takeFocus; /* Value of -takefocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + char *scrollCmd; /* Command prefix for communicating with + * scrollbar(s). Malloc'ed. NULL means + * no command to issue. */ + int flags; /* Miscellaneous flags; see below for + * definitions. */ +} Entry; + +/* + * Assigned bits of "flags" fields of Entry structures, and what those + * bits mean: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has + * already been queued to redisplay the entry. + * GOT_FOCUS: Non-zero means this window has the input + * focus. + * UPDATE_SCROLLBAR: Non-zero means scrollbar should be updated + * during next redisplay operation. + */ + +#define REDRAW_PENDING 1 +#define GOT_FOCUS 2 +#define UPDATE_SCROLLBAR 4 + +/* + * Information used for argv parsing. + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_ENTRY_ATTR, Ck_Offset(Entry, normalAttr), 0}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_ENTRY_BG_COLOR, Ck_Offset(Entry, normalBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_ENTRY_BG_MONO, Ck_Offset(Entry, normalBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_ENTRY_FG, Ck_Offset(Entry, normalFg), 0}, + {CK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", + DEF_ENTRY_JUSTIFY, Ck_Offset(Entry, justify), 0}, + {CK_CONFIG_ATTR, "-selectattributes", "selectAttributes", + "SelectAttributes", DEF_ENTRY_SELECT_ATTR_COLOR, + Ck_Offset(Entry, selAttr), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-selectattributes", "selectAttributes", + "SelectAttributes", DEF_ENTRY_SELECT_ATTR_MONO, + Ck_Offset(Entry, selAttr), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-selectbackground", "selectBackground", "Foreground", + DEF_ENTRY_SELECT_BG_COLOR, Ck_Offset(Entry, selBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectbackground", "selectBackground", "Foreground", + DEF_ENTRY_SELECT_BG_MONO, Ck_Offset(Entry, selBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_ENTRY_SELECT_FG_COLOR, Ck_Offset(Entry, selFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_ENTRY_SELECT_FG_MONO, Ck_Offset(Entry, selFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_STRING, "-show", "show", "Show", + DEF_ENTRY_SHOW, Ck_Offset(Entry, showChar), CK_CONFIG_NULL_OK}, + {CK_CONFIG_UID, "-state", "state", "State", + DEF_ENTRY_STATE, Ck_Offset(Entry, state), 0}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_ENTRY_TAKE_FOCUS, Ck_Offset(Entry, takeFocus), CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", + DEF_ENTRY_TEXT_VARIABLE, Ck_Offset(Entry, textVarName), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_INT, "-width", "width", "Width", + DEF_ENTRY_WIDTH, Ck_Offset(Entry, prefWidth), 0}, + {CK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", + DEF_ENTRY_SCROLL_COMMAND, Ck_Offset(Entry, scrollCmd), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Flags for GetEntryIndex procedure: + */ + +#define ZERO_OK 1 +#define LAST_PLUS_ONE_OK 2 + +/* + * Forward declarations for procedures defined later in this file: + */ + +static int ConfigureEntry _ANSI_ARGS_((Tcl_Interp *interp, + Entry *entryPtr, int argc, char **argv, + int flags)); +static void DeleteChars _ANSI_ARGS_((Entry *entryPtr, int index, + int count)); +static void DestroyEntry _ANSI_ARGS_((ClientData clientData)); +static void DisplayEntry _ANSI_ARGS_((ClientData clientData)); +static void EntryComputeGeometry _ANSI_ARGS_((Entry *entryPtr)); +static void EntryEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static void EntryFocusProc _ANSI_ARGS_ ((Entry *entryPtr, + int gotFocus)); +static void EventuallyRedraw _ANSI_ARGS_((Entry *entryPtr)); +static void EntryCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void EntrySetValue _ANSI_ARGS_((Entry *entryPtr, + char *value)); +static void EntrySelectTo _ANSI_ARGS_(( + Entry *entryPtr, int index)); +static char * EntryTextVarProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); +static void EntryUpdateScrollbar _ANSI_ARGS_((Entry *entryPtr)); +static void EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr, + double *firstPtr, double *lastPtr)); +static int EntryWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int GetEntryIndex _ANSI_ARGS_((Tcl_Interp *interp, + Entry *entryPtr, char *string, int *indexPtr)); +static void InsertChars _ANSI_ARGS_((Entry *entryPtr, int index, + char *string)); + +/* + *-------------------------------------------------------------- + * + * Ck_EntryCmd -- + * + * This procedure is invoked to process the "entry" Tcl + * command. See the user documentation for details on what + * it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_EntryCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + register Entry *entryPtr; + CkWindow *new; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + new = Ck_CreateWindowFromPath(interp, mainPtr, argv[1], 0); + if (new == NULL) { + return TCL_ERROR; + } + + /* + * Initialize the fields of the structure that won't be initialized + * by ConfigureEntry, or that ConfigureEntry requires to be + * initialized already (e.g. resource pointers). + */ + + entryPtr = (Entry *) ckalloc(sizeof (Entry)); + entryPtr->winPtr = new; + entryPtr->interp = interp; + entryPtr->widgetCmd = Tcl_CreateCommand(interp, + entryPtr->winPtr->pathName, EntryWidgetCmd, + (ClientData) entryPtr, EntryCmdDeletedProc); +#if CK_USE_UTF + entryPtr->numBytes = 0; +#endif + entryPtr->numChars = 0; + entryPtr->string = (char *) ckalloc(1); + entryPtr->string[0] = '\0'; + entryPtr->textVarName = NULL; + entryPtr->state = ckNormalUid; + entryPtr->normalBg = 0; + entryPtr->normalFg = 0; + entryPtr->normalAttr = 0; + entryPtr->selBg = 0; + entryPtr->selFg = 0; + entryPtr->selAttr = 0; + entryPtr->justify = CK_JUSTIFY_LEFT; + entryPtr->prefWidth = 0; + entryPtr->leftIndex = 0; + entryPtr->tabOrigin = 0; + entryPtr->insertPos = 0; + entryPtr->showChar = NULL; + entryPtr->displayString = NULL; + entryPtr->prefWidth = 1; + entryPtr->selectFirst = -1; + entryPtr->selectLast = -1; + entryPtr->selectAnchor = 0; + entryPtr->takeFocus = NULL; + entryPtr->scrollCmd = NULL; + entryPtr->flags = 0; + + Ck_SetClass(entryPtr->winPtr, "Entry"); + Ck_CreateEventHandler(entryPtr->winPtr, + CK_EV_EXPOSE | CK_EV_MAP | CK_EV_DESTROY, + EntryEventProc, (ClientData) entryPtr); + if (ConfigureEntry(interp, entryPtr, argc-2, argv+2, 0) != TCL_OK) { + goto error; + } + + interp->result = entryPtr->winPtr->pathName; + return TCL_OK; + + error: + Ck_DestroyWindow(entryPtr->winPtr); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * EntryWidgetCmd -- + * + * 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. + * + *-------------------------------------------------------------- + */ + +static int +EntryWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about entry widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + register Entry *entryPtr = (Entry *) clientData; + int result = TCL_OK; + size_t length; + int c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Ck_Preserve((ClientData) entryPtr); + c = argv[1][0]; + length = strlen(argv[1]); + 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 = Ck_ConfigureValue(interp, entryPtr->winPtr, configSpecs, + (char *) entryPtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 2)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, entryPtr->winPtr, configSpecs, + (char *) entryPtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, entryPtr->winPtr, configSpecs, + (char *) entryPtr, argv[2], 0); + } else { + result = ConfigureEntry(interp, entryPtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) { + int first, last; + + if ((argc < 3) || (argc > 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " delete firstIndex ?lastIndex?\"", + (char *) NULL); + goto error; + } + if (GetEntryIndex(interp, entryPtr, argv[2], &first) != TCL_OK) { + goto error; + } + if (argc == 3) { + last = first+1; + } else { + if (GetEntryIndex(interp, entryPtr, argv[3], &last) != TCL_OK) { + goto error; + } + } + if ((last >= first) && (entryPtr->state == ckNormalUid)) { + DeleteChars(entryPtr, first, last-first); + } + } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " get\"", (char *) NULL); + goto error; + } + interp->result = entryPtr->string; + } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0) + && (length >= 2)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " icursor pos\"", + (char *) NULL); + goto error; + } + if (GetEntryIndex(interp, entryPtr, argv[2], &entryPtr->insertPos) + != TCL_OK) { + goto error; + } + EventuallyRedraw(entryPtr); + } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) + && (length >= 3)) { + int index; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " index string\"", (char *) NULL); + goto error; + } + if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) { + goto error; + } + sprintf(interp->result, "%d", index); + } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) + && (length >= 3)) { + int index; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " insert index text\"", + (char *) NULL); + goto error; + } + if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) { + goto error; + } + if (entryPtr->state == ckNormalUid) { + InsertChars(entryPtr, index, argv[3]); + } + } else if ((c == 's') && (length >= 2) + && (strncmp(argv[1], "selection", length) == 0)) { + int index, index2; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " select option ?index?\"", (char *) NULL); + goto error; + } + length = strlen(argv[2]); + c = argv[2][0]; + if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection clear\"", (char *) NULL); + goto error; + } + if (entryPtr->selectFirst != -1) { + entryPtr->selectFirst = entryPtr->selectLast = -1; + EventuallyRedraw(entryPtr); + } + goto done; + } else if ((c == 'p') && (strncmp(argv[2], "present", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection present\"", (char *) NULL); + goto error; + } + if (entryPtr->selectFirst == -1) { + interp->result = "0"; + } else { + interp->result = "1"; + } + goto done; + } + if (argc >= 4) { + if (GetEntryIndex(interp, entryPtr, argv[3], &index) != TCL_OK) { + goto error; + } + } + if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection adjust index\"", + (char *) NULL); + goto error; + } + if (entryPtr->selectFirst >= 0) { + int half1, half2; + + half1 = (entryPtr->selectFirst + entryPtr->selectLast)/2; + half2 = (entryPtr->selectFirst + entryPtr->selectLast + 1)/2; + if (index < half1) { + entryPtr->selectAnchor = entryPtr->selectLast; + } else if (index > half2) { + entryPtr->selectAnchor = entryPtr->selectFirst; + } else { + /* + * We're at about the halfway point in the selection; + * just keep the existing anchor. + */ + } + } + EntrySelectTo(entryPtr, index); + } else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection from index\"", + (char *) NULL); + goto error; + } + entryPtr->selectAnchor = index; + } else if ((c == 'r') && (strncmp(argv[2], "range", length) == 0)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection range start end\"", + (char *) NULL); + goto error; + } + if (GetEntryIndex(interp, entryPtr, argv[4], &index2) != TCL_OK) { + goto error; + } + if (index >= index2) { + entryPtr->selectFirst = entryPtr->selectLast = -1; + } else { + entryPtr->selectFirst = index; + entryPtr->selectLast = index2; + } + EventuallyRedraw(entryPtr); + } else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection to index\"", + (char *) NULL); + goto error; + } + EntrySelectTo(entryPtr, index); + } else { + Tcl_AppendResult(interp, "bad selection option \"", argv[2], + "\": must be adjust, clear, from, present, range, or to", + (char *) NULL); + goto error; + } + } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { + int index, type, count, charsPerPage; + double fraction, first, last; + + if (argc == 2) { + EntryVisibleRange(entryPtr, &first, &last); + sprintf(interp->result, "%g %g", first, last); + goto done; + } else if (argc == 3) { + if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) { + goto error; + } + } else { + type = Ck_GetScrollInfo(interp, argc, argv, &fraction, &count); + index = entryPtr->leftIndex; + switch (type) { + case CK_SCROLL_ERROR: + goto error; + case CK_SCROLL_MOVETO: + index = (int) (fraction * entryPtr->numChars); + break; + case CK_SCROLL_PAGES: + charsPerPage = entryPtr->winPtr->width - 2; + if (charsPerPage < 1) + charsPerPage = 1; + index += charsPerPage*count; + break; + case CK_SCROLL_UNITS: + index += count; + break; + } + } + if (index >= entryPtr->numChars) { + index = entryPtr->numChars-1; + } + if (index < 0) { + index = 0; + } + entryPtr->leftIndex = index; + entryPtr->flags |= UPDATE_SCROLLBAR; + EntryComputeGeometry(entryPtr); + EventuallyRedraw(entryPtr); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be cget, configure, delete, get, ", + "icursor, index, insert, selection, or xview", + (char *) NULL); + goto error; + } +done: + Ck_Release((ClientData) entryPtr); + return result; + +error: + Ck_Release((ClientData) entryPtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyEntry -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of an entry at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the entry is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyEntry(clientData) + ClientData clientData; /* Info about entry widget. */ +{ + Entry *entryPtr = (Entry *) clientData; + + /* + * Free up all the stuff that requires special handling, then + * let Ck_FreeOptions handle all the standard option-related + * stuff. + */ + + ckfree(entryPtr->string); + if (entryPtr->textVarName != NULL) { + Tcl_UntraceVar(entryPtr->interp, entryPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + EntryTextVarProc, (ClientData) entryPtr); + } + if (entryPtr->displayString != NULL) { + ckfree(entryPtr->displayString); + } + Ck_FreeOptions(configSpecs, (char *) entryPtr, 0); + ckfree((char *) entryPtr); +} + +/* + *---------------------------------------------------------------------- + * + * EntryCmdDeletedProc -- + * + * 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 +EntryCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + Entry *entryPtr = (Entry *) clientData; + CkWindow *winPtr = entryPtr->winPtr; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case winPtr + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (winPtr != NULL) { + entryPtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureEntry -- + * + * This procedure is called to process an argv/argc list, plus + * the Tk option database, in order to configure (or reconfigure) + * an entry widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as colors, border width, + * etc. get set for entryPtr; old resources get freed, + * if there were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureEntry(interp, entryPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + register Entry *entryPtr; /* 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. */ +{ + /* + * Eliminate any existing trace on a variable monitored by the entry. + */ + + if (entryPtr->textVarName != NULL) { + Tcl_UntraceVar(interp, entryPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + EntryTextVarProc, (ClientData) entryPtr); + } + + if (Ck_ConfigureWidget(interp, entryPtr->winPtr, configSpecs, + argc, argv, (char *) entryPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * If the entry is tied to the value of a variable, then set up + * a trace on the variable's value, create the variable if it doesn't + * exist, and set the entry's value from the variable's value. + */ + + if (entryPtr->textVarName != NULL) { + char *value; + + value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY); + if (value == NULL) { + Tcl_SetVar(interp, entryPtr->textVarName, entryPtr->string, + TCL_GLOBAL_ONLY); + } else { + EntrySetValue(entryPtr, value); + } + Tcl_TraceVar(interp, entryPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + EntryTextVarProc, (ClientData) entryPtr); + } + + /* + * A few other options also need special processing, such as parsing + * the geometry and setting the colors. + */ + + if ((entryPtr->state != ckNormalUid) + && (entryPtr->state != ckDisabledUid)) { + Tcl_AppendResult(interp, "bad state value \"", entryPtr->state, + "\": must be normal or disabled", (char *) NULL); + entryPtr->state = ckNormalUid; + return TCL_ERROR; + } + + /* + * Recompute the window's geometry and arrange for it to be + * redisplayed. + */ + + EntryComputeGeometry(entryPtr); + entryPtr->flags |= UPDATE_SCROLLBAR; + EventuallyRedraw(entryPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DisplayEntry -- + * + * This procedure redraws the contents of an entry window. + * + * Results: + * None. + * + * Side effects: + * Information appears on the screen. + * + *-------------------------------------------------------------- + */ + +static void +DisplayEntry(clientData) + ClientData clientData; /* Information about window. */ +{ + register Entry *entryPtr = (Entry *) clientData; + CkWindow *winPtr = entryPtr->winPtr; + int y, startX, leftIndex, selectFirst, selectLast, insertPos, dummy; + char *displayString; + + entryPtr->flags &= ~REDRAW_PENDING; + if ((entryPtr->winPtr == NULL) || !(winPtr->flags & CK_MAPPED)) + return; + + /* + * Update the scrollbar if that's needed. + */ + + if (entryPtr->flags & UPDATE_SCROLLBAR) { + EntryUpdateScrollbar(entryPtr); + } + + /* + * Compute x-coordinate of the pixel just after last visible + * one, plus vertical position of baseline of text. + */ + + y = winPtr->height / 2; + + if (entryPtr->displayString == NULL) { + displayString = entryPtr->string; + } else { + displayString = entryPtr->displayString; + } + + Ck_SetWindowAttr(winPtr, entryPtr->normalFg, entryPtr->normalBg, + entryPtr->normalAttr); + Ck_ClearToBot(winPtr, 0, 0); + +#if CK_USE_UTF + leftIndex = Tcl_UtfAtIndex(displayString, entryPtr->leftIndex) - + displayString; + selectFirst = Tcl_UtfAtIndex(displayString, entryPtr->selectFirst) - + displayString; + selectLast = Tcl_UtfAtIndex(displayString, entryPtr->selectLast) - + displayString; + insertPos = Tcl_UtfAtIndex(displayString, entryPtr->insertPos) - + displayString; +#else + leftIndex = entryPtr->leftIndex; + selectFirst = entryPtr->selectFirst; + selectLast = entryPtr->selectLast; + insertPos = entryPtr->insertPos; +#endif + + CkDisplayChars(winPtr->mainPtr, winPtr->window, + displayString + leftIndex, + strlen(displayString) - leftIndex, + entryPtr->leftX, y, entryPtr->tabOrigin, + CK_NEWLINES_NOT_SPECIAL); + + if (entryPtr->selectLast >= entryPtr->leftIndex) { + if (entryPtr->selectFirst < entryPtr->leftIndex) { + startX = 0; + } else { + CkMeasureChars(winPtr->mainPtr, + displayString + leftIndex, + selectFirst - leftIndex, entryPtr->leftX, + winPtr->width, entryPtr->tabOrigin, CK_NEWLINES_NOT_SPECIAL, + &startX, &dummy); + } + if (startX < winPtr->width) { + Ck_SetWindowAttr(winPtr, entryPtr->selFg, entryPtr->selBg, + entryPtr->selAttr); + wmove(winPtr->window, y, startX + entryPtr->leftX); + CkDisplayChars(winPtr->mainPtr, winPtr->window, + displayString + selectFirst, + selectLast - selectFirst, + entryPtr->leftX + startX, y, entryPtr->tabOrigin, + CK_NEWLINES_NOT_SPECIAL); + Ck_SetWindowAttr(winPtr, entryPtr->normalFg, entryPtr->normalBg, + entryPtr->normalAttr); + } + } + + CkMeasureChars(winPtr->mainPtr, displayString + leftIndex, + insertPos - leftIndex, entryPtr->leftX, + winPtr->width, entryPtr->tabOrigin, CK_NEWLINES_NOT_SPECIAL, + &startX, &dummy); + + if (startX >= 0 && startX < winPtr->width) { + wmove(winPtr->window, y, startX); + if (entryPtr->state == ckNormalUid) + Ck_SetHWCursor(winPtr, 1); + else + Ck_SetHWCursor(winPtr, 0); + } else { + wmove(winPtr->window, y, 0); + Ck_SetHWCursor(winPtr, 0); + } + + Ck_EventuallyRefresh(winPtr); +} + +/* + *---------------------------------------------------------------------- + * + * EntryComputeGeometry -- + * + * This procedure is invoked to recompute information about where + * in its window an entry's string will be displayed. It also + * computes the requested size for the window. + * + * Results: + * None. + * + * Side effects: + * The tabOrigin fields are recomputed for entryPtr, + * and leftIndex may be adjusted. Ck_GeometryRequest is called + * to register the desired dimensions for the window. + * + *---------------------------------------------------------------------- + */ + +static void +EntryComputeGeometry(entryPtr) + Entry *entryPtr; /* Widget record for entry. */ +{ + int totalLength, overflow, maxOffScreen; + int width, i, rightX, dummy; + char *p, *displayString; + CkWindow *winPtr = entryPtr->winPtr; + + /* + * If we're displaying a special character instead of the value of + * the entry, recompute the displayString. + */ + + if (entryPtr->displayString != NULL) { + ckfree(entryPtr->displayString); + entryPtr->displayString = NULL; + } + if (entryPtr->showChar != NULL) { +#if CK_USE_UTF + int ulen; + + entryPtr->displayString = (char *) ckalloc(entryPtr->numChars * 3 + 1); + ulen = Tcl_UtfNext(entryPtr->showChar) - entryPtr->showChar; + for (p = entryPtr->displayString, i = entryPtr->numChars; i > 0; + i--) { + memcpy(p, entryPtr->showChar, ulen); + p += ulen; + } +#else + entryPtr->displayString = (char *) ckalloc(entryPtr->numChars + 1); + for (p = entryPtr->displayString, i = entryPtr->numChars; i > 0; + i--, p++) { + *p = entryPtr->showChar[0]; + } +#endif + *p = 0; + displayString = entryPtr->displayString; + } else { + displayString = entryPtr->string; + } + + /* + * Recompute where the leftmost character on the display will + * be drawn (entryPtr->leftX) and adjust leftIndex if necessary + * so that we don't let characters hang off the edge of the + * window unless the entire window is full. + */ + + CkMeasureChars(winPtr->mainPtr, displayString, strlen(displayString), + 0, INT_MAX, 0, + CK_NEWLINES_NOT_SPECIAL, &totalLength, &dummy); + if (entryPtr->insertPos == entryPtr->numChars) + totalLength += 1; + overflow = totalLength - entryPtr->winPtr->width; + if (overflow < 0) { + entryPtr->leftIndex = 0; + if (entryPtr->justify == CK_JUSTIFY_LEFT) { + entryPtr->leftX = 0; + } else if (entryPtr->justify == CK_JUSTIFY_RIGHT) { + entryPtr->leftX = entryPtr->winPtr->width - totalLength; + } else { + entryPtr->leftX = (entryPtr->winPtr->width - totalLength) / 2; + } + entryPtr->tabOrigin = entryPtr->leftX; + } else { + int leftIndex; + + /* + * The whole string can't fit in the window. Compute the + * maximum number of characters that may be off-screen to + * the left without leaving empty space on the right of the + * window, then don't let leftIndex be any greater than that. + */ + + maxOffScreen = CkMeasureChars(winPtr->mainPtr, + displayString, strlen(displayString), + 0, overflow, 0, CK_NEWLINES_NOT_SPECIAL|CK_PARTIAL_OK, &rightX, + &dummy); + if (rightX < overflow) { + maxOffScreen += 1; + } + if (entryPtr->leftIndex > maxOffScreen) { + entryPtr->leftIndex = maxOffScreen; + } +#if CK_USE_UTF + leftIndex = Tcl_UtfAtIndex(displayString, entryPtr->leftIndex) - + displayString; +#else + leftIndex = entryPtr->leftIndex; +#endif + CkMeasureChars(winPtr->mainPtr, displayString, leftIndex, + 0, INT_MAX, 0, + CK_NEWLINES_NOT_SPECIAL|CK_PARTIAL_OK, &rightX, &dummy); + entryPtr->leftX = 0; + entryPtr->tabOrigin = entryPtr->leftX - rightX; + } + + if (entryPtr->prefWidth > 0) { + width = entryPtr->prefWidth; + } else if (totalLength == 0) { + width = 1; + } else { + width = totalLength; + } + Ck_GeometryRequest(entryPtr->winPtr, width, 1); +} + +/* + *---------------------------------------------------------------------- + * + * InsertChars -- + * + * Add new characters to an entry widget. + * + * Results: + * None. + * + * Side effects: + * New information gets added to entryPtr; it will be redisplayed + * soon, but not necessarily immediately. + * + *---------------------------------------------------------------------- + */ + +static void +InsertChars(entryPtr, index, string) + register Entry *entryPtr; /* Entry that is to get the new + * elements. */ + int index; /* Add the new elements before this + * element. */ + char *string; /* New characters to add (NULL-terminated + * string). */ +{ + int length, clength; + char *new; +#if CK_USE_UTF + int inspos; +#endif + + length = strlen(string); + if (length == 0) { + return; + } +#if CK_USE_UTF + clength = Tcl_NumUtfChars(string, -1); + new = (char *) ckalloc((unsigned) (entryPtr->numBytes + length + 1)); + inspos = Tcl_UtfAtIndex(entryPtr->string, index) - entryPtr->string; + strncpy(new, entryPtr->string, (size_t) inspos); + strcpy(new+inspos, string); + strcpy(new+inspos+length, entryPtr->string+inspos); + ckfree(entryPtr->string); + entryPtr->string = new; + entryPtr->numChars += clength; + entryPtr->numBytes += length; +#else + clength = length; + new = (char *) ckalloc((unsigned) (entryPtr->numChars + length + 1)); + strncpy(new, entryPtr->string, (size_t) index); + strcpy(new+index, string); + strcpy(new+index+length, entryPtr->string+index); + ckfree(entryPtr->string); + entryPtr->string = new; + entryPtr->numChars += length; +#endif + + /* + * Inserting characters invalidates all indexes into the string. + * Touch up the indexes so that they still refer to the same + * characters (at new positions). When updating the selection + * end-points, don't include the new text in the selection unless + * it was completely surrounded by the selection. + */ + + if (entryPtr->selectFirst >= index) { + entryPtr->selectFirst += clength; + } + if (entryPtr->selectLast > index) { + entryPtr->selectLast += clength; + } + if ((entryPtr->selectAnchor > index) || (entryPtr->selectFirst >= index)) { + entryPtr->selectAnchor += clength; + } + if (entryPtr->leftIndex > index) { + entryPtr->leftIndex += clength; + } + if (entryPtr->insertPos >= index) { + entryPtr->insertPos += clength; + } + + if (entryPtr->textVarName != NULL) { + Tcl_SetVar(entryPtr->interp, entryPtr->textVarName, entryPtr->string, + TCL_GLOBAL_ONLY); + } + entryPtr->flags |= UPDATE_SCROLLBAR; + EntryComputeGeometry(entryPtr); + EventuallyRedraw(entryPtr); +} + +/* + *---------------------------------------------------------------------- + * + * DeleteChars -- + * + * Remove one or more characters from an entry widget. + * + * Results: + * None. + * + * Side effects: + * Memory gets freed, the entry gets modified and (eventually) + * redisplayed. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteChars(entryPtr, index, count) + register Entry *entryPtr; /* Entry widget to modify. */ + int index; /* Index of first character to delete. */ + int count; /* How many characters to delete. */ +{ + char *new; +#if CK_USE_UTF + int delpos, delcount; +#endif + + if ((index + count) > entryPtr->numChars) { + count = entryPtr->numChars - index; + } + if (count <= 0) { + return; + } + +#if CK_USE_UTF + delpos = Tcl_UtfAtIndex(entryPtr->string, index) - entryPtr->string; + delcount = Tcl_UtfAtIndex(entryPtr->string + delpos, count) - + (entryPtr->string + delpos); + new = (char *) ckalloc((unsigned) (entryPtr->numBytes + 1 - delcount)); + strncpy(new, entryPtr->string, (size_t) delpos); + strcpy(new+delpos, entryPtr->string+delpos+delcount); + entryPtr->numChars = Tcl_NumUtfChars(new, -1); + entryPtr->numBytes = strlen(new); +#else + new = (char *) ckalloc((unsigned) (entryPtr->numChars + 1 - count)); + strncpy(new, entryPtr->string, (size_t) index); + strcpy(new+index, entryPtr->string+index+count); + entryPtr->numChars -= count; +#endif + ckfree(entryPtr->string); + entryPtr->string = new; + + /* + * Deleting characters results in the remaining characters being + * renumbered. Update the various indexes into the string to reflect + * this change. + */ + + if (entryPtr->selectFirst >= index) { + if (entryPtr->selectFirst >= (index+count)) { + entryPtr->selectFirst -= count; + } else { + entryPtr->selectFirst = index; + } + } + if (entryPtr->selectLast >= index) { + if (entryPtr->selectLast >= (index+count)) { + entryPtr->selectLast -= count; + } else { + entryPtr->selectLast = index; + } + } + if (entryPtr->selectLast <= entryPtr->selectFirst) { + entryPtr->selectFirst = entryPtr->selectLast = -1; + } + if (entryPtr->selectAnchor >= index) { + if (entryPtr->selectAnchor >= (index+count)) { + entryPtr->selectAnchor -= count; + } else { + entryPtr->selectAnchor = index; + } + } + if (entryPtr->leftIndex > index) { + if (entryPtr->leftIndex >= (index+count)) { + entryPtr->leftIndex -= count; + } else { + entryPtr->leftIndex = index; + } + } + if (entryPtr->insertPos >= index) { + if (entryPtr->insertPos >= (index+count)) { + entryPtr->insertPos -= count; + } else { + entryPtr->insertPos = index; + } + } + + if (entryPtr->textVarName != NULL) { + Tcl_SetVar(entryPtr->interp, entryPtr->textVarName, entryPtr->string, + TCL_GLOBAL_ONLY); + } + entryPtr->flags |= UPDATE_SCROLLBAR; + EntryComputeGeometry(entryPtr); + EventuallyRedraw(entryPtr); +} + +/* + *---------------------------------------------------------------------- + * + * EntrySetValue -- + * + * Replace the contents of a text entry with a given value. This + * procedure is invoked when updating the entry from the entry's + * associated variable. + * + * Results: + * None. + * + * Side effects: + * The string displayed in the entry will change. Any selection + * in the entry is lost and the insertion point gets set to the + * end of the entry. Note: this procedure does *not* update the + * entry's associated variable, since that could result in an + * infinite loop. + * + *---------------------------------------------------------------------- + */ + +static void +EntrySetValue(entryPtr, value) + register Entry *entryPtr; /* Entry whose value is to be + * changed. */ + char *value; /* New text to display in entry. */ +{ + ckfree(entryPtr->string); +#if CK_USE_UTF + entryPtr->numBytes = strlen(value); + entryPtr->numChars = Tcl_NumUtfChars(value, -1); + entryPtr->string = (char *) ckalloc((unsigned) (entryPtr->numBytes + 1)); +#else + entryPtr->numChars = strlen(value); + entryPtr->string = (char *) ckalloc((unsigned) (entryPtr->numChars + 1)); +#endif + strcpy(entryPtr->string, value); + entryPtr->selectFirst = entryPtr->selectLast = -1; + entryPtr->leftIndex = 0; + entryPtr->insertPos = entryPtr->numChars; + + entryPtr->flags |= UPDATE_SCROLLBAR; + EntryComputeGeometry(entryPtr); + EventuallyRedraw(entryPtr); +} + +/* + *-------------------------------------------------------------- + * + * EntryEventProc -- + * + * This procedure is invoked by the dispatcher for various + * events on entryes. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +EntryEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + Entry *entryPtr = (Entry *) clientData; + + if (eventPtr->type == CK_EV_EXPOSE) { + Ck_Preserve((ClientData) entryPtr); + entryPtr->flags |= UPDATE_SCROLLBAR; + EntryComputeGeometry(entryPtr); + EventuallyRedraw(entryPtr); + Ck_Release((ClientData) entryPtr); + } else if (eventPtr->type == CK_EV_DESTROY) { + if (entryPtr->winPtr != NULL) { + entryPtr->winPtr = NULL; + Tcl_DeleteCommand(entryPtr->interp, + Tcl_GetCommandName(entryPtr->interp, entryPtr->widgetCmd)); + } + if (entryPtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayEntry, (ClientData) entryPtr); + } + Ck_EventuallyFree((ClientData) entryPtr, (Ck_FreeProc *) DestroyEntry); + } else if (eventPtr->type == CK_EV_FOCUSIN) { + EntryFocusProc(entryPtr, 1); + } else if (eventPtr->type == CK_EV_FOCUSOUT) { + EntryFocusProc(entryPtr, 0); + } +} + +/* + *-------------------------------------------------------------- + * + * GetEntryIndex -- + * + * Parse an index into an entry 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 entryPtr) corresponding to + * string. The index value is guaranteed to lie between 0 and + * the number of characters in the string, inclusive. If an + * error occurs then an error message is left in interp->result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +GetEntryIndex(interp, entryPtr, string, indexPtr) + Tcl_Interp *interp; /* For error messages. */ + Entry *entryPtr; /* Entry for which the index is being + * specified. */ + char *string; /* Specifies character in entryPtr. */ + int *indexPtr; /* Where to store converted index. */ +{ + size_t length; + int dummy; + CkWindow *winPtr = entryPtr->winPtr; + + length = strlen(string); + + if (string[0] == 'a') { + if (strncmp(string, "anchor", length) == 0) { + *indexPtr = entryPtr->selectAnchor; + } else { + badIndex: + + /* + * Some of the paths here leave messages in interp->result, + * so we have to clear it out before storing our own message. + */ + + Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); + Tcl_AppendResult(interp, "bad entry index \"", string, + "\"", (char *) NULL); + return TCL_ERROR; + } + } else if (string[0] == 'e') { + if (strncmp(string, "end", length) == 0) { + *indexPtr = entryPtr->numChars; + } else { + goto badIndex; + } + } else if (string[0] == 'i') { + if (strncmp(string, "insert", length) == 0) { + *indexPtr = entryPtr->insertPos; + } else { + goto badIndex; + } + } else if (string[0] == 's') { + if (entryPtr->selectFirst == -1) { + interp->result = "selection isn't in entry"; + return TCL_ERROR; + } + if (length < 5) { + goto badIndex; + } + if (strncmp(string, "sel.first", length) == 0) { + *indexPtr = entryPtr->selectFirst; + } else if (strncmp(string, "sel.last", length) == 0) { + *indexPtr = entryPtr->selectLast; + } else { + goto badIndex; + } + } else if (string[0] == '@') { + int x, roundUp; + + if (Tcl_GetInt(interp, string+1, &x) != TCL_OK) { + goto badIndex; + } + if (x < 0) { + x = 0; + } + roundUp = 0; + if (x >= entryPtr->winPtr->width) { + x = entryPtr->winPtr->width - 1; + roundUp = 1; + } + if (entryPtr->numChars == 0) { + *indexPtr = 0; + } else { + char *string = (entryPtr->displayString == NULL) ? + entryPtr->string : entryPtr->displayString; + + *indexPtr = CkMeasureChars(winPtr->mainPtr, string, strlen(string), + entryPtr->tabOrigin, x, + entryPtr->tabOrigin, CK_NEWLINES_NOT_SPECIAL, &dummy, &dummy); +#if 0 + *indexPtr = entryPtr->leftX + entryPtr->leftIndex + x; +#endif + } + if (*indexPtr >= entryPtr->numChars) + *indexPtr = entryPtr->numChars; + } else { + if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) { + goto badIndex; + } + if (*indexPtr < 0){ + *indexPtr = 0; + } else if (*indexPtr > entryPtr->numChars) { + *indexPtr = entryPtr->numChars; + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * EntrySelectTo -- + * + * 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 +EntrySelectTo(entryPtr, index) + register Entry *entryPtr; /* Information about widget. */ + int index; /* Index of element that is to + * become the "other" end of the + * selection. */ +{ + int newFirst, newLast; + + /* + * Pick new starting and ending points for the selection. + */ + + if (entryPtr->selectAnchor > entryPtr->numChars) { + entryPtr->selectAnchor = entryPtr->numChars; + } + if (entryPtr->selectAnchor <= index) { + newFirst = entryPtr->selectAnchor; + newLast = index; + } else { + newFirst = index; + newLast = entryPtr->selectAnchor; + if (newLast < 0) { + newFirst = newLast = -1; + } + } + if ((entryPtr->selectFirst == newFirst) + && (entryPtr->selectLast == newLast)) { + return; + } + entryPtr->selectFirst = newFirst; + entryPtr->selectLast = newLast; + EventuallyRedraw(entryPtr); +} + +/* + *---------------------------------------------------------------------- + * + * EventuallyRedraw -- + * + * Ensure that an entry is eventually redrawn on the display. + * + * Results: + * None. + * + * Side effects: + * Information gets redisplayed. Right now we don't do selective + * redisplays: the whole window will be redrawn. This doesn't + * seem to hurt performance noticeably, but if it does then this + * could be changed. + * + *---------------------------------------------------------------------- + */ + +static void +EventuallyRedraw(entryPtr) + Entry *entryPtr; /* Information about widget. */ +{ + if ((entryPtr->winPtr == NULL) || !(entryPtr->winPtr->flags & CK_MAPPED)) { + return; + } + + /* + * Right now we don't do selective redisplays: the whole window + * will be redrawn. This doesn't seem to hurt performance noticeably, + * but if it does then this could be changed. + */ + + if (!(entryPtr->flags & REDRAW_PENDING)) { + entryPtr->flags |= REDRAW_PENDING; + Tk_DoWhenIdle(DisplayEntry, (ClientData) entryPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * EntryVisibleRange -- + * + * Return information about the range of the entry that is + * currently visible. + * + * Results: + * *firstPtr and *lastPtr are modified to hold fractions between + * 0 and 1 identifying the range of characters visible in the + * entry. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +EntryVisibleRange(entryPtr, firstPtr, lastPtr) + Entry *entryPtr; /* Information about widget. */ + double *firstPtr; /* Return position of first visible + * character in widget. */ + double *lastPtr; /* Return position of char just after + * last visible one. */ +{ + char *displayString; + int charsInWindow, endX, dummy; + CkWindow *winPtr = entryPtr->winPtr; + + if (entryPtr->displayString == NULL) { + displayString = entryPtr->string; + } else { + displayString = entryPtr->displayString; + } + if (entryPtr->numChars == 0) { + *firstPtr = 0.0; + *lastPtr = 1.0; + } else { + int leftIndex, total; + +#if CK_USE_UTF + leftIndex = Tcl_UtfAtIndex(displayString, entryPtr->leftIndex) - + displayString; + total = entryPtr->numBytes - leftIndex; +#else + leftIndex = entryPtr->leftIndex; + total = entryPtr->numChars - leftIndex; +#endif + charsInWindow = CkMeasureChars(winPtr->mainPtr, + displayString + leftIndex, total, 0, + entryPtr->winPtr->width, 0, + CK_AT_LEAST_ONE|CK_NEWLINES_NOT_SPECIAL, &endX, &dummy); + *firstPtr = ((double) leftIndex)/entryPtr->numChars; + *lastPtr = ((double) (leftIndex + charsInWindow)) + /entryPtr->numChars; + } +} + +/* + *---------------------------------------------------------------------- + * + * EntryUpdateScrollbar -- + * + * This procedure is invoked whenever information has changed in + * an entry in a way that would invalidate a scrollbar display. + * If there is an associated scrollbar, then this procedure updates + * it by invoking a Tcl command. + * + * Results: + * None. + * + * Side effects: + * A Tcl command is invoked, and an additional command may be + * invoked to process errors in the command. + * + *---------------------------------------------------------------------- + */ + +static void +EntryUpdateScrollbar(entryPtr) + Entry *entryPtr; /* Information about widget. */ +{ + char args[100]; + int code; + double first, last; + + if (entryPtr->scrollCmd == NULL) { + return; + } + + EntryVisibleRange(entryPtr, &first, &last); + sprintf(args, " %g %g", first, last); + code = Tcl_VarEval(entryPtr->interp, entryPtr->scrollCmd, args, + (char *) NULL); + if (code != TCL_OK) { + Tcl_AddErrorInfo(entryPtr->interp, + "\n (horizontal scrolling command executed by entry)"); + Tk_BackgroundError(entryPtr->interp); + } + Tcl_SetResult(entryPtr->interp, (char *) NULL, TCL_STATIC); +} + +/* + *---------------------------------------------------------------------- + * + * EntryFocusProc -- + * + * This procedure is called whenever the entry 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 +EntryFocusProc(entryPtr, gotFocus) + Entry *entryPtr; /* Entry that got or lost focus. */ + int gotFocus; /* 1 means window is getting focus, 0 means + * it's losing it. */ +{ + if (gotFocus) + entryPtr->flags |= GOT_FOCUS; + else + entryPtr->flags &= ~GOT_FOCUS; +} + +/* + *-------------------------------------------------------------- + * + * EntryTextVarProc -- + * + * This procedure is invoked when someone changes the variable + * whose contents are to be displayed in an entry. + * + * Results: + * NULL is always returned. + * + * Side effects: + * The text displayed in the entry will change to match the + * variable. + * + *-------------------------------------------------------------- + */ + +static char * +EntryTextVarProc(clientData, interp, name1, name2, flags) + ClientData clientData; /* Information about button. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Not used. */ + char *name2; /* Not used. */ + int flags; /* Information about what happened. */ +{ + register Entry *entryPtr = (Entry *) clientData; + char *value; + + /* + * If the variable is unset, then immediately recreate it unless + * the whole interpreter is going away. + */ + + if (flags & TCL_TRACE_UNSETS) { + if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + Tcl_SetVar(interp, entryPtr->textVarName, entryPtr->string, + TCL_GLOBAL_ONLY); + Tcl_TraceVar(interp, entryPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + EntryTextVarProc, clientData); + } + return (char *) NULL; + } + + /* + * Update the entry's text with the value of the variable, unless + * the entry already has that value (this happens when the variable + * changes value because we changed it because someone typed in + * the entry). + */ + + value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY); + if (value == NULL) { + value = ""; + } + if (strcmp(value, entryPtr->string) != 0) { + EntrySetValue(entryPtr, value); + } + return (char *) NULL; +} + + + + diff --git a/ckEvent.c b/ckEvent.c new file mode 100644 index 0000000..b6c097b --- /dev/null +++ b/ckEvent.c @@ -0,0 +1,1235 @@ +/* + * ckEvent.c -- + * + * This file provides basic event-managing facilities, + * whereby procedure callbacks may be attached to + * certain events. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995-1999 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +#ifdef HAVE_GPM +#include "gpm.h" +#endif + +/* + * There's a potential problem if a handler is deleted while it's + * current (i.e. its procedure is executing), since Ck_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. Ck_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 { + CkEvent *eventPtr; /* Event currently being handled. */ + CkWindow *winPtr; /* Window for event. Gets set to NULL if + * window is deleted while event is being + * handled. */ + CkEventHandler *nextHandler; /* Next handler in search. */ + struct InProgress *nextPtr; /* Next higher nested search. */ +} InProgress; + +static InProgress *pendingPtr = NULL; + /* Topmost search in progress, or + * NULL if none. */ + +/* + * For each call to Ck_CreateGenericHandler, an instance of the following + * structure will be created. All of the active handlers are linked into a + * list. + */ + +typedef struct GenericHandler { + Ck_GenericProc *proc; /* Procedure to dispatch on all 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; + +static GenericHandler *genericList = NULL; + /* First handler in the list, or NULL. */ +static GenericHandler *lastGenericPtr = NULL; + /* Last handler in list. */ + +/* + * There's a potential problem if Ck_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 variable has a non-zero value when a handler is active. + */ + +static int genericHandlersActive = 0; + +/* + * For barcode readers an instance of the following structure is linked + * to mainInfo. The supported DATA LOGIC barcode readers are connected + * between PC keyboard and PC keyboard controller and generate a data + * packet surrounded by start and end characters. If the start character + * is received a timer is started and the following keystrokes are + * collected into the buffer until the end character is received or the + * timer expires. + */ + +#define DEFAULT_BARCODE_TIMEOUT 1000 + +typedef struct barcodeData { + Tk_TimerToken timer;/* Barcode packet timer. */ + int pkttime; /* Timeout value. */ + int startChar; /* Start of barcode packet character. */ + int endChar; /* End of barcode packet character. */ + int delivered; /* BarCode event has been delivered. */ + int index; /* Current index into buffer. */ +#if CK_USE_UTF + char buffer[256]; /* Here the barcode packet is assembled. */ +#else + char buffer[128]; /* Here the barcode packet is assembled. */ +#endif +} BarcodeData; + +/* + * Timeout procedure for reading barcode packet: + */ + +static void BarcodeTimeout _ANSI_ARGS_((ClientData clientData)); + +/* + *-------------------------------------------------------------- + * + * Ck_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 Ck_HandleEvent, + * proc will be called. See the manual entry for details + * of the calling sequence and return value for proc. + * + *-------------------------------------------------------------- + */ + +void +Ck_CreateEventHandler(winPtr, mask, proc, clientData) + CkWindow *winPtr; /* Window in which to create handler. */ + long mask; /* Events for which proc should be called. */ + Ck_EventProc *proc; /* Procedure to call for each + * selected event */ + ClientData clientData; /* Arbitrary data to pass to proc. */ +{ + CkEventHandler *handlerPtr; + int found; + + /* + * Skim through the list of existing handlers to 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 = (CkEventHandler *) ckalloc(sizeof (CkEventHandler)); + 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 = (CkEventHandler *) ckalloc( + sizeof (CkEventHandler)); + handlerPtr = handlerPtr->nextPtr; +initHandler: + handlerPtr->mask = mask; + handlerPtr->proc = proc; + handlerPtr->clientData = clientData; + handlerPtr->nextPtr = NULL; + } +} + +/* + *-------------------------------------------------------------- + * + * Ck_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 +Ck_DeleteEventHandler(winPtr, mask, proc, clientData) + CkWindow *winPtr; /* Same as corresponding arguments passed */ + long mask; /* previously to Ck_CreateEventHandler. */ + Ck_EventProc *proc; + ClientData clientData; +{ + CkEventHandler *handlerPtr; + InProgress *ipPtr; + CkEventHandler *prevPtr; + + /* + * 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 Ck_HandleEvent is about to process this handler, tell it to + * process the next one instead. + */ + + for (ipPtr = 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); +} + +/*-------------------------------------------------------------- + * + * Ck_CreateGenericHandler -- + * + * Register a procedure to be called on each event, regardless + * of window. Generic handlers are useful for capturing + * events that aren't associated with windows, or events for windows + * not managed by Ck. + * + * Results: + * None. + * + * Side Effects: + * From now on, whenever an event is given to Ck_HandleEvent, + * invoke proc, giving it clientData and the event as arguments. + * + *-------------------------------------------------------------- + */ + +void +Ck_CreateGenericHandler(proc, clientData) + Ck_GenericProc *proc; /* Procedure to call on every event. */ + ClientData clientData; /* One-word value to pass to proc. */ +{ + GenericHandler *handlerPtr; + + handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler)); + + handlerPtr->proc = proc; + handlerPtr->clientData = clientData; + handlerPtr->deleteFlag = 0; + handlerPtr->nextPtr = NULL; + if (genericList == NULL) { + genericList = handlerPtr; + } else { + lastGenericPtr->nextPtr = handlerPtr; + } + lastGenericPtr = handlerPtr; +} + +/* + *-------------------------------------------------------------- + * + * Ck_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 Ck_HandleEvent. + * + *-------------------------------------------------------------- + */ + +void +Ck_DeleteGenericHandler(proc, clientData) + Ck_GenericProc *proc; + ClientData clientData; +{ + GenericHandler * handler; + + for (handler = genericList; handler; handler = handler->nextPtr) { + if ((handler->proc == proc) && (handler->clientData == clientData)) { + handler->deleteFlag = 1; + } + } +} + +/* + *-------------------------------------------------------------- + * + * Ck_HandleEvent -- + * + * Given an event, invoke all the handlers that have + * been registered for the event. + * + * Results: + * None. + * + * Side effects: + * Depends on the handlers. + * + *-------------------------------------------------------------- + */ + +void +Ck_HandleEvent(mainPtr, eventPtr) + CkMainInfo *mainPtr; + CkEvent *eventPtr; /* Event to dispatch. */ +{ + CkEventHandler *handlerPtr; + GenericHandler *genericPtr; + GenericHandler *genPrevPtr; + CkWindow *winPtr; + InProgress ip; + + /* + * 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 = genericList; genericPtr != NULL; ) { + if (genericPtr->deleteFlag) { + if (!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) { + genericList = tmpPtr; + } else { + genPrevPtr->nextPtr = tmpPtr; + } + if (tmpPtr == NULL) { + lastGenericPtr = genPrevPtr; + } + (void) ckfree((char *) genericPtr); + genericPtr = tmpPtr; + continue; + } + } else { + int done; + + genericHandlersActive++; + done = (*genericPtr->proc)(genericPtr->clientData, eventPtr); + genericHandlersActive--; + if (done) { + return; + } + } + genPrevPtr = genericPtr; + genericPtr = genPrevPtr->nextPtr; + } + + if (Tcl_FindHashEntry(&mainPtr->winTable, (char *) eventPtr->any.winPtr) + == NULL) { + /* + * There isn't a CkWindow structure for this window. + */ + return; + } + winPtr = eventPtr->any.winPtr; + ip.eventPtr = eventPtr; + ip.winPtr = winPtr; + ip.nextHandler = NULL; + ip.nextPtr = pendingPtr; + pendingPtr = &ip; + for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) { + if ((handlerPtr->mask & eventPtr->type) != 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. + */ + + CkBindEventProc(winPtr, eventPtr); + + pendingPtr = ip.nextPtr; +} + +/* + *-------------------------------------------------------------- + * + * CkEventDeadWindow -- + * + * 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 +CkEventDeadWindow(winPtr) + CkWindow *winPtr; /* Information about the window + * that is being deleted. */ +{ + CkEventHandler *handlerPtr; + InProgress *ipPtr; + + /* + * While deleting all the handlers, be careful to check for + * Ck_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 = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + if (ipPtr->nextHandler == handlerPtr) { + ipPtr->nextHandler = NULL; + } + if (ipPtr->winPtr == winPtr) { + ipPtr->winPtr = NULL; + } + } + ckfree((char *) handlerPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * CkHandleInput -- + * + * Process keyboard events from curses. + * + * Results: + * The return value is TK_FILE_HANDLED if the procedure + * actually found an event to process. If no event was found + * then TK_READABLE is returned. + * + * Side effects: + * The handling of the event could cause additional + * side effects. + * + *-------------------------------------------------------------- + */ + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +int +CkHandleInput(clientData, mask, flags) + ClientData clientData; /* Pointer to main info. */ + int mask; /* OR-ed combination of the bits TK_READABLE, + * TK_WRITABLE, and TK_EXCEPTION, indicating + * current state of file. */ + int flags; /* Flag bits passed to Tk_DoOneEvent; + * contains bits such as TK_DONT_WAIT, + * TK_X_EVENTS, Tk_FILE_EVENTS, etc. */ +{ + CkEvent event; + CkMainInfo *mainPtr = (CkMainInfo *) clientData; + int code; + static int buttonpressed = 0; + static int errCount = 0; + + if (!(flags & TK_FILE_EVENTS)) + return 0; + + if (!(mask & TK_READABLE)) + return TK_READABLE; + + code = getch(); + if (code == ERR) { + if (++errCount > 100) { + Tcl_Eval(mainPtr->interp, "exit 99"); + exit(99); /* just in case */ + } + return TK_READABLE; + } + errCount = 0; + + /* + * Barcode reader handling. + */ + + if (mainPtr->flags & CK_HAS_BARCODE) { + BarcodeData *bd = (BarcodeData *) mainPtr->barcodeData; + + /* + * Here, special handling for nested event loops: + * If BarCode event has been delivered already, we must + * reset the buffer index in order to get normal Key events. + */ + if (bd->delivered && bd->index >= 0) { + bd->delivered = 0; + bd->index = -1; + } + + if (bd->index >= 0 || code == bd->startChar) { + if (code == bd->startChar) { + Tk_DeleteTimerHandler(bd->timer); + bd->timer = Tk_CreateTimerHandler(bd->pkttime, BarcodeTimeout, + (ClientData) mainPtr); + bd->index = 0; + } else if (code == bd->endChar) { + Tk_DeleteTimerHandler(bd->timer); + bd->timer = (Tk_TimerToken) NULL; + bd->delivered = 1; + event.key.type = CK_EV_BARCODE; + event.key.winPtr = mainPtr->focusPtr; + event.key.keycode = 0; + Ck_HandleEvent(mainPtr, &event); + /* + * Careful, event handler could turn barcode off. + * Only reset buffer index if BarCode event delivered + * flag is set. + */ + bd = (BarcodeData *) mainPtr->barcodeData; + if (bd != NULL && bd->delivered) { + bd->delivered = 0; + bd->index = -1; + } + return TK_FILE_HANDLED; + } else { + /* Leave space for one NUL byte. */ + if (bd->index < sizeof (bd->buffer) - 1) + bd->buffer[bd->index] = code; + bd->index++; + } + return TK_READABLE; + } + } + +#ifdef NCURSES_MOUSE_VERSION + /* + * ncurses-1.9.8a has builtin mouse support for at least xterm. + */ + + if (code == KEY_MOUSE) { + MEVENT mEvent; + int i; + + if (mainPtr->flags & CK_MOUSE_XTERM) { + goto getMouse; + } + + if (getmouse(&mEvent) == ERR) + return TK_FILE_HANDLED; + + for (i = 1; i <= 3; i++) { + if (BUTTON_PRESS(mEvent.bstate, i)) { + event.mouse.type = CK_EV_MOUSE_DOWN; + goto mouseEventNC; + } else if (BUTTON_RELEASE(mEvent.bstate, i)) { + event.mouse.type = CK_EV_MOUSE_UP; +mouseEventNC: + event.mouse.button = i; + event.mouse.x = mEvent.x; + event.mouse.y = mEvent.y; + event.mouse.winPtr = Ck_GetWindowXY(mainPtr, &event.mouse.x, + &event.mouse.y, 1); + Ck_HandleEvent(mainPtr, &event); + return TK_FILE_HANDLED; + } + } + } +#endif + +#if defined(__WIN32__) || defined(DJGPP) + if ((mainPtr->flags & CK_HAS_MOUSE) && code == KEY_MOUSE) { + int i; + + request_mouse_pos(); + for (i = 0; i < 3; i++) { + if (Mouse_status.button[i] == BUTTON_PRESSED) { + event.mouse.type = CK_EV_MOUSE_DOWN; + goto mouseEvt; + } else if (Mouse_status.button[i] == BUTTON_RELEASED) { + event.mouse.type = CK_EV_MOUSE_UP; +mouseEvt: + event.mouse.button = i + 1; + event.mouse.x = Mouse_status.x; + event.mouse.y = Mouse_status.y; + event.mouse.winPtr = Ck_GetWindowXY(mainPtr, &event.mouse.x, + &event.mouse.y, 1); + Ck_HandleEvent(mainPtr, &event); + return TK_FILE_HANDLED; + } + } + } +#endif + + /* + * Xterm mouse report handling: Although GPM has an xterm module + * this is separately done here, since I want to be as independent + * as possible from GPM. + * It is assumed that the entire mouse report comes in one piece + * ie without any delay between the 6 relevant characters. + * Only a single button down/up event is generated. + */ + +#if !defined(__WIN32__)&& !defined(DJGPP) + if ((mainPtr->flags & CK_MOUSE_XTERM) && (code == 0x1b || code == 0x9b)) { + int code2; + + if (code == 0x9b) + goto getM; + code2 = getch(); + if (code2 != ERR) { + if (code2 == '[') + goto getM; + ungetch(code2); + } else + errCount++; + goto keyEvent; +getM: + code2 = getch(); + if (code2 != ERR) { + if (code2 == 'M') + goto getMouse; + ungetch(code2); + } else + errCount++; + goto keyEvent; +getMouse: + code2 = getch(); + if (code2 == ERR) { + errCount++; + return TK_READABLE; + } + event.mouse.button = ((code2 - 0x20) & 0x03) + 1; + code2 = getch(); + if (code2 == ERR) { + errCount++; + return TK_READABLE; + } + event.mouse.x = event.mouse.rootx = code2 - 0x20 - 1; + code2 = getch(); + if (code2 == ERR) { + errCount++; + return TK_READABLE; + } + event.mouse.y = event.mouse.rooty = code2 - 0x20 - 1; + if (event.mouse.button > 3) { + event.mouse.button = buttonpressed; + buttonpressed = 0; + event.mouse.type = CK_EV_MOUSE_UP; + goto mouseEvent; + } else if (buttonpressed == 0) { + buttonpressed = event.mouse.button; + event.mouse.type = CK_EV_MOUSE_DOWN; +mouseEvent: + event.mouse.winPtr = Ck_GetWindowXY(mainPtr, &event.mouse.x, + &event.mouse.y, 1); + Ck_HandleEvent(mainPtr, &event); + return TK_FILE_HANDLED; + } + return TK_READABLE; + } +#endif + +keyEvent: + event.key.type = CK_EV_KEYPRESS; + event.key.winPtr = mainPtr->focusPtr; + event.key.keycode = code; + if (event.key.keycode < 0) + event.key.keycode &= 0xff; + Ck_HandleEvent(mainPtr, &event); + return TK_FILE_HANDLED; +} +#else +void +CkHandleInput(clientData, mask) + ClientData clientData; /* Pointer to main info. */ + int mask; /* OR-ed combination of the bits TK_READABLE, + * TK_WRITABLE, and TK_EXCEPTION, indicating + * current state of file. */ +{ + CkEvent event; + CkMainInfo *mainPtr = (CkMainInfo *) clientData; + int code; + static int buttonpressed = 0; + static int errCount = 0; + + if (!(mask & TCL_READABLE)) + return; + + code = getch(); + if (code == ERR) { + if (++errCount > 100) { + Tcl_Eval(mainPtr->interp, "exit 99"); +#if (TCL_MAJOR_VERSION >= 8) + Tcl_Exit(99); /* just in case */ +#else + exit(99); /* just in case */ +#endif + } + return; + } + errCount = 0; + + /* + * Barcode reader handling. + */ + + if (mainPtr->flags & CK_HAS_BARCODE) { + BarcodeData *bd = (BarcodeData *) mainPtr->barcodeData; + + /* + * Here, special handling for nested event loops: + * If BarCode event has been delivered already, we must + * reset the buffer index in order to get normal Key events. + */ + if (bd->delivered && bd->index >= 0) { + bd->delivered = 0; + bd->index = -1; + } + + if (bd->index >= 0 || code == bd->startChar) { + if (code == bd->startChar) { + Tk_DeleteTimerHandler(bd->timer); + bd->timer = Tk_CreateTimerHandler(bd->pkttime, BarcodeTimeout, + (ClientData) mainPtr); + bd->index = 0; + } else if (code == bd->endChar) { + Tk_DeleteTimerHandler(bd->timer); + bd->timer = (Tk_TimerToken) NULL; + bd->delivered = 1; + event.key.type = CK_EV_BARCODE; + event.key.winPtr = mainPtr->focusPtr; + event.key.keycode = 0; + Ck_HandleEvent(mainPtr, &event); + /* + * Careful, event handler could turn barcode off. + * Only reset buffer index if BarCode event delivered + * flag is set. + */ + bd = (BarcodeData *) mainPtr->barcodeData; + if (bd != NULL && bd->delivered) { + bd->delivered = 0; + bd->index = -1; + } + return; + } else { + /* Leave space for one NUL byte. */ + if (bd->index < sizeof (bd->buffer) - 1) { +#if CK_USE_UTF + char c, utfb[8]; + int numc, i; + + c = code; + Tcl_ExternalToUtf(NULL, mainPtr->isoEncoding, + &c, 1, 0, NULL, utfb, sizeof (utfb), + NULL, &numc, NULL); + if (bd->index + numc < sizeof (bd->buffer) - 1) { + for (i = 0; i < numc; i++) + bd->buffer[bd->index + i] = utfb[i]; + } else + bd->buffer[bd->index] = '\0'; + bd->index += numc - 1; +#else + bd->buffer[bd->index] = code; +#endif + } + bd->index++; + } + return; + } + } + +#ifdef NCURSES_MOUSE_VERSION + /* + * ncurses-1.9.8a has builtin mouse support for at least xterm. + */ + + if (code == KEY_MOUSE) { + MEVENT mEvent; + int i; + + if (mainPtr->flags & CK_MOUSE_XTERM) { + goto getMouse; + } + + if (getmouse(&mEvent) == ERR) + return; + + for (i = 1; i <= 3; i++) { + if (BUTTON_PRESS(mEvent.bstate, i)) { + event.mouse.type = CK_EV_MOUSE_DOWN; + goto mouseEventNC; + } else if (BUTTON_RELEASE(mEvent.bstate, i)) { + event.mouse.type = CK_EV_MOUSE_UP; +mouseEventNC: + event.mouse.button = i; + event.mouse.rootx = mEvent.x; + event.mouse.rooty = mEvent.y; + event.mouse.x = mEvent.x; + event.mouse.y = mEvent.y; + event.mouse.winPtr = Ck_GetWindowXY(mainPtr, &event.mouse.x, + &event.mouse.y, 1); + Ck_HandleEvent(mainPtr, &event); + return; + } + } + } +#endif + +#if defined(__WIN32__) || defined(DJGPP) + if ((mainPtr->flags & CK_HAS_MOUSE) && code == KEY_MOUSE) { + int i; + + request_mouse_pos(); + for (i = 0; i < 3; i++) { + if (Mouse_status.button[i] == BUTTON_PRESSED) { + event.mouse.type = CK_EV_MOUSE_DOWN; + goto mouseEvt; + } else if (Mouse_status.button[i] == BUTTON_RELEASED) { + event.mouse.type = CK_EV_MOUSE_UP; +mouseEvt: + event.mouse.button = i + 1; + event.mouse.x = Mouse_status.x; + event.mouse.y = Mouse_status.y; + event.mouse.winPtr = Ck_GetWindowXY(mainPtr, &event.mouse.x, + &event.mouse.y, 1); + Ck_HandleEvent(mainPtr, &event); + return; + } + } + } +#endif + + /* + * Xterm mouse report handling: Although GPM has an xterm module + * this is separately done here, since I want to be as independent + * as possible from GPM. + * It is assumed that the entire mouse report comes in one piece + * ie without any delay between the 6 relevant characters. + * Only a single button down/up event is generated. + */ + +#if !defined(__WIN32__) && !defined(DJGPP) + if ((mainPtr->flags & CK_MOUSE_XTERM) && (code == 0x1b || code == 0x9b)) { + int code2; + + if (code == 0x9b) + goto getM; + code2 = getch(); + if (code2 != ERR) { + if (code2 == '[') + goto getM; + ungetch(code2); + } else + errCount++; + goto keyEvent; +getM: + code2 = getch(); + if (code2 != ERR) { + if (code2 == 'M') + goto getMouse; + ungetch(code2); + } else + errCount++; + goto keyEvent; +getMouse: + code2 = getch(); + if (code2 == ERR) { + errCount++; + return; + } + event.mouse.button = ((code2 - 0x20) & 0x03) + 1; + code2 = getch(); + if (code2 == ERR) { + errCount++; + return; + } + event.mouse.x = event.mouse.rootx = code2 - 0x20 - 1; + code2 = getch(); + if (code2 == ERR) { + errCount++; + return; + } + event.mouse.y = event.mouse.rooty = code2 - 0x20 - 1; + if (event.mouse.button > 3) { + event.mouse.button = buttonpressed; + buttonpressed = 0; + event.mouse.type = CK_EV_MOUSE_UP; + goto mouseEvent; + } else if (buttonpressed == 0) { + buttonpressed = event.mouse.button; + event.mouse.type = CK_EV_MOUSE_DOWN; +mouseEvent: + event.mouse.winPtr = Ck_GetWindowXY(mainPtr, &event.mouse.x, + &event.mouse.y, 1); + Ck_HandleEvent(mainPtr, &event); + return; + } + return; + } +#endif + +keyEvent: + event.key.type = CK_EV_KEYPRESS; + event.key.winPtr = mainPtr->focusPtr; + event.key.keycode = code; + if (event.key.keycode < 0) + event.key.keycode &= 0xff; + Ck_HandleEvent(mainPtr, &event); +} + +#endif /* TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION <= 4 */ + +#ifdef HAVE_GPM +/* + *-------------------------------------------------------------- + * + * CkHandleGPMInput -- + * + * Process mouse events from GPM. + * + * Results: + * The return value is TK_FILE_HANDLED if the procedure + * actually found an event to process. If no event was found + * then TK_READABLE is returned. + * + * Side effects: + * The handling of the event could cause additional + * side effects. + * + *-------------------------------------------------------------- + */ + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +int +CkHandleGPMInput(clientData, mask, flags) + ClientData clientData; /* Pointer to main info. */ + int mask; /* OR-ed combination of the bits TK_READABLE, + * TK_WRITABLE, and TK_EXCEPTION, indicating + * current state of file. */ + int flags; /* Flag bits passed to Tk_DoOneEvent; + * contains bits such as TK_DONT_WAIT, + * TK_X_EVENTS, Tk_FILE_EVENTS, etc. */ +{ + Gpm_Event gpmEvent; + CkEvent event; + CkMainInfo *mainPtr = (CkMainInfo *) clientData; + int ret, type; + + if (!(flags & TK_FILE_EVENTS)) + return 0; + + if (!(mask & TK_READABLE)) + return TK_READABLE; + + ret = Gpm_GetEvent(&gpmEvent); + if (ret == 0) { + /* + * GPM connection is closed; delete this file handler. + */ + + Tk_DeleteFileHandler((int) mainPtr->mouseData); + mainPtr->mouseData = (ClientData) -1; + return 0; + } else if (ret == -1) + return TK_READABLE; + + GPM_DRAWPOINTER(&gpmEvent); + type = gpmEvent.type & (GPM_DOWN | GPM_UP); + if (type == GPM_DOWN || type == GPM_UP) { + event.mouse.type = type == GPM_DOWN ? CK_EV_MOUSE_DOWN : + CK_EV_MOUSE_UP; + if (gpmEvent.buttons & GPM_B_LEFT) + event.mouse.button = 1; + else if (gpmEvent.buttons & GPM_B_MIDDLE) + event.mouse.button = 2; + else if (gpmEvent.buttons & GPM_B_RIGHT) + event.mouse.button = 3; + event.mouse.x = event.mouse.rootx = gpmEvent.x - 1; + event.mouse.y = event.mouse.rooty = gpmEvent.y - 1; + event.mouse.winPtr = Ck_GetWindowXY(mainPtr, &event.mouse.x, + &event.mouse.y, 1); + Ck_HandleEvent(mainPtr, &event); + return TK_FILE_HANDLED; + } + return TK_READABLE; +} +#else +void +CkHandleGPMInput(clientData, mask) + ClientData clientData; /* Pointer to main info. */ + int mask; /* OR-ed combination of the bits TK_READABLE, + * TK_WRITABLE, and TK_EXCEPTION, indicating + * current state of file. */ +{ + Gpm_Event gpmEvent; + CkEvent event; + CkMainInfo *mainPtr = (CkMainInfo *) clientData; + int ret, type; + + if (!(mask & TCL_READABLE)) + return; + + ret = Gpm_GetEvent(&gpmEvent); + if (ret == 0) { + /* + * GPM connection is closed; delete this file handler. + */ +#if (TCL_MAJOR_VERSION == 7) + Tcl_DeleteFileHandler((Tcl_File) mainPtr->mouseData); +#else + Tcl_DeleteFileHandler((int) mainPtr->mouseData); +#endif + mainPtr->mouseData = (ClientData) 0; + return; + } else if (ret == -1) + return; + + GPM_DRAWPOINTER(&gpmEvent); + type = gpmEvent.type & (GPM_DOWN | GPM_UP); + if (type == GPM_DOWN || type == GPM_UP) { + event.mouse.type = type == GPM_DOWN ? CK_EV_MOUSE_DOWN : + CK_EV_MOUSE_UP; + if (gpmEvent.buttons & GPM_B_LEFT) + event.mouse.button = 1; + else if (gpmEvent.buttons & GPM_B_MIDDLE) + event.mouse.button = 2; + else if (gpmEvent.buttons & GPM_B_RIGHT) + event.mouse.button = 3; + event.mouse.x = event.mouse.rootx = gpmEvent.x - 1; + event.mouse.y = event.mouse.rooty = gpmEvent.y - 1; + event.mouse.winPtr = Ck_GetWindowXY(mainPtr, &event.mouse.x, + &event.mouse.y, 1); + Ck_HandleEvent(mainPtr, &event); + } +} +#endif /* TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION <= 4 */ +#endif /* HAVE_GPM */ + +/* + *-------------------------------------------------------------- + * + * Ck_MainLoop -- + * + * Call Ck_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 +Ck_MainLoop() +{ + extern CkMainInfo *ckMainInfo; + + while (ckMainInfo != NULL) { + Tk_DoOneEvent(0); + } +} + +/* + *-------------------------------------------------------------- + * + * BarcodeTimeout -- + * + * Handle timeout while reading barcode packet. + * + *-------------------------------------------------------------- + */ + +static void +BarcodeTimeout(clientData) + ClientData clientData; +{ + CkMainInfo *mainPtr = (CkMainInfo *) clientData; + BarcodeData *bd = (BarcodeData *) mainPtr->barcodeData; + + if (bd != NULL) { + bd->index = -1; + bd->timer = (Tk_TimerToken) NULL; + } +} + +/* + *-------------------------------------------------------------- + * + * CkGetBarcodeData -- + * + * Return data collected in barcode packet buffer. + * + *-------------------------------------------------------------- + */ + +char * +CkGetBarcodeData(mainPtr) + CkMainInfo *mainPtr; +{ + BarcodeData *bd = (BarcodeData *) mainPtr->barcodeData; + + if (bd == NULL || bd->index < 0) + return NULL; + if (bd->index >= sizeof (bd->buffer) - 1) + bd->buffer[sizeof (bd->buffer) - 1] = '\0'; + else + bd->buffer[bd->index] = '\0'; + return bd->buffer; +} + +/* + *-------------------------------------------------------------- + * + * CkBarcodeCmd -- + * + * Minor command handler to deal with barcode reader. + * Called by "curses" Tcl command. + * + * Results: + * TCL_OK or TCL_ERROR. + * + * + *-------------------------------------------------------------- + */ + +int +CkBarcodeCmd(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. */ +{ + CkMainInfo *mainPtr = ((CkWindow *) (clientData))->mainPtr; + BarcodeData *bd = (BarcodeData *) mainPtr->barcodeData; + + if (argc == 2) { + if (mainPtr->flags & CK_HAS_BARCODE) { + char buffer[32]; + + sprintf(buffer, "%d %d %d", bd->startChar, bd->endChar, + bd->pkttime); + Tcl_AppendResult(interp, buffer, (char *) NULL); + } + return TCL_OK; + } else if (argc == 3) { + if (strcmp(argv[2], "off") != 0) + goto badArgs; + if (mainPtr->flags & CK_HAS_BARCODE) { + Tk_DeleteTimerHandler(bd->timer); + mainPtr->flags &= ~CK_HAS_BARCODE; + mainPtr->barcodeData = NULL; + ckfree((char *) bd); + } + return TCL_OK; + } else if (argc == 4 || argc == 5) { + int start, end, pkttime; + + if (Tcl_GetInt(interp, argv[2], &start) != TCL_OK || + Tcl_GetInt(interp, argv[3], &end) != TCL_OK) + return TCL_ERROR; + if (argc > 4 && Tcl_GetInt(interp, argv[4], &pkttime) != TCL_OK) + return TCL_ERROR; + if (!(mainPtr->flags & CK_HAS_BARCODE)) { + bd = (BarcodeData *) ckalloc(sizeof (BarcodeData)); + mainPtr->flags |= CK_HAS_BARCODE; + mainPtr->barcodeData = (ClientData) bd; + bd->pkttime = DEFAULT_BARCODE_TIMEOUT; + bd->timer = (Tk_TimerToken) NULL; + bd->delivered = 0; + bd->index = -1; + } + if (argc > 4 && pkttime > 50) + bd->pkttime = pkttime; + bd->startChar = start; + bd->endChar = end; + return TCL_OK; + } else { +badArgs: + Tcl_AppendResult(interp, "bad or wrong # args: should be \"", argv[0], + " barcode ?off?\" or \"", + argv[0], " barcode startChar endChar ?timeout?\"", (char *) NULL); + } + return TCL_ERROR; +} diff --git a/ckFocus.c b/ckFocus.c new file mode 100644 index 0000000..9600d2f --- /dev/null +++ b/ckFocus.c @@ -0,0 +1,79 @@ +/* + * ckFocus.c -- + * + * This file contains procedures that manage the input focus. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + + +/* + *-------------------------------------------------------------- + * + * Ck_FocusCmd -- + * + * This procedure is invoked to process the "focus" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_FocusCmd(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. */ +{ + CkWindow *winPtr = (CkWindow *) clientData; + CkWindow *newPtr, *focusWinPtr; + + /* + * If invoked with no arguments, just return the current focus window. + */ + + if (argc == 1) { + focusWinPtr = winPtr->mainPtr->focusPtr; + if (focusWinPtr != NULL) + interp->result = focusWinPtr->pathName; + return TCL_OK; + } + + /* + * If invoked with a single argument beginning with "." then focus + * on that window. + */ + + if (argc == 2) { + if (argv[1][0] == 0) { + return TCL_OK; + } + if (argv[1][0] == '.') { + newPtr = (CkWindow *) Ck_NameToWindow(interp, argv[1], winPtr); + if (newPtr == NULL) + return TCL_ERROR; + if (!(newPtr->flags & CK_ALREADY_DEAD)) + Ck_SetFocus(newPtr); + return TCL_OK; + } + } + + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ?pathName?\"", (char *) NULL); + return TCL_ERROR; +} diff --git a/ckFrame.c b/ckFrame.c new file mode 100644 index 0000000..b54df1d --- /dev/null +++ b/ckFrame.c @@ -0,0 +1,493 @@ +/* + * ckFrame.c -- + * + * This module implements "frame" and "toplevel" widgets for the + * toolkit. Frames are windows with a background color + * and possibly border, but no other attributes. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +/* + * A data structure of the following type is kept for each + * frame that currently exists for this process: + */ + +typedef struct { + CkWindow *winPtr; /* Window that embodies the frame. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with widget. + * Used to delete widget command. */ + Tcl_Command widgetCmd; /* Token for frame's widget command. */ + CkBorder *borderPtr; /* Structure used to draw border. */ + int fg, bg; /* Foreground/background colors. */ + int attr; /* Video attributes. */ + int width; /* Width to request for window. <= 0 means + * don't request any size. */ + int height; /* Height to request for window. <= 0 means + * don't request any size. */ + char *takeFocus; /* Value of -takefocus option. */ + int flags; /* Various flags; see below for + * definitions. */ +} Frame; + +/* + * Flag bits for frames: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler + * has already been queued to redraw + * this window. + */ + +#define REDRAW_PENDING 1 + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_FRAME_ATTRIB, Ck_Offset(Frame, attr), 0}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_FRAME_BG_COLOR, Ck_Offset(Frame, bg), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_FRAME_BG_MONO, Ck_Offset(Frame, bg), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_FRAME_FG_COLOR, Ck_Offset(Frame, fg), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_FRAME_FG_MONO, Ck_Offset(Frame, fg), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_BORDER, "-border", "border", "Border", + DEF_FRAME_BORDER, Ck_Offset(Frame, borderPtr), CK_CONFIG_NULL_OK}, + {CK_CONFIG_COORD, "-height", "height", "Height", + DEF_FRAME_HEIGHT, Ck_Offset(Frame, height), 0}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_FRAME_TAKE_FOCUS, Ck_Offset(Frame, takeFocus), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_COORD, "-width", "width", "Width", + DEF_FRAME_WIDTH, Ck_Offset(Frame, width), 0}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp, + Frame *framePtr, int argc, char **argv, int flags)); +static void DestroyFrame _ANSI_ARGS_((ClientData clientData)); +static void FrameCmdDeletedProc _ANSI_ARGS_((ClientData clientData)); +static void DisplayFrame _ANSI_ARGS_((ClientData clientData)); +static void FrameEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static int FrameWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +/* + *-------------------------------------------------------------- + * + * Ck_FrameCmd -- + * + * This procedure is invoked to process the "frame" and + * "toplevel" Tcl commands. See the user documentation for + * details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_FrameCmd(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. */ +{ + CkWindow *winPtr = (CkWindow *) clientData; + CkWindow *new; + char *className; + int src, dst, toplevel; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * The code below is a special hack that extracts a few key + * options from the argument list now, rather than letting + * ConfigureFrame do it. This is necessary because we have + * to know the window's class before creating the window. + */ + + toplevel = *argv[0] == 't'; + className = NULL; + for (src = 2, dst = 2; src < argc; src += 2) { + char c; + + c = argv[src][1]; + if ((c == 'c') + && (strncmp(argv[src], "-class", strlen(argv[src])) == 0)) { + className = argv[src+1]; + } else { + argv[dst] = argv[src]; + argv[dst+1] = argv[src+1]; + dst += 2; + } + } + argc -= src-dst; + + /* + * Create the window and initialize our structures and event handlers. + */ + + new = Ck_CreateWindowFromPath(interp, winPtr, argv[1], toplevel); + if (new == NULL) + return TCL_ERROR; + if (className == NULL) { + className = Ck_GetOption(new, "class", "Class"); + if (className == NULL) { + className = (toplevel) ? "Toplevel" : "Frame"; + } + } + Ck_SetClass(new, className); + return CkInitFrame(interp, new, argc-2, argv+2); +} + +/* + *---------------------------------------------------------------------- + * + * CkInitFrame -- + * + * This procedure initializes a frame widget. It's + * separate from Ck_FrameCmd so that it can be used for the + * main window, which has already been created elsewhere. + * + * Results: + * A standard Tcl completion code. + * + * Side effects: + * A widget record gets allocated, handlers get set up, etc.. + * + *---------------------------------------------------------------------- + */ + +int +CkInitFrame(interp, winPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter associated with the + * application. */ + CkWindow *winPtr; /* Window to use for frame or + * top-level. Caller must already + * have set window's class. */ + int argc; /* Number of configuration arguments + * (not including class command and + * window name). */ + char *argv[]; /* Configuration arguments. */ +{ + Frame *framePtr; + + framePtr = (Frame *) ckalloc(sizeof (Frame)); + framePtr->winPtr = winPtr; + framePtr->interp = interp; + framePtr->widgetCmd = Tcl_CreateCommand(interp, + framePtr->winPtr->pathName, FrameWidgetCmd, + (ClientData) framePtr, FrameCmdDeletedProc); + framePtr->borderPtr = NULL; + framePtr->fg = 0; + framePtr->bg = 0; + framePtr->attr = 0; + framePtr->width = 1; + framePtr->height = 1; + framePtr->takeFocus = NULL; + framePtr->flags = 0; + Ck_CreateEventHandler(framePtr->winPtr, + CK_EV_MAP | CK_EV_EXPOSE | CK_EV_DESTROY, + FrameEventProc, (ClientData) framePtr); + if (ConfigureFrame(interp, framePtr, argc, argv, 0) != TCL_OK) { + Ck_DestroyWindow(framePtr->winPtr); + return TCL_ERROR; + } + interp->result = framePtr->winPtr->pathName; + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * FrameWidgetCmd -- + * + * This procedure is invoked to process the Tcl command + * that corresponds to a frame widget. See the user + * documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +static int +FrameWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about frame widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + Frame *framePtr = (Frame *) clientData; + int result = TCL_OK; + int length; + char c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Ck_Preserve((ClientData) framePtr); + c = argv[1][0]; + length = strlen(argv[1]); + 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 = Ck_ConfigureValue(interp, framePtr->winPtr, configSpecs, + (char *) framePtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, framePtr->winPtr, configSpecs, + (char *) framePtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, framePtr->winPtr, configSpecs, + (char *) framePtr, argv[2], 0); + } else { + result = ConfigureFrame(interp, framePtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be cget or configure", (char *) NULL); + goto error; + } + Ck_Release((ClientData) framePtr); + return result; + +error: + Ck_Release((ClientData) framePtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyFrame -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a frame at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the frame is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyFrame(clientData) + ClientData clientData; /* Info about frame widget. */ +{ + Frame *framePtr = (Frame *) clientData; + + Ck_FreeOptions(configSpecs, (char *) framePtr, 0); + ckfree((char *) framePtr); +} + +/* + *---------------------------------------------------------------------- + * + * FrameCmdDeletedProc -- + * + * 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 +FrameCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + Frame *framePtr = (Frame *) clientData; + CkWindow *winPtr = framePtr->winPtr; + + /* + * 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 (winPtr != NULL) { + framePtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureFrame -- + * + * This procedure is called to process an argv/argc list, plus + * the option database, in order to configure (or + * reconfigure) a frame widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as text string, colors, font, + * etc. get set for framePtr; old resources get freed, if there + * were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureFrame(interp, framePtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Frame *framePtr; /* 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. */ +{ + if (Ck_ConfigureWidget(interp, framePtr->winPtr, configSpecs, + argc, argv, (char *) framePtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + Ck_SetWindowAttr(framePtr->winPtr, framePtr->fg, framePtr->bg, + framePtr->attr); + Ck_SetInternalBorder(framePtr->winPtr, framePtr->borderPtr != NULL); + if ((framePtr->width > 0) || (framePtr->height > 0)) + Ck_GeometryRequest(framePtr->winPtr, framePtr->width, + framePtr->height); + if ((framePtr->winPtr->flags & CK_MAPPED) + && !(framePtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayFrame, (ClientData) framePtr); + framePtr->flags |= REDRAW_PENDING; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * DisplayFrame -- + * + * This procedure is invoked to display a frame widget. + * + * Results: + * None. + * + * Side effects: + * Commands are output to display the frame in its + * current mode. + * + *---------------------------------------------------------------------- + */ + +static void +DisplayFrame(clientData) + ClientData clientData; /* Information about widget. */ +{ + Frame *framePtr = (Frame *) clientData; + CkWindow *winPtr = framePtr->winPtr; + + framePtr->flags &= ~REDRAW_PENDING; + if ((framePtr->winPtr == NULL) || !(winPtr->flags & CK_MAPPED)) { + return; + } + Ck_ClearToBot(winPtr, 0, 0); + if (framePtr->borderPtr != NULL) + Ck_DrawBorder(winPtr, framePtr->borderPtr, 0, 0, + winPtr->width, winPtr->height); + Ck_EventuallyRefresh(winPtr); +} + +/* + *-------------------------------------------------------------- + * + * FrameEventProc -- + * + * This procedure is invoked by the dispatcher on + * structure changes to a frame. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +FrameEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + Frame *framePtr = (Frame *) clientData; + + if (eventPtr->type == CK_EV_EXPOSE && framePtr->winPtr != NULL && + !(framePtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayFrame, (ClientData) framePtr); + framePtr->flags |= REDRAW_PENDING; + } else if (eventPtr->type == CK_EV_DESTROY) { + if (framePtr->winPtr != NULL) { + framePtr->winPtr = NULL; + Tcl_DeleteCommand(framePtr->interp, + Tcl_GetCommandName(framePtr->interp, framePtr->widgetCmd)); + } + if (framePtr->flags & REDRAW_PENDING) + Tk_CancelIdleCall(DisplayFrame, (ClientData) framePtr); + Ck_EventuallyFree((ClientData) framePtr, (Ck_FreeProc *) DestroyFrame); + } +} diff --git a/ckGeometry.c b/ckGeometry.c new file mode 100644 index 0000000..3730e79 --- /dev/null +++ b/ckGeometry.c @@ -0,0 +1,572 @@ +/* + * ckGeometry.c -- + * + * This file contains generic code for geometry management + * (stuff that's used by all geometry managers). + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * Data structures of the following type are used by Tk_MaintainGeometry. + * For each slave managed by Tk_MaintainGeometry, there is one of these + * structures associated with its master. + */ + +typedef struct MaintainSlave { + CkWindow *slave; /* The slave window being positioned. */ + CkWindow *master; /* The master that determines slave's + * position; it must be a descendant of + * slave's parent. */ + int x, y; /* Desired position of slave relative to + * master. */ + int width, height; /* Desired dimensions of slave. */ + struct MaintainSlave *nextPtr; + /* Next in list of Maintains associated + * with master. */ +} MaintainSlave; + +/* + * For each window that has been specified as a master to + * Tk_MaintainGeometry, there is a structure of the following type: + */ + +typedef struct MaintainMaster { + CkWindow *ancestor; /* The lowest ancestor of this window + * for which we have *not* created a + * StructureNotify handler. May be the + * same as the window itself. */ + int checkScheduled; /* Non-zero means that there is already a + * call to MaintainCheckProc scheduled as + * an idle handler. */ + MaintainSlave *slavePtr; /* First in list of all slaves associated + * with this master. */ +} MaintainMaster; + +/* + * Hash table that maps from a master's CkWindow pointer to a list of + * Maintains for that master: + */ + +static Tcl_HashTable maintainHashTable; + +/* + * Has maintainHashTable been initialized yet? + */ + +static int initialized = 0; + +/* + * Prototypes for static procedures in this file: + */ + +static void MaintainCheckProc _ANSI_ARGS_((ClientData clientData)); +static void MaintainMasterProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static void MaintainSlaveProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); + +/* + *-------------------------------------------------------------- + * + * Ck_ManageGeometry -- + * + * Arrange for a particular procedure to manage the geometry + * of a given slave window. + * + * Results: + * None. + * + * Side effects: + * Proc becomes the new geometry manager for tkwin, replacing + * any previous geometry manager. The geometry manager will + * be notified (by calling procedures in *mgrPtr) when interesting + * things happen in the future. If there was an existing geometry + * manager for tkwin different from the new one, it is notified + * by calling its lostSlaveProc. + * + *-------------------------------------------------------------- + */ + +void +Ck_ManageGeometry(winPtr, mgrPtr, clientData) + CkWindow *winPtr; /* Window whose geometry is to + * be managed by proc. */ + Ck_GeomMgr *mgrPtr; /* Static structure describing the + * geometry manager. This structure + * must never go away. */ + ClientData clientData; /* Arbitrary one-word argument to + * pass to geometry manager procedures. */ +{ + if ((winPtr->geomMgrPtr != NULL) && (mgrPtr != NULL) + && ((winPtr->geomMgrPtr != mgrPtr) + || (winPtr->geomData != clientData)) + && (winPtr->geomMgrPtr->lostSlaveProc != NULL)) { + (*winPtr->geomMgrPtr->lostSlaveProc)(winPtr->geomData, winPtr); + } + + winPtr->geomMgrPtr = mgrPtr; + winPtr->geomData = clientData; +} + +/* + *-------------------------------------------------------------- + * + * Ck_GeometryRequest -- + * + * This procedure is invoked by widget code to indicate + * its preferences about the size of a window it manages. + * In general, widget code should call this procedure + * rather than Ck_ResizeWindow. + * + * Results: + * None. + * + * Side effects: + * The geometry manager for winPtr (if any) is invoked to + * handle the request. If possible, it will reconfigure + * winPtr and/or other windows to satisfy the request. The + * caller gets no indication of success or failure, but it + * will get events if the window size was actually + * changed. + * + *-------------------------------------------------------------- + */ + +void +Ck_GeometryRequest(winPtr, reqWidth, reqHeight) + CkWindow *winPtr; /* Window that geometry information + * pertains to. */ + int reqWidth, reqHeight; /* Minimum desired dimensions for + * window, in pixels. */ +{ + if (reqWidth <= 0) { + reqWidth = 1; + } + if (reqHeight <= 0) { + reqHeight = 1; + } + if ((reqWidth == winPtr->reqWidth) && (reqHeight == winPtr->reqHeight)) { + return; + } + winPtr->reqWidth = reqWidth; + winPtr->reqHeight = reqHeight; + if ((winPtr->geomMgrPtr != NULL) + && (winPtr->geomMgrPtr->requestProc != NULL)) { + (*winPtr->geomMgrPtr->requestProc)(winPtr->geomData, winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * Ck_SetInternalBorder -- + * + * Notify relevant geometry managers that a window has an internal + * border of zero or one character cells and that child windows + * should not be placed on that border. + * + * Results: + * None. + * + * Side effects: + * The border is recorded for the window, and all geometry + * managers of all children are notified so that can re-layout, if + * necessary. + * + *---------------------------------------------------------------------- + */ + +void +Ck_SetInternalBorder(winPtr, onoff) + CkWindow *winPtr; /* Window to modify. */ + int onoff; /* Border flag. */ +{ + if ((onoff && (winPtr->flags & CK_BORDER)) || + (!onoff && !(winPtr->flags & CK_BORDER))) + return; + if (onoff) + winPtr->flags |= CK_BORDER; + else + winPtr->flags &= ~CK_BORDER; + for (winPtr = winPtr->childList; winPtr != NULL; + winPtr = winPtr->nextPtr) { + if (winPtr->geomMgrPtr != NULL) { + (*winPtr->geomMgrPtr->requestProc)(winPtr->geomData, winPtr); + } + } +} + +/* + *---------------------------------------------------------------------- + * + * Ck_MaintainGeometry -- + * + * This procedure is invoked by geometry managers to handle slaves + * whose master's are not their parents. It translates the desired + * geometry for the slave into the coordinate system of the parent + * and respositions the slave if it isn't already at the right place. + * Furthermore, it sets up event handlers so that if the master (or + * any of its ancestors up to the slave's parent) is mapped, unmapped, + * or moved, then the slave will be adjusted to match. + * + * Results: + * None. + * + * Side effects: + * Event handlers are created and state is allocated to keep track + * of slave. Note: if slave was already managed for master by + * Tk_MaintainGeometry, then the previous information is replaced + * with the new information. The caller must eventually call + * Tk_UnmaintainGeometry to eliminate the correspondence (or, the + * state is automatically freed when either window is destroyed). + * + *---------------------------------------------------------------------- + */ + +void +Ck_MaintainGeometry(slave, master, x, y, width, height) + CkWindow *slave; /* Slave for geometry management. */ + CkWindow *master; /* Master for slave; must be a descendant + * of slave's parent. */ + int x, y; /* Desired position of slave within master. */ + int width, height; /* Desired dimensions for slave. */ +{ + Tcl_HashEntry *hPtr; + MaintainMaster *masterPtr; + register MaintainSlave *slavePtr; + int new, map; + CkWindow *ancestor, *parent; + + if (!initialized) { + initialized = 1; + Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS); + } + + /* + * See if there is already a MaintainMaster structure for the master; + * if not, then create one. + */ + + parent = slave->parentPtr; + hPtr = Tcl_CreateHashEntry(&maintainHashTable, (char *) master, &new); + if (!new) { + masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr); + } else { + masterPtr = (MaintainMaster *) ckalloc(sizeof(MaintainMaster)); + masterPtr->ancestor = master; + masterPtr->checkScheduled = 0; + masterPtr->slavePtr = NULL; + Tcl_SetHashValue(hPtr, masterPtr); + } + + /* + * Create a MaintainSlave structure for the slave if there isn't + * already one. + */ + + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + if (slavePtr->slave == slave) { + goto gotSlave; + } + } + slavePtr = (MaintainSlave *) ckalloc(sizeof(MaintainSlave)); + slavePtr->slave = slave; + slavePtr->master = master; + slavePtr->nextPtr = masterPtr->slavePtr; + masterPtr->slavePtr = slavePtr; + Ck_CreateEventHandler(slave, + CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY, + MaintainSlaveProc, (ClientData) slavePtr); + + /* + * Make sure that there are event handlers registered for all + * the windows between master and slave's parent (including master + * but not slave's parent). There may already be handlers for master + * and some of its ancestors (masterPtr->ancestor tells how many). + */ + + for (ancestor = master; ancestor != parent; + ancestor = ancestor->parentPtr) { + if (ancestor == masterPtr->ancestor) { + Ck_CreateEventHandler(ancestor, + CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY, + MaintainMasterProc, (ClientData) masterPtr); + masterPtr->ancestor = ancestor->parentPtr; + } + } + + /* + * Fill in up-to-date information in the structure, then update the + * window if it's not currently in the right place or state. + */ + + gotSlave: + slavePtr->x = x; + slavePtr->y = y; + slavePtr->width = width; + slavePtr->height = height; + map = 1; + for (ancestor = slavePtr->master; ; ancestor = ancestor->parentPtr) { + if (!(ancestor->flags & CK_MAPPED) && (ancestor != parent)) { + map = 0; + } + if (ancestor == parent) { + if ((x != slavePtr->slave->x) + || (y != slavePtr->slave->y) + || (width != slavePtr->slave->width) + || (height != slavePtr->slave->height)) { + Ck_MoveWindow(slavePtr->slave, x, y); + Ck_ResizeWindow(slavePtr->slave, width, height); + Ck_RestackWindow(slavePtr->slave, CK_ABOVE, slavePtr->master); + } + if (map) { + Ck_MapWindow(slavePtr->slave); + } else { + Ck_UnmapWindow(slavePtr->slave); + } + break; + } + x += ancestor->x; + y += ancestor->y; + } +} + +/* + *---------------------------------------------------------------------- + * + * Ck_UnmaintainGeometry -- + * + * This procedure cancels a previous Ck_MaintainGeometry call, + * so that the relationship between slave and master is no longer + * maintained. + * + * Results: + * None. + * + * Side effects: + * The slave is unmapped and state is released, so that slave won't + * track master any more. If we weren't previously managing slave + * relative to master, then this procedure has no effect. + * + *---------------------------------------------------------------------- + */ + +void +Ck_UnmaintainGeometry(slave, master) + CkWindow *slave; /* Slave for geometry management. */ + CkWindow *master; /* Master for slave; must be a descendant + * of slave's parent. */ +{ + Tcl_HashEntry *hPtr; + MaintainMaster *masterPtr; + register MaintainSlave *slavePtr, *prevPtr; + CkWindow *ancestor; + + if (!initialized) { + initialized = 1; + Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS); + } + + if (!(slave->flags & CK_ALREADY_DEAD)) { + Ck_UnmapWindow(slave); + } + hPtr = Tcl_FindHashEntry(&maintainHashTable, (char *) master); + if (hPtr == NULL) { + return; + } + masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr); + slavePtr = masterPtr->slavePtr; + if (slavePtr->slave == slave) { + masterPtr->slavePtr = slavePtr->nextPtr; + } else { + for (prevPtr = slavePtr, slavePtr = slavePtr->nextPtr; ; + prevPtr = slavePtr, slavePtr = slavePtr->nextPtr) { + if (slavePtr == NULL) { + return; + } + if (slavePtr->slave == slave) { + prevPtr->nextPtr = slavePtr->nextPtr; + break; + } + } + } + Ck_DeleteEventHandler(slavePtr->slave, + CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY, + MaintainSlaveProc, (ClientData) slavePtr); + ckfree((char *) slavePtr); + if (masterPtr->slavePtr == NULL) { + if (masterPtr->ancestor != NULL) { + for (ancestor = master; ; ancestor = ancestor->parentPtr) { + Ck_DeleteEventHandler(ancestor, + CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY, + MaintainMasterProc, (ClientData) masterPtr); + if (ancestor == masterPtr->ancestor) { + break; + } + } + } + if (masterPtr->checkScheduled) { + Tk_CancelIdleCall(MaintainCheckProc, (ClientData) masterPtr); + } + Tcl_DeleteHashEntry(hPtr); + ckfree((char *) masterPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * MaintainMasterProc -- + * + * This procedure is invoked by the event dispatcher in + * response to StructureNotify events on the master or one + * of its ancestors, on behalf of Ck_MaintainGeometry. + * + * Results: + * None. + * + * Side effects: + * It schedules a call to MaintainCheckProc, which will eventually + * caused the postions and mapped states to be recalculated for all + * the maintained slaves of the master. Or, if the master window is + * being deleted then state is cleaned up. + * + *---------------------------------------------------------------------- + */ + +static void +MaintainMasterProc(clientData, eventPtr) + ClientData clientData; /* Pointer to MaintainMaster structure + * for the master window. */ + CkEvent *eventPtr; /* Describes what just happened. */ +{ + MaintainMaster *masterPtr = (MaintainMaster *) clientData; + MaintainSlave *slavePtr; + int done; + + if ((eventPtr->type == CK_EV_EXPOSE) + || (eventPtr->type == CK_EV_MAP) + || (eventPtr->type == CK_EV_UNMAP)) { + if (!masterPtr->checkScheduled) { + masterPtr->checkScheduled = 1; + Tk_DoWhenIdle(MaintainCheckProc, (ClientData) masterPtr); + } + } else if (eventPtr->type == CK_EV_DESTROY) { + /* + * Delete all of the state associated with this master, but + * be careful not to use masterPtr after the last slave is + * deleted, since its memory will have been freed. + */ + + done = 0; + do { + slavePtr = masterPtr->slavePtr; + if (slavePtr->nextPtr == NULL) { + done = 1; + } + Ck_UnmaintainGeometry(slavePtr->slave, slavePtr->master); + } while (!done); + } +} + +/* + *---------------------------------------------------------------------- + * + * MaintainSlaveProc -- + * + * This procedure is invoked by the Tk event dispatcher in + * response to StructureNotify events on a slave being managed + * by Tk_MaintainGeometry. + * + * Results: + * None. + * + * Side effects: + * If the event is a DestroyNotify event then the Maintain state + * and event handlers for this slave are deleted. + * + *---------------------------------------------------------------------- + */ + +static void +MaintainSlaveProc(clientData, eventPtr) + ClientData clientData; /* Pointer to MaintainSlave structure + * for master-slave pair. */ + CkEvent *eventPtr; /* Describes what just happened. */ +{ + MaintainSlave *slavePtr = (MaintainSlave *) clientData; + + if (eventPtr->type == CK_EV_DESTROY) { + Ck_UnmaintainGeometry(slavePtr->slave, slavePtr->master); + } +} + +/* + *---------------------------------------------------------------------- + * + * MaintainCheckProc -- + * + * This procedure is invoked by the Tk event dispatcher as an + * idle handler, when a master or one of its ancestors has been + * reconfigured, mapped, or unmapped. Its job is to scan all of + * the slaves for the master and reposition them, map them, or + * unmap them as needed to maintain their geometry relative to + * the master. + * + * Results: + * None. + * + * Side effects: + * Slaves can get repositioned, mapped, or unmapped. + * + *---------------------------------------------------------------------- + */ + +static void +MaintainCheckProc(clientData) + ClientData clientData; /* Pointer to MaintainMaster structure + * for the master window. */ +{ + MaintainMaster *masterPtr = (MaintainMaster *) clientData; + MaintainSlave *slavePtr; + CkWindow *ancestor, *parent; + int x, y, map; + + masterPtr->checkScheduled = 0; + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + parent = slavePtr->slave->parentPtr; + x = slavePtr->x; + y = slavePtr->y; + map = 1; + for (ancestor = slavePtr->master; ; ancestor = ancestor->parentPtr) { + if (!(ancestor->flags & CK_MAPPED) && (ancestor != parent)) { + map = 0; + } + if (ancestor == parent) { + if ((x != slavePtr->slave->x) + || (y != slavePtr->slave->y)) { + Ck_MoveWindow(slavePtr->slave, x, y); + } + if (map) { + Ck_MapWindow(slavePtr->slave); + } else { + Ck_UnmapWindow(slavePtr->slave); + } + break; + } + x += ancestor->x; + y += ancestor->y; + } + } +} diff --git a/ckGet.c b/ckGet.c new file mode 100644 index 0000000..028410c --- /dev/null +++ b/ckGet.c @@ -0,0 +1,538 @@ +/* + * ckGet.c -- + * + * This file contains a number of "Ck_GetXXX" procedures, which + * parse text strings into useful forms for Ck. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +typedef struct { + short fg, bg; +} CPair; + +static CPair *cPairs = NULL; +static int numPairs, newPair; + +/* + * The hash table below is used to keep track of all the Ck_Uids created + * so far. + */ + +static Tcl_HashTable uidTable; +static int initialized = 0; + +static struct { + char *name; + int value; +} ctab[] = { + { "black", COLOR_BLACK }, + { "blue", COLOR_BLUE }, + { "cyan", COLOR_CYAN }, + { "green", COLOR_GREEN }, + { "magenta", COLOR_MAGENTA }, + { "red", COLOR_RED }, + { "white", COLOR_WHITE }, + { "yellow", COLOR_YELLOW } +}; + +static struct { + char *name; + int value; +} atab[] = { + { "blink", A_BLINK }, + { "bold", A_BOLD }, + { "dim", A_DIM }, + { "normal", A_NORMAL }, + { "reverse", A_REVERSE }, + { "standout", A_STANDOUT }, + { "underline", A_UNDERLINE } +}; + +/* + *---------------------------------------------------------------------- + * + * Ck_GetUid -- + * + * Given a string, this procedure returns a unique identifier + * for the string. + * + * Results: + * This procedure returns a Ck_Uid corresponding to the "string" + * argument. The Ck_Uid has a string value identical to string + * (strcmp will return 0), but it's guaranteed that any other + * calls to this procedure with a string equal to "string" will + * return exactly the same result (i.e. can compare Ck_Uid + * *values* directly, without having to call strcmp on what they + * point to). + * + * Side effects: + * New information may be entered into the identifier table. + * + *---------------------------------------------------------------------- + */ + +Ck_Uid +Ck_GetUid(string) + char *string; /* String to convert. */ +{ + int dummy; + + if (!initialized) { + Tcl_InitHashTable(&uidTable, TCL_STRING_KEYS); + initialized = 1; + } + return (Ck_Uid) Tcl_GetHashKey(&uidTable, + Tcl_CreateHashEntry(&uidTable, string, &dummy)); +} + +/* + *------------------------------------------------------------------------ + * + * Ck_GetColor -- + * + * Given a color specification, return curses color value. + * + * Results: + * TCL_OK if color found, curses color in *colorPtr. + * TCL_ERROR if color not found; interp->result contains an + * error message. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ + +int +Ck_GetColor(interp, name, colorPtr) + Tcl_Interp *interp; + char *name; + int *colorPtr; +{ + int i, len; + + len = strlen(name); + if (len > 0) + for (i = 0; i < sizeof (ctab) / sizeof (ctab[0]); i++) + if (strncmp(name, ctab[i].name, len) == 0) { + if (colorPtr != NULL) + *colorPtr = ctab[i].value; + return TCL_OK; + } + Tcl_AppendResult(interp, "bad color \"", name, "\"", (char *) NULL); + return TCL_ERROR; +} + +/* + *------------------------------------------------------------------------ + * + * Ck_NameOfColor -- + * + * Given a curses color, return its name. + * + * Results: + * String: name of color, or NULL if no valid color. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ + +char * +Ck_NameOfColor(color) + int color; /* Curses color to get name for */ +{ + int i; + + for (i = 0; i < sizeof (ctab) / sizeof (ctab[0]); i++) + if (ctab[i].value == color) + return ctab[i].name; + return NULL; +} + +/* + *------------------------------------------------------------------------ + * + * Ck_GetAttr -- + * + * Given an attribute specification, return attribute value. + * + * Results: + * TCL_OK if color found, curses color in *colorPtr. + * TCL_ERROR if color not found; interp->result contains an + * error message. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ + +int +Ck_GetAttr(interp, name, attrPtr) + Tcl_Interp *interp; + char *name; + int *attrPtr; +{ + int i, k, len, largc; + char **largv; + + if (Tcl_SplitList(interp, name, &largc, &largv) != TCL_OK) + return TCL_ERROR; + if (attrPtr != NULL) + *attrPtr = A_NORMAL; + if (largc > 1 || (largc == 1 && largv[0][0] != '\0')) { + for (i = 0; i < largc; i++) { + len = strlen(largv[i]); + if (len > 0) { + for (k = 0; k < sizeof (atab) / sizeof (atab[0]); k++) + if (strncmp(largv[i], atab[k].name, len) == 0) { + if (attrPtr != NULL) + *attrPtr |= atab[k].value; + break; + } + if (k >= sizeof (atab) / sizeof (atab[0])) { + Tcl_AppendResult(interp, "bad attribute \"", + name, "\"", (char *) NULL); + ckfree((char *) largv); + return TCL_ERROR; + } + } + } + } + ckfree((char *) largv); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------ + * + * Ck_NameOfAttr -- + * + * Given an attribute value, return its textual specification. + * + * Results: + * interp->result contains result or message. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ + +char * +Ck_NameOfAttr(attr) + int attr; +{ + int i; + char *result; + Tcl_DString list; + + Tcl_DStringInit(&list); + if (attr == -1 || attr == A_NORMAL) + Tcl_DStringAppendElement(&list, "normal"); + else { + for (i = 0; i < sizeof (atab) / sizeof (atab[0]); i++) + if (attr & atab[i].value) + Tcl_DStringAppendElement(&list, atab[i].name); + } + result = ckalloc(Tcl_DStringLength(&list) + 1); + strcpy(result, Tcl_DStringValue(&list)); + Tcl_DStringFree(&list); + return result; +} +/* + *------------------------------------------------------------------------ + * + * Ck_GetColorPair -- + * + * Given background/foreground curses colors, a color pair + * is allocated and returned. + * + * Results: + * TCL_OK if color found, curses color in *colorPtr. + * TCL_ERROR if color not found; interp->result contains an + * error message. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ + +int +Ck_GetPair(winPtr, fg, bg) + CkWindow *winPtr; + int fg, bg; +{ + int i; + + if (!(winPtr->mainPtr->flags & CK_HAS_COLOR)) + return COLOR_PAIR(0); + if (cPairs == NULL) { + cPairs = (CPair *) ckalloc(sizeof (CPair) * (COLOR_PAIRS + 2)); + numPairs = 0; + newPair = 1; + } + for (i = 1; i < numPairs; i++) + if (cPairs[i].fg == fg && cPairs[i].bg == bg) + return COLOR_PAIR(i); + i = newPair; + cPairs[i].fg = fg; + cPairs[i].bg = bg; + init_pair((short) i, (short) fg, (short) bg); + if (++newPair >= COLOR_PAIRS) + newPair = 1; + else + numPairs = newPair; + return COLOR_PAIR(i); +} + +/* + *-------------------------------------------------------------- + * + * Ck_GetAnchor -- + * + * Given a string, return the corresponding Ck_Anchor. + * + * Results: + * The return value is a standard Tcl return result. If + * TCL_OK is returned, then everything went well and the + * position is stored at *anchorPtr; otherwise TCL_ERROR + * is returned and an error message is left in + * interp->result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Ck_GetAnchor(interp, string, anchorPtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + char *string; /* String describing a direction. */ + Ck_Anchor *anchorPtr; /* Where to store Ck_Anchor corresponding + * to string. */ +{ + switch (string[0]) { + case 'n': + if (string[1] == 0) { + *anchorPtr = CK_ANCHOR_N; + return TCL_OK; + } else if ((string[1] == 'e') && (string[2] == 0)) { + *anchorPtr = CK_ANCHOR_NE; + return TCL_OK; + } else if ((string[1] == 'w') && (string[2] == 0)) { + *anchorPtr = CK_ANCHOR_NW; + return TCL_OK; + } + goto error; + case 's': + if (string[1] == 0) { + *anchorPtr = CK_ANCHOR_S; + return TCL_OK; + } else if ((string[1] == 'e') && (string[2] == 0)) { + *anchorPtr = CK_ANCHOR_SE; + return TCL_OK; + } else if ((string[1] == 'w') && (string[2] == 0)) { + *anchorPtr = CK_ANCHOR_SW; + return TCL_OK; + } else { + goto error; + } + case 'e': + if (string[1] == 0) { + *anchorPtr = CK_ANCHOR_E; + return TCL_OK; + } + goto error; + case 'w': + if (string[1] == 0) { + *anchorPtr = CK_ANCHOR_W; + return TCL_OK; + } + goto error; + case 'c': + if (strncmp(string, "center", strlen(string)) == 0) { + *anchorPtr = CK_ANCHOR_CENTER; + return TCL_OK; + } + goto error; + } + + error: + Tcl_AppendResult(interp, "bad anchor position \"", string, + "\": must be n, ne, e, se, s, sw, w, nw, or center", + (char *) NULL); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * Ck_NameOfAnchor -- + * + * Given a Ck_Anchor, return the string that corresponds + * to it. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +char * +Ck_NameOfAnchor(anchor) + Ck_Anchor anchor; /* Anchor for which identifying string + * is desired. */ +{ + switch (anchor) { + case CK_ANCHOR_N: return "n"; + case CK_ANCHOR_NE: return "ne"; + case CK_ANCHOR_E: return "e"; + case CK_ANCHOR_SE: return "se"; + case CK_ANCHOR_S: return "s"; + case CK_ANCHOR_SW: return "sw"; + case CK_ANCHOR_W: return "w"; + case CK_ANCHOR_NW: return "nw"; + case CK_ANCHOR_CENTER: return "center"; + } + return "unknown anchor position"; +} + +/* + *-------------------------------------------------------------- + * + * Ck_GetJustify -- + * + * Given a string, return the corresponding Ck_Justify. + * + * Results: + * The return value is a standard Tcl return result. If + * TCL_OK is returned, then everything went well and the + * justification is stored at *justifyPtr; otherwise + * TCL_ERROR is returned and an error message is left in + * interp->result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Ck_GetJustify(interp, string, justifyPtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + char *string; /* String describing a justification style. */ + Ck_Justify *justifyPtr; /* Where to store Ck_Justify corresponding + * to string. */ +{ + int c, length; + + c = string[0]; + length = strlen(string); + + if ((c == 'l') && (strncmp(string, "left", length) == 0)) { + *justifyPtr = CK_JUSTIFY_LEFT; + return TCL_OK; + } + if ((c == 'r') && (strncmp(string, "right", length) == 0)) { + *justifyPtr = CK_JUSTIFY_RIGHT; + return TCL_OK; + } + if ((c == 'c') && (strncmp(string, "center", length) == 0)) { + *justifyPtr = CK_JUSTIFY_CENTER; + return TCL_OK; + } + if ((c == 'f') && (strncmp(string, "fill", length) == 0)) { + *justifyPtr = CK_JUSTIFY_FILL; + return TCL_OK; + } + + Tcl_AppendResult(interp, "bad justification \"", string, + "\": must be left, right, center, or fill", + (char *) NULL); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * Ck_NameOfJustify -- + * + * Given a Ck_Justify, return the string that corresponds + * to it. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +char * +Ck_NameOfJustify(justify) + Ck_Justify justify; /* Justification style for which + * identifying string is desired. */ +{ + switch (justify) { + case CK_JUSTIFY_LEFT: return "left"; + case CK_JUSTIFY_RIGHT: return "right"; + case CK_JUSTIFY_CENTER: return "center"; + case CK_JUSTIFY_FILL: return "fill"; + } + return "unknown justification style"; +} + +/* + *-------------------------------------------------------------- + * + * Ck_GetCoord -- + * + * Given a string, return the coordinate that corresponds + * to it. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Ck_GetCoord(interp, winPtr, string, intPtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + CkWindow *winPtr; /* Window (not used). */ + char *string; /* String to convert. */ + int *intPtr; /* Place to store converted result. */ +{ + int value; + + if (Tcl_GetInt(interp, string, &value) != TCL_OK) + return TCL_ERROR; + if (value < 0) { + Tcl_AppendResult(interp, "coordinate may not be negative", + (char *) NULL); + return TCL_ERROR; + } + *intPtr = value; + return TCL_OK; +} diff --git a/ckGrid.c b/ckGrid.c new file mode 100644 index 0000000..0d54a32 --- /dev/null +++ b/ckGrid.c @@ -0,0 +1,2090 @@ +/* + * ckGrid.c -- + * + * Grid based geometry manager. + * + * Copyright (c) 1996 by Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * LayoutInfo structure. We shouldn't be using hard-wired limits! + */ + +#define MAXGRIDSIZE 128 +#ifndef MAXINT +# define MAXINT 0x7fff +#endif +#define MINWEIGHT 0.0001 /* weight totals < this are considered to be zero */ + +/* + * Special characters to support relative layouts + */ + +#define REL_SKIP 'x' /* skip this column */ +#define REL_HORIZ '-' /* extend previous widget horizontally */ +#define REL_VERT '^' /* extend previous widget verticallly */ + +/* + * structure to hold collected constraints temporarily: + * needs to use a "Constrain" thingy + */ + +typedef struct { + int width, height; /* number of cells horizontally, vertically */ + int lastRow; /* last cell with a window in it */ + int minWidth[MAXGRIDSIZE]; /* largest minWidth in each column */ + int minHeight[MAXGRIDSIZE]; /* largest minHeight in each row */ + double weightX[MAXGRIDSIZE];/* largest weight in each column */ + double weightY[MAXGRIDSIZE];/* largest weight in each row */ +} LayoutInfo; + +/* structure for holding row and column constraints */ + +typedef struct { + int used; /* maximum element used */ + int max; /* maximum element allocated */ + int *minsize; /* array of minimum column/row sizes */ + double *weight; /* array of column/row weights */ +} Constrain; + +/* For each window that the gridbag cares about (either because + * the window is managed by the gridbag or because the window + * has slaves that are managed by the gridbag), there is a + * structure of the following type: + */ + +typedef struct GridBag { + CkWindow *winPtr; /* Pointer to window. NULL means that + * the window has been deleted, but the + * packet hasn't had a chance to clean up + * yet because the structure is still in + * use. */ + struct GridBag *masterPtr; /* Master window within which this window + * is managed (NULL means this window + * isn't managed by the gridbag). */ + struct GridBag *nextPtr; /* Next window managed within same + * parent. List is priority-ordered: + * first on list gets layed out first. */ + struct GridBag *slavePtr; /* First in list of slaves managed + * inside this window (NULL means + * no gridbag slaves). */ + + int gridColumn, gridRow; + int gridWidth, gridHeight; + + int tempX, tempY; + int tempWidth, tempHeight; + + double weightX, weightY; + int minWidth, minHeight; + + int padX, padY; /* Total additional pixels to leave around the + * window (half of this space is left on each + * side). This is space *outside* the window: + * we'll allocate extra space in frame but + * won't enlarge window). */ + int iPadX, iPadY; /* Total extra pixels to allocate inside the + * window (half this amount will appear on + * each side). */ + int startx, starty; /* starting location of layout */ + int *abortPtr; /* If non-NULL, it means that there is a nested + * call to ArrangeGrid already working on + * this window. *abortPtr may be set to 1 to + * abort that nested call. This happens, for + * example, if winPtr or any of its slaves + * is deleted. */ + int flags; /* Miscellaneous flags; see below + * for definitions. */ + + Constrain row, column; /* column and row constraints */ + + int valid; + LayoutInfo *layoutCache; +} GridBag; + +/* + * Flag values for GridBag structures: + * + * REQUESTED_RELAYOUT: 1 means a Tk_DoWhenIdle request + * has already been made to re-arrange + * all the slaves of this window. + * STICK_NORTH 1 means this window sticks to the edgth of its + * STICK_EAST cavity + * STICK_SOUTH + * STICK_WEST + * + * DONT_PROPAGATE: 1 means don't set this window's requested + * size. 0 means if this window is a master + * then Ck will set its requested size to fit + * the needs of its slaves. + */ + +#define STICK_NORTH 1 +#define STICK_EAST 2 +#define STICK_SOUTH 4 +#define STICK_WEST 8 +#define STICK_ALL (STICK_NORTH|STICK_EAST|STICK_SOUTH|STICK_WEST) + +#define REQUESTED_RELAYOUT 16 +#define DONT_PROPAGATE 32 + +/* + * Hash table used to map from CkWindow pointers to corresponding + * GridBag structures: + */ + +static Tcl_HashTable gridBagHashTable; + +/* + * Have statics in this module been initialized? + */ + +static initialized = 0; + +/* + * Prototypes for procedures used only in this file: + */ + +static void ArrangeGrid _ANSI_ARGS_((ClientData clientData)); +static int ConfigureSlaves _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, int argc, char *argv[])); +static void DestroyGridBag _ANSI_ARGS_((char *memPtr)); +static void GetCachedLayoutInfo _ANSI_ARGS_((GridBag *masterPtr)); +static GridBag * GetGridBag _ANSI_ARGS_((CkWindow *winPtr)); +static void GetLayoutInfo _ANSI_ARGS_((GridBag *masterPtr, + LayoutInfo *r)); +static void GetMinSize _ANSI_ARGS_((GridBag *masterPtr, + LayoutInfo *info, int *minw, int *minh)); +static void GridBagStructureProc _ANSI_ARGS_(( + ClientData clientData, CkEvent *eventPtr)); +static void GridLostSlaveProc _ANSI_ARGS_((ClientData clientData, + CkWindow *winPtr)); +static void GridReqProc _ANSI_ARGS_((ClientData clientData, + CkWindow *winPtr)); +static void GridBagStructureProc _ANSI_ARGS_(( + ClientData clientData, CkEvent *eventPtr)); +static void StickyToString _ANSI_ARGS_((int flags, char *result)); +static int StringToSticky _ANSI_ARGS_((char *string)); +static void Unlink _ANSI_ARGS_((GridBag *gridPtr)); + +static Ck_GeomMgr gridMgrType = { + "grid", /* name */ + GridReqProc, /* requestProc */ + GridLostSlaveProc, /* lostSlaveProc */ +}; + +/* + *-------------------------------------------------------------- + * + * Ck_GridCmd -- + * + * This procedure is invoked to process the "grid" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_GridCmd(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. */ +{ + CkWindow *winPtr = (CkWindow *) clientData; + size_t length; + char c; + + if ((argc >= 2) && (argv[1][0] == '.')) { + return ConfigureSlaves(interp, winPtr, argc-1, argv+1); + } + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option arg ?arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + + if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) { + CkWindow *master; + GridBag *masterPtr; + int row, column; + int i, x, y; + int prevX, prevY; + int width, height; + double weight; + int diff; + + if (argc != 5) { + Tcl_AppendResult(interp, "Wrong number of arguments: ", + "must be \"",argv[0], + " bbox \"", (char *) NULL); + return TCL_ERROR; + } + + master = Ck_NameToWindow(interp, argv[2], winPtr); + if (master == NULL) { + return TCL_ERROR; + } + if (Tcl_GetInt(interp, argv[3], &column) != TCL_OK) { + return TCL_ERROR; + } + if (Tcl_GetInt(interp, argv[4], &row) != TCL_OK) { + return TCL_ERROR; + } + masterPtr = GetGridBag(master); + + /* make sure the grid is up to snuff */ + + while ((masterPtr->flags & REQUESTED_RELAYOUT)) { + Tk_CancelIdleCall(ArrangeGrid, (ClientData) masterPtr); + ArrangeGrid((ClientData) masterPtr); + } + GetCachedLayoutInfo(masterPtr); + + if (row < 0 || column < 0) { + *interp->result = '\0'; + return TCL_OK; + } + if (column >= masterPtr->layoutCache->width || + row >= masterPtr->layoutCache->height) { + *interp->result = '\0'; + return TCL_OK; + } + x = masterPtr->startx; + y = masterPtr->starty; + GetMinSize(masterPtr, masterPtr->layoutCache, &width, &height); + + diff = masterPtr->winPtr->width - (width + masterPtr->iPadX); + for (weight=0.0, i=0; ilayoutCache->width; i++) + weight += masterPtr->layoutCache->weightX[i]; + + prevX = 0; /* Needed to prevent gcc warning. */ + for (i=0; i<=column; i++) { + int dx = 0; + if (weight > MINWEIGHT) { + dx = (int)((((double)diff) * + masterPtr->layoutCache->weightX[i]) / weight); + } + prevX = x; + x += masterPtr->layoutCache->minWidth[i] + dx; + } + diff = masterPtr->winPtr->height - (height + masterPtr->iPadY); + for (weight=0.0, i=0; ilayoutCache->width; i++) { + weight += masterPtr->layoutCache->weightY[i]; + } + prevY = 0; /* Needed to prevent gcc warning. */ + for (i=0; i<=row; i++) { + int dy = 0; + if (weight > MINWEIGHT) { + dy = (int)((((double)diff) * + masterPtr->layoutCache->weightY[i]) / weight); + } + prevY = y; + y += masterPtr->layoutCache->minHeight[i] + dy; + } + sprintf(interp->result,"%d %d %d %d",prevX,prevY,x - prevX,y - prevY); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) { + if (argv[2][0] != '.') { + Tcl_AppendResult(interp, "bad argument \"", argv[2], + "\": must be name of window", (char *) NULL); + return TCL_ERROR; + } + return ConfigureSlaves(interp, winPtr, argc-2, argv+2); + } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) { + CkWindow *slave; + GridBag *slavePtr; + int i; + + for (i = 2; i < argc; i++) { + slave = Ck_NameToWindow(interp, argv[i], winPtr); + if (slave == NULL) { + return TCL_ERROR; + } + slavePtr = GetGridBag(slave); + if (slavePtr->masterPtr != NULL) { + Ck_ManageGeometry(slave, (Ck_GeomMgr *) NULL, + (ClientData) NULL); + Unlink(slavePtr); + Ck_UnmapWindow(slavePtr->winPtr); + } + } + } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) { + GridBag *slavePtr; + CkWindow *slave; + char buffer[64]; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " info window\"", (char *) NULL); + return TCL_ERROR; + } + slave = Ck_NameToWindow(interp, argv[2], winPtr); + if (slave == NULL) { + return TCL_ERROR; + } + slavePtr = GetGridBag(slave); + if (slavePtr->masterPtr == NULL) { + interp->result[0] = '\0'; + return TCL_OK; + } + +#if 0 + Tcl_AppendElement(interp, "-in"); + Tcl_AppendElement(interp, slavePtr->masterPtr->winPtr->pathName); +#endif + sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d", + slavePtr->gridColumn, slavePtr->gridRow, + slavePtr->gridWidth, slavePtr->gridHeight); + Tcl_AppendResult(interp, buffer, (char *) NULL); + sprintf(buffer, " -ipadx %d -ipady %d -padx %d -pady %d", + slavePtr->iPadX/2, slavePtr->iPadY/2, slavePtr->padX/2, + slavePtr->padY/2); + Tcl_AppendResult(interp, buffer, (char *) NULL); + StickyToString(slavePtr->flags,buffer); + Tcl_AppendResult(interp, " -sticky ", buffer, (char *) NULL); +#if 0 + sprintf(buffer, " -weightx %.2f -weighty %.2f", + slavePtr->weightX, slavePtr->weightY); + Tcl_AppendResult(interp, buffer, (char *) NULL); +#endif + } else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) { + CkWindow *master; + GridBag *masterPtr; + int propagate; + + if (argc > 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " propagate window ?boolean?\"", + (char *) NULL); + return TCL_ERROR; + } + master = Ck_NameToWindow(interp, argv[2], winPtr); + if (master == NULL) { + return TCL_ERROR; + } + masterPtr = GetGridBag(master); + if (argc == 3) { + interp->result = (masterPtr->flags & DONT_PROPAGATE) ? "0" : "1"; + return TCL_OK; + } + if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) { + return TCL_ERROR; + } + if (propagate) { + masterPtr->flags &= ~DONT_PROPAGATE; + + /* + * Re-arrange the master to allow new geometry information to + * propagate upwards to the master\'s master. + */ + + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + masterPtr->valid = 0; + if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { + masterPtr->flags |= REQUESTED_RELAYOUT; + Tk_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + } + } else { + masterPtr->flags |= DONT_PROPAGATE; + } + } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)) { + CkWindow *master; + GridBag *masterPtr; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " size window\"", (char *) NULL); + return TCL_ERROR; + } + master = Ck_NameToWindow(interp, argv[2], winPtr); + if (master == NULL) + return TCL_ERROR; + masterPtr = GetGridBag(master); + GetCachedLayoutInfo(masterPtr); + + sprintf(interp->result, "%d %d", masterPtr->layoutCache->width, + masterPtr->layoutCache->height); + } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) { + CkWindow *master; + GridBag *masterPtr, *slavePtr; + int i, value; + int row = -1, column = -1; + + if (argc < 3 || argc%2 ==0) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " slaves window ?-option value...?\"", + (char *) NULL); + return TCL_ERROR; + } + + for (i=3; islavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + if (column>=0 && (slavePtr->gridColumn > column + || slavePtr->gridColumn+slavePtr->gridWidth-1 < column)) { + continue; + } + if (row>=0 && (slavePtr->gridRow > row || + slavePtr->gridRow+slavePtr->gridHeight-1 < row)) { + continue; + } + Tcl_AppendElement(interp, slavePtr->winPtr->pathName); + } + + /* + * grid columnconfigure -option + * grid columnconfigure -option value -option value + * grid rowconfigure -option + * grid rowconfigure -option value -option value + */ + + } else if (((c == 'c') && + (strncmp(argv[1], "columnconfigure", length) == 0)) || + ((c == 'r') && (strncmp(argv[1], "rowconfigure", length) == 0))) { + CkWindow *master; + GridBag *masterPtr; + Constrain *con; + int index, i, size; + double weight; + + if (argc != 5 && (argc < 5 || argc%2 == 1)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ", argv[1], " master index ?-option value...?\"", + (char *)NULL); + return TCL_ERROR; + } + + master = Ck_NameToWindow(interp, argv[2], winPtr); + if (master == NULL) { + return TCL_ERROR; + } + masterPtr = GetGridBag(master); + con = (c=='c') ? &(masterPtr->column) : &(masterPtr->row); + + if (Tcl_GetInt(interp, argv[3], &index) != TCL_OK) { + return TCL_ERROR; + } + if (index < 0 || index >= MAXGRIDSIZE) { + Tcl_AppendResult(interp, argv[3], " is out of range", + (char *)NULL); + return TCL_ERROR; + } + + /* + * make sure the row/column constraint array is allocated. This + * Should be changed to avoid hard-wired limits. We'll wimp out + * for now. + */ + + if (con->max == 0) { + unsigned int size; + con->max = MAXGRIDSIZE; + con->used = 0; + + size = MAXGRIDSIZE * sizeof(con->minsize[0]); + con->minsize = (int *) ckalloc(size); + memset(con->minsize, 0, size); + + size = MAXGRIDSIZE * sizeof(con->weight[0]); + con->weight = (double *) ckalloc(size); + memset(con->weight, 0, size); + } + + for (i=4; iused <= index ? 0 : con->minsize[index]; + sprintf(interp->result, "%d", size); + } else if (Ck_GetCoord(interp, master, argv[i + 1], &size) + != TCL_OK) { + return TCL_ERROR; + } else { + con->minsize[index] = size; + if (size > 0 && index >= con->used) { + con->used = index+1; + } else if (size == 0 && index+1 == con->used) { + while (index >= 0 && (con->minsize[index]==0) && + (con->weight[index] == 0.0)) { + index--; + } + con->used = index + 1; + } + } + } else if (strncmp(argv[i], "-weight", length) == 0) { + if (argc == 5) { + weight = con->used <= index ? 0 : con->weight[index]; + sprintf(interp->result, "%.2f", weight); + } else if (Tcl_GetDouble(interp, argv[i+1], &weight) + != TCL_OK) { + return TCL_ERROR; + } else { + con->weight[index] = weight; + if (weight > MINWEIGHT && index >= con->used) { + con->used = index+1; + } else if (weight == 0.0 && index+1 == con->used) { + while (index >= 0 && (con->minsize[index]==0) && + (con->weight[index] == 0.0)) { + index--; + } + con->used = index + 1; + } + } + } else { + Tcl_AppendResult(interp, argv[i], + " is an invalid option: should be \"", + "-minsize, -weight\"", + (char *) NULL); + return TCL_ERROR; + } + } + + /* if we changed a property, re-arrange the table */ + + if (argc != 5) { + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + masterPtr->valid = 0; + if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { + masterPtr->flags |= REQUESTED_RELAYOUT; + Tk_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + } + } + } else if ((c == 'l') && (strncmp(argv[1], "location", length) == 0)) { + CkWindow *master; + GridBag *masterPtr; + int x, y, i, j, w, h; + int width, height; + double weight; + int diff; + + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " location master x y\"", (char *)NULL); + return TCL_ERROR; + } + + master = Ck_NameToWindow(interp, argv[2], winPtr); + if (master == NULL) { + return TCL_ERROR; + } + masterPtr = GetGridBag(master); + + if (Ck_GetCoord(interp, master, argv[3], &x) != TCL_OK) { + return TCL_ERROR; + } + if (Ck_GetCoord(interp, master, argv[4], &y) != TCL_OK) { + return TCL_ERROR; + } + + /* make sure the grid is up to snuff */ + + while ((masterPtr->flags & REQUESTED_RELAYOUT)) { + Tk_CancelIdleCall(ArrangeGrid, (ClientData) masterPtr); + ArrangeGrid((ClientData) masterPtr); + } + GetCachedLayoutInfo(masterPtr); + GetMinSize(masterPtr, masterPtr->layoutCache, &width, &height); + + diff = masterPtr->winPtr->width - (width + masterPtr->iPadX); + for (weight=0.0, i=0; ilayoutCache->width; i++) { + weight += masterPtr->layoutCache->weightX[i]; + } + w = masterPtr->startx; + if (w > x) { + i = -1; + } else { + for (i = 0; i < masterPtr->layoutCache->width; i++) { + int dx = 0; + if (weight > MINWEIGHT) { + dx = (int)((((double)diff) * + masterPtr->layoutCache->weightX[i]) / weight); + } + w += masterPtr->layoutCache->minWidth[i] + dx; + if (w > x) { + break; + } + } + } + + diff = masterPtr->winPtr->height - (height + masterPtr->iPadY); + for (weight = 0.0, j = 0; j < masterPtr->layoutCache->height; j++) + weight += masterPtr->layoutCache->weightY[j]; + h = masterPtr->starty; + if (h > y) { + j = -1; + } else { + for (j = 0; j < masterPtr->layoutCache->height; j++) { + int dy = 0; + if (weight > MINWEIGHT) { + dy = (int)((((double)diff) * + masterPtr->layoutCache->weightY[j]) / weight); + } + h += masterPtr->layoutCache->minHeight[j] + dy; + if (h > y) { + break; + } + } + } + sprintf(interp->result, "%d %d", i, j); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be bbox, columnconfigure, configure, forget, ", + "info, location, propagate, rowconfigure, size, or slaves", + (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * GridReqProc -- + * + * This procedure is invoked by Ck_GeometryRequest for + * windows managed by the gridbag. + * + * Results: + * None. + * + * Side effects: + * Arranges for winPtr, and all its managed siblings, to + * be re-arranged at the next idle point. + * + *-------------------------------------------------------------- + */ + +static void +GridReqProc(clientData, winPtr) + ClientData clientData; /* GridBag's information about + * window that got new preferred + * geometry. */ + CkWindow *winPtr; /* Other Ck-related information + * about the window. */ +{ + GridBag *gridPtr = (GridBag *) clientData; + + gridPtr = gridPtr->masterPtr; + gridPtr->valid = 0; + if (!(gridPtr->flags & REQUESTED_RELAYOUT)) { + gridPtr->flags |= REQUESTED_RELAYOUT; + Tk_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * GridLostSlaveProc -- + * + * This procedure is invoked by Ck whenever some other geometry + * claims control over a slave that used to be managed by us. + * + * Results: + * None. + * + * Side effects: + * Forgets all grid-related information about the slave. + * + *-------------------------------------------------------------- + */ + +static void +GridLostSlaveProc(clientData, winPtr) + ClientData clientData; /* GridBag structure for slave window that + * was stolen away. */ + CkWindow *winPtr; /* Pointer to the slave window. */ +{ + GridBag *slavePtr = (GridBag *) clientData; + + if (slavePtr->masterPtr->winPtr != slavePtr->winPtr->parentPtr) { + Ck_UnmaintainGeometry(slavePtr->winPtr, slavePtr->masterPtr->winPtr); + } + Unlink(slavePtr); + Ck_UnmapWindow(slavePtr->winPtr); +} + +/* + *-------------------------------------------------------------- + * + * Fill in an instance of the above structure for the current set + * of managed children. This requires two passes through the + * set of children, first to figure out what cells they occupy + * and how many rows and columns there are, and then to distribute + * the weights and min sizes amoung the rows/columns. + * + * This also caches the minsizes for all the children when they are + * first encountered. + * + *-------------------------------------------------------------- + */ + +static void +GetLayoutInfo(masterPtr, r) + GridBag *masterPtr; + LayoutInfo *r; +{ + GridBag *slavePtr; + int i, k, px, py, pixels_diff, nextSize; + double weight_diff, weight; + int curX, curY, curWidth, curHeight, curRow, curCol; + int xMax[MAXGRIDSIZE]; + int yMax[MAXGRIDSIZE]; + + /* + * Pass #1 + * + * Figure out the dimensions of the layout grid. + */ + + r->width = r->height = 0; + curRow = curCol = -1; + memset(xMax, 0, sizeof(int) * MAXGRIDSIZE); + memset(yMax, 0, sizeof(int) * MAXGRIDSIZE); + + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + + curX = slavePtr->gridColumn; + curY = slavePtr->gridRow; + curWidth = slavePtr->gridWidth; + curHeight = slavePtr->gridHeight; + + /* Adjust the grid width and height */ + for (px = curX + curWidth; r->width < px; r->width++) { + /* Null body. */ + } + for (py = curY + curHeight; r->height < py; r->height++) { + /* Null body. */ + } + + /* Adjust the xMax and yMax arrays */ + for (i = curX; i < (curX + curWidth); i++) { + yMax[i] = py; + } + for (i = curY; i < (curY + curHeight); i++) { + xMax[i] = px; + } + + /* Cache the current slave's size. */ + slavePtr->minWidth = slavePtr->winPtr->reqWidth; + slavePtr->minHeight = slavePtr->winPtr->reqHeight; + } + + /* + * Apply minimum row/column dimensions + */ + if (r->width < masterPtr->column.used) { + r->width = masterPtr->column.used; + } + r->lastRow = r->height; + if (r->height < masterPtr->row.used) { + r->height = masterPtr->row.used; + } + + /* + * Pass #2 + */ + + curRow = curCol = -1; + memset(xMax, 0, sizeof(int) * MAXGRIDSIZE); + memset(yMax, 0, sizeof(int) * MAXGRIDSIZE); + + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + curX = slavePtr->gridColumn; + curY = slavePtr->gridRow; + curWidth = slavePtr->gridWidth; + curHeight = slavePtr->gridHeight; + + px = curX + curWidth; + py = curY + curHeight; + + for (i = curX; i < (curX + curWidth); i++) { + yMax[i] = py; + } + for (i = curY; i < (curY + curHeight); i++) { + xMax[i] = px; + } + + /* Assign the new values to the gridbag slave */ + slavePtr->tempX = curX; + slavePtr->tempY = curY; + slavePtr->tempWidth = curWidth; + slavePtr->tempHeight = curHeight; + } + + /* + * Pass #3 + * + * Distribute the minimun widths and weights: + */ + + /* Initialize arrays to zero */ + memset(r->minWidth, 0, r->width * sizeof(int)); + memset(r->minHeight, 0, r->height * sizeof(int)); + memset(r->weightX, 0, r->width * sizeof(double)); + memset(r->weightY, 0, r->height * sizeof(double)); + nextSize = MAXINT; + + for (i = 1; i != MAXINT; i = nextSize, nextSize = MAXINT) { + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + + if (slavePtr->tempWidth == i) { + px = slavePtr->tempX + slavePtr->tempWidth; /* right column */ + + /* + * Figure out if we should use this slave's weight. + * If the weight is less than the total weight spanned by + * the width of the cell, then discard the weight. + * Otherwise split it the difference + * according to the existing weights. + */ + + weight_diff = slavePtr->weightX; + for (k = slavePtr->tempX; k < px; k++) + weight_diff -= r->weightX[k]; + if (weight_diff > 0.0) { + weight = 0.0; + for (k = slavePtr->tempX; k < px; k++) + weight += r->weightX[k]; + for (k = slavePtr->tempX; weight > MINWEIGHT; k++) { + double wt = r->weightX[k]; + double dx = (wt * weight_diff) / weight; + r->weightX[k] += dx; + weight_diff -= dx; + weight -= wt; + } + /* Assign the remainder to the rightmost cell */ + r->weightX[px-1] += weight_diff; + } + + /* + * Calculate the minWidth array values. + * First, figure out how wide the current slave needs to be. + * Then, see if it will fit within the current minWidth values. + * If it won't fit, add the difference according to the + * weightX array. + */ + + pixels_diff = slavePtr->minWidth + slavePtr->padX + + slavePtr->iPadX; + for (k = slavePtr->tempX; k < px; k++) + pixels_diff -= r->minWidth[k]; + if (pixels_diff > 0) { + weight = 0.0; + for (k = slavePtr->tempX; k < px; k++) + weight += r->weightX[k]; + for (k = slavePtr->tempX; weight > MINWEIGHT; k++) { + double wt = r->weightX[k]; + int dx = (int)((wt * ((double)pixels_diff)) / weight); + r->minWidth[k] += dx; + pixels_diff -= dx; + weight -= wt; + } + /* Any leftovers go into the rightmost cell */ + r->minWidth[px-1] += pixels_diff; + } + } else if (slavePtr->tempWidth > i && + slavePtr->tempWidth < nextSize) + nextSize = slavePtr->tempWidth; + + if (slavePtr->tempHeight == i) { + py = slavePtr->tempY + slavePtr->tempHeight; /* bottom row */ + + /* + * Figure out if we should use this slave's weight. + * If the weight is less than the total weight spanned by + * the height of the cell, then discard the weight. + * Otherwise split it the difference according to the + * existing weights. + */ + + weight_diff = slavePtr->weightY; + for (k = slavePtr->tempY; k < py; k++) + weight_diff -= r->weightY[k]; + if (weight_diff > 0.0) { + weight = 0.0; + for (k = slavePtr->tempY; k < py; k++) + weight += r->weightY[k]; + for (k = slavePtr->tempY; weight > MINWEIGHT; k++) { + double wt = r->weightY[k]; + double dy = (wt * weight_diff) / weight; + r->weightY[k] += dy; + weight_diff -= dy; + weight -= wt; + } + /* Assign the remainder to the bottom cell */ + r->weightY[py-1] += weight_diff; + } + + /* + * Calculate the minHeight array values. + * First, figure out how tall the current slave needs to be. + * Then, see if it will fit within the current minHeight + * values. If it won't fit, add the difference according to + * the weightY array. + */ + + pixels_diff = slavePtr->minHeight + slavePtr->padY + + slavePtr->iPadY; + for (k = slavePtr->tempY; k < py; k++) + pixels_diff -= r->minHeight[k]; + if (pixels_diff > 0) { + weight = 0.0; + for (k = slavePtr->tempY; k < py; k++) + weight += r->weightY[k]; + for (k = slavePtr->tempY; weight > MINWEIGHT; k++) { + double wt = r->weightY[k]; + int dy = (int)((wt * ((double)pixels_diff)) / weight); + r->minHeight[k] += dy; + pixels_diff -= dy; + weight -= wt; + } + /* Any leftovers go into the bottom cell */ + r->minHeight[py-1] += pixels_diff; + } + } else if (slavePtr->tempHeight > i && + slavePtr->tempHeight < nextSize) + nextSize = slavePtr->tempHeight; + } + } + + /* + * Apply minimum row/column dimensions + */ + for (i=0; icolumn.used; i++) { + if (r->minWidth[i] < masterPtr->column.minsize[i]) + r->minWidth[i] = masterPtr->column.minsize[i]; + if (r->weightX[i] < masterPtr->column.weight[i]) + r->weightX[i] = masterPtr->column.weight[i]; + } + for (i=0; irow.used; i++) { + if (r->minHeight[i] < masterPtr->row.minsize[i]) + r->minHeight[i] = masterPtr->row.minsize[i]; + if (r->weightY[i] < masterPtr->row.weight[i]) + r->weightY[i] = masterPtr->row.weight[i]; + } +} + +/* + *-------------------------------------------------------------- + * + * Cache the layout info after it is calculated. + * + *-------------------------------------------------------------- + */ + +static void +GetCachedLayoutInfo(masterPtr) + GridBag *masterPtr; +{ + if (masterPtr->valid == 0) { + if (!masterPtr->layoutCache) + masterPtr->layoutCache = (LayoutInfo *)ckalloc(sizeof(LayoutInfo)); + + GetLayoutInfo(masterPtr, masterPtr->layoutCache); + masterPtr->valid = 1; + } +} + +/* + *-------------------------------------------------------------- + * + * Adjusts the x, y, width, and height fields to the correct + * values depending on the constraint geometry and pads. + * + *-------------------------------------------------------------- + */ + +static void +AdjustForGravity(gridPtr, x, y, width, height) + GridBag *gridPtr; + int *x; + int *y; + int *width; + int *height; +{ + int diffx=0, diffy=0; + int sticky = gridPtr->flags&STICK_ALL; + + *x += gridPtr->padX/2; + *width -= gridPtr->padX; + *y += gridPtr->padY/2; + *height -= gridPtr->padY; + + if (*width > (gridPtr->minWidth + gridPtr->iPadX)) { + diffx = *width - (gridPtr->minWidth + gridPtr->iPadX); + *width = gridPtr->minWidth + gridPtr->iPadX; + } + + if (*height > (gridPtr->minHeight + gridPtr->iPadY)) { + diffy = *height - (gridPtr->minHeight + gridPtr->iPadY); + *height = gridPtr->minHeight + gridPtr->iPadY; + } + + if (sticky&STICK_EAST && sticky&STICK_WEST) + *width += diffx; + if (sticky&STICK_NORTH && sticky&STICK_SOUTH) + *height += diffy; + if (!(sticky&STICK_WEST)) { + if (sticky&STICK_EAST) + *x += diffx; + else + *x += diffx/2; + } + if (!(sticky&STICK_NORTH)) { + if (sticky&STICK_SOUTH) + *y += diffy; + else + *y += diffy/2; + } +} + +/* + *-------------------------------------------------------------- + * + * Figure out the minimum size (not counting the X border) of the + * master based on the information from GetLayoutInfo() + * + *-------------------------------------------------------------- + */ + +static void +GetMinSize(masterPtr, info, minw, minh) + GridBag *masterPtr; + LayoutInfo *info; + int *minw; + int *minh; +{ + int i, t; + int intBWidth; /* Width of internal border in parent window, + * if any. */ + + intBWidth = (masterPtr->winPtr->flags & CK_BORDER) ? 1 : 0; + + t = 0; + for(i = 0; i < info->width; i++) + t += info->minWidth[i]; + *minw = t + 2*intBWidth; + + t = 0; + for(i = 0; i < info->height; i++) + t += info->minHeight[i]; + *minh = t + 2*intBWidth; +} + +/* + *-------------------------------------------------------------- + * + * ArrangeGrid -- + * + * This procedure is invoked (using the Tk_DoWhenIdle + * mechanism) to re-layout a set of windows managed by + * the gridbag. It is invoked at idle time so that a + * series of gridbag requests can be merged into a single + * layout operation. + * + * Results: + * None. + * + * Side effects: + * The slaves of masterPtr may get resized or moved. + * + *-------------------------------------------------------------- + */ + +static void +ArrangeGrid(clientData) + ClientData clientData; /* Structure describing parent whose slaves + * are to be re-layed out. */ +{ + GridBag *masterPtr = (GridBag *) clientData; + GridBag *slavePtr; + int abort; + int i, x, y, width, height; + int diffw, diffh; + double weight; + CkWindow *parent, *ancestor; + LayoutInfo info; + int intBWidth; /* Width of internal border in parent window, + * if any. */ + int iPadX, iPadY; + + masterPtr->flags &= ~REQUESTED_RELAYOUT; + + /* + * If the parent has no slaves anymore, then don't do anything + * at all: just leave the parent's size as-is. + * Even if row and column constraints have been set! + */ + + if (masterPtr->slavePtr == NULL) { + return; + } + + /* + * Abort any nested call to ArrangeGrid for this window, since + * we'll do everything necessary here, and set up so this call + * can be aborted if necessary. + */ + + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + masterPtr->abortPtr = &abort; + abort = 0; + Ck_Preserve((ClientData) masterPtr); + + /* + * Pass #1: scan all the slaves to figure out the total amount + * of space needed. + */ + + GetLayoutInfo(masterPtr, &info); + GetMinSize(masterPtr, &info, &width, &height); + + if (((width != masterPtr->winPtr->reqWidth) + || (height != masterPtr->winPtr->reqHeight)) + && !(masterPtr->flags & DONT_PROPAGATE)) { + Ck_GeometryRequest(masterPtr->winPtr, width, height); + masterPtr->flags |= REQUESTED_RELAYOUT; + masterPtr->valid = 0; + Tk_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + goto done; + } + + /* + * If the parent isn't mapped then don't do anything more: wait + * until it gets mapped again. Need to get at least to here to + * reflect size needs up the window hierarchy, but there's no + * point in actually mapping the slaves. + */ + + if (!(masterPtr->winPtr->flags & CK_MAPPED)) { + goto done; + } + + /* + * If the current dimensions of the window don't match the desired + * dimensions, then adjust the minWidth and minHeight arrays + * according to the weights. + */ + + diffw = masterPtr->winPtr->width - (width + masterPtr->iPadX); + if (diffw != 0) { + weight = 0.0; + for (i = 0; i < info.width; i++) + weight += info.weightX[i]; + if (weight > MINWEIGHT) { + for (i = 0; i < info.width; i++) { + int dx = (int)(( ((double)diffw) * info.weightX[i]) / weight); + info.minWidth[i] += dx; + width += dx; + if (info.minWidth[i] < 0) { + width -= info.minWidth[i]; + info.minWidth[i] = 0; + } + } + } + diffw = masterPtr->winPtr->width - (width + masterPtr->iPadX); + } + else { + diffw = 0; + } + + diffh = masterPtr->winPtr->height - (height + masterPtr->iPadY); + if (diffh != 0) { + weight = 0.0; + for (i = 0; i < info.height; i++) + weight += info.weightY[i]; + if (weight > MINWEIGHT) { + for (i = 0; i < info.height; i++) { + int dy = (int)(( ((double)diffh) * info.weightY[i]) / weight); + info.minHeight[i] += dy; + height += dy; + if (info.minHeight[i] < 0) { + height -= info.minHeight[i]; + info.minHeight[i] = 0; + } + } + } + diffh = masterPtr->winPtr->height - (height + masterPtr->iPadY); + } + else { + diffh = 0; + } + + /* + * Now do the actual layout of the slaves using the layout information + * that has been collected. + */ + + iPadX = masterPtr->iPadX/2; + iPadY = masterPtr->iPadY/2; + intBWidth = (masterPtr->winPtr->flags & CK_BORDER) ? 1 : 0; + + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + + masterPtr->startx = x = diffw/2 + intBWidth + iPadX; + for(i = 0; i < slavePtr->tempX; i++) + x += info.minWidth[i]; + + masterPtr->starty = y = diffh/2 + intBWidth + iPadY; + for(i = 0; i < slavePtr->tempY; i++) + y += info.minHeight[i]; + + width = 0; + for(i = slavePtr->tempX; i < (slavePtr->tempX + slavePtr->tempWidth); + i++) + width += info.minWidth[i]; + + height = 0; + for(i = slavePtr->tempY; i < (slavePtr->tempY + slavePtr->tempHeight); + i++) + height += info.minHeight[i]; + + AdjustForGravity(slavePtr, &x, &y, &width, &height); + + /* + * If the window in which slavePtr is managed is not its + * parent in the window hierarchy, translate the coordinates + * to the coordinate system of the real X parent. + */ + + parent = slavePtr->winPtr->parentPtr; + for (ancestor = masterPtr->winPtr; ancestor != parent; + ancestor = ancestor->parentPtr) { + x += ancestor->x; + y += ancestor->y; + } + + /* + * If the window is too small to be interesting then + * unmap it. Otherwise configure it and then make sure + * it's mapped. + */ + + if ((width <= 0) || (height <= 0)) { + Ck_UnmapWindow(slavePtr->winPtr); + } + else { + if (width != slavePtr->winPtr->width || + height != slavePtr->winPtr->height) + Ck_ResizeWindow(slavePtr->winPtr, width, height); + if (x != slavePtr->winPtr->x || + y != slavePtr->winPtr->y) + Ck_MoveWindow(slavePtr->winPtr, x, y); + /* + * Temporary kludge til Ck_MoveResizeWindow available !!! + */ + if (width != slavePtr->winPtr->width || + height != slavePtr->winPtr->height) + Ck_ResizeWindow(slavePtr->winPtr, width, height); + if (abort) { + goto done; + } + Ck_MapWindow(slavePtr->winPtr); + } + + /* + * Changes to the window's structure could cause almost anything + * to happen, including deleting the parent or child. If this + * happens, we'll be told to abort. + */ + + if (abort) { + goto done; + } + } + + done: + masterPtr->abortPtr = NULL; + Ck_Release((ClientData) masterPtr); +} + +/* + *-------------------------------------------------------------- + * + * GetGridBag -- + * + * This internal procedure is used to locate a GridBag + * structure for a given window, creating one if one + * doesn't exist already. + * + * Results: + * The return value is a pointer to the GridBag structure + * corresponding to winPtr. + * + * Side effects: + * A new gridbag structure may be created. If so, then + * a callback is set up to clean things up when the + * window is deleted. + * + *-------------------------------------------------------------- + */ + +static GridBag * +GetGridBag(winPtr) + CkWindow *winPtr; /* Pointer to window for which + * gridbag structure is desired. */ +{ + GridBag *gridPtr; + Tcl_HashEntry *hPtr; + int new; + + if (!initialized) { + initialized = 1; + Tcl_InitHashTable(&gridBagHashTable, TCL_ONE_WORD_KEYS); + } + + /* + * See if there's already gridbag for this window. If not, + * then create a new one. + */ + + hPtr = Tcl_CreateHashEntry(&gridBagHashTable, (char *) winPtr, &new); + if (!new) { + return (GridBag *) Tcl_GetHashValue(hPtr); + } + gridPtr = (GridBag *) ckalloc(sizeof(GridBag)); + gridPtr->winPtr = winPtr; + gridPtr->masterPtr = NULL; + gridPtr->nextPtr = NULL; + gridPtr->slavePtr = NULL; + + gridPtr->gridColumn = gridPtr->gridRow = -1; + gridPtr->gridWidth = gridPtr->gridHeight = 1; + gridPtr->weightX = gridPtr->weightY = 0.0; + gridPtr->minWidth = gridPtr->minHeight = 0; + + gridPtr->padX = gridPtr->padY = 0; + gridPtr->iPadX = gridPtr->iPadY = 0; + gridPtr->startx = gridPtr->starty = 0; + gridPtr->abortPtr = NULL; + gridPtr->flags = 0; + + gridPtr->column.max = 0; + gridPtr->row.max = 0; + gridPtr->column.used = 0; + gridPtr->row.used = 0; + + gridPtr->valid = 0; + gridPtr->layoutCache = NULL; + + Tcl_SetHashValue(hPtr, gridPtr); + Ck_CreateEventHandler(winPtr, + CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY, + GridBagStructureProc, (ClientData) gridPtr); + return gridPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Unlink -- + * + * Remove a gridbag from its parent's list of slaves. + * + * Results: + * None. + * + * Side effects: + * The parent will be scheduled for re-arranging. + * + *---------------------------------------------------------------------- + */ + +static void +Unlink(gridPtr) + GridBag *gridPtr; /* Window to unlink. */ +{ + GridBag *masterPtr, *gridPtr2; + + masterPtr = gridPtr->masterPtr; + if (masterPtr == NULL) { + return; + } + if (masterPtr->slavePtr == gridPtr) { + masterPtr->slavePtr = gridPtr->nextPtr; + } + else { + for (gridPtr2 = masterPtr->slavePtr; ; gridPtr2 = gridPtr2->nextPtr) { + if (gridPtr2 == NULL) { + panic("Unlink couldn't find previous window"); + } + if (gridPtr2->nextPtr == gridPtr) { + gridPtr2->nextPtr = gridPtr->nextPtr; + break; + } + } + } + masterPtr->valid = 0; + if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { + masterPtr->flags |= REQUESTED_RELAYOUT; + Tk_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + } + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + + gridPtr->masterPtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyGridBag -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a gridbag at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the gridbag is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyGridBag(memPtr) + char *memPtr; /* Info about window that is now dead. */ +{ + GridBag *gridPtr = (GridBag *) memPtr; + + if (gridPtr->column.max) { + ckfree((char *) gridPtr->column.minsize); + ckfree((char *) gridPtr->column.weight); + } + if (gridPtr->row.max) { + ckfree((char *) gridPtr->row.minsize); + ckfree((char *) gridPtr->row.weight); + } + if (gridPtr->layoutCache) + ckfree((char *) gridPtr->layoutCache); + + ckfree((char *) gridPtr); +} + +/* + *---------------------------------------------------------------------- + * + * GridBagStructureProc -- + * + * This procedure is invoked by the Ck event dispatcher in response + * to window change events. + * + * Results: + * None. + * + * Side effects: + * If a window was just deleted, clean up all its gridbag-related + * information. If it was just resized, re-configure its slaves, if + * any. + * + *---------------------------------------------------------------------- + */ + +static void +GridBagStructureProc(clientData, eventPtr) + ClientData clientData; /* Our information about window + * referred to by eventPtr. */ + CkEvent *eventPtr; /* Describes what just happened. */ +{ + GridBag *gridPtr = (GridBag *) clientData; + + if (eventPtr->type == CK_EV_MAP || eventPtr->type == CK_EV_EXPOSE) { + gridPtr->valid = 0; + if (!(gridPtr->flags & REQUESTED_RELAYOUT)) { + gridPtr->flags |= REQUESTED_RELAYOUT; + Tk_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr); + } + } else if (eventPtr->type == CK_EV_DESTROY) { + GridBag *gridPtr2, *nextPtr; + + if (gridPtr->masterPtr != NULL) { + Unlink(gridPtr); + } + for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL; + gridPtr2 = nextPtr) { + Ck_UnmapWindow(gridPtr2->winPtr); + gridPtr2->masterPtr = NULL; + nextPtr = gridPtr2->nextPtr; + gridPtr2->nextPtr = NULL; + } + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&gridBagHashTable, + (char *) gridPtr->winPtr)); + if (gridPtr->flags & REQUESTED_RELAYOUT) { + Tk_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr); + } + gridPtr->winPtr = NULL; + Ck_EventuallyFree((ClientData) gridPtr, + (Ck_FreeProc *) DestroyGridBag); + } else if (eventPtr->type == CK_EV_UNMAP) { + GridBag *gridPtr2; + + for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL; + gridPtr2 = gridPtr2->nextPtr) { + Ck_UnmapWindow(gridPtr2->winPtr); + } + } +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureSlaves -- + * + * This implements the guts of the "grid configure" command. Given + * a list of slaves and configuration options, it arranges for the + * gridbag to manage the slaves and sets the specified options. + * + * Results: + * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is + * returned and interp->result is set to contain an error message. + * + * Side effects: + * Slave windows get taken over by the gridbag. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureSlaves(interp, winPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + CkWindow *winPtr; /* Any window in application containing + * slaves. Used to look up slave names. */ + int argc; /* Number of elements in argv. */ + char *argv[]; /* Argument strings: contains one or more + * window names followed by any number + * of "option value" pairs. Caller must + * make sure that there is at least one + * window name. */ +{ + GridBag *masterPtr, *slavePtr, *prevPtr; + CkWindow *other, *slave; +#if 0 + CkWindow *parent, *ancestor; +#endif + int i, j, numWindows, c, length, tmp, positionGiven; + int currentColumn=0, numColumns=1; + int gotLayout = 0; + int gotWidth = 0; + int width; + + /* + * Find out how many windows are specified. (shouldn't use + * hardwired symbols) + */ + + for (numWindows = 0; numWindows < argc; numWindows++) { + if (argv[numWindows][0] != '.' + && strcmp(argv[numWindows],"-")!=0 + && strcmp(argv[numWindows],"^")!=0 + && strcmp(argv[numWindows],"x")!=0) { + break; + } + } + slave = NULL; + + /* + * Iterate over all of the slave windows, parsing the configuration + * options for each slave. It's a bit wasteful to re-parse the + * options for each slave, but things get too messy if we try to + * parse the arguments just once at the beginning. For example, + * if a slave already is managed we want to just change a few + * existing values without resetting everything. If there are + * multiple windows, the -in option only gets processed for the + * first window. + */ + + masterPtr = NULL; + prevPtr = NULL; + positionGiven = 0; + for (j = 0; j < numWindows; j++) { + + /* adjust default widget location for non-widgets */ + if (*argv[j] != '.') { + switch (*argv[j]) { + case '^': /* extend the widget in the previous row + * Since we don't know who the master is yet, + * handle these in a separate pass at the end + */ + /* no break */ + case REL_SKIP: /* skip over the next column */ + currentColumn++; + break; + case REL_HORIZ: /* increase the span, already dealt with */ + /* not quite right */ + if (j>0 && (*argv[j-1] == REL_SKIP || *argv[j-1] == '^')) { + Tcl_AppendResult(interp, "Invalid grid combination:", + " \"-\" can't follow \"", argv[j - 1], "\"", NULL); + return TCL_ERROR; + } + break; + default: + panic("Invalid grid position indicator"); + } + continue; + } + + for (numColumns = 1; + j + numColumns < numWindows && *argv[j + numColumns] == REL_HORIZ; + numColumns++) { + /* null body */ + } + slave = Ck_NameToWindow(interp, argv[j], winPtr); + if (slave == NULL) { + return TCL_ERROR; + } + if (slave->flags & CK_TOPLEVEL) { + Tcl_AppendResult(interp, "can't manage \"", argv[j], + "\": it's a top-level window", (char *) NULL); + return TCL_ERROR; + } + slavePtr = GetGridBag(slave); + + /* + * The following statement is taken from tkPack.c: + * + * "If the slave isn't currently managed, reset all of its + * configuration information to default values (there could + * be old values left from a previous packer)." + * + * I disagree with this statement. If a slave is disabled (using + * "forget") and then re-enabled, I submit that 90% of the time the + * programmer will want it to retain its old configuration information. + * If the programmer doesn't want this behavior, then she can reset the + * defaults for herself, but she will never have to worry about keeping + * track of the old state. + */ + + for (i = numWindows; i < argc; i+=2) { + if ((i+2) > argc) { + Tcl_AppendResult(interp, "extra option \"", argv[i], + "\" (option with no value?)", (char *) NULL); + return TCL_ERROR; + } + length = strlen(argv[i]); + if (length < 2) { + goto badOption; + } + c = argv[i][1]; +#if 0 + if ((c == 'i') && (strcmp(argv[i], "-in") == 0)) { + if (j == 0) { + other = Ck_NameToWindow(interp, argv[i+1], winPtr); + if (other == NULL) { + return TCL_ERROR; + } + if (other == slave) { + sprintf(interp->result, + "Window can't be managed in itself"); + return TCL_ERROR; + } + masterPtr = GetGridBag(other); + prevPtr = masterPtr->slavePtr; + if (prevPtr != NULL) { + while (prevPtr->nextPtr != NULL) { + prevPtr = prevPtr->nextPtr; + } + } + positionGiven = 1; + } + } else +#endif + if ((c == 'i') && (strcmp(argv[i], "-ipadx") == 0)) { + if ((Ck_GetCoord(interp, slave, argv[i + 1], &tmp) != TCL_OK) + || (tmp < 0)) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad ipadx value \"", argv[i+1], + "\": must be positive screen distance", + (char *) NULL); + return TCL_ERROR; + } + slavePtr->iPadX = tmp*2; + } else if ((c == 'i') && (strcmp(argv[i], "-ipady") == 0)) { + if ((Ck_GetCoord(interp, slave, argv[i + 1], &tmp) != TCL_OK) + || (tmp< 0)) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad ipady value \"", argv[i+1], + "\": must be positive screen distance", + (char *) NULL); + return TCL_ERROR; + } + slavePtr->iPadY = tmp*2; + } else if ((c == 'p') && (strcmp(argv[i], "-padx") == 0)) { + if ((Ck_GetCoord(interp, slave, argv[i + 1], &tmp) != TCL_OK) + || (tmp< 0)) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad padx value \"", argv[i+1], + "\": must be positive screen distance", + (char *) NULL); + return TCL_ERROR; + } + slavePtr->padX = tmp*2; + } else if ((c == 'p') && (strcmp(argv[i], "-pady") == 0)) { + if ((Ck_GetCoord(interp, slave, argv[i + 1], &tmp) != TCL_OK) + || (tmp< 0)) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad pady value \"", argv[i+1], + "\": must be positive screen distance", + (char *) NULL); + return TCL_ERROR; + } + slavePtr->padY = tmp*2; + } else if ((c == 'c') && (strcmp(argv[i], "-column") == 0)) { + if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || tmp<0) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad column value \"", argv[i+1], + "\": must be a non-negative integer", (char *) NULL); + return TCL_ERROR; + } + slavePtr->gridColumn = tmp; + } else if ((c == 'r') && (strcmp(argv[i], "-row") == 0)) { + if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || tmp<0) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad grid value \"", argv[i+1], + "\": must be a non-negative integer", (char *) NULL); + return TCL_ERROR; + } + slavePtr->gridRow = tmp; + } else if ((c == 'c') && (strcmp(argv[i], "-columnspan") == 0)) { + if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || + tmp <= 0) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad columnspan value \"", + argv[i+1], + "\": must be a positive integer", (char *) NULL); + return TCL_ERROR; + } + slavePtr->gridWidth = tmp; + gotWidth++; + } else if ((c == 'r') && (strcmp(argv[i], "-rowspan") == 0)) { + if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad rowspan value \"", + argv[i+1], + "\": must be a positive integer", (char *) NULL); + return TCL_ERROR; + } + slavePtr->gridHeight = tmp; +#if 0 + } else if ((c == 'w') && + (!strcmp(argv[i], "-weightx") || + !strcmp(argv[i], "-wx"))) { + if (Tcl_GetDouble(interp, argv[i+1], &tmp_dbl) != TCL_OK) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad weight value \"", argv[i+1], + "\": must be a double", (char *) NULL); + return TCL_ERROR; + } + slavePtr->weightX = tmp_dbl; + } else if ((c == 'w') && + (!strcmp(argv[i], "-weighty") || + !strcmp(argv[i], "-wy"))) { + if (Tcl_GetDouble(interp, argv[i+1], &tmp_dbl) != TCL_OK) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad weight value \"", argv[i+1], + "\": must be a double", (char *) NULL); + return TCL_ERROR; + } + slavePtr->weightY = tmp_dbl; +#endif + } else if ((c == 's') && strcmp(argv[i], "-sticky") == 0) { + int sticky = StringToSticky(argv[i+1]); + if (sticky == -1) { + Tcl_AppendResult(interp, "bad stickyness value \"", + argv[i+1], + "\": must be a string containing n, e, s, and/or w", + (char *) NULL); + return TCL_ERROR; + } + slavePtr->flags = sticky | (slavePtr->flags & ~STICK_ALL); + } else { + badOption: + Tcl_AppendResult(interp, "unknown or ambiguous option \"", +#if 0 + argv[i], "\": must be -in, -sticky, ", +#else + argv[i], "\": must be -sticky, ", +#endif + "-row, -column, -rowspan, -columnspan, ", + "-ipadx, -ipady, -padx or -pady.", + (char *) NULL); + return TCL_ERROR; + } + } + + /* + * If no position in a gridbag list was specified and the slave + * is already managed, then leave it in its current location in + * its current gridbag list. + */ + + if (!positionGiven && (slavePtr->masterPtr != NULL)) { + masterPtr = slavePtr->masterPtr; + goto scheduleLayout; + } + + /* + * If the slave is going to be put back after itself then + * skip the whole operation, since it won't work anyway. + */ + + if (prevPtr == slavePtr) { + masterPtr = slavePtr->masterPtr; + goto scheduleLayout; + } + + /* + * If the "-in" option has not been specified, arrange for the + * slave to go at the end of the order for its parent. + */ + + if (!positionGiven) { + masterPtr = GetGridBag(slave->parentPtr); + prevPtr = masterPtr->slavePtr; + if (prevPtr != NULL) { + while (prevPtr->nextPtr != NULL) { + prevPtr = prevPtr->nextPtr; + } + } + } +#if 0 + /* + * Make sure that the slave's parent is either the master or + * an ancestor of the master. + */ + + parent = slave->parentPtr; + for (ancestor = masterPtr->winPtr; ; ancestor = ancestor->parentPtr) { + if (ancestor == parent) { + break; + } + if (ancestor->flags & CK_TOPLEVEL) { + Tcl_AppendResult(interp, "can't put ", argv[j], + " inside ", masterPtr->winPtr->parentPtr, + (char *) NULL); + return TCL_ERROR; + } + } +#else + if (masterPtr->winPtr != slave->parentPtr) { + Tcl_AppendResult(interp, "can't put ", argv[j], + " inside ", masterPtr->winPtr->parentPtr, + (char *) NULL); + return TCL_ERROR; + } +#endif + + /* + * Unlink the slave if it's currently managed, then position it + * after prevPtr. + */ + + if (slavePtr->masterPtr != NULL) { + Unlink(slavePtr); + } + slavePtr->masterPtr = masterPtr; + if (prevPtr == NULL) { + slavePtr->nextPtr = masterPtr->slavePtr; + masterPtr->slavePtr = slavePtr; + } else { + slavePtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = slavePtr; + } + Ck_ManageGeometry(slave, &gridMgrType, (ClientData) slavePtr); + prevPtr = slavePtr; + + /* assign default row and column */ + + if (slavePtr->gridColumn == -1) { + slavePtr->gridColumn = currentColumn; + } + slavePtr->gridWidth += numColumns - 1; + if (slavePtr->gridRow == -1) { + if (!gotLayout++) GetCachedLayoutInfo(masterPtr); + slavePtr->gridRow = masterPtr->layoutCache->lastRow; + } + + /* + * Arrange for the parent to be re-arranged at the first + * idle moment. + */ + + scheduleLayout: + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + masterPtr->valid = 0; + if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { + masterPtr->flags |= REQUESTED_RELAYOUT; + Tk_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + } + currentColumn += slavePtr->gridWidth; + numColumns = 1; + } + + /* now look for all the "^"'s */ + + for (j = 0; j < numWindows; j++) { + struct GridBag *otherPtr; + char *lastWindow; /* use this window to base current row/col on */ + int match; /* found a match for the ^ */ + + if (*argv[j] == '.') { + lastWindow = argv[j]; + } + if (*argv[j] != '^') { + continue; + } + for (width=1; width+j < numWindows && *argv[j+width] == '^'; width++) { + /* Null Body */ + } + other = Ck_NameToWindow(interp, lastWindow, winPtr); + otherPtr = GetGridBag(other); + if (!gotLayout++) GetCachedLayoutInfo(masterPtr); + + for (match=0, slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + + if (slavePtr->gridWidth == width + && slavePtr->gridColumn == otherPtr->gridColumn + + otherPtr->gridWidth + && slavePtr->gridRow + slavePtr->gridHeight == + otherPtr->gridRow) { + slavePtr->gridHeight++; + match++; + } + lastWindow = slavePtr->winPtr->pathName; + } + if (!match) { + Tcl_AppendResult(interp, "can't find slave to extend with \"^\"", + " after ", lastWindow, (char *) NULL); + return TCL_ERROR; + } + j += width - 1; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Convert "Sticky" bits into a string + * + *---------------------------------------------------------------------- + */ + +static void +StickyToString(flags, result) + int flags; /* the sticky flags */ + char *result; /* where to put the result */ +{ + int count = 0; + if (flags & STICK_NORTH) + result[count++] = 'n'; + if (flags & STICK_EAST) + result[count++] = 'e'; + if (flags & STICK_SOUTH) + result[count++] = 's'; + if (flags & STICK_WEST) + result[count++] = 'w'; + if (count) { + result[count] = '\0'; + } else { + sprintf(result,"{}"); + } +} + +/* + *---------------------------------------------------------------------- + * + * Convert sticky string to flags + * + *---------------------------------------------------------------------- + */ + +static int +StringToSticky(string) + char *string; +{ + int sticky = 0; + char c; + + while ((c = *string++) != '\0') { + switch (c) { + case 'n': case 'N': sticky |= STICK_NORTH; break; + case 'e': case 'E': sticky |= STICK_EAST; break; + case 's': case 'S': sticky |= STICK_SOUTH; break; + case 'w': case 'W': sticky |= STICK_WEST; break; + case ' ': case ',': case '\t': case '\r': case '\n': break; + default: return -1; + } + } + return sticky; +} diff --git a/ckListbox.c b/ckListbox.c new file mode 100644 index 0000000..556b92e --- /dev/null +++ b/ckListbox.c @@ -0,0 +1,1708 @@ +/* + * ckListbox.c -- + * + * This module implements listbox widgets for the + * toolkit. A listbox displays a collection of strings, + * one per line, and provides scrolling and selection. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +/* + * One record of the following type is kept for each element + * associated with a listbox widget: + */ + +typedef struct Element { + int textLength; /* # non-NULL characters in text. */ + int textWidth; /* Total width of element in screen + * characters. */ + int selected; /* 1 means this item is selected, 0 means + * it isn't. */ + struct Element *nextPtr; /* Next in list of all elements of this + * listbox, or NULL for last element. */ + char text[4]; /* Characters of this element, NULL- + * terminated. The actual space allocated + * here will be as large as needed (> 4, + * most likely). Must be the last field + * of the record. */ +} Element; + +#define ElementSize(stringLength) \ + (sizeof(Element) - 3 + stringLength) + +/* + * A data structure of the following type is kept for each listbox + * widget managed by this file: + */ + +typedef struct { + CkWindow *winPtr; /* Window that embodies the listbox. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with listbox. */ + Tcl_Command widgetCmd; /* Token for listbox's widget command. */ + int numElements; /* Total number of elements in this listbox. */ + Element *firstPtr; /* First in list of elements (NULL if no + * elements). */ + Element *lastPtr; /* Last in list of elements (NULL if no + * elements). */ + + /* + * Information used when displaying widget: + */ + + int normalBg; /* Normal background color. */ + int normalFg; /* Normal foreground color. */ + int normalAttr; /* Normal video attributes. */ + int selBg; /* Select background color. */ + int selFg; /* Select foreground color. */ + int selAttr; /* Select video attributes. */ + int activeBg; /* Active background color. */ + int activeFg; /* Active foreground color. */ + int activeAttr; /* Video attribute for active item. */ + int width; /* Desired width of window, in characters. */ + int height; /* Desired height of window, in lines. */ + int topIndex; /* Index of top-most element visible in + * window. */ + int fullLines; /* Number of lines that fit are completely + * visible in window. There may be one + * additional line at the bottom that is + * partially visible. */ + + /* + * Information to support horizontal scrolling: + */ + + int maxWidth; /* Width of widest string in listbox. */ + int xOffset; /* The left edge of each string in the + * listbox is offset to the left by this + * many chars (0 means no offset, positive + * means there is an offset). */ + + /* + * Information about what's selected or active, if any. + */ + + Ck_Uid selectMode; /* Selection style: single, browse, multiple, + * or extended. This value isn't used in C + * code, but the Tcl bindings use it. */ + int numSelected; /* Number of elements currently selected. */ + int selectAnchor; /* Fixed end of selection (i.e. element + * at which selection was started.) */ + int active; /* Index of "active" element (the one that + * has been selected by keyboard traversal). + * -1 means none. */ + + /* + * Miscellaneous information: + */ + + char *takeFocus; /* Value of -takefocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + char *yScrollCmd; /* Command prefix for communicating with + * vertical scrollbar. NULL means no command + * to issue. Malloc'ed. */ + char *xScrollCmd; /* Command prefix for communicating with + * horizontal scrollbar. NULL means no command + * to issue. Malloc'ed. */ + int flags; /* Various flag bits: see below for + * definitions. */ +} Listbox; + +/* + * Flag bits for listboxes: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler + * has already been queued to redraw + * this window. + * UPDATE_V_SCROLLBAR: Non-zero means vertical scrollbar needs + * to be updated. + * UPDATE_H_SCROLLBAR: Non-zero means horizontal scrollbar needs + * to be updated. + * GOT_FOCUS: Non-zero means this widget currently + * has the input focus. + */ + +#define REDRAW_PENDING 1 +#define UPDATE_V_SCROLLBAR 2 +#define UPDATE_H_SCROLLBAR 4 +#define GOT_FOCUS 8 + +/* + * Information used for argv parsing: + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_LISTBOX_ACTIVE_ATTR_COLOR, + Ck_Offset(Listbox, activeAttr), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_LISTBOX_ACTIVE_ATTR_MONO, + Ck_Offset(Listbox, activeAttr), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_LISTBOX_ACTIVE_BG_COLOR, Ck_Offset(Listbox, activeBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_LISTBOX_ACTIVE_BG_MONO, Ck_Offset(Listbox, activeBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_LISTBOX_ACTIVE_FG_COLOR, Ck_Offset(Listbox, activeFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_LISTBOX_ACTIVE_FG_MONO, Ck_Offset(Listbox, activeFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_LISTBOX_ATTR, Ck_Offset(Listbox, normalAttr), 0}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_LISTBOX_BG_COLOR, Ck_Offset(Listbox, normalBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_LISTBOX_BG_MONO, Ck_Offset(Listbox, normalBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_LISTBOX_FG, Ck_Offset(Listbox, normalFg), 0}, + {CK_CONFIG_INT, "-height", "height", "Height", + DEF_LISTBOX_HEIGHT, Ck_Offset(Listbox, height), 0}, + {CK_CONFIG_ATTR, "-selectattributes", "selectAttributes", + "SelectAttributes", DEF_LISTBOX_SELECT_ATTR_COLOR, + Ck_Offset(Listbox, selAttr), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-selectattributes", "selectAttributes", + "SelectAttributes", DEF_LISTBOX_SELECT_ATTR_MONO, + Ck_Offset(Listbox, selAttr), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-selectbackground", "selectBackground", "Foreground", + DEF_LISTBOX_SELECT_BG_COLOR, Ck_Offset(Listbox, selBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectbackground", "selectBackground", "Foreground", + DEF_LISTBOX_SELECT_BG_MONO, Ck_Offset(Listbox, selBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_LISTBOX_SELECT_FG_COLOR, Ck_Offset(Listbox, selFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_LISTBOX_SELECT_FG_MONO, Ck_Offset(Listbox, selFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_UID, "-selectmode", "selectMode", "SelectMode", + DEF_LISTBOX_SELECT_MODE, Ck_Offset(Listbox, selectMode), 0}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_LISTBOX_TAKE_FOCUS, Ck_Offset(Listbox, takeFocus), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_INT, "-width", "width", "Width", + DEF_LISTBOX_WIDTH, Ck_Offset(Listbox, width), 0}, + {CK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", + DEF_LISTBOX_SCROLL_COMMAND, Ck_Offset(Listbox, xScrollCmd), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", + DEF_LISTBOX_SCROLL_COMMAND, Ck_Offset(Listbox, yScrollCmd), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void ChangeListboxOffset _ANSI_ARGS_((Listbox *listPtr, + int offset)); +static void ChangeListboxView _ANSI_ARGS_((Listbox *listPtr, + int index)); +static int ConfigureListbox _ANSI_ARGS_((Tcl_Interp *interp, + Listbox *listPtr, int argc, char **argv, + int flags)); +static void DeleteEls _ANSI_ARGS_((Listbox *listPtr, int first, + int last)); +static void DestroyListbox _ANSI_ARGS_((ClientData clientData)); +static void DisplayListbox _ANSI_ARGS_((ClientData clientData)); +static int GetListboxIndex _ANSI_ARGS_((Tcl_Interp *interp, + Listbox *listPtr, char *string, int numElsOK, + int *indexPtr)); +static void InsertEls _ANSI_ARGS_((Listbox *listPtr, int index, + int argc, char **argv)); +static void ListboxCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void ListboxComputeGeometry _ANSI_ARGS_((Listbox *listPtr)); +static void ListboxEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static void ListboxRedrawRange _ANSI_ARGS_((Listbox *listPtr, + int first, int last)); +static void ListboxSelect _ANSI_ARGS_((Listbox *listPtr, + int first, int last, int select)); +static void ListboxUpdateHScrollbar _ANSI_ARGS_((Listbox *listPtr)); +static void ListboxUpdateVScrollbar _ANSI_ARGS_((Listbox *listPtr)); +static int ListboxWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int NearestListboxElement _ANSI_ARGS_((Listbox *listPtr, + int y)); + +/* + *-------------------------------------------------------------- + * + * Ck_ListboxCmd -- + * + * This procedure is invoked to process the "listbox" Tcl + * command. See the user documentation for details on what + * it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_ListboxCmd(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. */ +{ + register Listbox *listPtr; + CkWindow *new; + CkWindow *mainPtr = (CkWindow *) clientData; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + new = Ck_CreateWindowFromPath(interp, mainPtr, argv[1], 0); + if (new == NULL) { + return TCL_ERROR; + } + + /* + * Initialize the fields of the structure that won't be initialized + * by ConfigureListbox, or that ConfigureListbox requires to be + * initialized already (e.g. resource pointers). + */ + + listPtr = (Listbox *) ckalloc(sizeof(Listbox)); + listPtr->winPtr = new; + listPtr->interp = interp; + listPtr->widgetCmd = Tcl_CreateCommand(interp, listPtr->winPtr->pathName, + ListboxWidgetCmd, (ClientData) listPtr, ListboxCmdDeletedProc); + listPtr->numElements = 0; + listPtr->firstPtr = NULL; + listPtr->lastPtr = NULL; + listPtr->normalBg = 0; + listPtr->normalFg = 0; + listPtr->normalAttr = 0; + listPtr->selBg = 0; + listPtr->selFg = 0; + listPtr->selAttr = 0; + listPtr->activeBg = 0; + listPtr->activeFg = 0; + listPtr->activeAttr = 0; + listPtr->width = 0; + listPtr->height = 0; + listPtr->topIndex = 0; + listPtr->fullLines = 1; + listPtr->maxWidth = 0; + listPtr->xOffset = 0; + listPtr->selectMode = NULL; + listPtr->numSelected = 0; + listPtr->selectAnchor = 0; + listPtr->active = 0; + listPtr->takeFocus = NULL; + listPtr->xScrollCmd = NULL; + listPtr->yScrollCmd = NULL; + listPtr->flags = 0; + + Ck_SetClass(listPtr->winPtr, "Listbox"); + Ck_CreateEventHandler(listPtr->winPtr, + CK_EV_EXPOSE | CK_EV_MAP | CK_EV_DESTROY | + CK_EV_FOCUSIN | CK_EV_FOCUSOUT, + ListboxEventProc, (ClientData) listPtr); + if (ConfigureListbox(interp, listPtr, argc-2, argv+2, 0) != TCL_OK) { + goto error; + } + + interp->result = listPtr->winPtr->pathName; + return TCL_OK; + + error: + Ck_DestroyWindow(listPtr->winPtr); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * ListboxWidgetCmd -- + * + * 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. + * + *-------------------------------------------------------------- + */ + +static int +ListboxWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about listbox widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + register Listbox *listPtr = (Listbox *) clientData; + int result = TCL_OK; + size_t length; + int c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Ck_Preserve((ClientData) listPtr); + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) { + int index; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " activate index\"", + (char *) NULL); + goto error; + } + ListboxRedrawRange(listPtr, listPtr->active, listPtr->active); + if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) + != TCL_OK) { + goto error; + } + listPtr->active = index; + ListboxRedrawRange(listPtr, listPtr->active, listPtr->active); + } 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 = Ck_ConfigureValue(interp, listPtr->winPtr, configSpecs, + (char *) listPtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 2)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, listPtr->winPtr, configSpecs, + (char *) listPtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, listPtr->winPtr, configSpecs, + (char *) listPtr, argv[2], 0); + } else { + result = ConfigureListbox(interp, listPtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else if ((c == 'c') && (strncmp(argv[1], "curselection", length) == 0) + && (length >= 2)) { + int i, count; + char index[20]; + Element *elPtr; + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " curselection\"", + (char *) NULL); + goto error; + } + count = 0; + for (i = 0, elPtr = listPtr->firstPtr; elPtr != NULL; + i++, elPtr = elPtr->nextPtr) { + if (elPtr->selected) { + sprintf(index, "%d", i); + Tcl_AppendElement(interp, index); + count++; + } + } + if (count != listPtr->numSelected) { + panic("ListboxWidgetCmd: selection count incorrect"); + } + } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) { + int first, last; + + if ((argc < 3) || (argc > 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " delete firstIndex ?lastIndex?\"", + (char *) NULL); + goto error; + } + if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) { + goto error; + } + if (argc == 3) { + last = first; + } else { + if (GetListboxIndex(interp, listPtr, argv[3], 0, &last) != TCL_OK) { + goto error; + } + } + DeleteEls(listPtr, first, last); + } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + int first, last, i; + Element *elPtr; + + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " get first ?last?\"", (char *) NULL); + goto error; + } + if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) { + goto error; + } + if ((argc == 4) && (GetListboxIndex(interp, listPtr, argv[3], + 0, &last) != TCL_OK)) { + goto error; + } + for (elPtr = listPtr->firstPtr, i = 0; i < first; + i++, elPtr = elPtr->nextPtr) { + /* Empty loop body. */ + } + if (elPtr != NULL) { + if (argc == 3) { + interp->result = elPtr->text; + } else { + for ( ; i <= last; i++, elPtr = elPtr->nextPtr) { + Tcl_AppendElement(interp, elPtr->text); + } + } + } + } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) + && (length >= 3)) { + int index; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " index index\"", + (char *) NULL); + goto error; + } + if (GetListboxIndex(interp, listPtr, argv[2], 1, &index) + != TCL_OK) { + goto error; + } + sprintf(interp->result, "%d", index); + } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) + && (length >= 3)) { + int index; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " insert index ?element element ...?\"", + (char *) NULL); + goto error; + } + if (GetListboxIndex(interp, listPtr, argv[2], 1, &index) + != TCL_OK) { + goto error; + } + InsertEls(listPtr, index, argc-3, argv+3); + } else if ((c == 'n') && (strncmp(argv[1], "nearest", length) == 0)) { + int index, y; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " nearest y\"", (char *) NULL); + goto error; + } + if (Tcl_GetInt(interp, argv[2], &y) != TCL_OK) { + goto error; + } + index = NearestListboxElement(listPtr, y); + sprintf(interp->result, "%d", index); + } else if ((c == 's') && (strncmp(argv[1], "see", length) == 0) + && (length >= 3)) { + int index, diff; + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " see index\"", + (char *) NULL); + goto error; + } + if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + diff = listPtr->topIndex-index; + if (diff > 0) { + if (diff <= (listPtr->fullLines/3)) { + ChangeListboxView(listPtr, index); + } else { + ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2); + } + } else { + diff = index - (listPtr->topIndex + listPtr->fullLines - 1); + if (diff > 0) { + if (diff <= (listPtr->fullLines/3)) { + ChangeListboxView(listPtr, listPtr->topIndex + diff); + } else { + ChangeListboxView(listPtr, + index - (listPtr->fullLines-1)/2); + } + } + } + } else if ((c == 's') && (length >= 3) + && (strncmp(argv[1], "selection", length) == 0)) { + int first, last; + + if ((argc != 4) && (argc != 5)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection option index ?index?\"", + (char *) NULL); + goto error; + } + if (GetListboxIndex(interp, listPtr, argv[3], 0, &first) != TCL_OK) { + goto error; + } + if (argc == 5) { + if (GetListboxIndex(interp, listPtr, argv[4], 0, &last) != TCL_OK) { + goto error; + } + } else { + last = first; + } + length = strlen(argv[2]); + c = argv[2][0]; + if ((c == 'a') && (strncmp(argv[2], "anchor", length) == 0)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection anchor index\"", (char *) NULL); + goto error; + } + listPtr->selectAnchor = first; + } else if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) { + ListboxSelect(listPtr, first, last, 0); + } else if ((c == 'i') && (strncmp(argv[2], "includes", length) == 0)) { + int i; + Element *elPtr; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " selection includes index\"", (char *) NULL); + goto error; + } + for (elPtr = listPtr->firstPtr, i = 0; i < first; + i++, elPtr = elPtr->nextPtr) { + /* Empty loop body. */ + } + if ((elPtr != NULL) && (elPtr->selected)) { + interp->result = "1"; + } else { + interp->result = "0"; + } + } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) { + ListboxSelect(listPtr, first, last, 1); + } else { + Tcl_AppendResult(interp, "bad selection option \"", argv[2], + "\": must be anchor, clear, includes, or set", + (char *) NULL); + goto error; + } + } else if ((c == 's') && (length >= 2) + && (strncmp(argv[1], "size", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " size\"", (char *) NULL); + goto error; + } + sprintf(interp->result, "%d", listPtr->numElements); + } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { + int index, count, type, windowWidth; + int offset = 0; /* Initialized to stop gcc warnings. */ + double fraction, fraction2; + + windowWidth = listPtr->winPtr->width; + if (argc == 2) { + if (listPtr->maxWidth == 0) { + interp->result = "0 1"; + } else { + fraction = listPtr->xOffset/((double) listPtr->maxWidth); + fraction2 = (listPtr->xOffset + windowWidth) + /((double) listPtr->maxWidth); + if (fraction2 > 1.0) { + fraction2 = 1.0; + } + sprintf(interp->result, "%g %g", fraction, fraction2); + } + } else if (argc == 3) { + if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) { + goto error; + } + ChangeListboxOffset(listPtr, index); + } else { + type = Ck_GetScrollInfo(interp, argc, argv, &fraction, &count); + switch (type) { + case CK_SCROLL_ERROR: + goto error; + case CK_SCROLL_MOVETO: + offset = (int) fraction*listPtr->maxWidth; + break; + case CK_SCROLL_PAGES: + offset = listPtr->xOffset + count * windowWidth; + break; + case CK_SCROLL_UNITS: + offset = listPtr->xOffset + count; + break; + } + ChangeListboxOffset(listPtr, offset); + } + } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) { + int index, count, type; + double fraction, fraction2; + + if (argc == 2) { + if (listPtr->numElements == 0) { + interp->result = "0 1"; + } else { + fraction = listPtr->topIndex/((double) listPtr->numElements); + fraction2 = (listPtr->topIndex+listPtr->fullLines) + /((double) listPtr->numElements); + if (fraction2 > 1.0) { + fraction2 = 1.0; + } + sprintf(interp->result, "%g %g", fraction, fraction2); + } + } else if (argc == 3) { + if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) + != TCL_OK) { + goto error; + } + ChangeListboxView(listPtr, index); + } else { + type = Ck_GetScrollInfo(interp, argc, argv, &fraction, &count); + switch (type) { + case CK_SCROLL_ERROR: + goto error; + case CK_SCROLL_MOVETO: + index = (int) (listPtr->numElements * fraction); + break; + case CK_SCROLL_PAGES: + if (listPtr->fullLines > 2) { + index = listPtr->topIndex + + count * (listPtr->fullLines - 2); + } else { + index = listPtr->topIndex + count; + } + break; + case CK_SCROLL_UNITS: + index = listPtr->topIndex + count; + break; + } + ChangeListboxView(listPtr, index); + } + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be activate, cget, configure, ", + "curselection, delete, get, index, insert, nearest, ", + "see, selection, size, ", + "xview, or yview", (char *) NULL); + goto error; + } + Ck_Release((ClientData) listPtr); + return result; + + error: + Ck_Release((ClientData) listPtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyListbox -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a listbox at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the listbox is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyListbox(clientData) + ClientData clientData; /* Info about listbox widget. */ +{ + register Listbox *listPtr = (Listbox *) clientData; + register Element *elPtr, *nextPtr; + + /* + * Free up all of the list elements. + */ + + for (elPtr = listPtr->firstPtr; elPtr != NULL; ) { + nextPtr = elPtr->nextPtr; + ckfree((char *) elPtr); + elPtr = nextPtr; + } + + Ck_FreeOptions(configSpecs, (char *) listPtr, 0); + ckfree((char *) listPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ListboxCmdDeletedProc -- + * + * 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 +ListboxCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + Listbox *listPtr = (Listbox *) clientData; + CkWindow *winPtr = listPtr->winPtr; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case winPtr + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (winPtr != NULL) { + listPtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureListbox -- + * + * This procedure is called to process an argv/argc list, plus + * the option database, in order to configure (or reconfigure) + * a listbox widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as colors, border width, + * etc. get set for listPtr; old resources get freed, + * if there were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureListbox(interp, listPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + register Listbox *listPtr; /* 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 Ck_ConfigureWidget. */ +{ + if (Ck_ConfigureWidget(interp, listPtr->winPtr, configSpecs, + argc, argv, (char *) listPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Register the desired geometry for the window and arrange for + * the window to be redisplayed. + */ + + ListboxComputeGeometry(listPtr); + listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR; + ListboxRedrawRange(listPtr, 0, listPtr->numElements-1); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DisplayListbox -- + * + * This procedure redraws the contents of a listbox window. + * + * Results: + * None. + * + * Side effects: + * Information appears on the screen. + * + *-------------------------------------------------------------- + */ + +static void +DisplayListbox(clientData) + ClientData clientData; /* Information about window. */ +{ + Listbox *listPtr = (Listbox *) clientData; + CkWindow *winPtr = listPtr->winPtr; + Element *elPtr; + int i, limit, y, width, cursorY; + + listPtr->flags &= ~REDRAW_PENDING; + if (listPtr->flags & UPDATE_V_SCROLLBAR) { + ListboxUpdateVScrollbar(listPtr); + } + if (listPtr->flags & UPDATE_H_SCROLLBAR) { + ListboxUpdateHScrollbar(listPtr); + } + listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR); + if ((listPtr->winPtr == NULL) || !(winPtr->flags & CK_MAPPED)) { + return; + } + + Ck_SetWindowAttr(winPtr, listPtr->normalFg, listPtr->normalBg, + listPtr->normalAttr); + Ck_ClearToBot(winPtr, 0, 0); + + /* + * Iterate through all of the elements of the listbox, displaying each + * in turn. Selected elements use a different fg/bg/attr. + */ + + limit = listPtr->topIndex + listPtr->fullLines; + if (limit > listPtr->numElements) { + limit = listPtr->numElements; + } + width = listPtr->xOffset + winPtr->width; + for (elPtr = listPtr->firstPtr, i = 0, y = cursorY = 0; + (elPtr != NULL) && (i < limit); + elPtr = elPtr->nextPtr, i++) { + if (i < listPtr->topIndex) { + continue; + } + if (i == listPtr->active && (listPtr->flags & GOT_FOCUS)) { + cursorY = y; + Ck_SetWindowAttr(winPtr, listPtr->activeFg, listPtr->activeBg, + listPtr->activeAttr | + (elPtr->selected ? listPtr->selAttr : 0)); + } else if (elPtr->selected) { + Ck_SetWindowAttr(winPtr, listPtr->selFg, listPtr->selBg, + listPtr->selAttr); + } else { + Ck_SetWindowAttr(winPtr, listPtr->normalFg, listPtr->normalBg, + listPtr->normalAttr); + } +#if CK_USE_UTF + if (listPtr->xOffset < elPtr->textWidth) { + char *p = Tcl_UtfAtIndex(elPtr->text, listPtr->xOffset); + + CkDisplayChars(winPtr->mainPtr, winPtr->window, p, + strlen(p), 0, y, 0, + CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS | CK_FILL_UNTIL_EOL); + } +#else + CkDisplayChars(winPtr->mainPtr, + winPtr->window, &elPtr->text[listPtr->xOffset], + elPtr->textLength - listPtr->xOffset, 0, y, 0, + CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS | CK_FILL_UNTIL_EOL); +#endif + y++; + } + wmove(winPtr->window, cursorY, 0); + Ck_EventuallyRefresh(winPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ListboxComputeGeometry -- + * + * This procedure is invoked to recompute geometry information + * such as the sizes of the elements and the overall dimensions + * desired for the listbox. + * + * Results: + * None. + * + * Side effects: + * Geometry information is updated and a new requested size is + * registered for the widget. Internal border and gridding + * information is also set. + * + *---------------------------------------------------------------------- + */ + +static void +ListboxComputeGeometry(listPtr) + Listbox *listPtr; /* Listbox whose geometry is to be + * recomputed. */ +{ + int width, height; + + width = listPtr->width; + if (width <= 0) { + width = listPtr->maxWidth; + if (width < 1) { + width = 1; + } + } + height = listPtr->height; + if (listPtr->height <= 0) { + height = listPtr->numElements; + if (height < 1) { + height = 1; + } + } + Ck_GeometryRequest(listPtr->winPtr, width, height); +} + +/* + *---------------------------------------------------------------------- + * + * InsertEls -- + * + * Add new elements to a listbox widget. + * + * Results: + * None. + * + * Side effects: + * New information gets added to listPtr; it will be redisplayed + * soon, but not immediately. + * + *---------------------------------------------------------------------- + */ + +static void +InsertEls(listPtr, index, argc, argv) + register Listbox *listPtr; /* Listbox that is to get the new + * elements. */ + int index; /* Add the new elements before this + * element. */ + int argc; /* Number of new elements to add. */ + char **argv; /* New elements (one per entry). */ +{ + register Element *prevPtr, *newPtr; + int length, i, oldMaxWidth; + + /* + * Find the element before which the new ones will be inserted. + */ + + if (index <= 0) { + index = 0; + } + if (index > listPtr->numElements) { + index = listPtr->numElements; + } + if (index == 0) { + prevPtr = NULL; + } else if (index == listPtr->numElements) { + prevPtr = listPtr->lastPtr; + } else { + for (prevPtr = listPtr->firstPtr, i = index - 1; i > 0; i--) { + prevPtr = prevPtr->nextPtr; + } + } + + /* + * For each new element, create a record, initialize it, and link + * it into the list of elements. + */ + + oldMaxWidth = listPtr->maxWidth; + for (i = argc ; i > 0; i--, argv++, prevPtr = newPtr) { + length = strlen(*argv); + newPtr = (Element *) ckalloc(ElementSize(length)); + newPtr->textLength = length; + strcpy(newPtr->text, *argv); +#if CK_USE_UTF + newPtr->textWidth = Tcl_NumUtfChars(*argv, length); +#else + newPtr->textWidth = newPtr->textLength; +#endif + if (newPtr->textWidth > listPtr->maxWidth) { + listPtr->maxWidth = newPtr->textWidth; + } + newPtr->selected = 0; + if (prevPtr == NULL) { + newPtr->nextPtr = listPtr->firstPtr; + listPtr->firstPtr = newPtr; + } else { + newPtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = newPtr; + } + } + if ((prevPtr != NULL) && (prevPtr->nextPtr == NULL)) { + listPtr->lastPtr = prevPtr; + } + listPtr->numElements += argc; + + /* + * Update the selection and other indexes to account for the + * renumbering that has just occurred. Then arrange for the new + * information to be displayed. + */ + + if (index <= listPtr->selectAnchor) { + listPtr->selectAnchor += argc; + } + if (index < listPtr->topIndex) { + listPtr->topIndex += argc; + } + if (index <= listPtr->active) { + listPtr->active += argc; + if ((listPtr->active >= listPtr->numElements) + && (listPtr->numElements > 0)) { + listPtr->active = listPtr->numElements-1; + } + } + listPtr->flags |= UPDATE_V_SCROLLBAR; + if (listPtr->maxWidth != oldMaxWidth) { + listPtr->flags |= UPDATE_H_SCROLLBAR; + } + ListboxComputeGeometry(listPtr); + ListboxRedrawRange(listPtr, index, listPtr->numElements-1); +} + +/* + *---------------------------------------------------------------------- + * + * DeleteEls -- + * + * Remove one or more elements from a listbox widget. + * + * Results: + * None. + * + * Side effects: + * Memory gets freed, the listbox gets modified and (eventually) + * redisplayed. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteEls(listPtr, first, last) + register Listbox *listPtr; /* Listbox widget to modify. */ + int first; /* Index of first element to delete. */ + int last; /* Index of last element to delete. */ +{ + register Element *prevPtr, *elPtr; + int count, i, widthChanged; + + /* + * Adjust the range to fit within the existing elements of the + * listbox, and make sure there's something to delete. + */ + + if (first < 0) { + first = 0; + } + if (last >= listPtr->numElements) { + last = listPtr->numElements-1; + } + count = last + 1 - first; + if (count <= 0) { + return; + } + + /* + * Find the element just before the ones to delete. + */ + + if (first == 0) { + prevPtr = NULL; + } else { + for (i = first-1, prevPtr = listPtr->firstPtr; i > 0; i--) { + prevPtr = prevPtr->nextPtr; + } + } + + /* + * Delete the requested number of elements. + */ + + widthChanged = 0; + for (i = count; i > 0; i--) { + if (prevPtr == NULL) { + elPtr = listPtr->firstPtr; + listPtr->firstPtr = elPtr->nextPtr; + if (listPtr->firstPtr == NULL) { + listPtr->lastPtr = NULL; + } + } else { + elPtr = prevPtr->nextPtr; + prevPtr->nextPtr = elPtr->nextPtr; + if (prevPtr->nextPtr == NULL) { + listPtr->lastPtr = prevPtr; + } + } + if (elPtr->textWidth == listPtr->maxWidth) { + widthChanged = 1; + } + if (elPtr->selected) { + listPtr->numSelected -= 1; + } + ckfree((char *) elPtr); + } + listPtr->numElements -= count; + + /* + * Update the selection and viewing information to reflect the change + * in the element numbering, and redisplay to slide information up over + * the elements that were deleted. + */ + + if (first <= listPtr->selectAnchor) { + listPtr->selectAnchor -= count; + if (listPtr->selectAnchor < first) { + listPtr->selectAnchor = first; + } + } + if (first <= listPtr->topIndex) { + listPtr->topIndex -= count; + if (listPtr->topIndex < first) { + listPtr->topIndex = first; + } + } + if (listPtr->topIndex > (listPtr->numElements - listPtr->fullLines)) { + listPtr->topIndex = listPtr->numElements - listPtr->fullLines; + if (listPtr->topIndex < 0) { + listPtr->topIndex = 0; + } + } + if (listPtr->active > last) { + listPtr->active -= count; + } else if (listPtr->active >= first) { + listPtr->active = first; + if ((listPtr->active >= listPtr->numElements) + && (listPtr->numElements > 0)) { + listPtr->active = listPtr->numElements-1; + } + } + listPtr->flags |= UPDATE_V_SCROLLBAR; + ListboxComputeGeometry(listPtr); + if (widthChanged) { + int maxWidth = 0; + + for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) + if (elPtr->textWidth > maxWidth) + maxWidth = elPtr->textWidth; + if (maxWidth != listPtr->maxWidth) { + listPtr->maxWidth = maxWidth; + listPtr->flags |= UPDATE_H_SCROLLBAR; + if (listPtr->xOffset + listPtr->width >= listPtr->maxWidth) + listPtr->xOffset = listPtr->maxWidth - listPtr->width; + if (listPtr->xOffset < 0) + listPtr->xOffset = 0; + } + } + ListboxRedrawRange(listPtr, first, listPtr->numElements-1); +} + +/* + *-------------------------------------------------------------- + * + * ListboxEventProc -- + * + * This procedure is invoked by the dispatcher for various + * events on listboxes. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +ListboxEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + Listbox *listPtr = (Listbox *) clientData; + + if (eventPtr->type == CK_EV_DESTROY) { + if (listPtr->winPtr != NULL) { + listPtr->winPtr = NULL; + Tcl_DeleteCommand(listPtr->interp, + Tcl_GetCommandName(listPtr->interp, listPtr->widgetCmd)); + } + if (listPtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayListbox, (ClientData) listPtr); + } + Ck_EventuallyFree((ClientData) listPtr, + (Ck_FreeProc *) DestroyListbox); + } else if (eventPtr->type == CK_EV_EXPOSE) { + listPtr->fullLines = listPtr->winPtr->height; + listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR; + ChangeListboxView(listPtr, listPtr->topIndex); + ChangeListboxOffset(listPtr, listPtr->xOffset); + + /* + * Redraw the whole listbox. It's hard to tell what needs + * to be redrawn (e.g. if the listbox has shrunk then we + * may only need to redraw the borders), so just redraw + * everything for safety. + */ + + ListboxRedrawRange(listPtr, 0, listPtr->numElements-1); + } else if (eventPtr->type == CK_EV_FOCUSIN) { + listPtr->flags |= GOT_FOCUS; + ListboxRedrawRange(listPtr, listPtr->active, listPtr->active); + } else if (eventPtr->type == CK_EV_FOCUSOUT) { + listPtr->flags &= ~GOT_FOCUS; + ListboxRedrawRange(listPtr, listPtr->active, listPtr->active); + } +} + +/* + *-------------------------------------------------------------- + * + * GetListboxIndex -- + * + * Parse an index into a listbox 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 listPtr) corresponding to + * string. Otherwise an error message is left in interp->result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +GetListboxIndex(interp, listPtr, string, numElsOK, indexPtr) + Tcl_Interp *interp; /* For error messages. */ + Listbox *listPtr; /* Listbox for which the index is being + * specified. */ + char *string; /* Specifies an element in the listbox. */ + int numElsOK; /* 0 means the return value must be less + * less than the number of entries in + * the listbox; 1 means it may also be + * equal to the number of entries. */ + int *indexPtr; /* Where to store converted index. */ +{ + int c; + size_t length; + + length = strlen(string); + c = string[0]; + if ((c == 'a') && (strncmp(string, "active", length) == 0) + && (length >= 2)) { + *indexPtr = listPtr->active; + } else if ((c == 'a') && (strncmp(string, "anchor", length) == 0) + && (length >= 2)) { + *indexPtr = listPtr->selectAnchor; + } else if ((c == 'e') && (strncmp(string, "end", length) == 0)) { + *indexPtr = listPtr->numElements; + } else if (c == '@') { + int x, y; + char *p, *end; + + p = string+1; + x = strtol(p, &end, 0); + if ((end == p) || (*end != ',')) { + goto badIndex; + } + p = end+1; + y = strtol(p, &end, 0); + if ((end == p) || (*end != 0)) { + goto badIndex; + } + *indexPtr = NearestListboxElement(listPtr, y); + } else { + if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) { + Tcl_ResetResult(interp); + goto badIndex; + } + } + if (numElsOK) { + if (*indexPtr > listPtr->numElements) { + *indexPtr = listPtr->numElements; + } + } else if (*indexPtr >= listPtr->numElements) { + *indexPtr = listPtr->numElements-1; + } + if (*indexPtr < 0) { + *indexPtr = 0; + } + return TCL_OK; + + badIndex: + Tcl_AppendResult(interp, "bad listbox index \"", string, + "\": must be active, anchor, end, @x,y, or a number", + (char *) NULL); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * ChangeListboxView -- + * + * Change the view on a listbox widget so that a given element + * is displayed at the top. + * + * Results: + * None. + * + * Side effects: + * What's displayed on the screen is changed. If there is a + * scrollbar associated with this widget, then the scrollbar + * is instructed to change its display too. + * + *---------------------------------------------------------------------- + */ + +static void +ChangeListboxView(listPtr, index) + register Listbox *listPtr; /* Information about widget. */ + int index; /* Index of element in listPtr + * that should now appear at the + * top of the listbox. */ +{ + if (index >= (listPtr->numElements - listPtr->fullLines)) { + index = listPtr->numElements - listPtr->fullLines; + } + if (index < 0) { + index = 0; + } + if (listPtr->topIndex != index) { + listPtr->topIndex = index; + if (!(listPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayListbox, (ClientData) listPtr); + listPtr->flags |= REDRAW_PENDING; + } + listPtr->flags |= UPDATE_V_SCROLLBAR; + } +} + +/* + *---------------------------------------------------------------------- + * + * ChangListboxOffset -- + * + * Change the horizontal offset for a listbox. + * + * Results: + * None. + * + * Side effects: + * The listbox may be redrawn to reflect its new horizontal + * offset. + * + *---------------------------------------------------------------------- + */ + +static void +ChangeListboxOffset(listPtr, offset) + register Listbox *listPtr; /* Information about widget. */ + int offset; /* Desired new "xOffset" for + * listbox. */ +{ + int maxOffset; + + /* + * Make sure that the new offset is within the allowable range, and + * round it off to an even multiple of xScrollUnit. + */ + + maxOffset = listPtr->maxWidth - listPtr->winPtr->width; + if (offset > maxOffset) { + offset = maxOffset; + } + if (offset < 0) { + offset = 0; + } + listPtr->xOffset = offset; + listPtr->flags |= UPDATE_H_SCROLLBAR; + ListboxRedrawRange(listPtr, 0, listPtr->numElements); +} + +/* + *---------------------------------------------------------------------- + * + * NearestListboxElement -- + * + * Given a y-coordinate inside a listbox, compute the index of + * the element under that y-coordinate (or closest to that + * y-coordinate). + * + * Results: + * The return value is an index of an element of listPtr. If + * listPtr has no elements, then 0 is always returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +NearestListboxElement(listPtr, y) + register Listbox *listPtr; /* Information about widget. */ + int y; /* Y-coordinate in listPtr's window. */ +{ + int index; + + index = y; + if (index >= listPtr->fullLines) { + index = listPtr->fullLines - 1; + } + if (index < 0) { + index = 0; + } + index += listPtr->topIndex; + if (index >= listPtr->numElements) { + index = listPtr->numElements-1; + } + return index; +} + +/* + *---------------------------------------------------------------------- + * + * ListboxSelect -- + * + * Select or deselect one or more elements in a listbox.. + * + * Results: + * None. + * + * Side effects: + * All of the elements in the range between first and last are + * marked as either selected or deselected, depending on the + * "select" argument. Any items whose state changes are redisplayed. + * The selection is claimed from X when the number of selected + * elements changes from zero to non-zero. + * + *---------------------------------------------------------------------- + */ + +static void +ListboxSelect(listPtr, first, last, select) + register Listbox *listPtr; /* Information about widget. */ + int first; /* Index of first element to + * select or deselect. */ + int last; /* Index of last element to + * select or deselect. */ + int select; /* 1 means select items, 0 means + * deselect them. */ +{ + int i, firstRedisplay, lastRedisplay, increment, oldCount; + Element *elPtr; + + if (last < first) { + i = first; + first = last; + last = i; + } + if (first >= listPtr->numElements) { + return; + } + oldCount = listPtr->numSelected; + firstRedisplay = -1; + increment = select ? 1 : -1; + for (i = 0, elPtr = listPtr->firstPtr; i < first; + i++, elPtr = elPtr->nextPtr) { + /* Empty loop body. */ + } + for ( ; i <= last; i++, elPtr = elPtr->nextPtr) { + if (elPtr->selected == select) { + continue; + } + listPtr->numSelected += increment; + elPtr->selected = select; + if (firstRedisplay < 0) { + firstRedisplay = i; + } + lastRedisplay = i; + } + if (firstRedisplay >= 0) { + ListboxRedrawRange(listPtr, first, last); + } +} + +/* + *---------------------------------------------------------------------- + * + * ListboxRedrawRange -- + * + * Ensure that a given range of elements is eventually redrawn on + * the display (if those elements in fact appear on the display). + * + * Results: + * None. + * + * Side effects: + * Information gets redisplayed. + * + *---------------------------------------------------------------------- + */ + +static void +ListboxRedrawRange(listPtr, first, last) + register Listbox *listPtr; /* Information about widget. */ + int first; /* Index of first element in list + * that needs to be redrawn. */ + int last; /* Index of last element in list + * that needs to be redrawn. May + * be less than first; + * these just bracket a range. */ +{ + if ((listPtr->winPtr == NULL) || !(listPtr->winPtr->flags & CK_MAPPED) + || (listPtr->flags & REDRAW_PENDING)) { + return; + } + Tk_DoWhenIdle(DisplayListbox, (ClientData) listPtr); + listPtr->flags |= REDRAW_PENDING; +} + +/* + *---------------------------------------------------------------------- + * + * ListboxUpdateVScrollbar -- + * + * This procedure is invoked whenever information has changed in + * a listbox in a way that would invalidate a vertical scrollbar + * display. If there is an associated scrollbar, then this command + * updates it by invoking a Tcl command. + * + * Results: + * None. + * + * Side effects: + * A Tcl command is invoked, and an additional command may be + * invoked to process errors in the command. + * + *---------------------------------------------------------------------- + */ + +static void +ListboxUpdateVScrollbar(listPtr) + register Listbox *listPtr; /* Information about widget. */ +{ + char string[100]; + double first, last; + int result; + + if (listPtr->yScrollCmd == NULL) { + return; + } + if (listPtr->numElements == 0) { + first = 0.0; + last = 1.0; + } else { + first = listPtr->topIndex/((double) listPtr->numElements); + last = (listPtr->topIndex+listPtr->fullLines) + /((double) listPtr->numElements); + if (last > 1.0) { + last = 1.0; + } + } + sprintf(string, " %g %g", first, last); + result = Tcl_VarEval(listPtr->interp, listPtr->yScrollCmd, string, + (char *) NULL); + if (result != TCL_OK) { + Tcl_AddErrorInfo(listPtr->interp, + "\n (vertical scrolling command executed by listbox)"); + Tk_BackgroundError(listPtr->interp); + } +} + +/* + *---------------------------------------------------------------------- + * + * ListboxUpdateHScrollbar -- + * + * This procedure is invoked whenever information has changed in + * a listbox in a way that would invalidate a horizontal scrollbar + * display. If there is an associated horizontal scrollbar, then + * this command updates it by invoking a Tcl command. + * + * Results: + * None. + * + * Side effects: + * A Tcl command is invoked, and an additional command may be + * invoked to process errors in the command. + * + *---------------------------------------------------------------------- + */ + +static void +ListboxUpdateHScrollbar(listPtr) + register Listbox *listPtr; /* Information about widget. */ +{ + char string[60]; + int result, windowWidth; + double first, last; + + if (listPtr->xScrollCmd == NULL) { + return; + } + windowWidth = listPtr->winPtr->width; + if (listPtr->maxWidth == 0) { + first = 0; + last = 1.0; + } else { + first = listPtr->xOffset/((double) listPtr->maxWidth); + last = (listPtr->xOffset + windowWidth) + /((double) listPtr->maxWidth); + if (last > 1.0) { + last = 1.0; + } + } + sprintf(string, " %g %g", first, last); + result = Tcl_VarEval(listPtr->interp, listPtr->xScrollCmd, string, + (char *) NULL); + if (result != TCL_OK) { + Tcl_AddErrorInfo(listPtr->interp, + "\n (horizontal scrolling command executed by listbox)"); + Tk_BackgroundError(listPtr->interp); + } +} diff --git a/ckMain.c b/ckMain.c new file mode 100644 index 0000000..155a5b0 --- /dev/null +++ b/ckMain.c @@ -0,0 +1,324 @@ +/* + * ckMain.c -- + * + * This file contains a generic main program for Ck-based applications. + * It can be used as-is for many applications, just by supplying a + * different appInitProc procedure for each specific application. + * Or, it can be used as a template for creating new main programs + * for applications. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * Global variables used by the main program: + */ + +static Tcl_Interp *interp; /* Interpreter for this application. */ +static char *fileName = NULL; /* Script to source, if any. */ + +#ifdef TCL_MEM_DEBUG +static char dumpFile[100]; /* Records where to dump memory allocation + * information. */ +static int quitFlag = 0; /* 1 means the "checkmem" command was + * invoked, so the application should quit + * and dump memory allocation information. */ +static int CheckmemCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char *argv[])); +#endif + +/* + *---------------------------------------------------------------------- + * + * Ck_Main -- + * + * Main program for curses wish. + * + * Results: + * None. This procedure never returns (it exits the process when + * it's done. + * + * Side effects: + * This procedure initializes the toolkit and then starts + * interpreting commands; almost anything could happen, depending + * on the script being interpreted. + * + *---------------------------------------------------------------------- + */ + +void +Ck_Main(argc, argv, appInitProc) + int argc; /* Number of arguments. */ + char **argv; /* Array of argument strings. */ + int (*appInitProc)(); /* Application-specific initialization + * procedure to call after most + * initialization but before starting + * to execute commands. */ +{ + char *args, *msg, *argv0; + char buf[20]; + int code; +#if !((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)) + Tcl_Channel errChannel; +#endif + +#if !((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)) + Tcl_FindExecutable(argv[0]); +#endif + + interp = Tcl_CreateInterp(); + +#ifndef __WIN32__ + if (!isatty(0) || !isatty(1)) { +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fprintf(stderr, "standard input/output must be terminal\n"); + +#else + errChannel = Tcl_GetStdChannel(TCL_STDERR); + if (errChannel) + Tcl_Write(errChannel, + "standard input/output must be terminal\n", -1); +#endif + Tcl_Eval(interp, "exit 1"); +#if (TCL_MAJOR_VERSION >= 8) + Tcl_Exit(1); +#else + exit(1); /* Just in case */ +#endif + } +#endif + +#ifdef TCL_MEM_DEBUG + Tcl_InitMemory(interp); + Tcl_InitMemory(interp); + Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, + (Tcl_CmdDeleteProc *) NULL); +#endif + + /* + * Parse command-line arguments. Argv[1] must contain the name + * of the script file to process. + */ + + argv0 = argv[0]; + if (argc > 1) { + fileName = argv[1]; + argc--; + argv++; + } + + /* + * Make command-line arguments available in the Tcl variables "argc" + * and "argv". + */ + + args = Tcl_Merge(argc-1, argv+1); + Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY); + ckfree(args); + sprintf(buf, "%d", argc-1); + Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv0, + TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_interactive", (fileName == NULL) ? "1" : "0", + TCL_GLOBAL_ONLY); + + /* + * Invoke application-specific initialization. + */ + + if ((*appInitProc)(interp) != TCL_OK) { +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fprintf(stderr, "application-specific initialization failed: %s\n", + interp->result); +#else + errChannel = Tcl_GetStdChannel(TCL_STDERR); + if (errChannel) { + Tcl_Write(errChannel, + "application-specific initialization failed: ", -1); + Tcl_Write(errChannel, interp->result, -1); + Tcl_Write(errChannel, "\n", 1); + } +#endif + msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + goto errorExit; + } + + /* + * Invoke the script specified on the command line, if any. + */ + + if (fileName != NULL) { + code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL); + if (code != TCL_OK) + goto error; + Tcl_ResetResult(interp); + goto mainLoop; + } + + /* + * We're running interactively. Source a user-specific startup + * file if the application specified one and if the file exists. + */ + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + if (tcl_RcFileName != NULL) { + Tcl_DString temp; + char *fullName; + FILE *f; + + Tcl_DStringInit(&temp); + fullName = Tcl_TildeSubst(interp, fileName, &temp); + if (fullName == NULL) + fprintf(stderr, "%s\n", interp->result); + else { + + /* + * Test for the existence of the rc file before trying to read it. + */ + + f = fopen(fullName, "r"); + if (f != NULL) { + fclose(f); + if (Tcl_EvalFile(interp, fullName) != TCL_OK) + fprintf(stderr, "%s\n", interp->result); + } + Tcl_DStringFree(&temp); + } + } +#else + fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + if (fileName != NULL) { + Tcl_Channel c; + Tcl_DString temp; + char *fullName; + + Tcl_DStringInit(&temp); + fullName = Tcl_TranslateFileName(interp, fileName, &temp); + if (fullName == NULL) { + errChannel = Tcl_GetStdChannel(TCL_STDERR); + if (errChannel) { + Tcl_Write(errChannel, interp->result, -1); + Tcl_Write(errChannel, "\n", 1); + } + } else { + + /* + * Test for the existence of the rc file before trying to read it. + */ + + c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); + if (c != (Tcl_Channel) NULL) { + Tcl_Close(NULL, c); + if (Tcl_EvalFile(interp, fullName) != TCL_OK) { + errChannel = Tcl_GetStdChannel(TCL_STDERR); + if (errChannel) { + Tcl_Write(errChannel, interp->result, -1); + Tcl_Write(errChannel, "\n", 1); + } + } + } + Tcl_DStringFree(&temp); + } + } +#endif + +mainLoop: + /* + * Loop infinitely, waiting for commands to execute. + */ + +#ifdef TCL_MEM_DEBUG + Tcl_Eval(interp, "proc exit {{code 0}} {destroy .}"); +#endif + + Ck_MainLoop(); + +#ifdef TCL_MEM_DEBUG + if (quitFlag) { + Tcl_DeleteInterp(interp); + Tcl_DumpActiveMemory(dumpFile); + } +#endif + + /* + * Invoke Tcl exit command. + */ + + Tcl_Eval(interp, "exit"); +#if (TCL_MAJOR_VERSION >= 8) + Tcl_Exit(1); +#else + exit(1); /* Just in case */ +#endif + +error: + msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + if (msg == NULL) { + msg = interp->result; + } +errorExit: + if (msg != NULL) { +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fprintf(stderr, "%s\n", msg); +#else + errChannel = Tcl_GetStdChannel(TCL_STDERR); + if (errChannel) { + Tcl_Write(errChannel, msg, -1); + Tcl_Write(errChannel, "\n", 1); + } +#endif + } + Tcl_Eval(interp, "exit 1"); +#if (TCL_MAJOR_VERSION >= 8) + Tcl_Exit(1); +#else + exit(1); /* Just in case */ +#endif +} + +/* + *---------------------------------------------------------------------- + * + * CheckmemCmd -- + * + * This is the command procedure for the "checkmem" command, which + * causes the application to exit after printing information about + * memory usage to the file passed to this command as its first + * argument. + * + * Results: + * Returns a standard Tcl completion code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +#ifdef TCL_MEM_DEBUG + +static int +CheckmemCmd(clientData, interp, argc, argv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Interpreter for evaluation. */ + int argc; /* Number of arguments. */ + char *argv[]; /* String values of arguments. */ +{ + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " fileName\"", (char *) NULL); + return TCL_ERROR; + } + strcpy(dumpFile, argv[1]); + quitFlag = 1; + return TCL_OK; +} +#endif + diff --git a/ckMenu.c b/ckMenu.c new file mode 100644 index 0000000..ac7f1ce --- /dev/null +++ b/ckMenu.c @@ -0,0 +1,2081 @@ +/* + * ckMenu.c -- + * + * This module implements menus for the toolkit. The menus + * support normal button entries, plus check buttons, radio + * buttons, iconic forms of all of the above, and separator + * entries. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +#ifdef __WIN32__ +#define DestroyMenu CkDestroyMenu +#endif + +/* + * One of the following data structures is kept for each entry of each + * menu managed by this file: + */ + +typedef struct MenuEntry { + int type; /* Type of menu entry; see below for + * valid types. */ + struct Menu *menuPtr; /* Menu with which this entry is associated. */ + char *label; /* Main text label displayed in entry (NULL + * if no label). Malloc'ed. */ + int labelLength; /* Number of non-NULL characters in label. */ + int underline; /* Index of character to underline. */ + char *accel; /* Accelerator string displayed at right + * of menu entry. NULL means no such + * accelerator. Malloc'ed. */ + int accelLength; /* Number of non-NULL characters in + * accelerator. */ + + /* + * Information related to displaying entry: + */ + + Ck_Uid state; /* State of button for display purposes: + * normal, active, or disabled. */ + int y; /* Y-coordinate of entry. */ + int indicatorOn; /* True means draw indicator, false means + * don't draw it. */ + + + int normalBg; + int normalFg; + int normalAttr; + int activeBg; + int activeFg; + int activeAttr; + int disabledBg; + int disabledFg; + int disabledAttr; + int underlineFg; + int underlineAttr; + int indicatorFg; + + /* + * Information used to implement this entry's action: + */ + + char *command; /* Command to invoke when entry is invoked. + * Malloc'ed. */ + char *name; /* Name of variable (for check buttons and + * radio buttons) or menu (for cascade + * entries). Malloc'ed.*/ + char *onValue; /* Value to store in variable when selected + * (only for radio and check buttons). + * Malloc'ed. */ + char *offValue; /* Value to store in variable when not + * selected (only for check buttons). + * Malloc'ed. */ + + /* + * Miscellaneous information: + */ + + int flags; /* Various flags. See below for definitions. */ +} MenuEntry; + +/* + * Flag values defined for menu entries: + * + * ENTRY_SELECTED: Non-zero means this is a radio or check + * button and that it should be drawn in + * the "selected" state. + * ENTRY_NEEDS_REDISPLAY: Non-zero means the entry should be redisplayed. + */ + +#define ENTRY_SELECTED 1 +#define ENTRY_NEEDS_REDISPLAY 4 + +/* + * Types defined for MenuEntries: + */ + +#define COMMAND_ENTRY 0 +#define SEPARATOR_ENTRY 1 +#define CHECK_BUTTON_ENTRY 2 +#define RADIO_BUTTON_ENTRY 3 +#define CASCADE_ENTRY 4 + +/* + * Mask bits for above types: + */ + +#define COMMAND_MASK CK_CONFIG_USER_BIT +#define SEPARATOR_MASK (CK_CONFIG_USER_BIT << 1) +#define CHECK_BUTTON_MASK (CK_CONFIG_USER_BIT << 2) +#define RADIO_BUTTON_MASK (CK_CONFIG_USER_BIT << 3) +#define CASCADE_MASK (CK_CONFIG_USER_BIT << 4) +#define ALL_MASK (COMMAND_MASK | SEPARATOR_MASK \ + | CHECK_BUTTON_MASK | RADIO_BUTTON_MASK | CASCADE_MASK) + +/* + * Configuration specs for individual menu entries: + */ + +static Ck_ConfigSpec entryConfigSpecs[] = { + {CK_CONFIG_ATTR, "-activeattributes", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ACTIVE_ATTR, Ck_Offset(MenuEntry, activeAttr), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_COLOR, "-activebackground", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ACTIVE_BG, Ck_Offset(MenuEntry, activeBg), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ACTIVE_FG, Ck_Offset(MenuEntry, activeFg), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_STRING, "-accelerator", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ACCELERATOR, Ck_Offset(MenuEntry, accel), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_NULL_OK}, + {CK_CONFIG_ATTR, "-attributes", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ATTR, Ck_Offset(MenuEntry, normalAttr), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_COLOR, "-background", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_BG, Ck_Offset(MenuEntry, normalBg), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_STRING, "-command", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_COMMAND, Ck_Offset(MenuEntry, command), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_NULL_OK}, + {CK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_FG, Ck_Offset(MenuEntry, normalFg), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_NULL_OK}, + {CK_CONFIG_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_INDICATOR, Ck_Offset(MenuEntry, indicatorOn), + CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_LABEL, Ck_Offset(MenuEntry, label), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK}, + {CK_CONFIG_STRING, "-menu", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_MENU, Ck_Offset(MenuEntry, name), + CASCADE_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-offvalue", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_OFF_VALUE, Ck_Offset(MenuEntry, offValue), + CHECK_BUTTON_MASK}, + {CK_CONFIG_STRING, "-onvalue", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ON_VALUE, Ck_Offset(MenuEntry, onValue), + CHECK_BUTTON_MASK}, + {CK_CONFIG_COLOR, "-selectcolor", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_SELECT, Ck_Offset(MenuEntry, indicatorFg), + CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_UID, "-state", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_STATE, Ck_Offset(MenuEntry, state), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_STRING, "-value", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_VALUE, Ck_Offset(MenuEntry, onValue), + RADIO_BUTTON_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_CHECK_VARIABLE, Ck_Offset(MenuEntry, name), + CHECK_BUTTON_MASK|CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_RADIO_VARIABLE, Ck_Offset(MenuEntry, name), + RADIO_BUTTON_MASK}, + {CK_CONFIG_INT, "-underline", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_UNDERLINE, Ck_Offset(MenuEntry, underline), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_ATTR, "-underlineattributes", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_UNDERLINE, Ck_Offset(MenuEntry, underlineAttr), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_COLOR, "-underlineforeground", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_UNDERLINE, Ck_Offset(MenuEntry, underlineFg), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * A data structure of the following type is kept for each + * menu managed by this file: + */ + +typedef struct Menu { + CkWindow *winPtr; /* Window that embodies the pane. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with menu. */ + Tcl_Command widgetCmd; /* Token for menu's widget command. */ + MenuEntry **entries; /* Array of pointers to all the entries + * in the menu. NULL means no entries. */ + int numEntries; /* Number of elements in entries. */ + int active; /* Index of active entry. -1 means + * nothing active. */ + + /* + * Information used when displaying widget: + */ + + int normalBg; + int normalFg; + int normalAttr; + int activeBg; + int activeFg; + int activeAttr; + int disabledBg; + int disabledFg; + int disabledAttr; + int underlineFg; + int underlineAttr; + int indicatorFg; + CkBorder *borderPtr; + int labelWidth; /* Number of chars to allow for displaying + * labels in menu entries. */ + int indicatorSpace; /* Number of chars for displaying + * indicators. */ + + /* + * Miscellaneous information: + */ + + char *takeFocus; /* Value of -takefocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + char *postCommand; /* Command to execute just before posting + * this menu, or NULL. Malloc-ed. */ + MenuEntry *postedCascade; /* Points to menu entry for cascaded + * submenu that is currently posted, or + * NULL if no submenu posted. */ + int flags; /* Various flags; see below for + * definitions. */ +} Menu; + +/* + * Flag bits for menus: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler + * has already been queued to redraw + * this window. + * RESIZE_PENDING: Non-zero means a call to ComputeMenuGeometry + * has already been scheduled. + */ + +#define REDRAW_PENDING 1 +#define RESIZE_PENDING 2 + +/* + * Configuration specs valid for the menu as a whole: + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_MENU_ACTIVE_ATTR_COLOR, + Ck_Offset(Menu, activeAttr), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_MENU_ACTIVE_ATTR_MONO, + Ck_Offset(Menu, activeAttr), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_MENU_ACTIVE_BG_COLOR, Ck_Offset(Menu, activeBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_MENU_ACTIVE_BG_MONO, Ck_Offset(Menu, activeBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_MENU_ACTIVE_FG_COLOR, Ck_Offset(Menu, activeFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_MENU_ACTIVE_FG_MONO, Ck_Offset(Menu, activeFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_MENU_ATTR, Ck_Offset(Menu, normalAttr), 0}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_MENU_BG_COLOR, Ck_Offset(Menu, normalBg), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_MENU_BG_MONO, Ck_Offset(Menu, normalBg), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_BORDER, "-border", "border", "Border", + DEF_MENU_BORDER, Ck_Offset(Menu, borderPtr), CK_CONFIG_NULL_OK}, + {CK_CONFIG_ATTR, "-disabledattributes", "disabledAttributes", + "DisabledAttributes", DEF_MENU_DISABLED_ATTR, + Ck_Offset(Menu, disabledAttr), 0}, + {CK_CONFIG_COLOR, "-disabledbackground", "disabledBackground", + "Foreground", DEF_MENU_DISABLED_BG_COLOR, + Ck_Offset(Menu, disabledBg), CK_CONFIG_COLOR_ONLY|CK_CONFIG_NULL_OK}, + {CK_CONFIG_COLOR, "-disabledbackground", "disabledBackground", + "Foreground", DEF_MENU_DISABLED_BG_MONO, + Ck_Offset(Menu, disabledBg), CK_CONFIG_MONO_ONLY|CK_CONFIG_NULL_OK}, + {CK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", + "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR, + Ck_Offset(Menu, disabledFg), CK_CONFIG_COLOR_ONLY|CK_CONFIG_NULL_OK}, + {CK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", + "DisabledForeground", DEF_MENU_DISABLED_FG_MONO, + Ck_Offset(Menu, disabledFg), CK_CONFIG_MONO_ONLY|CK_CONFIG_NULL_OK}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_MENU_FG, Ck_Offset(Menu, normalFg), 0}, + {CK_CONFIG_STRING, "-postcommand", "postCommand", "Command", + DEF_MENU_POST_COMMAND, Ck_Offset(Menu, postCommand), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background", + DEF_MENU_SELECT_COLOR, Ck_Offset(Menu, indicatorFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background", + DEF_MENU_SELECT_MONO, Ck_Offset(Menu, indicatorFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_MENU_TAKE_FOCUS, Ck_Offset(Menu, takeFocus), CK_CONFIG_NULL_OK}, + {CK_CONFIG_ATTR, "-underlineattributes", "underlineAttributes", + "UnderlineAttributes", DEF_MENU_UNDERLINE_ATTR, + Ck_Offset(Menu, underlineAttr), CK_CONFIG_NULL_OK}, + {CK_CONFIG_COLOR, "-underlineforeground", "underlineForeground", + "UnderlineForeground", DEF_MENU_UNDERLINE_FG_COLOR, + Ck_Offset(Menu, underlineFg), CK_CONFIG_COLOR_ONLY|CK_CONFIG_NULL_OK}, + {CK_CONFIG_COLOR, "-underlineforeground", "underlineForeground", + "UnderlineForeground", DEF_MENU_UNDERLINE_FG_MONO, + Ck_Offset(Menu, underlineFg), CK_CONFIG_MONO_ONLY|CK_CONFIG_NULL_OK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static int ActivateMenuEntry _ANSI_ARGS_((Menu *menuPtr, + int index)); +static void ComputeMenuGeometry _ANSI_ARGS_(( + ClientData clientData)); +static int ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp, + Menu *menuPtr, int argc, char **argv, + int flags)); +static int ConfigureMenuEntry _ANSI_ARGS_((Tcl_Interp *interp, + Menu *menuPtr, MenuEntry *mePtr, int index, + int argc, char **argv, int flags)); +static void DestroyMenu _ANSI_ARGS_((ClientData clientData)); +static void DestroyMenuEntry _ANSI_ARGS_((ClientData clientData)); +static void DisplayMenu _ANSI_ARGS_((ClientData clientData)); +static void EventuallyRedrawMenu _ANSI_ARGS_((Menu *menuPtr, + MenuEntry *mePtr)); +static int GetMenuIndex _ANSI_ARGS_((Tcl_Interp *interp, + Menu *menuPtr, char *string, int lastOK, + int *indexPtr)); +static int MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp, + Menu *menuPtr, char *indexString, int argc, + char **argv)); +static void MenuCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void MenuEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static MenuEntry * MenuNewEntry _ANSI_ARGS_((Menu *menuPtr, int index, + int type)); +static char * MenuVarProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); +static int MenuWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int PostSubmenu _ANSI_ARGS_((Tcl_Interp *interp, + Menu *menuPtr, MenuEntry *mePtr)); + +/* + *-------------------------------------------------------------- + * + * Ck_MenuCmd -- + * + * This procedure is invoked to process the "menu" Tcl + * command. See the user documentation for details on + * what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_MenuCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + CkWindow *new; + register Menu *menuPtr; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Create the new window. + */ + + new = Ck_CreateWindowFromPath(interp, mainPtr, argv[1], 1); + if (new == NULL) { + return TCL_ERROR; + } + + /* + * Initialize the data structure for the menu. + */ + + menuPtr = (Menu *) ckalloc(sizeof(Menu)); + menuPtr->winPtr = new; + menuPtr->interp = interp; + menuPtr->widgetCmd = Tcl_CreateCommand(interp, + menuPtr->winPtr->pathName, MenuWidgetCmd, + (ClientData) menuPtr, MenuCmdDeletedProc); + menuPtr->entries = NULL; + menuPtr->numEntries = 0; + menuPtr->active = -1; + menuPtr->normalBg = 0; + menuPtr->normalFg = 0; + menuPtr->normalAttr = 0; + menuPtr->activeBg = 0; + menuPtr->activeFg = 0; + menuPtr->activeAttr = 0; + menuPtr->disabledBg = 0; + menuPtr->disabledFg = 0; + menuPtr->disabledAttr = 0; + menuPtr->underlineFg = 0; + menuPtr->underlineAttr = 0; + menuPtr->indicatorFg = 0; + menuPtr->borderPtr = NULL; + menuPtr->labelWidth = 0; + menuPtr->takeFocus = NULL; + menuPtr->postCommand = NULL; + menuPtr->postedCascade = NULL; + menuPtr->flags = 0; + + Ck_SetClass(new, "Menu"); + Ck_CreateEventHandler(menuPtr->winPtr, + CK_EV_MAP | CK_EV_EXPOSE | CK_EV_DESTROY, + MenuEventProc, (ClientData) menuPtr); + if (ConfigureMenu(interp, menuPtr, argc-2, argv+2, 0) != TCL_OK) { + goto error; + } + + interp->result = menuPtr->winPtr->pathName; + return TCL_OK; + + error: + Ck_DestroyWindow(menuPtr->winPtr); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * MenuWidgetCmd -- + * + * 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. + * + *-------------------------------------------------------------- + */ + +static int +MenuWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about menu widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + register Menu *menuPtr = (Menu *) clientData; + register MenuEntry *mePtr; + int result = TCL_OK; + size_t length; + int c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Ck_Preserve((ClientData) menuPtr); + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0) + && (length >= 2)) { + int index; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " activate index\"", (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + if (menuPtr->active == index) { + goto done; + } + if (index >= 0) { + if ((menuPtr->entries[index]->type == SEPARATOR_ENTRY) + || (menuPtr->entries[index]->state == ckDisabledUid)) { + index = -1; + } + } + result = ActivateMenuEntry(menuPtr, index); + } else if ((c == 'a') && (strncmp(argv[1], "add", length) == 0) + && (length >= 2)) { + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " add type ?options?\"", (char *) NULL); + goto error; + } + if (MenuAddOrInsert(interp, menuPtr, (char *) NULL, + argc-2, argv+2) != TCL_OK) { + goto error; + } + } 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 = Ck_ConfigureValue(interp, menuPtr->winPtr, configSpecs, + (char *) menuPtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 2)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, menuPtr->winPtr, configSpecs, + (char *) menuPtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, menuPtr->winPtr, configSpecs, + (char *) menuPtr, argv[2], 0); + } else { + result = ConfigureMenu(interp, menuPtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) { + int first, last, i, numDeleted; + + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " delete first ?last?\"", (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &first) != TCL_OK) { + goto error; + } + if (argc == 3) { + last = first; + } else { + if (GetMenuIndex(interp, menuPtr, argv[3], 0, &last) != TCL_OK) { + goto error; + } + } + if ((first < 0) || (last < first)) { + goto done; + } + numDeleted = last + 1 - first; + for (i = first; i <= last; i++) { + Ck_EventuallyFree((ClientData) menuPtr->entries[i], + (Ck_FreeProc *) DestroyMenuEntry); + } + for (i = last+1; i < menuPtr->numEntries; i++) { + menuPtr->entries[i-numDeleted] = menuPtr->entries[i]; + } + menuPtr->numEntries -= numDeleted; + if ((menuPtr->active >= first) && (menuPtr->active <= last)) { + menuPtr->active = -1; + } else if (menuPtr->active > last) { + menuPtr->active -= numDeleted; + } + if (!(menuPtr->flags & RESIZE_PENDING)) { + menuPtr->flags |= RESIZE_PENDING; + Tk_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr); + } + } else if ((c == 'e') && (length >= 7) + && (strncmp(argv[1], "entrycget", length) == 0)) { + int index; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " entrycget index option\"", + (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + if (index < 0) { + goto done; + } + mePtr = menuPtr->entries[index]; + Ck_Preserve((ClientData) mePtr); + result = Ck_ConfigureValue(interp, menuPtr->winPtr, entryConfigSpecs, + (char *) mePtr, argv[3], COMMAND_MASK << mePtr->type); + Ck_Release((ClientData) mePtr); + } else if ((c == 'e') && (length >= 7) + && (strncmp(argv[1], "entryconfigure", length) == 0)) { + int index; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " entryconfigure index ?option value ...?\"", + (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + if (index < 0) { + goto done; + } + mePtr = menuPtr->entries[index]; + Ck_Preserve((ClientData) mePtr); + if (argc == 3) { + result = Ck_ConfigureInfo(interp, menuPtr->winPtr, + entryConfigSpecs, (char *) mePtr, (char *) NULL, + COMMAND_MASK << mePtr->type); + } else if (argc == 4) { + result = Ck_ConfigureInfo(interp, menuPtr->winPtr, + entryConfigSpecs, + (char *) mePtr, argv[3], COMMAND_MASK << mePtr->type); + } else { + result = ConfigureMenuEntry(interp, menuPtr, mePtr, index, argc-3, + argv+3, CK_CONFIG_ARGV_ONLY | COMMAND_MASK << mePtr->type); + } + Ck_Release((ClientData) mePtr); + } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) + && (length >= 3)) { + int index; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " index string\"", (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + if (index < 0) { + interp->result = "none"; + } else { + sprintf(interp->result, "%d", index); + } + } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) + && (length >= 3)) { + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " insert index type ?options?\"", (char *) NULL); + goto error; + } + if (MenuAddOrInsert(interp, menuPtr, argv[2], + argc-3, argv+3) != TCL_OK) { + goto error; + } + } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0) + && (length >= 3)) { + int index; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " invoke index\"", (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + if (index < 0) { + goto done; + } + mePtr = menuPtr->entries[index]; + if (mePtr->state == ckDisabledUid) { + goto done; + } + Ck_Preserve((ClientData) mePtr); + if (mePtr->type == CHECK_BUTTON_ENTRY) { + if (mePtr->flags & ENTRY_SELECTED) { + if (Tcl_SetVar(interp, mePtr->name, mePtr->offValue, + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + result = TCL_ERROR; + } + } else { + if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue, + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + result = TCL_ERROR; + } + } + } else if (mePtr->type == RADIO_BUTTON_ENTRY) { + if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue, + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + result = TCL_ERROR; + } + } + if ((result == TCL_OK) && (mePtr->command != NULL)) { + result = CkCopyAndGlobalEval(interp, mePtr->command); + } + if ((result == TCL_OK) && (mePtr->type == CASCADE_ENTRY)) { + result = PostSubmenu(menuPtr->interp, menuPtr, mePtr); + } + Ck_Release((ClientData) mePtr); + } else if ((c == 'p') && (strncmp(argv[1], "post", length) == 0) + && (length == 4)) { + int x, y, tmp; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " post x y\"", (char *) NULL); + goto error; + } + if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) + || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { + goto error; + } + + /* + * De-activate any active element. + */ + + ActivateMenuEntry(menuPtr, -1); + + /* + * If there is a command for the menu, execute it. This + * may change the size of the menu, so be sure to recompute + * the menu's geometry if needed. + */ + + if (menuPtr->postCommand != NULL) { + result = CkCopyAndGlobalEval(menuPtr->interp, + menuPtr->postCommand); + if (result != TCL_OK) { + return result; + } + if (menuPtr->flags & RESIZE_PENDING) { + Tk_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr); + ComputeMenuGeometry((ClientData) menuPtr); + } + } + if (menuPtr->borderPtr != NULL) + x -= 1; + tmp = menuPtr->winPtr->mainPtr->maxWidth - menuPtr->winPtr->reqWidth; + if (x > tmp) { + x = tmp; + } + if (x < 0) { + x = 0; + } + tmp = menuPtr->winPtr->mainPtr->maxHeight - menuPtr->winPtr->reqHeight; + if (y > tmp) { + y = tmp; + } + if (y < 0) { + y = 0; + } + if (x != menuPtr->winPtr->x || y != menuPtr->winPtr->y) { + Ck_MoveWindow(menuPtr->winPtr, x, y); + } + if (menuPtr->winPtr->reqWidth != menuPtr->winPtr->width || + menuPtr->winPtr->reqHeight != menuPtr->winPtr->reqHeight) { + Ck_ResizeWindow(menuPtr->winPtr, + menuPtr->winPtr->reqWidth, menuPtr->winPtr->reqHeight); + } + if (!(menuPtr->winPtr->flags & CK_MAPPED)) { + Ck_MapWindow(menuPtr->winPtr); + } + } else if ((c == 'p') && (strncmp(argv[1], "postcascade", length) == 0) + && (length > 4)) { + int index; + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " postcascade index\"", (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) { + result = PostSubmenu(interp, menuPtr, (MenuEntry *) NULL); + } else { + result = PostSubmenu(interp, menuPtr, menuPtr->entries[index]); + } + } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) { + int index; + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " type index\"", (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + if (index < 0) { + goto done; + } + mePtr = menuPtr->entries[index]; + switch (mePtr->type) { + case COMMAND_ENTRY: + interp->result = "command"; + break; + case SEPARATOR_ENTRY: + interp->result = "separator"; + break; + case CHECK_BUTTON_ENTRY: + interp->result = "checkbutton"; + break; + case RADIO_BUTTON_ENTRY: + interp->result = "radiobutton"; + break; + case CASCADE_ENTRY: + interp->result = "cascade"; + break; + } + } else if ((c == 'u') && (strncmp(argv[1], "unpost", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " unpost\"", (char *) NULL); + goto error; + } + Ck_UnmapWindow(menuPtr->winPtr); + if (result == TCL_OK) { + result = PostSubmenu(interp, menuPtr, (MenuEntry *) NULL); + } + } else if ((c == 'y') && (strncmp(argv[1], "yposition", length) == 0)) { + int index; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " yposition index\"", (char *) NULL); + goto error; + } + if (GetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { + goto error; + } + if (index < 0) { + interp->result = "0"; + } else { + sprintf(interp->result, "%d", menuPtr->entries[index]->y); + } + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be activate, add, cget, configure, delete, ", + "entrycget, entryconfigure, index, insert, invoke, ", + "post, postcascade, type, unpost, or yposition", + (char *) NULL); + goto error; + } + done: + Ck_Release((ClientData) menuPtr); + return result; + + error: + Ck_Release((ClientData) menuPtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyMenu -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a menu at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the menu is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyMenu(clientData) + ClientData clientData; /* Info about menu widget. */ +{ + register Menu *menuPtr = (Menu *) clientData; + int i; + + /* + * Free up all the stuff that requires special handling, then + * let Ck_FreeOptions handle all the standard option-related + * stuff. + */ + + for (i = 0; i < menuPtr->numEntries; i++) { + DestroyMenuEntry((ClientData) menuPtr->entries[i]); + } + if (menuPtr->entries != NULL) { + ckfree((char *) menuPtr->entries); + } + Ck_FreeOptions(configSpecs, (char *) menuPtr, 0); + ckfree((char *) menuPtr); +} + +/* + *---------------------------------------------------------------------- + * + * DestroyMenuEntry -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a menu entry at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the menu entry is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyMenuEntry(clientData) + ClientData clientData; /* Pointer to entry to be freed. */ +{ + register MenuEntry *mePtr = (MenuEntry *) clientData; + Menu *menuPtr = mePtr->menuPtr; + + /* + * Free up all the stuff that requires special handling, then + * let Ck_FreeOptions handle all the standard option-related + * stuff. + */ + + if (menuPtr->postedCascade == mePtr) { + /* + * Ignore errors while unposting the menu, since it's possible + * that the menu has already been deleted and the unpost will + * generate an error. + */ + + PostSubmenu(menuPtr->interp, menuPtr, (MenuEntry *) NULL); + } + if (mePtr->name != NULL) { + Tcl_UntraceVar(menuPtr->interp, mePtr->name, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, (ClientData) mePtr); + } + Ck_FreeOptions(entryConfigSpecs, (char *) mePtr, + (COMMAND_MASK << mePtr->type)); + ckfree((char *) mePtr); +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureMenu -- + * + * This procedure is called to process an argv/argc list, plus + * the option database, in order to configure (or reconfigure) + * a menu widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as colors, font, etc. get set + * for menuPtr; old resources get freed, if there were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureMenu(interp, menuPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + register Menu *menuPtr; /* 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. */ +{ + int i; + + if (Ck_ConfigureWidget(interp, menuPtr->winPtr, configSpecs, + argc, argv, (char *) menuPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * After reconfiguring a menu, we need to reconfigure all of the + * entries in the menu, since some of the things in the children + * (such as graphics contexts) may have to change to reflect changes + * in the parent. + */ + + for (i = 0; i < menuPtr->numEntries; i++) { + MenuEntry *mePtr; + + mePtr = menuPtr->entries[i]; + ConfigureMenuEntry(interp, menuPtr, mePtr, i, 0, (char **) NULL, + CK_CONFIG_ARGV_ONLY | COMMAND_MASK << mePtr->type); + } + + Ck_SetInternalBorder(menuPtr->winPtr, menuPtr->borderPtr != NULL); + + if (!(menuPtr->flags & RESIZE_PENDING)) { + menuPtr->flags |= RESIZE_PENDING; + Tk_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureMenuEntry -- + * + * This procedure is called to process an argv/argc list, plus + * the option database, in order to configure (or reconfigure) + * one entry in a menu. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information such as label and accelerator get + * set for mePtr; old resources get freed, if there were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureMenuEntry(interp, menuPtr, mePtr, index, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Menu *menuPtr; /* Information about whole menu. */ + register MenuEntry *mePtr; /* Information about menu entry; may + * or may not already have values for + * some fields. */ + int index; /* Index of mePtr within menuPtr's + * entries. */ + int argc; /* Number of valid entries in argv. */ + char **argv; /* Arguments. */ + int flags; /* Additional flags to pass to + * Tk_ConfigureWidget. */ +{ + /* + * If this entry is a cascade and the cascade is posted, then unpost + * it before reconfiguring the entry (otherwise the reconfigure might + * change the name of the cascaded entry, leaving a posted menu + * high and dry). + */ + + if (menuPtr->postedCascade == mePtr) { + if (PostSubmenu(menuPtr->interp, menuPtr, (MenuEntry *) NULL) + != TCL_OK) { + Tk_BackgroundError(menuPtr->interp); + } + } + + /* + * If this entry is a check button or radio button, then remove + * its old trace procedure. + */ + + if ((mePtr->name != NULL) && + ((mePtr->type == CHECK_BUTTON_ENTRY) + || (mePtr->type == RADIO_BUTTON_ENTRY))) { + Tcl_UntraceVar(menuPtr->interp, mePtr->name, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, (ClientData) mePtr); + } + + if (Ck_ConfigureWidget(interp, menuPtr->winPtr, entryConfigSpecs, + argc, argv, (char *) mePtr, + flags | (COMMAND_MASK << mePtr->type)) != TCL_OK) { + return TCL_ERROR; + } + + /* + * The code below handles special configuration stuff not taken + * care of by Ck_ConfigureWidget, such as special processing for + * defaults, sizing strings, graphics contexts, etc. + */ + + if (mePtr->label == NULL) { + mePtr->labelLength = 0; + } else { + mePtr->labelLength = strlen(mePtr->label); + } + if (mePtr->accel == NULL) { + mePtr->accelLength = 0; + } else { + mePtr->accelLength = strlen(mePtr->accel); + } + + if (mePtr->state == ckActiveUid) { + if (index != menuPtr->active) { + ActivateMenuEntry(menuPtr, index); + } + } else { + if (index == menuPtr->active) { + ActivateMenuEntry(menuPtr, -1); + } + if ((mePtr->state != ckNormalUid) && (mePtr->state != ckDisabledUid)) { + Tcl_AppendResult(interp, "bad state value \"", mePtr->state, + "\": must be normal, active, or disabled", (char *) NULL); + mePtr->state = ckNormalUid; + return TCL_ERROR; + } + } + + if ((mePtr->type == CHECK_BUTTON_ENTRY) + || (mePtr->type == RADIO_BUTTON_ENTRY)) { + char *value; + + if (mePtr->name == NULL) { + mePtr->name = (char *) ckalloc(mePtr->labelLength + 1); + strcpy(mePtr->name, (mePtr->label == NULL) ? "" : mePtr->label); + } + if (mePtr->onValue == NULL) { + mePtr->onValue = (char *) ckalloc(mePtr->labelLength + 1); + strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : mePtr->label); + } + + /* + * Select the entry if the associated variable has the + * appropriate value, initialize the variable if it doesn't + * exist, then set a trace on the variable to monitor future + * changes to its value. + */ + + value = Tcl_GetVar(interp, mePtr->name, TCL_GLOBAL_ONLY); + mePtr->flags &= ~ENTRY_SELECTED; + if (value != NULL) { + if (strcmp(value, mePtr->onValue) == 0) { + mePtr->flags |= ENTRY_SELECTED; + } + } else { + Tcl_SetVar(interp, mePtr->name, + (mePtr->type == CHECK_BUTTON_ENTRY) ? mePtr->offValue : "", + TCL_GLOBAL_ONLY); + } + Tcl_TraceVar(interp, mePtr->name, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, (ClientData) mePtr); + } + + if (!(menuPtr->flags & RESIZE_PENDING)) { + menuPtr->flags |= RESIZE_PENDING; + Tk_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr); + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ComputeMenuGeometry -- + * + * This procedure is invoked to recompute the size and + * layout of a menu. It is called as a when-idle handler so + * that it only gets done once, even if a group of changes is + * made to the menu. + * + * Results: + * None. + * + * Side effects: + * Fields of menu entries are changed to reflect their + * current positions, and the size of the menu window + * itself may be changed. + * + *-------------------------------------------------------------- + */ + +static void +ComputeMenuGeometry(clientData) + ClientData clientData; /* Structure describing menu. */ +{ + Menu *menuPtr = (Menu *) clientData; + CkWindow *winPtr = menuPtr->winPtr; + register MenuEntry *mePtr; + int maxLabelWidth, maxIndicatorWidth, maxAccelWidth; + int width, height, indicatorSpace, dummy; + int i, y; + + if (menuPtr->winPtr == NULL) { + return; + } + + maxLabelWidth = maxIndicatorWidth = maxAccelWidth = 0; + y = 0; + + for (i = 0; i < menuPtr->numEntries; i++) { + mePtr = menuPtr->entries[i]; + indicatorSpace = 0; + + if (mePtr->label != NULL) { + CkMeasureChars(winPtr->mainPtr, + mePtr->label, mePtr->labelLength, 0, + 100000, 0, CK_NEWLINES_NOT_SPECIAL, &width, &dummy); + } else { + width = 0; + } + if (mePtr->indicatorOn && (mePtr->type == CHECK_BUTTON_ENTRY || + mePtr->type == RADIO_BUTTON_ENTRY)) { + indicatorSpace = 4; + } + if (width > maxLabelWidth) { + maxLabelWidth = width; + } + if (mePtr->type == CASCADE_ENTRY) { + width = 2; + } else if (mePtr->accel != NULL) { + CkMeasureChars(winPtr->mainPtr, + mePtr->accel, mePtr->accelLength, 0, + 100000, 0, CK_NEWLINES_NOT_SPECIAL, &width, &dummy); + } else { + width = 0; + } + if (width > maxAccelWidth) { + maxAccelWidth = width; + } + if (indicatorSpace > maxIndicatorWidth) { + maxIndicatorWidth = indicatorSpace; + } + mePtr->y = y; + y++; + } + + /* + * Got all the sizes. Update fields in the menu structure, then + * resize the window if necessary. Leave margins on either side + * of the indicator (or just one margin if there is no indicator). + * Leave another margin on the right side of the label, plus yet + * another margin to the right of the accelerator (if there is one). + */ + + menuPtr->indicatorSpace = maxIndicatorWidth; + menuPtr->labelWidth = maxLabelWidth; + width = menuPtr->indicatorSpace + menuPtr->labelWidth + maxAccelWidth; + height = y; + + if (width <= 0) { + width = 1; + } + if (height <= 0) { + height = 1; + } + + if (menuPtr->borderPtr != NULL) { + width += 2; + height += 2; + } + if (width != menuPtr->winPtr->reqWidth || + height != menuPtr->winPtr->reqHeight) { + Ck_GeometryRequest(menuPtr->winPtr, width, height); + } else { + /* + * Must always force a redisplay here if the window is mapped + * (even if the size didn't change, something else might have + * changed in the menu, such as a label or accelerator). The + * resize will force a redisplay above. + */ + + EventuallyRedrawMenu(menuPtr, (MenuEntry *) NULL); + } + menuPtr->flags &= ~RESIZE_PENDING; +} + +/* + *---------------------------------------------------------------------- + * + * DisplayMenu -- + * + * This procedure is invoked to display a menu widget. + * + * Results: + * None. + * + * Side effects: + * Commands are output to X to display the menu in its + * current mode. + * + *---------------------------------------------------------------------- + */ + +static void +DisplayMenu(clientData) + ClientData clientData; /* Information about widget. */ +{ + register Menu *menuPtr = (Menu *) clientData; + register MenuEntry *mePtr; + register CkWindow *winPtr = menuPtr->winPtr; + int index, leftEdge, x, y, cursorX, cursorY; + int fg, nFg, aFg, dFg; + int bg, nBg, aBg, dBg; + int attr, nAt, aAt, dAt; + + menuPtr->flags &= ~REDRAW_PENDING; + if (menuPtr->winPtr == NULL || !(winPtr->flags & CK_MAPPED)) + return; + + x = cursorX = menuPtr->borderPtr != NULL ? 1 : 0; + y = cursorY = menuPtr->borderPtr != NULL ? 1 : 0; + + /* + * Loop through all of the entries, drawing them one at a time. + */ + + leftEdge = menuPtr->indicatorSpace + x; + + for (index = 0; index < menuPtr->numEntries; index++, y++) { + mePtr = menuPtr->entries[index]; + if (mePtr->state == ckActiveUid) { + cursorY = y; + if (mePtr->type == CASCADE_ENTRY) + cursorX = winPtr->width - x - 1; + else if (mePtr->type == CHECK_BUTTON_ENTRY || + mePtr->type == RADIO_BUTTON_ENTRY) + cursorX = x + 1; + } + if (!(mePtr->flags & ENTRY_NEEDS_REDISPLAY)) { + continue; + } + mePtr->flags &= ~ENTRY_NEEDS_REDISPLAY; + + /* + * Colors. + */ + + nBg = mePtr->normalBg < 0 ? menuPtr->normalBg : mePtr->normalBg; + aBg = mePtr->activeBg < 0 ? menuPtr->activeBg : mePtr->activeBg; + dBg = mePtr->disabledBg < 0 ? menuPtr->disabledBg : mePtr->disabledBg; + nFg = mePtr->normalFg < 0 ? menuPtr->normalFg : mePtr->normalFg; + aFg = mePtr->activeFg < 0 ? menuPtr->activeFg : mePtr->activeFg; + dFg = mePtr->disabledFg < 0 ? menuPtr->disabledFg : mePtr->disabledFg; + nAt = mePtr->normalAttr < 0 ? menuPtr->normalAttr : mePtr->normalAttr; + aAt = mePtr->activeAttr < 0 ? menuPtr->activeAttr : mePtr->activeAttr; + dAt = mePtr->disabledAttr < 0 ? menuPtr->disabledAttr : + mePtr->disabledAttr; + + if (mePtr->state == ckActiveUid) { + bg = aBg; fg = aFg; attr = aAt; + } else if (mePtr->state == ckDisabledUid) { + bg = dBg; fg = dFg; attr = dAt; + } else { + bg = nBg; fg = nFg; attr = nAt; + } + + Ck_SetWindowAttr(winPtr, fg, bg, attr); + Ck_ClearToEol(winPtr, x, y); + + if (mePtr->label != NULL) { + CkDisplayChars(winPtr->mainPtr, winPtr->window, + mePtr->label, mePtr->labelLength, + leftEdge, y, leftEdge, + CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS); + if (mePtr->underline >= 0 && mePtr->state == ckNormalUid) { + Ck_SetWindowAttr(winPtr, mePtr->underlineFg < 0 ? + menuPtr->underlineFg : mePtr->underlineFg, bg, + mePtr->underlineAttr < 0 ? menuPtr->underlineAttr : + mePtr->underlineAttr); + CkUnderlineChars(winPtr->mainPtr, winPtr->window, mePtr->label, + mePtr->labelLength, leftEdge, y, leftEdge, + CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS, + mePtr->underline, mePtr->underline); + Ck_SetWindowAttr(winPtr, fg, bg, attr); + } + } + + /* + * Draw accelerator or cascade arrow. + */ + + if (mePtr->type == CASCADE_ENTRY) { + int gchar; + + Ck_GetGChar(menuPtr->interp, "rarrow", &gchar); + mvwaddch(winPtr->window, y, winPtr->width - x - 1, gchar); + } else if (mePtr->accel != NULL) { + CkDisplayChars(winPtr->mainPtr, winPtr->window, + mePtr->accel, mePtr->accelLength, + leftEdge + menuPtr->labelWidth, y, + leftEdge + menuPtr->labelWidth, + CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS); + } + + /* + * Draw check-button/radio-button indicators. + */ + + if (mePtr->indicatorOn && (mePtr->type == CHECK_BUTTON_ENTRY || + mePtr->type == RADIO_BUTTON_ENTRY)) { + wmove(winPtr->window, y, x); + Ck_SetWindowAttr(winPtr, nFg, nBg, nAt); + waddstr(winPtr->window, mePtr->type == CHECK_BUTTON_ENTRY ? + "[ ]" : "( )"); + if (mePtr->flags & ENTRY_SELECTED) { + int gchar; + + Ck_GetGChar(menuPtr->interp, + mePtr->type == CHECK_BUTTON_ENTRY ? "diamond" : "bullet", + &gchar); + Ck_SetWindowAttr(winPtr, mePtr->indicatorFg < 0 ? + menuPtr->indicatorFg : mePtr->indicatorFg, nBg, nAt); + mvwaddch(winPtr->window, y, x + 1, gchar); + } + } + + /* + * Draw separator. + */ + + if (mePtr->type == SEPARATOR_ENTRY) { + int i, gchar; + + wmove(winPtr->window, y, x); + Ck_SetWindowAttr(winPtr, nFg, nBg, nAt); + Ck_GetGChar(menuPtr->interp, "hline", &gchar); + for (i = x; i < winPtr->width - x; i++) + waddch(winPtr->window, gchar); + } + } + if (menuPtr->borderPtr != NULL) { + Ck_SetWindowAttr(winPtr, menuPtr->normalFg, menuPtr->normalBg, + menuPtr->normalAttr); + Ck_DrawBorder(winPtr, menuPtr->borderPtr, 0, 0, + winPtr->width, winPtr->height); + } + wmove(winPtr->window, cursorY, cursorX); + Ck_EventuallyRefresh(winPtr); +} + +/* + *-------------------------------------------------------------- + * + * GetMenuIndex -- + * + * Parse a textual index into a menu and return the numerical + * index of the indicated entry. + * + * Results: + * A standard Tcl result. If all went well, then *indexPtr is + * filled in with the entry index corresponding to string + * (ranges from -1 to the number of entries in the menu minus + * one). Otherwise an error message is left in interp->result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +GetMenuIndex(interp, menuPtr, string, lastOK, indexPtr) + Tcl_Interp *interp; /* For error messages. */ + Menu *menuPtr; /* Menu for which the index is being + * specified. */ + char *string; /* Specification of an entry in menu. See + * manual entry for valid .*/ + int lastOK; /* Non-zero means its OK to return index + * just *after* last entry. */ + int *indexPtr; /* Where to store converted relief. */ +{ + int i; + + if ((string[0] == 'a') && (strcmp(string, "active") == 0)) { + *indexPtr = menuPtr->active; + return TCL_OK; + } + + if (((string[0] == 'l') && (strcmp(string, "last") == 0)) + || ((string[0] == 'e') && (strcmp(string, "end") == 0))) { + *indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1); + return TCL_OK; + } + + if ((string[0] == 'n') && (strcmp(string, "none") == 0)) { + *indexPtr = -1; + return TCL_OK; + } + + if (string[0] == '@') { + if (Tcl_GetInt(interp, string+1, &i) == TCL_OK) { + if (menuPtr->borderPtr != NULL) + i -= 1; + if (i >= menuPtr->numEntries) + i = -1; + if (i < 0) + i = -1; + *indexPtr = i; + return TCL_OK; + } else { + Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); + } + } + + if (isdigit((unsigned char) string[0])) { + if (Tcl_GetInt(interp, string, &i) == TCL_OK) { + if (i >= menuPtr->numEntries) { + if (lastOK) { + i = menuPtr->numEntries; + } else { + i = menuPtr->numEntries-1; + } + } else if (i < 0) { + i = -1; + } + *indexPtr = i; + return TCL_OK; + } + Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); + } + + for (i = 0; i < menuPtr->numEntries; i++) { + char *label; + + label = menuPtr->entries[i]->label; + if ((label != NULL) + && (Tcl_StringMatch(menuPtr->entries[i]->label, string))) { + *indexPtr = i; + return TCL_OK; + } + } + + Tcl_AppendResult(interp, "bad menu entry index \"", + string, "\"", (char *) NULL); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * MenuEventProc -- + * + * This procedure is invoked by the Tk dispatcher for various + * events on menus. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +MenuEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + Menu *menuPtr = (Menu *) clientData; + if (eventPtr->type == CK_EV_EXPOSE || eventPtr->type == CK_EV_MAP) { + EventuallyRedrawMenu(menuPtr, (MenuEntry *) NULL); + } else if (eventPtr->type == CK_EV_DESTROY) { + if (menuPtr->winPtr != NULL) { + menuPtr->winPtr = NULL; + Tcl_DeleteCommand(menuPtr->interp, + Tcl_GetCommandName(menuPtr->interp, menuPtr->widgetCmd)); + } + if (menuPtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayMenu, (ClientData) menuPtr); + } + if (menuPtr->flags & RESIZE_PENDING) { + Tk_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr); + } + Ck_EventuallyFree((ClientData) menuPtr, (Ck_FreeProc *) DestroyMenu); + } +} + +/* + *---------------------------------------------------------------------- + * + * MenuCmdDeletedProc -- + * + * 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 +MenuCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + Menu *menuPtr = (Menu *) clientData; + CkWindow *winPtr = menuPtr->winPtr; + + /* + * 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 (winPtr != NULL) { + menuPtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * MenuNewEntry -- + * + * This procedure allocates and initializes a new menu entry. + * + * Results: + * The return value is a pointer to a new menu entry structure, + * which has been malloc-ed, initialized, and entered into the + * entry array for the menu. + * + * Side effects: + * Storage gets allocated. + * + *---------------------------------------------------------------------- + */ + +static MenuEntry * +MenuNewEntry(menuPtr, index, type) + Menu *menuPtr; /* Menu that will hold the new entry. */ + int index; /* Where in the menu the new entry is to + * go. */ + int type; /* The type of the new entry. */ +{ + MenuEntry *mePtr; + MenuEntry **newEntries; + int i; + + /* + * Create a new array of entries with an empty slot for the + * new entry. + */ + + newEntries = (MenuEntry **) ckalloc((unsigned) + ((menuPtr->numEntries+1)*sizeof(MenuEntry *))); + for (i = 0; i < index; i++) { + newEntries[i] = menuPtr->entries[i]; + } + for ( ; i < menuPtr->numEntries; i++) { + newEntries[i+1] = menuPtr->entries[i]; + } + if (menuPtr->numEntries != 0) { + ckfree((char *) menuPtr->entries); + } + menuPtr->entries = newEntries; + menuPtr->numEntries++; + menuPtr->entries[index] = mePtr = (MenuEntry *) ckalloc(sizeof(MenuEntry)); + mePtr->type = type; + mePtr->menuPtr = menuPtr; + mePtr->label = NULL; + mePtr->labelLength = 0; + mePtr->underline = -1; + mePtr->accel = NULL; + mePtr->accelLength = 0; + mePtr->state = ckNormalUid; + mePtr->y = 0; + mePtr->indicatorOn = 1; + mePtr->normalBg = -1; + mePtr->normalFg = -1; + mePtr->normalAttr = -1; + mePtr->activeBg = -1; + mePtr->activeFg = -1; + mePtr->activeAttr = -1; + mePtr->disabledBg = -1; + mePtr->disabledFg = -1; + mePtr->disabledAttr = -1; + mePtr->underlineFg = -1; + mePtr->underlineAttr = -1; + mePtr->indicatorFg = -1; + mePtr->command = NULL; + mePtr->name = NULL; + mePtr->onValue = NULL; + mePtr->offValue = NULL; + mePtr->flags = 0; + return mePtr; +} + +/* + *---------------------------------------------------------------------- + * + * MenuAddOrInsert -- + * + * This procedure does all of the work of the "add" and "insert" + * widget commands, allowing the code for these to be shared. + * + * Results: + * A standard Tcl return value. + * + * Side effects: + * A new menu entry is created in menuPtr. + * + *---------------------------------------------------------------------- + */ + +static int +MenuAddOrInsert(interp, menuPtr, indexString, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Menu *menuPtr; /* Widget in which to create new + * entry. */ + char *indexString; /* String describing index at which + * to insert. NULL means insert at + * end. */ + int argc; /* Number of elements in argv. */ + char **argv; /* Arguments to command: first arg + * is type of entry, others are + * config options. */ +{ + int c, type, i, index; + size_t length; + MenuEntry *mePtr; + + if (indexString != NULL) { + if (GetMenuIndex(interp, menuPtr, indexString, 1, &index) != TCL_OK) { + return TCL_ERROR; + } + } else { + index = menuPtr->numEntries; + } + if (index < 0) { + Tcl_AppendResult(interp, "bad index \"", indexString, "\"", + (char *) NULL); + return TCL_ERROR; + } + + /* + * Figure out the type of the new entry. + */ + + c = argv[0][0]; + length = strlen(argv[0]); + if ((c == 'c') && (strncmp(argv[0], "cascade", length) == 0) + && (length >= 2)) { + type = CASCADE_ENTRY; + } else if ((c == 'c') && (strncmp(argv[0], "checkbutton", length) == 0) + && (length >= 2)) { + type = CHECK_BUTTON_ENTRY; + } else if ((c == 'c') && (strncmp(argv[0], "command", length) == 0) + && (length >= 2)) { + type = COMMAND_ENTRY; + } else if ((c == 'r') + && (strncmp(argv[0], "radiobutton", length) == 0)) { + type = RADIO_BUTTON_ENTRY; + } else if ((c == 's') + && (strncmp(argv[0], "separator", length) == 0)) { + type = SEPARATOR_ENTRY; + } else { + Tcl_AppendResult(interp, "bad menu entry type \"", + argv[0], "\": must be cascade, checkbutton, ", + "command, radiobutton, or separator", (char *) NULL); + return TCL_ERROR; + } + mePtr = MenuNewEntry(menuPtr, index, type); + if (ConfigureMenuEntry(interp, menuPtr, mePtr, index, + argc-1, argv+1, 0) != TCL_OK) { + DestroyMenuEntry((ClientData) mePtr); + for (i = index+1; i < menuPtr->numEntries; i++) { + menuPtr->entries[i-1] = menuPtr->entries[i]; + } + menuPtr->numEntries--; + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * MenuVarProc -- + * + * This procedure is invoked when someone changes the + * state variable associated with a radiobutton or checkbutton + * menu entry. The entry's selected state is set to match + * the value of the variable. + * + * Results: + * NULL is always returned. + * + * Side effects: + * The menu entry may become selected or deselected. + * + *-------------------------------------------------------------- + */ + +static char * +MenuVarProc(clientData, interp, name1, name2, flags) + ClientData clientData; /* Information about menu entry. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* First part of variable's name. */ + char *name2; /* Second part of variable's name. */ + int flags; /* Describes what just happened. */ +{ + MenuEntry *mePtr = (MenuEntry *) clientData; + Menu *menuPtr; + char *value; + + menuPtr = mePtr->menuPtr; + + /* + * If the variable is being unset, then re-establish the + * trace unless the whole interpreter is going away. + */ + + if (flags & TCL_TRACE_UNSETS) { + mePtr->flags &= ~ENTRY_SELECTED; + if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + Tcl_TraceVar(interp, mePtr->name, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, clientData); + } + EventuallyRedrawMenu(menuPtr, (MenuEntry *) NULL); + return (char *) NULL; + } + + /* + * Use the value of the variable to update the selected status of + * the menu entry. + */ + + value = Tcl_GetVar(interp, mePtr->name, TCL_GLOBAL_ONLY); + if (value == NULL) { + value = ""; + } + if (strcmp(value, mePtr->onValue) == 0) { + if (mePtr->flags & ENTRY_SELECTED) { + return (char *) NULL; + } + mePtr->flags |= ENTRY_SELECTED; + } else if (mePtr->flags & ENTRY_SELECTED) { + mePtr->flags &= ~ENTRY_SELECTED; + } else { + return (char *) NULL; + } + EventuallyRedrawMenu(menuPtr, (MenuEntry *) NULL); + return (char *) NULL; +} + +/* + *---------------------------------------------------------------------- + * + * EventuallyRedrawMenu -- + * + * Arrange for an entry of a menu, or the whole menu, to be + * redisplayed at some point in the future. + * + * Results: + * None. + * + * Side effects: + * A when-idle hander is scheduled to do the redisplay, if there + * isn't one already scheduled. + * + *---------------------------------------------------------------------- + */ + +static void +EventuallyRedrawMenu(menuPtr, mePtr) + register Menu *menuPtr; /* Information about menu to redraw. */ + register MenuEntry *mePtr; /* Entry to redraw. NULL means redraw + * all the entries in the menu. */ +{ + int i; + + if (menuPtr->winPtr == NULL) { + return; + } + if (mePtr != NULL) { + mePtr->flags |= ENTRY_NEEDS_REDISPLAY; + } else { + for (i = 0; i < menuPtr->numEntries; i++) { + menuPtr->entries[i]->flags |= ENTRY_NEEDS_REDISPLAY; + } + } + if ((menuPtr->winPtr == NULL) || !(menuPtr->winPtr->flags & CK_MAPPED) + || (menuPtr->flags & REDRAW_PENDING)) { + return; + } + Tk_DoWhenIdle(DisplayMenu, (ClientData) menuPtr); + menuPtr->flags |= REDRAW_PENDING; +} + +/* + *-------------------------------------------------------------- + * + * PostSubmenu -- + * + * This procedure arranges for a particular submenu (i.e. the + * menu corresponding to a given cascade entry) to be + * posted. + * + * Results: + * A standard Tcl return result. Errors may occur in the + * Tcl commands generated to post and unpost submenus. + * + * Side effects: + * If there is already a submenu posted, it is unposted. + * The new submenu is then posted. + * + *-------------------------------------------------------------- + */ + +static int +PostSubmenu(interp, menuPtr, mePtr) + Tcl_Interp *interp; /* Used for invoking sub-commands and + * reporting errors. */ + register Menu *menuPtr; /* Information about menu as a whole. */ + register MenuEntry *mePtr; /* Info about submenu that is to be + * posted. NULL means make sure that + * no submenu is posted. */ +{ + char string[30]; + int result, x, y; + CkWindow *winPtr; + + if (mePtr == menuPtr->postedCascade) { + return TCL_OK; + } + + if (menuPtr->postedCascade != NULL) { + /* + * Note: when unposting a submenu, we have to redraw the entire + * parent menu. This is because of a combination of the following + * things: + * (a) the submenu partially overlaps the parent. + * (b) the submenu specifies "save under", which causes the X + * server to make a copy of the information under it when it + * is posted. When the submenu is unposted, the X server + * copies this data back and doesn't generate any Expose + * events for the parent. + * (c) the parent may have redisplayed itself after the submenu + * was posted, in which case the saved information is no + * longer correct. + * The simplest solution is just force a complete redisplay of + * the parent. + */ + + EventuallyRedrawMenu(menuPtr, (MenuEntry *) NULL); + result = Tcl_VarEval(interp, menuPtr->postedCascade->name, + " unpost", (char *) NULL); + menuPtr->postedCascade = NULL; + if (result != TCL_OK) { + return result; + } + } + + if ((mePtr != NULL) && (mePtr->name != NULL) + && (menuPtr->winPtr->flags & CK_MAPPED)) { + /* + * Make sure that the cascaded submenu is a child of the + * parent menu. + */ + + winPtr = Ck_NameToWindow(interp, mePtr->name, menuPtr->winPtr); + if (winPtr == NULL) { + return TCL_ERROR; + } + if (winPtr->parentPtr != menuPtr->winPtr) { + Tcl_AppendResult(interp, "cascaded sub-menu ", + winPtr->pathName, " must be a child of ", + menuPtr->winPtr->pathName, (char *) NULL); + return TCL_ERROR; + } + + /* + * Position the cascade with its upper left corner slightly + * below and to the left of the upper right corner of the + * menu entry (this is an attempt to match Motif behavior). + */ + x = menuPtr->winPtr->x; + y = menuPtr->winPtr->y; + x += menuPtr->winPtr->width; + y += mePtr->y; + sprintf(string, "%d %d", x, y); + result = Tcl_VarEval(interp, mePtr->name, " post ", string, + (char *) NULL); + if (result != TCL_OK) { + return result; + } + menuPtr->postedCascade = mePtr; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ActivateMenuEntry -- + * + * This procedure is invoked to make a particular menu entry + * the active one, deactivating any other entry that might + * currently be active. + * + * Results: + * The return value is a standard Tcl result (errors can occur + * while posting and unposting submenus). + * + * Side effects: + * Menu entries get redisplayed, and the active entry changes. + * Submenus may get posted and unposted. + * + *---------------------------------------------------------------------- + */ + +static int +ActivateMenuEntry(menuPtr, index) + register Menu *menuPtr; /* Menu in which to activate. */ + int index; /* Index of entry to activate, or + * -1 to deactivate all entries. */ +{ + register MenuEntry *mePtr; + int result = TCL_OK; + + if (menuPtr->active >= 0) { + mePtr = menuPtr->entries[menuPtr->active]; + + /* + * Don't change the state unless it's currently active (state + * might already have been changed to disabled). + */ + + if (mePtr->state == ckActiveUid) { + mePtr->state = ckNormalUid; + } + EventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]); + } + menuPtr->active = index; + if (index >= 0) { + mePtr = menuPtr->entries[index]; + mePtr->state = ckActiveUid; + EventuallyRedrawMenu(menuPtr, mePtr); + } + return result; +} diff --git a/ckMenubutton.c b/ckMenubutton.c new file mode 100644 index 0000000..47684e3 --- /dev/null +++ b/ckMenubutton.c @@ -0,0 +1,841 @@ +/* + * ckMenubutton.c -- + * + * This module implements button-like widgets that are used + * to invoke pull-down menus. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +/* + * A data structure of the following type is kept for each + * widget managed by this file: + */ + +typedef struct { + CkWindow *winPtr; /* Window that embodies the widget. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with menubutton. */ + Tcl_Command widgetCmd; /* Token for menubutton's widget command. */ + char *menuName; /* Name of menu associated with widget. + * Malloc-ed. */ + + /* + * Information about what's displayed in the menu button: + */ + + char *text; /* Text to display in button (malloc'ed) + * or NULL. */ + int numChars; /* # of characters in text. */ + char *textVarName; /* Name of variable (malloc'ed) or NULL. + * If non-NULL, button displays the contents + * of this variable. */ + + /* + * Information used when displaying widget: + */ + + Ck_Uid state; /* State of button for display purposes: + * normal, active, or disabled. */ + int normalFg; /* Foreground color in normal mode. */ + int normalBg; /* Background color in normal mode. */ + int normalAttr; /* Attributes in normal mode. */ + int activeFg; /* Foreground color in active mode. */ + int activeBg; /* Ditto, background color. */ + int activeAttr; /* Attributes in active mode. */ + int disabledBg; /* Background color when disabled. */ + int disabledFg; /* Foreground color when disabled. */ + int disabledAttr; /* Attributes when disabled. */ + int underlineFg; /* Foreground color for underlined char. */ + int underlineAttr; /* Attribute for underlined character. */ + int indicatorFg; /* Foreground color for indicator. */ + int underline; /* Index of underlined character, < 0 if + * no underlining. */ + int width, height; /* If > 0, these specify dimensions to request + * for window, in characters for text and in + * pixels for bitmaps. In this case the actual + * size of the text string or bitmap is + * ignored in computing desired window size. */ + Ck_Anchor anchor; /* Where text/bitmap should be displayed + * inside window region. */ + int indicatorOn; /* Non-zero means display indicator; 0 means + * don't display. */ + + /* + * Miscellaneous information: + */ + + char *takeFocus; /* Value of -takefocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + int flags; /* Various flags; see below for + * definitions. */ +} MenuButton; + +/* + * Flag bits for buttons: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler + * has already been queued to redraw + * this window. + * POSTED: Non-zero means that the menu associated + * with this button has been posted (typically + * because of an active button press). + * GOT_FOCUS: Non-zero means this button currently + * has the input focus. + */ + +#define REDRAW_PENDING 1 +#define POSTED 2 +#define GOT_FOCUS 4 + +/* + * Information used for parsing configuration specs: + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_MENUBUTTON_ACTIVE_ATTR_COLOR, + Ck_Offset(MenuButton, activeAttr), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_MENUBUTTON_ACTIVE_ATTR_MONO, + Ck_Offset(MenuButton, activeAttr), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_MENUBUTTON_ATTR, Ck_Offset(MenuButton, normalAttr), 0}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_MENUBUTTON_ACTIVE_BG_COLOR, Ck_Offset(MenuButton, activeBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_MENUBUTTON_ACTIVE_BG_MONO, Ck_Offset(MenuButton, activeBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_MENUBUTTON_ACTIVE_FG_COLOR, Ck_Offset(MenuButton, activeFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_MENUBUTTON_ACTIVE_FG_MONO, Ck_Offset(MenuButton, activeFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", + DEF_MENUBUTTON_ANCHOR, Ck_Offset(MenuButton, anchor), 0}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_MENUBUTTON_BG_COLOR, Ck_Offset(MenuButton, normalBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_MENUBUTTON_BG_MONO, Ck_Offset(MenuButton, normalBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_ATTR, "-disabledattributes", "disabledAttributes", + "DisabledAttributes", DEF_MENUBUTTON_DISABLED_ATTR, + Ck_Offset(MenuButton, disabledAttr), 0}, + {CK_CONFIG_COLOR, "-disabledbackground", "disabledBackground", + "DisabledBackground", DEF_MENUBUTTON_DISABLED_FG_COLOR, + Ck_Offset(MenuButton, disabledBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-disabledbackground", "disabledBackground", + "DisabledBackground", DEF_MENUBUTTON_DISABLED_BG_MONO, + Ck_Offset(MenuButton, disabledBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", + "DisabledForeground", DEF_MENUBUTTON_DISABLED_BG_COLOR, + Ck_Offset(MenuButton, disabledFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", + "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_MONO, + Ck_Offset(MenuButton, disabledFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_MENUBUTTON_FG, Ck_Offset(MenuButton, normalFg), 0}, + {CK_CONFIG_COORD, "-height", "height", "Height", + DEF_MENUBUTTON_HEIGHT, Ck_Offset(MenuButton, height), 0}, + {CK_CONFIG_COLOR, "-indicatorforeground", "indicatorForeground", + "Foreground", DEF_MENUBUTTON_INDICATOR_FG_COLOR, + Ck_Offset(MenuButton, indicatorFg), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-indicatorforeground", "indicatorForeground", + "Foreground", DEF_MENUBUTTON_INDICATOR_FG_MONO, + Ck_Offset(MenuButton, indicatorFg), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn", + DEF_MENUBUTTON_INDICATOR, Ck_Offset(MenuButton, indicatorOn), 0}, + {CK_CONFIG_STRING, "-menu", "menu", "Menu", + DEF_MENUBUTTON_MENU, Ck_Offset(MenuButton, menuName), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_UID, "-state", "state", "State", + DEF_MENUBUTTON_STATE, Ck_Offset(MenuButton, state), 0}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_MENUBUTTON_TAKE_FOCUS, Ck_Offset(MenuButton, takeFocus), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-text", "text", "Text", + DEF_MENUBUTTON_TEXT, Ck_Offset(MenuButton, text), 0}, + {CK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", + DEF_MENUBUTTON_TEXT_VARIABLE, Ck_Offset(MenuButton, textVarName), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_INT, "-underline", "underline", "Underline", + DEF_MENUBUTTON_UNDERLINE, Ck_Offset(MenuButton, underline), 0}, + {CK_CONFIG_ATTR, "-underlineattributes", "underlineAttributes", + "UnderlineAttributes", DEF_MENUBUTTON_UNDERLINE_ATTR, + Ck_Offset(MenuButton, underlineAttr), 0}, + {CK_CONFIG_COLOR, "-underlineforeground", "underlineForeground", + "UnderlineForeground", DEF_MENUBUTTON_UNDERLINE_FG_COLOR, + Ck_Offset(MenuButton, underlineFg), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-underlineforeground", "underlineForeground", + "UnderlineForeground", DEF_MENUBUTTON_UNDERLINE_FG_MONO, + Ck_Offset(MenuButton, underlineFg), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COORD, "-width", "width", "Width", + DEF_MENUBUTTON_WIDTH, Ck_Offset(MenuButton, width), 0}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void ComputeMenuButtonGeometry _ANSI_ARGS_(( + MenuButton *mbPtr)); +static void MenuButtonCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void MenuButtonEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static char * MenuButtonTextVarProc _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + char *name1, char *name2, int flags)); +static int MenuButtonWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int ConfigureMenuButton _ANSI_ARGS_((Tcl_Interp *interp, + MenuButton *mbPtr, int argc, char **argv, + int flags)); +static void DestroyMenuButton _ANSI_ARGS_((ClientData clientData)); +static void DisplayMenuButton _ANSI_ARGS_((ClientData clientData)); + +/* + *-------------------------------------------------------------- + * + * Ck_MenubuttonCmd -- + * + * This procedure is invoked to process the "menubutton" + * Tcl commands. See the user documentation for details + * on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_MenubuttonCmd(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. */ +{ + register MenuButton *mbPtr; + CkWindow *mainPtr = (CkWindow *) clientData; + CkWindow *new; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Create the new window. + */ + + new = Ck_CreateWindowFromPath(interp, mainPtr, argv[1], 0); + if (new == NULL) { + return TCL_ERROR; + } + + /* + * Initialize the data structure for the button. + */ + + mbPtr = (MenuButton *) ckalloc(sizeof(MenuButton)); + mbPtr->winPtr = new; + mbPtr->interp = interp; + mbPtr->widgetCmd = Tcl_CreateCommand(interp, mbPtr->winPtr->pathName, + MenuButtonWidgetCmd, (ClientData) mbPtr, MenuButtonCmdDeletedProc); + mbPtr->menuName = NULL; + mbPtr->text = NULL; + mbPtr->numChars = 0; + + mbPtr->textVarName = NULL; + mbPtr->state = ckNormalUid; + mbPtr->normalBg = 0; + mbPtr->normalFg = 0; + mbPtr->normalAttr = 0; + mbPtr->activeBg = 0; + mbPtr->activeFg = 0; + mbPtr->activeAttr = 0; + mbPtr->disabledBg = 0; + mbPtr->disabledFg = 0; + mbPtr->disabledAttr = 0; + mbPtr->underlineFg = 0; + mbPtr->underlineAttr = 0; + mbPtr->indicatorFg = 0; + mbPtr->underline = -1; + mbPtr->width = 0; + mbPtr->height = 0; + mbPtr->anchor = CK_ANCHOR_CENTER; + mbPtr->indicatorOn = 0; + mbPtr->takeFocus = NULL; + mbPtr->flags = 0; + + Ck_SetClass(mbPtr->winPtr, "Menubutton"); + Ck_CreateEventHandler(mbPtr->winPtr, + CK_EV_EXPOSE | CK_EV_MAP | CK_EV_DESTROY, + MenuButtonEventProc, (ClientData) mbPtr); + if (ConfigureMenuButton(interp, mbPtr, argc-2, argv+2, 0) != TCL_OK) { + Ck_DestroyWindow(mbPtr->winPtr); + return TCL_ERROR; + } + + interp->result = mbPtr->winPtr->pathName; + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * MenuButtonWidgetCmd -- + * + * 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. + * + *-------------------------------------------------------------- + */ + +static int +MenuButtonWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about button widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + register MenuButton *mbPtr = (MenuButton *) clientData; + int result = TCL_OK; + size_t length; + int c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Ck_Preserve((ClientData) mbPtr); + c = argv[1][0]; + length = strlen(argv[1]); + 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 = Ck_ConfigureValue(interp, mbPtr->winPtr, configSpecs, + (char *) mbPtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 2)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, mbPtr->winPtr, configSpecs, + (char *) mbPtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, mbPtr->winPtr, configSpecs, + (char *) mbPtr, argv[2], 0); + } else { + result = ConfigureMenuButton(interp, mbPtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be cget or configure", + (char *) NULL); + goto error; + } + Ck_Release((ClientData) mbPtr); + return result; + + error: + Ck_Release((ClientData) mbPtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyMenuButton -- + * + * This procedure is invoked to recycle all of the resources + * associated with a button widget. It is invoked as a + * when-idle handler in order to make sure that there is no + * other use of the button pending at the time of the deletion. + * + * Results: + * None. + * + * Side effects: + * Everything associated with the widget is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyMenuButton(clientData) + ClientData clientData; /* Info about button widget. */ +{ + register MenuButton *mbPtr = (MenuButton *) clientData; + + /* + * Free up all the stuff that requires special handling, then + * let Ck_FreeOptions handle all the standard option-related + * stuff. + */ + + if (mbPtr->textVarName != NULL) { + Tcl_UntraceVar(mbPtr->interp, mbPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuButtonTextVarProc, (ClientData) mbPtr); + } + Ck_FreeOptions(configSpecs, (char *) mbPtr, 0); + ckfree((char *) mbPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureMenuButton -- + * + * This procedure is called to process an argv/argc list, plus + * the Tk option database, in order to configure (or + * reconfigure) a menubutton widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as text string, colors, font, + * etc. get set for mbPtr; old resources get freed, if there + * were any. The menubutton is redisplayed. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureMenuButton(interp, mbPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + register MenuButton *mbPtr; /* 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. */ +{ + int result; + + /* + * Eliminate any existing trace on variables monitored by the menubutton. + */ + + if (mbPtr->textVarName != NULL) { + Tcl_UntraceVar(interp, mbPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuButtonTextVarProc, (ClientData) mbPtr); + } + + result = Ck_ConfigureWidget(interp, mbPtr->winPtr, configSpecs, + argc, argv, (char *) mbPtr, flags); + if (result != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few options need special processing, such as setting the + * background from a 3-D border, or filling in complicated + * defaults that couldn't be specified to Tk_ConfigureWidget. + */ + + if ((mbPtr->state != ckNormalUid) && (mbPtr->state != ckActiveUid) + && (mbPtr->state != ckDisabledUid)) { + Tcl_AppendResult(interp, "bad state value \"", mbPtr->state, + "\": must be normal, active, or disabled", (char *) NULL); + mbPtr->state = ckNormalUid; + return TCL_ERROR; + } + + if (mbPtr->textVarName != NULL) { + /* + * The menubutton displays a variable. Set up a trace to watch + * for any changes in it. + */ + + char *value; + + value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY); + if (value == NULL) { + Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text, + TCL_GLOBAL_ONLY); + } else { + if (mbPtr->text != NULL) { + ckfree(mbPtr->text); + } + mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); + strcpy(mbPtr->text, value); + } + Tcl_TraceVar(interp, mbPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuButtonTextVarProc, (ClientData) mbPtr); + } + + ComputeMenuButtonGeometry(mbPtr); + + /* + * Lastly, arrange for the button to be redisplayed. + */ + + if ((mbPtr->winPtr->flags & CK_MAPPED) + && !(mbPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayMenuButton, (ClientData) mbPtr); + mbPtr->flags |= REDRAW_PENDING; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * DisplayMenuButton -- + * + * This procedure is invoked to display a menubutton widget. + * + * Results: + * None. + * + * Side effects: + * Commands are output to X to display the menubutton in its + * current mode. + * + *---------------------------------------------------------------------- + */ + +static void +DisplayMenuButton(clientData) + ClientData clientData; /* Information about widget. */ +{ + MenuButton *mbPtr = (MenuButton *) clientData; + int x, y, fg, bg, attr, textWidth, charWidth; + CkWindow *winPtr = mbPtr->winPtr; + + mbPtr->flags &= ~REDRAW_PENDING; + if ((mbPtr->winPtr == NULL) || !(winPtr->flags & CK_MAPPED)) { + return; + } + + if (mbPtr->state == ckDisabledUid) { + fg = mbPtr->disabledFg; + bg = mbPtr->disabledBg; + attr = mbPtr->disabledAttr; + } else if (mbPtr->state == ckActiveUid) { + fg = mbPtr->activeFg; + bg = mbPtr->activeBg; + attr = mbPtr->activeAttr; + } else { + fg = mbPtr->normalFg; + bg = mbPtr->normalBg; + attr = mbPtr->normalAttr; + } + + /* + * Display text for button. + */ + + if (mbPtr->text != NULL) + CkMeasureChars(winPtr->mainPtr, mbPtr->text, mbPtr->numChars, 0, + winPtr->width, 0, CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS, + &textWidth, &charWidth); + else + textWidth = 0; + + switch (mbPtr->anchor) { + case CK_ANCHOR_NW: case CK_ANCHOR_W: case CK_ANCHOR_SW: + x = 0; + break; + case CK_ANCHOR_N: case CK_ANCHOR_CENTER: case CK_ANCHOR_S: + x = (winPtr->width - textWidth) / 2; + if (mbPtr->indicatorOn) + x--; + break; + default: + x = winPtr->width - textWidth; + if (mbPtr->indicatorOn) + x -= 2; + break; + } + if (x + textWidth > winPtr->width) + textWidth = winPtr->width - x; + + switch (mbPtr->anchor) { + case CK_ANCHOR_NW: case CK_ANCHOR_N: case CK_ANCHOR_NE: + y = 0; + break; + case CK_ANCHOR_W: case CK_ANCHOR_CENTER: case CK_ANCHOR_E: + y = (winPtr->height - 1) / 2; + break; + default: + y = winPtr->height - 1; + if (y < 0) + y = 0; + break; + } + + Ck_SetWindowAttr(winPtr, fg, bg, attr); + Ck_ClearToBot(winPtr, 0, 0); + if (mbPtr->text != NULL) { + CkDisplayChars(winPtr->mainPtr, winPtr->window, mbPtr->text, + charWidth, x, y, + 0, CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS); + if (mbPtr->underline >= 0 && mbPtr->state == ckNormalUid) { + Ck_SetWindowAttr(winPtr, mbPtr->underlineFg, bg, + mbPtr->underlineAttr); + CkUnderlineChars(winPtr->mainPtr, winPtr->window, + mbPtr->text, charWidth, x, y, + 0, CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS, + mbPtr->underline, mbPtr->underline); + Ck_SetWindowAttr(winPtr, fg, bg, attr); + } + } + if (mbPtr->indicatorOn) { + int gchar; + + x = textWidth + 2; + if (x >= winPtr->width) + x = winPtr->width - 1; + Ck_GetGChar(mbPtr->interp, "diamond", &gchar); + Ck_SetWindowAttr(winPtr, mbPtr->indicatorFg, bg, attr); + mvwaddch(winPtr->window, y, x, gchar); + } + Ck_SetWindowAttr(winPtr, fg, bg, attr); + wmove(winPtr->window, y, x); + Ck_EventuallyRefresh(winPtr); +} + +/* + *-------------------------------------------------------------- + * + * MenuButtonEventProc -- + * + * This procedure is invoked by the Tk dispatcher for various + * events on buttons. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +MenuButtonEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + MenuButton *mbPtr = (MenuButton *) clientData; + + if (eventPtr->type == CK_EV_EXPOSE) { + if (mbPtr->winPtr != NULL && !(mbPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayMenuButton, (ClientData) mbPtr); + mbPtr->flags |= REDRAW_PENDING; + } + } else if (eventPtr->type == CK_EV_DESTROY) { + if (mbPtr->winPtr != NULL) { + mbPtr->winPtr = NULL; + Tcl_DeleteCommand(mbPtr->interp, + Tcl_GetCommandName(mbPtr->interp, mbPtr->widgetCmd)); + } + if (mbPtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayMenuButton, (ClientData) mbPtr); + } + Ck_EventuallyFree((ClientData) mbPtr, + (Ck_FreeProc *) DestroyMenuButton); + } +} + +/* + *---------------------------------------------------------------------- + * + * MenuButtonCmdDeletedProc -- + * + * 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 +MenuButtonCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + MenuButton *mbPtr = (MenuButton *) clientData; + CkWindow *winPtr = mbPtr->winPtr; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case winPtr + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (winPtr != NULL) { + mbPtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ComputeMenuButtonGeometry -- + * + * After changes in a menu button's text or bitmap, this procedure + * recomputes the menu button's geometry and passes this information + * along to the geometry manager for the window. + * + * Results: + * None. + * + * Side effects: + * The menu button's window may change size. + * + *---------------------------------------------------------------------- + */ + +static void +ComputeMenuButtonGeometry(mbPtr) + register MenuButton *mbPtr; /* Widget record for menu button. */ +{ + int width, height, dummy; + CkWindow *winPtr = mbPtr->winPtr; + + mbPtr->numChars = mbPtr->text == NULL ? 0 : strlen(mbPtr->text); + if (mbPtr->height > 0) + height = mbPtr->height; + else + height = 1; + if (mbPtr->width > 0) + width = mbPtr->width; + else + CkMeasureChars(winPtr->mainPtr, mbPtr->text == NULL ? "" : mbPtr->text, + mbPtr->numChars, 0, 100000, 0, + CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS, + &width, &dummy); + + /* + * When issuing the geometry request, add extra space for the indicator + * if any. + */ + + if (mbPtr->indicatorOn) + width += 2; + + Ck_GeometryRequest(mbPtr->winPtr, width, height); +} + +/* + *-------------------------------------------------------------- + * + * MenuButtonTextVarProc -- + * + * This procedure is invoked when someone changes the variable + * whose contents are to be displayed in a menu button. + * + * Results: + * NULL is always returned. + * + * Side effects: + * The text displayed in the menu button will change to match the + * variable. + * + *-------------------------------------------------------------- + */ + +static char * +MenuButtonTextVarProc(clientData, interp, name1, name2, flags) + ClientData clientData; /* Information about button. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Name of variable. */ + char *name2; /* Second part of variable name. */ + int flags; /* Information about what happened. */ +{ + register MenuButton *mbPtr = (MenuButton *) clientData; + char *value; + + /* + * If the variable is unset, then immediately recreate it unless + * the whole interpreter is going away. + */ + + if (flags & TCL_TRACE_UNSETS) { + if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text, + TCL_GLOBAL_ONLY); + Tcl_TraceVar(interp, mbPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuButtonTextVarProc, clientData); + } + return (char *) NULL; + } + + value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY); + if (value == NULL) { + value = ""; + } + if (mbPtr->text != NULL) { + ckfree(mbPtr->text); + } + mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); + strcpy(mbPtr->text, value); + ComputeMenuButtonGeometry(mbPtr); + + if ((mbPtr->winPtr != NULL) && (mbPtr->winPtr->flags & CK_MAPPED) + && !(mbPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayMenuButton, (ClientData) mbPtr); + mbPtr->flags |= REDRAW_PENDING; + } + return (char *) NULL; +} diff --git a/ckMessage.c b/ckMessage.c new file mode 100644 index 0000000..dc4d92a --- /dev/null +++ b/ckMessage.c @@ -0,0 +1,792 @@ +/* + * ckMessage.c -- + * + * This module implements a message widgets for the + * toolkit. A message widget displays a multi-line string + * in a window according to a particular aspect ratio. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +/* + * A data structure of the following type is kept for each message + * widget managed by this file: + */ + +typedef struct { + CkWindow *winPtr; /* Window that embodies the message. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with message. */ + Tcl_Command widgetCmd; /* Token for message's widget command. */ + char *string; /* String displayed in message. */ + int numChars; /* Number of characters in string, not + * including terminating NULL character. */ + char *textVarName; /* Name of variable (malloc'ed) or NULL. + * If non-NULL, message displays the contents + * of this variable. */ + + /* + * Information used when displaying widget: + */ + + int bg, fg; /* Foreground and background colors. */ + int attr; /* Video attributes. */ + Ck_Anchor anchor; /* Where to position text within window region + * if window is larger or smaller than + * needed. */ + int width; /* User-requested width. 0 means compute + * width using aspect ratio below. */ + int aspect; /* Desired aspect ratio for window + * (100*width/height). */ + int lineLength; /* Length of each line. Computed + * from width and/or aspect. */ + int msgHeight; /* Total lines needed to display message. */ + Ck_Justify justify; /* Justification for text. */ + + /* + * Miscellaneous information: + */ + + char *takeFocus; /* Value of -takefocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + int flags; /* Various flags; see below for + * definitions. */ +} Message; + +/* + * Flag bits for messages: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler + * has already been queued to redraw + * this window. + */ + +#define REDRAW_PENDING 1 + +/* + * Information used for argv parsing. + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", + DEF_MESSAGE_ANCHOR, Ck_Offset(Message, anchor), 0}, + {CK_CONFIG_INT, "-aspect", "aspect", "Aspect", + DEF_MESSAGE_ASPECT, Ck_Offset(Message, aspect), 0}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_MESSAGE_ATTR, Ck_Offset(Message, attr), 0}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_MESSAGE_BG_COLOR, Ck_Offset(Message, bg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_MESSAGE_BG_MONO, Ck_Offset(Message, bg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_MESSAGE_FG_COLOR, Ck_Offset(Message, fg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_MESSAGE_FG_MONO, Ck_Offset(Message, fg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", + DEF_MESSAGE_JUSTIFY, Ck_Offset(Message, justify), 0}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_MESSAGE_TAKE_FOCUS, Ck_Offset(Message, takeFocus), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-text", "text", "Text", + DEF_MESSAGE_TEXT, Ck_Offset(Message, string), 0}, + {CK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", + DEF_MESSAGE_TEXT_VARIABLE, Ck_Offset(Message, textVarName), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_COORD, "-width", "width", "Width", + DEF_MESSAGE_WIDTH, Ck_Offset(Message, width), 0}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void MessageEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static char * MessageTextVarProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); +static int MessageWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static void MessageCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void ComputeMessageGeometry _ANSI_ARGS_((Message *msgPtr)); +static int ConfigureMessage _ANSI_ARGS_((Tcl_Interp *interp, + Message *msgPtr, int argc, char **argv, + int flags)); +static void DestroyMessage _ANSI_ARGS_((ClientData clientData)); +static void DisplayMessage _ANSI_ARGS_((ClientData clientData)); + +/* + *-------------------------------------------------------------- + * + * Ck_MessageCmd -- + * + * This procedure is invoked to process the "message" Tcl + * command. See the user documentation for details on what + * it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_MessageCmd(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. */ +{ + register Message *msgPtr; + CkWindow *new; + CkWindow *mainPtr = (CkWindow *) clientData; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + new = Ck_CreateWindowFromPath(interp, mainPtr, argv[1], 0); + if (new == NULL) { + return TCL_ERROR; + } + + msgPtr = (Message *) ckalloc(sizeof (Message)); + msgPtr->winPtr = new; + msgPtr->interp = interp; + msgPtr->widgetCmd = Tcl_CreateCommand(interp, + msgPtr->winPtr->pathName, MessageWidgetCmd, + (ClientData) msgPtr, MessageCmdDeletedProc); + msgPtr->string = NULL; + msgPtr->numChars = 0; + msgPtr->textVarName = NULL; + msgPtr->bg = 0; + msgPtr->fg = 0; + msgPtr->attr = 0; + msgPtr->anchor = CK_ANCHOR_CENTER; + msgPtr->width = 0; + msgPtr->aspect = 150; + msgPtr->lineLength = 0; + msgPtr->msgHeight = 0; + msgPtr->justify = CK_JUSTIFY_LEFT; + msgPtr->takeFocus = NULL; + msgPtr->flags = 0; + + Ck_SetClass(msgPtr->winPtr, "Message"); + Ck_CreateEventHandler(msgPtr->winPtr, + CK_EV_EXPOSE | CK_EV_MAP | CK_EV_DESTROY, + MessageEventProc, (ClientData) msgPtr); + if (ConfigureMessage(interp, msgPtr, argc-2, argv+2, 0) != TCL_OK) { + goto error; + } + + interp->result = msgPtr->winPtr->pathName; + return TCL_OK; + +error: + Ck_DestroyWindow(msgPtr->winPtr); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * MessageWidgetCmd -- + * + * 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. + * + *-------------------------------------------------------------- + */ + +static int +MessageWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about message widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + register Message *msgPtr = (Message *) clientData; + size_t length; + int c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + 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); + return TCL_ERROR; + } + return Ck_ConfigureValue(interp, msgPtr->winPtr, configSpecs, + (char *) msgPtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 2)) { + if (argc == 2) { + return Ck_ConfigureInfo(interp, msgPtr->winPtr, configSpecs, + (char *) msgPtr, (char *) NULL, 0); + } else if (argc == 3) { + return Ck_ConfigureInfo(interp, msgPtr->winPtr, configSpecs, + (char *) msgPtr, argv[2], 0); + } else { + return ConfigureMessage(interp, msgPtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be cget or configure", (char *) NULL); + return TCL_ERROR; + } +} + +/* + *---------------------------------------------------------------------- + * + * DestroyMessage -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a message at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the message is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyMessage(clientData) + ClientData clientData; /* Info about message widget. */ +{ + register Message *msgPtr = (Message *) clientData; + + /* + * Free up all the stuff that requires special handling, then + * let Ck_FreeOptions handle all the standard option-related + * stuff. + */ + + if (msgPtr->textVarName != NULL) { + Tcl_UntraceVar(msgPtr->interp, msgPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MessageTextVarProc, (ClientData) msgPtr); + } + Ck_FreeOptions(configSpecs, (char *) msgPtr, 0); + ckfree((char *) msgPtr); +} + +/* + *---------------------------------------------------------------------- + * + * MessageCmdDeletedProc -- + * + * 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 +MessageCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + Message *msgPtr = (Message *) clientData; + CkWindow *winPtr = msgPtr->winPtr; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case winPtr + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (winPtr != NULL) { + msgPtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureMessage -- + * + * This procedure is called to process an argv/argc list, plus + * the option database, in order to configure (or + * reconfigure) a message widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as text string, colors, + * etc. get set for msgPtr; old resources get freed, if there + * were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureMessage(interp, msgPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + register Message *msgPtr; /* 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. */ +{ + /* + * Eliminate any existing trace on a variable monitored by the message. + */ + + if (msgPtr->textVarName != NULL) { + Tcl_UntraceVar(interp, msgPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MessageTextVarProc, (ClientData) msgPtr); + } + + if (Ck_ConfigureWidget(interp, msgPtr->winPtr, configSpecs, + argc, argv, (char *) msgPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * If the message is to display the value of a variable, then set up + * a trace on the variable's value, create the variable if it doesn't + * exist, and fetch its current value. + */ + + if (msgPtr->textVarName != NULL) { + char *value; + + value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY); + if (value == NULL) { + Tcl_SetVar(interp, msgPtr->textVarName, + msgPtr->string == NULL ? "" : msgPtr->string, + TCL_GLOBAL_ONLY); + } else { + if (msgPtr->string != NULL) { + ckfree(msgPtr->string); + } + msgPtr->string = (char *) ckalloc((unsigned) (strlen(value) + 1)); + strcpy(msgPtr->string, value); + } + Tcl_TraceVar(interp, msgPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MessageTextVarProc, (ClientData) msgPtr); + } + + /* + * A few other options need special processing, such as setting + * the background from a 3-D border or handling special defaults + * that couldn't be specified to Tk_ConfigureWidget. + */ + + if (msgPtr->string == NULL) { + msgPtr->string = ckalloc(1); + msgPtr->string[0] = '\0'; + } + msgPtr->numChars = strlen(msgPtr->string); + + /* + * Recompute the desired geometry for the window, and arrange for + * the window to be redisplayed. + */ + + ComputeMessageGeometry(msgPtr); + if ((msgPtr->winPtr != NULL) && (msgPtr->winPtr->flags & CK_MAPPED) + && !(msgPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayMessage, (ClientData) msgPtr); + msgPtr->flags |= REDRAW_PENDING; + } + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * ComputeMessageGeometry -- + * + * Compute the desired geometry for a message window, + * taking into account the desired aspect ratio for the + * window. + * + * Results: + * None. + * + * Side effects: + * Ck_GeometryRequest is called to inform the geometry + * manager of the desired geometry for this window. + * + *-------------------------------------------------------------- + */ + +static void +ComputeMessageGeometry(msgPtr) + register Message *msgPtr; /* Information about window. */ +{ + char *p; + int width, inc, height, numLines; + int thisWidth, maxWidth; + int aspect, lowerBound, upperBound, dummy; + CkWindow *winPtr = msgPtr->winPtr; + + /* + * Compute acceptable bounds for the final aspect ratio. + */ + + aspect = msgPtr->aspect/10; + if (aspect < 5) { + aspect = 5; + } + lowerBound = msgPtr->aspect - aspect; + upperBound = msgPtr->aspect + aspect; + + /* + * Do the computation in multiple passes: start off with + * a very wide window, and compute its height. Then change + * the width and try again. Reduce the size of the change + * and iterate until dimensions are found that approximate + * the desired aspect ratio. Or, if the user gave an explicit + * width then just use that. + */ + + if (msgPtr->width > 0) { + width = msgPtr->width; + inc = 0; + } else { + width = msgPtr->winPtr->mainPtr->winPtr->width; + inc = width/2; + } + for ( ; ; inc /= 2) { + maxWidth = 0; + for (numLines = 1, p = msgPtr->string; ; numLines++) { + if (*p == '\n') { + p++; + continue; + } +#if CK_USE_UTF + CkMeasureChars(winPtr->mainPtr, p, + msgPtr->numChars - (p - msgPtr->string), + 0, width, 0, CK_WHOLE_WORDS|CK_AT_LEAST_ONE, &thisWidth, + &dummy); + p += dummy; +#else + p += CkMeasureChars(winPtr->mainPtr, p, + msgPtr->numChars - (p - msgPtr->string), + 0, width, 0, CK_WHOLE_WORDS|CK_AT_LEAST_ONE, &thisWidth, + &dummy); +#endif + if (thisWidth > maxWidth) { + maxWidth = thisWidth; + } + if (*p == 0) { + break; + } + + /* + * Skip spaces and tabs at the beginning of a line, unless + * they follow a user-requested newline. + */ + + while (isspace((unsigned char) (*p))) { + if (*p == '\n') { + p++; + break; + } + p++; + } + } + + height = numLines; + if (inc <= 2) { + break; + } + aspect = (100 * maxWidth) / height; + if (aspect < lowerBound) { + width += inc; + } else if (aspect > upperBound) { + width -= inc; + } else { + break; + } + } + msgPtr->lineLength = maxWidth; + msgPtr->msgHeight = numLines; + Ck_GeometryRequest(msgPtr->winPtr, maxWidth, height); +} + +/* + *-------------------------------------------------------------- + * + * DisplayMessage -- + * + * This procedure redraws the contents of a message window. + * + * Results: + * None. + * + * Side effects: + * Information appears on the screen. + * + *-------------------------------------------------------------- + */ + +static void +DisplayMessage(clientData) + ClientData clientData; /* Information about window. */ +{ + register Message *msgPtr = (Message *) clientData; + register CkWindow *winPtr = msgPtr->winPtr; + char *p; + int x, y, lineLength, numChars, charsLeft, dummy; + + msgPtr->flags &= ~REDRAW_PENDING; + if (msgPtr->winPtr == NULL || !(winPtr->flags & CK_MAPPED)) { + return; + } + + Ck_SetWindowAttr(winPtr, msgPtr->fg, msgPtr->bg, msgPtr->attr); + Ck_ClearToBot(winPtr, 0, 0); + + /* + * Compute starting y-location for message based on message size + * and anchor option. + */ + + switch (msgPtr->anchor) { + case CK_ANCHOR_NW: case CK_ANCHOR_N: case CK_ANCHOR_NE: + y = 0; + break; + case CK_ANCHOR_W: case CK_ANCHOR_CENTER: case CK_ANCHOR_E: + y = (winPtr->height - msgPtr->msgHeight) / 2; + break; + default: + y = winPtr->height - msgPtr->msgHeight; + break; + } + if (y < 0) { + y = 0; + } + + /* + * Work through the string to display one line at a time. + * Display each line in three steps. First compute the + * line's width, then figure out where to display the + * line to justify it properly, then display the line. + */ + + for (p = msgPtr->string, charsLeft = msgPtr->numChars; *p != 0; y++) { + if (*p == '\n') { + p++; + charsLeft--; + continue; + } + numChars = CkMeasureChars(winPtr->mainPtr, p, charsLeft, 0, + msgPtr->lineLength, + 0, CK_WHOLE_WORDS | CK_AT_LEAST_ONE, &lineLength, &dummy); + switch (msgPtr->anchor) { + case CK_ANCHOR_NW: case CK_ANCHOR_W: case CK_ANCHOR_SW: + x = 0; + break; + case CK_ANCHOR_N: case CK_ANCHOR_CENTER: case CK_ANCHOR_S: + x = (winPtr->width - msgPtr->lineLength) / 2; + break; + default: + x = winPtr->width - msgPtr->lineLength; + break; + } + if (msgPtr->justify == CK_JUSTIFY_CENTER) { + x += (msgPtr->lineLength - lineLength) / 2; + } else if (msgPtr->justify == CK_JUSTIFY_RIGHT) { + x += msgPtr->lineLength - lineLength; + } +#if 0 + if (x < 0) { + x = 0; + } +#endif + CkDisplayChars(winPtr->mainPtr, winPtr->window, p, numChars, + x, y, x, 0); + p += numChars; + charsLeft -= numChars; + + /* + * Skip blanks at the beginning of a line, unless they follow + * a user-requested newline. + */ + + while (isspace((unsigned char) (*p))) { + charsLeft--; + if (*p == '\n') { + p++; + break; + } + p++; + } + } + Ck_EventuallyRefresh(winPtr); +} + +/* + *-------------------------------------------------------------- + * + * MessageEventProc -- + * + * This procedure is invoked by the Tk dispatcher for various + * events on messages. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +MessageEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + Message *msgPtr = (Message *) clientData; + + if (eventPtr->type == CK_EV_EXPOSE) { + if (msgPtr->winPtr != NULL && !(msgPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayMessage, (ClientData) msgPtr); + msgPtr->flags |= REDRAW_PENDING; + } + } else if (eventPtr->type == CK_EV_DESTROY) { + if (msgPtr->winPtr != NULL) { + msgPtr->winPtr = NULL; + Tcl_DeleteCommand(msgPtr->interp, + Tcl_GetCommandName(msgPtr->interp, msgPtr->widgetCmd)); + } + if (msgPtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayMessage, (ClientData) msgPtr); + } + Ck_EventuallyFree((ClientData) msgPtr, (Ck_FreeProc *) DestroyMessage); + } +} + +/* + *-------------------------------------------------------------- + * + * MessageTextVarProc -- + * + * This procedure is invoked when someone changes the variable + * whose contents are to be displayed in a message. + * + * Results: + * NULL is always returned. + * + * Side effects: + * The text displayed in the message will change to match the + * variable. + * + *-------------------------------------------------------------- + */ + +static char * +MessageTextVarProc(clientData, interp, name1, name2, flags) + ClientData clientData; /* Information about message. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Name of variable. */ + char *name2; /* Second part of variable name. */ + int flags; /* Information about what happened. */ +{ + register Message *msgPtr = (Message *) clientData; + char *value; + + /* + * If the variable is unset, then immediately recreate it unless + * the whole interpreter is going away. + */ + + if (flags & TCL_TRACE_UNSETS) { + if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + Tcl_SetVar(interp, msgPtr->textVarName, + msgPtr->string == NULL ? "" : msgPtr->string, + TCL_GLOBAL_ONLY); + Tcl_TraceVar(interp, msgPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MessageTextVarProc, clientData); + } + return (char *) NULL; + } + + value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY); + if (value == NULL) { + value = ""; + } + if (msgPtr->string != NULL) { + ckfree(msgPtr->string); + } + msgPtr->numChars = strlen(value); + msgPtr->string = (char *) ckalloc((unsigned) (msgPtr->numChars + 1)); + strcpy(msgPtr->string, value); + ComputeMessageGeometry(msgPtr); + + if ((msgPtr->winPtr != NULL) && (msgPtr->winPtr->flags & CK_MAPPED) + && !(msgPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayMessage, (ClientData) msgPtr); + msgPtr->flags |= REDRAW_PENDING; + } + return (char *) NULL; +} diff --git a/ckOption.c b/ckOption.c new file mode 100644 index 0000000..74ff6ba --- /dev/null +++ b/ckOption.c @@ -0,0 +1,1349 @@ +/* + * ckOption.c -- + * + * This module contains procedures to manage the option + * database, which allows various strings to be associated + * with windows either by name or by class or both. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * The option database is stored as one tree for each main window. + * Each name or class field in an option is associated with a node or + * leaf of the tree. For example, the options "x.y.z" and "x.y*a" + * each correspond to three nodes in the tree; they share the nodes + * "x" and "x.y", but have different leaf nodes. One of the following + * structures exists for each node or leaf in the option tree. It is + * actually stored as part of the parent node, and describes a particular + * child of the parent. + */ + +typedef struct Element { + Ck_Uid nameUid; /* Name or class from one element of + * an option spec. */ + union { + struct ElArray *arrayPtr; /* If this is an intermediate node, + * a pointer to a structure describing + * the remaining elements of all + * options whose prefixes are the + * same up through this element. */ + Ck_Uid valueUid; /* For leaf nodes, this is the string + * value of the option. */ + } child; + int priority; /* Used to select among matching + * options. Includes both the + * priority level and a serial #. + * Greater value means higher + * priority. Irrelevant except in + * leaf nodes. */ + int flags; /* OR-ed combination of bits. See + * below for values. */ +} Element; + +/* + * Flags in Element structures: + * + * CLASS - Non-zero means this element refers to a class, + * Zero means this element refers to a name. + * NODE - Zero means this is a leaf element (the child + * field is a value, not a pointer to another node). + * One means this is a node element. + * WILDCARD - Non-zero means this there was a star in the + * original specification just before this element. + * Zero means there was a dot. + */ + +#define TYPE_MASK 0x7 + +#define CLASS 0x1 +#define NODE 0x2 +#define WILDCARD 0x4 + +#define EXACT_LEAF_NAME 0x0 +#define EXACT_LEAF_CLASS 0x1 +#define EXACT_NODE_NAME 0x2 +#define EXACT_NODE_CLASS 0x3 +#define WILDCARD_LEAF_NAME 0x4 +#define WILDCARD_LEAF_CLASS 0x5 +#define WILDCARD_NODE_NAME 0x6 +#define WILDCARD_NODE_CLASS 0x7 + +/* + * The following structure is used to manage a dynamic array of + * Elements. These structures are used for two purposes: to store + * the contents of a node in the option tree, and for the option + * stacks described below. + */ + +typedef struct ElArray { + int arraySize; /* Number of elements actually + * allocated in the "els" array. */ + int numUsed; /* Number of elements currently in + * use out of els. */ + Element *nextToUse; /* Pointer to &els[numUsed]. */ + Element els[1]; /* Array of structures describing + * children of this node. The + * array will actually contain enough + * elements for all of the children + * (and even a few extras, perhaps). + * This must be the last field in + * the structure. */ +} ElArray; + +#define EL_ARRAY_SIZE(numEls) ((unsigned) (sizeof(ElArray) \ + + ((numEls)-1)*sizeof(Element))) +#define INITIAL_SIZE 5 + +/* + * In addition to the option tree, which is a relatively static structure, + * there are eight additional structures called "stacks", which are used + * to speed up queries into the option database. The stack structures + * are designed for the situation where an individual widget makes repeated + * requests for its particular options. The requests differ only in + * their last name/class, so during the first request we extract all + * the options pertaining to the particular widget and save them in a + * stack-like cache; subsequent requests for the same widget can search + * the cache relatively quickly. In fact, the cache is a hierarchical + * one, storing a list of relevant options for this widget and all of + * its ancestors up to the application root; hence the name "stack". + * + * Each of the eight stacks consists of an array of Elements, ordered in + * terms of levels in the window hierarchy. All the elements relevant + * for the top-level widget appear first in the array, followed by all + * those from the next-level widget on the path to the current widget, + * etc. down to those for the current widget. + * + * Cached information is divided into eight stacks according to the + * CLASS, NODE, and WILDCARD flags. Leaf and non-leaf information is + * kept separate to speed up individual probes (non-leaf information is + * only relevant when building the stacks, but isn't relevant when + * making probes; similarly, only non-leaf information is relevant + * when the stacks are being extended to the next widget down in the + * widget hierarchy). Wildcard elements are handled separately from + * "exact" elements because once they appear at a particular level in + * the stack they remain active for all deeper levels; exact elements + * are only relevant at a particular level. For example, when searching + * for options relevant in a particular window, the entire wildcard + * stacks get checked, but only the portions of the exact stacks that + * pertain to the window's parent. Lastly, name and class stacks are + * kept separate because different search keys are used when searching + * them; keeping them separate speeds up the searches. + */ + +#define NUM_STACKS 8 +static ElArray *stacks[NUM_STACKS]; +static CkWindow *cachedWindow = NULL; /* Lowest-level window currently + * loaded in stacks at present. + * NULL means stacks have never + * been used, or have been + * invalidated because of a change + * to the database. */ + +/* + * One of the following structures is used to keep track of each + * level in the stacks. + */ + +typedef struct StackLevel { + CkWindow *winPtr; /* Window corresponding to this stack + * level. */ + int bases[NUM_STACKS]; /* For each stack, index of first + * element on stack corresponding to + * this level (used to restore "numUsed" + * fields when popping out of a level. */ +} StackLevel; + +/* + * Information about all of the stack levels that are currently + * active. This array grows dynamically to become as large as needed. + */ + +static StackLevel *levels = NULL; + /* Array describing current stack. */ +static int numLevels = 0; /* Total space allocated. */ +static int curLevel = -1; /* Highest level currently in use. Note: + * curLevel is never 0! (I don't remember + * why anymore...) */ + +/* + * The variable below is a serial number for all options entered into + * the database so far. It increments on each addition to the option + * database. It is used in computing option priorities, so that the + * most recent entry wins when choosing between options at the same + * priority level. + */ + +static int serial = 0; + +/* + * Special "no match" Element to use as default for searches. + */ + +static Element defaultMatch; + +/* + * Forward declarations for procedures defined in this file: + */ + +static int AddFromString _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, char *string, int priority)); +static void ClearOptionTree _ANSI_ARGS_((ElArray *arrayPtr)); +static ElArray * ExtendArray _ANSI_ARGS_((ElArray *arrayPtr, + Element *elPtr)); +static void ExtendStacks _ANSI_ARGS_((ElArray *arrayPtr, + int leaf)); +static ElArray * NewArray _ANSI_ARGS_((int numEls)); +static void OptionInit _ANSI_ARGS_((CkMainInfo *mainPtr)); +static int ParsePriority _ANSI_ARGS_((Tcl_Interp *interp, + char *string)); +static int ReadOptionFile _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, char *fileName, int priority)); +static void SetupStacks _ANSI_ARGS_((CkWindow *winPtr, int leaf)); + +/* + *-------------------------------------------------------------- + * + * Ck_AddOption -- + * + * Add a new option to the option database. + * + * Results: + * None. + * + * Side effects: + * Information is added to the option database. + * + *-------------------------------------------------------------- + */ + +void +Ck_AddOption(winPtr, name, value, priority) + CkWindow *winPtr; /* Window pointer; option will be associated + * with main window for this window. */ + char *name; /* Multi-element name of option. */ + char *value; /* String value for option. */ + int priority; /* Overall priority level to use for + * this option, such as CK_USER_DEFAULT_PRIO + * or CK_INTERACTIVE_PRIO. Must be between + * 0 and CK_MAX_PRIO. */ +{ + register ElArray **arrayPtrPtr; + register Element *elPtr; + Element newEl; + register char *p; + char *field; + int count, firstField, length; +#define TMP_SIZE 100 + char tmp[TMP_SIZE+1]; + + winPtr = winPtr->mainPtr->winPtr; + + if (winPtr->mainPtr->optionRootPtr == NULL) { + OptionInit(winPtr->mainPtr); + } + cachedWindow = NULL; /* Invalidate the cache. */ + + /* + * Compute the priority for the new element, including both the + * overall level and the serial number (to disambiguate with the + * level). + */ + + if (priority < 0) { + priority = 0; + } else if (priority > CK_MAX_PRIO) { + priority = CK_MAX_PRIO; + } + newEl.priority = (priority << 24) + serial; + serial++; + + /* + * Parse the option one field at a time. + */ + + arrayPtrPtr = &(winPtr->mainPtr->optionRootPtr); + p = name; + for (firstField = 1; ; firstField = 0) { + + /* + * Scan the next field from the name and convert it to a Tk_Uid. + * Must copy the field before calling Tk_Uid, so that a terminating + * NULL may be added without modifying the source string. + */ + + if (*p == '*') { + newEl.flags = WILDCARD; + p++; + } else { + newEl.flags = 0; + } + field = p; + while ((*p != 0) && (*p != '.') && (*p != '*')) { + p++; + } + length = p - field; + if (length > TMP_SIZE) { + length = TMP_SIZE; + } + strncpy(tmp, field, (size_t) length); + tmp[length] = 0; + newEl.nameUid = Ck_GetUid(tmp); + if (isupper((unsigned char) *field)) { + newEl.flags |= CLASS; + } + + if (*p != 0) { + + /* + * New element will be a node. If this option can't possibly + * apply to this main window, then just skip it. Otherwise, + * add it to the parent, if it isn't already there, and descend + * into it. + */ + + newEl.flags |= NODE; + if (firstField && !(newEl.flags & WILDCARD) + && (newEl.nameUid != winPtr->nameUid) + && (newEl.nameUid != winPtr->classUid)) { + return; + } + for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed; + ; elPtr++, count--) { + if (count == 0) { + newEl.child.arrayPtr = NewArray(5); + *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl); + arrayPtrPtr = &((*arrayPtrPtr)->nextToUse[-1].child.arrayPtr); + break; + } + if ((elPtr->nameUid == newEl.nameUid) + && (elPtr->flags == newEl.flags)) { + arrayPtrPtr = &(elPtr->child.arrayPtr); + break; + } + } + if (*p == '.') { + p++; + } + } else { + + /* + * New element is a leaf. Add it to the parent, if it isn't + * already there. If it exists already, keep whichever value + * has highest priority. + */ + + newEl.child.valueUid = Ck_GetUid(value); + for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed; + ; elPtr++, count--) { + if (count == 0) { + *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl); + return; + } + if ((elPtr->nameUid == newEl.nameUid) + && (elPtr->flags == newEl.flags)) { + if (elPtr->priority < newEl.priority) { + elPtr->priority = newEl.priority; + elPtr->child.valueUid = newEl.child.valueUid; + } + return; + } + } + } + } +} + +/* + *-------------------------------------------------------------- + * + * Ck_GetOption -- + * + * Retrieve an option from the option database. + * + * Results: + * The return value is the value specified in the option + * database for the given name and class on the given + * window. If there is nothing specified in the database + * for that option, then NULL is returned. + * + * Side effects: + * The internal caches used to speed up option mapping + * may be modified, if this tkwin is different from the + * last tkwin used for option retrieval. + * + *-------------------------------------------------------------- + */ + +Ck_Uid +Ck_GetOption(winPtr, name, className) + CkWindow *winPtr; /* Pointer to window that option is + * associated with. */ + char *name; /* Name of option. */ + char *className; /* Class of option. NULL means there + * is no class for this option: just + * check for name. */ +{ + Ck_Uid nameId, classId; + register Element *elPtr, *bestPtr; + register int count; + + /* + * Note: no need to call OptionInit here: it will be done by + * the SetupStacks call below (squeeze out those nanoseconds). + */ + + if (winPtr != cachedWindow) { + SetupStacks(winPtr, 1); + } + + nameId = Ck_GetUid(name); + bestPtr = &defaultMatch; + for (elPtr = stacks[EXACT_LEAF_NAME]->els, + count = stacks[EXACT_LEAF_NAME]->numUsed; count > 0; + elPtr++, count--) { + if ((elPtr->nameUid == nameId) + && (elPtr->priority > bestPtr->priority)) { + bestPtr = elPtr; + } + } + for (elPtr = stacks[WILDCARD_LEAF_NAME]->els, + count = stacks[WILDCARD_LEAF_NAME]->numUsed; count > 0; + elPtr++, count--) { + if ((elPtr->nameUid == nameId) + && (elPtr->priority > bestPtr->priority)) { + bestPtr = elPtr; + } + } + if (className != NULL) { + classId = Ck_GetUid(className); + for (elPtr = stacks[EXACT_LEAF_CLASS]->els, + count = stacks[EXACT_LEAF_CLASS]->numUsed; count > 0; + elPtr++, count--) { + if ((elPtr->nameUid == classId) + && (elPtr->priority > bestPtr->priority)) { + bestPtr = elPtr; + } + } + for (elPtr = stacks[WILDCARD_LEAF_CLASS]->els, + count = stacks[WILDCARD_LEAF_CLASS]->numUsed; count > 0; + elPtr++, count--) { + if ((elPtr->nameUid == classId) + && (elPtr->priority > bestPtr->priority)) { + bestPtr = elPtr; + } + } + } + return bestPtr->child.valueUid; +} + +/* + *-------------------------------------------------------------- + * + * Ck_OptionCmd -- + * + * This procedure is invoked to process the "option" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_OptionCmd(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. */ +{ + CkWindow *winPtr = (CkWindow *) clientData; + size_t length; + char c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " cmd arg ?arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)) { + int priority; + + if ((argc != 4) && (argc != 5)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " add pattern value ?priority?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 4) { + priority = CK_INTERACTIVE_PRIO; + } else { + priority = ParsePriority(interp, argv[4]); + if (priority < 0) { + return TCL_ERROR; + } + } + Ck_AddOption(winPtr, argv[2], argv[3], priority); + return TCL_OK; + } else if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) { + CkMainInfo *mainPtr; + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " clear\"", (char *) NULL); + return TCL_ERROR; + } + mainPtr = winPtr->mainPtr; + if (mainPtr->optionRootPtr != NULL) { + ClearOptionTree(mainPtr->optionRootPtr); + mainPtr->optionRootPtr = NULL; + } + cachedWindow = NULL; + return TCL_OK; + } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + CkWindow *winPtr2; + Ck_Uid value; + + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " get window name class\"", (char *) NULL); + return TCL_ERROR; + } + winPtr2 = Ck_NameToWindow(interp, argv[2], winPtr); + if (winPtr2 == NULL) { + return TCL_ERROR; + } + value = Ck_GetOption(winPtr2, argv[3], argv[4]); + if (value != NULL) { + interp->result = value; + } + return TCL_OK; + } else if ((c == 'r') && (strncmp(argv[1], "readfile", length) == 0)) { + int priority; + + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " readfile fileName ?priority?\"", + (char *) NULL); + return TCL_ERROR; + } + if (argc == 4) { + priority = ParsePriority(interp, argv[3]); + if (priority < 0) { + return TCL_ERROR; + } + } else { + priority = CK_INTERACTIVE_PRIO; + } + return ReadOptionFile(interp, winPtr, argv[2], priority); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be add, clear, get, or readfile", (char *) NULL); + return TCL_ERROR; + } +} + +/* + *-------------------------------------------------------------- + * + * CkOptionDeadWindow -- + * + * This procedure is called whenever a window is deleted. + * It cleans up any option-related stuff associated with + * the window. + * + * Results: + * None. + * + * Side effects: + * Option-related resources are freed. See code below + * for details. + * + *-------------------------------------------------------------- + */ + +void +CkOptionDeadWindow(winPtr) + register CkWindow *winPtr; /* Window to be cleaned up. */ +{ + /* + * If this window is in the option stacks, then clear the stacks. + */ + + if (winPtr->optionLevel != -1) { + int i; + + for (i = 1; i <= curLevel; i++) { + levels[i].winPtr->optionLevel = -1; + } + curLevel = -1; + cachedWindow = NULL; + } + + /* + * If this window was a main window, then delete its option + * database. + */ + + if ((winPtr->mainPtr->winPtr == winPtr) + && (winPtr->mainPtr->optionRootPtr != NULL)) { + ClearOptionTree(winPtr->mainPtr->optionRootPtr); + winPtr->mainPtr->optionRootPtr = NULL; + } +} + +/* + *---------------------------------------------------------------------- + * + * CkOptionClassChanged -- + * + * This procedure is invoked when a window's class changes. If + * the window is on the option cache, this procedure flushes + * any information for the window, since the new class could change + * what is relevant. + * + * Results: + * None. + * + * Side effects: + * The option cache may be flushed in part or in whole. + * + *---------------------------------------------------------------------- + */ + +void +CkOptionClassChanged(winPtr) + CkWindow *winPtr; /* Window whose class changed. */ +{ + int i, j, *basePtr; + ElArray *arrayPtr; + + if (winPtr->optionLevel == -1) { + return; + } + + /* + * Find the lowest stack level that refers to this window, then + * flush all of the levels above the matching one. + */ + + for (i = 1; i <= curLevel; i++) { + if (levels[i].winPtr == winPtr) { + for (j = i; j <= curLevel; j++) { + levels[j].winPtr->optionLevel = -1; + } + curLevel = i-1; + basePtr = levels[i].bases; + for (j = 0; j < NUM_STACKS; j++) { + arrayPtr = stacks[j]; + arrayPtr->numUsed = basePtr[j]; + arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed]; + } + if (curLevel <= 0) { + cachedWindow = NULL; + } else { + cachedWindow = levels[curLevel].winPtr; + } + break; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * ParsePriority -- + * + * Parse a string priority value. + * + * Results: + * The return value is the integer priority level corresponding + * to string, or -1 if string doesn't point to a valid priority level. + * In this case, an error message is left in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ParsePriority(interp, string) + Tcl_Interp *interp; /* Interpreter to use for error reporting. */ + char *string; /* Describes a priority level, either + * symbolically or numerically. */ +{ + int priority, c; + size_t length; + + c = string[0]; + length = strlen(string); + if ((c == 'w') + && (strncmp(string, "widgetDefault", length) == 0)) { + return CK_WIDGET_DEFAULT_PRIO; + } else if ((c == 's') + && (strncmp(string, "startupFile", length) == 0)) { + return CK_STARTUP_FILE_PRIO; + } else if ((c == 'u') + && (strncmp(string, "userDefault", length) == 0)) { + return CK_USER_DEFAULT_PRIO; + } else if ((c == 'i') + && (strncmp(string, "interactive", length) == 0)) { + return CK_INTERACTIVE_PRIO; + } else { + char *end; + + priority = strtoul(string, &end, 0); + if ((end == string) || (*end != 0) || (priority < 0) + || (priority > 100)) { + Tcl_AppendResult(interp, "bad priority level \"", string, + "\": must be widgetDefault, startupFile, userDefault, ", + "interactive, or a number between 0 and 100", + (char *) NULL); + return -1; + } + } + return priority; +} + +/* + *---------------------------------------------------------------------- + * + * AddFromString -- + * + * Given a string containing lines in the standard format for + * X resources (see other documentation for details on what this + * is), parse the resource specifications and enter them as options + * for tkwin's main window. + * + * Results: + * The return value is a standard Tcl return code. In the case of + * an error in parsing string, TCL_ERROR will be returned and an + * error message will be left in interp->result. The memory at + * string is totally trashed by this procedure. If you care about + * its contents, make a copy before calling here. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +AddFromString(interp, winPtr, string, priority) + Tcl_Interp *interp; /* Interpreter to use for reporting results. */ + CkWindow *winPtr; /* Pointer to window: options are entered + * for this window's main window. */ + char *string; /* String containing option specifiers. */ + int priority; /* Priority level to use for options in + * this string, such as TK_USER_DEFAULT_PRIO + * or TK_INTERACTIVE_PRIO. Must be between + * 0 and TK_MAX_PRIO. */ +{ + register char *src, *dst; + char *name, *value; + int lineNum; + + src = string; + lineNum = 1; + while (1) { + + /* + * Skip leading white space and empty lines and comment lines, and + * check for the end of the spec. + */ + + while ((*src == ' ') || (*src == '\t')) { + src++; + } + if ((*src == '#') || (*src == '!')) { + do { + src++; + if ((src[0] == '\\') && (src[1] == '\n')) { + src += 2; + lineNum++; + } + } while ((*src != '\n') && (*src != 0)); + } + if (*src == '\n') { + src++; + lineNum++; + continue; + } + if (*src == '\0') { + break; + } + + /* + * Parse off the option name, collapsing out backslash-newline + * sequences of course. + */ + + dst = name = src; + while (*src != ':') { + if ((*src == '\0') || (*src == '\n')) { + sprintf(interp->result, "missing colon on line %d", + lineNum); + return TCL_ERROR; + } + if ((src[0] == '\\') && (src[1] == '\n')) { + src += 2; + lineNum++; + } else { + *dst = *src; + dst++; + src++; + } + } + + /* + * Eliminate trailing white space on the name, and null-terminate + * it. + */ + + while ((dst != name) && ((dst[-1] == ' ') || (dst[-1] == '\t'))) { + dst--; + } + *dst = '\0'; + + /* + * Skip white space between the name and the value. + */ + + src++; + while ((*src == ' ') || (*src == '\t')) { + src++; + } + if (*src == '\0') { + sprintf(interp->result, "missing value on line %d", lineNum); + return TCL_ERROR; + } + + /* + * Parse off the value, squeezing out backslash-newline sequences + * along the way. + */ + + dst = value = src; + while (*src != '\n') { + if (*src == '\0') { + sprintf(interp->result, "missing newline on line %d", + lineNum); + return TCL_ERROR; + } + if ((src[0] == '\\') && (src[1] == '\n')) { + src += 2; + lineNum++; + } else { + *dst = *src; + dst++; + src++; + } + } + *dst = 0; + + /* + * Enter the option into the database. + */ + + Ck_AddOption(winPtr, name, value, priority); + src++; + lineNum++; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ReadOptionFile -- + * + * Read a file of options ("resources" in the old X terminology) + * and load them into the option database. + * + * Results: + * The return value is a standard Tcl return code. In the case of + * an error in parsing string, TCL_ERROR will be returned and an + * error message will be left in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ReadOptionFile(interp, winPtr, fileName, priority) + Tcl_Interp *interp; /* Interpreter to use for reporting results. */ + CkWindow *winPtr; /* Pointer to window: options are entered + * for this window's main window. */ + char *fileName; /* Name of file containing options. */ + int priority; /* Priority level to use for options in + * this file, such as TK_USER_DEFAULT_PRIO + * or TK_INTERACTIVE_PRIO. Must be between + * 0 and TK_MAX_PRIO. */ +{ +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + char *realName, *buffer; + int fileId, result; + struct stat statBuf; + Tcl_DString newName; + + realName = Tcl_TildeSubst(interp, fileName, &newName); + if (realName == NULL) { + return TCL_ERROR; + } + fileId = open(realName, O_RDONLY, 0); + Tcl_DStringFree(&newName); + if (fileId < 0) { + Tcl_AppendResult(interp, "couldn't read file \"", fileName, "\"", + (char *) NULL); + return TCL_ERROR; + } + if (fstat(fileId, &statBuf) == -1) { + Tcl_AppendResult(interp, "couldn't stat file \"", fileName, "\"", + (char *) NULL); + close(fileId); + return TCL_ERROR; + } + buffer = (char *) ckalloc((unsigned) statBuf.st_size+1); + if (read(fileId, buffer, (unsigned) statBuf.st_size) != statBuf.st_size) { + Tcl_AppendResult(interp, "error reading file \"", fileName, "\"", + (char *) NULL); + close(fileId); + return TCL_ERROR; + } + close(fileId); + buffer[statBuf.st_size] = 0; + result = AddFromString(interp, winPtr, buffer, priority); + ckfree(buffer); + return result; +#else + char *realName, *buffer; + int result, bufferSize; + Tcl_Channel chan; + Tcl_DString newName; + + realName = Tcl_TranslateFileName(interp, fileName, &newName); + if (realName == NULL) { + return TCL_ERROR; + } + chan = Tcl_OpenFileChannel(interp, realName, "r", 0); + Tcl_DStringFree(&newName); + if (chan == NULL) { + return TCL_ERROR; + } + + /* + * Compute size of file by seeking to the end of the file. + */ + + bufferSize = Tcl_Seek(chan, 0L, SEEK_END); + if (bufferSize < 0) { + Tcl_AppendResult(interp, "error getting file size of \"", + fileName, "\"", (char *) NULL); + Tcl_Close(NULL, chan); + return TCL_ERROR; + } + Tcl_Seek(chan, 0L, SEEK_SET); + buffer = (char *) ckalloc((unsigned) bufferSize + 1); + if (Tcl_Read(chan, buffer, bufferSize) != bufferSize) { + ckfree(buffer); + Tcl_AppendResult(interp, "error reading file \"", fileName, "\"", + (char *) NULL); + Tcl_Close(NULL, chan); + return TCL_ERROR; + } + Tcl_Close(NULL, chan); + buffer[bufferSize] = 0; + result = AddFromString(interp, winPtr, buffer, priority); + ckfree(buffer); + return result; +#endif +} + +/* + *-------------------------------------------------------------- + * + * NewArray -- + * + * Create a new ElArray structure of a given size. + * + * Results: + * The return value is a pointer to a properly initialized + * element array with "numEls" space. The array is marked + * as having no active elements. + * + * Side effects: + * Memory is allocated. + * + *-------------------------------------------------------------- + */ + +static ElArray * +NewArray(numEls) + int numEls; /* How many elements of space to allocate. */ +{ + register ElArray *arrayPtr; + + arrayPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(numEls)); + arrayPtr->arraySize = numEls; + arrayPtr->numUsed = 0; + arrayPtr->nextToUse = arrayPtr->els; + return arrayPtr; +} + +/* + *-------------------------------------------------------------- + * + * ExtendArray -- + * + * Add a new element to an array, extending the array if + * necessary. + * + * Results: + * The return value is a pointer to the new array, which + * will be different from arrayPtr if the array got expanded. + * + * Side effects: + * Memory may be allocated or freed. + * + *-------------------------------------------------------------- + */ + +static ElArray * +ExtendArray(arrayPtr, elPtr) + register ElArray *arrayPtr; /* Array to be extended. */ + register Element *elPtr; /* Element to be copied into array. */ +{ + /* + * If the current array has filled up, make it bigger. + */ + + if (arrayPtr->numUsed >= arrayPtr->arraySize) { + register ElArray *newPtr; + + newPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(2*arrayPtr->arraySize)); + newPtr->arraySize = 2*arrayPtr->arraySize; + newPtr->numUsed = arrayPtr->numUsed; + newPtr->nextToUse = &newPtr->els[newPtr->numUsed]; + memcpy((VOID *) newPtr->els, (VOID *) arrayPtr->els, + (arrayPtr->arraySize*sizeof(Element))); + ckfree((char *) arrayPtr); + arrayPtr = newPtr; + } + + *arrayPtr->nextToUse = *elPtr; + arrayPtr->nextToUse++; + arrayPtr->numUsed++; + return arrayPtr; +} + +/* + *-------------------------------------------------------------- + * + * SetupStacks -- + * + * Arrange the stacks so that they cache all the option + * information for a particular window. + * + * Results: + * None. + * + * Side effects: + * The stacks are modified to hold information for tkwin + * and all its ancestors in the window hierarchy. + * + *-------------------------------------------------------------- + */ + +static void +SetupStacks(winPtr, leaf) + CkWindow *winPtr; /* Window for which information is to + * be cached. */ + int leaf; /* Non-zero means this is the leaf + * window being probed. Zero means this + * is an ancestor of the desired leaf. */ +{ + int level, i, *iPtr; + register StackLevel *levelPtr; + register ElArray *arrayPtr; + + /* + * The following array defines the order in which the current + * stacks are searched to find matching entries to add to the + * stacks. Given the current priority-based scheme, the order + * below is no longer relevant; all that matters is that an + * element is on the list *somewhere*. The ordering is a relic + * of the old days when priorities were determined differently. + */ + + static int searchOrder[] = {WILDCARD_NODE_CLASS, WILDCARD_NODE_NAME, + EXACT_NODE_CLASS, EXACT_NODE_NAME, -1}; + + if (winPtr->mainPtr->optionRootPtr == NULL) { + OptionInit(winPtr->mainPtr); + } + + /* + * Step 1: make sure that options are cached for this window's + * parent. + */ + + if (winPtr->parentPtr != NULL) { + level = winPtr->parentPtr->optionLevel; + if ((level == -1) || (cachedWindow == NULL)) { + SetupStacks(winPtr->parentPtr, 0); + level = winPtr->parentPtr->optionLevel; + } + level++; + } else { + level = 1; + } + + /* + * Step 2: pop extra unneeded information off the stacks and + * mark those windows as no longer having cached information. + */ + + if (curLevel >= level) { + while (curLevel >= level) { + levels[curLevel].winPtr->optionLevel = -1; + curLevel--; + } + levelPtr = &levels[level]; + for (i = 0; i < NUM_STACKS; i++) { + arrayPtr = stacks[i]; + arrayPtr->numUsed = levelPtr->bases[i]; + arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed]; + } + } + curLevel = winPtr->optionLevel = level; + + /* + * Step 3: if the root database information isn't loaded or + * isn't valid, initialize level 0 of the stack from the + * database root (this only happens if winPtr is a main window). + */ + + if ((curLevel == 1) + && ((cachedWindow == NULL) + || (cachedWindow->mainPtr != winPtr->mainPtr))) { + for (i = 0; i < NUM_STACKS; i++) { + arrayPtr = stacks[i]; + arrayPtr->numUsed = 0; + arrayPtr->nextToUse = arrayPtr->els; + } + ExtendStacks(winPtr->mainPtr->optionRootPtr, 0); + } + + /* + * Step 4: create a new stack level; grow the level array if + * we've run out of levels. Clear the stacks for EXACT_LEAF_NAME + * and EXACT_LEAF_CLASS (anything that was there is of no use + * any more). + */ + + if (curLevel >= numLevels) { + StackLevel *newLevels; + + newLevels = (StackLevel *) ckalloc((unsigned) + (numLevels*2*sizeof(StackLevel))); + memcpy((VOID *) newLevels, (VOID *) levels, + (numLevels*sizeof(StackLevel))); + ckfree((char *) levels); + numLevels *= 2; + levels = newLevels; + } + levelPtr = &levels[curLevel]; + levelPtr->winPtr = winPtr; + arrayPtr = stacks[EXACT_LEAF_NAME]; + arrayPtr->numUsed = 0; + arrayPtr->nextToUse = arrayPtr->els; + arrayPtr = stacks[EXACT_LEAF_CLASS]; + arrayPtr->numUsed = 0; + arrayPtr->nextToUse = arrayPtr->els; + levelPtr->bases[EXACT_LEAF_NAME] = stacks[EXACT_LEAF_NAME]->numUsed; + levelPtr->bases[EXACT_LEAF_CLASS] = stacks[EXACT_LEAF_CLASS]->numUsed; + levelPtr->bases[EXACT_NODE_NAME] = stacks[EXACT_NODE_NAME]->numUsed; + levelPtr->bases[EXACT_NODE_CLASS] = stacks[EXACT_NODE_CLASS]->numUsed; + levelPtr->bases[WILDCARD_LEAF_NAME] = stacks[WILDCARD_LEAF_NAME]->numUsed; + levelPtr->bases[WILDCARD_LEAF_CLASS] = stacks[WILDCARD_LEAF_CLASS]->numUsed; + levelPtr->bases[WILDCARD_NODE_NAME] = stacks[WILDCARD_NODE_NAME]->numUsed; + levelPtr->bases[WILDCARD_NODE_CLASS] = stacks[WILDCARD_NODE_CLASS]->numUsed; + + + /* + * Step 5: scan the current stack level looking for matches to this + * window's name or class; where found, add new information to the + * stacks. + */ + + for (iPtr = searchOrder; *iPtr != -1; iPtr++) { + register Element *elPtr; + int count; + Ck_Uid id; + + i = *iPtr; + if (i & CLASS) { + id = winPtr->classUid; + } else { + id = winPtr->nameUid; + } + elPtr = stacks[i]->els; + count = levelPtr->bases[i]; + + /* + * For wildcard stacks, check all entries; for non-wildcard + * stacks, only check things that matched in the parent. + */ + + if (!(i & WILDCARD)) { + elPtr += levelPtr[-1].bases[i]; + count -= levelPtr[-1].bases[i]; + } + for ( ; count > 0; elPtr++, count--) { + if (elPtr->nameUid != id) { + continue; + } + ExtendStacks(elPtr->child.arrayPtr, leaf); + } + } + cachedWindow = winPtr; +} + +/* + *-------------------------------------------------------------- + * + * ExtendStacks -- + * + * Given an element array, copy all the elements from the + * array onto the system stacks (except for irrelevant leaf + * elements). + * + * Results: + * None. + * + * Side effects: + * The option stacks are extended. + * + *-------------------------------------------------------------- + */ + +static void +ExtendStacks(arrayPtr, leaf) + ElArray *arrayPtr; /* Array of elements to copy onto stacks. */ + int leaf; /* If zero, then don't copy exact leaf + * elements. */ +{ + register int count; + register Element *elPtr; + + for (elPtr = arrayPtr->els, count = arrayPtr->numUsed; + count > 0; elPtr++, count--) { + if (!(elPtr->flags & (NODE|WILDCARD)) && !leaf) { + continue; + } + stacks[elPtr->flags] = ExtendArray(stacks[elPtr->flags], elPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * OptionInit -- + * + * Initialize data structures for option handling. + * + * Results: + * None. + * + * Side effects: + * Option-related data structures get initialized. + * + *-------------------------------------------------------------- + */ + +static void +OptionInit(mainPtr) + register CkMainInfo *mainPtr; /* Top-level information about + * window that isn't initialized + * yet. */ +{ + int i; + + /* + * First, once-only initialization. + */ + + if (numLevels == 0) { + + numLevels = 5; + levels = (StackLevel *) ckalloc((unsigned) (5*sizeof(StackLevel))); + for (i = 0; i < NUM_STACKS; i++) { + stacks[i] = NewArray(10); + levels[0].bases[i] = 0; + } + + defaultMatch.nameUid = NULL; + defaultMatch.child.valueUid = NULL; + defaultMatch.priority = -1; + defaultMatch.flags = 0; + } + + /* + * Then, per-main-window initialization. Create and delete dummy + * interpreter for message logging. + */ + + mainPtr->optionRootPtr = NewArray(20); +} + +/* + *-------------------------------------------------------------- + * + * ClearOptionTree -- + * + * This procedure is called to erase everything in a + * hierarchical option database. + * + * Results: + * None. + * + * Side effects: + * All the options associated with arrayPtr are deleted, + * along with all option subtrees. The space pointed to + * by arrayPtr is freed. + * + *-------------------------------------------------------------- + */ + +static void +ClearOptionTree(arrayPtr) + ElArray *arrayPtr; /* Array of options; delete everything + * referred to recursively by this. */ +{ + register Element *elPtr; + int count; + + for (count = arrayPtr->numUsed, elPtr = arrayPtr->els; count > 0; + count--, elPtr++) { + if (elPtr->flags & NODE) { + ClearOptionTree(elPtr->child.arrayPtr); + } + } + ckfree((char *) arrayPtr); +} diff --git a/ckPack.c b/ckPack.c new file mode 100644 index 0000000..703fcf4 --- /dev/null +++ b/ckPack.c @@ -0,0 +1,1354 @@ +/* + * ckPack.c -- + * + * This file contains code to implement the "packer" + * geometry manager. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side; + +/* For each window that the packer cares about (either because + * the window is managed by the packer or because the window + * has slaves that are managed by the packer), there is a + * structure of the following type: + */ + +typedef struct Packer { + CkWindow *winPtr; /* Pointer to window. NULL means that + * the window has been deleted, but the + * packer hasn't had a chance to clean up + * yet because the structure is still in + * use. */ + struct Packer *masterPtr; /* Master window within which this window + * is packed (NULL means this window + * isn't managed by the packer). */ + struct Packer *nextPtr; /* Next window packed within same + * parent. List is priority-ordered: + * first on list gets packed first. */ + struct Packer *slavePtr; /* First in list of slaves packed + * inside this window (NULL means + * no packed slaves). */ + Side side; /* Side of parent against which + * this window is packed. */ + Ck_Anchor anchor; /* If frame allocated for window is larger + * than window needs, this indicates how + * where to position window in frame. */ + int padX, padY; /* Total additional pixels to leave around the + * window (half of this space is left on each + * side). This is space *outside* the window: + * we'll allocate extra space in frame but + * won't enlarge window). */ + int iPadX, iPadY; /* Total extra pixels to allocate inside the + * window (half this amount will appear on + * each side). */ + int *abortPtr; /* If non-NULL, it means that there is a nested + * call to ArrangePacking already working on + * this window. *abortPtr may be set to 1 to + * abort that nested call. This happens, for + * example, if tkwin or any of its slaves + * is deleted. */ + int flags; /* Miscellaneous flags; see below + * for definitions. */ +} Packer; + +/* + * Flag values for Packer structures: + * + * REQUESTED_REPACK: 1 means a Ck_DoWhenIdle request + * has already been made to repack + * all the slaves of this window. + * FILLX: 1 means if frame allocated for window + * is wider than window needs, expand window + * to fill frame. 0 means don't make window + * any larger than needed. + * FILLY: Same as FILLX, except for height. + * EXPAND: 1 means this window's frame will absorb any + * extra space in the parent window. + * DONT_PROPAGATE: 1 means don't set this window's requested + * size. 0 means if this window is a master + * then Tk will set its requested size to fit + * the needs of its slaves. + */ + +#define REQUESTED_REPACK 1 +#define FILLX 2 +#define FILLY 4 +#define EXPAND 8 +#define DONT_PROPAGATE 16 + +/* + * Hash table used to map from CkWindow pointers to corresponding + * Packer structures: + */ + +static Tcl_HashTable packerHashTable; + +/* + * Have statics in this module been initialized? + */ + +static int initialized = 0; + +/* + * The following structure is the official type record for the + * packer: + */ + +static void PackReqProc _ANSI_ARGS_((ClientData clientData, + CkWindow *winPtr)); +static void PackLostSlaveProc _ANSI_ARGS_((ClientData clientData, + CkWindow *winPtr)); + +static Ck_GeomMgr packerType = { + "pack", /* name */ + PackReqProc, /* requestProc */ + PackLostSlaveProc, /* lostSlaveProc */ +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void ArrangePacking _ANSI_ARGS_((ClientData clientData)); +static int ConfigureSlaves _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, int argc, char *argv[])); +static Packer * GetPacker _ANSI_ARGS_((CkWindow *winPtr)); +static void PackStructureProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static void Unlink _ANSI_ARGS_((Packer *packPtr)); +static int XExpansion _ANSI_ARGS_((Packer *slavePtr, + int cavityWidth)); +static int YExpansion _ANSI_ARGS_((Packer *slavePtr, + int cavityHeight)); + +/* + *-------------------------------------------------------------- + * + * Ck_PackCmd -- + * + * This procedure is invoked to process the "pack" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_PackCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + size_t length; + int c; + + if ((argc >= 2) && (argv[1][0] == '.')) { + return ConfigureSlaves(interp, mainPtr, argc-1, argv+1); + } + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option arg ?arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) { + if (argv[2][0] != '.') { + Tcl_AppendResult(interp, "bad argument \"", argv[2], + "\": must be name of window", (char *) NULL); + return TCL_ERROR; + } + return ConfigureSlaves(interp, mainPtr, argc-2, argv+2); + } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) { + CkWindow *slave; + Packer *slavePtr; + int i; + + for (i = 2; i < argc; i++) { + slave = Ck_NameToWindow(interp, argv[i], mainPtr); + if (slave == NULL) { + continue; + } + slavePtr = GetPacker(slave); + if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) { + Ck_ManageGeometry(slave, (Ck_GeomMgr *) NULL, + (ClientData) NULL); + if (slavePtr->masterPtr->winPtr != slavePtr->winPtr->parentPtr) { + Ck_UnmaintainGeometry(slavePtr->winPtr, + slavePtr->masterPtr->winPtr); + } + Unlink(slavePtr); + Ck_UnmapWindow(slavePtr->winPtr); + } + } + } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) { + register Packer *slavePtr; + CkWindow *slave; + char buffer[300]; + static char *sideNames[] = {"top", "bottom", "left", "right"}; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " info window\"", (char *) NULL); + return TCL_ERROR; + } + slave = Ck_NameToWindow(interp, argv[2], mainPtr); + if (slave == NULL) { + return TCL_ERROR; + } + slavePtr = GetPacker(slave); + if (slavePtr->masterPtr == NULL) { + Tcl_AppendResult(interp, "window \"", argv[2], + "\" isn't packed", (char *) NULL); + return TCL_ERROR; + } + Tcl_AppendElement(interp, "-in"); + Tcl_AppendElement(interp, slavePtr->masterPtr->winPtr->pathName); + Tcl_AppendElement(interp, "-anchor"); + Tcl_AppendElement(interp, Ck_NameOfAnchor(slavePtr->anchor)); + Tcl_AppendResult(interp, " -expand ", + (slavePtr->flags & EXPAND) ? "1" : "0", " -fill ", + (char *) NULL); + switch (slavePtr->flags & (FILLX|FILLY)) { + case 0: + Tcl_AppendResult(interp, "none", (char *) NULL); + break; + case FILLX: + Tcl_AppendResult(interp, "x", (char *) NULL); + break; + case FILLY: + Tcl_AppendResult(interp, "y", (char *) NULL); + break; + case FILLX|FILLY: + Tcl_AppendResult(interp, "both", (char *) NULL); + break; + } + sprintf(buffer, " -ipadx %d -ipady %d -padx %d -pady %d", + slavePtr->iPadX/2, slavePtr->iPadY/2, slavePtr->padX/2, + slavePtr->padY/2); + Tcl_AppendResult(interp, buffer, " -side ", sideNames[slavePtr->side], + (char *) NULL); + } else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) { + CkWindow *master; + Packer *masterPtr; + int propagate; + + if (argc > 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " propagate window ?boolean?\"", (char *) NULL); + return TCL_ERROR; + } + master = Ck_NameToWindow(interp, argv[2], mainPtr); + if (master == NULL) { + return TCL_ERROR; + } + masterPtr = GetPacker(master); + if (argc == 3) { + if (masterPtr->flags & DONT_PROPAGATE) { + interp->result = "0"; + } else { + interp->result = "1"; + } + return TCL_OK; + } + if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) { + return TCL_ERROR; + } + if (propagate) { + masterPtr->flags &= ~DONT_PROPAGATE; + + /* + * Repack the master to allow new geometry information to + * propagate upwards to the master's master. + */ + + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + if (!(masterPtr->flags & REQUESTED_REPACK)) { + masterPtr->flags |= REQUESTED_REPACK; + Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + } + } else { + masterPtr->flags |= DONT_PROPAGATE; + } + } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) { + CkWindow *master; + Packer *masterPtr, *slavePtr; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " slaves window\"", (char *) NULL); + return TCL_ERROR; + } + master = Ck_NameToWindow(interp, argv[2], mainPtr); + if (master == NULL) { + return TCL_ERROR; + } + masterPtr = GetPacker(master); + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + Tcl_AppendElement(interp, slavePtr->winPtr->pathName); + } + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be configure, forget, info, ", + "propagate, or slaves", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * PackReqProc -- + * + * This procedure is invoked by Ck_GeometryRequest for + * windows managed by the packer. + * + * Results: + * None. + * + * Side effects: + * Arranges for winPtr, and all its managed siblings, to + * be re-packed at the next idle point. + * + *-------------------------------------------------------------- + */ + +static void +PackReqProc(clientData, winPtr) + ClientData clientData; /* Packer's information about + * window that got new preferred + * geometry. */ + CkWindow *winPtr; /* Other information about the window. */ +{ + register Packer *packPtr = (Packer *) clientData; + + packPtr = packPtr->masterPtr; + if (!(packPtr->flags & REQUESTED_REPACK)) { + packPtr->flags |= REQUESTED_REPACK; + Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * PackLostSlaveProc -- + * + * This procedure is invoked whenever some other geometry + * claims control over a slave that used to be managed by us. + * + * Results: + * None. + * + * Side effects: + * Forgets all packer-related information about the slave. + * + *-------------------------------------------------------------- + */ + +static void +PackLostSlaveProc(clientData, winPtr) + ClientData clientData; /* Packer structure for slave window that + * was stolen away. */ + CkWindow *winPtr; /* Pointer to window. */ +{ + register Packer *slavePtr = (Packer *) clientData; + + if (slavePtr->masterPtr->winPtr != slavePtr->winPtr->parentPtr) { + Ck_UnmaintainGeometry(slavePtr->winPtr, slavePtr->masterPtr->winPtr); + } + Unlink(slavePtr); + Ck_UnmapWindow(slavePtr->winPtr); +} + +/* + *-------------------------------------------------------------- + * + * ArrangePacking -- + * + * This procedure is invoked (using the Tcl_DoWhenIdle + * mechanism) to re-layout a set of windows managed by + * the packer. It is invoked at idle time so that a + * series of packer requests can be merged into a single + * layout operation. + * + * Results: + * None. + * + * Side effects: + * The packed slaves of masterPtr may get resized or + * moved. + * + *-------------------------------------------------------------- + */ + +static void +ArrangePacking(clientData) + ClientData clientData; /* Structure describing parent whose slaves + * are to be re-layed out. */ +{ + register Packer *masterPtr = (Packer *) clientData; + register Packer *slavePtr; + int cavityX, cavityY, cavityWidth, cavityHeight; + /* These variables keep track of the + * as-yet-unallocated space remaining in + * the middle of the parent window. */ + int frameX, frameY, frameWidth, frameHeight; + /* These variables keep track of the frame + * allocated to the current window. */ + int x, y, width, height; /* These variables are used to hold the + * actual geometry of the current window. */ + int intBWidth; /* Width of internal border in parent window, + * if any. */ + int abort; /* May get set to non-zero to abort this + * repacking operation. */ + int borderX, borderY; + int maxWidth, maxHeight, tmp; + + masterPtr->flags &= ~REQUESTED_REPACK; + + /* + * If the parent has no slaves anymore, then don't do anything + * at all: just leave the parent's size as-is. + */ + + if (masterPtr->slavePtr == NULL) { + return; + } + + /* + * Abort any nested call to ArrangePacking for this window, since + * we'll do everything necessary here, and set up so this call + * can be aborted if necessary. + */ + + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + masterPtr->abortPtr = &abort; + abort = 0; + Ck_Preserve((ClientData) masterPtr); + + /* + * Pass #1: scan all the slaves to figure out the total amount + * of space needed. Two separate width and height values are + * computed: + * + * width - Holds the sum of the widths (plus padding) of + * all the slaves seen so far that were packed LEFT + * or RIGHT. + * height - Holds the sum of the heights (plus padding) of + * all the slaves seen so far that were packed TOP + * or BOTTOM. + * + * maxWidth - Gradually builds up the width needed by the master + * to just barely satisfy all the slave's needs. For + * each slave, the code computes the width needed for + * all the slaves so far and updates maxWidth if the + * new value is greater. + * maxHeight - Same as maxWidth, except keeps height info. + */ + + intBWidth = (masterPtr->winPtr->flags & CK_BORDER) ? 1 : 0; + width = height = maxWidth = maxHeight = 2*intBWidth; + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) { + tmp = slavePtr->winPtr->reqWidth + + slavePtr->padX + slavePtr->iPadX + width; + if (tmp > maxWidth) { + maxWidth = tmp; + } + height += slavePtr->winPtr->reqHeight + + slavePtr->padY + slavePtr->iPadY; + } else { + tmp = slavePtr->winPtr->reqHeight + + slavePtr->padY + slavePtr->iPadY + height; + if (tmp > maxHeight) { + maxHeight = tmp; + } + width += slavePtr->winPtr->reqWidth + + slavePtr->padX + slavePtr->iPadX; + } + } + if (width > maxWidth) { + maxWidth = width; + } + if (height > maxHeight) { + maxHeight = height; + } + + /* + * If the total amount of space needed in the parent window has + * changed, and if we're propagating geometry information, then + * notify the next geometry manager up and requeue ourselves to + * start again after the parent has had a chance to + * resize us. + */ + + if (((maxWidth != masterPtr->winPtr->reqWidth) + || (maxHeight != masterPtr->winPtr->reqHeight)) + && !(masterPtr->flags & DONT_PROPAGATE)) { + Ck_GeometryRequest(masterPtr->winPtr, maxWidth, maxHeight); + masterPtr->flags |= REQUESTED_REPACK; + Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + goto done; + } + + /* + * Pass #2: scan the slaves a second time assigning + * new sizes. The "cavity" variables keep track of the + * unclaimed space in the cavity of the window; this + * shrinks inward as we allocate windows around the + * edges. The "frame" variables keep track of the space + * allocated to the current window and its frame. The + * current window is then placed somewhere inside the + * frame, depending on anchor. + */ + + cavityX = cavityY = x = y = intBWidth; + cavityWidth = masterPtr->winPtr->width - 2*intBWidth; + cavityHeight = masterPtr->winPtr->height - 2*intBWidth; + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) { + frameWidth = cavityWidth; + frameHeight = slavePtr->winPtr->reqHeight + + slavePtr->padY + slavePtr->iPadY; + if (slavePtr->flags & EXPAND) { + frameHeight += YExpansion(slavePtr, cavityHeight); + } + cavityHeight -= frameHeight; + if (cavityHeight < 0) { + frameHeight += cavityHeight; + cavityHeight = 0; + } + frameX = cavityX; + if (slavePtr->side == TOP) { + frameY = cavityY; + cavityY += frameHeight; + } else { + frameY = cavityY + cavityHeight; + } + } else { + frameHeight = cavityHeight; + frameWidth = slavePtr->winPtr->reqWidth + + slavePtr->padX + slavePtr->iPadX; + if (slavePtr->flags & EXPAND) { + frameWidth += XExpansion(slavePtr, cavityWidth); + } + cavityWidth -= frameWidth; + if (cavityWidth < 0) { + frameWidth += cavityWidth; + cavityWidth = 0; + } + frameY = cavityY; + if (slavePtr->side == LEFT) { + frameX = cavityX; + cavityX += frameWidth; + } else { + frameX = cavityX + cavityWidth; + } + } + + /* + * Now that we've got the size of the frame for the window, + * compute the window's actual size and location using the + * fill, padding, and frame factors. The variables "borderX" + * and "borderY" are used to handle the differences between + * old-style packing and the new style (in old-style, iPadX + * and iPadY are always zero and padding is completely ignored + * except when computing frame size). + */ + + borderX = slavePtr->padX; + borderY = slavePtr->padY; + width = slavePtr->winPtr->reqWidth + slavePtr->iPadX; + if ((slavePtr->flags & FILLX) + || (width > (frameWidth - borderX))) { + width = frameWidth - borderX; + } + height = slavePtr->winPtr->reqHeight + slavePtr->iPadY; + if ((slavePtr->flags & FILLY) + || (height > (frameHeight - borderY))) { + height = frameHeight - borderY; + } + borderX /= 2; + borderY /= 2; + switch (slavePtr->anchor) { + case CK_ANCHOR_N: + x = frameX + (frameWidth - width)/2; + y = frameY + borderY; + break; + case CK_ANCHOR_NE: + x = frameX + frameWidth - width - borderX; + y = frameY + borderY; + break; + case CK_ANCHOR_E: + x = frameX + frameWidth - width - borderX; + y = frameY + (frameHeight - height)/2; + break; + case CK_ANCHOR_SE: + x = frameX + frameWidth - width - borderX; + y = frameY + frameHeight - height - borderY; + break; + case CK_ANCHOR_S: + x = frameX + (frameWidth - width)/2; + y = frameY + frameHeight - height - borderY; + break; + case CK_ANCHOR_SW: + x = frameX + borderX; + y = frameY + frameHeight - height - borderY; + break; + case CK_ANCHOR_W: + x = frameX + borderX; + y = frameY + (frameHeight - height)/2; + break; + case CK_ANCHOR_NW: + x = frameX + borderX; + y = frameY + borderY; + break; + case CK_ANCHOR_CENTER: + x = frameX + (frameWidth - width)/2; + y = frameY + (frameHeight - height)/2; + break; + default: + panic("bad frame factor in ArrangePacking"); + } + + /* + * The final step is to set the position, size, and mapped/unmapped + * state of the slave. + */ + + if (masterPtr->winPtr == slavePtr->winPtr->parentPtr) { + if (width <= 0 || height <= 0) { + Ck_UnmapWindow(slavePtr->winPtr); + } else { + if (width != slavePtr->winPtr->width || + height != slavePtr->winPtr->height) + Ck_ResizeWindow(slavePtr->winPtr, width, height); + if (x != slavePtr->winPtr->x || + y != slavePtr->winPtr->y) + Ck_MoveWindow(slavePtr->winPtr, x, y); + /* + * Temporary kludge til Ck_MoveResizeWindow available !!! + */ + if (width != slavePtr->winPtr->width || + height != slavePtr->winPtr->height) + Ck_ResizeWindow(slavePtr->winPtr, width, height); + if (abort) + goto done; + + /* + * Don't map the slave if the master isn't mapped: wait + * until the master gets mapped later. + */ + + if (masterPtr->winPtr->flags & CK_MAPPED) { + Ck_MapWindow(slavePtr->winPtr); + } + } + } else { + if ((width <= 0) || (height <= 0)) { + Ck_UnmaintainGeometry(slavePtr->winPtr, masterPtr->winPtr); + Ck_UnmapWindow(slavePtr->winPtr); + } else { + Ck_MaintainGeometry(slavePtr->winPtr, masterPtr->winPtr, + x, y, width, height); + } + } + + /* + * Changes to the window's structure could cause almost anything + * to happen, including deleting the parent or child. If this + * happens, we'll be told to abort. + */ + + if (abort) { + goto done; + } + } + +done: + masterPtr->abortPtr = NULL; + Ck_Release((ClientData) masterPtr); +} + +/* + *---------------------------------------------------------------------- + * + * XExpansion -- + * + * Given a list of packed slaves, the first of which is packed + * on the left or right and is expandable, compute how much to + * expand the child. + * + * Results: + * The return value is the number of additional pixels to give to + * the child. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +XExpansion(slavePtr, cavityWidth) + register Packer *slavePtr; /* First in list of remaining + * slaves. */ + int cavityWidth; /* Horizontal space left for all + * remaining slaves. */ +{ + int numExpand, minExpand, curExpand; + int childWidth; + + /* + * This procedure is tricky because windows packed top or bottom can + * be interspersed among expandable windows packed left or right. + * Scan through the list, keeping a running sum of the widths of + * all left and right windows (actually, count the cavity space not + * allocated) and a running count of all expandable left and right + * windows. At each top or bottom window, and at the end of the + * list, compute the expansion factor that seems reasonable at that + * point. Return the smallest factor seen at any of these points. + */ + + minExpand = cavityWidth; + numExpand = 0; + for ( ; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { + childWidth = slavePtr->winPtr->reqWidth + + slavePtr->padX + slavePtr->iPadX; + if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) { + curExpand = (cavityWidth - childWidth)/numExpand; + if (curExpand < minExpand) { + minExpand = curExpand; + } + } else { + cavityWidth -= childWidth; + if (slavePtr->flags & EXPAND) { + numExpand++; + } + } + } + curExpand = cavityWidth/numExpand; + if (curExpand < minExpand) { + minExpand = curExpand; + } + return (minExpand < 0) ? 0 : minExpand; +} + +/* + *---------------------------------------------------------------------- + * + * YExpansion -- + * + * Given a list of packed slaves, the first of which is packed + * on the top or bottom and is expandable, compute how much to + * expand the child. + * + * Results: + * The return value is the number of additional pixels to give to + * the child. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +YExpansion(slavePtr, cavityHeight) + register Packer *slavePtr; /* First in list of remaining + * slaves. */ + int cavityHeight; /* Vertical space left for all + * remaining slaves. */ +{ + int numExpand, minExpand, curExpand; + int childHeight; + + /* + * See comments for XExpansion. + */ + + minExpand = cavityHeight; + numExpand = 0; + for ( ; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { + childHeight = slavePtr->winPtr->reqHeight + + slavePtr->padY + slavePtr->iPadY; + if ((slavePtr->side == LEFT) || (slavePtr->side == RIGHT)) { + curExpand = (cavityHeight - childHeight)/numExpand; + if (curExpand < minExpand) { + minExpand = curExpand; + } + } else { + cavityHeight -= childHeight; + if (slavePtr->flags & EXPAND) { + numExpand++; + } + } + } + curExpand = cavityHeight/numExpand; + if (curExpand < minExpand) { + minExpand = curExpand; + } + return (minExpand < 0) ? 0 : minExpand; +} + +/* + *-------------------------------------------------------------- + * + * GetPacker -- + * + * This internal procedure is used to locate a Packer + * structure for a given window, creating one if one + * doesn't exist already. + * + * Results: + * The return value is a pointer to the Packer structure + * corresponding to tkwin. + * + * Side effects: + * A new packer structure may be created. If so, then + * a callback is set up to clean things up when the + * window is deleted. + * + *-------------------------------------------------------------- + */ + +static Packer * +GetPacker(winPtr) + CkWindow *winPtr; /* Pointer to window for which + * packer structure is desired. */ +{ + register Packer *packPtr; + Tcl_HashEntry *hPtr; + int new; + + if (!initialized) { + initialized = 1; + Tcl_InitHashTable(&packerHashTable, TCL_ONE_WORD_KEYS); + } + + /* + * See if there's already packer for this window. If not, + * then create a new one. + */ + + hPtr = Tcl_CreateHashEntry(&packerHashTable, (char *) winPtr, &new); + if (!new) { + return (Packer *) Tcl_GetHashValue(hPtr); + } + packPtr = (Packer *) ckalloc(sizeof (Packer)); + packPtr->winPtr = winPtr; + packPtr->masterPtr = NULL; + packPtr->nextPtr = NULL; + packPtr->slavePtr = NULL; + packPtr->side = TOP; + packPtr->anchor = CK_ANCHOR_CENTER; + packPtr->padX = packPtr->padY = 0; + packPtr->iPadX = packPtr->iPadY = 0; + packPtr->abortPtr = NULL; + packPtr->flags = 0; + Tcl_SetHashValue(hPtr, packPtr); + Ck_CreateEventHandler(winPtr, + CK_EV_DESTROY | CK_EV_MAP | CK_EV_EXPOSE, + PackStructureProc, (ClientData) packPtr); + return packPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Unlink -- + * + * Remove a packer from its parent's list of slaves. + * + * Results: + * None. + * + * Side effects: + * The parent will be scheduled for repacking. + * + *---------------------------------------------------------------------- + */ + +static void +Unlink(packPtr) + register Packer *packPtr; /* Window to unlink. */ +{ + register Packer *masterPtr, *packPtr2; + + masterPtr = packPtr->masterPtr; + if (masterPtr == NULL) { + return; + } + if (masterPtr->slavePtr == packPtr) { + masterPtr->slavePtr = packPtr->nextPtr; + } else { + for (packPtr2 = masterPtr->slavePtr; ; packPtr2 = packPtr2->nextPtr) { + if (packPtr2 == NULL) { + panic("Unlink couldn't find previous window"); + } + if (packPtr2->nextPtr == packPtr) { + packPtr2->nextPtr = packPtr->nextPtr; + break; + } + } + } + if (!(masterPtr->flags & REQUESTED_REPACK)) { + masterPtr->flags |= REQUESTED_REPACK; + Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + } + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + + packPtr->masterPtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyPacker -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a packer at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the packer is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyPacker(clientData) + ClientData clientData; /* Info about packed window that + * is now dead. */ +{ + register Packer *packPtr = (Packer *) clientData; + ckfree((char *) packPtr); +} + +/* + *---------------------------------------------------------------------- + * + * PackStructureProc -- + * + * This procedure is invoked by the event dispatcher in response + * to CK_EV_MAP/CK_EV_EXPOSE/CK_EV_DESTROY events. + * + * Results: + * None. + * + * Side effects: + * If a window was just deleted, clean up all its packer-related + * information. If it was just resized, repack its slaves, if + * any. + * + *---------------------------------------------------------------------- + */ + +static void +PackStructureProc(clientData, eventPtr) + ClientData clientData; /* Our information about window + * referred to by eventPtr. */ + CkEvent *eventPtr; /* Describes what just happened. */ +{ + register Packer *packPtr = (Packer *) clientData; + + if (eventPtr->type == CK_EV_MAP || eventPtr->type == CK_EV_EXPOSE) { + if ((packPtr->slavePtr != NULL) + && !(packPtr->flags & REQUESTED_REPACK)) { + packPtr->flags |= REQUESTED_REPACK; + Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr); + } + } else if (eventPtr->type == CK_EV_DESTROY) { + register Packer *slavePtr, *nextPtr; + + if (packPtr->masterPtr != NULL) { + Unlink(packPtr); + } + for (slavePtr = packPtr->slavePtr; slavePtr != NULL; + slavePtr = nextPtr) { + Ck_ManageGeometry(slavePtr->winPtr, (Ck_GeomMgr *) NULL, + (ClientData) NULL); + Ck_UnmapWindow(slavePtr->winPtr); + slavePtr->masterPtr = NULL; + nextPtr = slavePtr->nextPtr; + slavePtr->nextPtr = NULL; + } + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&packerHashTable, + (char *) packPtr->winPtr)); + if (packPtr->flags & REQUESTED_REPACK) { + Tcl_CancelIdleCall(ArrangePacking, (ClientData) packPtr); + } + packPtr->winPtr = NULL; + Ck_EventuallyFree((ClientData) packPtr, (Ck_FreeProc *) DestroyPacker); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureSlaves -- + * + * This implements the guts of the "pack configure" command. Given + * a list of slaves and configuration options, it arranges for the + * packer to manage the slaves and sets the specified options. + * + * Results: + * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is + * returned and interp->result is set to contain an error message. + * + * Side effects: + * Slave windows get taken over by the packer. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureSlaves(interp, winPtr, argc, argv) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + CkWindow *winPtr; /* Any window in application containing + * slaves. Used to look up slave names. */ + int argc; /* Number of elements in argv. */ + char *argv[]; /* Argument strings: contains one or more + * window names followed by any number + * of "option value" pairs. Caller must + * make sure that there is at least one + * window name. */ +{ + Packer *masterPtr, *slavePtr, *prevPtr, *otherPtr; + CkWindow *other, *slave, *parent, *ancestor; + int i, j, numWindows, c, tmp, positionGiven; + size_t length; + + /* + * Find out how many windows are specified. + */ + + for (numWindows = 0; numWindows < argc; numWindows++) { + if (argv[numWindows][0] != '.') { + break; + } + } + + /* + * Iterate over all of the slave windows, parsing the configuration + * options for each slave. It's a bit wasteful to re-parse the + * options for each slave, but things get too messy if we try to + * parse the arguments just once at the beginning. For example, + * if a slave already is packed we want to just change a few + * existing values without resetting everything. If there are + * multiple windows, the -after, -before, and -in options only + * get processed for the first window. + */ + + masterPtr = NULL; + prevPtr = NULL; + positionGiven = 0; + for (j = 0; j < numWindows; j++) { + slave = Ck_NameToWindow(interp, argv[j], winPtr); + if (slave == NULL) { + return TCL_ERROR; + } + if (slave->flags & CK_TOPLEVEL) { + Tcl_AppendResult(interp, "can't pack \"", argv[j], + "\": it's a top-level window", (char *) NULL); + return TCL_ERROR; + } + slavePtr = GetPacker(slave); + + /* + * If the slave isn't currently packed, reset all of its + * configuration information to default values (there could + * be old values left from a previous packing). + */ + + if (slavePtr->masterPtr == NULL) { + slavePtr->side = TOP; + slavePtr->anchor = CK_ANCHOR_CENTER; + slavePtr->padX = slavePtr->padY = 0; + slavePtr->iPadX = slavePtr->iPadY = 0; + slavePtr->flags &= ~(FILLX|FILLY|EXPAND); + } + + for (i = numWindows; i < argc; i+=2) { + if ((i+2) > argc) { + Tcl_AppendResult(interp, "extra option \"", argv[i], + "\" (option with no value?)", (char *) NULL); + return TCL_ERROR; + } + length = strlen(argv[i]); + if (length < 2) { + goto badOption; + } + c = argv[i][1]; + if ((c == 'a') && (strncmp(argv[i], "-after", length) == 0) + && (length >= 2)) { + if (j == 0) { + other = Ck_NameToWindow(interp, argv[i+1], winPtr); + if (other == NULL) { + return TCL_ERROR; + } + prevPtr = GetPacker(other); + if (prevPtr->masterPtr == NULL) { + notPacked: + Tcl_AppendResult(interp, "window \"", argv[i+1], + "\" isn't packed", (char *) NULL); + return TCL_ERROR; + } + masterPtr = prevPtr->masterPtr; + positionGiven = 1; + } + } else if ((c == 'a') && (strncmp(argv[i], "-anchor", length) == 0) + && (length >= 2)) { + if (Ck_GetAnchor(interp, argv[i+1], &slavePtr->anchor) + != TCL_OK) { + return TCL_ERROR; + } + } else if ((c == 'b') + && (strncmp(argv[i], "-before", length) == 0)) { + if (j == 0) { + other = Ck_NameToWindow(interp, argv[i+1], winPtr); + if (other == NULL) { + return TCL_ERROR; + } + otherPtr = GetPacker(other); + if (otherPtr->masterPtr == NULL) { + goto notPacked; + } + masterPtr = otherPtr->masterPtr; + prevPtr = masterPtr->slavePtr; + if (prevPtr == otherPtr) { + prevPtr = NULL; + } else { + while (prevPtr->nextPtr != otherPtr) { + prevPtr = prevPtr->nextPtr; + } + } + positionGiven = 1; + } + } else if ((c == 'e') + && (strncmp(argv[i], "-expand", length) == 0)) { + if (Tcl_GetBoolean(interp, argv[i+1], &tmp) != TCL_OK) { + return TCL_ERROR; + } + slavePtr->flags &= ~EXPAND; + if (tmp) { + slavePtr->flags |= EXPAND; + } + } else if ((c == 'f') && (strncmp(argv[i], "-fill", length) == 0)) { + if (strcmp(argv[i+1], "none") == 0) { + slavePtr->flags &= ~(FILLX|FILLY); + } else if (strcmp(argv[i+1], "x") == 0) { + slavePtr->flags = (slavePtr->flags & ~FILLY) | FILLX; + } else if (strcmp(argv[i+1], "y") == 0) { + slavePtr->flags = (slavePtr->flags & ~FILLX) | FILLY; + } else if (strcmp(argv[i+1], "both") == 0) { + slavePtr->flags |= FILLX|FILLY; + } else { + Tcl_AppendResult(interp, "bad fill style \"", argv[i+1], + "\": must be none, x, y, or both", (char *) NULL); + return TCL_ERROR; + } + } else if ((c == 'i') && (strcmp(argv[i], "-in") == 0)) { + if (j == 0) { + other = Ck_NameToWindow(interp, argv[i+1], winPtr); + if (other == NULL) { + return TCL_ERROR; + } + masterPtr = GetPacker(other); + prevPtr = masterPtr->slavePtr; + if (prevPtr != NULL) { + while (prevPtr->nextPtr != NULL) { + prevPtr = prevPtr->nextPtr; + } + } + positionGiven = 1; + } + } else if ((c == 'i') && (strcmp(argv[i], "-ipadx") == 0)) { + if ((Ck_GetCoord(interp, slave, argv[i+1], &tmp) != TCL_OK) + || (tmp < 0)) { + badPad: + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad pad value \"", argv[i+1], + "\": must be positive screen distance", + (char *) NULL); + return TCL_ERROR; + } + slavePtr->iPadX = tmp*2; + } else if ((c == 'i') && (strcmp(argv[i], "-ipady") == 0)) { + if ((Ck_GetCoord(interp, slave, argv[i+1], &tmp) != TCL_OK) + || (tmp< 0)) { + goto badPad; + } + slavePtr->iPadY = tmp*2; + } else if ((c == 'p') && (strcmp(argv[i], "-padx") == 0)) { + if ((Ck_GetCoord(interp, slave, argv[i+1], &tmp) != TCL_OK) + || (tmp< 0)) { + goto badPad; + } + slavePtr->padX = tmp*2; + } else if ((c == 'p') && (strcmp(argv[i], "-pady") == 0)) { + if ((Ck_GetCoord(interp, slave, argv[i+1], &tmp) != TCL_OK) + || (tmp< 0)) { + goto badPad; + } + slavePtr->padY = tmp*2; + } else if ((c == 's') && (strncmp(argv[i], "-side", length) == 0)) { + c = argv[i+1][0]; + if ((c == 't') && (strcmp(argv[i+1], "top") == 0)) { + slavePtr->side = TOP; + } else if ((c == 'b') && (strcmp(argv[i+1], "bottom") == 0)) { + slavePtr->side = BOTTOM; + } else if ((c == 'l') && (strcmp(argv[i+1], "left") == 0)) { + slavePtr->side = LEFT; + } else if ((c == 'r') && (strcmp(argv[i+1], "right") == 0)) { + slavePtr->side = RIGHT; + } else { + Tcl_AppendResult(interp, "bad side \"", argv[i+1], + "\": must be top, bottom, left, or right", + (char *) NULL); + return TCL_ERROR; + } + } else { + badOption: + Tcl_AppendResult(interp, "unknown or ambiguous option \"", + argv[i], "\": must be -after, -anchor, -before, ", + "-expand, -fill, -in, -ipadx, -ipady, -padx, ", + "-pady, or -side", (char *) NULL); + return TCL_ERROR; + } + } + + /* + * If no position in a packing list was specified and the slave + * is already packed, then leave it in its current location in + * its current packing list. + */ + + if (!positionGiven && (slavePtr->masterPtr != NULL)) { + masterPtr = slavePtr->masterPtr; + goto scheduleLayout; + } + + /* + * If the slave is going to be put back after itself then + * skip the whole operation, since it won't work anyway. + */ + + if (prevPtr == slavePtr) { + masterPtr = slavePtr->masterPtr; + goto scheduleLayout; + } + + /* + * If none of the "-before", or "-after" options has + * been specified, arrange for the slave to go at the end of + * the order for its parent. + */ + + if (!positionGiven) { + masterPtr = GetPacker(slave->parentPtr); + prevPtr = masterPtr->slavePtr; + if (prevPtr != NULL) { + while (prevPtr->nextPtr != NULL) { + prevPtr = prevPtr->nextPtr; + } + } + } + + /* + * Make sure that the slave's parent is either the master or + * an ancestor of the master. + */ + + parent = slave->parentPtr; + for (ancestor = masterPtr->winPtr; ; + ancestor = ancestor->parentPtr) { + if (ancestor == parent) { + break; + } + if (ancestor->flags & CK_TOPLEVEL) { + Tcl_AppendResult(interp, "can't pack ", argv[j], + " inside ", masterPtr->winPtr->pathName, + (char *) NULL); + return TCL_ERROR; + } + } + if (slave == masterPtr->winPtr) { + Tcl_AppendResult(interp, "can't pack ", argv[j], + " inside itself", (char *) NULL); + return TCL_ERROR; + } + + /* + * Unpack the slave if it's currently packed, then position it + * after prevPtr. + */ + + if (slavePtr->masterPtr != NULL) { + if ((slavePtr->masterPtr != masterPtr) && + (slavePtr->masterPtr->winPtr + != slavePtr->winPtr->parentPtr)) { + Ck_UnmaintainGeometry(slavePtr->winPtr, + slavePtr->masterPtr->winPtr); + } + Unlink(slavePtr); + } + slavePtr->masterPtr = masterPtr; + if (prevPtr == NULL) { + slavePtr->nextPtr = masterPtr->slavePtr; + masterPtr->slavePtr = slavePtr; + } else { + slavePtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = slavePtr; + } + Ck_ManageGeometry(slave, &packerType, (ClientData) slavePtr); + prevPtr = slavePtr; + + /* + * Arrange for the parent to be re-packed at the first + * idle moment. + */ + + scheduleLayout: + if (masterPtr->abortPtr != NULL) { + *masterPtr->abortPtr = 1; + } + if (!(masterPtr->flags & REQUESTED_REPACK)) { + masterPtr->flags |= REQUESTED_REPACK; + Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + } + } + return TCL_OK; +} diff --git a/ckPlace.c b/ckPlace.c new file mode 100644 index 0000000..91d22ea --- /dev/null +++ b/ckPlace.c @@ -0,0 +1,959 @@ +/* + * ckPlace.c -- + * + * This file contains code to implement a simple geometry manager + * for Ck based on absolute placement or "rubber-sheet" placement. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * Border modes for relative placement: + * + * BM_INSIDE: relative distances computed using area inside + * all borders of master window. + * BM_IGNORE: border issues are ignored: place relative to + * master's actual window size. + */ + +typedef enum {BM_INSIDE, BM_IGNORE} BorderMode; + +/* + * For each window whose geometry is managed by the placer there is + * a structure of the following type: + */ + +typedef struct Slave { + CkWindow *winPtr; /* Pointer to window. */ + struct Master *masterPtr; /* Pointer to information for window + * relative to which winPtr is placed. + * This isn't necessarily the logical + * parent of winPtr. NULL means the + * master was deleted or never assigned. */ + struct Slave *nextPtr; /* Next in list of windows placed relative + * to same master (NULL for end of list). */ + + /* + * Geometry information for window; where there are both relative + * and absolute values for the same attribute (e.g. x and relX) only + * one of them is actually used, depending on flags. + */ + + int x, y; /* X and Y coordinates for winPtr. */ + double relX, relY; /* X and Y coordinates relative to size of + * master. */ + int width, height; /* Absolute dimensions for winPtr. */ + double relWidth, relHeight; /* Dimensions for winPtr relative to size of + * master. */ + Ck_Anchor anchor; /* Which point on winPtr is placed at the + * given position. */ + BorderMode borderMode; /* How to treat borders of master window. */ + int flags; /* Various flags; see below for bit + * definitions. */ +} Slave; + +/* + * Flag definitions for Slave structures: + * + * CHILD_REL_X - 1 means use relX field; 0 means use x. + * CHILD_REL_Y - 1 means use relY field; 0 means use y; + * CHILD_WIDTH - 1 means use width field; + * CHILD_REL_WIDTH - 1 means use relWidth; if neither this nor + * CHILD_WIDTH is 1, use window's requested + * width. + * CHILD_HEIGHT - 1 means use height field; + * CHILD_REL_HEIGHT - 1 means use relHeight; if neither this nor + * CHILD_HEIGHT is 1, use window's requested + * height. + */ + +#define CHILD_REL_X 1 +#define CHILD_REL_Y 2 +#define CHILD_WIDTH 4 +#define CHILD_REL_WIDTH 8 +#define CHILD_HEIGHT 0x10 +#define CHILD_REL_HEIGHT 0x20 + +/* + * For each master window that has a slave managed by the placer there + * is a structure of the following form: + */ + +typedef struct Master { + CkWindow *winPtr; /* Pointer to master window. */ + struct Slave *slavePtr; /* First in linked list of slaves + * placed relative to this master. */ + int flags; /* See below for bit definitions. */ +} Master; + +/* + * Flag definitions for masters: + * + * PARENT_RECONFIG_PENDING - 1 means that a call to RecomputePlacement + * is already pending via a Do_When_Idle handler. + */ + +#define PARENT_RECONFIG_PENDING 1 + +/* + * The hash tables below both use CkWindow pointers as keys. They map + * from CkWindows to Slave and Master structures for windows, if they + * exist. + */ + +static int initialized = 0; +static Tcl_HashTable masterTable; +static Tcl_HashTable slaveTable; + +/* + * The following structure is the official type record for the + * placer: + */ + +static void PlaceRequestProc _ANSI_ARGS_((ClientData clientData, + CkWindow *winPtr)); +static void PlaceLostSlaveProc _ANSI_ARGS_((ClientData clientData, + CkWindow *winPtr)); + +static Ck_GeomMgr placerType = { + "place", /* name */ + PlaceRequestProc, /* requestProc */ + PlaceLostSlaveProc, /* lostSlaveProc */ +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void SlaveStructureProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static int ConfigureSlave _ANSI_ARGS_((Tcl_Interp *interp, + Slave *slavePtr, int argc, char **argv)); +static Slave * FindSlave _ANSI_ARGS_((CkWindow *winPtr)); +static Master * FindMaster _ANSI_ARGS_((CkWindow *winPtr)); +static void MasterStructureProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static void RecomputePlacement _ANSI_ARGS_((ClientData clientData)); +static void UnlinkSlave _ANSI_ARGS_((Slave *slavePtr)); + +/* + *-------------------------------------------------------------- + * + * Ck_PlaceCmd -- + * + * This procedure is invoked to process the "place" Tcl + * commands. See the user documentation for details on + * what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_PlaceCmd(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. */ +{ + CkWindow *winPtr; + Slave *slavePtr; + Tcl_HashEntry *hPtr; + int length; + char c; + + /* + * Initialize, if that hasn't been done yet. + */ + + if (!initialized) { + Tcl_InitHashTable(&masterTable, TCL_ONE_WORD_KEYS); + Tcl_InitHashTable(&slaveTable, TCL_ONE_WORD_KEYS); + initialized = 1; + } + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option|pathName args", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + + /* + * Handle special shortcut where window name is first argument. + */ + + if (c == '.') { + winPtr = Ck_NameToWindow(interp, argv[1], (CkWindow *) clientData); + if (winPtr == NULL) { + return TCL_ERROR; + } + slavePtr = FindSlave(winPtr); + return ConfigureSlave(interp, slavePtr, argc-2, argv+2); + } + + /* + * Handle more general case of option followed by window name followed + * by possible additional arguments. + */ + + winPtr = Ck_NameToWindow(interp, argv[2], (CkWindow *) clientData); + if (winPtr == NULL) { + return TCL_ERROR; + } + if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) { + if (argc < 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], + " configure pathName option value ?option value ...?\"", + (char *) NULL); + return TCL_ERROR; + } + slavePtr = FindSlave(winPtr); + return ConfigureSlave(interp, slavePtr, argc-3, argv+3); + } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " forget pathName\"", (char *) NULL); + return TCL_ERROR; + } + hPtr = Tcl_FindHashEntry(&slaveTable, (char *) winPtr); + if (hPtr == NULL) { + return TCL_OK; + } + slavePtr = (Slave *) Tcl_GetHashValue(hPtr); + UnlinkSlave(slavePtr); + Tcl_DeleteHashEntry(hPtr); + Ck_DeleteEventHandler(winPtr, CK_EV_MAP | CK_EV_EXPOSE | CK_EV_DESTROY, + SlaveStructureProc, (ClientData) slavePtr); + Ck_ManageGeometry(winPtr, (Ck_GeomMgr *) NULL, (ClientData) NULL); + Ck_UnmapWindow(winPtr); + ckfree((char *) slavePtr); + } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) { + char buffer[50]; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " info pathName\"", (char *) NULL); + return TCL_ERROR; + } + hPtr = Tcl_FindHashEntry(&slaveTable, (char *) winPtr); + if (hPtr == NULL) { + return TCL_OK; + } + slavePtr = (Slave *) Tcl_GetHashValue(hPtr); + if (slavePtr->flags & CHILD_REL_X) { + sprintf(buffer, "-relx %.4g", slavePtr->relX); + } else { + sprintf(buffer, "-x %d", slavePtr->x); + } + Tcl_AppendResult(interp, buffer, (char *) NULL); + if (slavePtr->flags & CHILD_REL_Y) { + sprintf(buffer, " -rely %.4g", slavePtr->relY); + } else { + sprintf(buffer, " -y %d", slavePtr->y); + } + Tcl_AppendResult(interp, buffer, (char *) NULL); + if (slavePtr->flags & CHILD_REL_WIDTH) { + sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth); + Tcl_AppendResult(interp, buffer, (char *) NULL); + } else if (slavePtr->flags & CHILD_WIDTH) { + sprintf(buffer, " -width %d", slavePtr->width); + Tcl_AppendResult(interp, buffer, (char *) NULL); + } + if (slavePtr->flags & CHILD_REL_HEIGHT) { + sprintf(buffer, " -relheight %.4g", slavePtr->relHeight); + Tcl_AppendResult(interp, buffer, (char *) NULL); + } else if (slavePtr->flags & CHILD_HEIGHT) { + sprintf(buffer, " -height %d", slavePtr->height); + Tcl_AppendResult(interp, buffer, (char *) NULL); + } + Tcl_AppendResult(interp, " -anchor ", Ck_NameOfAnchor(slavePtr->anchor), + (char *) NULL); + if (slavePtr->borderMode == BM_IGNORE) { + Tcl_AppendResult(interp, " -bordermode ignore", (char *) NULL); + } + } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " slaves pathName\"", (char *) NULL); + return TCL_ERROR; + } + hPtr = Tcl_FindHashEntry(&masterTable, (char *) winPtr); + if (hPtr != NULL) { + Master *masterPtr; + masterPtr = (Master *) Tcl_GetHashValue(hPtr); + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + Tcl_AppendElement(interp, slavePtr->winPtr->pathName); + } + } + } else { + Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1], + "\": must be configure, forget, info, or slaves", + (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * FindSlave -- + * + * Given a CkWindow *, find the Slave structure corresponding + * to that window (making a new one if necessary). + * + * Results: + * None. + * + * Side effects: + * A new Slave structure may be created. + * + *---------------------------------------------------------------------- + */ + +static Slave * +FindSlave(winPtr) + CkWindow *winPtr; /* Pointer to desired slave. */ +{ + Tcl_HashEntry *hPtr; + Slave *slavePtr; + int new; + + hPtr = Tcl_CreateHashEntry(&slaveTable, (char *) winPtr, &new); + if (new) { + slavePtr = (Slave *) ckalloc(sizeof (Slave)); + slavePtr->winPtr = winPtr; + slavePtr->masterPtr = NULL; + slavePtr->nextPtr = NULL; + slavePtr->x = slavePtr->y = 0; + slavePtr->relX = slavePtr->relY = 0.0; + slavePtr->width = slavePtr->height = 0; + slavePtr->relWidth = slavePtr->relHeight = 0.0; + slavePtr->anchor = CK_ANCHOR_NW; + slavePtr->borderMode = BM_INSIDE; + slavePtr->flags = 0; + Tcl_SetHashValue(hPtr, slavePtr); + Ck_CreateEventHandler(winPtr, CK_EV_MAP | CK_EV_EXPOSE | CK_EV_DESTROY, + SlaveStructureProc, (ClientData) slavePtr); + Ck_ManageGeometry(winPtr, &placerType, (ClientData) slavePtr); + } else { + slavePtr = (Slave *) Tcl_GetHashValue(hPtr); + } + return slavePtr; +} + +/* + *---------------------------------------------------------------------- + * + * UnlinkSlave -- + * + * This procedure removes a slave window from the chain of slaves + * in its master. + * + * Results: + * None. + * + * Side effects: + * The slave list of slavePtr's master changes. + * + *---------------------------------------------------------------------- + */ + +static void +UnlinkSlave(slavePtr) + Slave *slavePtr; /* Slave structure to be unlinked. */ +{ + register Master *masterPtr; + register Slave *prevPtr; + + masterPtr = slavePtr->masterPtr; + if (masterPtr == NULL) { + return; + } + if (masterPtr->slavePtr == slavePtr) { + masterPtr->slavePtr = slavePtr->nextPtr; + } else { + for (prevPtr = masterPtr->slavePtr; ; + prevPtr = prevPtr->nextPtr) { + if (prevPtr == NULL) { + panic("UnlinkSlave couldn't find slave to unlink"); + } + if (prevPtr->nextPtr == slavePtr) { + prevPtr->nextPtr = slavePtr->nextPtr; + break; + } + } + } + slavePtr->masterPtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * FindMaster -- + * + * Given a CkWindow *, find the Master structure corresponding + * to that window (making a new one if necessary). + * + * Results: + * None. + * + * Side effects: + * A new Master structure may be created. + * + *---------------------------------------------------------------------- + */ + +static Master * +FindMaster(winPtr) + CkWindow *winPtr; /* Pointer to desired master. */ +{ + Tcl_HashEntry *hPtr; + Master *masterPtr; + int new; + + hPtr = Tcl_CreateHashEntry(&masterTable, (char *) winPtr, &new); + if (new) { + masterPtr = (Master *) ckalloc(sizeof (Master)); + masterPtr->winPtr = winPtr; + masterPtr->slavePtr = NULL; + masterPtr->flags = 0; + Tcl_SetHashValue(hPtr, masterPtr); + /* + * Special case: for toplevels winPtr is NULL, + * therefore don't create event handler. + */ + if (winPtr != NULL) + Ck_CreateEventHandler(masterPtr->winPtr, + CK_EV_MAP | CK_EV_EXPOSE | CK_EV_DESTROY, + MasterStructureProc, (ClientData) masterPtr); + } else { + masterPtr = (Master *) Tcl_GetHashValue(hPtr); + } + return masterPtr; +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureSlave -- + * + * This procedure is called to process an argv/argc list to + * reconfigure the placement of a window. + * + * Results: + * A standard Tcl result. If an error occurs then a message is + * left in interp->result. + * + * Side effects: + * Information in slavePtr may change, and slavePtr's master is + * scheduled for reconfiguration. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureSlave(interp, slavePtr, argc, argv) + Tcl_Interp *interp; /* Used for error reporting. */ + Slave *slavePtr; /* Pointer to current information + * about slave. */ + int argc; /* Number of config arguments. */ + char **argv; /* String values for arguments. */ +{ + Master *masterPtr; + int c, length, result; + double d; + + result = TCL_OK; + for ( ; argc > 0; argc -= 2, argv += 2) { + if (argc < 2) { + Tcl_AppendResult(interp, "extra option \"", argv[0], + "\" (option with no value?)", (char *) NULL); + result = TCL_ERROR; + goto done; + } + length = strlen(argv[0]); + c = argv[0][1]; + if ((c == 'a') && (strncmp(argv[0], "-anchor", length) == 0)) { + if (Ck_GetAnchor(interp, argv[1], &slavePtr->anchor) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + } else if ((c == 'b') + && (strncmp(argv[0], "-bordermode", length) == 0)) { + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'i') && (strncmp(argv[1], "ignore", length) == 0) + && (length >= 2)) { + slavePtr->borderMode = BM_IGNORE; + } else if ((c == 'i') && (strncmp(argv[1], "inside", length) == 0) + && (length >= 2)) { + slavePtr->borderMode = BM_INSIDE; + } else { + Tcl_AppendResult(interp, "bad border mode \"", argv[1], + "\": must be ignore or inside", + (char *) NULL); + result = TCL_ERROR; + goto done; + } + } else if ((c == 'h') && (strncmp(argv[0], "-height", length) == 0)) { + if (argv[1][0] == 0) { + slavePtr->flags &= ~(CHILD_REL_HEIGHT|CHILD_HEIGHT); + } else { + if (Ck_GetCoord(interp, slavePtr->winPtr, argv[1], + &slavePtr->height) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + slavePtr->flags &= ~CHILD_REL_HEIGHT; + slavePtr->flags |= CHILD_HEIGHT; + } + } else if ((c == 'r') && (strncmp(argv[0], "-relheight", length) == 0) + && (length >= 5)) { + if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + slavePtr->relHeight = d; + slavePtr->flags |= CHILD_REL_HEIGHT; + slavePtr->flags &= ~CHILD_HEIGHT; + } else if ((c == 'r') && (strncmp(argv[0], "-relwidth", length) == 0) + && (length >= 5)) { + if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + slavePtr->relWidth = d; + slavePtr->flags |= CHILD_REL_WIDTH; + slavePtr->flags &= ~CHILD_WIDTH; + } else if ((c == 'r') && (strncmp(argv[0], "-relx", length) == 0) + && (length >= 5)) { + if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + slavePtr->relX = d; + slavePtr->flags |= CHILD_REL_X; + } else if ((c == 'r') && (strncmp(argv[0], "-rely", length) == 0) + && (length >= 5)) { + if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + slavePtr->relY = d; + slavePtr->flags |= CHILD_REL_Y; + } else if ((c == 'w') && (strncmp(argv[0], "-width", length) == 0)) { + if (argv[1][0] == 0) { + slavePtr->flags &= ~(CHILD_REL_WIDTH|CHILD_WIDTH); + } else { + if (Ck_GetCoord(interp, slavePtr->winPtr, argv[1], + &slavePtr->width) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + slavePtr->flags &= ~CHILD_REL_WIDTH; + slavePtr->flags |= CHILD_WIDTH; + } + } else if ((c == 'x') && (strncmp(argv[0], "-x", length) == 0)) { + if (Ck_GetCoord(interp, slavePtr->winPtr, argv[1], + &slavePtr->x) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + slavePtr->flags &= ~CHILD_REL_X; + } else if ((c == 'y') && (strncmp(argv[0], "-y", length) == 0)) { + if (Ck_GetCoord(interp, slavePtr->winPtr, argv[1], + &slavePtr->y) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + slavePtr->flags &= ~CHILD_REL_Y; + } else { + Tcl_AppendResult(interp, "unknown or ambiguous option \"", + argv[0], "\": must be -anchor, -bordermode, -height, ", + "-relheight, -relwidth, -relx, -rely, -width, ", + "-x, or -y", (char *) NULL); + result = TCL_ERROR; + goto done; + } + } + + /* + * Arrange for a placement recalculation in the master. + */ + +done: + masterPtr = slavePtr->masterPtr; + if (masterPtr == NULL) { + masterPtr = FindMaster((slavePtr->winPtr->flags & CK_TOPLEVEL) ? + NULL : slavePtr->winPtr->parentPtr); + slavePtr->masterPtr = masterPtr; + slavePtr->nextPtr = masterPtr->slavePtr; + masterPtr->slavePtr = slavePtr; + } + if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) { + masterPtr->flags |= PARENT_RECONFIG_PENDING; + Tk_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * RecomputePlacement -- + * + * This procedure is called as a when-idle handler. It recomputes + * the geometries of all the slaves of a given master. + * + * Results: + * None. + * + * Side effects: + * Windows may change size or shape. + * + *---------------------------------------------------------------------- + */ + +static void +RecomputePlacement(clientData) + ClientData clientData; /* Pointer to Master record. */ +{ + Master *masterPtr = (Master *) clientData; + Slave *slavePtr; + CkWindow *ancestor, *realMaster; + int x, y, width, height; + int masterWidth, masterHeight, masterBW; + + masterPtr->flags &= ~PARENT_RECONFIG_PENDING; + + /* + * Iterate over all the slaves for the master. Each slave's + * geometry can be computed independently of the other slaves. + */ + + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + /* + * Step 1: compute size and borderwidth of master, taking into + * account desired border mode. + */ + + masterBW = 0; + + /* + * Special case: masterPtr->winPtr == NULL, use entire screen ! + */ + + if (masterPtr->winPtr == NULL) { + masterWidth = slavePtr->winPtr->mainPtr->maxWidth; + masterHeight = slavePtr->winPtr->mainPtr->maxHeight; + } else { + masterWidth = masterPtr->winPtr->width; + masterHeight = masterPtr->winPtr->height; + if (slavePtr->borderMode == BM_INSIDE) { + masterBW = (masterPtr->winPtr->flags & CK_BORDER) ? 1 : 0; + } + masterWidth -= 2*masterBW; + masterHeight -= 2*masterBW; + } + + /* + * Step 2: compute size of slave (outside dimensions including + * border) and location of anchor point within master. + */ + + x = slavePtr->x; + if (slavePtr->flags & CHILD_REL_X) { + x = (int) ((slavePtr->relX*masterWidth) + + ((slavePtr->relX > 0) ? 0.5 : -0.5)); + } + x += masterBW; + y = slavePtr->y; + if (slavePtr->flags & CHILD_REL_Y) { + y = (int) ((slavePtr->relY*masterHeight) + + ((slavePtr->relY > 0) ? 0.5 : -0.5)); + } + y += masterBW; + if (slavePtr->flags & CHILD_REL_WIDTH) { + width = (int) ((slavePtr->relWidth*masterWidth) + 0.5); + } else if (slavePtr->flags & CHILD_WIDTH) { + width = slavePtr->width; + } else { + width = slavePtr->winPtr->reqWidth; + } + if (slavePtr->flags & CHILD_REL_HEIGHT) { + height = (int) ((slavePtr->relHeight*masterHeight) + 0.5); + } else if (slavePtr->flags & CHILD_HEIGHT) { + height = slavePtr->height; + } else { + height = slavePtr->winPtr->reqHeight; + } + + /* + * Step 3: adjust the x and y positions so that the desired + * anchor point on the slave appears at that position. Also + * adjust for the border mode and master's border. + */ + + switch (slavePtr->anchor) { + case CK_ANCHOR_N: + x -= width/2; + break; + case CK_ANCHOR_NE: + x -= width; + break; + case CK_ANCHOR_E: + x -= width; + y -= height/2; + break; + case CK_ANCHOR_SE: + x -= width; + y -= height; + break; + case CK_ANCHOR_S: + x -= width/2; + y -= height; + break; + case CK_ANCHOR_SW: + y -= height; + break; + case CK_ANCHOR_W: + y -= height/2; + break; + case CK_ANCHOR_NW: + break; + case CK_ANCHOR_CENTER: + x -= width/2; + y -= height/2; + break; + } + + /* + * Step 4: if masterPtr isn't actually the master of slavePtr, + * then translate the x and y coordinates back into the coordinate + * system of masterPtr. + */ + + for (ancestor = masterPtr->winPtr, + realMaster = slavePtr->winPtr->parentPtr; + ancestor != NULL && ancestor != realMaster; + ancestor = ancestor->parentPtr) { + x += ancestor->x; + y += ancestor->y; + } + + /* + * Step 5: adjust width and height again to reflect inside dimensions + * of window rather than outside. Also make sure that the width and + * height aren't zero. + */ + + if (width <= 0) { + width = 1; + } + if (height <= 0) { + height = 1; + } + + /* + * Step 6: see if the window's size or location has changed; if + * so then resize and/or move it. + */ + + if (width != slavePtr->winPtr->width || + height != slavePtr->winPtr->height) + Ck_ResizeWindow(slavePtr->winPtr, width, height); + if (x != slavePtr->winPtr->x || + y != slavePtr->winPtr->y) + Ck_MoveWindow(slavePtr->winPtr, x, y); + /* + * Temporary kludge til Ck_MoveResizeWindow available !!! + */ + if (width != slavePtr->winPtr->width || + height != slavePtr->winPtr->height) + Ck_ResizeWindow(slavePtr->winPtr, width, height); + + Ck_MapWindow(slavePtr->winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * MasterStructureProc -- + * + * This procedure is invoked by the event handler when + * CK_EV_MAP/CK_EV_EXPOSE/CK_EV_DESTROY events occur for + * a master window. + * + * Results: + * None. + * + * Side effects: + * Structures get cleaned up if the window was deleted. If the + * window was resized then slave geometries get recomputed. + * + *---------------------------------------------------------------------- + */ + +static void +MasterStructureProc(clientData, eventPtr) + ClientData clientData; /* Pointer to Master structure for window + * referred to by eventPtr. */ + CkEvent *eventPtr; /* Describes what just happened. */ +{ + Master *masterPtr = (Master *) clientData; + Slave *slavePtr, *nextPtr; + + if (eventPtr->type == CK_EV_EXPOSE || + eventPtr->type == CK_EV_MAP) { + if ((masterPtr->slavePtr != NULL) + && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) { + masterPtr->flags |= PARENT_RECONFIG_PENDING; + Tk_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr); + } + } else if (eventPtr->type == CK_EV_DESTROY) { + for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; + slavePtr = nextPtr) { + slavePtr->masterPtr = NULL; + nextPtr = slavePtr->nextPtr; + slavePtr->nextPtr = NULL; + } + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&masterTable, + (char *) masterPtr->winPtr)); + if (masterPtr->flags & PARENT_RECONFIG_PENDING) { + Tk_CancelIdleCall(RecomputePlacement, (ClientData) masterPtr); + } + masterPtr->winPtr = NULL; + ckfree((char *) masterPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * SlaveStructureProc -- + * + * This procedure is invoked by the event handler when + * CK_EV_MAP/CK_EV_EXPOSE/CK_EV_DESTROY events occur for a + * slave window. + * + * Results: + * None. + * + * Side effects: + * Structures get cleaned up if the window was deleted. + * + *---------------------------------------------------------------------- + */ + +static void +SlaveStructureProc(clientData, eventPtr) + ClientData clientData; /* Pointer to Slave structure for window + * referred to by eventPtr. */ + CkEvent *eventPtr; /* Describes what just happened. */ +{ + Slave *slavePtr = (Slave *) clientData; + + if (eventPtr->type == CK_EV_DESTROY) { + UnlinkSlave(slavePtr); + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&slaveTable, + (char *) slavePtr->winPtr)); + ckfree((char *) slavePtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * PlaceRequestProc -- + * + * This procedure is invoked whenever a slave managed by us + * changes its requested geometry. + * + * Results: + * None. + * + * Side effects: + * The window will get relayed out, if its requested size has + * anything to do with its actual size. + * + *---------------------------------------------------------------------- + */ + +static void +PlaceRequestProc(clientData, winPtr) + ClientData clientData; /* Pointer to our record for slave. */ + CkWindow *winPtr; /* Window that changed its desired + * size. */ +{ + Slave *slavePtr = (Slave *) clientData; + Master *masterPtr; + + if (((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) != 0) + && ((slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) != 0)) { + return; + } + masterPtr = slavePtr->masterPtr; + if (masterPtr == NULL) { + return; + } + if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) { + masterPtr->flags |= PARENT_RECONFIG_PENDING; + Tk_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * PlaceLostSlaveProc -- + * + * This procedure is invoked whenever some other geometry + * claims control over a slave that used to be managed by us. + * + * Results: + * None. + * + * Side effects: + * Forgets all placer-related information about the slave. + * + *-------------------------------------------------------------- + */ + +static void +PlaceLostSlaveProc(clientData, winPtr) + ClientData clientData; /* Slave structure for slave window that + * was stolen away. */ + CkWindow *winPtr; /* Slave window. */ +{ + register Slave *slavePtr = (Slave *) clientData; + + if (slavePtr->masterPtr->winPtr != slavePtr->winPtr->parentPtr) { + Ck_UnmaintainGeometry(slavePtr->winPtr, slavePtr->masterPtr->winPtr); + } + Ck_UnmapWindow(winPtr); + UnlinkSlave(slavePtr); + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&slaveTable, (char *) winPtr)); + Ck_DeleteEventHandler(winPtr, CK_EV_MAP | CK_EV_EXPOSE | CK_EV_DESTROY, + SlaveStructureProc, (ClientData) slavePtr); + ckfree((char *) slavePtr); +} diff --git a/ckPort.h b/ckPort.h new file mode 100644 index 0000000..0a4c54a --- /dev/null +++ b/ckPort.h @@ -0,0 +1,240 @@ +/* + * ckPort.h -- + * + * This file is included by all of the curses wish 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 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + */ + +#ifndef _CKPORT +#define _CKPORT + +#if defined(_WIN32) || defined(WIN32) +# include +#endif + +/* + * 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 +#include +#include +#if defined(_WIN32) || defined(WIN32) +# include +#else +# ifdef HAVE_LIMITS_H +# include +# else +# include "compat/limits.h" +# endif +#endif +#include +#if !defined(_WIN32) && !defined(WIN32) +# include +#endif +#ifdef NO_STDLIB_H +# include "compat/stdlib.h" +#else +# include +#endif +#include +#include +#if !defined(_WIN32) && !defined(WIN32) +# include +#endif +#ifdef HAVE_SYS_SELECT_H +# include +#endif +#include +#if !defined(_WIN32) && !defined(WIN32) +# include +#endif +#ifndef _TCL +# include +#endif +#if !defined(_WIN32) && !defined(WIN32) +# ifdef HAVE_UNISTD_H +# include +# else +# include "compat/unistd.h" +# endif +#endif + +#if (TCL_MAJOR_VERSION < 7) +#error Tcl major version must be 7 or greater +#endif + +/* + * Not all systems declare the errno variable in errno.h. so this + * file does it explicitly. + */ + +#if !defined(_WIN32) && !defined(WIN32) +extern int errno; +#endif + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + +/* + * 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 + +/* + * Define "NBBY" (number of bits per byte) if it's not already defined. + */ + +#ifndef NBBY +# define NBBY 8 +#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) + +/* + * The following macro checks to see whether there is buffered + * input data available for a stdio FILE. This has to be done + * in different ways on different systems. TK_FILE_GPTR and + * TK_FILE_COUNT are #defined by autoconf. + */ + +#ifdef TK_FILE_COUNT +# define TK_READ_DATA_PENDING(f) ((f)->TK_FILE_COUNT > 0) +#else +# ifdef TK_FILE_GPTR +# define TK_READ_DATA_PENDING(f) ((f)->_gptr < (f)->_egptr) +# else +# ifdef TK_FILE_READ_PTR +# define TK_READ_DATA_PENDING(f) ((f)->_IO_read_ptr != (f)->_IO_read_end) +# else + /* + * Don't know what to do for this system; whoever installs + * Tk will have to write a function TkReadDataPending to do + * the job. + */ + EXTERN int TkReadDataPending _ANSI_ARGS_((FILE *f)); +# define TK_READ_DATA_PENDING(f) TkReadDataPending(f) +# endif +# endif +#endif + +/* + * Substitute Tcl's own versions for several system calls. The + * Tcl versions retry automatically if interrupted by signals. + */ + +#define open(a,b,c) TclOpen(a,b,c) +#define read(a,b,c) TclRead(a,b,c) +#define waitpid(a,b,c) TclWaitpid(a,b,c) +#define write(a,b,c) TclWrite(a,b,c) +EXTERN int TclOpen _ANSI_ARGS_((char *path, int oflag, mode_t mode)); +EXTERN int TclRead _ANSI_ARGS_((int fd, VOID *buf, + unsigned int numBytes)); +EXTERN int TclWaitpid _ANSI_ARGS_((pid_t pid, int *statPtr, int options)); +EXTERN int TclWrite _ANSI_ARGS_((int fd, VOID *buf, + unsigned int numBytes)); + +/* + * If this system has a BSDgettimeofday function (e.g. IRIX) use it + * instead of gettimeofday; the gettimeofday function has a different + * interface than the BSD one that this code expects. + */ + +#ifdef HAVE_BSDGETTIMEOFDAY +# define gettimeofday BSDgettimeofday +#endif +#ifdef GETTOD_NOT_DECLARED +EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp, + struct timezone *tzp)); +#endif + +#else + +/* + * Provide some defines to get some Tk functionality which was in + * tkEvent.c prior to Tcl version 7.5. + */ + +#define Tk_BackgroundError Tcl_BackgroundError +#define Tk_DoWhenIdle Tcl_DoWhenIdle +#define Tk_DoWhenIdle2 Tcl_DoWhenIdle +#define Tk_CancelIdleCall Tcl_CancelIdleCall +#define Tk_CreateTimerHandler Tcl_CreateTimerHandler +#define Tk_DeleteTimerHandler Tcl_DeleteTimerHandler +#define Tk_AfterCmd Tcl_AfterCmd +#define Tk_FileeventCmd Tcl_FileEventCmd +#define Tk_DoOneEvent Tcl_DoOneEvent + +#endif + +/* + * Declarations for various library procedures that may not be declared + * in any other header file. + */ + +#ifndef panic +extern void panic(); +#endif + + /* Return type for signal(), this taken from TclX. + */ + +#ifndef RETSIGTYPE +# define RETSIGTYPE void +#endif + +typedef RETSIGTYPE (*Ck_SignalProc) _ANSI_ARGS_((int)); + + +#endif /* _CKPORT */ diff --git a/ckPreserve.c b/ckPreserve.c new file mode 100644 index 0000000..6c96e6d --- /dev/null +++ b/ckPreserve.c @@ -0,0 +1,233 @@ +/* + * ckPreserve.c -- + * + * This file contains a collection of procedures that are used + * to make sure that widget records and other data structures + * aren't reallocated when there are nested procedures that + * depend on their existence. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + +/* + * The following data structure is used to keep track of all the + * Ck_Preserve calls that are still in effect. It grows as needed + * to accommodate any number of calls in effect. + */ + +typedef struct { + ClientData clientData; /* Address of preserved block. */ + int refCount; /* Number of Ck_Preserve calls in effect + * for block. */ + int mustFree; /* Non-zero means Ck_EventuallyFree was + * called while a Ck_Preserve call was in + * effect, so the structure must be freed + * when refCount becomes zero. */ + Ck_FreeProc *freeProc; /* Procedure to call to free. */ +} Reference; + +static Reference *refArray; /* First in array of references. */ +static int spaceAvl = 0; /* Total number of structures available + * at *firstRefPtr. */ +static int inUse = 0; /* Count of structures currently in use + * in refArray. */ +#define INITIAL_SIZE 2 + +/* + *---------------------------------------------------------------------- + * + * Ck_Preserve -- + * + * This procedure is used by a procedure to declare its interest + * in a particular block of memory, so that the block will not be + * reallocated until a matching call to Ck_Release has been made. + * + * Results: + * None. + * + * Side effects: + * Information is retained so that the block of memory will + * not be freed until at least the matching call to Ck_Release. + * + *---------------------------------------------------------------------- + */ + +void +Ck_Preserve(clientData) + ClientData clientData; /* Pointer to malloc'ed block of memory. */ +{ + register Reference *refPtr; + int i; + + /* + * See if there is already a reference for this pointer. If so, + * just increment its reference count. + */ + + for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) { + if (refPtr->clientData == clientData) { + refPtr->refCount++; + return; + } + } + + /* + * Make a reference array if it doesn't already exist, or make it + * bigger if it is full. + */ + + if (inUse == spaceAvl) { + if (spaceAvl == 0) { + refArray = (Reference *) ckalloc((unsigned) + (INITIAL_SIZE*sizeof(Reference))); + spaceAvl = INITIAL_SIZE; + } else { + Reference *new; + + new = (Reference *) ckalloc((unsigned) + (2*spaceAvl*sizeof(Reference))); + memcpy((VOID *) new, (VOID *) refArray, spaceAvl*sizeof(Reference)); + ckfree((char *) refArray); + refArray = new; + spaceAvl *= 2; + } + } + + /* + * Make a new entry for the new reference. + */ + + refPtr = &refArray[inUse]; + refPtr->clientData = clientData; + refPtr->refCount = 1; + refPtr->mustFree = 0; + inUse += 1; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_Release -- + * + * This procedure is called to cancel a previous call to + * Ck_Preserve, thereby allowing a block of memory to be + * freed (if no one else cares about it). + * + * Results: + * None. + * + * Side effects: + * If Ck_EventuallyFree has been called for clientData, and if + * no other call to Ck_Preserve is still in effect, the block of + * memory is freed. + * + *---------------------------------------------------------------------- + */ + +void +Ck_Release(clientData) + ClientData clientData; /* Pointer to malloc'ed block of memory. */ +{ + register Reference *refPtr; + int i; + + for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) { + if (refPtr->clientData != clientData) { + continue; + } + refPtr->refCount--; + if (refPtr->refCount == 0) { + if (refPtr->mustFree) { + if (refPtr->freeProc == (Ck_FreeProc *) free) { + ckfree((char *) refPtr->clientData); + } else { + (*refPtr->freeProc)(refPtr->clientData); + } + } + + /* + * Copy down the last reference in the array to fill the + * hole left by the unused reference. + */ + + inUse--; + if (i < inUse) { + refArray[i] = refArray[inUse]; + } + } + return; + } + + /* + * Reference not found. This is a bug in the caller. + */ + + panic("Ck_Release couldn't find reference for 0x%x", clientData); +} + +/* + *---------------------------------------------------------------------- + * + * Ck_EventuallyFree -- + * + * Free up a block of memory, unless a call to Ck_Preserve is in + * effect for that block. In this case, defer the free until all + * calls to Ck_Preserve have been undone by matching calls to + * Ck_Release. + * + * Results: + * None. + * + * Side effects: + * Ptr may be released by calling free(). + * + *---------------------------------------------------------------------- + */ + +void +Ck_EventuallyFree(clientData, freeProc) + ClientData clientData; /* Pointer to malloc'ed block of memory. */ + Ck_FreeProc *freeProc; /* Procedure to actually do free. */ +{ + register Reference *refPtr; + int i; + + /* + * See if there is a reference for this pointer. If so, set its + * "mustFree" flag (the flag had better not be set already!). + */ + + for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) { + if (refPtr->clientData != clientData) { + continue; + } + if (refPtr->mustFree) { + panic("Ck_EventuallyFree called twice for 0x%x\n", clientData); + } + refPtr->mustFree = 1; + refPtr->freeProc = freeProc; + return; + } + + /* + * No reference for this block. Free it now. + */ + + if (freeProc == (Ck_FreeProc *) free) { + ckfree((char *) clientData); + } else { + (*freeProc)(clientData); + } +} + +#endif /* TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION <= 4 */ diff --git a/ckRecorder.c b/ckRecorder.c new file mode 100644 index 0000000..7e97113 --- /dev/null +++ b/ckRecorder.c @@ -0,0 +1,686 @@ +/* + * ckRecorder.c -- + * + * This file provides a simple event recorder. + * + * Copyright (c) 1996-1999 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +/* + * There is one structure of the following type for the global data + * of the recorder. + */ + +typedef struct { + CkWindow *mainPtr; + Tcl_Interp *interp; + int timerRunning; + Tk_TimerToken timer; +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + struct timeval lastEvent; + FILE *record; + FILE *replay; +#else + Tcl_Time lastEvent; + Tcl_Channel record; + Tcl_Channel replay; +#endif + int withDelay; + CkEvent event; +} Recorder; + +static Recorder *ckRecorder = NULL; + +/* + * Internal procedures. + */ + +static int RecorderInput _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +static int DStringGets _ANSI_ARGS_((FILE *filePtr, Tcl_DString *dsPtr)); +#else +static int DStringGets _ANSI_ARGS_((Tcl_Channel chan, + Tcl_DString *dsPtr)); +#endif +static void DeliverEvent _ANSI_ARGS_((ClientData clientData)); +static void RecorderReplay _ANSI_ARGS_((ClientData clientData)); + +/* + *---------------------------------------------------------------------- + * + * RecorderInput -- + * + * This procedure is installed as generic event handler. + * For certain events it adds lines to the recorder file. + * + *---------------------------------------------------------------------- + */ + +static int +RecorderInput(clientData, eventPtr) + ClientData clientData; + CkEvent *eventPtr; +{ + Recorder *recPtr = (Recorder *) clientData; + int hadEvent = 0, type = eventPtr->any.type; +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + struct timeval now; +#else + Tcl_Time now; + extern void TclpGetTime _ANSI_ARGS_((Tcl_Time *timePtr)); +#endif + char buffer[64]; + char *keySym, *barCode, *result; + char *argv[16]; + + if (recPtr->record == NULL) { + Ck_DeleteGenericHandler(RecorderInput, clientData); + return 0; + } + + if (type != CK_EV_KEYPRESS && type != CK_EV_BARCODE && + type != CK_EV_MOUSE_UP && type != CK_EV_MOUSE_DOWN) + return 0; + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + gettimeofday(&now, (struct timezone *) NULL); + if (recPtr->withDelay && recPtr->lastEvent.tv_sec != 0 && + recPtr->lastEvent.tv_usec != 0) { + double diff; + + diff = now.tv_sec * 1000 + now.tv_usec / 1000; + diff -= recPtr->lastEvent.tv_sec * 1000 + + recPtr->lastEvent.tv_usec / 1000; + if (diff > 50) { + if (diff > 3600000) + diff = 3600000; + fprintf(recPtr->record, " %d\n", (int) diff); + hadEvent++; + } + } +#else + TclpGetTime(&now); + if (recPtr->withDelay && recPtr->lastEvent.sec != 0 && + recPtr->lastEvent.usec != 0) { + double diff; + char string[100]; + + diff = now.sec * 1000 + now.usec / 1000; + diff -= recPtr->lastEvent.sec * 1000 + + recPtr->lastEvent.usec / 1000; + if (diff > 50) { + if (diff > 3600000) + diff = 3600000; + sprintf(string, " %d\n", (int) diff); + Tcl_Write(recPtr->record, string, strlen(string)); + hadEvent++; + } + } +#endif + + switch (type) { + case CK_EV_KEYPRESS: + argv[2] = NULL; + keySym = CkKeysymToString(eventPtr->key.keycode, 1); + if (strcmp(keySym, "NoSymbol") != 0) + argv[2] = keySym; + else if (eventPtr->key.keycode > 0 && + eventPtr->key.keycode < 256) { + /* Unsafe, ie not portable */ + sprintf(buffer, "0x%2x", eventPtr->key.keycode); + argv[2] = buffer; + } + if (argv[2] != NULL) { + argv[0] = ""; + argv[1] = eventPtr->key.winPtr == NULL ? "" : + eventPtr->key.winPtr->pathName; + result = Tcl_Merge(3, argv); +printPctSNL: +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fprintf(recPtr->record, "%s\n", result); +#else + Tcl_Write(recPtr->record, result, strlen(result)); + Tcl_Write(recPtr->record, "\n", 1); +#endif + ckfree(result); + hadEvent++; + } + break; + + case CK_EV_BARCODE: + barCode = CkGetBarcodeData(recPtr->mainPtr->mainPtr); + if (barCode != NULL) { + argv[0] = ""; + argv[1] = eventPtr->key.winPtr == NULL ? "" : + eventPtr->key.winPtr->pathName; + argv[2] = barCode; + result = Tcl_Merge(3, argv); + goto printPctSNL; + } + break; + + case CK_EV_MOUSE_UP: + case CK_EV_MOUSE_DOWN: + { + char bbuf[16], xbuf[16], ybuf[16], rxbuf[16], rybuf[16]; + + argv[0] = type == CK_EV_MOUSE_DOWN ? + "" : ""; + argv[1] = eventPtr->mouse.winPtr == NULL ? "" : + eventPtr->mouse.winPtr->pathName; + sprintf(bbuf, "%d", eventPtr->mouse.button); + argv[2] = bbuf; + sprintf(xbuf, "%d", eventPtr->mouse.x); + argv[3] = xbuf; + sprintf(ybuf, "%d", eventPtr->mouse.y); + argv[4] = ybuf; + sprintf(rxbuf, "%d", eventPtr->mouse.rootx); + argv[5] = rxbuf; + sprintf(rybuf, "%d", eventPtr->mouse.rooty); + argv[6] = rybuf; + result = Tcl_Merge(7, argv); + goto printPctSNL; + } + break; + } + + if (hadEvent) { +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fflush(recPtr->record); +#else + Tcl_Flush(recPtr->record); +#endif + recPtr->lastEvent = now; + } + + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * DStringGets -- + * + * Similar to the fgets library routine, a dynamic string is + * read from a file. Can deal with backslash-newline continuation. + * lines. + * + * Results: + * A standard Tcl result. + * + *---------------------------------------------------------------------- + */ + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) +static int +DStringGets(filePtr, dsPtr) + FILE *filePtr; + Tcl_DString *dsPtr; +{ + int count, c, p = EOF; + char buf; + + for (count = 0;;) { + c = getc(filePtr); + if (c == EOF) + return count ? TCL_OK : TCL_ERROR; + else if (c == '\n') { + if (p == '\\') + c = ' '; + else + return TCL_OK; + } + buf = c; + Tcl_DStringAppend(dsPtr, &buf, 1); + p = c; + } + /* Not reached. */ +} +#else +static int +DStringGets(chan, dsPtr) + Tcl_Channel chan; + Tcl_DString *dsPtr; +{ + char *p; + int length, code; + + for (;;) { + code = Tcl_Gets(chan, dsPtr); + length = Tcl_DStringLength(dsPtr); + if (code == -1) + return length == 0 ? TCL_ERROR : TCL_OK; + if (length > 0) { + p = Tcl_DStringValue(dsPtr) + length - 1; + if (*p != '\\') + return TCL_OK; + *p = ' '; + } else { + return TCL_OK; + } + } + /* Not reached. */ +} +#endif + +/* + *---------------------------------------------------------------------- + * + * DeliverEvent -- + * + * Call by do-when-idle mechanism, dispatched by replay handler. + * Deliver event, but first reschedule replay handler. This order + * is essential ! + * + *---------------------------------------------------------------------- + */ + +static void +DeliverEvent(clientData) + ClientData clientData; +{ + Recorder *recPtr = (Recorder *) clientData; + + Tk_DoWhenIdle(RecorderReplay, (ClientData) recPtr); + Ck_HandleEvent(recPtr->mainPtr->mainPtr, &recPtr->event); +} + +/* + *---------------------------------------------------------------------- + * + * RecorderReplay -- + * + * Replay handler, called by the do-when-idle mechanism or by a + * timer's expiration. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +RecorderReplay(clientData) + ClientData clientData; +{ + Recorder *recPtr = (Recorder *) clientData; + Tcl_DString input; + char *p; + int getsResult, delayValue = 0, doidle = 1; + + recPtr->timerRunning = 0; + if (recPtr->replay == NULL) + return; + + Tcl_DStringInit(&input); + while ((getsResult = DStringGets(recPtr->replay, &input)) == TCL_OK) { + p = Tcl_DStringValue(&input); + while (*p == ' ' || *p == '\t') + ++p; + if (*p == '#') { + Tcl_DStringTrunc(&input, 0); + continue; + } + if (*p == '<') { + CkEvent event; + int cmdError = TCL_OK, deliver = 0; + int argc; + char **argv; + + if (Tcl_SplitList(recPtr->interp, p, &argc, &argv) != TCL_OK) { + Tk_BackgroundError(recPtr->interp); + getsResult = TCL_ERROR; + break; + } + if (strcmp(argv[0], "") == 0) { + if (argc != 2) { +badNumArgs: + Tcl_AppendResult(recPtr->interp, + "wrong # args for ", argv[0], (char *) NULL); + cmdError = TCL_ERROR; + } else + cmdError = Tcl_GetInt(recPtr->interp, argv[1], + &delayValue); + } else if (strcmp(argv[0], "") == 0) { + int keySym; + + if (argc != 3) + goto badNumArgs; + event.any.type = CK_EV_KEYPRESS; + if (argv[1][0] == '\0') + event.any.winPtr = NULL; + else if ((event.any.winPtr = Ck_NameToWindow(recPtr->interp, + argv[1], recPtr->mainPtr)) == NULL) + cmdError = TCL_ERROR; + else if (strncmp(argv[2], "Control-", 8) == 0 && + strlen(argv[2]) == 9) { + event.key.keycode = argv[2][8] - 0x40; + if (event.key.keycode > 0x20) + event.key.keycode -= 0x20; + deliver++; + } else if (strncmp(argv[2], "0x", 2) == 0 && + strlen(argv[2]) == 4) { + sscanf(&argv[2][2], "%x", &event.key.keycode); + deliver++; + } else if ((keySym = CkStringToKeysym(argv[2])) != NoSymbol) { + event.key.keycode = keySym; + deliver++; + } + } else if (strcmp(argv[0], "") == 0) { + if (argc != 3) + goto badNumArgs; + + } else if (strcmp(argv[0], "") == 0) { + if (argc != 7) + goto badNumArgs; + event.any.type = CK_EV_MOUSE_DOWN; +doMouse: + if (argv[1][0] == '\0') + event.any.winPtr = NULL; + else if ((event.any.winPtr = Ck_NameToWindow(recPtr->interp, + argv[1], recPtr->mainPtr)) == NULL) + cmdError = TCL_ERROR; + else { + cmdError |= Tcl_GetInt(recPtr->interp, argv[2], + &event.mouse.button); + cmdError |= Tcl_GetInt(recPtr->interp, argv[3], + &event.mouse.x); + cmdError |= Tcl_GetInt(recPtr->interp, argv[4], + &event.mouse.y); + cmdError |= Tcl_GetInt(recPtr->interp, argv[5], + &event.mouse.rootx); + cmdError |= Tcl_GetInt(recPtr->interp, argv[6], + &event.mouse.rooty); + if (cmdError == TCL_OK) + deliver++; + } + } else if (strcmp(argv[0], "") == 0) { + if (argc != 7) + goto badNumArgs; + event.any.type = CK_EV_MOUSE_UP; + goto doMouse; + } + ckfree((char *) argv); + if (cmdError != TCL_OK) { + Tk_BackgroundError(recPtr->interp); + getsResult = cmdError; + } else if (deliver) { + doidle = delayValue = 0; + recPtr->event = event; + Tk_DoWhenIdle(DeliverEvent, (ClientData) recPtr); + } + break; + } else if (Tcl_GlobalEval(recPtr->interp, p) != TCL_OK) { + Tk_BackgroundError(recPtr->interp); + getsResult = TCL_ERROR; + break; + } + Tcl_DStringTrunc(&input, 0); + } + if (getsResult != TCL_OK) { +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fclose(recPtr->replay); +#else + Tcl_Close(NULL, recPtr->replay); +#endif + recPtr->replay = NULL; + } else if (delayValue != 0) { + recPtr->timerRunning = 1; + recPtr->timer = Tk_CreateTimerHandler(delayValue, RecorderReplay, + (ClientData) recPtr); + } else if (doidle != 0) { + Tk_DoWhenIdle(RecorderReplay, (ClientData) recPtr); + } + Tcl_DStringFree(&input); +} + +/* + *---------------------------------------------------------------------- + * + * Ck_RecorderCmd -- + * + * This procedure is invoked to process the "recorder" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Ck_RecorderCmd(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. */ +{ + Recorder *recPtr = ckRecorder; + CkWindow *mainPtr = (CkWindow *) clientData; + int length; + char c; + + if (recPtr == NULL) { + recPtr = (Recorder *) ckalloc(sizeof (Recorder)); + recPtr->mainPtr = mainPtr; + recPtr->interp = NULL; + recPtr->timerRunning = 0; +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + recPtr->lastEvent.tv_sec = recPtr->lastEvent.tv_usec = 0; +#else + recPtr->lastEvent.sec = recPtr->lastEvent.usec = 0; +#endif + recPtr->record = NULL; + recPtr->replay = NULL; + recPtr->withDelay = 0; + ckRecorder = recPtr; + } + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'r') && (strncmp(argv[1], "replay", length) == 0)) { + char *fileName; + Tcl_DString buffer; +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + FILE *newReplay; +#else + Tcl_Channel newReplay; +#endif + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " replay fileName\"", (char *) NULL); + return TCL_ERROR; + } + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fileName = Tcl_TildeSubst(interp, argv[2], &buffer); + if (fileName == NULL) { +replayError: + Tcl_DStringFree(&buffer); + return TCL_ERROR; + } + newReplay = fopen(fileName, "r"); + if (newReplay == NULL) { + Tcl_AppendResult(interp, "error opening \"", fileName, + "\": ", Tcl_PosixError(interp), (char *) NULL); + goto replayError; + } + Tcl_DStringFree(&buffer); + DStringGets(newReplay, &buffer); + if (strncmp("# CK-RECORDER", Tcl_DStringValue(&buffer), 13) != 0) { + fclose(newReplay); + Tcl_AppendResult(interp, "invalid file for replay", (char *) NULL); + goto replayError; + } +#else + fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); + if (fileName == NULL) { +replayError: + Tcl_DStringFree(&buffer); + return TCL_ERROR; + } + newReplay = Tcl_OpenFileChannel(interp, fileName, "r", 0); + if (newReplay == NULL) + goto replayError; + Tcl_DStringFree(&buffer); + Tcl_Gets(newReplay, &buffer); + if (strncmp("# CK-RECORDER", Tcl_DStringValue(&buffer), 13) != 0) { + Tcl_Close(NULL, newReplay); + Tcl_AppendResult(interp, "invalid file for replay", (char *) NULL); + goto replayError; + } +#endif + if (recPtr->replay != NULL) { + if (recPtr->timerRunning) + Tk_DeleteTimerHandler(recPtr->timer); +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fclose(recPtr->replay); +#else + Tcl_Close(NULL, recPtr->replay); +#endif + recPtr->timerRunning = 0; + } + recPtr->replay = newReplay; + recPtr->interp = interp; + Tk_DoWhenIdle(RecorderReplay, (ClientData) recPtr); + } else if ((c == 's') && (strncmp(argv[1], "start", length) == 0) && + (length > 1)) { + char *fileName; + int withDelay = 0, fileArg = 2; + Tcl_DString buffer; +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + FILE *newRecord; + time_t now; +#else + Tcl_Channel newRecord; + char *string; +#endif + + if (argc < 3 || argc > 4) { +badStartArgs: + Tcl_AppendResult(interp, "wrong # or bad args: should be \"", + argv[0], " start ?-withdelay? fileName\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 4) { + if (strcmp(argv[2], "-withdelay") != 0) + goto badStartArgs; + withDelay++; + fileArg++; + } +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fileName = Tcl_TildeSubst(interp, argv[fileArg], &buffer); + if (fileName == NULL) { +startError: + Tcl_DStringFree(&buffer); + return TCL_ERROR; + } + newRecord = fopen(fileName, "w"); + if (newRecord == NULL) { + Tcl_AppendResult(interp, "error opening \"", fileName, + "\": ", Tcl_PosixError(interp), (char *) NULL); + goto startError; + } + if (recPtr->record != NULL) + fclose(recPtr->record); + else { + recPtr->lastEvent.tv_sec = recPtr->lastEvent.tv_usec = 0; + Ck_CreateGenericHandler(RecorderInput, recPtr); + } + recPtr->record = newRecord; + recPtr->withDelay = withDelay; + time(&now); + fprintf(recPtr->record, "# CK-RECORDER\n# %s", ctime(&now)); + fprintf(recPtr->record, "# %s %s\n", + Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY), + Tcl_GetVar(interp, "argv", TCL_GLOBAL_ONLY)); + Tcl_DStringFree(&buffer); +#else + fileName = Tcl_TranslateFileName(interp, argv[fileArg], &buffer); + if (fileName == NULL) { +startError: + Tcl_DStringFree(&buffer); + return TCL_ERROR; + } + newRecord = Tcl_OpenFileChannel(interp, fileName, "w", 0666); + if (newRecord == NULL) + goto startError; + if (recPtr->record != NULL) + Tcl_Close(NULL, recPtr->record); + else { + recPtr->lastEvent.sec = recPtr->lastEvent.usec = 0; + Ck_CreateGenericHandler(RecorderInput, (ClientData) recPtr); + } + recPtr->record = newRecord; + recPtr->withDelay = withDelay; + string = "# CK-RECORDER\n# "; + Tcl_Write(recPtr->record, string, strlen(string)); + Tcl_Eval(interp, "clock format [clock seconds]"); + Tcl_Write(recPtr->record, interp->result, strlen(interp->result)); + Tcl_ResetResult(interp); + Tcl_Write(recPtr->record, "\n# ", 3); + string = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); + Tcl_Write(recPtr->record, string, strlen(string)); + Tcl_Write(recPtr->record, " ", 1); + string = Tcl_GetVar(interp, "argv", TCL_GLOBAL_ONLY); + Tcl_Write(recPtr->record, string, strlen(string)); + Tcl_Write(recPtr->record, "\n", 1); + Tcl_DStringFree(&buffer); +#endif + } else if ((c == 's') && (strncmp(argv[1], "stop", length) == 0) && + (length > 1)) { + if (argc > 3) { +badStopArgs: + Tcl_AppendResult(interp, "wrong # or bad args: should be \"", + argv[0], " stop ?replay?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 3) { + if (strcmp(argv[2], "replay") != 0) + goto badStopArgs; + if (recPtr->replay != NULL) { + if (recPtr->timerRunning) + Tk_DeleteTimerHandler(recPtr->timer); +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fclose(recPtr->replay); +#else + Tcl_Close(NULL, recPtr->replay); +#endif + recPtr->replay = NULL; + recPtr->timerRunning = 0; + } + } else if (recPtr->record != NULL) { +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + fclose(recPtr->record); +#else + Tcl_Close(NULL, recPtr->record); +#endif + Ck_DeleteGenericHandler(RecorderInput, (ClientData) recPtr); + recPtr->record = NULL; + } + } else { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " replay, start, or stop\"", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + + diff --git a/ckScrollbar.c b/ckScrollbar.c new file mode 100644 index 0000000..47e4c04 --- /dev/null +++ b/ckScrollbar.c @@ -0,0 +1,893 @@ +/* + * ckScrollbar.c -- + * + * This module implements a scrollbar widgets for the + * toolkit. A scrollbar displays a slider and two arrows; + * mouse clicks on features within the scrollbar cause + * scrolling commands to be invoked. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +/* + * A data structure of the following type is kept for each scrollbar + * widget managed by this file: + */ + +typedef struct { + CkWindow *winPtr; /* Window that embodies the scrollbar. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with scrollbar. */ + Tcl_Command widgetCmd; /* Token for scrollbar's widget command. */ + Ck_Uid orientUid; /* Orientation for window ("vertical" or + * "horizontal"). */ + int vertical; /* Non-zero means vertical orientation + * requested, zero means horizontal. */ + char *command; /* Command prefix to use when invoking + * scrolling commands. NULL means don't + * invoke commands. Malloc'ed. */ + int commandSize; /* Number of non-NULL bytes in command. */ + + /* + * Information used when displaying widget: + */ + + int normalBg; /* Used for drawing background. */ + int normalFg; /* Used for drawing foreground. */ + int normalAttr; /* Video attributes for normal mode. */ + int activeBg; /* Background in active mode. */ + int activeFg; /* Foreground in active mode. */ + int activeAttr; /* Video attributes for active mode. */ + + int sliderFirst; /* Coordinate of top or left edge + * of slider area. */ + int sliderLast; /* Coordinate just after bottom + * or right edge of slider area. */ + /* + * Information describing the application related to the scrollbar. + * This information is provided by the application by invoking the + * "set" widget command. + */ + + double firstFraction; /* Position of first visible thing in window, + * specified as a fraction between 0 and + * 1.0. */ + double lastFraction; /* Position of last visible thing in window, + * specified as a fraction between 0 and + * 1.0. */ + + /* + * Miscellaneous information: + */ + + char *takeFocus; /* Value of -takefocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + int flags; /* Various flags; see below for + * definitions. */ +} Scrollbar; + +/* + * Flag bits for scrollbars: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler + * has already been queued to redraw + * this window. + * ACTIVATED: 1 means draw in activated mode, + * 0 means draw in normal mode + */ + +#define REDRAW_PENDING 1 +#define ACTIVATED 2 + +/* + * Legal values for identifying position in scrollbar. These + * are the return values from the ScrollbarPosition procedure. + */ + +#define OUTSIDE 0 +#define TOP_ARROW 1 +#define TOP_GAP 2 +#define SLIDER 3 +#define BOTTOM_GAP 4 +#define BOTTOM_ARROW 5 + +/* + * Minimum slider length, in pixels (designed to make sure that the slider + * is always easy to grab with the mouse). + */ + +#define MIN_SLIDER_LENGTH 1 + +/* + * Information used for argv parsing. + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", "Attributes", + DEF_SCROLLBAR_ACTIVE_ATTR_COLOR, Ck_Offset(Scrollbar, activeAttr), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", "Attributes", + DEF_SCROLLBAR_ACTIVE_ATTR_MONO, Ck_Offset(Scrollbar, activeAttr), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_SCROLLBAR_ACTIVE_BG_COLOR, Ck_Offset(Scrollbar, activeBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_SCROLLBAR_ACTIVE_BG_MONO, Ck_Offset(Scrollbar, activeBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_SCROLLBAR_ACTIVE_FG_COLOR, Ck_Offset(Scrollbar, activeFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_SCROLLBAR_ACTIVE_FG_MONO, Ck_Offset(Scrollbar, activeBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_SCROLLBAR_ATTR, Ck_Offset(Scrollbar, normalAttr), 0}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_SCROLLBAR_BG_COLOR, Ck_Offset(Scrollbar, normalBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_SCROLLBAR_BG_MONO, Ck_Offset(Scrollbar, normalBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_STRING, "-command", "command", "Command", + DEF_SCROLLBAR_COMMAND, Ck_Offset(Scrollbar, command), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_SCROLLBAR_FG_COLOR, Ck_Offset(Scrollbar, normalFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_SCROLLBAR_FG_MONO, Ck_Offset(Scrollbar, normalFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_UID, "-orient", "orient", "Orient", + DEF_SCROLLBAR_ORIENT, Ck_Offset(Scrollbar, orientUid), 0}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_SCROLLBAR_TAKE_FOCUS, Ck_Offset(Scrollbar, takeFocus), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void ComputeScrollbarGeometry _ANSI_ARGS_(( + Scrollbar *scrollPtr)); +static int ConfigureScrollbar _ANSI_ARGS_((Tcl_Interp *interp, + Scrollbar *scrollPtr, int argc, char **argv, + int flags)); +static void DestroyScrollbar _ANSI_ARGS_((ClientData clientData)); +static void DisplayScrollbar _ANSI_ARGS_((ClientData clientData)); +static void EventuallyRedraw _ANSI_ARGS_((Scrollbar *scrollPtr)); +static void ScrollbarEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static void ScrollbarCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static int ScrollbarPosition _ANSI_ARGS_((Scrollbar *scrollPtr, + int x, int y)); +static int ScrollbarWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *, int argc, char **argv)); + +/* + *-------------------------------------------------------------- + * + * Ck_ScrollbarCmd -- + * + * This procedure is invoked to process the "scrollbar" Tcl + * command. See the user documentation for details on what + * it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_ScrollbarCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + register Scrollbar *scrollPtr; + CkWindow *new; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + new = Ck_CreateWindowFromPath(interp, mainPtr, argv[1], 0); + if (new == NULL) { + return TCL_ERROR; + } + + /* + * Initialize fields that won't be initialized by ConfigureScrollbar, + * or which ConfigureScrollbar expects to have reasonable values + * (e.g. resource pointers). + */ + + scrollPtr = (Scrollbar *) ckalloc(sizeof (Scrollbar)); + scrollPtr->winPtr = new; + scrollPtr->interp = interp; + scrollPtr->widgetCmd = Tcl_CreateCommand(interp, + scrollPtr->winPtr->pathName, ScrollbarWidgetCmd, + (ClientData) scrollPtr, ScrollbarCmdDeletedProc); + scrollPtr->orientUid = NULL; + scrollPtr->vertical = 0; + scrollPtr->command = NULL; + scrollPtr->commandSize = 0; + scrollPtr->normalBg = 0; + scrollPtr->normalFg = 0; + scrollPtr->normalAttr = 0; + scrollPtr->activeBg = 0; + scrollPtr->activeFg = 0; + scrollPtr->activeAttr = 0; + scrollPtr->firstFraction = 0.0; + scrollPtr->lastFraction = 0.0; + scrollPtr->takeFocus = NULL; + scrollPtr->flags = 0; + + Ck_SetClass(scrollPtr->winPtr, "Scrollbar"); + Ck_CreateEventHandler(scrollPtr->winPtr, + CK_EV_EXPOSE | CK_EV_MAP | CK_EV_DESTROY, + ScrollbarEventProc, (ClientData) scrollPtr); + if (ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, 0) != TCL_OK) { + goto error; + } + + interp->result = scrollPtr->winPtr->pathName; + return TCL_OK; + +error: + Ck_DestroyWindow(scrollPtr->winPtr); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * ScrollbarWidgetCmd -- + * + * 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. + * + *-------------------------------------------------------------- + */ + +static int +ScrollbarWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about scrollbar + * widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + register Scrollbar *scrollPtr = (Scrollbar *) clientData; + int result = TCL_OK; + size_t length; + int c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Ck_Preserve((ClientData) scrollPtr); + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " activate\"", (char *) NULL); + goto error; + } + if (!(scrollPtr->flags & ACTIVATED)) { + scrollPtr->flags |= ACTIVATED; + EventuallyRedraw(scrollPtr); + } + } 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 = Ck_ConfigureValue(interp, scrollPtr->winPtr, configSpecs, + (char *) scrollPtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 2)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, scrollPtr->winPtr, configSpecs, + (char *) scrollPtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, scrollPtr->winPtr, configSpecs, + (char *) scrollPtr, argv[2], 0); + } else { + result = ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else if ((c == 'd') && (strncmp(argv[1], "deactivate", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " deactivate\"", (char *) NULL); + goto error; + } + if (scrollPtr->flags & ACTIVATED) { + scrollPtr->flags &= ~ACTIVATED; + EventuallyRedraw(scrollPtr); + } + } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) { + int x, y, pos, length; + double fraction; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " fraction x y\"", (char *) NULL); + goto error; + } + if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) + || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { + goto error; + } + if (scrollPtr->vertical) { + pos = y - 1; + length = scrollPtr->winPtr->height - 1 - 2; + } else { + pos = x - 1; + length = scrollPtr->winPtr->width - 1 - 2; + } + if (length == 0) { + fraction = 0.0; + } else { + fraction = ((double) pos / (double) length); + } + if (fraction < 0) { + fraction = 0; + } else if (fraction > 1.0) { + fraction = 1.0; + } + sprintf(interp->result, "%g", fraction); + } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + char first[TCL_DOUBLE_SPACE], last[TCL_DOUBLE_SPACE]; + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " get\"", (char *) NULL); + goto error; + } + Tcl_PrintDouble(interp, scrollPtr->firstFraction, first); + Tcl_PrintDouble(interp, scrollPtr->lastFraction, last); + Tcl_AppendResult(interp, first, " ", last, (char *) NULL); + } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) { + int x, y, thing; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " identify x y\"", (char *) NULL); + goto error; + } + if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) + || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { + goto error; + } + thing = ScrollbarPosition(scrollPtr, x, y); + switch (thing) { + case TOP_ARROW: interp->result = "arrow1"; break; + case TOP_GAP: interp->result = "trough1"; break; + case SLIDER: interp->result = "slider"; break; + case BOTTOM_GAP: interp->result = "trough2"; break; + case BOTTOM_ARROW: interp->result = "arrow2"; break; + } + } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) { + if (argc == 4) { + double first, last; + + if (Tcl_GetDouble(interp, argv[2], &first) != TCL_OK) { + goto error; + } + if (Tcl_GetDouble(interp, argv[3], &last) != TCL_OK) { + goto error; + } + if (first < 0) { + scrollPtr->firstFraction = 0; + } else if (first > 1.0) { + scrollPtr->firstFraction = 1.0; + } else { + scrollPtr->firstFraction = first; + } + if (last < scrollPtr->firstFraction) { + scrollPtr->lastFraction = scrollPtr->firstFraction; + } else if (last > 1.0) { + scrollPtr->lastFraction = 1.0; + } else { + scrollPtr->lastFraction = last; + } + } else { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " set firstFraction lastFraction\"", + (char *) NULL); + goto error; + } + ComputeScrollbarGeometry(scrollPtr); + EventuallyRedraw(scrollPtr); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be activate, cget, configure, deactivate, ", + "fraction, get, or set", (char *) NULL); + goto error; + } + Ck_Release((ClientData) scrollPtr); + return result; + +error: + Ck_Release((ClientData) scrollPtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyScrollbar -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a scrollbar at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the scrollbar is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyScrollbar(clientData) + ClientData clientData; /* Info about scrollbar widget. */ +{ + register Scrollbar *scrollPtr = (Scrollbar *) clientData; + + /* + * Free up all the stuff that requires special handling, then + * let Ck_FreeOptions handle all the standard option-related + * stuff. + */ + + Ck_FreeOptions(configSpecs, (char *) scrollPtr, 0); + ckfree((char *) scrollPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ScrollbarCmdDeletedProc -- + * + * 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 +ScrollbarCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + Scrollbar *scrollPtr = (Scrollbar *) clientData; + CkWindow *winPtr = scrollPtr->winPtr; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case winPtr + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (winPtr != NULL) { + scrollPtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureScrollbar -- + * + * This procedure is called to process an argv/argc list, plus + * the option database, in order to configure (or + * reconfigure) a scrollbar widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as colors, border width, + * etc. get set for scrollPtr; old resources get freed, + * if there were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureScrollbar(interp, scrollPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + register Scrollbar *scrollPtr; /* 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 + * Ck_ConfigureWidget. */ +{ + size_t length; + + if (Ck_ConfigureWidget(interp, scrollPtr->winPtr, configSpecs, + argc, argv, (char *) scrollPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few options need special processing, such as parsing the + * orientation or setting the background from a 3-D border. + */ + + length = strlen(scrollPtr->orientUid); + if (strncmp(scrollPtr->orientUid, "vertical", length) == 0) { + scrollPtr->vertical = 1; + } else if (strncmp(scrollPtr->orientUid, "horizontal", length) == 0) { + scrollPtr->vertical = 0; + } else { + Tcl_AppendResult(interp, "bad orientation \"", scrollPtr->orientUid, + "\": must be vertical or horizontal", (char *) NULL); + return TCL_ERROR; + } + + if (scrollPtr->command != NULL) { + scrollPtr->commandSize = strlen(scrollPtr->command); + } else { + scrollPtr->commandSize = 0; + } + + /* + * Register the desired geometry for the window (leave enough space + * for the two arrows plus a minimum-size slider, plus border around + * the whole window, if any). Then arrange for the window to be + * redisplayed. + */ + + ComputeScrollbarGeometry(scrollPtr); + EventuallyRedraw(scrollPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DisplayScrollbar -- + * + * This procedure redraws the contents of a scrollbar 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 +DisplayScrollbar(clientData) + ClientData clientData; /* Information about window. */ +{ + register Scrollbar *scrollPtr = (Scrollbar *) clientData; + register CkWindow *winPtr = scrollPtr->winPtr; + int width, i, gchar; + + if ((scrollPtr->winPtr == NULL) || !(winPtr->flags & CK_MAPPED)) { + goto done; + } + + width = (scrollPtr->vertical ? winPtr->height : winPtr->width); + + if (scrollPtr->flags & ACTIVATED) { + Ck_SetWindowAttr(winPtr, scrollPtr->activeFg, + scrollPtr->activeBg, scrollPtr->activeAttr); + } else { + Ck_SetWindowAttr(winPtr, scrollPtr->normalFg, + scrollPtr->normalBg, scrollPtr->normalAttr); + } + + /* + * Fill space left with blanks. + */ + + if (scrollPtr->vertical) { + for (i = 0; i < width; i++) { + wmove(winPtr->window, i, 0); + waddch(winPtr->window, ' '); + } + } else { + wmove(winPtr->window, 0, 0); + for (i = 0; i < width; i++) { + waddch(winPtr->window, ' '); + } + } + + /* + * Display the slider. + */ + + Ck_GetGChar(scrollPtr->interp, "ckboard", &gchar); + if (scrollPtr->vertical) { + for (i = scrollPtr->sliderFirst; i < scrollPtr->sliderLast; i++) { + mvwaddch(winPtr->window, i, 0, gchar); + } + } else { + wmove(winPtr->window, 0, scrollPtr->sliderFirst); + for (i = scrollPtr->sliderFirst; i < scrollPtr->sliderLast; i++) { + waddch(winPtr->window, gchar); + } + } + + /* + * Display top or left arrow. + */ + + Ck_GetGChar(scrollPtr->interp, scrollPtr->vertical ? "uarrow" : "larrow", + &gchar); + mvwaddch(winPtr->window, 0, 0, gchar); + + /* + * Display the bottom or right arrow. + */ + + Ck_GetGChar(scrollPtr->interp, scrollPtr->vertical ? "darrow" : "rarrow", + &gchar); + scrollPtr->vertical ? wmove(winPtr->window, width - 1, 0) : + wmove(winPtr->window, 0, width - 1); + waddch(winPtr->window, gchar); + + Ck_EventuallyRefresh(winPtr); + +done: + scrollPtr->flags &= ~REDRAW_PENDING; +} + +/* + *-------------------------------------------------------------- + * + * ScrollbarEventProc -- + * + * This procedure is invoked by the dispatcher for various + * events on scrollbars. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +ScrollbarEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + Scrollbar *scrollPtr = (Scrollbar *) clientData; + + if (eventPtr->type == CK_EV_EXPOSE) { + ComputeScrollbarGeometry(scrollPtr); + EventuallyRedraw(scrollPtr); + } else if (eventPtr->type == CK_EV_DESTROY) { + if (scrollPtr->winPtr != NULL) { + scrollPtr->winPtr = NULL; + Tcl_DeleteCommand(scrollPtr->interp, + Tcl_GetCommandName(scrollPtr->interp, scrollPtr->widgetCmd)); + } + if (scrollPtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayScrollbar, (ClientData) scrollPtr); + } + Ck_EventuallyFree((ClientData) scrollPtr, + (Ck_FreeProc *) DestroyScrollbar); + } +} + +/* + *---------------------------------------------------------------------- + * + * ComputeScrollbarGeometry -- + * + * After changes in a scrollbar's size or configuration, this + * procedure recomputes various geometry information used in + * displaying the scrollbar. + * + * Results: + * None. + * + * Side effects: + * The scrollbar will be displayed differently. + * + *---------------------------------------------------------------------- + */ + +static void +ComputeScrollbarGeometry(scrollPtr) + register Scrollbar *scrollPtr; /* Scrollbar whose geometry may + * have changed. */ +{ + int fieldLength; + + fieldLength = (scrollPtr->vertical ? scrollPtr->winPtr->height + : scrollPtr->winPtr->width) - 2; + if (fieldLength < 0) { + fieldLength = 0; + } + scrollPtr->sliderFirst = (int) (fieldLength * scrollPtr->firstFraction); + scrollPtr->sliderLast = (int) (fieldLength * scrollPtr->lastFraction); + + /* + * Adjust the slider so that some piece of it is always + * displayed in the scrollbar and so that it has at least + * a minimal width (so it can be grabbed with the mouse). + */ + + if (scrollPtr->sliderFirst > fieldLength) { + scrollPtr->sliderFirst = fieldLength; + } + if (scrollPtr->sliderFirst < 0) { + scrollPtr->sliderFirst = 0; + } + if (scrollPtr->sliderLast < (scrollPtr->sliderFirst + + MIN_SLIDER_LENGTH)) { + scrollPtr->sliderLast = scrollPtr->sliderFirst + MIN_SLIDER_LENGTH; + } + if (scrollPtr->sliderLast > fieldLength) { + scrollPtr->sliderLast = fieldLength; + } + scrollPtr->sliderFirst += 1; + scrollPtr->sliderLast += 1; + + /* + * Register the desired geometry for the window (leave enough space + * for the two arrows plus a minimum-size slider, plus border around + * the whole window, if any). Then arrange for the window to be + * redisplayed. + */ + + if (scrollPtr->vertical) { + Ck_GeometryRequest(scrollPtr->winPtr, 1, 2 + MIN_SLIDER_LENGTH); + } else { + Ck_GeometryRequest(scrollPtr->winPtr, 2 + MIN_SLIDER_LENGTH, 1); + } +} + +/* + *-------------------------------------------------------------- + * + * ScrollbarPosition -- + * + * Determine the scrollbar element corresponding to a + * given position. + * + * Results: + * One of TOP_ARROW, TOP_GAP, etc., indicating which element + * of the scrollbar covers the position given by (x, y). If + * (x,y) is outside the scrollbar entirely, then OUTSIDE is + * returned. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +ScrollbarPosition(scrollPtr, x, y) + register Scrollbar *scrollPtr; /* Scrollbar widget record. */ + int x, y; /* Coordinates within scrollPtr's + * window. */ +{ + int length, width, tmp; + + if (scrollPtr->vertical) { + length = scrollPtr->winPtr->height; + width = scrollPtr->winPtr->width; + } else { + tmp = x; + x = y; + y = tmp; + length = scrollPtr->winPtr->width; + width = scrollPtr->winPtr->height; + } + + if (x < 0 || x >= width || y < 0 || y >= length) + return OUTSIDE; + + if (y == 0) + return TOP_ARROW; + if (y < scrollPtr->sliderFirst) + return TOP_GAP; + if (y < scrollPtr->sliderLast) + return SLIDER; + if (y == length - 1) + return BOTTOM_ARROW; + return BOTTOM_GAP; +} + +/* + *-------------------------------------------------------------- + * + * EventuallyRedraw -- + * + * Arrange for one or more of the fields of a scrollbar + * to be redrawn. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +EventuallyRedraw(scrollPtr) + register Scrollbar *scrollPtr; /* Information about widget. */ +{ + if ((scrollPtr->winPtr == NULL) || + !(scrollPtr->winPtr->flags & CK_MAPPED)) { + return; + } + if ((scrollPtr->flags & REDRAW_PENDING) == 0) { + Tk_DoWhenIdle(DisplayScrollbar, (ClientData) scrollPtr); + scrollPtr->flags |= REDRAW_PENDING; + } +} diff --git a/ckText.c b/ckText.c new file mode 100644 index 0000000..3e9d3c9 --- /dev/null +++ b/ckText.c @@ -0,0 +1,1580 @@ +/* + * ckText.c -- + * + * This module provides a big chunk of the implementation of + * multi-line editable text widgets for ck. Among other things, + * it provides the Tcl command interfaces to text widgets and + * the display code. The B-tree representation of text is + * implemented elsewhere. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "ckText.h" +#include "default.h" + +/* + * Information used to parse text configuration options: + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_TEXT_ATTR, Ck_Offset(CkText, attr), 0}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_TEXT_BG_COLOR, Ck_Offset(CkText, bg), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_TEXT_BG_MONO, Ck_Offset(CkText, bg), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_TEXT_FG, Ck_Offset(CkText, fg), 0}, + {CK_CONFIG_COORD, "-height", "height", "Height", + DEF_TEXT_HEIGHT, Ck_Offset(CkText, height), 0}, + {CK_CONFIG_ATTR, "-selectattributes", "selectAttributes", + "SelectAttributes", DEF_TEXT_SELECT_ATTR_COLOR, + Ck_Offset(CkText, selAttr), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-selectattributes", "selectAttributes", + "SelectAttributes", DEF_TEXT_SELECT_ATTR_MONO, + Ck_Offset(CkText, selAttr), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-selectbackground", "selectBackground", "Foreground", + DEF_TEXT_SELECT_BG_COLOR, Ck_Offset(CkText, selBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectbackground", "selectBackground", "Foreground", + DEF_TEXT_SELECT_BG_MONO, Ck_Offset(CkText, selBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_TEXT_SELECT_FG_COLOR, Ck_Offset(CkText, selFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_TEXT_SELECT_FG_MONO, Ck_Offset(CkText, selFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_UID, "-state", "state", "State", + DEF_TEXT_STATE, Ck_Offset(CkText, state), 0}, + {CK_CONFIG_STRING, "-tabs", "tabs", "Tabs", + DEF_TEXT_TABS, Ck_Offset(CkText, tabOptionString), CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_TEXT_TAKE_FOCUS, Ck_Offset(CkText, takeFocus), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_COORD, "-width", "width", "Width", + DEF_TEXT_WIDTH, Ck_Offset(CkText, width), 0}, + {CK_CONFIG_UID, "-wrap", "wrap", "Wrap", + DEF_TEXT_WRAP, Ck_Offset(CkText, wrapMode), 0}, + {CK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", + DEF_TEXT_XSCROLL_COMMAND, Ck_Offset(CkText, xScrollCmd), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", + DEF_TEXT_YSCROLL_COMMAND, Ck_Offset(CkText, yScrollCmd), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Ck_Uid's used to represent text states: + */ + +Ck_Uid ckTextCharUid = NULL; +Ck_Uid ckTextDisabledUid = NULL; +Ck_Uid ckTextNoneUid = NULL; +Ck_Uid ckTextNormalUid = NULL; +Ck_Uid ckTextWordUid = NULL; + +/* + * Boolean variable indicating whether or not special debugging code + * should be executed. + */ + +int ckTextDebug = 0; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp, + CkText *textPtr, int argc, char **argv, int flags)); +static int DeleteChars _ANSI_ARGS_((CkText *textPtr, + char *index1String, char *index2String)); +static void DestroyText _ANSI_ARGS_((ClientData clientData)); +static void InsertChars _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *indexPtr, char *string)); +static void TextCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void TextEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static int TextSearchCmd _ANSI_ARGS_((CkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); +static int TextWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +/* + *-------------------------------------------------------------- + * + * Ck_TextCmd -- + * + * This procedure is invoked to process the "text" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_TextCmd(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. */ +{ + CkWindow *mainPtr = (CkWindow *) clientData; + CkWindow *new; + register CkText *textPtr; + CkTextIndex startIndex; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Perform once-only initialization: + */ + + if (ckTextNormalUid == NULL) { + ckTextCharUid = Ck_GetUid("char"); + ckTextDisabledUid = Ck_GetUid("disabled"); + ckTextNoneUid = Ck_GetUid("none"); + ckTextNormalUid = Ck_GetUid("normal"); + ckTextWordUid = Ck_GetUid("word"); + } + + /* + * Create the window. + */ + + new = Ck_CreateWindowFromPath(interp, mainPtr, argv[1], 0); + if (new == NULL) { + return TCL_ERROR; + } + + textPtr = (CkText *) ckalloc(sizeof(CkText)); + textPtr->winPtr = new; + textPtr->interp = interp; + textPtr->widgetCmd = Tcl_CreateCommand(interp, + new->pathName, TextWidgetCmd, (ClientData) textPtr, + TextCmdDeletedProc); + textPtr->tree = CkBTreeCreate(); + Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS); + textPtr->numTags = 0; + Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS); + textPtr->state = ckTextNormalUid; + textPtr->bg = 0; + textPtr->fg = 0; + textPtr->attr = 0; + textPtr->tabOptionString = NULL; + textPtr->tabArrayPtr = NULL; + textPtr->wrapMode = ckTextCharUid; + textPtr->width = 0; + textPtr->height = 0; + textPtr->prevWidth = new->width; + textPtr->prevHeight = new->height; + CkTextCreateDInfo(textPtr); +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, 0, 0, &startIndex); +#else + CkTextMakeIndex(textPtr->tree, 0, 0, &startIndex); +#endif + CkTextSetYView(textPtr, &startIndex, 0); + textPtr->selTagPtr = NULL; + textPtr->selBg = 0; + textPtr->selFg = 0; + textPtr->selAttr = 0; + textPtr->abortSelections = 0; + textPtr->insertMarkPtr = NULL; + textPtr->bindingTable = NULL; + textPtr->currentMarkPtr = NULL; + textPtr->pickEvent.type = -1; + textPtr->numCurTags = 0; + textPtr->curTagArrayPtr = NULL; + textPtr->takeFocus = NULL; + textPtr->xScrollCmd = NULL; + textPtr->yScrollCmd = NULL; + textPtr->flags = 0; + + /* + * Create the "sel" tag and the "current" and "insert" marks. + */ + + textPtr->selTagPtr = CkTextCreateTag(textPtr, "sel"); + textPtr->currentMarkPtr = CkTextSetMark(textPtr, "current", &startIndex); + textPtr->insertMarkPtr = CkTextSetMark(textPtr, "insert", &startIndex); + + Ck_SetClass(new, "Text"); + Ck_CreateEventHandler(textPtr->winPtr, + CK_EV_EXPOSE | CK_EV_DESTROY | CK_EV_MAP | CK_EV_FOCUSIN | + CK_EV_FOCUSOUT, + TextEventProc, (ClientData) textPtr); + Ck_CreateEventHandler(textPtr->winPtr, CK_EV_KEYPRESS, + CkTextBindProc, (ClientData) textPtr); + if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) { + Ck_DestroyWindow(textPtr->winPtr); + return TCL_ERROR; + } + interp->result = textPtr->winPtr->pathName; + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * TextWidgetCmd -- + * + * This procedure is invoked to process the Tcl command + * that corresponds to a text widget. See the user + * documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +static int +TextWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about text widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + register CkText *textPtr = (CkText *) clientData; + int result = TCL_OK; + size_t length; + int c; + CkTextIndex index1, index2; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Ck_Preserve((ClientData) textPtr); + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) { + int x, y, width, height; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " bbox index\"", (char *) NULL); + result = TCL_ERROR; + goto done; + } + if (CkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (CkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) { + sprintf(interp->result, "%d %d %d %d", x, y, width, height); + } + } 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); + result = TCL_ERROR; + goto done; + } + result = Ck_ConfigureValue(interp, textPtr->winPtr, configSpecs, + (char *) textPtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0) + && (length >= 3)) { + int relation, value; + char *p; + + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " compare index1 op index2\"", (char *) NULL); + result = TCL_ERROR; + goto done; + } + if ((CkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) + || (CkTextGetIndex(interp, textPtr, argv[4], &index2) + != TCL_OK)) { + result = TCL_ERROR; + goto done; + } + relation = CkTextIndexCmp(&index1, &index2); + p = argv[3]; + if (p[0] == '<') { + value = (relation < 0); + if ((p[1] == '=') && (p[2] == 0)) { + value = (relation <= 0); + } else if (p[1] != 0) { + compareError: + Tcl_AppendResult(interp, "bad comparison operator \"", + argv[3], "\": must be <, <=, ==, >=, >, or !=", + (char *) NULL); + result = TCL_ERROR; + goto done; + } + } else if (p[0] == '>') { + value = (relation > 0); + if ((p[1] == '=') && (p[2] == 0)) { + value = (relation >= 0); + } else if (p[1] != 0) { + goto compareError; + } + } else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) { + value = (relation == 0); + } else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) { + value = (relation != 0); + } else { + goto compareError; + } + interp->result = (value) ? "1" : "0"; + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 3)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, textPtr->winPtr, configSpecs, + (char *) textPtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, textPtr->winPtr, configSpecs, + (char *) textPtr, argv[2], 0); + } else { + result = ConfigureText(interp, textPtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0) + && (length >= 3)) { + if (argc > 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " debug boolean\"", (char *) NULL); + result = TCL_ERROR; + goto done; + } + if (argc == 2) { + interp->result = (ckBTreeDebug) ? "1" : "0"; + } else { + if (Tcl_GetBoolean(interp, argv[2], &ckBTreeDebug) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + ckTextDebug = ckBTreeDebug; + } + } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0) + && (length >= 3)) { + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " delete index1 ?index2?\"", (char *) NULL); + result = TCL_ERROR; + goto done; + } + if (textPtr->state == ckTextNormalUid) { + result = DeleteChars(textPtr, argv[2], + (argc == 4) ? argv[3] : (char *) NULL); + } + } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0) + && (length >= 2)) { + int x, y, width, height, base; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " dlineinfo index\"", (char *) NULL); + result = TCL_ERROR; + goto done; + } + if (CkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (CkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base) + == 0) { + sprintf(interp->result, "%d %d %d %d %d", x, y, width, + height, base); + } + } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " get index1 ?index2?\"", (char *) NULL); + result = TCL_ERROR; + goto done; + } + if (CkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (argc == 3) { + index2 = index1; + CkTextIndexForwChars(&index2, 1, &index2); + } else if (CkTextGetIndex(interp, textPtr, argv[3], &index2) + != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (CkTextIndexCmp(&index1, &index2) >= 0) { + goto done; + } + while (1) { + int offset, last, savedChar; + CkTextSegment *segPtr; + + segPtr = CkTextIndexToSeg(&index1, &offset); + last = segPtr->size; + if (index1.linePtr == index2.linePtr) { + int last2; + + if (index2.charIndex == index1.charIndex) { + break; + } + last2 = index2.charIndex - index1.charIndex + offset; + if (last2 < last) { + last = last2; + } + } + if (segPtr->typePtr == &ckTextCharType) { + savedChar = segPtr->body.chars[last]; + segPtr->body.chars[last] = 0; + Tcl_AppendResult(interp, segPtr->body.chars + offset, + (char *) NULL); + segPtr->body.chars[last] = savedChar; + } + CkTextIndexForwChars(&index1, last-offset, &index1); + } + } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) + && (length >= 3)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " index index\"", + (char *) NULL); + result = TCL_ERROR; + goto done; + } + if (CkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + CkTextPrintIndex(&index1, interp->result); + } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) + && (length >= 3)) { + int i, j, numTags; + char **tagNames; + CkTextTag **oldTagArrayPtr; + + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], + " insert index chars ?tagList chars tagList ...?\"", + (char *) NULL); + result = TCL_ERROR; + goto done; + } + if (CkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (textPtr->state == ckTextNormalUid) { + for (j = 3; j < argc; j += 2) { + InsertChars(textPtr, &index1, argv[j]); + if (argc > (j+1)) { + CkTextIndexForwChars(&index1, (int) strlen(argv[j]), + &index2); + oldTagArrayPtr = CkBTreeGetTags(&index1, &numTags); + if (oldTagArrayPtr != NULL) { + for (i = 0; i < numTags; i++) { + CkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0); + } + ckfree((char *) oldTagArrayPtr); + } + if (Tcl_SplitList(interp, argv[j+1], &numTags, &tagNames) + != TCL_OK) { + result = TCL_ERROR; + goto done; + } + for (i = 0; i < numTags; i++) { + CkBTreeTag(&index1, &index2, + CkTextCreateTag(textPtr, tagNames[i]), 1); + } + ckfree((char *) tagNames); + index1 = index2; + } + } + } + } else if ((c == 'm') && (strncmp(argv[1], "mark", length) == 0)) { + result = CkTextMarkCmd(textPtr, interp, argc, argv); + } else if ((c == 's') && (strcmp(argv[1], "search") == 0) + && (length >= 3)) { + result = TextSearchCmd(textPtr, interp, argc, argv); + } else if ((c == 's') && (strcmp(argv[1], "see") == 0) && (length >= 3)) { + result = CkTextSeeCmd(textPtr, interp, argc, argv); + } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) { + result = CkTextTagCmd(textPtr, interp, argc, argv); +#if 0 + } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) { + result = CkTextWindowCmd(textPtr, interp, argc, argv); +#endif + } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { + result = CkTextXviewCmd(textPtr, interp, argc, argv); + } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0) + && (length >= 2)) { + result = CkTextYviewCmd(textPtr, interp, argc, argv); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be bbox, cget, compare, configure, debug, delete, ", + "dlineinfo, get, index, insert, mark, scan, search, see, ", + "tag, window, xview, or yview", + (char *) NULL); + result = TCL_ERROR; + } + + done: + Ck_Release((ClientData) textPtr); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyText -- + * + * This procedure is invoked by Ck_EventuallyFree or Ck_Release + * to clean up the internal structure of a text at a safe time + * (when no-one is using it anymore). + * + * Results: + * None. + * + * Side effects: + * Everything associated with the text is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyText(clientData) + ClientData clientData; /* Info about text widget. */ +{ + register CkText *textPtr = (CkText *) clientData; + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + CkTextTag *tagPtr; + + /* + * Free up all the stuff that requires special handling, then + * let Ck_FreeOptions handle all the standard option-related + * stuff. Special note: free up display-related information + * before deleting the B-tree, since display-related stuff + * may refer to stuff in the B-tree. + */ + + CkTextFreeDInfo(textPtr); + CkBTreeDestroy(textPtr->tree); + for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + tagPtr = (CkTextTag *) Tcl_GetHashValue(hPtr); + CkTextFreeTag(textPtr, tagPtr); + } + Tcl_DeleteHashTable(&textPtr->tagTable); + for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ckfree((char *) Tcl_GetHashValue(hPtr)); + } + Tcl_DeleteHashTable(&textPtr->markTable); + if (textPtr->tabArrayPtr != NULL) { + ckfree((char *) textPtr->tabArrayPtr); + } + if (textPtr->bindingTable != NULL) { + Ck_DeleteBindingTable(textPtr->bindingTable); + } + + /* + * NOTE: do NOT free up selBorder, selBdString, or selFgColorPtr: + * they are duplicates of information in the "sel" tag, which was + * freed up as part of deleting the tags above. + */ + + Ck_FreeOptions(configSpecs, (char *) textPtr, 0); + ckfree((char *) textPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureText -- + * + * This procedure is called to process an argv/argc list, plus + * the Ck option database, in order to configure (or + * reconfigure) a text widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as text string, colors, font, + * etc. get set for textPtr; old resources get freed, if there + * were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureText(interp, textPtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + register CkText *textPtr; /* 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 Ck_ConfigureWidget. */ +{ + if (Ck_ConfigureWidget(interp, textPtr->winPtr, configSpecs, + argc, argv, (char *) textPtr, flags) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A few other options also need special processing, such as parsing + * the geometry and setting the background from a 3-D border. + */ + + if ((textPtr->state != ckTextNormalUid) + && (textPtr->state != ckTextDisabledUid)) { + Tcl_AppendResult(interp, "bad state value \"", textPtr->state, + "\": must be normal or disabled", (char *) NULL); + textPtr->state = ckTextNormalUid; + return TCL_ERROR; + } + + if ((textPtr->wrapMode != ckTextCharUid) + && (textPtr->wrapMode != ckTextNoneUid) + && (textPtr->wrapMode != ckTextWordUid)) { + Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode, + "\": must be char, none, or word", (char *) NULL); + textPtr->wrapMode = ckTextCharUid; + return TCL_ERROR; + } + + /* + * Parse tab stops. + */ + + if (textPtr->tabArrayPtr != NULL) { + ckfree((char *) textPtr->tabArrayPtr); + textPtr->tabArrayPtr = NULL; + } + if (textPtr->tabOptionString != NULL) { + textPtr->tabArrayPtr = CkTextGetTabs(interp, textPtr->winPtr, + textPtr->tabOptionString); + if (textPtr->tabArrayPtr == NULL) { + Tcl_AddErrorInfo(interp,"\n (while processing -tabs option)"); + return TCL_ERROR; + } + } + + /* + * Make sure that configuration options are properly mirrored + * between the widget record and the "sel" tags. NOTE: we don't + * have to free up information during the mirroring; old + * information was freed when it was replaced in the widget + * record. + */ + + textPtr->selTagPtr->bg = textPtr->selBg; + textPtr->selTagPtr->fg = textPtr->selFg; + textPtr->selTagPtr->attr = textPtr->selAttr; + textPtr->selTagPtr->affectsDisplay = 0; +#if 0 +/* ??? */ + if ((textPtr->selTagPtr->border != NULL) + || (textPtr->selTagPtr->bdString != NULL) + || (textPtr->selTagPtr->reliefString != NULL) + || (textPtr->selTagPtr->bgStipple != None) + || (textPtr->selTagPtr->fgColor != NULL) + || (textPtr->selTagPtr->fontPtr != None) + || (textPtr->selTagPtr->fgStipple != None) + || (textPtr->selTagPtr->justifyString != NULL) + || (textPtr->selTagPtr->lMargin1String != NULL) + || (textPtr->selTagPtr->lMargin2String != NULL) + || (textPtr->selTagPtr->offsetString != NULL) + || (textPtr->selTagPtr->overstrikeString != NULL) + || (textPtr->selTagPtr->rMarginString != NULL) + || (textPtr->selTagPtr->spacing1String != NULL) + || (textPtr->selTagPtr->spacing2String != NULL) + || (textPtr->selTagPtr->spacing3String != NULL) + || (textPtr->selTagPtr->tabString != NULL) + || (textPtr->selTagPtr->underlineString != NULL) + || (textPtr->selTagPtr->wrapMode != NULL)) { + textPtr->selTagPtr->affectsDisplay = 1; + } +#endif + CkTextRedrawTag(textPtr, (CkTextIndex *) NULL, (CkTextIndex *) NULL, + textPtr->selTagPtr, 1); + + /* + * Register the desired geometry for the window, and arrange for + * the window to be redisplayed. + */ + + if (textPtr->width <= 0) { + textPtr->width = 1; + } + if (textPtr->height <= 0) { + textPtr->height = 1; + } + Ck_GeometryRequest(textPtr->winPtr, textPtr->width, textPtr->height); + + CkTextRelayoutWindow(textPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * TextEventProc -- + * + * This procedure is invoked by the Ck dispatcher on + * structure changes to a text. For texts with 3D + * borders, this procedure is also invoked for exposures. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +TextEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + register CkEvent *eventPtr; /* Information about event. */ +{ + register CkText *textPtr = (CkText *) clientData; + CkWindow *winPtr = textPtr->winPtr; + CkTextIndex index, index2; + + if (eventPtr->type == CK_EV_EXPOSE) { + if ((textPtr->prevWidth != winPtr->width) + || (textPtr->prevHeight != winPtr->height)) { + CkTextRelayoutWindow(textPtr); + textPtr->prevWidth = winPtr->width; + textPtr->prevHeight = winPtr->height; + } + CkTextRedrawRegion(textPtr, 0, 0, winPtr->width, winPtr->height); + } else if (eventPtr->type == CK_EV_DESTROY) { + if (textPtr->winPtr != NULL) { + textPtr->winPtr = NULL; + Tcl_DeleteCommand(textPtr->interp, + Tcl_GetCommandName(textPtr->interp, + textPtr->widgetCmd)); + } + Ck_EventuallyFree((ClientData) textPtr, (Ck_FreeProc *) DestroyText); + } else if ((eventPtr->type == CK_EV_FOCUSIN) + || (eventPtr->type == CK_EV_FOCUSOUT)) { + if (eventPtr->type == CK_EV_FOCUSIN) { + textPtr->flags |= GOT_FOCUS; + } else { + textPtr->flags &= ~GOT_FOCUS; + } + CkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index); + CkTextIndexForwChars(&index, 1, &index2); + CkTextChanged(textPtr, &index, &index2); + CkTextRedrawRegion(textPtr, 0, 0, winPtr->width, + winPtr->height); + } +} + +/* + *---------------------------------------------------------------------- + * + * TextCmdDeletedProc -- + * + * 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 +TextCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + CkText *textPtr = (CkText *) clientData; + CkWindow *winPtr = textPtr->winPtr; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case ckwin + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (winPtr != NULL) { + textPtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * InsertChars -- + * + * This procedure implements most of the functionality of the + * "insert" widget command. + * + * Results: + * None. + * + * Side effects: + * The characters in "string" get added to the text just before + * the character indicated by "indexPtr". + * + *---------------------------------------------------------------------- + */ + +static void +InsertChars(textPtr, indexPtr, string) + CkText *textPtr; /* Overall information about text widget. */ + CkTextIndex *indexPtr; /* Where to insert new characters. May be + * modified and/or invalidated. */ + char *string; /* Null-terminated string containing new + * information to add to text. */ +{ + int lineIndex; + + /* + * Don't allow insertions on the last (dummy) line of the text. + */ + + lineIndex = CkBTreeLineIndex(indexPtr->linePtr); + if (lineIndex == CkBTreeNumLines(textPtr->tree)) { + lineIndex--; +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, indexPtr); +#else + CkTextMakeIndex(textPtr->tree, lineIndex, 1000000, indexPtr); +#endif + } + + /* + * Notify the display module that lines are about to change, then do + * the insertion. + */ + + CkTextChanged(textPtr, indexPtr, indexPtr); + CkBTreeInsertChars(indexPtr, string); + + /* + * Invalidate any selection retrievals in progress. + */ + + textPtr->abortSelections = 1; +} + +/* + *---------------------------------------------------------------------- + * + * DeleteChars -- + * + * This procedure implements most of the functionality of the + * "delete" widget command. + * + * Results: + * Returns a standard Tcl result, and leaves an error message + * in textPtr->interp if there is an error. + * + * Side effects: + * Characters get deleted from the text. + * + *---------------------------------------------------------------------- + */ + +static int +DeleteChars(textPtr, index1String, index2String) + CkText *textPtr; /* Overall information about text widget. */ + char *index1String; /* String describing location of first + * character to delete. */ + char *index2String; /* String describing location of last + * character to delete. NULL means just + * delete the one character given by + * index1String. */ +{ + int line1, line2, line, charIndex, resetView; + CkTextIndex index1, index2; + + /* + * Parse the starting and stopping indices. + */ + + if (CkTextGetIndex(textPtr->interp, textPtr, index1String, &index1) + != TCL_OK) { + return TCL_ERROR; + } + if (index2String != NULL) { + if (CkTextGetIndex(textPtr->interp, textPtr, index2String, &index2) + != TCL_OK) { + return TCL_ERROR; + } + } else { + index2 = index1; + CkTextIndexForwChars(&index2, 1, &index2); + } + + /* + * Make sure there's really something to delete. + */ + + if (CkTextIndexCmp(&index1, &index2) >= 0) { + return TCL_OK; + } + + /* + * The code below is ugly, but it's needed to make sure there + * is always a dummy empty line at the end of the text. If the + * final newline of the file (just before the dummy line) is being + * deleted, then back up index to just before the newline. If + * there is a newline just before the first character being deleted, + * then back up the first index too, so that an even number of lines + * gets deleted. Furthermore, remove any tags that are present on + * the newline that isn't going to be deleted after all (this simulates + * deleting the newline and then adding a "clean" one back again). + */ + + line1 = CkBTreeLineIndex(index1.linePtr); + line2 = CkBTreeLineIndex(index2.linePtr); + if (line2 == CkBTreeNumLines(textPtr->tree)) { + CkTextTag **arrayPtr; + int arraySize, i; + CkTextIndex oldIndex2; + + oldIndex2 = index2; + CkTextIndexBackChars(&oldIndex2, 1, &index2); + line2--; + if ((index1.charIndex == 0) && (line1 != 0)) { + CkTextIndexBackChars(&index1, 1, &index1); + line1--; + } + arrayPtr = CkBTreeGetTags(&index2, &arraySize); + if (arrayPtr != NULL) { + for (i = 0; i < arraySize; i++) { + CkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0); + } + ckfree((char *) arrayPtr); + } + } + + /* + * Tell the display what's about to happen so it can discard + * obsolete display information, then do the deletion. Also, + * if the deletion involves the top line on the screen, then + * we have to reset the view (the deletion will invalidate + * textPtr->topIndex). Compute what the new first character + * will be, then do the deletion, then reset the view. + */ + + CkTextChanged(textPtr, &index1, &index2); + resetView = line = charIndex = 0; + if (CkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) { + if (CkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) { + /* + * Deletion range straddles topIndex: use the beginning + * of the range as the new topIndex. + */ + + resetView = 1; + line = line1; + charIndex = index1.charIndex; + } else if (index1.linePtr == textPtr->topIndex.linePtr) { + /* + * Deletion range starts on top line but after topIndex. + * Use the current topIndex as the new one. + */ + + resetView = 1; + line = line1; + charIndex = textPtr->topIndex.charIndex; + } + } else if (index2.linePtr == textPtr->topIndex.linePtr) { + /* + * Deletion range ends on top line but before topIndex. + * Figure out what will be the new character index for + * the character currently pointed to by topIndex. + */ + + resetView = 1; + line = line2; + charIndex = textPtr->topIndex.charIndex; + if (index1.linePtr != index2.linePtr) { + charIndex -= index2.charIndex; + } else { + charIndex -= (index2.charIndex - index1.charIndex); + } + } + CkBTreeDeleteChars(&index1, &index2); + if (resetView) { +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, line, charIndex, &index1); +#else + CkTextMakeIndex(textPtr->tree, line, charIndex, &index1); +#endif + CkTextSetYView(textPtr, &index1, 0); + } + + /* + * Invalidate any selection retrievals in progress. + */ + + textPtr->abortSelections = 1; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TextSearchCmd -- + * + * This procedure is invoked to process the "search" widget command + * for text widgets. See the user documentation for details on what + * it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +TextSearchCmd(textPtr, interp, argc, argv) + CkText *textPtr; /* Information about text widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + int backwards, exact, c, i, argsLeft, noCase, leftToScan; + size_t length; + int numLines, startingLine, startingChar, lineNum, firstChar, lastChar; + int code, matchLength, matchChar, passes, stopLine, searchWholeText; + int patLength; + char *arg, *pattern, *varName, *p, *startOfLine; + char buffer[20]; + CkTextIndex index, stopIndex; + Tcl_DString line, patDString; + CkTextSegment *segPtr; + CkTextLine *linePtr; + Tcl_RegExp regexp = NULL; /* Initialization needed only to + * prevent compiler warning. */ + + /* + * Parse switches and other arguments. + */ + + exact = 1; + backwards = 0; + noCase = 0; + varName = NULL; + for (i = 2; i < argc; i++) { + arg = argv[i]; + if (arg[0] != '-') { + break; + } + length = strlen(arg); + if (length < 2) { + badSwitch: + Tcl_AppendResult(interp, "bad switch \"", arg, + "\": must be -forward, -backward, -exact, -regexp, ", + "-nocase, -count, or --", (char *) NULL); + return TCL_ERROR; + } + c = arg[1]; + if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) { + backwards = 1; + } else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) { + if (i >= (argc-1)) { + interp->result = "no value given for \"-count\" option"; + return TCL_ERROR; + } + i++; + varName = argv[i]; + } else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) { + exact = 1; + } else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) { + backwards = 0; + } else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0)) { + noCase = 1; + } else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0)) { + exact = 0; + } else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) { + i++; + break; + } else { + goto badSwitch; + } + } + argsLeft = argc - (i+2); + if ((argsLeft != 0) && (argsLeft != 1)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " search ?switches? pattern index ?stopIndex?", + (char *) NULL); + return TCL_ERROR; + } + pattern = argv[i]; + + /* + * Convert the pattern to lower-case if we're supposed to ignore case. + */ + + if (noCase) { + Tcl_DStringInit(&patDString); + Tcl_DStringAppend(&patDString, pattern, -1); + pattern = Tcl_DStringValue(&patDString); +#if CK_USE_UTF + Tcl_UtfToLower(pattern); +#else + for (p = pattern; *p != 0; p++) { + if (isupper((unsigned char) *p)) { + *p = tolower((unsigned char) *p); + } + } +#endif + } + + if (CkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) { + return TCL_ERROR; + } + numLines = CkBTreeNumLines(textPtr->tree); + startingLine = CkBTreeLineIndex(index.linePtr); + startingChar = index.charIndex; + if (startingLine >= numLines) { + if (backwards) { + startingLine = CkBTreeNumLines(textPtr->tree) - 1; + startingChar = CkBTreeCharsInLine(CkBTreeFindLine(textPtr->tree, + startingLine)); + } else { + startingLine = 0; + startingChar = 0; + } + } + if (argsLeft == 1) { + if (CkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) { + return TCL_ERROR; + } + stopLine = CkBTreeLineIndex(stopIndex.linePtr); + if (!backwards && (stopLine == numLines)) { + stopLine = numLines-1; + } + searchWholeText = 0; + } else { + stopLine = 0; + searchWholeText = 1; + } + + /* + * Scan through all of the lines of the text circularly, starting + * at the given index. + */ + + matchLength = patLength = 0; /* Only needed to prevent compiler + * warnings. */ + if (exact) { + patLength = strlen(pattern); + } else { + regexp = Tcl_RegExpCompile(interp, pattern); + if (regexp == NULL) { + return TCL_ERROR; + } + } + lineNum = startingLine; + code = TCL_OK; + Tcl_DStringInit(&line); + for (passes = 0; passes < 2; ) { + if (lineNum >= numLines) { + /* + * Don't search the dummy last line of the text. + */ + + goto nextLine; + } + + /* + * Extract the text from the line. If we're doing regular + * expression matching, drop the newline from the line, so + * that "$" can be used to match the end of the line. + */ + + linePtr = CkBTreeFindLine(textPtr->tree, lineNum); + for (segPtr = linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + if (segPtr->typePtr != &ckTextCharType) { + continue; + } + Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size); + } + if (!exact) { + Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1); + } + startOfLine = Tcl_DStringValue(&line); + + /* + * If we're ignoring case, convert the line to lower case. + */ + + if (noCase) { +#if CK_USE_UTF + Tcl_DStringSetLength(&line, + Tcl_UtfToLower(Tcl_DStringValue(&line))); +#else + for (p = Tcl_DStringValue(&line); *p != 0; p++) { + if (isupper((unsigned char) *p)) { + *p = tolower((unsigned char) *p); + } + } +#endif + } + + /* + * Check for matches within the current line. If so, and if we're + * searching backwards, repeat the search to find the last match + * in the line. + */ + + matchChar = -1; + firstChar = 0; + lastChar = INT_MAX; + if (lineNum == startingLine) { + int indexInDString; + + /* + * The starting line is tricky: the first time we see it + * we check one part of the line, and the second pass through + * we check the other part of the line. We have to be very + * careful here because there could be embedded windows or + * other things that are not in the extracted line. Rescan + * the original line to compute the index in it of the first + * character. + */ + + indexInDString = startingChar; + for (segPtr = linePtr->segPtr, leftToScan = startingChar; + leftToScan > 0; segPtr = segPtr->nextPtr) { + if (segPtr->typePtr != &ckTextCharType) { + indexInDString -= segPtr->size; + } + leftToScan -= segPtr->size; + } + + passes++; + if ((passes == 1) ^ backwards) { + /* + * Only use the last part of the line. + */ + + firstChar = indexInDString; + if (firstChar >= Tcl_DStringLength(&line)) { + goto nextLine; + } + } else { + /* + * Use only the first part of the line. + */ + + lastChar = indexInDString; + } + } + do { + int thisLength; +#if CK_USE_UTF + Tcl_UniChar ch; +#endif + + if (exact) { + p = strstr(startOfLine + firstChar, pattern); + if (p == NULL) { + break; + } + i = p - startOfLine; + thisLength = patLength; + } else { + char *start, *end; + int match; + + match = Tcl_RegExpExec(interp, regexp, + startOfLine + firstChar, startOfLine); + if (match < 0) { + code = TCL_ERROR; + goto done; + } + if (!match) { + break; + } + Tcl_RegExpRange(regexp, 0, &start, &end); + i = start - startOfLine; + thisLength = end - start; + } + if (i >= lastChar) { + break; + } + matchChar = i; + matchLength = thisLength; +#if CK_USE_UTF + firstChar = i + Tcl_UtfToUniChar(startOfLine + matchChar, &ch); +#else + firstChar = matchChar+1; +#endif + } while (backwards); + + /* + * If we found a match then we're done. Make sure that + * the match occurred before the stopping index, if one was + * specified. + */ + + if (matchChar >= 0) { +#if CK_USE_UTF + int numChars; + + numChars = Tcl_NumUtfChars(startOfLine + matchChar, + matchLength); +#endif + + /* + * The index information returned by the regular expression + * parser only considers textual information: it doesn't + * account for embedded windows or any other non-textual info. + * Scan through the line's segments again to adjust both + * matchChar and matchCount. + */ + + for (segPtr = linePtr->segPtr, leftToScan = matchChar; + leftToScan >= 0; segPtr = segPtr->nextPtr) { + if (segPtr->typePtr != &ckTextCharType) { + matchChar += segPtr->size; + continue; + } + leftToScan -= segPtr->size; + } + for (leftToScan += matchLength; leftToScan > 0; + segPtr = segPtr->nextPtr) { + if (segPtr->typePtr != &ckTextCharType) { +#if CK_USE_UTF + numChars += segPtr->size; +#else + matchLength += segPtr->size; +#endif + continue; + } + leftToScan -= segPtr->size; + } +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, lineNum, matchChar, &index); +#else + CkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index); +#endif + if (!searchWholeText) { + if (!backwards && (CkTextIndexCmp(&index, &stopIndex) >= 0)) { + goto done; + } + if (backwards && (CkTextIndexCmp(&index, &stopIndex) < 0)) { + goto done; + } + } + if (varName != NULL) { +#if CK_USE_UTF + sprintf(buffer, "%d", numChars); +#else + sprintf(buffer, "%d", matchLength); +#endif + if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG) + == NULL) { + code = TCL_ERROR; + goto done; + } + } + CkTextPrintIndex(&index, interp->result); + goto done; + } + + /* + * Go to the next (or previous) line; + */ + + nextLine: + if (backwards) { + lineNum--; + if (!searchWholeText) { + if (lineNum < stopLine) { + break; + } + } else if (lineNum < 0) { + lineNum = numLines-1; + } + } else { + lineNum++; + if (!searchWholeText) { + if (lineNum > stopLine) { + break; + } + } else if (lineNum >= numLines) { + lineNum = 0; + } + } + Tcl_DStringSetLength(&line, 0); + } + done: + Tcl_DStringFree(&line); + if (noCase) { + Tcl_DStringFree(&patDString); + } + return code; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextGetTabs -- + * + * Parses a string description of a set of tab stops. + * + * Results: + * The return value is a pointer to a malloc'ed structure holding + * parsed information about the tab stops. If an error occurred + * then the return value is NULL and an error message is left in + * interp->result. + * + * Side effects: + * Memory is allocated for the structure that is returned. It is + * up to the caller to free this structure when it is no longer + * needed. + * + *---------------------------------------------------------------------- + */ + +CkTextTabArray * +CkTextGetTabs(interp, winPtr, string) + Tcl_Interp *interp; /* Used for error reporting. */ + CkWindow *winPtr; /* Window in which the tabs will be + * used. */ + char *string; /* Description of the tab stops. See + * text manual entry for details. */ +{ + int argc, i, count, c; + char **argv; + CkTextTabArray *tabArrayPtr; + CkTextTab *tabPtr; +#if CK_USE_UTF + Tcl_UniChar ch; +#endif + + if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) { + return NULL; + } + + /* + * First find out how many entries we need to allocate in the + * tab array. + */ + + count = 0; + for (i = 0; i < argc; i++) { + c = argv[i][0]; + if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) { + count++; + } + } + + /* + * Parse the elements of the list one at a time to fill in the + * array. + */ + + tabArrayPtr = (CkTextTabArray *) ckalloc((unsigned) + (sizeof(CkTextTabArray) + (count-1)*sizeof(CkTextTab))); + tabArrayPtr->numTabs = 0; + for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i < argc; i++, tabPtr++) { + if (Ck_GetCoord(interp, winPtr, argv[i], &tabPtr->location) + != TCL_OK) { + goto error; + } + tabArrayPtr->numTabs++; + + /* + * See if there is an explicit alignment in the next list + * element. Otherwise just use "left". + */ + + tabPtr->alignment = LEFT; + if ((i+1) == argc) { + continue; + } +#if CK_USE_UTF + Tcl_UtfToUniChar(argv[i+1], &ch); + if (!Tcl_UniCharIsAlpha(ch)) { + continue; + } +#else + c = (unsigned char) argv[i+1][0]; + if (!isalpha(c)) { + continue; + } +#endif + i += 1; + if ((c == 'l') && (strncmp(argv[i], "left", + strlen(argv[i])) == 0)) { + tabPtr->alignment = LEFT; + } else if ((c == 'r') && (strncmp(argv[i], "right", + strlen(argv[i])) == 0)) { + tabPtr->alignment = RIGHT; + } else if ((c == 'c') && (strncmp(argv[i], "center", + strlen(argv[i])) == 0)) { + tabPtr->alignment = CENTER; + } else if ((c == 'n') && (strncmp(argv[i], + "numeric", strlen(argv[i])) == 0)) { + tabPtr->alignment = NUMERIC; + } else { + Tcl_AppendResult(interp, "bad tab alignment \"", + argv[i], "\": must be left, right, center, or numeric", + (char *) NULL); + goto error; + } + } + ckfree((char *) argv); + return tabArrayPtr; + + error: + ckfree((char *) tabArrayPtr); + ckfree((char *) argv); + return NULL; +} diff --git a/ckText.h b/ckText.h new file mode 100644 index 0000000..bc2df01 --- /dev/null +++ b/ckText.h @@ -0,0 +1,703 @@ +/* + * ckText.h -- + * + * Declarations shared among the files that implement text + * widgets. + * + * Copyright (c) 1992-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. + * + */ + +#ifndef _CKTEXT_H +#define _CKTEXT_H + +#ifndef _CK +#include "ck.h" +#endif + +/* + * Opaque types for structures whose guts are only needed by a single + * file: + */ + +typedef struct CkTextBTree *CkTextBTree; + +/* + * The data structure below defines a single line of text (from newline + * to newline, not necessarily what appears on one line of the screen). + */ + +typedef struct CkTextLine { + struct Node *parentPtr; /* Pointer to parent node containing + * line. */ + struct CkTextLine *nextPtr; /* Next in linked list of lines with + * same parent node in B-tree. NULL + * means end of list. */ + struct CkTextSegment *segPtr; /* First in ordered list of segments + * that make up the line. */ +} CkTextLine; + +/* + * ----------------------------------------------------------------------- + * Segments: each line is divided into one or more segments, where each + * segment is one of several things, such as a group of characters, a + * tag toggle, a mark, or an embedded widget. Each segment starts with + * a standard header followed by a body that varies from type to type. + * ----------------------------------------------------------------------- + */ + +/* + * The data structure below defines the body of a segment that represents + * a tag toggle. There is one of these structures at both the beginning + * and end of each tagged range. + */ + +typedef struct CkTextToggle { + struct CkTextTag *tagPtr; /* Tag that starts or ends here. */ + int inNodeCounts; /* 1 means this toggle has been + * accounted for in node toggle + * counts; 0 means it hasn't, yet. */ +} CkTextToggle; + +/* + * The data structure below defines line segments that represent + * marks. There is one of these for each mark in the text. + */ + +typedef struct CkTextMark { + struct CkText *textPtr; /* Overall information about text + * widget. */ + CkTextLine *linePtr; /* Line structure that contains the + * segment. */ + Tcl_HashEntry *hPtr; /* Pointer to hash table entry for mark + * (in textPtr->markTable). */ +} CkTextMark; + +/* + * A structure of the following type holds information for each window + * embedded in a text widget. This information is only used by the + * file ckTextWind.c + */ + +typedef struct CkTextEmbWindow { + struct CkText *textPtr; /* Information about the overall text + * widget. */ + CkTextLine *linePtr; /* Line structure that contains this + * window. */ + CkWindow winPtr; /* Window for this segment. NULL + * means that the window hasn't + * been created yet. */ + char *create; /* Script to create window on-demand. + * NULL means no such script. + * Malloc-ed. */ + int align; /* How to align window in vertical + * space. See definitions in + * ckTextWind.c. */ + int padX, padY; /* Padding to leave around each side + * of window, in pixels. */ + int stretch; /* Should window stretch to fill + * vertical space of line (except for + * pady)? 0 or 1. */ + int chunkCount; /* Number of display chunks that + * refer to this window. */ + int displayed; /* Non-zero means that the window + * has been displayed on the screen + * recently. */ +} CkTextEmbWindow; + +/* + * The data structure below defines line segments. + */ + +typedef struct CkTextSegment { + struct Ck_SegType *typePtr; /* Pointer to record describing + * segment's type. */ + struct CkTextSegment *nextPtr; /* Next in list of segments for this + * line, or NULL for end of list. */ + int size; /* Size of this segment (# of bytes + * of index space it occupies). */ + union { + char chars[4]; /* Characters that make up character + * info. Actual length varies to + * hold as many characters as needed.*/ + CkTextToggle toggle; /* Information about tag toggle. */ + CkTextMark mark; /* Information about mark. */ + CkTextEmbWindow ew; /* Information about embedded + * window. */ + } body; +} CkTextSegment; + +/* + * Data structures of the type defined below are used during the + * execution of Tcl commands to keep track of various interesting + * places in a text. An index is only valid up until the next + * modification to the character structure of the b-tree so they + * can't be retained across Tcl commands. However, mods to marks + * or tags don't invalidate indices. + */ + +typedef struct CkTextIndex { + CkTextBTree tree; /* Tree containing desired position. */ + CkTextLine *linePtr; /* Pointer to line containing position + * of interest. */ + int charIndex; /* Index within line of desired + * character (0 means first one). */ +} CkTextIndex; + +/* + * Types for procedure pointers stored in CkTextDispChunk strutures: + */ + +typedef struct CkTextDispChunk CkTextDispChunk; + +typedef void Ck_ChunkDisplayProc _ANSI_ARGS_(( + CkTextDispChunk *chunkPtr, int x, int y, + int height, int baseline, WINDOW *window, + int screenY)); +typedef void Ck_ChunkUndisplayProc _ANSI_ARGS_(( + struct CkText *textPtr, + CkTextDispChunk *chunkPtr)); +typedef int Ck_ChunkMeasureProc _ANSI_ARGS_(( + CkTextDispChunk *chunkPtr, int x)); +typedef void Ck_ChunkBboxProc _ANSI_ARGS_(( + CkTextDispChunk *chunkPtr, int index, int y, + int lineHeight, int baseline, int *xPtr, + int *yPtr, int *widthPtr, int *heightPtr)); + +/* + * The structure below represents a chunk of stuff that is displayed + * together on the screen. This structure is allocated and freed by + * generic display code but most of its fields are filled in by + * segment-type-specific code. + */ + +struct CkTextDispChunk { + /* + * The fields below are set by the type-independent code before + * calling the segment-type-specific layoutProc. They should not + * be modified by segment-type-specific code. + */ + + int x; /* X position of chunk, in pixels. + * This position is measured from the + * left edge of the logical line, + * not from the left edge of the + * window (i.e. it doesn't change + * under horizontal scrolling). */ + struct CkTextDispChunk *nextPtr; /* Next chunk in the display line + * or NULL for the end of the list. */ + struct Style *stylePtr; /* Display information, known only + * to ckTextDisp.c. */ + + /* + * The fields below are set by the layoutProc that creates the + * chunk. + */ + + Ck_ChunkDisplayProc *displayProc; /* Procedure to invoke to draw this + * chunk on the display or an + * off-screen pixmap. */ + Ck_ChunkUndisplayProc *undisplayProc; + /* Procedure to invoke when segment + * ceases to be displayed on screen + * anymore. */ + Ck_ChunkMeasureProc *measureProc; /* Procedure to find character under + * a given x-location. */ + Ck_ChunkBboxProc *bboxProc; /* Procedure to find bounding box + * of character in chunk. */ + int numChars; /* Number of characters that will be + * displayed in the chunk. */ + int minHeight; /* Minimum total line height needed + * by this chunk. */ + int width; /* Width of this chunk, in pixels. + * Initially set by chunk-specific + * code, but may be increased to + * include tab or extra space at end + * of line. */ + int breakIndex; /* Index within chunk of last + * acceptable position for a line + * (break just before this character). + * <= 0 means don't break during or + * immediately after this chunk. */ + ClientData clientData; /* Additional information for use + * of displayProc and undisplayProc. */ +}; + +/* + * One data structure of the following type is used for each tag in a + * text widget. These structures are kept in textPtr->tagTable and + * referred to in other structures. + */ + +typedef struct CkTextTag { + char *name; /* Name of this tag. This field is actually + * a pointer to the key from the entry in + * textPtr->tagTable, so it needn't be freed + * explicitly. */ + int priority; /* Priority of this tag within widget. 0 + * means lowest priority. Exactly one tag + * has each integer value between 0 and + * numTags-1. */ + + /* + * Information for displaying text with this tag. The information + * belows acts as an override on information specified by lower-priority + * tags. If no value is specified, then the next-lower-priority tag + * on the text determins the value. The text widget itself provides + * defaults if no tag specifies an override. + */ + + int bg, fg, attr; /* Foreground/background/video attributes + * for text. -1 means no value specified. */ + char *justifyString; /* -justify option string (malloc-ed). + * NULL means option not specified. */ + Ck_Justify justify; /* How to justify text: CK_JUSTIFY_LEFT, + * CK_JUSTIFY_RIGHT, or CK_JUSTIFY_CENTER. + * Only valid if justifyString is non-NULL. */ + char *lMargin1String; /* -lmargin1 option string (malloc-ed). + * NULL means option not specified. */ + int lMargin1; /* Left margin for first display line of + * each text line, in pixels. Only valid + * if lMargin1String is non-NULL. */ + char *lMargin2String; /* -lmargin2 option string (malloc-ed). + * NULL means option not specified. */ + int lMargin2; /* Left margin for second and later display + * lines of each text line, in pixels. Only + * valid if lMargin2String is non-NULL. */ + char *rMarginString; /* -rmargin option string (malloc-ed). + * NULL means option not specified. */ + int rMargin; /* Right margin for text, in pixels. Only + * valid if rMarginString is non-NULL. */ + char *tabString; /* -tabs option string (malloc-ed). + * NULL means option not specified. */ + struct CkTextTabArray *tabArrayPtr; + /* Info about tabs for tag (malloc-ed) + * or NULL. Corresponds to tabString. */ + Ck_Uid wrapMode; /* How to handle wrap-around for this tag. + * Must be ckTextCharUid, ckTextNoneUid, + * ckTextWordUid, or NULL to use wrapMode + * for whole widget. */ + int affectsDisplay; /* Non-zero means that this tag affects the + * way information is displayed on the screen + * (so need to redisplay if tag changes). */ +} CkTextTag; + +#define TK_TAG_AFFECTS_DISPLAY 0x1 +#define TK_TAG_UNDERLINE 0x2 +#define TK_TAG_JUSTIFY 0x4 +#define TK_TAG_OFFSET 0x10 + +/* + * The data structure below is used for searching a B-tree for transitions + * on a single tag (or for all tag transitions). No code outside of + * ckTextBTree.c should ever modify any of the fields in these structures, + * but it's OK to use them for read-only information. + */ + +typedef struct CkTextSearch { + CkTextIndex curIndex; /* Position of last tag transition + * returned by CkBTreeNextTag, or + * index of start of segment + * containing starting position for + * search if CkBTreeNextTag hasn't + * been called yet, or same as + * stopIndex if search is over. */ + CkTextSegment *segPtr; /* Actual tag segment returned by last + * call to CkBTreeNextTag, or NULL if + * CkBTreeNextTag hasn't returned + * anything yet. */ + CkTextSegment *nextPtr; /* Where to resume search in next + * call to CkBTreeNextTag. */ + CkTextSegment *lastPtr; /* Stop search before just before + * considering this segment. */ + CkTextTag *tagPtr; /* Tag to search for (or tag found, if + * allTags is non-zero). */ + int linesLeft; /* Lines left to search (including + * curIndex and stopIndex). When + * this becomes <= 0 the search is + * over. */ + int allTags; /* Non-zero means ignore tag check: + * search for transitions on all + * tags. */ +} CkTextSearch; + +/* + * The following data structure describes a single tab stop. + */ + +typedef enum {LEFT, RIGHT, CENTER, NUMERIC} CkTextTabAlign; + +typedef struct CkTextTab { + int location; /* Offset in pixels of this tab stop + * from the left margin (lmargin2) of + * the text. */ + CkTextTabAlign alignment; /* Where the tab stop appears relative + * to the text. */ +} CkTextTab; + +typedef struct CkTextTabArray { + int numTabs; /* Number of tab stops. */ + CkTextTab tabs[1]; /* Array of tabs. The actual size + * will be numTabs. THIS FIELD MUST + * BE THE LAST IN THE STRUCTURE. */ +} CkTextTabArray; + +/* + * A data structure of the following type is kept for each text widget that + * currently exists for this process: + */ + +typedef struct CkText { + CkWindow *winPtr; /* Window that embodies the text. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with widget. Used + * to delete widget command. */ + Tcl_Command widgetCmd; /* Token for text's widget command. */ + CkTextBTree tree; /* B-tree representation of text and tags for + * widget. */ + Tcl_HashTable tagTable; /* Hash table that maps from tag names to + * pointers to CkTextTag structures. */ + int numTags; /* Number of tags currently defined for + * widget; needed to keep track of + * priorities. */ + Tcl_HashTable markTable; /* Hash table that maps from mark names to + * pointers to mark segments. */ + Tcl_HashTable windowTable; /* Hash table that maps from window names + * to pointers to window segments. If a + * window segment doesn't yet have an + * associated window, there is no entry for + * it here. */ + Ck_Uid state; /* Normal or disabled. Text is read-only + * when disabled. */ + + /* + * Default information for displaying (may be overridden by tags + * applied to ranges of characters). + */ + + int bg, fg, attr; + char *tabOptionString; /* Value of -tabs option string (malloc'ed). */ + CkTextTabArray *tabArrayPtr; + /* Information about tab stops (malloc'ed). + * NULL means perform default tabbing + * behavior. */ + + /* + * Additional information used for displaying: + */ + + Ck_Uid wrapMode; /* How to handle wrap-around. Must be + * ckTextCharUid, ckTextNoneUid, or + * ckTextWordUid. */ + int width, height; /* Desired dimensions for window, measured + * in characters. */ + int prevWidth, prevHeight; /* Last known dimensions of window; used to + * detect changes in size. */ + CkTextIndex topIndex; /* Identifies first character in top display + * line of window. */ + struct DInfo *dInfoPtr; /* Information maintained by ckTextDisp.c. */ + + /* + * Information related to selection. + */ + + int selFg, selBg, selAttr; + CkTextTag *selTagPtr; /* Pointer to "sel" tag. Used to tell when + * a new selection has been made. */ + CkTextIndex selIndex; /* Used during multi-pass selection retrievals. + * This index identifies the next character + * to be returned from the selection. */ + int abortSelections; /* Set to 1 whenever the text is modified + * in a way that interferes with selection + * retrieval: used to abort incremental + * selection retrievals. */ + int selOffset; /* Offset in selection corresponding to + * selLine and selCh. -1 means neither + * this information nor selIndex is of any + * use. */ + int insertX, insertY; /* Window coordinates of HW cursor. */ + + /* + * Information related to insertion cursor: + */ + + CkTextSegment *insertMarkPtr; + /* Points to segment for "insert" mark. */ + + /* + * Information used for event bindings associated with tags: + */ + + Ck_BindingTable bindingTable; + /* Table of all bindings currently defined + * for this widget. NULL means that no + * bindings exist, so the table hasn't been + * created. Each "object" used for this + * table is the address of a tag. */ + CkTextSegment *currentMarkPtr; + /* Pointer to segment for "current" mark, + * or NULL if none. */ + CkEvent pickEvent; /* The event from which the current character + * was chosen. Must be saved so that we + * can repick after modifications to the + * text. */ + int numCurTags; /* Number of tags associated with character + * at current mark. */ + CkTextTag **curTagArrayPtr; /* Pointer to array of tags for current + * mark, or NULL if none. */ + + /* + * Miscellaneous additional information: + */ + + char *takeFocus; /* Value of -takeFocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + char *xScrollCmd; /* Prefix of command to issue to update + * horizontal scrollbar when view changes. */ + char *yScrollCmd; /* Prefix of command to issue to update + * vertical scrollbar when view changes. */ + int flags; /* Miscellaneous flags; see below for + * definitions. */ +} CkText; + +/* + * Flag values for CkText records: + * + * GOT_SELECTION: Non-zero means we've already claimed the + * selection. + * INSERT_ON: Non-zero means insertion cursor should be + * displayed on screen. + * GOT_FOCUS: Non-zero means this window has the input + * focus. + * UPDATE_SCROLLBARS: Non-zero means scrollbar(s) should be updated + * during next redisplay operation. + */ + +#define GOT_SELECTION 1 +#define INSERT_ON 2 +#define GOT_FOCUS 4 +#define UPDATE_SCROLLBARS 0x10 +#define NEED_REPICK 0x20 + +/* + * Records of the following type define segment types in terms of + * a collection of procedures that may be called to manipulate + * segments of that type. + */ + +typedef CkTextSegment * Ck_SegSplitProc _ANSI_ARGS_(( + struct CkTextSegment *segPtr, int index)); +typedef int Ck_SegDeleteProc _ANSI_ARGS_(( + struct CkTextSegment *segPtr, + CkTextLine *linePtr, int treeGone)); +typedef CkTextSegment * Ck_SegCleanupProc _ANSI_ARGS_(( + struct CkTextSegment *segPtr, CkTextLine *linePtr)); +typedef void Ck_SegLineChangeProc _ANSI_ARGS_(( + struct CkTextSegment *segPtr, CkTextLine *linePtr)); +typedef int Ck_SegLayoutProc _ANSI_ARGS_((struct CkText *textPtr, + struct CkTextIndex *indexPtr, CkTextSegment *segPtr, + int offset, int maxX, int maxChars, + int noCharsYet, Ck_Uid wrapMode, + struct CkTextDispChunk *chunkPtr)); +typedef void Ck_SegCheckProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); + +typedef struct Ck_SegType { + char *name; /* Name of this kind of segment. */ + int leftGravity; /* If a segment has zero size (e.g. a + * mark or tag toggle), does it + * attach to character to its left + * or right? 1 means left, 0 means + * right. */ + Ck_SegSplitProc *splitProc; /* Procedure to split large segment + * into two smaller ones. */ + Ck_SegDeleteProc *deleteProc; /* Procedure to call to delete + * segment. */ + Ck_SegCleanupProc *cleanupProc; /* After any change to a line, this + * procedure is invoked for all + * segments left in the line to + * perform any cleanup they wish + * (e.g. joining neighboring + * segments). */ + Ck_SegLineChangeProc *lineChangeProc; + /* Invoked when a segment is about + * to be moved from its current line + * to an earlier line because of + * a deletion. The linePtr is that + * for the segment's old line. + * CleanupProc will be invoked after + * the deletion is finished. */ + Ck_SegLayoutProc *layoutProc; /* Returns size information when + * figuring out what to display in + * window. */ + Ck_SegCheckProc *checkProc; /* Called during consistency checks + * to check internal consistency of + * segment. */ +} Ck_SegType; + +/* + * The constant below is used to specify a line when what is really + * wanted is the entire text. For now, just use a very big number. + */ + +#define TK_END_OF_TEXT 1000000 + +/* + * The following definition specifies the maximum number of characters + * needed in a string to hold a position specifier. + */ + +#define TK_POS_CHARS 30 + +/* + * Declarations for variables shared among the text-related files: + */ + +extern int ckBTreeDebug; +extern int ckTextDebug; +extern Ck_SegType ckTextCharType; +extern Ck_Uid ckTextCharUid; +extern Ck_Uid ckTextDisabledUid; +extern Ck_SegType ckTextLeftMarkType; +extern Ck_Uid ckTextNoneUid; +extern Ck_Uid ckTextNormalUid; +extern Ck_SegType ckTextRightMarkType; +extern Ck_SegType ckTextToggleOnType; +extern Ck_SegType ckTextToggleOffType; +extern Ck_Uid ckTextWordUid; + +/* + * Declarations for procedures that are used by the text-related files + * but shouldn't be used anywhere else in Ck (or by Ck clients): + */ + +extern int CkBTreeCharTagged _ANSI_ARGS_((CkTextIndex *indexPtr, + CkTextTag *tagPtr)); +extern void CkBTreeCheck _ANSI_ARGS_((CkTextBTree tree)); +extern int CkBTreeCharsInLine _ANSI_ARGS_((CkTextLine *linePtr)); +extern CkTextBTree CkBTreeCreate _ANSI_ARGS_((void)); +extern void CkBTreeDestroy _ANSI_ARGS_((CkTextBTree tree)); +extern void CkBTreeDeleteChars _ANSI_ARGS_((CkTextIndex *index1Ptr, + CkTextIndex *index2Ptr)); +extern CkTextLine * CkBTreeFindLine _ANSI_ARGS_((CkTextBTree tree, + int line)); +extern CkTextTag ** CkBTreeGetTags _ANSI_ARGS_((CkTextIndex *indexPtr, + int *numTagsPtr)); +extern void CkBTreeInsertChars _ANSI_ARGS_((CkTextIndex *indexPtr, + char *string)); +extern int CkBTreeLineIndex _ANSI_ARGS_((CkTextLine *linePtr)); +extern void CkBTreeLinkSegment _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextIndex *indexPtr)); +extern CkTextLine * CkBTreeNextLine _ANSI_ARGS_((CkTextLine *linePtr)); +extern int CkBTreeNextTag _ANSI_ARGS_((CkTextSearch *searchPtr)); +extern int CkBTreeNumLines _ANSI_ARGS_((CkTextBTree tree)); +extern void CkBTreeStartSearch _ANSI_ARGS_((CkTextIndex *index1Ptr, + CkTextIndex *index2Ptr, CkTextTag *tagPtr, + CkTextSearch *searchPtr)); +extern void CkBTreeTag _ANSI_ARGS_((CkTextIndex *index1Ptr, + CkTextIndex *index2Ptr, CkTextTag *tagPtr, + int add)); +extern void CkBTreeUnlinkSegment _ANSI_ARGS_((CkTextBTree tree, + CkTextSegment *segPtr, CkTextLine *linePtr)); +extern void CkTextBindProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +extern void CkTextChanged _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *index1Ptr, CkTextIndex *index2Ptr)); +extern int CkTextCharBbox _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *indexPtr, int *xPtr, int *yPtr, + int *widthPtr, int *heightPtr)); +extern int CkTextCharLayoutProc _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *indexPtr, CkTextSegment *segPtr, + int offset, int maxX, int maxChars, int noBreakYet, + Ck_Uid wrapMode, CkTextDispChunk *chunkPtr)); +extern void CkTextCreateDInfo _ANSI_ARGS_((CkText *textPtr)); +extern int CkTextDLineInfo _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *indexPtr, int *xPtr, int *yPtr, + int *widthPtr, int *heightPtr, int *basePtr)); +extern CkTextTag * CkTextCreateTag _ANSI_ARGS_((CkText *textPtr, + char *tagName)); +extern void CkTextFreeDInfo _ANSI_ARGS_((CkText *textPtr)); +extern void CkTextFreeTag _ANSI_ARGS_((CkText *textPtr, + CkTextTag *tagPtr)); +extern int CkTextGetIndex _ANSI_ARGS_((Tcl_Interp *interp, + CkText *textPtr, char *string, + CkTextIndex *indexPtr)); +extern CkTextTabArray * CkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp, + CkWindow *winPtr, char *string)); +#if CK_USE_UTF +extern void CkTextIndexBackBytes _ANSI_ARGS_((CkTextIndex *srcPtr, + int count, CkTextIndex *dstPtr)); +#endif +extern void CkTextIndexBackChars _ANSI_ARGS_((CkTextIndex *srcPtr, + int count, CkTextIndex *dstPtr)); +extern int CkTextIndexCmp _ANSI_ARGS_((CkTextIndex *index1Ptr, + CkTextIndex *index2Ptr)); +#if CK_USE_UTF +extern void CkTextIndexForwBytes _ANSI_ARGS_((CkTextIndex *srcPtr, + int count, CkTextIndex *dstPtr)); +#endif +extern void CkTextIndexForwChars _ANSI_ARGS_((CkTextIndex *srcPtr, + int count, CkTextIndex *dstPtr)); +extern CkTextSegment * CkTextIndexToSeg _ANSI_ARGS_((CkTextIndex *indexPtr, + int *offsetPtr)); +extern void CkTextInsertDisplayProc _ANSI_ARGS_(( + CkTextDispChunk *chunkPtr, int x, int y, int height, + int baseline, WINDOW *window, int screenY)); +extern void CkTextLostSelection _ANSI_ARGS_(( + ClientData clientData)); +#if CK_USE_UTF +extern CkTextIndex * CkTextMakeByteIndex _ANSI_ARGS_((CkTextBTree tree, + int lineIndex, int byteIndex, + CkTextIndex *indexPtr)); +#endif +extern CkTextIndex * CkTextMakeIndex _ANSI_ARGS_((CkTextBTree tree, + int lineIndex, int charIndex, + CkTextIndex *indexPtr)); +extern int CkTextMarkCmd _ANSI_ARGS_((CkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); +extern int CkTextMarkNameToIndex _ANSI_ARGS_((CkText *textPtr, + char *name, CkTextIndex *indexPtr)); +extern void CkTextMarkSegToIndex _ANSI_ARGS_((CkText *textPtr, + CkTextSegment *markPtr, CkTextIndex *indexPtr)); +extern void CkTextEventuallyRepick _ANSI_ARGS_((CkText *textPtr)); +extern void CkTextPickCurrent _ANSI_ARGS_((CkText *textPtr, + CkEvent *eventPtr)); +extern void CkTextPixelIndex _ANSI_ARGS_((CkText *textPtr, + int x, int y, CkTextIndex *indexPtr)); +extern void CkTextPrintIndex _ANSI_ARGS_((CkTextIndex *indexPtr, + char *string)); +extern void CkTextRedrawRegion _ANSI_ARGS_((CkText *textPtr, + int x, int y, int width, int height)); +extern void CkTextRedrawTag _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *index1Ptr, CkTextIndex *index2Ptr, + CkTextTag *tagPtr, int withTag)); +extern void CkTextRelayoutWindow _ANSI_ARGS_((CkText *textPtr)); +extern int CkTextScanCmd _ANSI_ARGS_((CkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); +extern int CkTextSeeCmd _ANSI_ARGS_((CkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); +extern int CkTextSegToOffset _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); +extern CkTextSegment * CkTextSetMark _ANSI_ARGS_((CkText *textPtr, char *name, + CkTextIndex *indexPtr)); +extern void CkTextSetYView _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *indexPtr, int pickPlace)); +extern int CkTextTagCmd _ANSI_ARGS_((CkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); +extern int CkTextWindowCmd _ANSI_ARGS_((CkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); +extern int CkTextWindowIndex _ANSI_ARGS_((CkText *textPtr, + char *name, CkTextIndex *indexPtr)); +extern int CkTextXviewCmd _ANSI_ARGS_((CkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); +extern int CkTextYviewCmd _ANSI_ARGS_((CkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); + +#endif /* _CKTEXT_H */ diff --git a/ckTextBTree.c b/ckTextBTree.c new file mode 100644 index 0000000..4a8bc02 --- /dev/null +++ b/ckTextBTree.c @@ -0,0 +1,2796 @@ +/* + * ckTextBTree.c -- + * + * This file contains code that manages the B-tree representation + * of text for Ck's text widget and implements character and + * toggle segment types. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "ckText.h" + +/* + * The data structure below keeps summary information about one tag as part + * of the tag information in a node. + */ + +typedef struct Summary { + CkTextTag *tagPtr; /* Handle for tag. */ + int toggleCount; /* Number of transitions into or + * out of this tag that occur in + * the subtree rooted at this node. */ + struct Summary *nextPtr; /* Next in list of all tags for same + * node, or NULL if at end of list. */ +} Summary; + +/* + * The data structure below defines a node in the B-tree. + */ + +typedef struct Node { + struct Node *parentPtr; /* Pointer to parent node, or NULL if + * this is the root. */ + struct Node *nextPtr; /* Next in list of siblings with the + * same parent node, or NULL for end + * of list. */ + Summary *summaryPtr; /* First in malloc-ed list of info + * about tags in this subtree (NULL if + * no tag info in the subtree). */ + int level; /* Level of this node in the B-tree. + * 0 refers to the bottom of the tree + * (children are lines, not nodes). */ + union { /* First in linked list of children. */ + struct Node *nodePtr; /* Used if level > 0. */ + CkTextLine *linePtr; /* Used if level == 0. */ + } children; + int numChildren; /* Number of children of this node. */ + int numLines; /* Total number of lines (leaves) in + * the subtree rooted here. */ +} Node; + +/* + * Upper and lower bounds on how many children a node may have: + * rebalance when either of these limits is exceeded. MAX_CHILDREN + * should be twice MIN_CHILDREN and MIN_CHILDREN must be >= 2. + */ + +#define MAX_CHILDREN 12 +#define MIN_CHILDREN 6 + +/* + * The data structure below defines an entire B-tree. + */ + +typedef struct BTree { + Node *rootPtr; /* Pointer to root of B-tree. */ +} BTree; + +/* + * The structure below is used to pass information between + * CkBTreeGetTags and IncCount: + */ + +typedef struct TagInfo { + int numTags; /* Number of tags for which there + * is currently information in + * tags and counts. */ + int arraySize; /* Number of entries allocated for + * tags and counts. */ + CkTextTag **tagPtrs; /* Array of tags seen so far. + * Malloc-ed. */ + int *counts; /* Toggle count (so far) for each + * entry in tags. Malloc-ed. */ +} TagInfo; + +/* + * Variable that indicates whether to enable consistency checks for + * debugging. + */ + +int ckBTreeDebug = 0; + +/* + * Macros that determine how much space to allocate for new segments: + */ + +#define CSEG_SIZE(chars) ((unsigned) (Ck_Offset(CkTextSegment, body) \ + + 1 + (chars))) +#define TSEG_SIZE ((unsigned) (Ck_Offset(CkTextSegment, body) \ + + sizeof(CkTextToggle))) + +/* + * Forward declarations for procedures defined in this file: + */ + +static void ChangeNodeToggleCount _ANSI_ARGS_((Node *nodePtr, + CkTextTag *tagPtr, int delta)); +static void CharCheckProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); +static int CharDeleteProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr, int treeGone)); +static CkTextSegment * CharCleanupProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); +static CkTextSegment * CharSplitProc _ANSI_ARGS_((CkTextSegment *segPtr, + int index)); +static void CheckNodeConsistency _ANSI_ARGS_((Node *nodePtr)); +static void CleanupLine _ANSI_ARGS_((CkTextLine *linePtr)); +static void DeleteSummaries _ANSI_ARGS_((Summary *tagPtr)); +static void DestroyNode _ANSI_ARGS_((Node *nodePtr)); +static void IncCount _ANSI_ARGS_((CkTextTag *tagPtr, int inc, + TagInfo *tagInfoPtr)); +static void Rebalance _ANSI_ARGS_((BTree *treePtr, Node *nodePtr)); +static void RecomputeNodeCounts _ANSI_ARGS_((Node *nodePtr)); +static CkTextSegment * SplitSeg _ANSI_ARGS_((CkTextIndex *indexPtr)); +static void ToggleCheckProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); +static CkTextSegment * ToggleCleanupProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); +static int ToggleDeleteProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr, int treeGone)); +static void ToggleLineChangeProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); + +/* + * Type record for character segments: + */ + +Ck_SegType ckTextCharType = { + "character", /* name */ + 0, /* leftGravity */ + CharSplitProc, /* splitProc */ + CharDeleteProc, /* deleteProc */ + CharCleanupProc, /* cleanupProc */ + (Ck_SegLineChangeProc *) NULL, /* lineChangeProc */ + CkTextCharLayoutProc, /* layoutProc */ + CharCheckProc /* checkProc */ +}; + +/* + * Type record for segments marking the beginning of a tagged + * range: + */ + +Ck_SegType ckTextToggleOnType = { + "toggleOn", /* name */ + 0, /* leftGravity */ + (Ck_SegSplitProc *) NULL, /* splitProc */ + ToggleDeleteProc, /* deleteProc */ + ToggleCleanupProc, /* cleanupProc */ + ToggleLineChangeProc, /* lineChangeProc */ + (Ck_SegLayoutProc *) NULL, /* layoutProc */ + ToggleCheckProc /* checkProc */ +}; + +/* + * Type record for segments marking the end of a tagged + * range: + */ + +Ck_SegType ckTextToggleOffType = { + "toggleOff", /* name */ + 1, /* leftGravity */ + (Ck_SegSplitProc *) NULL, /* splitProc */ + ToggleDeleteProc, /* deleteProc */ + ToggleCleanupProc, /* cleanupProc */ + ToggleLineChangeProc, /* lineChangeProc */ + (Ck_SegLayoutProc *) NULL, /* layoutProc */ + ToggleCheckProc /* checkProc */ +}; + +/* + *---------------------------------------------------------------------- + * + * CkBTreeCreate -- + * + * This procedure is called to create a new text B-tree. + * + * Results: + * The return value is a pointer to a new B-tree containing + * one line with nothing but a newline character. + * + * Side effects: + * Memory is allocated and initialized. + * + *---------------------------------------------------------------------- + */ + +CkTextBTree +CkBTreeCreate() +{ + register BTree *treePtr; + register Node *rootPtr; + register CkTextLine *linePtr, *linePtr2; + register CkTextSegment *segPtr; + + /* + * The tree will initially have two empty lines. The second line + * isn't actually part of the tree's contents, but its presence + * makes several operations easier. The tree will have one node, + * which is also the root of the tree. + */ + + rootPtr = (Node *) ckalloc(sizeof(Node)); + linePtr = (CkTextLine *) ckalloc(sizeof(CkTextLine)); + linePtr2 = (CkTextLine *) ckalloc(sizeof(CkTextLine)); + rootPtr->parentPtr = NULL; + rootPtr->nextPtr = NULL; + rootPtr->summaryPtr = NULL; + rootPtr->level = 0; + rootPtr->children.linePtr = linePtr; + rootPtr->numChildren = 2; + rootPtr->numLines = 2; + + linePtr->parentPtr = rootPtr; + linePtr->nextPtr = linePtr2; + segPtr = (CkTextSegment *) ckalloc(CSEG_SIZE(1)); + linePtr->segPtr = segPtr; + segPtr->typePtr = &ckTextCharType; + segPtr->nextPtr = NULL; + segPtr->size = 1; + segPtr->body.chars[0] = '\n'; + segPtr->body.chars[1] = 0; + + linePtr2->parentPtr = rootPtr; + linePtr2->nextPtr = NULL; + segPtr = (CkTextSegment *) ckalloc(CSEG_SIZE(1)); + linePtr2->segPtr = segPtr; + segPtr->typePtr = &ckTextCharType; + segPtr->nextPtr = NULL; + segPtr->size = 1; + segPtr->body.chars[0] = '\n'; + segPtr->body.chars[1] = 0; + + treePtr = (BTree *) ckalloc(sizeof(BTree)); + treePtr->rootPtr = rootPtr; + + return (CkTextBTree) treePtr; +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeDestroy -- + * + * Delete a B-tree, recycling all of the storage it contains. + * + * Results: + * The tree given by treePtr is deleted. TreePtr should never + * again be used. + * + * Side effects: + * Memory is freed. + * + *---------------------------------------------------------------------- + */ + +void +CkBTreeDestroy(tree) + CkTextBTree tree; /* Pointer to tree to delete. */ +{ + BTree *treePtr = (BTree *) tree; + + DestroyNode(treePtr->rootPtr); + ckfree((char *) treePtr); +} + +/* + *---------------------------------------------------------------------- + * + * DestroyNode -- + * + * This is a recursive utility procedure used during the deletion + * of a B-tree. + * + * Results: + * None. + * + * Side effects: + * All the storage for nodePtr and its descendants is freed. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyNode(nodePtr) + register Node *nodePtr; +{ + if (nodePtr->level == 0) { + CkTextLine *linePtr; + CkTextSegment *segPtr; + + while (nodePtr->children.linePtr != NULL) { + linePtr = nodePtr->children.linePtr; + nodePtr->children.linePtr = linePtr->nextPtr; + while (linePtr->segPtr != NULL) { + segPtr = linePtr->segPtr; + linePtr->segPtr = segPtr->nextPtr; + (*segPtr->typePtr->deleteProc)(segPtr, linePtr, 1); + } + ckfree((char *) linePtr); + } + } else { + register Node *childPtr; + + while (nodePtr->children.nodePtr != NULL) { + childPtr = nodePtr->children.nodePtr; + nodePtr->children.nodePtr = childPtr->nextPtr; + DestroyNode(childPtr); + } + } + DeleteSummaries(nodePtr->summaryPtr); + ckfree((char *) nodePtr); +} + +/* + *---------------------------------------------------------------------- + * + * DeleteSummaries -- + * + * Free up all of the memory in a list of tag summaries associated + * with a node. + * + * Results: + * None. + * + * Side effects: + * Storage is released. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteSummaries(summaryPtr) + register Summary *summaryPtr; /* First in list of node's tag + * summaries. */ +{ + register Summary *nextPtr; + while (summaryPtr != NULL) { + nextPtr = summaryPtr->nextPtr; + ckfree((char *) summaryPtr); + summaryPtr = nextPtr; + } +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeInsertChars -- + * + * Insert characters at a given position in a B-tree. + * + * Results: + * None. + * + * Side effects: + * Characters are added to the B-tree at the given position. + * If the string contains newlines, new lines will be added, + * which could cause the structure of the B-tree to change. + * + *---------------------------------------------------------------------- + */ + +void +CkBTreeInsertChars(indexPtr, string) + register CkTextIndex *indexPtr; /* Indicates where to insert text. + * When the procedure returns, this + * index is no longer valid because + * of changes to the segment + * structure. */ + char *string; /* Pointer to bytes to insert (may + * contain newlines, must be null- + * terminated). */ +{ + register Node *nodePtr; + register CkTextSegment *prevPtr; /* The segment just before the first + * new segment (NULL means new segment + * is at beginning of line). */ + CkTextSegment *curPtr; /* Current segment; new characters + * are inserted just after this one. + * NULL means insert at beginning of + * line. */ + CkTextLine *linePtr; /* Current line (new segments are + * added to this line). */ + register CkTextSegment *segPtr; + CkTextLine *newLinePtr; + int chunkSize; /* # characters in current chunk. */ + register char *eol; /* Pointer to character just after last + * one in current chunk. */ + int changeToLineCount; /* Counts change to total number of + * lines in file. */ + + prevPtr = SplitSeg(indexPtr); + linePtr = indexPtr->linePtr; + curPtr = prevPtr; + + /* + * Chop the string up into lines and create a new segment for + * each line, plus a new line for the leftovers from the + * previous line. + */ + + changeToLineCount = 0; + while (*string != 0) { + for (eol = string; *eol != 0; eol++) { + if (*eol == '\n') { + eol++; + break; + } + } + chunkSize = eol-string; + segPtr = (CkTextSegment *) ckalloc(CSEG_SIZE(chunkSize)); + segPtr->typePtr = &ckTextCharType; + if (curPtr == NULL) { + segPtr->nextPtr = linePtr->segPtr; + linePtr->segPtr = segPtr; + } else { + segPtr->nextPtr = curPtr->nextPtr; + curPtr->nextPtr = segPtr; + } + segPtr->size = chunkSize; + strncpy(segPtr->body.chars, string, (size_t) chunkSize); + segPtr->body.chars[chunkSize] = 0; + curPtr = segPtr; + + if (eol[-1] != '\n') { + break; + } + + /* + * The chunk ended with a newline, so create a new CkTextLine + * and move the remainder of the old line to it. + */ + + newLinePtr = (CkTextLine *) ckalloc(sizeof(CkTextLine)); + newLinePtr->parentPtr = linePtr->parentPtr; + newLinePtr->nextPtr = linePtr->nextPtr; + linePtr->nextPtr = newLinePtr; + newLinePtr->segPtr = segPtr->nextPtr; + segPtr->nextPtr = NULL; + linePtr = newLinePtr; + curPtr = NULL; + changeToLineCount++; + + string = eol; + } + + /* + * Cleanup the starting line for the insertion, plus the ending + * line if it's different. + */ + + CleanupLine(indexPtr->linePtr); + if (linePtr != indexPtr->linePtr) { + CleanupLine(linePtr); + } + + /* + * Increment the line counts in all the parent nodes of the insertion + * point, then rebalance the tree if necessary. + */ + + for (nodePtr = linePtr->parentPtr ; nodePtr != NULL; + nodePtr = nodePtr->parentPtr) { + nodePtr->numLines += changeToLineCount; + } + nodePtr = linePtr->parentPtr; + nodePtr->numChildren += changeToLineCount; + if (nodePtr->numChildren > MAX_CHILDREN) { + Rebalance((BTree *) indexPtr->tree, nodePtr); + } + + if (ckBTreeDebug) { + CkBTreeCheck(indexPtr->tree); + } +} + +/* + *-------------------------------------------------------------- + * + * SplitSeg -- + * + * This procedure is called before adding or deleting + * segments. It does three things: (a) it finds the segment + * containing indexPtr; (b) if there are several such + * segments (because some segments have zero length) then + * it picks the first segment that does not have left + * gravity; (c) if the index refers to the middle of + * a segment then it splits the segment so that the + * index now refers to the beginning of a segment. + * + * Results: + * The return value is a pointer to the segment just + * before the segment corresponding to indexPtr (as + * described above). If the segment corresponding to + * indexPtr is the first in its line then the return + * value is NULL. + * + * Side effects: + * The segment referred to by indexPtr is split unless + * indexPtr refers to its first character. + * + *-------------------------------------------------------------- + */ + +static CkTextSegment * +SplitSeg(indexPtr) + CkTextIndex *indexPtr; /* Index identifying position + * at which to split a segment. */ +{ + CkTextSegment *prevPtr, *segPtr; + int count; + + for (count = indexPtr->charIndex, prevPtr = NULL, + segPtr = indexPtr->linePtr->segPtr; segPtr != NULL; + count -= segPtr->size, prevPtr = segPtr, segPtr = segPtr->nextPtr) { + if (segPtr->size > count) { + if (count == 0) { + return prevPtr; + } + segPtr = (*segPtr->typePtr->splitProc)(segPtr, count); + if (prevPtr == NULL) { + indexPtr->linePtr->segPtr = segPtr; + } else { + prevPtr->nextPtr = segPtr; + } + return segPtr; + } else if ((segPtr->size == 0) && (count == 0) + && !segPtr->typePtr->leftGravity) { + return prevPtr; + } + } + panic("SplitSeg reached end of line!"); + return NULL; +} + +/* + *-------------------------------------------------------------- + * + * CleanupLine -- + * + * This procedure is called after modifications have been + * made to a line. It scans over all of the segments in + * the line, giving each a chance to clean itself up, e.g. + * by merging with the following segments, updating internal + * information, etc. + * + * Results: + * None. + * + * Side effects: + * Depends on what the segment-specific cleanup procedures do. + * + *-------------------------------------------------------------- + */ + +static void +CleanupLine(linePtr) + CkTextLine *linePtr; /* Line to be cleaned up. */ +{ + CkTextSegment *segPtr, **prevPtrPtr; + int anyChanges; + + /* + * Make a pass over all of the segments in the line, giving each + * a chance to clean itself up. This could potentially change + * the structure of the line, e.g. by merging two segments + * together or having two segments cancel themselves; if so, + * then repeat the whole process again, since the first structure + * change might make other structure changes possible. Repeat + * until eventually there are no changes. + */ + + while (1) { + anyChanges = 0; + for (prevPtrPtr = &linePtr->segPtr, segPtr = *prevPtrPtr; + segPtr != NULL; + prevPtrPtr = &(*prevPtrPtr)->nextPtr, segPtr = *prevPtrPtr) { + if (segPtr->typePtr->cleanupProc != NULL) { + *prevPtrPtr = (*segPtr->typePtr->cleanupProc)(segPtr, linePtr); + if (segPtr != *prevPtrPtr) { + anyChanges = 1; + } + } + } + if (!anyChanges) { + break; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeDeleteChars -- + * + * Delete a range of characters from a B-tree. The caller + * must make sure that the final newline of the B-tree is + * never deleted. + * + * Results: + * None. + * + * Side effects: + * Information is deleted from the B-tree. This can cause the + * internal structure of the B-tree to change. Note: because + * of changes to the B-tree structure, the indices pointed + * to by index1Ptr and index2Ptr should not be used after this + * procedure returns. + * + *---------------------------------------------------------------------- + */ + +void +CkBTreeDeleteChars(index1Ptr, index2Ptr) + register CkTextIndex *index1Ptr; /* Indicates first character that is + * to be deleted. */ + register CkTextIndex *index2Ptr; /* Indicates character just after the + * last one that is to be deleted. */ +{ + CkTextSegment *prevPtr; /* The segment just before the start + * of the deletion range. */ + CkTextSegment *lastPtr; /* The segment just after the end + * of the deletion range. */ + CkTextSegment *segPtr, *nextPtr; + CkTextLine *curLinePtr; + Node *curNodePtr, *nodePtr; + + /* + * Tricky point: split at index2Ptr first; otherwise the split + * at index2Ptr may invalidate segPtr and/or prevPtr. + */ + + lastPtr = SplitSeg(index2Ptr); + if (lastPtr != NULL) { + lastPtr = lastPtr->nextPtr; + } else { + lastPtr = index2Ptr->linePtr->segPtr; + } + prevPtr = SplitSeg(index1Ptr); + if (prevPtr != NULL) { + segPtr = prevPtr->nextPtr; + prevPtr->nextPtr = lastPtr; + } else { + segPtr = index1Ptr->linePtr->segPtr; + index1Ptr->linePtr->segPtr = lastPtr; + } + + /* + * Delete all of the segments between prevPtr and lastPtr. + */ + + curLinePtr = index1Ptr->linePtr; + curNodePtr = curLinePtr->parentPtr; + while (segPtr != lastPtr) { + if (segPtr == NULL) { + CkTextLine *nextLinePtr; + + /* + * We just ran off the end of a line. First find the + * next line, then go back to the old line and delete it + * (unless it's the starting line for the range). + */ + + nextLinePtr = CkBTreeNextLine(curLinePtr); + if (curLinePtr != index1Ptr->linePtr) { + if (curNodePtr == index1Ptr->linePtr->parentPtr) { + index1Ptr->linePtr->nextPtr = curLinePtr->nextPtr; + } else { + curNodePtr->children.linePtr = curLinePtr->nextPtr; + } + for (nodePtr = curNodePtr; nodePtr != NULL; + nodePtr = nodePtr->parentPtr) { + nodePtr->numLines--; + } + curNodePtr->numChildren--; + ckfree((char *) curLinePtr); + } + curLinePtr = nextLinePtr; + segPtr = curLinePtr->segPtr; + + /* + * If the node is empty then delete it and its parents, + * recursively upwards until a non-empty node is found. + */ + + while (curNodePtr->numChildren == 0) { + Node *parentPtr; + + parentPtr = curNodePtr->parentPtr; + if (parentPtr->children.nodePtr == curNodePtr) { + parentPtr->children.nodePtr = curNodePtr->nextPtr; + } else { + Node *prevNodePtr = parentPtr->children.nodePtr; + while (prevNodePtr->nextPtr != curNodePtr) { + prevNodePtr = prevNodePtr->nextPtr; + } + prevNodePtr->nextPtr = curNodePtr->nextPtr; + } + parentPtr->numChildren--; + ckfree((char *) curNodePtr); + curNodePtr = parentPtr; + } + curNodePtr = curLinePtr->parentPtr; + continue; + } + + nextPtr = segPtr->nextPtr; + if ((*segPtr->typePtr->deleteProc)(segPtr, curLinePtr, 0) != 0) { + /* + * This segment refuses to die. Move it to prevPtr and + * advance prevPtr if the segment has left gravity. + */ + + if (prevPtr == NULL) { + segPtr->nextPtr = index1Ptr->linePtr->segPtr; + index1Ptr->linePtr->segPtr = segPtr; + } else { + segPtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = segPtr; + } + if (segPtr->typePtr->leftGravity) { + prevPtr = segPtr; + } + } + segPtr = nextPtr; + } + + /* + * If the beginning and end of the deletion range are in different + * lines, join the two lines together and discard the ending line. + */ + + if (index1Ptr->linePtr != index2Ptr->linePtr) { + CkTextLine *prevLinePtr; + + for (segPtr = lastPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + if (segPtr->typePtr->lineChangeProc != NULL) { + (*segPtr->typePtr->lineChangeProc)(segPtr, index2Ptr->linePtr); + } + } + curNodePtr = index2Ptr->linePtr->parentPtr; + for (nodePtr = curNodePtr; nodePtr != NULL; + nodePtr = nodePtr->parentPtr) { + nodePtr->numLines--; + } + curNodePtr->numChildren--; + prevLinePtr = curNodePtr->children.linePtr; + if (prevLinePtr == index2Ptr->linePtr) { + curNodePtr->children.linePtr = index2Ptr->linePtr->nextPtr; + } else { + while (prevLinePtr->nextPtr != index2Ptr->linePtr) { + prevLinePtr = prevLinePtr->nextPtr; + } + prevLinePtr->nextPtr = index2Ptr->linePtr->nextPtr; + } + ckfree((char *) index2Ptr->linePtr); + Rebalance((BTree *) index2Ptr->tree, curNodePtr); + } + + /* + * Cleanup the segments in the new line. + */ + + CleanupLine(index1Ptr->linePtr); + + /* + * Lastly, rebalance the first node of the range. + */ + + Rebalance((BTree *) index1Ptr->tree, index1Ptr->linePtr->parentPtr); + if (ckBTreeDebug) { + CkBTreeCheck(index1Ptr->tree); + } +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeFindLine -- + * + * Find a particular line in a B-tree based on its line number. + * + * Results: + * The return value is a pointer to the line structure for the + * line whose index is "line", or NULL if no such line exists. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +CkTextLine * +CkBTreeFindLine(tree, line) + CkTextBTree tree; /* B-tree in which to find line. */ + int line; /* Index of desired line. */ +{ + BTree *treePtr = (BTree *) tree; + register Node *nodePtr; + register CkTextLine *linePtr; + int linesLeft; + + nodePtr = treePtr->rootPtr; + linesLeft = line; + if ((line < 0) || (line >= nodePtr->numLines)) { + return NULL; + } + + /* + * Work down through levels of the tree until a node is found at + * level 0. + */ + + while (nodePtr->level != 0) { + for (nodePtr = nodePtr->children.nodePtr; + nodePtr->numLines <= linesLeft; + nodePtr = nodePtr->nextPtr) { + if (nodePtr == NULL) { + panic("CkBTreeFindLine ran out of nodes"); + } + linesLeft -= nodePtr->numLines; + } + } + + /* + * Work through the lines attached to the level-0 node. + */ + + for (linePtr = nodePtr->children.linePtr; linesLeft > 0; + linePtr = linePtr->nextPtr) { + if (linePtr == NULL) { + panic("CkBTreeFindLine ran out of lines"); + } + linesLeft -= 1; + } + return linePtr; +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeNextLine -- + * + * Given an existing line in a B-tree, this procedure locates the + * next line in the B-tree. This procedure is used for scanning + * through the B-tree. + * + * Results: + * The return value is a pointer to the line that immediately + * follows linePtr, or NULL if there is no such line. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +CkTextLine * +CkBTreeNextLine(linePtr) + register CkTextLine *linePtr; /* Pointer to existing line in + * B-tree. */ +{ + register Node *nodePtr; + + if (linePtr->nextPtr != NULL) { + return linePtr->nextPtr; + } + + /* + * This was the last line associated with the particular parent node. + * Search up the tree for the next node, then search down from that + * node to find the first line, + */ + + for (nodePtr = linePtr->parentPtr; ; nodePtr = nodePtr->parentPtr) { + if (nodePtr->nextPtr != NULL) { + nodePtr = nodePtr->nextPtr; + break; + } + if (nodePtr->parentPtr == NULL) { + return (CkTextLine *) NULL; + } + } + while (nodePtr->level > 0) { + nodePtr = nodePtr->children.nodePtr; + } + return nodePtr->children.linePtr; +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeLineIndex -- + * + * Given a pointer to a line in a B-tree, return the numerical + * index of that line. + * + * Results: + * The result is the index of linePtr within the tree, where 0 + * corresponds to the first line in the tree. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkBTreeLineIndex(linePtr) + CkTextLine *linePtr; /* Pointer to existing line in + * B-tree. */ +{ + register CkTextLine *linePtr2; + register Node *nodePtr, *parentPtr, *nodePtr2; + int index; + + /* + * First count how many lines precede this one in its level-0 + * node. + */ + + nodePtr = linePtr->parentPtr; + index = 0; + for (linePtr2 = nodePtr->children.linePtr; linePtr2 != linePtr; + linePtr2 = linePtr2->nextPtr) { + if (linePtr2 == NULL) { + panic("CkBTreeLineIndex couldn't find line"); + } + index += 1; + } + + /* + * Now work up through the levels of the tree one at a time, + * counting how many lines are in nodes preceding the current + * node. + */ + + for (parentPtr = nodePtr->parentPtr ; parentPtr != NULL; + nodePtr = parentPtr, parentPtr = parentPtr->parentPtr) { + for (nodePtr2 = parentPtr->children.nodePtr; nodePtr2 != nodePtr; + nodePtr2 = nodePtr2->nextPtr) { + if (nodePtr2 == NULL) { + panic("CkBTreeLineIndex couldn't find node"); + } + index += nodePtr2->numLines; + } + } + return index; +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeLinkSegment -- + * + * This procedure adds a new segment to a B-tree at a given + * location. + * + * Results: + * None. + * + * Side effects: + * SegPtr will be linked into its tree. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +void +CkBTreeLinkSegment(segPtr, indexPtr) + CkTextSegment *segPtr; /* Pointer to new segment to be added to + * B-tree. Should be completely initialized + * by caller except for nextPtr field. */ + CkTextIndex *indexPtr; /* Where to add segment: it gets linked + * in just before the segment indicated + * here. */ +{ + register CkTextSegment *prevPtr; + + prevPtr = SplitSeg(indexPtr); + if (prevPtr == NULL) { + segPtr->nextPtr = indexPtr->linePtr->segPtr; + indexPtr->linePtr->segPtr = segPtr; + } else { + segPtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = segPtr; + } + CleanupLine(indexPtr->linePtr); + if (ckBTreeDebug) { + CkBTreeCheck(indexPtr->tree); + } +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeUnlinkSegment -- + * + * This procedure unlinks a segment from its line in a B-tree. + * + * Results: + * None. + * + * Side effects: + * SegPtr will be unlinked from linePtr. The segment itself + * isn't modified by this procedure. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +void +CkBTreeUnlinkSegment(tree, segPtr, linePtr) + CkTextBTree tree; /* Tree containing segment. */ + CkTextSegment *segPtr; /* Segment to be unlinked. */ + CkTextLine *linePtr; /* Line that currently contains + * segment. */ +{ + register CkTextSegment *prevPtr; + + if (linePtr->segPtr == segPtr) { + linePtr->segPtr = segPtr->nextPtr; + } else { + for (prevPtr = linePtr->segPtr; prevPtr->nextPtr != segPtr; + prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + prevPtr->nextPtr = segPtr->nextPtr; + } + CleanupLine(linePtr); +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeTag -- + * + * Turn a given tag on or off for a given range of characters in + * a B-tree of text. + * + * Results: + * None. + * + * Side effects: + * The given tag is added to the given range of characters + * in the tree or removed from all those characters, depending + * on the "add" argument. The structure of the btree is modified + * enough that index1Ptr and index2Ptr are no longer valid after + * this procedure returns, and the indexes may be modified by + * this procedure. + * + *---------------------------------------------------------------------- + */ + +void +CkBTreeTag(index1Ptr, index2Ptr, tagPtr, add) + register CkTextIndex *index1Ptr; /* Indicates first character in + * range. */ + register CkTextIndex *index2Ptr; /* Indicates character just after the + * last one in range. */ + CkTextTag *tagPtr; /* Tag to add or remove. */ + int add; /* One means add tag to the given + * range of characters; zero means + * remove the tag from the range. */ +{ + CkTextSegment *segPtr, *prevPtr; + CkTextSearch search; + CkTextLine *cleanupLinePtr; + int oldState; + + /* + * See whether the tag is present at the start of the range. If + * the state doesn't already match what we want then add a toggle + * there. + */ + + oldState = CkBTreeCharTagged(index1Ptr, tagPtr); + if ((add != 0) ^ oldState) { + segPtr = (CkTextSegment *) ckalloc(TSEG_SIZE); + segPtr->typePtr = (add) ? &ckTextToggleOnType : &ckTextToggleOffType; + prevPtr = SplitSeg(index1Ptr); + if (prevPtr == NULL) { + segPtr->nextPtr = index1Ptr->linePtr->segPtr; + index1Ptr->linePtr->segPtr = segPtr; + } else { + segPtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = segPtr; + } + segPtr->size = 0; + segPtr->body.toggle.tagPtr = tagPtr; + segPtr->body.toggle.inNodeCounts = 0; + } + + /* + * Scan the range of characters and delete any internal tag + * transitions. Keep track of what the old state was at the end + * of the range, and add a toggle there if it's needed. + */ + + CkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search); + cleanupLinePtr = index1Ptr->linePtr; + while (CkBTreeNextTag(&search)) { + oldState ^= 1; + segPtr = search.segPtr; + prevPtr = search.curIndex.linePtr->segPtr; + if (prevPtr == segPtr) { + search.curIndex.linePtr->segPtr = segPtr->nextPtr; + } else { + while (prevPtr->nextPtr != segPtr) { + prevPtr = prevPtr->nextPtr; + } + prevPtr->nextPtr = segPtr->nextPtr; + } + if (segPtr->body.toggle.inNodeCounts) { + ChangeNodeToggleCount(search.curIndex.linePtr->parentPtr, + segPtr->body.toggle.tagPtr, -1); + segPtr->body.toggle.inNodeCounts = 0; + } + ckfree((char *) segPtr); + + /* + * The code below is a bit tricky. After deleting a toggle + * we eventually have to call CleanupLine, in order to allow + * character segments to be merged together. To do this, we + * remember in cleanupLinePtr a line that needs to be + * cleaned up, but we don't clean it up until we've moved + * on to a different line. That way the cleanup process + * won't goof up segPtr. + */ + + if (cleanupLinePtr != search.curIndex.linePtr) { + CleanupLine(cleanupLinePtr); + cleanupLinePtr = search.curIndex.linePtr; + } + } + if ((add != 0) ^ oldState) { + segPtr = (CkTextSegment *) ckalloc(TSEG_SIZE); + segPtr->typePtr = (add) ? &ckTextToggleOffType : &ckTextToggleOnType; + prevPtr = SplitSeg(index2Ptr); + if (prevPtr == NULL) { + segPtr->nextPtr = index2Ptr->linePtr->segPtr; + index2Ptr->linePtr->segPtr = segPtr; + } else { + segPtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = segPtr; + } + segPtr->size = 0; + segPtr->body.toggle.tagPtr = tagPtr; + segPtr->body.toggle.inNodeCounts = 0; + } + + /* + * Cleanup cleanupLinePtr and the last line of the range, if + * these are different. + */ + + CleanupLine(cleanupLinePtr); + if (cleanupLinePtr != index2Ptr->linePtr) { + CleanupLine(index2Ptr->linePtr); + } + + if (ckBTreeDebug) { + CkBTreeCheck(index1Ptr->tree); + } +} + +/* + *---------------------------------------------------------------------- + * + * ChangeNodeToggleCount -- + * + * This procedure increments or decrements the toggle count for + * a particular tag in a particular node and all its ancestors. + * + * Results: + * None. + * + * Side effects: + * The toggle count for tag is adjusted up or down by "delta" in + * nodePtr. + * + *---------------------------------------------------------------------- + */ + +static void +ChangeNodeToggleCount(nodePtr, tagPtr, delta) + register Node *nodePtr; /* Node whose toggle count for a tag + * must be changed. */ + CkTextTag *tagPtr; /* Information about tag. */ + int delta; /* Amount to add to current toggle + * count for tag (may be negative). */ +{ + register Summary *summaryPtr, *prevPtr; + + /* + * Iterate over the node and all of its ancestors. + */ + + for ( ; nodePtr != NULL; nodePtr = nodePtr->parentPtr) { + /* + * See if there's already an entry for this tag for this node. If so, + * perhaps all we have to do is adjust its count. + */ + + for (prevPtr = NULL, summaryPtr = nodePtr->summaryPtr; + summaryPtr != NULL; + prevPtr = summaryPtr, summaryPtr = summaryPtr->nextPtr) { + if (summaryPtr->tagPtr != tagPtr) { + continue; + } + summaryPtr->toggleCount += delta; + if (summaryPtr->toggleCount > 0) { + goto nextAncestor; + } + if (summaryPtr->toggleCount < 0) { + panic("ChangeNodeToggleCount: negative toggle count"); + } + + /* + * Zero count; must remove this tag from the list. + */ + + if (prevPtr == NULL) { + nodePtr->summaryPtr = summaryPtr->nextPtr; + } else { + prevPtr->nextPtr = summaryPtr->nextPtr; + } + ckfree((char *) summaryPtr); + goto nextAncestor; + } + + /* + * This tag isn't in the list. Add a new entry to the list. + */ + + if (delta < 0) { + panic("ChangeNodeToggleCount: negative delta, no tag entry"); + } + summaryPtr = (Summary *) ckalloc(sizeof(Summary)); + summaryPtr->tagPtr = tagPtr; + summaryPtr->toggleCount = delta; + summaryPtr->nextPtr = nodePtr->summaryPtr; + nodePtr->summaryPtr = summaryPtr; + + nextAncestor: + continue; + } +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeStartSearch -- + * + * This procedure sets up a search for tag transitions involving + * a given tag (or all tags) in a given range of the text. + * + * Results: + * None. + * + * Side effects: + * The information at *searchPtr is set up so that subsequent calls + * to CkBTreeNextTag will return information about the locations of + * tag transitions. Note that CkBTreeNextTag must be called to get + * the first transition. + * + *---------------------------------------------------------------------- + */ + +void +CkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, searchPtr) + CkTextIndex *index1Ptr; /* Search starts here. Tag toggles + * at this position will not be + * returned. */ + CkTextIndex *index2Ptr; /* Search stops here. Tag toggles + * at this position *will* be + * returned. */ + CkTextTag *tagPtr; /* Tag to search for. NULL means + * search for any tag. */ + register CkTextSearch *searchPtr; /* Where to store information about + * search's progress. */ +{ + int offset; + + searchPtr->curIndex = *index1Ptr; + searchPtr->segPtr = NULL; + searchPtr->nextPtr = CkTextIndexToSeg(index1Ptr, &offset); + searchPtr->curIndex.charIndex -= offset; + searchPtr->lastPtr = CkTextIndexToSeg(index2Ptr, (int *) NULL); + searchPtr->tagPtr = tagPtr; + searchPtr->linesLeft = CkBTreeLineIndex(index2Ptr->linePtr) + 1 + - CkBTreeLineIndex(index1Ptr->linePtr); + searchPtr->allTags = (tagPtr == NULL); + if (searchPtr->linesLeft == 1) { + /* + * Starting and stopping segments are in the same line; mark the + * search as over immediately if the second segment is before the + * first. + */ + + if (index1Ptr->charIndex >= index2Ptr->charIndex) { + searchPtr->linesLeft = 0; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeNextTag -- + * + * Once a tag search has begun, successive calls to this procedure + * return successive tag toggles. Note: it is NOT SAFE to call this + * procedure if characters have been inserted into or deleted from + * the B-tree since the call to CkBTreeStartSearch. + * + * Results: + * The return value is 1 if another toggle was found that met the + * criteria specified in the call to CkBTreeStartSearch; in this + * case searchPtr->curIndex gives the toggle's position and + * searchPtr->curTagPtr points to its segment. 0 is returned if + * no more matching tag transitions were found; in this case + * searchPtr->curIndex is the same as searchPtr->stopIndex. + * + * Side effects: + * Information in *searchPtr is modified to update the state of the + * search and indicate where the next tag toggle is located. + * + *---------------------------------------------------------------------- + */ + +int +CkBTreeNextTag(searchPtr) + register CkTextSearch *searchPtr; /* Information about search in + * progress; must have been set up by + * call to CkBTreeStartSearch. */ +{ + register CkTextSegment *segPtr; + register Node *nodePtr; + register Summary *summaryPtr; + + if (searchPtr->linesLeft <= 0) { + goto searchOver; + } + + /* + * The outermost loop iterates over lines that may potentially contain + * a relevant tag transition, starting from the current segment in + * the current line. + */ + + segPtr = searchPtr->nextPtr; + while (1) { + /* + * Check for more tags on the current line. + */ + + for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) { + if (segPtr == searchPtr->lastPtr) { + goto searchOver; + } + if (((segPtr->typePtr == &ckTextToggleOnType) + || (segPtr->typePtr == &ckTextToggleOffType)) + && (searchPtr->allTags + || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) { + searchPtr->segPtr = segPtr; + searchPtr->nextPtr = segPtr->nextPtr; + searchPtr->tagPtr = segPtr->body.toggle.tagPtr; + return 1; + } + searchPtr->curIndex.charIndex += segPtr->size; + } + + /* + * See if there are more lines associated with the current parent + * node. If so, go back to the top of the loop to search the next + * one. + */ + + nodePtr = searchPtr->curIndex.linePtr->parentPtr; + searchPtr->curIndex.linePtr = searchPtr->curIndex.linePtr->nextPtr; + searchPtr->linesLeft--; + if (searchPtr->linesLeft <= 0) { + goto searchOver; + } + if (searchPtr->curIndex.linePtr != NULL) { + segPtr = searchPtr->curIndex.linePtr->segPtr; + searchPtr->curIndex.charIndex = 0; + continue; + } + + /* + * Search across and up through the B-tree's node hierarchy looking + * for the next node that has a relevant tag transition somewhere in + * its subtree. Be sure to update linesLeft as we skip over large + * chunks of lines. + */ + + while (1) { + while (nodePtr->nextPtr == NULL) { + if (nodePtr->parentPtr == NULL) { + goto searchOver; + } + nodePtr = nodePtr->parentPtr; + } + nodePtr = nodePtr->nextPtr; + for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; + summaryPtr = summaryPtr->nextPtr) { + if ((searchPtr->allTags) || + (summaryPtr->tagPtr == searchPtr->tagPtr)) { + goto gotNodeWithTag; + } + } + searchPtr->linesLeft -= nodePtr->numLines; + } + + /* + * At this point we've found a subtree that has a relevant tag + * transition. Now search down (and across) through that subtree + * to find the first level-0 node that has a relevant tag transition. + */ + + gotNodeWithTag: + while (nodePtr->level > 0) { + for (nodePtr = nodePtr->children.nodePtr; ; + nodePtr = nodePtr->nextPtr) { + for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; + summaryPtr = summaryPtr->nextPtr) { + if ((searchPtr->allTags) + || (summaryPtr->tagPtr == searchPtr->tagPtr)) { + goto nextChild; + } + } + searchPtr->linesLeft -= nodePtr->numLines; + if (nodePtr->nextPtr == NULL) { + panic("CkBTreeNextTag found incorrect tag summary info."); + } + } + nextChild: + continue; + } + + /* + * Now we're down to a level-0 node that contains a line that contains + * a relevant tag transition. Set up line information and go back to + * the beginning of the loop to search through lines. + */ + + searchPtr->curIndex.linePtr = nodePtr->children.linePtr; + searchPtr->curIndex.charIndex = 0; + segPtr = searchPtr->curIndex.linePtr->segPtr; + if (searchPtr->linesLeft <= 0) { + goto searchOver; + } + continue; + } + + searchOver: + searchPtr->linesLeft = 0; + searchPtr->segPtr = NULL; + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeCharTagged -- + * + * Determine whether a particular character has a particular tag. + * + * Results: + * The return value is 1 if the given tag is in effect at the + * character given by linePtr and ch, and 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkBTreeCharTagged(indexPtr, tagPtr) + CkTextIndex *indexPtr; /* Indicates a character position at + * which to check for a tag. */ + CkTextTag *tagPtr; /* Tag of interest. */ +{ + register Node *nodePtr; + register CkTextLine *siblingLinePtr; + register CkTextSegment *segPtr; + CkTextSegment *toggleSegPtr; + int toggles, index; + + /* + * Check for toggles for the tag in indexPtr's line but before + * indexPtr. If there is one, its type indicates whether or + * not the character is tagged. + */ + + toggleSegPtr = NULL; + for (index = 0, segPtr = indexPtr->linePtr->segPtr; + (index + segPtr->size) <= indexPtr->charIndex; + index += segPtr->size, segPtr = segPtr->nextPtr) { + if (((segPtr->typePtr == &ckTextToggleOnType) + || (segPtr->typePtr == &ckTextToggleOffType)) + && (segPtr->body.toggle.tagPtr == tagPtr)) { + toggleSegPtr = segPtr; + } + } + if (toggleSegPtr != NULL) { + return (toggleSegPtr->typePtr == &ckTextToggleOnType); + } + + /* + * No toggle in this line. Look for toggles for the tag in lines + * that are predecessors of indexPtr->linePtr but under the same + * level-0 node. + */ + + toggles = 0; + for (siblingLinePtr = indexPtr->linePtr->parentPtr->children.linePtr; + siblingLinePtr != indexPtr->linePtr; + siblingLinePtr = siblingLinePtr->nextPtr) { + for (segPtr = siblingLinePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + if (((segPtr->typePtr == &ckTextToggleOnType) + || (segPtr->typePtr == &ckTextToggleOffType)) + && (segPtr->body.toggle.tagPtr == tagPtr)) { + toggleSegPtr = segPtr; + } + } + } + if (toggleSegPtr != NULL) { + return (toggleSegPtr->typePtr == &ckTextToggleOnType); + } + + /* + * No toggle in this node. Scan upwards through the ancestors of + * this node, counting the number of toggles of the given tag in + * siblings that precede that node. + */ + + toggles = 0; + for (nodePtr = indexPtr->linePtr->parentPtr; nodePtr->parentPtr != NULL; + nodePtr = nodePtr->parentPtr) { + register Node *siblingPtr; + register Summary *summaryPtr; + + for (siblingPtr = nodePtr->parentPtr->children.nodePtr; + siblingPtr != nodePtr; siblingPtr = siblingPtr->nextPtr) { + for (summaryPtr = siblingPtr->summaryPtr; summaryPtr != NULL; + summaryPtr = summaryPtr->nextPtr) { + if (summaryPtr->tagPtr == tagPtr) { + toggles += summaryPtr->toggleCount; + } + } + } + } + + /* + * An odd number of toggles means that the tag is present at the + * given point. + */ + + return toggles & 1; +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeGetTags -- + * + * Return information about all of the tags that are associated + * with a particular character in a B-tree of text. + * + * Results: + * The return value is a malloc-ed array containing pointers to + * information for each of the tags that is associated with + * the character at the position given by linePtr and ch. The + * word at *numTagsPtr is filled in with the number of pointers + * in the array. It is up to the caller to free the array by + * passing it to free. If there are no tags at the given character + * then a NULL pointer is returned and *numTagsPtr will be set to 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +CkTextTag ** +CkBTreeGetTags(indexPtr, numTagsPtr) + CkTextIndex *indexPtr; /* Indicates a particular position in + * the B-tree. */ + int *numTagsPtr; /* Store number of tags found at this + * location. */ +{ + register Node *nodePtr; + register CkTextLine *siblingLinePtr; + register CkTextSegment *segPtr; + int src, dst, index; + TagInfo tagInfo; +#define NUM_TAG_INFOS 10 + + tagInfo.numTags = 0; + tagInfo.arraySize = NUM_TAG_INFOS; + tagInfo.tagPtrs = (CkTextTag **) ckalloc((unsigned) + NUM_TAG_INFOS*sizeof(CkTextTag *)); + tagInfo.counts = (int *) ckalloc((unsigned) + NUM_TAG_INFOS*sizeof(int)); + + /* + * Record tag toggles within the line of indexPtr but preceding + * indexPtr. + */ + + for (index = 0, segPtr = indexPtr->linePtr->segPtr; + (index + segPtr->size) <= indexPtr->charIndex; + index += segPtr->size, segPtr = segPtr->nextPtr) { + if ((segPtr->typePtr == &ckTextToggleOnType) + || (segPtr->typePtr == &ckTextToggleOffType)) { + IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo); + } + } + + /* + * Record toggles for tags in lines that are predecessors of + * indexPtr->linePtr but under the same level-0 node. + */ + + for (siblingLinePtr = indexPtr->linePtr->parentPtr->children.linePtr; + siblingLinePtr != indexPtr->linePtr; + siblingLinePtr = siblingLinePtr->nextPtr) { + for (segPtr = siblingLinePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + if ((segPtr->typePtr == &ckTextToggleOnType) + || (segPtr->typePtr == &ckTextToggleOffType)) { + IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo); + } + } + } + + /* + * For each node in the ancestry of this line, record tag toggles + * for all siblings that precede that node. + */ + + for (nodePtr = indexPtr->linePtr->parentPtr; nodePtr->parentPtr != NULL; + nodePtr = nodePtr->parentPtr) { + register Node *siblingPtr; + register Summary *summaryPtr; + + for (siblingPtr = nodePtr->parentPtr->children.nodePtr; + siblingPtr != nodePtr; siblingPtr = siblingPtr->nextPtr) { + for (summaryPtr = siblingPtr->summaryPtr; summaryPtr != NULL; + summaryPtr = summaryPtr->nextPtr) { + if (summaryPtr->toggleCount & 1) { + IncCount(summaryPtr->tagPtr, summaryPtr->toggleCount, + &tagInfo); + } + } + } + } + + /* + * Go through the tag information and squash out all of the tags + * that have even toggle counts (these tags exist before the point + * of interest, but not at the desired character itself). + */ + + for (src = 0, dst = 0; src < tagInfo.numTags; src++) { + if (tagInfo.counts[src] & 1) { + tagInfo.tagPtrs[dst] = tagInfo.tagPtrs[src]; + dst++; + } + } + *numTagsPtr = dst; + ckfree((char *) tagInfo.counts); + if (dst == 0) { + ckfree((char *) tagInfo.tagPtrs); + return NULL; + } + return tagInfo.tagPtrs; +} + +/* + *---------------------------------------------------------------------- + * + * IncCount -- + * + * This is a utility procedure used by CkBTreeGetTags. It + * increments the count for a particular tag, adding a new + * entry for that tag if there wasn't one previously. + * + * Results: + * None. + * + * Side effects: + * The information at *tagInfoPtr may be modified, and the arrays + * may be reallocated to make them larger. + * + *---------------------------------------------------------------------- + */ + +static void +IncCount(tagPtr, inc, tagInfoPtr) + CkTextTag *tagPtr; /* Handle for tag. */ + int inc; /* Amount by which to increment tag count. */ + TagInfo *tagInfoPtr; /* Holds cumulative information about tags; + * increment count here. */ +{ + register CkTextTag **tagPtrPtr; + int count; + + for (tagPtrPtr = tagInfoPtr->tagPtrs, count = tagInfoPtr->numTags; + count > 0; tagPtrPtr++, count--) { + if (*tagPtrPtr == tagPtr) { + tagInfoPtr->counts[tagInfoPtr->numTags-count] += inc; + return; + } + } + + /* + * There isn't currently an entry for this tag, so we have to + * make a new one. If the arrays are full, then enlarge the + * arrays first. + */ + + if (tagInfoPtr->numTags == tagInfoPtr->arraySize) { + CkTextTag **newTags; + int *newCounts, newSize; + + newSize = 2*tagInfoPtr->arraySize; + newTags = (CkTextTag **) ckalloc((unsigned) + (newSize*sizeof(CkTextTag *))); + memcpy((VOID *) newTags, (VOID *) tagInfoPtr->tagPtrs, + tagInfoPtr->arraySize * sizeof(CkTextTag *)); + ckfree((char *) tagInfoPtr->tagPtrs); + tagInfoPtr->tagPtrs = newTags; + newCounts = (int *) ckalloc((unsigned) (newSize*sizeof(int))); + memcpy((VOID *) newCounts, (VOID *) tagInfoPtr->counts, + tagInfoPtr->arraySize * sizeof(int)); + ckfree((char *) tagInfoPtr->counts); + tagInfoPtr->counts = newCounts; + tagInfoPtr->arraySize = newSize; + } + + tagInfoPtr->tagPtrs[tagInfoPtr->numTags] = tagPtr; + tagInfoPtr->counts[tagInfoPtr->numTags] = inc; + tagInfoPtr->numTags++; +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeCheck -- + * + * This procedure runs a set of consistency checks over a B-tree + * and panics if any inconsistencies are found. + * + * Results: + * None. + * + * Side effects: + * If a structural defect is found, the procedure panics with an + * error message. + * + *---------------------------------------------------------------------- + */ + +void +CkBTreeCheck(tree) + CkTextBTree tree; /* Tree to check. */ +{ + BTree *treePtr = (BTree *) tree; + register Summary *summaryPtr; + register Node *nodePtr; + register CkTextLine *linePtr; + register CkTextSegment *segPtr; + + /* + * Make sure that overall there is an even count of tag transitions + * for the whole tree. + */ + + for (summaryPtr = treePtr->rootPtr->summaryPtr; summaryPtr != NULL; + summaryPtr = summaryPtr->nextPtr) { + if (summaryPtr->toggleCount & 1) { + panic("CkBTreeCheck found odd toggle count for \"%s\" (%d)", + summaryPtr->tagPtr->name, summaryPtr->toggleCount); + } + } + + /* + * Call a recursive procedure to do the main body of checks. + */ + + nodePtr = treePtr->rootPtr; + CheckNodeConsistency(treePtr->rootPtr); + + /* + * Make sure that there are at least two lines in the text and + * that the last line has no characters except a newline. + */ + + if (nodePtr->numLines < 2) { + panic("CkBTreeCheck: less than 2 lines in tree"); + } + while (nodePtr->level > 0) { + nodePtr = nodePtr->children.nodePtr; + while (nodePtr->nextPtr != NULL) { + nodePtr = nodePtr->nextPtr; + } + } + linePtr = nodePtr->children.linePtr; + while (linePtr->nextPtr != NULL) { + linePtr = linePtr->nextPtr; + } + segPtr = linePtr->segPtr; + while ((segPtr->typePtr == &ckTextToggleOffType) + || (segPtr->typePtr == &ckTextRightMarkType) + || (segPtr->typePtr == &ckTextLeftMarkType)) { + /* + * It's OK to toggle a tag off in the last line, but + * not to start a new range. It's also OK to have marks + * in the last line. + */ + + segPtr = segPtr->nextPtr; + } + if (segPtr->typePtr != &ckTextCharType) { + panic("CkBTreeCheck: last line has bogus segment type"); + } + if (segPtr->nextPtr != NULL) { + panic("CkBTreeCheck: last line has too many segments"); + } + if (segPtr->size != 1) { + panic("CkBTreeCheck: last line has wrong # characters: %d", + segPtr->size); + } + if ((segPtr->body.chars[0] != '\n') || (segPtr->body.chars[1] != 0)) { + panic("CkBTreeCheck: last line had bad value: %s", + segPtr->body.chars); + } +} + +/* + *---------------------------------------------------------------------- + * + * CheckNodeConsistency -- + * + * This procedure is called as part of consistency checking for + * B-trees: it checks several aspects of a node and also runs + * checks recursively on the node's children. + * + * Results: + * None. + * + * Side effects: + * If anything suspicious is found in the tree structure, the + * procedure panics. + * + *---------------------------------------------------------------------- + */ + +static void +CheckNodeConsistency(nodePtr) + register Node *nodePtr; /* Node whose subtree should be + * checked. */ +{ + register Node *childNodePtr; + register Summary *summaryPtr, *summaryPtr2; + register CkTextLine *linePtr; + register CkTextSegment *segPtr; + int numChildren, numLines, toggleCount, minChildren; + + if (nodePtr->parentPtr != NULL) { + minChildren = MIN_CHILDREN; + } else if (nodePtr->level > 0) { + minChildren = 2; + } else { + minChildren = 1; + } + if ((nodePtr->numChildren < minChildren) + || (nodePtr->numChildren > MAX_CHILDREN)) { + panic("CheckNodeConsistency: bad child count (%d)", + nodePtr->numChildren); + } + + numChildren = 0; + numLines = 0; + if (nodePtr->level == 0) { + for (linePtr = nodePtr->children.linePtr; linePtr != NULL; + linePtr = linePtr->nextPtr) { + if (linePtr->parentPtr != nodePtr) { + panic("CheckNodeConsistency: line doesn't point to parent"); + } + if (linePtr->segPtr == NULL) { + panic("CheckNodeConsistency: line has no segments"); + } + for (segPtr = linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + if (segPtr->typePtr->checkProc != NULL) { + (*segPtr->typePtr->checkProc)(segPtr, linePtr); + } + if ((segPtr->size == 0) && (!segPtr->typePtr->leftGravity) + && (segPtr->nextPtr != NULL) + && (segPtr->nextPtr->size == 0) + && (segPtr->nextPtr->typePtr->leftGravity)) { + panic("CheckNodeConsistency: wrong segment order for gravity"); + } + if ((segPtr->nextPtr == NULL) + && (segPtr->typePtr != &ckTextCharType)) { + panic("CheckNodeConsistency: line ended with wrong type"); + } + } + numChildren++; + numLines++; + } + } else { + for (childNodePtr = nodePtr->children.nodePtr; childNodePtr != NULL; + childNodePtr = childNodePtr->nextPtr) { + if (childNodePtr->parentPtr != nodePtr) { + panic("CheckNodeConsistency: node doesn't point to parent"); + } + if (childNodePtr->level != (nodePtr->level-1)) { + panic("CheckNodeConsistency: level mismatch (%d %d)", + nodePtr->level, childNodePtr->level); + } + CheckNodeConsistency(childNodePtr); + for (summaryPtr = childNodePtr->summaryPtr; summaryPtr != NULL; + summaryPtr = summaryPtr->nextPtr) { + for (summaryPtr2 = nodePtr->summaryPtr; ; + summaryPtr2 = summaryPtr2->nextPtr) { + if (summaryPtr2 == NULL) { + panic("CheckNodeConsistency: node tag \"%s\" not %s", + summaryPtr->tagPtr->name, + "present in parent summaries"); + } + if (summaryPtr->tagPtr == summaryPtr2->tagPtr) { + break; + } + } + } + numChildren++; + numLines += childNodePtr->numLines; + } + } + if (numChildren != nodePtr->numChildren) { + panic("CheckNodeConsistency: mismatch in numChildren (%d %d)", + numChildren, nodePtr->numChildren); + } + if (numLines != nodePtr->numLines) { + panic("CheckNodeConsistency: mismatch in numLines (%d %d)", + numLines, nodePtr->numLines); + } + + for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; + summaryPtr = summaryPtr->nextPtr) { + toggleCount = 0; + if (nodePtr->level == 0) { + for (linePtr = nodePtr->children.linePtr; linePtr != NULL; + linePtr = linePtr->nextPtr) { + for (segPtr = linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + if ((segPtr->typePtr != &ckTextToggleOnType) + && (segPtr->typePtr != &ckTextToggleOffType)) { + continue; + } + if (segPtr->body.toggle.tagPtr == summaryPtr->tagPtr) { + toggleCount ++; + } + } + } + } else { + for (childNodePtr = nodePtr->children.nodePtr; + childNodePtr != NULL; + childNodePtr = childNodePtr->nextPtr) { + for (summaryPtr2 = childNodePtr->summaryPtr; + summaryPtr2 != NULL; + summaryPtr2 = summaryPtr2->nextPtr) { + if (summaryPtr2->tagPtr == summaryPtr->tagPtr) { + toggleCount += summaryPtr2->toggleCount; + } + } + } + } + if (toggleCount != summaryPtr->toggleCount) { + panic("CheckNodeConsistency: mismatch in toggleCount (%d %d)", + toggleCount, summaryPtr->toggleCount); + } + for (summaryPtr2 = summaryPtr->nextPtr; summaryPtr2 != NULL; + summaryPtr2 = summaryPtr2->nextPtr) { + if (summaryPtr2->tagPtr == summaryPtr->tagPtr) { + panic("CheckNodeConsistency: duplicated node tag: %s", + summaryPtr->tagPtr->name); + } + } + } +} + +/* + *---------------------------------------------------------------------- + * + * Rebalance -- + * + * This procedure is called when a node of a B-tree appears to be + * out of balance (too many children, or too few). It rebalances + * that node and all of its ancestors in the tree. + * + * Results: + * None. + * + * Side effects: + * The internal structure of treePtr may change. + * + *---------------------------------------------------------------------- + */ + +static void +Rebalance(treePtr, nodePtr) + BTree *treePtr; /* Tree that is being rebalanced. */ + register Node *nodePtr; /* Node that may be out of balance. */ +{ + /* + * Loop over the entire ancestral chain of the node, working up + * through the tree one node at a time until the root node has + * been processed. + */ + + for ( ; nodePtr != NULL; nodePtr = nodePtr->parentPtr) { + register Node *newPtr, *childPtr; + register CkTextLine *linePtr; + int i; + + /* + * Check to see if the node has too many children. If it does, + * then split off all but the first MIN_CHILDREN into a separate + * node following the original one. Then repeat until the + * node has a decent size. + */ + + if (nodePtr->numChildren > MAX_CHILDREN) { + while (1) { + /* + * If the node being split is the root node, then make a + * new root node above it first. + */ + + if (nodePtr->parentPtr == NULL) { + newPtr = (Node *) ckalloc(sizeof(Node)); + newPtr->parentPtr = NULL; + newPtr->nextPtr = NULL; + newPtr->summaryPtr = NULL; + newPtr->level = nodePtr->level + 1; + newPtr->children.nodePtr = nodePtr; + newPtr->numChildren = 1; + newPtr->numLines = nodePtr->numLines; + RecomputeNodeCounts(newPtr); + treePtr->rootPtr = newPtr; + } + newPtr = (Node *) ckalloc(sizeof(Node)); + newPtr->parentPtr = nodePtr->parentPtr; + newPtr->nextPtr = nodePtr->nextPtr; + nodePtr->nextPtr = newPtr; + newPtr->summaryPtr = NULL; + newPtr->level = nodePtr->level; + newPtr->numChildren = nodePtr->numChildren - MIN_CHILDREN; + if (nodePtr->level == 0) { + for (i = MIN_CHILDREN-1, + linePtr = nodePtr->children.linePtr; + i > 0; i--, linePtr = linePtr->nextPtr) { + /* Empty loop body. */ + } + newPtr->children.linePtr = linePtr->nextPtr; + linePtr->nextPtr = NULL; + } else { + for (i = MIN_CHILDREN-1, + childPtr = nodePtr->children.nodePtr; + i > 0; i--, childPtr = childPtr->nextPtr) { + /* Empty loop body. */ + } + newPtr->children.nodePtr = childPtr->nextPtr; + childPtr->nextPtr = NULL; + } + RecomputeNodeCounts(nodePtr); + nodePtr->parentPtr->numChildren++; + nodePtr = newPtr; + if (nodePtr->numChildren <= MAX_CHILDREN) { + RecomputeNodeCounts(nodePtr); + break; + } + } + } + + while (nodePtr->numChildren < MIN_CHILDREN) { + register Node *otherPtr; + Node *halfwayNodePtr = NULL; /* Initialization needed only */ + CkTextLine *halfwayLinePtr = NULL; /* to prevent cc warnings. */ + int totalChildren, firstChildren, i; + + /* + * Too few children for this node. If this is the root then, + * it's OK for it to have less than MIN_CHILDREN children + * as long as it's got at least two. If it has only one + * (and isn't at level 0), then chop the root node out of + * the tree and use its child as the new root. + */ + + if (nodePtr->parentPtr == NULL) { + if ((nodePtr->numChildren == 1) && (nodePtr->level > 0)) { + treePtr->rootPtr = nodePtr->children.nodePtr; + treePtr->rootPtr->parentPtr = NULL; + DeleteSummaries(nodePtr->summaryPtr); + ckfree((char *) nodePtr); + } + return; + } + + /* + * Not the root. Make sure that there are siblings to + * balance with. + */ + + if (nodePtr->parentPtr->numChildren < 2) { + Rebalance(treePtr, nodePtr->parentPtr); + continue; + } + + /* + * Find a sibling neighbor to borrow from, and arrange for + * nodePtr to be the earlier of the pair. + */ + + if (nodePtr->nextPtr == NULL) { + for (otherPtr = nodePtr->parentPtr->children.nodePtr; + otherPtr->nextPtr != nodePtr; + otherPtr = otherPtr->nextPtr) { + /* Empty loop body. */ + } + nodePtr = otherPtr; + } + otherPtr = nodePtr->nextPtr; + + /* + * We're going to either merge the two siblings together + * into one node or redivide the children among them to + * balance their loads. As preparation, join their two + * child lists into a single list and remember the half-way + * point in the list. + */ + + totalChildren = nodePtr->numChildren + otherPtr->numChildren; + firstChildren = totalChildren/2; + if (nodePtr->children.nodePtr == NULL) { + nodePtr->children = otherPtr->children; + otherPtr->children.nodePtr = NULL; + otherPtr->children.linePtr = NULL; + } + if (nodePtr->level == 0) { + register CkTextLine *linePtr; + + for (linePtr = nodePtr->children.linePtr, i = 1; + linePtr->nextPtr != NULL; + linePtr = linePtr->nextPtr, i++) { + if (i == firstChildren) { + halfwayLinePtr = linePtr; + } + } + linePtr->nextPtr = otherPtr->children.linePtr; + while (i <= firstChildren) { + halfwayLinePtr = linePtr; + linePtr = linePtr->nextPtr; + i++; + } + } else { + register Node *childPtr; + + for (childPtr = nodePtr->children.nodePtr, i = 1; + childPtr->nextPtr != NULL; + childPtr = childPtr->nextPtr, i++) { + if (i <= firstChildren) { + if (i == firstChildren) { + halfwayNodePtr = childPtr; + } + } + } + childPtr->nextPtr = otherPtr->children.nodePtr; + while (i <= firstChildren) { + halfwayNodePtr = childPtr; + childPtr = childPtr->nextPtr; + i++; + } + } + + /* + * If the two siblings can simply be merged together, do it. + */ + + if (totalChildren <= MAX_CHILDREN) { + RecomputeNodeCounts(nodePtr); + nodePtr->nextPtr = otherPtr->nextPtr; + nodePtr->parentPtr->numChildren--; + DeleteSummaries(otherPtr->summaryPtr); + ckfree((char *) otherPtr); + continue; + } + + /* + * The siblings can't be merged, so just divide their + * children evenly between them. + */ + + if (nodePtr->level == 0) { + otherPtr->children.linePtr = halfwayLinePtr->nextPtr; + halfwayLinePtr->nextPtr = NULL; + } else { + otherPtr->children.nodePtr = halfwayNodePtr->nextPtr; + halfwayNodePtr->nextPtr = NULL; + } + RecomputeNodeCounts(nodePtr); + RecomputeNodeCounts(otherPtr); + } + } +} + +/* + *---------------------------------------------------------------------- + * + * RecomputeNodeCounts -- + * + * This procedure is called to recompute all the counts in a node + * (tags, child information, etc.) by scanning the information in + * its descendants. This procedure is called during rebalancing + * when a node's child structure has changed. + * + * Results: + * None. + * + * Side effects: + * The tag counts for nodePtr are modified to reflect its current + * child structure, as are its numChildren and numLines fields. + * Also, all of the childrens' parentPtr fields are made to point + * to nodePtr. + * + *---------------------------------------------------------------------- + */ + +static void +RecomputeNodeCounts(nodePtr) + register Node *nodePtr; /* Node whose tag summary information + * must be recomputed. */ +{ + register Summary *summaryPtr, *summaryPtr2; + register Node *childPtr; + register CkTextLine *linePtr; + register CkTextSegment *segPtr; + CkTextTag *tagPtr; + + /* + * Zero out all the existing counts for the node, but don't delete + * the existing Summary records (most of them will probably be reused). + */ + + for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; + summaryPtr = summaryPtr->nextPtr) { + summaryPtr->toggleCount = 0; + } + nodePtr->numChildren = 0; + nodePtr->numLines = 0; + + /* + * Scan through the children, adding the childrens' tag counts into + * the node's tag counts and adding new Summary structures if + * necessary. + */ + + if (nodePtr->level == 0) { + for (linePtr = nodePtr->children.linePtr; linePtr != NULL; + linePtr = linePtr->nextPtr) { + nodePtr->numChildren++; + nodePtr->numLines++; + linePtr->parentPtr = nodePtr; + for (segPtr = linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + if (((segPtr->typePtr != &ckTextToggleOnType) + && (segPtr->typePtr != &ckTextToggleOffType)) + || !(segPtr->body.toggle.inNodeCounts)) { + continue; + } + tagPtr = segPtr->body.toggle.tagPtr; + for (summaryPtr = nodePtr->summaryPtr; ; + summaryPtr = summaryPtr->nextPtr) { + if (summaryPtr == NULL) { + summaryPtr = (Summary *) ckalloc(sizeof(Summary)); + summaryPtr->tagPtr = tagPtr; + summaryPtr->toggleCount = 1; + summaryPtr->nextPtr = nodePtr->summaryPtr; + nodePtr->summaryPtr = summaryPtr; + break; + } + if (summaryPtr->tagPtr == tagPtr) { + summaryPtr->toggleCount++; + break; + } + } + } + } + } else { + for (childPtr = nodePtr->children.nodePtr; childPtr != NULL; + childPtr = childPtr->nextPtr) { + nodePtr->numChildren++; + nodePtr->numLines += childPtr->numLines; + childPtr->parentPtr = nodePtr; + for (summaryPtr2 = childPtr->summaryPtr; summaryPtr2 != NULL; + summaryPtr2 = summaryPtr2->nextPtr) { + for (summaryPtr = nodePtr->summaryPtr; ; + summaryPtr = summaryPtr->nextPtr) { + if (summaryPtr == NULL) { + summaryPtr = (Summary *) ckalloc(sizeof(Summary)); + summaryPtr->tagPtr = summaryPtr2->tagPtr; + summaryPtr->toggleCount = summaryPtr2->toggleCount; + summaryPtr->nextPtr = nodePtr->summaryPtr; + nodePtr->summaryPtr = summaryPtr; + break; + } + if (summaryPtr->tagPtr == summaryPtr2->tagPtr) { + summaryPtr->toggleCount += summaryPtr2->toggleCount; + break; + } + } + } + } + } + + /* + * Scan through the node's tag records again and delete any Summary + * records that still have a zero count. + */ + + summaryPtr2 = NULL; + for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; ) { + if (summaryPtr->toggleCount > 0) { + summaryPtr2 = summaryPtr; + summaryPtr = summaryPtr->nextPtr; + continue; + } + if (summaryPtr2 != NULL) { + summaryPtr2->nextPtr = summaryPtr->nextPtr; + ckfree((char *) summaryPtr); + summaryPtr = summaryPtr2->nextPtr; + } else { + nodePtr->summaryPtr = summaryPtr->nextPtr; + ckfree((char *) summaryPtr); + summaryPtr = nodePtr->summaryPtr; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeNumLines -- + * + * This procedure returns a count of the number of lines of + * text present in a given B-tree. + * + * Results: + * The return value is a count of the number of usable lines + * in tree (i.e. it doesn't include the dummy line that is just + * used to mark the end of the tree). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkBTreeNumLines(tree) + CkTextBTree tree; /* Information about tree. */ +{ + BTree *treePtr = (BTree *) tree; + return treePtr->rootPtr->numLines - 1; +} + +/* + *-------------------------------------------------------------- + * + * CharSplitProc -- + * + * This procedure implements splitting for character segments. + * + * Results: + * The return value is a pointer to a chain of two segments + * that have the same characters as segPtr except split + * among the two segments. + * + * Side effects: + * Storage for segPtr is freed. + * + *-------------------------------------------------------------- + */ + +static CkTextSegment * +CharSplitProc(segPtr, index) + CkTextSegment *segPtr; /* Pointer to segment to split. */ + int index; /* Position within segment at which + * to split. */ +{ + CkTextSegment *newPtr1, *newPtr2; + + newPtr1 = (CkTextSegment *) ckalloc(CSEG_SIZE(index)); + newPtr2 = (CkTextSegment *) ckalloc( + CSEG_SIZE(segPtr->size - index)); + newPtr1->typePtr = &ckTextCharType; + newPtr1->nextPtr = newPtr2; + newPtr1->size = index; + strncpy(newPtr1->body.chars, segPtr->body.chars, (size_t) index); + newPtr1->body.chars[index] = 0; + newPtr2->typePtr = &ckTextCharType; + newPtr2->nextPtr = segPtr->nextPtr; + newPtr2->size = segPtr->size - index; + strcpy(newPtr2->body.chars, segPtr->body.chars + index); + ckfree((char*) segPtr); + return newPtr1; +} + +/* + *-------------------------------------------------------------- + * + * CharCleanupProc -- + * + * This procedure merges adjacent character segments into + * a single character segment, if possible. + * + * Results: + * The return value is a pointer to the first segment in + * the (new) list of segments that used to start with segPtr. + * + * Side effects: + * Storage for the segments may be allocated and freed. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static CkTextSegment * +CharCleanupProc(segPtr, linePtr) + CkTextSegment *segPtr; /* Pointer to first of two adjacent + * segments to join. */ + CkTextLine *linePtr; /* Line containing segments (not + * used). */ +{ + CkTextSegment *segPtr2, *newPtr; + + segPtr2 = segPtr->nextPtr; + if ((segPtr2 == NULL) || (segPtr2->typePtr != &ckTextCharType)) { + return segPtr; + } + newPtr = (CkTextSegment *) ckalloc(CSEG_SIZE( + segPtr->size + segPtr2->size)); + newPtr->typePtr = &ckTextCharType; + newPtr->nextPtr = segPtr2->nextPtr; + newPtr->size = segPtr->size + segPtr2->size; + strcpy(newPtr->body.chars, segPtr->body.chars); + strcpy(newPtr->body.chars + segPtr->size, segPtr2->body.chars); + ckfree((char*) segPtr); + ckfree((char*) segPtr2); + return newPtr; +} + +/* + *-------------------------------------------------------------- + * + * CharDeleteProc -- + * + * This procedure is invoked to delete a character segment. + * + * Results: + * Always returns 0 to indicate that the segment was deleted. + * + * Side effects: + * Storage for the segment is freed. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +CharDeleteProc(segPtr, linePtr, treeGone) + CkTextSegment *segPtr; /* Segment to delete. */ + CkTextLine *linePtr; /* Line containing segment. */ + int treeGone; /* Non-zero means the entire tree is + * being deleted, so everything must + * get cleaned up. */ +{ + ckfree((char*) segPtr); + return 0; +} + +/* + *-------------------------------------------------------------- + * + * CharCheckProc -- + * + * This procedure is invoked to perform consistency checks + * on character segments. + * + * Results: + * None. + * + * Side effects: + * If the segment isn't inconsistent then the procedure + * panics. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +CharCheckProc(segPtr, linePtr) + CkTextSegment *segPtr; /* Segment to check. */ + CkTextLine *linePtr; /* Line containing segment. */ +{ + /* + * Make sure that the segment contains the number of + * characters indicated by its header, and that the last + * segment in a line ends in a newline. Also make sure + * that there aren't ever two character segments adjacent + * to each other: they should be merged together. + */ + + if (segPtr->size <= 0) { + panic("CharCheckProc: segment has size <= 0"); + } + if ((int) strlen(segPtr->body.chars) != segPtr->size) { + panic("CharCheckProc: segment has wrong size"); + } + if (segPtr->nextPtr == NULL) { + if (segPtr->body.chars[segPtr->size-1] != '\n') { + panic("CharCheckProc: line doesn't end with newline"); + } + } else { + if (segPtr->nextPtr->typePtr == &ckTextCharType) { + panic("CharCheckProc: adjacent character segments weren't merged"); + } + } +} + +/* + *-------------------------------------------------------------- + * + * ToggleDeleteProc -- + * + * This procedure is invoked to delete toggle segments. + * + * Results: + * Returns 1 to indicate that the segment may not be deleted, + * unless the entire B-tree is going away. + * + * Side effects: + * If the tree is going away then the toggle's memory is + * freed; otherwise the toggle counts in nodes above the + * segment get updated. + * + *-------------------------------------------------------------- + */ + +static int +ToggleDeleteProc(segPtr, linePtr, treeGone) + CkTextSegment *segPtr; /* Segment to check. */ + CkTextLine *linePtr; /* Line containing segment. */ + int treeGone; /* Non-zero means the entire tree is + * being deleted, so everything must + * get cleaned up. */ +{ + if (treeGone) { + ckfree((char *) segPtr); + return 0; + } + + /* + * This toggle is in the middle of a range of characters that's + * being deleted. Refuse to die. We'll be moved to the end of + * the deleted range and our cleanup procedure will be called + * later. Decrement node toggle counts here, and set a flag + * so we'll re-increment them in the cleanup procedure. + */ + + if (segPtr->body.toggle.inNodeCounts) { + ChangeNodeToggleCount(linePtr->parentPtr, + segPtr->body.toggle.tagPtr, -1); + segPtr->body.toggle.inNodeCounts = 0; + } + return 1; +} + +/* + *-------------------------------------------------------------- + * + * ToggleCleanupProc -- + * + * This procedure when a toggle is part of a line that's + * been modified in some way. It's invoked after the + * modifications are complete. + * + * Results: + * The return value is the head segment in a new list + * that is to replace the tail of the line that used to + * start at segPtr. This allows the procedure to delete + * or modify segPtr. + * + * Side effects: + * Toggle counts in the nodes above the new line will be + * updated if they're not already. Toggles may be collapsed + * if there are duplicate toggles at the same position. + * + *-------------------------------------------------------------- + */ + +static CkTextSegment * +ToggleCleanupProc(segPtr, linePtr) + CkTextSegment *segPtr; /* Segment to check. */ + CkTextLine *linePtr; /* Line that now contains segment. */ +{ + CkTextSegment *segPtr2, *prevPtr; + int counts; + + /* + * If this is a toggle-off segment, look ahead through the next + * segments to see if there's a toggle-on segment for the same tag + * before any segments with non-zero size. If so then the two + * toggles cancel each other; remove them both. + */ + + if (segPtr->typePtr == &ckTextToggleOffType) { + for (prevPtr = segPtr, segPtr2 = prevPtr->nextPtr; + (segPtr2 != NULL) && (segPtr2->size == 0); + prevPtr = segPtr2, segPtr2 = prevPtr->nextPtr) { + if (segPtr2->typePtr != &ckTextToggleOnType) { + continue; + } + if (segPtr2->body.toggle.tagPtr != segPtr->body.toggle.tagPtr) { + continue; + } + counts = segPtr->body.toggle.inNodeCounts + + segPtr2->body.toggle.inNodeCounts; + if (counts != 0) { + ChangeNodeToggleCount(linePtr->parentPtr, + segPtr->body.toggle.tagPtr, -counts); + } + prevPtr->nextPtr = segPtr2->nextPtr; + ckfree((char *) segPtr2); + segPtr2 = segPtr->nextPtr; + ckfree((char *) segPtr); + return segPtr2; + } + } + + if (!segPtr->body.toggle.inNodeCounts) { + ChangeNodeToggleCount(linePtr->parentPtr, + segPtr->body.toggle.tagPtr, 1); + segPtr->body.toggle.inNodeCounts = 1; + } + return segPtr; +} + +/* + *-------------------------------------------------------------- + * + * ToggleLineChangeProc -- + * + * This procedure is invoked when a toggle segment is about + * to move from one line to another. + * + * Results: + * None. + * + * Side effects: + * Toggle counts are decremented in the nodes above the line. + * + *-------------------------------------------------------------- + */ + +static void +ToggleLineChangeProc(segPtr, linePtr) + CkTextSegment *segPtr; /* Segment to check. */ + CkTextLine *linePtr; /* Line that used to contain segment. */ +{ + if (segPtr->body.toggle.inNodeCounts) { + ChangeNodeToggleCount(linePtr->parentPtr, + segPtr->body.toggle.tagPtr, -1); + segPtr->body.toggle.inNodeCounts = 0; + } +} + +/* + *-------------------------------------------------------------- + * + * ToggleCheckProc -- + * + * This procedure is invoked to perform consistency checks + * on toggle segments. + * + * Results: + * None. + * + * Side effects: + * If a consistency problem is found the procedure panics. + * + *-------------------------------------------------------------- + */ + +static void +ToggleCheckProc(segPtr, linePtr) + CkTextSegment *segPtr; /* Segment to check. */ + CkTextLine *linePtr; /* Line containing segment. */ +{ + register Summary *summaryPtr; + + if (segPtr->size != 0) { + panic("ToggleCheckProc: segment had non-zero size"); + } + if (!segPtr->body.toggle.inNodeCounts) { + panic("ToggleCheckProc: toggle counts not updated in nodes"); + } + for (summaryPtr = linePtr->parentPtr->summaryPtr; ; + summaryPtr = summaryPtr->nextPtr) { + if (summaryPtr == NULL) { + panic("ToggleCheckProc: tag not present in node"); + } + if (summaryPtr->tagPtr == segPtr->body.toggle.tagPtr) { + break; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * CkBTreeCharsInLine -- + * + * This procedure returns a count of the number of characters + * in a given line. + * + * Results: + * The return value is the character count for linePtr. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkBTreeCharsInLine(linePtr) + CkTextLine *linePtr; /* Line whose characters should be + * counted. */ +{ + CkTextSegment *segPtr; + int count = 0; + +#if CK_USE_UTF + for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { + if (segPtr->typePtr == &ckTextCharType) { + count += Tcl_NumUtfChars(segPtr->body.chars, segPtr->size); + } else { + count += segPtr->size; + } + } +#else + for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { + count += segPtr->size; + } +#endif + return count; +} diff --git a/ckTextDisp.c b/ckTextDisp.c new file mode 100644 index 0000000..516b827 --- /dev/null +++ b/ckTextDisp.c @@ -0,0 +1,3809 @@ +/* + * ckTextDisp.c -- + * + * This module provides facilities to display text widgets. It is + * the only place where information is kept about the screen layout + * of text widgets. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "ckText.h" + +/* + * The following structure describes how to display a range of characters. + * The information is generated by scanning all of the tags associated + * with the characters and combining that with default information for + * the overall widget. These structures form the hash keys for + * dInfoPtr->styleTable. + */ + +typedef struct StyleValues { + int fg, bg, attr; + int justify; /* Justification style for text. */ + int lMargin1; /* Left margin, in pixels, for first display + * line of each text line. */ + int lMargin2; /* Left margin, in pixels, for second and + * later display lines of each text line. */ + int rMargin; /* Right margin, in pixels. */ + CkTextTabArray *tabArrayPtr;/* Locations and types of tab stops (may + * be NULL). */ + Ck_Uid wrapMode; /* How to handle wrap-around for this tag. + * One of ckTextCharUid, ckTextNoneUid, + * or ckTextWordUid. */ +} StyleValues; + +/* + * The following structure extends the StyleValues structure above with + * graphics contexts used to actually draw the characters. The entries + * in dInfoPtr->styleTable point to structures of this type. + */ + +typedef struct Style { + int refCount; /* Number of times this structure is + * referenced in Chunks. */ + StyleValues *sValuePtr; /* Raw information from which GCs were + * derived. */ + Tcl_HashEntry *hPtr; /* Pointer to entry in styleTable. Used + * to delete entry. */ +} Style; + +/* + * The following macro determines whether two styles have the same + * background so that, for example, no beveled border should be drawn + * between them. + */ + +#define SAME_BACKGROUND(s1, s2) \ + (((s1)->sValuePtr->border == (s2)->sValuePtr->border) \ + && ((s1)->sValuePtr->borderWidth == (s2)->sValuePtr->borderWidth) \ + && ((s1)->sValuePtr->relief == (s2)->sValuePtr->relief) \ + && ((s1)->sValuePtr->bgStipple == (s2)->sValuePtr->bgStipple)) + +/* + * The following structure describes one line of the display, which may + * be either part or all of one line of the text. + */ + +typedef struct DLine { + CkTextIndex index; /* Identifies first character in text + * that is displayed on this line. */ + int count; /* Number of characters accounted for by this + * display line, including a trailing space + * or newline that isn't actually displayed. */ + int y; /* Y-position at which line is supposed to + * be drawn (topmost pixel of rectangular + * area occupied by line). */ + int oldY; /* Y-position at which line currently + * appears on display. -1 means line isn't + * currently visible on display and must be + * redrawn. This is used to move lines by + * scrolling rather than re-drawing. */ + int height; /* Height of line, in chars. */ + int length; /* Total length of line, in chars. */ + CkTextDispChunk *chunkPtr; /* Pointer to first chunk in list of all + * of those that are displayed on this + * line of the screen. */ + struct DLine *nextPtr; /* Next in list of all display lines for + * this window. The list is sorted in + * order from top to bottom. Note: the + * next DLine doesn't always correspond + * to the next line of text: (a) can have + * multiple DLines for one text line, and + * (b) can have gaps where DLine's have been + * deleted because they're out of date. */ + int flags; /* Various flag bits: see below for values. */ +} DLine; + +/* + * Flag bits for DLine structures: + * + * NEW_LAYOUT - Non-zero means that the line has been + * re-layed out since the last time the + * display was updated. + * TOP_LINE - Non-zero means that this was the top line + * in the window the last time that the window + * was laid out. This is important because + * a line may be displayed differently if its + * at the top or bottom than if it's in the + * middle (e.g. beveled edges aren't displayed + * for middle lines if the adjacent line has + * a similar background). + * BOTTOM_LINE - Non-zero means that this was the bottom line + * in the window the last time that the window + * was laid out. + */ + +#define NEW_LAYOUT 2 +#define TOP_LINE 4 +#define BOTTOM_LINE 8 + +/* + * Overall display information for a text widget: + */ + +typedef struct DInfo { + Tcl_HashTable styleTable; /* Hash table that maps from StyleValues + * to Styles for this widget. */ + DLine *dLinePtr; /* First in list of all display lines for + * this widget, in order from top to bottom. */ + int x; /* First x-coordinate that may be used for + * actually displaying line information. + * Leaves space for border, etc. */ + int y; /* First y-coordinate that may be used for + * actually displaying line information. + * Leaves space for border, etc. */ + int maxX; /* First x-coordinate to right of available + * space for displaying lines. */ + int maxY; /* First y-coordinate below available + * space for displaying lines. */ + int topOfEof; /* Top-most pixel (lowest y-value) that has + * been drawn in the appropriate fashion for + * the portion of the window after the last + * line of the text. This field is used to + * figure out when to redraw part or all of + * the eof field. */ + + /* + * Information used for scrolling: + */ + + int newCharOffset; /* Desired x scroll position, measured as the + * number of average-size characters off-screen + * to the left for a line with no left + * margin. */ + int curOffset; /* Actual x scroll position, measured as the + * number of chars off-screen to the left. */ + int maxLength; /* Length in chars of longest line that's + * visible in window (length may exceed window + * size). If there's no wrapping, this will + * be zero. */ + double xScrollFirst, xScrollLast; + /* Most recent values reported to horizontal + * scrollbar; used to eliminate unnecessary + * reports. */ + double yScrollFirst, yScrollLast; + /* Most recent values reported to vertical + * scrollbar; used to eliminate unnecessary + * reports. */ + + /* + * Miscellaneous information: + */ + + int dLinesInvalidated; /* This value is set to 1 whenever something + * happens that invalidates information in + * DLine structures; if a redisplay + * is in progress, it will see this and + * abort the redisplay. This is needed + * because, for example, an embedded window + * could change its size when it is first + * displayed, invalidating the DLine that + * is currently being displayed. If redisplay + * continues, it will use freed memory and + * could dump core. */ + int flags; /* Various flag values: see below for + * definitions. */ +} DInfo; + +/* + * In CkTextDispChunk structures for character segments, the clientData + * field points to one of the following structures: + */ + +typedef struct CharInfo { + int numChars; /* Number of characters to display. */ + CkWindow *winPtr; /* For Ck_SetWindowAttr. */ + char chars[4]; /* Characters to display. Actual size + * will be numChars, not 4. THIS MUST BE + * THE LAST FIELD IN THE STRUCTURE. */ +} CharInfo; + +/* + * Flag values for DInfo structures: + * + * DINFO_OUT_OF_DATE: Non-zero means that the DLine structures + * for this window are partially or completely + * out of date and need to be recomputed. + * REDRAW_PENDING: Means that a when-idle handler has been + * scheduled to update the display. + * REDRAW_BORDERS: Means window border or pad area has + * potentially been damaged and must be redrawn. + * REPICK_NEEDED: 1 means that the widget has been modified + * in a way that could change the current + * character (a different character might be + * under the mouse cursor now). Need to + * recompute the current character before + * the next redisplay. + */ + +#define DINFO_OUT_OF_DATE 1 +#define REDRAW_PENDING 2 +#define REDRAW_BORDERS 4 +#define REPICK_NEEDED 8 + +/* + * The following counters keep statistics about redisplay that can be + * checked to see how clever this code is at reducing redisplays. + */ + +static int numRedisplays; /* Number of calls to DisplayText. */ +static int linesRedrawn; /* Number of calls to DisplayDLine. */ + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void AdjustForTab _ANSI_ARGS_((CkText *textPtr, + CkTextTabArray *tabArrayPtr, int index, + CkTextDispChunk *chunkPtr)); +static void CharBboxProc _ANSI_ARGS_((CkTextDispChunk *chunkPtr, + int index, int y, int lineHeight, int baseline, + int *xPtr, int *yPtr, int *widthPtr, + int *heightPtr)); +static void CharDisplayProc _ANSI_ARGS_((CkTextDispChunk *chunkPtr, + int x, int y, int height, int baseline, + WINDOW *window, int screenY)); +static int CharMeasureProc _ANSI_ARGS_((CkTextDispChunk *chunkPtr, + int x)); +static void CharUndisplayProc _ANSI_ARGS_((CkText *textPtr, + CkTextDispChunk *chunkPtr)); +static void DisplayDLine _ANSI_ARGS_((CkText *textPtr, + DLine *dlPtr, DLine *prevPtr, WINDOW *window)); +static void DisplayText _ANSI_ARGS_((ClientData clientData)); +static DLine * FindDLine _ANSI_ARGS_((DLine *dlPtr, + CkTextIndex *indexPtr)); +static void FreeDLines _ANSI_ARGS_((CkText *textPtr, + DLine *firstPtr, DLine *lastPtr, int unlink)); +static void FreeStyle _ANSI_ARGS_((CkText *textPtr, + Style *stylePtr)); +static Style * GetStyle _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *indexPtr)); +static void GetXView _ANSI_ARGS_((Tcl_Interp *interp, + CkText *textPtr, int report)); +static void GetYView _ANSI_ARGS_((Tcl_Interp *interp, + CkText *textPtr, int report)); +static DLine * LayoutDLine _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *indexPtr)); +static void MeasureUp _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *srcPtr, int distance, + CkTextIndex *dstPtr)); +static void UpdateDisplayInfo _ANSI_ARGS_((CkText *textPtr)); +static void ScrollByLines _ANSI_ARGS_((CkText *textPtr, + int offset)); +static int SizeOfTab _ANSI_ARGS_((CkText *textPtr, + CkTextTabArray *tabArrayPtr, int index, int x, + int maxX)); + +/* + *---------------------------------------------------------------------- + * + * CkTextCreateDInfo -- + * + * This procedure is called when a new text widget is created. + * Its job is to set up display-related information for the widget. + * + * Results: + * None. + * + * Side effects: + * A DInfo data structure is allocated and initialized and attached + * to textPtr. + * + *---------------------------------------------------------------------- + */ + +void +CkTextCreateDInfo(textPtr) + CkText *textPtr; /* Overall information for text widget. */ +{ + register DInfo *dInfoPtr; + + dInfoPtr = (DInfo *) ckalloc(sizeof(DInfo)); + Tcl_InitHashTable(&dInfoPtr->styleTable, sizeof(StyleValues)/sizeof(int)); + dInfoPtr->dLinePtr = NULL; + dInfoPtr->topOfEof = 0; + dInfoPtr->newCharOffset = 0; + dInfoPtr->curOffset = 0; + dInfoPtr->maxLength = 0; + dInfoPtr->xScrollFirst = -1; + dInfoPtr->xScrollLast = -1; + dInfoPtr->yScrollFirst = -1; + dInfoPtr->yScrollLast = -1; + dInfoPtr->dLinesInvalidated = 0; + dInfoPtr->flags = DINFO_OUT_OF_DATE; + textPtr->dInfoPtr = dInfoPtr; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextFreeDInfo -- + * + * This procedure is called to free up all of the private display + * information kept by this file for a text widget. + * + * Results: + * None. + * + * Side effects: + * Lots of resources get freed. + * + *---------------------------------------------------------------------- + */ + +void +CkTextFreeDInfo(textPtr) + CkText *textPtr; /* Overall information for text widget. */ +{ + register DInfo *dInfoPtr = textPtr->dInfoPtr; + + /* + * Be careful to free up styleTable *after* freeing up all the + * DLines, so that the hash table is still intact to free up the + * style-related information from the lines. Once the lines are + * all free then styleTable will be empty. + */ + + FreeDLines(textPtr, dInfoPtr->dLinePtr, (DLine *) NULL, 1); + Tcl_DeleteHashTable(&dInfoPtr->styleTable); + if (dInfoPtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayText, (ClientData) textPtr); + } + ckfree((char *) dInfoPtr); +} + +/* + *---------------------------------------------------------------------- + * + * GetStyle -- + * + * This procedure creates all the information needed to display + * text at a particular location. + * + * Results: + * The return value is a pointer to a Style structure that + * corresponds to *sValuePtr. + * + * Side effects: + * A new entry may be created in the style table for the widget. + * + *---------------------------------------------------------------------- + */ + +static Style * +GetStyle(textPtr, indexPtr) + CkText *textPtr; /* Overall information about text widget. */ + CkTextIndex *indexPtr; /* The character in the text for which + * display information is wanted. */ +{ + CkTextTag **tagPtrs; + register CkTextTag *tagPtr; + StyleValues styleValues; + Style *stylePtr; + Tcl_HashEntry *hPtr; + int numTags, new, i; + + /* + * The variables below keep track of the highest-priority specification + * that has occurred for each of the various fields of the StyleValues. + */ + + int bgPrio, fgPrio, attrPrio, justifyPrio; + int lMargin1Prio, lMargin2Prio, rMarginPrio; + int tabPrio, wrapPrio; + + /* + * Find out what tags are present for the character, then compute + * a StyleValues structure corresponding to those tags (scan + * through all of the tags, saving information for the highest- + * priority tag). + */ + + tagPtrs = CkBTreeGetTags(indexPtr, &numTags); + bgPrio = fgPrio = attrPrio = justifyPrio = -1; + lMargin1Prio = lMargin2Prio = rMarginPrio = -1; + tabPrio = wrapPrio = -1; + memset((VOID *) &styleValues, 0, sizeof(StyleValues)); + styleValues.fg = textPtr->fg; + styleValues.bg = textPtr->bg; + styleValues.attr = textPtr->attr; + styleValues.justify = CK_JUSTIFY_LEFT; + styleValues.tabArrayPtr = textPtr->tabArrayPtr; + styleValues.wrapMode = textPtr->wrapMode; + for (i = 0 ; i < numTags; i++) { + tagPtr = tagPtrs[i]; + if ((tagPtr->bg != -1) && (tagPtr->priority > bgPrio)) { + styleValues.bg = tagPtr->bg; + bgPrio = tagPtr->priority; + } + if ((tagPtr->fg != -1) && (tagPtr->priority > fgPrio)) { + styleValues.fg = tagPtr->fg; + fgPrio = tagPtr->priority; + } + if ((tagPtr->attr != -1) && (tagPtr->priority > attrPrio)) { + styleValues.attr = tagPtr->attr; + attrPrio = tagPtr->priority; + } + if ((tagPtr->justifyString != NULL) + && (tagPtr->priority > justifyPrio)) { + styleValues.justify = tagPtr->justify; + justifyPrio = tagPtr->priority; + } + if ((tagPtr->lMargin1String != NULL) + && (tagPtr->priority > lMargin1Prio)) { + styleValues.lMargin1 = tagPtr->lMargin1; + lMargin1Prio = tagPtr->priority; + } + if ((tagPtr->lMargin2String != NULL) + && (tagPtr->priority > lMargin2Prio)) { + styleValues.lMargin2 = tagPtr->lMargin2; + lMargin2Prio = tagPtr->priority; + } + if ((tagPtr->rMarginString != NULL) + && (tagPtr->priority > rMarginPrio)) { + styleValues.rMargin = tagPtr->rMargin; + rMarginPrio = tagPtr->priority; + } + if ((tagPtr->tabString != NULL) + && (tagPtr->priority > tabPrio)) { + styleValues.tabArrayPtr = tagPtr->tabArrayPtr; + tabPrio = tagPtr->priority; + } + if ((tagPtr->wrapMode != NULL) + && (tagPtr->priority > wrapPrio)) { + styleValues.wrapMode = tagPtr->wrapMode; + wrapPrio = tagPtr->priority; + } + } + if (tagPtrs != NULL) { + ckfree((char *) tagPtrs); + } + + /* + * Use an existing style if there's one around that matches. + */ + + hPtr = Tcl_CreateHashEntry(&textPtr->dInfoPtr->styleTable, + (char *) &styleValues, &new); + if (!new) { + stylePtr = (Style *) Tcl_GetHashValue(hPtr); + stylePtr->refCount++; + return stylePtr; + } + + /* + * No existing style matched. Make a new one. + */ + + stylePtr = (Style *) ckalloc(sizeof(Style)); + stylePtr->refCount = 1; + stylePtr->sValuePtr = (StyleValues *) + Tcl_GetHashKey(&textPtr->dInfoPtr->styleTable, hPtr); + stylePtr->hPtr = hPtr; + Tcl_SetHashValue(hPtr, stylePtr); + return stylePtr; +} + +/* + *---------------------------------------------------------------------- + * + * FreeStyle -- + * + * This procedure is called when a Style structure is no longer + * needed. It decrements the reference count and frees up the + * space for the style structure if the reference count is 0. + * + * Results: + * None. + * + * Side effects: + * The storage and other resources associated with the style + * are freed up if no-one's still using it. + * + *---------------------------------------------------------------------- + */ + +static void +FreeStyle(textPtr, stylePtr) + CkText *textPtr; /* Information about overall widget. */ + register Style *stylePtr; /* Information about style to be freed. */ + +{ + stylePtr->refCount--; + if (stylePtr->refCount == 0) { + Tcl_DeleteHashEntry(stylePtr->hPtr); + ckfree((char *) stylePtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * LayoutDLine -- + * + * This procedure generates a single DLine structure for a display + * line whose leftmost character is given by indexPtr. + * + * Results: + * The return value is a pointer to a DLine structure desribing the + * display line. All fields are filled in and correct except for + * y and nextPtr. + * + * Side effects: + * Storage is allocated for the new DLine. + * + *---------------------------------------------------------------------- + */ + +static DLine * +LayoutDLine(textPtr, indexPtr) + CkText *textPtr; /* Overall information about text widget. */ + CkTextIndex *indexPtr; /* Beginning of display line. May not + * necessarily point to a character segment. */ +{ + register DLine *dlPtr; /* New display line. */ + CkTextSegment *segPtr; /* Current segment in text. */ + CkTextDispChunk *lastChunkPtr; /* Last chunk allocated so far + * for line. */ + CkTextDispChunk *chunkPtr; /* Current chunk. */ + CkTextIndex curIndex; + CkTextDispChunk *breakChunkPtr; /* Chunk containing best word break + * point, if any. */ + CkTextIndex breakIndex; /* Index of first character in + * breakChunkPtr. */ + int breakCharOffset; /* Character within breakChunkPtr just + * to right of best break point. */ + int noCharsYet; /* Non-zero means that no characters + * have been placed on the line yet. */ + int justify; /* How to justify line: taken from + * style for first character in line. */ + int jIndent; /* Additional indentation (beyond + * margins) due to justification. */ + int rMargin; /* Right margin width for line. */ + Ck_Uid wrapMode; /* Wrap mode to use for this line. */ + int x = 0, maxX = 0; /* Initializations needed only to + * stop compiler warnings. */ + int wholeLine; /* Non-zero means this display line + * runs to the end of the text line. */ + int tabIndex; /* Index of the current tab stop. */ + int gotTab; /* Non-zero means the current chunk + * contains a tab. */ + CkTextDispChunk *tabChunkPtr; /* Pointer to the chunk containing + * the previous tab stop. */ + int maxChars; /* Maximum number of characters to + * include in this chunk. */ + CkTextTabArray *tabArrayPtr; /* Tab stops for line; taken from + * style for first character on line. */ + int tabSize; /* Number of pixels consumed by current + * tab stop. */ + int offset, code; + StyleValues *sValuePtr; + + /* + * Create and initialize a new DLine structure. + */ + + dlPtr = (DLine *) ckalloc(sizeof(DLine)); + dlPtr->index = *indexPtr; + dlPtr->count = 0; + dlPtr->y = 0; + dlPtr->oldY = -1; + dlPtr->height = 0; + dlPtr->chunkPtr = NULL; + dlPtr->nextPtr = NULL; + dlPtr->flags = NEW_LAYOUT; + + /* + * Each iteration of the loop below creates one CkTextDispChunk for + * the new display line. The line will always have at least one + * chunk (for the newline character at the end, if there's nothing + * else available). + */ + + curIndex = *indexPtr; + lastChunkPtr = NULL; + chunkPtr = NULL; + noCharsYet = 1; + breakChunkPtr = NULL; + breakCharOffset = 0; + justify = CK_JUSTIFY_LEFT; + tabIndex = -1; + tabChunkPtr = NULL; + tabArrayPtr = NULL; + rMargin = 0; + wrapMode = ckTextCharUid; + tabSize = 0; + + /* + * Find the first segment to consider for the line. Can't call + * CkTextIndexToSeg for this because it won't return a segment + * with zero size (such as the insertion cursor's mark). + */ + + for (offset = curIndex.charIndex, segPtr = curIndex.linePtr->segPtr; + (offset > 0) && (offset >= segPtr->size); + offset -= segPtr->size, segPtr = segPtr->nextPtr) { + /* Empty loop body. */ + } + + while (segPtr != NULL) { + if (segPtr->typePtr->layoutProc == NULL) { + segPtr = segPtr->nextPtr; + offset = 0; + continue; + } + if (chunkPtr == NULL) { + chunkPtr = (CkTextDispChunk *) ckalloc(sizeof(CkTextDispChunk)); + chunkPtr->nextPtr = NULL; + } + chunkPtr->stylePtr = GetStyle(textPtr, &curIndex); + + /* + * Save style information such as justification and indentation, + * up until the first character is encountered, then retain that + * information for the rest of the line. + */ + + if (noCharsYet) { + tabArrayPtr = chunkPtr->stylePtr->sValuePtr->tabArrayPtr; + justify = chunkPtr->stylePtr->sValuePtr->justify; + rMargin = chunkPtr->stylePtr->sValuePtr->rMargin; + wrapMode = chunkPtr->stylePtr->sValuePtr->wrapMode; + x = ((curIndex.charIndex == 0) + ? chunkPtr->stylePtr->sValuePtr->lMargin1 + : chunkPtr->stylePtr->sValuePtr->lMargin2); + if (wrapMode == ckTextNoneUid) { + maxX = INT_MAX; + } else { + maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x + - rMargin; + if (maxX < x) { + maxX = x; + } + } + } + + /* + * See if there is a tab in the current chunk; if so, only + * layout characters up to (and including) the tab. + */ + + gotTab = 0; + maxChars = segPtr->size - offset; + if (justify == CK_JUSTIFY_LEFT) { + if (segPtr->typePtr == &ckTextCharType) { + char *p; + + for (p = segPtr->body.chars + offset; *p != 0; p++) { + if (*p == '\t') { + maxChars = (p + 1 - segPtr->body.chars) - offset; + gotTab = 1; + break; + } + } + } + } + + chunkPtr->x = x; + code = (*segPtr->typePtr->layoutProc)(textPtr, &curIndex, segPtr, + offset, maxX-tabSize, maxChars, noCharsYet, wrapMode, + chunkPtr); + if (code <= 0) { + FreeStyle(textPtr, chunkPtr->stylePtr); + if (code < 0) { + /* + * This segment doesn't wish to display itself (e.g. most + * marks). + */ + + segPtr = segPtr->nextPtr; + offset = 0; + continue; + } + + /* + * No characters from this segment fit in the window: this + * means we're at the end of the display line. + */ + + if (chunkPtr != NULL) { + ckfree((char *) chunkPtr); + } + break; + } + if (chunkPtr->numChars > 0) { + noCharsYet = 0; + } + if (lastChunkPtr == NULL) { + dlPtr->chunkPtr = chunkPtr; + } else { + lastChunkPtr->nextPtr = chunkPtr; + } + lastChunkPtr = chunkPtr; + x += chunkPtr->width; + if (chunkPtr->breakIndex > 0) { + breakCharOffset = chunkPtr->breakIndex; + breakIndex = curIndex; + breakChunkPtr = chunkPtr; + } + if (chunkPtr->numChars != maxChars) { + break; + } + + /* + * If we're at a new tab, adjust the layout for all the chunks + * pertaining to the previous tab. Also adjust the amount of + * space left in the line to account for space that will be eaten + * up by the tab. + */ + + if (gotTab) { + if (tabIndex >= 0) { + AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr); + x = chunkPtr->x + chunkPtr->width; + } + tabIndex++; + tabChunkPtr = chunkPtr; + tabSize = SizeOfTab(textPtr, tabArrayPtr, tabIndex, x, maxX); + if (tabSize >= (maxX - x)) { + break; + } + } + curIndex.charIndex += chunkPtr->numChars; + offset += chunkPtr->numChars; + if (offset >= segPtr->size) { + offset = 0; + segPtr = segPtr->nextPtr; + } + chunkPtr = NULL; + } + if (noCharsYet) { + panic("LayoutDLine couldn't place any characters on a line"); + } + wholeLine = (segPtr == NULL); + + /* + * We're at the end of the display line. Throw away everything + * after the most recent word break, if there is one; this may + * potentially require the last chunk to be layed out again. + */ + + if ((breakChunkPtr != NULL) && ((lastChunkPtr != breakChunkPtr) + || (breakCharOffset != lastChunkPtr->numChars))) { + while (1) { + chunkPtr = breakChunkPtr->nextPtr; + if (chunkPtr == NULL) { + break; + } + FreeStyle(textPtr, chunkPtr->stylePtr); + breakChunkPtr->nextPtr = chunkPtr->nextPtr; + (*chunkPtr->undisplayProc)(textPtr, chunkPtr); + ckfree((char *) chunkPtr); + } + if (breakCharOffset != breakChunkPtr->numChars) { + (*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr); + segPtr = CkTextIndexToSeg(&breakIndex, &offset); + (*segPtr->typePtr->layoutProc)(textPtr, &breakIndex, + segPtr, offset, maxX, breakCharOffset, 0, + wrapMode, breakChunkPtr); + } + lastChunkPtr = breakChunkPtr; + wholeLine = 0; + } + + /* + * Make tab adjustments for the last tab stop, if there is one. + */ + + if ((tabIndex >= 0) && (tabChunkPtr != NULL)) { + AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr); + } + + /* + * Make one more pass over the line to recompute various things + * like its height, length, and total number of characters. Also + * modify the x-locations of chunks to reflect justification. + * If we're not wrapping, I'm not sure what is the best way to + * handle left and center justification: should the total length, + * for purposes of justification, be (a) the window width, (b) + * the length of the longest line in the window, or (c) the length + * of the longest line in the text? (c) isn't available, (b) seems + * weird, since it can change with vertical scrolling, so (a) is + * what is implemented below. + */ + + if (wrapMode == ckTextNoneUid) { + maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin; + } + dlPtr->length = lastChunkPtr->x + lastChunkPtr->width; + if (justify == CK_JUSTIFY_LEFT) { + jIndent = 0; + } else if (justify == CK_JUSTIFY_RIGHT) { + jIndent = maxX - dlPtr->length; + } else { + jIndent = (maxX - dlPtr->length)/2; + } + for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL; + chunkPtr = chunkPtr->nextPtr) { + chunkPtr->x += jIndent; + dlPtr->count += chunkPtr->numChars; + if (chunkPtr->minHeight > dlPtr->height) { + dlPtr->height = chunkPtr->minHeight; + } + sValuePtr = chunkPtr->stylePtr->sValuePtr; + } + sValuePtr = dlPtr->chunkPtr->stylePtr->sValuePtr; + + /* + * Recompute line length: may have changed because of justification. + */ + + dlPtr->length = lastChunkPtr->x + lastChunkPtr->width; + return dlPtr; +} + +/* + *---------------------------------------------------------------------- + * + * UpdateDisplayInfo -- + * + * This procedure is invoked to recompute some or all of the + * DLine structures for a text widget. At the time it is called + * the DLine structures still left in the widget are guaranteed + * to be correct except that (a) the y-coordinates aren't + * necessarily correct, (b) there may be missing structures + * (the DLine structures get removed as soon as they are potentially + * out-of-date), and (c) DLine structures that don't start at the + * beginning of a line may be incorrect if previous information in + * the same line changed size in a way that moved a line boundary + * (DLines for any info that changed will have been deleted, but + * not DLines for unchanged info in the same text line). + * + * Results: + * None. + * + * Side effects: + * Upon return, the DLine information for textPtr correctly reflects + * the positions where characters will be displayed. However, this + * procedure doesn't actually bring the display up-to-date. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateDisplayInfo(textPtr) + CkText *textPtr; /* Text widget to update. */ +{ + register DInfo *dInfoPtr = textPtr->dInfoPtr; + register DLine *dlPtr, *prevPtr; + CkTextIndex index; + CkTextLine *lastLinePtr; + int y, maxY, maxOffset; + + if (!(dInfoPtr->flags & DINFO_OUT_OF_DATE)) { + return; + } + dInfoPtr->flags &= ~DINFO_OUT_OF_DATE; + + /* + * Delete any DLines that are now above the top of the window. + */ + + index = textPtr->topIndex; + dlPtr = FindDLine(dInfoPtr->dLinePtr, &index); + if ((dlPtr != NULL) && (dlPtr != dInfoPtr->dLinePtr)) { + FreeDLines(textPtr, dInfoPtr->dLinePtr, dlPtr, 1); + } + + /* + *-------------------------------------------------------------- + * Scan through the contents of the window from top to bottom, + * recomputing information for lines that are missing. + *-------------------------------------------------------------- + */ + + lastLinePtr = CkBTreeFindLine(textPtr->tree, + CkBTreeNumLines(textPtr->tree)); + dlPtr = dInfoPtr->dLinePtr; + prevPtr = NULL; + y = dInfoPtr->y; + maxY = dInfoPtr->maxY; + while (1) { + register DLine *newPtr; + + if (index.linePtr == lastLinePtr) { + break; + } + + /* + * There are three possibilities right now: + * (a) the next DLine (dlPtr) corresponds exactly to the next + * information we want to display: just use it as-is. + * (b) the next DLine corresponds to a different line, or to + * a segment that will be coming later in the same line: + * leave this DLine alone in the hopes that we'll be able + * to use it later, then create a new DLine in front of + * it. + * (c) the next DLine corresponds to a segment in the line we + * want, but it's a segment that has already been processed + * or will never be processed. Delete the DLine and try + * again. + * + * One other twist on all this. It's possible for 3D borders + * to interact between lines (see DisplayLineBackground) so if + * a line is relayed out and has styles with 3D borders, its + * neighbors have to be redrawn if they have 3D borders too, + * since the interactions could have changed (the neighbors + * don't have to be relayed out, just redrawn). + */ + + if ((dlPtr == NULL) || (dlPtr->index.linePtr != index.linePtr)) { + /* + * Case (b) -- must make new DLine. + */ + + makeNewDLine: + if (ckTextDebug) { + char string[TK_POS_CHARS]; + + /* + * Debugging is enabled, so keep a log of all the lines + * that were re-layed out. The test suite uses this + * information. + */ + + CkTextPrintIndex(&index, string); + Tcl_SetVar2(textPtr->interp, "ck_textRelayout", (char *) NULL, + string, + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + } + newPtr = LayoutDLine(textPtr, &index); + if (prevPtr == NULL) { + dInfoPtr->dLinePtr = newPtr; + } else { + prevPtr->nextPtr = newPtr; + } + newPtr->nextPtr = dlPtr; + dlPtr = newPtr; + } else { + /* + * DlPtr refers to the line we want. Next check the + * index within the line. + */ + + if (index.charIndex == dlPtr->index.charIndex) { + /* + * Case (a) -- can use existing display line as-is. + */ + goto lineOK; + } + if (index.charIndex < dlPtr->index.charIndex) { + goto makeNewDLine; + } + + /* + * Case (c) -- dlPtr is useless. Discard it and start + * again with the next display line. + */ + + newPtr = dlPtr->nextPtr; + FreeDLines(textPtr, dlPtr, newPtr, 0); + dlPtr = newPtr; + continue; + } + + /* + * Advance to the start of the next line. + */ + + lineOK: + dlPtr->y = y; + y += dlPtr->height; +#if CK_USE_UTF + CkTextIndexForwBytes(&index, dlPtr->count, &index); +#else + CkTextIndexForwChars(&index, dlPtr->count, &index); +#endif + prevPtr = dlPtr; + dlPtr = dlPtr->nextPtr; + + /* + * If we switched text lines, delete any DLines left for the + * old text line. + */ + + if (index.linePtr != prevPtr->index.linePtr) { + register DLine *nextPtr; + + nextPtr = dlPtr; + while ((nextPtr != NULL) + && (nextPtr->index.linePtr == prevPtr->index.linePtr)) { + nextPtr = nextPtr->nextPtr; + } + if (nextPtr != dlPtr) { + FreeDLines(textPtr, dlPtr, nextPtr, 0); + prevPtr->nextPtr = nextPtr; + dlPtr = nextPtr; + } + } + + /* + * It's important to have the following check here rather than in + * the while statement for the loop, so that there's always at least + * one DLine generated, regardless of how small the window is. This + * keeps a lot of other code from breaking. + */ + + if (y >= maxY) { + break; + } + } + + /* + * Delete any DLine structures that don't fit on the screen. + */ + + FreeDLines(textPtr, dlPtr, (DLine *) NULL, 1); + + /* + *-------------------------------------------------------------- + * If there is extra space at the bottom of the window (because + * we've hit the end of the text), then bring in more lines at + * the top of the window, if there are any, to fill in the view. + *-------------------------------------------------------------- + */ + + if (y < maxY) { + int lineNum, spaceLeft, charsToCount; + DLine *lowestPtr; + + /* + * Layout an entire text line (potentially > 1 display line), + * then link in as many display lines as fit without moving + * the bottom line out of the window. Repeat this until + * all the extra space has been used up or we've reached the + * beginning of the text. + */ + + spaceLeft = maxY - y; + lineNum = CkBTreeLineIndex(dInfoPtr->dLinePtr->index.linePtr); + charsToCount = dInfoPtr->dLinePtr->index.charIndex; + if (charsToCount == 0) { + charsToCount = INT_MAX; + lineNum--; + } + for ( ; (lineNum >= 0) && (spaceLeft > 0); lineNum--) { + index.linePtr = CkBTreeFindLine(textPtr->tree, lineNum); + index.charIndex = 0; + lowestPtr = NULL; + do { + dlPtr = LayoutDLine(textPtr, &index); + dlPtr->nextPtr = lowestPtr; + lowestPtr = dlPtr; +#if CK_USE_UTF + if (dlPtr->length == 0 && dlPtr->height == 0) { + charsToCount--; + break; + } + CkTextIndexForwBytes(&index, dlPtr->count, &index); +#else + CkTextIndexForwChars(&index, dlPtr->count, &index); +#endif + charsToCount -= dlPtr->count; + } while ((charsToCount > 0) + && (index.linePtr == lowestPtr->index.linePtr)); + + /* + * Scan through the display lines from the bottom one up to + * the top one. + */ + + while (lowestPtr != NULL) { + dlPtr = lowestPtr; + spaceLeft -= dlPtr->height; + if (spaceLeft < 0) { + break; + } + lowestPtr = dlPtr->nextPtr; + dlPtr->nextPtr = dInfoPtr->dLinePtr; + dInfoPtr->dLinePtr = dlPtr; + if (ckTextDebug) { + char string[TK_POS_CHARS]; + + CkTextPrintIndex(&dlPtr->index, string); + Tcl_SetVar2(textPtr->interp, "ck_textRelayout", + (char *) NULL, string, + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + } + } + FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0); + charsToCount = INT_MAX; + } + + /* + * Now we're all done except that the y-coordinates in all the + * DLines are wrong and the top index for the text is wrong. + * Update them. + */ + + textPtr->topIndex = dInfoPtr->dLinePtr->index; + y = dInfoPtr->y; + for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; + dlPtr = dlPtr->nextPtr) { + if (y > dInfoPtr->maxY) { + panic("Added too many new lines in UpdateDisplayInfo"); + } + dlPtr->y = y; + y += dlPtr->height; + } + } + + /* + *-------------------------------------------------------------- + * If the old top or bottom line has scrolled elsewhere on the + * screen, we may not be able to re-use its old contents by + * copying bits (e.g., a beveled edge that was drawn when it was + * at the top or bottom won't be drawn when the line is in the + * middle and its neighbor has a matching background). Similarly, + * if the new top or bottom line came from somewhere else on the + * screen, we may not be able to copy the old bits. + *-------------------------------------------------------------- + */ + + dlPtr = dInfoPtr->dLinePtr; + while (1) { + if (dlPtr->nextPtr == NULL) { + dlPtr->flags &= ~TOP_LINE; + dlPtr->flags |= BOTTOM_LINE; + break; + } + dlPtr->flags &= ~(TOP_LINE|BOTTOM_LINE); + dlPtr = dlPtr->nextPtr; + } + dInfoPtr->dLinePtr->flags |= TOP_LINE; + + /* + * Arrange for scrollbars to be updated. + */ + + textPtr->flags |= UPDATE_SCROLLBARS; + + /* + *-------------------------------------------------------------- + * Deal with horizontal scrolling: + * 1. If there's empty space to the right of the longest line, + * shift the screen to the right to fill in the empty space. + * 2. If the desired horizontal scroll position has changed, + * force a full redisplay of all the lines in the widget. + * 3. If the wrap mode isn't "none" then re-scroll to the base + * position. + *-------------------------------------------------------------- + */ + + dInfoPtr->maxLength = 0; + for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; + dlPtr = dlPtr->nextPtr) { + if (dlPtr->length > dInfoPtr->maxLength) { + dInfoPtr->maxLength = dlPtr->length; + } + } + + maxOffset = dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x); + if (dInfoPtr->newCharOffset >= maxOffset) { + dInfoPtr->newCharOffset = maxOffset != 0 ? maxOffset + 1 : 0; + } + if (dInfoPtr->newCharOffset < 0) { + dInfoPtr->newCharOffset = 0; + } + if (dInfoPtr->newCharOffset != dInfoPtr->curOffset) { + dInfoPtr->curOffset = dInfoPtr->newCharOffset; + for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; + dlPtr = dlPtr->nextPtr) { + dlPtr->oldY = -1; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * FreeDLines -- + * + * This procedure is called to free up all of the resources + * associated with one or more DLine structures. + * + * Results: + * None. + * + * Side effects: + * Memory gets freed and various other resources are released. + * + *---------------------------------------------------------------------- + */ + +static void +FreeDLines(textPtr, firstPtr, lastPtr, unlink) + CkText *textPtr; /* Information about overall text + * widget. */ + register DLine *firstPtr; /* Pointer to first DLine to free up. */ + DLine *lastPtr; /* Pointer to DLine just after last + * one to free (NULL means everything + * starting with firstPtr). */ + int unlink; /* 1 means DLines are currently linked + * into the list rooted at + * textPtr->dInfoPtr->dLinePtr and + * they have to be unlinked. 0 means + * just free without unlinking. */ +{ + register CkTextDispChunk *chunkPtr, *nextChunkPtr; + register DLine *nextDLinePtr; + + if (unlink) { + if (textPtr->dInfoPtr->dLinePtr == firstPtr) { + textPtr->dInfoPtr->dLinePtr = lastPtr; + } else { + register DLine *prevPtr; + for (prevPtr = textPtr->dInfoPtr->dLinePtr; + prevPtr->nextPtr != firstPtr; prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + prevPtr->nextPtr = lastPtr; + } + } + while (firstPtr != lastPtr) { + nextDLinePtr = firstPtr->nextPtr; + for (chunkPtr = firstPtr->chunkPtr; chunkPtr != NULL; + chunkPtr = nextChunkPtr) { + if (chunkPtr->undisplayProc != NULL) { + (*chunkPtr->undisplayProc)(textPtr, chunkPtr); + } + FreeStyle(textPtr, chunkPtr->stylePtr); + nextChunkPtr = chunkPtr->nextPtr; + ckfree((char *) chunkPtr); + } + ckfree((char *) firstPtr); + firstPtr = nextDLinePtr; + } + textPtr->dInfoPtr->dLinesInvalidated = 1; +} + +/* + *---------------------------------------------------------------------- + * + * DisplayDLine -- + * + * This procedure is invoked to draw a single line on the + * screen. + * + * Results: + * None. + * + * Side effects: + * The line given by dlPtr is drawn at its correct position in + * textPtr's window. Note that this is one *display* line, not + * one *text* line. + * + *---------------------------------------------------------------------- + */ + +static void +DisplayDLine(textPtr, dlPtr, prevPtr, window) + CkText *textPtr; /* Text widget in which to draw line. */ + register DLine *dlPtr; /* Information about line to draw. */ + DLine *prevPtr; /* Line just before one to draw, or NULL + * if dlPtr is the top line. */ + WINDOW *window; +{ + register CkTextDispChunk *chunkPtr; + DInfo *dInfoPtr = textPtr->dInfoPtr; + int x; + + /* + * First, clear the area of the line to the background color for the + * text widget. + */ + + Ck_SetWindowAttr(textPtr->winPtr, textPtr->fg, textPtr->bg, textPtr->attr); + Ck_ClearToEol(textPtr->winPtr, 0, dlPtr->y); + + /* + * Make yet another pass through all of the chunks to redraw all of + * foreground information. Note: we have to call the displayProc + * even for chunks that are off-screen. This is needed, for + * example, so that embedded windows can be unmapped in this case. + */ + + for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL); + chunkPtr = chunkPtr->nextPtr) { + x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curOffset; + if (chunkPtr->displayProc == CkTextInsertDisplayProc) { + (*chunkPtr->displayProc)(chunkPtr, x, 0, dlPtr->height, + 0, window, dlPtr->y); + continue; + } + if ((x + chunkPtr->width <= 0) || (x >= dInfoPtr->maxX)) { + /* + * Note: we have to call the displayProc even for chunks + * that are off-screen. This is needed, for example, so + * that embedded windows can be unmapped in this case. + * Display the chunk at a coordinate that can be clearly + * identified by the displayProc as being off-screen to + * the left (the displayProc may not be able to tell if + * something is off to the right). + */ + + (*chunkPtr->displayProc)(chunkPtr, -chunkPtr->width, + 0, dlPtr->height, 0, window, dlPtr->y); + } else { + (*chunkPtr->displayProc)(chunkPtr, x, 0, + dlPtr->height, 0, window, dlPtr->y); + } + if (dInfoPtr->dLinesInvalidated) { + return; + } + } + linesRedrawn++; +} + +/* + *---------------------------------------------------------------------- + * + * DisplayText -- + * + * This procedure is invoked as a when-idle handler to update the + * display. It only redisplays the parts of the text widget that + * are out of date. + * + * Results: + * None. + * + * Side effects: + * Information is redrawn on the screen. + * + *---------------------------------------------------------------------- + */ + +static void +DisplayText(clientData) + ClientData clientData; /* Information about widget. */ +{ + register CkText *textPtr = (CkText *) clientData; + DInfo *dInfoPtr = textPtr->dInfoPtr; + CkWindow *winPtr; + register DLine *dlPtr; + DLine *prevPtr; + int maxHeight; + int bottomY = 0; /* Initialization needed only to stop + * compiler warnings. */ + + if (textPtr->winPtr == NULL) { + /* + * The widget has been deleted. Don't do anything. + */ + + return; + } + + if (ckTextDebug) { + Tcl_SetVar2(textPtr->interp, "ck_textRelayout", (char *) NULL, + "", TCL_GLOBAL_ONLY); + } + + if (!(textPtr->winPtr->flags & CK_MAPPED) || + (dInfoPtr->maxX <= dInfoPtr->x) || (dInfoPtr->maxY <= dInfoPtr->y)) { + UpdateDisplayInfo(textPtr); + dInfoPtr->flags &= ~REDRAW_PENDING; + goto doScrollbars; + } + numRedisplays++; + if (ckTextDebug) { + Tcl_SetVar2(textPtr->interp, "ck_textRedraw", (char *) NULL, + "", TCL_GLOBAL_ONLY); + } + + /* + * Choose a new current item if that is needed (this could cause + * event handlers to be invoked, hence the preserve/release calls + * and the loop, since the handlers could conceivably necessitate + * yet another current item calculation). The ckwin check is because + * the whole window could go away in the Ck_Release call. + */ + + while (dInfoPtr->flags & REPICK_NEEDED) { + Ck_Preserve((ClientData) textPtr); + dInfoPtr->flags &= ~REPICK_NEEDED; + CkTextPickCurrent(textPtr, &textPtr->pickEvent); + winPtr = textPtr->winPtr; + Ck_Release((ClientData) textPtr); + if (winPtr == NULL) { + return; + } + } + + /* + * First recompute what's supposed to be displayed. + */ + + UpdateDisplayInfo(textPtr); + dInfoPtr->dLinesInvalidated = 0; + dInfoPtr->flags &= ~REDRAW_PENDING; + + maxHeight = -1; + for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) { + if ((dlPtr->height > maxHeight) && (dlPtr->oldY != dlPtr->y)) { + maxHeight = dlPtr->height; + } + bottomY = dlPtr->y + dlPtr->height; + } + if (maxHeight > dInfoPtr->maxY) { + maxHeight = dInfoPtr->maxY; + } + + + /* + * Now we have to redraw the lines that couldn't be updated by + * scrolling. First, compute the height of the largest line and + * allocate an off-screen pixmap to use for double-buffered + * displays. + */ + + if (maxHeight > 0) { + for (prevPtr = NULL, dlPtr = textPtr->dInfoPtr->dLinePtr; + (dlPtr != NULL) && (dlPtr->y < dInfoPtr->maxY); + prevPtr = dlPtr, dlPtr = dlPtr->nextPtr) { + if (dlPtr->oldY != dlPtr->y) { + if (ckTextDebug) { + char string[TK_POS_CHARS]; + CkTextPrintIndex(&dlPtr->index, string); + Tcl_SetVar2(textPtr->interp, "ck_textRedraw", + (char *) NULL, string, + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + } + DisplayDLine(textPtr, dlPtr, prevPtr, textPtr->winPtr->window); + if (dInfoPtr->dLinesInvalidated) { + goto done; + } + dlPtr->oldY = dlPtr->y; + dlPtr->flags &= ~NEW_LAYOUT; + } + } + } + + /* + * See if we need to refresh the part of the window below the + * last line of text (if there is any such area). + */ + + if (dInfoPtr->topOfEof > dInfoPtr->maxY) { + dInfoPtr->topOfEof = dInfoPtr->maxY; + } + if (bottomY < dInfoPtr->topOfEof) { + if (ckTextDebug) { + Tcl_SetVar2(textPtr->interp, "ck_textRedraw", + (char *) NULL, "eof", + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + } + Ck_SetWindowAttr(textPtr->winPtr, textPtr->fg, textPtr->bg, + textPtr->attr); + Ck_ClearToBot(textPtr->winPtr, 0, bottomY); + } + dInfoPtr->topOfEof = bottomY; + +doScrollbars: + + /* + * Update the vertical scrollbar, if there is one. Note: it's + * important to clear REDRAW_PENDING here, just in case the + * scroll procedure does something that requires redisplay. + */ + + if (textPtr->flags & UPDATE_SCROLLBARS) { + textPtr->flags &= ~UPDATE_SCROLLBARS; + if (textPtr->yScrollCmd != NULL) { + GetYView(textPtr->interp, textPtr, 1); + } + + /* + * Update the horizontal scrollbar, if any. + */ + + if (textPtr->xScrollCmd != NULL) { + GetXView(textPtr->interp, textPtr, 1); + } + } +done: + if (textPtr->insertX >= 0 && + textPtr->insertX < textPtr->winPtr->width && + textPtr->insertY >= 0 && + textPtr->insertY < textPtr->winPtr->height && + textPtr->winPtr->window != NULL) { + wmove(textPtr->winPtr->window, textPtr->insertY, textPtr->insertX); + Ck_SetHWCursor(textPtr->winPtr, 1); + } else + Ck_SetHWCursor(textPtr->winPtr, 0); + Ck_EventuallyRefresh(textPtr->winPtr); +} + +/* + *---------------------------------------------------------------------- + * + * CkTextEventuallyRepick -- + * + * This procedure is invoked whenever something happens that + * could change the current character or the tags associated + * with it. + * + * Results: + * None. + * + * Side effects: + * A repick is scheduled as an idle handler. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +void +CkTextEventuallyRepick(textPtr) + CkText *textPtr; /* Widget record for text widget. */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + + dInfoPtr->flags |= REPICK_NEEDED; + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + dInfoPtr->flags |= REDRAW_PENDING; + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * CkTextRedrawRegion -- + * + * This procedure is invoked to schedule a redisplay for a given + * region of a text widget. The redisplay itself may not occur + * immediately: it's scheduled as a when-idle handler. + * + * Results: + * None. + * + * Side effects: + * Information will eventually be redrawn on the screen. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +void +CkTextRedrawRegion(textPtr, x, y, width, height) + CkText *textPtr; /* Widget record for text widget. */ + int x, y; /* Coordinates of upper-left corner of area + * to be redrawn, in pixels relative to + * textPtr's window. */ + int width, height; /* Width and height of area to be redrawn. */ +{ + register DLine *dlPtr; + DInfo *dInfoPtr = textPtr->dInfoPtr; + int maxY; + + /* + * Find all lines that overlap the given region and mark them for + * redisplay. + */ + + maxY = y + height; + for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; + dlPtr = dlPtr->nextPtr) { + if (((dlPtr->y + dlPtr->height) > y) && (dlPtr->y < maxY)) { + dlPtr->oldY = -1; + } + } + if (dInfoPtr->topOfEof < maxY) { + dInfoPtr->topOfEof = maxY; + } + + /* + * Schedule the redisplay operation if there isn't one already + * scheduled. + */ + + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + dInfoPtr->flags |= REDRAW_PENDING; + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * CkTextChanged -- + * + * This procedure is invoked when info in a text widget is about + * to be modified in a way that changes how it is displayed (e.g. + * characters were inserted or deleted, or tag information was + * changed). This procedure must be called *before* a change is + * made, so that indexes in the display information are still + * valid. + * + * Results: + * None. + * + * Side effects: + * The range of character between index1Ptr (inclusive) and + * index2Ptr (exclusive) will be redisplayed at some point in the + * future (the actual redisplay is scheduled as a when-idle handler). + * + *---------------------------------------------------------------------- + */ + +void +CkTextChanged(textPtr, index1Ptr, index2Ptr) + CkText *textPtr; /* Widget record for text widget. */ + CkTextIndex *index1Ptr; /* Index of first character to redisplay. */ + CkTextIndex *index2Ptr; /* Index of character just after last one + * to redisplay. */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + DLine *firstPtr, *lastPtr; + CkTextIndex rounded; + + /* + * Schedule both a redisplay and a recomputation of display information. + * It's done here rather than the end of the procedure for two reasons: + * + * 1. If there are no display lines to update we'll want to return + * immediately, well before the end of the procedure. + * 2. It's important to arrange for the redisplay BEFORE calling + * FreeDLines. The reason for this is subtle and has to do with + * embedded windows. The chunk delete procedure for an embedded + * window will schedule an idle handler to unmap the window. + * However, we want the idle handler for redisplay to be called + * first, so that it can put the embedded window back on the screen + * again (if appropriate). This will prevent the window from ever + * being unmapped, and thereby avoid flashing. + */ + + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } + dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; + + /* + * Find the DLines corresponding to index1Ptr and index2Ptr. There + * is one tricky thing here, which is that we have to relayout in + * units of whole text lines: round index1Ptr back to the beginning + * of its text line, and include all the display lines after index2, + * up to the end of its text line. This is necessary because the + * indices stored in the display lines will no longer be valid. It's + * also needed because any edit could change the way lines wrap. + */ + + rounded = *index1Ptr; + rounded.charIndex = 0; + firstPtr = FindDLine(dInfoPtr->dLinePtr, &rounded); + if (firstPtr == NULL) { + return; + } + lastPtr = FindDLine(dInfoPtr->dLinePtr, index2Ptr); + while ((lastPtr != NULL) + && (lastPtr->index.linePtr == index2Ptr->linePtr)) { + lastPtr = lastPtr->nextPtr; + } + + /* + * Delete all the DLines from firstPtr up to but not including lastPtr. + */ + + FreeDLines(textPtr, firstPtr, lastPtr, 1); +} + +/* + *---------------------------------------------------------------------- + * + * CkTextRedrawTag -- + * + * This procedure is invoked to request a redraw of all characters + * in a given range that have a particular tag on or off. It's + * called, for example, when tag options change. + * + * Results: + * None. + * + * Side effects: + * Information on the screen may be redrawn, and the layout of + * the screen may change. + * + *---------------------------------------------------------------------- + */ + +void +CkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag) + CkText *textPtr; /* Widget record for text widget. */ + CkTextIndex *index1Ptr; /* First character in range to consider + * for redisplay. NULL means start at + * beginning of text. */ + CkTextIndex *index2Ptr; /* Character just after last one to consider + * for redisplay. NULL means process all + * the characters in the text. */ + CkTextTag *tagPtr; /* Information about tag. */ + int withTag; /* 1 means redraw characters that have the + * tag, 0 means redraw those without. */ +{ + register DLine *dlPtr; + DLine *endPtr; + int tagOn; + CkTextSearch search; + DInfo *dInfoPtr = textPtr->dInfoPtr; + CkTextIndex endOfText, *endIndexPtr; + + /* + * Round up the starting position if it's before the first line + * visible on the screen (we only care about what's on the screen). + */ + + dlPtr = dInfoPtr->dLinePtr; + if (dlPtr == NULL) { + return; + } + if ((index1Ptr == NULL) || (CkTextIndexCmp(&dlPtr->index, index1Ptr) > 0)) { + index1Ptr = &dlPtr->index; + } + + /* + * Set the stopping position if it wasn't specified. + */ + + if (index2Ptr == NULL) { +#if CK_USE_UTF + index2Ptr = CkTextMakeByteIndex(textPtr->tree, + CkBTreeNumLines(textPtr->tree), 0, &endOfText); +#else + index2Ptr = CkTextMakeIndex(textPtr->tree, + CkBTreeNumLines(textPtr->tree), 0, &endOfText); +#endif + } + + /* + * Initialize a search through all transitions on the tag, starting + * with the first transition where the tag's current state is different + * from what it will eventually be. + */ + + CkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search); + tagOn = CkBTreeCharTagged(index1Ptr, tagPtr); + if (tagOn != withTag) { + if (!CkBTreeNextTag(&search)) { + return; + } + } + + /* + * Schedule a redisplay and layout recalculation if they aren't + * already pending. This has to be done before calling FreeDLines, + * for the reason given in CkTextChanged. + */ + + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } + dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; + + /* + * Each loop through the loop below is for one range of characters + * where the tag's current state is different than its eventual + * state. At the top of the loop, search contains information about + * the first character in the range. + */ + + while (1) { + /* + * Find the first DLine structure in the range. Note: if the + * desired character isn't the first in its text line, then look + * for the character just before it instead. This is needed to + * handle the case where the first character of a wrapped + * display line just got smaller, so that it now fits on the + * line before: need to relayout the line containing the + * previous character. + */ + + if (search.curIndex.charIndex == 0) { + dlPtr = FindDLine(dlPtr, &search.curIndex); + } else { + CkTextIndex tmp; + + tmp = search.curIndex; + tmp.charIndex -= 1; + dlPtr = FindDLine(dlPtr, &tmp); + } + if (dlPtr == NULL) { + break; + } + + /* + * Find the first DLine structure that's past the end of the range. + */ + + if (!CkBTreeNextTag(&search)) { + endIndexPtr = index2Ptr; + } else { + endIndexPtr = &search.curIndex; + } + endPtr = FindDLine(dlPtr, endIndexPtr); + if ((endPtr != NULL) && (endPtr->index.linePtr == endIndexPtr->linePtr) + && (endPtr->index.charIndex < endIndexPtr->charIndex)) { + endPtr = endPtr->nextPtr; + } + + /* + * Delete all of the display lines in the range, so that they'll + * be re-layed out and redrawn. + */ + + FreeDLines(textPtr, dlPtr, endPtr, 1); + dlPtr = endPtr; + + /* + * Find the first text line in the next range. + */ + + if (!CkBTreeNextTag(&search)) { + break; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * CkTextRelayoutWindow -- + * + * This procedure is called when something has happened that + * invalidates the whole layout of characters on the screen, such + * as a change in a configuration option for the overall text + * widget or a change in the window size. It causes all display + * information to be recomputed and the window to be redrawn. + * + * Results: + * None. + * + * Side effects: + * All the display information will be recomputed for the window + * and the window will be redrawn. + * + *---------------------------------------------------------------------- + */ + +void +CkTextRelayoutWindow(textPtr) + CkText *textPtr; /* Widget record for text widget. */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + + /* + * Schedule the window redisplay. See CkTextChanged for the + * reason why this has to be done before any calls to FreeDLines. + */ + + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } + dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; + + /* + * Throw away all the current layout information. + */ + + FreeDLines(textPtr, dInfoPtr->dLinePtr, (DLine *) NULL, 1); + dInfoPtr->dLinePtr = NULL; + + /* + * Recompute some overall things for the layout. Even if the + * window gets very small, pretend that there's at least one + * pixel of drawing space in it. + */ + + dInfoPtr->x = 0; + dInfoPtr->y = 0; + dInfoPtr->maxX = textPtr->winPtr->width; + dInfoPtr->maxY = textPtr->winPtr->height; + dInfoPtr->topOfEof = dInfoPtr->maxY; + + /* + * If the upper-left character isn't the first in a line, recompute + * it. This is necessary because a change in the window's size + * or options could change the way lines wrap. + */ + + if (textPtr->topIndex.charIndex != 0) { + MeasureUp(textPtr, &textPtr->topIndex, 0, &textPtr->topIndex); + } +} + +/* + *---------------------------------------------------------------------- + * + * CkTextSetYView -- + * + * This procedure is called to specify what lines are to be + * displayed in a text widget. + * + * Results: + * None. + * + * Side effects: + * The display will (eventually) be updated so that the position + * given by "indexPtr" is visible on the screen at the position + * determined by "pickPlace". + * + *---------------------------------------------------------------------- + */ + +void +CkTextSetYView(textPtr, indexPtr, pickPlace) + CkText *textPtr; /* Widget record for text widget. */ + CkTextIndex *indexPtr; /* Position that is to appear somewhere + * in the view. */ + int pickPlace; /* 0 means topLine must appear at top of + * screen. 1 means we get to pick where it + * appears: minimize screen motion or else + * display line at center of screen. */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + register DLine *dlPtr; + int bottomY, close, lineIndex; + CkTextIndex tmpIndex, rounded; + + /* + * If the specified position is the extra line at the end of the + * text, round it back to the last real line. + */ + + lineIndex = CkBTreeLineIndex(indexPtr->linePtr); + if (lineIndex == CkBTreeNumLines(indexPtr->tree)) { + CkTextIndexBackChars(indexPtr, 1, &rounded); + indexPtr = &rounded; + } + + if (!pickPlace) { + /* + * The specified position must go at the top of the screen. + * Just leave all the DLine's alone: we may be able to reuse + * some of the information that's currently on the screen + * without redisplaying it all. + */ + + if (indexPtr->charIndex == 0) { + textPtr->topIndex = *indexPtr; + } else { + MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex); + } + goto scheduleUpdate; + } + + /* + * We have to pick where to display the index. First, bring + * the display information up to date and see if the index will be + * completely visible in the current screen configuration. If so + * then there's nothing to do. + */ + + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } + dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr); + if (dlPtr != NULL) { + if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) { + /* + * Part of the line hangs off the bottom of the screen; + * pretend the whole line is off-screen. + */ + + dlPtr = NULL; + } else if ((dlPtr->index.linePtr == indexPtr->linePtr) + && (dlPtr->index.charIndex <= indexPtr->charIndex)) { + return; + } + } + + /* + * The desired line isn't already on-screen. + */ + + bottomY = (dInfoPtr->y + dInfoPtr->maxY)/2; + close = (dInfoPtr->maxY - dInfoPtr->y)/3; + if (dlPtr != NULL) { + /* + * The desired line is above the top of screen. If it is + * "close" to the top of the window then make it the top + * line on the screen. + */ + + MeasureUp(textPtr, &textPtr->topIndex, close, &tmpIndex); + if (CkTextIndexCmp(&tmpIndex, indexPtr) <= 0) { + MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex); + goto scheduleUpdate; + } + } else { + /* + * The desired line is below the bottom of the screen. If it is + * "close" to the bottom of the screen then position it at the + * bottom of the screen. + */ + + MeasureUp(textPtr, indexPtr, close, &tmpIndex); + if (FindDLine(dInfoPtr->dLinePtr, &tmpIndex) != NULL) { + bottomY = dInfoPtr->maxY - dInfoPtr->y; + } + } + + /* + * Our job now is to arrange the display so that indexPtr appears + * as low on the screen as possible but with its bottom no lower + * than bottomY. BottomY is the bottom of the window if the + * desired line is just below the current screen, otherwise it + * is the center of the window. + */ + + MeasureUp(textPtr, indexPtr, bottomY, &textPtr->topIndex); + + scheduleUpdate: + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } + dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; +} + +/* + *-------------------------------------------------------------- + * + * MeasureUp -- + * + * Given one index, find the index of the first character + * on the highest display line that would be displayed no more + * than "distance" pixels above the given index. + * + * Results: + * *dstPtr is filled in with the index of the first character + * on a display line. The display line is found by measuring + * up "distance" pixels above the pixel just below an imaginary + * display line that contains srcPtr. If the display line + * that covers this coordinate actually extends above the + * coordinate, then return the index of the next lower line + * instead (i.e. the returned index will be completely visible + * at or below the given y-coordinate). + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +MeasureUp(textPtr, srcPtr, distance, dstPtr) + CkText *textPtr; /* Text widget in which to measure. */ + CkTextIndex *srcPtr; /* Index of character from which to start + * measuring. */ + int distance; /* Vertical distance in pixels measured + * from the pixel just below the lowest + * one in srcPtr's line. */ + CkTextIndex *dstPtr; /* Index to fill in with result. */ +{ + int lineNum; /* Number of current line. */ + int charsToCount; /* Maximum number of characters to measure + * in current line. */ + CkTextIndex bestIndex; /* Best candidate seen so far for result. */ + CkTextIndex index; + DLine *dlPtr, *lowestPtr; + int noBestYet; /* 1 means bestIndex hasn't been set. */ + + noBestYet = 1; + charsToCount = srcPtr->charIndex + 1; + index.tree = srcPtr->tree; + for (lineNum = CkBTreeLineIndex(srcPtr->linePtr); lineNum >= 0; + lineNum--) { + /* + * Layout an entire text line (potentially > 1 display line). + * For the first line, which contains srcPtr, only layout the + * part up through srcPtr (charsToCount is non-infinite to + * accomplish this). Make a list of all the display lines + * in backwards order (the lowest DLine on the screen is first + * in the list). + */ + + index.linePtr = CkBTreeFindLine(srcPtr->tree, lineNum); + index.charIndex = 0; + lowestPtr = NULL; + do { + dlPtr = LayoutDLine(textPtr, &index); + dlPtr->nextPtr = lowestPtr; + lowestPtr = dlPtr; +#if CK_USE_UTF + CkTextIndexForwBytes(&index, dlPtr->count, &index); +#else + CkTextIndexForwChars(&index, dlPtr->count, &index); +#endif + charsToCount -= dlPtr->count; + } while ((charsToCount > 0) && (index.linePtr == dlPtr->index.linePtr)); + + /* + * Scan through the display lines to see if we've covered enough + * vertical distance. If so, save the starting index for the + * line at the desired location. + */ + + for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) { + distance -= dlPtr->height; + if (distance < 0) { + *dstPtr = (noBestYet) ? dlPtr->index : bestIndex; + break; + } + bestIndex = dlPtr->index; + noBestYet = 0; + } + + /* + * Discard the display lines, then either return or prepare + * for the next display line to lay out. + */ + + FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0); + if (distance < 0) { + return; + } + charsToCount = INT_MAX; /* Consider all chars. in next line. */ + } + + /* + * Ran off the beginning of the text. Return the first character + * in the text. + */ +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, 0, 0, dstPtr); +#else + CkTextMakeIndex(textPtr->tree, 0, 0, dstPtr); +#endif +} + +/* + *-------------------------------------------------------------- + * + * CkTextSeeCmd -- + * + * This procedure is invoked to process the "see" option for + * the widget command for text widgets. See the user documentation + * for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +CkTextSeeCmd(textPtr, interp, argc, argv) + CkText *textPtr; /* Information about text widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. Someone else has already + * parsed this command enough to know that + * argv[1] is "see". */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + CkTextIndex index; + int x, y, width, height, lineWidth, charCount, oneThird, delta; + DLine *dlPtr; + CkTextDispChunk *chunkPtr; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " see index\"", (char *) NULL); + return TCL_ERROR; + } + if (CkTextGetIndex(interp, textPtr, argv[2], &index) != TCL_OK) { + return TCL_ERROR; + } + + /* + * If the specified position is the extra line at the end of the + * text, round it back to the last real line. + */ + + if (CkBTreeLineIndex(index.linePtr) == CkBTreeNumLines(index.tree)) { + CkTextIndexBackChars(&index, 1, &index); + } + + /* + * First get the desired position into the vertical range of the window. + */ + + CkTextSetYView(textPtr, &index, 1); + + /* + * Now make sure that the character is in view horizontally. + */ + + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } + lineWidth = dInfoPtr->maxX - dInfoPtr->x; + if (dInfoPtr->maxLength < lineWidth) { + return TCL_OK; + } + + /* + * Find the chunk that contains the desired index. + */ + + dlPtr = FindDLine(dInfoPtr->dLinePtr, &index); + charCount = index.charIndex - dlPtr->index.charIndex; + for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) { + if (charCount < chunkPtr->numChars) { + break; + } + charCount -= chunkPtr->numChars; + } + + /* + * Call a chunk-specific procedure to find the horizontal range of + * the character within the chunk. + */ + + (*chunkPtr->bboxProc)(chunkPtr, charCount, dlPtr->y, + dlPtr->height, 0, &x, &y, &width, &height); + delta = x - dInfoPtr->curOffset; + oneThird = lineWidth/3; + if (delta < 0) { + if (delta < -oneThird) { + dInfoPtr->newCharOffset = (x - lineWidth/2); + } else { + dInfoPtr->newCharOffset -= -delta; + } + } else { + delta -= (lineWidth - width); + if (delta >= 0) { + if (delta > oneThird) { + dInfoPtr->newCharOffset = (x - lineWidth/2); + } else { + dInfoPtr->newCharOffset += delta + 1; + } + } else { + return TCL_OK; + } + } + dInfoPtr->flags |= DINFO_OUT_OF_DATE; + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + dInfoPtr->flags |= REDRAW_PENDING; + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * CkTextXviewCmd -- + * + * This procedure is invoked to process the "xview" option for + * the widget command for text widgets. See the user documentation + * for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +CkTextXviewCmd(textPtr, interp, argc, argv) + CkText *textPtr; /* Information about text widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. Someone else has already + * parsed this command enough to know that + * argv[1] is "xview". */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + int type, charsPerPage, count, newOffset; + double fraction; + + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } + + if (argc == 2) { + GetXView(interp, textPtr, 0); + return TCL_OK; + } + + newOffset = dInfoPtr->newCharOffset; + type = Ck_GetScrollInfo(interp, argc, argv, &fraction, &count); + switch (type) { + case CK_SCROLL_ERROR: + return TCL_ERROR; + case CK_SCROLL_MOVETO: + newOffset = (int) (fraction * dInfoPtr->maxLength); + break; + case CK_SCROLL_PAGES: + charsPerPage = dInfoPtr->maxX - dInfoPtr->x - 2; + if (charsPerPage < 1) { + charsPerPage = 1; + } + newOffset += charsPerPage*count; + break; + case CK_SCROLL_UNITS: + newOffset += count; + break; + } + + dInfoPtr->newCharOffset = newOffset; + dInfoPtr->flags |= DINFO_OUT_OF_DATE; + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + dInfoPtr->flags |= REDRAW_PENDING; + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ScrollByLines -- + * + * This procedure is called to scroll a text widget up or down + * by a given number of lines. + * + * Results: + * None. + * + * Side effects: + * The view in textPtr's window changes to reflect the value + * of "offset". + * + *---------------------------------------------------------------------- + */ + +static void +ScrollByLines(textPtr, offset) + CkText *textPtr; /* Widget to scroll. */ + int offset; /* Amount by which to scroll, in *screen* + * lines. Positive means that information + * later in text becomes visible, negative + * means that information earlier in the + * text becomes visible. */ +{ + int i, charsToCount, lineNum; + CkTextIndex new, index; + CkTextLine *lastLinePtr; + DInfo *dInfoPtr = textPtr->dInfoPtr; + DLine *dlPtr, *lowestPtr; + + if (offset < 0) { + /* + * Must scroll up (to show earlier information in the text). + * The code below is similar to that in MeasureUp, except that + * it counts lines instead of pixels. + */ + + charsToCount = textPtr->topIndex.charIndex + 1; + index.tree = textPtr->tree; + offset--; /* Skip line containing topIndex. */ + for (lineNum = CkBTreeLineIndex(textPtr->topIndex.linePtr); + lineNum >= 0; lineNum--) { + index.linePtr = CkBTreeFindLine(textPtr->tree, lineNum); + index.charIndex = 0; + lowestPtr = NULL; + do { + dlPtr = LayoutDLine(textPtr, &index); + dlPtr->nextPtr = lowestPtr; + lowestPtr = dlPtr; +#if CK_USE_UTF + CkTextIndexForwBytes(&index, dlPtr->count, &index); +#else + CkTextIndexForwChars(&index, dlPtr->count, &index); +#endif + charsToCount -= dlPtr->count; + } while ((charsToCount > 0) + && (index.linePtr == dlPtr->index.linePtr)); + + for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) { + offset++; + if (offset == 0) { + textPtr->topIndex = dlPtr->index; + break; + } + } + + /* + * Discard the display lines, then either return or prepare + * for the next display line to lay out. + */ + + FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0); + if (offset >= 0) { + goto scheduleUpdate; + } + charsToCount = INT_MAX; + } + + /* + * Ran off the beginning of the text. Return the first character + * in the text. + */ +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->topIndex); +#else + CkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->topIndex); +#endif + } else { + /* + * Scrolling down, to show later information in the text. + * Just count lines from the current top of the window. + */ + + lastLinePtr = CkBTreeFindLine(textPtr->tree, + CkBTreeNumLines(textPtr->tree)); + for (i = 0; i < offset; i++) { + dlPtr = LayoutDLine(textPtr, &textPtr->topIndex); + dlPtr->nextPtr = NULL; +#if CK_USE_UTF + if (dlPtr->length == 0 && dlPtr->height == 0) { + offset++; + } + CkTextIndexForwBytes(&textPtr->topIndex, dlPtr->count, &new); +#else + CkTextIndexForwChars(&textPtr->topIndex, dlPtr->count, &new); +#endif + FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0); + if (new.linePtr == lastLinePtr) { + break; + } + textPtr->topIndex = new; + } + } + + scheduleUpdate: + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } + dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; +} + +/* + *-------------------------------------------------------------- + * + * CkTextYviewCmd -- + * + * This procedure is invoked to process the "yview" option for + * the widget command for text widgets. See the user documentation + * for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +CkTextYviewCmd(textPtr, interp, argc, argv) + CkText *textPtr; /* Information about text widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. Someone else has already + * parsed this command enough to know that + * argv[1] is "yview". */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + int pickPlace, lineNum, type, lineHeight; + int pixels, count; + size_t switchLength; + double fraction; + CkTextIndex index, new; + CkTextLine *lastLinePtr; + DLine *dlPtr; +#if CK_USE_UTF + int bytesInLine; +#endif + + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } + + if (argc == 2) { + GetYView(interp, textPtr, 0); + return TCL_OK; + } + + /* + * Next, handle the old syntax: "pathName yview ?-pickplace? where" + */ + + pickPlace = 0; + if (argv[2][0] == '-') { + switchLength = strlen(argv[2]); + if ((switchLength >= 2) + && (strncmp(argv[2], "-pickplace", switchLength) == 0)) { + pickPlace = 1; + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " yview -pickplace lineNum|index\"", + (char *) NULL); + return TCL_ERROR; + } + } + } + if ((argc == 3) || pickPlace) { + if (Tcl_GetInt(interp, argv[2+pickPlace], &lineNum) == TCL_OK) { +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index); +#else + CkTextMakeIndex(textPtr->tree, lineNum, 0, &index); +#endif + CkTextSetYView(textPtr, &index, 0); + return TCL_OK; + } + + /* + * The argument must be a regular text index. + */ + + Tcl_ResetResult(interp); + if (CkTextGetIndex(interp, textPtr, argv[2+pickPlace], + &index) != TCL_OK) { + return TCL_ERROR; + } + CkTextSetYView(textPtr, &index, pickPlace); + return TCL_OK; + } + + /* + * New syntax: dispatch based on argv[2]. + */ + + type = Ck_GetScrollInfo(interp, argc, argv, &fraction, &count); + switch (type) { + case CK_SCROLL_ERROR: + return TCL_ERROR; + case CK_SCROLL_MOVETO: +#if CK_USE_UTF + if (fraction > 1.0) { + fraction = 1.0; + } + if (fraction < 0) { + fraction = 0; + } + fraction *= CkBTreeNumLines(textPtr->tree); + lineNum = (int) fraction; + CkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index); + bytesInLine = CkBTreeCharsInLine(index.linePtr); + index.charIndex = (int)((bytesInLine * (fraction-lineNum)) + 0.5); + if (index.charIndex >= bytesInLine) { + CkTextMakeByteIndex(textPtr->tree, lineNum + 1, 0, &index); + } +#else + fraction *= CkBTreeNumLines(textPtr->tree); + lineNum = (int) fraction; + CkTextMakeIndex(textPtr->tree, lineNum+1, 0, &index); + CkTextIndexBackChars(&index, 1, &index); + index.charIndex = (int) ((index.charIndex+1)*(fraction-lineNum)); +#endif + CkTextSetYView(textPtr, &index, 0); + break; + case CK_SCROLL_PAGES: + /* + * Scroll up or down by screenfulls. Actually, use the + * window height minus two lines, so that there's some + * overlap between adjacent pages. + */ + + lineHeight = 1; + if (count < 0) { + pixels = (dInfoPtr->maxY - 2*lineHeight - dInfoPtr->y)*(-count) + + lineHeight; + MeasureUp(textPtr, &textPtr->topIndex, pixels, &new); + if (CkTextIndexCmp(&textPtr->topIndex, &new) == 0) { + /* + * A page of scrolling ended up being less than one line. + * Scroll one line anyway. + */ + + count = -1; + goto scrollByLines; + } + textPtr->topIndex = new; + } else { + /* + * Scrolling down by pages. Layout lines starting at the + * top index and count through the desired vertical distance. + */ + + pixels = (dInfoPtr->maxY - 2*lineHeight - dInfoPtr->y)*count; + lastLinePtr = CkBTreeFindLine(textPtr->tree, + CkBTreeNumLines(textPtr->tree)); + do { + dlPtr = LayoutDLine(textPtr, &textPtr->topIndex); + dlPtr->nextPtr = NULL; +#if CK_USE_UTF + CkTextIndexForwBytes(&textPtr->topIndex, dlPtr->count, + &new); +#else + CkTextIndexForwChars(&textPtr->topIndex, dlPtr->count, + &new); +#endif + pixels -= dlPtr->height; + FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0); + if (new.linePtr == lastLinePtr) { + break; + } + textPtr->topIndex = new; + } while (pixels > 0); + } + if (!(dInfoPtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayText, (ClientData) textPtr); + } + dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; + break; + case CK_SCROLL_UNITS: + scrollByLines: + ScrollByLines(textPtr, count); + break; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * GetXView -- + * + * This procedure computes the fractions that indicate what's + * visible in a text window and, optionally, evaluates a + * Tcl script to report them to the text's associated scrollbar. + * + * Results: + * If report is zero, then interp->result is filled in with + * two real numbers separated by a space, giving the position of + * the left and right edges of the window as fractions from 0 to + * 1, where 0 means the left edge of the text and 1 means the right + * edge. If report is non-zero, then interp->result isn't modified + * directly, but instead a script is evaluated in interp to report + * the new horizontal scroll position to the scrollbar (if the scroll + * position hasn't changed then no script is invoked). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +GetXView(interp, textPtr, report) + Tcl_Interp *interp; /* If "report" is FALSE, string + * describing visible range gets + * stored in interp->result. */ + CkText *textPtr; /* Information about text widget. */ + int report; /* Non-zero means report info to + * scrollbar if it has changed. */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + char buffer[200]; + double first, last; + int code; + + if (dInfoPtr->maxLength > 0) { + first = ((double) dInfoPtr->curOffset) + / dInfoPtr->maxLength; + last = first + ((double) (dInfoPtr->maxX - dInfoPtr->x)) + / dInfoPtr->maxLength; + if (last > 1.0) { + last = 1.0; + } + } else { + first = 0; + last = 1.0; + } + if (!report) { + sprintf(interp->result, "%g %g", first, last); + return; + } + if ((first == dInfoPtr->xScrollFirst) && (last == dInfoPtr->xScrollLast)) { + return; + } + dInfoPtr->xScrollFirst = first; + dInfoPtr->xScrollLast = last; + sprintf(buffer, " %g %g", first, last); + code = Tcl_VarEval(interp, textPtr->xScrollCmd, + buffer, (char *) NULL); + if (code != TCL_OK) { + Tcl_AddErrorInfo(interp, + "\n (horizontal scrolling command executed by text)"); + Tk_BackgroundError(interp); + } +} + +/* + *---------------------------------------------------------------------- + * + * GetYView -- + * + * This procedure computes the fractions that indicate what's + * visible in a text window and, optionally, evaluates a + * Tcl script to report them to the text's associated scrollbar. + * + * Results: + * If report is zero, then interp->result is filled in with + * two real numbers separated by a space, giving the position of + * the top and bottom of the window as fractions from 0 to 1, where + * 0 means the beginning of the text and 1 means the end. If + * report is non-zero, then interp->result isn't modified directly, + * but a script is evaluated in interp to report the new scroll + * position to the scrollbar (if the scroll position hasn't changed + * then no script is invoked). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +GetYView(interp, textPtr, report) + Tcl_Interp *interp; /* If "report" is FALSE, string + * describing visible range gets + * stored in interp->result. */ + CkText *textPtr; /* Information about text widget. */ + int report; /* Non-zero means report info to + * scrollbar if it has changed. */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + char buffer[200]; + double first, last; + DLine *dlPtr; + int totalLines, code, count; + + dlPtr = dInfoPtr->dLinePtr; + totalLines = CkBTreeNumLines(textPtr->tree); + first = ((double) CkBTreeLineIndex(dlPtr->index.linePtr)) + + ((double) dlPtr->index.charIndex) + / (CkBTreeCharsInLine(dlPtr->index.linePtr)); + first /= totalLines; + while (1) { + if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) { + /* + * The last line is only partially visible, so don't + * count its characters in what's visible. + */ + count = 0; + break; + } + if (dlPtr->nextPtr == NULL) { + count = dlPtr->count; + break; + } + dlPtr = dlPtr->nextPtr; + } + last = ((double) CkBTreeLineIndex(dlPtr->index.linePtr)) + + ((double) (dlPtr->index.charIndex + count)) + / (CkBTreeCharsInLine(dlPtr->index.linePtr)); + last /= totalLines; + if (!report) { + sprintf(interp->result, "%g %g", first, last); + return; + } + if ((first == dInfoPtr->yScrollFirst) && (last == dInfoPtr->yScrollLast)) { + return; + } + dInfoPtr->yScrollFirst = first; + dInfoPtr->yScrollLast = last; + sprintf(buffer, " %g %g", first, last); + code = Tcl_VarEval(interp, textPtr->yScrollCmd, + buffer, (char *) NULL); + if (code != TCL_OK) { + Tcl_AddErrorInfo(interp, + "\n (vertical scrolling command executed by text)"); + Tk_BackgroundError(interp); + } +} + +/* + *---------------------------------------------------------------------- + * + * FindDLine -- + * + * This procedure is called to find the DLine corresponding to a + * given text index. + * + * Results: + * The return value is a pointer to the first DLine found in the + * list headed by dlPtr that displays information at or after the + * specified position. If there is no such line in the list then + * NULL is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static DLine * +FindDLine(dlPtr, indexPtr) + register DLine *dlPtr; /* Pointer to first in list of DLines + * to search. */ + CkTextIndex *indexPtr; /* Index of desired character. */ +{ + CkTextLine *linePtr; + + if (dlPtr == NULL) { + return NULL; + } + if (CkBTreeLineIndex(indexPtr->linePtr) + < CkBTreeLineIndex(dlPtr->index.linePtr)) { + /* + * The first display line is already past the desired line. + */ + return dlPtr; + } + + /* + * Find the first display line that covers the desired text line. + */ + + linePtr = dlPtr->index.linePtr; + while (linePtr != indexPtr->linePtr) { + while (dlPtr->index.linePtr == linePtr) { + dlPtr = dlPtr->nextPtr; + if (dlPtr == NULL) { + return NULL; + } + } + linePtr = CkBTreeNextLine(linePtr); + if (linePtr == NULL) { + panic("FindDLine reached end of text"); + } + } + if (indexPtr->linePtr != dlPtr->index.linePtr) { + return dlPtr; + } + + /* + * Now get to the right position within the text line. + */ + + while (indexPtr->charIndex >= (dlPtr->index.charIndex + dlPtr->count)) { + dlPtr = dlPtr->nextPtr; + if ((dlPtr == NULL) || (dlPtr->index.linePtr != indexPtr->linePtr)) { + break; + } + } + return dlPtr; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextPixelIndex -- + * + * Given an (x,y) coordinate on the screen, find the location of + * the character closest to that location. + * + * Results: + * The index at *indexPtr is modified to refer to the character + * on the display that is closest to (x,y). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +CkTextPixelIndex(textPtr, x, y, indexPtr) + CkText *textPtr; /* Widget record for text widget. */ + int x, y; /* Pixel coordinates of point in widget's + * window. */ + CkTextIndex *indexPtr; /* This index gets filled in with the + * index of the character nearest to (x,y). */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + register DLine *dlPtr; + register CkTextDispChunk *chunkPtr; + + /* + * Make sure that all of the layout information about what's + * displayed where on the screen is up-to-date. + */ + + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } + + /* + * If the coordinates are above the top of the window, then adjust + * them to refer to the upper-right corner of the window. If they're + * off to one side or the other, then adjust to the closest side. + */ + + if (y < dInfoPtr->y) { + y = dInfoPtr->y; + x = dInfoPtr->x; + } + if (x >= dInfoPtr->maxX) { + x = dInfoPtr->maxX - 1; + } + if (x < dInfoPtr->x) { + x = dInfoPtr->x; + } + + /* + * Find the display line containing the desired y-coordinate. + */ + + for (dlPtr = dInfoPtr->dLinePtr; y >= (dlPtr->y + dlPtr->height); + dlPtr = dlPtr->nextPtr) { + if (dlPtr->nextPtr == NULL) { + /* + * Y-coordinate is off the bottom of the displayed text. + * Use the last character on the last line. + */ + + x = dInfoPtr->maxX - 1; + break; + } + } + + /* + * Scan through the line's chunks to find the one that contains + * the desired x-coordinate. Before doing this, translate the + * x-coordinate from the coordinate system of the window to the + * coordinate system of the line (to take account of x-scrolling). + */ + + *indexPtr = dlPtr->index; + x = x - dInfoPtr->x + dInfoPtr->curOffset; + for (chunkPtr = dlPtr->chunkPtr; x >= (chunkPtr->x + chunkPtr->width); + indexPtr->charIndex += chunkPtr->numChars, + chunkPtr = chunkPtr->nextPtr) { + if (chunkPtr->nextPtr == NULL) { +#if CK_USE_UTF + indexPtr->charIndex += chunkPtr->numChars; + CkTextIndexBackChars(indexPtr, 1, indexPtr); +#else + indexPtr->charIndex += chunkPtr->numChars - 1; +#endif + return; + } + } + + /* + * If the chunk has more than one character in it, ask it which + * character is at the desired location. + */ + + if (chunkPtr->numChars > 1) { + indexPtr->charIndex += (*chunkPtr->measureProc)(chunkPtr, x); + } +} + +/* + *---------------------------------------------------------------------- + * + * CkTextCharBbox -- + * + * Given an index, find the bounding box of the screen area + * occupied by that character. + * + * Results: + * Zero is returned if the character is on the screen. -1 + * means the character isn't on the screen. If the return value + * is 0, then the bounding box of the part of the character that's + * visible on the screen is returned to *xPtr, *yPtr, *widthPtr, + * and *heightPtr. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr) + CkText *textPtr; /* Widget record for text widget. */ + CkTextIndex *indexPtr; /* Index of character whose bounding + * box is desired. */ + int *xPtr, *yPtr; /* Filled with character's upper-left + * coordinate. */ + int *widthPtr, *heightPtr; /* Filled in with character's dimensions. */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + DLine *dlPtr; + register CkTextDispChunk *chunkPtr; + int index; + + /* + * Make sure that all of the screen layout information is up to date. + */ + + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } + + /* + * Find the display line containing the desired index. + */ + + dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr); + if ((dlPtr == NULL) || (CkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) { + return -1; + } + + /* + * Find the chunk within the line that contains the desired + * index. + */ + + index = indexPtr->charIndex - dlPtr->index.charIndex; + for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) { + if (chunkPtr == NULL) { + return -1; + } + if (index < chunkPtr->numChars) { + break; + } + index -= chunkPtr->numChars; + } + + /* + * Call a chunk-specific procedure to find the horizontal range of + * the character within the chunk, then fill in the vertical range. + * The x-coordinate returned by bboxProc is a coordinate within a + * line, not a coordinate on the screen. Translate it to reflect + * horizontal scrolling. + */ + + (*chunkPtr->bboxProc)(chunkPtr, index, dlPtr->y, + dlPtr->height, 0, xPtr, yPtr, widthPtr, + heightPtr); + *xPtr = *xPtr + dInfoPtr->x - dInfoPtr->curOffset; + if ((index == (chunkPtr->numChars-1)) && (chunkPtr->nextPtr == NULL)) { + /* + * Last character in display line. Give it all the space up to + * the line. + */ + + if (*xPtr > dInfoPtr->maxX) { + *xPtr = dInfoPtr->maxX; + } + *widthPtr = dInfoPtr->maxX - *xPtr; + } + if ((*xPtr + *widthPtr) <= dInfoPtr->x) { + return -1; + } + if ((*xPtr + *widthPtr) > dInfoPtr->maxX) { + *widthPtr = dInfoPtr->maxX - *xPtr; + if (*widthPtr <= 0) { + return -1; + } + } + if ((*yPtr + *heightPtr) > dInfoPtr->maxY) { + *heightPtr = dInfoPtr->maxY - *yPtr; + if (*heightPtr <= 0) { + return -1; + } + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextDLineInfo -- + * + * Given an index, return information about the display line + * containing that character. + * + * Results: + * Zero is returned if the character is on the screen. -1 + * means the character isn't on the screen. If the return value + * is 0, then information is returned in the variables pointed + * to by xPtr, yPtr, widthPtr, heightPtr, and basePtr. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr) + CkText *textPtr; /* Widget record for text widget. */ + CkTextIndex *indexPtr; /* Index of character whose bounding + * box is desired. */ + int *xPtr, *yPtr; /* Filled with line's upper-left + * coordinate. */ + int *widthPtr, *heightPtr; /* Filled in with line's dimensions. */ + int *basePtr; /* Filled in with the baseline position, + * measured as an offset down from *yPtr. */ +{ + DInfo *dInfoPtr = textPtr->dInfoPtr; + DLine *dlPtr; + + /* + * Make sure that all of the screen layout information is up to date. + */ + + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } + + /* + * Find the display line containing the desired index. + */ + + dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr); + if ((dlPtr == NULL) || (CkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) { + return -1; + } + + *xPtr = dInfoPtr->x - dInfoPtr->curOffset + dlPtr->chunkPtr->x; + *widthPtr = dlPtr->length - dlPtr->chunkPtr->x; + *yPtr = dlPtr->y; + if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) { + *heightPtr = dInfoPtr->maxY - dlPtr->y; + } else { + *heightPtr = dlPtr->height; + } + *basePtr = 0; + return 0; +} + +/* + *-------------------------------------------------------------- + * + * CkTextCharLayoutProc -- + * + * This procedure is the "layoutProc" for character segments. + * + * Results: + * If there is something to display for the chunk then a + * non-zero value is returned and the fields of chunkPtr + * will be filled in (see the declaration of CkTextDispChunk + * in ckText.h for details). If zero is returned it means + * that no characters from this chunk fit in the window. + * If -1 is returned it means that this segment just doesn't + * need to be displayed (never happens for text). + * + * Side effects: + * Memory is allocated to hold additional information about + * the chunk. + * + *-------------------------------------------------------------- + */ + +int +CkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars, + noCharsYet, wrapMode, chunkPtr) + CkText *textPtr; /* Text widget being layed out. */ + CkTextIndex *indexPtr; /* Index of first character to lay out + * (corresponds to segPtr and offset). */ + CkTextSegment *segPtr; /* Segment being layed out. */ + int offset; /* Offset within segment of first character + * to consider. */ + int maxX; /* Chunk must not occupy pixels at this + * position or higher. */ + int maxChars; /* Chunk must not include more than this + * many characters. */ + int noCharsYet; /* Non-zero means no characters have been + * assigned to this display line yet. */ + Ck_Uid wrapMode; /* How to handle line wrapping: ckTextCharUid, + * ckTextNoneUid, or ckTextWordUid. */ + register CkTextDispChunk *chunkPtr; + /* Structure to fill in with information + * about this chunk. The x field has already + * been set by the caller. */ +{ + int nextX, charsThatFit, count, dummy; + CharInfo *ciPtr; + char *p; + CkTextSegment *nextPtr; + CkWindow *winPtr = textPtr->winPtr; + + /* + * Figure out how many characters will fit in the space we've got. + * Include the next character, even though it won't fit completely, + * if any of the following is true: + * (a) the chunk contains no characters and the display line contains + * no characters yet (i.e. the line isn't wide enough to hold + * even a single character). + * (b) at least one pixel of the character is visible, we haven't + * already exceeded the character limit, and the next character + * is a white space character. + */ + + p = segPtr->body.chars + offset; + CkMeasureChars(winPtr->mainPtr, p, maxChars, chunkPtr->x, + maxX, 0, CK_IGNORE_TABS, &nextX, &charsThatFit); + if (charsThatFit < maxChars) { + if ((charsThatFit == 0) && noCharsYet) { + charsThatFit = 1; + CkMeasureChars(winPtr->mainPtr, p, 1, chunkPtr->x, INT_MAX, 0, + CK_IGNORE_TABS, &nextX, &dummy); + } + if (p[charsThatFit] == '\n') { + /* + * A newline character takes up no space, so if the previous + * character fits then so does the newline. + */ + + charsThatFit++; + } + if (charsThatFit == 0) { + return 0; + } + } + + /* + * Fill in the chunk structure and allocate and initialize a + * CharInfo structure. If the last character is a newline + * then don't bother to display it. + */ + + chunkPtr->displayProc = CharDisplayProc; + chunkPtr->undisplayProc = CharUndisplayProc; + chunkPtr->measureProc = CharMeasureProc; + chunkPtr->bboxProc = CharBboxProc; + chunkPtr->numChars = charsThatFit; + chunkPtr->minHeight = 1; + chunkPtr->width = nextX - chunkPtr->x; + chunkPtr->breakIndex = -1; + ciPtr = (CharInfo *) ckalloc((unsigned) + (sizeof(CharInfo) - 3 + charsThatFit)); + chunkPtr->clientData = (ClientData) ciPtr; + ciPtr->numChars = charsThatFit; + ciPtr->winPtr = textPtr->winPtr; + strncpy(ciPtr->chars, p, (size_t) charsThatFit); + if (p[charsThatFit-1] == '\n') { + ciPtr->numChars--; + } + + /* + * Compute a break location. If we're in word wrap mode, a + * break can occur after any space character, or at the end of + * the chunk if the next segment (ignoring those with zero size) + * is not a character segment. + */ + + if (wrapMode != ckTextWordUid) { + chunkPtr->breakIndex = chunkPtr->numChars; + } else { + for (count = charsThatFit, p += charsThatFit-1; count > 0; + count--, p--) { + if (isspace((unsigned char) *p)) { + chunkPtr->breakIndex = count; + break; + } + } + if ((charsThatFit+offset) == segPtr->size) { + for (nextPtr = segPtr->nextPtr; nextPtr != NULL; + nextPtr = nextPtr->nextPtr) { + if (nextPtr->size != 0) { + if (nextPtr->typePtr != &ckTextCharType) { + chunkPtr->breakIndex = chunkPtr->numChars; + } + break; + } + } + } + } + return 1; +} + +/* + *-------------------------------------------------------------- + * + * CharDisplayProc -- + * + * This procedure is called to display a character chunk on + * the screen or in an off-screen pixmap. + * + * Results: + * None. + * + * Side effects: + * Graphics are drawn. + * + *-------------------------------------------------------------- + */ + +static void +CharDisplayProc(chunkPtr, x, y, height, baseline, window, screenY) + CkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */ + int x; /* X-position in dst at which to + * draw this chunk (may differ from + * the x-position in the chunk because + * of scrolling). */ + int y; /* Y-position at which to draw this + * chunk in dst. */ + int height; /* Total height of line. */ + int baseline; /* Offset of baseline from y. */ + WINDOW *window; + int screenY; /* Y-coordinate in text window that + * corresponds to y. */ +{ + CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; + Style *stylePtr; + StyleValues *sValuePtr; + + if ((x + chunkPtr->width) <= 0) { + /* + * The chunk is off-screen. + */ + + return; + } + + stylePtr = chunkPtr->stylePtr; + sValuePtr = stylePtr->sValuePtr; + + /* + * Draw the text for this chunk. + */ + + if (ciPtr->numChars > 0) { + Ck_SetWindowAttr(ciPtr->winPtr, sValuePtr->fg, sValuePtr->bg, + sValuePtr->attr); + CkDisplayChars(ciPtr->winPtr->mainPtr, window, ciPtr->chars, + ciPtr->numChars, x, + screenY + baseline, x - chunkPtr->x, CK_IGNORE_TABS); + } +} + +/* + *-------------------------------------------------------------- + * + * CharUndisplayProc -- + * + * This procedure is called when a character chunk is no + * longer going to be displayed. It frees up resources + * that were allocated to display the chunk. + * + * Results: + * None. + * + * Side effects: + * Memory and other resources get freed. + * + *-------------------------------------------------------------- + */ + +static void +CharUndisplayProc(textPtr, chunkPtr) + CkText *textPtr; /* Overall information about text + * widget. */ + CkTextDispChunk *chunkPtr; /* Chunk that is about to be freed. */ +{ + CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; + + ckfree((char *) ciPtr); +} + +/* + *-------------------------------------------------------------- + * + * CharMeasureProc -- + * + * This procedure is called to determine which character in + * a character chunk lies over a given x-coordinate. + * + * Results: + * The return value is the index *within the chunk* of the + * character that covers the position given by "x". + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +CharMeasureProc(chunkPtr, x) + CkTextDispChunk *chunkPtr; /* Chunk containing desired coord. */ + int x; /* X-coordinate, in same coordinate + * system as chunkPtr->x. */ +{ + CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; + int endX, charX; + + CkMeasureChars(ciPtr->winPtr->mainPtr, + ciPtr->chars, chunkPtr->numChars-1, chunkPtr->x, + x, 0, CK_IGNORE_TABS, &endX, &charX); + return charX; +} + +/* + *-------------------------------------------------------------- + * + * CharBboxProc -- + * + * This procedure is called to compute the bounding box of + * the area occupied by a single character. + * + * Results: + * There is no return value. *xPtr and *yPtr are filled in + * with the coordinates of the upper left corner of the + * character, and *widthPtr and *heightPtr are filled in with + * the dimensions of the character in pixels. Note: not all + * of the returned bbox is necessarily visible on the screen + * (the rightmost part might be off-screen to the right, + * and the bottommost part might be off-screen to the bottom). + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr, + widthPtr, heightPtr) + CkTextDispChunk *chunkPtr; /* Chunk containing desired char. */ + int index; /* Index of desired character within + * the chunk. */ + int y; /* Topmost pixel in area allocated + * for this line. */ + int lineHeight; /* Height of line, in pixels. */ + int baseline; /* Location of line's baseline, in + * pixels measured down from y. */ + int *xPtr, *yPtr; /* Gets filled in with coords of + * character's upper-left pixel. + * X-coord is in same coordinate + * system as chunkPtr->x. */ + int *widthPtr; /* Gets filled in with width of + * character, in pixels. */ + int *heightPtr; /* Gets filled in with height of + * character, in pixels. */ +{ + CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; + CkWindow *winPtr = ciPtr->winPtr; + int maxX, dummy; + + maxX = chunkPtr->width + chunkPtr->x; + CkMeasureChars(winPtr->mainPtr, + ciPtr->chars, index, chunkPtr->x, 1000000, 0, + CK_IGNORE_TABS, xPtr, &dummy); + if (index == ciPtr->numChars) { + /* + * This situation only happens if the last character in a line + * is a space character, in which case it absorbs all of the + * extra space in the line (see CkTextCharLayoutProc). + */ + + *widthPtr = maxX - *xPtr; + } else if ((ciPtr->chars[index] == '\t') + && (index == (ciPtr->numChars-1))) { + /* + * The desired character is a tab character that terminates a + * chunk; give it all the space left in the chunk. + */ + + *widthPtr = maxX - *xPtr; + } else { + CkMeasureChars(winPtr->mainPtr, + ciPtr->chars + index, 1, *xPtr, 1000000, 0, + CK_IGNORE_TABS, widthPtr, &dummy); + if (*widthPtr > maxX) { + *widthPtr = maxX - *xPtr; + } else { + *widthPtr -= *xPtr; + } + } + *yPtr = y + baseline; + *heightPtr = 1; +} + +/* + *---------------------------------------------------------------------- + * + * AdjustForTab -- + * + * This procedure is called to move a series of chunks right + * in order to align them with a tab stop. + * + * Results: + * None. + * + * Side effects: + * The width of chunkPtr gets adjusted so that it absorbs the + * extra space due to the tab. The x locations in all the chunks + * after chunkPtr are adjusted rightward to align with the tab + * stop given by tabArrayPtr and index. + * + *---------------------------------------------------------------------- + */ + +static void +AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr) + CkText *textPtr; /* Information about the text widget as + * a whole. */ + CkTextTabArray *tabArrayPtr; /* Information about the tab stops + * that apply to this line. May be + * NULL to indicate default tabbing + * (every 8 chars). */ + int index; /* Index of current tab stop. */ + CkTextDispChunk *chunkPtr; /* Chunk whose last character is + * the tab; the following chunks + * contain information to be shifted + * right. */ + +{ + int x, desired, delta, width, decimal, i, gotDigit; + CkTextDispChunk *chunkPtr2, *decimalChunkPtr; + CkTextTab *tabPtr; + CharInfo *ciPtr = NULL; /* Initialization needed only to + * prevent compiler warnings. */ + int tabX, prev, spaceWidth, dummy; + char *p; + CkTextTabAlign alignment; + + if (chunkPtr->nextPtr == NULL) { + /* + * Nothing after the actual tab; just return. + */ + + return; + } + + /* + * If no tab information has been given, do the usual thing: + * round up to the next boundary of 8 average-sized characters. + */ + + x = chunkPtr->nextPtr->x; + if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) { + /* + * No tab information has been given, so use the default + * interpretation of tabs. + */ + + CkMeasureChars(textPtr->winPtr->mainPtr, + "\t", 1, x, INT_MAX, 0, 0, &desired, &dummy); + goto update; + } + + if (index < tabArrayPtr->numTabs) { + alignment = tabArrayPtr->tabs[index].alignment; + tabX = tabArrayPtr->tabs[index].location; + } else { + /* + * Ran out of tab stops; compute a tab position by extrapolating + * from the last two tab positions. + */ + + if (tabArrayPtr->numTabs > 1) { + prev = tabArrayPtr->tabs[tabArrayPtr->numTabs-2].location; + } else { + prev = 0; + } + alignment = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].alignment; + tabX = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location + + (index + 1 - tabArrayPtr->numTabs) + * (tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location - prev); + } + + tabPtr = &tabArrayPtr->tabs[index]; + if (alignment == LEFT) { + desired = tabX; + goto update; + } + + if ((alignment == CENTER) || (alignment == RIGHT)) { + /* + * Compute the width of all the information in the tab group, + * then use it to pick a desired location. + */ + + width = 0; + for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL; + chunkPtr2 = chunkPtr2->nextPtr) { + width += chunkPtr2->width; + } + if (alignment == CENTER) { + desired = tabX - width/2; + } else { + desired = tabX - width; + } + goto update; + } + + /* + * Must be numeric alignment. Search through the text to be + * tabbed, looking for the last , or . before the first character + * that isn't a number, comma, period, or sign. + */ + + decimalChunkPtr = NULL; + decimal = gotDigit = 0; + for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL; + chunkPtr2 = chunkPtr2->nextPtr) { + if (chunkPtr2->displayProc != CharDisplayProc) { + continue; + } + ciPtr = (CharInfo *) chunkPtr2->clientData; + for (p = ciPtr->chars, i = 0; i < ciPtr->numChars; p++, i++) { + if (isdigit((unsigned char) *p)) { + gotDigit = 1; + } else if ((*p == '.') || (*p == ',')) { + decimal = p-ciPtr->chars; + decimalChunkPtr = chunkPtr2; + } else if (gotDigit) { + if (decimalChunkPtr == NULL) { + decimal = p-ciPtr->chars; + decimalChunkPtr = chunkPtr2; + } + goto endOfNumber; + } + } + } + endOfNumber: + if (decimalChunkPtr != NULL) { + int curX; + + ciPtr = (CharInfo *) decimalChunkPtr->clientData; + CkMeasureChars(ciPtr->winPtr->mainPtr, + ciPtr->chars, decimal, decimalChunkPtr->x, 1000000, 0, + CK_IGNORE_TABS, &curX, &dummy); + desired = tabX - (curX - x); + goto update; + } else { + /* + * There wasn't a decimal point. Right justify the text. + */ + + width = 0; + for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL; + chunkPtr2 = chunkPtr2->nextPtr) { + width += chunkPtr2->width; + } + desired = tabX - width; + } + + /* + * Shift all of the chunks to the right so that the left edge is + * at the desired location, then expand the chunk containing the + * tab. Be sure that the tab occupies at least the width of a + * space character. + */ + + update: + delta = desired - x; + CkMeasureChars(textPtr->winPtr->mainPtr, " ", 1, 0, INT_MAX, + 0, 0, &spaceWidth, &dummy); + if (delta < spaceWidth) { + delta = spaceWidth; + } + for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL; + chunkPtr2 = chunkPtr2->nextPtr) { + chunkPtr2->x += delta; + } + chunkPtr->width += delta; +} + +/* + *---------------------------------------------------------------------- + * + * SizeOfTab -- + * + * This returns an estimate of the amount of white space that will + * be consumed by a tab. + * + * Results: + * The return value is the minimum number of pixels that will + * be occupied by the index'th tab of tabArrayPtr, assuming that + * the current position on the line is x and the end of the + * line is maxX. For numeric tabs, this is a conservative + * estimate. The return value is always >= 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +SizeOfTab(textPtr, tabArrayPtr, index, x, maxX) + CkText *textPtr; /* Information about the text widget as + * a whole. */ + CkTextTabArray *tabArrayPtr; /* Information about the tab stops + * that apply to this line. NULL + * means use default tabbing (every + * 8 chars.) */ + int index; /* Index of current tab stop. */ + int x; /* Current x-location in line. Only + * used if tabArrayPtr == NULL. */ + int maxX; /* X-location of pixel just past the + * right edge of the line. */ +{ + int tabX, prev, result, spaceWidth, dummy; + CkTextTabAlign alignment; + CkWindow *winPtr = textPtr->winPtr; + + if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) { + CkMeasureChars(winPtr->mainPtr, "\t", 1, x, INT_MAX, + 0, 0, &tabX, &dummy); + return tabX - x; + } + if (index < tabArrayPtr->numTabs) { + tabX = tabArrayPtr->tabs[index].location; + alignment = tabArrayPtr->tabs[index].alignment; + } else { + /* + * Ran out of tab stops; compute a tab position by extrapolating + * from the last two tab positions. + */ + + if (tabArrayPtr->numTabs > 1) { + prev = tabArrayPtr->tabs[tabArrayPtr->numTabs-2].location; + } else { + prev = 0; + } + tabX = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location + + (index + 1 - tabArrayPtr->numTabs) + * (tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location - prev); + alignment = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].alignment; + } + if (alignment == CENTER) { + /* + * Be very careful in the arithmetic below, because maxX may + * be the largest positive number: watch out for integer + * overflow. + */ + + if ((maxX-tabX) < (tabX - x)) { + result = (maxX - x) - 2*(maxX - tabX); + } else { + result = 0; + } + goto done; + } + if (alignment == RIGHT) { + result = 0; + goto done; + } + + /* + * Note: this treats NUMERIC alignment the same as LEFT + * alignment, which is somewhat conservative. However, it's + * pretty tricky at this point to figure out exactly where + * the damn decimal point will be. + */ + + if (tabX > x) { + result = tabX - x; + } else { + result = 0; + } + + done: + CkMeasureChars(winPtr->mainPtr, " ", 1, 0, INT_MAX, + 0, 0, &spaceWidth, &dummy); + if (result < spaceWidth) { + result = spaceWidth; + } + return result; +} diff --git a/ckTextIndex.c b/ckTextIndex.c new file mode 100644 index 0000000..5428294 --- /dev/null +++ b/ckTextIndex.c @@ -0,0 +1,1269 @@ +/* + * ckTextIndex.c -- + * + * This module provides procedures that manipulate indices for + * text widgets. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1995-2000 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "ckText.h" + +/* + * Index to use to select last character in line (very large integer): + */ + +#define LAST_CHAR 1000000 + +/* + * Forward declarations for procedures defined later in this file: + */ + +static char * ForwBack _ANSI_ARGS_((char *string, + CkTextIndex *indexPtr)); +static char * StartEnd _ANSI_ARGS_(( char *string, + CkTextIndex *indexPtr)); + +#if CK_USE_UTF +/* + *--------------------------------------------------------------------------- + * + * CkTextMakeByteIndex -- + * + * Given a line index and a byte index, look things up in the B-tree + * and fill in a CkTextIndex structure. + * + * Results: + * The structure at *indexPtr is filled in with information about the + * character at lineIndex and byteIndex (or the closest existing + * character, if the specified one doesn't exist), and indexPtr is + * returned as result. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +CkTextIndex * +CkTextMakeByteIndex(tree, lineIndex, byteIndex, indexPtr) + CkTextBTree tree; /* Tree that lineIndex and charIndex refer + * to. */ + int lineIndex; /* Index of desired line (0 means first + * line of text). */ + int byteIndex; /* Byte index of desired character. */ + CkTextIndex *indexPtr; /* Structure to fill in. */ +{ + CkTextSegment *segPtr; + int index; + char *p, *start; + Tcl_UniChar ch; + + indexPtr->tree = tree; + if (lineIndex < 0) { + lineIndex = 0; + byteIndex = 0; + } + if (byteIndex < 0) { + byteIndex = 0; + } + indexPtr->linePtr = CkBTreeFindLine(tree, lineIndex); + if (indexPtr->linePtr == NULL) { + indexPtr->linePtr = CkBTreeFindLine(tree, CkBTreeNumLines(tree)); + byteIndex = 0; + } + if (byteIndex == 0) { + indexPtr->charIndex = byteIndex; + return indexPtr; + } + + /* + * Verify that the index is within the range of the line and points + * to a valid character boundary. + */ + + index = 0; + for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) { + if (segPtr == NULL) { + /* + * Use the index of the last character in the line. Since + * the last character on the line is guaranteed to be a '\n', + * we can back up a constant sizeof(char) bytes. + */ + + indexPtr->charIndex = index - sizeof(char); + break; + } + if (index + segPtr->size > byteIndex) { + indexPtr->charIndex = byteIndex; + if ((byteIndex > index) && (segPtr->typePtr == &ckTextCharType)) { + /* + * Prevent UTF-8 character from being split up by ensuring + * that byteIndex falls on a character boundary. If index + * falls in the middle of a UTF-8 character, it will be + * adjusted to the end of that UTF-8 character. + */ + + start = segPtr->body.chars + (byteIndex - index); + p = Tcl_UtfPrev(start, segPtr->body.chars); + p += Tcl_UtfToUniChar(p, &ch); + indexPtr->charIndex += p - start; + } + break; + } + index += segPtr->size; + } + return indexPtr; +} +#endif + +/* + *-------------------------------------------------------------- + * + * CkTextMakeIndex -- + * + * Given a line index and a character index, look things up + * in the B-tree and fill in a CkTextIndex structure. + * + * Results: + * The structure at *indexPtr is filled in with information + * about the character at lineIndex and charIndex (or the + * closest existing character, if the specified one doesn't + * exist), and indexPtr is returned as result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +CkTextIndex * +CkTextMakeIndex(tree, lineIndex, charIndex, indexPtr) + CkTextBTree tree; /* Tree that lineIndex and charIndex refer + * to. */ + int lineIndex; /* Index of desired line (0 means first + * line of text). */ + int charIndex; /* Index of desired character. */ + CkTextIndex *indexPtr; /* Structure to fill in. */ +{ + register CkTextSegment *segPtr; + int index; +#if CK_USE_UTF + char *p, *start, *end; + int offset; + Tcl_UniChar ch; +#endif + + indexPtr->tree = tree; + if (lineIndex < 0) { + lineIndex = 0; + charIndex = 0; + } + if (charIndex < 0) { + charIndex = 0; + } + indexPtr->linePtr = CkBTreeFindLine(tree, lineIndex); + if (indexPtr->linePtr == NULL) { + indexPtr->linePtr = CkBTreeFindLine(tree, CkBTreeNumLines(tree)); + charIndex = 0; + } + + /* + * Verify that the index is within the range of the line. + * If not, just use the index of the last character in the line. + */ + + for (index = 0, segPtr = indexPtr->linePtr->segPtr; ; + segPtr = segPtr->nextPtr) { + if (segPtr == NULL) { + indexPtr->charIndex = index-1; + break; + } +#if CK_USE_UTF + if (segPtr->typePtr == &ckTextCharType) { + /* + * Turn character offset into a byte offset. + */ + + start = segPtr->body.chars; + end = start + segPtr->size; + for (p = start; p < end; p += offset) { + if (charIndex == 0) { + indexPtr->charIndex = index; + return indexPtr; + } + charIndex--; + offset = Tcl_UtfToUniChar(p, &ch); + index += offset; + } + } else { + if (charIndex < segPtr->size) { + indexPtr->charIndex = index; + break; + } + charIndex -= segPtr->size; + index += segPtr->size; + } +#else + index += segPtr->size; + if (index > charIndex) { + indexPtr->charIndex = charIndex; + break; + } +#endif + } + return indexPtr; +} + +/* + *-------------------------------------------------------------- + * + * CkTextIndexToSeg -- + * + * Given an index, this procedure returns the segment and + * offset within segment for the index. + * + * Results: + * The return value is a pointer to the segment referred to + * by indexPtr; this will always be a segment with non-zero + * size. The variable at *offsetPtr is set to hold the + * integer offset within the segment of the character + * given by indexPtr. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +CkTextSegment * +CkTextIndexToSeg(indexPtr, offsetPtr) + CkTextIndex *indexPtr; /* Text index. */ + int *offsetPtr; /* Where to store offset within + * segment, or NULL if offset isn't + * wanted. */ +{ + register CkTextSegment *segPtr; + int offset; + + for (offset = indexPtr->charIndex, segPtr = indexPtr->linePtr->segPtr; + offset >= segPtr->size; + offset -= segPtr->size, segPtr = segPtr->nextPtr) { + /* Empty loop body. */ + } + if (offsetPtr != NULL) { + *offsetPtr = offset; + } + return segPtr; +} + +/* + *-------------------------------------------------------------- + * + * CkTextSegToOffset -- + * + * Given a segment pointer and the line containing it, this + * procedure returns the offset of the segment within its + * line. + * + * Results: + * The return value is the offset (within its line) of the + * first character in segPtr. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +CkTextSegToOffset(segPtr, linePtr) + CkTextSegment *segPtr; /* Segment whose offset is desired. */ + CkTextLine *linePtr; /* Line containing segPtr. */ +{ + CkTextSegment *segPtr2; + int offset; + + offset = 0; + for (segPtr2 = linePtr->segPtr; segPtr2 != segPtr; + segPtr2 = segPtr2->nextPtr) { + offset += segPtr2->size; + } + return offset; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextGetIndex -- + * + * Given a string, return the line and character indices that + * it describes. + * + * Results: + * The return value is a standard Tcl return result. If + * TCL_OK is returned, then everything went well and the index + * at *indexPtr is filled in; otherwise TCL_ERROR is returned + * and an error message is left in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkTextGetIndex(interp, textPtr, string, indexPtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + CkText *textPtr; /* Information about text widget. */ + char *string; /* Textual description of position. */ + CkTextIndex *indexPtr; /* Index structure to fill in. */ +{ + register char *p; + char *end, *endOfBase; + Tcl_HashEntry *hPtr; + CkTextTag *tagPtr; + CkTextSearch search; + CkTextIndex first, last; + int wantLast, result; + char c; + + /* + *--------------------------------------------------------------------- + * Stage 1: check to see if the index consists of nothing but a mar + * name. We do this check now even though it's also done later, in + * order to allow mark names that include funny characters such as + * spaces or "+1c". + *--------------------------------------------------------------------- + */ + + if (CkTextMarkNameToIndex(textPtr, string, indexPtr) == TCL_OK) { + return TCL_OK; + } + + /* + *------------------------------------------------ + * Stage 2: start again by parsing the base index. + *------------------------------------------------ + */ + + indexPtr->tree = textPtr->tree; + + /* + * First look for the form "tag.first" or "tag.last" where "tag" + * is the name of a valid tag. Try to use up as much as possible + * of the string in this check (strrchr instead of strchr below). + * Doing the check now, and in this way, allows tag names to include + * funny characters like "@" or "+1c". + */ + + p = strrchr(string, '.'); + if (p != NULL) { + if ((p[1] == 'f') && (strncmp(p+1, "first", 5) == 0)) { + wantLast = 0; + endOfBase = p+6; + } else if ((p[1] == 'l') && (strncmp(p+1, "last", 4) == 0)) { + wantLast = 1; + endOfBase = p+5; + } else { + goto tryxy; + } + *p = 0; + hPtr = Tcl_FindHashEntry(&textPtr->tagTable, string); + *p = '.'; + if (hPtr == NULL) { + goto tryxy; + } + tagPtr = (CkTextTag *) Tcl_GetHashValue(hPtr); +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, 0, 0, &first); + CkTextMakeByteIndex(textPtr->tree, CkBTreeNumLines(textPtr->tree), 0, + &last); +#else + CkTextMakeIndex(textPtr->tree, 0, 0, &first); + CkTextMakeIndex(textPtr->tree, CkBTreeNumLines(textPtr->tree), 0, + &last); +#endif + CkBTreeStartSearch(&first, &last, tagPtr, &search); + if (!CkBTreeCharTagged(&first, tagPtr) && !CkBTreeNextTag(&search)) { + Tcl_AppendResult(interp, + "text doesn't contain any characters tagged with \"", + Tcl_GetHashKey(&textPtr->tagTable, hPtr), "\"", + (char *) NULL); + return TCL_ERROR; + } + *indexPtr = search.curIndex; + if (wantLast) { + while (CkBTreeNextTag(&search)) { + *indexPtr = search.curIndex; + } + } + goto gotBase; + } + + tryxy: + if (string[0] == '@') { + /* + * Find character at a given x,y location in the window. + */ + + int x, y; + + p = string+1; + x = strtol(p, &end, 0); + if ((end == p) || (*end != ',')) { + goto error; + } + p = end+1; + y = strtol(p, &end, 0); + if (end == p) { + goto error; + } + CkTextPixelIndex(textPtr, x, y, indexPtr); + endOfBase = end; + goto gotBase; + } + + if (isdigit((unsigned char) string[0]) || (string[0] == '-')) { + int lineIndex, charIndex; + + /* + * Base is identified with line and character indices. + */ + + lineIndex = strtol(string, &end, 0) - 1; + if ((end == string) || (*end != '.')) { + goto error; + } + p = end+1; + if ((*p == 'e') && (strncmp(p, "end", 3) == 0)) { + charIndex = LAST_CHAR; + endOfBase = p+3; + } else { + charIndex = strtol(p, &end, 0); + if (end == p) { + goto error; + } + endOfBase = end; + } + CkTextMakeIndex(textPtr->tree, lineIndex, charIndex, indexPtr); + goto gotBase; + } + + for (p = string; *p != 0; p++) { + if (isspace((unsigned char) *p) || (*p == '+') || (*p == '-')) { + break; + } + } + endOfBase = p; +#if 0 + if (string[0] == '.') { + /* + * See if the base position is the name of an embedded window. + */ + + c = *endOfBase; + *endOfBase = 0; + result = CkTextWindowIndex(textPtr, string, indexPtr); + *endOfBase = c; + if (result != 0) { + goto gotBase; + } + } +#endif + if ((string[0] == 'e') + && (strncmp(string, "end", (size_t) (endOfBase-string)) == 0)) { + /* + * Base position is end of text. + */ + +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, CkBTreeNumLines(textPtr->tree), + 0, indexPtr); +#else + CkTextMakeIndex(textPtr->tree, CkBTreeNumLines(textPtr->tree), + 0, indexPtr); +#endif + goto gotBase; + } else { + /* + * See if the base position is the name of a mark. + */ + + c = *endOfBase; + *endOfBase = 0; + result = CkTextMarkNameToIndex(textPtr, string, indexPtr); + *endOfBase = c; + if (result == TCL_OK) { + goto gotBase; + } + } + goto error; + + /* + *------------------------------------------------------------------- + * Stage 3: process zero or more modifiers. Each modifier is either + * a keyword like "wordend" or "linestart", or it has the form + * "op count units" where op is + or -, count is a number, and units + * is "chars" or "lines". + *------------------------------------------------------------------- + */ + + gotBase: + p = endOfBase; + while (1) { + while (isspace((unsigned char) *p)) { + p++; + } + if (*p == 0) { + break; + } + + if ((*p == '+') || (*p == '-')) { + p = ForwBack(p, indexPtr); + } else { + p = StartEnd(p, indexPtr); + } + if (p == NULL) { + goto error; + } + } + return TCL_OK; + + error: + Tcl_AppendResult(interp, "bad text index \"", string, "\"", + (char *) NULL); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextPrintIndex -- + * + * + * This procedure generates a string description of an index, + * suitable for reading in again later. + * + * Results: + * The characters pointed to by string are modified. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +CkTextPrintIndex(indexPtr, string) + CkTextIndex *indexPtr; /* Pointer to index. */ + char *string; /* Place to store the position. Must have + * at least TK_POS_CHARS characters. */ +{ +#if CK_USE_UTF + CkTextSegment *segPtr; + int numBytes, charIndex; + + numBytes = indexPtr->charIndex; + charIndex = 0; + for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) { + if (numBytes <= segPtr->size) { + break; + } + if (segPtr->typePtr == &ckTextCharType) { + charIndex += Tcl_NumUtfChars(segPtr->body.chars, segPtr->size); + } else { + charIndex += segPtr->size; + } + numBytes -= segPtr->size; + } + if (segPtr->typePtr == &ckTextCharType) { + charIndex += Tcl_NumUtfChars(segPtr->body.chars, numBytes); + } else { + charIndex += numBytes; + } + sprintf(string, "%d.%d", CkBTreeLineIndex(indexPtr->linePtr) + 1, + charIndex); +#else + sprintf(string, "%d.%d", CkBTreeLineIndex(indexPtr->linePtr) + 1, + indexPtr->charIndex); +#endif +} + +/* + *-------------------------------------------------------------- + * + * CkTextIndexCmp -- + * + * Compare two indices to see which one is earlier in + * the text. + * + * Results: + * The return value is 0 if index1Ptr and index2Ptr refer + * to the same position in the file, -1 if index1Ptr refers + * to an earlier position than index2Ptr, and 1 otherwise. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +CkTextIndexCmp(index1Ptr, index2Ptr) + CkTextIndex *index1Ptr; /* First index. */ + CkTextIndex *index2Ptr; /* Second index. */ +{ + int line1, line2; + + if (index1Ptr->linePtr == index2Ptr->linePtr) { + if (index1Ptr->charIndex < index2Ptr->charIndex) { + return -1; + } else if (index1Ptr->charIndex > index2Ptr->charIndex) { + return 1; + } else { + return 0; + } + } + line1 = CkBTreeLineIndex(index1Ptr->linePtr); + line2 = CkBTreeLineIndex(index2Ptr->linePtr); + if (line1 < line2) { + return -1; + } + if (line1 > line2) { + return 1; + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * ForwBack -- + * + * This procedure handles +/- modifiers for indices to adjust + * the index forwards or backwards. + * + * Results: + * If the modifier in string is successfully parsed then the + * return value is the address of the first character after the + * modifier, and *indexPtr is updated to reflect the modifier. + * If there is a syntax error in the modifier then NULL is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static char * +ForwBack(string, indexPtr) + char *string; /* String to parse for additional info + * about modifier (count and units). + * Points to "+" or "-" that starts + * modifier. */ + CkTextIndex *indexPtr; /* Index to update as specified in string. */ +{ + register char *p; + char *end, *units; + int count, lineIndex; + size_t length; + + /* + * Get the count (how many units forward or backward). + */ + + p = string+1; + while (isspace((unsigned char) *p)) { + p++; + } + count = strtol(p, &end, 0); + if (end == p) { + return NULL; + } + p = end; + while (isspace((unsigned char) *p)) { + p++; + } + + /* + * Find the end of this modifier (next space or + or - character), + * then parse the unit specifier and update the position + * accordingly. + */ + + units = p; + while ((*p != 0) && !isspace((unsigned char) *p) + && (*p != '+') && (*p != '-')) { + p++; + } + length = p - units; + if ((*units == 'c') && (strncmp(units, "chars", length) == 0)) { + if (*string == '+') { + CkTextIndexForwChars(indexPtr, count, indexPtr); + } else { + CkTextIndexBackChars(indexPtr, count, indexPtr); + } + } else if ((*units == 'l') && (strncmp(units, "lines", length) == 0)) { + lineIndex = CkBTreeLineIndex(indexPtr->linePtr); + if (*string == '+') { + lineIndex += count; + } else { + lineIndex -= count; + + /* + * The check below retains the character position, even + * if the line runs off the start of the file. Without + * it, the character position will get reset to 0 by + * CkTextMakeIndex. + */ + + if (lineIndex < 0) { + lineIndex = 0; + } + } +#if CK_USE_UTF + CkTextMakeByteIndex(indexPtr->tree, lineIndex, indexPtr->charIndex, + indexPtr); +#else + CkTextMakeIndex(indexPtr->tree, lineIndex, indexPtr->charIndex, + indexPtr); +#endif + } else { + return NULL; + } + return p; +} + +#if CK_USE_UTF +/* + *--------------------------------------------------------------------------- + * + * CkTextIndexForwBytes -- + * + * Given an index for a text widget, this procedure creates a new + * index that points "count" bytes ahead of the source index. + * + * Results: + * *dstPtr is modified to refer to the character "count" bytes after + * srcPtr, or to the last character in the CkText if there aren't + * "count" bytes left. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +void +CkTextIndexForwBytes(srcPtr, byteCount, dstPtr) + CkTextIndex *srcPtr; /* Source index. */ + int byteCount; /* How many bytes forward to move. May be + * negative. */ + CkTextIndex *dstPtr; /* Destination index: gets modified. */ +{ + CkTextLine *linePtr; + CkTextSegment *segPtr; + int lineLength; + + if (byteCount < 0) { + CkTextIndexBackBytes(srcPtr, -byteCount, dstPtr); + return; + } + + *dstPtr = *srcPtr; + dstPtr->charIndex += byteCount; + while (1) { + /* + * Compute the length of the current line. + */ + + lineLength = 0; + for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + lineLength += segPtr->size; + } + + /* + * If the new index is in the same line then we're done. + * Otherwise go on to the next line. + */ + + if (dstPtr->charIndex < lineLength) { + return; + } + dstPtr->charIndex -= lineLength; + linePtr = CkBTreeNextLine(dstPtr->linePtr); + if (linePtr == NULL) { + dstPtr->charIndex = lineLength - 1; + return; + } + dstPtr->linePtr = linePtr; + } +} +#endif + +/* + *---------------------------------------------------------------------- + * + * CkTextIndexForwChars -- + * + * Given an index for a text widget, this procedure creates a + * new index that points "count" characters ahead of the source + * index. + * + * Results: + * *dstPtr is modified to refer to the character "count" characters + * after srcPtr, or to the last character in the file if there aren't + * "count" characters left in the file. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +CkTextIndexForwChars(srcPtr, count, dstPtr) + CkTextIndex *srcPtr; /* Source index. */ + int count; /* How many characters forward to + * move. May be negative. */ + CkTextIndex *dstPtr; /* Destination index: gets modified. */ +{ + CkTextLine *linePtr; + CkTextSegment *segPtr; + int lineLength; +#if CK_USE_UTF + int byteOffset; + char *p, *start, *end; + Tcl_UniChar ch; +#endif + + if (count < 0) { + CkTextIndexBackChars(srcPtr, -count, dstPtr); + return; + } + + *dstPtr = *srcPtr; + +#if CK_USE_UTF + segPtr = CkTextIndexToSeg(dstPtr, &byteOffset); + while (1) { + + /* + * Go through each segment in line looking for specified character + * index. + */ + + for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) { + if (segPtr->typePtr == &ckTextCharType) { + start = segPtr->body.chars + byteOffset; + end = segPtr->body.chars + segPtr->size; + for (p = start; p < end; p += Tcl_UtfToUniChar(p, &ch)) { + if (count == 0) { + dstPtr->charIndex += (p - start); + return; + } + count--; + } + } else { + if (count < segPtr->size - byteOffset) { + dstPtr->charIndex += count; + return; + } + count -= segPtr->size - byteOffset; + } + dstPtr->charIndex += segPtr->size - byteOffset; + byteOffset = 0; + } + + /* + * Go to the next line. If we are at the end of the text item, + * back up one byte (for the terminal '\n' character) and return + * that index. + */ + + linePtr = CkBTreeNextLine(dstPtr->linePtr); + if (linePtr == NULL) { + dstPtr->charIndex -= sizeof(char); + return; + } + dstPtr->linePtr = linePtr; + dstPtr->charIndex = 0; + segPtr = dstPtr->linePtr->segPtr; + } +#else + dstPtr->charIndex += count; + while (1) { + /* + * Compute the length of the current line. + */ + + lineLength = 0; + for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + lineLength += segPtr->size; + } + + /* + * If the new index is in the same line then we're done. + * Otherwise go on to the next line. + */ + + if (dstPtr->charIndex < lineLength) { + return; + } + dstPtr->charIndex -= lineLength; + linePtr = CkBTreeNextLine(dstPtr->linePtr); + if (linePtr == NULL) { + dstPtr->charIndex = lineLength - 1; + return; + } + dstPtr->linePtr = linePtr; + } +#endif +} + +#if CK_USE_UTF +/* + *--------------------------------------------------------------------------- + * + * CkTextIndexBackBytes -- + * + * Given an index for a text widget, this procedure creates a new + * index that points "count" bytes earlier than the source index. + * + * Results: + * *dstPtr is modified to refer to the character "count" bytes before + * srcPtr, or to the first character in the CkText if there aren't + * "count" bytes earlier than srcPtr. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +void +CkTextIndexBackBytes(srcPtr, byteCount, dstPtr) + CkTextIndex *srcPtr; /* Source index. */ + int byteCount; /* How many bytes backward to move. May be + * negative. */ + CkTextIndex *dstPtr; /* Destination index: gets modified. */ +{ + CkTextSegment *segPtr; + int lineIndex; + + if (byteCount < 0) { + CkTextIndexForwBytes(srcPtr, -byteCount, dstPtr); + return; + } + + *dstPtr = *srcPtr; + dstPtr->charIndex -= byteCount; + lineIndex = -1; + while (dstPtr->charIndex < 0) { + /* + * Move back one line in the text. If we run off the beginning + * of the file then just return the first character in the text. + */ + + if (lineIndex < 0) { + lineIndex = CkBTreeLineIndex(dstPtr->linePtr); + } + if (lineIndex == 0) { + dstPtr->charIndex = 0; + return; + } + lineIndex--; + dstPtr->linePtr = CkBTreeFindLine(dstPtr->tree, lineIndex); + + /* + * Compute the length of the line and add that to dstPtr->charIndex. + */ + + for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + dstPtr->charIndex += segPtr->size; + } + } +} +#endif + +/* + *---------------------------------------------------------------------- + * + * CkTextIndexBackChars -- + * + * Given an index for a text widget, this procedure creates a + * new index that points "count" characters earlier than the + * source index. + * + * Results: + * *dstPtr is modified to refer to the character "count" characters + * before srcPtr, or to the first character in the file if there aren't + * "count" characters earlier than srcPtr. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +CkTextIndexBackChars(srcPtr, count, dstPtr) + CkTextIndex *srcPtr; /* Source index. */ + int count; /* How many characters backward to + * move. May be negative. */ + CkTextIndex *dstPtr; /* Destination index: gets modified. */ +{ + CkTextSegment *segPtr; + int lineIndex; +#if CK_USE_UTF + CkTextSegment *oldPtr; + int segSize; + char *p, *start, *end; +#endif + + if (count < 0) { + CkTextIndexForwChars(srcPtr, -count, dstPtr); + return; + } + + *dstPtr = *srcPtr; +#if CK_USE_UTF + + /* + * Find offset within seg that contains byteIndex. + * Move backward specified number of chars. + */ + + lineIndex = -1; + + segSize = dstPtr->charIndex; + for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) { + if (segSize <= segPtr->size) { + break; + } + segSize -= segPtr->size; + } + while (1) { + if (segPtr->typePtr == &ckTextCharType) { + start = segPtr->body.chars; + end = segPtr->body.chars + segSize; + for (p = end; ; p = Tcl_UtfPrev(p, start)) { + if (count == 0) { + dstPtr->charIndex -= (end - p); + return; + } + if (p == start) { + break; + } + count--; + } + } else { + if (count <= segSize) { + dstPtr->charIndex -= count; + return; + } + count -= segSize; + } + dstPtr->charIndex -= segSize; + + /* + * Move back into previous segment. + */ + + oldPtr = segPtr; + segPtr = dstPtr->linePtr->segPtr; + if (segPtr != oldPtr) { + for ( ; segPtr->nextPtr != oldPtr; segPtr = segPtr->nextPtr) { + /* Empty body. */ + } + segSize = segPtr->size; + continue; + } + + /* + * Move back to previous line. + */ + + if (lineIndex < 0) { + lineIndex = CkBTreeLineIndex(dstPtr->linePtr); + } + if (lineIndex == 0) { + dstPtr->charIndex = 0; + return; + } + lineIndex--; + dstPtr->linePtr = CkBTreeFindLine(dstPtr->tree, lineIndex); + + /* + * Compute the length of the line and add that to dstPtr->byteIndex. + */ + + oldPtr = dstPtr->linePtr->segPtr; + for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { + dstPtr->charIndex += segPtr->size; + oldPtr = segPtr; + } + segPtr = oldPtr; + segSize = segPtr->size; + } +#else + dstPtr->charIndex -= count; + lineIndex = -1; + while (dstPtr->charIndex < 0) { + /* + * Move back one line in the text. If we run off the beginning + * of the file then just return the first character in the text. + */ + + if (lineIndex < 0) { + lineIndex = CkBTreeLineIndex(dstPtr->linePtr); + } + if (lineIndex == 0) { + dstPtr->charIndex = 0; + return; + } + lineIndex--; + dstPtr->linePtr = CkBTreeFindLine(dstPtr->tree, lineIndex); + + /* + * Compute the length of the line and add that to dstPtr->charIndex. + */ + + for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + dstPtr->charIndex += segPtr->size; + } + } +#endif +} + +/* + *---------------------------------------------------------------------- + * + * StartEnd -- + * + * This procedure handles modifiers like "wordstart" and "lineend" + * to adjust indices forwards or backwards. + * + * Results: + * If the modifier is successfully parsed then the return value + * is the address of the first character after the modifier, and + * *indexPtr is updated to reflect the modifier. If there is a + * syntax error in the modifier then NULL is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static char * +StartEnd(string, indexPtr) + char *string; /* String to parse for additional info + * about modifier (count and units). + * Points to first character of modifer + * word. */ + CkTextIndex *indexPtr; /* Index to mdoify based on string. */ +{ + char *p; + int c, offset; + size_t length; + register CkTextSegment *segPtr; + + /* + * Find the end of the modifier word. + */ + + for (p = string; isalnum((unsigned char) *p); p++) { + /* Empty loop body. */ + } + length = p-string; + if ((*string == 'l') && (strncmp(string, "lineend", length) == 0) + && (length >= 5)) { + indexPtr->charIndex = 0; + for (segPtr = indexPtr->linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + indexPtr->charIndex += segPtr->size; + } + indexPtr->charIndex -= 1; + } else if ((*string == 'l') && (strncmp(string, "linestart", length) == 0) + && (length >= 5)) { + indexPtr->charIndex = 0; + } else if ((*string == 'w') && (strncmp(string, "wordend", length) == 0) + && (length >= 5)) { + int firstChar = 1; + + /* + * If the current character isn't part of a word then just move + * forward one character. Otherwise move forward until finding + * a character that isn't part of a word and stop there. + */ + + segPtr = CkTextIndexToSeg(indexPtr, &offset); + while (1) { + if (segPtr->typePtr == &ckTextCharType) { + c = segPtr->body.chars[offset]; + if (!isalnum((unsigned char) c) && (c != '_')) { + break; + } + firstChar = 0; + } + offset += 1; + indexPtr->charIndex += 1; + if (offset >= segPtr->size) { + segPtr = CkTextIndexToSeg(indexPtr, &offset); + } + } + if (firstChar) { + CkTextIndexForwChars(indexPtr, 1, indexPtr); + } + } else if ((*string == 'w') && (strncmp(string, "wordstart", length) == 0) + && (length >= 5)) { + int firstChar = 1; + + /* + * Starting with the current character, look for one that's not + * part of a word and keep moving backward until you find one. + * Then if the character found wasn't the first one, move forward + * again one position. + */ + + segPtr = CkTextIndexToSeg(indexPtr, &offset); + while (1) { + if (segPtr->typePtr == &ckTextCharType) { + c = segPtr->body.chars[offset]; + if (!isalnum((unsigned char) c) && (c != '_')) { + break; + } + firstChar = 0; + } + offset -= 1; + indexPtr->charIndex -= 1; + if (offset < 0) { + if (indexPtr->charIndex < 0) { + indexPtr->charIndex = 0; + goto done; + } + segPtr = CkTextIndexToSeg(indexPtr, &offset); + } + } + if (!firstChar) { + CkTextIndexForwChars(indexPtr, 1, indexPtr); + } + } else { + return NULL; + } + done: + return p; +} diff --git a/ckTextMark.c b/ckTextMark.c new file mode 100644 index 0000000..96419e9 --- /dev/null +++ b/ckTextMark.c @@ -0,0 +1,576 @@ +/* + * ckTextMark.c -- + * + * This file contains the procedure that implement marks for + * text widgets. + * + * Copyright (c) 1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "ckText.h" + +/* + * Macro that determines the size of a mark segment: + */ + +#define MSEG_SIZE ((unsigned) (Ck_Offset(CkTextSegment, body) \ + + sizeof(CkTextMark))) + +/* + * Forward references for procedures defined in this file: + */ + +static void InsertUndisplayProc _ANSI_ARGS_((CkText *textPtr, + CkTextDispChunk *chunkPtr)); +static int MarkDeleteProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr, int treeGone)); +static CkTextSegment * MarkCleanupProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); +static void MarkCheckProc _ANSI_ARGS_((CkTextSegment *segPtr, + CkTextLine *linePtr)); +static int MarkLayoutProc _ANSI_ARGS_((CkText *textPtr, + CkTextIndex *indexPtr, CkTextSegment *segPtr, + int offset, int maxX, int maxChars, + int noCharsYet, Ck_Uid wrapMode, + CkTextDispChunk *chunkPtr)); + +/* + * The following structures declare the "mark" segment types. + * There are actually two types for marks, one with left gravity + * and one with right gravity. They are identical except for + * their gravity property. + */ + +Ck_SegType ckTextRightMarkType = { + "mark", /* name */ + 0, /* leftGravity */ + (Ck_SegSplitProc *) NULL, /* splitProc */ + MarkDeleteProc, /* deleteProc */ + MarkCleanupProc, /* cleanupProc */ + (Ck_SegLineChangeProc *) NULL, /* lineChangeProc */ + MarkLayoutProc, /* layoutProc */ + MarkCheckProc /* checkProc */ +}; + +Ck_SegType ckTextLeftMarkType = { + "mark", /* name */ + 1, /* leftGravity */ + (Ck_SegSplitProc *) NULL, /* splitProc */ + MarkDeleteProc, /* deleteProc */ + MarkCleanupProc, /* cleanupProc */ + (Ck_SegLineChangeProc *) NULL, /* lineChangeProc */ + MarkLayoutProc, /* layoutProc */ + MarkCheckProc /* checkProc */ +}; + +/* + *-------------------------------------------------------------- + * + * CkTextMarkCmd -- + * + * This procedure is invoked to process the "mark" options of + * the widget command for text widgets. See the user documentation + * for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +CkTextMarkCmd(textPtr, interp, argc, argv) + register CkText *textPtr; /* Information about text widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. Someone else has already + * parsed this command enough to know that + * argv[1] is "mark". */ +{ + int c, i; + size_t length; + Tcl_HashEntry *hPtr; + CkTextSegment *markPtr; + Tcl_HashSearch search; + CkTextIndex index; + Ck_SegType *newTypePtr; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " mark option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[2][0]; + length = strlen(argv[2]); + if ((c == 'g') && (strncmp(argv[2], "gravity", length) == 0)) { + if (argc > 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " mark gravity markName ?gravity?", + (char *) NULL); + return TCL_ERROR; + } + hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[3]); + if (hPtr == NULL) { + Tcl_AppendResult(interp, "there is no mark named \"", + argv[3], "\"", (char *) NULL); + return TCL_ERROR; + } + markPtr = (CkTextSegment *) Tcl_GetHashValue(hPtr); + if (argc == 4) { + if (markPtr->typePtr == &ckTextRightMarkType) { + interp->result = "right"; + } else { + interp->result = "left"; + } + return TCL_OK; + } + length = strlen(argv[4]); + c = argv[4][0]; + if ((c == 'l') && (strncmp(argv[4], "left", length) == 0)) { + newTypePtr = &ckTextLeftMarkType; + } else if ((c == 'r') && (strncmp(argv[4], "right", length) == 0)) { + newTypePtr = &ckTextRightMarkType; + } else { + Tcl_AppendResult(interp, "bad mark gravity \"", + argv[4], "\": must be left or right", (char *) NULL); + return TCL_ERROR; + } + CkTextMarkSegToIndex(textPtr, markPtr, &index); + CkBTreeUnlinkSegment(textPtr->tree, markPtr, + markPtr->body.mark.linePtr); + markPtr->typePtr = newTypePtr; + CkBTreeLinkSegment(markPtr, &index); + } else if ((c == 'n') && (strncmp(argv[2], "names", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " mark names\"", (char *) NULL); + return TCL_ERROR; + } + for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_AppendElement(interp, + Tcl_GetHashKey(&textPtr->markTable, hPtr)); + } + } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " mark set markName index\"", (char *) NULL); + return TCL_ERROR; + } + if (CkTextGetIndex(interp, textPtr, argv[4], &index) != TCL_OK) { + return TCL_ERROR; + } + CkTextSetMark(textPtr, argv[3], &index); + } else if ((c == 'u') && (strncmp(argv[2], "unset", length) == 0)) { + for (i = 3; i < argc; i++) { + hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[i]); + if (hPtr != NULL) { + markPtr = (CkTextSegment *) Tcl_GetHashValue(hPtr); + if ((markPtr == textPtr->insertMarkPtr) + || (markPtr == textPtr->currentMarkPtr)) { + continue; + } + CkBTreeUnlinkSegment(textPtr->tree, markPtr, + markPtr->body.mark.linePtr); + Tcl_DeleteHashEntry(hPtr); + ckfree((char *) markPtr); + } + } + } else { + Tcl_AppendResult(interp, "bad mark option \"", argv[2], + "\": must be gravity, names, set, or unset", + (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextSetMark -- + * + * Set a mark to a particular position, creating a new mark if + * one doesn't already exist. + * + * Results: + * The return value is a pointer to the mark that was just set. + * + * Side effects: + * A new mark is created, or an existing mark is moved. + * + *---------------------------------------------------------------------- + */ + +CkTextSegment * +CkTextSetMark(textPtr, name, indexPtr) + CkText *textPtr; /* Text widget in which to create mark. */ + char *name; /* Name of mark to set. */ + CkTextIndex *indexPtr; /* Where to set mark. */ +{ + Tcl_HashEntry *hPtr; + CkTextSegment *markPtr; + CkTextIndex insertIndex; + int new; + + hPtr = Tcl_CreateHashEntry(&textPtr->markTable, name, &new); + markPtr = (CkTextSegment *) Tcl_GetHashValue(hPtr); + if (!new) { + /* + * If this is the insertion point that's being moved, be sure + * to force a display update at the old position. Also, don't + * let the insertion cursor be after the final newline of the + * file. + */ + + if (markPtr == textPtr->insertMarkPtr) { + CkTextIndex index, index2; + CkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index); + CkTextIndexForwChars(&index, 1, &index2); + CkTextChanged(textPtr, &index, &index2); + if (CkBTreeLineIndex(indexPtr->linePtr) + == CkBTreeNumLines(textPtr->tree)) { + CkTextIndexBackChars(indexPtr, 1, &insertIndex); + indexPtr = &insertIndex; + } + } + CkBTreeUnlinkSegment(textPtr->tree, markPtr, + markPtr->body.mark.linePtr); + } else { + markPtr = (CkTextSegment *) ckalloc(MSEG_SIZE); + markPtr->typePtr = &ckTextRightMarkType; + markPtr->size = 0; + markPtr->body.mark.textPtr = textPtr; + markPtr->body.mark.linePtr = indexPtr->linePtr; + markPtr->body.mark.hPtr = hPtr; + Tcl_SetHashValue(hPtr, markPtr); + } + CkBTreeLinkSegment(markPtr, indexPtr); + + /* + * If the mark is the insertion cursor, then update the screen at the + * mark's new location. + */ + + if (markPtr == textPtr->insertMarkPtr) { + CkTextIndex index2; + + CkTextIndexForwChars(indexPtr, 1, &index2); + CkTextChanged(textPtr, indexPtr, &index2); + } + return markPtr; +} + +/* + *-------------------------------------------------------------- + * + * CkTextMarkSegToIndex -- + * + * Given a segment that is a mark, create an index that + * refers to the next text character (or other text segment + * with non-zero size) after the mark. + * + * Results: + * *IndexPtr is filled in with index information. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +CkTextMarkSegToIndex(textPtr, markPtr, indexPtr) + CkText *textPtr; /* Text widget containing mark. */ + CkTextSegment *markPtr; /* Mark segment. */ + CkTextIndex *indexPtr; /* Index information gets stored here. */ +{ + CkTextSegment *segPtr; + + indexPtr->tree = textPtr->tree; + indexPtr->linePtr = markPtr->body.mark.linePtr; + indexPtr->charIndex = 0; + for (segPtr = indexPtr->linePtr->segPtr; segPtr != markPtr; + segPtr = segPtr->nextPtr) { + indexPtr->charIndex += segPtr->size; + } +} + +/* + *-------------------------------------------------------------- + * + * CkTextMarkNameToIndex -- + * + * Given the name of a mark, return an index corresponding + * to the mark name. + * + * Results: + * The return value is TCL_OK if "name" exists as a mark in + * the text widget. In this case *indexPtr is filled in with + * the next segment whose after the mark whose size is + * non-zero. TCL_ERROR is returned if the mark doesn't exist + * in the text widget. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +CkTextMarkNameToIndex(textPtr, name, indexPtr) + CkText *textPtr; /* Text widget containing mark. */ + char *name; /* Name of mark. */ + CkTextIndex *indexPtr; /* Index information gets stored here. */ +{ + Tcl_HashEntry *hPtr; + + hPtr = Tcl_FindHashEntry(&textPtr->markTable, name); + if (hPtr == NULL) { + return TCL_ERROR; + } + CkTextMarkSegToIndex(textPtr, (CkTextSegment *) Tcl_GetHashValue(hPtr), + indexPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * MarkDeleteProc -- + * + * This procedure is invoked by the text B-tree code whenever + * a mark lies in a range of characters being deleted. + * + * Results: + * Returns 1 to indicate that deletion has been rejected. + * + * Side effects: + * None (even if the whole tree is being deleted we don't + * free up the mark; it will be done elsewhere). + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +MarkDeleteProc(segPtr, linePtr, treeGone) + CkTextSegment *segPtr; /* Segment being deleted. */ + CkTextLine *linePtr; /* Line containing segment. */ + int treeGone; /* Non-zero means the entire tree is + * being deleted, so everything must + * get cleaned up. */ +{ + return 1; +} + +/* + *-------------------------------------------------------------- + * + * MarkCleanupProc -- + * + * This procedure is invoked by the B-tree code whenever a + * mark segment is moved from one line to another. + * + * Results: + * None. + * + * Side effects: + * The linePtr field of the segment gets updated. + * + *-------------------------------------------------------------- + */ + +static CkTextSegment * +MarkCleanupProc(markPtr, linePtr) + CkTextSegment *markPtr; /* Mark segment that's being moved. */ + CkTextLine *linePtr; /* Line that now contains segment. */ +{ + markPtr->body.mark.linePtr = linePtr; + return markPtr; +} + +/* + *-------------------------------------------------------------- + * + * MarkLayoutProc -- + * + * This procedure is the "layoutProc" for mark segments. + * + * Results: + * If the mark isn't the insertion cursor then the return + * value is -1 to indicate that this segment shouldn't be + * displayed. If the mark is the insertion character then + * 1 is returned and the chunkPtr structure is filled in. + * + * Side effects: + * None, except for filling in chunkPtr. + * + *-------------------------------------------------------------- + */ + + /*ARGSUSED*/ +static int +MarkLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars, + noCharsYet, wrapMode, chunkPtr) + CkText *textPtr; /* Text widget being layed out. */ + CkTextIndex *indexPtr; /* Identifies first character in chunk. */ + CkTextSegment *segPtr; /* Segment corresponding to indexPtr. */ + int offset; /* Offset within segPtr corresponding to + * indexPtr (always 0). */ + int maxX; /* Chunk must not occupy pixels at this + * position or higher. */ + int maxChars; /* Chunk must not include more than this + * many characters. */ + int noCharsYet; /* Non-zero means no characters have been + * assigned to this line yet. */ + Ck_Uid wrapMode; /* Not used. */ + register CkTextDispChunk *chunkPtr; + /* Structure to fill in with information + * about this chunk. The x field has already + * been set by the caller. */ +{ + if (segPtr != textPtr->insertMarkPtr) { + return -1; + } + + chunkPtr->displayProc = CkTextInsertDisplayProc; + chunkPtr->undisplayProc = InsertUndisplayProc; + chunkPtr->measureProc = (Ck_ChunkMeasureProc *) NULL; + chunkPtr->bboxProc = (Ck_ChunkBboxProc *) NULL; + chunkPtr->numChars = 0; + chunkPtr->minHeight = 0; + chunkPtr->width = 0; + + /* + * Note: can't break a line after the insertion cursor: this + * prevents the insertion cursor from being stranded at the end + * of a line. + */ + + chunkPtr->breakIndex = -1; + chunkPtr->clientData = (ClientData) textPtr; + return 1; +} + +/* + *-------------------------------------------------------------- + * + * CkTextInsertDisplayProc -- + * + * This procedure is called to display the insertion + * cursor. + * + * Results: + * None. + * + * Side effects: + * Graphics are drawn. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +void +CkTextInsertDisplayProc(chunkPtr, x, y, height, baseline, window, screenY) + CkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */ + int x; /* X-position in dst at which to + * draw this chunk (may differ from + * the x-position in the chunk because + * of scrolling). */ + int y; /* Y-position at which to draw this + * chunk in dst (x-position is in + * the chunk itself). */ + int height; /* Total height of line. */ + int baseline; /* Offset of baseline from y. */ + WINDOW *window; /* Curses window. */ + int screenY; /* Y-coordinate in text window that + * corresponds to y. */ +{ + CkText *textPtr = (CkText *) chunkPtr->clientData; + + textPtr->insertY = screenY; + textPtr->insertX = x; +} + +/* + *-------------------------------------------------------------- + * + * InsertUndisplayProc -- + * + * This procedure is called when the insertion cursor is no + * longer at a visible point on the display. It does nothing + * right now. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +InsertUndisplayProc(textPtr, chunkPtr) + CkText *textPtr; /* Overall information about text + * widget. */ + CkTextDispChunk *chunkPtr; /* Chunk that is about to be freed. */ +{ + return; +} + +/* + *-------------------------------------------------------------- + * + * MarkCheckProc -- + * + * This procedure is invoked by the B-tree code to perform + * consistency checks on mark segments. + * + * Results: + * None. + * + * Side effects: + * The procedure panics if it detects anything wrong with + * the mark. + * + *-------------------------------------------------------------- + */ + +static void +MarkCheckProc(markPtr, linePtr) + CkTextSegment *markPtr; /* Segment to check. */ + CkTextLine *linePtr; /* Line containing segment. */ +{ + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + + if (markPtr->body.mark.linePtr != linePtr) { + panic("MarkCheckProc: markPtr->body.mark.linePtr bogus"); + } + + /* + * Make sure that the mark is still present in the text's mark + * hash table. + */ + + for (hPtr = Tcl_FirstHashEntry(&markPtr->body.mark.textPtr->markTable, + &search); hPtr != markPtr->body.mark.hPtr; + hPtr = Tcl_NextHashEntry(&search)) { + if (hPtr == NULL) { + panic("MarkCheckProc couldn't find hash table entry for mark"); + } + } +} diff --git a/ckTextTag.c b/ckTextTag.c new file mode 100644 index 0000000..69b0e08 --- /dev/null +++ b/ckTextTag.c @@ -0,0 +1,923 @@ +/* + * ckTextTag.c -- + * + * This module implements the "tag" subcommand of the widget command + * for text widgets, plus most of the other high-level functions + * related to tags. + * + * Copyright (c) 1992-1994 The Regents of the University of California. + * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1995 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "ckText.h" +#include "default.h" + +/* + * Information used for parsing tag configuration information: + */ + +static Ck_ConfigSpec tagConfigSpecs[] = { + {CK_CONFIG_ATTR, "-attributes", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, attr), 0}, + {CK_CONFIG_COLOR, "-background", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, bg), 0}, + {CK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, fg), 0}, + {CK_CONFIG_STRING, "-justify", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, justifyString), CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-lmargin1", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, lMargin1String), CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-lmargin2", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, lMargin2String), CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-rmargin", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, rMarginString), CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-tabs", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, tabString), CK_CONFIG_NULL_OK}, + {CK_CONFIG_UID, "-wrap", (char *) NULL, (char *) NULL, + (char *) NULL, Ck_Offset(CkTextTag, wrapMode), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void ChangeTagPriority _ANSI_ARGS_((CkText *textPtr, + CkTextTag *tagPtr, int prio)); +static CkTextTag * FindTag _ANSI_ARGS_((Tcl_Interp *interp, + CkText *textPtr, char *tagName)); +static void SortTags _ANSI_ARGS_((int numTags, + CkTextTag **tagArrayPtr)); +static int TagSortProc _ANSI_ARGS_((CONST VOID *first, + CONST VOID *second)); + +/* + *-------------------------------------------------------------- + * + * CkTextTagCmd -- + * + * This procedure is invoked to process the "tag" options of + * the widget command for text widgets. See the user documentation + * for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +CkTextTagCmd(textPtr, interp, argc, argv) + register CkText *textPtr; /* Information about text widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. Someone else has already + * parsed this command enough to know that + * argv[1] is "tag". */ +{ + int c, i, addTag; + size_t length; + char *fullOption; + register CkTextTag *tagPtr; + CkTextIndex first, last, index1, index2; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[2][0]; + length = strlen(argv[2]); + if ((c == 'a') && (strncmp(argv[2], "add", length) == 0)) { + fullOption = "add"; + addTag = 1; + + addAndRemove: + if (argc < 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag ", fullOption, + " tagName index1 ?index2 index1 index2 ...?\"", + (char *) NULL); + return TCL_ERROR; + } + tagPtr = CkTextCreateTag(textPtr, argv[3]); + for (i = 4; i < argc; i += 2) { + if (CkTextGetIndex(interp, textPtr, argv[i], &index1) != TCL_OK) { + return TCL_ERROR; + } + if (argc > (i+1)) { + if (CkTextGetIndex(interp, textPtr, argv[i+1], &index2) + != TCL_OK) { + return TCL_ERROR; + } + if (CkTextIndexCmp(&index1, &index2) >= 0) { + return TCL_OK; + } + } else { + index2 = index1; + CkTextIndexForwChars(&index2, 1, &index2); + } + + if (tagPtr->affectsDisplay) { + CkTextRedrawTag(textPtr, &index1, &index2, tagPtr, !addTag); + } else { + /* + * Still need to trigger enter/leave events on tags that + * have changed. + */ + + CkTextEventuallyRepick(textPtr); + } + CkBTreeTag(&index1, &index2, tagPtr, addTag); + + /* + * If the tag is "sel" then grab the selection if we're supposed + * to export it and don't already have it. Also, invalidate + * partially-completed selection retrievals. + */ + + if (tagPtr == textPtr->selTagPtr) { + textPtr->abortSelections = 1; + } + } + } else if ((c == 'b') && (strncmp(argv[2], "bind", length) == 0)) { + if ((argc < 4) || (argc > 6)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag bind tagName ?sequence? ?command?\"", + (char *) NULL); + return TCL_ERROR; + } + tagPtr = CkTextCreateTag(textPtr, argv[3]); + + /* + * Make a binding table if the widget doesn't already have + * one. + */ + + if (textPtr->bindingTable == NULL) { + textPtr->bindingTable = Ck_CreateBindingTable(interp); + } + + if (argc == 6) { + int append = 0; + unsigned long mask; + + if (argv[5][0] == 0) { + return Ck_DeleteBinding(interp, textPtr->bindingTable, + (ClientData) tagPtr, argv[4]); + } + if (argv[5][0] == '+') { + argv[5]++; + append = 1; + } + mask = Ck_CreateBinding(interp, textPtr->bindingTable, + (ClientData) tagPtr, argv[4], argv[5], append); + if (mask != TCL_OK) { + return TCL_ERROR; + } + } else if (argc == 5) { + char *command; + + command = Ck_GetBinding(interp, textPtr->bindingTable, + (ClientData) tagPtr, argv[4]); + if (command == NULL) { + return TCL_ERROR; + } + interp->result = command; + } else { + Ck_GetAllBindings(interp, textPtr->bindingTable, + (ClientData) tagPtr); + } + } else if ((c == 'c') && (strncmp(argv[2], "cget", length) == 0) + && (length >= 2)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag cget tagName option\"", + (char *) NULL); + return TCL_ERROR; + } + tagPtr = FindTag(interp, textPtr, argv[3]); + if (tagPtr == NULL) { + return TCL_ERROR; + } + return Ck_ConfigureValue(interp, textPtr->winPtr, tagConfigSpecs, + (char *) tagPtr, argv[4], 0); + } else if ((c == 'c') && (strncmp(argv[2], "configure", length) == 0) + && (length >= 2)) { + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag configure tagName ?option? ?value? ", + "?option value ...?\"", (char *) NULL); + return TCL_ERROR; + } + tagPtr = CkTextCreateTag(textPtr, argv[3]); + if (argc == 4) { + return Ck_ConfigureInfo(interp, textPtr->winPtr, tagConfigSpecs, + (char *) tagPtr, (char *) NULL, 0); + } else if (argc == 5) { + return Ck_ConfigureInfo(interp, textPtr->winPtr, tagConfigSpecs, + (char *) tagPtr, argv[4], 0); + } else { + int result; + + result = Ck_ConfigureWidget(interp, textPtr->winPtr, + tagConfigSpecs, argc-4, argv+4, (char *) tagPtr, 0); + /* + * Some of the configuration options, like -underline + * and -justify, require additional translation (this is + * needed because we need to distinguish a particular value + * of an option from "unspecified"). + */ + + if (tagPtr->justifyString != NULL) { + if (Ck_GetJustify(interp, tagPtr->justifyString, + &tagPtr->justify) != TCL_OK) { + return TCL_ERROR; + } + } + if (tagPtr->lMargin1String != NULL) { + if (Ck_GetCoord(interp, textPtr->winPtr, + tagPtr->lMargin1String, &tagPtr->lMargin1) != TCL_OK) { + return TCL_ERROR; + } + } + if (tagPtr->lMargin2String != NULL) { + if (Ck_GetCoord(interp, textPtr->winPtr, + tagPtr->lMargin2String, &tagPtr->lMargin2) != TCL_OK) { + return TCL_ERROR; + } + } + if (tagPtr->rMarginString != NULL) { + if (Ck_GetCoord(interp, textPtr->winPtr, + tagPtr->rMarginString, &tagPtr->rMargin) != TCL_OK) { + return TCL_ERROR; + } + } + if (tagPtr->tabArrayPtr != NULL) { + ckfree((char *) tagPtr->tabArrayPtr); + tagPtr->tabArrayPtr = NULL; + } + if (tagPtr->tabString != NULL) { + tagPtr->tabArrayPtr = CkTextGetTabs(interp, textPtr->winPtr, + tagPtr->tabString); + if (tagPtr->tabArrayPtr == NULL) { + return TCL_ERROR; + } + } + if ((tagPtr->wrapMode != NULL) + && (tagPtr->wrapMode != ckTextCharUid) + && (tagPtr->wrapMode != ckTextNoneUid) + && (tagPtr->wrapMode != ckTextWordUid)) { + Tcl_AppendResult(interp, "bad wrap mode \"", tagPtr->wrapMode, + "\": must be char, none, or word", (char *) NULL); + tagPtr->wrapMode = NULL; + return TCL_ERROR; + } + + /* + * If the "sel" tag was changed, be sure to mirror information + * from the tag back into the text widget record. NOTE: we + * don't have to free up information in the widget record + * before overwriting it, because it was mirrored in the tag + * and hence freed when the tag field was overwritten. + */ + + if (tagPtr == textPtr->selTagPtr) { + textPtr->selBg = tagPtr->bg; + textPtr->selFg = tagPtr->fg; + textPtr->selAttr = tagPtr->attr; + } + tagPtr->affectsDisplay = 1; + CkTextRedrawTag(textPtr, (CkTextIndex *) NULL, + (CkTextIndex *) NULL, tagPtr, 1); + return result; + } + } else if ((c == 'd') && (strncmp(argv[2], "delete", length) == 0)) { + Tcl_HashEntry *hPtr; + + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag delete tagName tagName ...\"", + (char *) NULL); + return TCL_ERROR; + } + for (i = 3; i < argc; i++) { + hPtr = Tcl_FindHashEntry(&textPtr->tagTable, argv[i]); + if (hPtr == NULL) { + continue; + } + tagPtr = (CkTextTag *) Tcl_GetHashValue(hPtr); + if (tagPtr == textPtr->selTagPtr) { + continue; + } + if (tagPtr->affectsDisplay) { + CkTextRedrawTag(textPtr, (CkTextIndex *) NULL, + (CkTextIndex *) NULL, tagPtr, 1); + } +#if CK_USE_UTF + CkBTreeTag(CkTextMakeByteIndex(textPtr->tree, 0, 0, &first), + CkTextMakeByteIndex(textPtr->tree, + CkBTreeNumLines(textPtr->tree), 0, &last), + tagPtr, 0); +#else + CkBTreeTag(CkTextMakeIndex(textPtr->tree, 0, 0, &first), + CkTextMakeIndex(textPtr->tree, + CkBTreeNumLines(textPtr->tree), 0, &last), + tagPtr, 0); +#endif + Tcl_DeleteHashEntry(hPtr); + if (textPtr->bindingTable != NULL) { + Ck_DeleteAllBindings(textPtr->bindingTable, + (ClientData) tagPtr); + } + + /* + * Update the tag priorities to reflect the deletion of this tag. + */ + + ChangeTagPriority(textPtr, tagPtr, textPtr->numTags-1); + textPtr->numTags -= 1; + CkTextFreeTag(textPtr, tagPtr); + } + } else if ((c == 'l') && (strncmp(argv[2], "lower", length) == 0)) { + CkTextTag *tagPtr2; + int prio; + + if ((argc != 4) && (argc != 5)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag lower tagName ?belowThis?\"", + (char *) NULL); + return TCL_ERROR; + } + tagPtr = FindTag(interp, textPtr, argv[3]); + if (tagPtr == NULL) { + return TCL_ERROR; + } + if (argc == 5) { + tagPtr2 = FindTag(interp, textPtr, argv[4]); + if (tagPtr2 == NULL) { + return TCL_ERROR; + } + if (tagPtr->priority < tagPtr2->priority) { + prio = tagPtr2->priority - 1; + } else { + prio = tagPtr2->priority; + } + } else { + prio = 0; + } + ChangeTagPriority(textPtr, tagPtr, prio); + CkTextRedrawTag(textPtr, (CkTextIndex *) NULL, (CkTextIndex *) NULL, + tagPtr, 1); + } else if ((c == 'n') && (strncmp(argv[2], "names", length) == 0) + && (length >= 2)) { + CkTextTag **arrayPtr; + int arraySize; + + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag names ?index?\"", + (char *) NULL); + return TCL_ERROR; + } + if (argc == 3) { + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + + arrayPtr = (CkTextTag **) ckalloc((unsigned) + (textPtr->numTags * sizeof(CkTextTag *))); + for (i = 0, hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search); + hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { + arrayPtr[i] = (CkTextTag *) Tcl_GetHashValue(hPtr); + } + arraySize = textPtr->numTags; + } else { + if (CkTextGetIndex(interp, textPtr, argv[3], &index1) + != TCL_OK) { + return TCL_ERROR; + } + arrayPtr = CkBTreeGetTags(&index1, &arraySize); + if (arrayPtr == NULL) { + return TCL_OK; + } + } + SortTags(arraySize, arrayPtr); + for (i = 0; i < arraySize; i++) { + tagPtr = arrayPtr[i]; + Tcl_AppendElement(interp, tagPtr->name); + } + ckfree((char *) arrayPtr); + } else if ((c == 'n') && (strncmp(argv[2], "nextrange", length) == 0) + && (length >= 2)) { + CkTextSearch tSearch; + char position[TK_POS_CHARS]; + + if ((argc != 5) && (argc != 6)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag nextrange tagName index1 ?index2?\"", + (char *) NULL); + return TCL_ERROR; + } + tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]); + if (tagPtr == NULL) { + return TCL_OK; + } + if (CkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) { + return TCL_ERROR; + } +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, CkBTreeNumLines(textPtr->tree), + 0, &last); +#else + CkTextMakeIndex(textPtr->tree, CkBTreeNumLines(textPtr->tree), + 0, &last); +#endif + if (argc == 5) { + index2 = last; + } else if (CkTextGetIndex(interp, textPtr, argv[5], &index2) + != TCL_OK) { + return TCL_ERROR; + } + + /* + * The search below is a bit tricky. Rather than use the B-tree + * facilities to stop the search at index2, let it search up + * until the end of the file but check for a position past index2 + * ourselves. The reason for doing it this way is that we only + * care whether the *start* of the range is before index2; once + * we find the start, we don't want CkBTreeNextTag to abort the + * search because the end of the range is after index2. + */ + + CkBTreeStartSearch(&index1, &last, tagPtr, &tSearch); + if (CkBTreeCharTagged(&index1, tagPtr)) { + CkTextSegment *segPtr; + int offset; + + /* + * The first character is tagged. See if there is an + * on-toggle just before the character. If not, then + * skip to the end of this tagged range. + */ + + for (segPtr = index1.linePtr->segPtr, offset = index1.charIndex; + offset >= 0; + offset -= segPtr->size, segPtr = segPtr->nextPtr) { + if ((offset == 0) && (segPtr->typePtr == &ckTextToggleOnType) + && (segPtr->body.toggle.tagPtr == tagPtr)) { + goto gotStart; + } + } + if (!CkBTreeNextTag(&tSearch)) { + return TCL_OK; + } + } + + /* + * Find the start of the tagged range. + */ + + if (!CkBTreeNextTag(&tSearch)) { + return TCL_OK; + } + gotStart: + if (CkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) { + return TCL_OK; + } + CkTextPrintIndex(&tSearch.curIndex, position); + Tcl_AppendElement(interp, position); + CkBTreeNextTag(&tSearch); + CkTextPrintIndex(&tSearch.curIndex, position); + Tcl_AppendElement(interp, position); + } else if ((c == 'r') && (strncmp(argv[2], "raise", length) == 0) + && (length >= 3)) { + CkTextTag *tagPtr2; + int prio; + + if ((argc != 4) && (argc != 5)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag raise tagName ?aboveThis?\"", + (char *) NULL); + return TCL_ERROR; + } + tagPtr = FindTag(interp, textPtr, argv[3]); + if (tagPtr == NULL) { + return TCL_ERROR; + } + if (argc == 5) { + tagPtr2 = FindTag(interp, textPtr, argv[4]); + if (tagPtr2 == NULL) { + return TCL_ERROR; + } + if (tagPtr->priority <= tagPtr2->priority) { + prio = tagPtr2->priority; + } else { + prio = tagPtr2->priority + 1; + } + } else { + prio = textPtr->numTags-1; + } + ChangeTagPriority(textPtr, tagPtr, prio); + CkTextRedrawTag(textPtr, (CkTextIndex *) NULL, (CkTextIndex *) NULL, + tagPtr, 1); + } else if ((c == 'r') && (strncmp(argv[2], "ranges", length) == 0) + && (length >= 3)) { + CkTextSearch tSearch; + char position[TK_POS_CHARS]; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " tag ranges tagName\"", (char *) NULL); + return TCL_ERROR; + } + tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]); + if (tagPtr == NULL) { + return TCL_OK; + } +#if CK_USE_UTF + CkTextMakeByteIndex(textPtr->tree, 0, 0, &first); + CkTextMakeByteIndex(textPtr->tree, CkBTreeNumLines(textPtr->tree), + 0, &last); +#else + CkTextMakeIndex(textPtr->tree, 0, 0, &first); + CkTextMakeIndex(textPtr->tree, CkBTreeNumLines(textPtr->tree), + 0, &last); +#endif + CkBTreeStartSearch(&first, &last, tagPtr, &tSearch); + if (CkBTreeCharTagged(&first, tagPtr)) { + CkTextPrintIndex(&first, position); + Tcl_AppendElement(interp, position); + } + while (CkBTreeNextTag(&tSearch)) { + CkTextPrintIndex(&tSearch.curIndex, position); + Tcl_AppendElement(interp, position); + } + } else if ((c == 'r') && (strncmp(argv[2], "remove", length) == 0) + && (length >= 2)) { + fullOption = "remove"; + addTag = 0; + goto addAndRemove; + } else { + Tcl_AppendResult(interp, "bad tag option \"", argv[2], + "\": must be add, bind, cget, configure, delete, lower, ", + "names, nextrange, raise, ranges, or remove", + (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextCreateTag -- + * + * Find the record describing a tag within a given text widget, + * creating a new record if one doesn't already exist. + * + * Results: + * The return value is a pointer to the CkTextTag record for tagName. + * + * Side effects: + * A new tag record is created if there isn't one already defined + * for tagName. + * + *---------------------------------------------------------------------- + */ + +CkTextTag * +CkTextCreateTag(textPtr, tagName) + CkText *textPtr; /* Widget in which tag is being used. */ + char *tagName; /* Name of desired tag. */ +{ + register CkTextTag *tagPtr; + Tcl_HashEntry *hPtr; + int new; + + hPtr = Tcl_CreateHashEntry(&textPtr->tagTable, tagName, &new); + if (!new) { + return (CkTextTag *) Tcl_GetHashValue(hPtr); + } + + /* + * No existing entry. Create a new one, initialize it, and add a + * pointer to it to the hash table entry. + */ + + tagPtr = (CkTextTag *) ckalloc(sizeof(CkTextTag)); + tagPtr->name = Tcl_GetHashKey(&textPtr->tagTable, hPtr); + tagPtr->priority = textPtr->numTags; + tagPtr->bg = -1; + tagPtr->fg = -1; + tagPtr->attr = -1; + tagPtr->justifyString = NULL; + tagPtr->justify = CK_JUSTIFY_LEFT; + tagPtr->lMargin1String = NULL; + tagPtr->lMargin1 = 0; + tagPtr->lMargin2String = NULL; + tagPtr->lMargin2 = 0; + tagPtr->rMarginString = NULL; + tagPtr->rMargin = 0; + tagPtr->tabString = NULL; + tagPtr->tabArrayPtr = NULL; + tagPtr->wrapMode = NULL; + tagPtr->affectsDisplay = 0; + textPtr->numTags++; + Tcl_SetHashValue(hPtr, tagPtr); + return tagPtr; +} + +/* + *---------------------------------------------------------------------- + * + * FindTag -- + * + * See if tag is defined for a given widget. + * + * Results: + * If tagName is defined in textPtr, a pointer to its CkTextTag + * structure is returned. Otherwise NULL is returned and an + * error message is recorded in interp->result unless interp + * is NULL. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static CkTextTag * +FindTag(interp, textPtr, tagName) + Tcl_Interp *interp; /* Interpreter to use for error message; + * if NULL, then don't record an error + * message. */ + CkText *textPtr; /* Widget in which tag is being used. */ + char *tagName; /* Name of desired tag. */ +{ + Tcl_HashEntry *hPtr; + + hPtr = Tcl_FindHashEntry(&textPtr->tagTable, tagName); + if (hPtr != NULL) { + return (CkTextTag *) Tcl_GetHashValue(hPtr); + } + if (interp != NULL) { + Tcl_AppendResult(interp, "tag \"", tagName, + "\" isn't defined in text widget", (char *) NULL); + } + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * CkTextFreeTag -- + * + * This procedure is called when a tag is deleted to free up the + * memory and other resources associated with the tag. + * + * Results: + * None. + * + * Side effects: + * Memory and other resources are freed. + * + *---------------------------------------------------------------------- + */ + +void +CkTextFreeTag(textPtr, tagPtr) + CkText *textPtr; /* Info about overall widget. */ + register CkTextTag *tagPtr; /* Tag being deleted. */ +{ + if (tagPtr->justifyString != NULL) { + ckfree(tagPtr->justifyString); + } + if (tagPtr->lMargin1String != NULL) { + ckfree(tagPtr->lMargin1String); + } + if (tagPtr->lMargin2String != NULL) { + ckfree(tagPtr->lMargin2String); + } + if (tagPtr->rMarginString != NULL) { + ckfree(tagPtr->rMarginString); + } + if (tagPtr->tabString != NULL) { + ckfree(tagPtr->tabString); + } + if (tagPtr->tabArrayPtr != NULL) { + ckfree((char *) tagPtr->tabArrayPtr); + } + ckfree((char *) tagPtr); +} + +/* + *---------------------------------------------------------------------- + * + * SortTags -- + * + * This procedure sorts an array of tag pointers in increasing + * order of priority, optimizing for the common case where the + * array is small. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +SortTags(numTags, tagArrayPtr) + int numTags; /* Number of tag pointers at *tagArrayPtr. */ + CkTextTag **tagArrayPtr; /* Pointer to array of pointers. */ +{ + int i, j, prio; + register CkTextTag **tagPtrPtr; + CkTextTag **maxPtrPtr, *tmp; + + if (numTags < 2) { + return; + } + if (numTags < 20) { + for (i = numTags-1; i > 0; i--, tagArrayPtr++) { + maxPtrPtr = tagPtrPtr = tagArrayPtr; + prio = tagPtrPtr[0]->priority; + for (j = i, tagPtrPtr++; j > 0; j--, tagPtrPtr++) { + if (tagPtrPtr[0]->priority < prio) { + prio = tagPtrPtr[0]->priority; + maxPtrPtr = tagPtrPtr; + } + } + tmp = *maxPtrPtr; + *maxPtrPtr = *tagArrayPtr; + *tagArrayPtr = tmp; + } + } else { + qsort((VOID *) tagArrayPtr, (unsigned) numTags, sizeof (CkTextTag *), + TagSortProc); + } +} + +/* + *---------------------------------------------------------------------- + * + * TagSortProc -- + * + * This procedure is called by qsort when sorting an array of + * tags in priority order. + * + * Results: + * The return value is -1 if the first argument should be before + * the second element (i.e. it has lower priority), 0 if it's + * equivalent (this should never happen!), and 1 if it should be + * after the second element. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TagSortProc(first, second) + CONST VOID *first, *second; /* Elements to be compared. */ +{ + CkTextTag *tagPtr1, *tagPtr2; + + tagPtr1 = * (CkTextTag **) first; + tagPtr2 = * (CkTextTag **) second; + return tagPtr1->priority - tagPtr2->priority; +} + +/* + *---------------------------------------------------------------------- + * + * ChangeTagPriority -- + * + * This procedure changes the priority of a tag by modifying + * its priority and the priorities of other tags that are affected + * by the change. + * + * Results: + * None. + * + * Side effects: + * Priorities may be changed for some or all of the tags in + * textPtr. The tags will be arranged so that there is exactly + * one tag at each priority level between 0 and textPtr->numTags-1, + * with tagPtr at priority "prio". + * + *---------------------------------------------------------------------- + */ + +static void +ChangeTagPriority(textPtr, tagPtr, prio) + CkText *textPtr; /* Information about text widget. */ + CkTextTag *tagPtr; /* Tag whose priority is to be + * changed. */ + int prio; /* New priority for tag. */ +{ + int low, high, delta; + register CkTextTag *tagPtr2; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + + if (prio < 0) { + prio = 0; + } + if (prio >= textPtr->numTags) { + prio = textPtr->numTags-1; + } + if (prio == tagPtr->priority) { + return; + } else if (prio < tagPtr->priority) { + low = prio; + high = tagPtr->priority-1; + delta = 1; + } else { + low = tagPtr->priority+1; + high = prio; + delta = -1; + } + for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + tagPtr2 = (CkTextTag *) Tcl_GetHashValue(hPtr); + if ((tagPtr2->priority >= low) && (tagPtr2->priority <= high)) { + tagPtr2->priority += delta; + } + } + tagPtr->priority = prio; +} + +/* + *-------------------------------------------------------------- + * + * CkTextBindProc -- + * + * This procedure is invoked by the Ck 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). + * + *-------------------------------------------------------------- + */ + +void +CkTextBindProc(clientData, eventPtr) + ClientData clientData; /* Pointer to canvas structure. */ + CkEvent *eventPtr; /* Pointer to X event that just + * happened. */ +{ + CkText *textPtr = (CkText *) clientData; +} + +/* + *-------------------------------------------------------------- + * + * CkTextPickCurrent -- + * + * Find the character containing the coordinates in an event + * and place the "current" mark on that character. If the + * "current" mark has moved then generate a fake leave event + * on the old current character and a fake enter event on the new + * current character. + * + * Results: + * None. + * + * Side effects: + * The current mark for textPtr may change. If it does, + * then the commands associated with character entry and leave + * could do just about anything. + * + *-------------------------------------------------------------- + */ + +void +CkTextPickCurrent(textPtr, eventPtr) + register CkText *textPtr; /* Text widget in which to select + * current character. */ + CkEvent *eventPtr; /* Event describing location of + * mouse cursor. Must be EnterWindow, + * LeaveWindow, ButtonRelease, or + * MotionNotify. */ +{ +} diff --git a/ckTree.c b/ckTree.c new file mode 100644 index 0000000..f029086 --- /dev/null +++ b/ckTree.c @@ -0,0 +1,2170 @@ +/* + * ckTree.c -- + * + * This module implements a tree widget. + * + * Copyright (c) 1996 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" +#include "default.h" + +/* + * Widget defaults: + */ + +#define DEF_TREE_ACTIVE_ATTR_COLOR "normal" +#define DEF_TREE_ACTIVE_ATTR_MONO "reverse" +#define DEF_TREE_ACTIVE_BG_COLOR "white" +#define DEF_TREE_ACTIVE_BG_MONO "black" +#define DEF_TREE_ACTIVE_FG_COLOR "black" +#define DEF_TREE_ACTIVE_FG_MONO "white" +#define DEF_TREE_ATTR_COLOR "normal" +#define DEF_TREE_ATTR_MONO "normal" +#define DEF_TREE_BG_COLOR "black" +#define DEF_TREE_BG_MONO "black" +#define DEF_TREE_FG_COLOR "white" +#define DEF_TREE_FG_MONO "white" +#define DEF_TREE_HEIGHT "10" +#define DEF_TREE_SELECT_ATTR_COLOR "bold" +#define DEF_TREE_SELECT_ATTR_MONO "bold" +#define DEF_TREE_SELECT_BG_COLOR "black" +#define DEF_TREE_SELECT_BG_MONO "black" +#define DEF_TREE_SELECT_FG_COLOR "white" +#define DEF_TREE_SELECT_FG_MONO "white" +#define DEF_TREE_TAKE_FOCUS "1" +#define DEF_TREE_WIDTH "40" +#define DEF_TREE_SCROLL_COMMAND NULL + +/* + * A node in the tree is represented by this data structure. + */ + +#define TAG_SPACE 5 + +typedef struct Node { + int id; /* Unique id of the node. */ + int level; /* Level in tree, 0 means root. */ + struct Tree *tree; /* Pointer to widget. */ + struct Node *parent; /* Pointer to parent node or NULL. */ + struct Node *next; /* Pointer to next node in this level. */ + struct Node *firstChild, *lastChild; + Ck_Uid staticTagSpace[TAG_SPACE]; + Ck_Uid *tagPtr; /* Pointer to tag array. */ + int tagSpace; /* Total size of tag array. */ + int numTags; /* Number of tags in tag array. */ + int fg; /* Foreground color of node's text. */ + int bg; /* Background color of node's text. */ + int attr; /* Video attributes of node's text. */ + char *text; /* Text to display for this node. */ + int textWidth; /* Width of node's text. */ + int flags; /* Flag bits (see below). */ +} Node; + +/* + * Flag bits for node: + * + * SELECTED: Non-zero means node is selected + * SHOWCHILDREN: Non-zero means if node has children + * they shall be displayed. + */ + +#define SELECTED 1 +#define SHOWCHILDREN 2 + +/* + * Custom option for handling "-tags" options for tree nodes: + */ + +static int TreeTagsParseProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, CkWindow *winPtr, char *value, + char *widgRec, int offset)); +static char * TreeTagsPrintProc _ANSI_ARGS_((ClientData clientData, + CkWindow *winPtr, char *widgRec, int offset, + Tcl_FreeProc **freeProcPtr)); + +Ck_CustomOption treeTagsOption = { + TreeTagsParseProc, + TreeTagsPrintProc, + (ClientData) NULL +}; + +/* + * Information used for parsing configuration specs for nodes: + */ + +static Ck_ConfigSpec nodeConfigSpecs[] = { + {CK_CONFIG_ATTR, "-attributes", (char *) NULL, (char *) NULL, + "", Ck_Offset(Node, attr), CK_CONFIG_DONT_SET_DEFAULT }, + {CK_CONFIG_COLOR, "-background", (char *) NULL, (char *) NULL, + "", Ck_Offset(Node, bg), CK_CONFIG_DONT_SET_DEFAULT }, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL, + "", Ck_Offset(Node, fg), CK_CONFIG_DONT_SET_DEFAULT}, + {CK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, + (char *) NULL, 0, CK_CONFIG_NULL_OK, &treeTagsOption}, + {CK_CONFIG_STRING, "-text", (char *) NULL, (char *) NULL, + NULL, Ck_Offset(Node, text), CK_CONFIG_NULL_OK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * A data structure of the following type is kept for each + * widget managed by this file: + */ + +typedef struct Tree { + CkWindow *winPtr; /* Window that embodies the widget. NULL + * means that the window has been destroyed + * but the data structures haven't yet been + * cleaned up.*/ + Tcl_Interp *interp; /* Interpreter associated with menubutton. */ + Tcl_Command widgetCmd; /* Token for menubutton's widget command. */ + + int idCount; /* For unique ids for nodes. */ + + /* + * Information about what's displayed in the menu button: + */ + + Node *firstChild, *lastChild; + Tcl_HashTable nodeTable; + + /* + * Information used when displaying widget: + */ + + int normalFg; /* Foreground color in normal mode. */ + int normalBg; /* Background color in normal mode. */ + int normalAttr; /* Attributes in normal mode. */ + int activeFg; /* Foreground color in active mode. */ + int activeBg; /* Ditto, background color. */ + int activeAttr; /* Attributes in active mode. */ + int selectFg; /* Foreground color for selected nodes. */ + int selectBg; /* Ditto, background color. */ + int selectAttr; /* Attributes for selected nodes. */ + + int width, height; /* If > 0, these specify dimensions to request + * for window, in characters for text and in + * pixels for bitmaps. In this case the actual + * size of the text string or bitmap is + * ignored in computing desired window size. */ + + int visibleNodes; /* Total number of visible nodes. */ + int topIndex; /* Index of starting line. */ + Node *topNode; /* Node at top line of window. */ + Node *activeNode; /* Node which has active tag or NULL. */ + + int leadingSpace; /* For displaying: size of leadingString. */ + int *leadingString; /* Malloc'ed leading vertical lines for + * displaying. */ + + /* + * Miscellaneous information: + */ + + char *takeFocus; /* Value of -takefocus option; not used in + * the C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ + char *yScrollCmd; /* Command prefix for communicating with + * vertical scrollbar. NULL means no command + * to issue. Malloc'ed. */ + char *xScrollCmd; /* Command prefix for communicating with + * horizontal scrollbar. NULL means no command + * to issue. Malloc'ed. */ + int flags; /* Various flags; see below for + * definitions. */ +} Tree; + +/* + * Flag bits for entire tree: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler + * has already been queued to redraw + * this window. + * GOT_FOCUS: Non-zero means this button currently + * has the input focus. + * UPDATE_V_SCROLLBAR: Non-zero means vertical scrollbar needs + * to be updated. + * UPDATE_H_SCROLLBAR: Non-zero means horizontal scrollbar needs + * to be updated. + */ + +#define REDRAW_PENDING 1 +#define GOT_FOCUS 2 +#define UPDATE_V_SCROLLBAR 4 +#define UPDATE_H_SCROLLBAR 4 + +/* + * Information used for parsing configuration specs: + */ + +static Ck_ConfigSpec configSpecs[] = { + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_TREE_ACTIVE_ATTR_COLOR, + Ck_Offset(Tree, activeAttr), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-activeattributes", "activeAttributes", + "ActiveAttributes", DEF_TREE_ACTIVE_ATTR_MONO, + Ck_Offset(Tree, activeAttr), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_TREE_ATTR_COLOR, Ck_Offset(Tree, normalAttr), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-attributes", "attributes", "Attributes", + DEF_TREE_ATTR_MONO, Ck_Offset(Tree, normalAttr), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_TREE_ACTIVE_BG_COLOR, Ck_Offset(Tree, activeBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activebackground", "activeBackground", "Foreground", + DEF_TREE_ACTIVE_BG_MONO, Ck_Offset(Tree, activeBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_TREE_ACTIVE_FG_COLOR, Ck_Offset(Tree, activeFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_TREE_ACTIVE_FG_MONO, Ck_Offset(Tree, activeFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_TREE_BG_COLOR, Ck_Offset(Tree, normalBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-background", "background", "Background", + DEF_TREE_BG_MONO, Ck_Offset(Tree, normalBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, 0}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_TREE_FG_COLOR, Ck_Offset(Tree, normalFg), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", + DEF_TREE_FG_MONO, Ck_Offset(Tree, normalFg), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COORD, "-height", "height", "Height", + DEF_TREE_HEIGHT, Ck_Offset(Tree, height), 0}, + {CK_CONFIG_ATTR, "-selectattributes", "selectAttributes", + "SelectAttributes", DEF_TREE_SELECT_ATTR_COLOR, + Ck_Offset(Tree, selectAttr), CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_ATTR, "-selectattributes", "selectAttributes", + "SelectAttributes", DEF_TREE_SELECT_ATTR_MONO, + Ck_Offset(Tree, selectAttr), CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-selectbackground", "selectBackground", "Foreground", + DEF_TREE_SELECT_BG_COLOR, Ck_Offset(Tree, selectBg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectbackground", "selectBackground", "Foreground", + DEF_TREE_SELECT_BG_MONO, Ck_Offset(Tree, selectBg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_TREE_SELECT_FG_COLOR, Ck_Offset(Tree, selectFg), + CK_CONFIG_COLOR_ONLY}, + {CK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_TREE_SELECT_FG_MONO, Ck_Offset(Tree, selectFg), + CK_CONFIG_MONO_ONLY}, + {CK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_TREE_TAKE_FOCUS, Ck_Offset(Tree, takeFocus), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_COORD, "-width", "width", "Width", + DEF_TREE_WIDTH, Ck_Offset(Tree, width), 0}, + {CK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", + DEF_TREE_SCROLL_COMMAND, Ck_Offset(Tree, xScrollCmd), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", + DEF_TREE_SCROLL_COMMAND, Ck_Offset(Tree, yScrollCmd), + CK_CONFIG_NULL_OK}, + {CK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * The structure defined below is used to keep track of a tag search + * in progress. Only the "prevPtr" field should be accessed by anyone + * other than StartTagSearch and NextNode. + */ + +typedef struct TagSearch { + Tree *treePtr; /* Tree widget being searched. */ + Tcl_HashSearch search; /* Hash search for nodeTable. */ + Ck_Uid tag; /* Tag to search for. 0 means return + * all nodes. */ + int searchOver; /* Non-zero means NextNode should always + * return NULL. */ +} TagSearch; + +static Ck_Uid allUid = NULL; +static Ck_Uid hideChildrenUid = NULL; +static Ck_Uid activeUid = NULL; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static Node * StartTagSearch _ANSI_ARGS_((Tree *treePtr, + char *tag, TagSearch *searchPtr)); +static Node * NextNode _ANSI_ARGS_((TagSearch *searchPtr)); +static void DoNode _ANSI_ARGS_((Tcl_Interp *interp, + Node *nodePtr, Ck_Uid tag)); +static void TreeCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static void TreeEventProc _ANSI_ARGS_((ClientData clientData, + CkEvent *eventPtr)); +static int TreeWidgetCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int ConfigureTree _ANSI_ARGS_((Tcl_Interp *interp, + Tree *treePtr, int argc, char **argv, + int flags)); +static void DestroyTree _ANSI_ARGS_((ClientData clientData)); +static void DisplayTree _ANSI_ARGS_((ClientData clientData)); +static void TreeEventuallyRedraw _ANSI_ARGS_((Tree *treePtr)); +static int FindNodes _ANSI_ARGS_((Tcl_Interp *interp, + Tree *treePtr, int argc, char **argv, + char *newTag, char *cmdName, char *option)); +static void DeleteNode _ANSI_ARGS_((Tree *treePtr, Node *nodePtr)); +static void RecomputeVisibleNodes _ANSI_ARGS_((Tree *treePtr)); +static void ChangeTreeView _ANSI_ARGS_((Tree *treePtr, int index)); +static void TreeUpdateVScrollbar _ANSI_ARGS_((Tree *treePtr)); +static int GetNodeYCoord _ANSI_ARGS_((Tree *treePtr, + Node *thisPtr, int *yPtr)); + +/* + *-------------------------------------------------------------- + * + * Ck_TreeCmd -- + * + * This procedure is invoked to process the "tree" + * Tcl commands. See the user documentation for details + * on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +int +Ck_TreeCmd(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. */ +{ + Tree *treePtr; + CkWindow *mainPtr = (CkWindow *) clientData; + CkWindow *new; + + allUid = Ck_GetUid("all"); + hideChildrenUid = Ck_GetUid("hidechildren"); + activeUid = Ck_GetUid("active"); + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " pathName ?options?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Create the new window. + */ + + new = Ck_CreateWindowFromPath(interp, mainPtr, argv[1], 0); + if (new == NULL) { + return TCL_ERROR; + } + + /* + * Initialize the data structure for the button. + */ + + treePtr = (Tree *) ckalloc(sizeof (Tree)); + treePtr->winPtr = new; + treePtr->interp = interp; + treePtr->widgetCmd = Tcl_CreateCommand(interp, treePtr->winPtr->pathName, + TreeWidgetCmd, (ClientData) treePtr, TreeCmdDeletedProc); + treePtr->idCount = 0; + treePtr->firstChild = treePtr->lastChild = NULL; + Tcl_InitHashTable(&treePtr->nodeTable, TCL_ONE_WORD_KEYS); + treePtr->normalBg = 0; + treePtr->normalFg = 0; + treePtr->normalAttr = 0; + treePtr->activeBg = 0; + treePtr->activeFg = 0; + treePtr->activeAttr = 0; + treePtr->selectBg = 0; + treePtr->selectFg = 0; + treePtr->selectAttr = 0; + treePtr->width = 0; + treePtr->height = 0; + treePtr->visibleNodes = 0; + treePtr->topIndex = 0; + treePtr->topNode = NULL; + treePtr->activeNode = NULL; + treePtr->leadingSpace = 0; + treePtr->leadingString = NULL; + treePtr->takeFocus = NULL; + treePtr->xScrollCmd = NULL; + treePtr->yScrollCmd = NULL; + treePtr->flags = 0; + + Ck_SetClass(treePtr->winPtr, "Tree"); + Ck_CreateEventHandler(treePtr->winPtr, + CK_EV_EXPOSE | CK_EV_MAP | CK_EV_DESTROY | + CK_EV_FOCUSIN | CK_EV_FOCUSOUT, TreeEventProc, (ClientData) treePtr); + if (ConfigureTree(interp, treePtr, argc-2, argv+2, 0) != TCL_OK) { + Ck_DestroyWindow(treePtr->winPtr); + return TCL_ERROR; + } + + interp->result = treePtr->winPtr->pathName; + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * TreeWidgetCmd -- + * + * 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. + * + *-------------------------------------------------------------- + */ + +static int +TreeWidgetCmd(clientData, interp, argc, argv) + ClientData clientData; /* Information about button widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + Tree *treePtr = (Tree *) clientData; + int result = TCL_OK, redraw = 0, recompute = 0; + size_t length; + int c; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + Ck_Preserve((ClientData) treePtr); + 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 = FindNodes(interp, treePtr, argc-3, argv+3, argv[2], argv[0], + " addtag tag"); + } 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 = Ck_ConfigureValue(interp, treePtr->winPtr, configSpecs, + (char *) treePtr, argv[2], 0); + } else if ((c == 'c') && (strncmp(argv[1], "children", length) == 0) + && (length >= 2)) { + Node *nodePtr = NULL; + TagSearch search; + + if (argc > 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " children ?tagOrId?\"", + (char *) NULL); + goto error; + } + if (argc > 2) { + nodePtr = StartTagSearch(treePtr, argv[2], &search); + if (nodePtr == NULL) + goto error; + } + if (nodePtr == NULL) + nodePtr = treePtr->firstChild; + else + nodePtr = nodePtr->firstChild; + while (nodePtr != NULL) { + DoNode(interp, nodePtr, (Ck_Uid) NULL); + nodePtr = nodePtr->next; + } + result = TCL_OK; + } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) + && (length >= 2)) { + if (argc == 2) { + result = Ck_ConfigureInfo(interp, treePtr->winPtr, configSpecs, + (char *) treePtr, (char *) NULL, 0); + } else if (argc == 3) { + result = Ck_ConfigureInfo(interp, treePtr->winPtr, configSpecs, + (char *) treePtr, argv[2], 0); + } else { + result = ConfigureTree(interp, treePtr, argc-2, argv+2, + CK_CONFIG_ARGV_ONLY); + } + } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0) + && (length >= 2)) { + int i; + + for (i = 2; i < argc; i++) { + for (;;) { + Node *nodePtr; + TagSearch search; + + nodePtr = StartTagSearch(treePtr, argv[i], &search); + if (nodePtr == NULL) + break; + DeleteNode(treePtr, nodePtr); + recompute++; + } + } + if (recompute) + redraw++; + } else if ((c == 'd') && (strncmp(argv[1], "dtag", length) == 0) + && (length >= 2)) { + Ck_Uid tag; + int i; + Node *nodePtr; + TagSearch search; + + 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 = Ck_GetUid(argv[3]); + } else { + tag = Ck_GetUid(argv[2]); + } + for (nodePtr = StartTagSearch(treePtr, argv[2], &search); + nodePtr != NULL; nodePtr = NextNode(&search)) { + for (i = nodePtr->numTags-1; i >= 0; i--) { + if (nodePtr->tagPtr[i] == tag) { + nodePtr->tagPtr[i] = nodePtr->tagPtr[nodePtr->numTags-1]; + nodePtr->numTags--; + if (tag == activeUid) + redraw++; + else if (tag == hideChildrenUid) { + if (!(nodePtr->flags & SHOWCHILDREN)) { + nodePtr->flags |= SHOWCHILDREN; + recompute++; + redraw++; + } + } + } + } + } + } 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 = FindNodes(interp, treePtr, argc - 2, argv + 2, (char *) NULL, + argv[0], " find"); + } else if ((c == 'g') && (strncmp(argv[1], "gettags", length) == 0)) { + Node *nodePtr; + TagSearch search; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " gettags tagOrId\"", (char *) NULL); + goto error; + } + nodePtr = StartTagSearch(treePtr, argv[2], &search); + if (nodePtr != NULL) { + int i; + + for (i = 0; i < nodePtr->numTags; i++) { + Tcl_AppendElement(interp, (char *) nodePtr->tagPtr[i]); + } + } + } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)) { + int optargc = 2, id; + Node *nodePtr = NULL, *new; + char *end; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " insert ?id? ?option value ...?\"", + (char *) NULL); + goto error; + } + id = strtoul(argv[2], &end, 0); + if (*end == 0) { + if (end != argv[2]) { + Tcl_HashEntry *hPtr; + + hPtr = Tcl_FindHashEntry(&treePtr->nodeTable, (char *) id); + if (hPtr == NULL) { + Tcl_AppendResult(interp, "no node with id \"", argv[2], + "\"", (char *) NULL); + goto error; + } + nodePtr = (Node *) Tcl_GetHashValue(hPtr); + } + optargc = 3; + } + + new = (Node *) ckalloc (sizeof (Node)); + new->id = treePtr->idCount++; + new->level = nodePtr == NULL ? 0 : nodePtr->level + 1; + new->tree = treePtr; + new->parent = nodePtr; + new->next = NULL; + new->firstChild = new->lastChild = NULL; + new->tagPtr = new->staticTagSpace; + new->tagSpace = TAG_SPACE; + new->numTags = 0; + new->fg = new->bg = new->attr = -1; + new->text = NULL; + new->textWidth = 0; + new->flags = SHOWCHILDREN; + + if (new->level * 2 > treePtr->leadingSpace) { + int *newString; + + treePtr->leadingSpace = new->level * 8; + newString = (int *) ckalloc(treePtr->leadingSpace * sizeof (int)); + if (treePtr->leadingString != NULL) + ckfree((char *) treePtr->leadingString); + treePtr->leadingString = newString; + } + + result = Ck_ConfigureWidget(interp, treePtr->winPtr, + nodeConfigSpecs, argc - optargc, &argv[optargc], + (char *) new, CK_CONFIG_ARGV_ONLY); + + if (result == TCL_OK) { + Tcl_HashEntry *hPtr; + int newHash; + char buf[32]; + + hPtr = Tcl_CreateHashEntry(&treePtr->nodeTable, + (char *) new->id, &newHash); + Tcl_SetHashValue(hPtr, (ClientData) new); + if (new->parent == NULL) { + new->level = 0; + if (treePtr->lastChild == NULL) + treePtr->firstChild = new; + else + treePtr->lastChild->next = new; + treePtr->lastChild = new; + } else { + new->level = nodePtr->level + 1; + if (nodePtr->lastChild == NULL) + nodePtr->firstChild = new; + else + nodePtr->lastChild->next = new; + nodePtr->lastChild = new; + } + recompute++; + redraw++; + sprintf(buf, "%d", new->id); + Tcl_AppendResult(interp, buf, (char *) NULL); + } else { + ckfree((char *) new); + } + } else if ((c == 'n') && (strncmp(argv[1], "nodecget", length) == 0) + && (length >= 6)) { + Node *nodePtr; + TagSearch search; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " nodecget tagOrId option\"", + (char *) NULL); + return TCL_ERROR; + } + nodePtr = StartTagSearch(treePtr, argv[2], &search); + if (nodePtr != NULL) { + result = Ck_ConfigureValue(treePtr->interp, treePtr->winPtr, + nodeConfigSpecs, (char *) nodePtr, + argv[3], 0); + } + } else if ((c == 'n') && (strncmp(argv[1], "nodeconfigure", length) == 0) + && (length >= 6)) { + Node *nodePtr; + TagSearch search; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " nodeconfigure tagOrId ?option value ...?\"", + (char *) NULL); + goto error; + } + for (nodePtr = StartTagSearch(treePtr, argv[2], &search); + nodePtr != NULL; nodePtr = NextNode(&search)) { + if (argc == 3) { + result = Ck_ConfigureInfo(treePtr->interp, treePtr->winPtr, + nodeConfigSpecs, (char *) nodePtr, + (char *) NULL, 0); + } else if (argc == 4) { + result = Ck_ConfigureInfo(treePtr->interp, treePtr->winPtr, + nodeConfigSpecs, (char *) nodePtr, + argv[3], 0); + } else { + result = Ck_ConfigureWidget(interp, treePtr->winPtr, + nodeConfigSpecs, argc - 3, &argv[3], + (char *) nodePtr, CK_CONFIG_ARGV_ONLY); + redraw++; + } + if ((result != TCL_OK) || (argc < 5)) { + break; + } + } + } else if ((c == 'p') && (strncmp(argv[1], "parent", length) == 0) + && (length >= 2)) { + Node *nodePtr; + TagSearch search; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " parent tagOrId\"", + (char *) NULL); + goto error; + } + nodePtr = StartTagSearch(treePtr, argv[2], &search); + if (nodePtr == NULL) + goto error; + if (nodePtr->parent != NULL) + DoNode(interp, nodePtr->parent, (Ck_Uid) NULL); + result = TCL_OK; + } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0) + && (length >= 2)) { + Node *nodePtr; + TagSearch search; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " select option tagOrId\"", (char *) NULL); + goto error; + } + nodePtr = StartTagSearch(treePtr, argv[3], &search); + if (nodePtr == NULL) { + Tcl_AppendResult(interp, "can't find a selectable node \"", + argv[3], "\"", (char *) NULL); + goto error; + } + length = strlen(argv[2]); + c = argv[2][0]; + if ((c == 'c') && (argv[2] != NULL) && + (strncmp(argv[2], "clear", length) == 0)) { + do { + nodePtr->flags &= ~SELECTED; + nodePtr = NextNode(&search); + redraw++; + } while (nodePtr != NULL); + } else if ((c == 'i') && (strncmp(argv[2], "includes", length) == 0)) { + interp->result = (nodePtr->flags & SELECTED) ? "1" : "0"; + } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) { + do { + nodePtr->flags |= SELECTED; + nodePtr = NextNode(&search); + redraw++; + } while (nodePtr != NULL); + } else { + Tcl_AppendResult(interp, "bad select option \"", argv[2], + "\": must be clear, includes, or set", (char *) NULL); + goto error; + } + } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { + int type, count; + double fraction; + + if (argc == 2) { + } else { + type = Ck_GetScrollInfo(interp, argc, argv, &fraction, &count); + switch (type) { + case CK_SCROLL_ERROR: + goto error; + case CK_SCROLL_MOVETO: + break; + case CK_SCROLL_PAGES: + break; + case CK_SCROLL_UNITS: + break; + } + } + } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) { + int type, count, index; + double fraction; + + if (argc == 2) { + if (treePtr->visibleNodes == 0) { + interp->result = "0 1"; + } else { + double fraction2; + + fraction = treePtr->topIndex / (double) treePtr->visibleNodes; + fraction2 = (treePtr->topIndex + treePtr->winPtr->height) / + (double) treePtr->visibleNodes; + if (fraction2 > 1.0) { + fraction2 = 1.0; + } + sprintf(interp->result, "%g %g", fraction, fraction2); + } + } else if (argc == 3) { + Node *nodePtr; + TagSearch search; + + nodePtr = StartTagSearch(treePtr, argv[2], &search); + if (nodePtr == NULL) { + Tcl_AppendResult(interp, "can't find a selectable node \"", + argv[3], "\"", (char *) NULL); + goto error; + } + if (GetNodeYCoord(treePtr, nodePtr, &index) == TCL_OK) { + if (index < treePtr->topIndex || + index >= treePtr->topIndex + treePtr->winPtr->height) + ChangeTreeView(treePtr, + index - treePtr->winPtr->height / 2); + } + } else { + type = Ck_GetScrollInfo(interp, argc, argv, &fraction, &count); + switch (type) { + case CK_SCROLL_ERROR: + goto error; + case CK_SCROLL_MOVETO: + index = (int) (treePtr->visibleNodes * fraction + 0.5); + break; + case CK_SCROLL_PAGES: + if (treePtr->visibleNodes > 2) { + index = treePtr->topIndex + + count * (treePtr->winPtr->height - 2); + } else { + index = treePtr->topIndex + count; + } + break; + case CK_SCROLL_UNITS: + index = treePtr->topIndex + count; + break; + } + ChangeTreeView(treePtr, index); + } + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be cget or configure", + (char *) NULL); + goto error; + } + if (recompute) + RecomputeVisibleNodes(treePtr); + if (redraw) + TreeEventuallyRedraw(treePtr); + + Ck_Release((ClientData) treePtr); + return result; + +error: + Ck_Release((ClientData) treePtr); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyTree -- + * + * This procedure is invoked to recycle all of the resources + * associated with a tree widget. It is invoked as a + * when-idle handler in order to make sure that there is no + * other use of the tree pending at the time of the deletion. + * + * Results: + * None. + * + * Side effects: + * Everything associated with the widget is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyTree(clientData) + ClientData clientData; /* Info about tree widget. */ +{ + Tree *treePtr = (Tree *) clientData; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Node *nodePtr; + + /* + * Free up all the stuff that requires special handling, then + * let Ck_FreeOptions handle all the standard option-related + * stuff. + */ + + if (treePtr->leadingString != NULL) { + ckfree((char *) treePtr->leadingString); + treePtr->leadingString = NULL; + } + + hPtr = Tcl_FirstHashEntry(&treePtr->nodeTable, &search); + while (hPtr != NULL) { + nodePtr = (Node *) Tcl_GetHashValue(hPtr); + Ck_FreeOptions(nodeConfigSpecs, (char *) nodePtr, 0); + if (nodePtr->tagPtr != nodePtr->staticTagSpace) + ckfree((char *) nodePtr->tagPtr); + ckfree((char *) nodePtr); + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&treePtr->nodeTable); + + Ck_FreeOptions(configSpecs, (char *) treePtr, 0); + ckfree((char *) treePtr); +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureTree -- + * + * This procedure is called to process an argv/argc list, plus + * the option database, in order to configure (or + * reconfigure) a tree widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then interp->result contains an error message. + * + * Side effects: + * Configuration information, such as text string, colors, font, + * etc. get set for treePtr; old resources get freed, if there + * were any. The tree is redisplayed. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureTree(interp, treePtr, argc, argv, flags) + Tcl_Interp *interp; /* Used for error reporting. */ + Tree *treePtr; /* 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 Ck_ConfigureWidget. */ +{ + int result, width, height; + + result = Ck_ConfigureWidget(interp, treePtr->winPtr, configSpecs, + argc, argv, (char *) treePtr, flags); + if (result != TCL_OK) + return TCL_ERROR; + width = treePtr->width; + if (width <= 0) + width = 1; + height = treePtr->height; + if (height <= 0) + height = 1; + Ck_GeometryRequest(treePtr->winPtr, width, height); + TreeEventuallyRedraw(treePtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TreeEventuallyRedraw -- + * + * This procedure is called to dispatch a do-when-idle + * handler for redrawing the tree. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +TreeEventuallyRedraw(treePtr) + Tree *treePtr; +{ + if ((treePtr->winPtr->flags & CK_MAPPED) + && !(treePtr->flags & REDRAW_PENDING)) { + Tk_DoWhenIdle(DisplayTree, (ClientData) treePtr); + treePtr->flags |= REDRAW_PENDING; + } +} + +/* + *---------------------------------------------------------------------- + * + * DeleteNode -- + * + * This procedure is called to delete a node and its children. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteNode(treePtr, nodePtr) + Tree *treePtr; + Node *nodePtr; +{ + Node *childPtr, *thisPtr, *prevPtr; + Tcl_HashEntry *hPtr; + + while ((childPtr = nodePtr->firstChild) != NULL) + DeleteNode(treePtr, childPtr); + + if (treePtr->topNode == nodePtr) + treePtr->topNode = nodePtr->parent; + if (treePtr->activeNode == nodePtr) + treePtr->activeNode = NULL; + + prevPtr = NULL; + if (nodePtr->parent == NULL) { + thisPtr = treePtr->firstChild; + } else { + thisPtr = nodePtr->parent->firstChild; + } + for (; thisPtr != NULL; prevPtr = thisPtr, thisPtr = thisPtr->next) { + if (thisPtr == nodePtr) { + if (prevPtr == NULL) { + if (nodePtr->parent == NULL) + treePtr->firstChild = nodePtr->next; + else + nodePtr->parent->firstChild = nodePtr->next; + } else + prevPtr->next = nodePtr->next; + if (nodePtr->next == NULL) { + if (nodePtr->parent == NULL) + treePtr->lastChild = prevPtr; + else + nodePtr->parent->lastChild = prevPtr; + } + break; + } + } + + hPtr = Tcl_FindHashEntry(&treePtr->nodeTable, (char *) nodePtr->id); + Tcl_DeleteHashEntry(hPtr); + Ck_FreeOptions(nodeConfigSpecs, (char *) nodePtr, 0); + if (nodePtr->tagPtr != nodePtr->staticTagSpace) + ckfree((char *) nodePtr->tagPtr); + ckfree((char *) nodePtr); +} + + +static void +DeleteActiveTag(treePtr) + Tree *treePtr; +{ + int i; + Node *nodePtr = treePtr->activeNode; + + if (nodePtr == NULL) + return; + + for (i = nodePtr->numTags-1; i >= 0; i--) { + if (nodePtr->tagPtr[i] == activeUid) { + nodePtr->tagPtr[i] = nodePtr->tagPtr[nodePtr->numTags-1]; + nodePtr->numTags--; + } + } + treePtr->activeNode = NULL; +} + + +/* + *---------------------------------------------------------------------- + * + * DisplayTree -- + * + * This procedure is invoked to display a tree widget. + * + * Results: + * None. + * + * Side effects: + * Commands are output to X to display the tree. + * + *---------------------------------------------------------------------- + */ + +static void +DisplayTree(clientData) + ClientData clientData; /* Information about widget. */ +{ + Tree *treePtr = (Tree *) clientData; + CkWindow *winPtr = treePtr->winPtr; + Node *nodePtr, *nextPtr, *parentPtr; + int i, x, y, mustRestore, rarrow; + int ulcorner, urcorner, llcorner, lrcorner, lvline, lhline, ltee, ttee; + WINDOW *window; + + treePtr->flags &= ~REDRAW_PENDING; + if ((treePtr->winPtr == NULL) || !(winPtr->flags & CK_MAPPED)) { + return; + } + if (treePtr->flags & UPDATE_V_SCROLLBAR) { + TreeUpdateVScrollbar(treePtr); + } + treePtr->flags &= ~(REDRAW_PENDING|UPDATE_H_SCROLLBAR|UPDATE_V_SCROLLBAR); + + if (treePtr->firstChild == NULL) { + Ck_ClearToBot(winPtr, 0, 0); + Ck_EventuallyRefresh(winPtr); + return; + } + + Ck_GetGChar(NULL, "rarrow", &rarrow); + Ck_GetGChar(NULL, "ulcorner", &ulcorner); + Ck_GetGChar(NULL, "urcorner", &urcorner); + Ck_GetGChar(NULL, "llcorner", &llcorner); + Ck_GetGChar(NULL, "lrcorner", &lrcorner); + Ck_GetGChar(NULL, "vline", &lvline); + Ck_GetGChar(NULL, "hline", &lhline); + Ck_GetGChar(NULL, "ltee", <ee); + Ck_GetGChar(NULL, "ttee", &ttee); + + Ck_SetWindowAttr(winPtr, treePtr->normalFg, treePtr->normalBg, + treePtr->normalAttr); + + nodePtr = treePtr->topNode; + + i = nodePtr->level * 2 - 1; + nextPtr = nodePtr->parent; + while (i >= 0) { + treePtr->leadingString[i] = ' '; + parentPtr = nextPtr->parent; + if (parentPtr != NULL) { + if (parentPtr->lastChild == nextPtr) + treePtr->leadingString[i - 1] = ' '; + else + treePtr->leadingString[i - 1] = lvline; + } else if (treePtr->lastChild == nextPtr) + treePtr->leadingString[i - 1] = ' '; + else + treePtr->leadingString[i - 1] = lvline; + nextPtr = parentPtr; + i -= 2; + } + + window = winPtr->window; + y = 0; + while (nodePtr != NULL && y < winPtr->height) { + x = mustRestore = 0; + wmove(window, y, x); + if (nodePtr == treePtr->firstChild) { + waddch(window, (nodePtr == treePtr->lastChild) ? lhline : ulcorner); + x++; + } else if (nodePtr == treePtr->lastChild) { + waddch(window, llcorner); + x++; + } else if (nodePtr->level == 0) { + waddch(window, ltee); + x++; + } + for (i = 0; i < nodePtr->level * 2 && x < winPtr->width; i++) { + waddch(window, treePtr->leadingString[i]); + x++; + } + if (nodePtr->parent != NULL) { + if (x < winPtr->width) { + if (nodePtr == nodePtr->parent->lastChild) + waddch(window, llcorner); + else + waddch(window, ltee); + x++; + } + } + if (x < winPtr->width) { + waddch(window, lhline); + x++; + } + if (nodePtr->firstChild != NULL && (nodePtr->flags & SHOWCHILDREN)) { + if (x < winPtr->width) { + waddch(window, ttee); + x++; + } + nextPtr = nodePtr->firstChild; + } else { + if (x < winPtr->width) { + waddch(window, (nodePtr->firstChild == NULL) ? lhline : rarrow); + x++; + } + nextPtr = nodePtr->next; + if (nextPtr == NULL) { + parentPtr = nodePtr->parent; + while (nextPtr == NULL) { + if (parentPtr == NULL) { + break; + } + nextPtr = parentPtr->next; + if (nextPtr == NULL) { + parentPtr = parentPtr->parent; + } + } + } + } + if (x < winPtr->width) { + waddch(window, ' '); + x++; + } + + if (nodePtr == treePtr->activeNode && (treePtr->flags & GOT_FOCUS)) { + Ck_SetWindowAttr(winPtr, treePtr->activeFg, treePtr->activeBg, + treePtr->activeAttr | ((nodePtr->flags & SELECTED) ? + treePtr->selectAttr : 0)); + mustRestore = 1; + } else if (nodePtr->flags & SELECTED) { + Ck_SetWindowAttr(winPtr, treePtr->selectFg, treePtr->selectBg, + treePtr->selectAttr); + mustRestore = 1; + } + CkDisplayChars(winPtr->mainPtr, window, + nodePtr->text, strlen(nodePtr->text), + x, y, 0, + CK_NEWLINES_NOT_SPECIAL | CK_IGNORE_TABS); + if (mustRestore) + Ck_SetWindowAttr(winPtr, treePtr->normalFg, treePtr->normalBg, + treePtr->normalAttr); + Ck_ClearToEol(winPtr, -1, -1); + + i = nodePtr->level * 2; + treePtr->leadingString[i] = nodePtr->next != NULL ? lvline : ' '; + treePtr->leadingString[i + 1] = ' '; + + nodePtr = nextPtr; + y++; + } + if (y < winPtr->height) + Ck_ClearToBot(winPtr, 0, y); + Ck_EventuallyRefresh(winPtr); +} + +/* + *-------------------------------------------------------------- + * + * TreeEventProc -- + * + * This procedure is invoked by the dispatcher for various + * events on trees. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +TreeEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + CkEvent *eventPtr; /* Information about event. */ +{ + Tree *treePtr = (Tree *) clientData; + + if (eventPtr->type == CK_EV_EXPOSE) { + TreeEventuallyRedraw(treePtr); + } else if (eventPtr->type == CK_EV_DESTROY) { + if (treePtr->winPtr != NULL) { + treePtr->winPtr = NULL; + Tcl_DeleteCommand(treePtr->interp, + Tcl_GetCommandName(treePtr->interp, treePtr->widgetCmd)); + } + if (treePtr->flags & REDRAW_PENDING) { + Tk_CancelIdleCall(DisplayTree, (ClientData) treePtr); + } + Ck_EventuallyFree((ClientData) treePtr, (Ck_FreeProc *) DestroyTree); + } else if (eventPtr->type == CK_EV_FOCUSIN) { + treePtr->flags |= GOT_FOCUS; + TreeEventuallyRedraw(treePtr); + } else if (eventPtr->type == CK_EV_FOCUSOUT) { + treePtr->flags &= ~GOT_FOCUS; + TreeEventuallyRedraw(treePtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * TreeCmdDeletedProc -- + * + * 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 +TreeCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + Tree *treePtr = (Tree *) clientData; + CkWindow *winPtr = treePtr->winPtr; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted (in which case winPtr + * is NULL) or because the command was deleted, and then this procedure + * destroys the widget. + */ + + if (winPtr != NULL) { + treePtr->winPtr = NULL; + Ck_DestroyWindow(winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * RecomputeVisibleNodes -- + * + * Display parameters are recomputed. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +RecomputeVisibleNodes(treePtr) + Tree *treePtr; +{ + int count = 0, top = -1; + Node *nodePtr, *nextPtr = NULL; + + nodePtr = treePtr->firstChild; + if (nodePtr == NULL) + treePtr->topNode = NULL; + while (nodePtr != NULL) { + if (nodePtr->parent == NULL) + nextPtr = nodePtr->next; + if (nodePtr == treePtr->topNode) + top = count; + if (nodePtr->firstChild != NULL && (nodePtr->flags & SHOWCHILDREN)) { + nodePtr = nodePtr->firstChild; + } else if (nodePtr->next != NULL) + nodePtr = nodePtr->next; + else { + while (nodePtr != NULL) { + nodePtr = nodePtr->parent; + if (nodePtr != NULL && nodePtr->next != NULL) { + nodePtr = nodePtr->next; + break; + } + } + if (nodePtr == NULL) + nodePtr = nextPtr; + } + count++; + } + if (top < 0) { + treePtr->topNode = treePtr->firstChild; + top = 0; + } + if (top != treePtr->topIndex || count != treePtr->visibleNodes) + treePtr->flags |= UPDATE_V_SCROLLBAR; + treePtr->topIndex = top; + treePtr->visibleNodes = count; +} + +/* + *---------------------------------------------------------------------- + * + * ChangeTreeView -- + * + * Change the vertical view on a tree widget so that a given element + * is displayed at the top. + * + * Results: + * None. + * + * Side effects: + * What's displayed on the screen is changed. If there is a + * scrollbar associated with this widget, then the scrollbar + * is instructed to change its display too. + * + *---------------------------------------------------------------------- + */ + +static void +ChangeTreeView(treePtr, index) + Tree *treePtr; /* Information about widget. */ + int index; /* Index of element in treePtr + * that should now appear at the + * top of the tree. */ +{ + int count; + Node *nodePtr, *nextPtr = NULL; + + if (index >= treePtr->visibleNodes - treePtr->winPtr->height) + index = treePtr->visibleNodes - treePtr->winPtr->height; + if (index < 0) + index = 0; + if (treePtr->topIndex != index) { + if (index < treePtr->topIndex) { + count = 0; + nodePtr = treePtr->firstChild; + } else { + count = treePtr->topIndex; + nodePtr = treePtr->topNode; + } + while (nodePtr != NULL) { + if (nodePtr->parent == NULL) + nextPtr = nodePtr->next; + if (count == index) + break; + if (nodePtr->firstChild != NULL && + (nodePtr->flags & SHOWCHILDREN)) { + nodePtr = nodePtr->firstChild; + } else if (nodePtr->next != NULL) + nodePtr = nodePtr->next; + else { + while (nodePtr != NULL) { + nodePtr = nodePtr->parent; + if (nodePtr != NULL && nodePtr->next != NULL) { + nodePtr = nodePtr->next; + break; + } + } + if (nodePtr == NULL) + nodePtr = nextPtr; + } + count++; + } + treePtr->topNode = nodePtr; + treePtr->topIndex = count; + treePtr->flags |= UPDATE_V_SCROLLBAR; + TreeEventuallyRedraw(treePtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * GetNodeYCoord -- + * + * Given node return the window Y coordinate corresponding to it. + * + *---------------------------------------------------------------------- + */ + +static int +GetNodeYCoord(treePtr, thisPtr, yPtr) + Tree *treePtr; /* Information about widget. */ + Node *thisPtr; + int *yPtr; +{ + int count; + Node *nodePtr, *nextPtr = NULL; + + count = 0; + nodePtr = treePtr->firstChild; + while (nodePtr != NULL) { + if (thisPtr == nodePtr) { + *yPtr = count; + return TCL_OK; + } + if (nodePtr->parent == NULL) + nextPtr = nodePtr->next; + if (nodePtr->firstChild != NULL && (nodePtr->flags & SHOWCHILDREN)) { + nodePtr = nodePtr->firstChild; + } else if (nodePtr->next != NULL) + nodePtr = nodePtr->next; + else { + while (nodePtr != NULL) { + nodePtr = nodePtr->parent; + if (nodePtr != NULL && nodePtr->next != NULL) { + nodePtr = nodePtr->next; + break; + } + } + if (nodePtr == NULL) + nodePtr = nextPtr; + } + count++; + } + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * TreeTagsParseProc -- + * + * This procedure is invoked during option processing to handle + * "-tags" options for tree nodes. + * + * Results: + * A standard Tcl return value. + * + * Side effects: + * The tags for a given node get replaced by those indicated + * in the value argument. + * + *-------------------------------------------------------------- + */ + +static int +TreeTagsParseProc(clientData, interp, winPtr, value, widgRec, offset) + ClientData clientData; /* Not used.*/ + Tcl_Interp *interp; /* Used for reporting errors. */ + CkWindow *winPtr; /* Window containing tree widget. */ + char *value; /* Value of option (list of tag + * names). */ + char *widgRec; /* Pointer to record for item. */ + int offset; /* Offset into item (ignored). */ +{ + Node *nodePtr = (Node *) widgRec, *activeNode = NULL; + int argc, i, hideChildren = 0, redraw = 0, recompute = 0; + char **argv; + Ck_Uid *newPtr; + + /* + * Break the value up into the individual tag names. + */ + + if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Check for special tags. + */ + for (i = 0; i < nodePtr->numTags; i++) { + if (nodePtr->tagPtr[i] == activeUid) { + DeleteActiveTag(nodePtr->tree); + redraw++; + } + } + + /* + * Make sure that there's enough space in the node to hold the + * tag names. + */ + + if (nodePtr->tagSpace < argc) { + newPtr = (Ck_Uid *) ckalloc((unsigned) (argc * sizeof(Ck_Uid))); + for (i = nodePtr->numTags-1; i >= 0; i--) { + newPtr[i] = nodePtr->tagPtr[i]; + } + if (nodePtr->tagPtr != nodePtr->staticTagSpace) { + ckfree((char *) nodePtr->tagPtr); + } + nodePtr->tagPtr = newPtr; + nodePtr->tagSpace = argc; + } + nodePtr->numTags = argc; + for (i = 0; i < argc; i++) { + nodePtr->tagPtr[i] = Ck_GetUid(argv[i]); + if (nodePtr->tagPtr[i] == hideChildrenUid) + hideChildren++; + else if (nodePtr->tagPtr[i] == activeUid) + activeNode = nodePtr; + } + ckfree((char *) argv); + if (hideChildren && (nodePtr->flags & SHOWCHILDREN)) { + nodePtr->flags &= ~SHOWCHILDREN; + recompute++; + redraw++; + } else if (!hideChildren && !(nodePtr->flags & SHOWCHILDREN)) { + nodePtr->flags |= SHOWCHILDREN; + recompute++; + redraw++; + } + if (activeNode != NULL) { + DeleteActiveTag(nodePtr->tree); + nodePtr->tree->activeNode = activeNode; + redraw++; + } + if (recompute) + RecomputeVisibleNodes(nodePtr->tree); + if (redraw) + TreeEventuallyRedraw(nodePtr->tree); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * TreeTagsPrintProc -- + * + * This procedure is invoked by the Ck configuration code + * to produce a printable string for the "-tags" configuration + * option for tree nodes. + * + * Results: + * The return value is a string describing all the tags for + * the node 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. + * + *-------------------------------------------------------------- + */ + +static char * +TreeTagsPrintProc(clientData, winPtr, widgRec, offset, freeProcPtr) + ClientData clientData; /* Ignored. */ + CkWindow *winPtr; /* Window containing tree 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. */ +{ + Node *nodePtr = (Node *) widgRec; + + if (nodePtr->numTags == 0) { + *freeProcPtr = (Tcl_FreeProc *) NULL; + return ""; + } + if (nodePtr->numTags == 1) { + *freeProcPtr = (Tcl_FreeProc *) NULL; + return (char *) nodePtr->tagPtr[0]; + } + *freeProcPtr = (Tcl_FreeProc *) free; + return Tcl_Merge(nodePtr->numTags, (char **) nodePtr->tagPtr); +} + +/* + *-------------------------------------------------------------- + * + * StartTagSearch -- + * + * This procedure is called to initiate an enumeration of + * all nodes in a given tree that contain a given tag. + * + * Results: + * The return value is a pointer to the first node in + * treePtr that matches tag, or NULL if there is no + * such node. The information at *searchPtr is initialized + * such that successive calls to NextNode will return + * successive nodes that match tag. + * + * Side effects: + * SearchPtr is linked into a list of searches in progress + * on treePtr, 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 Node * +StartTagSearch(treePtr, tag, searchPtr) + Tree *treePtr; /* Tree whose nodes are to be + * searched. */ + char *tag; /* String giving tag value. */ + TagSearch *searchPtr; /* Record describing tag search; + * will be initialized here. */ +{ + int id; + Tcl_HashEntry *hPtr; + Node *nodePtr; + Ck_Uid *tagPtr; + Ck_Uid uid; + int count; + + /* + * Initialize the search. + */ + + nodePtr = NULL; + searchPtr->treePtr = treePtr; + searchPtr->searchOver = 0; + + /* + * Find the first matching node in one of several ways. If the tag + * is a number then it selects the single node with the matching + * identifier. + */ + + if (isdigit((unsigned char) (*tag))) { + char *end; + + id = strtoul(tag, &end, 0); + if (*end == 0) { + + hPtr = Tcl_FindHashEntry(&treePtr->nodeTable, (char *) id); + if (hPtr != NULL) + nodePtr = (Node *) Tcl_GetHashValue(hPtr); + searchPtr->searchOver = 1; + return nodePtr; + } + } + + hPtr = Tcl_FirstHashEntry(&treePtr->nodeTable, &searchPtr->search); + if (hPtr == NULL) { + searchPtr->searchOver = 1; + return nodePtr; + } + searchPtr->tag = uid = Ck_GetUid(tag); + if (uid == allUid) { + + /* + * All nodes match. + */ + + searchPtr->tag = NULL; + return (Node *) Tcl_GetHashValue(hPtr); + } + + do { + nodePtr = (Node *) Tcl_GetHashValue(hPtr); + for (tagPtr = nodePtr->tagPtr, count = nodePtr->numTags; + count > 0; + tagPtr++, count--) { + if (*tagPtr == uid) { + return nodePtr; + } + } + hPtr = Tcl_NextHashEntry(&searchPtr->search); + } while (hPtr != NULL); + + searchPtr->searchOver = 1; + return NULL; +} + +/* + *-------------------------------------------------------------- + * + * NextNode -- + * + * This procedure returns successive nodes 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 node that matches + * the tag specified to StartTagSearch, or NULL if no such + * node exists. *SearchPtr is updated so that the next call + * to this procedure will return the next node. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static Node * +NextNode(searchPtr) + TagSearch *searchPtr; /* Record describing search in + * progress. */ +{ + Node *nodePtr; + Tcl_HashEntry *hPtr; + int count; + Ck_Uid uid; + Ck_Uid *tagPtr; + + if (searchPtr->searchOver) + return NULL; + + hPtr = Tcl_NextHashEntry(&searchPtr->search); + if (hPtr == NULL) { + searchPtr->searchOver = 1; + return NULL; + } + + /* + * Handle special case of "all" search by returning next node. + */ + + uid = searchPtr->tag; + if (uid == NULL) { + return (Node *) Tcl_GetHashValue(hPtr); + } + + /* + * Look for a node with a particular tag. + */ + + do { + nodePtr = (Node *) Tcl_GetHashValue(hPtr); + for (tagPtr = nodePtr->tagPtr, count = nodePtr->numTags; + count > 0; + tagPtr++, count--) { + if (*tagPtr == uid) { + return nodePtr; + } + } + hPtr = Tcl_NextHashEntry(&searchPtr->search); + } while (hPtr != NULL); + + searchPtr->searchOver = 1; + return NULL; +} + +/* + *-------------------------------------------------------------- + * + * DoNode -- + * + * This is a utility procedure called by FindNodes. It + * either adds nodePtr's id to the result forming in interp, + * or it adds a new tag to nodePtr, depending on the value + * of tag. + * + * Results: + * None. + * + * Side effects: + * If tag is NULL then nodePtr's id is added as a list element + * to interp->result; otherwise tag is added to nodePtr's + * list of tags. + * + *-------------------------------------------------------------- + */ + +static void +DoNode(interp, nodePtr, tag) + Tcl_Interp *interp; /* Interpreter in which to (possibly) + * record node id. */ + Node *nodePtr; /* Node to (possibly) modify. */ + Ck_Uid tag; /* Tag to add to those already + * present for node, or NULL. */ +{ + Ck_Uid *tagPtr; + int count; + + /* + * Handle the "add-to-result" case and return, if appropriate. + */ + + if (tag == NULL) { + char msg[30]; + + sprintf(msg, "%d", nodePtr->id); + Tcl_AppendElement(interp, msg); + return; + } + + for (tagPtr = nodePtr->tagPtr, count = nodePtr->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 (nodePtr->tagSpace == nodePtr->numTags) { + Ck_Uid *newTagPtr; + + nodePtr->tagSpace += TAG_SPACE; + newTagPtr = (Ck_Uid *) ckalloc((unsigned) + (nodePtr->tagSpace * sizeof (Ck_Uid))); + memcpy(newTagPtr, nodePtr->tagPtr, nodePtr->numTags * sizeof (Ck_Uid)); + if (nodePtr->tagPtr != nodePtr->staticTagSpace) { + ckfree((char *) nodePtr->tagPtr); + } + nodePtr->tagPtr = newTagPtr; + tagPtr = &nodePtr->tagPtr[nodePtr->numTags]; + } + + /* + * Add in the new tag. + */ + + *tagPtr = tag; + nodePtr->numTags++; + + if (tag == activeUid) { + DeleteActiveTag(nodePtr->tree); + nodePtr->tree->activeNode = nodePtr; + TreeEventuallyRedraw(nodePtr->tree); + } else if (tag == hideChildrenUid) { + nodePtr->flags &= ~SHOWCHILDREN; + RecomputeVisibleNodes(nodePtr->tree); + TreeEventuallyRedraw(nodePtr->tree); + } +} + +/* + *-------------------------------------------------------------- + * + * FindNodes -- + * + * This procedure does all the work of implementing the + * "find" and "addtag" options of the tree widget command, + * which locate nodes that have certain features (location, + * tags). + * + * Results: + * A standard Tcl return value. If newTag is NULL, then a + * list of ids from all the nodes that match argc/argv is + * returned in interp->result. If newTag is NULL, then + * the normal interp->result is an empty string. If an error + * occurs, then interp->result will hold an error message. + * + * Side effects: + * If newTag is non-NULL, then all the nodes that match the + * information in argc/argv have that tag added to their + * lists of tags. + * + *-------------------------------------------------------------- + */ + +static int +FindNodes(interp, treePtr, argc, argv, newTag, cmdName, option) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tree *treePtr; /* Tree whose nodes 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 interp->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; + Node *nodePtr; + Ck_Uid uid; + + if (newTag != NULL) { + uid = Ck_GetUid(newTag); + } else { + uid = NULL; + } + c = argv[0][0]; + length = strlen(argv[0]); + if ((c == 'a') && (strncmp(argv[0], "all", length) == 0) + && (length >= 2)) { + if (argc != 1) { + Tcl_AppendResult(interp, "wrong # args: must be \"", + cmdName, option, " all", (char *) NULL); + return TCL_ERROR; + } + for (nodePtr = StartTagSearch(treePtr, "all", &search); + nodePtr != NULL; nodePtr = NextNode(&search)) { + DoNode(interp, nodePtr, uid); + } + } else if ((c == 'n') && (strncmp(argv[0], "next", length) == 0) && + length > 2) { + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: must be \"", + cmdName, option, " next tagOrId", (char *) NULL); + return TCL_ERROR; + } + nodePtr = StartTagSearch(treePtr, argv[1], &search); + if (nodePtr == NULL) + nodePtr = treePtr->firstChild; + if (nodePtr != NULL) { + if (nodePtr->firstChild != NULL && (nodePtr->flags & SHOWCHILDREN)) + nodePtr = nodePtr->firstChild; + else if (nodePtr->next != NULL) + nodePtr = nodePtr->next; + else { + while (nodePtr != NULL) { + nodePtr = nodePtr->parent; + if (nodePtr != NULL && nodePtr->next != NULL) { + nodePtr = nodePtr->next; + break; + } + } + } + if (nodePtr != NULL) + DoNode(interp, nodePtr, uid); + } + } else if ((c == 'n') && (strncmp(argv[0], "nearest", length) == 0) && + length > 2) { + int x, y, count; + Node *nextPtr = NULL; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: must be \"", + cmdName, option, " nearest x y", (char *) NULL); + return TCL_ERROR; + } + if (Ck_GetCoord(interp, treePtr->winPtr, argv[1], &x) != TCL_OK || + Ck_GetCoord(interp, treePtr->winPtr, argv[2], &y) != TCL_OK) + return TCL_ERROR; + if (y >= treePtr->winPtr->height) + y = treePtr->winPtr->height - 1; + + count = 0; + nodePtr = treePtr->topNode; + while (nodePtr != NULL) { + if (count == y) + break; + if (nodePtr->parent == NULL) + nextPtr = nodePtr->next; + if (nodePtr->firstChild != NULL && + (nodePtr->flags & SHOWCHILDREN)) { + nodePtr = nodePtr->firstChild; + } else if (nodePtr->next != NULL) + nodePtr = nodePtr->next; + else { + while (nodePtr != NULL) { + nodePtr = nodePtr->parent; + if (nodePtr != NULL && nodePtr->next != NULL) { + nodePtr = nodePtr->next; + break; + } + } + if (nodePtr == NULL) + nodePtr = nextPtr; + } + count++; + } + if (nodePtr != NULL) + sprintf(interp->result, "%d", nodePtr->id); + } else if ((c == 'p') && (strncmp(argv[0], "prev", length) == 0)) { + int done = 0; + Node *parentPtr, *nextPtr; + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: must be \"", + cmdName, option, " prev tagOrId", (char *) NULL); + return TCL_ERROR; + } + nodePtr = StartTagSearch(treePtr, argv[1], &search); + if (nodePtr == NULL) + nodePtr = treePtr->firstChild; + if (nodePtr != NULL) { + parentPtr = nodePtr->parent; + if (parentPtr != NULL) { + if (nodePtr == parentPtr->firstChild) { + nextPtr = parentPtr; + done = 1; + } else + nextPtr = parentPtr->firstChild; + } else + parentPtr = nextPtr = treePtr->firstChild; + if (!done) { + for (;nextPtr != NULL && nextPtr->next != nodePtr; + nextPtr = nextPtr->next) { + /* Empty loop body. */ + } + if (nextPtr == NULL) + nextPtr = parentPtr->parent; + if (nextPtr == NULL) + nextPtr = treePtr->firstChild; + else { + while (nextPtr->lastChild != NULL && + (nextPtr->flags & SHOWCHILDREN)) + nextPtr = nextPtr->lastChild; + } + } + DoNode(interp, nextPtr, uid); + } + } else if ((c == 'w') && (strncmp(argv[0], "withtag", length) == 0)) { + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: must be \"", + cmdName, option, " withtag tagOrId", (char *) NULL); + return TCL_ERROR; + } + for (nodePtr = StartTagSearch(treePtr, argv[1], &search); + nodePtr != NULL; nodePtr = NextNode(&search)) { + DoNode(interp, nodePtr, uid); + } + } else { + Tcl_AppendResult(interp, "bad search command \"", argv[0], + "\": must be all, nearest, or withtag", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TreeUpdateVScrollbar -- + * + * This procedure is invoked whenever information has changed in + * a tree in a way that would invalidate a vertical scrollbar + * display. If there is an associated scrollbar, then this command + * updates it by invoking a Tcl command. + * + * Results: + * None. + * + * Side effects: + * A Tcl command is invoked, and an additional command may be + * invoked to process errors in the command. + * + *---------------------------------------------------------------------- + */ + +static void +TreeUpdateVScrollbar(treePtr) + Tree *treePtr; /* Information about widget. */ +{ + char string[100]; + double first, last; + int result; + + if (treePtr->yScrollCmd == NULL) { + return; + } + if (treePtr->visibleNodes == 0) { + first = 0.0; + last = 1.0; + } else { + first = treePtr->topIndex / ((double) treePtr->visibleNodes); + last = (treePtr->topIndex + treePtr->winPtr->height) + / ((double) treePtr->visibleNodes); + if (last > 1.0) { + last = 1.0; + } + } + sprintf(string, " %g %g", first, last); + result = Tcl_VarEval(treePtr->interp, treePtr->yScrollCmd, string, + (char *) NULL); + if (result != TCL_OK) { + Tcl_AddErrorInfo(treePtr->interp, + "\n (vertical scrolling command executed by tree)"); + Tk_BackgroundError(treePtr->interp); + } +} diff --git a/ckUtil.c b/ckUtil.c new file mode 100644 index 0000000..20d3ebc --- /dev/null +++ b/ckUtil.c @@ -0,0 +1,1018 @@ +/* + * ckUtil.c -- + * + * Miscellaneous utility functions. + * + * Copyright (c) 1995 Christian Werner. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +#define REPLACE 1 +#define NORMAL 2 +#define TAB 3 +#define NEWLINE 4 +#define GCHAR 5 + +struct charType { + char type; /* Type of char, see definitions above. */ + char width; /* Width if replaced by backslash sequence. */ +}; + +struct charEncoding { + char *name; /* Name for this encoding table. */ + struct charType ct[256]; /* Encoding table. */ +}; + +/* + * For ISO8859, codes 0x81..0x99 are mapped to ACS characters + * according to this table: + */ + +static char *gcharTab[] = { + "ulcorner", "llcorner", "urcorner", "lrcorner", + "ltee", "rtee", "btee", "ttee", + "hline", "vline", "plus", "s1", + "s9", "diamond", "ckboard", "degree", + "plminus", "bullet", "larrow", "rarrow", + "darrow", "uarrow", "board", "lantern", + "block" +}; + +static struct charEncoding EncodingTable[] = { + +/* + *---------------------------------------------------------------------- + * + * ISO 8859 encoding. + * + *---------------------------------------------------------------------- + */ + +{ + "ISO8859", { + + { REPLACE, 4 }, /* \x00 */ + { REPLACE, 4 }, /* \x01 */ + { REPLACE, 4 }, /* \x02 */ + { REPLACE, 4 }, /* \x03 */ + { REPLACE, 4 }, /* \x04 */ + { REPLACE, 4 }, /* \x05 */ + { REPLACE, 4 }, /* \x06 */ + { REPLACE, 4 }, /* \x07 */ + { REPLACE, 2 }, /* \b */ + { TAB, 2 }, /* \t */ + { NEWLINE, 2 }, /* \n */ + { REPLACE, 4 }, /* \x0b */ + { REPLACE, 2 }, /* \f */ + { REPLACE, 2 }, /* \r */ + { REPLACE, 4 }, /* 0x0e */ + { REPLACE, 4 }, /* 0x0f */ + + /* 0x10 .. 0x1f */ + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + + /* ' ' .. '/' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* '0' .. '?' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* '@' .. 'O' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 'P' .. '_' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* '`' .. 'o' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 'p' .. '~' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + { REPLACE, 4 }, /* 0x7f */ + + /* 0x80 .. 0x8f */ + { REPLACE, 4 }, { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, + { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, + { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, + { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, + + /* 0x90 .. 0x9f */ + { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, + { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, { GCHAR, 1 }, + { GCHAR, 1 }, { GCHAR, 1 }, { REPLACE, 4 }, { REPLACE, 4 }, + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + + /* 0xa0 .. 0xaf */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xb0 .. 0xbf */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xc0 .. 0xcf */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xd0 .. 0xdf */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xe0 .. 0xef */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xf0 .. 0xff */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + } +}, + +/* + *---------------------------------------------------------------------- + * + * IBM code page 437 encoding. + * + *---------------------------------------------------------------------- + */ + +{ + "IBM437", { + + { REPLACE, 4 }, /* \x00 */ + { REPLACE, 4 }, /* \x01 */ + { REPLACE, 4 }, /* \x02 */ + { REPLACE, 4 }, /* \x03 */ + { REPLACE, 4 }, /* \x04 */ + { REPLACE, 4 }, /* \x05 */ + { REPLACE, 4 }, /* \x06 */ + { REPLACE, 4 }, /* \x07 */ + { REPLACE, 2 }, /* \b */ + { TAB, 2 }, /* \t */ + { NEWLINE, 2 }, /* \n */ + { REPLACE, 4 }, /* \x0b */ + { REPLACE, 2 }, /* \f */ + { REPLACE, 2 }, /* \r */ + { REPLACE, 4 }, /* 0x0e */ + { REPLACE, 4 }, /* 0x0f */ + + /* 0x10 .. 0x1f */ + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, { REPLACE, 4 }, + + /* ' ' .. '/' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* '0' .. '?' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* '@' .. 'O' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 'P' .. '_' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* '`' .. 'o' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 'p' .. '~' */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + { REPLACE, 4 }, /* 0x7f */ + + /* 0x80 .. 0x8f */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0x90 .. 0x9a */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + { NORMAL, 1 }, /* 0x9b */ + + /* 0x9c .. 0x9f */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xa0 .. 0xaf */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xb0 .. 0xbf */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xc0 .. 0xcf */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xd0 .. 0xdf */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xe0 .. 0xef */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + /* 0xf0 .. 0xfe */ + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + { NORMAL, 1 }, { NORMAL, 1 }, { NORMAL, 1 }, + + { NORMAL, 1 } /* 0xff */ + + } +} + +}; + +/* + * This is the switch for char encoding. + */ + +static int Encoding = 0; + +#define CHARTYPE(x) EncodingTable[Encoding].ct[(x)] + +/* + * Characters used when displaying control sequences. + */ + +static char hexChars[] = "0123456789abcdefxtnvr\\"; + +/* + * The following table maps some control characters to sequences + * like '\n' rather than '\x10'. A zero entry in the table means + * no such mapping exists, and the table only maps characters + * less than 0x10. + */ + +static char mapChars[] = { + 0, 0, 0, 0, 0, 0, 0, 0, + 'b', 't', 'n', 0, 'f', 'r', 0 +}; + + +/* + *---------------------------------------------------------------------- + * + * CkCopyAndGlobalEval -- + * + * This procedure makes a copy of a script then calls Tcl_GlobalEval + * to evaluate it. It's used in situations where the execution of + * a command may cause the original command string to be reallocated. + * + * Results: + * Returns the result of evaluating script, including both a standard + * Tcl completion code and a string in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +CkCopyAndGlobalEval(interp, script) + Tcl_Interp *interp; /* Interpreter in which to evaluate + * script. */ + char *script; /* Script to evaluate. */ +{ + Tcl_DString buffer; + int code; + + Tcl_DStringInit(&buffer); + Tcl_DStringAppend(&buffer, script, -1); + code = Tcl_GlobalEval(interp, Tcl_DStringValue(&buffer)); + Tcl_DStringFree(&buffer); + return code; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_GetScrollInfo -- + * + * This procedure is invoked to parse "xview" and "yview" + * scrolling commands for widgets using the new scrolling + * command syntax ("moveto" or "scroll" options). + * + * Results: + * The return value is either CK_SCROLL_MOVETO, CK_SCROLL_PAGES, + * CK_SCROLL_UNITS, or CK_SCROLL_ERROR. This indicates whether + * the command was successfully parsed and what form the command + * took. If CK_SCROLL_MOVETO, *dblPtr is filled in with the + * desired position; if CK_SCROLL_PAGES or CK_SCROLL_UNITS, + * *intPtr is filled in with the number of lines to move (may be + * negative); if CK_SCROLL_ERROR, interp->result contains an + * error message. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Ck_GetScrollInfo(interp, argc, argv, dblPtr, intPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + int argc; /* # arguments for command. */ + char **argv; /* Arguments for command. */ + double *dblPtr; /* Filled in with argument "moveto" + * option, if any. */ + int *intPtr; /* Filled in with number of pages + * or lines to scroll, if any. */ +{ + int c; + size_t length; + + length = strlen(argv[2]); + c = argv[2][0]; + if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " ", argv[1], " moveto fraction\"", + (char *) NULL); + return CK_SCROLL_ERROR; + } + if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) { + return CK_SCROLL_ERROR; + } + return CK_SCROLL_MOVETO; + } else if ((c == 's') + && (strncmp(argv[2], "scroll", length) == 0)) { + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " ", argv[1], " scroll number units|pages\"", + (char *) NULL); + return CK_SCROLL_ERROR; + } + if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) { + return CK_SCROLL_ERROR; + } + length = strlen(argv[4]); + c = argv[4][0]; + if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) { + return CK_SCROLL_PAGES; + } else if ((c == 'u') + && (strncmp(argv[4], "units", length) == 0)) { + return CK_SCROLL_UNITS; + } else { + Tcl_AppendResult(interp, "bad argument \"", argv[4], + "\": must be units or pages", (char *) NULL); + return CK_SCROLL_ERROR; + } + } + Tcl_AppendResult(interp, "unknown option \"", argv[2], + "\": must be moveto or scroll", (char *) NULL); + return CK_SCROLL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * Ck_SetEncoding -- + * + *-------------------------------------------------------------- + */ + +int +Ck_SetEncoding(interp, name) + Tcl_Interp *interp; + char *name; +{ + int i; + + for (i = 0; i < sizeof (EncodingTable) / sizeof (EncodingTable[0]); i++) + if (strcmp(name, EncodingTable[i].name) == 0) { + Encoding = i; + return TCL_OK; + } + Tcl_AppendResult(interp, "no encoding \"", name, "\"", (char *) NULL); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * Ck_GetEncoding -- + * + *-------------------------------------------------------------- + */ + +int +Ck_GetEncoding(interp) + Tcl_Interp *interp; +{ + interp->result = EncodingTable[Encoding].name; + return TCL_OK; +} + +#if CK_USE_UTF +/* + *-------------------------------------------------------------- + * + * MakeISO -- + * + * Procedure to convert UTF-8 representation to + * ISO8859-1 for printing on screen. + * + *-------------------------------------------------------------- + */ + +static char * +MakeISO(mainPtr, string, numChars, lenPtr) + CkMainInfo *mainPtr; + char *string; + int numChars; + int *lenPtr; +{ + char *p; + + Tcl_DStringFree(&mainPtr->isoBuffer); + p = Tcl_UtfToExternalDString(mainPtr->isoEncoding, string, + numChars, &mainPtr->isoBuffer); + if (lenPtr) { + *lenPtr = Tcl_DStringLength(&mainPtr->isoBuffer); + } + return p; +} +#endif + +/* + *-------------------------------------------------------------- + * + * CkMeasureChars -- + * + * Measure the number of characters from a string that + * will fit in a given horizontal span. The measurement + * is done under the assumption that CkDisplayChars will + * be used to actually display the characters. + * + * Results: + * The return value is the number of characters from source + * that fit in the span given by startX and maxX. *nextXPtr + * is filled in with the x-coordinate at which the first + * character that didn't fit would be drawn, if it were to + * be drawn. + * + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +CkMeasureChars(mainPtr, source, maxChars, startX, maxX, + tabOrigin, flags, nextXPtr, nextCPtr) + CkMainInfo *mainPtr; /* Needed for encoding. */ + char *source; /* Characters to be displayed. Need not + * be NULL-terminated. */ + int maxChars; /* Maximum # of characters to consider from + * source. */ + int startX; /* X-position at which first character will + * be drawn. */ + int maxX; /* Don't consider any character that would + * cross this x-position. */ + int tabOrigin; /* X-location that serves as "origin" for + * tab stops. */ + int flags; /* Various flag bits OR-ed together. + * CK_WHOLE_WORDS means stop on a word boundary + * (just before a space character) if + * possible. CK_AT_LEAST_ONE means always + * return a value of at least one, even + * if the character doesn't fit. + * CK_PARTIAL_OK means it's OK to display only + * a part of the last character in the line. + * CK_NEWLINES_NOT_SPECIAL means that newlines + * are treated just like other control chars: + * they don't terminate the line. + * CK_IGNORE_TABS means give all tabs zero + * width. */ + int *nextXPtr; /* Return x-position of terminating + * character here. */ + int *nextCPtr; /* Return byte position of terminating + character in source. */ +{ + register char *p; /* Current character. */ + register int c; + char *term; /* Pointer to most recent character that + * may legally be a terminating character. */ + int termX; /* X-position just after term. */ + int curX; /* X-position corresponding to p. */ + int newX; /* X-position corresponding to p+1. */ + int rem; +#if CK_USE_UTF + int n, m, srcRead, dstWrote, dstChars, nChars = 0; + Tcl_UniChar uch; + char buf[TCL_UTF_MAX], buf2[TCL_UTF_MAX]; + + /* + * Scan the input string one character at a time, until a character + * is found that crosses maxX. + */ + + newX = curX = startX; + termX = 0; + term = source; + for (p = source; *p != '\0' && maxChars > 0;) { + char *p2; + + n = Tcl_UtfToUniChar(p, &uch); + p2 = p + n; + ++nChars; + maxChars -= n; + m = Tcl_UniCharToUtf(uch, buf); + Tcl_UtfToExternal(NULL, mainPtr->isoEncoding, buf, m, + TCL_ENCODING_START | TCL_ENCODING_END, + NULL, buf2, sizeof (buf2), &srcRead, + &dstWrote, &dstChars); + if (buf2[0] == '\0') { + buf2[0] = '?'; + } + c = buf2[0] & 0xFF; + if ((CHARTYPE(c).type == NORMAL) || (CHARTYPE(c).type == REPLACE) || + (CHARTYPE(c).type == GCHAR)) { + newX += CHARTYPE(c).width; + } else if (CHARTYPE(c).type == TAB) { + if (!(flags & CK_IGNORE_TABS)) { + newX += 8; + rem = (newX - tabOrigin) % 8; + if (rem < 0) { + rem += 8; + } + newX -= rem; + } + } else if (CHARTYPE(c).type == NEWLINE) { + if (flags & CK_NEWLINES_NOT_SPECIAL) { + newX += CHARTYPE(c).width; + } else { + break; + } + } + if (newX > maxX) { + break; + } + p = p2; + if (maxChars > 1) { + n = Tcl_UtfToUniChar(p, &uch); + m = Tcl_UniCharToUtf(uch, buf); + Tcl_UtfToExternal(NULL, mainPtr->isoEncoding, buf, m, + TCL_ENCODING_START | TCL_ENCODING_END, + NULL, buf2, sizeof (buf2), &srcRead, + &dstWrote, &dstChars); + if (buf2[0] == '\0') { + buf2[0] = '?'; + } + c = buf2[0] & 0xff; + } else { + c = 0; + } + if (isspace(c) || (c == 0)) { + term = p2; + termX = newX; + } + curX = newX; + } + + /* + * P points to the first character that doesn't fit in the desired + * span. Use the flags to figure out what to return. + */ + + if ((flags & CK_PARTIAL_OK) && (curX < maxX)) { + curX = newX; + n = Tcl_UtfToUniChar(p, &uch); + p += n; + ++nChars; + } + if ((flags & CK_AT_LEAST_ONE) && (term == source) && (maxChars > 0) + && !isspace((unsigned char) *term)) { + term = p; + termX = curX; + if (term == source) { + n = Tcl_UtfToUniChar(term, &uch); + term += n; + ++nChars; + } + } else if ((maxChars == 0) || !(flags & CK_WHOLE_WORDS)) { + term = p; + termX = curX; + } + *nextXPtr = termX; + *nextCPtr = term - source; + return nChars; +#else + /* + * Scan the input string one character at a time, until a character + * is found that crosses maxX. + */ + + newX = curX = startX; + termX = 0; + term = source; + for (p = source, c = *p & 0xff; c != '\0' && maxChars > 0; + p++, maxChars--) { + if ((CHARTYPE(c).type == NORMAL) || (CHARTYPE(c).type == REPLACE) || + (CHARTYPE(c).type == GCHAR)) { + newX += CHARTYPE(c).width; + } else if (CHARTYPE(c).type == TAB) { + if (!(flags & CK_IGNORE_TABS)) { + newX += 8; + rem = (newX - tabOrigin) % 8; + if (rem < 0) { + rem += 8; + } + newX -= rem; + } + } else if (CHARTYPE(c).type == NEWLINE) { + if (flags & CK_NEWLINES_NOT_SPECIAL) { + newX += CHARTYPE(c).width; + } else { + break; + } + } + if (newX > maxX) { + break; + } + if (maxChars > 1) { + c = p[1] & 0xff; + } else { + c = 0; + } + if (isspace(c) || (c == 0)) { + term = p+1; + termX = newX; + } + curX = newX; + } + + /* + * P points to the first character that doesn't fit in the desired + * span. Use the flags to figure out what to return. + */ + + if ((flags & CK_PARTIAL_OK) && (curX < maxX)) { + curX = newX; + p++; + } + if ((flags & CK_AT_LEAST_ONE) && (term == source) && (maxChars > 0) + && !isspace((unsigned char) *term)) { + term = p; + termX = curX; + if (term == source) { + term++; + termX = newX; + } + } else if ((maxChars == 0) || !(flags & CK_WHOLE_WORDS)) { + term = p; + termX = curX; + } + *nextXPtr = termX; + *nextCPtr = termX; + return term - source; +#endif +} + +/* + *-------------------------------------------------------------- + * + * CkDisplayChars -- + * + * Draw a string of characters on the screen, converting + * tabs to the right number of spaces and control characters + * to sequences of the form "\xhh" where hh are two hex + * digits. + * + * Results: + * None. + * + * Side effects: + * Information gets drawn on the screen. + * + *-------------------------------------------------------------- + */ + +void +CkDisplayChars(mainPtr, window, string, numChars, x, y, tabOrigin, flags) + CkMainInfo *mainPtr; /* Needed for encoding. */ + WINDOW *window; /* Curses window. */ + char *string; /* Characters to be displayed. */ + int numChars; /* Number of characters to display from + * string. */ + int x, y; /* Coordinates at which to draw string. */ + int tabOrigin; /* X-location that serves as "origin" for + * tab stops. */ + int flags; /* Flags to control display. Only + * CK_NEWLINES_NOT_SPECIAL, CK_IGNORE_TABS + * and CK_FILL_UNTIL_EOL are supported right + * now. See CkMeasureChars for information + * about it. */ +{ + register char *p; /* Current character being scanned. */ + register int c; + int startX; /* X-coordinate corresponding to start. */ + int curX; /* X-coordinate corresponding to p. */ + char replace[10]; + int rem, dummy, maxX; + +#if CK_USE_UTF + string = MakeISO(mainPtr, string, numChars, &numChars); +#endif + + /* + * Scan the string one character at a time and display the + * character. + */ + + getmaxyx(window, dummy, maxX); + maxX -= x; + if (numChars > maxX) + numChars = maxX; + p = string; + if (x < 0) { + numChars += x; + p -= x; + x = 0; + } + wmove(window, y, x); + startX = curX = x; + for (; numChars > 0; numChars--, p++) { + c = *p & 0xff; + if (c == '\0') + break; + if (CHARTYPE(c).type == NORMAL) { + waddch(window, c); + startX++; + continue; + } + if (CHARTYPE(c).type == TAB) { + if (!(flags & CK_IGNORE_TABS)) { + curX += 8; + rem = (curX - tabOrigin) % 8; + if (rem < 0) { + rem += 8; + } + curX -= rem; + } + while (startX < curX) { + waddch(window, ' '); + startX++; + } + continue; + } else if (CHARTYPE(c).type == GCHAR) { + int gchar; + + if (Ck_GetGChar(NULL, gcharTab[c - 0x81], &gchar) != TCL_OK) + goto replaceChar; + waddch(window, gchar); + startX++; + continue; + } else if (CHARTYPE(c).type == REPLACE || (CHARTYPE(c).type == NEWLINE + && (flags & CK_NEWLINES_NOT_SPECIAL))) { +replaceChar: + if ((c < sizeof(mapChars)) && (mapChars[c] != 0)) { + replace[0] = '\\'; + replace[1] = mapChars[c]; + replace[2] = '\0'; + waddstr(window, replace); + curX += 2; + } else { + replace[0] = '\\'; + replace[1] = 'x'; + replace[2] = hexChars[(c >> 4) & 0xf]; + replace[3] = hexChars[c & 0xf]; + replace[4] = '\0'; + waddstr(window, replace); + curX += 4; + } + } else if (CHARTYPE(c).type == NEWLINE) { + y++; + wmove(window, y, x); + curX = x; + } + startX = curX; + } + if (flags & CK_FILL_UNTIL_EOL) { + while (startX < maxX) { + waddch(window, ' '); + startX++; + } + } +} + +/* + *-------------------------------------------------------------- + * + * CkUnderlineChars -- + * + * Draw a range of string of characters on the screen, + * converting tabs to the right number of spaces and control + * characters to sequences of the form "\xhh" where hh are two hex + * digits. + * + * Results: + * None. + * + * Side effects: + * Information gets drawn on the screen. + * + *-------------------------------------------------------------- + */ + +void +CkUnderlineChars(mainPtr, window, string, numChars, x, y, tabOrigin, + flags, first, last) + CkMainInfo *mainPtr; /* Needed for encoding. */ + WINDOW *window; /* Curses window. */ + char *string; /* Characters to be displayed. */ + int numChars; /* Number of characters to display from + * string. */ + int x, y; /* Coordinates at which to draw string. */ + int tabOrigin; /* X-location that serves as "origin" for + * tab stops. */ + int flags; /* Flags to control display. Only + * CK_NEWLINES_NOT_SPECIAL, CK_IGNORE_TABS + * and CK_FILL_UNTIL_EOL are supported right + * now. See CkMeasureChars for information + * about it. */ + int first, last; /* Range: First and last characters to + * display. */ +{ + register char *p; /* Current character being scanned. */ + register int c, count; + int startX; /* X-coordinate corresponding to start. */ + int curX; /* X-coordinate corresponding to p. */ + char replace[10]; + int rem, dummy, maxX; + +#if CK_USE_UTF + string = MakeISO(mainPtr, string, numChars, &numChars); +#endif + + /* + * Scan the string one character at a time and display the + * character. + */ + + count = 0; + getmaxyx(window, dummy, maxX); + maxX -= x; + if (numChars > maxX) + numChars = maxX; + p = string; + if (x < 0) { + numChars += x; + count += x; + p -= x; + x = 0; + } + wmove(window, y, x); + startX = curX = x; + for (; numChars > 0 && count <= last; numChars--, count++, p++) { + c = *p & 0xff; + if (c == '\0') + break; + if (CHARTYPE(c).type == NORMAL) { + startX++; + if (count >= first) + waddch(window, c); + else + wmove(window, y, startX); + continue; + } + if (CHARTYPE(c).type == TAB) { + if (!(flags & CK_IGNORE_TABS)) { + curX += 8; + rem = (curX - tabOrigin) % 8; + if (rem < 0) { + rem += 8; + } + curX -= rem; + } + while (startX < curX) { + startX++; + if (count >= first) + waddch(window, ' '); + else + wmove(window, y, startX); + } + continue; + } else if (CHARTYPE(c).type == GCHAR) { + int gchar; + + if (Ck_GetGChar(NULL, gcharTab[c - 0x81], &gchar) != TCL_OK) + goto replaceChar; + startX++; + if (count >= first) + waddch(window, gchar); + else + wmove(window, y, startX); + continue; + } else if (CHARTYPE(c).type == REPLACE || (CHARTYPE(c).type == NEWLINE + && (flags & CK_NEWLINES_NOT_SPECIAL))) { +replaceChar: + if ((c < sizeof(mapChars)) && (mapChars[c] != 0)) { + replace[0] = '\\'; + replace[1] = mapChars[c]; + replace[2] = '\0'; + curX += 2; + if (count >= first) + waddstr(window, replace); + else + wmove(window, y, curX); + } else { + replace[0] = '\\'; + replace[1] = 'x'; + replace[2] = hexChars[(c >> 4) & 0xf]; + replace[3] = hexChars[c & 0xf]; + replace[4] = '\0'; + curX += 4; + if (count >= first) + waddstr(window, replace); + else + wmove(window, y, curX); + } + } else if (CHARTYPE(c).type == NEWLINE) { + y++; + wmove(window, y, x); + curX = x; + } + startX = curX; + } +} + diff --git a/ckWindow.c b/ckWindow.c new file mode 100644 index 0000000..a326de9 --- /dev/null +++ b/ckWindow.c @@ -0,0 +1,2688 @@ +/* + * ckWindow.c -- + * + * This file provides basic window-manipulation procedures. + * + * Copyright (c) 1995-2001 Christian Werner. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "ckPort.h" +#include "ck.h" + +#ifdef HAVE_GPM +#include "gpm.h" +#endif + +/* + * Main information. + */ + +CkMainInfo *ckMainInfo = NULL; + +#ifdef __WIN32__ + +/* + * Curses input event handling information. + */ + +typedef struct { + HANDLE stdinHandle; + HWND hwnd; + HANDLE thread; + CkMainInfo *mainPtr; +} InputInfo; + +static InputInfo inputInfo = { + INVALID_HANDLE_VALUE, + NULL, + INVALID_HANDLE_VALUE, + NULL +}; + +static void InputSetup _ANSI_ARGS_((InputInfo *inputInfo)); +static void InputExit _ANSI_ARGS_((ClientData clientData)); +static void InputThread _ANSI_ARGS_((void *arg)); +static LRESULT CALLBACK InputHandler _ANSI_ARGS_((HWND hwnd, UINT message, + WPARAM wParam, + LPARAM lParam)); +static void InputHandler2 _ANSI_ARGS_((ClientData clientData)); +#endif + +/* + * The variables below hold several uid's that are used in many places + * in the toolkit. + */ + +Ck_Uid ckDisabledUid = NULL; +Ck_Uid ckActiveUid = NULL; +Ck_Uid ckNormalUid = NULL; + +/* + * The following structure defines all of the commands supported by + * the toolkit, and the C procedures that execute them. + */ + +typedef int (CkCmdProc) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, + int argc, char **argv)); + +typedef struct { + char *name; /* Name of command. */ + CkCmdProc *cmdProc; /* Command procedure. */ +} CkCmd; + +CkCmd commands[] = { + /* + * Commands that are part of the intrinsics: + */ + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + {"after", Tk_AfterCmd}, +#endif + {"bell", Ck_BellCmd}, + {"bind", Ck_BindCmd}, + {"bindtags", Ck_BindtagsCmd}, + {"curses", Ck_CursesCmd}, + {"destroy", Ck_DestroyCmd}, + {"exit", Ck_ExitCmd}, +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + {"fileevent", Tk_FileeventCmd}, +#endif + {"focus", Ck_FocusCmd}, + {"grid", Ck_GridCmd}, + {"lower", Ck_LowerCmd}, + {"option", Ck_OptionCmd}, + {"pack", Ck_PackCmd}, + {"place", Ck_PlaceCmd}, + {"raise", Ck_RaiseCmd}, + {"recorder", Ck_RecorderCmd}, + {"tkwait", Ck_TkwaitCmd}, + {"update", Ck_UpdateCmd}, + {"winfo", Ck_WinfoCmd}, + + /* + * Widget-creation commands. + */ + + {"button", Ck_ButtonCmd}, + {"checkbutton", Ck_ButtonCmd}, + {"entry", Ck_EntryCmd}, + {"frame", Ck_FrameCmd}, + {"label", Ck_ButtonCmd}, + {"listbox", Ck_ListboxCmd}, + {"menu", Ck_MenuCmd}, + {"menubutton", Ck_MenubuttonCmd}, + {"message", Ck_MessageCmd}, + {"radiobutton", Ck_ButtonCmd}, + {"scrollbar", Ck_ScrollbarCmd}, + {"text", Ck_TextCmd}, + {"toplevel", Ck_FrameCmd}, + {"tree", Ck_TreeCmd}, + + {(char *) NULL, (CkCmdProc *) NULL} +}; + +/* + * Static procedures of this module. + */ + +static void UnlinkWindow _ANSI_ARGS_((CkWindow *winPtr)); +static void UnlinkToplevel _ANSI_ARGS_((CkWindow *winPtr)); +static void ChangeToplevelFocus _ANSI_ARGS_((CkWindow *winPtr)); +static void DoRefresh _ANSI_ARGS_((ClientData clientData)); +static void RefreshToplevels _ANSI_ARGS_((CkWindow *winPtr)); +static void RefreshThem _ANSI_ARGS_((CkWindow *winPtr)); +static void UpdateHWCursor _ANSI_ARGS_((CkMainInfo *mainPtr)); +static CkWindow *GetWindowXY _ANSI_ARGS_((CkWindow *winPtr, int *xPtr, + int *yPtr)); +static int DeadAppCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int ExecCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int PutsCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int CloseCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int FlushCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int ReadCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int GetsCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +/* + * Some plain Tcl commands are handled specially. + */ + +CkCmd redirCommands[] = { +#ifndef __WIN32__ + {"exec", ExecCmd}, +#endif + {"puts", PutsCmd}, + {"close", CloseCmd}, + {"flush", FlushCmd}, + {"read", ReadCmd}, + {"gets", GetsCmd}, + {(char *) NULL, (CkCmdProc *) NULL} +}; + +/* + * The following structure is used as ClientData for redirected + * plain Tcl commands. + */ + +typedef struct { + CkMainInfo *mainPtr; + Tcl_CmdInfo cmdInfo; +} RedirInfo; + +/* + *-------------------------------------------------------------- + * + * NewWindow -- + * + * This procedure creates and initializes a CkWindow structure. + * + * Results: + * The return value is a pointer to the new window. + * + * Side effects: + * A new window structure is allocated and all its fields are + * initialized. + * + *-------------------------------------------------------------- + */ + +static CkWindow * +NewWindow(parentPtr) + CkWindow *parentPtr; +{ + CkWindow *winPtr; + + winPtr = (CkWindow *) ckalloc(sizeof (CkWindow)); + winPtr->window = NULL; + winPtr->childList = NULL; + winPtr->lastChildPtr = NULL; + winPtr->parentPtr = NULL; + winPtr->nextPtr = NULL; + winPtr->topLevPtr = NULL; + winPtr->mainPtr = NULL; + winPtr->pathName = NULL; + winPtr->nameUid = NULL; + winPtr->classUid = NULL; + winPtr->handlerList = NULL; + winPtr->tagPtr = NULL; + winPtr->numTags = 0; + winPtr->focusPtr = NULL; + winPtr->geomMgrPtr = NULL; + winPtr->geomData = NULL; + winPtr->optionLevel = -1; + winPtr->reqWidth = winPtr->reqHeight = 1; + winPtr->x = winPtr->y = 0; + winPtr->width = winPtr->height = 1; + winPtr->fg = COLOR_WHITE; + winPtr->bg = COLOR_BLACK; + winPtr->attr = A_NORMAL; + winPtr->flags = 0; + + return winPtr; +} + +/* + *---------------------------------------------------------------------- + * + * NameWindow -- + * + * This procedure is invoked to give a window a name and insert + * the window into the hierarchy associated with a particular + * application. + * + * Results: + * A standard Tcl return value. + * + * Side effects: + * See above. + * + *---------------------------------------------------------------------- + */ + +static int +NameWindow(interp, winPtr, parentPtr, name) + Tcl_Interp *interp; /* Interpreter to use for error reporting. */ + CkWindow *winPtr; /* Window that is to be named and inserted. */ + CkWindow *parentPtr; /* Pointer to logical parent for winPtr + * (used for naming, options, etc.). */ + char *name; /* Name for winPtr; must be unique among + * parentPtr's children. */ +{ +#define FIXED_SIZE 200 + char staticSpace[FIXED_SIZE]; + char *pathName; + int new; + Tcl_HashEntry *hPtr; + int length1, length2; + + /* + * Setup all the stuff except name right away, then do the name stuff + * last. This is so that if the name stuff fails, everything else + * will be properly initialized (needed to destroy the window cleanly + * after the naming failure). + */ + winPtr->parentPtr = parentPtr; + winPtr->nextPtr = NULL; + if (parentPtr->childList == NULL) { + parentPtr->lastChildPtr = winPtr; + parentPtr->childList = winPtr; + } else { + parentPtr->lastChildPtr->nextPtr = winPtr; + parentPtr->lastChildPtr = winPtr; + } + winPtr->mainPtr = parentPtr->mainPtr; + winPtr->nameUid = Ck_GetUid(name); + + /* + * Don't permit names that start with an upper-case letter: this + * will just cause confusion with class names in the option database. + */ + + if (isupper((unsigned char) name[0])) { + Tcl_AppendResult(interp, + "window name starts with an upper-case letter: \"", + name, "\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * To permit names of arbitrary length, must be prepared to malloc + * a buffer to hold the new path name. To run fast in the common + * case where names are short, use a fixed-size buffer on the + * stack. + */ + + length1 = strlen(parentPtr->pathName); + length2 = strlen(name); + if ((length1+length2+2) <= FIXED_SIZE) { + pathName = staticSpace; + } else { + pathName = (char *) ckalloc((unsigned) (length1+length2+2)); + } + if (length1 == 1) { + pathName[0] = '.'; + strcpy(pathName+1, name); + } else { + strcpy(pathName, parentPtr->pathName); + pathName[length1] = '.'; + strcpy(pathName+length1+1, name); + } + hPtr = Tcl_CreateHashEntry(&parentPtr->mainPtr->nameTable, pathName, &new); + if (pathName != staticSpace) { + ckfree(pathName); + } + if (!new) { + Tcl_AppendResult(interp, "window name \"", name, + "\" already exists in parent", (char *) NULL); + return TCL_ERROR; + } + Tcl_SetHashValue(hPtr, winPtr); + winPtr->pathName = Tcl_GetHashKey(&parentPtr->mainPtr->nameTable, hPtr); + Tcl_CreateHashEntry(&parentPtr->mainPtr->winTable, (char *) winPtr, &new); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_MainWindow -- + * + * Returns the main window for an application. + * + * Results: + * If interp is associated with the main window, the main + * window is returned. Otherwise NULL is returned and an + * error message is left in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +CkWindow * +Ck_MainWindow(interp) + Tcl_Interp *interp; /* Interpreter that embodies application, + * also used for error reporting. */ +{ + if (ckMainInfo == NULL || ckMainInfo->interp != interp) { + if (interp != NULL) + interp->result = "no main window for application."; + return NULL; + } + return ckMainInfo->winPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_CreateMainWindow -- + * + * Make the main window. + * + * Results: + * The return value is a token for the new window, or NULL if + * an error prevented the new window from being created. If + * NULL is returned, an error message will be left in + * interp->result. + * + * Side effects: + * A new window structure is allocated locally. + * + *---------------------------------------------------------------------- + */ + +CkWindow * +Ck_CreateMainWindow(interp, className) + Tcl_Interp *interp; /* Interpreter to use for error reporting. */ + char *className; /* Class name of the new main window. */ +{ + int dummy; + Tcl_HashEntry *hPtr; + CkMainInfo *mainPtr; + CkWindow *winPtr; + CkCmd *cmdPtr; +#ifdef SIGTSTP +#ifdef HAVE_SIGACTION + struct sigaction oldsig, newsig; +#else + Ck_SignalProc sigproc; +#endif +#endif +#ifdef NCURSES_MOUSE_VERSION + MEVENT mEvent; +#endif + char *term; + int isxterm = 0; + + /* + * For now, only one main window may exists for the application. + */ + if (ckMainInfo != NULL) + return NULL; + + /* + * Create the basic CkWindow structure. + */ + + winPtr = NewWindow(NULL); + + /* + * Create the CkMainInfo structure for this application, and set + * up name-related information for the new window. + */ + + mainPtr = (CkMainInfo *) ckalloc(sizeof(CkMainInfo)); + mainPtr->winPtr = winPtr; + mainPtr->interp = interp; + Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&mainPtr->winTable, TCL_ONE_WORD_KEYS); + mainPtr->topLevPtr = NULL; + mainPtr->focusPtr = winPtr; + mainPtr->bindingTable = Ck_CreateBindingTable(interp); + mainPtr->optionRootPtr = NULL; + mainPtr->refreshCount = 0; + mainPtr->refreshDelay = 0; + mainPtr->lastRefresh = 0; + mainPtr->refreshTimer = NULL; + mainPtr->flags = 0; + ckMainInfo = mainPtr; + winPtr->mainPtr = mainPtr; + winPtr->nameUid = Ck_GetUid("."); + winPtr->classUid = Ck_GetUid("Main"); /* ??? */ + winPtr->flags |= CK_TOPLEVEL; + hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, (char *) winPtr->nameUid, + &dummy); + Tcl_SetHashValue(hPtr, winPtr); + winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr); + Tcl_CreateHashEntry(&mainPtr->winTable, (char *) winPtr, &dummy); + + ckNormalUid = Ck_GetUid("normal"); + ckDisabledUid = Ck_GetUid("disabled"); + ckActiveUid = Ck_GetUid("active"); + +#if CK_USE_UTF +#ifdef __WIN32__ + { + char enc[32], *envcp = getenv("CK_USE_ENCODING"); + unsigned int cp = GetConsoleCP(); + + if (envcp && strncmp(envcp, "cp", 2) == 0) { + cp = atoi(envcp + 2); + SetConsoleCP(cp); + cp = GetConsoleCP(); + } + if (GetConsoleOutputCP() != cp) { + SetConsoleOutputCP(cp); + } + sprintf(enc, "cp%d", cp); + mainPtr->isoEncoding = Tcl_GetEncoding(NULL, enc); + } +#else + /* + * Use default system encoding as suggested by + * Anton Kovalenko . + * May be overriden by environment variable. + */ + mainPtr->isoEncoding = Tcl_GetEncoding(NULL, getenv("CK_USE_ENCODING")); + if (mainPtr->isoEncoding == NULL) { + mainPtr->isoEncoding = Tcl_GetEncoding(NULL, NULL); + } +#endif + if (mainPtr->isoEncoding == NULL) { + panic("standard encoding not found"); + } + Tcl_DStringInit(&mainPtr->isoBuffer); +#endif + + /* Curses related initialization */ + +#ifdef SIGTSTP + /* This is essential for ncurses-1.9.4 */ +#ifdef HAVE_SIGACTION + newsig.sa_handler = SIG_IGN; + sigfillset(&newsig.sa_mask); + newsig.sa_flags = 0; + sigaction(SIGTSTP, &newsig, &oldsig); +#else + sigproc = (Ck_SignalProc) signal(SIGTSTP, SIG_IGN); +#endif +#endif + if (initscr() == (WINDOW *) ERR) { + ckfree((char *) winPtr); + return NULL; + } +#ifdef SIGTSTP + /* This is essential for ncurses-1.9.4 */ +#ifdef HAVE_SIGACTION + sigaction(SIGTSTP, &oldsig, NULL); +#else + signal(SIGTSTP, sigproc); +#endif +#endif + raw(); + noecho(); + idlok(stdscr, TRUE); + scrollok(stdscr, FALSE); + keypad(stdscr, TRUE); + nodelay(stdscr, TRUE); + meta(stdscr, TRUE); + nonl(); + mainPtr->maxWidth = COLS; + mainPtr->maxHeight = LINES; + winPtr->width = mainPtr->maxWidth; + winPtr->height = mainPtr->maxHeight; + winPtr->window = newwin(winPtr->height, winPtr->width, 0, 0); + if (has_colors()) { + start_color(); + mainPtr->flags |= CK_HAS_COLOR; + } +#ifdef NCURSES_MOUSE_VERSION + mouseinterval(1); + mousemask(BUTTON1_PRESSED | BUTTON1_RELEASED | + BUTTON2_PRESSED | BUTTON2_RELEASED | + BUTTON3_PRESSED | BUTTON3_RELEASED, NULL); + mainPtr->flags |= (getmouse(&mEvent) != ERR) ? CK_HAS_MOUSE : 0; +#endif /* NCURSES_MOUSE_VERSION */ + +#if defined(__WIN32__) || defined(__DJGPP__) + mouse_set(BUTTON1_PRESSED | BUTTON1_RELEASED | + BUTTON2_PRESSED | BUTTON2_RELEASED | + BUTTON3_PRESSED | BUTTON3_RELEASED); + mainPtr->flags |= CK_HAS_MOUSE; + term = "win32"; +#else + term = getenv("TERM"); + isxterm = strncmp(term, "xterm", 5) == 0 || + strncmp(term, "rxvt", 4) == 0 || + strncmp(term, "kterm", 5) == 0 || + strncmp(term, "color_xterm", 11) == 0 || + (term[0] != '\0' && strncmp(term + 1, "xterm", 5) == 0); + if (!(mainPtr->flags & CK_HAS_MOUSE) && isxterm) { + mainPtr->flags |= CK_HAS_MOUSE | CK_MOUSE_XTERM; + fflush(stdout); + fputs("\033[?1000h", stdout); + fflush(stdout); + } +#endif /* __WIN32__ */ + +#ifdef HAVE_GPM + /* + * Some ncurses aren't compiled with GPM support built in, + * therefore by setting the following environment variable + * usage of GPM can be turned on. + */ + if (!isxterm && (mainPtr->flags & CK_HAS_MOUSE)) { + char *forcegpm = getenv("CK_USE_GPM"); + + if (forcegpm && strchr("YyTt123456789", forcegpm[0])) { + mainPtr->flags &= ~CK_HAS_MOUSE; + } + } + if (!isxterm && !(mainPtr->flags & CK_HAS_MOUSE)) { + int fd; + Gpm_Connect conn; +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + EXTERN int CkHandleGPMInput _ANSI_ARGS_((ClientData clientData, + int mask, int flags)); +#else + EXTERN void CkHandleGPMInput _ANSI_ARGS_((ClientData clientData, + int mask)); +#endif + + conn.eventMask = GPM_DOWN | GPM_UP | GPM_MOVE; + conn.defaultMask = 0; + conn.minMod = 0; + conn.maxMod = 0; + fd = Gpm_Open(&conn, 0); + if (fd >= 0) { + mainPtr->flags |= CK_HAS_MOUSE; +#if (TCL_MAJOR_VERSION >= 8) + mainPtr->mouseData = (ClientData) fd; + Tcl_CreateFileHandler(fd, TCL_READABLE, + CkHandleGPMInput, (ClientData) mainPtr); +#else +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + mainPtr->mouseData = (ClientData) fd; + Tk_CreateFileHandler2(fd, CkHandleGPMInput, (ClientData) mainPtr); +#else + mainPtr->mouseData = (ClientData) + Tcl_GetFile((ClientData) fd, TCL_UNIX_FD); + Tcl_CreateFileHandler((Tcl_File) mainPtr->mouseData, TCL_READABLE, + CkHandleGPMInput, (ClientData) mainPtr); +#endif +#endif + } + } +#endif /* HAVE_GPM */ + +#ifdef __WIN32__ + /* PDCurses specific !!! */ + inputInfo.mainPtr = mainPtr; + inputInfo.stdinHandle = GetStdHandle(STD_INPUT_HANDLE); + typeahead(-1); + SetConsoleMode(inputInfo.stdinHandle, + ENABLE_MOUSE_INPUT | ENABLE_WINDOW_INPUT); + InputSetup(&inputInfo); +#else +#if (TCL_MAJOR_VERSION >= 8) + Tcl_CreateFileHandler(0, + TCL_READABLE, CkHandleInput, (ClientData) mainPtr); +#else +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + Tk_CreateFileHandler2(0, CkHandleInput, (ClientData) mainPtr); +#else + Tcl_CreateFileHandler(Tcl_GetFile((ClientData) 0, TCL_UNIX_FD), + TCL_READABLE, CkHandleInput, (ClientData) mainPtr); +#endif +#endif +#endif + + idlok(winPtr->window, TRUE); + scrollok(winPtr->window, FALSE); + keypad(winPtr->window, TRUE); + nodelay(winPtr->window, TRUE); + meta(winPtr->window, TRUE); + curs_set(0); + while (getch() != ERR) { + /* empty loop body. */ + } + winPtr->flags |= CK_MAPPED; + Ck_SetWindowAttr(winPtr, winPtr->fg, winPtr->bg, winPtr->attr); + Ck_ClearToBot(winPtr, 0, 0); + Ck_EventuallyRefresh(winPtr); + + /* + * Bind in Ck's commands. + */ + + for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { + Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc, + (ClientData) winPtr, (Tcl_CmdDeleteProc *) NULL); + } + + /* + * Redirect some critical Tcl commands to our own procedures + */ + for (cmdPtr = redirCommands; cmdPtr->name != NULL; cmdPtr++) { + RedirInfo *redirInfo; +#if (TCL_MAJOR_VERSION >= 8) + Tcl_DString cmdName; + extern int TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp, + char *oldName, char *newName)); +#endif + redirInfo = (RedirInfo *) ckalloc(sizeof (RedirInfo)); + redirInfo->mainPtr = mainPtr; + Tcl_GetCommandInfo(interp, cmdPtr->name, &redirInfo->cmdInfo); +#if (TCL_MAJOR_VERSION >= 8) + Tcl_DStringInit(&cmdName); + Tcl_DStringAppend(&cmdName, "____", -1); + Tcl_DStringAppend(&cmdName, cmdPtr->name, -1); + TclRenameCommand(interp, cmdPtr->name, Tcl_DStringValue(&cmdName)); + Tcl_DStringFree(&cmdName); +#endif + Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc, + (ClientData) redirInfo, (Tcl_CmdDeleteProc *) free); + } + + /* + * Set variables for the intepreter. + */ + +#if (TCL_MAJOR_VERSION < 8) + if (Tcl_GetVar(interp, "ck_library", TCL_GLOBAL_ONLY) == NULL) { + /* + * A library directory hasn't already been set, so figure out + * which one to use. + */ + + char *libDir = getenv("CK_LIBRARY"); + + if (libDir == NULL) { + libDir = CK_LIBRARY; + } + Tcl_SetVar(interp, "ck_library", libDir, TCL_GLOBAL_ONLY); + } +#endif + Tcl_SetVar(interp, "ck_version", CK_VERSION, TCL_GLOBAL_ONLY); + + /* + * Make main window into a frame widget. + */ + + Ck_SetClass(winPtr, className); + CkInitFrame(interp, winPtr, 0, NULL); + mainPtr->topLevPtr = winPtr; + winPtr->focusPtr = winPtr; + return winPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_Init -- + * + * This procedure is invoked to add Ck to an interpreter. It + * incorporates all of Ck's commands into the interpreter and + * creates the main window for a new Ck application. + * + * Results: + * Returns a standard Tcl completion code and sets interp->result + * if there is an error. + * + * Side effects: + * Depends on what's in the ck.tcl script. + * + *---------------------------------------------------------------------- + */ + +int +Ck_Init(interp) + Tcl_Interp *interp; /* Interpreter to initialize. */ +{ + CkWindow *mainWindow; + char *p, *name, *class; + int code; + static char initCmd[] = +#if (TCL_MAJOR_VERSION >= 8) +"proc init {} {\n\ + global ck_library ck_version\n\ + rename init {}\n\ + tcl_findLibrary ck $ck_version 0 ck.tcl CK_LIBRARY ck_library\n\ +}\n\ +init"; +#else +"proc init {} {\n\ + global ck_library ck_version env\n\ + rename init {}\n\ + set dirs {}\n\ + if [info exists env(CK_LIBRARY)] {\n\ + lappend dirs $env(CK_LIBRARY)\n\ + }\n\ + lappend dirs $ck_library\n\ + lappend dirs [file dirname [info library]]/lib/ck$ck_version\n\ + catch {lappend dirs [file dirname [file dirname \\\n\ + [info nameofexecutable]]]/lib/ck$ck_version}\n\ + set lib ck$ck_version\n\ + lappend dirs [file dirname [file dirname [pwd]]]/$lib/library\n\ + lappend dirs [file dirname [file dirname [info library]]]/$lib/library\n\ + lappend dirs [file dirname [pwd]]/library\n\ + foreach i $dirs {\n\ + set ck_library $i\n\ + if ![catch {uplevel #0 source $i/ck.tcl}] {\n\ + return\n\ + }\n\ + }\n\ + set msg \"Can't find a usable ck.tcl in the following directories: \n\"\n\ + append msg \" $dirs\n\"\n\ + append msg \"This probably means that Ck wasn't installed properly.\n\"\n\ + error $msg\n\ +}\n\ +init"; +#endif + + p = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); + if (p == NULL || *p == '\0') + p = "Ck"; + name = strrchr(p, '/'); + if (name != NULL) + name++; + else + name = p; + class = (char *) ckalloc((unsigned) (strlen(name) + 1)); + strcpy(class, name); + class[0] = toupper((unsigned char) class[0]); + mainWindow = Ck_CreateMainWindow(interp, class); + ckfree(class); + +#if !((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)) + if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) + return TCL_ERROR; + code = Tcl_PkgProvide(interp, "Ck", CK_VERSION); + if (code != TCL_OK) + return TCL_ERROR; +#endif + return Tcl_Eval(interp, initCmd); +} + +/* + *-------------------------------------------------------------- + * + * Ck_CreateWindow -- + * + * Create a new window as a child of an existing window. + * + * Results: + * The return value is the pointer to the new window. + * If an error occurred in creating the window, then an + * error message is left in interp->result and NULL is + * returned. + * + * Side effects: + * A new window structure is allocated locally. A curses + * window is not initially created, but will be created + * the first time the window is mapped. + * + *-------------------------------------------------------------- + */ + +CkWindow * +Ck_CreateWindow(interp, parentPtr, name, toplevel) + Tcl_Interp *interp; /* Interpreter to use for error reporting. + * Interp->result is assumed to be + * initialized by the caller. */ + CkWindow *parentPtr; /* Parent of new window. */ + char *name; /* Name for new window. Must be unique + * among parent's children. */ + int toplevel; /* If true, create toplevel window. */ +{ + CkWindow *winPtr; + + winPtr = NewWindow(parentPtr); + if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) { + Ck_DestroyWindow(winPtr); + return NULL; + } + if (toplevel) { + CkWindow *wPtr; + + winPtr->flags |= CK_TOPLEVEL; + winPtr->focusPtr = winPtr; + if (winPtr->mainPtr->topLevPtr == NULL) { + winPtr->topLevPtr = winPtr->mainPtr->topLevPtr; + winPtr->mainPtr->topLevPtr = winPtr; + } else { + for (wPtr = winPtr->mainPtr->topLevPtr; wPtr->topLevPtr != NULL; + wPtr = wPtr->topLevPtr) { + /* Empty loop body. */ + } + winPtr->topLevPtr = wPtr->topLevPtr; + wPtr->topLevPtr = winPtr; + } + } + return winPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_CreateWindowFromPath -- + * + * This procedure is similar to Ck_CreateWindow except that + * it uses a path name to create the window, rather than a + * parent and a child name. + * + * Results: + * The return value is the pointer to the new window. + * If an error occurred in creating the window, then an + * error message is left in interp->result and NULL is + * returned. + * + * Side effects: + * A new window structure is allocated locally. A curses + * window is not initially created, but will be created + * the first time the window is mapped. + * + *---------------------------------------------------------------------- + */ + +CkWindow * +Ck_CreateWindowFromPath(interp, anywin, pathName, toplevel) + Tcl_Interp *interp; /* Interpreter to use for error reporting. + * Interp->result is assumed to be + * initialized by the caller. */ + CkWindow *anywin; /* Pointer to any window in application + * that is to contain new window. */ + char *pathName; /* Path name for new window within the + * application of anywin. The parent of + * this window must already exist, but + * the window itself must not exist. */ + int toplevel; /* If true, create toplevel window. */ +{ +#define FIXED_SPACE 5 + char fixedSpace[FIXED_SPACE+1]; + char *p; + CkWindow *parentPtr, *winPtr; + int numChars; + + /* + * Strip the parent's name out of pathName (it's everything up + * to the last dot). There are two tricky parts: (a) must + * copy the parent's name somewhere else to avoid modifying + * the pathName string (for large names, space for the copy + * will have to be malloc'ed); (b) must special-case the + * situation where the parent is ".". + */ + + p = strrchr(pathName, '.'); + if (p == NULL) { + Tcl_AppendResult(interp, "bad window path name \"", pathName, + "\"", (char *) NULL); + return NULL; + } + numChars = p - pathName; + if (numChars > FIXED_SPACE) { + p = (char *) ckalloc((unsigned) (numChars+1)); + } else { + p = fixedSpace; + } + if (numChars == 0) { + *p = '.'; + p[1] = '\0'; + } else { + strncpy(p, pathName, numChars); + p[numChars] = '\0'; + } + + /* + * Find the parent window. + */ + + parentPtr = Ck_NameToWindow(interp, p, anywin); + if (p != fixedSpace) { + ckfree(p); + } + if (parentPtr == NULL) + return NULL; + + /* + * Create the window. + */ + + winPtr = NewWindow(parentPtr); + if (NameWindow(interp, winPtr, parentPtr, pathName + numChars + 1) + != TCL_OK) { + Ck_DestroyWindow(winPtr); + return NULL; + } + if (toplevel) { + CkWindow *wPtr; + + winPtr->flags |= CK_TOPLEVEL; + winPtr->focusPtr = winPtr; + if (winPtr->mainPtr->topLevPtr == NULL) { + winPtr->topLevPtr = winPtr->mainPtr->topLevPtr; + winPtr->mainPtr->topLevPtr = winPtr; + } else { + for (wPtr = winPtr->mainPtr->topLevPtr; wPtr->topLevPtr != NULL; + wPtr = wPtr->topLevPtr) { + /* Empty loop body. */ + } + winPtr->topLevPtr = wPtr->topLevPtr; + wPtr->topLevPtr = winPtr; + } + } + return winPtr; +} + +/* + *-------------------------------------------------------------- + * + * Ck_DestroyWindow -- + * + * Destroy an existing window. After this call, the caller + * should never again use the pointer. + * + * Results: + * None. + * + * Side effects: + * The window is deleted, along with all of its children. + * Relevant callback procedures are invoked. + * + *-------------------------------------------------------------- + */ + +void +Ck_DestroyWindow(winPtr) + CkWindow *winPtr; /* Window to destroy. */ +{ + CkWindowEvent event; + Tcl_HashEntry *hPtr; +#ifdef NCURSES_MOUSE_VERSION + MEVENT mEvent; +#endif + + if (winPtr->flags & CK_ALREADY_DEAD) + return; + winPtr->flags |= CK_ALREADY_DEAD; + + /* + * Recursively destroy children. The CK_RECURSIVE_DESTROY + * flags means that the child's window needn't be explicitly + * destroyed (the destroy of the parent already did it), nor + * does it need to be removed from its parent's child list, + * since the parent is being destroyed too. + */ + + while (winPtr->childList != NULL) { + winPtr->childList->flags |= CK_RECURSIVE_DESTROY; + Ck_DestroyWindow(winPtr->childList); + } + if (winPtr->mainPtr->focusPtr == winPtr) { + event.type = CK_EV_FOCUSOUT; + event.winPtr = winPtr; + Ck_HandleEvent(winPtr->mainPtr, (CkEvent *) &event); + } + if (winPtr->window != NULL) { + delwin(winPtr->window); + winPtr->window = NULL; + } + CkOptionDeadWindow(winPtr); + event.type = CK_EV_DESTROY; + event.winPtr = winPtr; + Ck_HandleEvent(winPtr->mainPtr, (CkEvent *) &event); + if (winPtr->tagPtr != NULL) { + CkFreeBindingTags(winPtr); + } + UnlinkWindow(winPtr); + CkEventDeadWindow(winPtr); + hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->winTable, (char *) winPtr); + if (hPtr != NULL) + Tcl_DeleteHashEntry(hPtr); + if (winPtr->pathName != NULL) { + CkMainInfo *mainPtr = winPtr->mainPtr; + + Ck_DeleteAllBindings(mainPtr->bindingTable, + (ClientData) winPtr->pathName); + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&mainPtr->nameTable, + winPtr->pathName)); + if (mainPtr->winPtr == winPtr) { + CkCmd *cmdPtr; + + for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) + if (cmdPtr->cmdProc != Ck_ExitCmd) + Tcl_CreateCommand(mainPtr->interp, cmdPtr->name, + DeadAppCmd, (ClientData) NULL, + (Tcl_CmdDeleteProc *) NULL); + Tcl_DeleteHashTable(&mainPtr->nameTable); + Ck_DeleteBindingTable(mainPtr->bindingTable); + +#ifdef NCURSES_MOUSE_VERSION + mousemask(0, NULL); + mainPtr->flags &= (getmouse(&mEvent) != ERR) ? ~CK_HAS_MOUSE : ~0; +#endif /* NCURSES_MOUSE_VERSION */ + + if (mainPtr->flags & CK_HAS_MOUSE) { +#if defined(__WIN32__) || defined(__DJGPP__) + mouse_set(0); +#endif + if (mainPtr->flags & CK_MOUSE_XTERM) { + fflush(stdout); + fputs("\033[?1000l", stdout); + fflush(stdout); + } else { +#ifdef HAVE_GPM +#if (TCL_MAJOR_VERSION >= 8) + Tcl_DeleteFileHandler((int) mainPtr->mouseData); +#else +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + Tk_DeleteFileHandler((int) mainPtr->mouseData); +#else + Tcl_DeleteFileHandler((Tcl_File) mainPtr->mouseData); +#endif +#endif + Gpm_Close(); +#endif + } + } + + curs_set(1); + if (mainPtr->flags & CK_NOCLR_ON_EXIT) { + wattrset(stdscr, A_NORMAL); + } else { + wclear(stdscr); + wrefresh(stdscr); + } + endwin(); +#if CK_USE_UTF + Tcl_DStringFree(&mainPtr->isoBuffer); + Tcl_FreeEncoding(mainPtr->isoEncoding); +#endif + ckfree((char *) mainPtr); + ckMainInfo = NULL; + goto done; + } + } + if (winPtr->flags & CK_TOPLEVEL) { + UnlinkToplevel(winPtr); + ChangeToplevelFocus(winPtr->mainPtr->topLevPtr); + } else if (winPtr->mainPtr->focusPtr == winPtr) { + winPtr->mainPtr->focusPtr = winPtr->parentPtr; + if (winPtr->mainPtr->focusPtr != NULL && + (winPtr->mainPtr->focusPtr->flags & CK_MAPPED)) { + event.type = CK_EV_FOCUSIN; + event.winPtr = winPtr->mainPtr->focusPtr; + Ck_HandleEvent(winPtr->mainPtr, (CkEvent *) &event); + } + } else { + CkWindow *topPtr; + + for (topPtr = winPtr; topPtr != NULL && !(topPtr->flags & CK_TOPLEVEL); + topPtr = topPtr->parentPtr) { + /* Empty loop body. */ + } + if (topPtr->focusPtr == winPtr) + topPtr->focusPtr = winPtr->parentPtr; + } + Ck_EventuallyRefresh(winPtr); +done: + ckfree((char *) winPtr); +} + +/* + *-------------------------------------------------------------- + * + * Ck_MapWindow -- + * + * Map a window within its parent. This may require the + * window and/or its parents to actually be created. + * + * Results: + * None. + * + * Side effects: + * The given window will be mapped. Windows may also + * be created. + * + *-------------------------------------------------------------- + */ + +void +Ck_MapWindow(winPtr) + CkWindow *winPtr; /* Pointer to window to map. */ +{ + if (winPtr == NULL || (winPtr->flags & CK_MAPPED)) + return; + if (!(winPtr->parentPtr->flags & CK_MAPPED)) + return; + if (winPtr->window == NULL) + Ck_MakeWindowExist(winPtr); +} + +/* + *-------------------------------------------------------------- + * + * Ck_MakeWindowExist -- + * + * Ensure that a particular window actually exists. + * + * Results: + * None. + * + * Side effects: + * When the procedure returns, the curses window associated + * with winPtr is guaranteed to exist. This may require the + * window's ancestors to be created also. + * + *-------------------------------------------------------------- + */ + +void +Ck_MakeWindowExist(winPtr) + CkWindow *winPtr; /* Pointer to window. */ +{ + int x, y; + CkMainInfo *mainPtr; + CkWindow *parentPtr; + CkWindowEvent event; + + if (winPtr == NULL || winPtr->window != NULL) + return; + + mainPtr = winPtr->mainPtr; + if (winPtr->parentPtr->window == NULL) + Ck_MakeWindowExist(winPtr->parentPtr); + + if (winPtr->x >= mainPtr->maxWidth) + winPtr->x = mainPtr->maxWidth - 1; + if (winPtr->x < 0) + winPtr->x = 0; + if (winPtr->y >= mainPtr->maxHeight) + winPtr->y = mainPtr->maxHeight - 1; + if (winPtr->y < 0) + winPtr->y = 0; + + x = winPtr->x; + y = winPtr->y; + + if (!(winPtr->flags & CK_TOPLEVEL)) { + parentPtr = winPtr->parentPtr; + if (x < 0) + x = winPtr->x = 0; + else if (x >= parentPtr->width) + x = winPtr->x = parentPtr->width - 1; + if (y < 0) + y = winPtr->y = 0; + else if (y >= parentPtr->height) + y = winPtr->y = parentPtr->height - 1; + if (x + winPtr->width >= parentPtr->width) + winPtr->width = parentPtr->width - x; + if (y + winPtr->height >= parentPtr->height) + winPtr->height = parentPtr->height - y; + parentPtr = winPtr; + while ((parentPtr = parentPtr->parentPtr) != NULL) { + x += parentPtr->x; + y += parentPtr->y; + if (parentPtr->flags & CK_TOPLEVEL) + break; + } + } + if (winPtr->width <= 0) + winPtr->width = 1; + if (winPtr->height <= 0) + winPtr->height = 1; + + winPtr->window = newwin(winPtr->height, winPtr->width, y, x); + idlok(winPtr->window, TRUE); + scrollok(winPtr->window, FALSE); + keypad(winPtr->window, TRUE); + nodelay(winPtr->window, TRUE); + meta(winPtr->window, TRUE); + winPtr->flags |= CK_MAPPED; + Ck_ClearToBot(winPtr, 0, 0); + Ck_SetWindowAttr(winPtr, winPtr->fg, winPtr->bg, winPtr->attr); + Ck_EventuallyRefresh(winPtr); + + event.type = CK_EV_MAP; + event.winPtr = winPtr; + Ck_HandleEvent(mainPtr, (CkEvent *) &event); + event.type = CK_EV_EXPOSE; + event.winPtr = winPtr; + Ck_HandleEvent(mainPtr, (CkEvent *) &event); + if (winPtr == mainPtr->focusPtr) { + event.type = CK_EV_FOCUSIN; + event.winPtr = winPtr; + Ck_HandleEvent(mainPtr, (CkEvent *) &event); + } +} + +/* + *-------------------------------------------------------------- + * + * Ck_MoveWindow -- + * + * Move given window and its children. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +Ck_MoveWindow(winPtr, x, y) + CkWindow *winPtr; /* Window to move. */ + int x, y; /* New location for window (within + * parent). */ +{ + CkWindow *childPtr, *parentPtr; + int newx, newy; + + if (winPtr == NULL) + return; + + winPtr->x = x; + winPtr->y = y; + if (winPtr->window == NULL) + return; + + newx = x; + newy = y; + if (!(winPtr->flags & CK_TOPLEVEL)) { + parentPtr = winPtr; + while ((parentPtr = parentPtr->parentPtr) != NULL) { + newx += parentPtr->x; + newy += parentPtr->y; + if (parentPtr->flags & CK_TOPLEVEL) + break; + } + } + if (newx + winPtr->width >= winPtr->mainPtr->maxWidth) { + winPtr->x -= newx - (winPtr->mainPtr->maxWidth - winPtr->width); + newx = winPtr->mainPtr->maxWidth - winPtr->width; + } + if (newy + winPtr->height >= winPtr->mainPtr->maxHeight) { + winPtr->y -= newy - (winPtr->mainPtr->maxHeight - winPtr->height); + newy = winPtr->mainPtr->maxHeight - winPtr->height; + } + if (newx < 0) { + winPtr->x -= newx; + newx = 0; + } + if (newy < 0) { + winPtr->y -= newy; + newy = 0; + } + + mvwin(winPtr->window, newy, newx); + + for (childPtr = winPtr->childList; + childPtr != NULL; childPtr = childPtr->nextPtr) + if (!(childPtr->flags & CK_TOPLEVEL)) + Ck_MoveWindow(childPtr, childPtr->x, childPtr->y); + Ck_EventuallyRefresh(winPtr); +} + +/* + *-------------------------------------------------------------- + * + * Ck_ResizeWindow -- + * + * Resize given window and eventually its children. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +Ck_ResizeWindow(winPtr, width, height) + CkWindow *winPtr; /* Window to resize. */ + int width, height; /* New dimensions for window. */ +{ + CkWindow *childPtr, *parentPtr; + CkWindow *mainWin = winPtr->mainPtr->winPtr; + CkWindowEvent event; + WINDOW *new; + int x, y, evMap = 0, doResize = 0; + + if (winPtr == NULL || winPtr == mainWin) + return; + + /* + * Special case: if both width/height set to -12345, adjust + * within parent window ! + */ + + parentPtr = winPtr->parentPtr; + if (!(width == -12345 && height == -12345)) { + winPtr->width = width; + winPtr->height = height; + doResize++; + } + + if (!(winPtr->flags & CK_TOPLEVEL)) { + if (winPtr->x + winPtr->width >= parentPtr->width) { + winPtr->width = parentPtr->width - winPtr->x; + doResize++; + } + if (winPtr->y + winPtr->height >= parentPtr->height) { + winPtr->height = parentPtr->height - winPtr->y; + doResize++; + } + + if (!doResize) + return; + + if (winPtr->window == NULL) + return; + + parentPtr = winPtr; + x = winPtr->x; + y = winPtr->y; + while ((parentPtr = parentPtr->parentPtr) != NULL) { + x += parentPtr->x; + y += parentPtr->y; + if (parentPtr->flags & CK_TOPLEVEL) + break; + } + } else { + x = winPtr->x; + y = winPtr->y; + } + + if (winPtr->width <= 0) + winPtr->width = 1; + if (winPtr->height <= 0) + winPtr->height = 1; + + if (x + winPtr->width > winPtr->mainPtr->maxWidth) + winPtr->width = winPtr->mainPtr->maxWidth - x; + if (y + winPtr->height > winPtr->mainPtr->maxHeight) + winPtr->height = winPtr->mainPtr->maxHeight - y; + + new = newwin(winPtr->height, winPtr->width, y, x); + if (winPtr->window == NULL) { + winPtr->flags |= CK_MAPPED; + evMap++; + } else { + delwin(winPtr->window); + } + winPtr->window = new; + idlok(winPtr->window, TRUE); + scrollok(winPtr->window, FALSE); + keypad(winPtr->window, TRUE); + nodelay(winPtr->window, TRUE); + meta(winPtr->window, TRUE); + Ck_SetWindowAttr(winPtr, winPtr->fg, winPtr->bg, winPtr->attr); + Ck_ClearToBot(winPtr, 0, 0); + + for (childPtr = winPtr->childList; + childPtr != NULL; childPtr = childPtr->nextPtr) { + if (childPtr->flags & CK_TOPLEVEL) + continue; + Ck_ResizeWindow(childPtr, -12345, -12345); + } + Ck_EventuallyRefresh(winPtr); + + event.type = CK_EV_MAP; + event.winPtr = winPtr; + Ck_HandleEvent(mainWin->mainPtr, (CkEvent *) &event); + event.type = CK_EV_EXPOSE; + event.winPtr = winPtr; + Ck_HandleEvent(mainWin->mainPtr, (CkEvent *) &event); +} + +/* + *-------------------------------------------------------------- + * + * Ck_UnmapWindow, etc. -- + * + * There are several procedures under here, each of which + * mirrors an existing X procedure. In addition to performing + * the functions of the corresponding procedure, each + * procedure also updates the local window structure and + * synthesizes an X event (if the window's structure is being + * managed internally). + * + * Results: + * See the manual entries. + * + * Side effects: + * See the manual entries. + * + *-------------------------------------------------------------- + */ + +void +Ck_UnmapWindow(winPtr) + CkWindow *winPtr; /* Pointer to window to unmap. */ +{ + CkWindow *childPtr; + CkMainInfo *mainPtr = winPtr->mainPtr; + CkWindowEvent event; + + for (childPtr = winPtr->childList; + childPtr != NULL; childPtr = childPtr->nextPtr) { + if (childPtr->flags & CK_TOPLEVEL) + continue; + Ck_UnmapWindow(childPtr); + } + if (!(winPtr->flags & CK_MAPPED)) + return; + winPtr->flags &= ~CK_MAPPED; + delwin(winPtr->window); + winPtr->window = NULL; + Ck_EventuallyRefresh(winPtr); + + if (mainPtr->focusPtr == winPtr) { + CkWindow *parentPtr; + + parentPtr = winPtr->parentPtr; + while (parentPtr != NULL && !(parentPtr->flags & CK_TOPLEVEL)) + parentPtr = parentPtr->parentPtr; + mainPtr->focusPtr = parentPtr; + event.type = CK_EV_FOCUSOUT; + event.winPtr = winPtr; + Ck_HandleEvent(mainPtr, (CkEvent *) &event); + } + event.type = CK_EV_UNMAP; + event.winPtr = winPtr; + Ck_HandleEvent(mainPtr, (CkEvent *) &event); +} + +void +Ck_SetWindowAttr(winPtr, fg, bg, attr) + CkWindow *winPtr; /* Window to manipulate. */ + int fg, bg; /* Foreground/background colors. */ + int attr; /* Video attributes. */ +{ + winPtr->fg = fg; + winPtr->bg = bg; + winPtr->attr = attr; + if (winPtr->window != NULL) { + if ((winPtr->mainPtr->flags & (CK_HAS_COLOR | CK_REVERSE_KLUDGE)) == + (CK_HAS_COLOR | CK_REVERSE_KLUDGE)) { + if (attr & A_REVERSE) { + int tmp; + + attr &= ~A_REVERSE; + tmp = bg; + bg = fg; + fg = tmp; + } + } + wattrset(winPtr->window, attr | Ck_GetPair(winPtr, fg, bg)); + } +} + +void +Ck_GetRootGeometry(winPtr, xPtr, yPtr, widthPtr, heightPtr) + CkWindow *winPtr; + int *xPtr, *yPtr, *widthPtr, *heightPtr; +{ + int x, y; + + if (widthPtr != NULL) + *widthPtr = winPtr->width; + if (heightPtr != NULL) + *heightPtr = winPtr->height; + + x = y = 0; + do { + x += winPtr->x; + y += winPtr->y; + if (winPtr->flags & CK_TOPLEVEL) + break; + winPtr = winPtr->parentPtr; + } while (winPtr != NULL); + if (xPtr != NULL) + *xPtr = x; + if (yPtr != NULL) + *yPtr = y; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_NameToWindow -- + * + * Given a string name for a window, this procedure + * returns the pointer to the window, if there exists a + * window corresponding to the given name. + * + * Results: + * The return result is either the pointer to the window corresponding + * to "name", or else NULL to indicate that there is no such + * window. In this case, an error message is left in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +CkWindow * +Ck_NameToWindow(interp, pathName, winPtr) + Tcl_Interp *interp; /* Where to report errors. */ + char *pathName; /* Path name of window. */ + CkWindow *winPtr; /* Pointer to window: name is assumed to + * belong to the same main window as winPtr. */ +{ + Tcl_HashEntry *hPtr; + + hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, pathName); + if (hPtr == NULL) { + Tcl_AppendResult(interp, "bad window path name \"", + pathName, "\"", (char *) NULL); + return NULL; + } + return (CkWindow *) Tcl_GetHashValue(hPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Ck_SetClass -- + * + * This procedure is used to give a window a class. + * + * Results: + * None. + * + * Side effects: + * A new class is stored for winPtr, replacing any existing + * class for it. + * + *---------------------------------------------------------------------- + */ + +void +Ck_SetClass(winPtr, className) + CkWindow *winPtr; /* Window to assign class. */ + char *className; /* New class for window. */ +{ + winPtr->classUid = Ck_GetUid(className); + CkOptionClassChanged(winPtr); +} + +/* + *---------------------------------------------------------------------- + * + * UnlinkWindow -- + * + * This procedure removes a window from the childList of its + * parent. + * + * Results: + * None. + * + * Side effects: + * The window is unlinked from its childList. + * + *---------------------------------------------------------------------- + */ + +static void +UnlinkWindow(winPtr) + CkWindow *winPtr; /* Child window to be unlinked. */ +{ + CkWindow *prevPtr; + + if (winPtr->parentPtr == NULL) + return; + prevPtr = winPtr->parentPtr->childList; + if (prevPtr == winPtr) { + winPtr->parentPtr->childList = winPtr->nextPtr; + if (winPtr->nextPtr == NULL) + winPtr->parentPtr->lastChildPtr = NULL; + } else { + while (prevPtr->nextPtr != winPtr) { + prevPtr = prevPtr->nextPtr; + if (prevPtr == NULL) + panic("UnlinkWindow couldn't find child in parent"); + } + prevPtr->nextPtr = winPtr->nextPtr; + if (winPtr->nextPtr == NULL) + winPtr->parentPtr->lastChildPtr = prevPtr; + } +} + +/* + *---------------------------------------------------------------------- + * + * UnlinkToplevel -- + * + * This procedure removes a window from the toplevel list. + * + * Results: + * None. + * + * Side effects: + * The window is unlinked from the toplevel list. + * + *---------------------------------------------------------------------- + */ + +static void +UnlinkToplevel(winPtr) + CkWindow *winPtr; +{ + CkWindow *prevPtr; + + prevPtr = winPtr->mainPtr->topLevPtr; + if (prevPtr == winPtr) { + winPtr->mainPtr->topLevPtr = winPtr->topLevPtr; + } else { + while (prevPtr->topLevPtr != winPtr) { + prevPtr = prevPtr->topLevPtr; + if (prevPtr == NULL) + panic("UnlinkToplevel couldn't find toplevel"); + } + prevPtr->topLevPtr = winPtr->topLevPtr; + } +} + +/* + *---------------------------------------------------------------------- + * + * Ck_RestackWindow -- + * + * Change a window's position in the stacking order. + * + * Results: + * TCL_OK is normally returned. If other is not a descendant + * of winPtr's parent then TCL_ERROR is returned and winPtr is + * not repositioned. + * + * Side effects: + * WinPtr is repositioned in the stacking order. + * + *---------------------------------------------------------------------- + */ + +int +Ck_RestackWindow(winPtr, aboveBelow, otherPtr) + CkWindow *winPtr; /* Pointer to window whose position in + * the stacking order is to change. */ + int aboveBelow; /* Indicates new position of winPtr relative + * to other; must be Above or Below. */ + CkWindow *otherPtr; /* WinPtr will be moved to a position that + * puts it just above or below this window. + * If NULL then winPtr goes above or below + * all windows in the same parent. */ +{ + CkWindow *prevPtr; + + if (winPtr->flags & CK_TOPLEVEL) { + if (otherPtr != NULL) { + while (otherPtr != NULL && !(otherPtr->flags & CK_TOPLEVEL)) + otherPtr = otherPtr->parentPtr; + } + if (otherPtr == winPtr) + return TCL_OK; + + UnlinkToplevel(winPtr); + if (aboveBelow == CK_ABOVE) { + if (otherPtr == NULL) { + winPtr->topLevPtr = winPtr->mainPtr->topLevPtr; + winPtr->mainPtr->topLevPtr = winPtr; + } else { + CkWindow *thisPtr = winPtr->mainPtr->topLevPtr; + + prevPtr = NULL; + while (thisPtr != NULL && thisPtr != otherPtr) { + prevPtr = thisPtr; + thisPtr = thisPtr->topLevPtr; + } + if (prevPtr == NULL) { + winPtr->topLevPtr = winPtr->mainPtr->topLevPtr; + winPtr->mainPtr->topLevPtr = winPtr; + } else { + winPtr->topLevPtr = prevPtr->topLevPtr; + prevPtr->topLevPtr = winPtr; + } + } + } else { + CkWindow *thisPtr = winPtr->mainPtr->topLevPtr; + + prevPtr = NULL; + while (thisPtr != NULL && thisPtr != otherPtr) { + prevPtr = thisPtr; + thisPtr = thisPtr->topLevPtr; + } + if (thisPtr == NULL) { + winPtr->topLevPtr = prevPtr->topLevPtr; + prevPtr->topLevPtr = winPtr; + } else { + winPtr->topLevPtr = thisPtr->topLevPtr; + thisPtr->topLevPtr = winPtr; + } + } + ChangeToplevelFocus(winPtr->mainPtr->topLevPtr); + goto done; + } + + /* + * Find an ancestor of otherPtr that is a sibling of winPtr. + */ + + if (otherPtr == NULL) { + if (aboveBelow == CK_BELOW) + otherPtr = winPtr->parentPtr->lastChildPtr; + else + otherPtr = winPtr->parentPtr->childList; + } else { + while (winPtr->parentPtr != otherPtr->parentPtr) { + otherPtr = otherPtr->parentPtr; + if (otherPtr == NULL) + return TCL_ERROR; + } + } + if (otherPtr == winPtr) + return TCL_OK; + + /* + * Reposition winPtr in the stacking order. + */ + + UnlinkWindow(winPtr); + if (aboveBelow == CK_BELOW) { + winPtr->nextPtr = otherPtr->nextPtr; + if (winPtr->nextPtr == NULL) + winPtr->parentPtr->lastChildPtr = winPtr; + otherPtr->nextPtr = winPtr; + } else { + prevPtr = winPtr->parentPtr->childList; + if (prevPtr == otherPtr) + winPtr->parentPtr->childList = winPtr; + else { + while (prevPtr->nextPtr != otherPtr) + prevPtr = prevPtr->nextPtr; + prevPtr->nextPtr = winPtr; + } + winPtr->nextPtr = otherPtr; + } + +done: + Ck_EventuallyRefresh(winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_SetFocus -- + * + * This procedure is invoked to change the focus window for a + * given display in a given application. + * + * Results: + * None. + * + * Side effects: + * Event handlers may be invoked to process the change of + * focus. + * + *---------------------------------------------------------------------- + */ + +void +Ck_SetFocus(winPtr) + CkWindow *winPtr; /* Window that is to be the new focus. */ +{ + CkMainInfo *mainPtr = winPtr->mainPtr; + CkEvent event; + CkWindow *oldTop = NULL, *newTop, *oldFocus; + + if (winPtr == mainPtr->focusPtr) + return; + + oldFocus = mainPtr->focusPtr; + if (oldFocus != NULL) { + for (oldTop = oldFocus; oldTop != NULL && + !(oldTop->flags & CK_TOPLEVEL); oldTop = oldTop->parentPtr) { + /* Empty loop body. */ + } + event.win.type = CK_EV_FOCUSOUT; + event.win.winPtr = oldFocus; + Ck_HandleEvent(mainPtr, &event); + } + mainPtr->focusPtr = winPtr; + for (newTop = winPtr; newTop != NULL && + !(newTop->flags & CK_TOPLEVEL); newTop = newTop->parentPtr) { + /* Empty loop body. */ + } + if (oldTop != newTop) { + if (oldTop != NULL) + oldTop->focusPtr = oldFocus; + Ck_RestackWindow(newTop, CK_ABOVE, NULL); + Ck_EventuallyRefresh(mainPtr->winPtr); + } + if (winPtr->flags & CK_MAPPED) { + event.win.type = CK_EV_FOCUSIN; + event.win.winPtr = winPtr; + Ck_HandleEvent(mainPtr, &event); + Ck_EventuallyRefresh(mainPtr->winPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ChangeToplevelFocus -- + * + *---------------------------------------------------------------------- + */ + +static void +ChangeToplevelFocus(winPtr) + CkWindow *winPtr; +{ + CkWindow *winTop, *oldTop; + CkMainInfo *mainPtr; + + if (winPtr == NULL) + return; + + mainPtr = winPtr->mainPtr; + for (winTop = winPtr; winTop != NULL && !(winTop->flags & CK_TOPLEVEL); + winTop = winTop->parentPtr) { + /* Empty loop body. */ + } + for (oldTop = mainPtr->focusPtr; oldTop != NULL && + !(oldTop->flags & CK_TOPLEVEL); oldTop = oldTop->parentPtr) { + /* Empty loop body. */ + } + if (winTop != oldTop) { + CkEvent event; + + if (oldTop != NULL) { + oldTop->focusPtr = mainPtr->focusPtr; + event.win.type = CK_EV_FOCUSOUT; + event.win.winPtr = mainPtr->focusPtr; + Ck_HandleEvent(mainPtr, &event); + } + mainPtr->focusPtr = winTop->focusPtr; + event.win.type = CK_EV_FOCUSIN; + event.win.winPtr = mainPtr->focusPtr; + Ck_HandleEvent(mainPtr, &event); + } +} + +/* + *---------------------------------------------------------------------- + * + * Ck_EventuallyRefresh -- + * + * Dispatch refresh of entire screen. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Ck_EventuallyRefresh(winPtr) + CkWindow *winPtr; +{ + if (++winPtr->mainPtr->refreshCount == 1) + Tcl_DoWhenIdle(DoRefresh, (ClientData) winPtr->mainPtr); +} + +/* + *---------------------------------------------------------------------- + * + * DoRefresh -- + * + * Refresh all curses windows. If the terminal is connected via + * a network connection (ie terminal server) the curses typeahead + * mechanism is not sufficient for delaying screen updates due to + * TCP buffering. + * Therefore the refreshDelay may be used in order to limit updates + * to happen not more often than 1000/refreshDelay times per second. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +DoRefresh(clientData) + ClientData clientData; +{ + CkMainInfo *mainPtr = (CkMainInfo *) clientData; + + if (mainPtr->flags & CK_REFRESH_TIMER) { + Tk_DeleteTimerHandler(mainPtr->refreshTimer); + mainPtr->flags &= ~CK_REFRESH_TIMER; + } + if (--mainPtr->refreshCount > 0) { + Tk_DoWhenIdle2(DoRefresh, clientData); + return; + } + mainPtr->refreshCount = 0; + if (mainPtr->refreshDelay > 0) { +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + struct timeval tv; + double t0; + + gettimeofday(&tv, (struct timezone *) NULL); + t0 = (tv.tv_sec + 0.000001 * tv.tv_usec) * 1000; +#else + Tcl_Time tv; + double t0; + extern void TclpGetTime _ANSI_ARGS_((Tcl_Time *timePtr)); + + TclpGetTime(&tv); + t0 = (tv.sec + 0.000001 * tv.usec) * 1000; +#endif + if (t0 - mainPtr->lastRefresh < mainPtr->refreshDelay) { + mainPtr->refreshTimer = Tk_CreateTimerHandler( + mainPtr->refreshDelay - (int) (t0 - mainPtr->lastRefresh), + DoRefresh, clientData); + mainPtr->flags |= CK_REFRESH_TIMER; + return; + } + mainPtr->lastRefresh = t0; + } + curs_set(0); + RefreshToplevels(mainPtr->topLevPtr); + UpdateHWCursor(ckMainInfo); + doupdate(); +} + +/* + *---------------------------------------------------------------------- + * + * RefreshToplevels -- + * + * Recursively refresh all toplevel windows starting at winPtr. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +RefreshToplevels(winPtr) + CkWindow *winPtr; +{ + if (winPtr->topLevPtr != NULL) + RefreshToplevels(winPtr->topLevPtr); + if (winPtr->window != NULL) { + touchwin(winPtr->window); + wnoutrefresh(winPtr->window); + if (winPtr->childList != NULL) + RefreshThem(winPtr->childList); + } +} + +/* + *---------------------------------------------------------------------- + * + * RefreshThem -- + * + * Recursively refresh all curses windows starting at winPtr. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +RefreshThem(winPtr) + CkWindow *winPtr; +{ + if (winPtr->nextPtr != NULL) + RefreshThem(winPtr->nextPtr); + if (winPtr->flags & CK_TOPLEVEL) + return; + if (winPtr->window != NULL) { + touchwin(winPtr->window); + wnoutrefresh(winPtr->window); + } + if (winPtr->childList != NULL) + RefreshThem(winPtr->childList); +} + +/* + *---------------------------------------------------------------------- + * + * UpdateHWCursor -- + * + * Make hardware cursor (in)visible for given window using curses. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateHWCursor(mainPtr) + CkMainInfo *mainPtr; +{ + int x, y; + CkWindow *wPtr, *stopAtWin, *winPtr = mainPtr->focusPtr; + + if (winPtr == NULL || winPtr->window == NULL || + (winPtr->flags & (CK_SHOW_CURSOR | CK_ALREADY_DEAD)) == 0) { +invisible: + curs_set(0); + if (mainPtr->focusPtr != NULL && mainPtr->focusPtr->window != NULL) + wnoutrefresh(mainPtr->focusPtr->window); + return; + } + + /* + * Get position of HW cursor in winPtr coordinates. + */ + + getyx(winPtr->window, y, x); + + stopAtWin = NULL; + while (winPtr != NULL) { + for (wPtr = winPtr->childList; + wPtr != NULL && wPtr != stopAtWin; wPtr = wPtr->nextPtr) { + if ((wPtr->flags & CK_TOPLEVEL) || wPtr->window == NULL) + continue; + if (x >= wPtr->x && x < wPtr->x + wPtr->width && + y >= wPtr->y && y < wPtr->y + wPtr->height) + goto invisible; + } + x += winPtr->x; + y += winPtr->y; + stopAtWin = winPtr; + if (winPtr->parentPtr == NULL) + break; + winPtr = winPtr->parentPtr; + if (winPtr->flags & CK_TOPLEVEL) + break; + } + for (wPtr = mainPtr->topLevPtr; wPtr != NULL && wPtr != winPtr; + wPtr = wPtr->topLevPtr) + if (x >= wPtr->x && x < wPtr->x + wPtr->width && + y >= wPtr->y && y < wPtr->y + wPtr->height) + goto invisible; + curs_set(1); + wnoutrefresh(mainPtr->focusPtr->window); +} + +/* + *---------------------------------------------------------------------- + * + * GetWindowXY -- + * + * Given X, Y coordinates, return topmost window. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static CkWindow * +GetWindowXY(winPtr, xPtr, yPtr) + CkWindow *winPtr; + int *xPtr, *yPtr; +{ + int x, y; + CkWindow *wPtr; + + x = *xPtr - winPtr->x; y = *yPtr - winPtr->y; + for (wPtr = winPtr->childList; wPtr != NULL; wPtr = wPtr->nextPtr) { + if (!(wPtr->flags & CK_MAPPED) || (wPtr->flags & CK_TOPLEVEL)) + continue; + if (x >= wPtr->x && x < wPtr->x + wPtr->width && + y >= wPtr->y && y < wPtr->y + wPtr->height) { + wPtr = GetWindowXY(wPtr, &x, &y); + *xPtr = x; + *yPtr = y; + return wPtr; + } + } + *xPtr = x; + *yPtr = y; + return winPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_GetWindowXY -- + * + * Given X, Y coordinates, return topmost window. + * If mode is zero, consider all toplevels, otherwise consider + * only topmost toplevel in search. + * + * Results: + * Window pointer or NULL. *xPtr, *yPtr are adjusted to window + * coordinate system if possible. + * + *---------------------------------------------------------------------- + */ + +CkWindow * +Ck_GetWindowXY(mainPtr, xPtr, yPtr, mode) + CkMainInfo *mainPtr; + int *xPtr, *yPtr, mode; +{ + int x, y, x0, y0; + CkWindow *wPtr; + + x0 = *xPtr; y0 = *yPtr; + wPtr = mainPtr->topLevPtr; +nextToplevel: + x = x0; y = y0; + if (wPtr->flags & CK_MAPPED) { + if (x >= wPtr->x && x < wPtr->x + wPtr->width && + y >= wPtr->y && y < wPtr->y + wPtr->height) { + wPtr = GetWindowXY(wPtr, &x, &y); + *xPtr = x; + *yPtr = y; + return wPtr; + } else { + *xPtr = -1; + *yPtr = -1; + } + } else if (mode) { + return NULL; + } + if (mode == 0) { + wPtr = wPtr->topLevPtr; + if (wPtr != NULL) + goto nextToplevel; + } + return wPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Ck_SetHWCursor -- + * + * Make hardware cursor (in)visible for given window. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Ck_SetHWCursor(winPtr, newState) + CkWindow *winPtr; + int newState; +{ + int oldState = winPtr->flags & CK_SHOW_CURSOR; + + if (newState == oldState) + return; + + if (newState) + winPtr->flags |= CK_SHOW_CURSOR; + else + winPtr->flags &= ~CK_SHOW_CURSOR; + if (winPtr == winPtr->mainPtr->focusPtr) + UpdateHWCursor(winPtr->mainPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Ck_ClearToEol -- + * + * Clear window starting from given position, til end of line. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Ck_ClearToEol(winPtr, x, y) + CkWindow *winPtr; + int x, y; +{ + WINDOW *window = winPtr->window; + + if (window == NULL) + return; + + if (x == -1 && y == -1) + getyx(window, y, x); + else + wmove(window, y, x); + for (; x < winPtr->width; x++) + waddch(window, ' '); +} + +/* + *---------------------------------------------------------------------- + * + * Ck_ClearToBot -- + * + * Clear window starting from given position, til end of screen. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Ck_ClearToBot(winPtr, x, y) + CkWindow *winPtr; + int x, y; +{ + WINDOW *window = winPtr->window; + + if (window == NULL) + return; + + wmove(window, y, x); + for (; x < winPtr->width; x++) + waddch(window, ' '); + for (++y; y < winPtr->height; y++) { + wmove(window, y, 0); + for (x = 0; x < winPtr->width; x++) + waddch(window, ' '); + } +} + +/* + *---------------------------------------------------------------------- + * + * DeadAppCmd -- + * + * Report error since toolkit gone. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +DeadAppCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + interp->result = "toolkit uninstalled"; + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * ExecCmd -- + * + * Own version of "exec" Tcl command which supports the -endwin + * option. + * + * Results: + * See documentation for "exec". + * + *---------------------------------------------------------------------- + */ + +static int +ExecCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + RedirInfo *redirInfo = (RedirInfo *) clientData; + Tcl_CmdInfo *cmdInfo = &redirInfo->cmdInfo; + int result, endWin = 0; + char *savedargv1; +#ifdef SIGINT +#ifdef HAVE_SIGACTION + struct sigaction oldsig, newsig; +#else + Ck_SignalProc sigproc; +#endif +#endif + + if (argc > 1 && strcmp(argv[1], "-endwin") == 0) { + endWin = 1; + savedargv1 = argv[1]; + argv[1] = argv[0]; + curs_set(1); + endwin(); +#ifdef SIGINT +#ifdef HAVE_SIGACTION + newsig.sa_handler = SIG_IGN; + sigfillset(&newsig.sa_mask); + newsig.sa_flags = 0; + sigaction(SIGINT, &newsig, &oldsig); +#else + sigproc = signal(SIGINT, SIG_IGN); +#endif +#endif + } + result = (*cmdInfo->proc)(cmdInfo->clientData, interp, + argc - endWin, argv + endWin); + if (endWin) { +#ifdef SIGINT +#ifdef HAVE_SIGACTION + sigaction(SIGINT, &oldsig, NULL); +#else + signal(SIGINT, sigproc); +#endif +#endif + argv[0] = argv[1]; + argv[1] = savedargv1; + Ck_EventuallyRefresh(redirInfo->mainPtr->winPtr); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * PutsCmd -- + * + * Redirect "puts" Tcl command from "stdout" to "stderr" in the + * hope that it will not destroy our screen. + * + * Results: + * See documentation of "puts" command. + * + *---------------------------------------------------------------------- + */ + +static int +PutsCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + RedirInfo *redirInfo = (RedirInfo *) clientData; + Tcl_CmdInfo *cmdInfo = &redirInfo->cmdInfo; + int index = 0; + char *newArgv[5]; + + newArgv[0] = argv[0]; + if (argc > 1 && strcmp(argv[1], "-nonewline") == 0) { + newArgv[1] = argv[1]; + index++; + } + if (argc == index + 2) { + newArgv[index + 2] = argv[index + 1]; +toStderr: + newArgv[index + 1] = "stderr"; + return (*cmdInfo->proc)(cmdInfo->clientData, interp, + index + 3, newArgv); + } else if (argc == index + 3 && + (strcmp(argv[index + 1], "stdout") == 0 || + strcmp(argv[index + 1], "file1") == 0)) { + newArgv[index + 2] = argv[index + 2]; + goto toStderr; + } + return (*cmdInfo->proc)(cmdInfo->clientData, interp, argc, argv); +} + +/* + *---------------------------------------------------------------------- + * + * CloseCmd -- + * + * Report error when attempt is made to close stdin or stdout. + * + * Results: + * See documentation of "close" command. + * + *---------------------------------------------------------------------- + */ + +static int +CloseCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + RedirInfo *redirInfo = (RedirInfo *) clientData; + Tcl_CmdInfo *cmdInfo = &redirInfo->cmdInfo; + + if (argc == 2 && + (strcmp(argv[1], "stdin") == 0 || + strcmp(argv[1], "file0") == 0 || + strcmp(argv[1], "stdout") == 0 || + strcmp(argv[1], "file1") == 0)) { + Tcl_AppendResult(interp, "may not close fileId \"", + argv[1], "\" while in toolkit", (char *) NULL); + return TCL_ERROR; + } + return (*cmdInfo->proc)(cmdInfo->clientData, interp, argc, argv); +} + +/* + *---------------------------------------------------------------------- + * + * FlushCmd -- + * + * Report error when attempt is made to flush stdin or stdout. + * + * Results: + * See documentation of "flush" command. + * + *---------------------------------------------------------------------- + */ + +static int +FlushCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + RedirInfo *redirInfo = (RedirInfo *) clientData; + Tcl_CmdInfo *cmdInfo = &redirInfo->cmdInfo; + + if (argc == 2 && + (strcmp(argv[1], "stdin") == 0 || + strcmp(argv[1], "file0") == 0 || + strcmp(argv[1], "stdout") == 0 || + strcmp(argv[1], "file1") == 0)) { + Tcl_AppendResult(interp, "may not flush fileId \"", + argv[1], "\" while in toolkit", (char *) NULL); + return TCL_ERROR; + } + return (*cmdInfo->proc)(cmdInfo->clientData, interp, argc, argv); +} + +/* + *---------------------------------------------------------------------- + * + * ReadCmd -- + * + * Report error when attempt is made to read from stdin. + * + * Results: + * See documentation of "read" command. + * + *---------------------------------------------------------------------- + */ + +static int +ReadCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + RedirInfo *redirInfo = (RedirInfo *) clientData; + Tcl_CmdInfo *cmdInfo = &redirInfo->cmdInfo; + + if ((argc > 1 && + (strcmp(argv[1], "stdin") == 0 || + strcmp(argv[1], "file0") == 0)) || + (argc > 2 && + (strcmp(argv[2], "stdin") == 0 || + strcmp(argv[2], "file0") == 0))) { + Tcl_AppendResult(interp, "may not read from fileId \"", + argv[1], "\" while in toolkit", (char *) NULL); + return TCL_ERROR; + } + return (*cmdInfo->proc)(cmdInfo->clientData, interp, argc, argv); +} + +/* + *---------------------------------------------------------------------- + * + * GetsCmd -- + * + * Report error when attempt is made to read from stdin. + * + * Results: + * See documentation of "gets" command. + * + *---------------------------------------------------------------------- + */ + +static int +GetsCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + RedirInfo *redirInfo = (RedirInfo *) clientData; + Tcl_CmdInfo *cmdInfo = &redirInfo->cmdInfo; + + if (argc >= 2 && + (strcmp(argv[1], "stdin") == 0 || + strcmp(argv[1], "file0") == 0)) { + Tcl_AppendResult(interp, "may not gets from fileId \"", + argv[1], "\" while in toolkit", (char *) NULL); + return TCL_ERROR; + } + return (*cmdInfo->proc)(cmdInfo->clientData, interp, argc, argv); +} + +#ifdef __WIN32__ + +/* + *---------------------------------------------------------------------- + * + * WIN32 specific curses input event handling. + * + *---------------------------------------------------------------------- + */ + +static void +InputSetup(inputInfo) + InputInfo *inputInfo; +{ + WNDCLASS class; + DWORD id; + + /* + * Create the async notification window with a new class. + */ + class.style = 0; + class.cbClsExtra = 0; + class.cbWndExtra = 0; + class.hInstance = GetModuleHandle(NULL); + class.hbrBackground = NULL; + class.lpszMenuName = NULL; + class.lpszClassName = "CursesInput"; + class.lpfnWndProc = InputHandler; + class.hIcon = NULL; + class.hCursor = NULL; + if (RegisterClass(&class)) { + inputInfo->hwnd = + CreateWindow("CursesInput", "CursesInput", WS_TILED, 0, 0, + 0, 0, NULL, NULL, class.hInstance, NULL); + } + if (inputInfo->hwnd == NULL) { + panic("cannot create curses input window"); + } + SetWindowLong(inputInfo->hwnd, GWL_USERDATA, (LONG) inputInfo); + inputInfo->thread = CreateThread(NULL, 4096, + (LPTHREAD_START_ROUTINE) InputThread, + (void *) inputInfo, 0, &id); + Tcl_CreateExitHandler(InputExit, (ClientData) inputInfo); +} + +static void +InputExit(clientData) + ClientData clientData; +{ + InputInfo *inputInfo = (InputInfo *) clientData; + + if (inputInfo->hwnd != NULL) { + HWND hwnd = inputInfo->hwnd; + + inputInfo->hwnd = NULL; + DestroyWindow(hwnd); + } + if (inputInfo->thread != INVALID_HANDLE_VALUE) { + WaitForSingleObject(inputInfo->thread, 1000); + } +} + +static void +InputThread(arg) + void *arg; +{ + InputInfo *inputInfo = (InputInfo *) arg; + INPUT_RECORD ip; + DWORD nRead; + + while (inputInfo->hwnd != NULL) { + nRead = 0; + PeekConsoleInput(inputInfo->stdinHandle, &ip, 1, &nRead); + if (nRead > 0) { + PostMessage(inputInfo->hwnd, WM_USER + 42, 0, 0); + } + Sleep(10); + } + inputInfo->thread = INVALID_HANDLE_VALUE; + ExitThread(0); +} + +static LRESULT CALLBACK +InputHandler(hwnd, message, wParam, lParam) + HWND hwnd; + UINT message; + WPARAM wParam; + LPARAM lParam; +{ + InputInfo *inputInfo = (InputInfo *) GetWindowLong(hwnd, GWL_USERDATA); + + if (message != WM_USER + 42) { + return DefWindowProc(hwnd, message, wParam, lParam); + } + Tk_DoWhenIdle(InputHandler2, (ClientData) inputInfo); + return 0; +} + +static void +InputHandler2(clientData) + ClientData clientData; +{ + InputInfo *inputInfo = (InputInfo *) clientData; + INPUT_RECORD ip; + DWORD nRead; + + do { + CkHandleInput((ClientData) inputInfo->mainPtr, TCL_READABLE); + nRead = 0; + PeekConsoleInput(inputInfo->stdinHandle, &ip, 1, &nRead); + } while (nRead != 0); +} + +#endif + + diff --git a/compat/license.terms b/compat/license.terms new file mode 100644 index 0000000..3dcd816 --- /dev/null +++ b/compat/license.terms @@ -0,0 +1,32 @@ +This software is copyrighted by the Regents of the University of +California, Sun Microsystems, Inc., and other parties. The following +terms apply to all files associated with the software unless explicitly +disclaimed in individual files. + +The authors hereby grant permission to use, copy, modify, distribute, +and license this software and its documentation for any purpose, provided +that existing copyright notices are retained in all copies and that this +notice is included verbatim in any distributions. No written agreement, +license, or royalty fee is required for any of the authorized uses. +Modifications to this software may be copyrighted by their authors +and need not follow the licensing terms described here, provided that +the new terms are clearly indicated on the first page of each file where +they apply. + +IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. + +THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +MODIFICATIONS. + +RESTRICTED RIGHTS: Use, duplication or disclosure by the government +is subject to the restrictions as set forth in subparagraph (c) (1) (ii) +of the Rights in Technical Data and Computer Software Clause as DFARS +252.227-7013 and FAR 52.227-19. diff --git a/compat/stdlib.h b/compat/stdlib.h new file mode 100644 index 0000000..dd8cb91 --- /dev/null +++ b/compat/stdlib.h @@ -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 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * @(#) stdlib.h 1.9 94/12/17 16:26:20 + */ + +#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 --git a/compat/unistd.h b/compat/unistd.h new file mode 100644 index 0000000..66e1250 --- /dev/null +++ b/compat/unistd.h @@ -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. + * + * @(#) unistd.h 1.5 94/12/17 16:26:27 + */ + +#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 --git a/config.guess b/config.guess new file mode 100755 index 0000000..1127162 --- /dev/null +++ b/config.guess @@ -0,0 +1,1415 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003 Free Software Foundation, Inc. + +timestamp='2003-10-07' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +# Originally written by Per Bothner . +# Please send patches to . Submit a context +# diff and a properly formatted ChangeLog entry. +# +# This script attempts to guess a canonical system name similar to +# config.sub. If it succeeds, it prints the system name on stdout, and +# exits with 0. Otherwise, it exits with 1. +# +# The plan is that this can be called by configure scripts if you +# don't specify an explicit build system type. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 +Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit 0 ;; + --version | -v ) + echo "$version" ; exit 0 ;; + --help | --h* | -h ) + echo "$usage"; exit 0 ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +trap 'exit 1' 1 2 15 + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +set_cc_for_build=' +trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; +trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; +: ${TMPDIR=/tmp} ; + { tmp=`(umask 077 && mktemp -d -q "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; +dummy=$tmp/dummy ; +tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; +case $CC_FOR_BUILD,$HOST_CC,$CC in + ,,) echo "int x;" > $dummy.c ; + for c in cc gcc c89 c99 ; do + if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then + CC_FOR_BUILD="$c"; break ; + fi ; + done ; + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found ; + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; +esac ;' + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if (test -f /.attbin/uname) >/dev/null 2>&1 ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown +UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + +# Note: order is significant - the case branches are not exclusive. + +case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" + UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ + /usr/sbin/$sysctl 2>/dev/null || echo unknown)` + case "${UNAME_MACHINE_ARCH}" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently, or will in the future. + case "${UNAME_MACHINE_ARCH}" in + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep __ELF__ >/dev/null + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "${UNAME_VERSION}" in + Debian*) + release='-gnu' + ;; + *) + release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" + exit 0 ;; + amiga:OpenBSD:*:*) + echo m68k-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + arc:OpenBSD:*:*) + echo mipsel-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + hp300:OpenBSD:*:*) + echo m68k-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + mac68k:OpenBSD:*:*) + echo m68k-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + macppc:OpenBSD:*:*) + echo powerpc-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + mvme68k:OpenBSD:*:*) + echo m68k-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + mvme88k:OpenBSD:*:*) + echo m88k-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + mvmeppc:OpenBSD:*:*) + echo powerpc-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + pmax:OpenBSD:*:*) + echo mipsel-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + sgi:OpenBSD:*:*) + echo mipseb-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + sun3:OpenBSD:*:*) + echo m68k-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + wgrisc:OpenBSD:*:*) + echo mipsel-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + *:OpenBSD:*:*) + echo ${UNAME_MACHINE}-unknown-openbsd${UNAME_RELEASE} + exit 0 ;; + alpha:OSF1:*:*) + if test $UNAME_RELEASE = "V4.0"; then + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` + fi + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE="alpha" ;; + "EV4.5 (21064)") + UNAME_MACHINE="alpha" ;; + "LCA4 (21066/21068)") + UNAME_MACHINE="alpha" ;; + "EV5 (21164)") + UNAME_MACHINE="alphaev5" ;; + "EV5.6 (21164A)") + UNAME_MACHINE="alphaev56" ;; + "EV5.6 (21164PC)") + UNAME_MACHINE="alphapca56" ;; + "EV5.7 (21164PC)") + UNAME_MACHINE="alphapca57" ;; + "EV6 (21264)") + UNAME_MACHINE="alphaev6" ;; + "EV6.7 (21264A)") + UNAME_MACHINE="alphaev67" ;; + "EV6.8CB (21264C)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8AL (21264B)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8CX (21264D)") + UNAME_MACHINE="alphaev68" ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE="alphaev69" ;; + "EV7 (21364)") + UNAME_MACHINE="alphaev7" ;; + "EV7.9 (21364A)") + UNAME_MACHINE="alphaev79" ;; + esac + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + exit 0 ;; + Alpha*:OpenVMS:*:*) + echo alpha-hp-vms + exit 0 ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix + exit 0 ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 + exit 0 ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit 0;; + *:[Aa]miga[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-amigaos + exit 0 ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-morphos + exit 0 ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit 0 ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} + exit 0;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit 0;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit 0 ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit 0 ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit 0 ;; + DRS?6000:UNIX_SV:4.2*:7*) + case `/usr/bin/uname -p` in + sparc) echo sparc-icl-nx7 && exit 0 ;; + esac ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit 0 ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit 0 ;; + i86pc:SunOS:5.*:*) + echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit 0 ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit 0 ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) + UNAME_RELEASE=`uname -v` + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` + exit 0 ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos${UNAME_RELEASE} + exit 0 ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 + case "`/bin/arch`" in + sun3) + echo m68k-sun-sunos${UNAME_RELEASE} + ;; + sun4) + echo sparc-sun-sunos${UNAME_RELEASE} + ;; + esac + exit 0 ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos${UNAME_RELEASE} + exit 0 ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit 0 ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit 0 ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit 0 ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint${UNAME_RELEASE} + exit 0 ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint${UNAME_RELEASE} + exit 0 ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint${UNAME_RELEASE} + exit 0 ;; + powerpc:machten:*:*) + echo powerpc-apple-machten${UNAME_RELEASE} + exit 0 ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit 0 ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix${UNAME_RELEASE} + exit 0 ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix${UNAME_RELEASE} + exit 0 ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix${UNAME_RELEASE} + exit 0 ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +#ifdef __cplusplus +#include /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c \ + && $dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ + && exit 0 + echo mips-mips-riscos${UNAME_RELEASE} + exit 0 ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit 0 ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit 0 ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit 0 ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit 0 ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit 0 ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit 0 ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit 0 ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` + if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] + then + if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ + [ ${TARGET_BINARY_INTERFACE}x = x ] + then + echo m88k-dg-dgux${UNAME_RELEASE} + else + echo m88k-dg-dguxbcs${UNAME_RELEASE} + fi + else + echo i586-dg-dgux${UNAME_RELEASE} + fi + exit 0 ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit 0 ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit 0 ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit 0 ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit 0 ;; + *:IRIX*:*:*) + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` + exit 0 ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit 0 ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} + exit 0 ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && $dummy && exit 0 + echo rs6000-ibm-aix3.2.5 + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit 0 ;; + *:AIX:*:[45]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${IBM_ARCH}-ibm-aix${IBM_REV} + exit 0 ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit 0 ;; + ibmrt:4.4BSD:*|romp-ibm:BSD:*) + echo romp-ibm-bsd4.4 + exit 0 ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to + exit 0 ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit 0 ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit 0 ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit 0 ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit 0 ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + case "${UNAME_MACHINE}" in + 9000/31? ) HP_ARCH=m68000 ;; + 9000/[34]?? ) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if [ -x /usr/bin/getconf ]; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; + '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 + esac ;; + esac + fi + if [ "${HP_ARCH}" = "" ]; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + + #define _HPUX_SOURCE + #include + #include + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if [ ${HP_ARCH} = "hppa2.0w" ] + then + # avoid double evaluation of $set_cc_for_build + test -n "$CC_FOR_BUILD" || eval $set_cc_for_build + if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E -) | grep __LP64__ >/dev/null + then + HP_ARCH="hppa2.0w" + else + HP_ARCH="hppa64" + fi + fi + echo ${HP_ARCH}-hp-hpux${HPUX_REV} + exit 0 ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux${HPUX_REV} + exit 0 ;; + 3050*:HI-UX:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && $dummy && exit 0 + echo unknown-hitachi-hiuxwe2 + exit 0 ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) + echo hppa1.1-hp-bsd + exit 0 ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit 0 ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit 0 ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) + echo hppa1.1-hp-osf + exit 0 ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit 0 ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo ${UNAME_MACHINE}-unknown-osf1mk + else + echo ${UNAME_MACHINE}-unknown-osf1 + fi + exit 0 ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit 0 ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit 0 ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit 0 ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit 0 ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit 0 ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit 0 ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit 0 ;; + CRAY*[A-Z]90:*:*:*) + echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit 0 ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit 0 ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit 0 ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit 0 ;; + *:UNICOS/mp:*:*) + echo nv1-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit 0 ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit 0 ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} + exit 0 ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi${UNAME_RELEASE} + exit 0 ;; + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} + exit 0 ;; + *:FreeBSD:*:*) + # Determine whether the default compiler uses glibc. + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + #if __GLIBC__ >= 2 + LIBC=gnu + #else + LIBC= + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` + # GNU/KFreeBSD systems have a "k" prefix to indicate we are using + # FreeBSD's kernel, but not the complete OS. + case ${LIBC} in gnu) kernel_only='k' ;; esac + echo ${UNAME_MACHINE}-unknown-${kernel_only}freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`${LIBC:+-$LIBC} + exit 0 ;; + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin + exit 0 ;; + i*:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 + exit 0 ;; + i*:PW*:*) + echo ${UNAME_MACHINE}-pc-pw32 + exit 0 ;; + x86:Interix*:[34]*) + echo i586-pc-interix${UNAME_RELEASE}|sed -e 's/\..*//' + exit 0 ;; + [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) + echo i${UNAME_MACHINE}-pc-mks + exit 0 ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i586-pc-interix + exit 0 ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin + exit 0 ;; + p*:CYGWIN*:*) + echo powerpcle-unknown-cygwin + exit 0 ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit 0 ;; + *:GNU:*:*) + # the GNU system + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit 0 ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu + exit 0 ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix + exit 0 ;; + arm*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit 0 ;; + cris:Linux:*:*) + echo cris-axis-linux-gnu + exit 0 ;; + ia64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit 0 ;; + m68*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit 0 ;; + mips:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef mips + #undef mipsel + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=mipsel + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=mips + #else + CPU= + #endif + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` + test x"${CPU}" != x && echo "${CPU}-unknown-linux-gnu" && exit 0 + ;; + mips64:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef mips64 + #undef mips64el + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=mips64el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=mips64 + #else + CPU= + #endif + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` + test x"${CPU}" != x && echo "${CPU}-unknown-linux-gnu" && exit 0 + ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu + exit 0 ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit 0 ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit 0 ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in + PA7*) echo hppa1.1-unknown-linux-gnu ;; + PA8*) echo hppa2.0-unknown-linux-gnu ;; + *) echo hppa-unknown-linux-gnu ;; + esac + exit 0 ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu + exit 0 ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux + exit 0 ;; + sh64*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit 0 ;; + sh*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit 0 ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit 0 ;; + x86_64:Linux:*:*) + echo x86_64-unknown-linux-gnu + exit 0 ;; + i*86:Linux:*:*) + # The BFD linker knows what the default object file format is, so + # first see if it will tell us. cd to the root directory to prevent + # problems with other programs or directories called `ld' in the path. + # Set LC_ALL=C to ensure ld outputs messages in English. + ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ + | sed -ne '/supported targets:/!d + s/[ ][ ]*/ /g + s/.*supported targets: *// + s/ .*// + p'` + case "$ld_supported_targets" in + elf32-i386) + TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" + ;; + a.out-i386-linux) + echo "${UNAME_MACHINE}-pc-linux-gnuaout" + exit 0 ;; + coff-i386) + echo "${UNAME_MACHINE}-pc-linux-gnucoff" + exit 0 ;; + "") + # Either a pre-BFD a.out linker (linux-gnuoldld) or + # one that does not give us useful --help. + echo "${UNAME_MACHINE}-pc-linux-gnuoldld" + exit 0 ;; + esac + # Determine whether the default compiler is a.out or elf + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + #ifdef __ELF__ + # ifdef __GLIBC__ + # if __GLIBC__ >= 2 + LIBC=gnu + # else + LIBC=gnulibc1 + # endif + # else + LIBC=gnulibc1 + # endif + #else + #ifdef __INTEL_COMPILER + LIBC=gnu + #else + LIBC=gnuaout + #endif + #endif + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` + test x"${LIBC}" != x && echo "${UNAME_MACHINE}-pc-linux-${LIBC}" && exit 0 + test x"${TENTATIVE}" != x && echo "${TENTATIVE}" && exit 0 + ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit 0 ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} + exit 0 ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo ${UNAME_MACHINE}-pc-os2-emx + exit 0 ;; + i*86:XTS-300:*:STOP) + echo ${UNAME_MACHINE}-unknown-stop + exit 0 ;; + i*86:atheos:*:*) + echo ${UNAME_MACHINE}-unknown-atheos + exit 0 ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + echo i386-unknown-lynxos${UNAME_RELEASE} + exit 0 ;; + i*86:*DOS:*:*) + echo ${UNAME_MACHINE}-pc-msdosdjgpp + exit 0 ;; + i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi + exit 0 ;; + i*86:*:5:[78]*) + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + exit 0 ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then + UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo ${UNAME_MACHINE}-pc-sco$UNAME_REL + else + echo ${UNAME_MACHINE}-pc-sysv32 + fi + exit 0 ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i386. + echo i386-pc-msdosdjgpp + exit 0 ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit 0 ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit 0 ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 + fi + exit 0 ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit 0 ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit 0 ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit 0 ;; + M68*:*:R3V[567]*:*) + test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && echo i486-ncr-sysv4.3${OS_REL} && exit 0 + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && echo i486-ncr-sysv4 && exit 0 ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos${UNAME_RELEASE} + exit 0 ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit 0 ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos${UNAME_RELEASE} + exit 0 ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos${UNAME_RELEASE} + exit 0 ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + echo powerpc-unknown-lynxos${UNAME_RELEASE} + exit 0 ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv${UNAME_RELEASE} + exit 0 ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit 0 ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit 0 ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` + echo ${UNAME_MACHINE}-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit 0 ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + echo i586-unisys-sysv4 + exit 0 ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit 0 ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit 0 ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit 0 ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux${UNAME_RELEASE} + exit 0 ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit 0 ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then + echo mips-nec-sysv${UNAME_RELEASE} + else + echo mips-unknown-sysv${UNAME_RELEASE} + fi + exit 0 ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit 0 ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit 0 ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit 0 ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} + exit 0 ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} + exit 0 ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux${UNAME_RELEASE} + exit 0 ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} + exit 0 ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} + exit 0 ;; + *:Darwin:*:*) + case `uname -p` in + *86) UNAME_PROCESSOR=i686 ;; + powerpc) UNAME_PROCESSOR=powerpc ;; + esac + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} + exit 0 ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = "x86"; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} + exit 0 ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit 0 ;; + NSR-[DGKLNPTVWY]:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk${UNAME_RELEASE} + exit 0 ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit 0 ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit 0 ;; + DS/*:UNIX_System_V:*:*) + echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} + exit 0 ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + if test "$cputype" = "386"; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo ${UNAME_MACHINE}-unknown-plan9 + exit 0 ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit 0 ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit 0 ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit 0 ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit 0 ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit 0 ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit 0 ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux${UNAME_RELEASE} + exit 0 ;; +esac + +#echo '(No uname command or uname output not recognized.)' 1>&2 +#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 + +eval $set_cc_for_build +cat >$dummy.c < +# include +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (__arm) && defined (__acorn) && defined (__unix) + printf ("arm-acorn-riscix"); exit (0); +#endif + +#if defined (hp300) && !defined (hpux) + printf ("m68k-hp-bsd\n"); exit (0); +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); + +#endif + +#if defined (vax) +# if !defined (ultrix) +# include +# if defined (BSD) +# if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +# else +# if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# endif +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# else + printf ("vax-dec-ultrix\n"); exit (0); +# endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && $dummy && exit 0 + +# Apollos put the system type in the environment. + +test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } + +# Convex versions that predate uname can use getsysinfo(1) + +if [ -x /usr/convex/getsysinfo ] +then + case `getsysinfo -f cpu_type` in + c1*) + echo c1-convex-bsd + exit 0 ;; + c2*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit 0 ;; + c34*) + echo c34-convex-bsd + exit 0 ;; + c38*) + echo c38-convex-bsd + exit 0 ;; + c4*) + echo c4-convex-bsd + exit 0 ;; + esac +fi + +cat >&2 < in order to provide the needed +information to handle your system. + +config.guess timestamp = $timestamp + +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null` + +hostinfo = `(hostinfo) 2>/dev/null` +/bin/universe = `(/bin/universe) 2>/dev/null` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` +/bin/arch = `(/bin/arch) 2>/dev/null` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` + +UNAME_MACHINE = ${UNAME_MACHINE} +UNAME_RELEASE = ${UNAME_RELEASE} +UNAME_SYSTEM = ${UNAME_SYSTEM} +UNAME_VERSION = ${UNAME_VERSION} +EOF + +exit 1 + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/configure b/configure new file mode 100755 index 0000000..620a7ef --- /dev/null +++ b/configure @@ -0,0 +1,2784 @@ +#! /bin/sh + +# Guess values for system-dependent variables and create Makefiles. +# Generated automatically using autoconf version 2.13 +# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. + +# Defaults: +ac_help= +ac_default_prefix=/usr/local +# Any additions from configure.in: +ac_help="$ac_help + --with-tcl=DIR use Tcl 8.X binaries from DIR" +ac_help="$ac_help + --enable-shared build libck as a shared library" + +# Initialize some variables set by options. +# The variables have the same names as the options, with +# dashes changed to underlines. +build=NONE +cache_file=./config.cache +exec_prefix=NONE +host=NONE +no_create= +nonopt=NONE +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +target=NONE +verbose= +x_includes=NONE +x_libraries=NONE +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datadir='${prefix}/share' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' +includedir='${prefix}/include' +oldincludedir='/usr/include' +infodir='${prefix}/info' +mandir='${prefix}/man' + +# Initialize some other variables. +subdirs= +MFLAGS= MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} +# Maximum number of lines to put in a shell here document. +ac_max_here_lines=12 + +ac_prev= +for ac_option +do + + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval "$ac_prev=\$ac_option" + ac_prev= + continue + fi + + case "$ac_option" in + -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; + *) ac_optarg= ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case "$ac_option" in + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir="$ac_optarg" ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build="$ac_optarg" ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file="$ac_optarg" ;; + + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) + datadir="$ac_optarg" ;; + + -disable-* | --disable-*) + ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + eval "enable_${ac_feature}=no" ;; + + -enable-* | --enable-*) + ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "enable_${ac_feature}='$ac_optarg'" ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix="$ac_optarg" ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he) + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat << EOF +Usage: configure [options] [host] +Options: [defaults in brackets after descriptions] +Configuration: + --cache-file=FILE cache test results in FILE + --help print this message + --no-create do not create output files + --quiet, --silent do not print \`checking...' messages + --version print the version of autoconf that created configure +Directory and file names: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [same as prefix] + --bindir=DIR user executables in DIR [EPREFIX/bin] + --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] + --libexecdir=DIR program executables in DIR [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data in DIR + [PREFIX/share] + --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data in DIR + [PREFIX/com] + --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] + --libdir=DIR object code libraries in DIR [EPREFIX/lib] + --includedir=DIR C header files in DIR [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] + --infodir=DIR info documentation in DIR [PREFIX/info] + --mandir=DIR man documentation in DIR [PREFIX/man] + --srcdir=DIR find the sources in DIR [configure dir or ..] + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM + run sed PROGRAM on installed program names +EOF + cat << EOF +Host type: + --build=BUILD configure for building on BUILD [BUILD=HOST] + --host=HOST configure for HOST [guessed] + --target=TARGET configure for TARGET [TARGET=HOST] +Features and packages: + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --x-includes=DIR X include files are in DIR + --x-libraries=DIR X library files are in DIR +EOF + if test -n "$ac_help"; then + echo "--enable and --with options recognized:$ac_help" + fi + exit 0 ;; + + -host | --host | --hos | --ho) + ac_prev=host ;; + -host=* | --host=* | --hos=* | --ho=*) + host="$ac_optarg" ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir="$ac_optarg" ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir="$ac_optarg" ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir="$ac_optarg" ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir="$ac_optarg" ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + localstatedir="$ac_optarg" ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir="$ac_optarg" ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir="$ac_optarg" ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix="$ac_optarg" ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix="$ac_optarg" ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix="$ac_optarg" ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name="$ac_optarg" ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir="$ac_optarg" ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir="$ac_optarg" ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site="$ac_optarg" ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir="$ac_optarg" ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir="$ac_optarg" ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target="$ac_optarg" ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers) + echo "configure generated by autoconf version 2.13" + exit 0 ;; + + -with-* | --with-*) + ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "with_${ac_package}='$ac_optarg'" ;; + + -without-* | --without-*) + ac_package=`echo $ac_option|sed -e 's/-*without-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + eval "with_${ac_package}=no" ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes="$ac_optarg" ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries="$ac_optarg" ;; + + -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } + ;; + + *) + if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then + echo "configure: warning: $ac_option: invalid host type" 1>&2 + fi + if test "x$nonopt" != xNONE; then + { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } + fi + nonopt="$ac_option" + ;; + + esac +done + +if test -n "$ac_prev"; then + { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } +fi + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +# File descriptor usage: +# 0 standard input +# 1 file creation +# 2 errors and warnings +# 3 some systems may open it to /dev/tty +# 4 used on the Kubota Titan +# 6 checking for... messages and results +# 5 compiler messages saved in config.log +if test "$silent" = yes; then + exec 6>/dev/null +else + exec 6>&1 +fi +exec 5>./config.log + +echo "\ +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. +" 1>&5 + +# Strip out --no-create and --no-recursion so they do not pile up. +# Also quote any args containing shell metacharacters. +ac_configure_args= +for ac_arg +do + case "$ac_arg" in + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) ;; + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) + ac_configure_args="$ac_configure_args '$ac_arg'" ;; + *) ac_configure_args="$ac_configure_args $ac_arg" ;; + esac +done + +# NLS nuisances. +# Only set these to C if already set. These must not be set unconditionally +# because not all systems understand e.g. LANG=C (notably SCO). +# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! +# Non-C LC_CTYPE values break the ctype check. +if test "${LANG+set}" = set; then LANG=C; export LANG; fi +if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi +if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi +if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo > confdefs.h + +# A filename unique to this package, relative to the directory that +# configure is in, which we can look for to find out if srcdir is correct. +ac_unique_file=ck.h + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then its parent. + ac_prog=$0 + ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` + test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. + srcdir=$ac_confdir + if test ! -r $srcdir/$ac_unique_file; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } + else + { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } + fi +fi +srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` + +# Prefer explicitly selected file to automatically selected ones. +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi +fi +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + echo "loading site script $ac_site_file" + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + echo "loading cache $cache_file" + . $cache_file +else + echo "creating cache $cache_file" + > $cache_file +fi + +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +ac_exeext= +ac_objext=o +if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then + # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. + if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then + ac_n= ac_c=' +' ac_t=' ' + else + ac_n=-n ac_c= ac_t= + fi +else + ac_n= ac_c='\c' ac_t= +fi + + + +ac_aux_dir= +for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do + if test -f $ac_dir/install-sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f $ac_dir/install.sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + fi +done +if test -z "$ac_aux_dir"; then + { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } +fi +ac_config_guess=$ac_aux_dir/config.guess +ac_config_sub=$ac_aux_dir/config.sub +ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# ./install, which can be erroneously created by make from ./install.sh. +echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 +echo "configure:561: checking for a BSD compatible install" >&5 +if test -z "$INSTALL"; then +if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" + for ac_dir in $PATH; do + # Account for people who put trailing slashes in PATH elements. + case "$ac_dir/" in + /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + if test -f $ac_dir/$ac_prog; then + if test $ac_prog = install && + grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + else + ac_cv_path_install="$ac_dir/$ac_prog -c" + break 2 + fi + fi + done + ;; + esac + done + IFS="$ac_save_IFS" + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL="$ac_cv_path_install" + else + # As a last resort, use the slow shell script. We don't cache a + # path for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the path is relative. + INSTALL="$ac_install_sh" + fi +fi +echo "$ac_t""$INSTALL" 1>&6 + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +# Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:616: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_RANLIB="ranlib" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":" +fi +fi +RANLIB="$ac_cv_prog_RANLIB" +if test -n "$RANLIB"; then + echo "$ac_t""$RANLIB" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +CC=${CC-cc} +echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 +echo "configure:645: checking how to run the C preprocessor" >&5 +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then +if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + # This must be in double quotes, not single quotes, because CPP may get + # substituted into the Makefile and "${CC-cc}" will confuse make. + CPP="${CC-cc} -E" + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:666: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP="${CC-cc} -E -traditional-cpp" + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:683: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP="${CC-cc} -nologo -E" + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:700: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP=/lib/cpp +fi +rm -f conftest* +fi +rm -f conftest* +fi +rm -f conftest* + ac_cv_prog_CPP="$CPP" +fi + CPP="$ac_cv_prog_CPP" +else + ac_cv_prog_CPP="$CPP" +fi +echo "$ac_t""$CPP" 1>&6 + +for ac_hdr in unistd.h limits.h +do +ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +echo "configure:728: checking for $ac_hdr" >&5 +if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:738: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +fi +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` + cat >> confdefs.h <&6 +fi +done + + +#-------------------------------------------------------------------- +# Supply a substitute for stdlib.h if it doesn't define strtol, +# strtoul, or strtod (which it doesn't in some versions of SunOS). +#-------------------------------------------------------------------- + +echo $ac_n "checking stdlib.h""... $ac_c" 1>&6 +echo "configure:771: checking stdlib.h" >&5 +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "strtol" >/dev/null 2>&1; then + rm -rf conftest* + tk_ok=yes +else + rm -rf conftest* + tk_ok=no +fi +rm -f conftest* + +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "strtoul" >/dev/null 2>&1; then + : +else + rm -rf conftest* + tk_ok=no +fi +rm -f conftest* + +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "strtod" >/dev/null 2>&1; then + : +else + rm -rf conftest* + tk_ok=no +fi +rm -f conftest* + +if test $tk_ok = no; then + cat >> confdefs.h <<\EOF +#define NO_STDLIB_H 1 +EOF + +fi +echo "$ac_t""$tk_ok" 1>&6 + +#-------------------------------------------------------------------- +# Check for various typedefs and provide substitutes if +# they don't exist. +#-------------------------------------------------------------------- + +echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 +echo "configure:829: checking for ANSI C header files" >&5 +if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +#include +#include +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:842: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + ac_cv_header_stdc=yes +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "memchr" >/dev/null 2>&1; then + : +else + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "free" >/dev/null 2>&1; then + : +else + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. +if test "$cross_compiling" = yes; then + : +else + cat > conftest.$ac_ext < +#define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int main () { int i; for (i = 0; i < 256; i++) +if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); +exit (0); } + +EOF +if { (eval echo configure:909: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then + : +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -fr conftest* + ac_cv_header_stdc=no +fi +rm -fr conftest* +fi + +fi +fi + +echo "$ac_t""$ac_cv_header_stdc" 1>&6 +if test $ac_cv_header_stdc = yes; then + cat >> confdefs.h <<\EOF +#define STDC_HEADERS 1 +EOF + +fi + +echo $ac_n "checking for mode_t""... $ac_c" 1>&6 +echo "configure:933: checking for mode_t" >&5 +if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#if STDC_HEADERS +#include +#include +#endif +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_mode_t=yes +else + rm -rf conftest* + ac_cv_type_mode_t=no +fi +rm -f conftest* + +fi +echo "$ac_t""$ac_cv_type_mode_t" 1>&6 +if test $ac_cv_type_mode_t = no; then + cat >> confdefs.h <<\EOF +#define mode_t int +EOF + +fi + +echo $ac_n "checking for pid_t""... $ac_c" 1>&6 +echo "configure:966: checking for pid_t" >&5 +if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#if STDC_HEADERS +#include +#include +#endif +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_pid_t=yes +else + rm -rf conftest* + ac_cv_type_pid_t=no +fi +rm -f conftest* + +fi +echo "$ac_t""$ac_cv_type_pid_t" 1>&6 +if test $ac_cv_type_pid_t = no; then + cat >> confdefs.h <<\EOF +#define pid_t int +EOF + +fi + +echo $ac_n "checking for size_t""... $ac_c" 1>&6 +echo "configure:999: checking for size_t" >&5 +if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#if STDC_HEADERS +#include +#include +#endif +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_size_t=yes +else + rm -rf conftest* + ac_cv_type_size_t=no +fi +rm -f conftest* + +fi +echo "$ac_t""$ac_cv_type_size_t" 1>&6 +if test $ac_cv_type_size_t = no; then + cat >> confdefs.h <<\EOF +#define size_t unsigned +EOF + +fi + +echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 +echo "configure:1032: checking for uid_t in sys/types.h" >&5 +if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "uid_t" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_uid_t=yes +else + rm -rf conftest* + ac_cv_type_uid_t=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$ac_cv_type_uid_t" 1>&6 +if test $ac_cv_type_uid_t = no; then + cat >> confdefs.h <<\EOF +#define uid_t int +EOF + + cat >> confdefs.h <<\EOF +#define gid_t int +EOF + +fi + + +#------------------------------------------------------------------------------ +# What type do signals return? Do we have sigaction ? +#------------------------------------------------------------------------------ + +echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 +echo "configure:1071: checking return type of signal handlers" >&5 +if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +#ifdef signal +#undef signal +#endif +#ifdef __cplusplus +extern "C" void (*signal (int, void (*)(int)))(int); +#else +void (*signal ()) (); +#endif + +int main() { +int i; +; return 0; } +EOF +if { (eval echo configure:1093: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_type_signal=void +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_type_signal=int +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_type_signal" 1>&6 +cat >> confdefs.h <&6 +echo "configure:1114: checking for $ac_func" >&5 +if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +$ac_func(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1142: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_$ac_func=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_$ac_func=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` + cat >> confdefs.h <&6 +fi +done + + +#-------------------------------------------------------------------- +# See if there was a command-line option for where Tcl is; if +# not, assume that its top-level directory is a sibling of ours. +#-------------------------------------------------------------------- + +# Check whether --with-tcl or --without-tcl was given. +if test "${with_tcl+set}" = set; then + withval="$with_tcl" + TCL_BIN_DIR=$withval +else + TCL_BIN_DIR=`cd ../tcl8.0/unix ; pwd` +fi + +if test ! -d $TCL_BIN_DIR ; then + { echo "configure: error: Tcl directory $TCL_BIN_DIR doesn't exist" 1>&2; exit 1; } +fi + +#-------------------------------------------------------------------- +# Read in configuration information generated by Tcl for shared +# libraries, and arrange for it to be substituted into our +# Makefile. +#-------------------------------------------------------------------- + +if test -r $TCL_BIN_DIR/tclConfig.sh ; then + file=$TCL_BIN_DIR/tclConfig.sh + if test -d $TCL_BIN_DIR/../generic ; then + TCL_DIR=`cd $TCL_BIN_DIR/../generic ; pwd` + elif test -d $TCL_BIN_DIR/../include ; then + TCL_DIR=`cd $TCL_BIN_DIR/../include ; pwd` + else + TCL_DIR=$TCL_BIN_DIR + fi + . $file + CC=$TCL_CC + SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS + SHLIB_LD=$TCL_SHLIB_LD + SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS + SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX + SHLIB_VERSION=$TCL_SHLIB_VERSION + DL_LIBS=$TCL_DL_LIBS + LD_FLAGS=$TCL_LD_FLAGS + LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS +else + TCL_DIR=$TCL_BIN_DIR + TCL_LIB_FILE=libtcl.a + TCL_LIB_VERSIONS_OK=no + TCL_BUILD_LIB_SPEC="-L$TCL_BIN_DIR -ltcl" + TCL_INCLUDE_SPEC="-I$TCL_DIR" +fi + +echo $ac_n "checking Ck version""... $ac_c" 1>&6 +echo "configure:1218: checking Ck version" >&5 +if test "${TCL_VERSION}" = "7.4"; then + VERSION=4.0 + CK_VERSION=4.0 + CK_MAJOR_VERSION=4 + CK_MINOR_VERSION=0 +elif test "${TCL_VERSION}" = "7.5"; then + VERSION=4.1 + CK_VERSION=4.1 + CK_MAJOR_VERSION=4 + CK_MINOR_VERSION=1 +elif test "${TCL_VERSION}" = "7.6"; then + VERSION=4.2 + CK_VERSION=4.2 + CK_MAJOR_VERSION=4 + CK_MINOR_VERSION=2 +else + # Assume Tcl8.0 or higher + VERSION=$TCL_VERSION + CK_VERSION=$VERSION + CK_MAJOR_VERSION=$TCL_MAJOR_VERSION + CK_MINOR_VERSION=$TCL_MINOR_VERSION +fi +echo "$ac_t""${CK_VERSION}" 1>&6 + +#-------------------------------------------------------------------- +# Include sys/select.h if it exists and if it supplies things +# that appear to be useful and aren't already in sys/types.h. +# This appears to be true only on the RS/6000 under AIX. Some +# systems like OSF/1 have a sys/select.h that's of no use, and +# other systems like SCO UNIX have a sys/select.h that's +# pernicious. If "fd_set" isn't defined anywhere then set a +# special flag. +#-------------------------------------------------------------------- + +echo $ac_n "checking fd_set and sys/select""... $ac_c" 1>&6 +echo "configure:1254: checking fd_set and sys/select" >&5 +cat > conftest.$ac_ext < +int main() { +fd_set readMask, writeMask; +; return 0; } +EOF +if { (eval echo configure:1263: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tk_ok=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tk_ok=no +fi +rm -f conftest* +if test $tk_ok = no; then + cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "fd_mask" >/dev/null 2>&1; then + rm -rf conftest* + tk_ok=yes +fi +rm -f conftest* + + if test $tk_ok = yes; then + cat >> confdefs.h <<\EOF +#define HAVE_SYS_SELECT_H 1 +EOF + + fi +fi +echo "$ac_t""$tk_ok" 1>&6 +if test $tk_ok = no; then + cat >> confdefs.h <<\EOF +#define NO_FD_SET 1 +EOF + +fi + +#--------------------------------------------------------------------- +# Locate the curses header files and the curses library archive. +# The order is: +# ../ncurses +# /usr/include and /usr/lib +# /opt/ncurses +# /usr/local +# /usr/local/ncurses +#--------------------------------------------------------------------- + +echo checking for curses/ncurses header files +CURSESINCLUDES=nope +USE_NCURSES=0 +dirs="../ncurses/include /usr/include /usr/include/ncurses /opt/ncurses/include /usr/local/include /usr/local/include/ncurses" +for i in $dirs ; do + if test -r $i/ncurses.h; then + echo $ac_n "checking ncurses headers""... $ac_c" 1>&6 +echo "configure:1318: checking ncurses headers" >&5 + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS -I$i" + cat > conftest.$ac_ext < +int main() { +int c; initscr(); c = ACS_ULCORNER; curs_set(1); +; return 0; } +EOF +if { (eval echo configure:1329: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + echo "$ac_t""yes" 1>&6 + CURSESINCLUDES="-I$i" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t""no" 1>&6 +fi +rm -f conftest* + CFLAGS=$tk_oldCFlags + if test "$CURSESINCLUDES" != nope; then + USE_NCURSES=1 + break + fi + fi + if test -r $i/curses.h; then + echo $ac_n "checking curses headers""... $ac_c" 1>&6 +echo "configure:1348: checking curses headers" >&5 + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS -I$i" + cat > conftest.$ac_ext < +int main() { +int c; initscr(); c = ACS_ULCORNER; curs_set(1); +; return 0; } +EOF +if { (eval echo configure:1359: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + echo "$ac_t""yes" 1>&6 + CURSESINCLUDES="-I$i" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t""no" 1>&6 +fi +rm -f conftest* + CFLAGS=$tk_oldCFlags + if test "$CURSESINCLUDES" != nope; then + break + fi + fi +done +if test "$CURSESINCLUDES" = nope; then + echo "Warning: couldn't find any curses header file." + CURSESINCLUDES="# no header file found" +else + if test $USE_NCURSES = 1 ; then + echo "using ncurses.h from $CURSESINCLUDES" + else + echo "using curses.h from $CURSESINCLUDES" + fi +fi + +echo checking for curses/ncurses library files +CURSESLIBSW=nope +dirs="../ncurses/lib /usr/lib /usr/lib/ncurses /opt/ncurses/lib /usr/local/lib /usr/local/ncurses/lib" +for i in $dirs ; do + if test $USE_NCURSES = 0 ; then + if test -r $i/libcurses.a || test -r $i/libcurses$SHLIB_SUFFIX ; then + echo $ac_n "checking curses library""... $ac_c" 1>&6 +echo "configure:1394: checking curses library" >&5 + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $CURSESINCLUDES" + if test "$i" = "/usr/lib" ; then + LIBSW="-lcurses -ltermcap" + else + LIBSW="-L$i -lcurses -ltermcap" + fi + tk_oldLibs=$LIBS + LIBS="$LIBSW" + cat > conftest.$ac_ext < +int main() { +int c; initscr(); c = ACS_ULCORNER; curs_set(1); +; return 0; } +EOF +if { (eval echo configure:1412: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + echo "$ac_t""yes" 1>&6 + CURSESLIBSW="$LIBSW" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t""no" 1>&6 +fi +rm -f conftest* + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs + if test "$CURSESLIBSW" != nope; then + break + fi + fi + else + if test -r $i/libncurses.a || test -r $i/libncurses$SHLIB_SUFFIX ; then + echo $ac_n "checking ncurses library""... $ac_c" 1>&6 +echo "configure:1432: checking ncurses library" >&5 + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $CURSESINCLUDES" + if test "$i" = "/usr/lib" ; then + LIBSW="-lncurses" + else + LIBSW="-L$i -lncurses" + fi + tk_oldLibs=$LIBS + LIBS="$LIBSW" + cat > conftest.$ac_ext < +int main() { +int c; initscr(); c = ACS_ULCORNER; curs_set(1); +; return 0; } +EOF +if { (eval echo configure:1450: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + echo "$ac_t""yes" 1>&6 + CURSESLIBSW="$LIBSW" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t""no" 1>&6 +fi +rm -f conftest* + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs + if test "$CURSESLIBSW" != nope; then + break + fi + fi + fi +done + +if test "$CURSESLIBSW" = nope ; then + echo "Warning: couldn't find the curses library archive. Using -lcurses." + CURSESLIBSW="-lcurses -ltermcap" +else + echo "using curses library: $CURSESLIBSW" + echo $ac_n "checking curses scr_dump function""... $ac_c" 1>&6 +echo "configure:1476: checking curses scr_dump function" >&5 + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $CURSESINCLUDES" + tk_oldLibs=$LIBS + LIBS="$CURSESLIBSW" + if test $USE_NCURSES = 1 ; then + cat > conftest.$ac_ext < +int main() { +int c; initscr(); scr_dump("xx"); +; return 0; } +EOF +if { (eval echo configure:1490: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define HAVE_SCR_DUMP 1 +EOF + +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t""no" 1>&6 +fi +rm -f conftest* + else + cat > conftest.$ac_ext < +int main() { +int c; initscr(); scr_dump("xx"); +; return 0; } +EOF +if { (eval echo configure:1513: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define HAVE_SCR_DUMP 1 +EOF + +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t""no" 1>&6 +fi +rm -f conftest* + fi + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs +fi + +if test $USE_NCURSES = 1 ; then + USE_NCURSES="-DUSE_NCURSES" +else + USE_NCURSES="" +fi + +#--------------------------------------------------------------------- +# Check for GPM (General Purpose Mouse) +#--------------------------------------------------------------------- + +echo $ac_n "checking GPM library""... $ac_c" 1>&6 +echo "configure:1543: checking GPM library" >&5 +tk_oldLibs=$LIBS +LIBS="-lgpm" +cat > conftest.$ac_ext < +int main() { +Gpm_Connect conn; Gpm_Open(&conn, 0); +; return 0; } +EOF +if { (eval echo configure:1554: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define HAVE_GPM 1 +EOF + + CURSESLIBSW="$CURSESLIBSW -lgpm" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t""no" 1>&6 +fi +rm -f conftest* +LIBS=$tk_oldLibs + +#-------------------------------------------------------------------- +# Check for the existence of various libraries. The order here +# is important, so that then end up in the right order in the +# command line generated by make. The -lsocket and -lnsl libraries +# require a couple of special tricks: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- + +echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6 +echo "configure:1590: checking for main in -lXbsd" >&5 +ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-lXbsd $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + LIBS="$LIBS -lXbsd" +else + echo "$ac_t""no" 1>&6 +fi + + +tk_checkBoth=0 +echo $ac_n "checking for connect""... $ac_c" 1>&6 +echo "configure:1628: checking for connect" >&5 +if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char connect(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_connect) || defined (__stub___connect) +choke me +#else +connect(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1656: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_connect=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_connect=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then + echo "$ac_t""yes" 1>&6 + tk_checkSocket=0 +else + echo "$ac_t""no" 1>&6 +tk_checkSocket=1 +fi + +if test "$tk_checkSocket" = 1; then + echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6 +echo "configure:1678: checking for main in -lsocket" >&5 +ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-lsocket $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + LIBS="$LIBS -lsocket" +else + echo "$ac_t""no" 1>&6 +tk_checkBoth=1 +fi + +fi +if test "$tk_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + echo $ac_n "checking for accept""... $ac_c" 1>&6 +echo "configure:1719: checking for accept" >&5 +if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char accept(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_accept) || defined (__stub___accept) +choke me +#else +accept(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1747: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_accept=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_accept=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then + echo "$ac_t""yes" 1>&6 + tk_checkNsl=0 +else + echo "$ac_t""no" 1>&6 +LIBS=$tk_oldLibs +fi + +fi +echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 +echo "configure:1769: checking for gethostbyname" >&5 +if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char gethostbyname(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) +choke me +#else +gethostbyname(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1797: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_gethostbyname=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_gethostbyname=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6 +echo "configure:1815: checking for main in -lnsl" >&5 +ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-lnsl $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + LIBS="$LIBS -lnsl" +else + echo "$ac_t""no" 1>&6 +fi + +fi + + +#-------------------------------------------------------------------- +# On Interactive the str(n)casecmp is burried in libinet.a +#-------------------------------------------------------------------- + +echo $ac_n "checking for strncasecmp""... $ac_c" 1>&6 +echo "configure:1858: checking for strncasecmp" >&5 +if eval "test \"`echo '$''{'ac_cv_func_strncasecmp'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strncasecmp(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strncasecmp) || defined (__stub___strncasecmp) +choke me +#else +strncasecmp(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1886: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_strncasecmp=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_strncasecmp=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'strncasecmp`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +echo $ac_n "checking for main in -linet""... $ac_c" 1>&6 +echo "configure:1904: checking for main in -linet" >&5 +ac_lib_var=`echo inet'_'main | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-linet $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + LIBS="$LIBS -linet" +else + echo "$ac_t""no" 1>&6 +fi + +fi + + +#-------------------------------------------------------------------- +# Figure out how to find out whether a FILE structure contains +# buffered readable data. Some known names for the count field: +# _cnt: Most UNIX systems +# __cnt: HPUX +# _r: BSD +# readCount: Sprite +# Or, in GNU libc there are two fields, _gptr and _egptr, which +# have to be compared. +#-------------------------------------------------------------------- + +echo $ac_n "checking count field in FILE structures""... $ac_c" 1>&6 +echo "configure:1954: checking count field in FILE structures" >&5 +cat > conftest.$ac_ext < +int main() { +FILE *f = stdin; f->_cnt = 0; +; return 0; } +EOF +if { (eval echo configure:1963: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + fcnt="_cnt" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 +fi +rm -f conftest* +if test "$fcnt" = ""; then + cat > conftest.$ac_ext < +int main() { +FILE *f = stdin; f->__cnt = 0; +; return 0; } +EOF +if { (eval echo configure:1980: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + fcnt="__cnt" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 +fi +rm -f conftest* +fi +if test "$fcnt" = ""; then + cat > conftest.$ac_ext < +int main() { +FILE *f = stdin; f->_r = 0; +; return 0; } +EOF +if { (eval echo configure:1998: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + fcnt="_r" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 +fi +rm -f conftest* +fi +if test "$fcnt" = ""; then + cat > conftest.$ac_ext < +int main() { +FILE *f = stdin; f->readCount = 0; +; return 0; } +EOF +if { (eval echo configure:2016: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + fcnt="readCount" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 +fi +rm -f conftest* +fi +if test "$fcnt" != ""; then + cat >> confdefs.h < conftest.$ac_ext < +int main() { +FILE *f = stdin; f->_gptr = f->_egptr; +; return 0; } +EOF +if { (eval echo configure:2040: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tk_ok=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tk_ok=no +fi +rm -f conftest* + if test $tk_ok = yes; then + cat >> confdefs.h <<\EOF +#define TK_FILE_GPTR 1 +EOF + + fcnt="_gptr/_egptr" + fi +fi +if test "$fcnt" = ""; then + cat > conftest.$ac_ext < +int main() { +FILE *f = stdin; f->_IO_read_ptr = f->_IO_read_end; +; return 0; } +EOF +if { (eval echo configure:2067: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tk_ok=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tk_ok=no +fi +rm -f conftest* + if test $tk_ok = yes; then + cat >> confdefs.h <<\EOF +#define TK_FILE_READ_PTR 1 +EOF + + fcnt="_IO_read_ptr/_IO_read_end" + fi +fi +if test "$fcnt" = ""; then + echo "$ac_t""not found; must supply TkReadDataPending procedure" 1>&6 +else + echo "$ac_t"""$fcnt"" 1>&6 +fi + +#-------------------------------------------------------------------- +# On a few very rare systems, all of the libm.a stuff is +# already in libc.a. Set compiler flags accordingly. +# Also, Linux requires the "ieee" library for math to +# work right (and it must appear before "-lm"). +#-------------------------------------------------------------------- + +MATH_LIBS="" +echo $ac_n "checking for sin""... $ac_c" 1>&6 +echo "configure:2100: checking for sin" >&5 +if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char sin(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_sin) || defined (__stub___sin) +choke me +#else +sin(); +#endif + +; return 0; } +EOF +if { (eval echo configure:2128: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_sin=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_sin=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +MATH_LIBS="-lm" +fi + +echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6 +echo "configure:2149: checking for main in -lieee" >&5 +ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-lieee $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + MATH_LIBS="-lieee $MATH_LIBS" +else + echo "$ac_t""no" 1>&6 +fi + + +#-------------------------------------------------------------------- +# If this system doesn't have a memmove procedure, use memcpy +# instead. +#-------------------------------------------------------------------- + +echo $ac_n "checking for memmove""... $ac_c" 1>&6 +echo "configure:2191: checking for memmove" >&5 +if eval "test \"`echo '$''{'ac_cv_func_memmove'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char memmove(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_memmove) || defined (__stub___memmove) +choke me +#else +memmove(); +#endif + +; return 0; } +EOF +if { (eval echo configure:2219: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_memmove=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_memmove=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'memmove`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +cat >> confdefs.h <<\EOF +#define memmove memcpy +EOF + +fi + + +#-------------------------------------------------------------------- +# SGI systems don't use the BSD form of the gettimeofday function, +# but they have a BSDgettimeofday function that can be used instead. +# +# Also, check for the existence of a gettimeofday declaration, +# to tkPort.h can declare it if it isn't already declared. +#-------------------------------------------------------------------- + +echo $ac_n "checking for BSDgettimeofday""... $ac_c" 1>&6 +echo "configure:2252: checking for BSDgettimeofday" >&5 +if eval "test \"`echo '$''{'ac_cv_func_BSDgettimeofday'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char BSDgettimeofday(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_BSDgettimeofday) || defined (__stub___BSDgettimeofday) +choke me +#else +BSDgettimeofday(); +#endif + +; return 0; } +EOF +if { (eval echo configure:2280: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_BSDgettimeofday=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_BSDgettimeofday=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'BSDgettimeofday`\" = yes"; then + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define HAVE_BSDGETTIMEOFDAY 1 +EOF + +else + echo "$ac_t""no" 1>&6 +fi + +echo $ac_n "checking for gettimeofday declaration""... $ac_c" 1>&6 +echo "configure:2303: checking for gettimeofday declaration" >&5 +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "gettimeofday" >/dev/null 2>&1; then + rm -rf conftest* + echo "$ac_t""present" 1>&6 +else + rm -rf conftest* + + echo "$ac_t""missing" 1>&6 + cat >> confdefs.h <<\EOF +#define GETTOD_NOT_DECLARED 1 +EOF + + +fi +rm -f conftest* + + +#-------------------------------------------------------------------- +# Under Solaris 2.4, strtod returns the wrong value for the +# terminating character under some conditions. Check for this +# and if the problem exists use a substitute procedure +# "fixstrtod" (provided by Tcl) that corrects the error. +#-------------------------------------------------------------------- + +echo $ac_n "checking for strtod""... $ac_c" 1>&6 +echo "configure:2334: checking for strtod" >&5 +if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strtod(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strtod) || defined (__stub___strtod) +choke me +#else +strtod(); +#endif + +; return 0; } +EOF +if { (eval echo configure:2362: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_strtod=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_strtod=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'strtod`\" = yes"; then + echo "$ac_t""yes" 1>&6 + tk_strtod=1 +else + echo "$ac_t""no" 1>&6 +tk_strtod=0 +fi + +if test "$tk_strtod" = 1; then + echo $ac_n "checking for Solaris 2.4 strtod bug""... $ac_c" 1>&6 +echo "configure:2384: checking for Solaris 2.4 strtod bug" >&5 + if test "$cross_compiling" = yes; then + tk_ok=0 +else + cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then + tk_ok=1 +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -fr conftest* + tk_ok=0 +fi +rm -fr conftest* +fi + + if test "$tk_ok" = 1; then + echo "$ac_t""ok" 1>&6 + else + echo "$ac_t""buggy" 1>&6 + cat >> confdefs.h <<\EOF +#define strtod fixstrtod +EOF + + fi +fi + +#-------------------------------------------------------------------- +# The statements below define a collection of symbols related to +# building libck as a shared library instead of a static library. +#-------------------------------------------------------------------- + +# Check whether --enable-shared or --disable-shared was given. +if test "${enable_shared+set}" = set; then + enableval="$enable_shared" + ok=$enableval +else + ok=no +fi + +if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then + CK_SHLIB_CFLAGS="${SHLIB_CFLAGS}" + eval "CK_LIB_FILE=libck${TCL_SHARED_LIB_SUFFIX}" + MAKE_LIB="\${SHLIB_LD} -o ${CK_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}" + RANLIB=":" +else + CK_SHLIB_CFLAGS="" + eval "CK_LIB_FILE=libck${TCL_UNSHARED_LIB_SUFFIX}" + # Fixup if suffix missing + if test "$CK_LIB_FILE" = "libck" ; then + CK_LIB_FILE=libck.a + fi + MAKE_LIB="ar cr ${CK_LIB_FILE} \${OBJS}" +fi + +# Note: in the following variable, it's important to use the absolute +# path name of the Tcl directory rather than "..": this is because +# AIX remembers this path and will attempt to use it at run-time to look +# up the Tcl library. + +if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then + CK_BUILD_LIB_SPEC="-L`pwd` -lck${VERSION}" + CK_LIB_SPEC="-L${exec_prefix}/lib -lck${VERSION}" +else + CK_BUILD_LIB_SPEC="-L`pwd` -lck`echo ${VERSION} | tr -d .`" + CK_LIB_SPEC="-L${exec_prefix}/lib -lck`echo ${VERSION} | tr -d .`" +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +trap '' 1 2 15 +cat > confcache <<\EOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs. It is not useful on other systems. +# If it contains results you don't want to keep, you may remove or edit it. +# +# By default, configure uses ./config.cache as the cache file, +# creating it if it does not exist already. You can give configure +# the --cache-file=FILE option to use a different cache file; that is +# what configure does when it calls configure scripts in +# subdirectories, so they share the cache. +# Giving --cache-file=/dev/null disables caching, for debugging configure. +# config.status only pays attention to the cache file if you give it the +# --recheck option to rerun configure. +# +EOF +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, don't put newlines in cache variables' values. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +(set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote substitution + # turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + -e "s/'/'\\\\''/g" \ + -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' + ;; + esac >> confcache +if cmp -s $cache_file confcache; then + : +else + if test -w $cache_file; then + echo "updating cache $cache_file" + cat confcache > $cache_file + else + echo "not updating unwritable cache $cache_file" + fi +fi +rm -f confcache + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Any assignment to VPATH causes Sun make to only execute +# the first set of double-colon rules, so remove it if not needed. +# If there is a colon in the path, we need to keep it. +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' +fi + +trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +cat > conftest.defs <<\EOF +s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g +s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g +s%\[%\\&%g +s%\]%\\&%g +s%\$%$$%g +EOF +DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` +rm -f conftest.defs + + +# Without the "./", some shells look in PATH for config.status. +: ${CONFIG_STATUS=./config.status} + +echo creating $CONFIG_STATUS +rm -f $CONFIG_STATUS +cat > $CONFIG_STATUS </dev/null | sed 1q`: +# +# $0 $ac_configure_args +# +# Compiler output produced by configure, useful for debugging +# configure, is in ./config.log if it exists. + +ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" +for ac_option +do + case "\$ac_option" in + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" + exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; + -version | --version | --versio | --versi | --vers | --ver | --ve | --v) + echo "$CONFIG_STATUS generated by autoconf version 2.13" + exit 0 ;; + -help | --help | --hel | --he | --h) + echo "\$ac_cs_usage"; exit 0 ;; + *) echo "\$ac_cs_usage"; exit 1 ;; + esac +done + +ac_given_srcdir=$srcdir +ac_given_INSTALL="$INSTALL" + +trap 'rm -fr `echo "Makefile ckConfig.sh pkgIndex.tcl" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 +EOF +cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF +$ac_vpsub +$extrasub +s%@SHELL@%$SHELL%g +s%@CFLAGS@%$CFLAGS%g +s%@CPPFLAGS@%$CPPFLAGS%g +s%@CXXFLAGS@%$CXXFLAGS%g +s%@FFLAGS@%$FFLAGS%g +s%@DEFS@%$DEFS%g +s%@LDFLAGS@%$LDFLAGS%g +s%@LIBS@%$LIBS%g +s%@exec_prefix@%$exec_prefix%g +s%@prefix@%$prefix%g +s%@program_transform_name@%$program_transform_name%g +s%@bindir@%$bindir%g +s%@sbindir@%$sbindir%g +s%@libexecdir@%$libexecdir%g +s%@datadir@%$datadir%g +s%@sysconfdir@%$sysconfdir%g +s%@sharedstatedir@%$sharedstatedir%g +s%@localstatedir@%$localstatedir%g +s%@libdir@%$libdir%g +s%@includedir@%$includedir%g +s%@oldincludedir@%$oldincludedir%g +s%@infodir@%$infodir%g +s%@mandir@%$mandir%g +s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g +s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g +s%@INSTALL_DATA@%$INSTALL_DATA%g +s%@RANLIB@%$RANLIB%g +s%@CPP@%$CPP%g +s%@CC@%$CC%g +s%@DL_LIBS@%$DL_LIBS%g +s%@LD_FLAGS@%$LD_FLAGS%g +s%@MATH_LIBS@%$MATH_LIBS%g +s%@MAKE_LIB@%$MAKE_LIB%g +s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g +s%@SHLIB_LD@%$SHLIB_LD%g +s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g +s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g +s%@SHLIB_VERSION@%$SHLIB_VERSION%g +s%@TCL_DIR@%$TCL_DIR%g +s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g +s%@TCL_LIB@%$TCL_LIB%g +s%@TCL_INCLUDE_SPEC@%$TCL_INCLUDE_SPEC%g +s%@TCL_VERSION@%$TCL_VERSION%g +s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g +s%@CK_LD_SEARCH_FLAGS@%$CK_LD_SEARCH_FLAGS%g +s%@CK_LIB_FILE@%$CK_LIB_FILE%g +s%@CK_LIB_SPEC@%$CK_LIB_SPEC%g +s%@CK_MAJOR_VERSION@%$CK_MAJOR_VERSION%g +s%@CK_MINOR_VERSION@%$CK_MINOR_VERSION%g +s%@CK_SHLIB_CFLAGS@%$CK_SHLIB_CFLAGS%g +s%@CK_VERSION@%$CK_VERSION%g +s%@CK_BUILD_LIB_SPEC@%$CK_BUILD_LIB_SPEC%g +s%@USE_NCURSES@%$USE_NCURSES%g +s%@CURSESINCLUDES@%$CURSESINCLUDES%g +s%@CURSESLIBSW@%$CURSESLIBSW%g + +CEOF +EOF + +cat >> $CONFIG_STATUS <<\EOF + +# Split the substitutions into bite-sized pieces for seds with +# small command number limits, like on Digital OSF/1 and HP-UX. +ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. +ac_file=1 # Number of current file. +ac_beg=1 # First line for current file. +ac_end=$ac_max_sed_cmds # Line after last line for current file. +ac_more_lines=: +ac_sed_cmds="" +while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file + else + sed "${ac_end}q" conftest.subs > conftest.s$ac_file + fi + if test ! -s conftest.s$ac_file; then + ac_more_lines=false + rm -f conftest.s$ac_file + else + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f conftest.s$ac_file" + else + ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" + fi + ac_file=`expr $ac_file + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_cmds` + fi +done +if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat +fi +EOF + +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF +for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case "$ac_file" in + *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` + ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; + *) ac_file_in="${ac_file}.in" ;; + esac + + # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. + + # Remove last slash and all that follows it. Not all systems have dirname. + ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` + if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then + # The file is in a subdirectory. + test ! -d "$ac_dir" && mkdir "$ac_dir" + ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" + # A "../" for each directory in $ac_dir_suffix. + ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` + else + ac_dir_suffix= ac_dots= + fi + + case "$ac_given_srcdir" in + .) srcdir=. + if test -z "$ac_dots"; then top_srcdir=. + else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; + /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; + *) # Relative path. + srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" + top_srcdir="$ac_dots$ac_given_srcdir" ;; + esac + + case "$ac_given_INSTALL" in + [/$]*) INSTALL="$ac_given_INSTALL" ;; + *) INSTALL="$ac_dots$ac_given_INSTALL" ;; + esac + + echo creating "$ac_file" + rm -f "$ac_file" + configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." + case "$ac_file" in + *Makefile*) ac_comsub="1i\\ +# $configure_input" ;; + *) ac_comsub= ;; + esac + + ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` + sed -e "$ac_comsub +s%@configure_input@%$configure_input%g +s%@srcdir@%$srcdir%g +s%@top_srcdir@%$top_srcdir%g +s%@INSTALL@%$INSTALL%g +" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file +fi; done +rm -f conftest.s* + +EOF +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF + +exit 0 +EOF +chmod +x $CONFIG_STATUS +rm -fr confdefs* $ac_clean_files +test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 + diff --git a/configure.in b/configure.in new file mode 100755 index 0000000..35da687 --- /dev/null +++ b/configure.in @@ -0,0 +1,505 @@ +dnl This file is an input file used by the GNU "autoconf" program to +dnl generate the file "configure", which is run during Ck installation +dnl to configure the system for the local environment. +AC_INIT(ck.h) + +AC_PROG_INSTALL +AC_PROG_RANLIB +CC=${CC-cc} +AC_HAVE_HEADERS(unistd.h limits.h) + +#-------------------------------------------------------------------- +# Supply a substitute for stdlib.h if it doesn't define strtol, +# strtoul, or strtod (which it doesn't in some versions of SunOS). +#-------------------------------------------------------------------- + +AC_MSG_CHECKING(stdlib.h) +AC_HEADER_EGREP(strtol, stdlib.h, tk_ok=yes, tk_ok=no) +AC_HEADER_EGREP(strtoul, stdlib.h, , tk_ok=no) +AC_HEADER_EGREP(strtod, stdlib.h, , tk_ok=no) +if test $tk_ok = no; then + AC_DEFINE(NO_STDLIB_H) +fi +AC_MSG_RESULT($tk_ok) + +#-------------------------------------------------------------------- +# Check for various typedefs and provide substitutes if +# they don't exist. +#-------------------------------------------------------------------- + +AC_MODE_T +AC_PID_T +AC_SIZE_T +AC_UID_T + +#------------------------------------------------------------------------------ +# What type do signals return? Do we have sigaction ? +#------------------------------------------------------------------------------ + +AC_RETSIGTYPE +AC_HAVE_FUNCS(sigaction) + +#-------------------------------------------------------------------- +# See if there was a command-line option for where Tcl is; if +# not, assume that its top-level directory is a sibling of ours. +#-------------------------------------------------------------------- + +AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.X binaries from DIR], + TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../tcl8.0/unix ; pwd`) +if test ! -d $TCL_BIN_DIR ; then + AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist) +fi + +#-------------------------------------------------------------------- +# Read in configuration information generated by Tcl for shared +# libraries, and arrange for it to be substituted into our +# Makefile. +#-------------------------------------------------------------------- + +if test -r $TCL_BIN_DIR/tclConfig.sh ; then + file=$TCL_BIN_DIR/tclConfig.sh + if test -d $TCL_BIN_DIR/../generic ; then + TCL_DIR=`cd $TCL_BIN_DIR/../generic ; pwd` + elif test -d $TCL_BIN_DIR/../include ; then + TCL_DIR=`cd $TCL_BIN_DIR/../include ; pwd` + else + TCL_DIR=$TCL_BIN_DIR + fi + . $file + CC=$TCL_CC + SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS + SHLIB_LD=$TCL_SHLIB_LD + SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS + SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX + SHLIB_VERSION=$TCL_SHLIB_VERSION + DL_LIBS=$TCL_DL_LIBS + LD_FLAGS=$TCL_LD_FLAGS + LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS +else + TCL_DIR=$TCL_BIN_DIR + TCL_LIB_FILE=libtcl.a + TCL_LIB_VERSIONS_OK=no + TCL_BUILD_LIB_SPEC="-L$TCL_BIN_DIR -ltcl" + TCL_INCLUDE_SPEC="-I$TCL_DIR" +fi + +AC_MSG_CHECKING([Ck version]) +if test "${TCL_VERSION}" = "7.4"; then + VERSION=4.0 + CK_VERSION=4.0 + CK_MAJOR_VERSION=4 + CK_MINOR_VERSION=0 +elif test "${TCL_VERSION}" = "7.5"; then + VERSION=4.1 + CK_VERSION=4.1 + CK_MAJOR_VERSION=4 + CK_MINOR_VERSION=1 +elif test "${TCL_VERSION}" = "7.6"; then + VERSION=4.2 + CK_VERSION=4.2 + CK_MAJOR_VERSION=4 + CK_MINOR_VERSION=2 +else + # Assume Tcl8.0 or higher + VERSION=$TCL_VERSION + CK_VERSION=$VERSION + CK_MAJOR_VERSION=$TCL_MAJOR_VERSION + CK_MINOR_VERSION=$TCL_MINOR_VERSION +fi +AC_MSG_RESULT(${CK_VERSION}) + +#-------------------------------------------------------------------- +# Include sys/select.h if it exists and if it supplies things +# that appear to be useful and aren't already in sys/types.h. +# This appears to be true only on the RS/6000 under AIX. Some +# systems like OSF/1 have a sys/select.h that's of no use, and +# other systems like SCO UNIX have a sys/select.h that's +# pernicious. If "fd_set" isn't defined anywhere then set a +# special flag. +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([fd_set and sys/select]) +AC_TRY_COMPILE([#include ], + [fd_set readMask, writeMask;], tk_ok=yes, tk_ok=no) +if test $tk_ok = no; then + AC_HEADER_EGREP(fd_mask, sys/select.h, tk_ok=yes) + if test $tk_ok = yes; then + AC_DEFINE(HAVE_SYS_SELECT_H) + fi +fi +AC_MSG_RESULT($tk_ok) +if test $tk_ok = no; then + AC_DEFINE(NO_FD_SET) +fi + +#--------------------------------------------------------------------- +# Locate the curses header files and the curses library archive. +# The order is: +# ../ncurses +# /usr/include and /usr/lib +# /opt/ncurses +# /usr/local +# /usr/local/ncurses +#--------------------------------------------------------------------- + +echo checking for curses/ncurses header files +CURSESINCLUDES=nope +USE_NCURSES=0 +dirs="../ncurses/include /usr/include /usr/include/ncurses /opt/ncurses/include /usr/local/include /usr/local/include/ncurses" +for i in $dirs ; do + if test -r $i/ncurses.h; then + AC_MSG_CHECKING([ncurses headers]) + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS -I$i" + AC_TRY_COMPILE([#include ], + [int c; initscr(); c = ACS_ULCORNER; curs_set(1);], + [AC_MSG_RESULT(yes) + CURSESINCLUDES="-I$i"], AC_MSG_RESULT(no)) + CFLAGS=$tk_oldCFlags + if test "$CURSESINCLUDES" != nope; then + USE_NCURSES=1 + break + fi + fi + if test -r $i/curses.h; then + AC_MSG_CHECKING([curses headers]) + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS -I$i" + AC_TRY_COMPILE([#include ], + [int c; initscr(); c = ACS_ULCORNER; curs_set(1);], + [AC_MSG_RESULT(yes) + CURSESINCLUDES="-I$i"], AC_MSG_RESULT(no)) + CFLAGS=$tk_oldCFlags + if test "$CURSESINCLUDES" != nope; then + break + fi + fi +done +if test "$CURSESINCLUDES" = nope; then + echo "Warning: couldn't find any curses header file." + CURSESINCLUDES="# no header file found" +else + if test $USE_NCURSES = 1 ; then + echo "using ncurses.h from $CURSESINCLUDES" + else + echo "using curses.h from $CURSESINCLUDES" + fi +fi + +echo checking for curses/ncurses library files +CURSESLIBSW=nope +dirs="../ncurses/lib /usr/lib /usr/lib/ncurses /opt/ncurses/lib /usr/local/lib /usr/local/ncurses/lib" +for i in $dirs ; do + if test $USE_NCURSES = 0 ; then + if test -r $i/libcurses.a || test -r $i/libcurses$SHLIB_SUFFIX ; then + AC_MSG_CHECKING([curses library]) + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $CURSESINCLUDES" + if test "$i" = "/usr/lib" ; then + LIBSW="-lcurses -ltermcap" + else + LIBSW="-L$i -lcurses -ltermcap" + fi + tk_oldLibs=$LIBS + LIBS="$LIBSW" + AC_TRY_LINK([#include ], + [int c; initscr(); c = ACS_ULCORNER; curs_set(1);], + [AC_MSG_RESULT(yes) + CURSESLIBSW="$LIBSW"], AC_MSG_RESULT(no)) + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs + if test "$CURSESLIBSW" != nope; then + break + fi + fi + else + if test -r $i/libncurses.a || test -r $i/libncurses$SHLIB_SUFFIX ; then + AC_MSG_CHECKING([ncurses library]) + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $CURSESINCLUDES" + if test "$i" = "/usr/lib" ; then + LIBSW="-lncurses" + else + LIBSW="-L$i -lncurses" + fi + tk_oldLibs=$LIBS + LIBS="$LIBSW" + AC_TRY_LINK([#include ], + [int c; initscr(); c = ACS_ULCORNER; curs_set(1);], + [AC_MSG_RESULT(yes) + CURSESLIBSW="$LIBSW"], AC_MSG_RESULT(no)) + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs + if test "$CURSESLIBSW" != nope; then + break + fi + fi + fi +done + +if test "$CURSESLIBSW" = nope ; then + echo "Warning: couldn't find the curses library archive. Using -lcurses." + CURSESLIBSW="-lcurses -ltermcap" +else + echo "using curses library: $CURSESLIBSW" + AC_MSG_CHECKING([curses scr_dump function]) + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $CURSESINCLUDES" + tk_oldLibs=$LIBS + LIBS="$CURSESLIBSW" + if test $USE_NCURSES = 1 ; then + AC_TRY_LINK([#include ], + [int c; initscr(); scr_dump("xx");], + [AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_SCR_DUMP)], AC_MSG_RESULT(no)) + else + AC_TRY_LINK([#include ], + [int c; initscr(); scr_dump("xx");], + [AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_SCR_DUMP)], AC_MSG_RESULT(no)) + fi + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs +fi + +if test $USE_NCURSES = 1 ; then + USE_NCURSES="-DUSE_NCURSES" +else + USE_NCURSES="" +fi + +#--------------------------------------------------------------------- +# Check for GPM (General Purpose Mouse) +#--------------------------------------------------------------------- + +AC_MSG_CHECKING([GPM library]) +tk_oldLibs=$LIBS +LIBS="-lgpm" +AC_TRY_LINK([#include ], + [Gpm_Connect conn; Gpm_Open(&conn, 0);], + [AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_GPM) + CURSESLIBSW="$CURSESLIBSW -lgpm"], + [AC_MSG_RESULT(no)]) +LIBS=$tk_oldLibs + +#-------------------------------------------------------------------- +# Check for the existence of various libraries. The order here +# is important, so that then end up in the right order in the +# command line generated by make. The -lsocket and -lnsl libraries +# require a couple of special tricks: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- + +AC_CHECK_LIB(Xbsd, main, [LIBS="$LIBS -lXbsd"]) + +tk_checkBoth=0 +AC_CHECK_FUNC(connect, tk_checkSocket=0, tk_checkSocket=1) +if test "$tk_checkSocket" = 1; then + AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", tk_checkBoth=1) +fi +if test "$tk_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + AC_CHECK_FUNC(accept, tk_checkNsl=0, [LIBS=$tk_oldLibs]) +fi +AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) + +#-------------------------------------------------------------------- +# On Interactive the str(n)casecmp is burried in libinet.a +#-------------------------------------------------------------------- + +AC_CHECK_FUNC(strncasecmp, , AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])) + +#-------------------------------------------------------------------- +# Figure out how to find out whether a FILE structure contains +# buffered readable data. Some known names for the count field: +# _cnt: Most UNIX systems +# __cnt: HPUX +# _r: BSD +# readCount: Sprite +# Or, in GNU libc there are two fields, _gptr and _egptr, which +# have to be compared. +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([count field in FILE structures]) +AC_TRY_COMPILE([#include ], + [FILE *f = stdin; f->_cnt = 0;], fcnt="_cnt", ) +if test "$fcnt" = ""; then + AC_TRY_COMPILE([#include ], + [FILE *f = stdin; f->__cnt = 0;], fcnt="__cnt", ) +fi +if test "$fcnt" = ""; then + AC_TRY_COMPILE([#include ], + [FILE *f = stdin; f->_r = 0;], fcnt="_r", ) +fi +if test "$fcnt" = ""; then + AC_TRY_COMPILE([#include ], + [FILE *f = stdin; f->readCount = 0;], fcnt="readCount", ) +fi +if test "$fcnt" != ""; then + AC_DEFINE_UNQUOTED(TK_FILE_COUNT, $fcnt) +fi +if test "$fcnt" = ""; then + AC_TRY_COMPILE([#include ], + [FILE *f = stdin; f->_gptr = f->_egptr;], + tk_ok=yes, tk_ok=no) + if test $tk_ok = yes; then + AC_DEFINE(TK_FILE_GPTR) + fcnt="_gptr/_egptr" + fi +fi +if test "$fcnt" = ""; then + AC_TRY_COMPILE([#include ], + [FILE *f = stdin; f->_IO_read_ptr = f->_IO_read_end;], + tk_ok=yes, tk_ok=no) + if test $tk_ok = yes; then + AC_DEFINE(TK_FILE_READ_PTR) + fcnt="_IO_read_ptr/_IO_read_end" + fi +fi +if test "$fcnt" = ""; then + AC_MSG_RESULT([not found; must supply TkReadDataPending procedure]) +else + AC_MSG_RESULT("$fcnt") +fi + +#-------------------------------------------------------------------- +# On a few very rare systems, all of the libm.a stuff is +# already in libc.a. Set compiler flags accordingly. +# Also, Linux requires the "ieee" library for math to +# work right (and it must appear before "-lm"). +#-------------------------------------------------------------------- + +MATH_LIBS="" +AC_CHECK_FUNC(sin, , MATH_LIBS="-lm") +AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"]) + +#-------------------------------------------------------------------- +# If this system doesn't have a memmove procedure, use memcpy +# instead. +#-------------------------------------------------------------------- + +AC_CHECK_FUNC(memmove, , [AC_DEFINE(memmove, memcpy)]) + +#-------------------------------------------------------------------- +# SGI systems don't use the BSD form of the gettimeofday function, +# but they have a BSDgettimeofday function that can be used instead. +# +# Also, check for the existence of a gettimeofday declaration, +# to tkPort.h can declare it if it isn't already declared. +#-------------------------------------------------------------------- + +AC_CHECK_FUNC(BSDgettimeofday, AC_DEFINE(HAVE_BSDGETTIMEOFDAY)) +AC_MSG_CHECKING([for gettimeofday declaration]) +AC_EGREP_HEADER(gettimeofday, sys/time.h, AC_MSG_RESULT(present), [ + AC_MSG_RESULT(missing) + AC_DEFINE(GETTOD_NOT_DECLARED) +]) + +#-------------------------------------------------------------------- +# Under Solaris 2.4, strtod returns the wrong value for the +# terminating character under some conditions. Check for this +# and if the problem exists use a substitute procedure +# "fixstrtod" (provided by Tcl) that corrects the error. +#-------------------------------------------------------------------- + +AC_CHECK_FUNC(strtod, tk_strtod=1, tk_strtod=0) +if test "$tk_strtod" = 1; then + AC_MSG_CHECKING([for Solaris 2.4 strtod bug]) + AC_TRY_RUN([ + extern double strtod(); + int main() + { + char *string = "NaN"; + char *term; + strtod(string, &term); + if ((term != string) && (term[-1] == 0)) { + exit(1); + } + exit(0); + }], tk_ok=1, tk_ok=0, tk_ok=0) + if test "$tk_ok" = 1; then + AC_MSG_RESULT(ok) + else + AC_MSG_RESULT(buggy) + AC_DEFINE(strtod, fixstrtod) + fi +fi + +#-------------------------------------------------------------------- +# The statements below define a collection of symbols related to +# building libck as a shared library instead of a static library. +#-------------------------------------------------------------------- + +AC_ARG_ENABLE(shared, + [ --enable-shared build libck as a shared library], + [ok=$enableval], [ok=no]) +if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then + CK_SHLIB_CFLAGS="${SHLIB_CFLAGS}" + eval "CK_LIB_FILE=libck${TCL_SHARED_LIB_SUFFIX}" + MAKE_LIB="\${SHLIB_LD} -o ${CK_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}" + RANLIB=":" +else + CK_SHLIB_CFLAGS="" + eval "CK_LIB_FILE=libck${TCL_UNSHARED_LIB_SUFFIX}" + # Fixup if suffix missing + if test "$CK_LIB_FILE" = "libck" ; then + CK_LIB_FILE=libck.a + fi + MAKE_LIB="ar cr ${CK_LIB_FILE} \${OBJS}" +fi + +# Note: in the following variable, it's important to use the absolute +# path name of the Tcl directory rather than "..": this is because +# AIX remembers this path and will attempt to use it at run-time to look +# up the Tcl library. + +if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then + CK_BUILD_LIB_SPEC="-L`pwd` -lck${VERSION}" + CK_LIB_SPEC="-L${exec_prefix}/lib -lck${VERSION}" +else + CK_BUILD_LIB_SPEC="-L`pwd` -lck`echo ${VERSION} | tr -d .`" + CK_LIB_SPEC="-L${exec_prefix}/lib -lck`echo ${VERSION} | tr -d .`" +fi + +AC_SUBST(CC) +AC_SUBST(DL_LIBS) +AC_SUBST(LD_FLAGS) +AC_SUBST(MATH_LIBS) +AC_SUBST(MAKE_LIB) +AC_SUBST(SHLIB_CFLAGS) +AC_SUBST(SHLIB_LD) +AC_SUBST(SHLIB_LD_LIBS) +AC_SUBST(SHLIB_SUFFIX) +AC_SUBST(SHLIB_VERSION) +AC_SUBST(TCL_DIR) +AC_SUBST(TCL_BIN_DIR) +AC_SUBST(TCL_LIB) +AC_SUBST(TCL_INCLUDE_SPEC) +AC_SUBST(TCL_VERSION) +AC_SUBST(TCL_BUILD_LIB_SPEC) +AC_SUBST(CK_LD_SEARCH_FLAGS) +AC_SUBST(CK_LIB_FILE) +AC_SUBST(CK_LIB_SPEC) +AC_SUBST(CK_MAJOR_VERSION) +AC_SUBST(CK_MINOR_VERSION) +AC_SUBST(CK_SHLIB_CFLAGS) +AC_SUBST(CK_VERSION) +AC_SUBST(CK_BUILD_LIB_SPEC) +AC_SUBST(USE_NCURSES) +AC_SUBST(CURSESINCLUDES) +AC_SUBST(CURSESLIBSW) + + +AC_OUTPUT(Makefile ckConfig.sh pkgIndex.tcl) diff --git a/cwsh.rc b/cwsh.rc new file mode 100644 index 0000000..6a7e5ae --- /dev/null +++ b/cwsh.rc @@ -0,0 +1,33 @@ +#define RESOURCE_INCLUDED +#include + +#define STRINGIFY1(x) #x +#define STRINGIFY(x) STRINGIFY1(x) + +VS_VERSION_INFO VERSIONINFO + FILEVERSION CK_MAJOR_VERSION,CK_MINOR_VERSION,0,0 + PRODUCTVERSION CK_MAJOR_VERSION,CK_MINOR_VERSION,0,0 + FILEFLAGSMASK 0x3fL + FILEFLAGS 0x0L + FILEOS 0x4L + FILETYPE 0x1L + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904b0" + BEGIN + VALUE "FileDescription", "Curses based Windowing SHell\0" + VALUE "OriginalFilename", "cwsh.exe\0" + VALUE "CompanyName", "\0" + VALUE "FileVersion", CK_VERSION, + VALUE "LegalCopyright", "Copyright \251 2000-2001 Christian Werner\0" + VALUE "ProductName", "Ck " CK_VERSION " for Windows\0" + VALUE "ProductVersion", CK_VERSION + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 1200 + END +END diff --git a/d.sh b/d.sh new file mode 100644 index 0000000..a98838e --- /dev/null +++ b/d.sh @@ -0,0 +1,102 @@ +# +# Write out list of default widget options +# + +defscript1() { + cat >/tmp/d$$.tcl <<'EOD' +set count 0 +foreach c [lsort -ascii [info commands]] { + if {$c == "puts" || $c == "vwait"} { + continue + } + if {[catch {$c .w$count} tmp]} { + continue + } + if {"$tmp" != ".w$count"} { + continue + } + if {[catch {.w$count configure} clist]} { + incr count + continue + } + puts stderr [format "\n\t\t\t%s\n" $c] + foreach i [lsort -ascii $clist] { + if {[llength $i] > 2} { + puts stderr [format "%-35s\t%s" [lindex $i 0] [lindex $i 3]] + } + } + incr count +} +exit 0 +EOD +echo /tmp/d$$.tcl +} + +# +# Write out list of class bindings +# + +defscript2() { + cat >/tmp/d$$.tcl <<'EOD' +proc all w { return $w } +set count 0 +foreach c [lsort -ascii [info commands]] { + if {$c == "puts" || $c == "vwait"} { + continue + } + if {[catch {$c .w$count} tmp]} { + continue + } + if {"$tmp" != ".w$count"} { + continue + } + set class $c + if {$class != "all" && [catch {winfo class .w$count} class]} { + incr count + continue + } + puts stderr [format "\n\t\t\t%s\n" $class] + set out "" + set icnt 0 + foreach i [lsort -ascii [bind $class]] { + append out [format "%-19.19s" $i] + incr icnt + if {$icnt % 4 == 0} { + append out "\n" + } else { + append out " " + } + } + if {$out == ""} { + set out "*** no events bound to class ***" + } + puts stderr [string trimright $out "\n"] + incr count +} +exit 0 +EOD +echo /tmp/d$$.tcl +} + + +SCRIPT=`defscript1` + +rm -f def.list +exec 2>def.list +echo "Terminals w/ color" >&2 +echo "------------------" >&2 +TERM=color_xterm ./cwsh $SCRIPT +echo -e "\f" >&2 +echo "Terminals w/o color" >&2 +echo "-------------------" >&2 +TERM=vt100 ./cwsh $SCRIPT +rm -f $SCRIPT + +SCRIPT=`defscript2` + +echo -e "\f" >&2 +echo "Events bound to classes" >&2 +echo "-----------------------" >&2 +TERM=vt100 ./cwsh $SCRIPT +rm -f $SCRIPT + diff --git a/default.h b/default.h new file mode 100644 index 0000000..5ebf9b7 --- /dev/null +++ b/default.h @@ -0,0 +1,230 @@ +/* + * default.h -- + * + * This file defines the defaults for all options for all widgets. + * + * Copyright (c) 1995 Christian Werner. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + + +#define DEF_FRAME_ATTRIB "normal" +#define DEF_FRAME_BG_COLOR "black" +#define DEF_FRAME_BG_MONO "black" +#define DEF_FRAME_FG_COLOR "white" +#define DEF_FRAME_FG_MONO "white" +#define DEF_FRAME_BORDER NULL +#define DEF_FRAME_HEIGHT "0" +#define DEF_FRAME_TAKE_FOCUS "0" +#define DEF_FRAME_WIDTH "0" + + +#define DEF_BUTTON_ACTIVE_ATTR_COLOR "normal" +#define DEF_BUTTON_ACTIVE_ATTR_MONO "reverse" +#define DEF_BUTTON_ACTIVE_BG_COLOR "white" +#define DEF_BUTTON_ACTIVE_BG_MONO "black" +#define DEF_BUTTON_ACTIVE_FG_COLOR "black" +#define DEF_BUTTON_ACTIVE_FG_MONO "white" +#define DEF_BUTTON_ATTR "normal" +#define DEF_LABEL_ATTR "normal" +#define DEF_BUTTON_ANCHOR "center" +#define DEF_BUTTON_BG_COLOR "black" +#define DEF_BUTTON_BG_MONO "black" +#define DEF_BUTTON_COMMAND NULL +#define DEF_BUTTON_DISABLED_ATTR "dim" +#define DEF_BUTTON_DISABLED_BG_COLOR "black" +#define DEF_BUTTON_DISABLED_BG_MONO "black" +#define DEF_BUTTON_DISABLED_FG_COLOR "white" +#define DEF_BUTTON_DISABLED_FG_MONO "white" +#define DEF_BUTTON_FG "white" +#define DEF_BUTTON_HEIGHT "0" +#define DEF_BUTTON_OFF_VALUE "0" +#define DEF_BUTTON_ON_VALUE "1" +#define DEF_BUTTON_SELECT_COLOR "red" +#define DEF_BUTTON_SELECT_MONO "white" +#define DEF_BUTTON_STATE "normal" +#define DEF_BUTTON_TAKE_FOCUS "1" +#define DEF_LABEL_TAKE_FOCUS "0" +#define DEF_BUTTON_TEXT NULL +#define DEF_BUTTON_TEXT_VARIABLE NULL +#define DEF_BUTTON_UNDERLINE "-1" +#define DEF_BUTTON_UNDERLINE_ATTR "bold" +#define DEF_BUTTON_UNDERLINE_FG_COLOR "white" +#define DEF_BUTTON_UNDERLINE_FG_MONO "white" +#define DEF_BUTTON_VALUE NULL +#define DEF_RADIOBUTTON_VARIABLE NULL +#define DEF_CHECKBUTTON_VARIABLE NULL +#define DEF_BUTTON_WIDTH "0" + + +#define DEF_ENTRY_BG_COLOR "black" +#define DEF_ENTRY_BG_MONO "black" +#define DEF_ENTRY_ATTR "normal" +#define DEF_ENTRY_FG "white" +#define DEF_ENTRY_JUSTIFY "left" +#define DEF_ENTRY_SELECT_ATTR_COLOR "normal" +#define DEF_ENTRY_SELECT_ATTR_MONO "reverse" +#define DEF_ENTRY_SELECT_FG_COLOR "black" +#define DEF_ENTRY_SELECT_FG_MONO "black" +#define DEF_ENTRY_SELECT_BG_COLOR "white" +#define DEF_ENTRY_SELECT_BG_MONO "black" +#define DEF_ENTRY_SHOW NULL +#define DEF_ENTRY_STATE "normal" +#define DEF_ENTRY_TAKE_FOCUS "1" +#define DEF_ENTRY_TEXT_VARIABLE NULL +#define DEF_ENTRY_WIDTH "16" +#define DEF_ENTRY_SCROLL_COMMAND NULL + + +#define DEF_LISTBOX_ACTIVE_ATTR_COLOR "normal" +#define DEF_LISTBOX_ACTIVE_ATTR_MONO "reverse" +#define DEF_LISTBOX_ACTIVE_BG_COLOR "white" +#define DEF_LISTBOX_ACTIVE_BG_MONO "black" +#define DEF_LISTBOX_ACTIVE_FG_COLOR "black" +#define DEF_LISTBOX_ACTIVE_FG_MONO "white" +#define DEF_LISTBOX_BG_COLOR "black" +#define DEF_LISTBOX_BG_MONO "black" +#define DEF_LISTBOX_FG "white" +#define DEF_LISTBOX_ATTR "normal" +#define DEF_LISTBOX_HEIGHT "10" +#define DEF_LISTBOX_SELECT_ATTR_COLOR "bold" +#define DEF_LISTBOX_SELECT_ATTR_MONO "bold" +#define DEF_LISTBOX_SELECT_BG_COLOR "black" +#define DEF_LISTBOX_SELECT_BG_MONO "black" +#define DEF_LISTBOX_SELECT_FG_COLOR "white" +#define DEF_LISTBOX_SELECT_FG_MONO "white" +#define DEF_LISTBOX_SELECT_MODE "browse" +#define DEF_LISTBOX_TAKE_FOCUS "1" +#define DEF_LISTBOX_WIDTH "20" +#define DEF_LISTBOX_SCROLL_COMMAND NULL +#define DEF_LISTBOX_SCROLL_COMMAND NULL + + +#define DEF_SCROLLBAR_ACTIVE_ATTR_COLOR "normal" +#define DEF_SCROLLBAR_ACTIVE_ATTR_MONO "reverse" +#define DEF_SCROLLBAR_ACTIVE_BG_COLOR "white" +#define DEF_SCROLLBAR_ACTIVE_BG_MONO "black" +#define DEF_SCROLLBAR_ACTIVE_FG_COLOR "black" +#define DEF_SCROLLBAR_ACTIVE_FG_MONO "white" +#define DEF_SCROLLBAR_ATTR "normal" +#define DEF_SCROLLBAR_BG_COLOR "black" +#define DEF_SCROLLBAR_BG_MONO "black" +#define DEF_SCROLLBAR_COMMAND NULL +#define DEF_SCROLLBAR_FG_COLOR "white" +#define DEF_SCROLLBAR_FG_MONO "white" +#define DEF_SCROLLBAR_ORIENT "vertical" +#define DEF_SCROLLBAR_TAKE_FOCUS "1" + + +#define DEF_MESSAGE_ANCHOR "center" +#define DEF_MESSAGE_ASPECT "320" +#define DEF_MESSAGE_ATTR "normal" +#define DEF_MESSAGE_BG_COLOR "black" +#define DEF_MESSAGE_BG_MONO "black" +#define DEF_MESSAGE_FG_COLOR "white" +#define DEF_MESSAGE_FG_MONO "white" +#define DEF_MESSAGE_JUSTIFY "left" +#define DEF_MESSAGE_TAKE_FOCUS "0" +#define DEF_MESSAGE_TEXT NULL +#define DEF_MESSAGE_TEXT_VARIABLE NULL +#define DEF_MESSAGE_WIDTH "0" + + +#define DEF_TEXT_ATTR "normal" +#define DEF_TEXT_BG_COLOR "black" +#define DEF_TEXT_BG_MONO "black" +#define DEF_TEXT_FG "white" +#define DEF_TEXT_HEIGHT "10" +#define DEF_TEXT_SELECT_ATTR_COLOR "normal" +#define DEF_TEXT_SELECT_ATTR_MONO "reverse" +#define DEF_TEXT_SELECT_BG_COLOR "white" +#define DEF_TEXT_SELECT_BG_MONO "black" +#define DEF_TEXT_SELECT_FG_COLOR "black" +#define DEF_TEXT_SELECT_FG_MONO "white" +#define DEF_TEXT_STATE "normal" +#define DEF_TEXT_TABS "" +#define DEF_TEXT_TAKE_FOCUS "1" +#define DEF_TEXT_WIDTH "40" +#define DEF_TEXT_WRAP "char" +#define DEF_TEXT_XSCROLL_COMMAND NULL +#define DEF_TEXT_YSCROLL_COMMAND NULL + + +#define DEF_MENUBUTTON_ATTR "normal" +#define DEF_MENUBUTTON_ACTIVE_ATTR_COLOR "normal" +#define DEF_MENUBUTTON_ACTIVE_ATTR_MONO "reverse" +#define DEF_MENUBUTTON_ACTIVE_BG_COLOR "white" +#define DEF_MENUBUTTON_ACTIVE_BG_MONO "black" +#define DEF_MENUBUTTON_ACTIVE_FG_COLOR "black" +#define DEF_MENUBUTTON_ACTIVE_FG_MONO "white" +#define DEF_MENUBUTTON_ANCHOR "center" +#define DEF_MENUBUTTON_BG_COLOR "black" +#define DEF_MENUBUTTON_BG_MONO "black" +#define DEF_MENUBUTTON_DISABLED_ATTR "dim" +#define DEF_MENUBUTTON_DISABLED_BG_COLOR "black" +#define DEF_MENUBUTTON_DISABLED_BG_MONO "black" +#define DEF_MENUBUTTON_DISABLED_FG_COLOR "white" +#define DEF_MENUBUTTON_DISABLED_FG_MONO "white" +#define DEF_MENUBUTTON_FG "white" +#define DEF_MENUBUTTON_HEIGHT "0" +#define DEF_MENUBUTTON_INDICATOR "0" +#define DEF_MENUBUTTON_INDICATOR_FG_COLOR "red" +#define DEF_MENUBUTTON_INDICATOR_FG_MONO "white" +#define DEF_MENUBUTTON_MENU NULL +#define DEF_MENUBUTTON_STATE "normal" +#define DEF_MENUBUTTON_TAKE_FOCUS "0" +#define DEF_MENUBUTTON_TEXT NULL +#define DEF_MENUBUTTON_TEXT_VARIABLE NULL +#define DEF_MENUBUTTON_UNDERLINE "-1" +#define DEF_MENUBUTTON_UNDERLINE_ATTR "reverse" +#define DEF_MENUBUTTON_UNDERLINE_FG_COLOR "white" +#define DEF_MENUBUTTON_UNDERLINE_FG_MONO "white" +#define DEF_MENUBUTTON_WIDTH "0" + + +#define DEF_MENU_ENTRY_ACTIVE_ATTR NULL +#define DEF_MENU_ENTRY_ACTIVE_BG NULL +#define DEF_MENU_ENTRY_ACTIVE_FG NULL +#define DEF_MENU_ENTRY_ACCELERATOR NULL +#define DEF_MENU_ENTRY_ATTR NULL +#define DEF_MENU_ENTRY_BG NULL +#define DEF_MENU_ENTRY_COMMAND NULL +#define DEF_MENU_ENTRY_FG NULL +#define DEF_MENU_ENTRY_INDICATOR "1" +#define DEF_MENU_ENTRY_LABEL NULL +#define DEF_MENU_ENTRY_MENU NULL +#define DEF_MENU_ENTRY_OFF_VALUE "0" +#define DEF_MENU_ENTRY_ON_VALUE "1" +#define DEF_MENU_ENTRY_SELECT NULL +#define DEF_MENU_ENTRY_STATE "normal" +#define DEF_MENU_ENTRY_VALUE NULL +#define DEF_MENU_ENTRY_CHECK_VARIABLE NULL +#define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" +#define DEF_MENU_ENTRY_UNDERLINE "-1" + + +#define DEF_MENU_ACTIVE_ATTR_COLOR "normal" +#define DEF_MENU_ACTIVE_ATTR_MONO "reverse" +#define DEF_MENU_ACTIVE_BG_COLOR "white" +#define DEF_MENU_ACTIVE_BG_MONO "black" +#define DEF_MENU_ACTIVE_FG_COLOR "black" +#define DEF_MENU_ACTIVE_FG_MONO "white" +#define DEF_MENU_ATTR "normal" +#define DEF_MENU_BG_COLOR "black" +#define DEF_MENU_BG_MONO "black" +#define DEF_MENU_BORDER NULL +#define DEF_MENU_DISABLED_ATTR "dim" +#define DEF_MENU_DISABLED_BG_COLOR "black" +#define DEF_MENU_DISABLED_BG_MONO "black" +#define DEF_MENU_DISABLED_FG_COLOR "white" +#define DEF_MENU_DISABLED_FG_MONO "white" +#define DEF_MENU_FG "white" +#define DEF_MENU_POST_COMMAND "" +#define DEF_MENU_SELECT_COLOR "red" +#define DEF_MENU_SELECT_MONO "white" +#define DEF_MENU_TAKE_FOCUS "0" +#define DEF_MENU_UNDERLINE_ATTR "reverse" +#define DEF_MENU_UNDERLINE_FG_COLOR "white" +#define DEF_MENU_UNDERLINE_FG_MONO "white" diff --git a/doc/after.n b/doc/after.n new file mode 100644 index 0000000..c326a3e --- /dev/null +++ b/doc/after.n @@ -0,0 +1,83 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH after n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +after \- Execute a command after a time delay +.SH SYNOPSIS +\fBafter \fIms\fR +.br +\fBafter \fIms \fR?\fIscript script script ...\fR? +.br +\fBafter cancel \fIid\fR +.br +\fBafter cancel \fIscript script script ...\fR +.br +\fBafter idle \fR?\fIscript script script ...\fR? +.BE + +.SH DESCRIPTION +.PP +This command is used to delay execution of the program or to execute +a command in background after a delay. It has several forms, +depending on the first argument to the command: +.TP +\fBafter \fIms\fR +\fIMs\fR must be an integer giving a time in milliseconds. +The command sleeps for \fIms\fR milliseconds and then returns. +While the command is sleeping the application does not respond to +keypresses or any other events. +.TP +\fBafter \fIms \fR?\fIscript script script ...\fR? +In this form the command returns immediately, but it arranges +for a Tcl command to be executed \fIms\fR milliseconds later as a +background event handler. +The delayed command is formed by concatenating all the \fIscript\fR +arguments in the same fashion as the \fBconcat\fR command. +The command will be executed at global level (outside the context +of any Tcl procedure). +If an error occurs while executing the delayed command then the +\fBtkerror\fR mechanism is used to report the error. +The \fBafter\fR command returns an identifier that can be used +to cancel the delayed command using \fBafter cancel\fR. +.TP +\fBafter cancel \fIid\fR +Cancels the execution of a delayed command that +was previously scheduled. +\fIId\fR indicates which command should be canceled; it must have +been the return value from a previous \fBafter\fR command. +If the command given by \fIid\fR has already been executed then +the \fBafter cancel\fR command has no effect. +.TP +\fBafter cancel \fIscript script ...\fR +This command also cancels the execution of a delayed command. +The \fIscript\fR arguments are concatenated together with space +separators (just as in the \fBconcat\fR command). +If there is a pending command that matches the string, it is +cancelled and will never be executed; if no such command is +currently pending then the \fBafter cancel\fR command has no effect. +.TP +\fBafter idle \fIscript \fR?\fIscript script ...\fR? +Concatenates the \fIscript\fR arguments together with space +separators (just as in the \fBconcat\fR command), and arranges +for the resulting script to be evaluated later as an idle handler +(the script runs the next time the Tk event loop is entered +and there are no events to process). +The command returns an identifier that can be used +to cancel the delayed command using \fBafter cancel\fR. +If an error occurs while executing the script then the +\fBtkerror\fR mechanism is used to report the error. + +.SH "SEE ALSO" +tkerror + +.SH KEYWORDS +cancel, delay, sleep, time diff --git a/doc/bell.n b/doc/bell.n new file mode 100644 index 0000000..ef7fba4 --- /dev/null +++ b/doc/bell.n @@ -0,0 +1,27 @@ +'\" +'\" Copyright (c) 1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH bell n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +bell \- Ring a terminal's bell +.SH SYNOPSIS +\fBbell\fR +.BE + +.SH DESCRIPTION +.PP +This command rings the bell on the terminal if supported, otherwise the +terminal's screen is flashed. An empty string is returned as result of +this command. \fBBell\fR is carried out immediately, i.e. not deferred +until the application becomes idle. + +.SH KEYWORDS +beep, bell, ring diff --git a/doc/bind.n b/doc/bind.n new file mode 100644 index 0000000..9947536 --- /dev/null +++ b/doc/bind.n @@ -0,0 +1,271 @@ +'\" +'\" Copyright (c) 1990 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH bind n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +bind \- Arrange for events to invoke Tcl scripts +.SH SYNOPSIS +\fBbind\fI tag\fR +.br +\fBbind\fI tag sequence\fR +.br +\fBbind\fI tag sequence script\fR +.br +\fBbind\fI tag sequence \fB+\fIscript\fR +.BE + +.SH INTRODUCTION +.PP +The \fBbind\fR command associates Tcl scripts with events. +If all three arguments are specified, \fBbind\fR will +arrange for \fIscript\fR (a Tcl script) to be evaluated whenever +the event(s) given by \fIsequence\fR occur in the window(s) +identified by \fItag\fR. +If \fIscript\fR is prefixed with a ``+'', then it is appended to +any existing binding for \fIsequence\fR; otherwise \fIscript\fR replaces +any existing binding. +If \fIscript\fR is an empty string then the current binding for +\fIsequence\fR is destroyed, leaving \fIsequence\fR unbound. +In all of the cases where a \fIscript\fR argument is provided, +\fBbind\fR returns an empty string. +.PP +If \fIsequence\fR is specified without a \fIscript\fR, then the +script currently bound to \fIsequence\fR is returned, or +an empty string is returned if there is no binding for \fIsequence\fR. +If neither \fIsequence\fR nor \fIscript\fR is specified, then the +return value is a list whose elements are all the sequences +for which there exist bindings for \fItag\fR. +.PP +The \fItag\fR argument determines which window(s) the binding applies to. +If \fItag\fR begins with a dot, as in \fB.a.b.c\fR, then it must +be the path name for a window; otherwise it may be an arbitrary +string. +Each window has an associated list of tags, and a binding applies +to a particular window if its tag is among those specified for +the window. +Although the \fBbindtags\fR command may be used to assign an +arbitrary set of binding tags to a window, the default binding +tags provide the following behavior: +.IP +If a tag is the name of an internal window the binding applies +to that window. +.IP +If the tag is the name of a toplevel window the binding applies +to the toplevel window and all its internal windows. +.IP +If the tag is the name of a class of widgets, such as \fBButton\fR, +the binding applies to all widgets in that class; +.IP +If \fItag\fR has the value \fBall\fR, +the binding applies to all windows in the application. + +.SH "EVENT PATTERNS" +.PP +The \fIsequence\fR argument specifies a sequence of one or more +event patterns, with optional white space between the patterns. Each +event pattern may +take either of two forms. In the simplest case it is a single +printing ASCII character, such as \fBa\fR or \fB[\fR. The character +may not be a space character or the character \fB<\fR. This form of +pattern matches a \fBKeyPress\fR event for the particular +character. The second form of pattern is longer but more general. +It has the following syntax: +.DS C +\fB<\fItype-detail\fB>\fR +.DE +The entire event pattern is surrounded by angle brackets. +Inside the angle brackets are an event +type, and an extra piece of information (\fIdetail\fR) identifying +a particular button or keysym. Any of the fields may be omitted, +as long as at least one of \fItype\fR and \fIdetail\fR is present. +The fields must be separated by white space or dashes. + +.SH "EVENT TYPES" +.LP +The \fItype\fR field may be any of the following list. +Where two names appear together, they are synonyms. +.DS C +.ta 5c 10c +\fB +BarCode Expose Map +ButtonPress, Button FocusIn Unmap +ButtonRelease FocusOut +Destroy KeyPress, Key, Control\fR +.DE +.LP +The last part of a long event specification is \fIdetail\fR. In the +case of a \fBButtonPress\fR or \fBButtonRelease\fR event, it is the +number of a button (1-5). If a button number is given, then only an +event on that particular button will match; if no button number is +given, then an event on any button will match. Note: giving a +specific button number is different than specifying a button modifier; +in the first case, it refers to a button being pressed or released, +while in the second it refers to some other button that is already +depressed when the matching event occurs. If a button +number is given then \fItype\fR may be omitted: if will default +to \fBButtonPress\fR. For example, the specifier \fB<1>\fR +is equivalent to \fB\fR. +.LP +If the event type is \fBKeyPress\fR, \fBKey\fR or \fBControl\fR, then +\fIdetail\fR may be specified in the form of a keysym. Keysyms +are textual specifications for particular keys on the keyboard; +they include all the alphanumeric ASCII characters (e.g. ``a'' is +the keysym for the ASCII character ``a''), plus descriptions for +non-alphanumeric characters (``comma'' is the keysym for the comma +character), plus descriptions for some of the non-ASCII keys on the +keyboard (e.g. ``F1'' is the keysym for the F1 function key, if it exists). +The complete list of keysyms is not presented here; it is +available by invoking the \fBcurses haskey\fR Tcl command and may vary +from system to system. +If necessary, you can use the \fB%K\fR notation described below +to print out the keysym name for a particular key. +If a keysym \fIdetail\fR is given, then the +\fItype\fR field may be omitted; it will default to \fBKeyPress\fR. +For example, \fB\fR is equivalent to +\fB\fR. + +.SH "BINDING SCRIPTS AND SUBSTITUTIONS" +.LP +The \fIscript\fR argument to \fBbind\fR is a Tcl script, +which will be executed whenever the given event sequence occurs. +\fICommand\fR will be executed in the same interpreter that the +\fBbind\fR command was executed in, and it will run at global +level (only global variables will be accessible). +If \fIscript\fR contains +any \fB%\fR characters, then the script will not be +executed directly. Instead, a new script will be +generated by replacing each \fB%\fR, and the character following +it, with information from the current event. The replacement +depends on the character following the \fB%\fR, as defined in the +list below. Unless otherwise indicated, the +replacement string is the decimal value of the given field from +the current event. +Some of the substitutions are only valid for +certain types of events; if they are used for other types of events +the value substituted is undefined. +.TP +\fB%%\fR +Replaced with a single percent. +.TP +\fB%b\fR +The number of the button that was pressed or released. Valid only +for \fBButtonPress\fR and \fBButtonRelease\fR events. +.TP +\fB%k\fR +The \fIkeycode\fR field from the event. Valid only for \fBKeyPress\fR +and \fBKeyRelease\fR events. +.TP +\fB%x\fR +The \fIx\fR coordinate (window coordinate system) +from \fBButtonPress\fR and \fBButtonRelease\fR events. +.TP +\fB%y\fR +The \fIy\fR coordinate (window coordinate system) +from \fBButtonPress\fR and \fBButtonRelease\fR events. +.TP +\fB%A\fR +For \fBKeyPress\fR events, substitutes the ASCII character corresponding to +the event, or the empty string if the event doesn't correspond to an ASCII +character (e.g. the shift key was pressed). +For \fBBarCode\fR events, substitutes the entire barcode data packet. +.TP +\fB%K\fR +The keysym corresponding to the event, substituted as a textual +string. Valid only for \fBKeyPress\fR events. +.TP +\fB%N\fR +The keysym corresponding to the event, substituted as +a decimal number. Valid only for \fBKeyPress\fR events. +.TP +\fB%W\fR +The path name of the window to which the event was reported (the +\fIwindow\fR field from the event). Valid for all event types. +.TP +\fB%X\fR +The \fIx\fR coordinate (screen coordinate system) +from \fBButtonPress\fR and \fBButtonRelease\fR events. +.TP +\fB%Y\fR +The \fIy\fR coordinate (screen coordinate system) +from \fBButtonPress\fR and \fBButtonRelease\fR events. +.LP +The replacement string for a %-replacement is formatted as a proper +Tcl list element. +This means that it will be surrounded with braces +if it contains spaces, or special characters such as \fB$\fR and +\fB{\fR may be preceded by backslashes. +This guarantees that the string will be passed through the Tcl +parser when the binding script is evaluated. +Most replacements are numbers or well-defined strings such +as \fBcomma\fR; for these replacements no special formatting +is ever necessary. +The most common case where reformatting occurs is for the \fB%A\fR +substitution. For example, if \fIscript\fR is +.DS +\fBinsert\0%A\fR +.DE +and the character typed is an open square bracket, then the script +actually executed will be +.DS +\fBinsert\0\e[\fR +.DE +This will cause the \fBinsert\fR to receive the original replacement +string (open square bracket) as its first argument. +If the extra backslash hadn't been added, Tcl would not have been +able to parse the script correctly. + +.SH MULTIPLE MATCHES +.LP +It is possible for several bindings to match a given event. +If the bindings are associated with different \fItag\fR's, +then each of the bindings will be executed, in order. +By default, a class binding will be executed first, followed +by a binding for the widget, a binding for its toplevel, and +an \fBall\fR binding. +The \fBbindtags\fR command may be used to change this order for +a particular window or to associate additional binding tags with +the window. +.LP +The \fBcontinue\fR and \fBbreak\fR commands may be used inside a +binding script to control the processing of matching scripts. +If \fBcontinue\fR is invoked, then the current binding script +is terminated but Tk will continue processing binding scripts +associated with other \fItag\fR's. +If the \fBbreak\fR command is invoked within a binding script, +then that script terminates and no other scripts will be invoked +for the event. +.LP +If more than one binding matches a particular event and they +have the same \fItag\fR, then the most specific binding +is chosen and its script is evaluated. +The following tests are applied, in order, to determine which of +several matching sequences is more specific: +(a) a longer sequence (in terms of number +of events matched) is more specific than a shorter sequence; +(b) an event pattern that specifies a specific button or key is more specific +than one that doesn't. +.LP +If an event does not match any of the existing bindings, then the +event is ignored. +An unbound event is not considered to be an error. + +.SH ERRORS +.LP +If an error occurs in executing the script for a binding then the +\fBtkerror\fR mechanism is used to report the error. +The \fBtkerror\fR command will be executed at global level +(outside the context of any Tcl procedure). + +.SH "SEE ALSO" +tkerror + +.SH KEYWORDS +event, binding diff --git a/doc/bindtags.n b/doc/bindtags.n new file mode 100644 index 0000000..b496216 --- /dev/null +++ b/doc/bindtags.n @@ -0,0 +1,78 @@ +'\" +'\" Copyright (c) 1990 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH bindtags n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +bindtags \- Determine which bindings apply to a window, and order of evaluation +.SH SYNOPSIS +\fBbindtags \fIwindow \fR?\fItagList\fR? +.BE + +.SH DESCRIPTION +.PP +When a binding is created with the \fBbind\fR command, it is +associated either with a particular window such as \fB.a.b.c\fR, +a class name such as \fBButton\fR, the keyword \fBall\fR, or any +other string. +All of these forms are called \fIbinding tags\fR. +Each window contains a list of binding tags that determine how +events are processed for the window. +When an event occurs in a window, it is applied to each of the +window's tags in order: for each tag, the most specific binding +that matches the given tag and event is executed. +See the \fBbind\fR command for more information on the matching +process. +.PP +By default, each window has four binding tags consisting of the +name of the window, the window's class name, the name of the window's +nearest toplevel ancestor, and \fBall\fR, in that order. +Toplevel windows have only three tags by default, since the toplevel +name is the same as that of the window. +The \fBbindtags\fR command allows the binding tags for a window to be +read and modified. +.PP +If \fBbindtags\fR is invoked with only one argument, then the +current set of binding tags for \fIwindow\fR is returned as a list. +If the \fItagList\fR argument is specified to \fBbindtags\fR, +then it must be a proper list; the tags for \fIwindow\fR are changed +to the elements of the list. +The elements of \fItagList\fR may be arbitrary strings; however, +any tag starting with a dot is treated as the name of a window; if +no window by that name exists at the time an event is processed, +then the tag is ignored for that event. +The order of the elements in \fItagList\fR determines the order in +which binding scripts are executed in response to events. +For example, the command +.DS +\fBbindtags .b {all . Button .b}\fR +.DE +reverses the order in which binding scripts will be evaluated for +a button named \fB.b\fR so that \fBall\fR bindings are invoked +first, following by bindings for \fB.b\fR's toplevel (``.''), followed by +class bindings, followed by bindings for \fB.b\fR. +.PP +The \fBbindtags\fR command may be used to introduce arbitrary +additional binding tags for a window, or to remove standard tags. +For example, the command +.DS +\fBbindtags .b {.b TrickyButton . all}\fR +.DE +replaces the \fBButton\fR tag for \fB.b\fR with \fBTrickyButton\fR. +This means that the default widget bindings for buttons, which are +associated with the \fBButton\fR tag, will no longer apply to \fB.b\fR, +but any bindings associated with \fBTrickyButton\fR (perhaps some +new button behavior) will apply. + +.SH "SEE ALSO" +bind + +.SH KEYWORDS +binding, event, tag diff --git a/doc/button.n b/doc/button.n new file mode 100644 index 0000000..0bca668 --- /dev/null +++ b/doc/button.n @@ -0,0 +1,156 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH button n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +button \- Create and manipulate button widgets +.SH SYNOPSIS +\fBbutton\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 3.8c 7.6c 11.4c +\fBactiveAttributes\fR \fBattributes\fR \fBdisabledForeground\fR \fBtextVariable\fR +\fBactiveBackground\fR \fBbackground\fR \fBforeground\fR \fBunderline\fR +\fBactiveForeground\fR \fBdisabledAttributes\fR \fBtakeFocus\fR \fBunderlineAttributes\fR +\fBanchor\fR \fBdisabledBackground\fR \fBtext\fR \fBunderlineForeground\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBcommand\fR +Class: \fBCommand\fR +Command-Line Switch: \fB\-command\fR +.fi +.IP +Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is pressed over the button +window. +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies a desired height for the button in screen lines. +If this option isn't specified, the button's desired height is 1 line. +.LP +.nf +Name: \fBstate\fR +Class: \fBState\fR +Command-Line Switch: \fB\-state\fR +.fi +.IP +Specifies one of three states for the button: \fBnormal\fR, \fBactive\fR, +or \fBdisabled\fR. In normal state the button is displayed using the +\fBforeground\fR and \fBbackground\fR options. The active state is +typically used when the input focus is in the button. In active state +the button is displayed using the \fBactiveAttributes\fR, +\fBactiveForeground\fR and \fBactiveBackground\fR options. +Disabled state means that the button should be insensitive: +the default bindings will refuse to activate the widget and will ignore +mouse button presses. In this state the \fBdisabledAttributes\fR, +\fBdisabledForeground\fR and \fBdisabledBackground\fR options +determine how the button is displayed. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies a desired width for the button in screen columns. +If this option isn't specified, the button's desired width is computed +from the size of the text being displayed in it. +.BE + +.SH DESCRIPTION +.PP +The \fBbutton\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a button widget. +Additional options, described above, may be specified on the command line +or in the option database to configure aspects of the button such as its +colors, attributes, and text. The \fBbutton\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A button is a widget that displays a textual string, bitmap or image. +One of the characters may optionally be underlined using the +\fBunderline\fR, \fBunderlineAttributes\fR, and \fBunderlineForeground\fR +options. It can display itself in either of three different ways, according +to the \fBstate\fR option. +When a user invokes the button (e.g. by pressing mouse button 1 with the cursor +over the button), then the Tcl command specified in the \fB\-command\fR +option is invoked. + +.SH "WIDGET COMMAND" +.PP +The \fBbutton\fR command creates a new Tcl command whose +name is \fIpathName\fR. This command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for button widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBbutton\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBbutton\fR +command. +.TP +\fIpathName \fBinvoke\fR +Invoke the Tcl command associated with the button, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the button. +This command is ignored if the button's state is \fBdisabled\fR. + +.SH "DEFAULT BINDINGS" +.PP +Ck automatically creates class bindings for buttons that give them +the following default behavior: +.IP [1] +A button activates whenever it gets the input focus and deactivates +whenever it loses the input focus. +.IP [2] +If mouse button 1 is pressed over a button, the button is invoked. +.IP [3] +When a button has the input focus, the space or return key cause the +button to be invoked. +.PP +If the button's state is \fBdisabled\fR then none of the above +actions occur: the button is completely non-responsive. +.PP +The behavior of buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH KEYWORDS +button, widget diff --git a/doc/checkbutton.n b/doc/checkbutton.n new file mode 100644 index 0000000..9cd9ed6 --- /dev/null +++ b/doc/checkbutton.n @@ -0,0 +1,232 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH checkbutton n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +checkbutton \- Create and manipulate checkbutton widgets +.SH SYNOPSIS +\fBcheckbutton\fI pathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 3.8c 7.6c 11.4c +\fBactiveAttributes\fR \fBattributes\fR \fBdisabledForeground\fR \fBtextVariable\fR +\fBactiveBackground\fR \fBbackground\fR \fBforeground\fR \fBunderline\fR +\fBactiveForeground\fR \fBdisabledAttributes\fR \fBtakeFocus\fR \fBunderlineAttributes\fR +\fBanchor\fR \fBdisabledBackground\fR \fBtext\fR \fBunderlineForeground\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBcommand\fR +Class: \fBCommand\fR +Command-Line Switch: \fB\-command\fR +.fi +.IP +Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is pressed on the button +window. The button's global variable (\fB\-variable\fR option) will +be updated before the command is invoked. +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies a desired height for the button in screen lines. +If this option isn't specified, the button's desired height is 1 line. +.LP +.nf +Name: \fBoffValue\fR +Class: \fBValue\fR +Command-Line Switch: \fB\-offvalue\fR +.fi +.IP +Specifies value to store in the button's associated variable whenever +this button is deselected. Defaults to ``0''. +.LP +.nf +Name: \fBonValue\fR +Class: \fBValue\fR +Command-Line Switch: \fB\-onvalue\fR +.fi +.IP +Specifies value to store in the button's associated variable whenever +this button is selected. Defaults to ``1''. +.LP +.nf +Name: \fBselectColor\fR +Class: \fBBackground\fR +Command-Line Switch: \fB\-selectcolor\fR +.fi +.IP +Specifies a background color to use when the button is selected. +If \fBindicatorOn\fR is true then the color applicies to the indicator. +.LP +.nf +Name: \fBstate\fR +Class: \fBState\fR +Command-Line Switch: \fB\-state\fR +.fi +.IP +Specifies one of three states for the checkbutton: \fBnormal\fR, \fBactive\fR, +or \fBdisabled\fR. In normal state the checkbutton is displayed using the +\fBattributes\fR, \fBforeground\fR and \fBbackground\fR options. +The active state is used when the input focus is in the checkbutton. +In active state the checkbutton is displayed using the +\fBactiveAttributes\fR, \fBactiveForeground\fR, and +\fBactiveBackground\fR options. Disabled state means that the checkbutton +should be insensitive: the default bindings will refuse to activate +the widget and will ignore mouse button presses. +In this state the \fBdisabledAttributes\fR, \fBdisabledForeground\fR, and +\fBdisabledBackground\fR options determine how the checkbutton is displayed. +.LP +.nf +Name: \fBvariable\fR +Class: \fBVariable\fR +Command-Line Switch: \fB\-variable\fR +.fi +.IP +Specifies name of global variable to set to indicate whether +or not this button is selected. Defaults to the name of the +button within its parent (i.e. the last element of the button +window's path name). +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies a desired width for the button in screen columns. +If this option isn't specified, the button's desired width is computed +from the size of the text being displayed in it. +.BE + +.SH DESCRIPTION +.PP +The \fBcheckbutton\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a checkbutton widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the checkbutton such as its colors, font, +text, and initial relief. The \fBcheckbutton\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A checkbutton is a widget that displays a textual string +and a square called an \fIindicator\fR. One of the characters of the +string may optionally be underlined using the +\fBunderline\fR, \fBunderlineAttributes\fR, and \fBunderlineForeground\fR +options. A checkbutton has all of the behavior of a simple button, +including the following: it can display itself in either of three different +ways, according to the \fBstate\fR option, and it invokes +a Tcl command whenever mouse button 1 is clicked over the +checkbutton. +.PP +In addition, checkbuttons can be \fIselected\fR. If a checkbutton is +selected then the indicator is drawn with a special color, and +a Tcl variable associated with the checkbutton is set to a particular +value (normally 1). +If the checkbutton is not selected, then the indicator is drawn with no +special color, and the associated variable is set to a different value +(typically 0). +By default, the name of the variable associated with a checkbutton is the +same as the \fIname\fR used to create the checkbutton. +The variable name, and the ``on'' and ``off'' values stored in it, +may be modified with options on the command line or in the option +database. By default a checkbutton is configured to select and deselect +itself on alternate button clicks. +In addition, each checkbutton monitors its associated variable and +automatically selects and deselects itself when the variables value +changes to and from the button's ``on'' value. + +.SH "WIDGET COMMAND" +.PP +The \fBcheckbutton\fR command creates a new Tcl command whose +name is \fIpathName\fR. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for checkbutton widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBcheckbutton\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBcheckbutton\fR +command. +.TP +\fIpathName \fBdeselect\fR +Deselects the checkbutton and sets the associated variable to its ``off'' +value. +.TP +\fIpathName \fBinvoke\fR +Does just what would have happened if the user invoked the checkbutton +with the mouse: toggle the selection state of the button and invoke +the Tcl command associated with the checkbutton, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the checkbutton. +This command is ignored if the checkbutton's state is \fBdisabled\fR. +.TP +\fIpathName \fBselect\fR +Selects the checkbutton and sets the associated variable to its ``on'' +value. +.TP +\fIpathName \fBtoggle\fR +Toggles the selection state of the button, redisplaying it and +modifying its associated variable to reflect the new state. + +.SH BINDINGS +.PP +Ck automatically creates class bindings for checkbuttons that give them +the following default behavior: +.IP [1] +A checkbutton activates whenever it gets the input focus and deactivates +whenever it loses the input focus. +.IP [2] +When mouse button 1 is pressed over a checkbutton it is invoked (its +selection state toggles and the command associated with the button is +invoked, if there is one). +.IP [3] +When a checkbutton has the input focus, the space or return keys cause +the checkbutton to be invoked. +.PP +If the checkbutton's state is \fBdisabled\fR then none of the above +actions occur: the checkbutton is completely non-responsive. +.PP +The behavior of checkbuttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH KEYWORDS +checkbutton, widget diff --git a/doc/ck_chooseColor.n b/doc/ck_chooseColor.n new file mode 100644 index 0000000..1b884e8 --- /dev/null +++ b/doc/ck_chooseColor.n @@ -0,0 +1,284 @@ +'\" +'\" Copyright (c) 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: ck_chooseColor.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" RCS: @(#) $Id: ck_chooseColor.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +'\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.TH ck_chooseColor n 4.2 Tk "Tk Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +ck_chooseColor \- pops up a dialog box for the user to select a color. +.PP +.SH SYNOPSIS +\fBck_chooseColor \fR?\fIoption value ...\fR? +.BE + +.SH DESCRIPTION +.PP +The procedure \fBck_chooseColor\fR pops up a dialog box for the +user to select a color. The following \fIoption\-value\fR pairs are +possible as command line arguments: +.TP +\fB\-initialcolor\fR \fIcolor\fR +Specifies the color to display in the color dialog when it pops +up. \fIcolor\fR must be in a form acceptable to the \fBTk_GetColor\fR +function. +.TP +\fB\-parent\fR \fIwindow\fR +Makes \fIwindow\fR the logical parent of the color dialog. The color +dialog is displayed on top of its parent window. +.TP +\fB\-title\fR \fItitleString\fR +Specifies a string to display as the title of the dialog box. If this +option is not specified, then a default title will be displayed. +.LP +If the user selects a color, \fBck_chooseColor\fR will return the +name of the color in a form acceptable to \fBTk_GetColor\fR. If the +user cancels the operation, both commands will return the empty +string. +.SH EXAMPLE +.CS +button .b \-bg [ck_chooseColor \-initialcolor gray \-title "Choose color"] +.CE + +.SH KEYWORDS +color selection dialog diff --git a/doc/ck_dialog.n b/doc/ck_dialog.n new file mode 100644 index 0000000..6ce2688 --- /dev/null +++ b/doc/ck_dialog.n @@ -0,0 +1,298 @@ +'\" +'\" Copyright (c) 1992 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: ck_dialog.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" RCS: @(#) $Id: ck_dialog.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +'\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.TH ck_dialog n 4.1 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +ck_dialog \- Create modal dialog and wait for response +.SH SYNOPSIS +\fBck_dialog \fIwindow title text default string string ...\fR +.BE + +.SH DESCRIPTION +.PP +This procedure is part of the Ck script library. +Its arguments describe a dialog box: +.TP +\fIwindow\fR +Name of top-level window to use for dialog. Any existing window +by this name is destroyed. +.TP +\fItitle\fR +Text to display in dialog's decorative frame. +.TP +\fItext\fR +Message to appear in the top portion of the dialog box. +.TP +\fIdefault\fR +If this is an integer greater than or equal to zero, then it gives +the index of the button that is to be the default button for the dialog +(0 for the leftmost button, and so on). +If less than zero or an empty string then first button (number zero) is +focuced by default. +.TP +\fIstring\fR +There will be one button for each of these arguments. +Each \fIstring\fR specifies text to display in a button, +in order from left to right. +.PP +After creating a dialog box, \fBck_dialog\fR waits for the user to +select one of the buttons either by clicking on the button with the +mouse or by typing return to invoke the default button (if any). +Then it returns the index of the selected button: 0 for the leftmost +button, 1 for the button next to it, and so on. +If the dialog's window is destroyed before the user selects one +of the buttons, then -1 is returned. +.PP +While waiting for the user to respond, \fBck_dialog\fR sets a local +grab. This prevents the user from interacting with the application +in any way except to invoke the dialog box. +.SH RESOURCES + +This dialog uses Dialog class. + +.SH KEYWORDS + dialog, modal diff --git a/doc/ck_getOpenFile.n b/doc/ck_getOpenFile.n new file mode 100644 index 0000000..6435c69 --- /dev/null +++ b/doc/ck_getOpenFile.n @@ -0,0 +1,400 @@ +'\" +'\" Copyright (c) 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: ck_getOpenFile.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" RCS: @(#) $Id: ck_getOpenFile.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +'\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.TH ck_getOpenFile n 4.2 Tk "Tk Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +tk_getOpenFile, tk_getSaveFile \- pop up a dialog box for the user to select a file to open or save. +.SH SYNOPSIS +\fBck_getOpenFile \fR?\fIoption value ...\fR? +.br +\fBck_getSaveFile \fR?\fIoption value ...\fR? +.BE + +.SH DESCRIPTION +.PP +The procedures \fBck_getOpenFile\fR and \fBck_getSaveFile\fR pop up a +dialog box for the user to select a file to open or save. The +\fBck_getOpenFile\fR command is usually associated with the \fBOpen\fR +command in the \fBFile\fR menu. Its purpose is for the user to select an +existing file \fIonly\fR. If the user enters an non-existent file, the +dialog box gives the user an error prompt and requires the user to give +an alternative selection. If an application allows the user to create +new files, it should do so by providing a separate \fBNew\fR menu command. +.PP +The \fBck_getSaveFile\fR command is usually associated with the \fBSave +as\fR command in the \fBFile\fR menu. If the user enters a file that +already exists, the dialog box prompts the user for confirmation +whether the existing file should be overwritten or not. +.PP +The following \fIoption\-value\fR pairs are possible as command line +arguments to these two commands: +.TP +\fB\-defaultextension\fR \fIextension\fR +Specifies a string that will be appended to the filename if the user +enters a filename without an extension. The defaut value is the empty +string, which means no extension will be appended to the filename in +any case. This option is ignored on the Macintosh platform, which +does not require extensions to filenames, +.VS 8.4 +and the UNIX implementation guesses reasonable values for this from +the \fB\-filetypes\fR option when this is not supplied. +.VE 8.4 +.TP +\fB\-filetypes\fR \fIfilePatternList\fR +If a \fBFile types\fR listbox exists in the file dialog on the particular +platform, this option gives the \fIfiletype\fRs in this listbox. When +the user choose a filetype in the listbox, only the files of that type +are listed. If this option is unspecified, or if it is set to the +empty list, or if the \fBFile types\fR listbox is not supported by the +particular platform then all files are listed regardless of their +types. See the section SPECIFYING FILE PATTERNS below for a +discussion on the contents of \fIfilePatternList\fR. +.TP +\fB\-initialdir\fR \fIdirectory\fR +Specifies that the files in \fIdirectory\fR should be displayed +when the dialog pops up. If this parameter is not specified, then +the files in the current working directory are displayed. If the +parameter specifies a relative path, the return value will convert the +relative path to an absolute path. This option may not always work on +the Macintosh. This is not a bug. Rather, the \fIGeneral Controls\fR +control panel on the Mac allows the end user to override the +application default directory. +.TP +\fB\-initialfile\fR \fIfilename\fR +Specifies a filename to be displayed in the dialog when it pops up. This +option is ignored on the Macintosh platform. +.TP +\fB\-parent\fR \fIwindow\fR +Makes \fIwindow\fR the logical parent of the file dialog. The file +dialog is displayed on top of its parent window. +.TP +\fB\-title\fR \fItitleString\fR +Specifies a string to display as the title of the dialog box. If this +option is not specified, then a default title is displayed. +.PP +If the user selects a file, both \fBck_getOpenFile\fR and +\fBck_getSaveFile\fR return the full pathname of this file. If the +user cancels the operation, both commands return the empty string. +.SH "SPECIFYING FILE PATTERNS" + +The \fIfilePatternList\fR value given by the \fB\-filetypes\fR option +is a list of file patterns. Each file pattern is a list of the +form +.CS +\fItypeName\fR {\fIextension\fR ?\fIextension ...\fR?} ?{\fImacType\fR ?\fImacType ...\fR?}? +.CE +\fItypeName\fR is the name of the file type described by this +file pattern and is the text string that appears in the \fBFile types\fR +listbox. \fIextension\fR is a file extension for this file pattern. +\fImacType\fR is a four-character Macintosh file type. The list of +\fImacType\fRs is optional and may be omitted for applications that do +not need to execute on the Macintosh platform. +.PP +Several file patterns may have the same \fItypeName,\fR in which case +they refer to the same file type and share the same entry in the +listbox. When the user selects an entry in the listbox, all the files +that match at least one of the file patterns corresponding +to that entry are listed. Usually, each file pattern corresponds to a +distinct type of file. The use of more than one file patterns for one +type of file is necessary on the Macintosh platform only. +.PP +On the Macintosh platform, a file matches a file pattern if its +name matches at least one of the \fIextension\fR(s) AND it +belongs to at least one of the \fImacType\fR(s) of the +file pattern. For example, the \fBC Source Files\fR file pattern in the +sample code matches with files that have a \fB\.c\fR extension AND +belong to the \fImacType\fR \fBTEXT\fR. To use the OR rule instead, +you can use two file patterns, one with the \fIextensions\fR only and +the other with the \fImacType\fR only. The \fBGIF Files\fR file type +in the sample code matches files that EITHER have a \fB\.gif\fR +extension OR belong to the \fImacType\fR \fBGIFF\fR. +.PP +On the Unix and Windows platforms, a file matches a file pattern +if its name matches at at least one of the \fIextension\fR(s) of +the file pattern. The \fImacType\fRs are ignored. +.SH "SPECIFYING EXTENSIONS" +.PP +On the Unix and Macintosh platforms, extensions are matched using +glob-style pattern matching. On the Windows platforms, extensions are +matched by the underlying operating system. The types of possible +extensions are: (1) the special extension * matches any +file; (2) the special extension "" matches any files that +do not have an extension (i.e., the filename contains no full stop +character); (3) any character string that does not contain any wild +card characters (* and ?). +.PP +Due to the different pattern matching rules on the various platforms, +to ensure portability, wild card characters are not allowed in the +extensions, except as in the special extension *. Extensions +without a full stop character (e.g, ~) are allowed but may not +work on all platforms. + +.SH EXAMPLE +.CS +set types { + {{Text Files} {.txt} } + {{TCL Scripts} {.tcl} } + {{C Source Files} {.c} TEXT} + {{GIF Files} {.gif} } + {{GIF Files} {} GIFF} + {{All Files} * } +} +set filename [ck_getOpenFile -filetypes $types] + +if {$filename != ""} { + # Open the file ... +} +.CE + +.SH CUSTOMIZATION + +Ck file dialog uses class \fBCkFdialog\fR for its toplevel wiget. Use +\fBoption add\fR command to change default colors for it. +directory menu is inside frame with class \fBDir\fR and filename input +line in the frame with class \fBFilename\fR + +.SH KEYWORDS +file selection dialog diff --git a/doc/ck_messsageBox.n b/doc/ck_messsageBox.n new file mode 100644 index 0000000..70177e0 --- /dev/null +++ b/doc/ck_messsageBox.n @@ -0,0 +1,324 @@ +'\" +'\" Copyright (c) 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: ck_messsageBox.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" RCS: @(#) $Id: ck_messsageBox.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +'\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.TH ck_messageBox n 4.2 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +ck_messageBox \- pops up a message window and waits for user response. +.SH SYNOPSIS +\fBck_messageBox \fR?\fIoption value ...\fR? +.BE + +.SH DESCRIPTION +.PP +This procedure creates and displays a message window with an +application-specified message, an icon and a set of buttons. Each of +the buttons in the message window is identified by a unique symbolic +name (see the \fB\-type\fR options). After the message window is +popped up, \fBtk_messageBox\fR waits for the user to select one of the +buttons. Then it returns the symbolic name of the selected button. + +The following option-value pairs are supported: +.TP +\fB\-default\fR \fIname\fR +\fIName\fR gives the symbolic name of the default button for +this message window ('ok', 'cancel', and so on). See \fB\-type\fR +for a list of the symbolic names. If this option is not specified, +the first button in the dialog will be made the default. +.TP +\fB\-icon\fR \fIiconImage\fR +Specifies an icon to display. \fIIconImage\fR must be one of the +following: \fBerror\fR, \fBinfo\fR, \fBquestion\fR or +\fBwarning\fR. If this option is not specified, then the info icon will be +displayed. +.TP +\fB\-message\fR \fIstring\fR +Specifies the message to display in this message box. +.TP +\fB\-parent\fR \fIwindow\fR +Makes \fIwindow\fR the logical parent of the message box. The message +box is displayed on top of its parent window. +.TP +\fB\-title\fR \fItitleString\fR +Specifies a string to display as the title of the message box. The +default value is an empty string. +.TP +\fB\-type\fR \fIpredefinedType\fR +Arranges for a predefined set of buttons to be displayed. The +following values are possible for \fIpredefinedType\fR: +.RS +.TP 18 +\fBabortretryignore\fR +Displays three buttons whose symbolic names are \fBabort\fR, +\fBretry\fR and \fBignore\fR. +.TP 18 +\fBok\fR +Displays one button whose symbolic name is \fBok\fR. +.TP 18 +\fBokcancel\fR +Displays two buttons whose symbolic names are \fBok\fR and \fBcancel\fR. +.TP 18 +\fBretrycancel\fR +Displays two buttons whose symbolic names are \fBretry\fR and \fBcancel\fR. +.TP 18 +\fByesno\fR +Displays two buttons whose symbolic names are \fByes\fR and \fBno\fR. +.TP 18 +\fByesnocancel\fR +Displays three buttons whose symbolic names are \fByes\fR, \fBno\fR +and \fBcancel\fR. +.RE +.PP +.SH EXAMPLE +.CS +set answer [ck_messageBox \-message "Really quit?" \-type yesno \-icon question] +switch -- $answer { + yes exit + no {ck_messageBox \-message "I know you like this application!" \-type ok} +} +.CE + +.SH KEYWORDS +message box diff --git a/doc/ck_optionMenu.n b/doc/ck_optionMenu.n new file mode 100644 index 0000000..7714881 --- /dev/null +++ b/doc/ck_optionMenu.n @@ -0,0 +1,275 @@ +'\" +'\" Copyright (c) 1990-1994 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: ck_optionMenu.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" RCS: @(#) $Id: ck_optionMenu.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +'\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.TH ck_optionMenu n 4.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +ck_optionMenu \- Create an option menubutton and its menu +.SH SYNOPSIS +\fBck_optionMenu \fIw varName value \fR?\fIvalue value ...\fR? +.BE + +.SH DESCRIPTION +.PP +This procedure creates an option menubutton whose name is \fIw\fR, +plus an associated menu. +Together they allow the user to select one of the values +given by the \fIvalue\fR arguments. +The current value will be stored in the global variable whose +name is given by \fIvarName\fR and it will also be displayed as the label +in the option menubutton. +The user can click on the menubutton to display a menu containing +all of the \fIvalue\fRs and thereby select a new value. +Once a new value is selected, it will be stored in the variable +and appear in the option menubutton. +The current value can also be changed by setting the variable. +.PP +The return value from \fBck_optionMenu\fR is the name of the menu +associated with \fIw\fR, so that the caller can change its configuration +options or manipulate it in other ways. + +.SH KEYWORDS +option menu diff --git a/doc/ck_popup.n b/doc/ck_popup.n new file mode 100644 index 0000000..fa98ed4 --- /dev/null +++ b/doc/ck_popup.n @@ -0,0 +1,268 @@ +'\" +'\" 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: ck_popup.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" RCS: @(#) $Id: ck_popup.n,v 1.1 2006-02-24 18:59:53 vitus Exp $ +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +'\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.TH ck_popup n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +ck_popup \- Post a popup menu +.SH SYNOPSIS +\fBtk_popup \fImenu x y \fR?\fIentry\fR? +.BE + +.SH DESCRIPTION +.PP +This procedure posts a menu at a given position on the screen and +configures Tk so that the menu and its cascaded children can be +traversed with the mouse or the keyboard. +\fIMenu\fR is the name of a menu widget and \fIx\fR and \fIy\fR +are the root coordinates at which to display the menu. +If \fIentry\fR is omitted or an empty string, the +menu's upper left corner is positioned at the given point. +Otherwise \fIentry\fR gives the index of an entry in \fImenu\fR and +the menu will be positioned so that the entry is positioned over +the given point. + +.SH KEYWORDS +menu, popup diff --git a/doc/curses.n b/doc/curses.n new file mode 100644 index 0000000..624927f --- /dev/null +++ b/doc/curses.n @@ -0,0 +1,131 @@ +'\" +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH curses n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +curses \- Retrieve/modify curses based information +.SH SYNOPSIS +\fBcurses\fR \fIoption \fR?\fIarg arg ...\fR? +.BE + +.SH DESCRIPTION +.PP +The \fBcurses\fR command is used to retrieve or modify information +which is related to the \fBcurses(3)\fR library providing the +input/output mechanisms used by Ck. +It can take any of a number of different forms, +depending on the \fIoption\fR argument. The legal forms are: +.TP +\fBcurses barcode\fR \fIstartChar endChar ?timeout?\fR +Enables or modifies barcode reader support with delivery of \fBBarCode\fR +events. \fIStartChar\fR and \fIendChar\fR are the start and end characters +which delimit the barcode data packet without being delivered to the +application. They must be specified as decimal numbers. +The optional \fItimeout\fR argument is the maximum time between reception +of start and end characters in millisecond for receiving the data packet; +the default value is 1000. +.TP +\fBcurses barcode\fR \fI?off?\fR +If \fIoff\fR is present, barcode reader support is disabled. Otherwise, +the current start/end characters and the timeout are returned as a list +of three decimal numbers. +.TP +\fBcurses baudrate\fR +Returns the baud rate of the terminal as decimal string. +.TP +\fBcurses encoding \fR\fI?ISO8859|IBM437?\fR +Sets or returns the character encoding being or to be used for +displaying text. This affects for example the output of +the text widget for the character values 0x80..0x9f. +.TP +\fBcurses gchar \fR\fI?charName? ?value?\fR +Sets or returns the mappings of ``Alternate Character Set'' characters +used to display the arrows of scrollbars, the indicators for checkbuttons +and radiobuttons etc. \fICharName\fR must be a valid name of an ACS +character (see list below), and \fIvalue\fR must be an integer, i.e. +the value of the \fBcurses(3)\fR character which shall be output for the +ACS character. By default the \fBterminfo(5)\fR entry for the terminal +provides these mappings and there's rarely a need to modify them. +.sp 1 +.ta 3c +.nf +\fBCk name description\fR +ulcorner upper left corner +urcorner upper right corner +llcorner lower left corner +lrcorner lower right corner +rtee tee pointing right +ltee tee pointing left +btee tee pointing up +ttee tee pointing down +hline horizontal line +vline vertical line +plus large plus or crossover +s1 scan line #1 +s9 scan line #9 +diamond diamond +ckboard checker board (stipple) +degree degree symbol +plminus plus/minus +bullet bullet +larrow arrow pointing left +rarrow arrow pointing right +uarrow arrow pointing up +darrow arrow pointing down +board board of squares +lantern lantern symbol +block solid square block +.fi +.TP +\fBcurses haskey\fR \fI?keyName?\fR +If \fIkeyName\fR is omitted this command returns a list of all valid +symbolic names of keyboard keys. +If \fIkeyName\fR is given, a boolean is returned indicating if the +terminal can generate that key. +.TP +\fBcurses purgeinput\fR +Removes all characters typed so far from the keyboard input queue. This +command should be used with great caution, since \fBxterm(1)\fR +mouse events and barcode events are reported through the keyboard +input queue as a character stream which can be interrupted +by this command. +.TP +\fBcurses refreshdelay \fR\fI?milliseconds?\fR +Sets or returns a time value which is used to limit the number of +\fBcurses(3)\fR screen updates. By default the delay is zero, which +does not impose any limits. Setting the refresh delay to a positive +number can be useful in environments where the terminal is connected +via terminal servers or \fBrlogin(1)\fR sessions. +.TP +\fBcurses reversekludge \fR\fI?boolean?\fR +Queries or modifies special code for treatment of the reverse video +attribute in conjunction with colors. On some terminals (e.g. the +infamous AT386 Interactive console), the reverse attribute overrides +the colors in effect. If the special code is enabled, the reverse +attribute is emulated by swapping the foreground and background colors. +.TP +\fBcurses screendump \fR\fIfileName\fR +Dumps the current screen contents to the file \fIfileName\fR if the +curses library supports the \fBscr_dmp(3)\fR function. Otherwise an +error is reported. The screen dump file is per se not useful, since +it contains some binary representation internal to curses. However, +there may exist an external utility program which transforms the screen +dump file to ASCII in order to print it on paper. +.TP +\fBcurses suspend\fR +Takes appropriate actions for job control, such as saving \fBcurses(3)\fR +terminal state, sending the stop signal to the process and restoring +the terminal state when the process is continued. + +.SH "SEE ALSO" +curses(3) + +.SH KEYWORDS +screen, terminal, curses + diff --git a/doc/cwsh.1 b/doc/cwsh.1 new file mode 100644 index 0000000..e1912ec --- /dev/null +++ b/doc/cwsh.1 @@ -0,0 +1,117 @@ +'\" +'\" Copyright (c) 1991-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH cwsh 1 8.0 Ck "Ck Applications" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +cwsh \- Simple curses windowing shell +.SH SYNOPSIS +\fBcwsh\fR ?\fIfileName arg arg ...\fR? +.BE + +.SH DESCRIPTION +.PP +\fBCwsh\fR is a simple program consisting of the Tcl command +language, the Ck toolkit, and a main program that eventually reads +commands from a file. +It creates a main window and then processes Tcl commands. +If \fBcwsh\fR is invoked with no arguments, +then it reads Tcl commands interactively from a command window. +It will continue processing commands until all windows have been +deleted or until the \fBexit\fR Tcl command is evaluated. +If there exists a file \fB.cwshrc\fR in the home directory of +the user, \fBcwsh\fR evaluates the file as a Tcl script +just before presenting the command window. +.PP +If \fBcwsh\fR is invoked with an initial \fIfileName\fR argument, then +\fIfileName\fR is treated as the name of a script file. +\fBCwsh\fR will evaluate the script in \fIfileName\fR (which +presumably creates a user interface), then it will respond to events +until all windows have been deleted. The command window will not +be created. +There is no automatic evaluation of \fB.cwshrc\fR in this +case, but the script file can always \fBsource\fR it if desired. + +.SH "APPLICATION NAME AND CLASS" +.PP +The name of the application, which is used for processing the +option data base is taken from \fIfileName\fR, if it is specified, +or from the command name by which \fBcwsh\fR was invoked. +If this name contains a ``/'' +character, then only the characters after the last slash are used +as the application name. +.PP +The class of the application, which is used for purposes such as +specifying options, is the same as its name except that the first letter is +capitalized. + +.SH "VARIABLES" +.PP +\fBCwsh\fR sets the following Tcl variables: +.TP 15 +\fBargc\fR +Contains a count of the number of \fIarg\fR arguments (0 if none). +.TP 15 +\fBargv\fR +Contains a Tcl list whose elements are the \fIarg\fR arguments +that follow \fIfileName\fR, in order, or an empty string +if there are no such arguments. +.TP 15 +\fBargv0\fR +Contains \fIfileName\fR if it was specified. +Otherwise, contains the name by which \fBcwsh\fR was invoked. +.TP 15 +\fBtcl_interactive\fR +Contains 1 if \fBcwsh\fR was started without \fIfileName\fR +argument, 0 otherwise. + +.SH "SCRIPT FILES" +.PP +If you create a Tcl script in a file whose first line is +.DS +\fB#!/usr/local/bin/cwsh\fR +.DE +then you can invoke the script file directly from your shell if +you mark it as executable. +This assumes that \fBcwsh\fR has been installed in the default +location in /usr/local/bin; if it's installed somewhere else +then you'll have to modify the above line to match. +Many UNIX systems do not allow the \fB#!\fR line to exceed about +30 characters in length, so be sure that the \fBcwsh\fR executable +can be accessed with a short file name. +.PP +An even better approach is to start your script files with the +following three lines: +.DS +\fB#!/bin/sh +# the next line restarts using cwsh \e +exec cwsh "$0" "$@"\fR +.DE +This approach has three advantages over the approach in the previous +paragraph. First, the location of the \fBcwsh\fR binary doesn't have +to be hard-wired into the script: it can be anywhere in your shell +search path. Second, it gets around the 30-character file name limit +in the previous approach. +Third, this approach will work even if \fBcwsh\fR is +itself a shell script (this is done on some systems in order to +handle multiple architectures or operating systems: the \fBcwsh\fR +script selects one of several binaries to run). The three lines +cause both \fBsh\fR and \fBcwsh\fR to process the script, but the +\fBexec\fR is only executed by \fBsh\fR. +\fBsh\fR processes the script first; it treats the second +line as a comment and executes the third line. +The \fBexec\fR statement cause the shell to stop processing and +instead to start up \fBcwsh\fR to reprocess the entire script. +When \fBcwsh\fR starts up, it treats all three lines as comments, +since the backslash at the end of the second line causes the third +line to be treated as part of the comment on the second line. + +.SH KEYWORDS +shell, toolkit diff --git a/doc/destroy.n b/doc/destroy.n new file mode 100644 index 0000000..34a08ec --- /dev/null +++ b/doc/destroy.n @@ -0,0 +1,30 @@ +'\" +'\" Copyright (c) 1990 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH destroy n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +destroy \- Destroy one or more windows +.SH SYNOPSIS +\fBdestroy \fR?\fIwindow window ...\fR? +.BE + +.SH DESCRIPTION +.PP +This command deletes the windows given by the +\fIwindow\fR arguments, plus all of their descendants. +If a \fIwindow\fR ``.'' is deleted then the entire application +will be destroyed and the actions of the \fBexit\fR command are +taken. The \fIwindow\fRs are destroyed in order, and if an error occurs +in destroying a window the command aborts without destroying the +remaining windows. + +.SH KEYWORDS +application, destroy, window diff --git a/doc/dialog.n b/doc/dialog.n new file mode 100644 index 0000000..62eb45e --- /dev/null +++ b/doc/dialog.n @@ -0,0 +1,46 @@ +'\" +'\" Copyright (c) 1992 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH ck_dialog n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +ck_dialog \- Create dialog and wait for response +.SH SYNOPSIS +\fBck_dialog \fIwindow title text string string ...\fR +.BE + +.SH DESCRIPTION +.PP +This procedure is part of the Ck script library. +Its arguments describe a dialog box: +.TP +\fIwindow\fR +Name of top-level window to use for dialog. Any existing window +by this name is destroyed. +.TP +\fItitle\fR +Text to appear in the window's top line as title for the dialog. +.TP +\fItext\fR +Message to appear in the top portion of the dialog box. +.TP +\fIstring\fR +There will be one button for each of these arguments. +Each \fIstring\fR specifies text to display in a button, +in order from left to right. +.PP +After creating a dialog box, \fBck_dialog\fR waits for the user to +select one of the buttons either by clicking on the button with the +mouse or by typing return or space to invoke the focus button (if any). +Then it returns the index of the selected button: 0 for the leftmost +button, 1 for the button next to it, and so on. + +.SH KEYWORDS +bitmap, dialog diff --git a/doc/entry.n b/doc/entry.n new file mode 100644 index 0000000..ef0c3ee --- /dev/null +++ b/doc/entry.n @@ -0,0 +1,335 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH entry n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +entry \- Create and manipulate entry widgets +.SH SYNOPSIS +\fBentry\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +\fBattributes\fR \fBjustify\fR \fBselectForeground\fR \fBxScrollCommand\fR +\fBbackground\fR \fBselectAttributes\fR \fBtakeFocus\fR +\fBforeground\fR \fBselectBackground\fR \fBtextVariable\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBshow\fR +Class: \fBShow\fR +Command-Line Switch: \fB\-show\fR +.fi +.IP +If this option is specified, then the true contents of the entry +are not displayed in the window. +Instead, each character in the entry's value will be displayed as +the first character in the value of this option, such as ``*''. +This is useful, for example, if the entry is to be used to enter +a password. +.LP +.nf +Name: \fBstate\fR +Class: \fBState\fR +Command-Line Switch: \fB\-state\fR +.fi +.IP +Specifies one of two states for the entry: \fBnormal\fR or \fBdisabled\fR. +If the entry is disabled then the value may not be changed using widget +commands and no insertion cursor will be displayed, even if the input focus is +in the widget. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies an integer value indicating the desired width of the entry window, +in screen columns. If the value is less than or equal to zero, the widget +picks a size just large enough to hold its current text. The default width +is 16. +.BE + +.SH DESCRIPTION +.PP +The \fBentry\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into an entry widget. +Additional options, described above, may be specified on the +command line or in the option database +to configure aspects of the entry such as its colors and attributes. +The \fBentry\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +An entry is a widget that displays a one-line text string and +allows that string to be edited using widget commands described below, which +are typically bound to keystrokes and mouse actions. +When first created, an entry's string is empty. +A portion of the entry may be selected as described below. +Entries also observe the standard Ck rules for dealing with the +input focus. When an entry has the input focus it displays an +\fIinsertion cursor\fR to indicate where new characters will be +inserted. +.PP +Entries are capable of displaying strings that are too long to +fit entirely within the widget's window. In this case, only a +portion of the string will be displayed; commands described below +may be used to change the view in the window. Entries use +the standard \fBxScrollCommand\fR mechanism for interacting with +scrollbars (see the description of the \fBxScrollCommand\fR option +for details). + +.SH "WIDGET COMMAND" +.PP +The \fBentry\fR command creates a new Tcl command whose +name is \fIpathName\fR. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. +.PP +Many of the widget commands for entries take one or more indices as +arguments. An index specifies a particular character in the entry's +string, in any of the following ways: +.TP 12 +\fInumber\fR +Specifies the character as a numerical index, where 0 corresponds +to the first character in the string. +.TP 12 +\fBanchor\fR +Indicates the anchor point for the selection, which is set with the +\fBselect from\fR and \fBselect adjust\fR widget commands. +.TP 12 +\fBend\fR +Indicates the character just after the last one in the entry's string. +This is equivalent to specifying a numerical index equal to the length +of the entry's string. +.TP 12 +\fBinsert\fR +Indicates the character adjacent to and immediately following the +insertion cursor. +.TP 12 +\fBsel.first\fR +Indicates the first character in the selection. It is an error to +use this form if the selection isn't in the entry window. +.TP 12 +\fBsel.last\fR +Indicates the character just after the last one in the selection. +It is an error to use this form if the selection isn't in the +entry window. +.TP 12 +\fB@\fInumber\fR +In this form, \fInumber\fR is treated as an x-coordinate in the +entry's window; the character spanning that x-coordinate is used. +For example, ``\fB@0\fR'' indicates the left-most character in the +window. +.LP +Abbreviations may be used for any of the forms above, e.g. ``\fBe\fR'' +or ``\fBsel.f\fR''. In general, out-of-range indices are automatically +rounded to the nearest legal value. +.PP +The following commands are possible for entry widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBentry\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBentry\fR +command. +.TP +\fIpathName \fBdelete \fIfirst \fR?\fIlast\fR? +Delete one or more elements of the entry. +\fIFirst\fR is the index of the first character to delete, and +\fIlast\fR is the index of the character just after the last +one to delete. +If \fIlast\fR isn't specified it defaults to \fIfirst\fR+1, +i.e. a single character is deleted. +This command returns an empty string. +.TP +\fIpathName \fBget\fR +Returns the entry's string. +.TP +\fIpathName \fBicursor \fIindex\fR +Arrange for the insertion cursor to be displayed just before the character +given by \fIindex\fR. Returns an empty string. +.TP +\fIpathName \fBindex\fI index\fR +Returns the numerical index corresponding to \fIindex\fR. +.TP +\fIpathName \fBinsert \fIindex string\fR +Insert the characters of \fIstring\fR just before the character +indicated by \fIindex\fR. Returns an empty string. +.TP +\fIpathName \fBselection \fIoption arg\fR +This command is used to adjust the selection within an entry. It +has several forms, depending on \fIoption\fR: +.RS +.TP +\fIpathName \fBselection adjust \fIindex\fR +Locate the end of the selection nearest to the character given by +\fIindex\fR, and adjust that end of the selection to be at \fIindex\fR +(i.e including but not going beyond \fIindex\fR). The other +end of the selection is made the anchor point for future +\fBselect to\fR commands. If the selection +isn't currently in the entry, then a new selection is created to +include the characters between \fIindex\fR and the most recent +selection anchor point, inclusive. +Returns an empty string. +.TP +\fIpathName \fBselection clear\fR +Clear the selection if it is currently in this widget. If the +selection isn't in this widget then the command has no effect. +Returns an empty string. +.TP +\fIpathName \fBselection from \fIindex\fR +Set the selection anchor point to just before the character +given by \fIindex\fR. Doesn't change the selection. +Returns an empty string. +.TP +\fIpathName \fBselection present\fR +Returns 1 if there is are characters selected in the entry, +0 if nothing is selected. +.TP +\fIpathName \fBselection range \fIstart\fR \fIend\fR +Sets the selection to include the characters starting with +the one indexed by \fIstart\fR and ending with the one just +before \fIend\fR. +If \fIend\fR refers to the same character as \fIstart\fR or an +earlier one, then the entry's selection is cleared. +.TP +\fIpathName \fBselection to \fIindex\fR +If \fIindex\fR is before the anchor point, set the selection +to the characters from \fIindex\fR up to but not including +the anchor point. +If \fIindex\fR is the same as the anchor point, do nothing. +If \fIindex\fR is after the anchor point, set the selection +to the characters from the anchor point up to but not including +\fIindex\fR. +The anchor point is determined by the most recent \fBselect from\fR +or \fBselect adjust\fR command in this widget. +If the selection isn't in this widget then a new selection is +created using the most recent anchor point specified for the widget. +Returns an empty string. +.RE +.TP +\fIpathName \fBxview \fIargs\fR +This command is used to query and change the horizontal position of the +text in the widget's window. It can take any of the following +forms: +.RS +.TP +\fIpathName \fBxview\fR +Returns a list containing two elements. +Each element is a real fraction between 0 and 1; together they describe +the horizontal span that is visible in the window. +For example, if the first element is .2 and the second element is .6, +20% of the entry's text is off-screen to the left, the middle 40% is visible +in the window, and 40% of the text is off-screen to the right. +These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR +option. +.TP +\fIpathName \fBxview\fR \fIindex\fR +Adjusts the view in the window so that the character given by \fIindex\fR +is displayed at the left edge of the window. +.TP +\fIpathName \fBxview moveto\fI fraction\fR +Adjusts the view in the window so that the character \fIfraction\fR of the +way through the text appears at the left edge of the window. +\fIFraction\fR must be a fraction between 0 and 1. +.TP +\fIpathName \fBxview scroll \fInumber what\fR +This command shifts the view in the window left or right according to +\fInumber\fR and \fIwhat\fR. +\fINumber\fR must be an integer. +\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation +of one of these. +If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by +\fInumber\fR average-width characters on the display; if it is +\fBpages\fR then the view adjusts by \fInumber\fR screenfuls. +If \fInumber\fR is negative then characters farther to the left +become visible; if it is positive then characters farther to the right +become visible. +.RE + +.SH "DEFAULT BINDINGS" +.PP +Ck automatically creates class bindings for entries that give them +the following default behavior. +.IP [1] +Clicking mouse button 1 positions the insertion cursor +just before the character underneath the mouse cursor, sets the +input focus to this widget, and clears any selection in the widget. +.IP [2] +If any normal printing characters are typed in an entry, they are +inserted at the point of the insertion cursor. +.IP [3] +The Left and Right keys move the insertion cursor one character to the +left or right; they also clear any selection in the entry and set +the selection anchor. +Control-b and Control-f behave the same as Left and Right, respectively. +.IP [4] +The Home key, or Control-a, will move the insertion cursor to the +beginning of the entry and clear any selection in the entry. +.IP [5] +The End key, or Control-e, will move the insertion cursor to the +end of the entry and clear any selection in the entry. +.IP [6] +The Select key sets the selection anchor to the position +of the insertion cursor. It doesn't affect the current selection. +.IP [7] +The Delete key deletes the selection, if there is one in the entry. +If there is no selection, it deletes the character to the right of +the insertion cursor. +.IP [8] +The BackSpace key and Control-h delete the selection, if there is one +in the entry. +If there is no selection, it deletes the character to the left of +the insertion cursor. +.IP [9] +Control-d deletes the character to the right of the insertion cursor. +.IP [10] +Control-k deletes all the characters to the right of the insertion +cursor. +.IP [11] +Control-t reverses the order of the two characters to the right of +the insertion cursor. +.PP +If the entry is disabled using the \fB\-state\fR option, then the entry's +view can still be adjusted and text in the entry can still be selected, +but no insertion cursor will be displayed and no text modifications will +take place. +.PP +The behavior of entries can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH KEYWORDS +entry, widget diff --git a/doc/entryx.n b/doc/entryx.n new file mode 100644 index 0000000..e975bdd --- /dev/null +++ b/doc/entryx.n @@ -0,0 +1,130 @@ +'\" +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH entryx n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +entryx \- Create extended entry widgets +.SH SYNOPSIS +\fBentryx \fIpathName ?options?\fR +.BE + +.SH DESCRIPTION +.PP +This procedure is part of the Ck script library. It is a slightly extended +version of the Tcl \fBentry\fR command which provides the following +additional command line options: +.TP +\fB\-default \fIvalue\fR +Default value for \fBinteger\fR, \fBunsigned\fR, and \fBfloat\fR modes, +which is stored in entry widget on FocusOut, if the value in the widget +is not a legal number. Defaults to an empty string. +.TP +\fB\-fieldwidth \fInumber\fR +Limits the string in the entry widget to at most \fInumber\fR characters. +Defaults to some ten thousand characters. +.TP +\fB\-initial \fIvalue\fR +Initial value for the entry's string. If this option is omitted, no +initial value is set. +.TP +\fB\-mode \fImodeName\fR +Determines the additional bindings for input checking which will be +bound to the entry widget. \fIModeName\fR must be one of \fBinteger\fR +(for integer numbers including optional sign), \fBunsigned\fR (for +integer numbers without sign), \fBfloat\fR (for +floating point numbers including optional sign and fractional part, +but without exponent part), \fBnormal\fR (for entries without input +checking at all), \fBregexp\fR (for checking the entry's string +against a regular expression), and \fBboolean\fR (for boolean values, +e.g. 0 or 1, Y or N and so on). +If the \fB\-mode\fR option is omitted, \fBnormal\fR is chosen as default. +.TP +\fB\-offvalue \fIchar\fR +For mode \fBboolean\fR entry widgets only: \fIchar\fR is used for the +``false'' state of the entry. \fIChar\fR defaults to ``0''. It is always +converted to upper case. +.TP +\fB\-onvalue \fIchar\fR +For mode \fBboolean\fR entry widgets only: \fIchar\fR is used for the +``true'' state of the entry. \fIChar\fR defaults to ``1''. It is always +converted to upper case. +.TP +\fB\-regexp \fIregExp\fR +For all modes this is the regular expression which provides input filtering. +This option is ignored for \fBboolean\fR mode. +.TP +\fB\-touchvariable \fIvarName\fR +The global variable \fIvarName\fR is set to 1 whenever the user +changes the entry's string. The user may reset this variable to 0 +at any time. +.PP +These options must be given at creation time of the entry. They cannot +be modified later using the \fBconfigure\fR widget command. +.PP +After creating the entry widget, \fBentryx\fR binds procedures to +do input checking using the \fBbindtags\fR mechanism to the entry widget. +These procedures provide for overtype rather than insert mode and give +the following behaviour: +.IP [1] +If mouse button 1 is pressed on the entry and the entry accepts the input +focus, the input focus is set on the entry and the entry's insertion cursor +is placed on the very first character. +.IP [2] +The Left and Right keys move the insertion cursor one character to the +left or right. In \fBboolean\fR mode these keys are used for keyboard +traversal, i.e. the Left key moves the focus to the previous widget in +focus order, the Right key to the next widget. +.IP [3] +The return key moves the input focus to the next widget in focus order. +.IP [4] +The Home key moves the insertion cursor to the +beginning of the entry. In \fBboolean\fR mode this key is ignored. +.IP [5] +The End key moves the insertion cursor to the +end of the entry. In \fBboolean\fR mode this key is ignored. +.IP [6] +The Delete key deletes the character to the right of the insertion cursor. +In \fBboolean\fR mode this key is ignored. +.IP [7] +The BackSpace key and Control-h delete the character to the left of +the insertion cursor. In \fBboolean\fR mode this key is ignored. +.IP [8] +The space key deletes from the insertion cursor until the end of the entry, +if the mode is \fBinteger\fR, \fBunsigned\fR, \fBfloat\fR or \fBregexp\fR. +For \fBregexp\fR mode, the space character must not be part of the regular +expression to achieve this behaviour. Otherwise it is treated as all other +printable keys. In \fBboolean\fR mode this key toggles the entry's value. +.IP [9] +All other printable keys are checked according to the entry's mode. +If allowed they overtype the character under the insertion cursor, otherwise +they are ignored and the terminal's bell is rung. +Lower case characters are automatically converted to upper case, if the +regular expression filters denies lower case characters but allows upper +case characters. +.IP [10] +FocusIn is bound to display the entry with the \fIreverse\fR attribute for +monochrome screens or with swapped foreground and background colors on color +screens; additionally, the insertion cursor is placed on the very first +character in the entry. +.IP [11] +FocusOut is bound to restore the visual effects of FocusIn, i.e. on +mononochrome screens, the \fIreverse\fR attribute is removed, +on color screens, the foreground and background colors are restored to +their original values. For \fBinteger\fR, \fBunsigned\fR, and \fIfloat\fR +modes, the entry's value is finally checked using the \fBscan\fR Tcl command. +If the value is legal it is restored into the entry as the return from the +\fBscan\fR, thus giving the Tcl canonical form for the value, i.e. no leading +zeros for integral values (which otherwise could be interpreted as octal +numbers) and a decimal point with at least one fractional +digit for floating point values (which otherwise could be interpreted as +integral numbers). If the \fBscan\fR conversion fails, the value specified +in the \fB\-default\fR option is stored into the entry. + +.SH KEYWORDS +entry, input diff --git a/doc/exit.n b/doc/exit.n new file mode 100644 index 0000000..7c651be --- /dev/null +++ b/doc/exit.n @@ -0,0 +1,34 @@ +'\" +'\" Copyright (c) 1993 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH exit n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +exit \- Exit the process +.SH SYNOPSIS +\fBexit \fR?\fI\-noclear\fR? \fR?\fIreturnCode\fR? +.BE + +.SH DESCRIPTION +.PP +Terminate the process, returning \fIreturnCode\fR (an integer) to the +system as the exit status. +If \fIreturnCode\fR isn't specified then it defaults +to 0. +This command replaces the Tcl command by the same name. +It is identical to Tcl's \fBexit\fR command except that +before exiting it destroys all the windows managed by +the process. +This allows various cleanup operations to be performed, such +as restoring the terminal's state and clearing the terminal's screen. +If the \fI\-noclear\fR switch is given, no screen clear takes place. + +.SH KEYWORDS +exit, process diff --git a/doc/fileevent.n b/doc/fileevent.n new file mode 100644 index 0000000..63dd542 --- /dev/null +++ b/doc/fileevent.n @@ -0,0 +1,112 @@ +'\" +'\" Copyright (c) 1994 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH fileevent n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +fileevent \- Execute a script when a file becomes readable or writable +.SH SYNOPSIS +\fBfileevent \fIfileId \fBreadable \fR?\fIscript\fR? +.br +\fBfileevent \fIfileId \fBwritable \fR?\fIscript\fR? +.BE + +.SH DESCRIPTION +.PP +This command is used to create \fIfile event handlers\fR. +A file event handler is a binding between a file and a script, +such that the script is evaluated whenever the file becomes +readable or writable. +File event handlers are most commonly used to allow data to be +received from a child process on an event-driven basis, so that +the receiver can continue to interact with the user while +waiting for the data to arrive. +If an application invokes \fBgets\fR or \fBread\fR when there +is no input data available, the process will block; until the +input data arrives, it will not be able to service other events, +so it will appear to the user to ``freeze up''. +With \fBfileevent\fR, the process can tell when data is present +and only invoke \fBgets\fR or \fBread\fR when they won't block. +.PP +The \fIfileId\fR argument to \fBfileevent\fR refers to an open file; +it must be \fBstdin\fR, \fBstdout\fR, \fBstderr\fR, or the return value +from some previous \fBopen\fR command. +If the \fIscript\fR argument is specified, then \fBfileevent\fR +creates a new event handler: \fIscript\fR will be evaluated +whenever the file becomes readable or writable (depending on the +second argument to \fBfileevent\fR). +In this case \fBfileevent\fR returns an empty string. +The \fBreadable\fR and \fBwritable\fR event handlers for a file +are independent, and may be created and deleted separately. +However, there may be at most one \fBreadable\fR and one \fBwritable\fR +handler for a file at a given time. +If \fBfileevent\fR is called when the specified handler already +exists, the new script replaces the old one. +.PP +If the \fIscript\fR argument is not specified, \fBfileevent\fR +returns the current script for \fIfileId\fR, or an empty string +if there is none. +If the \fIscript\fR argument is specified as an empty string +then the event handler is deleted, so that no script will be invoked. +A file event handler is also deleted automatically whenever +its file is closed or its interpreter is deleted. +.PP +A file is considered to be readable whenever the \fBgets\fR +and \fBread\fR commands can return without blocking. +A file is also considered to be readable if an end-of-file or +error condition is present. +It is important for \fIscript\fR to check for these conditions +and handle them appropriately; for example, if there is no special +check for end-of-file, an infinite loop may occur where \fIscript\fR +reads no data, returns, and is immediately invoked again. +.PP +When using \fBfileevent\fR for event-driven I/O, it's important +to read the file in the same units that are written +from the other end. +For example, suppose that you are using \fBfileevent\fR to +read data generated by a child process. +If the child process is writing whole lines, then you should use +\fBgets\fR to read those lines. +If the child generates one line at a time then you shouldn't +make more than a single call to \fBgets\fR in \fIscript\fR: the first call +will consume all the available data, so the second call may block. +You can also use \fBread\fR to read the child's data, but only +if you know how many bytes the child is writing at a time: if +you try to read more bytes than the child has written, the +\fBread\fR call will block. +.PP +A file is considered to be writable if at least one byte of data +can be written to the file without blocking, or if an error condition +is present. +Write handlers are probably not very useful without additional command +support. +The \fBputs\fR command is dangerous since it write more than +one byte at a time and may thus block. +What is really needed is a new non-blocking form of write that +saves any data that couldn't be written to the file. +.PP +The script for a file event is executed at global level (outside the +context of any Tcl procedure). +If an error occurs while executing the script then the +\fBtkerror\fR mechanism is used to report the error. +In addition, the file event handler is deleted if it ever returns +an error; this is done in order to prevent infinite loops due to +buggy handlers. + +.SH CREDITS +.PP +\fBfileevent\fR is based on the \fBaddinput\fR command created +by Mark Diekhans. + +.SH "SEE ALSO" +tkerror + +.SH KEYWORDS +asynchronous I/O, event handler, file, readable, script, writable diff --git a/doc/focus.n b/doc/focus.n new file mode 100644 index 0000000..58a2bd0 --- /dev/null +++ b/doc/focus.n @@ -0,0 +1,47 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH focus n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +focus \- Manage the input focus +.SH SYNOPSIS +\fBfocus\fR +.br +\fBfocus \fIwindow\fR +.BE + +.SH DESCRIPTION +.PP +The \fBfocus\fR command is used to manage the Ck input focus. +At any given time, one window on the terminal's screen is designated as +the \fIfocus window\fR; any key press events are sent to that window. +The Tcl procedures \fBck_focusNext\fR and \fBck_focusPrev\fR +implement a focus order among the windows of a top-level; they +are used in the default bindings for Tab and Shift-Tab, among other +things. Switching the focus among different top-levels is up +to the user. +.PP +The \fBfocus\fR command can take any of the following forms: +.TP +\fBfocus\fR +Returns the path name of the focus window or an empty string if no window +in the application has the focus. +.TP +\fBfocus \fIwindow\fR +This command sets the input focus to \fIwindow\fR and returns an +empty string. If \fIwindow\fR is in a different top-level than +the current input focus window, then \fIwindow's\fR top-level +is automatically raised just as if the \fBraise\fR Tcl command +had been invoked. +If \fIwindow\fR is an empty string then the command does nothing. + +.SH KEYWORDS +events, focus, keyboard, top-level diff --git a/doc/focusNext.n b/doc/focusNext.n new file mode 100644 index 0000000..d81afc1 --- /dev/null +++ b/doc/focusNext.n @@ -0,0 +1,45 @@ +'\" +'\" Copyright (c) 1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH ck_focusNext n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +ck_focusNext, ck_focusPrev \- Utility procedures for managing the input focus. +.SH SYNOPSIS +\fBck_focusNext \fIwindow\fR +.br +\fBck_focusPrev \fIwindow\fR +.BE + +.SH DESCRIPTION +.PP +\fBck_focusNext\fR is a utility procedure used for keyboard traversal. +It returns the ``next'' window after \fIwindow\fR in focus order. +The focus order is determined by +the stacking order of windows and the structure of the window hierarchy. +Among siblings, the focus order is the same as the stacking order, with the +lowest window being first. +If a window has children, the window is visited first, followed by +its children (recursively), followed by its next sibling. +Top-level windows other than \fIwindow\fR are skipped, so that +\fBck_focusNext\fR never returns a window in a different top-level +from \fIwindow\fR. +.PP +After computing the next window, \fBck_focusNext\fR examines the +window's \fB\-takefocus\fR option to see whether it should be skipped. +If so, \fBck_focusNext\fR continues on to the next window in the focus +order, until it eventually finds a window that will accept the focus +or returns back to \fIwindow\fR. +.PP +\fBck_focusPrev\fR is similar to \fBck_focusNext\fR except that it +returns the window just before \fIwindow\fR in the focus order. + +.SH KEYWORDS +focus, keyboard traversal, toplevel diff --git a/doc/frame.n b/doc/frame.n new file mode 100644 index 0000000..4f9819a --- /dev/null +++ b/doc/frame.n @@ -0,0 +1,117 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH frame n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +frame \- Create and manipulate frame widgets +.SH SYNOPSIS +\fBframe\fI \fIpathName ?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +\fBattributes\fR \fBborder\fR \fBforeground\fR \fBtakefocus\fR +\fBbackground\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBclass\fR +Class: \fBClass\fR +Command-Line Switch: \fB\-class\fR +.fi +.IP +Specifies a class for the window. +This class will be used when querying the option database for +the window's other options, and it will also be used later for +other purposes such as bindings. +The \fBclass\fR option may not be changed with the \fBconfigure\fR +widget command. +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies the desired height for the window in screen lines. +If this option is equal to zero then the window will +not request any size at all. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies the desired width for the window in screen columns. +If this option is equal to zero then the window will +not request any size at all. +.BE + +.SH DESCRIPTION +.PP +The \fBframe\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a frame widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the frame such as its background color +and attributes. The \fBframe\fR command returns the +path name of the new window. +.PP +A frame is a simple widget. Its primary purpose is to act as a +spacer or container for complex window layouts. The only features +of a frame are its background color, attributes and border. + +.SH "WIDGET COMMAND" +.PP +The \fBframe\fR command creates a new Tcl command whose +name is the same as the path name of the frame's window. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIPathName\fR is the name of the command, which is the same as +the frame widget's path name. \fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for frame widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBframe\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBframe\fR +command. + +.SH BINDINGS +.PP +When a new frame is created, it has no default event bindings: +frames are not intended to be interactive. + +.SH KEYWORDS +frame, widget diff --git a/doc/grid.n b/doc/grid.n new file mode 100644 index 0000000..82df8b5 --- /dev/null +++ b/doc/grid.n @@ -0,0 +1,231 @@ +'\" +'\" Copyright (c) 1996 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +'\" +.so man.macros +.TH grid n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +grid \- Geometry manager that arranges widgets in a grid +.SH SYNOPSIS +\fBgrid \fIoption arg \fR?\fIarg ...\fR? +.BE + +.SH DESCRIPTION +.PP +The \fBgrid\fR command is used to communicate with the grid +geometry manager that arranges widgets in rows and columns inside +of another window, called the geometry master (or master window). +The \fBgrid\fR command can have any of several forms, depending +on the \fIoption\fR argument: +.TP +\fBgrid \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR? +If the first argument to \fBgrid\fR is a window name (any value +starting with ``.''), then the command is processed in the same +way as \fBgrid configure\fR. +.TP +\fBgrid bbox \fImaster column row\fR +The bounding box (in rows or columns) is returned for the space occupied by +the grid position indicated by \fIcolumn\fP and \fIrow\fP. The +return value consists of 4 integers. The first two are the column/row offset +from the master window (x then y) of the top-left corner of the grid +cell, and the second two are the width and height of the cell. +.TP +\fBgrid columnconfigure \fImaster index \fR?\fI\-option value...\fR? +Query or set the column properties of the \fIindex\fP column of the +geometry master, \fImaster\fP. +The valid options are \fB\-minsize\fP and \fB\-weight\fP. +The \fB\-minsize\fP option sets the minimum column size, +and the \fB\-weight\fP option (a floating point value) +sets the relative weight for apportioning +any extra spaces among +columns. If no value is specified, the current value is returned. +.TP +\fBgrid configure \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR? +The arguments consist of the names of one or more slave windows +followed by pairs of arguments that specify how +to manage the slaves. +The characters \fB\-\fP, \fBx\fP and \fB^\fP, +can be specified instead of a window name to alter the default +location of a \fIslave\fP, as described in the ``RELATIVE PLACEMENT'' +section, below. +The following options are supported: +.RS +.TP +\fB\-column \fIn\fR +Insert the slave so that it occupies the \fIn\fPth column in the grid. +Column numbers start with 0. If this option is not supplied, then the +slave is arranged just to the right of previous slave specified on this +call to \fIgrid\fP, or column "0" if it is the first slave. For each +\fBx\fP that immediately precedes the \fIslave\fP, the column position +is incremented by one. Thus the \fBx\fP represents a blank column +for this row in the grid. +.TP +\fB\-columnspan \fIn\fR +Insert the slave so that it occupies \fIn\fP columns in the grid. +The default is one column, unless the window name is followed by a +\fB\-\fP, in which case the columnspan is incremented once for each immediately +following \fB\-\fP. +.TP +\fB\-ipadx \fIamount\fR +The \fIamount\fR specifies how much horizontal internal padding to +leave on each side of the slave(s). +\fIAmount\fR is specified in terminal columns. It defaults to 0. +.TP +\fB\-ipady \fIamount\fR +The \fIamount\fR specifies how much vertical internal padding to +leave on on the top and bottom of the slave(s). +\fIAmount\fR is specified in terminal rows. It defaults to 0. +.TP +\fB\-padx \fIamount\fR +The \fIamount\fR specifies how much horizontal external padding to +leave on each side of the slave(s). The \fIamount\fR defaults to 0. +.TP +\fB\-pady \fIamount\fR +The \fIamount\fR specifies how much vertical external padding to +leave on the top and bottom of the slave(s). The \fIamount\fR defaults to 0. +.TP +\fB\-row \fIn\fR +Insert the slave so that it occupies the \fIn\fPth row in the grid. +Row numbers start with 0. If this option is not supplied, then the +slave is arranged on the same row as the previous slave specified on this +call to \fBgrid\fP, or the first unoccupied row if this is the first slave. +.TP +\fB\-rowspan \fIn\fR +Insert the slave so that it occupies \fIn\fP rows in the grid. +The default is one row. If the next \fBgrid\fP command contains +\fB^\fP characters instead of \fIslaves\fP that line up with the columns +of this \fIslave\fP, then the \fBrowspan\fP of this \fIslave\fP is +extended by one. +.TP +\fB\-sticky \fIstyle\fR +If a slave's parcel is larger than its requested dimensions, this +option may be used to position (or stretch) the slave within its cavity. +\fIStyle\fR is a string that contains zero or more of the characters +\fBn\fP, \fBs\fP, \fBe\fP or \fBw\fP. +The string can optionally contains spaces or +commas, but they are ignored. Each letter refers to a side (north, south, +east, or west) that the slave will "stick" to. If both \fBn\fP and \fBs\fP (or +\fBe\fP and \fBw\fP) are specified, the slave will be stretched to fill the entire +height (or width) of its cavity. The \fBsticky\fP option subsumes the +combination of \fB\-anchor\fP and \fB\-fill\fP that is used by \fBpack\fP. +The default is \fB{}\fP, which causes the slave to be centered in its cavity, +at its requested size. +.LP +If any of the slaves are already managed by the geometry manager +then any unspecified options for them retain their previous values rather +than receiving default values. +.RE +.TP +\fBgrid forget \fIslave \fR?\fIslave ...\fR? +Removes each of the \fIslave\fRs from grid for its +master and unmaps their windows. +The slaves will no longer be managed by the grid geometry manager. +.TP +\fBgrid info \fIslave\fR +Returns a list whose elements are the current configuration state of +the slave given by \fIslave\fR in the same option-value form that +might be specified to \fBgrid configure\fR. +.TP +\fBgrid location \fImaster x y\fR +Given \fIx\fP and \fIy\fP values in terminal columns/rows relative to the +master window, the column and row number at that \fIx\fP and \fIy\fP +location is returned. +For locations that are above or to the left of the grid, \fB-1\fP is returned. +.TP +\fBgrid propagate \fImaster\fR ?\fIboolean\fR? +If \fIboolean\fR has a true boolean value such as \fB1\fR or \fBon\fR +then propagation is enabled for \fImaster\fR, which must be a window +name (see ``GEOMETRY PROPAGATION'' below). +If \fIboolean\fR has a false boolean value then propagation is +disabled for \fImaster\fR. +In either of these cases an empty string is returned. +If \fIboolean\fR is omitted then the command returns \fB0\fR or +\fB1\fR to indicate whether propagation is currently enabled +for \fImaster\fR. +Propagation is enabled by default. +.TP +\fBgrid \fRrowconfigure \fImaster index \fR?\fI\-option value...\fR? +Query or set the row properties of the \fIindex\fP row of the +geometry master, \fImaster\fP. +The valid options are \fB\-minsize\fP and \fB\-weight\fP. +\fBMinsize\fP sets the minimum row size, in screen units, and \fBweight\fP +sets the relative weight for apportioning any extra spaces among +rows. If no value is specified, the current value is returned. +.TP +\fBgrid size \fImaster\fR +Returns the size of the grid (in columns then rows) for \fImaster\fP. +The size is determined either by the \fIslave\fP occupying the largest +row or column, or the largest column or row with a \fBminsize\fP or +\fBweight\fP. +.TP +\fBgrid slaves \fImaster\fR ?\fI\-option value\fR? +If no options are supplied, a list of all of the slaves in \fImaster\fR +are returned. \fIOption\fP can be either \fB\-row\fP or \fB\-column\fP which +causes only the slaves in the row (or column) specified by \fIvalue\fP +to be returned. +.SH "RELATIVE PLACEMENT" +.PP +The \fBgrid\fP command contains a limited set of capabilities that +permit layouts to be created without specifying the row and column +information for each slave. This permits slaves to be rearranged, +added, or removed without the need to explicitly specify row and +column information. +When no column or row information is specified for a \fIslave\fP, +default values are chosen for +\fBcolumn\fP, \fBrow\fP, \fPcolumnspan\fP and \fProwspan\fP +at the time the \fIslave\fP is managed. The values are chosen +based upon the current layout of the grid, the position of the \fIslave\fP +relative to other \fIslave\fPs in the same grid command, and the presence +of the characters \fB\-\fP, \fB^\fP, and \fB^\fP in \fBgrid\fP +command where \fIslave\fP names are normally expected. +.RS +.TP +\fB\-\fP +This increases the columnspan of the \fIslave\fP to the left. Several +\fB\-\fP's in a row will successively increase the columnspan. S \fB\-\fP +may not follow a \fB^\fP or a \fBx\fP. +.TP +\fBx\fP +This leaves an empty column between the \fIslave\fP on the left and +the \fIslave\fP on the right. +.TP +\fB^\fP +This extends the \fBrowspan\fP of the \fIslave\fP above the \fB^\fP's +in the grid. The number of \fB^\fP's in a row must match the number of +columns spanned by the \fIslave\fP above it. +.RE +.SH "GEOMETRY PROPAGATION" +.PP +Grid normally computes how large a master must be to +just exactly meet the needs of its slaves, and it sets the +requested width and height of the master to these dimensions. +This causes geometry information to propagate up through a +window hierarchy to a top-level window so that the entire +sub-tree sizes itself to fit the needs of the leaf windows. +However, the \fBgrid propagate\fR command may be used to +turn off propagation for one or more masters. +If propagation is disabled then grid will not set +the requested width and height of the master window. +This may be useful if, for example, you wish for a master +window to have a fixed size that you specify. + +.SH "RESTRICTIONS ON MASTER WINDOWS" +.PP +The master for each slave must be the slave's parent. +This restriction is necessary to guarantee that the +slave can be placed over any part of its master that is +visible without danger of the slave being clipped by its parent. + +.SH CREDITS +.PP +The \fBgrid\fP command is based on the \fIGridBag\fP geometry manager +written by D. Stein. + +.SH KEYWORDS +geometry manager, location, grid, parcel, propagation, size, pack diff --git a/doc/label.n b/doc/label.n new file mode 100644 index 0000000..11e15e7 --- /dev/null +++ b/doc/label.n @@ -0,0 +1,105 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH label n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +label \- Create and manipulate label widgets +.SH SYNOPSIS +\fBlabel\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 3.8c 7.6c 11.4c +\fBanchor\fR \fBforeground\fR \fBtextVariable\fR \fBunderlineForeground\fR +\fBattributes\fR \fBtakeFocus\fR \fBunderline\fR +\fBbackground\fR \fBtext\fR \fBunderlineAttributes\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies a desired height for the label in screen lines. +If this option isn't specified, the label's desired height is 1 line. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies a desired width for the label in screen columns. +If this option isn't specified, the label's desired width is computed +from the size of the text being displayed in it. +.BE + +.SH DESCRIPTION +.PP +The \fBlabel\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a label widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the label such as its colors, font, +text, and initial relief. The \fBlabel\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A label is a widget that displays a textual string. +The label can be manipulated in a few simple ways, such as +changing its attributes or text, using the commands described below. + +.SH "WIDGET COMMAND" +.PP +The \fBlabel\fR command creates a new Tcl command whose +name is \fIpathName\fR. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for label widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBlabel\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBlabel\fR +command. + +.SH BINDINGS +.PP +When a new label is created, it has no default event bindings: +labels are not intended to be interactive. + +.SH KEYWORDS +label, widget diff --git a/doc/listbox.n b/doc/listbox.n new file mode 100644 index 0000000..7638574 --- /dev/null +++ b/doc/listbox.n @@ -0,0 +1,362 @@ +'\" +'\" Copyright (c) 1990 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH listbox n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +listbox \- Create and manipulate listbox widgets +.SH SYNOPSIS +\fBlistbox\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +\fBactiveAttributes\fR \fBattributes\fR \fBselectAttributes\fR \fBtakeFocus\fR +\fBactiveBackground\fR \fBbackground\fR \fBselectBackground\fR \fBxScrollCommand\fR +\fBactiveForeground\fR \fBforeground\fR \fBselectForeground\fR \fByScrollCommand\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies the desired height for the window, in lines. +If zero or less, then the desired height for the window is made just +large enough to hold all the elements in the listbox. +.LP +.nf +Name: \fBselectMode\fR +Class: \fBSelectMode\fR +Command-Line Switch: \fB\-selectmode\fR +.fi +.IP +Specifies one of several styles for manipulating the selection. +The value of the option may be arbitrary, but the default bindings +expect it to be either \fBsingle\fR, \fBbrowse\fR or \fBmultiple\fR; +the default value is \fBbrowse\fR. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies the desired width for the window in characters. +If zero or less, then the desired width for the window is made just +large enough to hold all the elements in the listbox. +.BE + +.SH DESCRIPTION +.PP +The \fBlistbox\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a listbox widget. +Additional options, described above, may be specified on the command line +or in the option database to configure aspects of the listbox such as its +colors, attributes and text. The \fBlistbox\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A listbox is a widget that displays a list of strings, one per line. +When first created, a new listbox has no elements. +Elements may be added or deleted using widget commands described +below. In addition, one or more elements may be selected as described +below. +.PP +It is not necessary for all the elements to be +displayed in the listbox window at once; commands described below +may be used to change the view in the window. Listboxes allow +scrolling in both directions using the standard \fBxScrollCommand\fR +and \fByScrollCommand\fR options. + +.SH "INDICES" +.PP +Many of the widget commands for listboxes take one or more indices +as arguments. +An index specifies a particular element of the listbox, in any of +the following ways: +.TP 12 +\fInumber\fR +Specifies the element as a numerical index, where 0 corresponds +to the first element in the listbox. +.TP 12 +\fBactive\fR +Indicates the element that has the location cursor. This element +will be displayed with the \fBactiveAttributes\fR, \fBactiveBackground\fR, +and \fBactiveForeground\fR options if the keyboard focus is in the +listbox. The element is specified with the \fBactivate\fR +widget command. +.TP 12 +\fBanchor\fR +Indicates the anchor point for the selection, which is set with the +\fBselection anchor\fR widget command. +.TP 12 +\fBend\fR +Indicates the end of the listbox. +For some commands this means just after the last element; +for other commands it means the last element. +.TP 12 +\fB@\fIx\fB,\fIy\fR +Indicates the element that covers the point in the listbox window +specified by \fIx\fR and \fIy\fR (in screen coordinates). If no +element covers that point, then the closest element to that +point is used. +.LP +In the widget command descriptions below, arguments named \fIindex\fR, +\fIfirst\fR, and \fIlast\fR always contain text indices in one of +the above forms. + +.SH "WIDGET COMMAND" +.PP +The \fBlistbox\fR command creates a new Tcl command whose +name is \fIpathName\fR. This command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for listbox widgets: +.TP +\fIpathName \fBactivate\fR \fIindex\fR +Sets the active element to the one indicated by \fIindex\fR. +The active element is drawn with the \fBactiveAttributes\fR, +\fBactiveBackground\fR, and \fBactiveForeground\fR options +when the widget has the input focus, and its index may be retrieved +with the index \fBactive\fR. +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBlistbox\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBlistbox\fR +command. +.TP +\fIpathName \fBcurselection\fR +Returns a list containing the numerical indices of +all of the elements in the listbox that are currently selected. +If there are no elements selected in the listbox then an empty +string is returned. +.TP +\fIpathName \fBdelete \fIfirst \fR?\fIlast\fR? +Deletes one or more elements of the listbox. \fIFirst\fR and \fIlast\fR +are indices specifying the first and last elements in the range +to delete. If \fIlast\fR isn't specified it defaults to +\fIfirst\fR, i.e. a single element is deleted. +.TP +\fIpathName \fBget \fIfirst\fR ?\fIlast\fR? +If \fIlast\fR is omitted, returns the contents of the listbox +element indicated by \fIfirst\fR. +If \fIlast\fR is specified, the command returns a list whose elements +are all of the listbox elements between \fIfirst\fR and \fIlast\fR, +inclusive. +Both \fIfirst\fR and \fIlast\fR may have any of the standard +forms for indices. +.TP +\fIpathName \fBindex \fIindex\fR +Returns a decimal string giving the integer index value that +corresponds to \fIindex\fR. +.TP +\fIpathName \fBinsert \fIindex \fR?\fIelement element ...\fR? +Inserts zero or more new elements in the list just before the +element given by \fIindex\fR. If \fIindex\fR is specified as +\fBend\fR then the new elements are added to the end of the +list. Returns an empty string. +.TP +\fIpathName \fBnearest \fIy\fR +Given a y-coordinate within the listbox window, this command returns +the index of the (visible) listbox element nearest to that y-coordinate. +.TP +\fIpathName \fBsee \fIindex\fR +Adjust the view in the listbox so that the element given by \fIindex\fR +is visible. +If the element is already visible then the command has no effect; +if the element is near one edge of the window then the listbox +scrolls to bring the element into view at the edge; otherwise +the listbox scrolls to center the element. +.TP +\fIpathName \fBselection \fIoption arg\fR +This command is used to adjust the selection within a listbox. It +has several forms, depending on \fIoption\fR: +.RS +.TP +\fIpathName \fBselection anchor \fIindex\fR +Sets the selection anchor to the element given by \fIindex\fR. +The selection anchor is the end of the selection that is fixed +while dragging out a selection with the mouse. +The index \fBanchor\fR may be used to refer to the anchor +element. +.TP +\fIpathName \fBselection clear \fIfirst \fR?\fIlast\fR? +If any of the elements between \fIfirst\fR and \fIlast\fR +(inclusive) are selected, they are deselected. +The selection state is not changed for elements outside +this range. +.TP +\fIpathName \fBselection includes \fIindex\fR +Returns 1 if the element indicated by \fIindex\fR is currently +selected, 0 if it isn't. +.TP +\fIpathName \fBselection set \fIfirst \fR?\fIlast\fR? +Selects all of the elements in the range between +\fIfirst\fR and \fIlast\fR, inclusive, without affecting +the selection state of elements outside that range. +.RE +.TP +\fIpathName \fBsize\fR +Returns a decimal string indicating the total number of elements +in the listbox. +.TP +\fIpathName \fBxview \fIargs\fR +This command is used to query and change the horizontal position of the +information in the widget's window. It can take any of the following +forms: +.RS +.TP +\fIpathName \fBxview\fR +Returns a list containing two elements. +Each element is a real fraction between 0 and 1; together they describe +the horizontal span that is visible in the window. +For example, if the first element is .2 and the second element is .6, +20% of the listbox's text is off-screen to the left, the middle 40% is visible +in the window, and 40% of the text is off-screen to the right. +These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR +option. +.TP +\fIpathName \fBxview\fR \fIindex\fR +Adjusts the view in the window so that the character position given by +\fIindex\fR is displayed at the left edge of the window. +Character positions are defined by the width of the character \fB0\fR. +.TP +\fIpathName \fBxview moveto\fI fraction\fR +Adjusts the view in the window so that \fIfraction\fR of the +total width of the listbox text is off-screen to the left. +\fIfraction\fR must be a fraction between 0 and 1. +.TP +\fIpathName \fBxview scroll \fInumber what\fR +This command shifts the view in the window left or right according to +\fInumber\fR and \fIwhat\fR. +\fINumber\fR must be an integer. +\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation +of one of these. +If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by +\fInumber\fR character units (the width of the \fB0\fR character) +on the display; if it is \fBpages\fR then the view adjusts by +\fInumber\fR screenfuls. +If \fInumber\fR is negative then characters farther to the left +become visible; if it is positive then characters farther to the right +become visible. +.RE +.TP +\fIpathName \fByview \fI?args\fR? +This command is used to query and change the vertical position of the +text in the widget's window. +It can take any of the following forms: +.RS +.TP +\fIpathName \fByview\fR +Returns a list containing two elements, both of which are real fractions +between 0 and 1. +The first element gives the position of the listbox element at the +top of the window, relative to the listbox as a whole (0.5 means +it is halfway through the listbox, for example). +The second element gives the position of the listbox element just after +the last one in the window, relative to the listbox as a whole. +These are the same values passed to scrollbars via the \fB\-yscrollcommand\fR +option. +.TP +\fIpathName \fByview\fR \fIindex\fR +Adjusts the view in the window so that the element given by +\fIindex\fR is displayed at the top of the window. +.TP +\fIpathName \fByview moveto\fI fraction\fR +Adjusts the view in the window so that the element given by \fIfraction\fR +appears at the top of the window. +\fIFraction\fR is a fraction between 0 and 1; 0 indicates the first +element in the listbox, 0.33 indicates the element one-third the +way through the listbox, and so on. +.TP +\fIpathName \fByview scroll \fInumber what\fR +This command adjusts the view in the window up or down according to +\fInumber\fR and \fIwhat\fR. +\fINumber\fR must be an integer. +\fIWhat\fR must be either \fBunits\fR or \fBpages\fR. +If \fIwhat\fR is \fBunits\fR, the view adjusts up or down by +\fInumber\fR lines; if it is \fBpages\fR then +the view adjusts by \fInumber\fR screenfuls. +If \fInumber\fR is negative then earlier elements +become visible; if it is positive then later elements +become visible. +.RE + +.SH "DEFAULT BINDINGS" +.PP +Ck automatically creates class bindings for listboxes. Much of the +behavior of a listbox is determined by its \fBselectMode\fR option, +which selects one of three ways of dealing with the selection. +.PP +If the selection mode is \fBsingle\fR or \fBbrowse\fR, at most one +element can be selected in the listbox at once. +In both modes, clicking button 1 on an element selects +it and deselects any other selected item. +.PP +If the selection mode is \fBmultiple\fR, any number of elements may +be selected at once, including discontiguous ranges. +Clicking button 1 on an element toggles its selection state without +affecting any other elements. +.PP +Most people will probably want to use \fBbrowse\fR mode for +single selections and \fBmultiple\fR mode for multiple selections. +.PP +In addition to the above behavior, the following additional behavior +is defined by the default bindings: +.IP [1] +If the Up or Down key is pressed, the location cursor (active +element) moves up or down one element. +If the selection mode is \fBbrowse\fR then the +new active element is also selected and all other elements are +deselected. +.IP [2] +The Left and Right keys scroll the listbox view left and right +by the one column. +.IP [3] +The Prior and Next keys scroll the listbox view up and down +by one page (the height of the window). +.IP [4] +The Home and End keys scroll the listbox horizontally to +the left and right edges, respectively. +.IP [5] +The space and Select keys make a selection at the location cursor +(active element) just as if mouse button 1 had been pressed over +this element. +.PP +The behavior of listboxes can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH KEYWORDS +listbox, widget diff --git a/doc/lower.n b/doc/lower.n new file mode 100644 index 0000000..d8a9291 --- /dev/null +++ b/doc/lower.n @@ -0,0 +1,34 @@ +'\" +'\" Copyright (c) 1990 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH lower n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +lower \- Change a window's position in the stacking order +.SH SYNOPSIS +\fBlower \fIwindow \fR?\fIbelowThis\fR? +.BE + +.SH DESCRIPTION +.PP +If the \fIbelowThis\fR argument is omitted then the command lowers +\fIwindow\fR so that it is below all of its siblings in the stacking +order (it will be obscured by any siblings that overlap it and +will not obscure any siblings). +If \fIbelowThis\fR is specified then it must be the path name of +a window that is either a sibling of \fIwindow\fR or the descendant +of a sibling of \fIwindow\fR. +In this case the \fBlower\fR command will insert +\fIwindow\fR into the stacking order just below \fIbelowThis\fR +(or the ancestor of \fIbelowThis\fR that is a sibling of \fIwindow\fR); +this could end up either raising or lowering \fIwindow\fR. + +.SH KEYWORDS +lower, obscure, stacking order diff --git a/doc/man.macros b/doc/man.macros new file mode 100644 index 0000000..879f5b6 --- /dev/null +++ b/doc/man.macros @@ -0,0 +1,168 @@ +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out [indent] +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS [type [name]] +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .VS +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" @(#) man.macros 1.3 95/05/06 15:19:04 +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ie !"\\$3"" \{\ +.ta \\n()Au \\n()Bu +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. diff --git a/doc/menu.n b/doc/menu.n new file mode 100644 index 0000000..5cf059f --- /dev/null +++ b/doc/menu.n @@ -0,0 +1,578 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH menu n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +menu \- Create and manipulate menu widgets +.SH SYNOPSIS +\fBmenu\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 3.8c 7.6c 11.4c +\fBactiveAttributes\fR \fBbackground\fR \fBdisabledForeground\fR \fBunderlineForeground\fR +\fBactiveBackground\fR \fBborder\fR \fBforeground\fR +\fBactiveForeground\fR \fBdisabledAttributes\fR \fBtakeFocus\fR +\fBattributes\fR \fBdisabledBackground\fR \fBunderlineAttributes\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBpostCommand\fR +Class: \fBCommand\fR +Command-Line Switch: \fB\-postcommand\fR +.fi +.IP +If this option is specified then it provides a Tcl command to execute +each time the menu is posted. The command is invoked by the \fBpost\fR +widget command before posting the menu. +.LP +.nf +Name: \fBselectColor\fR +Class: \fBBackground\fR +Command-Line Switch: \fB\-selectcolor\fR +.fi +.IP +For menu entries that are check buttons or radio buttons, this option +specifies the color to display in the indicator when the check button +or radio button is selected. On color terminals this defaults to red, +on monochrome terminals to white. +.BE + +.SH INTRODUCTION +.PP +The \fBmenu\fR command creates a new top-level window (given +by the \fIpathName\fR argument) and makes it into a menu widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the menu such as its colors and font. +The \fBmenu\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A menu is a widget that displays a collection of one-line entries arranged +in a column. There exist several different types of entries, +each with different properties. Entries of different types may be +combined in a single menu. Menu entries are not the same as +entry widgets. In fact, menu entries are not even distinct widgets; +the entire menu is one widget. +.PP +Menu entries are displayed with up to three separate fields. +The main field is a label in the form of a text string. +If the \fB\-accelerator\fR option is specified for an entry then a second +textual field is displayed to the right of the label. The accelerator +typically describes a keystroke sequence that may be typed in the +application to cause the same result as invoking the menu entry. +The third field is an \fIindicator\fR. The indicator is present only for +checkbutton or radiobutton entries. It indicates whether the entry +is selected or not, and is displayed to the left of the entry's +string. +.PP +In normal use, an entry becomes active (displays itself differently) +whenever the input focus is over the entry. If a mouse +button is pressed over the entry then the entry is \fIinvoked\fR. +The effect of invocation is different for each type of entry; +these effects are described below in the sections on individual +entries. +.PP +Entries may be \fIdisabled\fR, which causes their labels +and accelerators to be displayed with other colors. +The default menu bindings will not allow +a disabled entry to be activated or invoked. +Disabled entries may be re-enabled, at which point it becomes +possible to activate and invoke them again. + +.SH "COMMAND ENTRIES" +.PP +The most common kind of menu entry is a command entry, which +behaves much like a button widget. When a command entry is +invoked, a Tcl command is executed. The Tcl +command is specified with the \fB\-command\fR option. + +.SH "SEPARATOR ENTRIES" +.PP +A separator is an entry that is displayed as a horizontal dividing +line. A separator may not be activated or invoked, and it has +no behavior other than its display appearance. + +.SH "CHECKBUTTON ENTRIES" +.PP +A checkbutton menu entry behaves much like a checkbutton widget. +When it is invoked it toggles back and forth between the selected +and deselected states. When the entry is selected, a particular +value is stored in a particular global variable (as determined by +the \fB\-onvalue\fR and \fB\-variable\fR options for the entry); when +the entry is deselected another value (determined by the +\fB\-offvalue\fR option) is stored in the global variable. +An indicator box is displayed to the left of the label in a checkbutton +entry. If the entry is selected then the indicator's center is displayed +in the color given by the \fB-selectcolor\fR option for the entry; +otherwise the indicator's center is displayed in the background color for +the menu or menu entry. +If a \fB\-command\fR option is specified for a checkbutton +entry, then its value is evaluated as a Tcl command each time the entry +is invoked; this happens after toggling the entry's +selected state. + +.SH "RADIOBUTTON ENTRIES" +.PP +A radiobutton menu entry behaves much like a radiobutton widget. +Radiobutton entries are organized in groups of which only one +entry may be selected at a time. Whenever a particular entry +becomes selected it stores a particular value into a particular +global variable (as determined by the \fB\-value\fR and +\fB\-variable\fR options for the entry). This action +causes any previously-selected entry in the same group +to deselect itself. +Once an entry has become selected, any change to the entry's +associated variable will cause the entry to deselect itself. +Grouping of radiobutton entries is determined by their +associated variables: if two entries have the same associated +variable then they are in the same group. +An indicator diamond is displayed to the left of the label in each +radiobutton entry. If the entry is selected then the indicator's +center is displayed in the color given by the \fB\-selectcolor\fR option +for the entry; +otherwise the indicator's center is displayed in the background color for +the menu or menu entry. +If a \fB\-command\fR option is specified for a radiobutton +entry, then its value is evaluated as a Tcl command each time the entry +is invoked; this happens after selecting the entry. + +.SH "CASCADE ENTRIES" +.PP +A cascade entry is one with an associated menu (determined +by the \fB\-menu\fR option). Cascade entries allow the construction +of cascading menus. +The \fBpostcascade\fR widget command can be used to post and unpost +the associated menu just to the right of the cascade entry. +The associated menu must be a child of the menu containing +the cascade entry (this is needed in order for menu traversal to +work correctly). +.PP +A cascade entry posts its associated menu by invoking a +Tcl command of the form +.RS +.IP +\fImenu\fB post \fIx y\fR +.RE +.LP +where \fImenu\fR is the path name of the associated menu, and \fIx\fR +and \fIy\fR are the root-window coordinates of the upper-right +corner of the cascade entry. +The lower-level menu is unposted by executing a Tcl command with +the form +.RS +.IP +\fImenu\fB unpost\fR +.RE +.LP +where \fImenu\fR is the name of the associated menu. +.LP +If a \fB\-command\fR option is specified for a cascade entry then it is +evaluated as a Tcl command whenever the entry is invoked. + +.SH "WIDGET COMMAND" +.PP +The \fBmenu\fR command creates a new Tcl command whose +name is \fIpathName\fR. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. +.PP +Many of the widget commands for a menu take as one argument an +indicator of which entry of the menu to operate on. These +indicators are called \fIindex\fRes and may be specified in +any of the following forms: +.TP 12 +\fInumber\fR +Specifies the entry numerically, where 0 corresponds +to the top-most entry of the menu, 1 to the entry below it, and +so on. +.TP 12 +\fBactive\fR +Indicates the entry that is currently active. If no entry is +active then this form is equivalent to \fBnone\fR. This form may +not be abbreviated. +.TP 12 +\fBend\fR +Indicates the bottommost entry in the menu. If there are no +entries in the menu then this form is equivalent to \fBnone\fR. +This form may not be abbreviated. +.TP 12 +\fBlast\fR +Same as \fBend\fR. +.TP 12 +\fBnone\fR +Indicates ``no entry at all''; this is used most commonly with +the \fBactivate\fR option to deactivate all the entries in the +menu. In most cases the specification of \fBnone\fR causes +nothing to happen in the widget command. +This form may not be abbreviated. +.TP 12 +\fB@\fInumber\fR +In this form, \fInumber\fR is treated as a y-coordinate in the +menu's window; the entry closest to that y-coordinate is used. +For example, ``\fB@0\fR'' indicates the top-most entry in the +window. +.TP 12 +\fIpattern\fR +If the index doesn't satisfy one of the above forms then this +form is used. \fIPattern\fR is pattern-matched against the label of +each entry in the menu, in order from the top down, until a +matching entry is found. The rules of \fBTcl_StringMatch\fR +are used. +.PP +The following widget commands are possible for menu widgets: +.TP +\fIpathName \fBactivate \fIindex\fR +Change the state of the entry indicated by \fIindex\fR to \fBactive\fR +and redisplay it using its active colors. +Any previously-active entry is deactivated. If \fIindex\fR +is specified as \fBnone\fR, or if the specified entry is +disabled, then the menu ends up with no active entry. +Returns an empty string. +.TP +\fIpathName \fBadd \fItype \fR?\fIoption value option value ...\fR? +Add a new entry to the bottom of the menu. The new entry's type +is given by \fItype\fR and must be one of \fBcascade\fR, +\fBcheckbutton\fR, \fBcommand\fR, \fBradiobutton\fR, or \fBseparator\fR, +or a unique abbreviation of one of the above. If additional arguments +are present, they specify any of the following options: +.RS +.TP +\fB\-activeattributes \fIvalue\fR +Specifies video attributes to use for displaying this entry when it +is active. +If this option is specified as an empty string (the default), then the +\fBactiveAttributes\fR option for the overall menu is used. +This option is not available for separator entries. +.TP +\fB\-activebackground \fIvalue\fR +Specifies a background color to use for displaying this entry when it +is active. +If this option is specified as an empty string (the default), then the +\fBactiveBackground\fR option for the overall menu is used. +This option is not available for separator entries. +.TP +\fB\-activeforeground \fIvalue\fR +Specifies a foreground color to use for displaying this entry when it +is active. +If this option is specified as an empty string (the default), then the +\fBactiveForeground\fR option for the overall menu is used. +This option is not available for separator entries. +.TP +\fB\-accelerator \fIvalue\fR +Specifies a string to display at the right side of the menu entry. +Normally describes an accelerator keystroke sequence that may be +typed to invoke the same function as the menu entry. This option +is not available for separator entries. +.TP +\fB\-attributes \fIvalue\fR +Specifies video attributes to use for displaying this entry when it +is in the normal state (neither active nor disabled). +If this option is specified as an empty string (the default), then the +\fBattributes\fR option for the overall menu is used. +This option is not available for separator entries. +.TP +\fB\-background \fIvalue\fR +Specifies a background color to use for displaying this entry when it +is in the normal state (neither active nor disabled). +If this option is specified as an empty string (the default), then the +\fBbackground\fR option for the overall menu is used. +This option is not available for separator entries. +.TP +\fB\-command \fIvalue\fR +For command, checkbutton, and radiobutton entries, specifies a +Tcl command to execute when the menu entry is invoked. +For cascade entries, specifies a Tcl command to execute +when the entry is activated (i.e. just before its submenu is +posted). +Not available for separator entries. +.TP +\fB\-foreground \fIvalue\fR +Specifies a foreground color to use for displaying this entry when it +is in the normal state (neither active nor disabled). +If this option is specified as an empty string (the default), then the +\fBforeground\fR option for the overall menu is used. +This option is not available for separator entries. +.TP +\fB\-indicatoron \fIvalue\fR +Available only for checkbutton and radiobutton entries. +\fIValue\fR is a boolean that determines whether or not the +indicator should be displayed. +.TP +\fB\-label \fIvalue\fR +Specifies a string to display as an identifying label in the menu +entry. Not available for separator entries. +.TP +\fB\-menu \fIvalue\fR +Available only for cascade entries. Specifies the path name of +the submenu associated with this entry. +The submenu must be a child of the menu. +.TP +\fB\-offvalue \fIvalue\fR +Available only for checkbutton entries. Specifies the value to +store in the entry's associated variable when the entry is +deselected. +.TP +\fB\-onvalue \fIvalue\fR +Available only for checkbutton entries. Specifies the value to +store in the entry's associated variable when the entry is selected. +.TP +\fB\-selectcolor \fIvalue\fR +Available only for checkbutton and radiobutton entries. +Specifies the color to display in the indicator when the entry is +selected. +If the value is an empty string (the default) then the \fBselectColor\fR +option for the menu determines the indicator color. +.TP +\fB\-state \fIvalue\fR +Specifies one of three states for the entry: \fBnormal\fR, \fBactive\fR, +or \fBdisabled\fR. In normal state the entry is displayed using the +\fBattributes\fR, \fBforeground\fR, and \fBbackground\fR options +for the entry or for the menu. +The active state is typically used when the input focus is in the entry. +In active state the entry is displayed using the +\fBactiveAttributes\fR, \fBactiveForeground\fR, and \fBactiveBackground\fR +options for the entry or for the menu. +Disabled state means that the entry should be insensitive: +the default bindings will refuse to activate or invoke the entry. +In this state the entry is displayed according to the +\fBdisabledAttributes\fR, \fBdisabledForeground\fR, and +\fBdisabledBackground\fR options for the menu. +This option is not available for separator entries. +.TP +\fB\-underline \fIvalue\fR +Specifies the integer index of a character to underline in the entry. +This option is also queried by the default bindings and used to +implement keyboard traversal. +0 corresponds to the first character of the text displayed in the entry, +1 to the next character, and so on. +This option is not available for separator entries. +.TP +\fB\-underlineAttributes \fIvalue\fR +Specifies video attributes to use for displaying the underlined +character in this entry when it +is in the normal state (neither active nor disabled). +If this option is specified as an empty string (the default), then the +\fBunderlineAttributes\fR option for the overall menu is used. +This option is not available for separator entries. +.TP +\fB\-underlineForeground \fIvalue\fR +Specifies a foreground color to use for displaying the underlined +character in this entry when it +is in the normal state (neither active nor disabled). +If this option is specified as an empty string (the default), then the +\fBunderlineForeground\fR option for the overall menu is used. +This option is not available for separator entries. +.TP +\fB\-value \fIvalue\fR +Available only for radiobutton entries. Specifies the value to +store in the entry's associated variable when the entry is selected. +.TP +\fB\-variable \fIvalue\fR +Available only for checkbutton and radiobutton entries. Specifies +the name of a global value to set when the entry is selected. +For checkbutton entries the variable is also set when the entry +is deselected. For radiobutton entries, changing the variable +causes the currently-selected entry to deselect itself. +.LP +The \fBadd\fR widget command returns an empty string. +.RE +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBmenu\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBmenu\fR +command. +.TP +\fIpathName \fBdelete \fIindex1\fR ?\fIindex2\fR? +Delete all of the menu entries between \fIindex1\fR and +\fIindex2\fR inclusive. +If \fIindex2\fR is omitted then it defaults to \fIindex1\fR. +.TP +\fIpathName \fBentrycget\fR \fIindex option\fR +Returns the current value of a configuration option for +the entry given by \fIindex\fR. +\fIOption\fR may have any of the values accepted by the \fBadd\fR +widget command. +.TP +\fIpathName \fBentryconfigure \fIindex \fR?\fIoptions\fR? +This command is similar to the \fBconfigure\fR command, except that +it applies to the options for an individual entry, whereas \fBconfigure\fR +applies to the options for the menu as a whole. +\fIOptions\fR may have any of the values accepted by the \fBadd\fR +widget command. If \fIoptions\fR are specified, options are modified +as indicated +in the command and the command returns an empty string. +If no \fIoptions\fR are specified, returns a list describing +the current options for entry \fIindex\fR. +.TP +\fIpathName \fBindex \fIindex\fR +Returns the numerical index corresponding to \fIindex\fR, or +\fBnone\fR if \fIindex\fR was specified as \fBnone\fR. +.TP +\fIpathName \fBinsert \fIindex\fR \fItype \fR?\fIoption value option value ...\fR? +Same as the \fBadd\fR widget command except that it inserts the new +entry just before the entry given by \fIindex\fR, instead of appending +to the end of the menu. The \fItype\fR, \fIoption\fR, and \fIvalue\fR +arguments have the same interpretation as for the \fBadd\fR widget +command. It is not possible to insert new menu entries before the +tear-off entry, if the menu has one. +.TP +\fIpathName \fBinvoke \fIindex\fR +Invoke the action of the menu entry. See the sections on the +individual entries above for details on what happens. If the +menu entry is disabled then nothing happens. If the +entry has a command associated with it then the result of that +command is returned as the result of the \fBinvoke\fR widget +command. Otherwise the result is an empty string. Note: invoking +a menu entry does not automatically unpost the menu; the default +bindings normally take care of this before invoking the \fBinvoke\fR +widget command. +.TP +\fIpathName \fBpost \fIx y\fR +Arrange for the menu to be displayed on the screen at the root-window +coordinates given by \fIx\fR and \fIy\fR. These coordinates are +adjusted if necessary to guarantee that the entire menu is visible on +the screen. This command normally returns an empty string. +If the \fBpostCommand\fR option has been specified, then its value is +executed as a Tcl script before posting the menu and the result of +that script is returned as the result of the \fBpost\fR widget +command. +If an error returns while executing the command, then the error is +returned without posting the menu. +.TP +\fIpathName \fBpostcascade \fIindex\fR +Posts the submenu associated with the cascade entry given by +\fIindex\fR, and unposts any previously posted submenu. +If \fIindex\fR doesn't correspond to a cascade entry, +or if \fIpathName\fR isn't posted, +the command has no effect except to unpost any currently posted +submenu. +.TP +\fIpathName \fBtype \fIindex\fR +Returns the type of the menu entry given by \fIindex\fR. +This is the \fItype\fR argument passed to the \fBadd\fR widget +command when the entry was created, such as \fBcommand\fR +or \fBseparator\fR. +.TP +\fIpathName \fBunpost\fR +Unmap the window so that it is no longer displayed. If a +lower-level cascaded menu is posted, unpost that menu. Returns an +empty string. +.TP +\fIpathName \fByposition \fIindex\fR +Returns a decimal string giving the y-coordinate within the menu +window of the line in the entry specified by \fIindex\fR. + +.SH "MENU CONFIGURATIONS" +.PP +The default bindings support two different ways of using menus: +.TP +\fBPulldown Menus\fR +This is the most common case. You create one menubutton widget for +each top-level menu, and typically you arrange a series of menubuttons +in a row in a menubar window. You also create the top-level menus +and any cascaded submenus, and tie them together with \fB\-menu\fR +options in menubuttons and cascade menu entries. The top-level menu must +be a child of the menubutton, and each submenu must be a child of the +menu that refers to it. Once you have done this, the default bindings +will allow users to traverse and invoke the tree of menus via its +menubutton; see the \fBmenubutton\fR manual entry for details. +.TP +\fBOption Menus\fR +An option menu consists of a menubutton with an associated menu +that allows you to select one of several values. The current value +is displayed in the menubutton and is also stored in a global +variable. Use the \fBck_optionMenu\fR procedure to create option +menubuttons and their menus. + +.SH "DEFAULT BINDINGS" +.PP +Ck automatically creates class bindings for menus that give them +the following default behavior: +.IP [1] +When button 1 is pressed on a menu, the active entry (if any) is invoked. +The menu also unposts. +.IP [2] +The Space and Return keys invoke the active entry and +unpost the menu. +.IP [3] +If any of the entries in a menu have letters underlined with +with \fB\-underline\fR option, then pressing one of the underlined +letters (or its upper-case or lower-case equivalent) invokes that +entry and unposts the menu. +.IP [4] +The Escape key aborts a menu selection in progress without invoking any +entry. It also unposts the menu. +.IP [5] +The Up and Down keys activate the next higher or lower entry +in the menu. When one end of the menu is reached, the active +entry wraps around to the other end. +.IP [6] +The Left key moves to the next menu to the left. +If the current menu is a cascaded submenu, then the submenu is +unposted and the current menu entry becomes the cascade entry +in the parent. +If the current menu is a top-level menu posted from a +menubutton, then the current menubutton is unposted and the +next menubutton to the left is posted. +Otherwise the key has no effect. +The left-right order of menubuttons is determined by their stacking +order: Ck assumes that the lowest menubutton (which by default +is the first one created) is on the left. +.IP [7] +The Right key moves to the next menu to the right. +If the current entry is a cascade entry, then the submenu is +posted and the current menu entry becomes the first entry +in the submenu. +Otherwise, if the current menu was posted from a +menubutton, then the current menubutton is unposted and the +next menubutton to the right is posted. +.PP +Disabled menu entries are non-responsive: they don't activate and +they ignore mouse button presses and releases. +.PP +The behavior of menus can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH BUGS +.PP +At present it isn't possible to use the +option database to specify values for the options to individual +entries. + +.SH KEYWORDS +menu, widget diff --git a/doc/menubutton.n b/doc/menubutton.n new file mode 100644 index 0000000..2d2b247 --- /dev/null +++ b/doc/menubutton.n @@ -0,0 +1,187 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH menubutton n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +menubutton \- Create and manipulate menubutton widgets +.SH SYNOPSIS +\fBmenubutton\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 3.8c 7.6c 11.4c +\fBactiveAttributes\fR \fBattributes\fR \fBdisabledForeground\fR \fBtextVariable\fR +\fBactiveBackground\fR \fBbackground\fR \fBforeground\fR \fBunderline\fR +\fBactiveForeground\fR \fBdisabledAttributes\fR \fBtakeFocus\fR \fBunderlineAttributes\fR +\fBanchor\fR \fBdisabledBackground\fR \fBtext\fR \fBunderlineForeground\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies a desired height for the menubutton in screen lines. +If this option isn't specified, the menubutton's desired height is 1 line. +.LP +.nf +Name: \fBindicatorForeground\fR +Class: \fBIndicatorForeground\fR +Command-Line Switch: \fB\-indicatorforeground\fR +.fi +.IP +Color in which the indicator rectangle, if any, is drawn. +On color terminals this defaults to red, on monochrome terminals +to white. +.LP +.nf +Name: \fBindicatorOn\fR +Class: \fBIndicatorOn\fR +Command-Line Switch: \fB\-indicatoron\fR +.fi +.IP +The value must be a proper boolean value. If it is true then +a small indicator rectangle will be displayed on the right side +of the menubutton and the default menu bindings will treat this +as an option menubutton. If false then no indicator will be +displayed. +.LP +.nf +Name: \fBmenu\fR +Class: \fBMenuName\fR +Command-Line Switch: \fB\-menu\fR +.fi +.IP +Specifies the path name of the menu associated with this menubutton. +The menu must be a child of the menubutton. +.LP +.nf +Name: \fBstate\fR +Class: \fBState\fR +Command-Line Switch: \fB\-state\fR +.fi +.IP +Specifies one of three states for the menubutton: \fBnormal\fR, \fBactive\fR, +or \fBdisabled\fR. In normal state the menubutton is displayed using the +\fBattributes\fR, \fBforeground\fR, and \fBbackground\fR options. +The active state is typically used when the input focus is in the menubutton. +In active state the menubutton is displayed using the +\fBactiveAttributes\fR, \fBactiveForeground\fR, and +\fBactiveBackground\fR options. +Disabled state means that the menubutton should be insensitive: +the default bindings will refuse to activate +the widget and will ignore mouse button presses. +In this state the \fBdisabledAttributes\fR, \fBdisabledForeground\fR, and +\fBdisabledBackground\fR options determine how the button is displayed. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies a desired width for the menubutton in screen columns. +If this option isn't specified, the menubutton's desired width is computed +from the size of the text being displayed in it. +.BE + +.SH INTRODUCTION +.PP +The \fBmenubutton\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a menubutton widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the menubutton such as its colors, attributes, +and text. The \fBmenubutton\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A menubutton is a widget that displays a textual string +and is associated with a menu widget. +One of the characters may optionally be underlined using the +\fBunderline\fR, \fBunderlineAttributes\fR, and +\fBunderlineForeground\fR options. +In normal usage, pressing mouse button 1 over the menubutton causes +the associated menu to be posted just underneath the menubutton. +.PP +There are several interactions between menubuttons and menus; see +the \fBmenu\fR manual entry for information on various menu configurations, +such as pulldown menus and option menus. + +.SH "WIDGET COMMAND" +.PP +The \fBmenubutton\fR command creates a new Tcl command whose +name is \fIpathName\fR. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for menubutton widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBmenubutton\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBmenubutton\fR +command. + +.SH "DEFAULT BINDINGS" +.PP +Ck automatically creates class bindings for menubuttons that give them +the following default behavior: +.IP [1] +A menubutton activates whenever it gets the input focus and deactivates +whenever it loses the input focus. +.IP [2] +Pressing mouse button 1 over a menubutton posts the menubutton: +its associated menu is posted under the menubutton. +Once a menu entry has been invoked, the menubutton unposts itself. +.IP [3] +When a menubutton is posted, its associated menu claims the input +focus to allow keyboard traversal of the menu and its submenus. +See the \fBmenu\fR manual entry for details on these bindings. +.IP [4] +The F10 key may be typed in any window to post the first menubutton +under its toplevel window that isn't disabled. +.IP [5] +If a menubutton has the input focus, the space and return keys +post the menubutton. +.PP +If the menubutton's state is \fBdisabled\fR then none of the above +actions occur: the menubutton is completely non-responsive. +.PP +The behavior of menubuttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH KEYWORDS +menubutton, widget diff --git a/doc/message.n b/doc/message.n new file mode 100644 index 0000000..4ef76a5 --- /dev/null +++ b/doc/message.n @@ -0,0 +1,162 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH message n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +message \- Create and manipulate message widgets +.SH SYNOPSIS +\fBmessage\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +\fBanchor\fR \fBbackground\fR \fBtakeFocus\fR \fBtextVariable\fR +\fBattributes\fR \fBforeground\fR \fBtext\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBaspect\fR +Class: \fBAspect\fR +Command-Line Switch: \fB\-aspect\fR +.fi +.IP +Specifies a non-negative integer value indicating desired +aspect ratio for the text. The aspect ratio is specified as +100*width/height. 100 means the text should +be as wide as it is tall, 200 means the text should +be twice as wide as it is tall, 50 means the text should +be twice as tall as it is wide, and so on. +Used to choose line length for text if \fBwidth\fR option +isn't specified. Defaults to 320. +.LP +.nf +Name: \fBjustify\fR +Class: \fBJustify\fR +Command-Line Switch: \fB\-justify\fR +.fi +.IP +Specifies how to justify lines of text. +Must be one of \fBleft\fR, \fBcenter\fR, or \fBright\fR. Defaults +to \fBleft\fR. +This option works together with the \fBanchor\fR, \fBaspect\fR, +and \fBwidth\fR options to provide a variety +of arrangements of the text within the window. +The \fBaspect\fR and \fBwidth\fR options determine the amount of +screen space needed to display the text. +The \fBanchor\fR option determines where this +rectangular area is displayed within the widget's window, and the +\fBjustify\fR option determines how each line is displayed within that +rectangular region. +For example, suppose \fBanchor\fR is \fBe\fR and \fBjustify\fR is +\fBleft\fR, and that the message window is much larger than needed +for the text. +The the text will displayed so that the left edges of all the lines +line up; the entire text block will be centered in the vertical span +of the window. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies the length of lines in the window in screen columns. +If this option has a value greater than zero then the \fBaspect\fR +option is ignored and the \fBwidth\fR option determines the line +length. +If this option has a value equal to zero, then the \fBaspect\fR option +determines the line length. +.BE + +.SH DESCRIPTION +.PP +The \fBmessage\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a message widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the message such as its colors, attributes, +and text. The \fBmessage\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A message is a widget that displays a textual string. A message +widget has three special features. First, it breaks up +its string into lines in order to produce a given aspect ratio +for the window. The line breaks are chosen at word boundaries +wherever possible (if not even a single word would fit on a +line, then the word will be split across lines). Newline characters +in the string will force line breaks; they can be used, for example, +to leave blank lines in the display. +.PP +The second feature of a message widget is justification. The text +may be displayed left-justified (each line starts at the left side of +the window), centered on a line-by-line basis, or right-justified +(each line ends at the right side of the window). +.PP +The third feature of a message widget is that it handles control +characters and non-printing characters specially. Tab characters +are replaced with enough blank space to line up on the next +8-character boundary. Newlines cause line breaks. Other control +characters (ASCII code less than 0x20) and characters not defined +in the font are displayed as a four-character sequence \fB\ex\fIhh\fR where +\fIhh\fR is the two-digit hexadecimal number corresponding to +the character. + +.SH "WIDGET COMMAND" +.PP +The \fBmessage\fR command creates a new Tcl command whose +name is \fIpathName\fR. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for message widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBmessage\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBmessage\fR +command. + +.SH "DEFAULT BINDINGS" +.PP +When a new message is created, it has no default event bindings: +messages are intended for output purposes only. + +.SH BUGS +.PP +Tabs don't work very well with text that is centered or right-justified. +The most common result is that the line is justified wrong. + +.SH KEYWORDS +message, widget diff --git a/doc/option.n b/doc/option.n new file mode 100644 index 0000000..1aef6bd --- /dev/null +++ b/doc/option.n @@ -0,0 +1,86 @@ +'\" +'\" Copyright (c) 1990 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH option n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +option \- Add/retrieve window options to/from the option database +.SH SYNOPSIS +\fBoption add \fIpattern value \fR?\fIpriority\fR? +.sp +\fBoption clear\fR +.sp +\fBoption get \fIwindow name class\fR +.sp +\fBoption readfile \fIfileName \fR?\fIpriority\fR? +.BE + +.SH DESCRIPTION +.PP +The \fBoption\fR command allows you to add entries to the Ck option +database or to retrieve options from the database. The \fBadd\fR +form of the command adds a new option to the database. +\fIPattern\fR contains +the option being specified, and consists of names and/or classes +separated by asterisks or dots, in the usual X format. \fIValue\fR +contains a text string to associate with \fIpattern\fR; this is the +value that will be returned in invocations of the \fBoption get\fR +command. If \fIpriority\fR +is specified, it indicates the priority level for this option (see +below for legal values); it defaults to \fBinteractive\fR. +This command always returns an empty string. +.PP +The \fBoption clear\fR command clears the option database. This command +always returns an empty string. +.PP +The \fBoption get\fR command returns the value of the option +specified for \fIwindow\fR +under \fIname\fR and \fIclass\fR. If several entries in the option +database match \fIwindow\fR, \fIname\fR, and \fIclass\fR, then +the command returns whichever was created with highest +\fIpriority\fR level. If there are several matching +entries at the same priority level, then it returns whichever entry +was most recently entered into the option database. If there are +no matching entries, then the empty string is returned. +.PP +The \fBreadfile\fR form of the command reads \fIfileName\fR, +which should have the standard format for an +X resource database such as \fB.Xdefaults\fR, and adds all the +options specified in that file to the option database. If \fIpriority\fR +is specified, it indicates the priority level at which to enter the +options; \fIpriority\fR defaults to \fBinteractive\fR. +.PP +The \fIpriority\fR arguments to the \fBoption\fR command are +normally specified symbolically using one of the following values: +.TP +\fBwidgetDefault\fR +Level 20. Used for default values hard-coded into widgets. +.TP +\fBstartupFile\fR +Level 40. Used for options specified in application-specific +startup files. +.TP +\fBuserDefault\fR +Level 60. Used for options specified in user-specific defaults +files, such as \fB.Xdefaults\fR, resource databases loaded into +the X server, or user-specific startup files. +.TP +\fBinteractive\fR +Level 80. Used for options specified interactively after the application +starts running. If \fIpriority\fR isn't specified, it defaults to +this level. +.LP +Any of the above keywords may be abbreviated. In addition, priorities +may be specified numerically using integers between 0 and 100, +inclusive. The numeric form is probably a bad idea except for new priority +levels other than the ones given above. + +.SH KEYWORDS +database, option, priority, retrieve diff --git a/doc/options.n b/doc/options.n new file mode 100644 index 0000000..d5e3569 --- /dev/null +++ b/doc/options.n @@ -0,0 +1,367 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH options n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +options \- Standard options supported by widgets +.BE + +.SH DESCRIPTION +This manual entry describes the common configuration options supported +by widgets in the Ck toolkit. Every widget does not necessarily support +every option (see the manual entries for individual widgets for a list +of the standard options supported by that widget), but if a widget does +support an option with one of the names listed below, then the option +has exactly the effect described below. +.PP +In the descriptions below, +``Name'' refers to the option's name in the option database +``Class'' refers to the option's class value +in the option database. ``Command-Line Switch'' refers to the +switch used in widget-creation and \fBconfigure\fR widget commands to +set this value. For example, if an option's command-line switch is +\fB\-foreground\fR and there exists a widget \fB.a.b.c\fR, then the +command +.DS +\&\fB.a.b.c\0\0configure\0\0\-foreground black\fR +.DE +may be used to specify the value \fBblack\fR for the option in the +the widget \fB.a.b.c\fR. Command-line switches may be abbreviated, +as long as the abbreviation is unambiguous. +.ta 4c +.LP +.nf +Name: \fBactiveAttributes\fR +Class: \fBAttributes\fR +Command-Line Switch: \fB\-activeattributes\fR +.fi +.IP +Specifies video attributes to use when drawing active elements of +widgets. This option must be a proper Tcl list which may contain +the elements: +.PP +.ta 4c 8c +.nf + \fBblink\fR \fBreverse\fR + \fBbold\fR \fBstandout\fR + \fBdim\fR \fBunderline\fR + \fBnormal\fR +.fi +.ta 4c +.IP +If the list is empty, the \fBnormal\fR attribute is automatically present. +.LP +.nf +Name: \fBactiveBackground\fR +Class: \fBForeground\fR +Command-Line Switch: \fB\-activebackground\fR +.fi +.IP +Specifies background color to use when drawing active elements of +widgets. Color specifications are always symbolic; valid color names are: +.PP +.ta 4c 8c +.nf + \fBblack\fR \fBmagenta\fR + \fBblue\fR \fBred\fR + \fBcyan\fR \fByellow\fR + \fBgreen\fR \fBwhite\fR +.fi +.ta 4c +.PP +.LP +.nf +Name: \fBactiveForeground\fR +Class: \fBBackground\fR +Command-Line Switch: \fB\-activeforeground\fR +.fi +.IP +Specifies foreground color to use when drawing active elements. +See above for possible colors. +.LP +.nf +Name: \fBanchor\fR +Class: \fBAnchor\fR +Command-Line Switch: \fB\-anchor\fR +.fi +.IP +Specifies how the text in a widget is to be displayed in the widget. +Must be one of the values \fBn\fR, \fBne\fR, \fBe\fR, \fBse\fR, +\fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR. +For example, \fBnw\fR means display the text such that its +top-left corner is at the top-left corner of the widget. +.LP +.nf +Name: \fBattributes\fR +Class: \fBAttributes\fR +Command-Line Switch: \fB\-attributes\fR +.fi +.IP +Specifies video attributes to use when displaying the widget. +See \fBactiveAttributes\fR for possible values. +.LP +.nf +Name: \fBbackground\fR +Class: \fBBackground\fR +Command-Line Switch: \fB\-background or \-bg\fR +.fi +.IP +Specifies the normal background color to use when displaying the +widget. See \fBactiveBackground\fR for possible colors. +.LP +.nf +Name: \fBborder\fR +Class: \fBBorder\fR +Command-Line Switch: \fB\-border\fR +.fi +.IP +Specifies the characters used for drawing a border around a widget. +This options must be a proper Tcl list with exactly zero, one, three, six, +or eight elements: +.RS +.TP 12 +0 elements +No extra space for the border is allocated by the widget. +.TP 12 +1 element +All four sides of the border's rectangle plus the corners are made from +the sole element. +.TP 12 +3 elements +The first element is used for the rectangle's corners, the second for +the horizontal sides, and the third for the vertical sides. +.TP 12 +6 elements +The order of elements in the rectangle is: upper left corner, horizontal +side, upper right corner, vertical side, lower right corner, lower left +corner. +.TP 12 +8 elements +Each element gives corner and side, alternating, starting at the upper +left corner of the square, clockwise. +.RE +.IP +The list elements must be either a single character or a symbolic name +of a graphical character. For valid names of graphical characters refer +to the \fBcurses gchar\fR command. +.LP +.nf +Name: \fBdisabledAttributes\fR +Class: \fBDisabledAttributes\fR +Command-Line Switch: \fB\-disabledattributes\fR +.fi +.IP +Specifies video attributes to use when drawing a disabled element. +See \fBactiveAttributes\fR for possible values. +.LP +.nf +Name: \fBdisabledBackground\fR +Class: \fBDisabledBackground\fR +Command-Line Switch: \fB\-disabledbackground\fR +.fi +.IP +Specifies background color to use when drawing a disabled element. +See \fBactiveBackground\fR for possible colors. +.LP +.nf +Name: \fBdisabledForeground\fR +Class: \fBDisabledForeground\fR +Command-Line Switch: \fB\-disabledforeground\fR +.fi +.IP +Specifies foreground color to use when drawing a disabled element. +See \fBactiveBackground\fR for possible colors. +.LP +.nf +Name: \fBforeground\fR +Class: \fBForeground\fR +Command-Line Switch: \fB\-foreground or \-fg\fR +.fi +.IP +Specifies the normal foreground color to use when displaying the widget. +See \fBactiveBackground\fR for possible colors. +.LP +.nf +Name: \fBjustify\fR +Class: \fBJustify\fR +Command-Line Switch: \fB\-justify\fR +.fi +.IP +When there are multiple lines of text displayed in a widget, this +option determines how the lines line up with each other. +Must be one of \fBleft\fR, \fBcenter\fR, or \fBright\fR. +\fBLeft\fR means that the lines' left edges all line up, \fBcenter\fR +means that the lines' centers are aligned, and \fBright\fR means +that the lines' right edges line up. +.LP +.nf +Name: \fBorient\fR +Class: \fBOrient\fR +Command-Line Switch: \fB\-orient\fR +.fi +.IP +For widgets that can lay themselves out with either a horizontal +or vertical orientation, such as scrollbars, this option specifies +which orientation should be used. Must be either \fBhorizontal\fR +or \fBvertical\fR or an abbreviation of one of these. +.LP +.nf +Name: \fBselectAttributes\fR +Class: \fBSelectAttributes\fR +Command-Line Switch: \fB\-selectattributes\fR +.fi +.IP +Specifies video attributes to use when displaying selected items. +See \fBactiveAttributes\fR for possible values. +.LP +.nf +Name: \fBselectBackground\fR +Class: \fBForeground\fR +Command-Line Switch: \fB\-selectbackground\fR +.fi +.IP +Specifies the background color to use when displaying selected +items. See \fBactiveBackground\fR for possible colors. +.LP +.nf +Name: \fBselectForeground\fR +Class: \fBBackground\fR +Command-Line Switch: \fB\-selectforeground\fR +.fi +.IP +Specifies the foreground color to use when displaying selected +items. See \fBactiveBackground\fR for possible colors. +.LP +.nf +Name: \fBtakeFocus\fR +Class: \fBTakeFocus\fR +Command-Line Switch: \fB\-takefocus\fR +.fi +.IP +Provides information used when moving the focus from window to window +via keyboard traversal (e.g., Tab and BackTab). +Before setting the focus to a window, the traversal scripts first +check whether the window is viewable (it and all its ancestors are mapped); +if not, the window is skipped. +Next, the scripts consult the value of the \fBtakeFocus\fR option. +A value of \fB0\fR means that this window should be skipped entirely +during keyboard traversal. +\fB1\fR means that the this window should always receive the input +focus. +An empty value means that the traversal scripts make the decision +about whether or not to focus on the window: the current +algorithm is to skip the window if it is +disabled or if it has no key bindings. +If the value has any other form, then the traversal scripts take +the value, append the name of the window to it (with a separator space), +and evaluate the resulting string as a Tcl script. +The script must return 0, 1, or an empty string; this value is used +just as if the option had that value in the first place. +Note: this interpretation of the option is defined entirely by +the Tcl scripts that implement traversal: the widget implementations +ignore the option entirely, so you can change its meaning if you +redefine the keyboard traversal scripts. +.LP +.nf +Name: \fBtext\fR +Class: \fBText\fR +Command-Line Switch: \fB\-text\fR +.fi +.IP +Specifies a string to be displayed inside the widget. The way in which +the string is displayed depends on the particular widget and may be +determined by other options, such as \fBanchor\fR or \fBjustify\fR. +.LP +.nf +Name: \fBtextVariable\fR +Class: \fBVariable\fR +Command-Line Switch: \fB\-textvariable\fR +.fi +.IP +Specifies the name of a variable. The value of the variable is a text +string to be displayed inside the widget; if the variable value changes +then the widget will automatically update itself to reflect the new value. +The way in which the string is displayed in the widget depends on the +particular widget and may be determined by other options, such as +\fBanchor\fR or \fBjustify\fR. +.LP +.nf +Name: \fBunderline\fR +Class: \fBUnderline\fR +Command-Line Switch: \fB\-underline\fR +.fi +.IP +Specifies the integer index of a character to underline in the widget. +This option is used by the default bindings to implement keyboard +traversal for menu buttons and menu entries. +0 corresponds to the first character of the text displayed in the +widget, 1 to the next character, and so on. +.LP +.nf +Name: \fBunderlineAttributes\fR +Class: \fBUnderlineAttributes\fR +Command-Line Switch: \fB\-underlineattributes\fR +.fi +.IP + +.LP +.nf +Name: \fBunderlineForeground\fR +Class: \fBUnderlineForeground\fR +Command-Line Switch: \fB\-underlineforeground\fR +.fi +.IP +Specifies the foreground color to use when displaying an underlined +character. See \fBactiveBackground\fR for possible colors. +.LP +.nf +Name: \fBxScrollCommand\fR +Class: \fBScrollCommand\fR +Command-Line Switch: \fB\-xscrollcommand\fR +.fi +.IP +Specifies the prefix for a command used to communicate with horizontal +scrollbars. +When the view in the widget's window changes (or +whenever anything else occurs that could change the display in a +scrollbar, such as a change in the total size of the widget's +contents), the widget will +generate a Tcl command by concatenating the scroll command and +two numbers. +Each of the numbers is a fraction between 0 and 1, which indicates +a position in the document. 0 indicates the beginning of the document, +1 indicates the end, .333 indicates a position one third the way through +the document, and so on. +The first fraction indicates the first information in the document +that is visible in the window, and the second fraction indicates +the information just after the last portion that is visible. +The command is +then passed to the Tcl interpreter for execution. Typically the +\fBxScrollCommand\fR option consists of the path name of a scrollbar +widget followed by ``set'', e.g. ``.x.scrollbar set'': this will cause +the scrollbar to be updated whenever the view in the window changes. +If this option is not specified, then no command will be executed. +.LP +.nf +Name: \fByScrollCommand\fR +Class: \fBScrollCommand\fR +Command-Line Switch: \fB\-yscrollcommand\fR +.fi +.IP +Specifies the prefix for a command used to communicate with vertical +scrollbars. This option is treated in the same way as the +\fBxScrollCommand\fR option, except that it is used for vertical +scrollbars and is provided by widgets that support vertical scrolling. +See the description of \fBxScrollCommand\fR for details +on how this option is used. + +.SH KEYWORDS +class, name, standard option, switch diff --git a/doc/pack.n b/doc/pack.n new file mode 100644 index 0000000..e58f913 --- /dev/null +++ b/doc/pack.n @@ -0,0 +1,252 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH pack n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +pack \- Geometry manager that packs around edges of cavity +.SH SYNOPSIS +\fBpack \fIoption arg \fR?\fIarg ...\fR? +.BE + +.SH DESCRIPTION +.PP +The \fBpack\fR command is used to communicate with the packer, +a geometry manager that arranges the children of a parent by +packing them in order around the edges of the parent. +The \fBpack\fR command can have any of several forms, depending +on the \fIoption\fR argument: +.TP +\fBpack \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR? +If the first argument to \fBpack\fR is a window name (any value +starting with ``.''), then the command is processed in the same +way as \fBpack configure\fR. +.TP +\fBpack configure \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR? +The arguments consist of the names of one or more slave windows +followed by pairs of arguments that specify how +to manage the slaves. +See ``THE PACKER ALGORITHM'' below for details on how the options +are used by the packer. +The following options are supported: +.RS +.TP +\fB\-after \fIother\fR +\fIOther\fR must the name of another window. +Use its master as the master for the slaves, and insert +the slaves just after \fIother\fR in the packing order. +.TP +\fB\-anchor \fIanchor\fR +\fIAnchor\fR must be a valid anchor position such as \fBn\fR +or \fBsw\fR; it specifies where to position each slave in its +parcel. +Defaults to \fBcenter\fR. +.TP +\fB\-before \fIother\fR +\fIOther\fR must the name of another window. +Use its master as the master for the slaves, and insert +the slaves just before \fIother\fR in the packing order. +.TP +\fB\-expand \fIboolean\fR +Specifies whether the slaves should be expanded to consume +extra space in their master. +\fIBoolean\fR may have any proper boolean value, such as \fB1\fR +or \fBno\fR. +Defaults to 0. +.TP +\fB\-fill \fIstyle\fR +If a slave's parcel is larger than its requested dimensions, this +option may be used to stretch the slave. +\fIStyle\fR must have one of the following values: +.RS +.TP +\fBnone\fR +Give the slave its requested dimensions plus any internal padding +requested with \fB\-ipadx\fR or \fB\-ipady\fR. This is the default. +.TP +\fBx\fR +Stretch the slave horizontally to fill the entire width of its +parcel (except leave external padding as specified by \fB\-padx\fR). +.TP +\fBy\fR +Stretch the slave vertically to fill the entire height of its +parcel (except leave external padding as specified by \fB\-pady\fR). +.TP +\fBboth\fR +Stretch the slave both horizontally and vertically. +.RE +.TP +\fB\-in \fIother\fR +Insert the slave(s) at the end of the packing order for the master +window given by \fIother\fR. +.TP +\fB\-ipadx \fIamount\fR +\fIAmount\fR specifies how much horizontal internal padding to +leave on each side of the slave(s). +\fIAmount\fR must be a valid screen distance, such as \fB2\fR or \fB.5c\fR. +It defaults to 0. +.TP +\fB\-ipady \fIamount\fR +\fIAmount\fR specifies how much vertical internal padding to +leave on each side of the slave(s). +\fIAmount\fR defaults to 0. +.TP +\fB\-padx \fIamount\fR +\fIAmount\fR specifies how much horizontal external padding to +leave on each side of the slave(s). +\fIAmount\fR defaults to 0. +.TP +\fB\-pady \fIamount\fR +\fIAmount\fR specifies how much vertical external padding to +leave on each side of the slave(s). +\fIAmount\fR defaults to 0. +.TP +\fB\-side \fIside\fR +Specifies which side of the master the slave(s) will be packed against. +Must be \fBleft\fR, \fBright\fR, \fBtop\fR, or \fBbottom\fR. +Defaults to \fBtop\fR. +.LP +If no \fB\-in\fR, \fB\-after\fR or \fB\-before\fR option is specified +then each of the slaves will be inserted at the end of the packing list +for its parent unless it is already managed by the packer (in which +case it will be left where it is). +If one of these options is specified then all the slaves will be +inserted at the specified point. +If any of the slaves are already managed by the geometry manager +then any unspecified options for them retain their previous values rather +than receiving default values. +.RE +.TP +\fBpack forget \fIslave \fR?\fIslave ...\fR? +Removes each of the \fIslave\fRs from the packing order for its +master and unmaps their windows. +The slaves will no longer be managed by the packer. +.TP +\fBpack info \fIslave\fR +Returns a list whose elements are the current configuration state of +the slave given by \fIslave\fR in the same option-value form that +might be specified to \fBpack configure\fR. +The first two elements of the list are ``\fB\-in \fImaster\fR'' where +\fImaster\fR is the slave's master. +.TP +\fBpack propagate \fImaster\fR ?\fIboolean\fR? +If \fIboolean\fR has a true boolean value such as \fB1\fR or \fBon\fR +then propagation is enabled for \fImaster\fR, which must be a window +name (see ``GEOMETRY PROPAGATION'' below). +If \fIboolean\fR has a false boolean value then propagation is +disabled for \fImaster\fR. +In either of these cases an empty string is returned. +If \fIboolean\fR is omitted then the command returns \fB0\fR or +\fB1\fR to indicate whether propagation is currently enabled +for \fImaster\fR. +Propagation is enabled by default. +.TP +\fBpack slaves \fImaster\fR +Returns a list of all of the slaves in the packing order for \fImaster\fR. +The order of the slaves in the list is the same as their order in +the packing order. +If \fImaster\fR has no slaves then an empty string is returned. + +.SH "THE PACKER ALGORITHM" +.PP +For each master the packer maintains an ordered list of slaves +called the \fIpacking list\fR. +The \fB\-in\fR, \fB\-after\fR, and \fB\-before\fR configuration +options are used to specify the master for each slave and the slave's +position in the packing list. +If none of these options is given for a slave then the slave +is added to the end of the packing list for its parent. +.PP +The packer arranges the slaves for a master by scanning the +packing list in order. +At the time it processes each slave, a rectangular area within +the master is still unallocated. +This area is called the \fIcavity\fR; for the first slave it +is the entire area of the master. +.PP +For each slave the packer carries out the following steps: +.IP [1] +The packer allocates a rectangular \fIparcel\fR for the slave +along the side of the cavity given by the slave's \fB\-side\fR option. +If the side is top or bottom then the width of the parcel is +the width of the cavity and its height is the requested height +of the slave plus the \fB\-ipady\fR and \fB\-pady\fR options. +For the left or right side the height of the parcel is +the height of the cavity and the width is the requested width +of the slave plus the \fB\-ipadx\fR and \fB\-padx\fR options. +The parcel may be enlarged further because of the \fB\-expand\fR +option (see ``EXPANSION'' below) +.IP [2] +The packer chooses the dimensions of the slave. +The width will normally be the slave's requested width plus +twice its \fB\-ipadx\fR option and the height will normally be +the slave's requested height plus twice its \fB\-ipady\fR +option. +However, if the \fB\-fill\fR option is \fBx\fR or \fBboth\fR +then the width of the slave is expanded to fill the width of the parcel, +minus twice the \fB\-padx\fR option. +If the \fB\-fill\fR option is \fBy\fR or \fBboth\fR +then the height of the slave is expanded to fill the width of the parcel, +minus twice the \fB\-pady\fR option. +.IP [3] +The packer positions the slave over its parcel. +If the slave is smaller than the parcel then the \fB\-anchor\fR +option determines where in the parcel the slave will be placed. +If \fB\-padx\fR or \fB\-pady\fR is non-zero, then the given +amount of external padding will always be left between the +slave and the edges of the parcel. +.PP +Once a given slave has been packed, the area of its parcel +is subtracted from the cavity, leaving a smaller rectangular +cavity for the next slave. +If a slave doesn't use all of its parcel, the unused space +in the parcel will not be used by subsequent slaves. +If the cavity should become too small to meet the needs of +a slave then the slave will be given whatever space is +left in the cavity. +If the cavity shrinks to zero size, then all remaining slaves +on the packing list will be unmapped from the screen until +the master window becomes large enough to hold them again. + +.SH "EXPANSION" +.PP +If a master window is so large that there will be extra space +left over after all of its slaves have been packed, then the +extra space is distributed uniformly among all of the slaves +for which the \fB\-expand\fR option is set. +Extra horizontal space is distributed among the expandable +slaves whose \fB\-side\fR is \fBleft\fR or \fBright\fR, +and extra vertical space is distributed among the expandable +slaves whose \fB\-side\fR is \fBtop\fR or \fBbottom\fR. + +.SH "GEOMETRY PROPAGATION" +.PP +The packer normally computes how large a master must be to +just exactly meet the needs of its slaves, and it sets the +requested width and height of the master to these dimensions. +This causes geometry information to propagate up through a +window hierarchy to a top-level window so that the entire +sub-tree sizes itself to fit the needs of the leaf windows. +However, the \fBpack propagate\fR command may be used to +turn off propagation for one or more masters. +If propagation is disabled then the packer will not set +the requested width and height of the packer. +This may be useful if, for example, you wish for a master +window to have a fixed size that you specify. + +.SH "RESTRICTIONS ON MASTER WINDOWS" +.PP +The master for each slave must be the slave's parent +This restriction is necessary to guarantee that the +slave can be placed over any part of its master that is +visible without danger of the slave being clipped by its parent. + +.SH KEYWORDS +geometry manager, location, packer, parcel, propagation, size diff --git a/doc/place.n b/doc/place.n new file mode 100644 index 0000000..55383fb --- /dev/null +++ b/doc/place.n @@ -0,0 +1,192 @@ +'\" +'\" Copyright (c) 1992 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH place n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +place \- Geometry manager for fixed or rubber-sheet placement +.SH SYNOPSIS +\fBplace \fIwindow option value \fR?\fIoption value ...\fR? +.sp +\fBplace configure \fIwindow option value \fR?\fIoption value ...\fR? +.sp +\fBplace forget \fIwindow\fR +.sp +\fBplace info \fIwindow\fR +.sp +\fBplace slaves \fIwindow\fR +.BE + +.SH DESCRIPTION +.PP +The placer is a geometry manager for Ck. +It provides simple fixed placement of windows, where you specify +the exact size and location of one window, called the \fIslave\fR, +within another window, called the \fImaster\fR. +The placer also provides rubber-sheet placement, where you specify the +size and location of the slave in terms of the dimensions of +the master, so that the slave changes size and location +in response to changes in the size of the master. +Lastly, the placer allows you to mix these styles of placement so +that, for example, the slave has a fixed width and height but is +centered inside the master. +.PP +If the first argument to the \fBplace\fR command is a window path +name or \fBconfigure\fR then the command arranges for the placer +to manage the geometry of a slave whose path name is \fIwindow\fR. +The remaining arguments consist of one or more \fIoption\-value\fR +pairs that specify the way in which \fIwindow\fR's +geometry is managed. +If the placer is already managing \fIwindow\fR, then the +\fIoption\-value\fR pairs modify the configuration for \fIwindow\fR. +In this form the \fBplace\fR command returns an empty string as result. +The following \fIoption\-value\fR pairs are supported: +.TP +\fB\-x \fIlocation\fR +\fILocation\fR specifies the x-coordinate within the master window +of the anchor point for \fIwindow\fR. +The location is specified in screen columns and need not lie within +the bounds of the master window. +.TP +\fB\-relx \fIlocation\fR +\fILocation\fR specifies the x-coordinate within the master window +of the anchor point for \fIwindow\fR. +In this case the location is specified in a relative fashion +as a floating-point number: 0.0 corresponds to the left edge +of the master and 1.0 corresponds to the right edge of the master. +\fILocation\fR need not be in the range 0.0\-1.0. +If both \fB\-x\fR and \fB\-relx\fR are specified for a slave +then their values are summed. For example, \fB\-relx 0.5 \-x \-2\fR +positions the left edge of the slave 2 columns to the left of the +center of its master. +.TP +\fB\-y \fIlocation\fR +\fILocation\fR specifies the y-coordinate within the master window +of the anchor point for \fIwindow\fR. +The location is specified in screen lines and need not lie within +the bounds of the master window. +.TP +\fB\-rely \fIlocation\fR +\fILocation\fR specifies the y-coordinate within the master window +of the anchor point for \fIwindow\fR. +In this case the value is specified in a relative fashion +as a floating-point number: 0.0 corresponds to the top edge +of the master and 1.0 corresponds to the bottom edge of the master. +\fILocation\fR need not be in the range 0.0\-1.0. +If both \fB\-y\fR and \fB\-rely\fR are specified for a slave +then their values are summed. For example, \fB\-rely 0.5 \-x 3\fR +positions the top edge of the slave 3 lines below the center of its master. +.TP +\fB\-anchor \fIwhere\fR +\fIWhere\fR specifies which point of \fIwindow\fR is to be positioned +at the (x,y) location selected by the \fB\-x\fR, \fB\-y\fR, +\fB\-relx\fR, and \fB\-rely\fR options. +The anchor point is in terms of the outer area of \fIwindow\fR +including its border, if any. +Thus if \fIwhere\fR is \fBse\fR then the lower-right corner of +\fIwindow\fR's border will appear at the given (x,y) location +in the master. +The anchor position defaults to \fBnw\fR. +.TP +\fB\-width \fIsize\fR +\fISize\fR specifies the width for \fIwindow\fR in screen columns. +The width will be the outer width of \fIwindow\fR including its +border, if any. +If \fIsize\fR is an empty string, or if no \fB\-width\fR +or \fB\-relwidth\fR option is specified, then the width requested +internally by the window will be used. +.TP +\fB\-relwidth \fIsize\fR +\fISize\fR specifies the width for \fIwindow\fR. +In this case the width is specified as a floating-point number +relative to the width of the master: 0.5 means \fIwindow\fR will +be half as wide as the master, 1.0 means \fIwindow\fR will have +the same width as the master, and so on. +If both \fB\-width\fR and \fB\-relwidth\fR are specified for a slave, +their values are summed. For example, \fB\-relwidth 1.0 \-width 5\fR +makes the slave 5 columns wider than the master. +.TP +\fB\-height \fIsize\fR +\fISize\fR specifies the height for \fIwindow\fR in screen lines. +The height will be the outer dimension of \fIwindow\fR including its +border, if any. +If \fIsize\fR is an empty string, or if no \fB\-height\fR or +\fB\-relheight\fR option is specified, then the height requested +internally by the window will be used. +.TP +\fB\-relheight \fIsize\fR +\fISize\fR specifies the height for \fIwindow\fR. +In this case the height is specified as a floating-point number +relative to the height of the master: 0.5 means \fIwindow\fR will +be half as high as the master, 1.0 means \fIwindow\fR will have +the same height as the master, and so on. +If both \fB\-height\fR and \fB\-relheight\fR are specified for a slave, +their values are summed. For example, \fB\-relheight 1.0 \-height \-2\fR +makes the slave 2 lines shorter than the master. +.TP +\fB\-bordermode \fImode\fR +\fIMode\fR determines the degree to which borders within the +master are used in determining the placement of the slave. +The default and most common value is \fBinside\fR. +In this case the placer considers the area of the master to +be the innermost area of the master, inside any border: +an option of \fB\-x 0\fR corresponds to an x-coordinate just +inside the border and an option of \fB\-relwidth 1.0\fR +means \fIwindow\fR will fill the area inside the master's +border. +If \fImode\fR is \fBignore\fR, borders are ignored: +the area of the master is considered to be its official area, which +includes any internal border. +.PP +If the same value is specified separately with +two different options, such as \fB\-x\fR and \fB\-relx\fR, then +the most recent option is used and the older one is ignored. +.PP +The \fBplace slaves\fR command returns a list of all the slave +windows for which \fIwindow\fR is the master. +If there are no slaves for \fIwindow\fR then an empty string is +returned. +.PP +The \fBplace forget\fR command causes the placer to stop managing +the geometry of \fIwindow\fR. As a side effect of this command +\fIwindow\fR will be unmapped so that it doesn't appear on the +screen. +If \fIwindow\fR isn't currently managed by the placer then the +command has no effect. +\fBPlace forget\fR returns an empty string as result. +.PP +The \fBplace info\fR command returns a list giving the current +configuration of \fIwindow\fR. +The list consists of \fIoption\-value\fR pairs in exactly the +same form as might be specified to the \fBplace configure\fR +command. +If the configuration of a window has been retrieved with +\fBplace info\fR, that configuration can be restored later by +first using \fBplace forget\fR to erase any existing information +for the window and then invoking \fBplace configure\fR with +the saved information. + +.SH "FINE POINTS" +.PP +Unlike many other geometry managers (such as the packer) +the placer does not make any attempt to manipulate the geometry of +the master windows or the parents of slave windows (i.e. it doesn't +set their requested sizes). +To control the sizes of these windows, make them windows like +frames and canvases that provide configuration options for this purpose. +.PP +The \fBplace\fR command is the only way to position toplevel windows +on the screen. In this special case, the master of a toplevel window +is assumed to be the entire screen area and the toplevel's location and +area is computed based on the screen's area. + +.SH KEYWORDS +geometry manager, height, location, master, place, rubber sheet, slave, width, +toplevel diff --git a/doc/radiobutton.n b/doc/radiobutton.n new file mode 100644 index 0000000..e20c924 --- /dev/null +++ b/doc/radiobutton.n @@ -0,0 +1,225 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH radiobutton n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +radiobutton \- Create and manipulate radiobutton widgets +.SH SYNOPSIS +\fBradiobutton\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 3.8c 7.6c 11.4c +\fBactiveAttributes\fR \fBattributes\fR \fBdisabledForeground\fR \fBtextVariable\fR +\fBactiveBackground\fR \fBbackground\fR \fBforeground\fR \fBunderline\fR +\fBactiveForeground\fR \fBdisabledAttributes\fR \fBtakeFocus\fR \fBunderlineAttributes\fR +\fBanchor\fR \fBdisabledBackground\fR \fBtext\fR \fBunderlineForeground\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBcommand\fR +Class: \fBCommand\fR +Command-Line Switch: \fB\-command\fR +.fi +.IP +Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is pressed in the button +window. The button's global variable (\fB\-variable\fR option) will +be updated before the command is invoked. +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies a desired height for the button in screen lines. +If this option isn't specified, the button's desired height is 1 line. +.LP +.nf +Name: \fBselectColor\fR +Class: \fBBackground\fR +Command-Line Switch: \fB\-selectcolor\fR +.fi +.IP +Specifies a background color to use when the button is selected. +If \fBindicatorOn\fR is true, the color applicies to the indicator. +.LP +.nf +Name: \fBstate\fR +Class: \fBState\fR +Command-Line Switch: \fB\-state\fR +.fi +.IP +Specifies one of three states for the radiobutton: \fBnormal\fR, \fBactive\fR, +or \fBdisabled\fR. In normal state the radiobutton is displayed using the +\fBattributes\fR, \fBforeground\fR, and \fBbackground\fR options. +The active state is used when the input focus is in the radiobutton. +In active state the radiobutton is displayed using the +\fBactiveAttributes\fR, \fBactiveForeground\fR, and +\fBactiveBackground\fR options. +Disabled state means that the radiobutton should be insensitive: +the default bindings will refuse to activate the widget and will ignore mouse +button presses. +In this state the \fBdisabledAttributes\fR, \fBdisabledForeground\fR and +\fBdisabledBackground\fR options determine how the radiobutton is displayed. +.LP +.nf +Name: \fBvalue\fR +Class: \fBValue\fR +Command-Line Switch: \fB\-value\fR +.fi +.IP +Specifies value to store in the button's associated variable whenever +this button is selected. +.LP +.nf +Name: \fBvariable\fR +Class: \fBVariable\fR +Command-Line Switch: \fB\-variable\fR +.fi +.IP +Specifies name of global variable to set whenever this button is +selected. Changes in this variable also cause the button to select +or deselect itself. Defaults to the value \fBselectedButton\fR. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies a desired width for the button in screen columns. +If this option isn't specified, the button's desired width is computed +from the size of the text being displayed in it. +.BE + +.SH DESCRIPTION +.PP +The \fBradiobutton\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a radiobutton widget. +Additional options, described above, may be specified on the command line +or in the option database to configure aspects of the radiobutton such as +its colors, attributes, and text. The \fBradiobutton\fR command returns its +\fIpathName\fR argument. At the time this command is invoked, +there must not exist a window named \fIpathName\fR, but +\fIpathName\fR's parent must exist. +.PP +A radiobutton is a widget that displays a textual string +and a circle called an \fIindicator\fR. +One of the characters of the string may optionally be underlined +using the \fBunderline\fR, \fBunderlineAttributes\fR, and +\fBunderlineForeground\fR options. +A radiobutton has all of the behavior of a simple button: +it can display itself in either of three different ways, +according to the \fBstate\fR option, and it invokes +a Tcl command whenever mouse button 1 is clicked over the +check button. +.PP +In addition, radiobuttons can be \fIselected\fR. +If a radiobutton is selected, the indicator is normally +drawn with a special color, and a Tcl variable associated with the +radiobutton is set to a particular value. +If the radiobutton is not selected, the indicator is drawn with no +special color. Typically, several radiobuttons share a single variable +and the value of the variable indicates which radiobutton is to be selected. +When a radiobutton is selected it sets the value of the variable to +indicate that fact; each radiobutton also monitors the value of +the variable and automatically selects and deselects itself when the +variable's value changes. +By default the variable \fBselectedButton\fR +is used; its contents give the name of the button that is +selected, or the empty string if no button associated with that +variable is selected. +The name of the variable for a radiobutton, +plus the variable to be stored into it, may be modified with options +on the command line or in the option database. +Configuration options may also be used to modify the way the +indicator is displayed. +By default a radio button is configured to select itself on button clicks. + +.SH "WIDGET COMMAND" +.PP +The \fBradiobutton\fR command creates a new Tcl command whose +name is \fIpathName\fR. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for radiobutton widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBradiobutton\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBradiobutton\fR +command. +.TP +\fIpathName \fBdeselect\fR +Deselects the radiobutton and sets the associated variable to an +empty string. +If this radiobutton was not currently selected, the command has +no effect. +.TP +\fIpathName \fBinvoke\fR +Does just what would have happened if the user invoked the radiobutton +with the mouse: selects the button and invokes +its associated Tcl command, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the radiobutton. +This command is ignored if the radiobutton's state is \fBdisabled\fR. +.TP +\fIpathName \fBselect\fR +Selects the radiobutton and sets the associated variable to the +value corresponding to this widget. + +.SH BINDINGS +.PP +Ck automatically creates class bindings for radiobuttons that give them +the following default behavior: +.IP [1] +The radiobutton activates whenever it gets the input focus and deactivates +whenever it loses the input focus. +.IP [2] +When mouse button 1 is pressed over a radiobutton it is invoked (it +becomes selected and the command associated with the button is +invoked, if there is one). +.IP [3] +When a radiobutton has the input focus, the space or return keys cause +the radiobutton to be invoked. +.PP +If the radiobutton's state is \fBdisabled\fR then none of the above +actions occur: the radiobutton is completely non-responsive. +.PP +The behavior of radiobuttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH KEYWORDS +radiobutton, widget diff --git a/doc/raise.n b/doc/raise.n new file mode 100644 index 0000000..834215f --- /dev/null +++ b/doc/raise.n @@ -0,0 +1,35 @@ +'\" +'\" Copyright (c) 1990 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH raise n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +raise \- Change a window's position in the stacking order +.SH SYNOPSIS +\fBraise \fIwindow \fR?\fIaboveThis\fR? +.BE + +.SH DESCRIPTION +.PP +If the \fIaboveThis\fR argument is omitted then the command raises +\fIwindow\fR so that it is above all of its siblings in the stacking +order (it will not be obscured by any siblings and will obscure +any siblings that overlap it). +If \fIaboveThis\fR is specified then it must be the path name of +a window that is either a sibling of \fIwindow\fR or the descendant +of a sibling of \fIwindow\fR. +In this case the \fBraise\fR command will insert +\fIwindow\fR into the stacking order just above \fIaboveThis\fR +(or the ancestor of \fIaboveThis\fR that is a sibling of \fIwindow\fR); +this could end up either raising or lowering \fIwindow\fR. + +.SH KEYWORDS +obscure, raise, stacking order + diff --git a/doc/recorder.n b/doc/recorder.n new file mode 100644 index 0000000..1101604 --- /dev/null +++ b/doc/recorder.n @@ -0,0 +1,62 @@ +'\" +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH recorder n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +recorder \- Simple event recorder/player +.SH SYNOPSIS +\fBrecorder replay \fIfileName\fR +.br +\fBrecorder start \fR?\fI\-withdelay\fR? \fIfileName\fR +.br +\fBrecorder stop\fR +.BE + +.SH DESCRIPTION +.PP +This command provides a simple recorder/player for certain kinds +of events. The \fBrecorder start\fR form arranges for recording +events to the event log file \fIfileName\fR. If the \fI\-withdelay\fR +switch is specified, the delays between events are also recorded. +The event log file may be replayed using the \fBrecorder replay\fR +command form. With \fBrecorder stop\fR all recording/playing +activity is stopped and all event log files are closed. +.PP +Each event takes up one line in an event log file. Event types are the +first word in angle brackets in the line. They are followed by parameters +for the event: +.TP +\fB \fIwindow button x y rootX rooty\fR +Mouse button \fBbutton\fR (1, 2, or 3) pressed in window \fIwindow\fR at +window coordinate \fIx\fR, \fIy\fR. Root coordinates are in \fIrootX\fR, +\fIrootY\fR. +.TP +\fB \fIwindow button x y rootX rooty\fR +Mouse button released, analogous to \fB\fR. +.TP +\fB \fImilliseconds\fR +Delay replay for \fImilliseconds\fR. +.TP +\fB \fIwindow keysym\fR +Key pressed in \fIwindow\fR. \fIKeysym\fR is the symbolic name of the +key, e.g. ``Linefeed'', ``Return'', ``Control-A'', or a hexadecimal +key code like 0xc3. +Note that hexadecimal key codes greater than 0x7f are not portable +accross different systems. +.PP +Lines starting with a hash are treated as comments. All other lines +whose first word does not start with an open angle bracket are +evaluated as normal Tcl commands. As in Tcl source files, newline-backslash +sequences are treated as continuation lines. +.PP +Errors occuring during replay are reported using the background error +mechanism. Upon error, the replay event log file is closed. + +.SH KEYWORDS +event, recorder diff --git a/doc/scrollbar.n b/doc/scrollbar.n new file mode 100644 index 0000000..bc9ce0d --- /dev/null +++ b/doc/scrollbar.n @@ -0,0 +1,242 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH scrollbar n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +scrollbar \- Create and manipulate scrollbar widgets +.SH SYNOPSIS +\fBscrollbar\fI pathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +\fBactiveAttributes\fR \fBactiveForeground\fR \fBbackground\fR \fBorient\fR +\fBactiveBackground\fR \fBattributes\fR \fBforeground\fR \fBtakeFocus\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBcommand\fR +Class: \fBCommand\fR +Command-Line Switch: \fB\-command\fR +.fi +.IP +Specifies the prefix of a Tcl command to invoke to change the view +in the widget associated with the scrollbar. When a user requests +a view change by manipulating the scrollbar, a Tcl command is +invoked. The actual command consists of this option followed by +additional information as described later. +.BE + +.SH DESCRIPTION +.PP +The \fBscrollbar\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a scrollbar widget. +Additional options, described above, may be specified on the command +line or in the option database to configure aspects of the scrollbar +such as its colors, orientation, and relief. +The \fBscrollbar\fR command returns its \fIpathName\fR argument. +At the time this command is invoked, there must not exist a window +named \fIpathName\fR, but \fIpathName\fR's parent must exist. +.PP +A scrollbar is a widget that displays two arrows, one at each end of +the scrollbar, and a \fIslider\fR in the middle portion of the +scrollbar. +It provides information about what is visible in an \fIassociated window\fR +that displays an document of some sort (such as a file being edited). +The position and size of the slider indicate which portion of the +document is visible in the associated window. For example, if the +slider in a vertical scrollbar covers the top third of the area +between the two arrows, it means that the associated window displays +the top third of its document. +.PP +Scrollbars can be used to adjust the view in the associated window +by clicking or dragging with the mouse. See the BINDINGS section +below for details. + +.SH "ELEMENTS" +A scrollbar displays five elements, which are referred to in the +widget commands for the scrollbar: +.TP 10 +\fBarrow1\fR +The top or left arrow in the scrollbar. +.TP 10 +\fBtrough1\fR +The region between the slider and \fBarrow1\fR. +.TP 10 +\fBslider\fR +The rectangle that indicates what is visible in the associated widget. +.TP 10 +\fBtrough2\fR +The region between the slider and \fBarrow2\fR. +.TP 10 +\fBarrow2\fR +The bottom or right arrow in the scrollbar. + +.SH "WIDGET COMMAND" +.PP +The \fBscrollbar\fR command creates a new Tcl command whose +name is \fIpathName\fR. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for scrollbar widgets: +.TP +\fIpathName \fBactivate\fR +Marks the scrollbar as active, which +causes it to be displayed as specified by the +\fBactiveAttributes\fR, \fBactiveBackground\fR and \fBactiveForeground\fR +options. +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBscrollbar\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBscrollbar\fR +command. +.TP +\fIpathName \fBdeactivate\fR +Marks the scrollbar as normal, which +causes it to be displayed as specified by the +\fBattributes\fR, \fBbackground\fR and \fBforeground\fR options. +.TP +\fIpathName \fBfraction \fIx y\fR +Returns a real number between 0 and 1 indicating where the point +given by \fIx\fR and \fIy\fR lies in the trough area of the scrollbar. +The value 0 corresponds to the top or left of the trough, the +value 1 corresponds to the bottom or right, 0.5 corresponds to +the middle, and so on. +\fIX\fR and \fIy\fR must be screen coordinates relative to the scrollbar +widget. +If \fIx\fR and \fIy\fR refer to a point outside the trough, the closest +point in the trough is used. +.TP +\fIpathName \fBget\fR +Returns the scrollbar settings in the form of a list whose +elements are the arguments to the most recent \fBset\fR widget command. +.TP +\fIpathName \fBidentify\fR \fIx y\fR +Returns the name of the element under the point given by \fIx\fR and +\fIy\fR (such as \fBarrow1\fR), or an empty string if the point does +not lie in any element of the scrollbar. +\fIX\fR and \fIy\fR must be screen coordinates relative to the scrollbar +widget. +.TP +\fIpathName \fBset\fR \fIfirst last\fR +This command is invoked by the scrollbar's associated widget to +tell the scrollbar about the current view in the widget. +The command takes two arguments, each of which is a real fraction +between 0 and 1. +The fractions describe the range of the document that is visible in +the associated widget. +For example, if \fIfirst\fR is 0.2 and \fIlast\fR is 0.4, it means +that the first part of the document visible in the window is 20% +of the way through the document, and the last visible part is 40% +of the way through. + +.SH "SCROLLING COMMANDS" +.PP +When the user interacts with the scrollbar, for example by dragging +the slider, the scrollbar notifies the associated widget that it +must change its view. +The scrollbar makes the notification by evaluating a Tcl command +generated from the scrollbar's \fB\-command\fR option. +The command may take any of the following forms. +In each case, \fIprefix\fR is the contents of the +\fB\-command\fR option, which usually has a form like \fB.t yview\fR +.TP +\fIprefix \fBmoveto \fIfraction\fR +\fIFraction\fR is a real number between 0 and 1. +The widget should adjust its view so that the point given +by \fIfraction\fR appears at the beginning of the widget. +If \fIfraction\fR is 0 it refers to the beginning of the +document. 1.0 refers to the end of the document, 0.333 +refers to a point one-third of the way through the document, +and so on. +.TP +\fIprefix \fBscroll \fInumber \fBunit\fR +The widget should adjust its view by \fInumber\fR units. +The units are defined in whatever way makes sense for the widget, +such as characters or lines in a text widget. +\fINumber\fR is either 1, which means one unit should scroll off +the top or left of the window, or \-1, which means that one unit +should scroll off the bottom or right of the window. +.TP +\fIprefix \fBscroll \fInumber \fBpage\fR +The widget should adjust its view by \fInumber\fR pages. +It is up to the widget to define the meaning of a page; typically +it is slightly less than what fits in the window, so that there +is a slight overlap between the old and new views. +\fINumber\fR is either 1, which means the next page should +become visible, or \-1, which means that the previous page should +become visible. + +.SH BINDINGS +Ck automatically creates class bindings for scrollbars that give them +the following default behavior. +If the behavior is different for vertical and horizontal scrollbars, +the horizontal behavior is described in parentheses. + +.IP [1] +Pressing button 1 over \fBarrow1\fR causes the view in the +associated widget to shift up (left) by one unit so that the +document appears to move down (right) one unit. +.IP [2] +Pressing button 1 over \fBtrough1\fR causes the view in the +associated widget to shift up (left) by one screenful so that the +document appears to move down (right) one screenful. +.IP [3] +Pressing button 1 over \fBtrough2\fR causes the view in the +associated widget to shift down (right) by one screenful so that the +document appears to move up (left) one screenful. +.IP [4] +Pressing button 1 over \fBarrow2\fR causes the view in the +associated widget to shift down (right) by one unit so that the +document appears to move up (left) one unit. +.IP [5] +In vertical scrollbars the Up and Down keys have the same behavior +as mouse clicks over \fBarrow1\fR and \fBarrow2\fR, respectively. +In horizontal scrollbars these keys have no effect. +.IP [6] +In horizontal scrollbars the Left and Right keys have the same behavior +as mouse clicks over \fBarrow1\fR and \fBarrow2\fR, respectively. +In vertical scrollbars these keys have no effect. +.IP [7] +The Prior and Next keys have the same behavior +as mouse clicks over \fBtrough1\fR and \fBtrough2\fR, respectively. +.IP [8] +The Home key adjusts the view to the top (left edge) of the document. +.IP [9] +The End key adjusts the view to the bottom (right edge) of the document. +.IP [10] +FocusIn and FocusOut events activate and deactive the scrollbars, respectively. + +.SH KEYWORDS +scrollbar, widget diff --git a/doc/text.n b/doc/text.n new file mode 100644 index 0000000..f8764b3 --- /dev/null +++ b/doc/text.n @@ -0,0 +1,1047 @@ +'\" +'\" Copyright (c) 1992 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH text n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +text \- Create and manipulate text widgets +.SH SYNOPSIS +\fBtext\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +\fBattributes\fR \fBselectAttributes\fR \fBselectForeground\fR \fBxScrollCommand\fR +\fBbackground\fR \fBselectBackground\fR \fBtakeFocus\fR \fByScrollCommand\fR +\fBforeground\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies the desired height for the window, in screen lines. +Must be at least one. +.LP +.nf +Name: \fBstate\fR +Class: \fBState\fR +Command-Line Switch: \fB\-state\fR +.fi +.IP +Specifies one of two states for the text: \fBnormal\fR or \fBdisabled\fR. +If the text is disabled then characters may not be inserted or deleted +and no insertion cursor will be displayed, even if the input focus is +in the widget. +.LP +.nf +Name: \fBtabs\fR +Class: \fBTabs\fR +Command-Line Switch: \fB\-tabs\fR +.fi +.IP +Specifies a set of tab stops for the window. The option's value consists +of a list of screen distances giving the positions of the tab stops. Each +position may optionally be followed in the next list element +by one of the keywords \fBleft\fR, \fBright\fR, \fBcenter\fR, +or \fBnumeric\fR, which specifies how to justify +text relative to the tab stop. \fBLeft\fR is the default; it causes +the text following the tab character to be positioned with its left edge +at the tab position. \fBRight\fR means that the right edge of the text +following the tab character is positioned at the tab position, and +\fBcenter\fR means that the text is centered at the tab position. +\fBNumeric\fR means that the decimal point in the text is positioned +at the tab position; if there is no decimal point then the least +significant digit of the number is positioned just to the left of the +tab position; if there is no number in the text then the text is +right-justified at the tab position. +For example, \fB\-tabs {2 left 4 6 center}\fR creates three +tab stops at two-column intervals; the first two use left +justification and the third uses center justification. +If the list of tab stops does not have enough elements to cover all +of the tabs in a text line, then Ck extrapolates new tab stops using +the spacing and alignment from the last tab stop in the list. +The value of the \fBtabs\fR option may be overridden by \fB\-tabs\fR +options in tags. +If no \fB\-tabs\fR option is specified, or if it is specified as +an empty list, then Ck uses default tabs spaced every eight columns. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies the desired width for the window in screen columns. +.LP +.nf +Name: \fBwrap\fR +Class: \fBWrap\fR +Command-Line Switch: \fB\-wrap\fR +.fi +.IP +Specifies how to handle lines in the text that are too long to be +displayed in a single line of the text's window. +The value must be \fBnone\fR or \fBchar\fR or \fBword\fR. +A wrap mode of \fBnone\fR means that each line of text appears as +exactly one line on the screen; extra characters that don't fit +on the screen are not displayed. +In the other modes each line of text will be broken up into several +screen lines if necessary to keep all the characters visible. +In \fBchar\fR mode a screen line break may occur after any character; +in \fBword\fR mode a line break will only be made at word boundaries. +.BE + +.SH DESCRIPTION +.PP +The \fBtext\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a text widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the text such as its colors and attributes. +The \fBtext\fR command returns the path name of the new window. +.PP +A text widget displays one or more lines of text and allows that +text to be edited. +Text widgets support two different kinds of annotations on the +text, called tags and marks. +Tags allow different portions of the text +to be displayed with different attributes and colors. +.\" In addition, Tcl commands can be associated with tags so +.\" that scripts are invoked when particular actions such as keystrokes +.\" and mouse button presses occur in particular ranges of the text. +See TAGS below for more details. +.PP +The second form of annotation consists of marks, which are floating +markers in the text. +Marks are used to keep track of various interesting positions in the +text as it is edited. +See MARKS below for more details. + +.SH INDICES +.PP +Many of the widget commands for texts take one or more indices +as arguments. +An index is a string used to indicate a particular place within +a text, such as a place to insert characters or one endpoint of a +range of characters to delete. +Indices have the syntax +.IP +\fIbase modifier modifier modifier ...\fR +.LP +Where \fIbase\fR gives a starting point and the \fImodifier\fRs +adjust the index from the starting point (e.g. move forward or +backward one character). Every index must contain a \fIbase\fR, +but the \fImodifier\fRs are optional. +.LP +The \fIbase\fR for an index must have one of the following forms: +.TP 12 +\fIline\fB.\fIchar\fR +Indicates \fIchar\fR'th character on line \fIline\fR. +Lines are numbered from 1 for consistency with other UNIX programs +that use this numbering scheme. +Within a line, characters are numbered from 0. +.TP 12 +\fB@\fIx\fB,\fIy\fR +Indicates the character that covers the place whose x and y coordinates +within the text's window are \fIx\fR and \fIy\fR. +.TP 12 +\fBend\fR +Indicates the end of the text (the character just after the last +newline). +.TP 12 +\fImark\fR +Indicates the character just after the mark whose name is \fImark\fR. +.TP 12 +\fItag\fB.first\fR +Indicates the first character in the text that has been tagged with +\fItag\fR. +This form generates an error if no characters are currently tagged +with \fItag\fR. +.TP 12 +\fItag\fB.last\fR +Indicates the character just after the last one in the text that has +been tagged with \fItag\fR. +This form generates an error if no characters are currently tagged +with \fItag\fR. +.LP +If modifiers follow the base index, each one of them must have one +of the forms listed below. Keywords such as \fBchars\fR and \fBwordend\fR +may be abbreviated as long as the abbreviation is unambiguous. +.TP +\fB+ \fIcount\fB chars\fR +Adjust the index forward by \fIcount\fR characters, moving to later +lines in the text if necessary. If there are fewer than \fIcount\fR +characters in the text after the current index, then set the index +to the last character in the text. +Spaces on either side of \fIcount\fR are optional. +.TP +\fB\- \fIcount\fB chars\fR +Adjust the index backward by \fIcount\fR characters, moving to earlier +lines in the text if necessary. If there are fewer than \fIcount\fR +characters in the text before the current index, then set the index +to the first character in the text. +Spaces on either side of \fIcount\fR are optional. +.TP +\fB+ \fIcount\fB lines\fR +Adjust the index forward by \fIcount\fR lines, retaining the same +character position within the line. If there are fewer than \fIcount\fR +lines after the line containing the current index, then set the index +to refer to the same character position on the last line of the text. +Then, if the line is not long enough to contain a character at the indicated +character position, adjust the character position to refer to the last +character of the line (the newline). +Spaces on either side of \fIcount\fR are optional. +.TP +\fB\- \fIcount\fB lines\fR +Adjust the index backward by \fIcount\fR lines, retaining the same +character position within the line. If there are fewer than \fIcount\fR +lines before the line containing the current index, then set the index +to refer to the same character position on the first line of the text. +Then, if the line is not long enough to contain a character at the indicated +character position, adjust the character position to refer to the last +character of the line (the newline). +Spaces on either side of \fIcount\fR are optional. +.TP +\fBlinestart\fR +Adjust the index to refer to the first character on the line. +.TP +\fBlineend\fR +Adjust the index to refer to the last character on the line (the newline). +.TP +\fBwordstart\fR +Adjust the index to refer to the first character of the word containing +the current index. A word consists of any number of adjacent characters +that are letters, digits, or underscores, or a single character that +is not one of these. +.TP +\fBwordend\fR +Adjust the index to refer to the character just after the last one of the +word containing the current index. If the current index refers to the last +character of the text then it is not modified. +.LP +If more than one modifier is present then they are applied in +left-to-right order. For example, the index ``\fBend \- 1 chars\fR'' +refers to the next-to-last character in the text and +``\fBinsert wordstart \- 1 c\fR'' refers to the character just before +the first one in the word containing the insertion cursor. + +.SH TAGS +.PP +The first form of annotation in text widgets is a tag. +A tag is a textual string that is associated with some of the characters +in a text. +Tags may contain arbitrary characters, but it is probably best to +avoid using the the characters `` '' (space), \fB+\fR, or \fB\-\fR: +these characters have special meaning in indices, so tags containing +them can't be used as indices. +There may be any number of tags associated with characters in a +text. +Each tag may refer to a single character, a range of characters, or +several ranges of characters. +An individual character may have any number of tags associated with it. +.PP +A priority order is defined among tags, and this order is used in +implementing some of the tag-related functions described below. +When a tag is defined (by associating it with characters or setting +its display options +.\" or binding commands +to it), it is given +a priority higher than any existing tag. +The priority order of tags may be redefined using the +``\fIpathName \fBtag raise\fR'' and ``\fIpathName \fBtag lower\fR'' +widget commands. +.PP +.\" Tags serve three purposes in text widgets. +Tags serve two purposes in text widgets. +First, they control the way information is displayed on the screen. +By default, characters are displayed as determined by the +\fBbackground\fR, \fBattributes\fR, and \fBforeground\fR options for the +text widget. +However, display options may be associated with individual tags +using the ``\fIpathName \fBtag configure\fR'' widget command. +If a character has been tagged, then the display options associated +with the tag override the default display style. +The following options are currently supported for tags: +.TP +\fB\-attributes \fIattrList\fR +\fIAttrList\fR specifies the attributes to use for characters associated +with the tag. +.TP +\fB\-background \fIcolor\fR +\fIColor\fR specifies the background color to use for characters +associated with the tag. +.TP +\fB\-foreground \fIcolor\fR +\fIColor\fR specifies the color to use when drawing text and other +foreground information such as underlines. +It may have any of the forms accepted by \fBTk_GetColor\fR. +.TP +\fB\-justify \fIjustify\fR +If the first character of a display line has a tag for which this +option has been specified, then \fIjustify\fR determines how to +justify the line. +It must be one of \fBleft\fR, \fBright\fR, or \fBcenter\fR. +If a line wraps, then the justification for each line on the +display is determined by the first character of that display line. +.TP +\fB\-lmargin1 \fIcolumns\fR +If the first character of a text line has a tag for which this +option has been specified, then \fIcolumns\fR specifies how +much the line should be indented from the left edge of the +window. +If a line of text wraps, this option only applies to the +first line on the display; the \fB\-lmargin2\fR option controls +the indentation for subsequent lines. +.TP +\fB\-lmargin2 \fIcolumns\fR +If the first character of a display line has a tag for which this +option has been specified, and if the display line is not the +first for its text line (i.e., the text line has wrapped), then +\fIcolumns\fR specifies how much the line should be indented from +the left edge of the window. +This option is only used when wrapping is enabled, and it only +applies to the second and later display lines for a text line. +.TP +\fB\-rmargin \fIcolumns\fR +If the first character of a display line has a tag for which this +option has been specified, then \fIcolumns\fR specifies how wide +a margin to leave between the end of the line and the right +edge of the window. +This option is only used when wrapping is enabled. +If a text line wraps, the right margin for each line on the +display is determined by the first character of that display +line. +.TP +\fB\-tabs \fItabList\fR +\fITabList\fR specifies a set of tab stops in the same form +as for the \fB\-tabs\fR option for the text widget. This +option only applies to a display line if it applies to the +first character on that display line. +If this option is specified as an empty string, it cancels +the option, leaving it unspecified for the tag (the default). +If the option is specified as a non-empty string that is +an empty list, such as \fB\-tags\0{\0}\fR, then it requests +default 8-character tabs as described for the \fBtags\fR +widget option. +.TP +\fB\-wrap \fImode\fR +\fIMode\fR specifies how to handle lines that are wider than the +text's window. +It has the same legal values as the \fB\-wrap\fR option +for the text widget: \fBnone\fR, \fBchar\fR, or \fBword\fR. +If this tag option is specified, it overrides the \fB\-wrap\fR option +for the text widget. +.PP +If a character has several tags associated with it, and if their +display options conflict, then the options of the highest priority +tag are used. +If a particular display option hasn't been specified for a +particular tag, or if it is specified as an empty string, then +that option will never be used; the next-highest-priority +tag's option will used instead. +If no tag specifies a particular display option, then the default +style for the widget will be used. +.\" .PP +.\" The second purpose for tags is event bindings. +.\" You can associate bindings with a tag in much the same way you can +.\" associate bindings with a widget class: whenever particular X +.\" events occur on characters with the given tag, a given +.\" Tcl command will be executed. +.\" Tag bindings can be used to give behaviors to ranges of characters; +.\" among other things, this allows hypertext-like +.\" features to be implemented. +.\" For details, see the description of the \fBtag bind\fR widget +.\" command below. +.PP +.\" The third use for tags is in managing the selection. +The second use for tags is in managing the selection. +See THE SELECTION below. + +.SH MARKS +.PP +The second form of annotation in text widgets is a mark. +Marks are used for remembering particular places in a text. +They are something like tags, in that they have names and +they refer to places in the file, but a mark isn't associated +with particular characters. +Instead, a mark is associated with the gap between two characters. +Only a single position may be associated with a mark at any given +time. +If the characters around a mark are deleted the mark will still +remain; it will just have new neighbor characters. +In contrast, if the characters containing a tag are deleted then +the tag will no longer have an association with characters in +the file. +Marks may be manipulated with the ``\fIpathName \fBmark\fR'' widget +command, and their current locations may be determined by using the +mark name as an index in widget commands. +.PP +Each mark also has a \fIgravity\fR, which is either \fBleft\fR or +\fBright\fR. +The gravity for a mark specifies what happens to the mark when +text is inserted at the point of the mark. +If a mark has left gravity, then the mark is treated as if it +were attached to the character on its left, so the mark will +remain to the left of any text inserted at the mark position. +If the mark has right gravity, new text inserted at the mark +position will appear to the right of the mark. The gravity +for a mark defaults to \fBright\fR. +.PP +The name space for marks is different from that for tags: the +same name may be used for both a mark and a tag, but they will refer +to different things. +.PP +Two marks have special significance. +First, the mark \fBinsert\fR is associated with the insertion cursor, +as described under THE INSERTION CURSOR below. +Second, the mark \fBcurrent\fR is associated with the character +closest to the mouse and is adjusted automatically to track the +mouse position and any changes to the text in the widget (one +exception: \fBcurrent\fR is not updated in response to mouse +motions if a mouse button is down; the update will be deferred +until all mouse buttons have been released). +Neither of these special marks may be deleted. + +.SH THE SELECTION +.PP +Selection support is implemented via tags. +The \fBsel\fR tag is automatically defined when a text widget is +created, and it may not be deleted with the ``\fIpathName \fBtag delete\fR'' +widget command. Furthermore, the \fBselectBackground\fR, +\fBselectAttributes\fR, and \fBselectForeground\fR options for +the text widget are tied to the \fB\-background\fR, +\fB\-attributes\fR, and \fB\-foreground\fR options for the \fBsel\fR +tag: changes in either will automatically be reflected in the +other. + +.SH THE INSERTION CURSOR +.PP +The mark named \fBinsert\fR has special significance in text widgets. +It is defined automatically when a text widget is created and it +may not be unset with the ``\fIpathName \fBmark unset\fR'' widget +command. +The \fBinsert\fR mark represents the position of the insertion +cursor, and the insertion cursor will automatically be moved to +this point whenever the text widget has the input focus. + +.SH "WIDGET COMMAND" +.PP +The \fBtext\fR command creates a new Tcl command whose +name is the same as the path name of the text's window. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIPathName\fR is the name of the command, which is the same as +the text widget's path name. \fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for text widgets: +.TP +\fIpathName \fBbbox \fIindex\fR +Returns a list of four elements describing the screen area +of the character given by \fIindex\fR. +The first two elements of the list give the x and y coordinates +of the upper-left corner of the area occupied by the +character, and the last two elements give the width and height +of the area. +If the character is not visible on the screen then the return +value is an empty list. +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBtext\fR +command. +.TP +\fIpathName \fBcompare\fR \fIindex1 op index2\fR +Compares the indices given by \fIindex1\fR and \fIindex2\fR according +to the relational operator given by \fIop\fR, and returns 1 if +the relationship is satisfied and 0 if it isn't. +\fIOp\fR must be one of the operators <, <=, ==, >=, >, or !=. +If \fIop\fR is == then 1 is returned if the two indices refer to +the same character, if \fIop\fR is < then 1 is returned if \fIindex1\fR +refers to an earlier character in the text than \fIindex2\fR, and +so on. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBtext\fR +command. +.TP +\fIpathName \fBdebug \fR?\fIboolean\fR? +If \fIboolean\fR is specified, then it must have one of the true or +false values accepted by Tcl_GetBoolean. +If the value is a true one then internal consistency checks will be +turned on in the B-tree code associated with text widgets. +If \fIboolean\fR has a false value then the debugging checks will +be turned off. +In either case the command returns an empty string. +If \fIboolean\fR is not specified then the command returns \fBon\fR +or \fBoff\fR to indicate whether or not debugging is turned on. +There is a single debugging switch shared by all text widgets: turning +debugging on or off in any widget turns it on or off for all widgets. +For widgets with large amounts of text, the consistency checks may +cause a noticeable slow-down. +.TP +\fIpathName \fBdelete \fIindex1 \fR?\fIindex2\fR? +Delete a range of characters from the text. +If both \fIindex1\fR and \fIindex2\fR are specified, then delete +all the characters starting with the one given by \fIindex1\fR +and stopping just before \fIindex2\fR (i.e. the character at +\fIindex2\fR is not deleted). +If \fIindex2\fR doesn't specify a position later in the text +than \fIindex1\fR then no characters are deleted. +If \fIindex2\fR isn't specified then the single character at +\fIindex1\fR is deleted. +It is not allowable to delete characters in a way that would leave +the text without a newline as the last character. +The command returns an empty string. +.TP +\fIpathName \fBdlineinfo \fIindex\fR +Returns a list with five elements describing the area occupied +by the display line containing \fIindex\fR. +The first two elements of the list give the x and y coordinates +of the upper-left corner of the area occupied by the +line, the third and fourth elements give the width and height +of the area, and the fifth element gives the position of the baseline +for the line (always zero). +All of this information is measured in screen coordinates. +If the current wrap mode is \fBnone\fR and the line extends beyond +the boundaries of the window, +the area returned reflects the entire area of the line, including the +portions that are out of the window. +If the line is shorter than the full width of the window then the +area returned reflects just the portion of the line that is occupied +by characters. +If the display line containing \fIindex\fR is not visible on +the screen then the return value is an empty list. +.TP +\fIpathName \fBget \fIindex1 \fR?\fIindex2\fR? +Return a range of characters from the text. +The return value will be all the characters in the text starting +with the one whose index is \fIindex1\fR and ending just before +the one whose index is \fIindex2\fR (the character at \fIindex2\fR +will not be returned). +If \fIindex2\fR is omitted then the single character at \fIindex1\fR +is returned. +If there are no characters in the specified range (e.g. \fIindex1\fR +is past the end of the file or \fIindex2\fR is less than or equal +to \fIindex1\fR) then an empty string is returned. +.TP +\fIpathName \fBindex \fIindex\fR +Returns the position corresponding to \fIindex\fR in the form +\fIline.char\fR where \fIline\fR is the line number and \fIchar\fR +is the character number. +\fIIndex\fR may have any of the forms described under INDICES above. +.TP +\fIpathName \fBinsert \fIindex chars \fR?\fItagList chars tagList ...\fR? +Inserts all of the \fIchars\fR arguments just before the character at +\fIindex\fR. +If \fIindex\fR refers to the end of the text (the character after +the last newline) then the new text is inserted just before the +last newline instead. +If there is a single \fIchars\fR argument and no \fItagList\fR, then +the new text will receive any tags that are present on both the +character before and the character after the insertion point; if a tag +is present on only one of these characters then it will not be +applied to the new text. +If \fItagList\fR is specified then it consists of a list of +tag names; the new characters will receive all of the tags in +this list and no others, regardless of the tags present around +the insertion point. +If multiple \fIchars\fR\-\fItagList\fR argument pairs are present, +they produce the same effect as if a separate \fBinsert\fR widget +command had been issued for each pair, in order. +The last \fItagList\fR argument may be omitted. +.TP +\fIpathName \fBmark \fIoption \fR?\fIarg arg ...\fR? +This command is used to manipulate marks. The exact behavior of +the command depends on the \fIoption\fR argument that follows +the \fBmark\fR argument. The following forms of the command +are currently supported: +.RS +.TP +\fIpathName \fBmark gravity \fImarkName\fR ?\fIdirection\fR? +If \fIdirection\fR is not specified, returns \fBleft\fR or \fBright\fR +to indicate which of its adjacent characters \fImarkName\fR is attached +to. +If \fIdirection\fR is specified, it must be \fBleft\fR or \fBright\fR; +the gravity of \fImarkName\fR is set to the given value. +.TP +\fIpathName \fBmark names\fR +Returns a list whose elements are the names of all the marks that +are currently set. +.TP +\fIpathName \fBmark set \fImarkName index\fR +Sets the mark named \fImarkName\fR to a position just before the +character at \fIindex\fR. +If \fImarkName\fR already exists, it is moved from its old position; +if it doesn't exist, a new mark is created. +This command returns an empty string. +.TP +\fIpathName \fBmark unset \fImarkName \fR?\fImarkName markName ...\fR? +Remove the mark corresponding to each of the \fImarkName\fR arguments. +The removed marks will not be usable in indices and will not be +returned by future calls to ``\fIpathName \fBmark names\fR''. +This command returns an empty string. +.RE +.TP +\fIpathName \fBsearch \fR?\fIswitches\fR? \fIpattern index \fR?\fIstopIndex\fR? +Searches the text in \fIpathName\fR starting at \fIindex\fR for a range +of characters that matches \fIpattern\fR. +If a match is found, the index of the first character in the match is +returned as result; otherwise an empty string is returned. +One or more of the following switches (or abbreviations thereof) +may be specified to control the search: +.RS +.TP +\fB\-forwards\fR +The search will proceed forward through the text, finding the first +matching range starting at a position later than \fIindex\fR. +This is the default. +.TP +\fB\-backwards\fR +The search will proceed backward through the text, finding the +matching range closest to \fIindex\fR whose first character +is before \fIindex\fR. +.TP +\fB\-exact\fR +Use exact matching: the characters in the matching range must be +identical to those in \fIpattern\fR. +This is the default. +.TP +\fB\-regexp\fR +Treat \fIpattern\fR as a regular expression and match it against +the text using the rules for regular expressions (see the \fBregexp\fR +command for details). +.TP +\fB\-nocase\fR +Ignore case differences between the pattern and the text. +.TP +\fB\-count\fI varName\fR +The argument following \fB\-count\fR gives the name of a variable; +if a match is found, the number of characters in the matching +range will be stored in the variable. +.TP +\fB\-\-\fR +This switch has no effect except to terminate the list of switches: +the next argument will be treated as \fIpattern\fR even if it starts +with \fB\-\fR. +.LP +The matching range must be entirely within a single line of text. +For regular expression matching the newlines are removed from the ends +of the lines before matching: use the \fB$\fR feature in regular +expressions to match the end of a line. +For exact matching the newlines are retained. +If \fIstopIndex\fR is specified, the search stops at that index: +for forward searches, no match at or after \fIstopIndex\fR will +be considered; for backward searches, no match earlier in the +text than \fIstopIndex\fR will be considered. +If \fIstopIndex\fR is omitted, the entire text will be searched: +when the beginning or end of the text is reached, the search +continues at the other end until the starting location is reached +again; if \fIstopIndex\fR is specified, no wrap-around will occur. +.RE +.TP +\fIpathName \fBsee \fIindex\fR +Adjusts the view in the window so that the character given by \fIindex\fR +is visible. +If \fIindex\fR is already visible then the command does nothing. +If \fIindex\fR is a short distance out of view, the command +adjusts the view just enough to make \fIindex\fR visible at the +edge of the window. +If \fIindex\fR is far out of view, then the command centers +\fIindex\fR in the window. +.TP +\fIpathName \fBtag \fIoption \fR?\fIarg arg ...\fR? +This command is used to manipulate tags. The exact behavior of the +command depends on the \fIoption\fR argument that follows the +\fBtag\fR argument. The following forms of the command are currently +supported: +.RS +.TP +\fIpathName \fBtag add \fItagName index1 \fR?\fIindex2 index1 index2 ...\fR? +Associate the tag \fItagName\fR with all of the characters starting +with \fIindex1\fR and ending just before +\fIindex2\fR (the character at \fIindex2\fR isn't tagged). +A single command may contain any number of \fIindex1\fR\-\fIindex2\fR +pairs. +If the last \fIindex2\fR is omitted then the single character at +\fIindex1\fR is tagged. +If there are no characters in the specified range (e.g. \fIindex1\fR +is past the end of the file or \fIindex2\fR is less than or equal +to \fIindex1\fR) then the command has no effect. +.\" .TP +.\" \fIpathName \fBtag bind \fItagName\fR ?\fIsequence\fR? ?\fIscript\fR? +.\" This command associates \fIscript\fR with the tag given by +.\" \fItagName\fR. +.\" Whenever the event sequence given by \fIsequence\fR occurs for a +.\" character that has been tagged with \fItagName\fR, +.\" the script will be invoked. +.\" This widget command is similar to the \fBbind\fR command except that +.\" it operates on characters in a text rather than entire widgets. +.\" See the \fBbind\fR manual entry for complete details +.\" on the syntax of \fIsequence\fR and the substitutions performed +.\" on \fIscript\fR before invoking it. +.\" If all arguments are specified then a new binding is created, replacing +.\" any existing binding for the same \fIsequence\fR and \fItagName\fR +.\" (if the first character of \fIscript\fR is ``+'' then \fIscript\fR +.\" augments an existing binding rather than replacing it). +.\" In this case the return value is an empty string. +.\" If \fIscript\fR is omitted then the command returns the \fIscript\fR +.\" associated with \fItagName\fR and \fIsequence\fR (an error occurs +.\" if there is no such binding). +.\" If both \fIscript\fR and \fIsequence\fR are omitted then the command +.\" returns a list of all the sequences for which bindings have been +.\" defined for \fItagName\fR. +.\" .RS +.\" .LP +.\" The only events for which bindings may be specified are those related +.\" to the mouse and keyboard, such as \fBEnter\fR, \fBLeave\fR, +.\" \fBButtonPress\fR, \fBMotion\fR, and \fBKeyPress\fR. +.\" Event bindings for a text widget use the \fBcurrent\fR mark +.\" described under MARKS above. +.\" An \fBEnter\fR event triggers for a tag when the tag first +.\" becomes present on the current character, and a \fBLeave\fR +.\" event triggers for a tag when it ceases to be present on +.\" the current character. +.\" \fBEnter\fR and \fBLeave\fR events can happen either because the +.\" \fBcurrent\fR mark moved or because the character at that +.\" position changed. +.\" Note that these events are different than \fBEnter\fR and \fBLeave\fR +.\" events for windows. +.\" Mouse and keyboard events are directed to the current character. +.\" .LP +.\" It is possible for the current character to have multiple tags, +.\" and for each of them to have a binding for a particular event +.\" sequence. +.\" When this occurs, one binding is invoked for each tag, in order +.\" from lowest-priority to highest priority. +.\" If there are multiple matching bindings for a single tag, then +.\" the most specific binding is chosen (see the manual entry for +.\" the \fBbind\fR command for details). +.\" \fBcontinue\fR and \fBbreak\fR commands within binding scripts +.\" are processed in the same way as for bindings created with +.\" the \fBbind\fR command. +.\" .LP +.\" If bindings are created for the widget as a whole using the +.\" \fBbind\fR command, then those bindings will supplement the +.\" tag bindings. +.\" The tag bindings will be invoked first, followed by bindings +.\" for the window as a whole. +.\" .RE +.TP +\fIpathName \fBtag cget\fR \fItagName option\fR +This command returns the current value of the option named \fIoption\fR +associated with the tag given by \fItagName\fR. +\fIOption\fR may have any of the values accepted by the \fBtag configure\fR +widget command. +.TP +\fIpathName \fBtag configure \fItagName\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR? +This command is similar to the \fBconfigure\fR widget command except +that it modifies options associated with the tag given by \fItagName\fR +instead of modifying options for the overall text widget. +If no \fIoption\fR is specified, the command returns a list describing +all of the available options for \fItagName\fR. +If \fIoption\fR is specified with no \fIvalue\fR, then the command returns +a list describing the one named option (this list will be identical to +the corresponding sublist of the value returned if no \fIoption\fR +is specified). +If one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given option(s) to have the given value(s) in \fItagName\fR; +in this case the command returns an empty string. +See TAGS above for details on the options available for tags. +.TP +\fIpathName \fBtag delete \fItagName \fR?\fItagName ...\fR? +Deletes all tag information for each of the \fItagName\fR +arguments. +The command removes the tags from all characters in the file +and also deletes any other information associated with the tags, +such as bindings and display information. +The command returns an empty string. +.TP +\fIpathName\fB tag lower \fItagName \fR?\fIbelowThis\fR? +Changes the priority of tag \fItagName\fR so that it is just lower +in priority than the tag whose name is \fIbelowThis\fR. +If \fIbelowThis\fR is omitted, then \fItagName\fR's priority +is changed to make it lowest priority of all tags. +.TP +\fIpathName \fBtag names \fR?\fIindex\fR? +Returns a list whose elements are the names of all the tags that +are active at the character position given by \fIindex\fR. +If \fIindex\fR is omitted, then the return value will describe +all of the tags that exist for the text (this includes all tags +that have been named in a ``\fIpathName \fBtag\fR'' widget +command but haven't been deleted by a ``\fIpathName \fBtag delete\fR'' +widget command, even if no characters are currently marked with +the tag). +The list will be sorted in order from lowest priority to highest +priority. +.TP +\fIpathName \fBtag nextrange \fItagName index1 \fR?\fIindex2\fR? +This command searches the text for a range of characters tagged +with \fItagName\fR where the first character of the range is +no earlier than the character at \fIindex1\fR and no later than +the character just before \fIindex2\fR (a range starting at +\fIindex2\fR will not be considered). +If several matching ranges exist, the first one is chosen. +The command's return value is a list containing +two elements, which are the index of the first character of the +range and the index of the character just after the last one in +the range. +If no matching range is found then the return value is an +empty string. +If \fIindex2\fR is not given then it defaults to the end of the text. +.TP +\fIpathName\fB tag raise \fItagName \fR?\fIaboveThis\fR? +Changes the priority of tag \fItagName\fR so that it is just higher +in priority than the tag whose name is \fIaboveThis\fR. +If \fIaboveThis\fR is omitted, then \fItagName\fR's priority +is changed to make it highest priority of all tags. +.TP +\fIpathName \fBtag ranges \fItagName\fR +Returns a list describing all of the ranges of text that have been +tagged with \fItagName\fR. +The first two elements of the list describe the first tagged range +in the text, the next two elements describe the second range, and +so on. +The first element of each pair contains the index of the first +character of the range, and the second element of the pair contains +the index of the character just after the last one in the +range. +If there are no characters tagged with \fItag\fR then an +empty string is returned. +.TP +\fIpathName \fBtag remove \fItagName index1 \fR?\fIindex2 index1 index2 ...\fR? +Remove the tag \fItagName\fR from all of the characters starting +at \fIindex1\fR and ending just before +\fIindex2\fR (the character at \fIindex2\fR isn't affected). +A single command may contain any number of \fIindex1\fR\-\fIindex2\fR +pairs. +If the last \fIindex2\fR is omitted then the single character at +\fIindex1\fR is tagged. +If there are no characters in the specified range (e.g. \fIindex1\fR +is past the end of the file or \fIindex2\fR is less than or equal +to \fIindex1\fR) then the command has no effect. +This command returns an empty string. +.RE +.TP +\fIpathName \fBxview \fIoption args\fR +This command is used to query and change the horizontal position of the +text in the widget's window. It can take any of the following +forms: +.RS +.TP +\fIpathName \fBxview\fR +Returns a list containing two elements. +Each element is a real fraction between 0 and 1; together they describe +the portion of the document's horizontal span that is visible in +the window. +For example, if the first element is .2 and the second element is .6, +20% of the text is off-screen to the left, the middle 40% is visible +in the window, and 40% of the text is off-screen to the right. +The fractions refer only to the lines that are actually visible in the +window: if the lines in the window are all very short, so that they +are entirely visible, the returned fractions will be 0 and 1, +even if there are other lines in the text that are +much wider than the window. +These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR +option. +.TP +\fIpathName \fBxview moveto\fI fraction\fR +Adjusts the view in the window so that \fIfraction\fR of the horizontal +span of the text is off-screen to the left. +\fIFraction\fR is a fraction between 0 and 1. +.TP +\fIpathName \fBxview scroll \fInumber what\fR +This command shifts the view in the window left or right according to +\fInumber\fR and \fIwhat\fR. +\fINumber\fR must be an integer. +\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation +of one of these. +If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by +\fInumber\fR average-width characters on the display; if it is +\fBpages\fR then the view adjusts by \fInumber\fR screenfuls. +If \fInumber\fR is negative then characters farther to the left +become visible; if it is positive then characters farther to the right +become visible. +.RE +.TP +\fIpathName \fByview \fI?args\fR? +This command is used to query and change the vertical position of the +text in the widget's window. +It can take any of the following forms: +.RS +.TP +\fIpathName \fByview\fR +Returns a list containing two elements, both of which are real fractions +between 0 and 1. +The first element gives the position of the first character in the +top line in the window, relative to the text as a whole (0.5 means +it is halfway through the text, for example). +The second element gives the position of the character just after +the last one in the bottom line of the window, +relative to the text as a whole. +These are the same values passed to scrollbars via the \fB\-yscrollcommand\fR +option. +.TP +\fIpathName \fByview moveto\fI fraction\fR +Adjusts the view in the window so that the character given by \fIfraction\fR +appears on the top line of the window. +\fIFraction\fR is a fraction between 0 and 1; 0 indicates the first +character in the text, 0.33 indicates the character one-third the +way through the text, and so on. +.TP +\fIpathName \fByview scroll \fInumber what\fR +This command adjust the view in the window up or down according to +\fInumber\fR and \fIwhat\fR. +\fINumber\fR must be an integer. +\fIWhat\fR must be either \fBunits\fR or \fBpages\fR. +If \fIwhat\fR is \fBunits\fR, the view adjusts up or down by +\fInumber\fR lines on the display; if it is \fBpages\fR then +the view adjusts by \fInumber\fR screenfuls. +If \fInumber\fR is negative then earlier positions in the text +become visible; if it is positive then later positions in the text +become visible. +.TP +\fIpathName \fByview \fR?\fB\-pickplace\fR? \fIindex\fR +Changes the view in the widget's window to make \fIindex\fR visible. +If the \fB\-pickplace\fR option isn't specified then \fIindex\fR will +appear at the top of the window. +If \fB\-pickplace\fR is specified then the widget chooses where +\fIindex\fR appears in the window: +.RS +.IP [1] +If \fIindex\fR is already visible somewhere in the window then the +command does nothing. +.IP [2] +If \fIindex\fR is only a few lines off-screen above the window then +it will be positioned at the top of the window. +.IP [3] +If \fIindex\fR is only a few lines off-screen below the window then +it will be positioned at the bottom of the window. +.IP [4] +Otherwise, \fIindex\fR will be centered in the window. +.LP +The \fB\-pickplace\fR option has been obsoleted by the \fBsee\fR widget +command (\fBsee\fR handles both x- and y-motion to make a location +visible, whereas \fB\-pickplace\fR only handles motion in y). +.RE +.TP +\fIpathName \fByview \fInumber\fR +This command makes the first character on the line after +the one given by \fInumber\fR visible at the top of the window. +\fINumber\fR must be an integer. +This command used to be used for scrolling, but now it is obsolete. +.RE + +.SH BINDINGS +.PP +Ck automatically creates class bindings for texts that give them +the following default behavior. +In the descriptions below, ``word'' refers to a contiguous group +of letters, digits, or ``_'' characters, or any single character +other than these. +.IP [1] +Clicking mouse button 1 positions the insertion cursor +just before the character underneath the mouse cursor, sets the +input focus to this widget, and clears any selection in the widget. +.IP [2] +If any normal printing characters are typed, they are +inserted at the point of the insertion cursor. +.IP [3] +The Left and Right keys move the insertion cursor one character to the +left or right; they also clear any selection in the text. +Control-b and Control-f behave the same as Left and Right, respectively. +.IP [4] +The Up and Down keys move the insertion cursor one line up or +down and clear any selection in the text. +Control-p and Control-n behave the same as Up and Down, respectively. +.IP [5] +The Next and Prior keys move the insertion cursor forward or backwards +by one screenful and clear any selection in the text. +Control-v moves the view down one screenful without moving the +insertion cursor or adjusting the selection. +.IP [6] +Home and Control-a move the insertion cursor to the +beginning of its line and clear any selection in the widget. +.IP [7] +End and Control-e move the insertion cursor to the +end of the line and clear any selection in the widget. +.IP [8] +The Delete key deletes the selection, if there is one in the widget. +If there is no selection, it deletes the character to the right of +the insertion cursor. +.IP [9] +Backspace and Control-h delete the selection, if there is one +in the widget. +If there is no selection, they delete the character to the left of +the insertion cursor. +.IP [10] +Control-d deletes the character to the right of the insertion cursor. +.IP [11] +Control-k deletes from the insertion cursor to the end of its line; +if the insertion cursor is already at the end of a line, then +Control-k deletes the newline character. +.IP [12] +Control-o opens a new line by inserting a newline character in +front of the insertion cursor without moving the insertion cursor. +.IP [13] +Control-x moves the input focus to the next widget in focus order. +.IP [14] +Control-t reverses the order of the two characters to the right of +the insertion cursor. +.PP +If the widget is disabled using the \fB\-state\fR option, then its +view can still be adjusted and text can still be selected, +but no insertion cursor will be displayed and no text modifications will +take place. +.PP +The behavior of texts can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +.SH "PERFORMANCE ISSUES" +.PP +Text widgets should run efficiently under a variety +of conditions. The text widget uses about 2-3 bytes of +main memory for each byte of text, so texts containing a megabyte +or more should be practical on most workstations. +Text is represented internally with a modified B-tree structure +that makes operations relatively efficient even with large texts. +Tags are included in the B-tree structure in a way that allows +tags to span large ranges or have many disjoint smaller ranges +without loss of efficiency. +Marks are also implemented in a way that allows large numbers of +marks. +The only known mode of operation where a text widget may not run +efficiently is if it has a very large number of different tags. +Hundreds of tags should be fine, or even a thousand, +but tens of thousands of tags will make texts consume a lot of +memory and run slowly. + +.SH KEYWORDS +text, widget diff --git a/doc/tkerror.n b/doc/tkerror.n new file mode 100644 index 0000000..7463a68 --- /dev/null +++ b/doc/tkerror.n @@ -0,0 +1,64 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH tkerror n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +tkerror \- Command invoked to process background errors +.SH SYNOPSIS +\fBtkerror \fImessage\fR +.BE + +.SH DESCRIPTION +.PP +The \fBtkerror\fR command doesn't exist as built-in part of Ck. Instead, +individual applications or users can define a \fBtkerror\fR +command (e.g. as a Tcl procedure) if they wish to handle background +errors. +.PP +A background error is one that occurs in a command that didn't +originate with the application. For example, if an error occurs +while executing a command specified with a \fBbind\fR or \fBafter\fR +command, then it is a background error. For a non-background error, +the error can simply be returned up through nested Tcl command +evaluations until it reaches the top-level code in the application; +then the application can report the error in whatever way it +wishes. When a background error occurs, the unwinding ends in +the Ck library and there is no obvious way for Ck to report +the error. +.PP +When Ck detects a background error, it saves information about the +error and invokes the \fBtkerror\fR command later when Ck is idle. +Before invoking \fBtkerror\fR, Ck restores the \fBerrorInfo\fR +and \fBerrorCode\fR variables to their values at the time the +error occurred, then it invokes \fBtkerror\fR with +the error message as its only argument. +Ck assumes that the application has implemented the \fBtkerror\fR +command, and that the command will report the error in a way that +makes sense for the application. Ck will ignore any result returned +by the \fBtkerror\fR command. +.PP +If another Tcl error occurs within the \fBtkerror\fR command +(for example, because no \fBtkerror\fR command has been defined) +then Ck reports the error itself by writing a message to stderr. +.PP +If several background errors accumulate before \fBtkerror\fR +is invoked to process them, \fBtkerror\fR will be invoked once +for each error, in the order they occurred. +However, if \fBtkerror\fR returns with a break exception, then +any remaining errors are skipped without calling \fBtkerror\fR. +.PP +The Ck script library includes a default \fBtkerror\fR procedure +that posts a dialog box containing the error message and offers +the user a chance to see a stack trace showing where the +error occurred. + +.SH KEYWORDS +background error, reporting diff --git a/doc/tkwait.n b/doc/tkwait.n new file mode 100644 index 0000000..f2595a8 --- /dev/null +++ b/doc/tkwait.n @@ -0,0 +1,49 @@ +'\" +'\" Copyright (c) 1992 The Regents of the University of California. +'\" Copyright (c) 1994 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH tkwait n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +tkwait \- Wait for variable to change or window to be destroyed +.SH SYNOPSIS +\fBtkwait variable \fIname\fR +.br +\fBtkwait visibility \fIname\fR +.br +\fBtkwait window \fIname\fR +.BE + +.SH DESCRIPTION +.PP +The \fBtkwait\fR command waits for one of several things to happen, +then it returns without taking any other actions. +The return value is always an empty string. +If the first argument is \fBvariable\fR (or any abbreviation of +it) then the second argument is the name of a global variable and the +command waits for that variable to be modified. +If the first argument is \fBvisibility\fR (or any abbreviation +of it) then the second argument is the name of a window and the +\fBtkwait\fR command waits for a change in its +visibility state. This form is typically used to wait for a newly-created +window to appear on the screen before taking some action. +At the time of this writing, visibility state changes are unreliable. +Thus this form of the \fBtkwait\fR command is strongly discouraged. +If the first argument is \fBwindow\fR (or any abbreviation +of it) then the second argument is the name of a window and the +\fBtkwait\fR command waits for that window to be destroyed. +This form is typically used to wait for a user to finish interacting +with a dialog box before using the result of that interaction. +.PP +While the \fBtkwait\fR command is waiting it processes events in +the normal fashion, so the application will continue to respond +to user interactions. + +.SH KEYWORDS +variable, visibility, wait, window diff --git a/doc/toplevel.n b/doc/toplevel.n new file mode 100644 index 0000000..ee8f94e --- /dev/null +++ b/doc/toplevel.n @@ -0,0 +1,124 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH toplevel n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +toplevel \- Create and manipulate toplevel widgets +.SH SYNOPSIS +\fBtoplevel\fI \fIpathName \fR?\fIoptions\fR? +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +\fBattributes\fR \fBborder\fR \fBforeground\fR \fBtakefocus\fR +\fBbackground\fR +.fi +.LP +See the ``options'' manual entry for details on the standard options. +.SH "WIDGET-SPECIFIC OPTIONS" +.ta 4c +.LP +.nf +Name: \fBclass\fR +Class: \fBClass\fR +Command-Line Switch: \fB\-class\fR +.fi +.IP +Specifies a class for the window. +This class will be used when querying the option database for +the window's other options, and it will also be used later for +other purposes such as bindings. +The \fBclass\fR option may not be changed with the \fBconfigure\fR +widget command. +.LP +.nf +Name: \fBheight\fR +Class: \fBHeight\fR +Command-Line Switch: \fB\-height\fR +.fi +.IP +Specifies the desired height for the window in screen lines. +If this option is equal to zero then the window will +not request any size at all. +.LP +.nf +Name: \fBwidth\fR +Class: \fBWidth\fR +Command-Line Switch: \fB\-width\fR +.fi +.IP +Specifies the desired width for the window in screen columns. +If this option is equal to zero then the window will +not request any size at all. +.BE + +.SH DESCRIPTION +.PP +The \fBtoplevel\fR command creates a new toplevel widget (given +by the \fIpathName\fR argument). Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the toplevel such as its background color +and relief. The \fBtoplevel\fR command returns the +path name of the new window. +.PP +A toplevel is similar to a frame except that it is created as a +top-level window: its parent with respect to screen real estate +is the terminal's screen rather than the logical parent from its +path name. The primary +purpose of a toplevel is to serve as a container for dialog boxes +and other collections of widgets. The only visible features +of a toplevel are its background color, attributes and border. + +.SH "WIDGET COMMAND" +.PP +The \fBtoplevel\fR command creates a new Tcl command whose +name is the same as the path name of the toplevel's window. This +command may be used to invoke various +operations on the widget. It has the following general form: +.DS C +\fIpathName option \fR?\fIarg arg ...\fR? +.DE +\fIPathName\fR is the name of the command, which is the same as +the toplevel widget's path name. \fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for toplevel widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBtoplevel\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR. If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBtoplevel\fR +command. + +.SH PLACEMENT +The only means to place a toplevel widget on the screen is the +\fBplace\fR geometry manager. + +.SH BINDINGS +.PP +When a new toplevel is created, it has no default event bindings: +toplevels are not intended to be interactive. + +.SH KEYWORDS +toplevel, widget, place diff --git a/doc/update.n b/doc/update.n new file mode 100644 index 0000000..c705e01 --- /dev/null +++ b/doc/update.n @@ -0,0 +1,57 @@ +'\" +'\" Copyright (c) 1990-1992 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH update n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +update \- Process pending events and/or when-idle handlers +.SH SYNOPSIS +\fBupdate\fR ?\fBidletasks|screen\fR? +.BE + +.SH DESCRIPTION +.PP +This command is used to bring the entire application world +``up to date.'' +It flushes all pending output to the display, waits for the +server to process that output and return errors or events, +handles all pending events of any sort (including when-idle handlers), +and repeats this set of operations until there are no pending +events, no pending when-idle handlers, no pending output to the server, +and no operations still outstanding at the server. +.PP +If the \fBidletasks\fR keyword is specified as an argument to the +command, then no new events or errors are processed; only when-idle +idlers are invoked. +This causes operations that are normally deferred, such as display +updates and window layout calculations, to be performed immediately. +.PP +The \fBupdate idletasks\fR command is useful in scripts where +changes have been made to the application's state and you want those +changes to appear on the display immediately, rather than waiting +for the script to complete. Most display updates are performed as +idle handlers, so \fBupdate idletasks\fR will cause them to run. +However, there are some kinds of updates that only happen in +response to events, such as those triggered by window size changes; +these updates will not occur in \fBupdate idletasks\fR. +.PP +If the \fBscreen\fR keyword is specified as an argument to the command, +then the entire screen is repainted from scratch without handling any other +events. This is useful if the terminal's screen has been garbled by +another process. +.PP +The \fBupdate\fR command with no options is useful in scripts where +you are performing a long-running computation but you still want +the application to respond to user interactions; if you occasionally +call \fBupdate\fR then user input will be processed during the +next call to \fBupdate\fR. + +.SH KEYWORDS +event, flush, handler, idle, update diff --git a/doc/winfo.n b/doc/winfo.n new file mode 100644 index 0000000..4493652 --- /dev/null +++ b/doc/winfo.n @@ -0,0 +1,144 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1995 Sun Microsystems, Inc. +'\" Copyright (c) 1996-1999 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH winfo n 8.0 Ck "Ck Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +winfo \- Return window-related information +.SH SYNOPSIS +\fBwinfo\fR \fIoption \fR?\fIarg arg ...\fR? +.BE + +.SH DESCRIPTION +.PP +The \fBwinfo\fR command is used to retrieve information about windows +managed by Ck. It can take any of a number of different forms, +depending on the \fIoption\fR argument. The legal forms are: +.TP +\fBwinfo children \fIwindow\fR +Returns a list containing the path names of all the children +of \fIwindow\fR. Top-level windows are returned as children +of their logical parents. +.TP +\fBwinfo class \fIwindow\fR +Returns the class name for \fIwindow\fR. +.TP +\fBwinfo containing \fIrootX rootY\fR +Returns the path name for the window containing the point given +by \fIrootX\fR and \fIrootY\fR. +\fIRootX\fR and \fIrootY\fR are specified as cursor position +in the coordinate system of the terminal. +If no window in this application contains the point then an empty +string is returned. +In selecting the containing window, children are given higher priority +than parents and among siblings the highest one in the stacking order is +chosen. +.TP +\fBwinfo depth \fIwindow\fR +Returns a decimal string giving the depth of \fIwindow\fR. 1 means the +terminal's screen is monochrome. Any number higher than 1 means that +the terminal supports colors. +.TP +\fBwinfo exists \fIwindow\fR +Returns 1 if there exists a window named \fIwindow\fR, 0 if no such +window exists. +.TP +\fBwinfo geometry \fIwindow\fR +Returns the geometry for \fIwindow\fR, in the form +\fIwidth\fBx\fIheight\fB+\fIx\fB+\fIy\fR. All dimensions are +in terminal coordinates. +.TP +\fBwinfo height \fIwindow\fR +Returns a decimal string giving \fIwindow\fR's height in terminal lines. +When a window is first created its height will be 1; the +height will eventually be changed by a geometry manager to fulfill +the window's needs. +If you need the true height immediately after creating a widget, +invoke \fBupdate\fR to force the geometry manager to arrange it, +or use \fBwinfo reqheight\fR to get the window's requested height +instead of its actual height. +.TP +\fBwinfo ismapped \fIwindow\fR +Returns \fB1\fR if \fIwindow\fR is currently mapped, \fB0\fR otherwise. +.TP +\fBwinfo manager \fIwindow\fR +Returns the name of the geometry manager currently +responsible for \fIwindow\fR, or an empty string if \fIwindow\fR +isn't managed by any geometry manager. +The name is usually the name of the Tcl command for the geometry +manager, such as \fBpack\fR or \fBplace\fR. +.TP +\fBwinfo name \fIwindow\fR +Returns \fIwindow\fR's name (i.e. its name within its parent, as opposed +to its full path name). +The command \fBwinfo name .\fR will return the name of the application. +.TP +\fBwinfo parent \fIwindow\fR +Returns the path name of \fIwindow\fR's parent, or an empty string +if \fIwindow\fR is the main window of the application. +.TP +\fBwinfo reqheight \fIwindow\fR +Returns a decimal string giving \fIwindow\fR's requested height, +in lines. This is the value used by \fIwindow\fR's geometry +manager to compute its geometry. +.TP +\fBwinfo reqwidth \fIwindow\fR +Returns a decimal string giving \fIwindow\fR's requested width, +in columns. This is the value used by \fIwindow\fR's geometry +manager to compute its geometry. +.TP +\fBwinfo rootx \fIwindow\fR +Returns a decimal string giving the x-coordinate, in the root +window of the screen, of the +upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it +has no border). +.TP +\fBwinfo rooty \fIwindow\fR +Returns a decimal string giving the y-coordinate, in the root +window of the screen, of the +upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it +has no border). +.TP +\fBwinfo screenheight \fIwindow\fR +Returns a decimal string giving the height of \fIwindow\fR's terminal +screen, in lines. +.TP +\fBwinfo screenwidth \fIwindow\fR +Returns a decimal string giving the width of \fIwindow\fR's terminal screen, +in columns. +.TP +\fBwinfo toplevel \fIwindow\fR +Returns the path name of the top-level window containing \fIwindow\fR. +.TP +\fBwinfo width \fIwindow\fR +Returns a decimal string giving \fIwindow\fR's width in columns. +When a window is first created its width will be 1; the +width will eventually be changed by a geometry manager to fulfill +the window's needs. +If you need the true width immediately after creating a widget, +invoke \fBupdate\fR to force the geometry manager to arrange it, +or use \fBwinfo reqwidth\fR to get the window's requested width +instead of its actual width. +.TP +\fBwinfo x \fIwindow\fR +Returns a decimal string giving the x-coordinate, in \fIwindow\fR's +parent, of the +upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it +has no border). +.TP +\fBwinfo y \fIwindow\fR +Returns a decimal string giving the y-coordinate, in \fIwindow\fR's +parent, of the +upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it +has no border). + +.SH KEYWORDS +children, class, geometry, height, identifier, information, +mapped, parent, path name, screen, terminal, width, window diff --git a/install-man b/install-man new file mode 100644 index 0000000..e69de29 diff --git a/install-sh b/install-sh new file mode 100755 index 0000000..0ff4b6a --- /dev/null +++ b/install-sh @@ -0,0 +1,119 @@ +#!/bin/sh + +# +# install - install a program, script, or datafile +# This comes from X11R5; it is not part of GNU. +# +# $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $ +# +# This script is compatible with the BSD install script, but was written +# from scratch. +# + + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit="${DOITPROG-}" + + +# put in absolute paths if you don't have them in your path; or use env. vars. + +mvprog="${MVPROG-mv}" +cpprog="${CPPROG-cp}" +chmodprog="${CHMODPROG-chmod}" +chownprog="${CHOWNPROG-chown}" +chgrpprog="${CHGRPPROG-chgrp}" +stripprog="${STRIPPROG-strip}" +rmprog="${RMPROG-rm}" + +instcmd="$mvprog" +chmodcmd="" +chowncmd="" +chgrpcmd="" +stripcmd="" +rmcmd="$rmprog -f" +mvcmd="$mvprog" +src="" +dst="" + +while [ x"$1" != x ]; do + case $1 in + -c) instcmd="$cpprog" + shift + continue;; + + -m) chmodcmd="$chmodprog $2" + shift + shift + continue;; + + -o) chowncmd="$chownprog $2" + shift + shift + continue;; + + -g) chgrpcmd="$chgrpprog $2" + shift + shift + continue;; + + -s) stripcmd="$stripprog" + shift + continue;; + + *) if [ x"$src" = x ] + then + src=$1 + else + dst=$1 + fi + shift + continue;; + esac +done + +if [ x"$src" = x ] +then + echo "install: no input file specified" + exit 1 +fi + +if [ x"$dst" = x ] +then + echo "install: no destination specified" + exit 1 +fi + + +# If destination is a directory, append the input filename; if your system +# does not like double slashes in filenames, you may need to add some logic + +if [ -d $dst ] +then + dst="$dst"/`basename $src` +fi + +# Make a temp file name in the proper directory. + +dstdir=`dirname $dst` +dsttmp=$dstdir/#inst.$$# + +# Move or copy the file name to the temp name + +$doit $instcmd $src $dsttmp + +# and set any options; do chmod last to preserve setuid bits + +if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi +if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi +if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi +if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi + +# Now rename the file to the real destination. + +$doit $rmcmd $dst +$doit $mvcmd $dsttmp $dst + + +exit 0 diff --git a/ks_names.h b/ks_names.h new file mode 100644 index 0000000..c3f5da7 --- /dev/null +++ b/ks_names.h @@ -0,0 +1,247 @@ +/* + * ks_names.h -- + * + * Key symbols, associated values and terminfo names. + * + * Copyright (c) 1995 Christian Werner. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifdef KEY_BACKSPACE +{ "BackSpace", KEY_BACKSPACE, "kbs" }, +#else +{ "BackSpace", 0x008, NULL }, +#endif +#ifdef KEY_DC +{ "Delete", KEY_DC, "kdch1" }, +#else +{ "Delete", 0x07f, NULL }, +#endif +{ "Tab", 0x009, NULL }, +{ "Linefeed", 0x00a, NULL }, +{ "Return", 0x00d, NULL }, +{ "Escape", 0x01b, NULL }, +{ "ASCIIDelete", 0x07f, NULL }, +#ifdef KEY_HOME +{ "Home", KEY_HOME, "khome" }, +#endif +#ifdef KEY_LEFT +{ "Left", KEY_LEFT, "kcub1" }, +#endif +#ifdef KEY_UP +{ "Up", KEY_UP, "kcuu1" }, +#endif +#ifdef KEY_RIGHT +{ "Right", KEY_RIGHT, "kcuf1" }, +#endif +#ifdef KEY_DOWN +{ "Down", KEY_DOWN, "kcud1" }, +#endif +#ifdef KEY_PPAGE +{ "Prior", KEY_PPAGE, "kpp" }, +#endif +#ifdef KEY_NPAGE +{ "Next", KEY_NPAGE, "knp" }, +#endif +#ifdef KEY_END +{ "End", KEY_END, "kend" }, +#endif +#ifdef KEY_BEG +{ "Begin", KEY_BEG, "kbeg" }, +#endif +#ifdef KEY_SELECT +{ "Select", KEY_SELECT, "kslt" }, +#endif +#ifdef KEY_PRINT +{ "Print", KEY_PRINT, "kprt" }, +#endif +#ifdef KEY_COMMAND +{ "Execute", KEY_COMMAND, "kcmd" }, +#endif +#ifdef KEY_IC +{ "Insert", KEY_IC, "kich1" }, +#endif +#ifdef KEY_UNDO +{ "Undo", KEY_UNDO, "kund" }, +#endif +#ifdef KEY_REDO +{ "Redo", KEY_REDO, "krdo" }, +#endif +#ifdef KEY_OPTIONS +{ "Menu", KEY_OPTIONS, "kopt" }, +#endif +#ifdef KEY_REFERENCE +{ "Find", KEY_REFERENCE, "kref" }, +#endif +#ifdef KEY_BTAB +{ "BackTab", KEY_BTAB, "kcbt" }, +#endif +#ifdef KEY_CANCEL +{ "Cancel", KEY_CANCEL, "kcan" }, +#endif +#ifdef KEY_HELP +{ "Help", KEY_HELP, "khlp" }, +#endif +#ifdef KEY_F +{ "F1", KEY_F(1), "kf1" }, +{ "F2", KEY_F(2), "kf2" }, +{ "F3", KEY_F(3), "kf3" }, +{ "F4", KEY_F(4), "kf4" }, +{ "F5", KEY_F(5), "kf5" }, +{ "F6", KEY_F(6), "kf6" }, +{ "F7", KEY_F(7), "kf7" }, +{ "F8", KEY_F(8), "kf8" }, +{ "F9", KEY_F(9), "kf9" }, +{ "F10", KEY_F(10), "kf10" }, +{ "L1", KEY_F(11), "kf11" }, +{ "F11", KEY_F(11), "kf11" }, +{ "L2", KEY_F(12), "kf12" }, +{ "F12", KEY_F(12), "kf12" }, +{ "L3", KEY_F(13), "kf13" }, +{ "F13", KEY_F(13), "kf13" }, +{ "L4", KEY_F(14), "kf14" }, +{ "F14", KEY_F(14), "kf14" }, +{ "L5", KEY_F(15), "kf15" }, +{ "F15", KEY_F(15), "kf15" }, +{ "L6", KEY_F(16), "kf16" }, +{ "F16", KEY_F(16), "kf16" }, +{ "L7", KEY_F(17), "kf17" }, +{ "F17", KEY_F(17), "kf17" }, +{ "L8", KEY_F(18), "kf18" }, +{ "F18", KEY_F(18), "kf18" }, +{ "L9", KEY_F(19), "kf19" }, +{ "F19", KEY_F(19), "kf19" }, +{ "L10", KEY_F(20), "kf20" }, +{ "F20", KEY_F(20), "kf20" }, +{ "R1", KEY_F(21), "kf21" }, +{ "F21", KEY_F(21), "kf21" }, +{ "R2", KEY_F(22), "kf22" }, +{ "F22", KEY_F(22), "kf22" }, +{ "R3", KEY_F(23), "kf23" }, +{ "F23", KEY_F(23), "kf23" }, +{ "R4", KEY_F(24), "kf24" }, +{ "F24", KEY_F(24), "kf24" }, +{ "R5", KEY_F(25), "kf25" }, +{ "F25", KEY_F(25), "kf25" }, +{ "R6", KEY_F(26), "kf26" }, +{ "F26", KEY_F(26), "kf26" }, +{ "R7", KEY_F(27), "kf27" }, +{ "F27", KEY_F(27), "kf27" }, +{ "R8", KEY_F(28), "kf28" }, +{ "F28", KEY_F(28), "kf28" }, +{ "R9", KEY_F(29), "kf29" }, +{ "F29", KEY_F(29), "kf29" }, +{ "R10", KEY_F(30), "kf30" }, +{ "F30", KEY_F(30), "kf30" }, +{ "R11", KEY_F(31), "kf31" }, +{ "F31", KEY_F(31), "kf31" }, +{ "R12", KEY_F(32), "kf32" }, +{ "F32", KEY_F(32), "kf32" }, +{ "R13", KEY_F(33), "kf33" }, +{ "F33", KEY_F(33), "kf33" }, +{ "R14", KEY_F(34), "kf34" }, +{ "F34", KEY_F(34), "kf34" }, +{ "R15", KEY_F(35), "kf35" }, +{ "F35", KEY_F(35), "kf35" }, +#endif +#ifdef KEY_SUSPEND +{ "Suspend", KEY_SUSPEND, "kspd" }, +#endif +{ "space", 0x020, NULL }, +{ "exclam", 0x021, NULL }, +{ "quotedbl", 0x022, NULL }, +{ "numbersign", 0x023, NULL }, +{ "dollar", 0x024, NULL }, +{ "percent", 0x025, NULL }, +{ "ampersand", 0x026, NULL }, +{ "quoteright", 0x027, NULL }, +{ "parenleft", 0x028, NULL }, +{ "parenright", 0x029, NULL }, +{ "asterisk", 0x02a, NULL }, +{ "plus", 0x02b, NULL }, +{ "comma", 0x02c, NULL }, +{ "minus", 0x02d, NULL }, +{ "period", 0x02e, NULL }, +{ "slash", 0x02f, NULL }, +{ "0", 0x030, NULL }, +{ "1", 0x031, NULL }, +{ "2", 0x032, NULL }, +{ "3", 0x033, NULL }, +{ "4", 0x034, NULL }, +{ "5", 0x035, NULL }, +{ "6", 0x036, NULL }, +{ "7", 0x037, NULL }, +{ "8", 0x038, NULL }, +{ "9", 0x039, NULL }, +{ "colon", 0x03a, NULL }, +{ "semicolon", 0x03b, NULL }, +{ "less", 0x03c, NULL }, +{ "equal", 0x03d, NULL }, +{ "greater", 0x03e, NULL }, +{ "question", 0x03f, NULL }, +{ "at", 0x040, NULL }, +{ "A", 0x041, NULL }, +{ "B", 0x042, NULL }, +{ "C", 0x043, NULL }, +{ "D", 0x044, NULL }, +{ "E", 0x045, NULL }, +{ "F", 0x046, NULL }, +{ "G", 0x047, NULL }, +{ "H", 0x048, NULL }, +{ "I", 0x049, NULL }, +{ "J", 0x04a, NULL }, +{ "K", 0x04b, NULL }, +{ "L", 0x04c, NULL }, +{ "M", 0x04d, NULL }, +{ "N", 0x04e, NULL }, +{ "O", 0x04f, NULL }, +{ "P", 0x050, NULL }, +{ "Q", 0x051, NULL }, +{ "R", 0x052, NULL }, +{ "S", 0x053, NULL }, +{ "T", 0x054, NULL }, +{ "U", 0x055, NULL }, +{ "V", 0x056, NULL }, +{ "W", 0x057, NULL }, +{ "X", 0x058, NULL }, +{ "Y", 0x059, NULL }, +{ "Z", 0x05a, NULL }, +{ "bracketleft", 0x05b, NULL }, +{ "backslash", 0x05c, NULL }, +{ "bracketright", 0x05d, NULL }, +{ "asciicircum", 0x05e, NULL }, +{ "underscore", 0x05f, NULL }, +{ "quoteleft", 0x060, NULL }, +{ "a", 0x061, NULL }, +{ "b", 0x062, NULL }, +{ "c", 0x063, NULL }, +{ "d", 0x064, NULL }, +{ "e", 0x065, NULL }, +{ "f", 0x066, NULL }, +{ "g", 0x067, NULL }, +{ "h", 0x068, NULL }, +{ "i", 0x069, NULL }, +{ "j", 0x06a, NULL }, +{ "k", 0x06b, NULL }, +{ "l", 0x06c, NULL }, +{ "m", 0x06d, NULL }, +{ "n", 0x06e, NULL }, +{ "o", 0x06f, NULL }, +{ "p", 0x070, NULL }, +{ "q", 0x071, NULL }, +{ "r", 0x072, NULL }, +{ "s", 0x073, NULL }, +{ "t", 0x074, NULL }, +{ "u", 0x075, NULL }, +{ "v", 0x076, NULL }, +{ "w", 0x077, NULL }, +{ "x", 0x078, NULL }, +{ "y", 0x079, NULL }, +{ "z", 0x07a, NULL }, +{ "braceleft", 0x07b, NULL }, +{ "bar", 0x07c, NULL }, +{ "braceright", 0x07d, NULL }, +{ "asciitilde", 0x07e, NULL }, + diff --git a/library/bgerror.tcl b/library/bgerror.tcl new file mode 100644 index 0000000..cba309d --- /dev/null +++ b/library/bgerror.tcl @@ -0,0 +1,69 @@ +# tkerror.tcl -- +# +# This file contains a default version of the tkError procedure. It +# posts a dialog box with the error message and gives the user a chance +# to see a more detailed stack trace. +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1995 Sun Microsystems, Inc. +# Copyright (c) 1999 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {[winfo depth .] > 1} { + option add *ckerrorDialog*background red + option add *ErrorTrace*background red +} + +# Fake the auto_mkindex procedure for Tcl 7.4 \ +proc tkerror err {} + +# Fake the auto_mkindex procedure for Tcl 7.5 and above \ +proc bgerror err {} + +# tkerror -- +# This is the default version of tkerror. It posts a dialog box containing +# the error message and gives the user a chance to ask to see a stack +# trace. +# +# Arguments: +# err - The error message. + +if {$tcl_version > 7.4} { + set ckPriv(bgErrProc) bgerror +} else { + set ckPriv(bgErrProc) tkerror +} + proc $ckPriv(bgErrProc) err { + global errorInfo + set info $errorInfo + set button [ck_dialog .ckerrorDialog "Error in Tcl Script" \ + "Error: $err" Okay Skip Trace] + if {$button == 0} { + return + } elseif {$button == 1} { + return -code break + } + set w .ckerrorTrace + catch {destroy $w} + toplevel $w -class ErrorTrace \ + -border { ulcorner hline urcorner vline lrcorner hline llcorner vline } + place $w -relx 0.5 -rely 0.5 -anchor center + label $w.title -text "Stack Trace for Error" + place $w.title -y 0 -relx 0.5 -anchor center -bordermode ignore + button $w.ok -text OK -command "destroy $w" + scrollbar $w.scroll -command "$w.text yview" -takefocus 0 + text $w.text -yscrollcommand "$w.scroll set" + frame $w.sep -border hline + pack $w.ok -side bottom -ipadx 1 + pack $w.sep -side bottom -fill x + pack $w.scroll -side right -fill y + pack $w.text -side left -expand 1 -fill both + $w.text insert 0.0 $info + $w.text mark set insert 0.0 + bind $w.text {focus [ck_focusNext %W] ; break} + focus $w.ok + tkwait window $w +} + diff --git a/library/button.tcl b/library/button.tcl new file mode 100644 index 0000000..9e0b207 --- /dev/null +++ b/library/button.tcl @@ -0,0 +1,75 @@ +# button.tcl -- +# +# This file defines the default bindings for Ck label, button, +# checkbutton, and radiobutton widgets and provides procedures +# that help in implementing those bindings. +# +# Copyright (c) 1992-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. +# + +set ckPriv(buttonWindow) "" + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for buttons. +#------------------------------------------------------------------------- + +bind Button {ckButtonFocus %W 1} +bind Button {ckButtonFocus %W 0} +bind Button {ckButtonInvoke %W} +bind Button {ckButtonInvoke %W} +bind Button {ckButtonInvoke %W} +bind Button {ckButtonInvoke %W} + +bind Checkbutton {ckButtonFocus %W 1} +bind Checkbutton {ckButtonFocus %W 0} +bind Checkbutton {ckButtonInvoke %W} +bind Checkbutton {ckButtonInvoke %W} +bind Checkbutton {ckButtonInvoke %W} +bind Checkbutton {ckButtonInvoke %W} + +bind Radiobutton {ckButtonFocus %W 1} +bind Radiobutton {ckButtonFocus %W 0} +bind Radiobutton {ckButtonInvoke %W} +bind Radiobutton {ckButtonInvoke %W} +bind Radiobutton {ckButtonInvoke %W} +bind Radiobutton {ckButtonInvoke %W} + +# ckButtonFocus -- +# The procedure below is called when a button is invoked through +# the keyboard. +# +# Arguments: +# w - The name of the widget. + +proc ckButtonFocus {w flag} { + global ckPriv + if {[$w cget -state] == "disabled"} return + if {$flag} { + set ckPriv(buttonWindow) $w + set ckPriv(buttonState) [$w cget -state] + $w configure -state active + return + } + if {$w == $ckPriv(buttonWindow)} { + set ckPriv(buttonWindow) "" + $w configure -state $ckPriv(buttonState) + set ckPriv(buttonState) "" + } +} + +# ckButtonInvoke -- +# The procedure below is called when a button is invoked through +# the keyboard. +# +# Arguments: +# w - The name of the widget. + +proc ckButtonInvoke w { + if {[$w cget -state] != "disabled"} { + uplevel #0 [list $w invoke] + } +} diff --git a/library/ck.tcl b/library/ck.tcl new file mode 100644 index 0000000..bdcaf77 --- /dev/null +++ b/library/ck.tcl @@ -0,0 +1,73 @@ +# ck.tcl -- +# +# Initialization script normally executed in the interpreter for each +# curses wish-based application. Arranges class bindings for widgets. +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1995 Sun Microsystems, Inc. +# Copyright (c) 1995-2000 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# Insist on running with compatible versions of Tcl and Ck. + +scan [info tclversion] "%d.%d" a b +scan $ck_version "%d.%d" c d +if {$a == 7} { + if {$c != 4} { + error "wrong version of Ck loaded ($c.$d): need 4.X" + } + if {$b != $d+4 } { + error "wrong version of Ck loaded ($c.$d): need 4.[expr $b-4]" + } +} elseif {$a == 8} { + if {$c != 8} { + error "wrong version of Ck loaded ($c.$d): need 8.X" + } + if {$d != $b} { + error "wrong version of Ck loaded ($c.$d): need 8.$b" + } +} + +unset a b c d + +if {[string compare $tcl_platform(platform) windows] == 0 } { + curses encoding IBM437 + set env(TERM) win32 +} elseif {[string compare $tcl_platform(platform) dos]==0} { + curses encoding IBM437 +} + +# Inhibit exec of unknown commands + +set auto_noexec 1 + +# Add this directory to the begin of the auto-load search path: + +if {[info exists auto_path]} { + set auto_path [concat $ck_library $auto_path] +} + +# ---------------------------------------------------------------------- +# Read in files that define all of the class bindings. +# ---------------------------------------------------------------------- + +source $ck_library/button.tcl +source $ck_library/entry.tcl +source $ck_library/listbox.tcl +source $ck_library/scrollbar.tcl +source $ck_library/text.tcl +source $ck_library/menu.tcl + +# ---------------------------------------------------------------------- +# Default bindings for keyboard traversal. +# ---------------------------------------------------------------------- + +bind all {focus [ck_focusNext %W]} +bind all {focus [ck_focusPrev %W]} +if {$tcl_interactive} { + bind all ckCommand + ckCommand +} + diff --git a/library/ckfbox.tcl b/library/ckfbox.tcl new file mode 100644 index 0000000..bd8a564 --- /dev/null +++ b/library/ckfbox.tcl @@ -0,0 +1,691 @@ +# ckfbox.tcl -- +# +# Implements the "CK" standard file selection dialog box. +# +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1999-2000 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +proc ck_getOpenFile args { + eval ckFDialog open $args +} + +proc ck_getSaveFile args { + eval ckFDialog save $args +} + +# ckFDialog -- +# +# Implements the file selection dialog. + +proc ckFDialog {type args} { + global ckPriv + set w __ck_filedialog + upvar #0 $w data + ckFDialog_Config $w $type $args + if {![string compare $data(-parent) .]} { + set w .$w + } else { + set w $data(-parent).$w + } + # (re)create the dialog box if necessary + if {![winfo exists $w]} { + ckFDialog_Create $w + } elseif {[string compare [winfo class $w] CkFDialog]} { + destroy $w + ckFDialog_Create $w + } else { + set data(dirMenuBtn) $w.f1.menu + set data(dirMenu) $w.f1.menu.menu + set data(upBtn) $w.f1.up + set data(list) $w.list + set data(ent) $w.f2.ent + set data(typeMenuLab) $w.f3.lab + set data(typeMenuBtn) $w.f3.menu + set data(typeMenu) $data(typeMenuBtn).m + set data(okBtn) $w.f2.ok + set data(cancelBtn) $w.f3.cancel + } + # Initialize the file types menu + if {$data(-filetypes) != {}} { + $data(typeMenu) delete 0 end + foreach type $data(-filetypes) { + set title [lindex $type 0] + set filter [lindex $type 1] + $data(typeMenu) add command -label $title \ + -command [list ckFDialog_SetFilter $w $type] + } + ckFDialog_SetFilter $w [lindex $data(-filetypes) 0] + $data(typeMenuBtn) config -state normal -takefocus 1 + $data(typeMenuLab) config -state normal + } else { + set data(filter) "*" + $data(typeMenuBtn) config -state disabled -takefocus 0 + $data(typeMenuLab) config -state disabled + } + ckFDialog_UpdateWhenIdle $w + place forget $w + place $w -relx 0.5 -rely 0.5 -anchor center + set oldFocus [focus] + focus $data(ent) + $data(ent) delete 0 end + $data(ent) insert 0 $data(selectFile) + $data(ent) select from 0 + $data(ent) select to end + $data(ent) icursor end + tkwait variable ckPriv(selectFilePath) + catch {focus $oldFocus} + destroy $w + return $ckPriv(selectFilePath) +} + +# ckFDialog_Config -- +# +# Configures the filedialog according to the argument list +# +proc ckFDialog_Config {w type argList} { + upvar #0 $w data + set data(type) $type + # 1. the configuration specs + set specs { + {-defaultextension "" "" ""} + {-filetypes "" "" ""} + {-initialdir "" "" ""} + {-initialfile "" "" ""} + {-parent "" "" "."} + {-title "" "" ""} + } + # 2. default values depending on the type of the dialog + if {![info exists data(selectPath)]} { + # first time the dialog has been popped up + set data(selectPath) [pwd] + set data(selectFile) "" + } + # 3. parse the arguments + tclParseConfigSpec $w $specs "" $argList + if {![string compare $data(-title) ""]} { + if {![string compare $type "open"]} { + set data(-title) "Open" + } else { + set data(-title) "Save As" + } + } + # 4. set the default directory and selection according to the -initial + # settings + if {[string compare $data(-initialdir) ""]} { + if {[file isdirectory $data(-initialdir)]} { + set data(selectPath) [glob $data(-initialdir)] + } else { + set data(selectPath) [pwd] + } + # Convert the initialdir to an absolute path name. + set old [pwd] + cd $data(selectPath) + set data(selectPath) [pwd] + cd $old + } + set data(selectFile) $data(-initialfile) + # 5. Parse the -filetypes option + set data(-filetypes) [ckFDGetFileTypes $data(-filetypes)] + if {![winfo exists $data(-parent)]} { + error "bad window path name \"$data(-parent)\"" + } +} + +proc ckFDialog_Create {w} { + set dataName [lindex [split $w .] end] + upvar #0 $dataName data + toplevel $w -class CkFDialog -border { + ulcorner hline urcorner vline lrcorner hline llcorner vline + } + # f1: the frame with the directory option menu + set f1 [frame $w.f1 -class Dir] + label $f1.lab -text "Directory:" -underline 0 + set data(dirMenuBtn) $f1.menu + set data(dirMenu) [ck_optionMenu $f1.menu [format %s(selectPath) $dataName] ""] + set data(upBtn) [button $f1.up -text Up -width 4 -underline 0] + pack $data(upBtn) -side right -padx 1 -fill both + pack $f1.lab -side left -padx 4 -fill both + pack $f1.menu -expand yes -fill both -padx 1 + frame $w.sep0 -border hline -height 1 + set data(list) [listbox $w.list -selectmode browse -height 8] + bindtags $data(list) [list Listbox $data(list) $w all] + bind $data(list) [list ckFDialog_ListBrowse $w] + bind $data(list) [list ckFDialog_ListBrowse $w] + bind $data(list) [list ckFDialog_ListBrowse $w] + bind $data(list) [list ckFDialog_ListInvoke $w] + bind $data(list) [list ckFDialog_ListInvoke $w] + frame $w.sep1 -border hline -height 1 + # f2: the frame with the OK button and the "file name" field + set f2 [frame $w.f2 -class Filename] + label $f2.lab -text "File name:" -anchor e -width 14 -underline 5 + set data(ent) [entry $f2.ent] + # f3: the frame with the cancel button and the file types field + set f3 [frame $w.f3 -class Filetype] + # The "File of types:" label needs to be grayed-out when + # -filetypes are not specified. The label widget does not support + # grayed-out text on monochrome displays. Therefore, we have to + # use a button widget to emulate a label widget (by setting its + # bindtags) + set data(typeMenuLab) [button $f3.lab -text "Files of type:" \ + -anchor e -width 14 -underline 9 -takefocus 0] + bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \ + [winfo toplevel $data(typeMenuLab)] all] + set data(typeMenuBtn) [menubutton $f3.menu -menu $f3.menu.m] + $f3.menu config -takefocus 1 \ + -disabledbackground [$f3.menu cget -background] \ + -disabledforeground [$f3.menu cget -foreground] + bind $f3.menu { + if {[%W cget -state] != "disabled"} { + %W configure -state active + } + } + bind $f3.menu { + if {[%W cget -state] != "disabled"} { + %W configure -state normal + } + } + set data(typeMenu) [menu $data(typeMenuBtn).m -border { + + ulcorner hline urcorner vline lrcorner hline llcorner vline}] + $data(typeMenuBtn) config -takefocus 1 -anchor w + # the okBtn is created after the typeMenu so that the keyboard traversal + # is in the right order + set data(okBtn) [button $f2.ok -text OK -underline 0 -width 6] + set data(cancelBtn) [button $f3.cancel -text Cancel -underline 0 -width 6] + # pack the widgets in f2 and f3 + pack $data(okBtn) -side right -padx 1 -anchor e + pack $f2.lab -side left -padx 1 + pack $f2.ent -expand 1 -fill x + pack $data(cancelBtn) -side right -padx 1 -anchor w + pack $data(typeMenuLab) -side left -padx 1 + pack $data(typeMenuBtn) -expand 1 -fill x -side right + # Pack all the frames together. We are done with widget construction. + pack $f1 -side top -fill x + pack $w.sep0 -side top -fill x + pack $f3 -side bottom -fill x + pack $f2 -side bottom -fill x + pack $w.sep1 -side bottom -fill x + pack $data(list) -expand 1 -fill both -padx 1 + # Set up the event handlers + bind $data(ent) "ckFDialog_ActivateEnt $w" + bind $data(ent) "ckFDialog_ActivateEnt $w" + $data(upBtn) config -command "ckFDialog_UpDirCmd $w" + $data(okBtn) config -command "ckFDialog_OkCmd $w" + $data(cancelBtn) config -command "ckFDialog_CancelCmd $w" + trace variable data(selectPath) w "ckFDialog_SetPath $w" + bind $w "focus $data(dirMenuBtn) ; break" + bind $w [format { + if {"[%s cget -state]" == "normal"} { + focus %s + } + } $data(typeMenuBtn) $data(typeMenuBtn)] + bind $w "focus $data(ent) ; break" + bind $w "ckButtonInvoke $data(cancelBtn)" + bind $w "ckButtonInvoke $data(cancelBtn) ; break" + bind $w "ckFDialog_InvokeBtn $w Open ; break" + bind $w "ckFDialog_InvokeBtn $w Save ; break" + bind $w "ckFDialog_UpDirCmd $w ; break" +} + +# ckFDialog_UpdateWhenIdle -- +# +# Creates an idle event handler which updates the dialog in idle +# time. This is important because loading the directory may take a long +# time and we don't want to load the same directory for multiple times +# due to multiple concurrent events. + +proc ckFDialog_UpdateWhenIdle {w} { + upvar #0 [winfo name $w] data + if {[info exists data(updateId)]} { + return + } else { + set data(updateId) [after idle ckFDialog_Update $w] + } +} + +# ckFDialog_Update -- +# +# Loads the files and directories into listbox. Also +# sets up the directory option menu for quick access to parent +# directories. + +proc ckFDialog_Update {w} { + global tcl_version + # This proc may be called within an idle handler. Make sure that the + # window has not been destroyed before this proc is called + if {![winfo exists $w] || [string compare [winfo class $w] CkFDialog]} { + return + } + set dataName [winfo name $w] + upvar #0 $dataName data + global ckPriv + catch {unset data(updateId)} + set appPWD [pwd] + if {[catch { + cd $data(selectPath) + }]} { + # We cannot change directory to $data(selectPath). $data(selectPath) + # should have been checked before ckFDialog_Update is called, so + # we normally won't come to here. Anyways, give an error and abort + # action. + ck_messageBox -type ok -parent $data(-parent) -message \ + "Cannot change to the directory \"$data(selectPath)\".\nPermission denied." + cd $appPWD + return + } + update idletasks + $data(list) delete 0 end + # Make the dir list + if {$tcl_version >= 8.0} { + set sortmode -dictionary + } else { + set sortmode -ascii + } + foreach f [lsort $sortmode [glob -nocomplain .* *]] { + if {![string compare $f .]} { + continue + } + if {![string compare $f ..]} { + continue + } + if {[file isdir ./$f]} { + if {![info exists hasDoneDir($f)]} { + $data(list) insert end [format "(dir) %s" $f] + set hasDoneDir($f) 1 + } + } + } + # Make the file list + # + if {![string compare $data(filter) *]} { + set files [lsort $sortmode \ + [glob -nocomplain .* *]] + } else { + set files [lsort $sortmode \ + [eval glob -nocomplain $data(filter)]] + } + + set top 0 + foreach f $files { + if {![file isdir ./$f]} { + if {![info exists hasDoneFile($f)]} { + $data(list) insert end [format " %s" $f] + set hasDoneFile($f) 1 + } + } + } + $data(list) selection clear 0 end + $data(list) selection set 0 + $data(list) activate 0 + $data(list) yview 0 + # Update the Directory: option menu + set list "" + set dir "" + foreach subdir [file split $data(selectPath)] { + set dir [file join $dir $subdir] + lappend list $dir + } + $data(dirMenu) delete 0 end + set var [format %s(selectPath) $dataName] + foreach path $list { + $data(dirMenu) add command -label $path -command [list set $var $path] + } + # Restore the PWD to the application's PWD + cd $appPWD +} + +# ckFDialog_SetPathSilently -- +# +# Sets data(selectPath) without invoking the trace procedure + +proc ckFDialog_SetPathSilently {w path} { + upvar #0 [winfo name $w] data + trace vdelete data(selectPath) w "ckFDialog_SetPath $w" + set data(selectPath) $path + trace variable data(selectPath) w "ckFDialog_SetPath $w" +} + +# This proc gets called whenever data(selectPath) is set + +proc ckFDialog_SetPath {w name1 name2 op} { + if {[winfo exists $w]} { + upvar #0 [winfo name $w] data + ckFDialog_UpdateWhenIdle $w + } +} + +# This proc gets called whenever data(filter) is set + +proc ckFDialog_SetFilter {w type} { + upvar #0 [winfo name $w] data + set data(filter) [lindex $type 1] + $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 0 + ckFDialog_UpdateWhenIdle $w +} + +# ckFDialogResolveFile -- +# +# Interpret the user's text input in a file selection dialog. +# Performs: +# +# (1) ~ substitution +# (2) resolve all instances of . and .. +# (3) check for non-existent files/directories +# (4) check for chdir permissions +# +# Arguments: +# context: the current directory you are in +# text: the text entered by the user +# defaultext: the default extension to add to files with no extension +# +# Return vaue: +# [list $flag $directory $file] +# +# flag = OK : valid input +# = PATTERN : valid directory/pattern +# = PATH : the directory does not exist +# = FILE : the directory exists by the file doesn't +# exist +# = CHDIR : Cannot change to the directory +# = ERROR : Invalid entry +# +# directory : valid only if flag = OK or PATTERN or FILE +# file : valid only if flag = OK or PATTERN +# +# directory may not be the same as context, because text may contain +# a subdirectory name + +proc ckFDialogResolveFile {context text defaultext} { + set appPWD [pwd] + set path [ckFDialog_JoinFile $context $text] + if {[file ext $path] == ""} { + set path "$path$defaultext" + } + if {[catch {file exists $path}]} { + # This "if" block can be safely removed if the following code + # stop generating errors. + # + # file exists ~nonsuchuser + # + return [list ERROR $path ""] + } + if {[file exists $path]} { + if {[file isdirectory $path]} { + if {[catch { + cd $path + }]} { + return [list CHDIR $path ""] + } + set directory [pwd] + set file "" + set flag OK + cd $appPWD + } else { + if {[catch { + cd [file dirname $path] + }]} { + return [list CHDIR [file dirname $path] ""] + } + set directory [pwd] + set file [file tail $path] + set flag OK + cd $appPWD + } + } else { + set dirname [file dirname $path] + if {[file exists $dirname]} { + if {[catch { + cd $dirname + }]} { + return [list CHDIR $dirname ""] + } + set directory [pwd] + set file [file tail $path] + if {[regexp {[*]|[?]} $file]} { + set flag PATTERN + } else { + set flag FILE + } + cd $appPWD + } else { + set directory $dirname + set file [file tail $path] + set flag PATH + } + } + return [list $flag $directory $file] +} + +# Gets called when the entry box gets keyboard focus. We clear the selection +# from the icon list . This way the user can be certain that the input in the +# entry box is the selection. + +proc ckFDialog_EntFocusIn {w} { + upvar #0 [winfo name $w] data + if {[string compare [$data(ent) get] ""]} { + $data(ent) selection from 0 + $data(ent) selection to end + $data(ent) icursor end + } else { + $data(ent) selection clear + } + $data(list) selection clear 0 end + if {![string compare $data(type) open]} { + $data(okBtn) config -text "Open" + } else { + $data(okBtn) config -text "Save" + } +} + +proc ckFDialog_EntFocusOut {w} { + upvar #0 [winfo name $w] data + $data(ent) selection clear +} + +# Gets called when user presses Return in the "File name" entry. + +proc ckFDialog_ActivateEnt {w} { + upvar #0 [winfo name $w] data + set text [string trim [$data(ent) get]] + set list [ckFDialogResolveFile $data(selectPath) $text \ + $data(-defaultextension)] + set flag [lindex $list 0] + set path [lindex $list 1] + set file [lindex $list 2] + switch -- $flag { + OK { + if {![string compare $file ""]} { + # user has entered an existing (sub)directory + set data(selectPath) $path + $data(ent) delete 0 end + } else { + ckFDialog_SetPathSilently $w $path + set data(selectFile) $file + ckFDialog_Done $w + } + } + PATTERN { + set data(selectPath) $path + set data(filter) $file + } + FILE { + if {![string compare $data(type) open]} { + ck_messageBox -type ok -parent $data(-parent) \ + -message "File \"[file join $path $file]\" does not exist." + $data(ent) select from 0 + $data(ent) select to end + $data(ent) icursor end + } else { + ckFDialog_SetPathSilently $w $path + set data(selectFile) $file + ckFDialog_Done $w + } + } + PATH { + ck_messageBox -type ok -parent $data(-parent) \ + -message "Directory \"$path\" does not exist." + $data(ent) select from 0 + $data(ent) select to end + $data(ent) icursor end + } + CHDIR { + ck_messageBox -type ok -parent $data(-parent) -message \ + "Cannot change to the directory \"$path\".\nPermission denied." + $data(ent) select from 0 + $data(ent) select to end + $data(ent) icursor end + } + ERROR { + ck_messageBox -type ok -parent $data(-parent) -message \ + "Invalid file name \"$path\"." + $data(ent) select from 0 + $data(ent) select to end + $data(ent) icursor end + } + } +} + +# Gets called when user presses the Alt-s or Alt-o keys. + +proc ckFDialog_InvokeBtn {w key} { + upvar #0 [winfo name $w] data + if {![string compare [$data(okBtn) cget -text] $key]} { + ckButtonInvoke $data(okBtn) + } +} + +# Gets called when user presses the "parent directory" button + +proc ckFDialog_UpDirCmd {w} { + upvar #0 [winfo name $w] data + if {[string compare $data(selectPath) "/"]} { + set data(selectPath) [file dirname $data(selectPath)] + } +} + +# Join a file name to a path name. The "file join" command will break +# if the filename begins with ~ + +proc ckFDialog_JoinFile {path file} { + if {[string match {~*} $file] && [file exists $path/$file]} { + return [file join $path ./$file] + } else { + return [file join $path $file] + } +} + +# Gets called when user presses the "OK" button + +proc ckFDialog_OkCmd {w} { + upvar #0 [winfo name $w] data + set text "" + set index [$data(list) curselection] + if {"$index" != ""} { + set text [string range [$data(list) get $index] 6 end] + } + if {[string compare $text ""]} { + set file [ckFDialog_JoinFile $data(selectPath) $text] + if {[file isdirectory $file]} { + ckFDialog_ListInvoke $w $text + return + } + } + ckFDialog_ActivateEnt $w +} + +# Gets called when user presses the "Cancel" button + +proc ckFDialog_CancelCmd {w} { + upvar #0 [winfo name $w] data + global ckPriv + set ckPriv(selectFilePath) "" +} + +# Gets called when user browses the listbox. + +proc ckFDialog_ListBrowse w { + upvar #0 [winfo name $w] data + set index [$data(list) curselection] + set text "" + if {[string length $index]} { + set text [string range [$data(list) get $index] 6 end] + } + if {[string length $text] == 0} { + return + } + set file [ckFDialog_JoinFile $data(selectPath) $text] + if {![file isdirectory $file]} { + $data(ent) delete 0 end + $data(ent) insert 0 $text + if {![string compare $data(type) open]} { + $data(okBtn) config -text "Open" + } else { + $data(okBtn) config -text "Save" + } + } else { + $data(okBtn) config -text "Open" + } +} + +# Gets called when user invokes the lisbox. + +proc ckFDialog_ListInvoke {w {text {}}} { + upvar #0 [winfo name $w] data + if {[string length $text] == 0} { + set index [$data(list) curselection] + if {[string length $index]} { + set text [string range [$data(list) get $index] 6 end] + } + } + if {[string length $text] == 0} { + return + } + set file [ckFDialog_JoinFile $data(selectPath) $text] + if {[file isdirectory $file]} { + set appPWD [pwd] + if {[catch {cd $file}]} { + ck_messageBox -type ok -parent $data(-parent) -message \ + "Cannot change to the directory \"$file\".\nPermission denied." + } else { + cd $appPWD + set data(selectPath) $file + } + } else { + set data(selectFile) $file + ckFDialog_Done $w + } +} + +# ckFDialog_Done -- +# +# Gets called when user has input a valid filename. Pops up a +# dialog box to confirm selection when necessary. Sets the +# ckPriv(selectFilePath) variable, which will break the "tkwait" +# loop in ckFDialog and return the selected filename to the +# script that calls ck_getOpenFile or ck_getSaveFile + +proc ckFDialog_Done {w {selectFilePath ""}} { + upvar #0 [winfo name $w] data + global ckPriv + if {![string compare $selectFilePath ""]} { + set selectFilePath [ckFDialog_JoinFile $data(selectPath) \ + $data(selectFile)] + set ckPriv(selectFile) $data(selectFile) + set ckPriv(selectPath) $data(selectPath) + if {[file exists $selectFilePath] && + ![string compare $data(type) save]} { + set reply [ck_messageBox -icon warning -type yesno\ + -parent $data(-parent) -message "File\ + \"$selectFilePath\" already exists.\nDo\ + you want to overwrite it?"] + if {![string compare $reply "no"]} { + return + } + } + } + set ckPriv(selectFilePath) $selectFilePath +} + diff --git a/library/clrpick.tcl b/library/clrpick.tcl new file mode 100644 index 0000000..de05640 --- /dev/null +++ b/library/clrpick.tcl @@ -0,0 +1,135 @@ +# clrpick.tcl -- +# +# Color selection dialog. +# standard color selection dialog. +# +# Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1999 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# ck_chooseColor -- +# +# Create a color dialog and let the user choose a color. This function +# should not be called directly. It is called by the tk_chooseColor +# function when a native color selector widget does not exist + +proc ck_chooseColor args { + global ckPriv + set w .__ck__color + upvar #0 $w data + if {[winfo depth .] == 1} { + set data(colors) {black white} + set data(rcolors) {white black} + } else { + set data(colors) {black blue cyan green magenta red white yellow} + set data(rcolors) {white white white white white white black black} + } + ckColorDialog_Config $w $args + + if {![winfo exists $w]} { + toplevel $w -class CkColorDialog -border { + ulcorner hline urcorner vline lrcorner hline llcorner vline + } + ckColorDialog_BuildDialog $w + } + place $w -relx 0.5 -rely 0.5 -anchor center + + # Set the focus. + + set oldFocus [focus] + focus $w.bot.ok + + # Wait for the user to respond, then restore the focus and + # return the index of the selected button. Restore the focus + # before deleting the window, since otherwise the window manager + # may take the focus away so we can't redirect it. Finally, + # restore any grab that was in effect. + + tkwait variable ckPriv(selectColor) + catch {focus $oldFocus} + destroy $w + unset data + return $ckPriv(selectColor) +} + +# ckColorDialog_Config -- +# +# Parses the command line arguments to tk_chooseColor +# +proc ckColorDialog_Config {w argList} { + global ckPriv + upvar #0 $w data + set specs { + {-initialcolor "" "" ""} + {-parent "" "" "."} + {-title "" "" "Color"} + } + tclParseConfigSpec $w $specs "" $argList + if {![string compare $data(-initialcolor) ""]} { + if {[info exists ckPriv(selectColor)] && \ + [string compare $ckPriv(selectColor) ""]} { + set data(-initialcolor) $ckPriv(selectColor) + } else { + set data(-initialcolor) [. cget -background] + } + } elseif {[lsearch -exact $data(colors) $data(-initialcolor)] <= 0} { + error "illegal -initialcolor" + } + if {![winfo exists $data(-parent)]} { + error "bad window path name \"$data(-parent)\"" + } +} + +# ckColorDialog_BuildDialog -- +# +# Build the dialog. +# +proc ckColorDialog_BuildDialog w { + upvar #0 $w data + label $w.title -text "Select Color" + pack $w.title -side top -fill x -pady 1 + frame $w.top + pack $w.top -side top -fill x -padx 1 + set count 0 + foreach i $data(colors) { + radiobutton $w.top.$i -background $i -text $i -value $i \ + -variable ${w}(finalColor) \ + -foreground [lindex $data(rcolors) $count] \ + -selectcolor [lindex $data(rcolors) $count] + if {[winfo depth .] > 1} { + $w.top.$i configure -activeforeground \ + [$w.top.$i cget -background] -activeattributes bold \ + -activebackground [$w.top.$i cget -foreground] + } + pack $w.top.$i -side top -fill x + incr count + } + frame $w.bot + pack $w.bot -side top -fill x -padx 1 -pady 1 + button $w.bot.ok -text OK -width 8 -underline 0 \ + -command [list ckColorDialog_OkCmd $w] + button $w.bot.cancel -text Cancel -width 8 -underline 0 \ + -command [list ckColorDialog_CancelCmd $w] + pack $w.bot.ok $w.bot.cancel -side left -expand 1 + # Accelerator bindings + bind $w [list ckButtonInvoke $w.bot.cancel] + bind $w [list ckButtonInvoke $w.bot.cancel] + bind $w [list ckButtonInvoke $w.bot.cancel] + bind $w [list ckButtonInvoke $w.bot.ok] + bind $w [list ckButtonInvoke $w.bot.ok] + set data(finalColor) $data(-initialcolor) +} + +proc ckColorDialog_OkCmd {w} { + global ckPriv + upvar #0 $w data + set ckPriv(selectColor) $data(finalColor) +} + +proc ckColorDialog_CancelCmd {w} { + global ckPriv + set ckPriv(selectColor) "" +} + diff --git a/library/comdlg.tcl b/library/comdlg.tcl new file mode 100644 index 0000000..6340a49 --- /dev/null +++ b/library/comdlg.tcl @@ -0,0 +1,159 @@ +# comdlg.tcl -- +# +# Some functions needed for the common dialog boxes. Probably need to go +# in a different file. +# +# RCS: @(#) $Id: comdlg.tcl,v 1.1 2006-02-24 18:59:53 vitus Exp $ +# +# Copyright (c) 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. +# + +# tclParseConfigSpec -- +# +# Parses a list of "-option value" pairs. If all options and +# values are legal, the values are stored in +# $data($option). Otherwise an error message is returned. When +# an error happens, the data() array may have been partially +# modified, but all the modified members of the data(0 array are +# guaranteed to have valid values. This is different than +# Tk_ConfigureWidget() which does not modify the value of a +# widget record if any error occurs. +# +# Arguments: +# +# w = widget record to modify. Must be the pathname of a widget. +# +# specs = { +# {-commandlineswitch resourceName ResourceClass defaultValue verifier} +# {....} +# } +# +# flags = currently unused. +# +# argList = The list of "-option value" pairs. +# +proc tclParseConfigSpec {w specs flags argList} { + upvar #0 $w data + + # 1: Put the specs in associative arrays for faster access + # + foreach spec $specs { + if {[llength $spec] < 4} { + error "\"spec\" should contain 5 or 4 elements" + } + set cmdsw [lindex $spec 0] + set cmd($cmdsw) "" + set rname($cmdsw) [lindex $spec 1] + set rclass($cmdsw) [lindex $spec 2] + set def($cmdsw) [lindex $spec 3] + set verproc($cmdsw) [lindex $spec 4] + } + + if {([llength $argList]%2) != 0} { + foreach {cmdsw value} $argList { + if {![info exists cmd($cmdsw)]} { + error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]" + } + } + error "value for \"[lindex $argList end]\" missing" + } + + # 2: set the default values + # + foreach cmdsw [array names cmd] { + set data($cmdsw) $def($cmdsw) + } + + # 3: parse the argument list + # + foreach {cmdsw value} $argList { + if {![info exists cmd($cmdsw)]} { + error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]" + } + set data($cmdsw) $value + } + + # Done! +} + +proc tclListValidFlags {v} { + upvar $v cmd + + set len [llength [array names cmd]] + set i 1 + set separator "" + set errormsg "" + foreach cmdsw [lsort [array names cmd]] { + append errormsg "$separator$cmdsw" + incr i + if {$i == $len} { + set separator " or " + } else { + set separator ", " + } + } + return $errormsg +} + +# This procedure is used to sort strings in a case-insenstive mode. +# +proc tclSortNoCase {str1 str2} { + return [string compare [string toupper $str1] [string toupper $str2]] +} + + +# Gives an error if the string does not contain a valid integer +# number +# +proc tclVerifyInteger {string} { + lindex {1 2 3} $string +} + +# ckFDGetFileTypes -- +# +# Process the string given by the -filetypes option of the file +# dialogs. Similar to the C function TkGetFileFilters() on the Mac +# and Windows platform. +# +proc ckFDGetFileTypes {string} { + foreach t $string { + if {[llength $t] < 2 || [llength $t] > 3} { + error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" + } + eval lappend [list fileTypes([lindex $t 0])] [lindex $t 1] + } + + set types {} + foreach t $string { + set label [lindex $t 0] + set exts {} + + if {[info exists hasDoneType($label)]} { + continue + } + + set name "$label (" + set sep "" + foreach ext $fileTypes($label) { + if {![string compare $ext ""]} { + continue + } + regsub {^[.]} $ext "*." ext + if {![info exists hasGotExt($label,$ext)]} { + append name $sep$ext + lappend exts $ext + set hasGotExt($label,$ext) 1 + } + set sep , + } + append name ")" + lappend types [list $name $exts] + + set hasDoneType($label) 1 + } + + return $types +} diff --git a/library/command.tcl b/library/command.tcl new file mode 100644 index 0000000..16480e9 --- /dev/null +++ b/library/command.tcl @@ -0,0 +1,106 @@ +# +# command.tcl -- +# +# This file defines the command dialog procedure. +# +# Copyright (c) 1995-1996 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# ckCommand -- +# Create command window e.g. for interactive use of cwsh + +proc ckCommand {{w .ckCommand}} { + global ckPriv + if [winfo exists $w] { + raise $w + return + } + toplevel $w -class CommandDialog \ + -border { ulcorner hline urcorner vline lrcorner hline llcorner vline } + place $w -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5 -anchor center + + label $w.title -text "Command dialog" + place $w.title -y 0 -relx 0.5 -bordermode ignore -anchor center + + entry $w.entry + frame $w.sep0 -border hline -height 1 + scrollbar $w.scroll -command "$w.output yview" -takefocus 0 + text $w.output -yscrollcommand "$w.scroll set" + frame $w.sep1 -border hline -height 1 + button $w.close -command "lower $w" -text Dismiss + + pack $w.entry -side top -fill x + pack $w.sep0 -side top -fill x + pack $w.close -side bottom -ipadx 1 + pack $w.sep1 -side bottom -fill x + pack $w.scroll -side right -fill y + pack $w.output -side left -fill both -expand 1 + + bind $w.entry "ckCommandRun $w" + bind $w.entry "ckCommandRun $w" + bind $w.entry "ckCmdHist $w 1" + bind $w.entry "ckCmdHist $w -1" + bind $w.output {focus [ck_focusNext %W] ; break} + bind $w.output "ckCommandRun $w \[$w.output get 1.0 end\]" + bind $w "lower $w ; break" + bind $w "ckCmdToggleSize $w" + bind $w {update screen} + + focus $w.entry + + set ckPriv(cmdHistory) {} + set ckPriv(cmdHistCnt) -1 + set ckPriv(cmdHistMax) 32 +} + +proc ckCmdToggleSize w { + if {[string first "-relwidth 1" [place info $w]] >= 0} { + place $w -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5 \ + -anchor center + } else { + place $w -relx 0.5 -rely 0.5 -relwidth 1.0 -relheight 1.0 \ + -anchor center + } +} + +proc ckCmdHist {w dir} { + global ckPriv + incr ckPriv(cmdHistCnt) $dir + if {$ckPriv(cmdHistCnt) < 0} { + set cmd "" + set ckPriv(cmdHistCnt) -1 + } else { + if {$ckPriv(cmdHistCnt) >= [llength $ckPriv(cmdHistory)]} { + set ckPriv(cmdHistCnt) [expr [llength $ckPriv(cmdHistory)] - 1] + return + } + set cmd [lindex $ckPriv(cmdHistory) $ckPriv(cmdHistCnt)] + } + $w.entry delete 0 end + $w.entry insert end $cmd +} + +proc ckCommandRun {w {cmd {}}} { + global errorInfo ckPriv + if {$cmd == ""} { + set cmd [string trim [$w.entry get]] + if {$cmd == ""} { + return + } + } + set code [catch {uplevel #0 $cmd} result] + if {$code == 0} { + set ckPriv(cmdHistory) [lrange [concat [list $cmd] \ + $ckPriv(cmdHistory)] 0 $ckPriv(cmdHistMax)] + set ckPriv(cmdHistCnt) -1 + } + $w.output delete 1.0 end + $w.output insert 1.0 $result + if $code { $w.output insert end "\n----\n$errorInfo" } + $w.output mark set insert 1.0 + if {$code == 0} { + $w.entry delete 0 end + } +} diff --git a/library/dialog.tcl b/library/dialog.tcl new file mode 100644 index 0000000..3e6d1e4 --- /dev/null +++ b/library/dialog.tcl @@ -0,0 +1,65 @@ +# dialog.tcl -- +# +# This file defines the procedure ck_dialog, which creates a dialog +# box containing a bitmap, a message, and one or more buttons. +# +# Copyright (c) 1992-1993 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. +# + +# +# ck_dialog: +# +# This procedure displays a dialog box, waits for a button in the dialog +# to be invoked, then returns the index of the selected button. +# +# Arguments: +# w - Window to use for dialog top-level. +# title - Title to display in dialog's decorative frame. +# text - Message to display in dialog. +# default - +# args - One or more strings to display in buttons across the +# bottom of the dialog box. + +proc ck_dialog {w title text default args} { + global ckPriv + if {[llength $args] <= 0} { + return -1 + } + catch {destroy $w} + toplevel $w -class Dialog \ + -border {ulcorner hline urcorner vline lrcorner hline llcorner vline} + place $w -relx 0.5 -rely 0.5 -anchor center + if {[string length $title] > 0} { + label $w.title -text $title + pack $w.title -side top -fill x + frame $w.sep0 -border hline -height 1 + pack $w.sep0 -side top -fill x + } + message $w.msg -text $text + pack $w.msg -side top + frame $w.sep1 -border hline -height 1 + pack $w.sep1 -side top -fill x + frame $w.b + pack $w.b -side top -fill x + set i 0 + foreach but $args { + button $w.b.b$i -text $but -command \ + "set ckPriv(button) $i ; destroy $w" + pack $w.b.b$i -side left -ipadx 1 -expand 1 + incr i + } + if {catch {set default [expr $default+0]} { + set default 0 + } + if {[string length $default]&&$default >=0&& $default <$i} { + focus $w.b.b$default + } else { + focus $w.b.b0 + } + tkwait window $w + return $ckPriv(button) +} diff --git a/library/entry.tcl b/library/entry.tcl new file mode 100644 index 0000000..00b8a19 --- /dev/null +++ b/library/entry.tcl @@ -0,0 +1,214 @@ +# entry.tcl -- +# +# This file defines the default bindings for entry widgets and provides +# procedures that help in implementing those bindings. +# +# Copyright (c) 1992-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. +# + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for entries. +#------------------------------------------------------------------------- + +bind Entry { + ckEntrySetCursor %W [expr [%W index insert] - 1] +} +bind Entry { + ckEntrySetCursor %W [expr [%W index insert] + 1] +} +bind Entry { + ckEntrySetCursor %W 0 +} +bind Entry { + ckEntrySetCursor %W end +} +bind Entry { + if [%W selection present] { + %W delete sel.first sel.last + } else { + %W delete insert + } +} +bind Entry { + if [%W selection present] { + %W delete sel.first sel.last + } else { + %W delete insert + } +} +bind Entry { + ckEntryBackspace %W +} +bind Entry { + ckListboxBeginSelect %W [%W index active] +} +bind Listbox { + ckListboxCancel %W +} +bind Listbox { + focus %W + ckListboxBeginSelect %W [%W index @0,%y] +} + +# ckListboxBeginSelect -- +# +# This procedure is typically invoked on space presses. It begins +# the process of making a selection in the listbox. Its exact behavior +# depends on the selection mode currently in effect for the listbox; +# see the Motif documentation for details. +# +# Arguments: +# w - The listbox widget. +# el - The element for the selection operation (typically the +# one under the pointer). Must be in numerical form. + +proc ckListboxBeginSelect {w el} { + global ckPriv + if {[$w cget -selectmode] == "multiple"} { + if [$w selection includes $el] { + $w selection clear $el + } else { + $w selection set $el + } + } else { + $w activate $el + $w selection clear 0 end + $w selection set $el + $w selection anchor $el + set ckPriv(listboxSelection) {} + set ckPriv(listboxPrev) $el + } +} + +# ckListboxUpDown -- +# +# Moves the location cursor (active element) up or down by one element, +# and changes the selection if we're in browse or extended selection +# mode. +# +# Arguments: +# w - The listbox widget. +# amount - +1 to move down one item, -1 to move back one item. + +proc ckListboxUpDown {w amount} { + global ckPriv + $w activate [expr [$w index active] + $amount] + $w see active + switch [$w cget -selectmode] { + browse { + $w selection clear 0 end + $w selection set active + } + extended { + $w selection clear 0 end + $w selection set active + $w selection anchor active + set ckPriv(listboxPrev) [$w index active] + set ckPriv(listboxSelection) {} + } + } +} + +# ckListboxCancel +# +# This procedure is invoked to cancel an extended selection in +# progress. If there is an extended selection in progress, it +# restores all of the items between the active one and the anchor +# to their previous selection state. +# +# Arguments: +# w - The listbox widget. + +proc ckListboxCancel w { + global ckPriv + if {[$w cget -selectmode] != "extended"} { + return + } + set first [$w index anchor] + set last $ckPriv(listboxPrev) + if {$first > $last} { + set tmp $first + set first $last + set last $tmp + } + $w selection clear $first $last + while {$first <= $last} { + if {[lsearch $ckPriv(listboxSelection) $first] >= 0} { + $w selection set $first + } + incr first + } +} diff --git a/library/menu.tcl b/library/menu.tcl new file mode 100644 index 0000000..27b7768 --- /dev/null +++ b/library/menu.tcl @@ -0,0 +1,534 @@ +# menu.tcl -- +# +# This file defines the default bindings for Tk menus and menubuttons. +# It also implements keyboard traversal of menus and implements a few +# other utility procedures related to menus. +# +# Copyright (c) 1992-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. +# + +#------------------------------------------------------------------------- +# Elements of ckPriv that are used in this file: +# +# focus - Saves the focus during a menu selection operation. +# Focus gets restored here when the menu is unposted. +# postedMb - Name of the menubutton whose menu is currently +# posted, or an empty string if nothing is posted +# popup - If a menu has been popped up via ck_popup, this +# gives the name of the menu. Otherwise this value +# is empty. +#------------------------------------------------------------------------- + +set ckPriv(postedMb) "" +set ckPriv(popup) "" + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for menus +# and menubuttons. +#------------------------------------------------------------------------- + +bind Menubutton {} +bind Menubutton { + if {[ckMbPost %W]} { + ckMenuFirstEntry [%W cget -menu] + } +} +bind Menubutton { + if {[ckMbPost %W]} { + ckMenuFirstEntry [%W cget -menu] + } +} +bind Menubutton { + if {[ckMbPost %W]} { + ckMenuFirstEntry [%W cget -menu] + } +} +bind Menubutton { + if {[ckMbPost %W]} { + ckMenuFirstEntry [%W cget -menu] + } +} + +bind Menu { + ckMenuInvoke %W +} +bind Menu { + ckMenuInvoke %W +} +bind Menu { + ckMenuInvoke %W +} +bind Menu { + ckMenuEscape %W ; break +} +bind Menu { + ckMenuLeftRight %W left +} +bind Menu { + ckMenuLeftRight %W right +} +bind Menu { + ckMenuNextEntry %W -1 +} +bind Menu { + ckMenuNextEntry %W +1 +} +bind Menu { + ckTraverseWithinMenu %W %A +} +bind Menu { + %W activate @%y + ckMenuInvoke %W +} + +bind all { + ckFirstMenu %W +} + +# ckMbPost -- +# Given a menubutton, this procedure does all the work of posting +# its associated menu and unposting any other menu that is currently +# posted. +# +# Arguments: +# w - The name of the menubutton widget whose menu +# is to be posted. +# x, y - Root coordinates of cursor, used for positioning +# option menus. If not specified, then the center +# of the menubutton is used for an option menu. + +proc ckMbPost {w {x {}} {y {}}} { + global ckPriv + if {([$w cget -state] == "disabled") || ($w == $ckPriv(postedMb))} { + return 0 + } + set menu [$w cget -menu] + if {$menu == ""} { + return 0 + } + if ![string match $w.* $menu] { + error "can't post $menu: it isn't a descendant of $w" + } + set cur $ckPriv(postedMb) + if {$cur != ""} { + ckMenuUnpost {} + } + set ckPriv(postedMb) $w + set ckPriv(focus) [focus] + $menu activate none + + # If this looks like an option menubutton then post the menu so + # that the current entry is on top of the mouse. Otherwise post + # the menu just below the menubutton, as for a pull-down. + + if {([$w cget -indicatoron] == 1) && ([$w cget -textvariable] != "")} { + if {$y == ""} { + set x [expr [winfo rootx $w] + [winfo width $w]/2] + set y [expr [winfo rooty $w] + [winfo height $w]/2] + } + ckPostOverPoint $menu $x $y [ckMenuFindName $menu [$w cget -text]] + } else { + $menu post [winfo rootx $w] [expr [winfo rooty $w]+[winfo height $w]] + } + focus $menu + $w configure -state active + return 1 +} + +# ckMenuUnpost -- +# This procedure unposts a given menu, plus all of its ancestors up +# to (and including) a menubutton, if any. It also restores various +# values to what they were before the menu was posted, and releases +# a grab if there's a menubutton involved. Special notes: +# Be sure to enclose various groups of commands in "catch" so that +# the procedure will complete even if the menubutton or the menu +# has been deleted. +# +# Arguments: +# menu - Name of a menu to unpost. Ignored if there +# is a posted menubutton. + +proc ckMenuUnpost menu { + global ckPriv + set mb $ckPriv(postedMb) + catch { + if {$mb != ""} { + $mb configure -state normal + catch {focus $ckPriv(focus)} + set ckPriv(focus) "" + set menu [$mb cget -menu] + $menu unpost + set ckPriv(postedMb) {} + } elseif {[string length $ckPriv(popup)]} { + catch {focus $ckPriv(focus)} + set ckPriv(focus) "" + $ckPriv(popup) unpost + set ckPriv(popup) "" + } + } +} + +# ckMenuInvoke -- +# This procedure is invoked when button 1 is released over a menu. +# It invokes the appropriate menu action and unposts the menu if +# it came from a menubutton. +# +# Arguments: +# w - Name of the menu widget. + +proc ckMenuInvoke w { + if {[$w type active] == "cascade"} { + $w postcascade active + set menu [$w entrycget active -menu] + ckMenuFirstEntry $menu + } else { + ckMenuUnpost $w + uplevel #0 [list $w invoke active] + } +} + +# ckMenuEscape -- +# This procedure is invoked for the Cancel (or Escape) key. It unposts +# the given menu and, if it is the top-level menu for a menu button, +# unposts the menu button as well. +# +# Arguments: +# menu - Name of the menu window. + +proc ckMenuEscape menu { + if {[winfo class [winfo parent $menu]] != "Menu"} { + ckMenuUnpost $menu + } else { + ckMenuLeftRight $menu -1 + } +} + +# ckMenuLeftRight -- +# This procedure is invoked to handle "left" and "right" traversal +# motions in menus. It traverses to the next menu in a menu bar, +# or into or out of a cascaded menu. +# +# Arguments: +# menu - The menu that received the keyboard +# event. +# direction - Direction in which to move: "left" or "right" + +proc ckMenuLeftRight {menu direction} { + global ckPriv + + # First handle traversals into and out of cascaded menus. + + if {$direction == "right"} { + set count 1 + if {[$menu type active] == "cascade"} { + $menu postcascade active + set m2 [$menu entrycget active -menu] + if {$m2 != ""} { + ckMenuFirstEntry $m2 + } + return + } + } else { + set count -1 + set m2 [winfo parent $menu] + if {[winfo class $m2] == "Menu"} { + focus $m2 + $m2 postcascade none + return + } + } + + # Can't traverse into or out of a cascaded menu. Go to the next + # or previous menubutton, if that makes sense. + + set w $ckPriv(postedMb) + if {$w == ""} { + return + } + set buttons [winfo children [winfo parent $w]] + set length [llength $buttons] + set i [expr [lsearch -exact $buttons $w] + $count] + while 1 { + while {$i < 0} { + incr i $length + } + while {$i >= $length} { + incr i -$length + } + set mb [lindex $buttons $i] + if {([winfo class $mb] == "Menubutton") + && ([$mb cget -state] != "disabled") + && ([$mb cget -menu] != "") + && ([[$mb cget -menu] index last] != "none")} { + break + } + if {$mb == $w} { + return + } + incr i $count + } + if {[ckMbPost $mb]} { + ckMenuFirstEntry [$mb cget -menu] + } +} + +# ckMenuNextEntry -- +# Activate the next higher or lower entry in the posted menu, +# wrapping around at the ends. Disabled entries are skipped. +# +# Arguments: +# menu - Menu window that received the keystroke. +# count - 1 means go to the next lower entry, +# -1 means go to the next higher entry. + +proc ckMenuNextEntry {menu count} { + global ckPriv + if {[$menu index last] == "none"} { + return + } + set length [expr [$menu index last]+1] + set active [$menu index active] + if {$active == "none"} { + set i 0 + } else { + set i [expr $active + $count] + } + while 1 { + while {$i < 0} { + incr i $length + } + while {$i >= $length} { + incr i -$length + } + if {[catch {$menu entrycget $i -state} state] == 0} { + if {$state != "disabled"} { + break + } + } + if {$i == $active} { + return + } + incr i $count + } + $menu activate $i +} + +# ckMenuFind -- +# This procedure searches the entire window hierarchy under w for +# a menubutton that isn't disabled and whose underlined character +# is "char". It returns the name of that window, if found, or an +# empty string if no matching window was found. If "char" is an +# empty string then the procedure returns the name of the first +# menubutton found that isn't disabled. +# +# Arguments: +# w - Name of window where key was typed. +# char - Underlined character to search for; +# may be either upper or lower case, and +# will match either upper or lower case. + +proc ckMenuFind {w char} { + global ckPriv + set char [string tolower $char] + + foreach child [winfo child $w] { + switch [winfo class $child] { + Menubutton { + set char2 [string index [$child cget -text] \ + [$child cget -underline]] + if {([string compare $char [string tolower $char2]] == 0) + || ($char == "")} { + if {[$child cget -state] != "disabled"} { + return $child + } + } + } + Frame { + set match [ckMenuFind $child $char] + if {$match != ""} { + return $match + } + } + } + } + return {} +} + +# ckFirstMenu -- +# This procedure traverses to the first menubutton in the toplevel +# for a given window, and posts that menubutton's menu. +# +# Arguments: +# w - Name of a window. Selects which toplevel +# to search for menubuttons. + +proc ckFirstMenu w { + set w [ckMenuFind [winfo toplevel $w] ""] + if {$w != ""} { + if {[ckMbPost $w]} { + ckMenuFirstEntry [$w cget -menu] + } + } +} + +# ckTraverseWithinMenu +# This procedure implements keyboard traversal within a menu. It +# searches for an entry in the menu that has "char" underlined. If +# such an entry is found, it is invoked and the menu is unposted. +# +# Arguments: +# w - The name of the menu widget. +# char - The character to look for; case is +# ignored. If the string is empty then +# nothing happens. + +proc ckTraverseWithinMenu {w char} { + if {$char == ""} { + return + } + set char [string tolower $char] + set last [$w index last] + if {$last == "none"} { + return + } + for {set i 0} {$i <= $last} {incr i} { + if [catch {set char2 [string index \ + [$w entrycget $i -label] \ + [$w entrycget $i -underline]]}] { + continue + } + if {[string compare $char [string tolower $char2]] == 0} { + if {[$w type $i] == "cascade"} { + $w postcascade $i + $w activate $i + set m2 [$w entrycget $i -menu] + if {$m2 != ""} { + tkMenuFirstEntry $m2 + } + } else { + ckMenuUnpost $w + uplevel #0 [list $w invoke $i] + } + return + } + } +} + +# ckMenuFirstEntry -- +# Given a menu, this procedure finds the first entry that isn't +# disabled or a tear-off or separator, and activates that entry. +# However, if there is already an active entry in the menu (e.g., +# because of a previous call to tkPostOverPoint) then the active +# entry isn't changed. This procedure also sets the input focus +# to the menu. +# +# Arguments: +# menu - Name of the menu window (possibly empty). + +proc ckMenuFirstEntry menu { + if {$menu == ""} { + return + } + focus $menu + if {[$menu index active] != "none"} { + return + } + set last [$menu index last] + if {$last == "none"} { + return + } + for {set i 0} {$i <= $last} {incr i} { + if {([catch {set state [$menu entrycget $i -state]}] == 0) + && ($state != "disabled")} { + $menu activate $i + return + } + } +} + +# ckMenuFindName -- +# Given a menu and a text string, return the index of the menu entry +# that displays the string as its label. If there is no such entry, +# return an empty string. This procedure is tricky because some names +# like "active" have a special meaning in menu commands, so we can't +# always use the "index" widget command. +# +# Arguments: +# menu - Name of the menu widget. +# s - String to look for. + +proc ckMenuFindName {menu s} { + set i "" + if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} { + catch {set i [$menu index $s]} + return $i + } + set last [$menu index last] + if {$last == "none"} { + return + } + for {set i 0} {$i <= $last} {incr i} { + if ![catch {$menu entrycget $i -label} label] { + if {$label == $s} { + return $i + } + } + } + return "" +} + +# ckPostOverPoint -- +# This procedure posts a given menu such that a given entry in the +# menu is centered over a given point in the root window. It also +# activates the given entry. +# +# Arguments: +# menu - Menu to post. +# x, y - Root coordinates of point. +# entry - Index of entry within menu to center over (x,y). +# If omitted or specified as {}, then the menu's +# upper-left corner goes at (x,y). + +proc ckPostOverPoint {menu x y {entry {}}} { + if {$entry != {}} { + if {$entry == [$menu index last]} { + incr y [expr -([$menu yposition $entry] \ + + [winfo reqheight $menu])/2] + } else { + incr y [expr -([$menu yposition $entry] \ + + [$menu yposition [expr $entry+1]])/2] + } + incr x [expr -[winfo reqwidth $menu]/2] + } + $menu post $x $y + if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} { + $menu activate $entry + } +} + +# ck_popup -- +# This procedure pops up a menu and sets things up for traversing +# the menu and its submenus. +# +# Arguments: +# menu - Name of the menu to be popped up. +# x, y - Root coordinates at which to pop up the +# menu. +# entry - Index of a menu entry to center over (x,y). +# If omitted or specified as {}, then menu's +# upper-left corner goes at (x,y). + +proc ck_popup {menu x y {entry {}}} { + global ckPriv + if {($ckPriv(popup) != "") || ($ckPriv(postedMb) != "")} { + ckMenuUnpost {} + } + ckPostOverPoint $menu $x $y $entry + set ckPriv(focus) [focus] + set ckPriv(popup) $menu + focus $menu +} diff --git a/library/msgbox.tcl b/library/msgbox.tcl new file mode 100644 index 0000000..473c953 --- /dev/null +++ b/library/msgbox.tcl @@ -0,0 +1,164 @@ +# msgbox.tcl -- +# +# Implements messageboxes. +# +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1999 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + + +# ck_messageBox -- +# +# Pops up a messagebox with an application-supplied message with +# an icon and a list of buttons. +# See the user documentation for details on what ck_messageBox does. + +proc ck_messageBox args { + global ckPriv + set w ckPrivMsgBox + upvar #0 $w data + set specs { + {-default "" "" ""} + {-icon "" "" "info"} + {-message "" "" ""} + {-parent "" "" .} + {-title "" "" ""} + {-type "" "" "ok"} + } + tclParseConfigSpec $w $specs "" $args + if {[lsearch {info warning error question} $data(-icon)] == -1} { + error "invalid icon \"$data(-icon)\", must be error, info, question or warning" + } + if {![winfo exists $data(-parent)]} { + error "bad window path name \"$data(-parent)\"" + } + switch -- $data(-type) { + abortretryignore { + set buttons { + {abort -width 6 -text Abort -underline 0} + {retry -width 6 -text Retry -underline 0} + {ignore -width 6 -text Ignore -underline 0} + } + } + ok { + set buttons { + {ok -width 6 -text OK -underline 0} + } + if {$data(-default) == ""} { + set data(-default) "ok" + } + } + okcancel { + set buttons { + {ok -width 6 -text OK -underline 0} + {cancel -width 6 -text Cancel -underline 0} + } + } + retrycancel { + set buttons { + {retry -width 6 -text Retry -underline 0} + {cancel -width 6 -text Cancel -underline 0} + } + } + yesno { + set buttons { + {yes -width 6 -text Yes -underline 0} + {no -width 6 -text No -underline 0} + } + } + yesnocancel { + set buttons { + {yes -width 6 -text Yes -underline 0} + {no -width 6 -text No -underline 0} + {cancel -width 6 -text Cancel -underline 0} + } + } + default { + error "invalid message box type \"$data(-type)\", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel" + } + } + if {[string compare $data(-default) ""]} { + set valid 0 + foreach btn $buttons { + if {![string compare [lindex $btn 0] $data(-default)]} { + set valid 1 + break + } + } + if {!$valid} { + error "invalid default button \"$data(-default)\"" + } + } + # 2. Set the dialog to be a child window of $parent + if {[string compare $data(-parent) .]} { + set w $data(-parent).__ck__messagebox + } else { + set w .__ck__messagebox + } + + # 3. Create the top-level window and divide it into top + # and bottom parts. + catch {destroy $w} + toplevel $w -class Dialog \ + -border { ulcorner hline urcorner vline lrcorner hline llcorner vline } + place $w -relx 0.5 -rely 0.5 -anchor center + label $w.title -text $data(-title) + pack $w.title -side top -fill x + frame $w.bot + pack $w.bot -side bottom -fill both + frame $w.top + pack $w.top -side top -fill both -expand 1 + # 4. Fill the top part with bitmap and message (use the option + # database for -wraplength so that it can be overridden by + # the caller). + message $w.top.msg -text $data(-message) -aspect 1000 + pack $w.top.msg -side right -expand 1 -fill both -padx 1 -pady 1 + # 5. Create a row of buttons at the bottom of the dialog. + set i 0 + foreach but $buttons { + set name [lindex $but 0] + set opts [lrange $but 1 end] + if {![string compare $opts {}]} { + # Capitalize the first letter of $name + set capName \ + [string toupper \ + [string index $name 0]][string range $name 1 end] + set opts [list -text $capName] + } + eval button $w.bot.$name $opts \ + -command [list [list set ckPriv(button) $name]] + pack $w.bot.$name -side left -expand 1 -padx 1 -pady 1 + # create the binding for the key accelerator, based on the underline + set underIdx [$w.bot.$name cget -underline] + if {$underIdx >= 0} { + set key [string index [$w.bot.$name cget -text] $underIdx] + bind $w [string tolower $key] [list $w.bot.$name invoke] + bind $w [string toupper $key] [list $w.bot.$name invoke] + } + incr i + } + # 6. Create a binding for on the dialog if there is a + # default button. + if {[string compare $data(-default) ""]} { + bind $w "ckButtonInvoke $w.bot.$data(-default) ; break" + bind $w "ckButtonInvoke $w.bot.$data(-default) ; break" + } + # 7. Claim the focus. + set oldFocus [focus] + if {[string compare $data(-default) ""]} { + focus $w.bot.$data(-default) + } else { + focus [lindex [winfo children $w.bot] 0] + } + # 8. Wait for the user to respond, then restore the focus and + # return the index of the selected button. Restore the focus + # before deleting the window, since otherwise the window manager + # may take the focus away so we can't redirect it. Finally, + # restore any grab that was in effect. + tkwait variable ckPriv(button) + catch {focus $oldFocus} + destroy $w + return $ckPriv(button) +} diff --git a/library/optMenu.tcl b/library/optMenu.tcl new file mode 100644 index 0000000..192775e --- /dev/null +++ b/library/optMenu.tcl @@ -0,0 +1,62 @@ +# optMenu.tcl -- +# +# This file defines the procedure ck_optionMenu, which creates +# an option button and its associated menu. +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1999 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# ck_optionMenu -- +# This procedure creates an option button named $w and an associated +# menu. Together they provide the functionality of Motif option menus: +# they can be used to select one of many values, and the current value +# appears in the global variable varName, as well as in the text of +# the option menubutton. The name of the menu is returned as the +# procedure's result, so that the caller can use it to change configuration +# options on the menu or otherwise manipulate it. +# +# Arguments: +# w - The name to use for the menubutton. +# varName - Global variable to hold the currently selected value. +# firstValue - First of legal values for option (must be >= 1). +# args - Any number of additional values. + +proc ck_optionMenu {w varName firstValue args} { + upvar #0 $varName var + if {![info exists var]} { + set var $firstValue + } + set width [string length $firstValue] + foreach i $args { + set l [string length $i] + if {$l > $width} { + set width $l + } + } + incr width 2 + menubutton $w -textvariable $varName -menu $w.menu \ + -anchor c -takefocus 1 -width $width + bind $w { + if {[%W cget -state] != "disabled"} { + %W configure -state active + update idletasks + } + } + bind $w { + if {[%W cget -state] != "disabled"} { + %W configure -state normal + update idletasks + } + } + menu $w.menu \ + -border { ulcorner hline urcorner vline lrcorner hline llcorner vline } + $w.menu add radiobutton -label $firstValue -variable $varName + foreach i $args { + $w.menu add radiobutton -label $i -variable $varName + } + return $w.menu +} diff --git a/library/parray.tcl b/library/parray.tcl new file mode 100644 index 0000000..117328b --- /dev/null +++ b/library/parray.tcl @@ -0,0 +1,31 @@ +# parray: +# Print the contents of a global array in command window. +# +# Copyright (c) 1991-1993 The Regents of the University of California. +# Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1995 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +proc parray {a {pattern *}} { + upvar 1 $a array + if ![array exists array] { + error "\"$a\" isn't an array" + } + set maxl 0 + foreach name [lsort [array names array $pattern]] { + if {[string length $name] > $maxl} { + set maxl [string length $name] + } + } + set result "" + set maxl [expr {$maxl + [string length $a] + 2}] + foreach name [lsort [array names array $pattern]] { + set nameString [format %s(%s) $a $name] + append result \ + [format "set %-*s %s\n" $maxl $nameString [list $array($name)]] + } + return $result +} diff --git a/library/scrollbar.tcl b/library/scrollbar.tcl new file mode 100644 index 0000000..42682e6 --- /dev/null +++ b/library/scrollbar.tcl @@ -0,0 +1,143 @@ +# scrollbar.tcl -- +# +# This file defines the default bindings for Tk scrollbar widgets. +# It also provides procedures that help in implementing the bindings. +# +# Copyright (c) 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. +# + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for scrollbars. +#------------------------------------------------------------------------- + +bind Scrollbar { + ckScrollByUnits %W v -1 +} +bind Scrollbar { + ckScrollByUnits %W v 1 +} +bind Scrollbar { + ckScrollByUnits %W h -1 +} +bind Scrollbar { + ckScrollByUnits %W h 1 +} +bind Scrollbar { + ckScrollByPages %W hv -1 +} +bind Scrollbar { + ckScrollByPages %W hv 1 +} +bind Scrollbar { + ckScrollToPos %W 0 +} +bind Scrollbar { + ckScrollToPos %W 1 +} +bind Scrollbar { + ckScrollByButton %W %x %y +} + +bind Scrollbar {%W activate} +bind Scrollbar {%W deactivate} + +# ckScrollByUnits -- +# This procedure tells the scrollbar's associated widget to scroll up +# or down by a given number of units. It notifies the associated widget +# in different ways for old and new command syntaxes. +# +# Arguments: +# w - The scrollbar widget. +# orient - Which kinds of scrollbars this applies to: "h" for +# horizontal, "v" for vertical, "hv" for both. +# amount - How many units to scroll: typically 1 or -1. + +proc ckScrollByUnits {w orient amount} { + set cmd [$w cget -command] + if {($cmd == "") || ([string first \ + [string index [$w cget -orient] 0] $orient] < 0)} { + return + } + set info [$w get] + if {[llength $info] == 2} { + uplevel #0 $cmd scroll $amount units + } else { + uplevel #0 $cmd [expr [lindex $info 2] + $amount] + } +} + +# ckScrollByPages -- +# This procedure tells the scrollbar's associated widget to scroll up +# or down by a given number of screenfuls. It notifies the associated +# widget in different ways for old and new command syntaxes. +# +# Arguments: +# w - The scrollbar widget. +# orient - Which kinds of scrollbars this applies to: "h" for +# horizontal, "v" for vertical, "hv" for both. +# amount - How many screens to scroll: typically 1 or -1. + +proc ckScrollByPages {w orient amount} { + set cmd [$w cget -command] + if {($cmd == "") || ([string first \ + [string index [$w cget -orient] 0] $orient] < 0)} { + return + } + set info [$w get] + if {[llength $info] == 2} { + uplevel #0 $cmd scroll $amount pages + } else { + uplevel #0 $cmd [expr [lindex $info 2] + $amount*([lindex $info 1] - 1)] + } +} + +# ckScrollToPos -- +# This procedure tells the scrollbar's associated widget to scroll to +# a particular location, given by a fraction between 0 and 1. It notifies +# the associated widget in different ways for old and new command syntaxes. +# +# Arguments: +# w - The scrollbar widget. +# pos - A fraction between 0 and 1 indicating a desired position +# in the document. + +proc ckScrollToPos {w pos} { + set cmd [$w cget -command] + if {($cmd == "")} { + return + } + set info [$w get] + if {[llength $info] == 2} { + uplevel #0 $cmd moveto $pos + } else { + uplevel #0 $cmd [expr round([lindex $info 0]*$pos)] + } +} + +# ckScrollByButton -- +# This procedure is invoked for button presses on any element of the +# scrollbar. +# +# Arguments: +# w - The scrollbar widget. +# x, y - Mouse coordinates of button press. + +proc ckScrollByButton {w x y} { + set element [$w identify $x $y] + if {$element == "arrow1"} { + ckScrollByUnits $w hv -1 + } elseif {$element == "trough1"} { + ckScrollByPages $w hv -1 + } elseif {$element == "trough2"} { + ckScrollByPages $w hv 1 + } elseif {$element == "arrow2"} { + ckScrollByUnits $w hv 1 + } else { + return + } +} + diff --git a/library/showglob.tcl b/library/showglob.tcl new file mode 100644 index 0000000..e298934 --- /dev/null +++ b/library/showglob.tcl @@ -0,0 +1,36 @@ +# +# showglob.tcl -- +# +# This file defines a command for retrieving Tcl global variables. +# +# Copyright (c) 1996 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +proc showglob args { + set result {} + if {[llength $args] == 0} { + set args * + } + foreach i $args { + foreach k [info globals $i] { + set glob($k) {} + } + } + foreach i [lsort -ascii [array names glob]] { + upvar #0 $i var + if [array exists var] { + foreach k [lsort -ascii [array names var]] { + lappend result set [list $i]($k) $var($k) + append result "\n" + } + } else { + catch {lappend result set $i $var} + append result "\n" + } + } + return $result +} + + diff --git a/library/showproc.tcl b/library/showproc.tcl new file mode 100644 index 0000000..a69e916 --- /dev/null +++ b/library/showproc.tcl @@ -0,0 +1,39 @@ +# +# showproc.tcl -- +# +# This file defines a command for retrieving Tcl procedures. +# +# Copyright (c) 1996 Christian Werner +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +proc showproc args { + set result {} + if {[llength $args] == 0} { + set args * + } + foreach i $args { + foreach k [info procs $i] { + set procs($k) {} + } + } + foreach i [lsort -ascii [array names procs]] { + set proc proc + lappend proc $i + set args {} + foreach k [info args $i] { + if [info default $i $k value] { + lappend args [list $k $value] + } else { + lappend args $k + } + } + lappend proc $args + lappend proc [info body $i] + lappend result $proc + } + return [join $result "\n\n"] +} + + diff --git a/library/tclIndex b/library/tclIndex new file mode 100644 index 0000000..f77679e --- /dev/null +++ b/library/tclIndex @@ -0,0 +1,100 @@ +# Tcl autoload index file, version 2.0 +# This file is generated by the "auto_mkindex" command +# and sourced to set up indexing information for one or +# more commands. Typically each line is a command that +# sets an element in the auto_index array, where the +# element name is the name of a command and the value is +# a script that loads the command. + +set auto_index(ckButtonFocus) [list source [file join $dir button.tcl]] +set auto_index(ckButtonInvoke) [list source [file join $dir button.tcl]] +set auto_index(showproc) [list source [file join $dir showproc.tcl]] +set auto_index(ckListboxBeginSelect) [list source [file join $dir listbox.tcl]] +set auto_index(ckListboxUpDown) [list source [file join $dir listbox.tcl]] +set auto_index(ckListboxCancel) [list source [file join $dir listbox.tcl]] +set auto_index(ckScrollByUnits) [list source [file join $dir scrollbar.tcl]] +set auto_index(ckScrollByPages) [list source [file join $dir scrollbar.tcl]] +set auto_index(ckScrollToPos) [list source [file join $dir scrollbar.tcl]] +set auto_index(ckScrollByButton) [list source [file join $dir scrollbar.tcl]] +set auto_index(ck_dialog) [list source [file join $dir dialog.tcl]] +set auto_index(keylpr) [list source [file join $dir keylpr.tcl]] +set auto_index(ckTextSetCursor) [list source [file join $dir text.tcl]] +set auto_index(ckTextInsert) [list source [file join $dir text.tcl]] +set auto_index(ckTextUpDownLine) [list source [file join $dir text.tcl]] +set auto_index(ckTextScrollPages) [list source [file join $dir text.tcl]] +set auto_index(ckCommand) [list source [file join $dir command.tcl]] +set auto_index(ckCmdToggleSize) [list source [file join $dir command.tcl]] +set auto_index(ckCmdHist) [list source [file join $dir command.tcl]] +set auto_index(ckCommandRun) [list source [file join $dir command.tcl]] +set auto_index(ckMbPost) [list source [file join $dir menu.tcl]] +set auto_index(ckMenuUnpost) [list source [file join $dir menu.tcl]] +set auto_index(ckMenuInvoke) [list source [file join $dir menu.tcl]] +set auto_index(ckMenuEscape) [list source [file join $dir menu.tcl]] +set auto_index(ckMenuLeftRight) [list source [file join $dir menu.tcl]] +set auto_index(ckMenuNextEntry) [list source [file join $dir menu.tcl]] +set auto_index(ckMenuFind) [list source [file join $dir menu.tcl]] +set auto_index(ckFirstMenu) [list source [file join $dir menu.tcl]] +set auto_index(ckTraverseWithinMenu) [list source [file join $dir menu.tcl]] +set auto_index(ckMenuFirstEntry) [list source [file join $dir menu.tcl]] +set auto_index(ckMenuFindName) [list source [file join $dir menu.tcl]] +set auto_index(ckPostOverPoint) [list source [file join $dir menu.tcl]] +set auto_index(ck_popup) [list source [file join $dir menu.tcl]] +set auto_index(ck_getOpenFile) [list source [file join $dir ckfbox.tcl]] +set auto_index(ck_getSaveFile) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_Config) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_Create) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_UpdateWhenIdle) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_Update) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_SetPathSilently) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_SetPath) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_SetFilter) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialogResolveFile) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_EntFocusIn) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_EntFocusOut) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_ActivateEnt) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_InvokeBtn) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_UpDirCmd) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_JoinFile) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_OkCmd) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_CancelCmd) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_ListBrowse) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_ListInvoke) [list source [file join $dir ckfbox.tcl]] +set auto_index(ckFDialog_Done) [list source [file join $dir ckfbox.tcl]] +set auto_index(parray) [list source [file join $dir parray.tcl]] +set auto_index(showglob) [list source [file join $dir showglob.tcl]] +set auto_index(ck_focusNext) [list source [file join $dir focus.tcl]] +set auto_index(ck_focusPrev) [list source [file join $dir focus.tcl]] +set auto_index(ckFocusOK) [list source [file join $dir focus.tcl]] +set auto_index(ck_RestrictFocus) [list source [file join $dir focus.tcl]] +set auto_index(ck_Unrestrict) [list source [file join $dir focus.tcl]] +set auto_index(ckEntryKeySelect) [list source [file join $dir entry.tcl]] +set auto_index(ckEntryInsert) [list source [file join $dir entry.tcl]] +set auto_index(ckEntryBackspace) [list source [file join $dir entry.tcl]] +set auto_index(ckEntrySeeInsert) [list source [file join $dir entry.tcl]] +set auto_index(ckEntrySetCursor) [list source [file join $dir entry.tcl]] +set auto_index(ckEntryTranspose) [list source [file join $dir entry.tcl]] +set auto_index(entryx) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryDestroy) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryTouched) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryFocus) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryXSetCursor) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryXSeeInsert) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryXBackspace) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryXDelete) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryBooleanInput) [list source [file join $dir entryx.tcl]] +set auto_index(ckEntryInput) [list source [file join $dir entryx.tcl]] +set auto_index(ck_messageBox) [list source [file join $dir msgbox.tcl]] +set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]] +set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]] +set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]] +set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]] +set auto_index(ckFDGetFileTypes) [list source [file join $dir comdlg.tcl]] +set auto_index(ck_optionMenu) [list source [file join $dir optMenu.tcl]] +set auto_index(ck_chooseColor) [list source [file join $dir clrpick.tcl]] +set auto_index(ckColorDialog_Config) [list source [file join $dir clrpick.tcl]] +set auto_index(ckColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]] +set auto_index(ckColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]] +set auto_index(ckColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]] +set auto_index(tkerror) [list source [file join $dir bgerror.tcl]] +set auto_index(bgerror) [list source [file join $dir bgerror.tcl]] diff --git a/library/text.tcl b/library/text.tcl new file mode 100644 index 0000000..79c1523 --- /dev/null +++ b/library/text.tcl @@ -0,0 +1,232 @@ +# text.tcl -- +# +# This file defines the default bindings for text widgets and provides +# procedures that help in implementing the bindings. +# +# Copyright (c) 1992-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. +# + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for texts. +#------------------------------------------------------------------------- + +bind Text { + ckTextSetCursor %W [%W index {insert - 1c}] +} +bind Text { + ckTextSetCursor %W [%W index {insert + 1c}] +} +bind Text { + ckTextSetCursor %W [ckTextUpDownLine %W -1] +} +bind Text { + ckTextSetCursor %W [ckTextUpDownLine %W 1] +} +bind Text { + ckTextSetCursor %W [ckTextScrollPages %W -1] +} +bind Text { + ckTextSetCursor %W [ckTextScrollPages %W 1] +} +bind Text { + ckTextSetCursor %W {insert linestart} +} +bind Text { + ckTextSetCursor %W {insert lineend} +} +bind Text { + ckTextInsert %W \t + focus %W + break +} +bind Text { + ckTextInsert %W \n +} +bind Text { + ckTextInsert %W \n +} +bind Text { + if {[%W tag nextrange sel 1.0 end] != ""} { + %W delete sel.first sel.last + } else { + %W delete insert + %W see insert + } +} +bind Text { + if {[%W tag nextrange sel 1.0 end] != ""} { + %W delete sel.first sel.last + } else { + %W delete insert + %W see insert + } +} +bind Text { + if {[%W tag nextrange sel 1.0 end] != ""} { + %W delete sel.first sel.last + } elseif [%W compare insert != 1.0] { + %W delete insert-1c + %W see insert + } +} +bind Text { + ckTextInsert %W %A +} +bind Text { + if [ckFocusOK %W] { + ckTextSetCursor %W @%x,%y + focus %W + } +} + +# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Otherwise, if a widget binding for one of these is defined, the +# class binding will also fire and insert the character, +# which is wrong. Ditto for . + +bind Text {# nothing} + +bind Text {focus [ck_focusNext %W]} + +bind Text { + ckTextSetCursor %W {insert linestart} +} +bind Text { + ckTextSetCursor %W insert-1c +} +bind Text { + %W delete insert +} +bind Text { + ckTextSetCursor %W {insert lineend} +} +bind Text { + ckTextSetCursor %W insert+1c +} +bind Text { + if [%W compare insert == {insert lineend}] { + %W delete insert + } else { + %W delete insert {insert lineend} + } +} +bind Text { + ckTextSetCursor %W [ckTextUpDownLine %W 1] +} +bind Text { + %W insert insert \n + %W mark set insert insert-1c +} +bind Text { + ckTextSetCursor %W [ckTextUpDownLine %W -1] +} +bind Text { + ckTextScrollPages %W 1 +} +bind Text { + if [%W compare insert != 1.0] { + %W delete insert-1c + %W see insert + } +} +bind Text {%W see insert} + +set ckPriv(prevPos) {} + +# ckTextSetCursor +# Move the insertion cursor to a given position in a text. Also +# clears the selection, if there is one in the text, and makes sure +# that the insertion cursor is visible. Also, don't let the insertion +# cursor appear on the dummy last line of the text. +# +# Arguments: +# w - The text window. +# pos - The desired new position for the cursor in the window. + +proc ckTextSetCursor {w pos} { + global ckPriv + + if [$w compare $pos == end] { + set pos {end - 1 chars} + } + $w mark set insert $pos + $w tag remove sel 1.0 end + $w see insert +} + +# ckTextInsert -- +# Insert a string into a text at the point of the insertion cursor. +# If there is a selection in the text, and it covers the point of the +# insertion cursor, then delete the selection before inserting. +# +# Arguments: +# w - The text window in which to insert the string +# s - The string to insert (usually just a single character) + +proc ckTextInsert {w s} { + if {([string length $s] == 0) || ([$w cget -state] == "disabled")} { + return + } + catch { + if {[$w compare sel.first <= insert] + && [$w compare sel.last >= insert]} { + $w delete sel.first sel.last + } + } + $w insert insert $s + $w see insert +} + +# ckTextUpDownLine -- +# Returns the index of the character one line above or below the +# insertion cursor. There are two tricky things here. First, +# we want to maintain the original column across repeated operations, +# even though some lines that will get passed through don't have +# enough characters to cover the original column. Second, don't +# try to scroll past the beginning or end of the text. +# +# Arguments: +# w - The text window in which the cursor is to move. +# n - The number of lines to move: -1 for up one line, +# +1 for down one line. + +proc ckTextUpDownLine {w n} { + global ckPriv + + set i [$w index insert] + scan $i "%d.%d" line char + if {[string compare $ckPriv(prevPos) $i] != 0} { + set ckPriv(char) $char + } + set new [$w index [expr $line + $n].$ckPriv(char)] + if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} { + set new $i + } + set ckPriv(prevPos) $new + return $new +} + +# ckTextScrollPages -- +# This is a utility procedure used in bindings for moving up and down +# pages and possibly extending the selection along the way. It scrolls +# the view in the widget by the number of pages, and it returns the +# index of the character that is at the same position in the new view +# as the insertion cursor used to be in the old view. +# +# Arguments: +# w - The text window in which the cursor is to move. +# count - Number of pages forward to scroll; may be negative +# to scroll backwards. + +proc ckTextScrollPages {w count} { + set bbox [$w bbox insert] + $w yview scroll $count pages + if {$bbox == ""} { + return [$w index @[expr [winfo height $w]/2],0] + } + return [$w index @[lindex $bbox 0],[lindex $bbox 1]] +} diff --git a/license.terms b/license.terms new file mode 100644 index 0000000..3dcd816 --- /dev/null +++ b/license.terms @@ -0,0 +1,32 @@ +This software is copyrighted by the Regents of the University of +California, Sun Microsystems, Inc., and other parties. The following +terms apply to all files associated with the software unless explicitly +disclaimed in individual files. + +The authors hereby grant permission to use, copy, modify, distribute, +and license this software and its documentation for any purpose, provided +that existing copyright notices are retained in all copies and that this +notice is included verbatim in any distributions. No written agreement, +license, or royalty fee is required for any of the authorized uses. +Modifications to this software may be copyrighted by their authors +and need not follow the licensing terms described here, provided that +the new terms are clearly indicated on the first page of each file where +they apply. + +IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. + +THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +MODIFICATIONS. + +RESTRICTED RIGHTS: Use, duplication or disclosure by the government +is subject to the restrictions as set forth in subparagraph (c) (1) (ii) +of the Rights in Technical Data and Computer Software Clause as DFARS +252.227-7013 and FAR 52.227-19. diff --git a/pkgIndex.tcl b/pkgIndex.tcl new file mode 100644 index 0000000..66be90d --- /dev/null +++ b/pkgIndex.tcl @@ -0,0 +1,11 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +package ifneeded Ck [list load [file join [file dirname $dir] libck.so]] diff --git a/pkgIndex.tcl.in b/pkgIndex.tcl.in new file mode 100644 index 0000000..6c6ea46 --- /dev/null +++ b/pkgIndex.tcl.in @@ -0,0 +1,11 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +package ifneeded Ck @CK_VERSION@ [list load [file join [file dirname $dir] libck@CK_VERSION@.so]] diff --git a/testck.tcl b/testck.tcl new file mode 100644 index 0000000..1eec27b --- /dev/null +++ b/testck.tcl @@ -0,0 +1,75 @@ + +lappend auto_path . +package require Ck +set frame {ulcorner hline urcorner vline lrcorner llcorner} +option add *CkFDialog*Background blue +option add *CkChooseColor*Background green +option add *MenuBar*foreground black +option add *MenuBar*background white +option add *MenuBar*activeBackground black +option add *MenuBar*activeForeground white +option add *MenuBar*selectedBackground black +option add *MenuBar*selectedForeground white +option add *MenuBar*underlineAttributes {underline bold} +option add *MenuBar*underlineForeground yellow +frame .menu -class MenuBar +menubutton .menu.file -text File -underline 0 -menu .menu.file.m +menu .menu.file.m -border $frame +.menu.file.m add command -label "New" -command {fileNew} +.menu.file.m add command -label "Open..." -command {fileOpen} +.menu.file.m add command -label "Save..." -command {fileSave} +.menu.file.m add separator +.menu.file.m add command -label "Exit" -command {destroy .} +menubutton .menu.dialog -text Dialogs -underline 0 -menu .menu.dialog.m +menu .menu.dialog.m -border $frame +.menu.dialog.m add command -label "Message box.." -command {ck_messageBox -title "MessageBox" -message "This is simple message box" -type ok} +.menu.dialog.m add command -label "Color Picker.." -command {ck_chooseColor} +.menu.dialog.m add command -label "Command window.." -command {ckCommand} +label .menu.hint -text "Press for menu" -foreground black -background white +pack .menu.hint -side right +pack .menu.file .menu.dialog -side left -padx 1 +pack .menu -side top -fill x +frame .f +text .f.t -yscrollcommand ".f.y set" -foreground yellow -attributes bold -background blue +scrollbar .f.y -orient vert -command ".f.t yview" +pack .f.t -side left -expand y -fill both +pack .f.y -side right -expand n -fill y +pack .f -side top -expand y -fill both +focus .f.t +bind .f.t {focus .menu.file;.menu.file configure -state active} +proc fileOpen {} { + global fileName + set filename [ck_getOpenFile] + if {![string length filename]} return; + set f [open $filename] + .f.t delete 0.0 end + .f.t insert 0.0 [read $f] + close $f + set fileName $filename + .f.t mark set insert 0.0 + focus .f.t +} + +proc fileSave {} { + global fileName + if {[info exists fileName]} { + set filename [ck_getSaveFile -initialfile $filename] + } else { + set filename [ck_getSaveFile] + } + if {![string length filename]} return; + set f [open $filename w] + puts -nonewline $f [.f.t get 0.0 end] + close $f + set fileName $filename + focus .f.t +} + +proc fileNew {} { + global fileName + catch {unset fileName} + .f.t delete 0.0 end + focus .f.t +} +tkwait window . + diff --git a/tkEvent.c b/tkEvent.c new file mode 100644 index 0000000..96b7276 --- /dev/null +++ b/tkEvent.c @@ -0,0 +1,1897 @@ +/* + * tkEvent.c -- + * + * This file provides basic event-managing facilities, whereby + * procedure callbacks may be attached to certain events. It + * also contains the command procedures for the commands "after" + * and "fileevent", plus abridged versions of "tkwait" and + * "update", for use with Tk_EventInit. + * + * Copyright (c) 1990-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. + */ + +#include "ckPort.h" +#include "ck.h" + +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + +/* + * For each timer callback that's pending, there is one record + * of the following type, chained together in a list sorted by + * time (earliest event first). + */ + +typedef struct TimerEvent { + struct timeval time; /* When timer is to fire. */ + void (*proc) _ANSI_ARGS_((ClientData clientData)); + /* Procedure to call. */ + ClientData clientData; /* Argument to pass to proc. */ + Tk_TimerToken token; /* Identifies event so it can be + * deleted. */ + struct TimerEvent *nextPtr; /* Next event in queue, or NULL for + * end of queue. */ +} TimerEvent; + +static TimerEvent *firstTimerHandlerPtr; + /* First event in queue. */ + +/* + * The information below is used to provide read, write, and + * exception masks to select during calls to Tk_DoOneEvent. + */ + +static fd_mask ready[3*MASK_SIZE]; + /* Masks passed to select and modified + * by kernel to indicate which files are + * actually ready. */ +static fd_mask check[3*MASK_SIZE]; + /* Temporary set of masks, built up during + * Tk_DoOneEvent, that reflects what files + * we should wait for in the next select + * (doesn't include things that we've been + * asked to ignore in this call). */ +static int numFds = 0; /* Number of valid bits in mask + * arrays (this value is passed + * to select). */ + +/* + * For each file registered in a call to Tk_CreateFileHandler, + * and for each display that's currently active, there is one + * record of the following type. All of these records are + * chained together into a single list. + */ + +typedef struct FileHandler { + int fd; /* POSIX file descriptor for file. */ + fd_mask *readPtr; /* Pointer to word in ready array + * for this file's read mask bit. */ + fd_mask *writePtr; /* Same for write mask bit. */ + fd_mask *exceptPtr; /* Same for except mask bit. */ + fd_mask *checkReadPtr; /* Pointer to word in check array for + * this file's read mask bit. */ + fd_mask *checkWritePtr; /* Same for write mask bit. */ + fd_mask *checkExceptPtr; /* Same for except mask bit. */ + fd_mask bitSelect; /* Value to AND with *readPtr etc. to + * select just this file's bit. */ + int mask; /* Mask of desired events: TK_READABLE, etc. */ + Tk_FileProc *proc; /* Procedure to call, in the style of + * Tk_CreateFileHandler. This is NULL + * if the handler was created by + * Tk_CreateFileHandler2. */ + Tk_FileProc2 *proc2; /* Procedure to call, in the style of + * Tk_CreateFileHandler2. NULL means that + * the handler was created by + * Tk_CreateFileHandler. */ + ClientData clientData; /* Argument to pass to proc. */ + struct FileHandler *nextPtr;/* Next in list of all files we + * care about (NULL for end of + * list). */ +} FileHandler; + +static FileHandler *firstFileHandlerPtr; + /* List of all file events. */ + +/* + * There is one of the following structures for each of the + * handlers declared in a call to Tk_DoWhenIdle. All of the + * currently-active handlers are linked together into a list. + */ + +typedef struct IdleHandler { + void (*proc) _ANSI_ARGS_((ClientData clientData)); + /* Procedure to call. */ + ClientData clientData; /* Value to pass to proc. */ + int generation; /* Used to distinguish older handlers from + * recently-created ones. */ + struct IdleHandler *nextPtr;/* Next in list of active handlers. */ +} IdleHandler; + +static IdleHandler *idleList = NULL; + /* First in list of all idle handlers. */ +static IdleHandler *lastIdlePtr = NULL; + /* Last in list (or NULL for empty list). */ +static int idleGeneration = 0; /* Used to fill in the "generation" fields + * of IdleHandler structures. Increments + * each time Tk_DoOneEvent starts calling + * idle handlers, so that all old handlers + * can be called without calling any of the + * new ones created by old ones. */ +static int oldGeneration = 0; /* "generation" currently being handled. */ + +/* + * The following procedure provides a secret hook for tkXEvent.c so that + * it can handle delayed mouse motion events at the right time. + */ + +void (*tkDelayedEventProc) _ANSI_ARGS_((void)) = NULL; + +/* + * One of the following structures exists for each file with a handler + * created by the "fileevent" command. Several of the fields are + * two-element arrays, in which the first element is used for read + * events and the second for write events. + */ + +typedef struct FileEvent { + FILE *f; /* Stdio handle for file. */ + Tcl_Interp *interps[2]; /* Interpreters in which to execute + * scripts. NULL means no handler + * for event. */ + char *scripts[2]; /* Scripts to evaluate in response to + * events (malloc'ed). NULL means no + * handler for event. */ + struct FileEvent *nextPtr; /* Next in list of all file events + * currently defined. */ +} FileEvent; + +static FileEvent *firstFileEventPtr = NULL; + /* First in list of all existing + * file events. */ + +/* + * The data structure below is used by the "after" command to remember + * the command to be executed later. + */ + +typedef struct AfterInfo { + Tcl_Interp *interp; /* Interpreter in which to execute command. */ + char *command; /* Command to execute. Malloc'ed, so must + * be freed when structure is deallocated. */ + int id; /* Integer identifier for command; used to + * cancel it. */ + Tk_TimerToken token; /* Used to cancel the "after" command. NULL + * means that the command is run as an + * idle handler rather than as a timer + * handler. */ + struct AfterInfo *nextPtr; /* Next in list of all "after" commands for + * the application. */ +} AfterInfo; + +static AfterInfo *firstAfterPtr = NULL; + /* First in list of all pending "after" + * commands. */ + +/* + * The data structure below is used to report background errors. One + * such structure is allocated for each error; it holds information + * about the interpreter and the error until tkerror can be invoked + * later as an idle handler. + */ + +typedef struct BgError { + Tcl_Interp *interp; /* Interpreter in which error occurred. NULL + * means this error report has been cancelled + * (a previous report generated a break). */ + char *errorMsg; /* The error message (interp->result when + * the error occurred). Malloc-ed. */ + char *errorInfo; /* Value of the errorInfo variable + * (malloc-ed). */ + char *errorCode; /* Value of the errorCode variable + * (malloc-ed). */ + struct BgError *nextPtr; /* Next in list of all pending error + * reports. */ +} BgError; + +static BgError *firstBgPtr = NULL; + /* First in list of all background errors + * waiting to be processed (NULL if none). */ +static BgError *lastBgPtr = NULL; + /* First in list of all background errors + * waiting to be processed (NULL if none). */ + +/* + * Prototypes for procedures referenced only in this file: + */ + +static void AfterProc _ANSI_ARGS_((ClientData clientData)); +static void DeleteFileEvent _ANSI_ARGS_((FILE *f)); +static int FileEventProc _ANSI_ARGS_((ClientData clientData, + int mask, int flags)); +static void FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr)); +static void HandleBgErrors _ANSI_ARGS_((ClientData clientData)); +static int TkwaitCmd2 _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int UpdateCmd2 _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static char * WaitVariableProc2 _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); + +/* + *-------------------------------------------------------------- + * + * Tk_CreateFileHandler -- + * + * Arrange for a given procedure to be invoked whenever + * a given file becomes readable or writable. + * + * Results: + * None. + * + * Side effects: + * From now on, whenever the I/O channel given by fd becomes + * ready in the way indicated by mask, proc will be invoked. + * See the manual entry for details on the calling sequence + * to proc. If fd is already registered then the old mask + * and proc and clientData values will be replaced with + * new ones. + * + *-------------------------------------------------------------- + */ + +void +Tk_CreateFileHandler(fd, mask, proc, clientData) + int fd; /* Integer identifier for stream. */ + int mask; /* OR'ed combination of TK_READABLE, + * TK_WRITABLE, and TK_EXCEPTION: + * indicates conditions under which + * proc should be called. TK_IS_DISPLAY + * indicates that this is a display and that + * clientData is the (Display *) for it, + * and that events should be handled + * automatically.*/ + Tk_FileProc *proc; /* Procedure to call for each + * selected event. */ + ClientData clientData; /* Arbitrary data to pass to proc. */ +{ + register FileHandler *filePtr; + int index; + + if (fd >= FD_SETSIZE) { + panic("Tk_CreatefileHandler can't handle file id %d", fd); + } + + /* + * Make sure the file isn't already registered. Create a + * new record in the normal case where there's no existing + * record. + */ + + for (filePtr = firstFileHandlerPtr; filePtr != NULL; + filePtr = filePtr->nextPtr) { + if (filePtr->fd == fd) { + break; + } + } + index = fd/(NBBY*sizeof(fd_mask)); + if (filePtr == NULL) { + filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr->fd = fd; + filePtr->readPtr = &ready[index]; + filePtr->writePtr = &ready[index+MASK_SIZE]; + filePtr->exceptPtr = &ready[index+2*MASK_SIZE]; + filePtr->checkReadPtr = &check[index]; + filePtr->checkWritePtr = &check[index+MASK_SIZE]; + filePtr->checkExceptPtr = &check[index+2*MASK_SIZE]; + filePtr->bitSelect = 1 << (fd%(NBBY*sizeof(fd_mask))); + filePtr->nextPtr = firstFileHandlerPtr; + firstFileHandlerPtr = filePtr; + } + + /* + * The remainder of the initialization below is done + * regardless of whether or not this is a new record + * or a modification of an old one. + */ + + filePtr->mask = mask; + filePtr->proc = proc; + filePtr->proc2 = NULL; + filePtr->clientData = clientData; + + if (numFds <= fd) { + numFds = fd+1; + } +} + +/* + *-------------------------------------------------------------- + * + * Tk_CreateFileHandler2 -- + * + * Arrange for a given procedure to be invoked during the + * event loop to handle a particular file. + * + * Results: + * None. + * + * Side effects: + * In each pass through Tk_DoOneEvent, proc will be invoked to + * decide whether fd is "ready" and take appropriate action if + * it is. See the manual entry for details on the calling + * sequence to proc. If a handler for fd has already been + * registered then it is superseded by the new one. + * + *-------------------------------------------------------------- + */ + +void +Tk_CreateFileHandler2(fd, proc, clientData) + int fd; /* Integer identifier for stream. */ + Tk_FileProc2 *proc; /* Procedure to call from the event + * dispatcher. */ + ClientData clientData; /* Arbitrary data to pass to proc. */ +{ + register FileHandler *filePtr; + + /* + * Let Tk_CreateFileHandler do all of the work of setting up + * the handler, then just modify things a bit after it returns. + */ + + Tk_CreateFileHandler(fd, 0, (Tk_FileProc *) NULL, clientData); + for (filePtr = firstFileHandlerPtr; filePtr->fd != fd; + filePtr = filePtr->nextPtr) { + /* Empty loop body. */ + } + filePtr->proc = NULL; + filePtr->proc2 = proc; +} + +/* + *-------------------------------------------------------------- + * + * Tk_DeleteFileHandler -- + * + * Cancel a previously-arranged callback arrangement for + * a file. + * + * Results: + * None. + * + * Side effects: + * If a callback was previously registered on fd, remove it. + * + *-------------------------------------------------------------- + */ + +void +Tk_DeleteFileHandler(fd) + int fd; /* Stream id for which to remove + * callback procedure. */ +{ + register FileHandler *filePtr; + FileHandler *prevPtr; + + /* + * Find the entry for the given file (and return if there + * isn't one). + */ + + for (prevPtr = NULL, filePtr = firstFileHandlerPtr; ; + prevPtr = filePtr, filePtr = filePtr->nextPtr) { + if (filePtr == NULL) { + return; + } + if (filePtr->fd == fd) { + break; + } + } + + /* + * Clean up information in the callback record. + */ + + if (prevPtr == NULL) { + firstFileHandlerPtr = filePtr->nextPtr; + } else { + prevPtr->nextPtr = filePtr->nextPtr; + } + ckfree((char *) filePtr); + + /* + * Recompute numFds. + */ + + numFds = 0; + for (filePtr = firstFileHandlerPtr; filePtr != NULL; + filePtr = filePtr->nextPtr) { + if (numFds <= filePtr->fd) { + numFds = filePtr->fd+1; + } + } +} + +/* + *-------------------------------------------------------------- + * + * Tk_CreateTimerHandler -- + * + * Arrange for a given procedure to be invoked at a particular + * time in the future. + * + * Results: + * The return value is a token for the timer event, which + * may be used to delete the event before it fires. + * + * Side effects: + * When milliseconds have elapsed, proc will be invoked + * exactly once. + * + *-------------------------------------------------------------- + */ + +Tk_TimerToken +Tk_CreateTimerHandler(milliseconds, proc, clientData) + int milliseconds; /* How many milliseconds to wait + * before invoking proc. */ + Tk_TimerProc *proc; /* Procedure to invoke. */ + ClientData clientData; /* Arbitrary data to pass to proc. */ +{ + register TimerEvent *timerPtr, *tPtr2, *prevPtr; + static int id = 0; + + timerPtr = (TimerEvent *) ckalloc(sizeof(TimerEvent)); + + /* + * Compute when the event should fire. + */ + + (void) gettimeofday(&timerPtr->time, (struct timezone *) NULL); + timerPtr->time.tv_sec += milliseconds/1000; + timerPtr->time.tv_usec += (milliseconds%1000)*1000; + if (timerPtr->time.tv_usec >= 1000000) { + timerPtr->time.tv_usec -= 1000000; + timerPtr->time.tv_sec += 1; + } + + /* + * Fill in other fields for the event. + */ + + timerPtr->proc = proc; + timerPtr->clientData = clientData; + id++; + timerPtr->token = (Tk_TimerToken) id; + + /* + * Add the event to the queue in the correct position + * (ordered by event firing time). + */ + + for (tPtr2 = firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; + prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) { + if ((tPtr2->time.tv_sec > timerPtr->time.tv_sec) + || ((tPtr2->time.tv_sec == timerPtr->time.tv_sec) + && (tPtr2->time.tv_usec > timerPtr->time.tv_usec))) { + break; + } + } + if (prevPtr == NULL) { + timerPtr->nextPtr = firstTimerHandlerPtr; + firstTimerHandlerPtr = timerPtr; + } else { + timerPtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = timerPtr; + } + return timerPtr->token; +} + +/* + *-------------------------------------------------------------- + * + * Tk_DeleteTimerHandler -- + * + * Delete a previously-registered timer handler. + * + * Results: + * None. + * + * Side effects: + * Destroy the timer callback identified by TimerToken, + * so that its associated procedure will not be called. + * If the callback has already fired, or if the given + * token doesn't exist, then nothing happens. + * + *-------------------------------------------------------------- + */ + +void +Tk_DeleteTimerHandler(token) + Tk_TimerToken token; /* Result previously returned by + * Tk_DeleteTimerHandler. */ +{ + register TimerEvent *timerPtr, *prevPtr; + + for (timerPtr = firstTimerHandlerPtr, prevPtr = NULL; timerPtr != NULL; + prevPtr = timerPtr, timerPtr = timerPtr->nextPtr) { + if (timerPtr->token != token) { + continue; + } + if (prevPtr == NULL) { + firstTimerHandlerPtr = timerPtr->nextPtr; + } else { + prevPtr->nextPtr = timerPtr->nextPtr; + } + ckfree((char *) timerPtr); + return; + } +} + +/* + *-------------------------------------------------------------- + * + * Tk_DoWhenIdle -- + * + * Arrange for proc to be invoked the next time the + * system is idle (i.e., just before the next time + * that Tk_DoOneEvent would have to wait for something + * to happen). + * + * Results: + * None. + * + * Side effects: + * Proc will eventually be called, with clientData + * as argument. See the manual entry for details. + * + *-------------------------------------------------------------- + */ + +void +Tk_DoWhenIdle(proc, clientData) + Tk_IdleProc *proc; /* Procedure to invoke. */ + ClientData clientData; /* Arbitrary value to pass to proc. */ +{ + register IdleHandler *idlePtr; + + idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler)); + idlePtr->proc = proc; + idlePtr->clientData = clientData; + idlePtr->generation = idleGeneration; + idlePtr->nextPtr = NULL; + if (lastIdlePtr == NULL) { + idleList = idlePtr; + } else { + lastIdlePtr->nextPtr = idlePtr; + } + lastIdlePtr = idlePtr; +} + +/* + *-------------------------------------------------------------- + * + * Tk_DoWhenIdle2 -- + * + * Arrange for proc to be invoked when the system is idle + * (i.e., if currently idle or just before the next time + * that Tk_DoOneEvent would have to wait for something + * to happen). + * + * Results: + * None. + * + * Side effects: + * Proc will eventually be called, with clientData + * as argument. See the manual entry for details. + * + *-------------------------------------------------------------- + */ + +void +Tk_DoWhenIdle2(proc, clientData) + Tk_IdleProc *proc; /* Procedure to invoke. */ + ClientData clientData; /* Arbitrary value to pass to proc. */ +{ + register IdleHandler *idlePtr; + + idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler)); + idlePtr->proc = proc; + idlePtr->clientData = clientData; + idlePtr->generation = idleList == NULL ? oldGeneration : + idleList->generation; + idlePtr->nextPtr = NULL; + if (lastIdlePtr == NULL) { + idleList = idlePtr; + } else { + lastIdlePtr->nextPtr = idlePtr; + } + lastIdlePtr = idlePtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_CancelIdleCall -- + * + * If there are any when-idle calls requested to a given procedure + * with given clientData, cancel all of them. + * + * Results: + * None. + * + * Side effects: + * If the proc/clientData combination were on the when-idle list, + * they are removed so that they will never be called. + * + *---------------------------------------------------------------------- + */ + +void +Tk_CancelIdleCall(proc, clientData) + Tk_IdleProc *proc; /* Procedure that was previously registered. */ + ClientData clientData; /* Arbitrary value to pass to proc. */ +{ + register IdleHandler *idlePtr, *prevPtr; + IdleHandler *nextPtr; + + for (prevPtr = NULL, idlePtr = idleList; idlePtr != NULL; + prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { + while ((idlePtr->proc == proc) + && (idlePtr->clientData == clientData)) { + nextPtr = idlePtr->nextPtr; + ckfree((char *) idlePtr); + idlePtr = nextPtr; + if (prevPtr == NULL) { + idleList = idlePtr; + } else { + prevPtr->nextPtr = idlePtr; + } + if (idlePtr == NULL) { + lastIdlePtr = prevPtr; + return; + } + } + } +} + +/* + *-------------------------------------------------------------- + * + * Tk_DoOneEvent -- + * + * Process a single event of some sort. If there's no + * work to do, wait for an event to occur, then process + * it. + * + * Results: + * The return value is 1 if the procedure actually found + * an event to process. If no event was found then 0 is + * returned. + * + * Side effects: + * May delay execution of process while waiting for an + * X event, X error, file-ready event, or timer event. + * The handling of the event could cause additional + * side effects. Collapses sequences of mouse-motion + * events for the same window into a single event by + * delaying motion event processing. + * + *-------------------------------------------------------------- + */ + +int +Tk_DoOneEvent(flags) + int flags; /* Miscellaneous flag values: may be any + * combination of TK_DONT_WAIT, TK_X_EVENTS, + * TK_FILE_EVENTS, TK_TIMER_EVENTS, and + * TK_IDLE_EVENTS. */ +{ + register FileHandler *filePtr; + struct timeval curTime, timeoutVal, *timeoutPtr; + int numFound, mask, anyFilesToWaitFor; + + if ((flags & TK_ALL_EVENTS) == 0) { + flags |= TK_ALL_EVENTS; + } + + /* + * Phase One: see if there's a ready file that was left over + * from before (i.e don't do a select, just check the bits from + * the last select). + */ + + checkFiles: + if (tcl_AsyncReady) { + (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0); + return 1; + } + memset((VOID *) check, 0, 3*MASK_SIZE*sizeof(fd_mask)); + anyFilesToWaitFor = 0; + for (filePtr = firstFileHandlerPtr; filePtr != NULL; + filePtr = filePtr->nextPtr) { + mask = 0; + if (*filePtr->readPtr & filePtr->bitSelect) { + mask |= TK_READABLE; + *filePtr->readPtr &= ~filePtr->bitSelect; + } + if (*filePtr->writePtr & filePtr->bitSelect) { + mask |= TK_WRITABLE; + *filePtr->writePtr &= ~filePtr->bitSelect; + } + if (*filePtr->exceptPtr & filePtr->bitSelect) { + mask |= TK_EXCEPTION; + *filePtr->exceptPtr &= ~filePtr->bitSelect; + } + if (filePtr->proc2 != NULL) { + /* + * Handler created by Tk_CreateFileHandler2. + */ + + mask = (*filePtr->proc2)(filePtr->clientData, mask, flags); + if (mask == TK_FILE_HANDLED) { + return 1; + } + } else { + /* + * Handler created by Tk_CreateFileHandler. + */ + + if (!(flags & TK_FILE_EVENTS)) { + continue; + } + if (mask != 0) { + (*filePtr->proc)(filePtr->clientData, mask); + return 1; + } + mask = filePtr->mask; + } + if (mask != 0) { + anyFilesToWaitFor = 1; + if (mask & TK_READABLE) { + *filePtr->checkReadPtr |= filePtr->bitSelect; + } + if (mask & TK_WRITABLE) { + *filePtr->checkWritePtr |= filePtr->bitSelect; + } + if (mask & TK_EXCEPTION) { + *filePtr->checkExceptPtr |= filePtr->bitSelect; + } + } + } + + /* + * Phase Two: get the current time and see if any timer + * events are ready to fire. If so, fire one and return. + */ + + checkTime: + if ((firstTimerHandlerPtr != NULL) && (flags & TK_TIMER_EVENTS)) { + register TimerEvent *timerPtr = firstTimerHandlerPtr; + + (void) gettimeofday(&curTime, (struct timezone *) NULL); + if ((timerPtr->time.tv_sec < curTime.tv_sec) + || ((timerPtr->time.tv_sec == curTime.tv_sec) + && (timerPtr->time.tv_usec < curTime.tv_usec))) { + firstTimerHandlerPtr = timerPtr->nextPtr; + (*timerPtr->proc)(timerPtr->clientData); + ckfree((char *) timerPtr); + return 1; + } + } + + /* + * Phase Three: if there are DoWhenIdle requests pending (or + * if we're not allowed to block), then do a select with an + * instantaneous timeout. If a ready file is found, then go + * back to process it. + */ + + if (((idleList != NULL) && (flags & TK_IDLE_EVENTS)) + || (flags & TK_DONT_WAIT)) { + if (flags & (TK_X_EVENTS|TK_FILE_EVENTS)) { + memcpy((VOID *) ready, (VOID *) check, + 3*MASK_SIZE*sizeof(fd_mask)); + timeoutVal.tv_sec = timeoutVal.tv_usec = 0; + numFound = select(numFds, (SELECT_MASK *) &ready[0], + (SELECT_MASK *) &ready[MASK_SIZE], + (SELECT_MASK *) &ready[2*MASK_SIZE], &timeoutVal); + if (numFound <= 0) { + /* + * Some systems don't clear the masks after an error, so + * we have to do it here. + */ + + memset((VOID *) ready, 0, 3*MASK_SIZE*sizeof(fd_mask)); + } + if ((numFound > 0) || ((numFound == -1) && (errno == EINTR))) { + goto checkFiles; + } + } + } + + /* + * Phase Four: if there is a delayed motion event then call a procedure + * to handle it. Do it now, before calling any DoWhenIdle handlers, + * since the goal of idle handlers is to delay until after all pending + * events have been processed. + * + * The particular implementation of this (a procedure variable shared + * with tkXEvent.c) is a bit kludgy, but it allows this file to be used + * separately without any of the rest of Tk. + */ + + if ((tkDelayedEventProc != NULL) && (flags & TK_X_EVENTS)) { + (*tkDelayedEventProc)(); + return 1; + } + + /* + * Phase Five: process all pending DoWhenIdle requests. + */ + + if ((idleList != NULL) && (flags & TK_IDLE_EVENTS)) { + register IdleHandler *idlePtr; + int myGeneration; + + oldGeneration = myGeneration = idleList->generation; + idleGeneration++; + + /* + * The code below is trickier than it may look, for the following + * reasons: + * + * 1. New handlers can get added to the list while the current + * one is being processed. If new ones get added, we don't + * want to process them during this pass through the list (want + * to check for other work to do first). This is implemented + * using the generation number in the handler: new handlers + * will have a different generation than any of the ones currently + * on the list. + * 2. The handler can call Tk_DoOneEvent, so we have to remove + * the hander from the list before calling it. Otherwise an + * infinite loop could result. + * 3. Tk_CancelIdleCall can be called to remove an element from + * the list while a handler is executing, so the list could + * change structure during the call. + */ + + for (idlePtr = idleList; + ((idlePtr != NULL) && (idlePtr->generation == myGeneration)); + idlePtr = idleList) { + idleList = idlePtr->nextPtr; + if (idleList == NULL) { + lastIdlePtr = NULL; + } + (*idlePtr->proc)(idlePtr->clientData); + ckfree((char *) idlePtr); + } + return 1; + } + + /* + * Phase Six: do a select to wait for either one of the + * files to become ready or for the first timer event to + * fire. Then go back to process the event. + */ + + if ((flags & TK_DONT_WAIT) + || !(flags & (TK_TIMER_EVENTS|TK_FILE_EVENTS|TK_X_EVENTS))) { + return 0; + } + if ((firstTimerHandlerPtr == NULL) || !(flags & TK_TIMER_EVENTS)) { + timeoutPtr = NULL; + } else { + timeoutPtr = &timeoutVal; + timeoutVal.tv_sec = firstTimerHandlerPtr->time.tv_sec + - curTime.tv_sec; + timeoutVal.tv_usec = firstTimerHandlerPtr->time.tv_usec + - curTime.tv_usec; + if (timeoutVal.tv_usec < 0) { + timeoutVal.tv_sec -= 1; + timeoutVal.tv_usec += 1000000; + } + } + if ((timeoutPtr == NULL) && !anyFilesToWaitFor) { + return 0; + } + memcpy((VOID *) ready, (VOID *) check, 3*MASK_SIZE*sizeof(fd_mask)); + numFound = select(numFds, (SELECT_MASK *) &ready[0], + (SELECT_MASK *) &ready[MASK_SIZE], + (SELECT_MASK *) &ready[2*MASK_SIZE], timeoutPtr); + if (numFound == -1) { + /* + * Some systems don't clear the masks after an error, so + * we have to do it here. + */ + + memset((VOID *) ready, 0, 3*MASK_SIZE*sizeof(fd_mask)); + } + if (numFound == 0) { + goto checkTime; + } + goto checkFiles; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_Sleep -- + * + * Delay execution for the specified number of milliseconds. + * + * Results: + * None. + * + * Side effects: + * Time passes. + * + *---------------------------------------------------------------------- + */ + +void +Tk_Sleep(ms) + int ms; /* Number of milliseconds to sleep. */ +{ + static struct timeval delay; + + delay.tv_sec = ms/1000; + delay.tv_usec = (ms%1000)*1000; + (void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0, + (SELECT_MASK *) 0, &delay); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_BackgroundError -- + * + * This procedure is invoked to handle errors that occur in Tcl + * commands that are invoked in "background" (e.g. from event or + * timer bindings). + * + * Results: + * None. + * + * Side effects: + * The command "tkerror" is invoked later as an idle handler to + * process the error, passing it the error message. If that fails, + * then an error message is output on stderr. + * + *---------------------------------------------------------------------- + */ + +void +Tk_BackgroundError(interp) + Tcl_Interp *interp; /* Interpreter in which an error has + * occurred. */ +{ + BgError *errPtr; + char *varValue; + + /* + * The Tcl_AddErrorInfo call below (with an empty string) ensures that + * errorInfo gets properly set. It's needed in cases where the error + * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval; + * in these cases errorInfo still won't have been set when this + * procedure is called. + */ + + Tcl_AddErrorInfo(interp, ""); + errPtr = (BgError *) ckalloc(sizeof(BgError)); + errPtr->interp = interp; + errPtr->errorMsg = (char *) ckalloc((unsigned) (strlen(interp->result) + + 1)); + strcpy(errPtr->errorMsg, interp->result); + varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + if (varValue == NULL) { + varValue = errPtr->errorMsg; + } + errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1)); + strcpy(errPtr->errorInfo, varValue); + varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); + if (varValue == NULL) { + varValue = ""; + } + errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1)); + strcpy(errPtr->errorCode, varValue); + errPtr->nextPtr = NULL; + if (firstBgPtr == NULL) { + firstBgPtr = errPtr; + Tk_DoWhenIdle(HandleBgErrors, (ClientData) NULL); + } else { + lastBgPtr->nextPtr = errPtr; + } + lastBgPtr = errPtr; + Tcl_ResetResult(interp); +} + +/* + *---------------------------------------------------------------------- + * + * HandleBgErrors -- + * + * This procedure is invoked as an idle handler to process all of + * the accumulated background errors. + * + * Results: + * None. + * + * Side effects: + * Depends on what actions "tkerror" takes for the errors. + * + *---------------------------------------------------------------------- + */ + +static void +HandleBgErrors(clientData) + ClientData clientData; /* Not used. */ +{ + Tcl_Interp *interp; + char *command; + char *argv[2]; + int code; + BgError *errPtr; + + while (firstBgPtr != NULL) { + interp = firstBgPtr->interp; + if (interp == NULL) { + goto doneWithReport; + } + + /* + * Restore important state variables to what they were at + * the time the error occurred. + */ + + Tcl_SetVar(interp, "errorInfo", firstBgPtr->errorInfo, + TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "errorCode", firstBgPtr->errorCode, + TCL_GLOBAL_ONLY); + + /* + * Create and invoke the tkerror command. + */ + + argv[0] = "tkerror"; + argv[1] = firstBgPtr->errorMsg; + command = Tcl_Merge(2, argv); + Tcl_AllowExceptions(interp); + code = Tcl_GlobalEval(interp, command); + ckfree(command); + if (code == TCL_ERROR) { + if (strcmp(interp->result, "\"tkerror\" is an invalid command name or ambiguous abbreviation") == 0) { + fprintf(stderr, "%s\n", firstBgPtr->errorInfo); + } else { + fprintf(stderr, "tkerror failed to handle background error.\n"); + fprintf(stderr, " Original error: %s\n", + firstBgPtr->errorMsg); + fprintf(stderr, " Error in tkerror: %s\n", interp->result); + } + } else if (code == TCL_BREAK) { + /* + * Break means cancel any remaining error reports for this + * interpreter. + */ + + for (errPtr = firstBgPtr; errPtr != NULL; + errPtr = errPtr->nextPtr) { + if (errPtr->interp == interp) { + errPtr->interp = NULL; + } + } + } + + /* + * Discard the command and the information about the error report. + */ + + doneWithReport: + ckfree(firstBgPtr->errorMsg); + ckfree(firstBgPtr->errorInfo); + ckfree(firstBgPtr->errorCode); + errPtr = firstBgPtr->nextPtr; + ckfree((char *) firstBgPtr); + firstBgPtr = errPtr; + } + lastBgPtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_AfterCmd -- + * + * This procedure is invoked to process the "after" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +int +Tk_AfterCmd(clientData, interp, argc, argv) + ClientData clientData; /* Main window associated with + * interpreter. Not used.*/ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + /* + * The variable below is used to generate unique identifiers for + * after commands. This id can wrap around, which can potentially + * cause problems. However, there are not likely to be problems + * in practice, because after commands can only be requested to + * about a month in the future, and wrap-around is unlikely to + * occur in less than about 1-10 years. Thus it's unlikely that + * any old ids will still be around when wrap-around occurs. + */ + + static int nextId = 1; + int ms, id; + AfterInfo *afterPtr; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " milliseconds ?command? ?arg arg ...?\" or \"", + argv[0], " cancel id|command\"", (char *) NULL); + return TCL_ERROR; + } + + if (isdigit((unsigned char) argv[1][0])) { + if (Tcl_GetInt(interp, argv[1], &ms) != TCL_OK) { + return TCL_ERROR; + } + if (ms < 0) { + ms = 0; + } + if (argc == 2) { + Tk_Sleep(ms); + return TCL_OK; + } + afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); + afterPtr->interp = interp; + if (argc == 3) { + afterPtr->command = (char *) ckalloc((unsigned) + (strlen(argv[2]) + 1)); + strcpy(afterPtr->command, argv[2]); + } else { + afterPtr->command = Tcl_Concat(argc-2, argv+2); + } + afterPtr->id = nextId; + nextId += 1; + afterPtr->token = Tk_CreateTimerHandler(ms, AfterProc, + (ClientData) afterPtr); + afterPtr->nextPtr = firstAfterPtr; + firstAfterPtr = afterPtr; + sprintf(interp->result, "after#%d", afterPtr->id); + } else if (strncmp(argv[1], "cancel", strlen(argv[1])) == 0) { + char *arg; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " cancel id|command\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 3) { + arg = argv[2]; + } else { + arg = Tcl_Concat(argc-2, argv+2); + } + if (strncmp(arg, "after#", 6) == 0) { + if (Tcl_GetInt(interp, arg+6, &id) != TCL_OK) { + return TCL_ERROR; + } + for (afterPtr = firstAfterPtr; afterPtr != NULL; + afterPtr = afterPtr->nextPtr) { + if (afterPtr->id == id) { + break; + } + } + } else { + for (afterPtr = firstAfterPtr; afterPtr != NULL; + afterPtr = afterPtr->nextPtr) { + if (strcmp(afterPtr->command, arg) == 0) { + break; + } + } + } + if (arg != argv[2]) { + ckfree(arg); + } + if (afterPtr != NULL) { + if (afterPtr->token != NULL) { + Tk_DeleteTimerHandler(afterPtr->token); + } else { + Tk_CancelIdleCall(AfterProc, (ClientData) afterPtr); + } + FreeAfterPtr(afterPtr); + } + } else if (strncmp(argv[1], "idle", strlen(argv[1])) == 0) { + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " idle script script ...\"", (char *) NULL); + return TCL_ERROR; + } + afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); + afterPtr->interp = interp; + if (argc == 3) { + afterPtr->command = (char *) ckalloc((unsigned) + (strlen(argv[2]) + 1)); + strcpy(afterPtr->command, argv[2]); + } else { + afterPtr->command = Tcl_Concat(argc-2, argv+2); + } + afterPtr->id = nextId; + nextId += 1; + afterPtr->token = NULL; + afterPtr->nextPtr = firstAfterPtr; + firstAfterPtr = afterPtr; + Tk_DoWhenIdle(AfterProc, (ClientData) afterPtr); + sprintf(interp->result, "after#%d", afterPtr->id); + } else { + Tcl_AppendResult(interp, "bad argument \"", argv[1], + "\": must be cancel, idle, or a number", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * AfterProc -- + * + * Timer callback to execute commands registered with the + * "after" command. + * + * Results: + * None. + * + * Side effects: + * Executes whatever command was specified. If the command + * returns an error, then the command "tkerror" is invoked + * to process the error; if tkerror fails then information + * about the error is output on stderr. + * + *---------------------------------------------------------------------- + */ + +static void +AfterProc(clientData) + ClientData clientData; /* Describes command to execute. */ +{ + AfterInfo *afterPtr = (AfterInfo *) clientData; + AfterInfo *prevPtr; + int result; + + /* + * First remove the callback from our list of callbacks; otherwise + * someone could delete the callback while it's being executed, which + * could cause a core dump. + */ + + if (firstAfterPtr == afterPtr) { + firstAfterPtr = afterPtr->nextPtr; + } else { + for (prevPtr = firstAfterPtr; prevPtr->nextPtr != afterPtr; + prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + prevPtr->nextPtr = afterPtr->nextPtr; + } + + /* + * Execute the callback. + */ + + result = Tcl_GlobalEval(afterPtr->interp, afterPtr->command); + if (result != TCL_OK) { + Tcl_AddErrorInfo(afterPtr->interp, "\n (\"after\" script)"); + Tk_BackgroundError(afterPtr->interp); + } + + /* + * Free the memory for the callback. + */ + + ckfree(afterPtr->command); + ckfree((char *) afterPtr); +} + +/* + *---------------------------------------------------------------------- + * + * FreeAfterPtr -- + * + * This procedure removes an "after" command from the list of + * those that are pending and frees its resources. This procedure + * does *not* cancel the timer handler; if that's needed, the + * caller must do it. + * + * Results: + * None. + * + * Side effects: + * The memory associated with afterPtr is released. + * + *---------------------------------------------------------------------- + */ + +static void +FreeAfterPtr(afterPtr) + AfterInfo *afterPtr; /* Command to be deleted. */ +{ + AfterInfo *prevPtr; + if (firstAfterPtr == afterPtr) { + firstAfterPtr = afterPtr->nextPtr; + } else { + for (prevPtr = firstAfterPtr; prevPtr->nextPtr != afterPtr; + prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + prevPtr->nextPtr = afterPtr->nextPtr; + } + ckfree(afterPtr->command); + ckfree((char *) afterPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_FileeventCmd -- + * + * This procedure is invoked to process the "fileevent" Tcl + * command. See the user documentation for details on what it does. + * This command is based on Mark Diekhans' "addinput" command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +int +Tk_FileeventCmd(clientData, interp, argc, argv) + ClientData clientData; /* Main window associated with interpreter. + * Not used.*/ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + FILE *f; + int index, fd, c; + size_t length; + FileEvent *fevPtr, *prevPtr; + + /* + * Parse arguments. + */ + + if ((argc != 3) && (argc != 4)) { + Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0], + " fileId event ?script?", (char *) NULL); + return TCL_ERROR; + } + c = argv[2][0]; + length = strlen(argv[2]); + if ((c == 'r') && (strncmp(argv[2], "readable", length) == 0)) { + index = 0; + } else if ((c == 'w') && (strncmp(argv[2], "writable", length) == 0)) { + index = 1; + } else { + Tcl_AppendResult(interp, "bad event name \"", argv[2], + "\": must be readable or writable", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_GetOpenFile(interp, argv[1], index, 1, &f) != TCL_OK) { + return TCL_ERROR; + } + fd = fileno(f); + + /* + * Locate an existing file handler for this file, if one exists, + * and make a new one if none currently exists. + */ + + for (fevPtr = firstFileEventPtr; ; fevPtr = fevPtr->nextPtr) { + if (fevPtr == NULL) { + if ((argc == 3) || (argv[3][0] == 0)) { + return TCL_OK; + } + fevPtr = (FileEvent *) ckalloc(sizeof(FileEvent)); + fevPtr->f = f; + fevPtr->interps[0] = NULL; + fevPtr->interps[1] = NULL; + fevPtr->scripts[0] = NULL; + fevPtr->scripts[1] = NULL; + fevPtr->nextPtr = firstFileEventPtr; + firstFileEventPtr = fevPtr; + Tk_CreateFileHandler2(fileno(f), FileEventProc, + (ClientData) fevPtr); + tcl_FileCloseProc = DeleteFileEvent; + break; + } + if (fevPtr->f == f) { + break; + } + } + + /* + * If we're just supposed to return the current script, do so. + */ + + if (argc == 3) { + if (fevPtr->scripts[index] != NULL) { + interp->result = fevPtr->scripts[index]; + } + return TCL_OK; + } + + /* + * If we're supposed to delete the event handler, do so. + */ + + if (argv[3][0] == 0) { + if (fevPtr->scripts[index] != NULL) { + fevPtr->interps[index] = NULL; + ckfree(fevPtr->scripts[index]); + fevPtr->scripts[index] = NULL; + } + if ((fevPtr->scripts[0] == NULL) && (fevPtr->scripts[1] == NULL)) { + if (firstFileEventPtr == fevPtr) { + firstFileEventPtr = fevPtr->nextPtr; + } else { + for (prevPtr = firstFileEventPtr; prevPtr->nextPtr != fevPtr; + prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + prevPtr->nextPtr = fevPtr->nextPtr; + } + Tk_DeleteFileHandler(fileno(fevPtr->f)); + ckfree((char *) fevPtr); + } + return TCL_OK; + } + + /* + * This is a new handler being created. Save its script. + */ + + fevPtr->interps[index] = interp; + if (fevPtr->scripts[index] != NULL) { + ckfree(fevPtr->scripts[index]); + } + fevPtr->scripts[index] = ckalloc((unsigned) (strlen(argv[3]) + 1)); + strcpy(fevPtr->scripts[index], argv[3]); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * FileEventProc -- + * + * This procedure is invoked by Tk's event loop to deal with file + * event bindings created by the "fileevent" command. + * + * Results: + * The return value is TK_FILE_HANDLED if the file was ready and + * a script was invoked to handle it. Otherwise an OR-ed combination + * of TK_READABLE and TK_WRITABLE is returned, indicating the events + * that should be checked in future calls to select. + * + * Side effects: + * Whatever the event script does. + * + *---------------------------------------------------------------------- + */ + +static int +FileEventProc(clientData, mask, flags) + ClientData clientData; /* Pointer to FileEvent structure for file. */ + int mask; /* OR-ed combination of the bits TK_READABLE, + * TK_WRITABLE, and TK_EXCEPTION, indicating + * current state of file. */ + int flags; /* Flag bits passed to Tk_DoOneEvent; + * contains bits such as TK_DONT_WAIT, + * TK_X_EVENTS, Tk_FILE_EVENTS, etc. */ +{ + FileEvent *fevPtr = (FileEvent *) clientData; + Tcl_DString script; + Tcl_Interp *interp; + FILE *f; + int code, checkMask; + + if (!(flags & TK_FILE_EVENTS)) { + return 0; + } + + /* + * The code here is a little tricky, because the script for an + * event could delete the event handler. Thus, after we call + * Tcl_GlobalEval we can't use fevPtr anymore. We also have to + * copy the script to make sure that it doesn't get freed while + * being evaluated. + */ + + checkMask = 0; + f = fevPtr->f; + if (fevPtr->scripts[1] != NULL) { + if (mask & TK_WRITABLE) { + Tcl_DStringInit(&script); + Tcl_DStringAppend(&script, fevPtr->scripts[1], -1); + interp = fevPtr->interps[1]; + code = Tcl_GlobalEval(interp, Tcl_DStringValue(&script)); + Tcl_DStringFree(&script); + if (code != TCL_OK) { + goto error; + } + return TK_FILE_HANDLED; + } else { + checkMask |= TK_WRITABLE; + } + } + if (fevPtr->scripts[0] != NULL) { + if ((mask & TK_READABLE) || TK_READ_DATA_PENDING(f)) { + Tcl_DStringInit(&script); + Tcl_DStringAppend(&script, fevPtr->scripts[0], -1); + interp = fevPtr->interps[0]; + code = Tcl_GlobalEval(interp, Tcl_DStringValue(&script)); + Tcl_DStringFree(&script); + if (code != TCL_OK) { + goto error; + } + return TK_FILE_HANDLED; + } else { + checkMask |= TK_READABLE; + } + } + return checkMask; + + /* + * An error occurred in the script, so we have to call + * Tk_BackgroundError. However, it's possible that the file ready + * condition didn't get cleared for the file, so we could end + * up in an infinite loop if we're not careful. To be safe, + * delete the event handler. + */ + + error: + DeleteFileEvent(f); + Tcl_AddErrorInfo(interp, + "\n (script bound to file event - binding deleted)"); + Tk_BackgroundError(interp); + return TK_FILE_HANDLED; +} + +/* + *---------------------------------------------------------------------- + * + * DeleteFileEvent -- + * + * This procedure is invoked to delete all file event handlers + * for a file. For example, this is necessary if a file is closed, + * or if an error occurs in a handler for a file. + * + * Results: + * None. + * + * Side effects: + * The file event handler is removed, so it will never be invoked + * again. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteFileEvent(f) + FILE *f; /* Stdio structure describing open file. */ +{ + register FileEvent *fevPtr; + FileEvent *prevPtr; + + /* + * See if there exists a file handler for the given file. + */ + + for (prevPtr = NULL, fevPtr = firstFileEventPtr; ; + prevPtr = fevPtr, fevPtr = fevPtr->nextPtr) { + if (fevPtr == NULL) { + return; + } + if (fevPtr->f == f) { + break; + } + } + + /* + * Unlink it from the list, then free it. + */ + + if (prevPtr == NULL) { + firstFileEventPtr = fevPtr->nextPtr; + } else { + prevPtr->nextPtr = fevPtr->nextPtr; + } + Tk_DeleteFileHandler(fileno(fevPtr->f)); + if (fevPtr->scripts[0] != NULL) { + ckfree(fevPtr->scripts[0]); + } + if (fevPtr->scripts[1] != NULL) { + ckfree(fevPtr->scripts[1]); + } + ckfree((char *) fevPtr); +} + +/* + *---------------------------------------------------------------------- + * + * TkEventCleanupProc -- + * + * This procedure is invoked whenever an interpreter is deleted. + * It deletes any file events and after commands that refer to + * that interpreter. + * + * Results: + * None. + * + * Side effects: + * File event handlers and after commands are removed. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +void +TkEventCleanupProc(clientData, interp) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Interpreter that is being deleted. */ +{ + FileEvent *fevPtr, *prevPtr, *nextPtr; + AfterInfo *afterPtr, *prevAfterPtr, *nextAfterPtr; + int i; + + prevPtr = NULL; + fevPtr = firstFileEventPtr; + while (fevPtr != NULL) { + for (i = 0; i < 2; i++) { + if (fevPtr->interps[i] == interp) { + fevPtr->interps[i] = NULL; + ckfree((char *) fevPtr->scripts[i]); + fevPtr->scripts[i] = NULL; + } + } + if ((fevPtr->scripts[0] != NULL) || (fevPtr->scripts[1] != NULL)) { + prevPtr = fevPtr; + fevPtr = fevPtr->nextPtr; + continue; + } + nextPtr = fevPtr->nextPtr; + if (prevPtr == NULL) { + firstFileEventPtr = nextPtr; + } else { + prevPtr->nextPtr = nextPtr; + } + Tk_DeleteFileHandler(fileno(fevPtr->f)); + ckfree((char *) fevPtr); + fevPtr = nextPtr; + } + + prevAfterPtr = NULL; + afterPtr = firstAfterPtr; + while (afterPtr != NULL) { + if (afterPtr->interp != interp) { + prevAfterPtr = afterPtr; + afterPtr = afterPtr->nextPtr; + continue; + } + nextAfterPtr = afterPtr->nextPtr; + if (prevAfterPtr == NULL) { + firstAfterPtr = nextAfterPtr; + } else { + prevAfterPtr->nextPtr = nextAfterPtr; + } + if (afterPtr->token != NULL) { + Tk_DeleteTimerHandler(afterPtr->token); + } else { + Tk_CancelIdleCall(AfterProc, (ClientData) afterPtr); + } + ckfree(afterPtr->command); + ckfree((char *) afterPtr); + afterPtr = nextAfterPtr; + } +} + +/* + *---------------------------------------------------------------------- + * + * TkwaitCmd2 -- + * + * This procedure is invoked to process the "tkwait" Tcl command. + * See the user documentation for details on what it does. This + * is a modified version of tkwait with only the "variable" + * option, suitable for use in stand-alone mode without the rest + * of Tk. It's only used when Tk_EventInit has been called. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TkwaitCmd2(clientData, interp, argc, argv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + int c, done; + size_t length; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " variable name\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0) + && (length >= 2)) { + Tcl_TraceVar(interp, argv[2], + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc2, (ClientData) &done); + done = 0; + while (!done) { + Tk_DoOneEvent(0); + } + Tcl_UntraceVar(interp, argv[2], + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc2, (ClientData) &done); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be variable", (char *) NULL); + return TCL_ERROR; + } + + /* + * Clear out the interpreter's result, since it may have been set + * by event handlers. + */ + + Tcl_ResetResult(interp); + return TCL_OK; +} + + /* ARGSUSED */ +static char * +WaitVariableProc2(clientData, interp, name1, name2, flags) + ClientData clientData; /* Pointer to integer to set to 1. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Name of variable. */ + char *name2; /* Second part of variable name. */ + int flags; /* Information about what happened. */ +{ + int *donePtr = (int *) clientData; + + *donePtr = 1; + return (char *) NULL; +} + +/* + *---------------------------------------------------------------------- + * + * UpdateCmd2 -- + * + * This procedure is invoked to process the "update" Tcl command. + * See the user documentation for details on what it does. This + * is a modified version of the command that doesn't deal with + * windows, suitable for use in stand-alone mode without the rest + * of Tk. It's only used when Tk_EventInit has been called. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +UpdateCmd2(clientData, interp, argc, argv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + int flags; + + if (argc == 1) { + flags = TK_DONT_WAIT|TK_FILE_EVENTS|TK_TIMER_EVENTS|TK_IDLE_EVENTS; + } else if (argc == 2) { + if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) { + Tcl_AppendResult(interp, "bad argument \"", argv[1], + "\": must be idletasks", (char *) NULL); + return TCL_ERROR; + } + flags = TK_IDLE_EVENTS; + } else { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " ?idletasks?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Handle all pending events. + */ + + while (Tk_DoOneEvent(flags) != 0) { + /* Empty loop body */ + } + + /* + * Must clear the interpreter's result because event handlers could + * have executed commands. + */ + + Tcl_ResetResult(interp); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_EventInit -- + * + * This procedure is invoked from Tcl_AppInit if the Tk event stuff + * is being used by itself (without the rest of Tk) in an application. + * It creates the "after" and "fileevent" commands. + * + * Results: + * Always returns TCL_OK. + * + * Side effects: + * New commands get added to interp. + * + *---------------------------------------------------------------------- + */ + +int +Tk_EventInit(interp) + Tcl_Interp *interp; /* Interpreter in which to set up + * event-handling. */ +{ + Tcl_CreateCommand(interp, "after", Tk_AfterCmd, (ClientData) NULL, + (void (*)()) NULL); + Tcl_CreateCommand(interp, "fileevent", Tk_FileeventCmd, (ClientData) NULL, + (void (*)()) NULL); + Tcl_CreateCommand(interp, "tkwait", TkwaitCmd2, (ClientData) NULL, + (void (*)()) NULL); + Tcl_CreateCommand(interp, "update", UpdateCmd2, (ClientData) NULL, + (void (*)()) NULL); + Tcl_CallWhenDeleted(interp, TkEventCleanupProc, (ClientData) NULL); + return TCL_OK; +} + +#endif /* TCL_MINOR_VERSION == 7 && TCL_MINOR_VERSION <= 4 */ diff --git a/vc6_80.mak b/vc6_80.mak new file mode 100644 index 0000000..9e2f07a --- /dev/null +++ b/vc6_80.mak @@ -0,0 +1,92 @@ +############################################################################## +# Ck for Win32 using Microsoft Visual C++ 6.0 +############################################################################## + +# +# TCL_DIR must be set to the installation directory of Tcl8.0 +# +TCL_DIR = C:\progra~1\Tcl + +# +# CURSES_INCLUDES must point to the directory where PDCURSES include files are +# +CURSES_INCLUDES = -IE:\pdcurses + +# +# CURSES_LIB must point to the PDCURSES link library +# +CURSES_LIB = E:\pdcurses\win32\pdcurses.lib + +# +# Installation directory of MS VC 6 +# +MSVC = "C:\progra~1\microsoft visual studio\vc98" + +#----------------------------------------------------------------------------- +# The information below should be usable as is. + +CC = cl +LN = link +RC = rc + +LIBS = $(TCL_DIR)\lib\tcl80.lib libcmt.lib kernel32.lib user32.lib \ + $(CURSES_LIB) + +DLLLIBS = $(TCL_DIR)\lib\tcl80.lib msvcrt.lib kernel32.lib user32.lib \ + $(CURSES_LIB) + +CFLAGS = -Zi -Gs -GD -c -W3 -nologo -D_MT -DWIN32 -I$(MSVC)\include \ + -I$(TCL_DIR)\include $(CURSES_INCLUDES) + +LFLAGS = /NODEFAULTLIB /RELEASE /NOLOGO /MACHINE:IX86 /SUBSYSTEM:WINDOWS \ + /ENTRY:WinMainCRTStartup + +DLLLFLAGS = /NODEFAULTLIB /RELEASE /NOLOGO /MACHINE:IX86 /SUBSYSTEM:WINDOWS \ + /ENTRY:_DllMainCRTStartup@12 /DLL + +WIDGOBJS = ckButton.obj ckEntry.obj ckFrame.obj ckListbox.obj \ + ckMenu.obj ckMenubutton.obj ckMessage.obj ckScrollbar.obj ckTree.obj + +TEXTOBJS = ckText.obj ckTextBTree.obj ckTextDisp.obj ckTextIndex.obj \ + ckTextMark.obj ckTextTag.obj + +OBJS = ckBind.obj ckBorder.obj ckCmds.obj ckConfig.obj ckEvent.obj \ + ckFocus.obj \ + ckGeometry.obj ckGet.obj ckGrid.obj ckMain.obj ckOption.obj \ + ckPack.obj ckPlace.obj \ + ckPreserve.obj ckRecorder.obj ckUtil.obj ckWindow.obj tkEvent.obj \ + ckAppInit.obj $(WIDGOBJS) $(TEXTOBJS) + +HDRS = default.h ks_names.h ck.h ckPort.h ckText.h + +all: ck80.dll cwsh.exe + +ck80.dll: $(OBJS) + set LIB=$(MSVC)\lib + $(LN) $(DLLLFLAGS) -out:$@ $(DLLLIBS) @<< +$(OBJS) +<< + +cwsh.exe: winMain.obj cwsh.res ck80.dll + set LIB=$(MSVC)\lib + $(LN) $(LFLAGS) winMain.obj cwsh.res -out:$@ $(DLLLIBS) ck80.lib + +clean: + del *.obj + del *.lib + del *.exp + del *.exe + del *.res + del *.pdb + del ck80.dll + +.c.obj: + $(CC) -DBUILD_ck -D_DLL $(CFLAGS) $< + +.rc.res: + $(RC) -I$(MSVC)\include -I$(TCL_DIR)\include -fo $@ -r $< + +winMain.obj: winMain.c + $(CC) $(CFLAGS) -D_DLL winMain.c + + diff --git a/vc6_82.mak b/vc6_82.mak new file mode 100644 index 0000000..0eaf01a --- /dev/null +++ b/vc6_82.mak @@ -0,0 +1,92 @@ +############################################################################## +# Ck for Win32 using Microsoft Visual C++ 6.0 +############################################################################## + +# +# TCL_DIR must be set to the installation directory of Tcl8.2 +# +TCL_DIR = C:\progra~1\Tcl + +# +# CURSES_INCLUDES must point to the directory where PDCURSES include files are +# +CURSES_INCLUDES = -IE:\pdcurses + +# +# CURSES_LIB must point to the PDCURSES link library +# +CURSES_LIB = E:\pdcurses\win32\pdcurses.lib + +# +# Installation directory of MS VC 6 +# +MSVC = "C:\progra~1\microsoft visual studio\vc98" + +#----------------------------------------------------------------------------- +# The information below should be usable as is. + +CC = cl +LN = link +RC = rc + +LIBS = $(TCL_DIR)\lib\tcl82.lib libcmt.lib kernel32.lib user32.lib \ + $(CURSES_LIB) + +DLLLIBS = $(TCL_DIR)\lib\tcl82.lib msvcrt.lib kernel32.lib user32.lib \ + $(CURSES_LIB) + +CFLAGS = -Zi -Gs -GD -c -W3 -nologo -D_MT -DWIN32 -I$(MSVC)\include \ + -I$(TCL_DIR)\include $(CURSES_INCLUDES) + +LFLAGS = /NODEFAULTLIB /RELEASE /NOLOGO /MACHINE:IX86 /SUBSYSTEM:WINDOWS \ + /ENTRY:WinMainCRTStartup + +DLLLFLAGS = /NODEFAULTLIB /RELEASE /NOLOGO /MACHINE:IX86 /SUBSYSTEM:WINDOWS \ + /ENTRY:_DllMainCRTStartup@12 /DLL + +WIDGOBJS = ckButton.obj ckEntry.obj ckFrame.obj ckListbox.obj \ + ckMenu.obj ckMenubutton.obj ckMessage.obj ckScrollbar.obj ckTree.obj + +TEXTOBJS = ckText.obj ckTextBTree.obj ckTextDisp.obj ckTextIndex.obj \ + ckTextMark.obj ckTextTag.obj + +OBJS = ckBind.obj ckBorder.obj ckCmds.obj ckConfig.obj ckEvent.obj \ + ckFocus.obj \ + ckGeometry.obj ckGet.obj ckGrid.obj ckMain.obj ckOption.obj \ + ckPack.obj ckPlace.obj \ + ckPreserve.obj ckRecorder.obj ckUtil.obj ckWindow.obj tkEvent.obj \ + ckAppInit.obj $(WIDGOBJS) $(TEXTOBJS) + +HDRS = default.h ks_names.h ck.h ckPort.h ckText.h + +all: ck82.dll cwsh.exe + +ck82.dll: $(OBJS) + set LIB=$(MSVC)\lib + $(LN) $(DLLLFLAGS) -out:$@ $(DLLLIBS) @<< +$(OBJS) +<< + +cwsh.exe: winMain.obj cwsh.res ck82.dll + set LIB=$(MSVC)\lib + $(LN) $(LFLAGS) winMain.obj cwsh.res -out:$@ $(DLLLIBS) ck82.lib + +clean: + del *.obj + del *.lib + del *.exp + del *.exe + del *.res + del *.pdb + del ck82.dll + +.c.obj: + $(CC) -DBUILD_ck -D_DLL $(CFLAGS) $< + +.rc.res: + $(RC) -I$(MSVC)\include -I$(TCL_DIR)\include -fo $@ -r $< + +winMain.obj: winMain.c + $(CC) $(CFLAGS) -D_DLL winMain.c + + diff --git a/vc6_83.mak b/vc6_83.mak new file mode 100644 index 0000000..6901274 --- /dev/null +++ b/vc6_83.mak @@ -0,0 +1,92 @@ +############################################################################## +# Ck for Win32 using Microsoft Visual C++ 6.0 +############################################################################## + +# +# TCL_DIR must be set to the installation directory of Tcl8.3 +# +TCL_DIR = C:\progra~1\Tcl + +# +# CURSES_INCLUDES must point to the directory where PDCURSES include files are +# +CURSES_INCLUDES = -IE:\pdcurses + +# +# CURSES_LIB must point to the PDCURSES link library +# +CURSES_LIB = E:\pdcurses\win32\pdcurses.lib + +# +# Installation directory of MS VC 6 +# +MSVC = "C:\progra~1\microsoft visual studio\vc98" + +#----------------------------------------------------------------------------- +# The information below should be usable as is. + +CC = cl +LN = link +RC = rc + +LIBS = $(TCL_DIR)\lib\tcl83.lib libcmt.lib kernel32.lib user32.lib \ + $(CURSES_LIB) + +DLLLIBS = $(TCL_DIR)\lib\tcl83.lib msvcrt.lib kernel32.lib user32.lib \ + $(CURSES_LIB) + +CFLAGS = -Zi -Gs -GD -c -W3 -nologo -D_MT -DWIN32 -I$(MSVC)\include \ + -I$(TCL_DIR)\include $(CURSES_INCLUDES) + +LFLAGS = /NODEFAULTLIB /RELEASE /NOLOGO /MACHINE:IX86 /SUBSYSTEM:WINDOWS \ + /ENTRY:WinMainCRTStartup + +DLLLFLAGS = /NODEFAULTLIB /RELEASE /NOLOGO /MACHINE:IX86 /SUBSYSTEM:WINDOWS \ + /ENTRY:_DllMainCRTStartup@12 /DLL + +WIDGOBJS = ckButton.obj ckEntry.obj ckFrame.obj ckListbox.obj \ + ckMenu.obj ckMenubutton.obj ckMessage.obj ckScrollbar.obj ckTree.obj + +TEXTOBJS = ckText.obj ckTextBTree.obj ckTextDisp.obj ckTextIndex.obj \ + ckTextMark.obj ckTextTag.obj + +OBJS = ckBind.obj ckBorder.obj ckCmds.obj ckConfig.obj ckEvent.obj \ + ckFocus.obj \ + ckGeometry.obj ckGet.obj ckGrid.obj ckMain.obj ckOption.obj \ + ckPack.obj ckPlace.obj \ + ckPreserve.obj ckRecorder.obj ckUtil.obj ckWindow.obj tkEvent.obj \ + ckAppInit.obj $(WIDGOBJS) $(TEXTOBJS) + +HDRS = default.h ks_names.h ck.h ckPort.h ckText.h + +all: ck83.dll cwsh.exe + +ck83.dll: $(OBJS) + set LIB=$(MSVC)\lib + $(LN) $(DLLLFLAGS) -out:$@ $(DLLLIBS) @<< +$(OBJS) +<< + +cwsh.exe: winMain.obj cwsh.res ck83.dll + set LIB=$(MSVC)\lib + $(LN) $(LFLAGS) winMain.obj cwsh.res -out:$@ $(DLLLIBS) ck83.lib + +clean: + del *.obj + del *.lib + del *.exp + del *.exe + del *.res + del *.pdb + del ck83.dll + +.c.obj: + $(CC) -DBUILD_ck -D_DLL $(CFLAGS) $< + +.rc.res: + $(RC) -I$(MSVC)\include -I$(TCL_DIR)\include -fo $@ -r $< + +winMain.obj: winMain.c + $(CC) $(CFLAGS) -D_DLL winMain.c + + diff --git a/winMain.c b/winMain.c new file mode 100644 index 0000000..4fcba07 --- /dev/null +++ b/winMain.c @@ -0,0 +1,297 @@ +/* + * winMain.c -- + * + * Main entry point for cwsh. + * + * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 1999 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: winMain.c,v 1.1 2006-02-24 18:59:53 vitus Exp $ + */ + +#include "ck.h" +#define WIN32_LEAN_AND_MEAN +#include +#undef WIN32_LEAN_AND_MEAN +#include +#include + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr)); +static void CwshPanic _ANSI_ARGS_(TCL_VARARGS(char *,format)); + + +/* + *---------------------------------------------------------------------- + * + * WinMain -- + * + * Main entry point from Windows. + * + * Results: + * Returns false if initialization fails, otherwise it never + * returns. + * + * Side effects: + * Just about anything, since from here we call arbitrary Tcl code. + * + *---------------------------------------------------------------------- + */ + +int APIENTRY +WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow) + HINSTANCE hInstance; + HINSTANCE hPrevInstance; + LPSTR lpszCmdLine; + int nCmdShow; +{ + char **argv, *p; + int argc; + char buffer[MAX_PATH]; + + Tcl_SetPanicProc(CwshPanic); + + fclose(stdin); + fclose(stdout); + fclose(stderr); + FreeConsole(); + if (!AllocConsole()) { + CwshPanic("Error allocating console"); + } + freopen("CONIN$", "r", stdin); + freopen("CONOUT$", "w", stdout); + freopen("CONOUT$", "w", stderr); + + /* + * Set up the default locale to be standard "C" locale so parsing + * is performed correctly. + */ + + setlocale(LC_ALL, "C"); + + /* + * Increase the application queue size from default value of 8. + * At the default value, cross application SendMessage of WM_KILLFOCUS + * will fail because the handler will not be able to do a PostMessage! + * This is only needed for Windows 3.x, since NT dynamically expands + * the queue. + */ + SetMessageQueue(64); + + setargv(&argc, &argv); + + /* + * Replace argv[0] with full pathname of executable, and forward + * slashes substituted for backslashes. + */ + + GetModuleFileName(NULL, buffer, sizeof(buffer)); + argv[0] = buffer; + for (p = buffer; *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; + } + } + + Ck_Main(argc, argv, Tcl_AppInit); + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in interp->result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_AppInit(interp) + Tcl_Interp *interp; /* Interpreter for application. */ +{ + if (Tcl_Init(interp) == TCL_ERROR) { + goto error; + } + if (Ck_Init(interp) == TCL_ERROR) { + goto error; + } +#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4) + tcl_RcFileName = "~/.cwshrc"; +#else + Tcl_StaticPackage(interp, "Ck", Ck_Init, (Tcl_PackageInitProc *) NULL); + Tcl_SetVar(interp, "tcl_rcFileName", "~/.cwshrc", TCL_GLOBAL_ONLY); +#endif + return TCL_OK; + +error: + CwshPanic(interp->result); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * CwshPanic -- + * + * Display a message and exit. + * + * Results: + * None. + * + * Side effects: + * Exits the program. + * + *---------------------------------------------------------------------- + */ + +void +CwshPanic TCL_VARARGS_DEF(char *,arg1) +{ + va_list argList; + char buf[1024]; + char *format; + + format = TCL_VARARGS_START(char *,arg1,argList); + vsprintf(buf, format, argList); + + MessageBeep(MB_ICONEXCLAMATION); + MessageBox(NULL, buf, "Fatal Error in CWSH", + MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); +#ifdef _MSC_VER + DebugBreak(); +#endif + ExitProcess(1); +} +/* + *------------------------------------------------------------------------- + * + * setargv -- + * + * Parse the Windows command line string into argc/argv. Done here + * because we don't trust the builtin argument parser in crt0. + * Windows applications are responsible for breaking their command + * line into arguments. + * + * 2N backslashes + quote -> N backslashes + begin quoted string + * 2N + 1 backslashes + quote -> literal + * N backslashes + non-quote -> literal + * quote + quote in a quoted string -> single quote + * quote + quote not in quoted string -> empty string + * quote -> begin quoted string + * + * Results: + * Fills argcPtr with the number of arguments and argvPtr with the + * array of arguments. + * + * Side effects: + * Memory allocated. + * + *-------------------------------------------------------------------------- + */ + +static void +setargv(argcPtr, argvPtr) + int *argcPtr; /* Filled with number of argument strings. */ + char ***argvPtr; /* Filled with argument strings (malloc'd). */ +{ + char *cmdLine, *p, *arg, *argSpace; + char **argv; + int argc, size, inquote, copy, slashes; + + cmdLine = GetCommandLine(); + + /* + * Precompute an overly pessimistic guess at the number of arguments + * in the command line by counting non-space spans. + */ + + size = 2; + for (p = cmdLine; *p != '\0'; p++) { + if (isspace(*p)) { + size++; + while (isspace(*p)) { + p++; + } + if (*p == '\0') { + break; + } + } + } + argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *) + + strlen(cmdLine) + 1)); + argv = (char **) argSpace; + argSpace += size * sizeof(char *); + size--; + + p = cmdLine; + for (argc = 0; argc < size; argc++) { + argv[argc] = arg = argSpace; + while (isspace(*p)) { + p++; + } + if (*p == '\0') { + break; + } + + inquote = 0; + slashes = 0; + while (1) { + copy = 1; + while (*p == '\\') { + slashes++; + p++; + } + if (*p == '"') { + if ((slashes & 1) == 0) { + copy = 0; + if ((inquote) && (p[1] == '"')) { + p++; + copy = 1; + } else { + inquote = !inquote; + } + } + slashes >>= 1; + } + + while (slashes) { + *arg = '\\'; + arg++; + slashes--; + } + + if ((*p == '\0') || (!inquote && isspace(*p))) { + break; + } + if (copy != 0) { + *arg = *p; + arg++; + } + p++; + } + *arg = '\0'; + argSpace = arg + 1; + } + argv[argc] = NULL; + + *argcPtr = argc; + *argvPtr = argv; +} +