--- /dev/null
+#define error_width 17
+#define error_height 17
+static unsigned char error_bits[] = {
+ 0xf0, 0x0f, 0x00, 0x58, 0x15, 0x00, 0xac, 0x2a, 0x00, 0x16, 0x50, 0x00,
+ 0x2b, 0xa0, 0x00, 0x55, 0x40, 0x01, 0xa3, 0xc0, 0x00, 0x45, 0x41, 0x01,
+ 0x83, 0xc2, 0x00, 0x05, 0x45, 0x01, 0x03, 0xca, 0x00, 0x05, 0x74, 0x01,
+ 0x0a, 0xa8, 0x00, 0x14, 0x58, 0x00, 0xe8, 0x2f, 0x00, 0x50, 0x15, 0x00,
+ 0xa0, 0x0a, 0x00};
--- /dev/null
+#define gray12_width 16
+#define gray12_height 16
+static unsigned char gray12_bits[] = {
+ 0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88, 0x00, 0x00, 0x22, 0x22,
+ 0x00, 0x00, 0x88, 0x88, 0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88,
+ 0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88};
--- /dev/null
+#define gray25_width 16
+#define gray25_height 16
+static unsigned char gray25_bits[] = {
+ 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22,
+ 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22,
+ 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22};
--- /dev/null
+#define gray50_width 16
+#define gray50_height 16
+static unsigned char gray50_bits[] = {
+ 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
+ 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
+ 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa};
--- /dev/null
+#define gray75_width 16
+#define gray75_height 16
+static unsigned char gray75_bits[] = {
+ 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd,
+ 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd,
+ 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd};
--- /dev/null
+#define hourglass_width 19
+#define hourglass_height 21
+static unsigned char hourglass_bits[] = {
+ 0xff, 0xff, 0x07, 0x55, 0x55, 0x05, 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01,
+ 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01, 0xc2, 0x0a, 0x03, 0x46, 0x05, 0x01,
+ 0x82, 0x0a, 0x03, 0x06, 0x05, 0x01, 0x02, 0x03, 0x03, 0x86, 0x05, 0x01,
+ 0xc2, 0x0a, 0x03, 0x66, 0x15, 0x01, 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01,
+ 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01, 0xa2, 0x2a, 0x03, 0xff, 0xff, 0x07,
+ 0xab, 0xaa, 0x02};
--- /dev/null
+#define info_width 8
+#define info_height 21
+static unsigned char info_bits[] = {
+ 0x3c, 0x2a, 0x16, 0x2a, 0x14, 0x00, 0x00, 0x3f, 0x15, 0x2e, 0x14, 0x2c,
+ 0x14, 0x2c, 0x14, 0x2c, 0x14, 0x2c, 0xd7, 0xab, 0x55};
--- /dev/null
+#define questhead_width 20
+#define questhead_height 22
+static unsigned char questhead_bits[] = {
+ 0xf8, 0x1f, 0x00, 0xac, 0x2a, 0x00, 0x56, 0x55, 0x00, 0xeb, 0xaf, 0x00,
+ 0xf5, 0x5f, 0x01, 0xfb, 0xbf, 0x00, 0x75, 0x5d, 0x01, 0xfb, 0xbe, 0x02,
+ 0x75, 0x5d, 0x05, 0xab, 0xbe, 0x0a, 0x55, 0x5f, 0x07, 0xab, 0xaf, 0x00,
+ 0xd6, 0x57, 0x01, 0xac, 0xab, 0x00, 0xd8, 0x57, 0x00, 0xb0, 0xaa, 0x00,
+ 0x50, 0x55, 0x00, 0xb0, 0x0b, 0x00, 0xd0, 0x17, 0x00, 0xb0, 0x0b, 0x00,
+ 0x58, 0x15, 0x00, 0xa8, 0x2a, 0x00};
--- /dev/null
+#define question_width 17
+#define question_height 27
+static unsigned char question_bits[] = {
+ 0xf0, 0x0f, 0x00, 0x58, 0x15, 0x00, 0xac, 0x2a, 0x00, 0x56, 0x55, 0x00,
+ 0x2b, 0xa8, 0x00, 0x15, 0x50, 0x01, 0x0b, 0xa0, 0x00, 0x05, 0x60, 0x01,
+ 0x0b, 0xa0, 0x00, 0x05, 0x60, 0x01, 0x0b, 0xb0, 0x00, 0x00, 0x58, 0x01,
+ 0x00, 0xaf, 0x00, 0x80, 0x55, 0x00, 0xc0, 0x2a, 0x00, 0x40, 0x15, 0x00,
+ 0xc0, 0x02, 0x00, 0x40, 0x01, 0x00, 0xc0, 0x02, 0x00, 0x40, 0x01, 0x00,
+ 0xc0, 0x02, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0xc0, 0x02, 0x00,
+ 0x40, 0x01, 0x00, 0xc0, 0x02, 0x00, 0x00, 0x01, 0x00};
--- /dev/null
+#define warning_width 6
+#define warning_height 19
+static unsigned char warning_bits[] = {
+ 0x0c, 0x16, 0x2b, 0x15, 0x2b, 0x15, 0x2b, 0x16, 0x0a, 0x16, 0x0a, 0x16,
+ 0x0a, 0x00, 0x00, 0x1e, 0x0a, 0x16, 0x0a};
--- /dev/null
+/*
+ * tk3d.c --
+ *
+ * This module provides procedures to draw borders in
+ * the three-dimensional Motif style.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk3d.h"
+
+/*
+ * The following table defines the string values for reliefs, which are
+ * used by Tk_GetReliefFromObj.
+ */
+
+static CONST char *reliefStrings[] = {"flat", "groove", "raised",
+ "ridge", "solid", "sunken",
+ (char *) NULL};
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void BorderInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupBorderObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeBorderObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int Intersect _ANSI_ARGS_((XPoint *a1Ptr, XPoint *a2Ptr,
+ XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr));
+static void InitBorderObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr,
+ int distance, XPoint *p3Ptr));
+
+/*
+ * The following structure defines the implementation of the "border" Tcl
+ * object, used for drawing. The border object remembers the hash table entry
+ * associated with a border. The actual allocation and deallocation of the
+ * border should be done by the configuration package when the border option
+ * is set.
+ */
+
+Tcl_ObjType tkBorderObjType = {
+ "border", /* name */
+ FreeBorderObjProc, /* freeIntRepProc */
+ DupBorderObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Alloc3DBorderFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * Tk_3DBorder structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is a token for a data structure describing a
+ * 3-D border. This token may be passed to procedures such as
+ * Tk_Draw3DRectangle and Tk_Free3DBorder. If an error prevented
+ * the border from being created then NULL is returned and an error
+ * message will be left in the interp's result.
+ *
+ * Side effects:
+ * The border is added to an internal database with a reference
+ * count. For each call to this procedure, there should eventually
+ * be a call to FreeBorderObjProc so that the database is
+ * cleaned up when borders aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for error results. */
+ Tk_Window tkwin; /* Need the screen the border is used on.*/
+ Tcl_Obj *objPtr; /* Object giving name of color for window
+ * background. */
+{
+ TkBorder *borderPtr;
+
+ if (objPtr->typePtr != &tkBorderObjType) {
+ InitBorderObj(objPtr);
+ }
+ borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkBorder, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (borderPtr != NULL) {
+ if (borderPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a border that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeBorderObjProc(objPtr);
+ borderPtr = NULL;
+ } else if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+
+ /*
+ * The object didn't point to the border that we wanted. Search
+ * the list of borders with the same name to see if one of the
+ * others is the right one.
+ */
+
+ /*
+ * If the cached value is NULL, either the object type was not a
+ * color going in, or the object is a color type but had
+ * previously been freed.
+ *
+ * If the value is not NULL, the internal rep is the value
+ * of the color the last time this object was accessed. Check
+ * the screen and colormap of the last access, and if they
+ * match, we are done.
+ */
+
+ if (borderPtr != NULL) {
+ TkBorder *firstBorderPtr =
+ (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr);
+ FreeBorderObjProc(objPtr);
+ for (borderPtr = firstBorderPtr ; borderPtr != NULL;
+ borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ borderPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call Tk_Get3DBorder to allocate a new border.
+ */
+
+ borderPtr = (TkBorder *) Tk_Get3DBorder(interp, tkwin,
+ Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount++;
+ }
+ return (Tk_3DBorder) borderPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Get3DBorder --
+ *
+ * Create a data structure for displaying a 3-D border.
+ *
+ * Results:
+ * The return value is a token for a data structure describing a
+ * 3-D border. This token may be passed to procedures such as
+ * Tk_Draw3DRectangle and Tk_Free3DBorder. If an error prevented
+ * the border from being created then NULL is returned and an error
+ * message will be left in the interp's result.
+ *
+ * Side effects:
+ * Data structures, graphics contexts, etc. are allocated.
+ * It is the caller's responsibility to eventually call
+ * Tk_Free3DBorder to release the resources.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Get3DBorder(interp, tkwin, colorName)
+ Tcl_Interp *interp; /* Place to store an error message. */
+ Tk_Window tkwin; /* Token for window in which border will
+ * be drawn. */
+ Tk_Uid colorName; /* String giving name of color
+ * for window background. */
+{
+ Tcl_HashEntry *hashPtr;
+ TkBorder *borderPtr, *existingBorderPtr;
+ int new;
+ XGCValues gcValues;
+ XColor *bgColorPtr;
+ TkDisplay *dispPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->borderInit) {
+ BorderInit(dispPtr);
+ }
+
+ hashPtr = Tcl_CreateHashEntry(&dispPtr->borderTable, colorName, &new);
+ if (!new) {
+ existingBorderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
+ for (borderPtr = existingBorderPtr; borderPtr != NULL;
+ borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+ } else {
+ existingBorderPtr = NULL;
+ }
+
+ /*
+ * No satisfactory border exists yet. Initialize a new one.
+ */
+
+ bgColorPtr = Tk_GetColor(interp, tkwin, colorName);
+ if (bgColorPtr == NULL) {
+ if (new) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ return NULL;
+ }
+
+ borderPtr = TkpGetBorder();
+ borderPtr->screen = Tk_Screen(tkwin);
+ borderPtr->visual = Tk_Visual(tkwin);
+ borderPtr->depth = Tk_Depth(tkwin);
+ borderPtr->colormap = Tk_Colormap(tkwin);
+ borderPtr->resourceRefCount = 1;
+ borderPtr->objRefCount = 0;
+ borderPtr->bgColorPtr = bgColorPtr;
+ borderPtr->darkColorPtr = NULL;
+ borderPtr->lightColorPtr = NULL;
+ borderPtr->shadow = None;
+ borderPtr->bgGC = None;
+ borderPtr->darkGC = None;
+ borderPtr->lightGC = None;
+ borderPtr->hashPtr = hashPtr;
+ borderPtr->nextPtr = existingBorderPtr;
+ Tcl_SetHashValue(hashPtr, borderPtr);
+
+ /*
+ * Create the information for displaying the background color,
+ * but delay the allocation of shadows until they are actually
+ * needed for drawing.
+ */
+
+ gcValues.foreground = borderPtr->bgColorPtr->pixel;
+ borderPtr->bgGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return (Tk_3DBorder) borderPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DRectangle --
+ *
+ * Draw a 3-D border at a given place in a given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A 3-D border will be drawn in the indicated drawable.
+ * The outside edges of the border will be determined by x,
+ * y, width, and height. The inside edges of the border
+ * will be determined by the borderWidth argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width, height,
+ borderWidth, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Outside area of region in
+ * which border will be drawn. */
+ int borderWidth; /* Desired width for border, in
+ * pixels. */
+ int relief; /* Type of relief: TK_RELIEF_RAISED,
+ * TK_RELIEF_SUNKEN, TK_RELIEF_GROOVE, etc. */
+{
+ if (width < 2*borderWidth) {
+ borderWidth = width/2;
+ }
+ if (height < 2*borderWidth) {
+ borderWidth = height/2;
+ }
+ Tk_3DVerticalBevel(tkwin, drawable, border, x, y, borderWidth, height,
+ 1, relief);
+ Tk_3DVerticalBevel(tkwin, drawable, border, x+width-borderWidth, y,
+ borderWidth, height, 0, relief);
+ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, borderWidth,
+ 1, 1, 1, relief);
+ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y+height-borderWidth,
+ width, borderWidth, 0, 0, 0, relief);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOf3DBorder --
+ *
+ * Given a border, return a textual string identifying the
+ * border's color.
+ *
+ * Results:
+ * The return value is the string that was used to create
+ * the border.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOf3DBorder(border)
+ Tk_3DBorder border; /* Token for border. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+
+ return borderPtr->hashPtr->key.string;
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tk_3DBorderColor --
+ *
+ * Given a 3D border, return the X color used for the "flat"
+ * surfaces.
+ *
+ * Results:
+ * Returns the color used drawing flat surfaces with the border.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------------
+ */
+XColor *
+Tk_3DBorderColor(border)
+ Tk_3DBorder border; /* Border whose color is wanted. */
+{
+ return(((TkBorder *) border)->bgColorPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tk_3DBorderGC --
+ *
+ * Given a 3D border, returns one of the graphics contexts used to
+ * draw the border.
+ *
+ * Results:
+ * Returns the graphics context given by the "which" argument.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------------
+ */
+GC
+Tk_3DBorderGC(tkwin, border, which)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Tk_3DBorder border; /* Border whose GC is wanted. */
+ int which; /* Selects one of the border's 3 GC's:
+ * TK_3D_FLAT_GC, TK_3D_LIGHT_GC, or
+ * TK_3D_DARK_GC. */
+{
+ TkBorder * borderPtr = (TkBorder *) border;
+
+ if ((borderPtr->lightGC == None) && (which != TK_3D_FLAT_GC)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+ if (which == TK_3D_FLAT_GC) {
+ return borderPtr->bgGC;
+ } else if (which == TK_3D_LIGHT_GC) {
+ return borderPtr->lightGC;
+ } else if (which == TK_3D_DARK_GC){
+ return borderPtr->darkGC;
+ }
+ panic("bogus \"which\" value in Tk_3DBorderGC");
+
+ /*
+ * The code below will never be executed, but it's needed to
+ * keep compilers happy.
+ */
+
+ return (GC) None;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Free3DBorder --
+ *
+ * This procedure is called when a 3D border is no longer
+ * needed. It frees the resources associated with the
+ * border. After this call, the caller should never again
+ * use the "border" token.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources are freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Free3DBorder(border)
+ Tk_3DBorder border; /* Token for border to be released. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ Display *display = DisplayOfScreen(borderPtr->screen);
+ TkBorder *prevPtr;
+
+ borderPtr->resourceRefCount--;
+ if (borderPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ prevPtr = (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr);
+ TkpFreeBorder(borderPtr);
+ if (borderPtr->bgColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->bgColorPtr);
+ }
+ if (borderPtr->darkColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->darkColorPtr);
+ }
+ if (borderPtr->lightColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->lightColorPtr);
+ }
+ if (borderPtr->shadow != None) {
+ Tk_FreeBitmap(display, borderPtr->shadow);
+ }
+ if (borderPtr->bgGC != None) {
+ Tk_FreeGC(display, borderPtr->bgGC);
+ }
+ if (borderPtr->darkGC != None) {
+ Tk_FreeGC(display, borderPtr->darkGC);
+ }
+ if (borderPtr->lightGC != None) {
+ Tk_FreeGC(display, borderPtr->lightGC);
+ }
+ if (prevPtr == borderPtr) {
+ if (borderPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(borderPtr->hashPtr);
+ } else {
+ Tcl_SetHashValue(borderPtr->hashPtr, borderPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != borderPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = borderPtr->nextPtr;
+ }
+ if (borderPtr->objRefCount == 0) {
+ ckfree((char *) borderPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Free3DBorderFromObj --
+ *
+ * This procedure is called to release a border allocated by
+ * Tk_Alloc3DBorderFromObj. It does not throw away the Tcl_Obj *;
+ * it only gets rid of the hash table entry for this border
+ * and clears the cached value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the border represented by
+ * objPtr is decremented, and the border's resources are released
+ * to X if there are no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Free3DBorderFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this border lives in. Needed
+ * for the screen and colormap values. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ Tk_Free3DBorder(Tk_Get3DBorderFromObj(tkwin, objPtr));
+ FreeBorderObjProc(objPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeBorderObjProc --
+ *
+ * This proc is called to release an object reference to a border.
+ * Called when the object's internal rep is released or when
+ * the cached borderPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the border's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeBorderObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkBorder *borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount--;
+ if ((borderPtr->objRefCount == 0)
+ && (borderPtr->resourceRefCount == 0)) {
+ ckfree((char *) borderPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupBorderObjProc --
+ *
+ * When a cached border object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The border's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupBorderObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkBorder *borderPtr = (TkBorder *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount++;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetBackgroundFromBorder --
+ *
+ * Change the background of a window to one appropriate for a given
+ * 3-D border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tkwin's background gets modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetBackgroundFromBorder(tkwin, border)
+ Tk_Window tkwin; /* Window whose background is to be set. */
+ Tk_3DBorder border; /* Token for border. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+
+ Tk_SetWindowBackground(tkwin, borderPtr->bgColorPtr->pixel);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetReliefFromObj --
+ *
+ * Return an integer value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetReliefFromObj(interp, objPtr, resultPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Obj *objPtr; /* The object we are trying to get the
+ * value from. */
+ int *resultPtr; /* Where to place the answer. */
+{
+ return Tcl_GetIndexFromObj(interp, objPtr, reliefStrings, "relief", 0,
+ resultPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetRelief --
+ *
+ * Parse a relief description and return the corresponding
+ * relief value, or an error.
+ *
+ * Results:
+ * A standard Tcl return value. If all goes well then
+ * *reliefPtr is filled in with one of the values
+ * TK_RELIEF_RAISED, TK_RELIEF_FLAT, or TK_RELIEF_SUNKEN.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetRelief(interp, name, reliefPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ CONST char *name; /* Name of a relief type. */
+ int *reliefPtr; /* Where to store converted relief. */
+{
+ char c;
+ size_t length;
+
+ c = name[0];
+ length = strlen(name);
+ if ((c == 'f') && (strncmp(name, "flat", length) == 0)) {
+ *reliefPtr = TK_RELIEF_FLAT;
+ } else if ((c == 'g') && (strncmp(name, "groove", length) == 0)
+ && (length >= 2)) {
+ *reliefPtr = TK_RELIEF_GROOVE;
+ } else if ((c == 'r') && (strncmp(name, "raised", length) == 0)
+ && (length >= 2)) {
+ *reliefPtr = TK_RELIEF_RAISED;
+ } else if ((c == 'r') && (strncmp(name, "ridge", length) == 0)) {
+ *reliefPtr = TK_RELIEF_RIDGE;
+ } else if ((c == 's') && (strncmp(name, "solid", length) == 0)) {
+ *reliefPtr = TK_RELIEF_SOLID;
+ } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) {
+ *reliefPtr = TK_RELIEF_SUNKEN;
+ } else {
+ char buf[200];
+
+ sprintf(buf, "bad relief type \"%.50s\": must be %s",
+ name, "flat, groove, raised, ridge, solid, or sunken");
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfRelief --
+ *
+ * Given a relief value, produce a string describing that
+ * relief value.
+ *
+ * Results:
+ * The return value is a static string that is equivalent
+ * to relief.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfRelief(relief)
+ int relief; /* One of TK_RELIEF_FLAT, TK_RELIEF_RAISED,
+ * or TK_RELIEF_SUNKEN. */
+{
+ if (relief == TK_RELIEF_FLAT) {
+ return "flat";
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ return "sunken";
+ } else if (relief == TK_RELIEF_RAISED) {
+ return "raised";
+ } else if (relief == TK_RELIEF_GROOVE) {
+ return "groove";
+ } else if (relief == TK_RELIEF_RIDGE) {
+ return "ridge";
+ } else if (relief == TK_RELIEF_SOLID) {
+ return "solid";
+ } else if (relief == TK_RELIEF_NULL) {
+ return "";
+ } else {
+ return "unknown relief";
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DPolygon --
+ *
+ * Draw a border with 3-D appearance around the edge of a
+ * given polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is drawn in "drawable" in the form of a
+ * 3-D border borderWidth units width wide on the left
+ * of the trajectory given by pointPtr and numPoints (or
+ * -borderWidth units wide on the right side, if borderWidth
+ * is negative).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ XPoint *pointPtr; /* Array of points describing
+ * polygon. All points must be
+ * absolute (CoordModeOrigin). */
+ int numPoints; /* Number of points at *pointPtr. */
+ int borderWidth; /* Width of border, measured in
+ * pixels to the left of the polygon's
+ * trajectory. May be negative. */
+ int leftRelief; /* TK_RELIEF_RAISED or
+ * TK_RELIEF_SUNKEN: indicates how
+ * stuff to left of trajectory looks
+ * relative to stuff on right. */
+{
+ XPoint poly[4], b1, b2, newB1, newB2;
+ XPoint perp, c, shift1, shift2; /* Used for handling parallel lines. */
+ register XPoint *p1Ptr, *p2Ptr;
+ TkBorder *borderPtr = (TkBorder *) border;
+ GC gc;
+ int i, lightOnLeft, dx, dy, parallel, pointsSeen;
+ Display *display = Tk_Display(tkwin);
+
+ if (borderPtr->lightGC == None) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ /*
+ * Handle grooves and ridges with recursive calls.
+ */
+
+ if ((leftRelief == TK_RELIEF_GROOVE) || (leftRelief == TK_RELIEF_RIDGE)) {
+ int halfWidth;
+
+ halfWidth = borderWidth/2;
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_RAISED
+ : TK_RELIEF_SUNKEN);
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ -halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_SUNKEN
+ : TK_RELIEF_RAISED);
+ return;
+ }
+
+ /*
+ * If the polygon is already closed, drop the last point from it
+ * (we'll close it automatically).
+ */
+
+ p1Ptr = &pointPtr[numPoints-1];
+ p2Ptr = &pointPtr[0];
+ if ((p1Ptr->x == p2Ptr->x) && (p1Ptr->y == p2Ptr->y)) {
+ numPoints--;
+ }
+
+ /*
+ * The loop below is executed once for each vertex in the polgon.
+ * At the beginning of each iteration things look like this:
+ *
+ * poly[1] /
+ * * /
+ * | /
+ * b1 * poly[0] (pointPtr[i-1])
+ * | |
+ * | |
+ * | |
+ * | |
+ * | |
+ * | | *p1Ptr *p2Ptr
+ * b2 *--------------------*
+ * |
+ * |
+ * x-------------------------
+ *
+ * The job of this iteration is to do the following:
+ * (a) Compute x (the border corner corresponding to
+ * pointPtr[i]) and put it in poly[2]. As part of
+ * this, compute a new b1 and b2 value for the next
+ * side of the polygon.
+ * (b) Put pointPtr[i] into poly[3].
+ * (c) Draw the polygon given by poly[0..3].
+ * (d) Advance poly[0], poly[1], b1, and b2 for the
+ * next side of the polygon.
+ */
+
+ /*
+ * The above situation doesn't first come into existence until
+ * two points have been processed; the first two points are
+ * used to "prime the pump", so some parts of the processing
+ * are ommitted for these points. The variable "pointsSeen"
+ * keeps track of the priming process; it has to be separate
+ * from i in order to be able to ignore duplicate points in the
+ * polygon.
+ */
+
+ pointsSeen = 0;
+ for (i = -2, p1Ptr = &pointPtr[numPoints-2], p2Ptr = p1Ptr+1;
+ i < numPoints; i++, p1Ptr = p2Ptr, p2Ptr++) {
+ if ((i == -1) || (i == numPoints-1)) {
+ p2Ptr = pointPtr;
+ }
+ if ((p2Ptr->x == p1Ptr->x) && (p2Ptr->y == p1Ptr->y)) {
+ /*
+ * Ignore duplicate points (they'd cause core dumps in
+ * ShiftLine calls below).
+ */
+ continue;
+ }
+ ShiftLine(p1Ptr, p2Ptr, borderWidth, &newB1);
+ newB2.x = newB1.x + (p2Ptr->x - p1Ptr->x);
+ newB2.y = newB1.y + (p2Ptr->y - p1Ptr->y);
+ poly[3] = *p1Ptr;
+ parallel = 0;
+ if (pointsSeen >= 1) {
+ parallel = Intersect(&newB1, &newB2, &b1, &b2, &poly[2]);
+
+ /*
+ * If two consecutive segments of the polygon are parallel,
+ * then things get more complex. Consider the following
+ * diagram:
+ *
+ * poly[1]
+ * *----b1-----------b2------a
+ * \
+ * \
+ * *---------*----------* b
+ * poly[0] *p2Ptr *p1Ptr /
+ * /
+ * --*--------*----c
+ * newB1 newB2
+ *
+ * Instead of using x and *p1Ptr for poly[2] and poly[3], as
+ * in the original diagram, use a and b as above. Then instead
+ * of using x and *p1Ptr for the new poly[0] and poly[1], use
+ * b and c as above.
+ *
+ * Do the computation in three stages:
+ * 1. Compute a point "perp" such that the line p1Ptr-perp
+ * is perpendicular to p1Ptr-p2Ptr.
+ * 2. Compute the points a and c by intersecting the lines
+ * b1-b2 and newB1-newB2 with p1Ptr-perp.
+ * 3. Compute b by shifting p1Ptr-perp to the right and
+ * intersecting it with p1Ptr-p2Ptr.
+ */
+
+ if (parallel) {
+ perp.x = p1Ptr->x + (p2Ptr->y - p1Ptr->y);
+ perp.y = p1Ptr->y - (p2Ptr->x - p1Ptr->x);
+ (void) Intersect(p1Ptr, &perp, &b1, &b2, &poly[2]);
+ (void) Intersect(p1Ptr, &perp, &newB1, &newB2, &c);
+ ShiftLine(p1Ptr, &perp, borderWidth, &shift1);
+ shift2.x = shift1.x + (perp.x - p1Ptr->x);
+ shift2.y = shift1.y + (perp.y - p1Ptr->y);
+ (void) Intersect(p1Ptr, p2Ptr, &shift1, &shift2, &poly[3]);
+ }
+ }
+ if (pointsSeen >= 2) {
+ dx = poly[3].x - poly[0].x;
+ dy = poly[3].y - poly[0].y;
+ if (dx > 0) {
+ lightOnLeft = (dy <= dx);
+ } else {
+ lightOnLeft = (dy < dx);
+ }
+ if (lightOnLeft ^ (leftRelief == TK_RELIEF_RAISED)) {
+ gc = borderPtr->lightGC;
+ } else {
+ gc = borderPtr->darkGC;
+ }
+ XFillPolygon(display, drawable, gc, poly, 4, Convex,
+ CoordModeOrigin);
+ }
+ b1.x = newB1.x;
+ b1.y = newB1.y;
+ b2.x = newB2.x;
+ b2.y = newB2.y;
+ poly[0].x = poly[3].x;
+ poly[0].y = poly[3].y;
+ if (parallel) {
+ poly[1].x = c.x;
+ poly[1].y = c.y;
+ } else if (pointsSeen >= 1) {
+ poly[1].x = poly[2].x;
+ poly[1].y = poly[2].y;
+ }
+ pointsSeen++;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Fill3DRectangle --
+ *
+ * Fill a rectangular area, supplying a 3D border if desired.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Fill3DRectangle(tkwin, drawable, border, x, y, width,
+ height, borderWidth, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Outside area of rectangular region. */
+ int borderWidth; /* Desired width for border, in
+ * pixels. Border will be *inside* region. */
+ int relief; /* Indicates 3D effect: TK_RELIEF_FLAT,
+ * TK_RELIEF_RAISED, or TK_RELIEF_SUNKEN. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+ int doubleBorder;
+
+ /*
+ * This code is slightly tricky because it only draws the background
+ * in areas not covered by the 3D border. This avoids flashing
+ * effects on the screen for the border region.
+ */
+
+ if (relief == TK_RELIEF_FLAT) {
+ borderWidth = 0;
+ } else {
+ /*
+ * We need to make this extra check, otherwise we will leave
+ * garbage in thin frames [Bug: 3596]
+ */
+ if (width < 2*borderWidth) {
+ borderWidth = width/2;
+ }
+ if (height < 2*borderWidth) {
+ borderWidth = height/2;
+ }
+ }
+ doubleBorder = 2*borderWidth;
+
+ if ((width > doubleBorder) && (height > doubleBorder)) {
+ XFillRectangle(Tk_Display(tkwin), drawable, borderPtr->bgGC,
+ x + borderWidth, y + borderWidth,
+ (unsigned int) (width - doubleBorder),
+ (unsigned int) (height - doubleBorder));
+ }
+ if (borderWidth) {
+ Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width,
+ height, borderWidth, relief);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Fill3DPolygon --
+ *
+ * Fill a polygonal area, supplying a 3D border if desired.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Fill3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ XPoint *pointPtr; /* Array of points describing
+ * polygon. All points must be
+ * absolute (CoordModeOrigin). */
+ int numPoints; /* Number of points at *pointPtr. */
+ int borderWidth; /* Width of border, measured in
+ * pixels to the left of the polygon's
+ * trajectory. May be negative. */
+ int leftRelief; /* Indicates 3D effect of left side of
+ * trajectory relative to right:
+ * TK_RELIEF_FLAT, TK_RELIEF_RAISED,
+ * or TK_RELIEF_SUNKEN. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+
+ XFillPolygon(Tk_Display(tkwin), drawable, borderPtr->bgGC,
+ pointPtr, numPoints, Complex, CoordModeOrigin);
+ if (leftRelief != TK_RELIEF_FLAT) {
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * BorderInit --
+ *
+ * Initialize the structures used for border management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *-------------------------------------------------------------
+ */
+
+static void
+BorderInit(dispPtr)
+ TkDisplay * dispPtr; /* Used to access thread-specific data. */
+{
+ dispPtr->borderInit = 1;
+ Tcl_InitHashTable(&dispPtr->borderTable, TCL_STRING_KEYS);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ShiftLine --
+ *
+ * Given two points on a line, compute a point on a
+ * new line that is parallel to the given line and
+ * a given distance away from it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ShiftLine(p1Ptr, p2Ptr, distance, p3Ptr)
+ XPoint *p1Ptr; /* First point on line. */
+ XPoint *p2Ptr; /* Second point on line. */
+ int distance; /* New line is to be this many
+ * units to the left of original
+ * line, when looking from p1 to
+ * p2. May be negative. */
+ XPoint *p3Ptr; /* Store coords of point on new
+ * line here. */
+{
+ int dx, dy, dxNeg, dyNeg;
+
+ /*
+ * The table below is used for a quick approximation in
+ * computing the new point. An index into the table
+ * is 128 times the slope of the original line (the slope
+ * must always be between 0 and 1). The value of the table
+ * entry is 128 times the amount to displace the new line
+ * in y for each unit of perpendicular distance. In other
+ * words, the table maps from the tangent of an angle to
+ * the inverse of its cosine. If the slope of the original
+ * line is greater than 1, then the displacement is done in
+ * x rather than in y.
+ */
+
+ static int shiftTable[129];
+
+ /*
+ * Initialize the table if this is the first time it is
+ * used.
+ */
+
+ if (shiftTable[0] == 0) {
+ int i;
+ double tangent, cosine;
+
+ for (i = 0; i <= 128; i++) {
+ tangent = i/128.0;
+ cosine = 128/cos(atan(tangent)) + .5;
+ shiftTable[i] = (int) cosine;
+ }
+ }
+
+ *p3Ptr = *p1Ptr;
+ dx = p2Ptr->x - p1Ptr->x;
+ dy = p2Ptr->y - p1Ptr->y;
+ if (dy < 0) {
+ dyNeg = 1;
+ dy = -dy;
+ } else {
+ dyNeg = 0;
+ }
+ if (dx < 0) {
+ dxNeg = 1;
+ dx = -dx;
+ } else {
+ dxNeg = 0;
+ }
+ if (dy <= dx) {
+ dy = ((distance * shiftTable[(dy<<7)/dx]) + 64) >> 7;
+ if (!dxNeg) {
+ dy = -dy;
+ }
+ p3Ptr->y += dy;
+ } else {
+ dx = ((distance * shiftTable[(dx<<7)/dy]) + 64) >> 7;
+ if (dyNeg) {
+ dx = -dx;
+ }
+ p3Ptr->x += dx;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Intersect --
+ *
+ * Find the intersection point between two lines.
+ *
+ * Results:
+ * Under normal conditions 0 is returned and the point
+ * at *iPtr is filled in with the intersection between
+ * the two lines. If the two lines are parallel, then
+ * -1 is returned and *iPtr isn't modified.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+Intersect(a1Ptr, a2Ptr, b1Ptr, b2Ptr, iPtr)
+ XPoint *a1Ptr; /* First point of first line. */
+ XPoint *a2Ptr; /* Second point of first line. */
+ XPoint *b1Ptr; /* First point of second line. */
+ XPoint *b2Ptr; /* Second point of second line. */
+ XPoint *iPtr; /* Filled in with intersection point. */
+{
+ int dxadyb, dxbdya, dxadxb, dyadyb, p, q;
+
+ /*
+ * The code below is just a straightforward manipulation of two
+ * equations of the form y = (x-x1)*(y2-y1)/(x2-x1) + y1 to solve
+ * for the x-coordinate of intersection, then the y-coordinate.
+ */
+
+ dxadyb = (a2Ptr->x - a1Ptr->x)*(b2Ptr->y - b1Ptr->y);
+ dxbdya = (b2Ptr->x - b1Ptr->x)*(a2Ptr->y - a1Ptr->y);
+ dxadxb = (a2Ptr->x - a1Ptr->x)*(b2Ptr->x - b1Ptr->x);
+ dyadyb = (a2Ptr->y - a1Ptr->y)*(b2Ptr->y - b1Ptr->y);
+
+ if (dxadyb == dxbdya) {
+ return -1;
+ }
+ p = (a1Ptr->x*dxbdya - b1Ptr->x*dxadyb + (b1Ptr->y - a1Ptr->y)*dxadxb);
+ q = dxbdya - dxadyb;
+ if (q < 0) {
+ p = -p;
+ q = -q;
+ }
+ if (p < 0) {
+ iPtr->x = - ((-p + q/2)/q);
+ } else {
+ iPtr->x = (p + q/2)/q;
+ }
+ p = (a1Ptr->y*dxadyb - b1Ptr->y*dxbdya + (b1Ptr->x - a1Ptr->x)*dyadyb);
+ q = dxadyb - dxbdya;
+ if (q < 0) {
+ p = -p;
+ q = -q;
+ }
+ if (p < 0) {
+ iPtr->y = - ((-p + q/2)/q);
+ } else {
+ iPtr->y = (p + q/2)/q;
+ }
+ return 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Get3DBorderFromObj --
+ *
+ * Returns the border referred to by a Tcl object. The border must
+ * already have been allocated via a call to Tk_Alloc3DBorderFromObj
+ * or Tk_Get3DBorder.
+ *
+ * Results:
+ * Returns the Tk_3DBorder that matches the tkwin and the string rep
+ * of the name of the border given in objPtr.
+ *
+ * Side effects:
+ * If the object is not already a border, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Get3DBorderFromObj(tkwin, objPtr)
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object whose string value selects
+ * a border. */
+{
+ TkBorder *borderPtr = NULL;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkBorderObjType) {
+ InitBorderObj(objPtr);
+ }
+
+ /*
+ * If we are lucky (and the user doesn't use too many different
+ * displays, screens, or colormaps...) then the TkBorder
+ * structure we need will be cached in the internal
+ * representation of the Tcl_Obj. Check it out...
+ */
+
+ borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
+ if ((borderPtr != NULL)
+ && (borderPtr->resourceRefCount > 0)
+ && (Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ /*
+ * The object already points to the right border structure.
+ * Just return it.
+ */
+ return (Tk_3DBorder) borderPtr;
+ }
+
+ /*
+ * If we make it here, it means we aren't so lucky. Either there
+ * was no cached TkBorder in the Tcl_Obj, or the TkBorder that was
+ * there is for the wrong screen/colormap. Either way, we have
+ * to search for the right TkBorder. For each color name, there is
+ * linked list of TkBorder structures, one structure for each
+ * screen/colormap combination. The head of the linked list is
+ * recorded in a hash table (where the key is the color name)
+ * attached to the TkDisplay structure. Walk this list to find
+ * the right TkBorder structure.
+ */
+
+ hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ for (borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
+ (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ FreeBorderObjProc(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+ borderPtr->objRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+
+ error:
+ panic("Tk_Get3DBorderFromObj called with non-existent border!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitBorderObj --
+ *
+ * Attempt to generate a border internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a blank internal format for a border value
+ * is intialized. The final form cannot be done without a Tk_Window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitBorderObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkBorderObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugBorder --
+ *
+ * This procedure returns debugging information about a border.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkBorder
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkBorder structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugBorder(tkwin, name)
+ Tk_Window tkwin; /* The window in which the border will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkBorder *borderPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, name);
+ if (hashPtr != NULL) {
+ borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
+ if (borderPtr == NULL) {
+ panic("TkDebugBorder found empty hash table entry");
+ }
+ for ( ; (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(borderPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(borderPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
--- /dev/null
+/*
+ * tkArgv.c --
+ *
+ * This file contains a procedure that handles table-based
+ * argv-argc parsing.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tk.h"
+
+/*
+ * Default table of argument descriptors. These are normally available
+ * in every application.
+ */
+
+static Tk_ArgvInfo defaultTable[] = {
+ {"-help", TK_ARGV_HELP, (char *) NULL, (char *) NULL,
+ "Print summary of command-line options and abort"},
+ {NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
+ (char *) NULL}
+};
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void PrintUsage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_ArgvInfo *argTable, int flags));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ParseArgv --
+ *
+ * Process an argv array according to a table of expected
+ * command-line options. See the manual page for more details.
+ *
+ * Results:
+ * The return value is a standard Tcl return value. If an
+ * error occurs then an error message is left in the interp's result.
+ * Under normal conditions, both *argcPtr and *argv are modified
+ * to return the arguments that couldn't be processed here (they
+ * didn't match the option table, or followed an TK_ARGV_REST
+ * argument).
+ *
+ * Side effects:
+ * Variables may be modified, resources may be entered for tkwin,
+ * or procedures may be called. It all depends on the arguments
+ * and their entries in argTable. See the user documentation
+ * for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags)
+ Tcl_Interp *interp; /* Place to store error message. */
+ Tk_Window tkwin; /* Window to use for setting Tk options.
+ * NULL means ignore Tk option specs. */
+ int *argcPtr; /* Number of arguments in argv. Modified
+ * to hold # args left in argv at end. */
+ CONST char **argv; /* Array of arguments. Modified to hold
+ * those that couldn't be processed here. */
+ Tk_ArgvInfo *argTable; /* Array of option descriptions */
+ int flags; /* Or'ed combination of various flag bits,
+ * such as TK_ARGV_NO_DEFAULTS. */
+{
+ register Tk_ArgvInfo *infoPtr;
+ /* Pointer to the current entry in the
+ * table of argument descriptions. */
+ Tk_ArgvInfo *matchPtr; /* Descriptor that matches current argument. */
+ CONST char *curArg; /* Current argument */
+ register char c; /* Second character of current arg (used for
+ * quick check for matching; use 2nd char.
+ * because first char. will almost always
+ * be '-'). */
+ int srcIndex; /* Location from which to read next argument
+ * from argv. */
+ int dstIndex; /* Index into argv to which next unused
+ * argument should be copied (never greater
+ * than srcIndex). */
+ int argc; /* # arguments in argv still to process. */
+ size_t length; /* Number of characters in current argument. */
+ int i;
+
+ if (flags & TK_ARGV_DONT_SKIP_FIRST_ARG) {
+ srcIndex = dstIndex = 0;
+ argc = *argcPtr;
+ } else {
+ srcIndex = dstIndex = 1;
+ argc = *argcPtr-1;
+ }
+
+ while (argc > 0) {
+ curArg = argv[srcIndex];
+ srcIndex++;
+ argc--;
+ length = strlen(curArg);
+ if (length > 0) {
+ c = curArg[1];
+ } else {
+ c = 0;
+ }
+
+ /*
+ * Loop throught the argument descriptors searching for one with
+ * the matching key string. If found, leave a pointer to it in
+ * matchPtr.
+ */
+
+ matchPtr = NULL;
+ for (i = 0; i < 2; i++) {
+ if (i == 0) {
+ infoPtr = argTable;
+ } else {
+ infoPtr = defaultTable;
+ }
+ for (; (infoPtr != NULL) && (infoPtr->type != TK_ARGV_END);
+ infoPtr++) {
+ if (infoPtr->key == NULL) {
+ continue;
+ }
+ if ((infoPtr->key[1] != c)
+ || (strncmp(infoPtr->key, curArg, length) != 0)) {
+ continue;
+ }
+ if ((tkwin == NULL)
+ && ((infoPtr->type == TK_ARGV_CONST_OPTION)
+ || (infoPtr->type == TK_ARGV_OPTION_VALUE)
+ || (infoPtr->type == TK_ARGV_OPTION_NAME_VALUE))) {
+ continue;
+ }
+ if (infoPtr->key[length] == 0) {
+ matchPtr = infoPtr;
+ goto gotMatch;
+ }
+ if (flags & TK_ARGV_NO_ABBREV) {
+ continue;
+ }
+ if (matchPtr != NULL) {
+ Tcl_AppendResult(interp, "ambiguous option \"", curArg,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ matchPtr = infoPtr;
+ }
+ }
+ if (matchPtr == NULL) {
+
+ /*
+ * Unrecognized argument. Just copy it down, unless the caller
+ * prefers an error to be registered.
+ */
+
+ if (flags & TK_ARGV_NO_LEFTOVERS) {
+ Tcl_AppendResult(interp, "unrecognized argument \"",
+ curArg, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ argv[dstIndex] = curArg;
+ dstIndex++;
+ continue;
+ }
+
+ /*
+ * Take the appropriate action based on the option type
+ */
+
+ gotMatch:
+ infoPtr = matchPtr;
+ switch (infoPtr->type) {
+ case TK_ARGV_CONSTANT:
+ *((int *) infoPtr->dst) = (int) infoPtr->src;
+ break;
+ case TK_ARGV_INT:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ char *endPtr;
+
+ *((int *) infoPtr->dst) =
+ strtol(argv[srcIndex], &endPtr, 0);
+ if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) {
+ Tcl_AppendResult(interp, "expected integer argument ",
+ "for \"", infoPtr->key, "\" but got \"",
+ argv[srcIndex], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_STRING:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ *((CONST char **)infoPtr->dst) = argv[srcIndex];
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_UID:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ *((Tk_Uid *)infoPtr->dst) = Tk_GetUid(argv[srcIndex]);
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_REST:
+ *((int *) infoPtr->dst) = dstIndex;
+ goto argsDone;
+ case TK_ARGV_FLOAT:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ char *endPtr;
+
+ *((double *) infoPtr->dst) =
+ strtod(argv[srcIndex], &endPtr);
+ if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) {
+ Tcl_AppendResult(interp, "expected floating-point ",
+ "argument for \"", infoPtr->key,
+ "\" but got \"", argv[srcIndex], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_FUNC: {
+ typedef int (ArgvFunc) _ANSI_ARGS_ ((char *, char *,
+ CONST char *));
+ ArgvFunc *handlerProc;
+
+ handlerProc = (ArgvFunc *) infoPtr->src;
+ if ((*handlerProc)(infoPtr->dst, infoPtr->key,
+ argv[srcIndex])) {
+ srcIndex += 1;
+ argc -= 1;
+ }
+ break;
+ }
+ case TK_ARGV_GENFUNC: {
+ typedef int (ArgvGenFunc)_ANSI_ARGS_((char *, Tcl_Interp *,
+ char *, int, CONST char **));
+ ArgvGenFunc *handlerProc;
+
+ handlerProc = (ArgvGenFunc *) infoPtr->src;
+ argc = (*handlerProc)(infoPtr->dst, interp, infoPtr->key,
+ argc, argv+srcIndex);
+ if (argc < 0) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case TK_ARGV_HELP:
+ PrintUsage (interp, argTable, flags);
+ return TCL_ERROR;
+ case TK_ARGV_CONST_OPTION:
+ Tk_AddOption(tkwin, infoPtr->dst, infoPtr->src,
+ TK_INTERACTIVE_PRIO);
+ break;
+ case TK_ARGV_OPTION_VALUE:
+ if (argc < 1) {
+ goto missingArg;
+ }
+ Tk_AddOption(tkwin, infoPtr->dst, argv[srcIndex],
+ TK_INTERACTIVE_PRIO);
+ srcIndex++;
+ argc--;
+ break;
+ case TK_ARGV_OPTION_NAME_VALUE:
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "\"", curArg,
+ "\" option requires two following arguments",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1],
+ TK_INTERACTIVE_PRIO);
+ srcIndex += 2;
+ argc -= 2;
+ break;
+ default: {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "bad argument type %d in Tk_ArgvInfo",
+ infoPtr->type);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ /*
+ * If we broke out of the loop because of an OPT_REST argument,
+ * copy the remaining arguments down.
+ */
+
+ argsDone:
+ while (argc) {
+ argv[dstIndex] = argv[srcIndex];
+ srcIndex++;
+ dstIndex++;
+ argc--;
+ }
+ argv[dstIndex] = (char *) NULL;
+ *argcPtr = dstIndex;
+ return TCL_OK;
+
+ missingArg:
+ Tcl_AppendResult(interp, "\"", curArg,
+ "\" option requires an additional argument", (char *) NULL);
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintUsage --
+ *
+ * Generate a help string describing command-line options.
+ *
+ * Results:
+ * The interp's result will be modified to hold a help string
+ * describing all the options in argTable, plus all those
+ * in the default table unless TK_ARGV_NO_DEFAULTS is
+ * specified in flags.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintUsage(interp, argTable, flags)
+ Tcl_Interp *interp; /* Place information in this interp's
+ * result area. */
+ Tk_ArgvInfo *argTable; /* Array of command-specific argument
+ * descriptions. */
+ int flags; /* If the TK_ARGV_NO_DEFAULTS bit is set
+ * in this word, then don't generate
+ * information for default options. */
+{
+ register Tk_ArgvInfo *infoPtr;
+ int width, i, numSpaces;
+#define NUM_SPACES 20
+ static char spaces[] = " ";
+ char tmp[TCL_DOUBLE_SPACE];
+
+ /*
+ * First, compute the width of the widest option key, so that we
+ * can make everything line up.
+ */
+
+ width = 4;
+ for (i = 0; i < 2; i++) {
+ for (infoPtr = i ? defaultTable : argTable;
+ infoPtr->type != TK_ARGV_END; infoPtr++) {
+ int length;
+ if (infoPtr->key == NULL) {
+ continue;
+ }
+ length = strlen(infoPtr->key);
+ if (length > width) {
+ width = length;
+ }
+ }
+ }
+
+ Tcl_AppendResult(interp, "Command-specific options:", (char *) NULL);
+ for (i = 0; ; i++) {
+ for (infoPtr = i ? defaultTable : argTable;
+ infoPtr->type != TK_ARGV_END; infoPtr++) {
+ if ((infoPtr->type == TK_ARGV_HELP) && (infoPtr->key == NULL)) {
+ Tcl_AppendResult(interp, "\n", infoPtr->help, (char *) NULL);
+ continue;
+ }
+ Tcl_AppendResult(interp, "\n ", infoPtr->key, ":", (char *) NULL);
+ numSpaces = width + 1 - strlen(infoPtr->key);
+ while (numSpaces > 0) {
+ if (numSpaces >= NUM_SPACES) {
+ Tcl_AppendResult(interp, spaces, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces,
+ (char *) NULL);
+ }
+ numSpaces -= NUM_SPACES;
+ }
+ Tcl_AppendResult(interp, infoPtr->help, (char *) NULL);
+ switch (infoPtr->type) {
+ case TK_ARGV_INT: {
+ sprintf(tmp, "%d", *((int *) infoPtr->dst));
+ Tcl_AppendResult(interp, "\n\t\tDefault value: ",
+ tmp, (char *) NULL);
+ break;
+ }
+ case TK_ARGV_FLOAT: {
+ sprintf(tmp, "%g", *((double *) infoPtr->dst));
+ Tcl_AppendResult(interp, "\n\t\tDefault value: ",
+ tmp, (char *) NULL);
+ break;
+ }
+ case TK_ARGV_STRING: {
+ char *string;
+
+ string = *((char **) infoPtr->dst);
+ if (string != NULL) {
+ Tcl_AppendResult(interp, "\n\t\tDefault value: \"",
+ string, "\"", (char *) NULL);
+ }
+ break;
+ }
+ default: {
+ break;
+ }
+ }
+ }
+
+ if ((flags & TK_ARGV_NO_DEFAULTS) || (i > 0)) {
+ break;
+ }
+ Tcl_AppendResult(interp, "\nGeneric options for all commands:",
+ (char *) NULL);
+ }
+}
--- /dev/null
+/*
+ * tkAtom.c --
+ *
+ * This file manages a cache of X Atoms in order to avoid
+ * interactions with the X server. It's much like the Xmu
+ * routines, except it has a cleaner interface (caller
+ * doesn't have to provide permanent storage for atom names,
+ * for example).
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following are a list of the predefined atom strings.
+ * They should match those found in xatom.h
+ */
+
+static char * atomNameArray[] = {
+ "PRIMARY", "SECONDARY", "ARC",
+ "ATOM", "BITMAP", "CARDINAL",
+ "COLORMAP", "CURSOR", "CUT_BUFFER0",
+ "CUT_BUFFER1", "CUT_BUFFER2", "CUT_BUFFER3",
+ "CUT_BUFFER4", "CUT_BUFFER5", "CUT_BUFFER6",
+ "CUT_BUFFER7", "DRAWABLE", "FONT",
+ "INTEGER", "PIXMAP", "POINT",
+ "RECTANGLE", "RESOURCE_MANAGER", "RGB_COLOR_MAP",
+ "RGB_BEST_MAP", "RGB_BLUE_MAP", "RGB_DEFAULT_MAP",
+ "RGB_GRAY_MAP", "RGB_GREEN_MAP", "RGB_RED_MAP",
+ "STRING", "VISUALID", "WINDOW",
+ "WM_COMMAND", "WM_HINTS", "WM_CLIENT_MACHINE",
+ "WM_ICON_NAME", "WM_ICON_SIZE", "WM_NAME",
+ "WM_NORMAL_HINTS", "WM_SIZE_HINTS", "WM_ZOOM_HINTS",
+ "MIN_SPACE", "NORM_SPACE", "MAX_SPACE",
+ "END_SPACE", "SUPERSCRIPT_X", "SUPERSCRIPT_Y",
+ "SUBSCRIPT_X", "SUBSCRIPT_Y", "UNDERLINE_POSITION",
+ "UNDERLINE_THICKNESS", "STRIKEOUT_ASCENT", "STRIKEOUT_DESCENT",
+ "ITALIC_ANGLE", "X_HEIGHT", "QUAD_WIDTH",
+ "WEIGHT", "POINT_SIZE", "RESOLUTION",
+ "COPYRIGHT", "NOTICE", "FONT_NAME",
+ "FAMILY_NAME", "FULL_NAME", "CAP_HEIGHT",
+ "WM_CLASS", "WM_TRANSIENT_FOR",
+ (char *) NULL
+};
+
+/*
+ * Forward references to procedures defined in this file:
+ */
+
+static void AtomInit _ANSI_ARGS_((TkDisplay *dispPtr));
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_InternAtom --
+ *
+ * Given a string, produce the equivalent X atom. This
+ * procedure is equivalent to XInternAtom, except that it
+ * keeps a local cache of atoms. Once a name is known,
+ * the server need not be contacted again for that name.
+ *
+ * Results:
+ * The return value is the Atom corresponding to name.
+ *
+ * Side effects:
+ * A new entry may be added to the local atom cache.
+ *
+ *--------------------------------------------------------------
+ */
+
+Atom
+Tk_InternAtom(tkwin, name)
+ Tk_Window tkwin; /* Window token; map name to atom
+ * for this window's display. */
+ CONST char *name; /* Name to turn into atom. */
+{
+ register TkDisplay *dispPtr;
+ register Tcl_HashEntry *hPtr;
+ int new;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->atomInit) {
+ AtomInit(dispPtr);
+ }
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &new);
+ if (new) {
+ Tcl_HashEntry *hPtr2;
+ Atom atom;
+
+ atom = XInternAtom(dispPtr->display, name, False);
+ Tcl_SetHashValue(hPtr, atom);
+ hPtr2 = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr2, Tcl_GetHashKey(&dispPtr->nameTable, hPtr));
+ }
+ return (Atom) Tcl_GetHashValue(hPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAtomName --
+ *
+ * This procedure is equivalent to XGetAtomName except that
+ * it uses the local atom cache to avoid contacting the
+ * server.
+ *
+ * Results:
+ * The return value is a character string corresponding to
+ * the atom given by "atom". This string's storage space
+ * is static: it need not be freed by the caller, and should
+ * not be modified by the caller. If "atom" doesn't exist
+ * on tkwin's display, then the string "?bad atom?" is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_GetAtomName(tkwin, atom)
+ Tk_Window tkwin; /* Window token; map atom to name
+ * relative to this window's
+ * display. */
+ Atom atom; /* Atom whose name is wanted. */
+{
+ register TkDisplay *dispPtr;
+ register Tcl_HashEntry *hPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->atomInit) {
+ AtomInit(dispPtr);
+ }
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
+ if (hPtr == NULL) {
+ char *name;
+ Tk_ErrorHandler handler;
+ int new, mustFree;
+
+ handler= Tk_CreateErrorHandler(dispPtr->display, BadAtom,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ name = XGetAtomName(dispPtr->display, atom);
+ mustFree = 1;
+ if (name == NULL) {
+ name = "?bad atom?";
+ mustFree = 0;
+ }
+ Tk_DeleteErrorHandler(handler);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, (char *) name,
+ &new);
+ Tcl_SetHashValue(hPtr, atom);
+ if (mustFree) {
+ XFree(name);
+ }
+ name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr, name);
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * AtomInit --
+ *
+ * Initialize atom-related information for a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tables get initialized, etc. etc..
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AtomInit(dispPtr)
+ register TkDisplay *dispPtr; /* Display to initialize. */
+{
+ Tcl_HashEntry *hPtr;
+ Atom atom;
+
+ dispPtr->atomInit = 1;
+ Tcl_InitHashTable(&dispPtr->nameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->atomTable, TCL_ONE_WORD_KEYS);
+
+ for (atom = 1; atom <= XA_LAST_PREDEFINED; atom++) {
+ hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
+ if (hPtr == NULL) {
+ char *name;
+ int new;
+
+ name = atomNameArray[atom - 1];
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, (char *) name,
+ &new);
+ Tcl_SetHashValue(hPtr, atom);
+ name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr, name);
+ }
+ }
+}
--- /dev/null
+/*
+ * tkBind.c --
+ *
+ * This file provides procedures that associate Tcl commands
+ * with X events or sequences of X events.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* UNIX */
+#include "tkUnixInt.h"
+#endif
+
+
+/*
+ * File structure:
+ *
+ * Structure definitions and static variables.
+ *
+ * Init/Free this package.
+ *
+ * Tcl "bind" command (actually located in tkCmds.c).
+ * "bind" command implementation.
+ * "bind" implementation helpers.
+ *
+ * Tcl "event" command.
+ * "event" command implementation.
+ * "event" implementation helpers.
+ *
+ * Package-specific common helpers.
+ *
+ * Non-package-specific helpers.
+ */
+
+
+/*
+ * The following union is used to hold the detail information from an
+ * XEvent (including Tk's XVirtualEvent extension).
+ */
+typedef union {
+ KeySym keySym; /* KeySym that corresponds to xkey.keycode. */
+ int button; /* Button that was pressed (xbutton.button). */
+ Tk_Uid name; /* Tk_Uid of virtual event. */
+ ClientData clientData; /* Used when type of Detail is unknown, and to
+ * ensure that all bytes of Detail are initialized
+ * when this structure is used in a hash key. */
+} Detail;
+
+/*
+ * 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 Tk_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 {
+ XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
+ * (higher indices are for more recent
+ * events). */
+ Detail detailRing[EVENT_BUFFER_SIZE];/* "Detail" information (keySym,
+ * button, Tk_Uid, or 0) 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;
+
+/*
+ * The following structure represents virtual event table. A virtual event
+ * table provides a way to map from platform-specific physical events such
+ * as button clicks or key presses to virtual events such as <<Paste>>,
+ * <<Close>>, or <<ScrollWindow>>.
+ *
+ * A virtual event is usually never part of the event stream, but instead is
+ * synthesized inline by matching low-level events. However, a virtual
+ * event may be generated by platform-specific code or by Tcl scripts. In
+ * that case, no lookup of the virtual event will need to be done using
+ * this table, because the virtual event is actually in the event stream.
+ */
+
+typedef struct VirtualEventTable {
+ Tcl_HashTable patternTable; /* Used to map from a physical event to
+ * a list of patterns that may match that
+ * event. Keys are PatternTableKey
+ * structs, values are (PatSeq *). */
+ Tcl_HashTable nameTable; /* Used to map a virtual event name to
+ * the array of physical events that can
+ * trigger it. Keys are the Tk_Uid names
+ * of the virtual events, values are
+ * PhysicalsOwned structs. */
+} VirtualEventTable;
+
+/*
+ * The following structure is used as a key in a patternTable for both
+ * binding tables and a virtual event tables.
+ *
+ * In a binding table, the object field corresponds to the binding tag
+ * for the widget whose bindings are being accessed.
+ *
+ * In a virtual event table, the object field is always NULL. Virtual
+ * events are a global definiton and are not tied to a particular
+ * binding tag.
+ *
+ * The same key is used for both types of pattern tables so that the
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+typedef struct PatternTableKey {
+ ClientData object; /* For binding table, identifies the binding
+ * tag of the object (or class of objects)
+ * relative to which the event occurred.
+ * For virtual event table, always NULL. */
+ int type; /* Type of event (from X). */
+ Detail detail; /* Additional information, such as keysym,
+ * button, Tk_Uid, or 0 if nothing
+ * additional. */
+} PatternTableKey;
+
+/*
+ * The following structure defines a pattern, which is matched against X
+ * events as part of the process of converting X events into Tcl commands.
+ */
+
+typedef struct Pattern {
+ int eventType; /* Type of X event, e.g. ButtonPress. */
+ int needMods; /* Mask of modifiers that must be
+ * present (0 means no modifiers are
+ * required). */
+ Detail detail; /* Additional information that must
+ * match event. Normally this is 0,
+ * meaning no additional information
+ * must match. For KeyPress and
+ * KeyRelease events, a keySym may
+ * be specified to select a
+ * particular keystroke (0 means any
+ * keystrokes). For button events,
+ * specifies a particular button (0
+ * means any buttons are OK). For virtual
+ * events, specifies the Tk_Uid of the
+ * virtual event name (never 0). */
+} Pattern;
+
+/*
+ * The following structure 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). It is used as the hash value in a
+ * patternTable for both binding tables and virtual event tables.
+ *
+ * In a binding table, it is the sequence of physical events that make up
+ * a binding for an object.
+ *
+ * In a virtual event table, it is the sequence of physical events that
+ * define a virtual event.
+ *
+ * The same structure is used for both types of pattern tables so that the
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+
+typedef struct PatSeq {
+ int numPats; /* Number of patterns in sequence (usually
+ * 1). */
+ TkBindEvalProc *eventProc; /* The procedure that will be invoked on
+ * the clientData when this pattern sequence
+ * matches. */
+ TkBindFreeProc *freeProc; /* The procedure that will be invoked to
+ * release the clientData when this pattern
+ * sequence is freed. */
+ ClientData clientData; /* Arbitray data passed to eventProc and
+ * freeProc when sequence matches. */
+ int flags; /* Miscellaneous flag values; see below for
+ * definitions. */
+ int refCount; /* Number of times that this binding is in
+ * the midst of executing. If greater than 1,
+ * then a recursive invocation is happening.
+ * Only when this is zero can the binding
+ * actually be freed. */
+ 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. */
+ struct VirtualOwners *voPtr;/* In a binding table, always NULL. In a
+ * virtual event table, identifies the array
+ * of virtual events that can be triggered by
+ * this event. */
+ struct PatSeq *nextObjPtr; /* In a binding table, next in list of all
+ * pattern sequences for the same object (NULL
+ * for end of list). Needed to implement
+ * Tk_DeleteAllBindings. In a virtual event
+ * table, always NULL. */
+ 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;
+
+/*
+ * Flag values for PatSeq structures:
+ *
+ * PAT_NEARBY 1 means that all of the events matching
+ * this sequence must occur with nearby X
+ * and Y mouse coordinates and close in time.
+ * This is typically used to restrict multiple
+ * button presses.
+ * MARKED_DELETED 1 means that this binding has been marked as deleted
+ * and removed from the binding table, but its memory
+ * could not be released because it was already queued for
+ * execution. When the binding is actually about to be
+ * executed, this flag will be checked and the binding
+ * skipped if set.
+ */
+
+#define PAT_NEARBY 0x1
+#define MARKED_DELETED 0x2
+
+/*
+ * Constants that define how close together two events must be
+ * in milliseconds or pixels to meet the PAT_NEARBY constraint:
+ */
+
+#define NEARBY_PIXELS 5
+#define NEARBY_MS 500
+
+
+/*
+ * The following structure keeps track of all the virtual events that are
+ * associated with a particular physical event. It is pointed to by the
+ * voPtr field in a PatSeq in the patternTable of a virtual event table.
+ */
+
+typedef struct VirtualOwners {
+ int numOwners; /* Number of virtual events to trigger. */
+ Tcl_HashEntry *owners[1]; /* Array of pointers to entries in
+ * nameTable. Enough space will
+ * actually be allocated for numOwners
+ * hash entries. */
+} VirtualOwners;
+
+/*
+ * The following structure is used in the nameTable of a virtual event
+ * table to associate a virtual event with all the physical events that can
+ * trigger it.
+ */
+typedef struct PhysicalsOwned {
+ int numOwned; /* Number of physical events owned. */
+ PatSeq *patSeqs[1]; /* Array of pointers to physical event
+ * patterns. Enough space will actually
+ * be allocated to hold numOwned. */
+} PhysicalsOwned;
+
+/*
+ * One of the following structures exists for each interpreter. This
+ * structure keeps track of the current display and screen in the
+ * interpreter, so that a script can be invoked whenever the display/screen
+ * changes (the script does things like point tk::Priv at a display-specific
+ * structure).
+ */
+
+typedef struct {
+ TkDisplay *curDispPtr; /* Display for last binding command invoked
+ * in this application. */
+ int curScreenIndex; /* Index of screen for last binding command. */
+ int bindingDepth; /* Number of active instances of Tk_BindEvent
+ * in this application. */
+} ScreenInfo;
+
+/*
+ * The following structure is used to keep track of all the C bindings that
+ * are awaiting invocation and whether the window they refer to has been
+ * destroyed. If the window is destroyed, then all pending callbacks for
+ * that window will be cancelled. The Tcl bindings will still all be
+ * invoked, however.
+ */
+
+typedef struct PendingBinding {
+ struct PendingBinding *nextPtr;
+ /* Next in chain of pending bindings, in
+ * case a recursive binding evaluation is in
+ * progress. */
+ Tk_Window tkwin; /* The window that the following bindings
+ * depend upon. */
+ int deleted; /* Set to non-zero by window cleanup code
+ * if tkwin is deleted. */
+ PatSeq *matchArray[5]; /* Array of pending C bindings. The actual
+ * size of this depends on how many C bindings
+ * matched the event passed to Tk_BindEvent.
+ * THIS FIELD MUST BE THE LAST IN THE
+ * STRUCTURE. */
+} PendingBinding;
+
+/*
+ * The following structure keeps track of all the information local to
+ * the binding package on a per interpreter basis.
+ */
+
+typedef struct BindInfo {
+ VirtualEventTable virtualEventTable;
+ /* The virtual events that exist in this
+ * interpreter. */
+ ScreenInfo screenInfo; /* Keeps track of the current display and
+ * screen, so it can be restored after
+ * a binding has executed. */
+ PendingBinding *pendingList;/* The list of pending C bindings, kept in
+ * case a C or Tcl binding causes the target
+ * window to be deleted. */
+ int deleted; /* 1 the application has been deleted but
+ * the structure has been preserved. */
+} BindInfo;
+
+/*
+ * In X11R4 and earlier versions, XStringToKeysym is ridiculously
+ * slow. The data structure and hash table below, along with the
+ * code that uses them, implement a fast mapping from strings to
+ * keysyms. In X11R5 and later releases XStringToKeysym is plenty
+ * fast so this stuff isn't needed. The #define REDO_KEYSYM_LOOKUP
+ * is normally undefined, so that XStringToKeysym gets used. It
+ * can be set in the Makefile to enable the use of the hash table
+ * below.
+ */
+
+#ifdef REDO_KEYSYM_LOOKUP
+typedef struct {
+ char *name; /* Name of keysym. */
+ KeySym value; /* Numeric identifier for keysym. */
+} KeySymInfo;
+static KeySymInfo keyArray[] = {
+#ifndef lint
+#include "ks_names.h"
+#endif
+ {(char *) NULL, 0}
+};
+static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */
+static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
+#endif /* REDO_KEYSYM_LOOKUP */
+
+/*
+ * Set to non-zero when the package-wide static variables have been
+ * initialized.
+ */
+
+static int initialized = 0;
+TCL_DECLARE_MUTEX(bindMutex)
+
+/*
+ * A hash table is kept to map from the string names of event
+ * modifiers to information about those modifiers. The structure
+ * for storing this information, and the hash table built at
+ * initialization time, are defined below.
+ */
+
+typedef struct {
+ char *name; /* Name of modifier. */
+ int mask; /* Button/modifier mask value, * such as Button1Mask. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} ModInfo;
+
+/*
+ * Flags for ModInfo structures:
+ *
+ * DOUBLE - Non-zero means duplicate this event,
+ * e.g. for double-clicks.
+ * TRIPLE - Non-zero means triplicate this event,
+ * e.g. for triple-clicks.
+ * QUADRUPLE - Non-zero means quadruple this event,
+ * e.g. for 4-fold-clicks.
+ * MULT_CLICKS - Combination of all of above.
+ */
+
+#define DOUBLE 1
+#define TRIPLE 2
+#define QUADRUPLE 4
+#define MULT_CLICKS 7
+
+static ModInfo modArray[] = {
+ {"Control", ControlMask, 0},
+ {"Shift", ShiftMask, 0},
+ {"Lock", LockMask, 0},
+ {"Meta", META_MASK, 0},
+ {"M", META_MASK, 0},
+ {"Alt", ALT_MASK, 0},
+ {"B1", Button1Mask, 0},
+ {"Button1", Button1Mask, 0},
+ {"B2", Button2Mask, 0},
+ {"Button2", Button2Mask, 0},
+ {"B3", Button3Mask, 0},
+ {"Button3", Button3Mask, 0},
+ {"B4", Button4Mask, 0},
+ {"Button4", Button4Mask, 0},
+ {"B5", Button5Mask, 0},
+ {"Button5", Button5Mask, 0},
+ {"Mod1", Mod1Mask, 0},
+ {"M1", Mod1Mask, 0},
+ {"Command", Mod1Mask, 0},
+ {"Mod2", Mod2Mask, 0},
+ {"M2", Mod2Mask, 0},
+ {"Option", Mod2Mask, 0},
+ {"Mod3", Mod3Mask, 0},
+ {"M3", Mod3Mask, 0},
+ {"Mod4", Mod4Mask, 0},
+ {"M4", Mod4Mask, 0},
+ {"Mod5", Mod5Mask, 0},
+ {"M5", Mod5Mask, 0},
+ {"Double", 0, DOUBLE},
+ {"Triple", 0, TRIPLE},
+ {"Quadruple", 0, QUADRUPLE},
+ {"Any", 0, 0}, /* Ignored: historical relic. */
+ {NULL, 0, 0}
+};
+static Tcl_HashTable modTable;
+
+/*
+ * 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 XSelectInput)
+ * for this event type. */
+} EventInfo;
+
+/*
+ * Note: some of the masks below are an OR-ed combination of
+ * several masks. This is necessary because X doesn't report
+ * up events unless you also ask for down events. Also, X
+ * doesn't report button state in motion events unless you've
+ * asked about button events.
+ */
+
+static EventInfo eventArray[] = {
+ {"Key", KeyPress, KeyPressMask},
+ {"KeyPress", KeyPress, KeyPressMask},
+ {"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask},
+ {"Button", ButtonPress, ButtonPressMask},
+ {"ButtonPress", ButtonPress, ButtonPressMask},
+ {"ButtonRelease", ButtonRelease,
+ ButtonPressMask|ButtonReleaseMask},
+ {"Motion", MotionNotify,
+ ButtonPressMask|PointerMotionMask},
+ {"Enter", EnterNotify, EnterWindowMask},
+ {"Leave", LeaveNotify, LeaveWindowMask},
+ {"FocusIn", FocusIn, FocusChangeMask},
+ {"FocusOut", FocusOut, FocusChangeMask},
+ {"Expose", Expose, ExposureMask},
+ {"Visibility", VisibilityNotify, VisibilityChangeMask},
+ {"Destroy", DestroyNotify, StructureNotifyMask},
+ {"Unmap", UnmapNotify, StructureNotifyMask},
+ {"Map", MapNotify, StructureNotifyMask},
+ {"Reparent", ReparentNotify, StructureNotifyMask},
+ {"Configure", ConfigureNotify, StructureNotifyMask},
+ {"Gravity", GravityNotify, StructureNotifyMask},
+ {"Circulate", CirculateNotify, StructureNotifyMask},
+ {"Property", PropertyNotify, PropertyChangeMask},
+ {"Colormap", ColormapNotify, ColormapChangeMask},
+ {"Activate", ActivateNotify, ActivateMask},
+ {"Deactivate", DeactivateNotify, ActivateMask},
+ {"MouseWheel", MouseWheelEvent, MouseWheelMask},
+ {"CirculateRequest", CirculateRequest, SubstructureRedirectMask},
+ {"ConfigureRequest", ConfigureRequest, SubstructureRedirectMask},
+ {"Create", CreateNotify, SubstructureNotifyMask},
+ {"MapRequest", MapRequest, SubstructureRedirectMask},
+ {"ResizeRequest", ResizeRequest, ResizeRedirectMask},
+ {(char *) NULL, 0, 0}
+};
+static Tcl_HashTable eventTable;
+
+/*
+ * The defines and table below are used to classify events into
+ * various groups. The reason for this is that logically identical
+ * fields (e.g. "state") appear at different places in different
+ * types of events. The classification masks can be used to figure
+ * out quickly where to extract information from events.
+ */
+
+#define KEY 0x1
+#define BUTTON 0x2
+#define MOTION 0x4
+#define CROSSING 0x8
+#define FOCUS 0x10
+#define EXPOSE 0x20
+#define VISIBILITY 0x40
+#define CREATE 0x80
+#define DESTROY 0x100
+#define UNMAP 0x200
+#define MAP 0x400
+#define REPARENT 0x800
+#define CONFIG 0x1000
+#define GRAVITY 0x2000
+#define CIRC 0x4000
+#define PROP 0x8000
+#define COLORMAP 0x10000
+#define VIRTUAL 0x20000
+#define ACTIVATE 0x40000
+#define MAPREQ 0x80000
+#define CONFIGREQ 0x100000
+#define RESIZEREQ 0x200000
+#define CIRCREQ 0x400000
+
+#define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL)
+
+static int flagArray[TK_LASTEVENT] = {
+ /* Not used */ 0,
+ /* Not used */ 0,
+ /* KeyPress */ KEY,
+ /* KeyRelease */ KEY,
+ /* ButtonPress */ BUTTON,
+ /* ButtonRelease */ BUTTON,
+ /* MotionNotify */ MOTION,
+ /* EnterNotify */ CROSSING,
+ /* LeaveNotify */ CROSSING,
+ /* FocusIn */ FOCUS,
+ /* FocusOut */ FOCUS,
+ /* KeymapNotify */ 0,
+ /* Expose */ EXPOSE,
+ /* GraphicsExpose */ EXPOSE,
+ /* NoExpose */ 0,
+ /* VisibilityNotify */ VISIBILITY,
+ /* CreateNotify */ CREATE,
+ /* DestroyNotify */ DESTROY,
+ /* UnmapNotify */ UNMAP,
+ /* MapNotify */ MAP,
+ /* MapRequest */ MAPREQ,
+ /* ReparentNotify */ REPARENT,
+ /* ConfigureNotify */ CONFIG,
+ /* ConfigureRequest */ CONFIGREQ,
+ /* GravityNotify */ GRAVITY,
+ /* ResizeRequest */ RESIZEREQ,
+ /* CirculateNotify */ CIRC,
+ /* CirculateRequest */ 0,
+ /* PropertyNotify */ PROP,
+ /* SelectionClear */ 0,
+ /* SelectionRequest */ 0,
+ /* SelectionNotify */ 0,
+ /* ColormapNotify */ COLORMAP,
+ /* ClientMessage */ 0,
+ /* MappingNotify */ 0,
+ /* VirtualEvent */ VIRTUAL,
+ /* Activate */ ACTIVATE,
+ /* Deactivate */ ACTIVATE,
+ /* MouseWheel */ KEY
+};
+
+/*
+ * The following table is used to map between the location where an
+ * generated event should be queued and the string used to specify the
+ * location.
+ */
+
+static TkStateMap queuePosition[] = {
+ {-1, "now"},
+ {TCL_QUEUE_HEAD, "head"},
+ {TCL_QUEUE_MARK, "mark"},
+ {TCL_QUEUE_TAIL, "tail"},
+ {-2, NULL}
+};
+
+/*
+ * The following tables are used as a two-way map between X's internal
+ * numeric values for fields in an XEvent and the strings used in Tcl. The
+ * tables are used both when constructing an XEvent from user input and
+ * when providing data from an XEvent to the user.
+ */
+
+static TkStateMap notifyMode[] = {
+ {NotifyNormal, "NotifyNormal"},
+ {NotifyGrab, "NotifyGrab"},
+ {NotifyUngrab, "NotifyUngrab"},
+ {NotifyWhileGrabbed, "NotifyWhileGrabbed"},
+ {-1, NULL}
+};
+
+static TkStateMap notifyDetail[] = {
+ {NotifyAncestor, "NotifyAncestor"},
+ {NotifyVirtual, "NotifyVirtual"},
+ {NotifyInferior, "NotifyInferior"},
+ {NotifyNonlinear, "NotifyNonlinear"},
+ {NotifyNonlinearVirtual, "NotifyNonlinearVirtual"},
+ {NotifyPointer, "NotifyPointer"},
+ {NotifyPointerRoot, "NotifyPointerRoot"},
+ {NotifyDetailNone, "NotifyDetailNone"},
+ {-1, NULL}
+};
+
+static TkStateMap circPlace[] = {
+ {PlaceOnTop, "PlaceOnTop"},
+ {PlaceOnBottom, "PlaceOnBottom"},
+ {-1, NULL}
+};
+
+static TkStateMap visNotify[] = {
+ {VisibilityUnobscured, "VisibilityUnobscured"},
+ {VisibilityPartiallyObscured, "VisibilityPartiallyObscured"},
+ {VisibilityFullyObscured, "VisibilityFullyObscured"},
+ {-1, NULL}
+};
+
+static TkStateMap configureRequestDetail[] = {
+ {None, "None"},
+ {Above, "Above"},
+ {Below, "Below"},
+ {BottomIf, "BottomIf"},
+ {TopIf, "TopIf"},
+ {Opposite, "Opposite"},
+ {-1, NULL}
+};
+
+static TkStateMap propNotify[] = {
+ {PropertyNewValue, "NewValue"},
+ {PropertyDelete, "Delete"},
+ {-1, NULL}
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static void ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp,
+ char *dispName, int screenIndex));
+static int CreateVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString,
+ char *eventString));
+static int DeleteVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString,
+ char *eventString));
+static void DeleteVirtualEventTable _ANSI_ARGS_((
+ VirtualEventTable *vetPtr));
+static void ExpandPercents _ANSI_ARGS_((TkWindow *winPtr,
+ CONST char *before, XEvent *eventPtr, KeySym keySym,
+ Tcl_DString *dsPtr));
+static void FreeTclBinding _ANSI_ARGS_((ClientData clientData));
+static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_HashTable *patternTablePtr, ClientData object,
+ CONST char *eventString, int create,
+ int allowVirtual, unsigned long *maskPtr));
+static void GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr));
+static char * GetField _ANSI_ARGS_((char *p, char *copy, int size));
+static void GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
+ Tcl_DString *dsPtr));
+static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString));
+static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
+ char *virtString));
+static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window main, int objc,
+ Tcl_Obj *CONST objv[]));
+static void InitVirtualEventTable _ANSI_ARGS_((
+ VirtualEventTable *vetPtr));
+static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
+ BindingTable *bindPtr, PatSeq *psPtr,
+ PatSeq *bestPtr, ClientData *objectPtr,
+ PatSeq **sourcePtrPtr));
+static int NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window main, Tcl_Obj *objPtr,
+ Tk_Window *tkwinPtr));
+static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char **eventStringPtr, Pattern *patPtr,
+ unsigned long *eventMaskPtr));
+static void DoWarp _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * The following define is used as a short circuit for the callback
+ * procedure to evaluate a TclBinding. The actual evaluation of the
+ * binding is handled inline, because special things have to be done
+ * with a Tcl binding before evaluation time.
+ */
+
+#define EvalTclBinding ((TkBindEvalProc *) 1)
+
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures used by bindings and virtual
+ * events. It must be called before any other functions in this
+ * file are called.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindInit(mainPtr)
+ TkMainInfo *mainPtr; /* The newly created application. */
+{
+ BindInfo *bindInfoPtr;
+
+ if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
+ panic("TkBindInit: virtual events can't be supported");
+ }
+
+ /*
+ * Initialize the static data structures used by the binding package.
+ * They are only initialized once, no matter how many interps are
+ * created.
+ */
+
+ if (!initialized) {
+ Tcl_MutexLock(&bindMutex);
+ if (!initialized) {
+ Tcl_HashEntry *hPtr;
+ ModInfo *modPtr;
+ EventInfo *eiPtr;
+ int dummy;
+
+#ifdef REDO_KEYSYM_LOOKUP
+ KeySymInfo *kPtr;
+
+ Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
+ for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
+ hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->value);
+ hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
+ &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->name);
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+
+ Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
+ for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
+ hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, modPtr);
+ }
+
+ 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;
+ }
+ Tcl_MutexUnlock(&bindMutex);
+ }
+
+ mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
+
+ bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
+ InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ bindInfoPtr->screenInfo.curDispPtr = NULL;
+ bindInfoPtr->screenInfo.curScreenIndex = -1;
+ bindInfoPtr->screenInfo.bindingDepth = 0;
+ bindInfoPtr->pendingList = NULL;
+ bindInfoPtr->deleted = 0;
+ mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
+
+ TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindFree --
+ *
+ * This procedure is called when an application is deleted. It
+ * deletes all the structures used by bindings and virtual events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindFree(mainPtr)
+ TkMainInfo *mainPtr; /* The newly created application. */
+{
+ BindInfo *bindInfoPtr;
+
+ Tk_DeleteBindingTable(mainPtr->bindingTable);
+ mainPtr->bindingTable = NULL;
+
+ bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
+ DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ bindInfoPtr->deleted = 1;
+ Tcl_EventuallyFree((ClientData) bindInfoPtr, TCL_DYNAMIC);
+ mainPtr->bindInfo = NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_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 Tk_CreateBinding.
+ *
+ * Side effects:
+ * Memory is allocated for the new table.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_BindingTable
+Tk_CreateBindingTable(interp)
+ Tcl_Interp *interp; /* Interpreter to associate with the binding
+ * table: commands are executed in this
+ * interpreter. */
+{
+ BindingTable *bindPtr;
+ int i;
+
+ /*
+ * 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 (Tk_BindingTable) bindPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_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
+Tk_DeleteBindingTable(bindingTable)
+ Tk_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;
+ psPtr->flags |= MARKED_DELETED;
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ 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);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBinding --
+ *
+ * Add a binding to a binding table, so that future calls to
+ * Tk_BindEvent may execute the command in the binding.
+ *
+ * Results:
+ * The return value is 0 if an error occurred while setting
+ * up the binding. In this case, an error message will be
+ * left in the interp's result. If all went well then the return
+ * value is a mask of the event types that must be made
+ * available to Tk_BindEvent in order to properly detect when
+ * this binding triggers. This value can be used to determine
+ * what events to select for in a window, for example.
+ *
+ * Side effects:
+ * An existing binding on the same event sequence may be
+ * replaced.
+ * The new binding may cause future calls to Tk_BindEvent to
+ * behave differently than they did previously.
+ *
+ *--------------------------------------------------------------
+ */
+
+unsigned long
+Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable;
+ /* Table in which to create binding. */
+ ClientData object; /* Token for object with which binding is
+ * associated. */
+ CONST char *eventString; /* String describing event sequence that
+ * triggers binding. */
+ CONST 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. If the existing binding is for a
+ * callback function and not a Tcl command
+ * string, the existing binding will always be
+ * replaced. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+ char *new, *old;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 1, 1, &eventMask);
+ if (psPtr == NULL) {
+ return 0;
+ }
+ if (psPtr->eventProc == NULL) {
+ int new;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * This pattern sequence was just created.
+ * Link the pattern into the list associated with the object, so
+ * that if the object goes away, these bindings will all
+ * automatically be deleted.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+ &new);
+ if (new) {
+ psPtr->nextObjPtr = NULL;
+ } else {
+ psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ Tcl_SetHashValue(hPtr, psPtr);
+ } else if (psPtr->eventProc != EvalTclBinding) {
+ /*
+ * Free existing procedural binding.
+ */
+
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ psPtr->clientData = NULL;
+ append = 0;
+ }
+
+ old = (char *) psPtr->clientData;
+ if ((append != 0) && (old != NULL)) {
+ int length;
+
+ length = strlen(old) + strlen(command) + 2;
+ new = (char *) ckalloc((unsigned) length);
+ sprintf(new, "%s\n%s", old, command);
+ } else {
+ new = (char *) ckalloc((unsigned) strlen(command) + 1);
+ strcpy(new, command);
+ }
+ if (old != NULL) {
+ ckfree(old);
+ }
+ psPtr->eventProc = EvalTclBinding;
+ psPtr->freeProc = FreeTclBinding;
+ psPtr->clientData = (ClientData) new;
+ return eventMask;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkCreateBindingProcedure --
+ *
+ * Add a C binding to a binding table, so that future calls to
+ * Tk_BindEvent may callback the procedure in the binding.
+ *
+ * Results:
+ * The return value is 0 if an error occurred while setting
+ * up the binding. In this case, an error message will be
+ * left in the interp's result. If all went well then the return
+ * value is a mask of the event types that must be made
+ * available to Tk_BindEvent in order to properly detect when
+ * this binding triggers. This value can be used to determine
+ * what events to select for in a window, for example.
+ *
+ * Side effects:
+ * Any existing binding on the same event sequence will be
+ * replaced.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+unsigned long
+TkCreateBindingProcedure(interp, bindingTable, object, eventString,
+ eventProc, freeProc, clientData)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable;
+ /* Table in which to create binding. */
+ ClientData object; /* Token for object with which binding is
+ * associated. */
+ CONST char *eventString; /* String describing event sequence that
+ * triggers binding. */
+ TkBindEvalProc *eventProc; /* Procedure to invoke when binding
+ * triggers. Must not be NULL. */
+ TkBindFreeProc *freeProc; /* Procedure to invoke when binding is
+ * freed. May be NULL for no procedure. */
+ ClientData clientData; /* Arbitrary ClientData to pass to eventProc
+ * and freeProc. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 1, 1, &eventMask);
+ if (psPtr == NULL) {
+ return 0;
+ }
+ if (psPtr->eventProc == NULL) {
+ int new;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * This pattern sequence was just created.
+ * Link the pattern into the list associated with the object, so
+ * that if the object goes away, these bindings will all
+ * automatically be deleted.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+ &new);
+ if (new) {
+ psPtr->nextObjPtr = NULL;
+ } else {
+ psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ Tcl_SetHashValue(hPtr, psPtr);
+ } else {
+
+ /*
+ * Free existing callback.
+ */
+
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ }
+
+ psPtr->eventProc = eventProc;
+ psPtr->freeProc = freeProc;
+ psPtr->clientData = clientData;
+ return eventMask;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteBinding --
+ *
+ * Remove an event binding from a binding table.
+ *
+ * Results:
+ * The result is a standard Tcl return value. If an error
+ * occurs then the interp's result will contain an error message.
+ *
+ * Side effects:
+ * The binding given by object and eventString is removed
+ * from bindingTable.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_DeleteBinding(interp, bindingTable, object, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable; /* Table in which to delete binding. */
+ ClientData object; /* Token for object with which binding
+ * is associated. */
+ CONST char *eventString; /* String describing event sequence
+ * that triggers binding. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr, *prevPtr;
+ unsigned long eventMask;
+ Tcl_HashEntry *hPtr;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 0, 1, &eventMask);
+ 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("Tk_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("Tk_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;
+ }
+ }
+ }
+
+ psPtr->flags |= MARKED_DELETED;
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_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
+ * the interp's result. The return value is semi-static: it
+ * will persist until the binding is changed or deleted.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_GetBinding(interp, bindingTable, object, eventString)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * binding. */
+ ClientData object; /* Token for object with which binding
+ * is associated. */
+ CONST char *eventString; /* String describing event sequence
+ * that triggers binding. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 0, 1, &eventMask);
+ if (psPtr == NULL) {
+ return NULL;
+ }
+ if (psPtr->eventProc == EvalTclBinding) {
+ return (CONST char *) psPtr->clientData;
+ }
+ return "";
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAllBindings --
+ *
+ * Return a list of event strings for all the bindings
+ * associated with a given object.
+ *
+ * Results:
+ * There is no return value. The interp's 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
+Tk_GetAllBindings(interp, bindingTable, object)
+ Tcl_Interp *interp; /* Interpreter returning result or
+ * error. */
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * bindings. */
+ ClientData object; /* Token for object. */
+
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString ds;
+
+ 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) {
+ /*
+ * For each binding, output information about each of the
+ * patterns in its sequence.
+ */
+
+ Tcl_DStringSetLength(&ds, 0);
+ GetPatternString(psPtr, &ds);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+ Tcl_DStringFree(&ds);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_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
+Tk_DeleteAllBindings(bindingTable, object)
+ Tk_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("Tk_DeleteAllBindings couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+ psPtr->flags |= MARKED_DELETED;
+
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ }
+ Tcl_DeleteHashEntry(hPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_BindEvent --
+ *
+ * This procedure is invoked to process an X 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, the most specific binding is invoked for
+ * each object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command associated with the matching binding.
+ *
+ * All Tcl bindings scripts for each object are accumulated before
+ * the first binding is evaluated. If the action of a Tcl binding
+ * is to change or delete a binding, or delete the window associated
+ * with the binding, all the original Tcl binding scripts will still
+ * fire. Contrast this with C binding procedures. If a pending C
+ * binding (one that hasn't fired yet, but is queued to be fired for
+ * this window) is deleted, it will not be called, and if it is
+ * changed, then the new binding procedure will be called. If the
+ * window itself is deleted, no further C binding procedures will be
+ * called for this window. When both Tcl binding scripts and C binding
+ * procedures are interleaved, the above rules still apply.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * bindings. */
+ XEvent *eventPtr; /* What actually happened. */
+ Tk_Window tkwin; /* Window on display where event
+ * occurred (needed in order to
+ * locate display information). */
+ int numObjects; /* Number of objects at *objectPtr. */
+ ClientData *objectPtr; /* Array of one or more objects
+ * to check for a matching binding. */
+{
+ BindingTable *bindPtr;
+ TkDisplay *dispPtr;
+ ScreenInfo *screenPtr;
+ BindInfo *bindInfoPtr;
+ TkDisplay *oldDispPtr;
+ XEvent *ringPtr;
+ PatSeq *vMatchDetailList, *vMatchNoDetailList;
+ int flags, oldScreen, i, deferModal;
+ unsigned int matchCount, matchSpace;
+ Tcl_Interp *interp;
+ Tcl_DString scripts, savedResult;
+ Detail detail;
+ char *p, *end;
+ PendingBinding *pendingPtr;
+ PendingBinding staticPending;
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ PatternTableKey key;
+ Tk_ClassModalProc *modalProc;
+ /*
+ * Ignore events on windows that don't have names: these are windows
+ * like wrapper windows that shouldn't be visible to the
+ * application.
+ */
+
+ if (winPtr->pathName == NULL) {
+ return;
+ }
+
+ /*
+ * Ignore the event completely if it is an Enter, Leave, FocusIn,
+ * or FocusOut event with detail NotifyInferior. The reason for
+ * ignoring these events is that we don't want transitions between
+ * a window and its children to visible to bindings on the parent:
+ * this would cause problems for mega-widgets, since the internal
+ * structure of a mega-widget isn't supposed to be visible to
+ * people watching the parent.
+ */
+
+ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
+ if (eventPtr->xcrossing.detail == NotifyInferior) {
+ return;
+ }
+ }
+ if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
+ if (eventPtr->xfocus.detail == NotifyInferior) {
+ return;
+ }
+ }
+
+ bindPtr = (BindingTable *) bindingTable;
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+
+ /*
+ * Add the new event to the ring of saved events for the
+ * binding table. Two tricky points:
+ *
+ * 1. Combine consecutive MotionNotify events. Do this by putting
+ * the new event *on top* of the previous event.
+ * 2. If a modifier key is held down, it auto-repeats to generate
+ * continuous KeyPress and KeyRelease events. These can flush
+ * the event ring so that valuable information is lost (such
+ * as repeated button clicks). To handle this, check for the
+ * special case of a modifier KeyPress arriving when the previous
+ * two events are a KeyRelease and KeyPress of the same key.
+ * If this happens, mark the most recent event (the KeyRelease)
+ * invalid and put the new event on top of the event before that
+ * (the KeyPress).
+ */
+
+ if ((eventPtr->type == MotionNotify)
+ && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
+ /*
+ * Don't advance the ring pointer.
+ */
+ } else if (eventPtr->type == KeyPress) {
+ int i;
+ for (i = 0; ; i++) {
+ if (i >= dispPtr->numModKeyCodes) {
+ goto advanceRingPointer;
+ }
+ if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+ break;
+ }
+ }
+ ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ if ((ringPtr->type != KeyRelease)
+ || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+ goto advanceRingPointer;
+ }
+ if (bindPtr->curEvent <= 0) {
+ i = EVENT_BUFFER_SIZE - 1;
+ } else {
+ i = bindPtr->curEvent - 1;
+ }
+ ringPtr = &bindPtr->eventRing[i];
+ if ((ringPtr->type != KeyPress)
+ || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+ goto advanceRingPointer;
+ }
+ bindPtr->eventRing[bindPtr->curEvent].type = -1;
+ bindPtr->curEvent = i;
+ } else {
+ advanceRingPointer:
+ bindPtr->curEvent++;
+ if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
+ bindPtr->curEvent = 0;
+ }
+ }
+ ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent));
+ detail.clientData = 0;
+ flags = flagArray[ringPtr->type];
+ if (flags & KEY) {
+ detail.keySym = TkpGetKeySym(dispPtr, ringPtr);
+ if (detail.keySym == NoSymbol) {
+ detail.keySym = 0;
+ }
+ } else if (flags & BUTTON) {
+ detail.button = ringPtr->xbutton.button;
+ } else if (flags & VIRTUAL) {
+ detail.name = ((XVirtualEvent *) ringPtr)->name;
+ }
+ bindPtr->detailRing[bindPtr->curEvent] = detail;
+
+ /*
+ * Find out if there are any virtual events that correspond to this
+ * physical event (or sequence of physical events).
+ */
+
+ vMatchDetailList = NULL;
+ vMatchNoDetailList = NULL;
+ memset(&key, 0, sizeof(key));
+
+ if (ringPtr->type != VirtualEvent) {
+ Tcl_HashTable *veptPtr;
+ Tcl_HashEntry *hPtr;
+
+ veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
+
+ key.object = NULL;
+ key.type = ringPtr->type;
+ key.detail = detail;
+
+ hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+ if (hPtr != NULL) {
+ vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+
+ if (key.detail.clientData != 0) {
+ key.detail.clientData = 0;
+ hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+ if (hPtr != NULL) {
+ vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ }
+ }
+
+ /*
+ * Loop over all the binding tags, finding the binding script or
+ * callback for each one. Append all of the binding scripts, with
+ * %-sequences expanded, to "scripts", with null characters separating
+ * the scripts for each object. Append all the callbacks to the array
+ * of pending callbacks.
+ */
+
+ pendingPtr = &staticPending;
+ matchCount = 0;
+ matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
+ Tcl_DStringInit(&scripts);
+
+ for ( ; numObjects > 0; numObjects--, objectPtr++) {
+ PatSeq *matchPtr, *sourcePtr;
+ Tcl_HashEntry *hPtr;
+
+ matchPtr = NULL;
+ sourcePtr = NULL;
+
+ /*
+ * Match the new event against those recorded in the pattern table,
+ * saving the longest matching pattern. For events with details
+ * (button and key events), look for a binding for the specific
+ * key or button. First see if the event matches a physical event
+ * that the object is interested in, then look for a virtual event.
+ */
+
+ key.object = *objectPtr;
+ key.type = ringPtr->type;
+ key.detail = detail;
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+ if (hPtr != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr,
+ (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
+ &sourcePtr);
+ }
+
+ if (vMatchDetailList != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
+ matchPtr, objectPtr, &sourcePtr);
+ }
+
+ /*
+ * If no match was found, look for a binding for all keys or buttons
+ * (detail of 0). Again, first match on a virtual event.
+ */
+
+ if ((detail.clientData != 0) && (matchPtr == NULL)) {
+ key.detail.clientData = 0;
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+ if (hPtr != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr,
+ (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
+ &sourcePtr);
+ }
+
+ if (vMatchNoDetailList != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
+ matchPtr, objectPtr, &sourcePtr);
+ }
+
+ }
+
+ if (matchPtr != NULL) {
+ if (sourcePtr->eventProc == NULL) {
+ panic("Tk_BindEvent: missing command");
+ }
+ if (sourcePtr->eventProc == EvalTclBinding) {
+ ExpandPercents(winPtr, (char *) sourcePtr->clientData,
+ eventPtr, detail.keySym, &scripts);
+ } else {
+ if (matchCount >= matchSpace) {
+ PendingBinding *new;
+ unsigned int oldSize, newSize;
+
+ oldSize = sizeof(staticPending)
+ - sizeof(staticPending.matchArray)
+ + matchSpace * sizeof(PatSeq*);
+ matchSpace *= 2;
+ newSize = sizeof(staticPending)
+ - sizeof(staticPending.matchArray)
+ + matchSpace * sizeof(PatSeq*);
+ new = (PendingBinding *) ckalloc(newSize);
+ memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
+ if (pendingPtr != &staticPending) {
+ ckfree((char *) pendingPtr);
+ }
+ pendingPtr = new;
+ }
+ sourcePtr->refCount++;
+ pendingPtr->matchArray[matchCount] = sourcePtr;
+ matchCount++;
+ }
+ /*
+ * A "" is added to the scripts string to separate the
+ * various scripts that should be invoked.
+ */
+
+ Tcl_DStringAppend(&scripts, "", 1);
+ }
+ }
+ if (Tcl_DStringLength(&scripts) == 0) {
+ return;
+ }
+
+ /*
+ * Now go back through and evaluate the binding 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 the interp's 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.
+ */
+
+ interp = bindPtr->interp;
+ Tcl_DStringInit(&savedResult);
+
+ /*
+ * Save information about the current screen, then invoke a script
+ * if the screen has changed.
+ */
+
+ Tcl_DStringGetResult(interp, &savedResult);
+ screenPtr = &bindInfoPtr->screenInfo;
+ oldDispPtr = screenPtr->curDispPtr;
+ oldScreen = screenPtr->curScreenIndex;
+ if ((dispPtr != screenPtr->curDispPtr)
+ || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
+ screenPtr->curDispPtr = dispPtr;
+ screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
+ ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
+ }
+
+ if (matchCount > 0) {
+ /*
+ * Remember the list of pending C binding callbacks, so we can mark
+ * them as deleted and not call them if the act of evaluating a C
+ * or Tcl binding deletes a C binding callback or even the whole
+ * window.
+ */
+
+ pendingPtr->nextPtr = bindInfoPtr->pendingList;
+ pendingPtr->tkwin = tkwin;
+ pendingPtr->deleted = 0;
+ bindInfoPtr->pendingList = pendingPtr;
+ }
+
+ /*
+ * Save the current value of the TK_DEFER_MODAL flag so we can
+ * restore it at the end of the loop. Clear the flag so we can
+ * detect any recursive requests for a modal loop.
+ */
+
+ flags = winPtr->flags;
+ winPtr->flags &= ~TK_DEFER_MODAL;
+
+ p = Tcl_DStringValue(&scripts);
+ end = p + Tcl_DStringLength(&scripts);
+ i = 0;
+
+ /*
+ * Be carefule when dereferencing screenPtr or bindInfoPtr. If we
+ * evaluate something that destroys ".", bindInfoPtr would have been
+ * freed, but we can tell that by first checking to see if
+ * winPtr->mainPtr == NULL.
+ */
+
+ Tcl_Preserve((ClientData) bindInfoPtr);
+ while (p < end) {
+ int code;
+
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth++;
+ }
+ Tcl_AllowExceptions(interp);
+
+ if (*p == '\0') {
+ PatSeq *psPtr;
+
+ psPtr = pendingPtr->matchArray[i];
+ i++;
+ code = TCL_OK;
+ if ((pendingPtr->deleted == 0)
+ && ((psPtr->flags & MARKED_DELETED) == 0)) {
+ code = (*psPtr->eventProc)(psPtr->clientData, interp, eventPtr,
+ tkwin, detail.keySym);
+ }
+ psPtr->refCount--;
+ if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ } else {
+ code = Tcl_GlobalEval(interp, p);
+ p += strlen(p);
+ }
+ p++;
+
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth--;
+ }
+ if (code != TCL_OK) {
+ if (code == TCL_CONTINUE) {
+ /*
+ * Do nothing: just go on to the next command.
+ */
+ } else if (code == TCL_BREAK) {
+ break;
+ } else {
+ Tcl_AddErrorInfo(interp, "\n (command bound to event)");
+ Tcl_BackgroundError(interp);
+ break;
+ }
+ }
+ }
+
+ if (matchCount > 0 && !pendingPtr->deleted) {
+ /*
+ * Restore the original modal flag value and invoke the modal loop
+ * if needed.
+ */
+
+ deferModal = winPtr->flags & TK_DEFER_MODAL;
+ winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL)
+ | (flags & TK_DEFER_MODAL);
+ if (deferModal) {
+ modalProc = Tk_GetClassProc(winPtr->classProcsPtr, modalProc);
+ if (modalProc != NULL) {
+ (*modalProc)(tkwin, eventPtr);
+ }
+ }
+ }
+
+ if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
+ && ((oldDispPtr != screenPtr->curDispPtr)
+ || (oldScreen != screenPtr->curScreenIndex))) {
+
+ /*
+ * Some other binding script is currently executing, but its
+ * screen is no longer current. Change the current display
+ * back again.
+ */
+
+ screenPtr->curDispPtr = oldDispPtr;
+ screenPtr->curScreenIndex = oldScreen;
+ ChangeScreen(interp, oldDispPtr->name, oldScreen);
+ }
+ Tcl_DStringResult(interp, &savedResult);
+ Tcl_DStringFree(&scripts);
+
+ if (matchCount > 0) {
+ if (!bindInfoPtr->deleted) {
+ /*
+ * Delete the pending list from the list of pending scripts
+ * for this window.
+ */
+
+ PendingBinding **curPtrPtr;
+
+ for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
+ if (*curPtrPtr == pendingPtr) {
+ *curPtrPtr = pendingPtr->nextPtr;
+ break;
+ }
+ curPtrPtr = &(*curPtrPtr)->nextPtr;
+ }
+ }
+ if (pendingPtr != &staticPending) {
+ ckfree((char *) pendingPtr);
+ }
+ }
+ Tcl_Release((ClientData) bindInfoPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindDeadWindow --
+ *
+ * This procedure is invoked when it is determined that a window is
+ * dead. It cleans up bind-related information about the window
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any pending C bindings for this window are cancelled.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindDeadWindow(winPtr)
+ TkWindow *winPtr; /* The window that is being deleted. */
+{
+ BindInfo *bindInfoPtr;
+ PendingBinding *curPtr;
+
+ /*
+ * Certain special windows like those used for send and clipboard
+ * have no mainPtr.
+ */
+ if (winPtr->mainPtr == NULL)
+ return;
+
+ bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+ curPtr = bindInfoPtr->pendingList;
+ while (curPtr != NULL) {
+ if (curPtr->tkwin == (Tk_Window) winPtr) {
+ curPtr->deleted = 1;
+ }
+ curPtr = curPtr->nextPtr;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchPatterns --
+ *
+ * Given a list of pattern sequences and a list of recent events,
+ * return the pattern sequence that best matches the event list,
+ * if there is one.
+ *
+ * This procedure is used in two different ways. In the simplest
+ * use, "object" is NULL and psPtr is a list of pattern sequences,
+ * each of which corresponds to a binding. In this case, the
+ * procedure finds the pattern sequences that match the event list
+ * and returns the most specific of those, if there is more than one.
+ *
+ * In the second case, psPtr is a list of pattern sequences, each
+ * of which corresponds to a definition for a virtual binding.
+ * In order for one of these sequences to "match", it must match
+ * the events (as above) but in addition there must be a binding
+ * for its associated virtual event on the current object. The
+ * "object" argument indicates which object the binding must be for.
+ *
+ * Results:
+ * The return value is NULL if bestPtr is NULL and no pattern matches
+ * the recent events from bindPtr. Otherwise the return value is
+ * the most specific pattern sequence among bestPtr and all those
+ * at psPtr that match the event list and object. If a pattern
+ * sequence other than bestPtr is returned, then *bestCommandPtr
+ * is filled in with a pointer to the command from the best sequence.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static PatSeq *
+MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
+ TkDisplay *dispPtr; /* Display from which the event came. */
+ BindingTable *bindPtr; /* Information about binding table, such as
+ * ring of recent events. */
+ PatSeq *psPtr; /* List of pattern sequences. */
+ PatSeq *bestPtr; /* The best match seen so far, from a
+ * previous call to this procedure. NULL
+ * means no prior best match. */
+ ClientData *objectPtr; /* If NULL, the sequences at psPtr
+ * correspond to "normal" bindings. If
+ * non-NULL, the sequences at psPtr correspond
+ * to virtual bindings; in order to match each
+ * sequence must correspond to a virtual
+ * binding for which a binding exists for
+ * object in bindPtr. */
+ PatSeq **sourcePtrPtr; /* Filled with the pattern sequence that
+ * contains the eventProc and clientData
+ * associated with the best match. If this
+ * differs from the return value, it is the
+ * virtual event that most closely matched the
+ * return value (a physical event). Not
+ * modified unless a result other than bestPtr
+ * is returned. */
+{
+ PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
+
+ bestSourcePtr = *sourcePtrPtr;
+
+ /*
+ * Iterate over all the pattern sequences.
+ */
+
+ for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
+ XEvent *eventPtr;
+ Pattern *patPtr;
+ Window window;
+ Detail *detailPtr;
+ int patCount, ringCount, flags, state;
+ int modMask;
+
+ /*
+ * 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];
+ window = eventPtr->xany.window;
+ patPtr = psPtr->pats;
+ patCount = psPtr->numPats;
+ ringCount = EVENT_BUFFER_SIZE;
+ while (patCount > 0) {
+ if (ringCount <= 0) {
+ goto nextSequence;
+ }
+ if (eventPtr->xany.type != patPtr->eventType) {
+ /*
+ * Most of the event types are considered superfluous
+ * in that they are ignored if they occur in the middle
+ * of a pattern sequence and have mismatching types. The
+ * only ones that cannot be ignored are ButtonPress and
+ * ButtonRelease events (if the next event in the pattern
+ * is a KeyPress or KeyRelease) and KeyPress and KeyRelease
+ * events (if the next pattern event is a ButtonPress or
+ * ButtonRelease). Here are some tricky cases to consider:
+ * 1. Double-Button or Double-Key events.
+ * 2. Double-ButtonRelease or Double-KeyRelease events.
+ * 3. The arrival of various events like Enter and Leave
+ * and FocusIn and GraphicsExpose between two button
+ * presses or key presses.
+ * 4. Modifier keys like Shift and Control shouldn't
+ * generate conflicts with button events.
+ */
+
+ if ((patPtr->eventType == KeyPress)
+ || (patPtr->eventType == KeyRelease)) {
+ if ((eventPtr->xany.type == ButtonPress)
+ || (eventPtr->xany.type == ButtonRelease)) {
+ goto nextSequence;
+ }
+ } else if ((patPtr->eventType == ButtonPress)
+ || (patPtr->eventType == ButtonRelease)) {
+ if ((eventPtr->xany.type == KeyPress)
+ || (eventPtr->xany.type == KeyRelease)) {
+ int i;
+
+ /*
+ * Ignore key events if they are modifier keys.
+ */
+
+ for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+ if (dispPtr->modKeyCodes[i]
+ == eventPtr->xkey.keycode) {
+ /*
+ * This key is a modifier key, so ignore it.
+ */
+ goto nextEvent;
+ }
+ }
+ goto nextSequence;
+ }
+ }
+ goto nextEvent;
+ }
+ if (eventPtr->xany.type == CreateNotify
+ && eventPtr->xcreatewindow.parent != window) {
+ goto nextSequence;
+ } else
+ if (eventPtr->xany.window != window) {
+ 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.clientData != 0)
+ && (patPtr->detail.clientData != detailPtr->clientData)) {
+ /*
+ * The detail appears not to match. However, if the event
+ * is a KeyPress for a modifier key then just ignore the
+ * event. Otherwise event sequences like "aD" never match
+ * because the shift key goes down between the "a" and the
+ * "D".
+ */
+
+ if (eventPtr->xany.type == KeyPress) {
+ int i;
+
+ for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+ if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+ goto nextEvent;
+ }
+ }
+ }
+ goto nextSequence;
+ }
+ flags = flagArray[eventPtr->type];
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ state = eventPtr->xkey.state;
+ } else if (flags & CROSSING) {
+ state = eventPtr->xcrossing.state;
+ } else {
+ state = 0;
+ }
+ if (patPtr->needMods != 0) {
+ modMask = patPtr->needMods;
+ if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
+ modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
+ }
+ if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
+ modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
+ }
+
+ if ((state & META_MASK) && (dispPtr->metaModMask != 0)) {
+ state = (state & ~META_MASK) | dispPtr->metaModMask;
+ }
+ if ((state & ALT_MASK) && (dispPtr->altModMask != 0)) {
+ state = (state & ~ALT_MASK) | dispPtr->altModMask;
+ }
+
+ if ((state & modMask) != modMask) {
+ goto nextSequence;
+ }
+ }
+ if (psPtr->flags & PAT_NEARBY) {
+ XEvent *firstPtr;
+ int timeDiff;
+
+ firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
+ if ((firstPtr->xkey.x_root
+ < (eventPtr->xkey.x_root - NEARBY_PIXELS))
+ || (firstPtr->xkey.x_root
+ > (eventPtr->xkey.x_root + NEARBY_PIXELS))
+ || (firstPtr->xkey.y_root
+ < (eventPtr->xkey.y_root - NEARBY_PIXELS))
+ || (firstPtr->xkey.y_root
+ > (eventPtr->xkey.y_root + NEARBY_PIXELS))
+ || (timeDiff > NEARBY_MS)) {
+ 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--;
+ }
+
+ matchPtr = psPtr;
+ sourcePtr = psPtr;
+
+ if (objectPtr != NULL) {
+ int iVirt;
+ VirtualOwners *voPtr;
+ PatternTableKey key;
+
+ /*
+ * The sequence matches the physical constraints.
+ * Is this object interested in any of the virtual events
+ * that correspond to this sequence?
+ */
+
+ voPtr = psPtr->voPtr;
+
+ memset(&key, 0, sizeof(key));
+ key.object = *objectPtr;
+ key.type = VirtualEvent;
+ key.detail.clientData = 0;
+
+ for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+ Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
+
+ key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
+ hPtr);
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
+ (char *) &key);
+ if (hPtr != NULL) {
+
+ /*
+ * This tag is interested in this virtual event and its
+ * corresponding physical event is a good match with the
+ * virtual event's definition.
+ */
+
+ PatSeq *virtMatchPtr;
+
+ virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ if ((virtMatchPtr->numPats != 1)
+ || (virtMatchPtr->nextSeqPtr != NULL)) {
+ panic("MatchPattern: badly constructed virtual event");
+ }
+ sourcePtr = virtMatchPtr;
+ goto match;
+ }
+ }
+
+ /*
+ * The physical event matches a virtual event's definition, but
+ * the tag isn't interested in it.
+ */
+ goto nextSequence;
+ }
+ match:
+
+ /*
+ * This sequence matches. If we've already got another match,
+ * pick whichever is most specific. Detail is most important,
+ * then needMods.
+ */
+
+ if (bestPtr != NULL) {
+ Pattern *patPtr2;
+ int i;
+
+ if (matchPtr->numPats != bestPtr->numPats) {
+ if (bestPtr->numPats > matchPtr->numPats) {
+ goto nextSequence;
+ } else {
+ goto newBest;
+ }
+ }
+ for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
+ i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
+ if (patPtr->detail.clientData != patPtr2->detail.clientData) {
+ if (patPtr->detail.clientData == 0) {
+ goto nextSequence;
+ } else {
+ goto newBest;
+ }
+ }
+ if (patPtr->needMods != patPtr2->needMods) {
+ if ((patPtr->needMods & patPtr2->needMods)
+ == patPtr->needMods) {
+ goto nextSequence;
+ } else if ((patPtr->needMods & patPtr2->needMods)
+ == patPtr2->needMods) {
+ goto newBest;
+ }
+ }
+ }
+ /*
+ * Tie goes to current best pattern.
+ *
+ * (1) For virtual vs. virtual, the least recently defined
+ * virtual wins, because virtuals are examined in order of
+ * definition. This order is _not_ guaranteed in the
+ * documentation.
+ *
+ * (2) For virtual vs. physical, the physical wins because all
+ * the physicals are examined before the virtuals. This order
+ * is guaranteed in the documentation.
+ *
+ * (3) For physical vs. physical pattern, the most recently
+ * defined physical wins, because physicals are examined in
+ * reverse order of definition. This order is guaranteed in
+ * the documentation.
+ */
+
+ goto nextSequence;
+ }
+ newBest:
+ bestPtr = matchPtr;
+ bestSourcePtr = sourcePtr;
+
+ nextSequence:
+ continue;
+ }
+
+ *sourcePtrPtr = bestSourcePtr;
+ return bestPtr;
+}
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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)
+ TkWindow *winPtr; /* Window where event occurred: needed to
+ * get input context. */
+ CONST char *before; /* Command containing percent expressions
+ * to be replaced. */
+ XEvent *eventPtr; /* X event containing information to be
+ * used in % replacements. */
+ KeySym keySym; /* KeySym: only relevant for KeyPress and
+ * KeyRelease 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, flags, length;
+#define NUM_SIZE 40
+ CONST char *string;
+ Tcl_DString buf;
+ char numStorage[NUM_SIZE+1];
+
+ Tcl_DStringInit(&buf);
+
+ if (eventPtr->type < TK_LASTEVENT) {
+ flags = flagArray[eventPtr->type];
+ } else {
+ flags = 0;
+ }
+ 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, (int) (string-before));
+ before = string;
+ }
+ if (*before == 0) {
+ break;
+ }
+
+ /*
+ * There's a percent sequence here. Process it.
+ */
+
+ number = 0;
+ string = "??";
+ switch (before[1]) {
+ case '#':
+ number = eventPtr->xany.serial;
+ goto doNumber;
+ case 'a':
+ if (flags & CONFIG) {
+ TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
+ string = numStorage;
+ }
+ goto doString;
+ case 'b':
+ number = eventPtr->xbutton.button;
+ goto doNumber;
+ case 'c':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.count;
+ }
+ goto doNumber;
+ case 'd':
+ if (flags & (CROSSING|FOCUS)) {
+ if (flags & FOCUS) {
+ number = eventPtr->xfocus.detail;
+ } else {
+ number = eventPtr->xcrossing.detail;
+ }
+ string = TkFindStateString(notifyDetail, number);
+ }
+ else if (flags & CONFIGREQ) {
+ if (eventPtr->xconfigurerequest.value_mask & CWStackMode) {
+ string = TkFindStateString(configureRequestDetail,
+ eventPtr->xconfigurerequest.detail);
+ } else {
+ string = "";
+ }
+ }
+ goto doString;
+ case 'f':
+ number = eventPtr->xcrossing.focus;
+ goto doNumber;
+ case 'h':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.height;
+ } else if (flags & (CONFIG)) {
+ number = eventPtr->xconfigure.height;
+ }
+ else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.height;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.height;
+ } else if (flags & RESIZEREQ) {
+ number = eventPtr->xresizerequest.height;
+ }
+ goto doNumber;
+ case 'i':
+ if (flags & CREATE) {
+ TkpPrintWindowId(numStorage, eventPtr->xcreatewindow.window);
+ } else if (flags & CONFIGREQ) {
+ TkpPrintWindowId(numStorage, eventPtr->xconfigurerequest.window);
+ } else if (flags & MAPREQ) {
+ TkpPrintWindowId(numStorage, eventPtr->xmaprequest.window);
+ } else {
+ TkpPrintWindowId(numStorage, eventPtr->xany.window);
+ }
+ string = numStorage;
+ goto doString;
+ case 'k':
+ number = eventPtr->xkey.keycode;
+ goto doNumber;
+ case 'm':
+ if (flags & CROSSING) {
+ number = eventPtr->xcrossing.mode;
+ } else if (flags & FOCUS) {
+ number = eventPtr->xfocus.mode;
+ }
+ string = TkFindStateString(notifyMode, number);
+ goto doString;
+ case 'o':
+ if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.override_redirect;
+ } else if (flags & MAP) {
+ number = eventPtr->xmap.override_redirect;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.override_redirect;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.override_redirect;
+ }
+ goto doNumber;
+ case 'p':
+ if (flags & CIRC) {
+ string = TkFindStateString(circPlace, eventPtr->xcirculate.place);
+ } else if (flags & CIRCREQ) {
+ string = TkFindStateString(circPlace, eventPtr->xcirculaterequest.place);
+ }
+ goto doString;
+ case 's':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.state;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.state;
+ } else if (flags & PROP) {
+ string = TkFindStateString(propNotify,
+ eventPtr->xproperty.state);
+ goto doString;
+ } else if (flags & VISIBILITY) {
+ string = TkFindStateString(visNotify,
+ eventPtr->xvisibility.state);
+ goto doString;
+ }
+ goto doNumber;
+ case 't':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = (int) eventPtr->xkey.time;
+ } else if (flags & CROSSING) {
+ number = (int) eventPtr->xcrossing.time;
+ } else if (flags & PROP) {
+ number = (int) eventPtr->xproperty.time;
+ }
+ goto doNumber;
+ case 'v':
+ number = eventPtr->xconfigurerequest.value_mask;
+ goto doNumber;
+ case 'w':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.width;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.width;
+ }
+ else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.width;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.width;
+ } else if (flags & RESIZEREQ) {
+ number = eventPtr->xresizerequest.width;
+ }
+ goto doNumber;
+ case 'x':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.x;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.x;
+ } else if (flags & EXPOSE) {
+ number = eventPtr->xexpose.x;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ number = eventPtr->xcreatewindow.x;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.x;
+ }
+ else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.x;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.x;
+ }
+ goto doNumber;
+ case 'y':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.y;
+ } else if (flags & EXPOSE) {
+ number = eventPtr->xexpose.y;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ number = eventPtr->xcreatewindow.y;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.y;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.y;
+
+ }
+ else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.y;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.y;
+ }
+ goto doNumber;
+ case 'A':
+ if (flags & KEY) {
+ Tcl_DStringFree(&buf);
+ string = TkpGetString(winPtr, eventPtr, &buf);
+ }
+ goto doString;
+ case 'B':
+ if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.border_width;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.border_width;
+ } else {
+ number = eventPtr->xconfigure.border_width;
+ }
+ goto doNumber;
+ case 'D':
+ /*
+ * This is used only by the MouseWheel event.
+ */
+
+ number = eventPtr->xkey.keycode;
+ goto doNumber;
+ case 'E':
+ number = (int) eventPtr->xany.send_event;
+ goto doNumber;
+ case 'K':
+ if (flags & KEY) {
+ char *name;
+
+ name = TkKeysymToString(keySym);
+ if (name != NULL) {
+ string = name;
+ }
+ }
+ goto doString;
+ case 'N':
+ number = (int) keySym;
+ goto doNumber;
+ case 'P':
+ if (flags & PROP) {
+ string = Tk_GetAtomName((Tk_Window) winPtr, eventPtr->xproperty.atom);
+ }
+ goto doString;
+ case 'R':
+ TkpPrintWindowId(numStorage, eventPtr->xkey.root);
+ string = numStorage;
+ goto doString;
+ case 'S':
+ TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
+ string = numStorage;
+ goto doString;
+ case 'T':
+ number = eventPtr->type;
+ goto doNumber;
+ case 'W': {
+ Tk_Window tkwin;
+
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ string = Tk_PathName(tkwin);
+ } else {
+ string = "??";
+ }
+ goto doString;
+ }
+ case 'X': {
+ Tk_Window tkwin;
+ int x, y;
+ int width, height;
+
+ number = eventPtr->xkey.x_root;
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ number -= x;
+ }
+ goto doNumber;
+ }
+ case 'Y': {
+ Tk_Window tkwin;
+ int x, y;
+ int width, height;
+
+ number = eventPtr->xkey.y_root;
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ number -= y;
+ }
+ 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);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertElement(string,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ before += 2;
+ }
+ Tcl_DStringFree(&buf);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeScreen --
+ *
+ * This procedure is invoked whenever the current screen changes
+ * in an application. It invokes a Tcl procedure named
+ * "tk::ScreenChanged", passing it the screen name as argument.
+ * tk::ScreenChanged does things like making the tk::Priv variable
+ * point to an array for the current display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what tk::ScreenChanged does. If an error occurs
+ * them bgerror will be invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeScreen(interp, dispName, screenIndex)
+ Tcl_Interp *interp; /* Interpreter in which to invoke
+ * command. */
+ char *dispName; /* Name of new display. */
+ int screenIndex; /* Index of new screen. */
+{
+ Tcl_DString cmd;
+ int code;
+ char screen[TCL_INTEGER_SPACE];
+
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, "tk::ScreenChanged ", 18);
+ Tcl_DStringAppend(&cmd, dispName, -1);
+ sprintf(screen, ".%d", screenIndex);
+ Tcl_DStringAppend(&cmd, screen, -1);
+ code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd));
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (changing screen in event binding)");
+ Tcl_BackgroundError(interp);
+ }
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_EventCmd --
+ *
+ * This procedure is invoked to process the "event" Tcl command.
+ * It is used to define and generate events.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_EventObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index;
+ Tk_Window tkwin;
+ VirtualEventTable *vetPtr;
+ TkBindInfo bindInfo;
+ static CONST char *optionStrings[] = {
+ "add", "delete", "generate", "info",
+ NULL
+ };
+ enum options {
+ EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO
+ };
+
+ tkwin = (Tk_Window) clientData;
+ bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
+ vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case EVENT_ADD: {
+ int i;
+ char *name, *event;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "virtual sequence ?sequence ...?");
+ return TCL_ERROR;
+ }
+ name = Tcl_GetStringFromObj(objv[2], NULL);
+ for (i = 3; i < objc; i++) {
+ event = Tcl_GetStringFromObj(objv[i], NULL);
+ if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
+ }
+ case EVENT_DELETE: {
+ int i;
+ char *name, *event;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "virtual ?sequence sequence ...?");
+ return TCL_ERROR;
+ }
+ name = Tcl_GetStringFromObj(objv[2], NULL);
+ if (objc == 3) {
+ return DeleteVirtualEvent(interp, vetPtr, name, NULL);
+ }
+ for (i = 3; i < objc; i++) {
+ event = Tcl_GetStringFromObj(objv[i], NULL);
+ if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
+ }
+ case EVENT_GENERATE: {
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?");
+ return TCL_ERROR;
+ }
+ return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);
+ }
+ case EVENT_INFO: {
+ if (objc == 2) {
+ GetAllVirtualEvents(interp, vetPtr);
+ return TCL_OK;
+ } else if (objc == 3) {
+ return GetVirtualEvent(interp, vetPtr,
+ Tcl_GetStringFromObj(objv[2], NULL));
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitVirtualEventTable --
+ *
+ * Given storage for a virtual event table, set up the fields to
+ * prepare a new domain in which virtual events may be defined.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * *vetPtr is now initialized.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitVirtualEventTable(vetPtr)
+ VirtualEventTable *vetPtr; /* Pointer to virtual event table. Memory
+ * is supplied by the caller. */
+{
+ Tcl_InitHashTable(&vetPtr->patternTable,
+ sizeof(PatternTableKey) / sizeof(int));
+ Tcl_InitHashTable(&vetPtr->nameTable, TCL_ONE_WORD_KEYS);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DeleteVirtualEventTable --
+ *
+ * Delete the contents of a virtual event table. The caller is
+ * responsible for freeing any memory used by the table itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DeleteVirtualEventTable(vetPtr)
+ VirtualEventTable *vetPtr; /* The virtual event table to delete. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ PatSeq *psPtr, *nextPtr;
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ for ( ; psPtr != NULL; psPtr = nextPtr) {
+ nextPtr = psPtr->nextSeqPtr;
+ ckfree((char *) psPtr->voPtr);
+ ckfree((char *) psPtr);
+ }
+ }
+ Tcl_DeleteHashTable(&vetPtr->patternTable);
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ckfree((char *) Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(&vetPtr->nameTable);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateVirtualEvent --
+ *
+ * Add a new definition for a virtual event. If the virtual event
+ * is already defined, the new definition augments those that
+ * already exist.
+ *
+ * Results:
+ * The return value is TCL_ERROR if an error occured while
+ * creating the virtual binding. In this case, an error message
+ * will be left in the interp's result. If all went well then the
+ * return value is TCL_OK.
+ *
+ * Side effects:
+ * The virtual event may cause future calls to Tk_BindEvent to
+ * behave differently than they did previously.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateVirtualEvent(interp, vetPtr, virtString, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to augment virtual event. */
+ char *virtString; /* Name of new virtual event. */
+ char *eventString; /* String describing physical event that
+ * triggers virtual event. */
+{
+ PatSeq *psPtr;
+ int dummy;
+ Tcl_HashEntry *vhPtr;
+ unsigned long eventMask;
+ PhysicalsOwned *poPtr;
+ VirtualOwners *voPtr;
+ Tk_Uid virtUid;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find/create physical event
+ */
+
+ psPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString,
+ 1, 0, &eventMask);
+ if (psPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find/create virtual event.
+ */
+
+ vhPtr = Tcl_CreateHashEntry(&vetPtr->nameTable, virtUid, &dummy);
+
+ /*
+ * Make virtual event own the physical event.
+ */
+
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ if (poPtr == NULL) {
+ poPtr = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned));
+ poPtr->numOwned = 0;
+ } else {
+ /*
+ * See if this virtual event is already defined for this physical
+ * event and just return if it is.
+ */
+
+ int i;
+ for (i = 0; i < poPtr->numOwned; i++) {
+ if (poPtr->patSeqs[i] == psPtr) {
+ return TCL_OK;
+ }
+ }
+ poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr,
+ sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *));
+ }
+ Tcl_SetHashValue(vhPtr, (ClientData) poPtr);
+ poPtr->patSeqs[poPtr->numOwned] = psPtr;
+ poPtr->numOwned++;
+
+ /*
+ * Make physical event so it can trigger the virtual event.
+ */
+
+ voPtr = psPtr->voPtr;
+ if (voPtr == NULL) {
+ voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners));
+ voPtr->numOwners = 0;
+ } else {
+ voPtr = (VirtualOwners *) ckrealloc((char *) voPtr,
+ sizeof(VirtualOwners)
+ + voPtr->numOwners * sizeof(Tcl_HashEntry *));
+ }
+ psPtr->voPtr = voPtr;
+ voPtr->owners[voPtr->numOwners] = vhPtr;
+ voPtr->numOwners++;
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteVirtualEvent --
+ *
+ * Remove the definition of a given virtual event. If the
+ * event string is NULL, all definitions of the virtual event
+ * will be removed. Otherwise, just the specified definition
+ * of the virtual event will be removed.
+ *
+ * Results:
+ * The result is a standard Tcl return value. If an error
+ * occurs then the interp's result will contain an error message.
+ * It is not an error to attempt to delete a virtual event that
+ * does not exist or a definition that does not exist.
+ *
+ * Side effects:
+ * The virtual event given by virtString may be removed from the
+ * virtual event table.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to delete event. */
+ char *virtString; /* String describing event sequence that
+ * triggers binding. */
+ char *eventString; /* The event sequence that should be deleted,
+ * or NULL to delete all event sequences for
+ * the entire virtual event. */
+{
+ int iPhys;
+ Tk_Uid virtUid;
+ Tcl_HashEntry *vhPtr;
+ PhysicalsOwned *poPtr;
+ PatSeq *eventPSPtr;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+ if (vhPtr == NULL) {
+ return TCL_OK;
+ }
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+
+ eventPSPtr = NULL;
+ if (eventString != NULL) {
+ unsigned long eventMask;
+
+ /*
+ * Delete only the specific physical event associated with the
+ * virtual event. If the physical event doesn't already exist, or
+ * the virtual event doesn't own that physical event, return w/o
+ * doing anything.
+ */
+
+ eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
+ eventString, 0, 0, &eventMask);
+ if (eventPSPtr == NULL) {
+ CONST char *string;
+
+ string = Tcl_GetStringResult(interp);
+ return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
+ }
+ }
+
+ for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
+ PatSeq *psPtr = poPtr->patSeqs[iPhys];
+ if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
+ int iVirt;
+ VirtualOwners *voPtr;
+
+ /*
+ * Remove association between this physical event and the given
+ * virtual event that it triggers.
+ */
+
+ voPtr = psPtr->voPtr;
+ for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+ if (voPtr->owners[iVirt] == vhPtr) {
+ break;
+ }
+ }
+ if (iVirt == voPtr->numOwners) {
+ panic("DeleteVirtualEvent: couldn't find owner");
+ }
+ voPtr->numOwners--;
+ if (voPtr->numOwners == 0) {
+ /*
+ * Removed last reference to this physical event, so
+ * remove it from physical->virtual map.
+ */
+ PatSeq *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("DeleteVirtualEvent couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+ ckfree((char *) psPtr->voPtr);
+ ckfree((char *) psPtr);
+ } else {
+ /*
+ * This physical event still triggers some other virtual
+ * event(s). Consolidate the list of virtual owners for
+ * this physical event so it no longer triggers the
+ * given virtual event.
+ */
+ voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
+ }
+
+ /*
+ * Now delete the virtual event's reference to the physical
+ * event.
+ */
+
+ poPtr->numOwned--;
+ if (eventPSPtr != NULL && poPtr->numOwned != 0) {
+ /*
+ * Just deleting this one physical event. Consolidate list
+ * of owned physical events and return.
+ */
+
+ poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
+ return TCL_OK;
+ }
+ }
+ }
+
+ if (poPtr->numOwned == 0) {
+ /*
+ * All the physical events for this virtual event were deleted,
+ * either because there was only one associated physical event or
+ * because the caller was deleting the entire virtual event. Now
+ * the virtual event itself should be deleted.
+ */
+
+ ckfree((char *) poPtr);
+ Tcl_DeleteHashEntry(vhPtr);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetVirtualEvent --
+ *
+ * Return the list of physical events that can invoke the
+ * given virtual event.
+ *
+ * Results:
+ * The return value is TCL_OK and the interp's result is filled with the
+ * string representation of the physical events associated with the
+ * virtual event; if there are no physical events for the given virtual
+ * event, the interp's result is filled with and empty string. If the
+ * virtual event string is improperly formed, then TCL_ERROR is
+ * returned and an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetVirtualEvent(interp, vetPtr, virtString)
+ Tcl_Interp *interp; /* Interpreter for reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to look for event. */
+ char *virtString; /* String describing virtual event. */
+{
+ Tcl_HashEntry *vhPtr;
+ Tcl_DString ds;
+ int iPhys;
+ PhysicalsOwned *poPtr;
+ Tk_Uid virtUid;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+ if (vhPtr == NULL) {
+ return TCL_OK;
+ }
+
+ Tcl_DStringInit(&ds);
+
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
+ Tcl_DStringSetLength(&ds, 0);
+ GetPatternString(poPtr->patSeqs[iPhys], &ds);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GetAllVirtualEvents --
+ *
+ * Return a list that contains the names of all the virtual
+ * event defined.
+ *
+ * Results:
+ * There is no return value. The interp's result is modified to
+ * hold a Tcl list with one entry for each virtual event in
+ * nameTable.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GetAllVirtualEvents(interp, vetPtr)
+ Tcl_Interp *interp; /* Interpreter returning result. */
+ VirtualEventTable *vetPtr;/* Table containing events. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, "<<", 2);
+ Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
+ Tcl_DStringAppend(&ds, ">>", 2);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+
+ Tcl_DStringFree(&ds);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HandleEventGenerate --
+ *
+ * Helper function for the "event generate" command. Generate and
+ * process an XEvent, constructed from information parsed from the
+ * event description string and its optional arguments.
+ *
+ * argv[0] contains name of the target window.
+ * argv[1] contains pattern string for one event (e.g, <Control-v>).
+ * argv[2..argc-1] contains -field/option pairs for specifying
+ * additional detail in the generated event.
+ *
+ * Either virtual or physical events can be generated this way.
+ * The event description string must contain the specification
+ * for only one event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When constructing the event,
+ * event.xany.serial is filled with the current X serial number.
+ * event.xany.window is filled with the target window.
+ * event.xany.display is filled with the target window's display.
+ * Any other fields in eventPtr which are not specified by the pattern
+ * string or the optional arguments, are set to 0.
+ *
+ * The event may be handled sychronously or asynchronously, depending
+ * on the value specified by the optional "-when" option. The
+ * default setting is synchronous.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int
+HandleEventGenerate(interp, mainWin, objc, objv)
+ Tcl_Interp *interp; /* Interp for errors return and name lookup. */
+ Tk_Window mainWin; /* Main window associated with interp. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ XEvent event;
+ CONST char *p;
+ char *name, *windowName;
+ int count, flags, synch, i, number, warp;
+ Tcl_QueuePosition pos;
+ Pattern pat;
+ Tk_Window tkwin, tkwin2;
+ TkWindow *mainPtr;
+ unsigned long eventMask;
+ static CONST char *fieldStrings[] = {
+ "-when", "-above", "-borderwidth", "-button",
+ "-count", "-delta", "-detail", "-focus",
+ "-height",
+ "-keycode", "-keysym", "-mode", "-override",
+ "-place", "-root", "-rootx", "-rooty",
+ "-sendevent", "-serial", "-state", "-subwindow",
+ "-time", "-warp", "-width", "-window",
+ "-x", "-y", NULL
+ };
+ enum field {
+ EVENT_WHEN, EVENT_ABOVE, EVENT_BORDER, EVENT_BUTTON,
+ EVENT_COUNT, EVENT_DELTA, EVENT_DETAIL, EVENT_FOCUS,
+ EVENT_HEIGHT,
+ EVENT_KEYCODE, EVENT_KEYSYM, EVENT_MODE, EVENT_OVERRIDE,
+ EVENT_PLACE, EVENT_ROOT, EVENT_ROOTX, EVENT_ROOTY,
+ EVENT_SEND, EVENT_SERIAL, EVENT_STATE, EVENT_SUBWINDOW,
+ EVENT_TIME, EVENT_WARP, EVENT_WIDTH, EVENT_WINDOW,
+ EVENT_X, EVENT_Y
+ };
+
+ windowName = Tcl_GetStringFromObj(objv[0], NULL);
+ if (!windowName[0]) {
+ tkwin = mainWin;
+ } else if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ mainPtr = (TkWindow *) mainWin;
+ if ((tkwin == NULL)
+ || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
+ char *name;
+
+ name = Tcl_GetStringFromObj(objv[0], NULL);
+ Tcl_AppendResult(interp, "window id \"", name,
+ "\" doesn't exist in this application", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[1], NULL);
+
+ p = name;
+ eventMask = 0;
+ count = ParseEventDescription(interp, &p, &pat, &eventMask);
+ if (count == 0) {
+ return TCL_ERROR;
+ }
+ if (count != 1) {
+ Tcl_SetResult(interp, "Double or Triple modifier not allowed",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (*p != '\0') {
+ Tcl_SetResult(interp, "only one event specification allowed",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ memset((VOID *) &event, 0, sizeof(event));
+ event.xany.type = pat.eventType;
+ event.xany.serial = NextRequest(Tk_Display(tkwin));
+ event.xany.send_event = False;
+ if (windowName[0]) {
+ event.xany.window = Tk_WindowId(tkwin);
+ } else {
+ event.xany.window = RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin));
+ }
+ event.xany.display = Tk_Display(tkwin);
+
+ flags = flagArray[event.xany.type];
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ event.xkey.state = pat.needMods;
+ if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) {
+ TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event);
+ } else if (flags & BUTTON) {
+ event.xbutton.button = pat.detail.button;
+ } else if (flags & VIRTUAL) {
+ ((XVirtualEvent *) &event)->name = pat.detail.name;
+ }
+ }
+ if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
+ event.xcreatewindow.window = event.xany.window;
+ }
+
+ /*
+ * Process the remaining arguments to fill in additional fields
+ * of the event.
+ */
+
+ synch = 1;
+ warp = 0;
+ pos = TCL_QUEUE_TAIL;
+ for (i = 2; i < objc; i += 2) {
+ Tcl_Obj *optionPtr, *valuePtr;
+ int index;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc & 1) {
+ /*
+ * This test occurs after Tcl_GetIndexFromObj() so that
+ * "event generate <Button> -xyz" will return the error message
+ * that "-xyz" is a bad option, rather than that the value
+ * for "-xyz" is missing.
+ */
+
+ Tcl_AppendResult(interp, "value for \"",
+ Tcl_GetStringFromObj(optionPtr, NULL), "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum field) index) {
+ case EVENT_WARP: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!(flags & (KEY_BUTTON_MOTION_VIRTUAL))) {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_WHEN: {
+ pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr,
+ queuePosition, valuePtr);
+ if ((int) pos < -1) {
+ return TCL_ERROR;
+ }
+ synch = 0;
+ if ((int) pos == -1) {
+ synch = 1;
+ }
+ break;
+ }
+ case EVENT_ABOVE: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CONFIG) {
+ event.xconfigure.above = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_BORDER: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|CONFIG)) {
+ event.xcreatewindow.border_width = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_BUTTON: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & BUTTON) {
+ event.xbutton.button = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_COUNT: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.count = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_DELTA: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
+ event.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_DETAIL: {
+ number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & FOCUS) {
+ event.xfocus.detail = number;
+ } else if (flags & CROSSING) {
+ event.xcrossing.detail = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_FOCUS: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.xcrossing.focus = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_HEIGHT: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.height = number;
+ } else if (flags & CONFIG) {
+ event.xconfigure.height = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_KEYCODE: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
+ event.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_KEYSYM: {
+ KeySym keysym;
+ char *value;
+
+ value = Tcl_GetStringFromObj(valuePtr, NULL);
+ keysym = TkStringToKeysym(value);
+ if (keysym == NoSymbol) {
+ Tcl_AppendResult(interp, "unknown keysym \"", value, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ TkpSetKeycodeAndState(tkwin, keysym, &event);
+ if (event.xkey.keycode == 0) {
+ Tcl_AppendResult(interp, "no keycode for keysym \"", value,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_MODE: {
+ number = TkFindStateNumObj(interp, optionPtr, notifyMode,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.xcrossing.mode = number;
+ } else if (flags & FOCUS) {
+ event.xfocus.mode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_OVERRIDE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CREATE) {
+ event.xcreatewindow.override_redirect = number;
+ } else if (flags & MAP) {
+ event.xmap.override_redirect = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.override_redirect = number;
+ } else if (flags & CONFIG) {
+ event.xconfigure.override_redirect = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_PLACE: {
+ number = TkFindStateNumObj(interp, optionPtr, circPlace,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CIRC) {
+ event.xcirculate.place = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_ROOT: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.root = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_ROOTX: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.x_root = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_ROOTY: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.y_root = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_SEND: {
+ CONST char *value;
+
+ value = Tcl_GetStringFromObj(valuePtr, NULL);
+ if (isdigit(UCHAR(value[0]))) {
+ /*
+ * Allow arbitrary integer values for the field; they
+ * are needed by a few of the tests in the Tk test suite.
+ */
+
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ event.xany.send_event = number;
+ break;
+ }
+ case EVENT_SERIAL: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ event.xany.serial = number;
+ break;
+ }
+ case EVENT_STATE: {
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ event.xkey.state = number;
+ } else {
+ event.xcrossing.state = number;
+ }
+ } else if (flags & VISIBILITY) {
+ number = TkFindStateNumObj(interp, optionPtr, visNotify,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ event.xvisibility.state = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_SUBWINDOW: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.subwindow = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_TIME: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.time = (Time) number;
+ } else if (flags & PROP) {
+ event.xproperty.time = (Time) number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_WIDTH: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.width = number;
+ } else if (flags & (CREATE|CONFIG)) {
+ event.xcreatewindow.width = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_WINDOW: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
+ |GRAVITY|CIRC)) {
+ event.xcreatewindow.window = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_X: {
+ int rootX, rootY;
+
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ rootX += number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.x = number;
+ event.xkey.x_root = rootX;
+ } else if (flags & EXPOSE) {
+ event.xexpose.x = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.xcreatewindow.x = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.x = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_Y: {
+ int rootX, rootY;
+
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ rootY += number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.y = number;
+ event.xkey.y_root = rootY;
+ } else if (flags & EXPOSE) {
+ event.xexpose.y = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.xcreatewindow.y = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.y = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ }
+ continue;
+
+ badopt:
+ Tcl_AppendResult(interp, name, " event doesn't accept \"",
+ Tcl_GetStringFromObj(optionPtr, NULL), "\" option", NULL);
+ return TCL_ERROR;
+ }
+ if (synch != 0) {
+ Tk_HandleEvent(&event);
+ } else {
+ Tk_QueueWindowEvent(&event, pos);
+ }
+ /*
+ * We only allow warping if the window is mapped
+ */
+ if ((warp != 0) && Tk_IsMapped(tkwin)) {
+ TkDisplay *dispPtr;
+ dispPtr = TkGetDisplay(event.xmotion.display);
+ if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
+ Tcl_DoWhenIdle(DoWarp, (ClientData) dispPtr);
+ dispPtr->flags |= TK_DISPLAY_IN_WARP;
+ }
+ dispPtr->warpWindow = event.xany.window;
+ dispPtr->warpX = event.xkey.x;
+ dispPtr->warpY = event.xkey.y;
+ }
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+
+}
+static int
+NameToWindow(interp, mainWin, objPtr, tkwinPtr)
+ Tcl_Interp *interp; /* Interp for error return and name lookup. */
+ Tk_Window mainWin; /* Main window of application. */
+ Tcl_Obj *objPtr; /* Contains name or id string of window. */
+ Tk_Window *tkwinPtr; /* Filled with token for window. */
+{
+ char *name;
+ Tk_Window tkwin;
+ Window id;
+
+ name = Tcl_GetStringFromObj(objPtr, NULL);
+ if (name[0] == '.') {
+ tkwin = Tk_NameToWindow(interp, name, mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ *tkwinPtr = tkwin;
+ } else {
+ /*
+ * Check for the winPtr being valid, even if it looks ok to
+ * TkpScanWindowId. [Bug #411307]
+ */
+
+ if ((TkpScanWindowId(NULL, name, &id) != TCL_OK) ||
+ ((*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), id))
+ == NULL)) {
+ Tcl_AppendResult(interp, "bad window name/identifier \"",
+ name, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * DoWarp --
+ *
+ * Perform Warping of X pointer. Executed as an idle handler only.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * X Pointer will move to a new location.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+DoWarp(clientData)
+ ClientData clientData;
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+
+ XWarpPointer(dispPtr->display, (Window) None, (Window) dispPtr->warpWindow,
+ 0, 0, 0, 0, (int) dispPtr->warpX, (int) dispPtr->warpY);
+ XForceScreenSaver(dispPtr->display, ScreenSaverReset);
+ dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetVirtualEventUid --
+ *
+ * Determine if the given string is in the proper format for a
+ * virtual event.
+ *
+ * Results:
+ * The return value is NULL if the virtual event string was
+ * not in the proper format. In this case, an error message
+ * will be left in the interp's result. Otherwise the return
+ * value is a Tk_Uid that represents the virtual event.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+static Tk_Uid
+GetVirtualEventUid(interp, virtString)
+ Tcl_Interp *interp;
+ char *virtString;
+{
+ Tk_Uid uid;
+ int length;
+
+ length = strlen(virtString);
+
+ if (length < 5 || virtString[0] != '<' || virtString[1] != '<' ||
+ virtString[length - 2] != '>' || virtString[length - 1] != '>') {
+ Tcl_AppendResult(interp, "virtual event \"", virtString,
+ "\" is badly formed", (char *) NULL);
+ return NULL;
+ }
+ virtString[length - 2] = '\0';
+ uid = Tk_GetUid(virtString + 2);
+ virtString[length - 2] = '>';
+
+ return uid;
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSequence --
+ *
+ * Find the entry in the pattern 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 the interp's 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 allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static PatSeq *
+FindSequence(interp, patternTablePtr, object, eventString, create,
+ allowVirtual, maskPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ Tcl_HashTable *patternTablePtr; /* Table to use for lookup. */
+ ClientData object; /* For binding table, token for object with
+ * which binding is associated.
+ * For virtual event table, NULL. */
+ CONST 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. */
+ int allowVirtual; /* 0 means that virtual events are not
+ * allowed in the sequence. Non-zero
+ * otherwise. */
+ unsigned long *maskPtr; /* *maskPtr is filled in with the event
+ * types on which this pattern sequence
+ * depends. */
+{
+
+ Pattern pats[EVENT_BUFFER_SIZE];
+ int numPats, virtualFound;
+ CONST char *p;
+ Pattern *patPtr;
+ PatSeq *psPtr;
+ Tcl_HashEntry *hPtr;
+ int flags, count, 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;
+ flags = 0;
+ eventMask = 0;
+ virtualFound = 0;
+
+ patPtr = &pats[EVENT_BUFFER_SIZE-1];
+ for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+
+ count = ParseEventDescription(interp, &p, patPtr, &eventMask);
+ if (count == 0) {
+ return NULL;
+ }
+
+ if (eventMask & VirtualEventMask) {
+ if (allowVirtual == 0) {
+ Tcl_SetResult(interp,
+ "virtual event not allowed in definition of another virtual event",
+ TCL_STATIC);
+ return NULL;
+ }
+ virtualFound = 1;
+ }
+
+ /*
+ * Replicate events for DOUBLE, TRIPLE, QUADRUPLE.
+ */
+
+ while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
+ flags |= PAT_NEARBY;
+ patPtr[-1] = patPtr[0];
+ patPtr--;
+ numPats++;
+ }
+ }
+
+ /*
+ *-------------------------------------------------------------
+ * 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) {
+ Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
+ return NULL;
+ }
+ if ((numPats > 1) && (virtualFound != 0)) {
+ Tcl_SetResult(interp, "virtual events may not be composed",
+ TCL_STATIC);
+ return NULL;
+ }
+
+ patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
+ memset(&key, 0, sizeof(key));
+ key.object = object;
+ key.type = patPtr->eventType;
+ key.detail = patPtr->detail;
+ hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &new);
+ sequenceSize = numPats*sizeof(Pattern);
+ if (!new) {
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = psPtr->nextSeqPtr) {
+ if ((numPats == psPtr->numPats)
+ && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
+ && (memcmp((char *) patPtr, (char *) psPtr->pats,
+ sequenceSize) == 0)) {
+ goto done;
+ }
+ }
+ }
+ if (!create) {
+ if (new) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ /*
+ * No binding exists for the sequence, so return an empty error.
+ * This is a special error that the caller will check for in order
+ * to silently ignore this case. This is a hack that maintains
+ * backward compatibility for Tk_GetBinding but the various "bind"
+ * commands silently ignore missing bindings.
+ */
+
+ return NULL;
+ }
+ psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
+ + (numPats-1)*sizeof(Pattern)));
+ psPtr->numPats = numPats;
+ psPtr->eventProc = NULL;
+ psPtr->freeProc = NULL;
+ psPtr->clientData = NULL;
+ psPtr->flags = flags;
+ psPtr->refCount = 0;
+ psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ psPtr->hPtr = hPtr;
+ psPtr->voPtr = NULL;
+ psPtr->nextObjPtr = NULL;
+ Tcl_SetHashValue(hPtr, psPtr);
+
+ memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
+
+ done:
+ *maskPtr = eventMask;
+ return psPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseEventDescription --
+ *
+ * Fill Pattern buffer with information about event from
+ * event string.
+ *
+ * Results:
+ * Leaves error message in interp and returns 0 if there was an
+ * error due to a badly formed event string. Returns 1 if proper
+ * event was specified, 2 if Double modifier was used in event
+ * string, or 3 if Triple was used.
+ *
+ * Side effects:
+ * On exit, eventStringPtr points to rest of event string (after the
+ * closing '>', so that this procedure can be called repeatedly to
+ * parse all the events in the entire sequence.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseEventDescription(interp, eventStringPtr, patPtr,
+ eventMaskPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ CONST char **eventStringPtr;/* On input, holds a pointer to start of
+ * event string. On exit, gets pointer to
+ * rest of string after parsed event. */
+ Pattern *patPtr; /* Filled with the pattern parsed from the
+ * event string. */
+ unsigned long *eventMaskPtr;/* Filled with event mask of matched event. */
+
+{
+ char *p;
+ unsigned long eventMask;
+ int count, eventFlags;
+#define FIELD_SIZE 48
+ char field[FIELD_SIZE];
+ Tcl_HashEntry *hPtr;
+ Tcl_DString copy;
+
+ Tcl_DStringInit(©);
+ p = Tcl_DStringAppend(©, *eventStringPtr, -1);
+
+ patPtr->eventType = -1;
+ patPtr->needMods = 0;
+ patPtr->detail.clientData = 0;
+
+ eventMask = 0;
+ count = 1;
+
+ /*
+ * Handle simple ASCII characters.
+ */
+
+ if (*p != '<') {
+ char string[2];
+
+ patPtr->eventType = KeyPress;
+ eventMask = KeyPressMask;
+ string[0] = *p;
+ string[1] = 0;
+ patPtr->detail.keySym = TkStringToKeysym(string);
+ if (patPtr->detail.keySym == NoSymbol) {
+ if (isprint(UCHAR(*p))) {
+ patPtr->detail.keySym = *p;
+ } else {
+ char buf[64];
+
+ sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ count = 0;
+ goto done;
+ }
+ }
+ p++;
+ goto end;
+ }
+
+ /*
+ * A fancier event description. This can be either a virtual event
+ * or a physical event.
+ *
+ * A virtual event description consists of:
+ *
+ * 1. double open angle brackets.
+ * 2. virtual event name.
+ * 3. double close angle brackets.
+ *
+ * A physical event description consists of:
+ *
+ * 1. open angle bracket.
+ * 2. any number of modifiers, each followed by spaces
+ * or dashes.
+ * 3. an optional event name.
+ * 4. an option button or keysym name. Either this or
+ * item 3 *must* be present; if both are present
+ * then they are separated by spaces or dashes.
+ * 5. a close angle bracket.
+ */
+
+ p++;
+ if (*p == '<') {
+ /*
+ * This is a virtual event: soak up all the characters up to
+ * the next '>'.
+ */
+
+ char *field = p + 1;
+ p = strchr(field, '>');
+ if (p == field) {
+ Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed",
+ TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+ if ((p == NULL) || (p[1] != '>')) {
+ Tcl_SetResult(interp, "missing \">\" in virtual binding",
+ TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+ *p = '\0';
+ patPtr->eventType = VirtualEvent;
+ eventMask = VirtualEventMask;
+ patPtr->detail.name = Tk_GetUid(field);
+ *p = '>';
+
+ p += 2;
+ goto end;
+ }
+
+ while (1) {
+ ModInfo *modPtr;
+ p = GetField(p, field, FIELD_SIZE);
+ if (*p == '>') {
+ /*
+ * This solves the problem of, e.g., <Control-M> being
+ * misinterpreted as Control + Meta + missing keysym
+ * instead of Control + KeyPress + M.
+ */
+ break;
+ }
+ hPtr = Tcl_FindHashEntry(&modTable, field);
+ if (hPtr == NULL) {
+ break;
+ }
+ modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
+ patPtr->needMods |= modPtr->mask;
+ if (modPtr->flags & (MULT_CLICKS)) {
+ int i = modPtr->flags & MULT_CLICKS;
+ count = 2;
+ while (i >>= 1) count++;
+ }
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ }
+
+ eventFlags = 0;
+ hPtr = Tcl_FindHashEntry(&eventTable, field);
+ if (hPtr != NULL) {
+ EventInfo *eiPtr;
+ eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
+
+ patPtr->eventType = eiPtr->type;
+ eventFlags = flagArray[eiPtr->type];
+ eventMask = eiPtr->eventMask;
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ p = GetField(p, field, FIELD_SIZE);
+ }
+ if (*field != '\0') {
+ if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
+ if (eventFlags == 0) {
+ patPtr->eventType = ButtonPress;
+ eventMask = ButtonPressMask;
+ } else if (eventFlags & KEY) {
+ goto getKeysym;
+ } else if ((eventFlags & BUTTON) == 0) {
+ Tcl_AppendResult(interp, "specified button \"", field,
+ "\" for non-button event", (char *) NULL);
+ count = 0;
+ goto done;
+ }
+ patPtr->detail.button = (*field - '0');
+ } else {
+ getKeysym:
+ patPtr->detail.keySym = TkStringToKeysym(field);
+ if (patPtr->detail.keySym == NoSymbol) {
+ Tcl_AppendResult(interp, "bad event type or keysym \"",
+ field, "\"", (char *) NULL);
+ count = 0;
+ goto done;
+ }
+ if (eventFlags == 0) {
+ patPtr->eventType = KeyPress;
+ eventMask = KeyPressMask;
+ } else if ((eventFlags & KEY) == 0) {
+ Tcl_AppendResult(interp, "specified keysym \"", field,
+ "\" for non-key event", (char *) NULL);
+ count = 0;
+ goto done;
+ }
+ }
+ } else if (eventFlags == 0) {
+ Tcl_SetResult(interp, "no event type or button # or keysym",
+ TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p != '>') {
+ while (*p != '\0') {
+ p++;
+ if (*p == '>') {
+ Tcl_SetResult(interp,
+ "extra characters after detail in binding",
+ TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+ }
+ Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+ p++;
+
+end:
+ *eventStringPtr += (p - Tcl_DStringValue(©));
+ *eventMaskPtr |= eventMask;
+done:
+ Tcl_DStringFree(©);
+ return count;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+ char *p; /* Pointer to part of pattern. */
+ char *copy; /* Place to copy field. */
+ int size; /* Maximum number of characters to
+ * copy. */
+{
+ while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>')
+ && (*p != '-') && (size > 1)) {
+ *copy = *p;
+ p++;
+ copy++;
+ size--;
+ }
+ *copy = '\0';
+ return p;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetPatternString --
+ *
+ * Produce a string version of the given event, for displaying to
+ * the user.
+ *
+ * Results:
+ * The string is left in dsPtr.
+ *
+ * Side effects:
+ * It is the caller's responsibility to initialize the DString before
+ * and to free it after calling this procedure.
+ *
+ *---------------------------------------------------------------------------
+ */
+static void
+GetPatternString(psPtr, dsPtr)
+ PatSeq *psPtr;
+ Tcl_DString *dsPtr;
+{
+ Pattern *patPtr;
+ char c, buffer[TCL_INTEGER_SPACE];
+ int patsLeft, needMods;
+ ModInfo *modPtr;
+ EventInfo *eiPtr;
+
+ /*
+ * 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 simple case of an ASCII character.
+ */
+
+ if ((patPtr->eventType == KeyPress)
+ && ((psPtr->flags & PAT_NEARBY) == 0)
+ && (patPtr->needMods == 0)
+ && (patPtr->detail.keySym < 128)
+ && isprint(UCHAR(patPtr->detail.keySym))
+ && (patPtr->detail.keySym != '<')
+ && (patPtr->detail.keySym != ' ')) {
+
+ c = (char) patPtr->detail.keySym;
+ Tcl_DStringAppend(dsPtr, &c, 1);
+ continue;
+ }
+
+ /*
+ * Check for virtual event.
+ */
+
+ if (patPtr->eventType == VirtualEvent) {
+ Tcl_DStringAppend(dsPtr, "<<", 2);
+ Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
+ Tcl_DStringAppend(dsPtr, ">>", 2);
+ continue;
+ }
+
+ /*
+ * It's a more general event specification. First check
+ * for "Double", "Triple", "Quadruple", then modifiers,
+ * then event type, then keysym or button detail.
+ */
+
+ Tcl_DStringAppend(dsPtr, "<", 1);
+ if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
+ && (memcmp((char *) patPtr, (char *) (patPtr-1),
+ sizeof(Pattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ if ((patsLeft > 1) && (memcmp((char *) patPtr,
+ (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ if ((patsLeft > 1) && (memcmp((char *) patPtr,
+ (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ Tcl_DStringAppend(dsPtr, "Quadruple-", 10);
+ } else {
+ Tcl_DStringAppend(dsPtr, "Triple-", 7);
+ }
+ } else {
+ Tcl_DStringAppend(dsPtr, "Double-", 7);
+ }
+ }
+ for (needMods = patPtr->needMods, modPtr = modArray;
+ needMods != 0; modPtr++) {
+ if (modPtr->mask & needMods) {
+ needMods &= ~modPtr->mask;
+ Tcl_DStringAppend(dsPtr, modPtr->name, -1);
+ Tcl_DStringAppend(dsPtr, "-", 1);
+ }
+ }
+ for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+ if (eiPtr->type == patPtr->eventType) {
+ Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
+ if (patPtr->detail.clientData != 0) {
+ Tcl_DStringAppend(dsPtr, "-", 1);
+ }
+ break;
+ }
+ }
+
+ if (patPtr->detail.clientData != 0) {
+ if ((patPtr->eventType == KeyPress)
+ || (patPtr->eventType == KeyRelease)) {
+ char *string;
+
+ string = TkKeysymToString(patPtr->detail.keySym);
+ if (string != NULL) {
+ Tcl_DStringAppend(dsPtr, string, -1);
+ }
+ } else {
+ sprintf(buffer, "%d", patPtr->detail.button);
+ Tcl_DStringAppend(dsPtr, buffer, -1);
+ }
+ }
+ Tcl_DStringAppend(dsPtr, ">", 1);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EvalTclBinding --
+ *
+ * The procedure that is invoked by Tk_BindEvent when a Tcl binding
+ * is fired.
+ *
+ * Results:
+ * A standard Tcl result code, the result of globally evaluating the
+ * percent-substitued binding string.
+ *
+ * Side effects:
+ * Normal side effects due to eval.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeTclBinding(clientData)
+ ClientData clientData;
+{
+ ckfree((char *) clientData);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkStringToKeysym --
+ *
+ * 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
+TkStringToKeysym(name)
+ char *name; /* Name of a keysym. */
+{
+#ifdef REDO_KEYSYM_LOOKUP
+ Tcl_HashEntry *hPtr;
+ KeySym keysym;
+
+ hPtr = Tcl_FindHashEntry(&keySymTable, name);
+ if (hPtr != NULL) {
+ return (KeySym) Tcl_GetHashValue(hPtr);
+ }
+ if (strlen(name) == 1) {
+ keysym = (KeySym) (unsigned char) name[0];
+ if (TkKeysymToString(keysym) != NULL) {
+ return keysym;
+ }
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+ return XStringToKeysym(name);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkKeysymToString --
+ *
+ * This procedure finds the keysym name associated with a given
+ * keysym.
+ *
+ * Results:
+ * The return value is a pointer to a static string containing
+ * the name of the given keysym, or NULL if there is no known name.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkKeysymToString(keysym)
+ KeySym keysym;
+{
+#ifdef REDO_KEYSYM_LOOKUP
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
+ if (hPtr != NULL) {
+ return (char *) Tcl_GetHashValue(hPtr);
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+ return XKeysymToString(keysym);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCopyAndGlobalEval --
+ *
+ * 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 the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkCopyAndGlobalEval(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;
+}
+
+
--- /dev/null
+/*
+ * tkBitmap.c --
+ *
+ * This file maintains a database of read-only bitmaps for the Tk
+ * toolkit. This allows bitmaps to be shared between widgets and
+ * also avoids interactions with the X server.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The includes below are for pre-defined bitmaps.
+ *
+ * Platform-specific issue: Windows complains when the bitmaps are
+ * included, because an array of characters is being initialized with
+ * integers as elements. For lint purposes, the following pragmas
+ * temporarily turn off that warning message.
+ */
+
+#if defined(__WIN32__) || defined(_WIN32)
+#pragma warning (disable : 4305)
+#endif
+
+#include "error.bmp"
+#include "gray12.bmp"
+#include "gray25.bmp"
+#include "gray50.bmp"
+#include "gray75.bmp"
+#include "hourglass.bmp"
+#include "info.bmp"
+#include "questhead.bmp"
+#include "question.bmp"
+#include "warning.bmp"
+
+#if defined(__WIN32__) || defined(_WIN32)
+#pragma warning (default : 4305)
+#endif
+
+/*
+ * One of the following data structures exists for each bitmap that is
+ * currently in use. Each structure is indexed with both "idTable" and
+ * "nameTable".
+ */
+
+typedef struct TkBitmap {
+ Pixmap bitmap; /* X identifier for bitmap. None means this
+ * bitmap was created by Tk_DefineBitmap
+ * and it isn't currently in use. */
+ int width, height; /* Dimensions of bitmap. */
+ Display *display; /* Display for which bitmap is valid. */
+ int screenNum; /* Screen on which bitmap is valid */
+ int resourceRefCount; /* Number of active uses of this bitmap (each
+ * active use corresponds to a call to
+ * Tk_AllocBitmapFromObj or Tk_GetBitmap).
+ * If this count is 0, then this TkBitmap
+ * structure is no longer valid and it isn't
+ * present in nameTable: it is being kept
+ * around only because there are objects
+ * referring to it. The structure is freed
+ * when resourceRefCount and objRefCount
+ * are both 0. */
+ int objRefCount; /* Number of Tcl_Obj's that reference
+ * this structure. */
+ Tcl_HashEntry *nameHashPtr; /* Entry in nameTable for this structure
+ * (needed when deleting). */
+ Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure
+ * (needed when deleting). */
+ struct TkBitmap *nextPtr; /* Points to the next TkBitmap structure with
+ * the same name. All bitmaps with the
+ * same name (but different displays or
+ * screens) are chained together off a
+ * single entry in nameTable. */
+} TkBitmap;
+
+/*
+ * Used in bitmapDataTable, stored in the TkDisplay structure, to map
+ * between in-core data about a bitmap to its TkBitmap structure.
+ */
+
+typedef struct {
+ CONST char *source; /* Bitmap bits. */
+ int width, height; /* Dimensions of bitmap. */
+} DataKey;
+
+typedef struct ThreadSpecificData {
+ int initialized; /* 0 means table below needs initializing. */
+ Tcl_HashTable predefBitmapTable;
+ /* Hash table created by Tk_DefineBitmap
+ * to map from a name to a collection
+ * of in-core data about a bitmap. The
+ * table is indexed by the address of the
+ * data for the bitmap, and the entries
+ * contain pointers to TkPredefBitmap
+ * structures. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void BitmapInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupBitmapObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeBitmap _ANSI_ARGS_((TkBitmap *bitmapPtr));
+static void FreeBitmapObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static TkBitmap * GetBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *name));
+static TkBitmap * GetBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj *objPtr));
+static void InitBitmapObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "bitmap" Tcl
+ * object, which maps a string bitmap name to a TkBitmap object. The
+ * ptr1 field of the Tcl_Obj points to a TkBitmap object.
+ */
+
+Tcl_ObjType tkBitmapObjType = {
+ "bitmap", /* name */
+ FreeBitmapObjProc, /* freeIntRepProc */
+ DupBitmapObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocBitmapFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * Pixmap structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (i.e. a Pixmap with a single plane), unless string couldn't be
+ * parsed correctly. In this case, None is returned and an error
+ * message is left in the interp's result. The caller should never
+ * modify the bitmap that is returned, and should eventually call
+ * Tk_FreeBitmapFromObj when the bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmapFromObj, so that the database can be cleaned up
+ * when bitmaps aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_AllocBitmapFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for error results. This may
+ * be NULL. */
+ Tk_Window tkwin; /* Need the screen the bitmap is used on.*/
+ Tcl_Obj *objPtr; /* Object describing bitmap; see manual
+ * entry for legal syntax of string value. */
+{
+ TkBitmap *bitmapPtr;
+
+ if (objPtr->typePtr != &tkBitmapObjType) {
+ InitBitmapObj(objPtr);
+ }
+ bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkBitmap, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (bitmapPtr != NULL) {
+ if (bitmapPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkBitmap that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeBitmapObjProc(objPtr);
+ bitmapPtr = NULL;
+ } else if ( (Tk_Display(tkwin) == bitmapPtr->display)
+ && (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum) ) {
+ bitmapPtr->resourceRefCount++;
+ return bitmapPtr->bitmap;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkBitmap that we wanted. Search
+ * the list of TkBitmaps with the same name to see if one of the
+ * others is the right one.
+ */
+
+ if (bitmapPtr != NULL) {
+ TkBitmap *firstBitmapPtr =
+ (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr);
+ FreeBitmapObjProc(objPtr);
+ for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if ( (Tk_Display(tkwin) == bitmapPtr->display) &&
+ (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum) ) {
+ bitmapPtr->resourceRefCount++;
+ bitmapPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ return bitmapPtr->bitmap;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call GetBitmap to allocate a new TkBitmap object.
+ */
+
+ bitmapPtr = GetBitmap(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ if (bitmapPtr == NULL) {
+ return None;
+ }
+ bitmapPtr->objRefCount++;
+ return bitmapPtr->bitmap;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmap --
+ *
+ * Given a string describing a bitmap, locate (or create if necessary)
+ * a bitmap that fits the description.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (i.e. a Pixmap with a single plane), unless string couldn't be
+ * parsed correctly. In this case, None is returned and an error
+ * message is left in the interp's result. The caller should never
+ * modify the bitmap that is returned, and should eventually call
+ * Tk_FreeBitmap when the bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetBitmap(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting,
+ * this may be NULL. */
+ Tk_Window tkwin; /* Window in which bitmap will be used. */
+ CONST char *string; /* Description of bitmap. See manual entry
+ * for details on legal syntax. */
+{
+ TkBitmap *bitmapPtr = GetBitmap(interp, tkwin, string);
+ if (bitmapPtr == NULL) {
+ return None;
+ }
+ return bitmapPtr->bitmap;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBitmap --
+ *
+ * Given a string describing a bitmap, locate (or create if necessary)
+ * a bitmap that fits the description. This routine returns the
+ * internal data structure for the bitmap. This avoids extra
+ * hash table lookups in Tk_AllocBitmapFromObj.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (i.e. a Pixmap with a single plane), unless string couldn't be
+ * parsed correctly. In this case, None is returned and an error
+ * message is left in the interp's result. The caller should never
+ * modify the bitmap that is returned, and should eventually call
+ * Tk_FreeBitmap when the bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmap or Tk_FreeBitmapFromObj, so that the database can
+ * be cleaned up when bitmaps aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkBitmap *
+GetBitmap(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting,
+ * this may be NULL. */
+ Tk_Window tkwin; /* Window in which bitmap will be used. */
+ CONST char *string; /* Description of bitmap. See manual entry
+ * for details on legal syntax. */
+{
+ Tcl_HashEntry *nameHashPtr, *predefHashPtr;
+ TkBitmap *bitmapPtr, *existingBitmapPtr;
+ TkPredefBitmap *predefPtr;
+ int new;
+ Pixmap bitmap;
+ int width, height;
+ int dummy2;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!dispPtr->bitmapInit) {
+ BitmapInit(dispPtr);
+ }
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string, &new);
+ if (!new) {
+ existingBitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr);
+ for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if ( (Tk_Display(tkwin) == bitmapPtr->display) &&
+ (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum) ) {
+ bitmapPtr->resourceRefCount++;
+ return bitmapPtr;
+ }
+ }
+ } else {
+ existingBitmapPtr = NULL;
+ }
+
+ /*
+ * No suitable bitmap exists. Create a new bitmap from the
+ * information contained in the string. If the string starts
+ * with "@" then the rest of the string is a file name containing
+ * the bitmap. Otherwise the string must refer to a bitmap
+ * defined by a call to Tk_DefineBitmap.
+ */
+
+ if (*string == '@') { /* INTL: ISO char */
+ Tcl_DString buffer;
+ int result;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't specify bitmap with '@' in a",
+ " safe interpreter", (char *) NULL);
+ goto error;
+ }
+
+ /*
+ * Note that we need to cast away the CONST from the string because
+ * Tcl_TranslateFileName is non const, even though it doesn't modify
+ * the string.
+ */
+
+ string = Tcl_TranslateFileName(interp, (char *) string + 1, &buffer);
+ if (string == NULL) {
+ goto error;
+ }
+ result = TkReadBitmapFile(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), string,
+ (unsigned int *) &width, (unsigned int *) &height,
+ &bitmap, &dummy2, &dummy2);
+ if (result != BitmapSuccess) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "error reading bitmap file \"", string,
+ "\"", (char *) NULL);
+ }
+ Tcl_DStringFree(&buffer);
+ goto error;
+ }
+ Tcl_DStringFree(&buffer);
+ } else {
+ predefHashPtr = Tcl_FindHashEntry(&tsdPtr->predefBitmapTable,
+ string);
+ if (predefHashPtr == NULL) {
+ /*
+ * The following platform specific call allows the user to
+ * define bitmaps that may only exist during run time. If
+ * it returns None nothing was found and we return the error.
+ */
+ bitmap = TkpGetNativeAppBitmap(Tk_Display(tkwin), string,
+ &width, &height);
+
+ if (bitmap == None) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "bitmap \"", string,
+ "\" not defined", (char *) NULL);
+ }
+ goto error;
+ }
+ } else {
+ predefPtr = (TkPredefBitmap *) Tcl_GetHashValue(predefHashPtr);
+ width = predefPtr->width;
+ height = predefPtr->height;
+ if (predefPtr->native) {
+ bitmap = TkpCreateNativeBitmap(Tk_Display(tkwin),
+ predefPtr->source);
+ if (bitmap == None) {
+ panic("native bitmap creation failed");
+ }
+ } else {
+ bitmap = XCreateBitmapFromData(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)),
+ predefPtr->source,
+ (unsigned) width, (unsigned) height);
+ }
+ }
+ }
+
+ /*
+ * Add information about this bitmap to our database.
+ */
+
+ bitmapPtr = (TkBitmap *) ckalloc(sizeof(TkBitmap));
+ bitmapPtr->bitmap = bitmap;
+ bitmapPtr->width = width;
+ bitmapPtr->height = height;
+ bitmapPtr->display = Tk_Display(tkwin);
+ bitmapPtr->screenNum = Tk_ScreenNumber(tkwin);
+ bitmapPtr->resourceRefCount = 1;
+ bitmapPtr->objRefCount = 0;
+ bitmapPtr->nameHashPtr = nameHashPtr;
+ bitmapPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapIdTable,
+ (char *) bitmap, &new);
+ if (!new) {
+ panic("bitmap already registered in Tk_GetBitmap");
+ }
+ bitmapPtr->nextPtr = existingBitmapPtr;
+ Tcl_SetHashValue(nameHashPtr, bitmapPtr);
+ Tcl_SetHashValue(bitmapPtr->idHashPtr, bitmapPtr);
+ return bitmapPtr;
+
+ error:
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DefineBitmap --
+ *
+ * This procedure associates a textual name with a binary bitmap
+ * description, so that the name may be used to refer to the
+ * bitmap in future calls to Tk_GetBitmap.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs then TCL_ERROR is
+ * returned and a message is left in the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_DefineBitmap(interp, name, source, width, height)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ CONST char *name; /* Name to use for bitmap. Must not already
+ * be defined as a bitmap. */
+ CONST char *source; /* Address of bits for bitmap. */
+ int width; /* Width of bitmap. */
+ int height; /* Height of bitmap. */
+{
+ int new;
+ Tcl_HashEntry *predefHashPtr;
+ TkPredefBitmap *predefPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Initialize the Bitmap module if not initialized already for this
+ * thread. Since the current TkDisplay structure cannot be
+ * introspected from here, pass a NULL pointer to BitmapInit,
+ * which will know to initialize only the data in the
+ * ThreadSpecificData structure for the current thread.
+ */
+
+ if (!tsdPtr->initialized) {
+ BitmapInit((TkDisplay *) NULL);
+ }
+
+ predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable,
+ name, &new);
+ if (!new) {
+ Tcl_AppendResult(interp, "bitmap \"", name,
+ "\" is already defined", (char *) NULL);
+ return TCL_ERROR;
+ }
+ predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
+ predefPtr->source = source;
+ predefPtr->width = width;
+ predefPtr->height = height;
+ predefPtr->native = 0;
+ Tcl_SetHashValue(predefHashPtr, predefPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfBitmap --
+ *
+ * Given a bitmap, return a textual string identifying the
+ * bitmap.
+ *
+ * Results:
+ * The return value is the string name associated with bitmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfBitmap(display, bitmap)
+ Display *display; /* Display for which bitmap was
+ * allocated. */
+ Pixmap bitmap; /* Bitmap whose name is wanted. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkBitmap *bitmapPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (dispPtr == NULL || !dispPtr->bitmapInit) {
+ unknown:
+ panic("Tk_NameOfBitmap received unknown bitmap argument");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ goto unknown;
+ }
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
+ return bitmapPtr->nameHashPtr->key.string;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SizeOfBitmap --
+ *
+ * Given a bitmap managed by this module, returns the width
+ * and height of the bitmap.
+ *
+ * Results:
+ * The words at *widthPtr and *heightPtr are filled in with
+ * the dimenstions of bitmap.
+ *
+ * Side effects:
+ * If bitmap isn't managed by this module then the procedure
+ * panics..
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr)
+ Display *display; /* Display for which bitmap was
+ * allocated. */
+ Pixmap bitmap; /* Bitmap whose size is wanted. */
+ int *widthPtr; /* Store bitmap width here. */
+ int *heightPtr; /* Store bitmap height here. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkBitmap *bitmapPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->bitmapInit) {
+ unknownBitmap:
+ panic("Tk_SizeOfBitmap received unknown bitmap argument");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ goto unknownBitmap;
+ }
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
+ *widthPtr = bitmapPtr->width;
+ *heightPtr = bitmapPtr->height;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeBitmap --
+ *
+ * This procedure does all the work of releasing a bitmap allocated by
+ * Tk_GetBitmap or TkGetBitmapFromData. It is invoked by both
+ * Tk_FreeBitmap and Tk_FreeBitmapFromObj
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with bitmap is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeBitmap(bitmapPtr)
+ TkBitmap *bitmapPtr; /* Bitmap to be released. */
+{
+ TkBitmap *prevPtr;
+
+ bitmapPtr->resourceRefCount--;
+ if (bitmapPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap);
+ Tcl_DeleteHashEntry(bitmapPtr->idHashPtr);
+ prevPtr = (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr);
+ if (prevPtr == bitmapPtr) {
+ if (bitmapPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(bitmapPtr->nameHashPtr);
+ } else {
+ Tcl_SetHashValue(bitmapPtr->nameHashPtr, bitmapPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != bitmapPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = bitmapPtr->nextPtr;
+ }
+ if (bitmapPtr->objRefCount == 0) {
+ ckfree((char *) bitmapPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeBitmap --
+ *
+ * This procedure is called to release a bitmap allocated by
+ * Tk_GetBitmap or TkGetBitmapFromData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with bitmap is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeBitmap(display, bitmap)
+ Display *display; /* Display for which bitmap was
+ * allocated. */
+ Pixmap bitmap; /* Bitmap to be released. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->bitmapInit) {
+ panic("Tk_FreeBitmap called before Tk_GetBitmap");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeBitmap received unknown bitmap argument");
+ }
+ FreeBitmap((TkBitmap *) Tcl_GetHashValue(idHashPtr));
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeBitmapFromObj --
+ *
+ * This procedure is called to release a bitmap allocated by
+ * Tk_AllocBitmapFromObj. It does not throw away the Tcl_Obj *;
+ * it only gets rid of the hash table entry for this bitmap
+ * and clears the cached value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the bitmap represented by
+ * objPtr is decremented, and the bitmap is released to X if there are
+ * no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeBitmapFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this bitmap lives in. Needed
+ * for the display value. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ FreeBitmap(GetBitmapFromObj(tkwin, objPtr));
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeBitmapObjProc --
+ *
+ * This proc is called to release an object reference to a bitmap.
+ * Called when the object's internal rep is released or when
+ * the cached bitmapPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the color's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeBitmapObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkBitmap *bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (bitmapPtr != NULL) {
+ bitmapPtr->objRefCount--;
+ if ((bitmapPtr->objRefCount == 0)
+ && (bitmapPtr->resourceRefCount == 0)) {
+ ckfree((char *) bitmapPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupBitmapObjProc --
+ *
+ * When a cached bitmap object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The color's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupBitmapObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkBitmap *bitmapPtr = (TkBitmap *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+
+ if (bitmapPtr != NULL) {
+ bitmapPtr->objRefCount++;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmapFromData --
+ *
+ * Given a description of the bits for a bitmap, make a bitmap that
+ * has the given properties. *** NOTE: this procedure is obsolete
+ * and really shouldn't be used anymore. ***
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (a one-plane Pixmap), unless it couldn't be created properly.
+ * In this case, None is returned and an error message is left in
+ * the interp's result. The caller should never modify the bitmap that
+ * is returned, and should eventually call Tk_FreeBitmap when the
+ * bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+Pixmap
+Tk_GetBitmapFromData(interp, tkwin, source, width, height)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which bitmap will be used. */
+ CONST char *source; /* Bitmap data for bitmap shape. */
+ int width, height; /* Dimensions of bitmap. */
+{
+ DataKey nameKey;
+ Tcl_HashEntry *dataHashPtr;
+ int new;
+ char string[16 + TCL_INTEGER_SPACE];
+ char *name;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ BitmapInit(dispPtr);
+
+ nameKey.source = source;
+ nameKey.width = width;
+ nameKey.height = height;
+ dataHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapDataTable,
+ (char *) &nameKey, &new);
+ if (!new) {
+ name = (char *) Tcl_GetHashValue(dataHashPtr);
+ } else {
+ dispPtr->bitmapAutoNumber++;
+ sprintf(string, "_tk%d", dispPtr->bitmapAutoNumber);
+ name = string;
+ Tcl_SetHashValue(dataHashPtr, name);
+ if (Tk_DefineBitmap(interp, name, source, width, height) != TCL_OK) {
+ Tcl_DeleteHashEntry(dataHashPtr);
+ return TCL_ERROR;
+ }
+ }
+ return Tk_GetBitmap(interp, tkwin, name);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmapFromObj --
+ *
+ * Returns the bitmap referred to by a Tcl object. The bitmap must
+ * already have been allocated via a call to Tk_AllocBitmapFromObj
+ * or Tk_GetBitmap.
+ *
+ * Results:
+ * Returns the Pixmap that matches the tkwin and the string rep
+ * of objPtr.
+ *
+ * Side effects:
+ * If the object is not already a bitmap, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetBitmapFromObj(tkwin, objPtr)
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get pixels. */
+{
+ TkBitmap *bitmapPtr = GetBitmapFromObj(tkwin, objPtr);
+ return bitmapPtr->bitmap;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBitmapFromObj --
+ *
+ * Returns the bitmap referred to by a Tcl object. The bitmap must
+ * already have been allocated via a call to Tk_AllocBitmapFromObj
+ * or Tk_GetBitmap.
+ *
+ * Results:
+ * Returns the TkBitmap * that matches the tkwin and the string rep
+ * of objPtr.
+ *
+ * Side effects:
+ * If the object is not already a bitmap, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkBitmap *
+GetBitmapFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* Window in which the bitmap will be used. */
+ Tcl_Obj *objPtr; /* The object that describes the desired
+ * bitmap. */
+{
+ TkBitmap *bitmapPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkBitmapObjType) {
+ InitBitmapObj(objPtr);
+ }
+
+ bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
+ if (bitmapPtr != NULL) {
+ if ((bitmapPtr->resourceRefCount > 0)
+ && (Tk_Display(tkwin) == bitmapPtr->display)) {
+ return bitmapPtr;
+ }
+ hashPtr = bitmapPtr->nameHashPtr;
+ FreeBitmapObjProc(objPtr);
+ } else {
+ hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable,
+ Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ }
+
+ /*
+ * At this point we've got a hash table entry, off of which hang
+ * one or more TkBitmap structures. See if any of them will work.
+ */
+
+ for (bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr);
+ bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) {
+ if (Tk_Display(tkwin) == bitmapPtr->display) {
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ bitmapPtr->objRefCount++;
+ return bitmapPtr;
+ }
+ }
+
+ error:
+ panic("GetBitmapFromObj called with non-existent bitmap!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitBitmapObj --
+ *
+ * Bookeeping procedure to change an objPtr to a bitmap type.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old internal rep of the object is freed. The internal
+ * rep is cleared. The final form of the object is set
+ * by either Tk_AllocBitmapFromObj or GetBitmapFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitBitmapObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkBitmapObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * BitmapInit --
+ * Initializes hash tables used by this module. Initializes
+ * tables stored in TkDisplay structure if a TkDisplay pointer
+ * is passed in. Iinitializes the thread-local data
+ * in the current thread's ThreadSpecificData structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BitmapInit(dispPtr)
+ TkDisplay *dispPtr; /* TkDisplay structure encapsulating
+ * thread-specific data used by this
+ * module, or NULL if unavailable. */
+{
+ Tcl_Interp *dummy;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * First initialize the data in the ThreadSpecificData strucuture,
+ * if needed.
+ */
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ dummy = Tcl_CreateInterp();
+ Tcl_InitHashTable(&tsdPtr->predefBitmapTable, TCL_STRING_KEYS);
+
+ Tk_DefineBitmap(dummy, "error", (char *) error_bits,
+ error_width, error_height);
+ Tk_DefineBitmap(dummy, "gray75", (char *) gray75_bits,
+ gray75_width, gray75_height);
+ Tk_DefineBitmap(dummy, "gray50", (char *) gray50_bits,
+ gray50_width, gray50_height);
+ Tk_DefineBitmap(dummy, "gray25", (char *) gray25_bits,
+ gray25_width, gray25_height);
+ Tk_DefineBitmap(dummy, "gray12", (char *) gray12_bits,
+ gray12_width, gray12_height);
+ Tk_DefineBitmap(dummy, "hourglass", (char *) hourglass_bits,
+ hourglass_width, hourglass_height);
+ Tk_DefineBitmap(dummy, "info", (char *) info_bits,
+ info_width, info_height);
+ Tk_DefineBitmap(dummy, "questhead", (char *) questhead_bits,
+ questhead_width, questhead_height);
+ Tk_DefineBitmap(dummy, "question", (char *) question_bits,
+ question_width, question_height);
+ Tk_DefineBitmap(dummy, "warning", (char *) warning_bits,
+ warning_width, warning_height);
+
+ TkpDefineNativeBitmaps();
+ Tcl_DeleteInterp(dummy);
+ }
+
+ /*
+ * Was a valid TkDisplay pointer passed? If so, initialize the
+ * Bitmap module tables in that structure.
+ */
+
+ if (dispPtr != NULL) {
+ dispPtr->bitmapInit = 1;
+ Tcl_InitHashTable(&dispPtr->bitmapNameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->bitmapDataTable, sizeof(DataKey)
+ /sizeof(int));
+
+ /*
+ * The call below is tricky: can't use sizeof(IdKey) because it
+ * gets padded with extra unpredictable bytes on some 64-bit
+ * machines.
+ */
+
+ /*
+ * The comment above doesn't make sense...
+ */
+ Tcl_InitHashTable(&dispPtr->bitmapIdTable, TCL_ONE_WORD_KEYS);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkReadBitmapFile --
+ *
+ * Loads a bitmap image in X bitmap format into the specified
+ * drawable. This is equivelent to the XReadBitmapFile in X.
+ *
+ * Results:
+ * Sets the size, hotspot, and bitmap on success.
+ *
+ * Side effects:
+ * Creates a new bitmap from the file data.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkReadBitmapFile(display, d, filename, width_return, height_return,
+ bitmap_return, x_hot_return, y_hot_return)
+ Display* display;
+ Drawable d;
+ CONST char* filename;
+ unsigned int* width_return;
+ unsigned int* height_return;
+ Pixmap* bitmap_return;
+ int* x_hot_return;
+ int* y_hot_return;
+{
+ char *data;
+
+ data = TkGetBitmapData(NULL, NULL, (char *) filename,
+ (int *) width_return, (int *) height_return, x_hot_return,
+ y_hot_return);
+ if (data == NULL) {
+ return BitmapFileInvalid;
+ }
+
+ *bitmap_return = XCreateBitmapFromData(display, d, data, *width_return,
+ *height_return);
+
+ ckfree(data);
+ return BitmapSuccess;
+ }
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugBitmap --
+ *
+ * This procedure returns debugging information about a bitmap.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkBitmap
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkBitmap structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugBitmap(tkwin, name)
+ Tk_Window tkwin; /* The window in which the bitmap will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkBitmap *bitmapPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, name);
+ if (hashPtr != NULL) {
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr);
+ if (bitmapPtr == NULL) {
+ panic("TkDebugBitmap found empty hash table entry");
+ }
+ for ( ; (bitmapPtr != NULL); bitmapPtr = bitmapPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(bitmapPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(bitmapPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetBitmapPredefTable --
+ * This procedure is used by tkMacBitmap.c to access the thread-
+ * specific predefBitmap table that maps from the names of
+ * the predefined bitmaps to data associated with those
+ * bitmaps. It is required because the table is allocated in
+ * thread-local storage and is not visible outside this file.
+
+ * Results:
+ * Returns a pointer to the predefined bitmap hash table for
+ * the current thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_HashTable *
+TkGetBitmapPredefTable()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return &tsdPtr->predefBitmapTable;
+}
--- /dev/null
+/*
+ * tkButton.c --
+ *
+ * This module implements a collection of button-like
+ * widgets for the Tk toolkit. The widgets implemented
+ * include labels, buttons, checkbuttons, and radiobuttons.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkButton.h"
+#include "default.h"
+
+typedef struct ThreadSpecificData {
+ int defaultsInitialized;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Class names for buttons, indexed by one of the type values defined
+ * in tkButton.h.
+ */
+
+static char *classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"};
+
+/*
+ * The following table defines the legal values for the -default option.
+ * It is used together with the "enum defaultValue" declaration in tkButton.h.
+ */
+
+static char *defaultStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -state option.
+ * It is used together with the "enum state" declaration in tkButton.h.
+ */
+
+static char *stateStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -compound option.
+ * It is used with the "enum compound" declaration in tkButton.h
+ */
+
+static char *compoundStrings[] = {
+ "bottom", "center", "left", "none", "right", "top", (char *) NULL
+};
+
+/*
+ * Information used for parsing configuration options. There is a
+ * separate table for each of the four widget classes.
+ */
+
+static Tk_OptionSpec labelOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_BUTTON_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_LABEL_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, 0}
+};
+
+static Tk_OptionSpec buttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_BUTTON_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-default", "default", "Default",
+ DEF_BUTTON_DEFAULT, -1, Tk_Offset(TkButton, defaultState),
+ 0, (ClientData) defaultStrings, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_BUTTON_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_BUTTON_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, relief),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_BUTTON_REPEAT_DELAY, -1, Tk_Offset(TkButton, repeatDelay),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_BUTTON_REPEAT_INTERVAL, -1, Tk_Offset(TkButton, repeatInterval),
+ 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+static Tk_OptionSpec checkbuttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn), 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-offrelief", "offRelief", "OffRelief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, offRelief), 0, 0, 0},
+ {TK_OPTION_STRING, "-offvalue", "offValue", "Value",
+ DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-onvalue", "onValue", "Value",
+ DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background",
+ DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0},
+ {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage",
+ DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+static Tk_OptionSpec radiobuttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn),
+ 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-offrelief", "offRelief", "OffRelief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, offRelief), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background",
+ DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0},
+ {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage",
+ DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-value", "value", "Value",
+ DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1,
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following table maps from one of the type values defined in
+ * tkButton.h, such as TYPE_LABEL, to the option template for that
+ * class of widgets.
+ */
+
+static Tk_OptionSpec *optionSpecs[] = {
+ labelOptionSpecs,
+ buttonOptionSpecs,
+ checkbuttonOptionSpecs,
+ radiobuttonOptionSpecs
+};
+
+/*
+ * The following tables define the widget commands supported by
+ * each of the classes, and map the indexes into the string tables
+ * into a single enumerated type used to dispatch the widget command.
+ */
+
+static CONST char *commandNames[][8] = {
+ {"cget", "configure", (char *) NULL},
+ {"cget", "configure", "flash", "invoke", (char *) NULL},
+ {"cget", "configure", "deselect", "flash", "invoke", "select",
+ "toggle", (char *) NULL},
+ {"cget", "configure", "deselect", "flash", "invoke", "select",
+ (char *) NULL}
+};
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE
+};
+static enum command map[][8] = {
+ {COMMAND_CGET, COMMAND_CONFIGURE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_FLASH, COMMAND_INVOKE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ButtonCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ButtonCreate _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], int type));
+static void ButtonEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void ButtonImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight));
+static void ButtonSelectImageProc _ANSI_ARGS_((
+ ClientData clientData, int x, int y, int width,
+ int height, int imgWidth, int imgHeight));
+static char * ButtonTextVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static char * ButtonVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static int ButtonWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ConfigureButton _ANSI_ARGS_((Tcl_Interp *interp,
+ TkButton *butPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static void DestroyButton _ANSI_ARGS_((TkButton *butPtr));
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ButtonCmd, Tk_CheckbuttonCmd, Tk_LabelCmd, Tk_RadiobuttonCmd --
+ *
+ * These procedures are invoked to process the "button", "label",
+ * "radiobutton", and "checkbutton" Tcl commands. See the
+ * user documentation for details on what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation. These procedures are just wrappers;
+ * they call ButtonCreate to do all of the real work.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ButtonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_BUTTON);
+}
+
+int
+Tk_CheckbuttonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_CHECK_BUTTON);
+}
+
+int
+Tk_LabelObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_LABEL);
+}
+
+int
+Tk_RadiobuttonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_RADIO_BUTTON);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonCreate --
+ *
+ * This procedure does all the real work of implementing 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ButtonCreate(clientData, interp, objc, objv, type)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+ int type; /* Type of button to create: TYPE_LABEL,
+ * TYPE_BUTTON, TYPE_CHECK_BUTTON, or
+ * TYPE_RADIO_BUTTON. */
+{
+ TkButton *butPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->defaultsInitialized) {
+ TkpButtonSetDefaults(optionSpecs[type]);
+ tsdPtr->defaultsInitialized = 1;
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the new window.
+ */
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]);
+
+ Tk_SetClass(tkwin, classNames[type]);
+ butPtr = TkpCreateButton(tkwin);
+
+ Tk_SetClassProcs(tkwin, &tkpButtonProcs, (ClientData) butPtr);
+
+ /*
+ * Initialize the data structure for the button.
+ */
+
+ butPtr->tkwin = tkwin;
+ butPtr->display = Tk_Display(tkwin);
+ butPtr->interp = interp;
+ butPtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin),
+ ButtonWidgetObjCmd, (ClientData) butPtr, ButtonCmdDeletedProc);
+ butPtr->type = type;
+ butPtr->optionTable = optionTable;
+ butPtr->textPtr = NULL;
+ butPtr->underline = -1;
+ butPtr->textVarNamePtr = NULL;
+ butPtr->bitmap = None;
+ butPtr->imagePtr = NULL;
+ butPtr->image = NULL;
+ butPtr->selectImagePtr = NULL;
+ butPtr->selectImage = NULL;
+ butPtr->state = STATE_NORMAL;
+ butPtr->normalBorder = NULL;
+ butPtr->activeBorder = NULL;
+ butPtr->borderWidthPtr = NULL;
+ butPtr->borderWidth = 0;
+ butPtr->relief = TK_RELIEF_FLAT;
+ butPtr->highlightWidthPtr = NULL;
+ butPtr->highlightWidth = 0;
+ butPtr->highlightBorder = NULL;
+ butPtr->highlightColorPtr = NULL;
+ butPtr->inset = 0;
+ butPtr->tkfont = NULL;
+ butPtr->normalFg = NULL;
+ butPtr->activeFg = NULL;
+ butPtr->disabledFg = NULL;
+ butPtr->normalTextGC = None;
+ butPtr->activeTextGC = None;
+ butPtr->disabledGC = None;
+ butPtr->gray = None;
+ butPtr->copyGC = None;
+ butPtr->widthPtr = NULL;
+ butPtr->width = 0;
+ butPtr->heightPtr = NULL;
+ butPtr->height = 0;
+ butPtr->wrapLengthPtr = NULL;
+ butPtr->wrapLength = 0;
+ butPtr->padXPtr = NULL;
+ butPtr->padX = 0;
+ butPtr->padYPtr = NULL;
+ butPtr->padY = 0;
+ butPtr->anchor = TK_ANCHOR_CENTER;
+ butPtr->justify = TK_JUSTIFY_CENTER;
+ butPtr->indicatorOn = 0;
+ butPtr->selectBorder = NULL;
+ butPtr->textWidth = 0;
+ butPtr->textHeight = 0;
+ butPtr->textLayout = NULL;
+ butPtr->indicatorSpace = 0;
+ butPtr->indicatorDiameter = 0;
+ butPtr->defaultState = DEFAULT_DISABLED;
+ butPtr->selVarNamePtr = NULL;
+ butPtr->onValuePtr = NULL;
+ butPtr->offValuePtr = NULL;
+ butPtr->cursor = None;
+ butPtr->takeFocusPtr = NULL;
+ butPtr->commandPtr = NULL;
+ butPtr->flags = 0;
+
+ Tk_CreateEventHandler(butPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ButtonEventProc, (ClientData) butPtr);
+
+ if (Tk_InitOptions(interp, (char *) butPtr, optionTable, tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ return TCL_ERROR;
+ }
+ if (ConfigureButton(interp, butPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(butPtr->tkwin),
+ -1);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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
+ButtonWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about button widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ int index;
+ int result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames[butPtr->type],
+ "option", 0, &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_Preserve((ClientData) butPtr);
+
+ switch (map[butPtr->type][index]) {
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) butPtr,
+ butPtr->optionTable, objv[2], butPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+
+ case COMMAND_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) butPtr,
+ butPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ butPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureButton(interp, butPtr, objc-2, objv+2);
+ }
+ break;
+ }
+
+ case COMMAND_DESELECT: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "deselect");
+ goto error;
+ }
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ } else if (butPtr->flags & SELECTED) {
+ if (Tcl_ObjSetVar2(interp,
+ butPtr->selVarNamePtr, NULL, Tcl_NewObj(),
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ }
+ break;
+ }
+
+ case COMMAND_FLASH: {
+ int i;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "flash");
+ goto error;
+ }
+ if (butPtr->state != STATE_DISABLED) {
+ for (i = 0; i < 4; i++) {
+ if (butPtr->state == STATE_NORMAL) {
+ butPtr->state = STATE_ACTIVE;
+ Tk_SetBackgroundFromBorder(butPtr->tkwin,
+ butPtr->activeBorder);
+ } else {
+ butPtr->state = STATE_NORMAL;
+ Tk_SetBackgroundFromBorder(butPtr->tkwin,
+ butPtr->normalBorder);
+ }
+ TkpDisplayButton((ClientData) butPtr);
+
+ /*
+ * Special note: must cancel any existing idle handler
+ * for TkpDisplayButton; it's no longer needed, and
+ * TkpDisplayButton cleared the REDRAW_PENDING flag.
+ */
+
+ Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
+ XFlush(butPtr->display);
+ Tcl_Sleep(50);
+ }
+ }
+ break;
+ }
+
+ case COMMAND_INVOKE: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+ goto error;
+ }
+ if (butPtr->state != STATE_DISABLED) {
+ result = TkInvokeButton(butPtr);
+ }
+ break;
+ }
+
+ case COMMAND_SELECT: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "select");
+ goto error;
+ }
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ break;
+ }
+
+ case COMMAND_TOGGLE: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "toggle");
+ goto error;
+ }
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ (butPtr->flags & SELECTED) ? butPtr->offValuePtr
+ : butPtr->onValuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ break;
+ }
+ }
+ Tcl_Release((ClientData) butPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) butPtr);
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyButton --
+ *
+ * This procedure is invoked by ButtonEventProc to free all the
+ * resources of a button and clean up its state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the widget is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyButton(butPtr)
+ TkButton *butPtr; /* Info about button widget. */
+{
+ butPtr->flags |= BUTTON_DELETED;
+ TkpDestroyButton(butPtr);
+
+ if (butPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd);
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->textVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+ if (butPtr->image != NULL) {
+ Tk_FreeImage(butPtr->image);
+ }
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
+ }
+ if (butPtr->normalTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
+ }
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ if (butPtr->disabledGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ }
+ if (butPtr->gray != None) {
+ Tk_FreeBitmap(butPtr->display, butPtr->gray);
+ }
+ if (butPtr->copyGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->copyGC);
+ }
+ if (butPtr->textLayout != NULL) {
+ Tk_FreeTextLayout(butPtr->textLayout);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->selVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+ Tk_FreeConfigOptions((char *) butPtr, butPtr->optionTable,
+ butPtr->tkwin);
+ butPtr->tkwin = NULL;
+ Tcl_EventuallyFree((ClientData) butPtr, TCL_DYNAMIC);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureButton --
+ *
+ * This procedure is called to process an objc/objv list to set
+ * configuration options for a button widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then an error message is left in interp's result.
+ *
+ * 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, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkButton *butPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error, haveImage;
+ Tk_Image image;
+
+ /*
+ * Eliminate any existing trace on variables monitored by the button.
+ */
+
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_UntraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_UntraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+
+ /*
+ * The following loop is potentially executed twice. During the
+ * first pass configuration options get set to their new values.
+ * If there is an error in this pass, we execute a second pass
+ * to restore all the options to their previous values.
+ */
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) butPtr,
+ butPtr->optionTable, objc, objv,
+ butPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * 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_SetOptions.
+ */
+
+ if ((butPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(butPtr->tkwin)) {
+ Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder);
+ } else {
+ Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder);
+ }
+ if (butPtr->borderWidth < 0) {
+ butPtr->borderWidth = 0;
+ }
+ if (butPtr->highlightWidth < 0) {
+ butPtr->highlightWidth = 0;
+ }
+ if (butPtr->padX < 0) {
+ butPtr->padX = 0;
+ }
+ if (butPtr->padY < 0) {
+ butPtr->padY = 0;
+ }
+
+ if (butPtr->type >= TYPE_CHECK_BUTTON) {
+ Tcl_Obj *valuePtr, *namePtr;
+
+ if (butPtr->selVarNamePtr == NULL) {
+ butPtr->selVarNamePtr = Tcl_NewStringObj(
+ Tk_Name(butPtr->tkwin), -1);
+ Tcl_IncrRefCount(butPtr->selVarNamePtr);
+ }
+ namePtr = butPtr->selVarNamePtr;
+
+ /*
+ * 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.
+ */
+
+ valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
+ butPtr->flags &= ~SELECTED;
+ if (valuePtr != NULL) {
+ if (strcmp(Tcl_GetString(valuePtr),
+ Tcl_GetString(butPtr->onValuePtr)) == 0) {
+ butPtr->flags |= SELECTED;
+ }
+ } else {
+ if (Tcl_ObjSetVar2(interp, namePtr, NULL,
+ (butPtr->type == TYPE_CHECK_BUTTON)
+ ? butPtr->offValuePtr : Tcl_NewObj(),
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ continue;
+ }
+
+ /*
+ * If a radiobutton has the empty string as value
+ * it should be selected.
+ */
+
+ if ((butPtr->type == TYPE_RADIO_BUTTON) &&
+ (*Tcl_GetString(butPtr->onValuePtr) == 0)) {
+ butPtr->flags |= SELECTED;
+ }
+ }
+ }
+
+ /*
+ * Get the images for the widget, if there are any. Allocate the
+ * new images before freeing the old ones, so that the reference
+ * counts don't go to zero and cause image data to be discarded.
+ */
+
+ if (butPtr->imagePtr != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ Tcl_GetString(butPtr->imagePtr), ButtonImageProc,
+ (ClientData) butPtr);
+ if (image == NULL) {
+ continue;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->image != NULL) {
+ Tk_FreeImage(butPtr->image);
+ }
+ butPtr->image = image;
+ if (butPtr->selectImagePtr != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ Tcl_GetString(butPtr->selectImagePtr),
+ ButtonSelectImageProc, (ClientData) butPtr);
+ if (image == NULL) {
+ continue;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
+ }
+ butPtr->selectImage = image;
+
+ haveImage = 0;
+ if (butPtr->imagePtr != NULL || butPtr->bitmap != None) {
+ haveImage = 1;
+ }
+ if ((!haveImage || butPtr->compound != COMPOUND_NONE)
+ && (butPtr->textVarNamePtr != NULL)) {
+ /*
+ * The button must display the value of a variable: set up a trace
+ * on the variable's value, create the variable if it doesn't
+ * exist, and fetch its current value.
+ */
+
+ Tcl_Obj *valuePtr, *namePtr;
+
+ namePtr = butPtr->textVarNamePtr;
+ valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ if (Tcl_ObjSetVar2(interp, namePtr, NULL, butPtr->textPtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ continue;
+ }
+ } else {
+ if (butPtr->textPtr != NULL) {
+ Tcl_DecrRefCount(butPtr->textPtr);
+ }
+ butPtr->textPtr = valuePtr;
+ Tcl_IncrRefCount(butPtr->textPtr);
+ }
+ }
+
+ if ((butPtr->bitmap != None) || (butPtr->imagePtr != NULL)) {
+ /*
+ * The button must display the contents of an image or
+ * bitmap.
+ */
+
+ if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->widthPtr,
+ &butPtr->width) != TCL_OK) {
+ widthError:
+ Tcl_AddErrorInfo(interp, "\n (processing -width option)");
+ continue;
+ }
+ if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->heightPtr,
+ &butPtr->height) != TCL_OK) {
+ heightError:
+ Tcl_AddErrorInfo(interp, "\n (processing -height option)");
+ continue;
+ }
+ } else {
+ /*
+ * The button displays an ordinary text string.
+ */
+
+ if (Tcl_GetIntFromObj(interp, butPtr->widthPtr, &butPtr->width)
+ != TCL_OK) {
+ goto widthError;
+ }
+ if (Tcl_GetIntFromObj(interp, butPtr->heightPtr, &butPtr->height)
+ != TCL_OK) {
+ goto heightError;
+ }
+ }
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * Reestablish the variable traces, if they're needed.
+ */
+
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_TraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_TraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+
+ TkButtonWorldChanged((ClientData) butPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkButtonWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Button will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkButtonWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ TkButton *butPtr;
+
+ butPtr = (TkButton *) instanceData;
+
+ /*
+ * Recompute GCs.
+ */
+
+ gcValues.font = Tk_FontId(butPtr->tkfont);
+ gcValues.foreground = butPtr->normalFg->pixel;
+ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
+
+ /*
+ * Note: GraphicsExpose events are disabled in normalTextGC because it's
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->normalTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
+ }
+ butPtr->normalTextGC = newGC;
+
+ if (butPtr->activeFg != NULL) {
+ gcValues.foreground = butPtr->activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ butPtr->activeTextGC = newGC;
+ }
+
+ /*
+ * Allocate the disabled graphics context, for drawing the widget in
+ * its disabled state
+ */
+ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
+ if ((butPtr->disabledFg != NULL) && (butPtr->imagePtr == NULL)) {
+ gcValues.foreground = butPtr->disabledFg->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ } else {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (butPtr->compound != COMPOUND_NONE) {
+ mask |= GCFont;
+ }
+ if (butPtr->gray == None) {
+ butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin, "gray50");
+ }
+ if (butPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = butPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ }
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->disabledGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ }
+ butPtr->disabledGC = newGC;
+
+ if (butPtr->copyGC == None) {
+ butPtr->copyGC = Tk_GetGC(butPtr->tkwin, 0, &gcValues);
+ }
+
+ TkpComputeButtonGeometry(butPtr);
+
+ /*
+ * Lastly, arrange for the button to be redisplayed.
+ */
+
+ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonEventProc --
+ *
+ * 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
+ButtonEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ /*
+ * Must redraw after size changes, since layout could have changed
+ * and borders will need to be redrawn.
+ */
+
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ DestroyButton(butPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ butPtr->flags |= GOT_FOCUS;
+ if (butPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ butPtr->flags &= ~GOT_FOCUS;
+ if (butPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((butPtr->tkwin != NULL) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted or because the command
+ * was deleted, and then this procedure destroys the widget. The
+ * BUTTON_DELETED flag distinguishes these cases.
+ */
+
+ if (!(butPtr->flags & BUTTON_DELETED)) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInvokeButton --
+ *
+ * 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
+ * the interp's result.
+ *
+ * Side effects:
+ * Depends on the button and its associated command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkInvokeButton(butPtr)
+ TkButton *butPtr; /* Information about button. */
+{
+ Tcl_Obj *namePtr = butPtr->selVarNamePtr;
+
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ if (butPtr->flags & SELECTED) {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
+ butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
+ butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ } else if (butPtr->type == TYPE_RADIO_BUTTON) {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL, butPtr->onValuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if ((butPtr->type != TYPE_LABEL) && (butPtr->commandPtr != NULL)) {
+ return Tcl_EvalObjEx(butPtr->interp, butPtr->commandPtr,
+ TCL_EVAL_GLOBAL);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ButtonVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ CONST char *name1; /* Name of variable. */
+ CONST char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+ char *name, *value;
+ Tcl_Obj *valuePtr;
+
+ name = Tcl_GetString(butPtr->selVarNamePtr);
+
+ /*
+ * 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_TraceVar(interp, name,
+ 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.
+ */
+
+ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ value = "";
+ } else {
+ value = Tcl_GetString(valuePtr);
+ }
+ if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 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->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ButtonTextVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ CONST char *name1; /* Not used. */
+ CONST char *name2; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ char *name;
+ Tcl_Obj *valuePtr;
+
+ if (butPtr->flags & BUTTON_DELETED) {
+ return (char *) NULL;
+ }
+
+ name = Tcl_GetString(butPtr->textVarNamePtr);
+
+ /*
+ * 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_SetVar2Ex(interp, name, NULL, butPtr->textPtr,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
+ }
+ Tcl_DecrRefCount(butPtr->textPtr);
+ butPtr->textPtr = valuePtr;
+ Tcl_IncrRefCount(butPtr->textPtr);
+ TkpComputeButtonGeometry(butPtr);
+
+ if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonImageProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the size or contents
+ * of an image displayed in a button.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+
+ if (butPtr->tkwin != NULL) {
+ TkpComputeButtonGeometry(butPtr);
+ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonSelectImageProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the size or contents
+ * of the image displayed in a button when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May arrange for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonSelectImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+
+ /*
+ * Don't recompute geometry: it's controlled by the primary image.
+ */
+
+ if ((butPtr->flags & SELECTED) && (butPtr->tkwin != NULL)
+ && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
--- /dev/null
+/*
+ * tkCanvArc.c --
+ *
+ * This file implements arc items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkCanvas.h"
+/*
+ * The structure below defines the record for each arc item.
+ */
+
+typedef enum {
+ PIESLICE_STYLE, CHORD_STYLE, ARC_STYLE
+} Style;
+
+typedef struct ArcItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ double bbox[4]; /* Coordinates (x1, y1, x2, y2) of bounding
+ * box for oval of which arc is a piece. */
+ double start; /* Angle at which arc begins, in degrees
+ * between 0 and 360. */
+ double extent; /* Extent of arc (angular distance from
+ * start to end of arc) in degrees between
+ * -360 and 360. */
+ double *outlinePtr; /* Points to (x,y) coordinates for points
+ * that define one or two closed polygons
+ * representing the portion of the outline
+ * that isn't part of the arc (the V-shape
+ * for a pie slice or a line-like segment
+ * for a chord). Malloc'ed. */
+ int numOutlinePoints; /* Number of points at outlinePtr. Zero
+ * means no space allocated. */
+ Tk_TSOffset tsoffset;
+ XColor *fillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc"). NULL
+ * means don't fill arc. */
+ XColor *activeFillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc" and state
+ * is "active"). NULL means use fillColor. */
+ XColor *disabledFillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc" and state
+ * is "disabled". NULL means use fillColor */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ Pixmap activeFillStipple; /* Stipple bitmap for filling item if state
+ * is active. */
+ Pixmap disabledFillStipple; /* Stipple bitmap for filling item if state
+ * is disabled. */
+ Style style; /* How to draw arc: arc, chord, or pieslice. */
+ GC fillGC; /* Graphics context for filling item. */
+ double center1[2]; /* Coordinates of center of arc outline at
+ * start (see ComputeArcOutline). */
+ double center2[2]; /* Coordinates of center of arc outline at
+ * start+extent (see ComputeArcOutline). */
+} ArcItem;
+
+/*
+ * The definitions below define the sizes of the polygons used to
+ * display outline information for various styles of arcs:
+ */
+
+#define CHORD_OUTLINE_PTS 7
+#define PIE_OUTLINE1_PTS 6
+#define PIE_OUTLINE2_PTS 7
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static int StyleParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value,
+ char *widgRec, int offset));
+static char * StylePrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption styleOption = {
+ (Tk_OptionParseProc *) StyleParseProc,
+ StylePrintProc, (ClientData) NULL
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption dashOption = {
+ (Tk_OptionParseProc *) TkCanvasDashParseProc,
+ TkCanvasDashPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc, (ClientData) (TK_OFFSET_RELATIVE)
+};
+static Tk_CustomOption pixelOption = {
+ (Tk_OptionParseProc *) TkPixelParseProc,
+ TkPixelPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, activeFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-activeoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.activeColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activeoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, activeFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-activewidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(ArcItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-dash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(ArcItem, outline.offset), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-disableddash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, disabledFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, disabledFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(ArcItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_DOUBLE, "-extent", (char *) NULL, (char *) NULL,
+ "90", Tk_Offset(ArcItem, extent), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(ArcItem, tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(ArcItem, outline.color), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-outlineoffset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(ArcItem, outline.tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.stipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_DOUBLE, "-start", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(ArcItem, start), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-style", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, style), TK_CONFIG_DONT_SET_DEFAULT,
+ &styleOption},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", (char *) NULL, (char *) NULL,
+ "1.0", Tk_Offset(ArcItem, outline.width), TK_CONFIG_DONT_SET_DEFAULT,
+ &pixelOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeArcBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ ArcItem *arcPtr));
+static int ConfigureArc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateArc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void DeleteArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int ArcCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ArcToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double ArcToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int ArcToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ScaleArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+static int AngleInRange _ANSI_ARGS_((double x, double y,
+ double start, double extent));
+static void ComputeArcOutline _ANSI_ARGS_((Tk_Canvas canvas,
+ ArcItem *arcPtr));
+static int HorizLineToArc _ANSI_ARGS_((double x1, double x2,
+ double y, double rx, double ry,
+ double start, double extent));
+static int VertLineToArc _ANSI_ARGS_((double x, double y1,
+ double y2, double rx, double ry,
+ double start, double extent));
+
+/*
+ * The structures below defines the arc item types by means of procedures
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkArcType = {
+ "arc", /* name */
+ sizeof(ArcItem), /* itemSize */
+ CreateArc, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureArc, /* configureProc */
+ ArcCoords, /* coordProc */
+ DeleteArc, /* deleteProc */
+ DisplayArc, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ ArcToPoint, /* pointProc */
+ ArcToArea, /* areaProc */
+ ArcToPostscript, /* postscriptProc */
+ ScaleArc, /* scaleProc */
+ TranslateArc, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+
+#ifndef PI
+# define PI 3.14159265358979323846
+#endif
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateArc --
+ *
+ * This procedure is invoked to create a new arc item in
+ * a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new arc item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateArc(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing arc. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ int i = 4;
+
+ if (objc == 1) {
+ i = 1;
+ } else if (objc > 1) {
+ char *arg = Tcl_GetString(objv[1]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+
+ if (objc < i) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean
+ * up after errors during the the remainder of this procedure.
+ */
+
+ Tk_CreateOutline(&(arcPtr->outline));
+ arcPtr->start = 0;
+ arcPtr->extent = 90;
+ arcPtr->outlinePtr = NULL;
+ arcPtr->numOutlinePoints = 0;
+ arcPtr->tsoffset.flags = 0;
+ arcPtr->tsoffset.xoffset = 0;
+ arcPtr->tsoffset.yoffset = 0;
+ arcPtr->fillColor = NULL;
+ arcPtr->activeFillColor = NULL;
+ arcPtr->disabledFillColor = NULL;
+ arcPtr->fillStipple = None;
+ arcPtr->activeFillStipple = None;
+ arcPtr->disabledFillStipple = None;
+ arcPtr->style = PIESLICE_STYLE;
+ arcPtr->fillGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((ArcCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureArc(interp, canvas, itemPtr, objc-4, objv+4, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+ error:
+ DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on arcs. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcCoords(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(arcPtr->bbox[0]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(arcPtr->bbox[1]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(arcPtr->bbox[2]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(arcPtr->bbox[3]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if ((objc == 1)||(objc == 4)) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 4) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 4, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
+ &arcPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &arcPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2],
+ &arcPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3],
+ &arcPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeArcBbox(canvas, arcPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArc --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a arc item, such as its outline and fill colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureArc(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Arc item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ int i;
+ Tk_Window tkwin;
+ Tk_TSOffset *tsoffset;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) arcPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ state = itemPtr->state;
+
+ /*
+ * A few of the options require additional processing, such as
+ * style and graphics contexts.
+ */
+
+ if (arcPtr->outline.activeWidth > arcPtr->outline.width ||
+ arcPtr->outline.activeDash.number != 0 ||
+ arcPtr->outline.activeColor != NULL ||
+ arcPtr->outline.activeStipple != None ||
+ arcPtr->activeFillColor != NULL ||
+ arcPtr->activeFillStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ tsoffset = &arcPtr->outline.tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int) ((arcPtr->bbox[0]+arcPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int) ((arcPtr->bbox[1]+arcPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+
+ i = (int) (arcPtr->start/360.0);
+ arcPtr->start -= i*360.0;
+ if (arcPtr->start < 0) {
+ arcPtr->start += 360.0;
+ }
+ i = (int) (arcPtr->extent/360.0);
+ arcPtr->extent -= i*360.0;
+
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr,
+ &(arcPtr->outline));
+ if (mask) {
+ gcValues.cap_style = CapButt;
+ mask |= GCCapStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (arcPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->outline.gc);
+ }
+ arcPtr->outline.gc = newGC;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ ComputeArcBbox(canvas, arcPtr);
+ return TCL_OK;
+ }
+
+ color = arcPtr->fillColor;
+ stipple = arcPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->activeFillColor!=NULL) {
+ color = arcPtr->activeFillColor;
+ }
+ if (arcPtr->activeFillStipple!=None) {
+ stipple = arcPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->disabledFillColor!=NULL) {
+ color = arcPtr->disabledFillColor;
+ }
+ if (arcPtr->disabledFillStipple!=None) {
+ stipple = arcPtr->disabledFillStipple;
+ }
+ }
+
+ if (arcPtr->style == ARC_STYLE) {
+ newGC = None;
+ } else if (color == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = color->pixel;
+ if (arcPtr->style == CHORD_STYLE) {
+ gcValues.arc_mode = ArcChord;
+ } else {
+ gcValues.arc_mode = ArcPieSlice;
+ }
+ mask = GCForeground|GCArcMode;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (arcPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->fillGC);
+ }
+ arcPtr->fillGC = newGC;
+
+ tsoffset = &arcPtr->tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int) ((arcPtr->bbox[0]+arcPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int) ((arcPtr->bbox[1]+arcPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[3] + 0.5);
+ }
+
+ ComputeArcBbox(canvas, arcPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteArc --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a arc item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteArc(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ Tk_DeleteOutline(display, &(arcPtr->outline));
+ if (arcPtr->numOutlinePoints != 0) {
+ ckfree((char *) arcPtr->outlinePtr);
+ }
+ if (arcPtr->fillColor != NULL) {
+ Tk_FreeColor(arcPtr->fillColor);
+ }
+ if (arcPtr->activeFillColor != NULL) {
+ Tk_FreeColor(arcPtr->activeFillColor);
+ }
+ if (arcPtr->disabledFillColor != NULL) {
+ Tk_FreeColor(arcPtr->disabledFillColor);
+ }
+ if (arcPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->fillStipple);
+ }
+ if (arcPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->activeFillStipple);
+ }
+ if (arcPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->disabledFillStipple);
+ }
+ if (arcPtr->fillGC != None) {
+ Tk_FreeGC(display, arcPtr->fillGC);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeArcBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of an arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeArcBbox(canvas, arcPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ ArcItem *arcPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ double tmp, center[2], point[2];
+ double width;
+ Tk_State state = arcPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = arcPtr->outline.width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ arcPtr->header.x1 = arcPtr->header.x2 =
+ arcPtr->header.y1 = arcPtr->header.y2 = -1;
+ return;
+ } else if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *) arcPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = arcPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = arcPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * Make sure that the first coordinates are the lowest ones.
+ */
+
+ if (arcPtr->bbox[1] > arcPtr->bbox[3]) {
+ double tmp;
+ tmp = arcPtr->bbox[3];
+ arcPtr->bbox[3] = arcPtr->bbox[1];
+ arcPtr->bbox[1] = tmp;
+ }
+ if (arcPtr->bbox[0] > arcPtr->bbox[2]) {
+ double tmp;
+ tmp = arcPtr->bbox[2];
+ arcPtr->bbox[2] = arcPtr->bbox[0];
+ arcPtr->bbox[0] = tmp;
+ }
+
+ ComputeArcOutline(canvas,arcPtr);
+
+ /*
+ * To compute the bounding box, start with the the bbox formed
+ * by the two endpoints of the arc. Then add in the center of
+ * the arc's oval (if relevant) and the 3-o'clock, 6-o'clock,
+ * 9-o'clock, and 12-o'clock positions, if they are relevant.
+ */
+
+ arcPtr->header.x1 = arcPtr->header.x2 = (int) arcPtr->center1[0];
+ arcPtr->header.y1 = arcPtr->header.y2 = (int) arcPtr->center1[1];
+ TkIncludePoint((Tk_Item *) arcPtr, arcPtr->center2);
+ center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2;
+ center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2;
+ if (arcPtr->style == PIESLICE_STYLE) {
+ TkIncludePoint((Tk_Item *) arcPtr, center);
+ }
+
+ tmp = -arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = arcPtr->bbox[2];
+ point[1] = center[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 90.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = center[0];
+ point[1] = arcPtr->bbox[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 180.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = arcPtr->bbox[0];
+ point[1] = center[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 270.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = center[0];
+ point[1] = arcPtr->bbox[3];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+
+ /*
+ * Lastly, expand by the width of the arc (if the arc's outline is
+ * being drawn) and add one extra pixel just for safety.
+ */
+
+ if (arcPtr->outline.gc == None) {
+ tmp = 1;
+ } else {
+ tmp = (int) ((width + 1.0)/2.0 + 1);
+ }
+ arcPtr->header.x1 -= (int) tmp;
+ arcPtr->header.y1 -= (int) tmp;
+ arcPtr->header.x2 += (int) tmp;
+ arcPtr->header.y2 += (int) tmp;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayArc --
+ *
+ * This procedure is invoked to draw an arc item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayArc(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ short x1, y1, x2, y2;
+ int start, extent, dashnumber;
+ double lineWidth;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ lineWidth = arcPtr->outline.width;
+ if (lineWidth < 1.0) {
+ lineWidth = 1.0;
+ }
+ dashnumber = arcPtr->outline.dash.number;
+ stipple = arcPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>lineWidth) {
+ lineWidth = arcPtr->outline.activeWidth;
+ }
+ if (arcPtr->outline.activeDash.number != 0) {
+ dashnumber = arcPtr->outline.activeDash.number;
+ }
+ if (arcPtr->activeFillStipple != None) {
+ stipple = arcPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth > 0) {
+ lineWidth = arcPtr->outline.disabledWidth;
+ }
+ if (arcPtr->outline.disabledDash.number != 0) {
+ dashnumber = arcPtr->outline.disabledDash.number;
+ }
+ if (arcPtr->disabledFillStipple != None) {
+ stipple = arcPtr->disabledFillStipple;
+ }
+ }
+
+ /*
+ * Compute the screen coordinates of the bounding box for the item,
+ * plus integer values for the angles.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[0], arcPtr->bbox[1],
+ &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[2], arcPtr->bbox[3],
+ &x2, &y2);
+ if (x2 <= x1) {
+ x2 = x1+1;
+ }
+ if (y2 <= y1) {
+ y2 = y1+1;
+ }
+ start = (int) ((64*arcPtr->start) + 0.5);
+ extent = (int) ((64*arcPtr->extent) + 0.5);
+
+ /*
+ * Display filled arc first (if wanted), then outline. If the extent
+ * is zero then don't invoke XFillArc or XDrawArc, since this causes
+ * some window servers to crash and should be a no-op anyway.
+ */
+
+ if ((arcPtr->fillGC != None) && (extent != 0)) {
+ if (stipple != None) {
+ int w=0; int h=0;
+ Tk_TSOffset *tsoffset = &arcPtr->tsoffset;
+ int flags = tsoffset->flags;
+ if (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE)) {
+ Tk_SizeOfBitmap(display, stipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ Tk_CanvasSetOffset(canvas, arcPtr->fillGC, tsoffset);
+ if (tsoffset) {
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ }
+ }
+ XFillArc(display, drawable, arcPtr->fillGC, x1, y1, (unsigned) (x2-x1),
+ (unsigned) (y2-y1), start, extent);
+ if (stipple != None) {
+ XSetTSOrigin(display, arcPtr->fillGC, 0, 0);
+ }
+ }
+ if (arcPtr->outline.gc != None) {
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(arcPtr->outline));
+
+ if (extent != 0) {
+ XDrawArc(display, drawable, arcPtr->outline.gc, x1, y1,
+ (unsigned) (x2-x1), (unsigned) (y2-y1), start, extent);
+ }
+
+ /*
+ * If the outline width is very thin, don't use polygons to draw
+ * the linear parts of the outline (this often results in nothing
+ * being displayed); just draw lines instead. The same is done if
+ * the outline is dashed, because then polygons don't work.
+ */
+
+ if (lineWidth < 1.5 || dashnumber != 0) {
+ Tk_CanvasDrawableCoords(canvas, arcPtr->center1[0],
+ arcPtr->center1[1], &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, arcPtr->center2[0],
+ arcPtr->center2[1], &x2, &y2);
+
+ if (arcPtr->style == CHORD_STYLE) {
+ XDrawLine(display, drawable, arcPtr->outline.gc,
+ x1, y1, x2, y2);
+ } else if (arcPtr->style == PIESLICE_STYLE) {
+ short cx, cy;
+
+ Tk_CanvasDrawableCoords(canvas,
+ (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0,
+ (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0, &cx, &cy);
+ XDrawLine(display, drawable, arcPtr->outline.gc,
+ cx, cy, x1, y1);
+ XDrawLine(display, drawable, arcPtr->outline.gc,
+ cx, cy, x2, y2);
+ }
+ } else {
+ if (arcPtr->style == CHORD_STYLE) {
+ TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ display, drawable, arcPtr->outline.gc, None);
+ } else if (arcPtr->style == PIESLICE_STYLE) {
+ TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ display, drawable, arcPtr->outline.gc, None);
+ TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, display, drawable, arcPtr->outline.gc,
+ None);
+ }
+ }
+
+ Tk_ResetOutlineGC(canvas, itemPtr, &(arcPtr->outline));
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * arc, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the arc. If the
+ * point isn't inside the arc then the return value is the
+ * distance from the point to the arc. If itemPtr is filled,
+ * then anywhere in the interior is considered "inside"; if
+ * itemPtr isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+ArcToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double vertex[2], pointAngle, diff, dist, newDist;
+ double poly[8], polyDist, width, t1, t2;
+ int filled, angleInRange;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = (double) arcPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = (double) arcPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = (double) arcPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * See if the point is within the angular range of the arc.
+ * Remember, X angles are backwards from the way we'd normally
+ * think of them. Also, compensate for any eccentricity of
+ * the oval.
+ */
+
+ vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ t1 = arcPtr->bbox[3] - arcPtr->bbox[1];
+ if (t1 != 0.0) {
+ t1 = (pointPtr[1] - vertex[1]) / t1;
+ }
+ t2 = arcPtr->bbox[2] - arcPtr->bbox[0];
+ if (t2 != 0.0) {
+ t2 = (pointPtr[0] - vertex[0]) / t2;
+ }
+ if ((t1 == 0.0) && (t2 == 0.0)) {
+ pointAngle = 0;
+ } else {
+ pointAngle = -atan2(t1, t2)*180/PI;
+ }
+ diff = pointAngle - arcPtr->start;
+ diff -= ((int) (diff/360.0) * 360.0);
+ if (diff < 0) {
+ diff += 360.0;
+ }
+ angleInRange = (diff <= arcPtr->extent) ||
+ ((arcPtr->extent < 0) && ((diff - 360.0) >= arcPtr->extent));
+
+ /*
+ * Now perform different tests depending on what kind of arc
+ * we're dealing with.
+ */
+
+ if (arcPtr->style == ARC_STYLE) {
+ if (angleInRange) {
+ return TkOvalToPoint(arcPtr->bbox, width,
+ 0, pointPtr);
+ }
+ dist = hypot(pointPtr[0] - arcPtr->center1[0],
+ pointPtr[1] - arcPtr->center1[1]);
+ newDist = hypot(pointPtr[0] - arcPtr->center2[0],
+ pointPtr[1] - arcPtr->center2[1]);
+ if (newDist < dist) {
+ return newDist;
+ }
+ return dist;
+ }
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outline.gc == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outline.gc == None) {
+ width = 0.0;
+ }
+
+ if (arcPtr->style == PIESLICE_STYLE) {
+ if (width > 1.0) {
+ dist = TkPolygonToPoint(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ pointPtr);
+ newDist = TkPolygonToPoint(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, pointPtr);
+ } else {
+ dist = TkLineToPoint(vertex, arcPtr->center1, pointPtr);
+ newDist = TkLineToPoint(vertex, arcPtr->center2, pointPtr);
+ }
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ if (angleInRange) {
+ newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr);
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ }
+ return dist;
+ }
+
+ /*
+ * This is a chord-style arc. We have to deal specially with the
+ * triangular piece that represents the difference between a
+ * chord-style arc and a pie-slice arc (for small angles this piece
+ * is excluded here where it would be included for pie slices;
+ * for large angles the piece is included here but would be
+ * excluded for pie slices).
+ */
+
+ if (width > 1.0) {
+ dist = TkPolygonToPoint(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ pointPtr);
+ } else {
+ dist = TkLineToPoint(arcPtr->center1, arcPtr->center2, pointPtr);
+ }
+ poly[0] = poly[6] = vertex[0];
+ poly[1] = poly[7] = vertex[1];
+ poly[2] = arcPtr->center1[0];
+ poly[3] = arcPtr->center1[1];
+ poly[4] = arcPtr->center2[0];
+ poly[5] = arcPtr->center2[1];
+ polyDist = TkPolygonToPoint(poly, 4, pointPtr);
+ if (angleInRange) {
+ if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)
+ || (polyDist > 0.0)) {
+ newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr);
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ }
+ } else {
+ if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)) {
+ if (filled && (polyDist < dist)) {
+ dist = polyDist;
+ }
+ }
+ }
+ return dist;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArcToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against arc. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double rx, ry; /* Radii for transformed oval: these define
+ * an oval centered at the origin. */
+ double tRect[4]; /* Transformed version of x1, y1, x2, y2,
+ * for coord. system where arc is centered
+ * on the origin. */
+ double center[2], width, angle, tmp;
+ double points[20], *pointPtr;
+ int numPoints, filled;
+ int inside; /* Non-zero means every test so far suggests
+ * that arc is inside rectangle. 0 means
+ * every test so far shows arc to be outside
+ * of rectangle. */
+ int newInside;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = (double) arcPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = (double) arcPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = (double) arcPtr->outline.disabledWidth;
+ }
+ }
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outline.gc == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outline.gc == None) {
+ width = 0.0;
+ }
+
+ /*
+ * Transform both the arc and the rectangle so that the arc's oval
+ * is centered on the origin.
+ */
+
+ center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ tRect[0] = rectPtr[0] - center[0];
+ tRect[1] = rectPtr[1] - center[1];
+ tRect[2] = rectPtr[2] - center[0];
+ tRect[3] = rectPtr[3] - center[1];
+ rx = arcPtr->bbox[2] - center[0] + width/2.0;
+ ry = arcPtr->bbox[3] - center[1] + width/2.0;
+
+ /*
+ * Find the extreme points of the arc and see whether these are all
+ * inside the rectangle (in which case we're done), partly in and
+ * partly out (in which case we're done), or all outside (in which
+ * case we have more work to do). The extreme points include the
+ * following, which are checked in order:
+ *
+ * 1. The outside points of the arc, corresponding to start and
+ * extent.
+ * 2. The center of the arc (but only in pie-slice mode).
+ * 3. The 12, 3, 6, and 9-o'clock positions (but only if the arc
+ * includes those angles).
+ */
+
+ pointPtr = points;
+ angle = -arcPtr->start*(PI/180.0);
+ pointPtr[0] = rx*cos(angle);
+ pointPtr[1] = ry*sin(angle);
+ angle += -arcPtr->extent*(PI/180.0);
+ pointPtr[2] = rx*cos(angle);
+ pointPtr[3] = ry*sin(angle);
+ numPoints = 2;
+ pointPtr += 4;
+
+ if ((arcPtr->style == PIESLICE_STYLE) && (arcPtr->extent < 180.0)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+
+ tmp = -arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = rx;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 90.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = -ry;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 180.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = -rx;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 270.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = ry;
+ numPoints++;
+ }
+
+ /*
+ * Now that we've located the extreme points, loop through them all
+ * to see which are inside the rectangle.
+ */
+
+ inside = (points[0] > tRect[0]) && (points[0] < tRect[2])
+ && (points[1] > tRect[1]) && (points[1] < tRect[3]);
+ for (pointPtr = points+2; numPoints > 1; pointPtr += 2, numPoints--) {
+ newInside = (pointPtr[0] > tRect[0]) && (pointPtr[0] < tRect[2])
+ && (pointPtr[1] > tRect[1]) && (pointPtr[1] < tRect[3]);
+ if (newInside != inside) {
+ return 0;
+ }
+ }
+
+ if (inside) {
+ return 1;
+ }
+
+ /*
+ * So far, oval appears to be outside rectangle, but can't yet tell
+ * for sure. Next, test each of the four sides of the rectangle
+ * against the bounding region for the arc. If any intersections
+ * are found, then return "overlapping". First, test against the
+ * polygon(s) forming the sides of a chord or pie-slice.
+ */
+
+ if (arcPtr->style == PIESLICE_STYLE) {
+ if (width >= 1.0) {
+ if (TkPolygonToArea(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ rectPtr) != -1) {
+ return 0;
+ }
+ if (TkPolygonToArea(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, rectPtr) != -1) {
+ return 0;
+ }
+ } else {
+ if ((TkLineToArea(center, arcPtr->center1, rectPtr) != -1) ||
+ (TkLineToArea(center, arcPtr->center2, rectPtr) != -1)) {
+ return 0;
+ }
+ }
+ } else if (arcPtr->style == CHORD_STYLE) {
+ if (width >= 1.0) {
+ if (TkPolygonToArea(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ rectPtr) != -1) {
+ return 0;
+ }
+ } else {
+ if (TkLineToArea(arcPtr->center1, arcPtr->center2,
+ rectPtr) != -1) {
+ return 0;
+ }
+ }
+ }
+
+ /*
+ * Next check for overlap between each of the four sides and the
+ * outer perimiter of the arc. If the arc isn't filled, then also
+ * check the inner perimeter of the arc.
+ */
+
+ if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start,
+ arcPtr->extent)
+ || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)) {
+ return 0;
+ }
+ if ((width > 1.0) && !filled) {
+ rx -= width;
+ ry -= width;
+ if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start,
+ arcPtr->extent)
+ || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)) {
+ return 0;
+ }
+ }
+
+ /*
+ * The arc still appears to be totally disjoint from the rectangle,
+ * but it's also possible that the rectangle is totally inside the arc.
+ * Do one last check, which is to check one point of the rectangle
+ * to see if it's inside the arc. If it is, we've got overlap. If
+ * it isn't, the arc's really outside the rectangle.
+ */
+
+ if (ArcToPoint(canvas, itemPtr, rectPtr) == 0.0) {
+ return 0;
+ }
+ return -1;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleArc --
+ *
+ * This procedure is invoked to rescale an arc item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The arc referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleArc(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing arc. */
+ Tk_Item *itemPtr; /* Arc to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ arcPtr->bbox[0] = originX + scaleX*(arcPtr->bbox[0] - originX);
+ arcPtr->bbox[1] = originY + scaleY*(arcPtr->bbox[1] - originY);
+ arcPtr->bbox[2] = originX + scaleX*(arcPtr->bbox[2] - originX);
+ arcPtr->bbox[3] = originY + scaleY*(arcPtr->bbox[3] - originY);
+ ComputeArcBbox(canvas, arcPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateArc --
+ *
+ * This procedure is called to move an arc by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the arc is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateArc(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ arcPtr->bbox[0] += deltaX;
+ arcPtr->bbox[1] += deltaY;
+ arcPtr->bbox[2] += deltaX;
+ arcPtr->bbox[3] += deltaY;
+ ComputeArcBbox(canvas, arcPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeArcOutline --
+ *
+ * This procedure creates a polygon describing everything in
+ * the outline for an arc except what's in the curved part.
+ * For a "pie slice" arc this is a V-shaped chunk, and for
+ * a "chord" arc this is a linear chunk (with cutaway corners).
+ * For "arc" arcs, this stuff isn't relevant.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at arcPtr->outlinePtr gets modified, and
+ * storage for arcPtr->outlinePtr may be allocated or freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeArcOutline(canvas,arcPtr)
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ ArcItem *arcPtr; /* Information about arc. */
+{
+ double sin1, cos1, sin2, cos2, angle, width, halfWidth;
+ double boxWidth, boxHeight;
+ double vertex[2], corner1[2], corner2[2];
+ double *outlinePtr;
+ Tk_State state = arcPtr->header.state;
+
+
+ /*
+ * Make sure that the outlinePtr array is large enough to hold
+ * either a chord or pie-slice outline.
+ */
+
+ if (arcPtr->numOutlinePoints == 0) {
+ arcPtr->outlinePtr = (double *) ckalloc((unsigned)
+ (26 * sizeof(double)));
+ arcPtr->numOutlinePoints = 22;
+ }
+ outlinePtr = arcPtr->outlinePtr;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ /*
+ * First compute the two points that lie at the centers of
+ * the ends of the curved arc segment, which are marked with
+ * X's in the figure below:
+ *
+ *
+ * * * *
+ * * *
+ * * * * *
+ * * * * *
+ * * * * *
+ * X * * X
+ *
+ * The code is tricky because the arc can be ovular in shape.
+ * It computes the position for a unit circle, and then
+ * scales to fit the shape of the arc's bounding box.
+ *
+ * Also, watch out because angles go counter-clockwise like you
+ * might expect, but the y-coordinate system is inverted. To
+ * handle this, just negate the angles in all the computations.
+ */
+
+ boxWidth = arcPtr->bbox[2] - arcPtr->bbox[0];
+ boxHeight = arcPtr->bbox[3] - arcPtr->bbox[1];
+ angle = -arcPtr->start*PI/180.0;
+ sin1 = sin(angle);
+ cos1 = cos(angle);
+ angle -= arcPtr->extent*PI/180.0;
+ sin2 = sin(angle);
+ cos2 = cos(angle);
+ vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ arcPtr->center1[0] = vertex[0] + cos1*boxWidth/2.0;
+ arcPtr->center1[1] = vertex[1] + sin1*boxHeight/2.0;
+ arcPtr->center2[0] = vertex[0] + cos2*boxWidth/2.0;
+ arcPtr->center2[1] = vertex[1] + sin2*boxHeight/2.0;
+
+ /*
+ * Next compute the "outermost corners" of the arc, which are
+ * marked with X's in the figure below:
+ *
+ * * * *
+ * * *
+ * * * * *
+ * * * * *
+ * X * * X
+ * * *
+ *
+ * The code below is tricky because it has to handle eccentricity
+ * in the shape of the oval. The key in the code below is to
+ * realize that the slope of the line from arcPtr->center1 to corner1
+ * is (boxWidth*sin1)/(boxHeight*cos1), and similarly for arcPtr->center2
+ * and corner2. These formulas can be computed from the formula for
+ * the oval.
+ */
+
+ width = arcPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *) arcPtr) {
+ if (arcPtr->outline.activeWidth>arcPtr->outline.width) {
+ width = arcPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>arcPtr->outline.width) {
+ width = arcPtr->outline.disabledWidth;
+ }
+ }
+ halfWidth = width/2.0;
+
+ if (((boxWidth*sin1) == 0.0) && ((boxHeight*cos1) == 0.0)) {
+ angle = 0.0;
+ } else {
+ angle = atan2(boxWidth*sin1, boxHeight*cos1);
+ }
+ corner1[0] = arcPtr->center1[0] + cos(angle)*halfWidth;
+ corner1[1] = arcPtr->center1[1] + sin(angle)*halfWidth;
+ if (((boxWidth*sin2) == 0.0) && ((boxHeight*cos2) == 0.0)) {
+ angle = 0.0;
+ } else {
+ angle = atan2(boxWidth*sin2, boxHeight*cos2);
+ }
+ corner2[0] = arcPtr->center2[0] + cos(angle)*halfWidth;
+ corner2[1] = arcPtr->center2[1] + sin(angle)*halfWidth;
+
+ /*
+ * For a chord outline, generate a six-sided polygon with three
+ * points for each end of the chord. The first and third points
+ * for each end are butt points generated on either side of the
+ * center point. The second point is the corner point.
+ */
+
+ if (arcPtr->style == CHORD_STYLE) {
+ outlinePtr[0] = outlinePtr[12] = corner1[0];
+ outlinePtr[1] = outlinePtr[13] = corner1[1];
+ TkGetButtPoints(arcPtr->center2, arcPtr->center1,
+ width, 0, outlinePtr+10, outlinePtr+2);
+ outlinePtr[4] = arcPtr->center2[0] + outlinePtr[2]
+ - arcPtr->center1[0];
+ outlinePtr[5] = arcPtr->center2[1] + outlinePtr[3]
+ - arcPtr->center1[1];
+ outlinePtr[6] = corner2[0];
+ outlinePtr[7] = corner2[1];
+ outlinePtr[8] = arcPtr->center2[0] + outlinePtr[10]
+ - arcPtr->center1[0];
+ outlinePtr[9] = arcPtr->center2[1] + outlinePtr[11]
+ - arcPtr->center1[1];
+ } else if (arcPtr->style == PIESLICE_STYLE) {
+ /*
+ * For pie slices, generate two polygons, one for each side
+ * of the pie slice. The first arm has a shape like this,
+ * where the center of the oval is X, arcPtr->center1 is at Y, and
+ * corner1 is at Z:
+ *
+ * _____________________
+ * | \
+ * | \
+ * X Y Z
+ * | /
+ * |_____________________/
+ *
+ */
+
+ TkGetButtPoints(arcPtr->center1, vertex, width, 0,
+ outlinePtr, outlinePtr+2);
+ outlinePtr[4] = arcPtr->center1[0] + outlinePtr[2] - vertex[0];
+ outlinePtr[5] = arcPtr->center1[1] + outlinePtr[3] - vertex[1];
+ outlinePtr[6] = corner1[0];
+ outlinePtr[7] = corner1[1];
+ outlinePtr[8] = arcPtr->center1[0] + outlinePtr[0] - vertex[0];
+ outlinePtr[9] = arcPtr->center1[1] + outlinePtr[1] - vertex[1];
+ outlinePtr[10] = outlinePtr[0];
+ outlinePtr[11] = outlinePtr[1];
+
+ /*
+ * The second arm has a shape like this:
+ *
+ *
+ * ______________________
+ * / \
+ * / \
+ * Z Y X /
+ * \ /
+ * \______________________/
+ *
+ * Similar to above X is the center of the oval/circle, Y is
+ * arcPtr->center2, and Z is corner2. The extra jog out to the left
+ * of X is needed in or to produce a butted joint with the
+ * first arm; the corner to the right of X is one of the
+ * first two points of the first arm, depending on extent.
+ */
+
+ TkGetButtPoints(arcPtr->center2, vertex, width, 0,
+ outlinePtr+12, outlinePtr+16);
+ if ((arcPtr->extent > 180) ||
+ ((arcPtr->extent < 0) && (arcPtr->extent > -180))) {
+ outlinePtr[14] = outlinePtr[0];
+ outlinePtr[15] = outlinePtr[1];
+ } else {
+ outlinePtr[14] = outlinePtr[2];
+ outlinePtr[15] = outlinePtr[3];
+ }
+ outlinePtr[18] = arcPtr->center2[0] + outlinePtr[16] - vertex[0];
+ outlinePtr[19] = arcPtr->center2[1] + outlinePtr[17] - vertex[1];
+ outlinePtr[20] = corner2[0];
+ outlinePtr[21] = corner2[1];
+ outlinePtr[22] = arcPtr->center2[0] + outlinePtr[12] - vertex[0];
+ outlinePtr[23] = arcPtr->center2[1] + outlinePtr[13] - vertex[1];
+ outlinePtr[24] = outlinePtr[12];
+ outlinePtr[25] = outlinePtr[13];
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * HorizLineToArc --
+ *
+ * Determines whether a horizontal line segment intersects
+ * a given arc.
+ *
+ * Results:
+ * The return value is 1 if the given line intersects the
+ * infinitely-thin arc section defined by rx, ry, start,
+ * and extent, and 0 otherwise. Only the perimeter of the
+ * arc is checked: interior areas (e.g. pie-slice or chord)
+ * are not checked.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+HorizLineToArc(x1, x2, y, rx, ry, start, extent)
+ double x1, x2; /* X-coords of endpoints of line segment.
+ * X1 must be <= x2. */
+ double y; /* Y-coordinate of line segment. */
+ double rx, ry; /* These x- and y-radii define an oval
+ * centered at the origin. */
+ double start, extent; /* Angles that define extent of arc, in
+ * the standard fashion for this module. */
+{
+ double tmp;
+ double tx, ty; /* Coordinates of intersection point in
+ * transformed coordinate system. */
+ double x;
+
+ /*
+ * Compute the x-coordinate of one possible intersection point
+ * between the arc and the line. Use a transformed coordinate
+ * system where the oval is a unit circle centered at the origin.
+ * Then scale back to get actual x-coordinate.
+ */
+
+ ty = y/ry;
+ tmp = 1 - ty*ty;
+ if (tmp < 0) {
+ return 0;
+ }
+ tx = sqrt(tmp);
+ x = tx*rx;
+
+ /*
+ * Test both intersection points.
+ */
+
+ if ((x >= x1) && (x <= x2) && AngleInRange(tx, ty, start, extent)) {
+ return 1;
+ }
+ if ((-x >= x1) && (-x <= x2) && AngleInRange(-tx, ty, start, extent)) {
+ return 1;
+ }
+ return 0;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * VertLineToArc --
+ *
+ * Determines whether a vertical line segment intersects
+ * a given arc.
+ *
+ * Results:
+ * The return value is 1 if the given line intersects the
+ * infinitely-thin arc section defined by rx, ry, start,
+ * and extent, and 0 otherwise. Only the perimeter of the
+ * arc is checked: interior areas (e.g. pie-slice or chord)
+ * are not checked.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+VertLineToArc(x, y1, y2, rx, ry, start, extent)
+ double x; /* X-coordinate of line segment. */
+ double y1, y2; /* Y-coords of endpoints of line segment.
+ * Y1 must be <= y2. */
+ double rx, ry; /* These x- and y-radii define an oval
+ * centered at the origin. */
+ double start, extent; /* Angles that define extent of arc, in
+ * the standard fashion for this module. */
+{
+ double tmp;
+ double tx, ty; /* Coordinates of intersection point in
+ * transformed coordinate system. */
+ double y;
+
+ /*
+ * Compute the y-coordinate of one possible intersection point
+ * between the arc and the line. Use a transformed coordinate
+ * system where the oval is a unit circle centered at the origin.
+ * Then scale back to get actual y-coordinate.
+ */
+
+ tx = x/rx;
+ tmp = 1 - tx*tx;
+ if (tmp < 0) {
+ return 0;
+ }
+ ty = sqrt(tmp);
+ y = ty*ry;
+
+ /*
+ * Test both intersection points.
+ */
+
+ if ((y > y1) && (y < y2) && AngleInRange(tx, ty, start, extent)) {
+ return 1;
+ }
+ if ((-y > y1) && (-y < y2) && AngleInRange(tx, -ty, start, extent)) {
+ return 1;
+ }
+ return 0;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * AngleInRange --
+ *
+ * Determine whether the angle from the origin to a given
+ * point is within a given range.
+ *
+ * Results:
+ * The return value is 1 if the angle from (0,0) to (x,y)
+ * is in the range given by start and extent, where angles
+ * are interpreted in the standard way for ovals (meaning
+ * backwards from normal interpretation). Otherwise the
+ * return value is 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+AngleInRange(x, y, start, extent)
+ double x, y; /* Coordinate of point; angle measured
+ * from origin to here, relative to x-axis. */
+ double start; /* First angle, degrees, >=0, <=360. */
+ double extent; /* Size of arc in degrees >=-360, <=360. */
+{
+ double diff;
+
+ if ((x == 0.0) && (y == 0.0)) {
+ return 1;
+ }
+ diff = -atan2(y, x);
+ diff = diff*(180.0/PI) - start;
+ while (diff > 360.0) {
+ diff -= 360.0;
+ }
+ while (diff < 0.0) {
+ diff += 360.0;
+ }
+ if (extent >= 0) {
+ return diff <= extent;
+ }
+ return (diff-360.0) >= extent;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * arc items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ char buffer[400];
+ double y1, y2, ang1, ang2;
+ XColor *color;
+ Pixmap stipple;
+ XColor *fillColor;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+
+ y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]);
+ y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]);
+ ang1 = arcPtr->start;
+ ang2 = ang1 + arcPtr->extent;
+ if (ang2 < ang1) {
+ ang1 = ang2;
+ ang2 = arcPtr->start;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ color = arcPtr->outline.color;
+ stipple = arcPtr->outline.stipple;
+ fillColor = arcPtr->fillColor;
+ fillStipple = arcPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeColor!=NULL) {
+ color = arcPtr->outline.activeColor;
+ }
+ if (arcPtr->outline.activeStipple!=None) {
+ stipple = arcPtr->outline.activeStipple;
+ }
+ if (arcPtr->activeFillColor!=NULL) {
+ fillColor = arcPtr->activeFillColor;
+ }
+ if (arcPtr->activeFillStipple!=None) {
+ fillStipple = arcPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledColor!=NULL) {
+ color = arcPtr->outline.disabledColor;
+ }
+ if (arcPtr->outline.disabledStipple!=None) {
+ stipple = arcPtr->outline.disabledStipple;
+ }
+ if (arcPtr->disabledFillColor!=NULL) {
+ fillColor = arcPtr->disabledFillColor;
+ }
+ if (arcPtr->disabledFillStipple!=None) {
+ fillStipple = arcPtr->disabledFillStipple;
+ }
+ }
+
+ /*
+ * If the arc is filled, output Postscript for the interior region
+ * of the arc.
+ */
+
+ if (arcPtr->fillGC != None) {
+ sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n",
+ (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2,
+ (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (arcPtr->style == CHORD_STYLE) {
+ sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
+ ang1, ang2);
+ } else {
+ sprintf(buffer,
+ "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
+ ang1, ang2);
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ if (fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outline.gc != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+
+ /*
+ * If there's an outline for the arc, draw it.
+ */
+
+ if (arcPtr->outline.gc != None) {
+ sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n",
+ (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2,
+ (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "0 0 1 %.15g %.15g", ang1, ang2);
+ Tcl_AppendResult(interp, buffer,
+ " arc\nsetmatrix\n0 setlinecap\n", (char *) NULL);
+ if (Tk_CanvasPsOutline(canvas, itemPtr,
+ &(arcPtr->outline)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->style != ARC_STYLE) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ if (arcPtr->style == CHORD_STYLE) {
+ Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
+ CHORD_OUTLINE_PTS);
+ } else {
+ Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
+ PIE_OUTLINE1_PTS);
+ if (Tk_CanvasPsColor(interp, canvas, color)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ Tk_CanvasPsPath(interp, canvas,
+ arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, color)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * StyleParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * the "-style" option.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The state for a given item gets replaced by the state
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+StyleParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ int c;
+ size_t length;
+
+ register Style *stylePtr = (Style *) (widgRec + offset);
+
+ if(value == NULL || *value == 0) {
+ *stylePtr = PIESLICE_STYLE;
+ return TCL_OK;
+ }
+
+ c = value[0];
+ length = strlen(value);
+
+ if ((c == 'a') && (strncmp(value, "arc", length) == 0)) {
+ *stylePtr = ARC_STYLE;
+ return TCL_OK;
+ }
+ if ((c == 'c') && (strncmp(value, "chord", length) == 0)) {
+ *stylePtr = CHORD_STYLE;
+ return TCL_OK;
+ }
+ if ((c == 'p') && (strncmp(value, "pieslice", length) == 0)) {
+ *stylePtr = PIESLICE_STYLE;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad -style option \"",
+ value, "\": must be arc, chord, or pieslice",
+ (char *) NULL);
+ *stylePtr = PIESLICE_STYLE;
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * StylePrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-style"
+ * configuration option.
+ *
+ * Results:
+ * The return value is a string describing the state for
+ * the item referred to by "widgRec". In addition, *freeProcPtr
+ * is filled in with the address of a procedure to call to free
+ * the result string when it's no longer needed (or NULL to
+ * indicate that the string doesn't need to be freed).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+StylePrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Ignored. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Style *stylePtr = (Style *) (widgRec + offset);
+
+ if (*stylePtr==ARC_STYLE) {
+ return "arc";
+ } else if (*stylePtr==CHORD_STYLE) {
+ return "chord";
+ } else {
+ return "pieslice";
+ }
+}
--- /dev/null
+/*
+ * tkCanvBmap.c --
+ *
+ * This file implements bitmap items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each bitmap item.
+ */
+
+typedef struct BitmapItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double x, y; /* Coordinates of positioning point for
+ * bitmap. */
+ Tk_Anchor anchor; /* Where to anchor bitmap relative to
+ * (x,y). */
+ Pixmap bitmap; /* Bitmap to display in window. */
+ Pixmap activeBitmap; /* Bitmap to display in window. */
+ Pixmap disabledBitmap; /* Bitmap to display in window. */
+ XColor *fgColor; /* Foreground color to use for bitmap. */
+ XColor *activeFgColor; /* Foreground color to use for bitmap. */
+ XColor *disabledFgColor; /* Foreground color to use for bitmap. */
+ XColor *bgColor; /* Background color to use for bitmap. */
+ XColor *activeBgColor; /* Background color to use for bitmap. */
+ XColor *disabledBgColor; /* Background color to use for bitmap. */
+ GC gc; /* Graphics context to use for drawing
+ * bitmap on screen. */
+} BitmapItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-activebackground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, activeBgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activebitmap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, activeBitmap), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, activeFgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(BitmapItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-background", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, bgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, bitmap), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledbackground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, disabledBgColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledbitmap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, disabledBitmap),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledforeground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, disabledFgColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(BitmapItem, fgColor), 0},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int BitmapCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int BitmapToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double BitmapToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int BitmapToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ComputeBitmapBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ BitmapItem *bmapPtr));
+static int ConfigureBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void DeleteBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the bitmap item type in terms of
+ * procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkBitmapType = {
+ "bitmap", /* name */
+ sizeof(BitmapItem), /* itemSize */
+ CreateBitmap, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureBitmap, /* configureProc */
+ BitmapCoords, /* coordProc */
+ DeleteBitmap, /* deleteProc */
+ DisplayBitmap, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ BitmapToPoint, /* pointProc */
+ BitmapToArea, /* areaProc */
+ BitmapToPostscript, /* postscriptProc */
+ ScaleBitmap, /* scaleProc */
+ TranslateBitmap, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateBitmap --
+ *
+ * This procedure is invoked to create a new bitmap
+ * item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new bitmap item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateBitmap(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing rectangle. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ int i;
+
+ if (objc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj(objv[1], NULL);
+ if (((objc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z'))) {
+ i = 1;
+ } else {
+ i = 2;
+ }
+ }
+
+ if (objc < i) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x y ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ bmapPtr->anchor = TK_ANCHOR_CENTER;
+ bmapPtr->bitmap = None;
+ bmapPtr->activeBitmap = None;
+ bmapPtr->disabledBitmap = None;
+ bmapPtr->fgColor = NULL;
+ bmapPtr->activeFgColor = NULL;
+ bmapPtr->disabledFgColor = NULL;
+ bmapPtr->bgColor = NULL;
+ bmapPtr->activeBgColor = NULL;
+ bmapPtr->disabledBgColor = NULL;
+ bmapPtr->gc = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((BitmapCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureBitmap(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteBitmap(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on bitmap items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapCoords(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(bmapPtr->x);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(bmapPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if (objc <3) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &bmapPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &bmapPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeBitmapBbox(canvas, bmapPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureBitmap --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a bitmap item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureBitmap(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Bitmap item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ Tk_Window tkwin;
+ unsigned long mask;
+ XColor *fgColor;
+ XColor *bgColor;
+ Pixmap bitmap;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) bmapPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as those
+ * that determine the graphics context.
+ */
+
+ state = itemPtr->state;
+
+ if (bmapPtr->activeFgColor!=NULL ||
+ bmapPtr->activeBgColor!=NULL ||
+ bmapPtr->activeBitmap!=None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ ComputeBitmapBbox(canvas, bmapPtr);
+ return TCL_OK;
+ }
+ fgColor = bmapPtr->fgColor;
+ bgColor = bmapPtr->bgColor;
+ bitmap = bmapPtr->bitmap;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (bmapPtr->activeFgColor!=NULL) {
+ fgColor = bmapPtr->activeFgColor;
+ }
+ if (bmapPtr->activeBgColor!=NULL) {
+ bgColor = bmapPtr->activeBgColor;
+ }
+ if (bmapPtr->activeBitmap!=None) {
+ bitmap = bmapPtr->activeBitmap;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (bmapPtr->disabledFgColor!=NULL) {
+ fgColor = bmapPtr->disabledFgColor;
+ }
+ if (bmapPtr->disabledBgColor!=NULL) {
+ bgColor = bmapPtr->disabledBgColor;
+ }
+ if (bmapPtr->disabledBitmap!=None) {
+ bitmap = bmapPtr->disabledBitmap;
+ }
+ }
+
+ if (state==TK_STATE_DISABLED || bitmap == None) {
+ ComputeBitmapBbox(canvas, bmapPtr);
+ return TCL_OK;
+ }
+
+ gcValues.foreground = fgColor->pixel;
+ mask = GCForeground;
+ if (bgColor != NULL) {
+ gcValues.background = bgColor->pixel;
+ mask |= GCBackground;
+ } else {
+ gcValues.clip_mask = bitmap;
+ mask |= GCClipMask;
+ }
+ if (bitmap == None) {
+ newGC = None;
+ } else {
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (bmapPtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), bmapPtr->gc);
+ }
+ bmapPtr->gc = newGC;
+
+ ComputeBitmapBbox(canvas, bmapPtr);
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteBitmap --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a bitmap item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteBitmap(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if (bmapPtr->bitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->bitmap);
+ }
+ if (bmapPtr->activeBitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->activeBitmap);
+ }
+ if (bmapPtr->disabledBitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->disabledBitmap);
+ }
+ if (bmapPtr->fgColor != NULL) {
+ Tk_FreeColor(bmapPtr->fgColor);
+ }
+ if (bmapPtr->activeFgColor != NULL) {
+ Tk_FreeColor(bmapPtr->activeFgColor);
+ }
+ if (bmapPtr->disabledFgColor != NULL) {
+ Tk_FreeColor(bmapPtr->disabledFgColor);
+ }
+ if (bmapPtr->bgColor != NULL) {
+ Tk_FreeColor(bmapPtr->bgColor);
+ }
+ if (bmapPtr->activeBgColor != NULL) {
+ Tk_FreeColor(bmapPtr->activeBgColor);
+ }
+ if (bmapPtr->disabledBgColor != NULL) {
+ Tk_FreeColor(bmapPtr->disabledBgColor);
+ }
+ if (bmapPtr->gc != NULL) {
+ Tk_FreeGC(display, bmapPtr->gc);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeBitmapBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a bitmap item.
+ * This procedure is where the child bitmap's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeBitmapBbox(canvas, bmapPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ BitmapItem *bmapPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height;
+ int x, y;
+ Pixmap bitmap;
+ Tk_State state = bmapPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ bitmap = bmapPtr->bitmap;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)bmapPtr) {
+ if (bmapPtr->activeBitmap!=None) {
+ bitmap = bmapPtr->activeBitmap;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (bmapPtr->disabledBitmap!=None) {
+ bitmap = bmapPtr->disabledBitmap;
+ }
+ }
+
+ x = (int) (bmapPtr->x + ((bmapPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (bmapPtr->y + ((bmapPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (state==TK_STATE_HIDDEN || bitmap == None) {
+ bmapPtr->header.x1 = bmapPtr->header.x2 = x;
+ bmapPtr->header.y1 = bmapPtr->header.y2 = y;
+ return;
+ }
+
+ /*
+ * Compute location and size of bitmap, using anchor information.
+ */
+
+ Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bmapPtr->bitmap,
+ &width, &height);
+ switch (bmapPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ bmapPtr->header.x1 = x;
+ bmapPtr->header.y1 = y;
+ bmapPtr->header.x2 = x + width;
+ bmapPtr->header.y2 = y + height;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayBitmap --
+ *
+ * This procedure is invoked to draw a bitmap item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayBitmap(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ int bmapX, bmapY, bmapWidth, bmapHeight;
+ short drawableX, drawableY;
+ XColor *fgColor;
+ XColor *bgColor;
+ Pixmap bitmap;
+ Tk_State state = itemPtr->state;
+
+ /*
+ * If the area being displayed doesn't cover the whole bitmap,
+ * then only redisplay the part of the bitmap that needs
+ * redisplay.
+ */
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ fgColor = bmapPtr->fgColor;
+ bgColor = bmapPtr->bgColor;
+ bitmap = bmapPtr->bitmap;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (bmapPtr->activeFgColor!=NULL) {
+ fgColor = bmapPtr->activeFgColor;
+ }
+ if (bmapPtr->activeBgColor!=NULL) {
+ bgColor = bmapPtr->activeBgColor;
+ }
+ if (bmapPtr->activeBitmap!=None) {
+ bitmap = bmapPtr->activeBitmap;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (bmapPtr->disabledFgColor!=NULL) {
+ fgColor = bmapPtr->disabledFgColor;
+ }
+ if (bmapPtr->disabledBgColor!=NULL) {
+ bgColor = bmapPtr->disabledBgColor;
+ }
+ if (bmapPtr->disabledBitmap!=None) {
+ bitmap = bmapPtr->disabledBitmap;
+ }
+ }
+
+ if (bitmap != None) {
+ if (x > bmapPtr->header.x1) {
+ bmapX = x - bmapPtr->header.x1;
+ bmapWidth = bmapPtr->header.x2 - x;
+ } else {
+ bmapX = 0;
+ if ((x+width) < bmapPtr->header.x2) {
+ bmapWidth = x + width - bmapPtr->header.x1;
+ } else {
+ bmapWidth = bmapPtr->header.x2 - bmapPtr->header.x1;
+ }
+ }
+ if (y > bmapPtr->header.y1) {
+ bmapY = y - bmapPtr->header.y1;
+ bmapHeight = bmapPtr->header.y2 - y;
+ } else {
+ bmapY = 0;
+ if ((y+height) < bmapPtr->header.y2) {
+ bmapHeight = y + height - bmapPtr->header.y1;
+ } else {
+ bmapHeight = bmapPtr->header.y2 - bmapPtr->header.y1;
+ }
+ }
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (bmapPtr->header.x1 + bmapX),
+ (double) (bmapPtr->header.y1 + bmapY),
+ &drawableX, &drawableY);
+
+ /*
+ * Must modify the mask origin within the graphics context
+ * to line up with the bitmap's origin (in order to make
+ * bitmaps with "-background {}" work right).
+ */
+
+ XSetClipOrigin(display, bmapPtr->gc, drawableX - bmapX,
+ drawableY - bmapY);
+ XCopyPlane(display, bitmap, drawable,
+ bmapPtr->gc, bmapX, bmapY, (unsigned int) bmapWidth,
+ (unsigned int) bmapHeight, drawableX, drawableY, 1);
+ XSetClipOrigin(display, bmapPtr->gc, 0, 0);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the bitmap. If the
+ * point isn't inside the bitmap then the return value is the
+ * distance from the point to the bitmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+BitmapToPoint(canvas, itemPtr, coordPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *coordPtr; /* Pointer to x and y coordinates. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = bmapPtr->header.x1;
+ y1 = bmapPtr->header.y1;
+ x2 = bmapPtr->header.x2;
+ y2 = bmapPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (coordPtr[0] < x1) {
+ xDiff = x1 - coordPtr[0];
+ } else if (coordPtr[0] > x2) {
+ xDiff = coordPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (coordPtr[1] < y1) {
+ yDiff = y1 - coordPtr[1];
+ } else if (coordPtr[1] > y2) {
+ yDiff = coordPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+BitmapToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if ((rectPtr[2] <= bmapPtr->header.x1)
+ || (rectPtr[0] >= bmapPtr->header.x2)
+ || (rectPtr[3] <= bmapPtr->header.y1)
+ || (rectPtr[1] >= bmapPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= bmapPtr->header.x1)
+ && (rectPtr[1] <= bmapPtr->header.y1)
+ && (rectPtr[2] >= bmapPtr->header.x2)
+ && (rectPtr[3] >= bmapPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleBitmap --
+ *
+ * This procedure is invoked to rescale a bitmap item in a
+ * canvas. It is one of the standard item procedures for
+ * bitmap items, and is invoked by the generic canvas code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The item referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleBitmap(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing rectangle. */
+ Tk_Item *itemPtr; /* Rectangle to be scaled. */
+ double originX, originY; /* Origin about which to scale item. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ bmapPtr->x = originX + scaleX*(bmapPtr->x - originX);
+ bmapPtr->y = originY + scaleY*(bmapPtr->y - originY);
+ ComputeBitmapBbox(canvas, bmapPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateBitmap --
+ *
+ * This procedure is called to move an item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the item is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateBitmap(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ bmapPtr->x += deltaX;
+ bmapPtr->y += deltaY;
+ ComputeBitmapBbox(canvas, bmapPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * bitmap items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in the interp's result, replacing whatever used to be there.
+ * If no error occurs, then Postscript for the item is appended
+ * to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ double x, y;
+ int width, height, rowsAtOnce, rowsThisTime;
+ int curRow;
+ char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4];
+
+ if (bmapPtr->bitmap == None) {
+ return TCL_OK;
+ }
+
+ /*
+ * Compute the coordinates of the lower-left corner of the bitmap,
+ * taking into account the anchor position for the bitmp.
+ */
+
+ x = bmapPtr->x;
+ y = Tk_CanvasPsY(canvas, bmapPtr->y);
+ Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bmapPtr->bitmap,
+ &width, &height);
+ switch (bmapPtr->anchor) {
+ case TK_ANCHOR_NW: y -= height; break;
+ case TK_ANCHOR_N: x -= width/2.0; y -= height; break;
+ case TK_ANCHOR_NE: x -= width; y -= height; break;
+ case TK_ANCHOR_E: x -= width; y -= height/2.0; break;
+ case TK_ANCHOR_SE: x -= width; break;
+ case TK_ANCHOR_S: x -= width/2.0; break;
+ case TK_ANCHOR_SW: break;
+ case TK_ANCHOR_W: y -= height/2.0; break;
+ case TK_ANCHOR_CENTER: x -= width/2.0; y -= height/2.0; break;
+ }
+
+ /*
+ * Color the background, if there is one.
+ */
+
+ if (bmapPtr->bgColor != NULL) {
+ sprintf(buffer,
+ "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n",
+ x, y, width, height, -width, "0 rlineto closepath");
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, bmapPtr->bgColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+
+ /*
+ * Draw the bitmap, if there is a foreground color. If the bitmap
+ * is very large, then chop it up into multiple bitmaps, each
+ * consisting of one or more rows. This is needed because Postscript
+ * can't handle single strings longer than 64 KBytes long.
+ */
+
+ if (bmapPtr->fgColor != NULL) {
+ if (Tk_CanvasPsColor(interp, canvas, bmapPtr->fgColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (width > 60000) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't generate Postscript",
+ " for bitmaps more than 60000 pixels wide",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ rowsAtOnce = 60000/width;
+ if (rowsAtOnce < 1) {
+ rowsAtOnce = 1;
+ }
+ sprintf(buffer, "%.15g %.15g translate\n", x, y+height);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ for (curRow = 0; curRow < height; curRow += rowsAtOnce) {
+ rowsThisTime = rowsAtOnce;
+ if (rowsThisTime > (height - curRow)) {
+ rowsThisTime = height - curRow;
+ }
+ sprintf(buffer, "0 -%.15g translate\n%d %d true matrix {\n",
+ (double) rowsThisTime, width, rowsThisTime);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsBitmap(interp, canvas, bmapPtr->bitmap,
+ 0, curRow, width, rowsThisTime) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, "\n} imagemask\n", (char *) NULL);
+ }
+ }
+ return TCL_OK;
+}
--- /dev/null
+/*
+ * tkCanvImg.c --
+ *
+ * This file implements image items for canvas widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each image item.
+ */
+
+typedef struct ImageItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Canvas canvas; /* Canvas containing the image. */
+ double x, y; /* Coordinates of positioning point for
+ * image. */
+ Tk_Anchor anchor; /* Where to anchor image relative to
+ * (x,y). */
+ char *imageString; /* String describing -image option (malloc-ed).
+ * NULL means no image right now. */
+ char *activeImageString; /* String describing -activeimage option.
+ * NULL means no image right now. */
+ char *disabledImageString; /* String describing -disabledimage option.
+ * NULL means no image right now. */
+ Tk_Image image; /* Image to display in window, or NULL if
+ * no image at present. */
+ Tk_Image activeImage; /* Image to display in window, or NULL if
+ * no image at present. */
+ Tk_Image disabledImage; /* Image to display in window, or NULL if
+ * no image at present. */
+} ImageItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-activeimage", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ImageItem, activeImageString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(ImageItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-disabledimage", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ImageItem, disabledImageString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ImageItem, imageString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ImageChangedProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height, int imgWidth,
+ int imgHeight));
+static int ImageCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *CONST argv[]));
+static int ImageToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double ImageToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int ImageToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ComputeImageBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ ImageItem *imgPtr));
+static int ConfigureImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *CONST argv[], int flags));
+static int CreateImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, Tcl_Obj *CONST argv[]));
+static void DeleteImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the image item type in terms of
+ * procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkImageType = {
+ "image", /* name */
+ sizeof(ImageItem), /* itemSize */
+ CreateImage, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureImage, /* configureProc */
+ ImageCoords, /* coordProc */
+ DeleteImage, /* deleteProc */
+ DisplayImage, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ ImageToPoint, /* pointProc */
+ ImageToArea, /* areaProc */
+ ImageToPostscript, /* postscriptProc */
+ ScaleImage, /* scaleProc */
+ TranslateImage, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateImage --
+ *
+ * This procedure is invoked to create a new image
+ * item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new image item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateImage(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing rectangle. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ int i;
+
+ if (argc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj((Tcl_Obj *) argv[1], NULL);
+ if (((argc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z'))) {
+ i = 1;
+ } else {
+ i = 2;
+ }
+ }
+
+ if (argc < i) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x y ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ imgPtr->canvas = canvas;
+ imgPtr->anchor = TK_ANCHOR_CENTER;
+ imgPtr->imageString = NULL;
+ imgPtr->activeImageString = NULL;
+ imgPtr->disabledImageString = NULL;
+ imgPtr->image = NULL;
+ imgPtr->activeImage = NULL;
+ imgPtr->disabledImage = NULL;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((ImageCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureImage(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteImage(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on image items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if (argc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(imgPtr->x);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(imgPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if (argc < 3) {
+ if (argc==1) {
+ if (Tcl_ListObjGetElements(interp, argv[0], &argc,
+ (Tcl_Obj ***) &argv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (argc != 2) {
+ char buf[64];
+
+ sprintf(buf, "wrong # coordinates: expected 2, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1],
+ &imgPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeImageBbox(canvas, imgPtr);
+ } else {
+ char buf[64];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureImage --
+ *
+ * This procedure is invoked to configure various aspects
+ * of an image item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureImage(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Image item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ Tk_Window tkwin;
+ Tk_Image image;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, argc,
+ (CONST char **) argv, (char *) imgPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the image. Save the old image around and don't free it
+ * until after the new one is allocated. This keeps the reference
+ * count from going to zero so the image doesn't have to be recreated
+ * if it hasn't changed.
+ */
+
+ if (imgPtr->activeImageString != NULL) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+ if (imgPtr->imageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->imageString,
+ ImageChangedProc, (ClientData) imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+ imgPtr->image = image;
+ if (imgPtr->activeImageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->activeImageString,
+ ImageChangedProc, (ClientData) imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->activeImage != NULL) {
+ Tk_FreeImage(imgPtr->activeImage);
+ }
+ imgPtr->activeImage = image;
+ if (imgPtr->disabledImageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->disabledImageString,
+ ImageChangedProc, (ClientData) imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->disabledImage != NULL) {
+ Tk_FreeImage(imgPtr->disabledImage);
+ }
+ imgPtr->disabledImage = image;
+ ComputeImageBbox(canvas, imgPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteImage --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a image item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteImage(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if (imgPtr->imageString != NULL) {
+ ckfree(imgPtr->imageString);
+ }
+ if (imgPtr->activeImageString != NULL) {
+ ckfree(imgPtr->activeImageString);
+ }
+ if (imgPtr->disabledImageString != NULL) {
+ ckfree(imgPtr->disabledImageString);
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+ if (imgPtr->activeImage != NULL) {
+ Tk_FreeImage(imgPtr->activeImage);
+ }
+ if (imgPtr->disabledImage != NULL) {
+ Tk_FreeImage(imgPtr->disabledImage);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeImageBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a image item.
+ * This procedure is where the child image's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeImageBbox(canvas, imgPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ ImageItem *imgPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height;
+ int x, y;
+ Tk_Image image;
+ Tk_State state = imgPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ image = imgPtr->image;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)imgPtr) {
+ if (imgPtr->activeImage != NULL) {
+ image = imgPtr->activeImage;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (imgPtr->disabledImage != NULL) {
+ image = imgPtr->disabledImage;
+ }
+ }
+
+ x = (int) (imgPtr->x + ((imgPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (imgPtr->y + ((imgPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if ((state == TK_STATE_HIDDEN) || (image == None)) {
+ imgPtr->header.x1 = imgPtr->header.x2 = x;
+ imgPtr->header.y1 = imgPtr->header.y2 = y;
+ return;
+ }
+
+ /*
+ * Compute location and size of image, using anchor information.
+ */
+
+ Tk_SizeOfImage(image, &width, &height);
+ switch (imgPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ imgPtr->header.x1 = x;
+ imgPtr->header.y1 = y;
+ imgPtr->header.x2 = x + width;
+ imgPtr->header.y2 = y + height;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayImage --
+ *
+ * This procedure is invoked to draw a image item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayImage(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ short drawableX, drawableY;
+ Tk_Image image;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ image = imgPtr->image;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (imgPtr->activeImage != NULL) {
+ image = imgPtr->activeImage;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (imgPtr->disabledImage != NULL) {
+ image = imgPtr->disabledImage;
+ }
+ }
+
+ if (image == NULL) {
+ return;
+ }
+
+ /*
+ * Translate the coordinates to those of the image, then redisplay it.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, (double) x, (double) y,
+ &drawableX, &drawableY);
+ Tk_RedrawImage(image, x - imgPtr->header.x1, y - imgPtr->header.y1,
+ width, height, drawable, drawableX, drawableY);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the image. If the
+ * point isn't inside the image then the return value is the
+ * distance from the point to the image.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+ImageToPoint(canvas, itemPtr, coordPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *coordPtr; /* Pointer to x and y coordinates. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = imgPtr->header.x1;
+ y1 = imgPtr->header.y1;
+ x2 = imgPtr->header.x2;
+ y2 = imgPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (coordPtr[0] < x1) {
+ xDiff = x1 - coordPtr[0];
+ } else if (coordPtr[0] > x2) {
+ xDiff = coordPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (coordPtr[1] < y1) {
+ yDiff = y1 - coordPtr[1];
+ } else if (coordPtr[1] > y2) {
+ yDiff = coordPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if ((rectPtr[2] <= imgPtr->header.x1)
+ || (rectPtr[0] >= imgPtr->header.x2)
+ || (rectPtr[3] <= imgPtr->header.y1)
+ || (rectPtr[1] >= imgPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= imgPtr->header.x1)
+ && (rectPtr[1] <= imgPtr->header.y1)
+ && (rectPtr[2] >= imgPtr->header.x2)
+ && (rectPtr[3] >= imgPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * image items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used to be there.
+ * If no error occurs, then Postscript for the item is appended
+ * to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created.*/
+{
+ ImageItem *imgPtr = (ImageItem *)itemPtr;
+ Tk_Window canvasWin = Tk_CanvasTkwin(canvas);
+
+ char buffer[256];
+ double x, y;
+ int width, height;
+ Tk_Image image;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ image = imgPtr->image;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (imgPtr->activeImage != NULL) {
+ image = imgPtr->activeImage;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (imgPtr->disabledImage != NULL) {
+ image = imgPtr->disabledImage;
+ }
+ }
+ Tk_SizeOfImage(image, &width, &height);
+
+ /*
+ * Compute the coordinates of the lower-left corner of the image,
+ * taking into account the anchor position for the image.
+ */
+
+ x = imgPtr->x;
+ y = Tk_CanvasPsY(canvas, imgPtr->y);
+
+ switch (imgPtr->anchor) {
+ case TK_ANCHOR_NW: y -= height; break;
+ case TK_ANCHOR_N: x -= width/2.0; y -= height; break;
+ case TK_ANCHOR_NE: x -= width; y -= height; break;
+ case TK_ANCHOR_E: x -= width; y -= height/2.0; break;
+ case TK_ANCHOR_SE: x -= width; break;
+ case TK_ANCHOR_S: x -= width/2.0; break;
+ case TK_ANCHOR_SW: break;
+ case TK_ANCHOR_W: y -= height/2.0; break;
+ case TK_ANCHOR_CENTER: x -= width/2.0; y -= height/2.0; break;
+ }
+
+ if (image == NULL) {
+ return TCL_OK;
+ }
+
+ if (!prepass) {
+ sprintf(buffer, "%.15g %.15g", x, y);
+ Tcl_AppendResult(interp, buffer, " translate\n", (char *) NULL);
+ }
+
+ return Tk_PostscriptImage(image, interp, canvasWin,
+ ((TkCanvas *) canvas)->psInfo, 0, 0, width, height, prepass);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleImage --
+ *
+ * This procedure is invoked to rescale an item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The item referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleImage(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing rectangle. */
+ Tk_Item *itemPtr; /* Rectangle to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ imgPtr->x = originX + scaleX*(imgPtr->x - originX);
+ imgPtr->y = originY + scaleY*(imgPtr->y - originY);
+ ComputeImageBbox(canvas, imgPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateImage --
+ *
+ * This procedure is called to move an item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the item is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateImage(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ imgPtr->x += deltaX;
+ imgPtr->y += deltaY;
+ ComputeImageBbox(canvas, imgPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageChangedProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the image's size or
+ * how it is displayed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the canvas to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageChangedProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to canvas item for image. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ ImageItem *imgPtr = (ImageItem *) clientData;
+
+ /*
+ * If the image's size changed and it's not anchored at its
+ * northwest corner then just redisplay the entire area of the
+ * image. This is a bit over-conservative, but we need to do
+ * something because a size change also means a position change.
+ */
+
+ if (((imgPtr->header.x2 - imgPtr->header.x1) != imgWidth)
+ || ((imgPtr->header.y2 - imgPtr->header.y1) != imgHeight)) {
+ x = y = 0;
+ width = imgWidth;
+ height = imgHeight;
+ Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1,
+ imgPtr->header.y1, imgPtr->header.x2, imgPtr->header.y2);
+ }
+ ComputeImageBbox(imgPtr->canvas, imgPtr);
+ Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1 + x,
+ imgPtr->header.y1 + y, (int) (imgPtr->header.x1 + x + width),
+ (int) (imgPtr->header.y1 + y + height));
+}
--- /dev/null
+/*
+ * tkCanvLine.c --
+ *
+ * This file implements line items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each line item.
+ */
+
+typedef enum {
+ ARROWS_NONE, ARROWS_FIRST, ARROWS_LAST, ARROWS_BOTH
+} Arrows;
+
+typedef struct LineItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ Tk_Canvas canvas; /* Canvas containing item. Needed for
+ * parsing arrow shapes. */
+ int numPoints; /* Number of points in line (always >= 0). */
+ double *coordPtr; /* Pointer to malloc-ed array containing
+ * x- and y-coords of all points in line.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. If
+ * the line has arrowheads then the first
+ * and last points have been adjusted to refer
+ * to the necks of the arrowheads rather than
+ * their tips. The actual endpoints are
+ * stored in the *firstArrowPtr and
+ * *lastArrowPtr, if they exist. */
+ int capStyle; /* Cap style for line. */
+ int joinStyle; /* Join style for line. */
+ GC arrowGC; /* Graphics context for drawing arrowheads. */
+ Arrows arrow; /* Indicates whether or not to draw arrowheads:
+ * "none", "first", "last", or "both". */
+ float arrowShapeA; /* Distance from tip of arrowhead to center. */
+ float arrowShapeB; /* Distance from tip of arrowhead to trailing
+ * point, measured along shaft. */
+ float arrowShapeC; /* Distance of trailing points from outside
+ * edge of shaft. */
+ double *firstArrowPtr; /* Points to array of PTS_IN_ARROW points
+ * describing polygon for arrowhead at first
+ * point in line. First point of arrowhead
+ * is tip. Malloc'ed. NULL means no arrowhead
+ * at first point. */
+ double *lastArrowPtr; /* Points to polygon for arrowhead at last
+ * point in line (PTS_IN_ARROW points, first
+ * of which is tip). Malloc'ed. NULL means
+ * no arrowhead at last point. */
+ Tk_SmoothMethod *smooth; /* Non-zero means draw line smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+} LineItem;
+
+/*
+ * Number of points in an arrowHead:
+ */
+
+#define PTS_IN_ARROW 6
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int ArrowheadPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, LineItem *linePtr,
+ double *arrowPtr));
+static void ComputeLineBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ LineItem *linePtr));
+static int ConfigureLine _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int ConfigureArrows _ANSI_ARGS_((Tk_Canvas canvas,
+ LineItem *linePtr));
+static int CreateLine _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void DeleteLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int GetLineIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ Tcl_Obj *obj, int *indexPtr));
+static int LineCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void LineDeleteCoords _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last));
+static void LineInsert _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, Tcl_Obj *obj));
+static int LineToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double LineToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int LineToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static int ArrowParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST char *value, char *recordPtr, int offset));
+static char * ArrowPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static int ParseArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST char *value, char *recordPtr, int offset));
+static char * PrintArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static void ScaleLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * Information used for parsing configuration specs. If you change any
+ * of the default strings, be sure to change the corresponding default
+ * values in CreateLine.
+ */
+
+static Tk_CustomOption arrowShapeOption = {
+ (Tk_OptionParseProc *) ParseArrowShape,
+ PrintArrowShape, (ClientData) NULL
+};
+static Tk_CustomOption arrowOption = {
+ (Tk_OptionParseProc *) ArrowParseProc,
+ ArrowPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption smoothOption = {
+ (Tk_OptionParseProc *) TkSmoothParseProc,
+ TkSmoothPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption dashOption = {
+ (Tk_OptionParseProc *) TkCanvasDashParseProc,
+ TkCanvasDashPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc,
+ (ClientData) (TK_OFFSET_RELATIVE|TK_OFFSET_INDEX)
+};
+static Tk_CustomOption pixelOption = {
+ (Tk_OptionParseProc *) TkPixelParseProc,
+ TkPixelPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.activeColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-activewidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(LineItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-arrow", (char *) NULL, (char *) NULL,
+ "none", Tk_Offset(LineItem, arrow), TK_CONFIG_DONT_SET_DEFAULT, &arrowOption},
+ {TK_CONFIG_CUSTOM, "-arrowshape", (char *) NULL, (char *) NULL,
+ "8 10 3", Tk_Offset(LineItem, arrowShapeA),
+ TK_CONFIG_DONT_SET_DEFAULT, &arrowShapeOption},
+ {TK_CONFIG_CAP_STYLE, "-capstyle", (char *) NULL, (char *) NULL,
+ "butt", Tk_Offset(LineItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(LineItem, outline.color), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-dash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(LineItem, outline.offset),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-disableddash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(LineItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL,
+ "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(LineItem, outline.tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_CUSTOM, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(LineItem, smooth),
+ TK_CONFIG_DONT_SET_DEFAULT, &smoothOption},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(LineItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.stipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", (char *) NULL, (char *) NULL,
+ "1.0", Tk_Offset(LineItem, outline.width),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The structures below defines the line item type by means
+ * of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkLineType = {
+ "line", /* name */
+ sizeof(LineItem), /* itemSize */
+ CreateLine, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureLine, /* configureProc */
+ LineCoords, /* coordProc */
+ DeleteLine, /* deleteProc */
+ DisplayLine, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ LineToPoint, /* pointProc */
+ LineToArea, /* areaProc */
+ LineToPostscript, /* postscriptProc */
+ ScaleLine, /* scaleProc */
+ TranslateLine, /* translateProc */
+ (Tk_ItemIndexProc *) GetLineIndex, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) LineInsert, /* insertProc */
+ LineDeleteCoords, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+
+/*
+ * The definition below determines how large are static arrays
+ * used to hold spline points (splines larger than this have to
+ * have their arrays malloc-ed).
+ */
+
+#define MAX_STATIC_POINTS 200
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateLine --
+ *
+ * This procedure is invoked to create a new line item in
+ * a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new line item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateLine(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing line. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int i;
+
+ /*
+ * Carry out initialization that is needed to set defaults and to
+ * allow proper cleanup after errors during the the remainder of
+ * this procedure.
+ */
+
+ Tk_CreateOutline(&(linePtr->outline));
+ linePtr->canvas = canvas;
+ linePtr->numPoints = 0;
+ linePtr->coordPtr = NULL;
+ linePtr->capStyle = CapButt;
+ linePtr->joinStyle = JoinRound;
+ linePtr->arrowGC = None;
+ linePtr->arrow = ARROWS_NONE;
+ linePtr->arrowShapeA = (float)8.0;
+ linePtr->arrowShapeB = (float)10.0;
+ linePtr->arrowShapeC = (float)3.0;
+ linePtr->firstArrowPtr = NULL;
+ linePtr->lastArrowPtr = NULL;
+ linePtr->smooth = (Tk_SmoothMethod *) NULL;
+ linePtr->splineSteps = 12;
+
+ /*
+ * Count the number of points and then parse them into a point
+ * array. Leading arguments are assumed to be points if they
+ * start with a digit or a minus sign followed by a digit.
+ */
+
+ for (i = 0; i < objc; i++) {
+ char *arg = Tcl_GetString(objv[i]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ break;
+ }
+ }
+ if (i && (LineCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureLine(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteLine(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * LineCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on lines. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineCoords(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int i, numPoints;
+ double *coordPtr;
+
+ if (objc == 0) {
+ int numCoords;
+ Tcl_Obj *subobj, *obj = Tcl_NewObj();
+
+ numCoords = 2*linePtr->numPoints;
+ if (linePtr->firstArrowPtr != NULL) {
+ coordPtr = linePtr->firstArrowPtr;
+ } else {
+ coordPtr = linePtr->coordPtr;
+ }
+ for (i = 0; i < numCoords; i++, coordPtr++) {
+ if (i == 2) {
+ coordPtr = linePtr->coordPtr+2;
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (i == (numCoords-2))) {
+ coordPtr = linePtr->lastArrowPtr;
+ }
+ subobj = Tcl_NewDoubleObj(*coordPtr);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ }
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (objc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for line",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (objc < 4) {
+ Tcl_AppendResult(interp,
+ "too few coordinates specified for line",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = objc/2;
+ if (linePtr->numPoints != numPoints) {
+ coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * objc));
+ if (linePtr->coordPtr != NULL) {
+ ckfree((char *) linePtr->coordPtr);
+ }
+ linePtr->coordPtr = coordPtr;
+ linePtr->numPoints = numPoints;
+ }
+ coordPtr = linePtr->coordPtr;
+ for (i = 0; i <objc; i++) {
+ if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i],
+ coordPtr++) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Update arrowheads by throwing away any existing arrow-head
+ * information and calling ConfigureArrows to recompute it.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree((char *) linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ ComputeLineBbox(canvas, linePtr);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureLine --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a line item such as its background color.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureLine(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Line item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC, arrowGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) linePtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ if (linePtr->outline.activeWidth > linePtr->outline.width ||
+ linePtr->outline.activeDash.number != 0 ||
+ linePtr->outline.activeColor != NULL ||
+ linePtr->outline.activeStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr,
+ &(linePtr->outline));
+ if (mask) {
+ if (linePtr->arrow == ARROWS_NONE) {
+ gcValues.cap_style = linePtr->capStyle;
+ mask |= GCCapStyle;
+ }
+ gcValues.join_style = linePtr->joinStyle;
+ mask |= GCJoinStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ gcValues.line_width = 0;
+ arrowGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = arrowGC = None;
+ }
+ if (linePtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->outline.gc);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->arrowGC);
+ }
+ linePtr->outline.gc = newGC;
+ linePtr->arrowGC = arrowGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+
+ if (linePtr->splineSteps < 1) {
+ linePtr->splineSteps = 1;
+ } else if (linePtr->splineSteps > 100) {
+ linePtr->splineSteps = 100;
+ }
+
+ if ((!linePtr->numPoints) || (state==TK_STATE_HIDDEN)) {
+ ComputeLineBbox(canvas, linePtr);
+ return TCL_OK;
+ }
+
+ /*
+ * Setup arrowheads, if needed. If arrowheads are turned off,
+ * restore the line's endpoints (they were shortened when the
+ * arrowheads were added).
+ */
+
+ if ((linePtr->firstArrowPtr != NULL) && (linePtr->arrow != ARROWS_FIRST)
+ && (linePtr->arrow != ARROWS_BOTH)) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != ARROWS_LAST)
+ && (linePtr->arrow != ARROWS_BOTH)) {
+ int i;
+
+ i = 2*(linePtr->numPoints-1);
+ linePtr->coordPtr[i] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1];
+ ckfree((char *) linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+
+ /*
+ * Recompute bounding box for line.
+ */
+
+ ComputeLineBbox(canvas, linePtr);
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteLine --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteLine(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+
+ Tk_DeleteOutline(display, &(linePtr->outline));
+ if (linePtr->coordPtr != NULL) {
+ ckfree((char *) linePtr->coordPtr);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(display, linePtr->arrowGC);
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree((char *) linePtr->firstArrowPtr);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree((char *) linePtr->lastArrowPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeLineBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a line.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeLineBbox(canvas, linePtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ LineItem *linePtr; /* Item whose bbos is to be
+ * recomputed. */
+{
+ double *coordPtr;
+ int i, intWidth;
+ double width;
+ Tk_State state = linePtr->header.state;
+ Tk_TSOffset *tsoffset;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ if (!(linePtr->numPoints) || (state==TK_STATE_HIDDEN)) {
+ linePtr->header.x1 = -1;
+ linePtr->header.x2 = -1;
+ linePtr->header.y1 = -1;
+ linePtr->header.y2 = -1;
+ return;
+ }
+
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ coordPtr = linePtr->coordPtr;
+ linePtr->header.x1 = linePtr->header.x2 = (int) *coordPtr;
+ linePtr->header.y1 = linePtr->header.y2 = (int) coordPtr[1];
+
+ /*
+ * Compute the bounding box of all the points in the line,
+ * then expand in all directions by the line's width to take
+ * care of butting or rounded corners and projecting or
+ * rounded caps. This expansion is an overestimate (worst-case
+ * is square root of two over two) but it's simple. Don't do
+ * anything special for curves. This causes an additional
+ * overestimate in the bounding box, but is faster.
+ */
+
+ for (i = 1, coordPtr = linePtr->coordPtr+2; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ width = linePtr->outline.width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ TkIncludePoint((Tk_Item *) linePtr, linePtr->firstArrowPtr);
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ TkIncludePoint((Tk_Item *) linePtr, linePtr->lastArrowPtr);
+ }
+ }
+
+ tsoffset = &linePtr->outline.tsoffset;
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ double *coordPtr = linePtr->coordPtr + (tsoffset->flags & ~TK_OFFSET_INDEX);
+ if (tsoffset->flags <= 0) {
+ coordPtr = linePtr->coordPtr;
+ if ((linePtr->arrow == ARROWS_FIRST) || (linePtr->arrow == ARROWS_BOTH)) {
+ coordPtr = linePtr->firstArrowPtr;
+ }
+ }
+ if (tsoffset->flags > (linePtr->numPoints * 2)) {
+ coordPtr = linePtr->coordPtr + (linePtr->numPoints * 2);
+ if ((linePtr->arrow == ARROWS_LAST) || (linePtr->arrow == ARROWS_BOTH)) {
+ coordPtr = linePtr->lastArrowPtr;
+ }
+ }
+ tsoffset->xoffset = (int) (coordPtr[0] + 0.5);
+ tsoffset->yoffset = (int) (coordPtr[1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = linePtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (linePtr->header.x1 + linePtr->header.x2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = linePtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = linePtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (linePtr->header.y1 + linePtr->header.y2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = linePtr->header.y2;
+ }
+ }
+
+ intWidth = (int) (width + 0.5);
+ linePtr->header.x1 -= intWidth;
+ linePtr->header.x2 += intWidth;
+ linePtr->header.y1 -= intWidth;
+ linePtr->header.y2 += intWidth;
+
+ if (linePtr->numPoints==1) {
+ linePtr->header.x1 -= 1;
+ linePtr->header.x2 += 1;
+ linePtr->header.y1 -= 1;
+ linePtr->header.y2 += 1;
+ return;
+ }
+
+ /*
+ * For mitered lines, make a second pass through all the points.
+ * Compute the locations of the two miter vertex points and add
+ * those into the bounding box.
+ */
+
+ if (linePtr->joinStyle == JoinMiter) {
+ for (i = linePtr->numPoints, coordPtr = linePtr->coordPtr; i >= 3;
+ i--, coordPtr += 2) {
+ double miter[4];
+ int j;
+
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, miter+j);
+ }
+ }
+ }
+ }
+
+ /*
+ * Add in the sizes of arrowheads, if any.
+ */
+
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ }
+ }
+
+ /*
+ * Add one more pixel of fudge factor just to be safe (e.g.
+ * X may round differently than we do).
+ */
+
+ linePtr->header.x1 -= 1;
+ linePtr->header.x2 += 1;
+ linePtr->header.y1 -= 1;
+ linePtr->header.y2 += 1;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayLine --
+ *
+ * This procedure is invoked to draw a line item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+ XPoint *pPtr;
+ double *coordPtr, linewidth;
+ int i, numPoints;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple = linePtr->outline.stipple;
+
+ if ((!linePtr->numPoints)||(linePtr->outline.gc==None)) {
+ return;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ linewidth = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeStipple != None) {
+ stipple = linePtr->outline.activeStipple;
+ }
+ if (linePtr->outline.activeWidth != linewidth) {
+ linewidth = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledStipple != None) {
+ stipple = linePtr->outline.disabledStipple;
+ }
+ if (linePtr->outline.disabledWidth != linewidth) {
+ linewidth = linePtr->outline.disabledWidth;
+ }
+ }
+ /*
+ * Build up an array of points in screen coordinates. Use a
+ * static array unless the line has an enormous number of points;
+ * in this case, dynamically allocate an array. For smoothed lines,
+ * generate the curve points on each redisplay.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ } else {
+ numPoints = linePtr->numPoints;
+ }
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint)));
+ }
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, pointPtr,
+ (double *) NULL);
+ } else {
+ for (i = 0, coordPtr = linePtr->coordPtr, pPtr = pointPtr;
+ i < linePtr->numPoints; i += 1, coordPtr += 2, pPtr++) {
+ Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1],
+ &pPtr->x, &pPtr->y);
+ }
+ }
+
+ /*
+ * Display line, the free up line storage if it was dynamically
+ * allocated. If we're stippling, then modify the stipple offset
+ * in the GC. Be sure to reset the offset when done, since the
+ * GC is supposed to be read-only.
+ */
+
+ if (Tk_ChangeOutlineGC(canvas, itemPtr, &(linePtr->outline))) {
+ Tk_CanvasSetOffset(canvas, linePtr->arrowGC, &linePtr->outline.tsoffset);
+ }
+ if (numPoints>1) {
+ XDrawLines(display, drawable, linePtr->outline.gc, pointPtr, numPoints,
+ CoordModeOrigin);
+ } else {
+ int intwidth = (int) (linewidth + 0.5);
+ if (intwidth<1) {
+ intwidth=1;
+ }
+ XFillArc(display, drawable, linePtr->outline.gc,
+ pointPtr->x - intwidth/2, pointPtr->y - intwidth/2,
+ (unsigned int)intwidth+1, (unsigned int)intwidth+1, 0, 64*360);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+
+ /*
+ * Display arrowheads, if they are wanted.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->firstArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->arrowGC, NULL);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->lastArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->arrowGC, NULL);
+ }
+ if (Tk_ResetOutlineGC(canvas, itemPtr, &(linePtr->outline))) {
+ XSetTSOrigin(display, linePtr->arrowGC, 0, 0);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * LineInsert --
+ *
+ * Insert coords into a line item at a given index.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The coords in the given item is modified.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+LineInsert(canvas, itemPtr, beforeThis, obj)
+ Tk_Canvas canvas; /* Canvas containing text item. */
+ Tk_Item *itemPtr; /* Line item to be modified. */
+ int beforeThis; /* Index before which new coordinates
+ * are to be inserted. */
+ Tcl_Obj *obj; /* New coordinates to be inserted. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int length, objc, i;
+ double *new, *coordPtr;
+ Tk_State state = itemPtr->state;
+ Tcl_Obj **objv;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ if (!obj || (Tcl_ListObjGetElements((Tcl_Interp *) NULL, obj, &objc, &objv) != TCL_OK)
+ || !objc || objc&1) {
+ return;
+ }
+ length = 2*linePtr->numPoints;
+ if (beforeThis < 0) {
+ beforeThis = 0;
+ }
+ if (beforeThis > length) {
+ beforeThis = length;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ linePtr->coordPtr[length-2] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[length-1] = linePtr->lastArrowPtr[1];
+ }
+ new = (double *) ckalloc((unsigned)(sizeof(double) * (length + objc)));
+ for(i=0; i<beforeThis; i++) {
+ new[i] = linePtr->coordPtr[i];
+ }
+ for(i=0; i<objc; i++) {
+ if (Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,objv[i],
+ new+(i+beforeThis))!=TCL_OK) {
+ Tcl_ResetResult(((TkCanvas *)canvas)->interp);
+ ckfree((char *) new);
+ return;
+ }
+ }
+
+ for(i=beforeThis; i<length; i++) {
+ new[i+objc] = linePtr->coordPtr[i];
+ }
+ if(linePtr->coordPtr) ckfree((char *)linePtr->coordPtr);
+ linePtr->coordPtr = new;
+ linePtr->numPoints = (length + objc)/2;
+
+ if ((length>3) && (state != TK_STATE_HIDDEN)) {
+ /*
+ * This is some optimizing code that will result that only the part
+ * of the polygon that changed (and the objects that are overlapping
+ * with that part) need to be redrawn. A special flag is set that
+ * instructs the general canvas code not to redraw the whole
+ * object. If this flag is not set, the canvas will do the redrawing,
+ * otherwise I have to do it here.
+ */
+ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW;
+
+ if (beforeThis>0) {beforeThis -= 2; objc+=2; }
+ if ((beforeThis+objc)<length) objc+=2;
+ if (linePtr->smooth) {
+ if(beforeThis>0) {
+ beforeThis-=2; objc+=2;
+ }
+ if((beforeThis+objc+2)<length) {
+ objc+=2;
+ }
+ }
+ itemPtr->x1 = itemPtr->x2 = (int) linePtr->coordPtr[beforeThis];
+ itemPtr->y1 = itemPtr->y2 = (int) linePtr->coordPtr[beforeThis+1];
+ if ((linePtr->firstArrowPtr != NULL) && (beforeThis<1)) {
+ /* include old first arrow */
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+objc)>=length)) {
+ /* include old last arrow */
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ coordPtr = linePtr->coordPtr+beforeThis+2;
+ for(i=2; i<objc; i+=2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ coordPtr+=2;
+ }
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree((char *) linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+
+ if(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW) {
+ double width;
+ int intWidth;
+ if ((linePtr->firstArrowPtr != NULL) && (beforeThis>2)) {
+ /* include new first arrow */
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+objc)<(length-2))) {
+ /* include new right arrow */
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+ intWidth = (int) (width + 0.5);
+ if (intWidth < 1) {
+ intWidth = 1;
+ }
+ itemPtr->x1 -= intWidth; itemPtr->y1 -= intWidth;
+ itemPtr->x2 += intWidth; itemPtr->y2 += intWidth;
+ Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1,
+ itemPtr->x2, itemPtr->y2);
+ }
+
+ ComputeLineBbox(canvas, linePtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * LineDeleteCoords --
+ *
+ * Delete one or more coordinates from a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters between "first" and "last", inclusive, get
+ * deleted from itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+LineDeleteCoords(canvas, itemPtr, first, last)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item in which to delete characters. */
+ int first; /* Index of first character to delete. */
+ int last; /* Index of last character to delete. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int count, i, first1, last1;
+ int length = 2*linePtr->numPoints;
+ double *coordPtr;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ first &= -2;
+ last &= -2;
+
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= length) {
+ last = length-2;
+ }
+ if (first > last) {
+ return;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ linePtr->coordPtr[length-2] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[length-1] = linePtr->lastArrowPtr[1];
+ }
+ first1 = first; last1 = last;
+ if(first1>0) first1 -= 2;
+ if(last1<length-2) last1 += 2;
+ if (linePtr->smooth) {
+ if(first1>0) first1 -= 2;
+ if(last1<length-2) last1 += 2;
+ }
+
+ if((first1<2) && (last1 >= length-2)) {
+ /*
+ * This is some optimizing code that will result that only the part
+ * of the line that changed (and the objects that are overlapping
+ * with that part) need to be redrawn. A special flag is set that
+ * instructs the general canvas code not to redraw the whole
+ * object. If this flag is set, the redrawing has to be done here,
+ * otherwise the general Canvas code will take care of it.
+ */
+
+ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW;
+ itemPtr->x1 = itemPtr->x2 = (int) linePtr->coordPtr[first1];
+ itemPtr->y1 = itemPtr->y2 = (int) linePtr->coordPtr[first1+1];
+ if ((linePtr->firstArrowPtr != NULL) && (first1<2)) {
+ /* include old first arrow */
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (last1>=length-2)) {
+ /* include old last arrow */
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ coordPtr = linePtr->coordPtr+first1+2;
+ for (i=first1+2; i<=last1; i+=2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ coordPtr+=2;
+ }
+ }
+
+ count = last + 2 - first;
+ for (i=last+2; i<length; i++) {
+ linePtr->coordPtr[i-count] = linePtr->coordPtr[i];
+ }
+ linePtr->numPoints -= count/2;
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree((char *) linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ if(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW) {
+ double width;
+ int intWidth;
+ if ((linePtr->firstArrowPtr != NULL) && (first1<4)) {
+ /* include new first arrow */
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (last1>(length-4))) {
+ /* include new right arrow */
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+ intWidth = (int) (width + 0.5);
+ if (intWidth < 1) {
+ intWidth = 1;
+ }
+ itemPtr->x1 -= intWidth; itemPtr->y1 -= intWidth;
+ itemPtr->x2 += intWidth; itemPtr->y2 += intWidth;
+ Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1,
+ itemPtr->x2, itemPtr->y2);
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * line, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the line. If the
+ * point isn't inside the line then the return value is the
+ * distance from the point to the line.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+LineToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ Tk_State state = itemPtr->state;
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr, *linePoints;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double poly[10];
+ double bestDist, dist, width;
+ int numPoints, count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner
+ * had to be treated as beveled after all
+ * because the angle was < 11 degrees. */
+
+ bestDist = 1.0e36;
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ linePoints);
+ } else {
+ numPoints = linePtr->numPoints;
+ linePoints = linePtr->coordPtr;
+ }
+
+ if (width < 1.0) {
+ width = 1.0;
+ }
+
+ if (!numPoints || itemPtr->state==TK_STATE_HIDDEN) {
+ return bestDist;
+ } else if (numPoints == 1) {
+ bestDist = hypot(linePoints[0] - pointPtr[0], linePoints[1] - pointPtr[1])
+ - width/2.0;
+ if (bestDist < 0) bestDist = 0;
+ return bestDist;
+ }
+
+ /*
+ * The overall idea is to iterate through all of the edges of
+ * the line, computing a polygon for each edge and testing the
+ * point against that polygon. In addition, there are additional
+ * tests to deal with rounded joints and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = linePoints; count >= 2;
+ count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point then compute
+ * the distance between the point and the point.
+ */
+
+ if (((linePtr->capStyle == CapRound) && (count == numPoints))
+ || ((linePtr->joinStyle == JoinRound)
+ && (count != numPoints))) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - width/2.0;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge,
+ * consisting of two points for the first point of the edge
+ * and two points for the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, width,
+ linePtr->capStyle == CapProjecting, poly, poly+2);
+ } else if ((linePtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0,
+ poly, poly+2);
+
+ /*
+ * If this line uses beveled joints, then check the distance
+ * to a polygon comprising the last two points of the previous
+ * polygon and the first two from this polygon; this checks
+ * the wedges that fill the mitered joint.
+ */
+
+ if ((linePtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ linePtr->capStyle == CapProjecting, poly+4, poly+6);
+ } else if (linePtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0,
+ poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * If caps are rounded, check the distance to the cap around the
+ * final end point of the line.
+ */
+
+ if (linePtr->capStyle == CapRound) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - width/2.0;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * If there are arrowheads, check the distance to the arrowheads.
+ */
+
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ dist = TkPolygonToPoint(linePtr->lastArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ }
+
+ done:
+ if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) {
+ ckfree((char *) linePoints);
+ }
+ return bestDist;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the
+ * area, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+LineToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against line. */
+ double *rectPtr;
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double *linePoints;
+ int numPoints, result;
+ double radius, width;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ radius = (width+1.0)/2.0;
+
+ if ((state==TK_STATE_HIDDEN) || !linePtr->numPoints) {
+ return -1;
+ } else if (linePtr->numPoints == 1) {
+ double oval[4];
+ oval[0] = linePtr->coordPtr[0]-radius;
+ oval[1] = linePtr->coordPtr[1]-radius;
+ oval[2] = linePtr->coordPtr[0]+radius;
+ oval[3] = linePtr->coordPtr[1]+radius;
+ return TkOvalToArea(oval, rectPtr);
+ }
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ linePoints);
+ } else {
+ numPoints = linePtr->numPoints;
+ linePoints = linePtr->coordPtr;
+ }
+
+ /*
+ * Check the segments of the line.
+ */
+
+ if (width < 1.0) {
+ width = 1.0;
+ }
+
+ result = TkThickPolyLineToArea(linePoints, numPoints,
+ width, linePtr->capStyle, linePtr->joinStyle,
+ rectPtr);
+ if (result == 0) {
+ goto done;
+ }
+
+ /*
+ * Check arrowheads, if any.
+ */
+
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ if (TkPolygonToArea(linePtr->firstArrowPtr, PTS_IN_ARROW,
+ rectPtr) != result) {
+ result = 0;
+ goto done;
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ if (TkPolygonToArea(linePtr->lastArrowPtr, PTS_IN_ARROW,
+ rectPtr) != result) {
+ result = 0;
+ goto done;
+ }
+ }
+ }
+
+ done:
+ if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) {
+ ckfree((char *) linePoints);
+ }
+ return result;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleLine --
+ *
+ * This procedure is invoked to rescale a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The line referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleLine(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing line. */
+ Tk_Item *itemPtr; /* Line to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ /*
+ * Delete any arrowheads before scaling all the points (so that
+ * the end-points of the line get restored).
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ int i;
+
+ i = 2*(linePtr->numPoints-1);
+ linePtr->coordPtr[i] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1];
+ ckfree((char *) linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] = originX + scaleX*(*coordPtr - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GetLineIndex --
+ *
+ * Parse an index into a line item and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the index (into itemPtr) corresponding to
+ * string. Otherwise an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetLineIndex(interp, canvas, itemPtr, obj, indexPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item for which the index is being
+ * specified. */
+ Tcl_Obj *obj; /* Specification of a particular coord
+ * in itemPtr's line. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ size_t length;
+ char *string = Tcl_GetStringFromObj(obj, (int *) &length);
+
+ if (string[0] == 'e') {
+ if (strncmp(string, "end", length) == 0) {
+ *indexPtr = 2*linePtr->numPoints;
+ } 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 index \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (string[0] == '@') {
+ int i;
+ double x ,y, bestDist, dist, *coordPtr;
+ char *end, *p;
+
+ p = string+1;
+ x = strtod(p, &end);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ p = end+1;
+ y = strtod(p, &end);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ bestDist = 1.0e36;
+ coordPtr = linePtr->coordPtr;
+ *indexPtr = 0;
+ for(i=0; i<linePtr->numPoints; i++) {
+ dist = hypot(coordPtr[0] - x, coordPtr[1] - y);
+ if (dist<bestDist) {
+ bestDist = dist;
+ *indexPtr = 2*i;
+ }
+ coordPtr += 2;
+ }
+ } else {
+ if (Tcl_GetIntFromObj(interp, obj, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ *indexPtr &= -2; /* if index is odd, make it even */
+ if (*indexPtr < 0){
+ *indexPtr = 0;
+ } else if (*indexPtr > (2*linePtr->numPoints)) {
+ *indexPtr = (2*linePtr->numPoints);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateLine --
+ *
+ * This procedure is called to move a line by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the line is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateLine(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseArrowShape --
+ *
+ * This procedure is called back during option parsing to
+ * parse arrow shape information.
+ *
+ * Results:
+ * The return value is a standard Tcl result: TCL_OK means
+ * that the arrow shape information was parsed ok, and
+ * TCL_ERROR means it couldn't be parsed.
+ *
+ * Side effects:
+ * Arrow information in recordPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ParseArrowShape(clientData, interp, tkwin, value, recordPtr, offset)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Not used. */
+ CONST char *value; /* Textual specification of arrow shape. */
+ char *recordPtr; /* Pointer to item record in which to
+ * store arrow information. */
+ int offset; /* Offset of shape information in widget
+ * record. */
+{
+ LineItem *linePtr = (LineItem *) recordPtr;
+ double a, b, c;
+ int argc;
+ CONST char **argv = NULL;
+
+ if (offset != Tk_Offset(LineItem, arrowShapeA)) {
+ panic("ParseArrowShape received bogus offset");
+ }
+
+ if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) {
+ syntaxError:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad arrow shape \"", value,
+ "\": must be list with three numbers", (char *) NULL);
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ return TCL_ERROR;
+ }
+ if (argc != 3) {
+ goto syntaxError;
+ }
+ if ((Tk_CanvasGetCoord(interp, linePtr->canvas, argv[0], &a) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[1], &b)
+ != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[2], &c)
+ != TCL_OK)) {
+ goto syntaxError;
+ }
+ linePtr->arrowShapeA = (float)a;
+ linePtr->arrowShapeB = (float)b;
+ linePtr->arrowShapeC = (float)c;
+ ckfree((char *) argv);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * PrintArrowShape --
+ *
+ * This procedure is a callback invoked by the configuration
+ * code to return a printable value describing an arrow shape.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+PrintArrowShape(clientData, tkwin, recordPtr, offset, freeProcPtr)
+ ClientData clientData; /* Not used. */
+ Tk_Window tkwin; /* Window associated with linePtr's widget. */
+ char *recordPtr; /* Pointer to item record containing current
+ * shape information. */
+ int offset; /* Offset of arrow information in record. */
+ Tcl_FreeProc **freeProcPtr; /* Store address of procedure to call to
+ * free string here. */
+{
+ LineItem *linePtr = (LineItem *) recordPtr;
+ char *buffer;
+
+ buffer = (char *) ckalloc(120);
+ sprintf(buffer, "%.5g %.5g %.5g", linePtr->arrowShapeA,
+ linePtr->arrowShapeB, linePtr->arrowShapeC);
+ *freeProcPtr = TCL_DYNAMIC;
+ return buffer;
+}
+\f
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * the "-arrow" option.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The arrow for a given item gets replaced by the arrow
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArrowParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ int c;
+ size_t length;
+
+ register Arrows *arrowPtr = (Arrows *) (widgRec + offset);
+
+ if(value == NULL || *value == 0) {
+ *arrowPtr = ARROWS_NONE;
+ return TCL_OK;
+ }
+
+ c = value[0];
+ length = strlen(value);
+
+ if ((c == 'n') && (strncmp(value, "none", length) == 0)) {
+ *arrowPtr = ARROWS_NONE;
+ return TCL_OK;
+ }
+ if ((c == 'f') && (strncmp(value, "first", length) == 0)) {
+ *arrowPtr = ARROWS_FIRST;
+ return TCL_OK;
+ }
+ if ((c == 'l') && (strncmp(value, "last", length) == 0)) {
+ *arrowPtr = ARROWS_LAST;
+ return TCL_OK;
+ }
+ if ((c == 'b') && (strncmp(value, "both", length) == 0)) {
+ *arrowPtr = ARROWS_BOTH;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad arrow spec \"", value,
+ "\": must be none, first, last, or both",
+ (char *) NULL);
+ *arrowPtr = ARROWS_NONE;
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-arrow"
+ * configuration option.
+ *
+ * Results:
+ * The return value is a string describing the arrows for
+ * the item referred to by "widgRec". In addition, *freeProcPtr
+ * is filled in with the address of a procedure to call to free
+ * the result string when it's no longer needed (or NULL to
+ * indicate that the string doesn't need to be freed).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+ArrowPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Arrows *arrowPtr = (Arrows *) (widgRec + offset);
+
+ switch (*arrowPtr) {
+ case ARROWS_FIRST:
+ return "first";
+ case ARROWS_LAST:
+ return "last";
+ case ARROWS_BOTH:
+ return "both";
+ default:
+ return "none";
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArrows --
+ *
+ * If arrowheads have been requested for a line, this
+ * procedure makes arrangements for the arrowheads.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Information in linePtr is set up for one or two arrowheads.
+ * the firstArrowPtr and lastArrowPtr polygons are allocated
+ * and initialized, if need be, and the end points of the line
+ * are adjusted so that a thick line doesn't stick out past
+ * the arrowheads.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConfigureArrows(canvas, linePtr)
+ Tk_Canvas canvas; /* Canvas in which arrows will be
+ * displayed (interp and tkwin
+ * fields are needed). */
+ LineItem *linePtr; /* Item to configure for arrows. */
+{
+ double *poly, *coordPtr;
+ double dx, dy, length, sinTheta, cosTheta, temp;
+ double fracHeight; /* Line width as fraction of
+ * arrowhead width. */
+ double backup; /* Distance to backup end points
+ * so the line ends in the middle
+ * of the arrowhead. */
+ double vertX, vertY; /* Position of arrowhead vertex. */
+ double shapeA, shapeB, shapeC; /* Adjusted coordinates (see
+ * explanation below). */
+ double width;
+ Tk_State state = linePtr->header.state;
+
+ if (linePtr->numPoints <2) {
+ return TCL_OK;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * The code below makes a tiny increase in the shape parameters
+ * for the line. This is a bit of a hack, but it seems to result
+ * in displays that more closely approximate the specified parameters.
+ * Without the adjustment, the arrows come out smaller than expected.
+ */
+
+ shapeA = linePtr->arrowShapeA + 0.001;
+ shapeB = linePtr->arrowShapeB + 0.001;
+ shapeC = linePtr->arrowShapeC + width/2.0 + 0.001;
+
+ /*
+ * If there's an arrowhead on the first point of the line, compute
+ * its polygon and adjust the first point of the line so that the
+ * line doesn't stick out past the leading edge of the arrowhead.
+ */
+
+ fracHeight = (width/2.0)/shapeC;
+ backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0;
+ if (linePtr->arrow != ARROWS_LAST) {
+ poly = linePtr->firstArrowPtr;
+ if (poly == NULL) {
+ poly = (double *) ckalloc((unsigned)
+ (2*PTS_IN_ARROW*sizeof(double)));
+ poly[0] = poly[10] = linePtr->coordPtr[0];
+ poly[1] = poly[11] = linePtr->coordPtr[1];
+ linePtr->firstArrowPtr = poly;
+ }
+ dx = poly[0] - linePtr->coordPtr[2];
+ dy = poly[1] - linePtr->coordPtr[3];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - shapeA*cosTheta;
+ vertY = poly[1] - shapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - shapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - shapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+
+ /*
+ * Polygon done. Now move the first point towards the second so
+ * that the corners at the end of the line are inside the
+ * arrowhead.
+ */
+
+ linePtr->coordPtr[0] = poly[0] - backup*cosTheta;
+ linePtr->coordPtr[1] = poly[1] - backup*sinTheta;
+ }
+
+ /*
+ * Similar arrowhead calculation for the last point of the line.
+ */
+
+ if (linePtr->arrow != ARROWS_FIRST) {
+ coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2);
+ poly = linePtr->lastArrowPtr;
+ if (poly == NULL) {
+ poly = (double *) ckalloc((unsigned)
+ (2*PTS_IN_ARROW*sizeof(double)));
+ poly[0] = poly[10] = coordPtr[2];
+ poly[1] = poly[11] = coordPtr[3];
+ linePtr->lastArrowPtr = poly;
+ }
+ dx = poly[0] - coordPtr[0];
+ dy = poly[1] - coordPtr[1];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - shapeA*cosTheta;
+ vertY = poly[1] - shapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - shapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - shapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+ coordPtr[2] = poly[0] - backup*cosTheta;
+ coordPtr[3] = poly[1] - backup*sinTheta;
+ }
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * line items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ char buffer[64 + TCL_INTEGER_SPACE];
+ char *style;
+
+ double width;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ color = linePtr->outline.color;
+ stipple = linePtr->outline.stipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ if (linePtr->outline.activeColor!=NULL) {
+ color = linePtr->outline.activeColor;
+ }
+ if (linePtr->outline.activeStipple!=None) {
+ stipple = linePtr->outline.activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ if (linePtr->outline.disabledColor!=NULL) {
+ color = linePtr->outline.disabledColor;
+ }
+ if (linePtr->outline.disabledStipple!=None) {
+ stipple = linePtr->outline.disabledStipple;
+ }
+ }
+
+ if (color == NULL || linePtr->numPoints<1 || linePtr->coordPtr==NULL) {
+ return TCL_OK;
+ }
+
+ if (linePtr->numPoints==1) {
+ sprintf(buffer, "%.15g %.15g translate %.15g %.15g",
+ linePtr->coordPtr[0], Tk_CanvasPsY(canvas, linePtr->coordPtr[1]),
+ width/2.0, width/2.0);
+ Tcl_AppendResult(interp, "matrix currentmatrix\n",buffer,
+ " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, color)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ return TCL_OK;
+ }
+ /*
+ * Generate a path for the line's center-line (do this differently
+ * for straight lines and smoothed lines).
+ */
+
+ if ((!linePtr->smooth) || (linePtr->numPoints < 3)) {
+ Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints);
+ } else {
+ if ((stipple == None) && linePtr->smooth->postscriptProc) {
+ linePtr->smooth->postscriptProc(interp, canvas,
+ linePtr->coordPtr, linePtr->numPoints, linePtr->splineSteps);
+ } else {
+ /*
+ * Special hack: Postscript printers don't appear to be able
+ * to turn a path drawn with "curveto"s into a clipping path
+ * without exceeding resource limits, so TkMakeBezierPostscript
+ * won't work for stippled curves. Instead, generate all of
+ * the intermediate points here and output them into the
+ * Postscript file with "lineto"s instead.
+ */
+
+ double staticPoints[2*MAX_STATIC_POINTS];
+ double *pointPtr;
+ int numPoints;
+
+ numPoints = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ pointPtr = staticPoints;
+ if (numPoints > MAX_STATIC_POINTS) {
+ pointPtr = (double *) ckalloc((unsigned)
+ (numPoints * 2 * sizeof(double)));
+ }
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ pointPtr);
+ Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints);
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+ }
+ }
+
+ /*
+ * Set other line-drawing parameters and stroke out the line.
+ */
+
+ style = "0 setlinecap\n";
+ if (linePtr->capStyle == CapRound) {
+ style = "1 setlinecap\n";
+ } else if (linePtr->capStyle == CapProjecting) {
+ style = "2 setlinecap\n";
+ }
+ Tcl_AppendResult(interp, style, (char *) NULL);
+ style = "0 setlinejoin\n";
+ if (linePtr->joinStyle == JoinRound) {
+ style = "1 setlinejoin\n";
+ } else if (linePtr->joinStyle == JoinBevel) {
+ style = "2 setlinejoin\n";
+ }
+ Tcl_AppendResult(interp, style, (char *) NULL);
+
+ if (Tk_CanvasPsOutline(canvas, itemPtr,
+ &(linePtr->outline)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Output polygons for the arrowheads, if there are any.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n",
+ (char *) NULL);
+ }
+ if (ArrowheadPostscript(interp, canvas, linePtr,
+ linePtr->firstArrowPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ if (ArrowheadPostscript(interp, canvas, linePtr,
+ linePtr->lastArrowPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowheadPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * an arrowhead for a line item.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * arrowhead is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArrowheadPostscript(interp, canvas, linePtr, arrowPtr)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ LineItem *linePtr; /* Line item for which Postscript is
+ * being generated. */
+ double *arrowPtr; /* Pointer to first of five points
+ * describing arrowhead polygon. */
+{
+ Pixmap stipple;
+ Tk_State state = linePtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ stipple = linePtr->outline.stipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) {
+ if (linePtr->outline.activeStipple!=None) {
+ stipple = linePtr->outline.activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.activeStipple!=None) {
+ stipple = linePtr->outline.disabledStipple;
+ }
+ }
+
+ Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW);
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ return TCL_OK;
+}
--- /dev/null
+/*
+ * tkCanvPoly.c --
+ *
+ * This file implements polygon items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each polygon item.
+ */
+
+typedef struct PolygonItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ int numPoints; /* Number of points in polygon.
+ * Polygon is always closed. */
+ int pointsAllocated; /* Number of points for which space is
+ * allocated at *coordPtr. */
+ double *coordPtr; /* Pointer to malloc-ed array containing
+ * x- and y-coords of all points in polygon.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. */
+ int joinStyle; /* Join style for outline */
+ Tk_TSOffset tsoffset;
+ XColor *fillColor; /* Foreground color for polygon. */
+ XColor *activeFillColor; /* Foreground color for polygon if state is active. */
+ XColor *disabledFillColor; /* Foreground color for polygon if state is disabled. */
+ Pixmap fillStipple; /* Stipple bitmap for filling polygon. */
+ Pixmap activeFillStipple; /* Stipple bitmap for filling polygon if state is active. */
+ Pixmap disabledFillStipple; /* Stipple bitmap for filling polygon if state is disabled. */
+ GC fillGC; /* Graphics context for filling polygon. */
+ Tk_SmoothMethod *smooth; /* Non-zero means draw shape smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+ int autoClosed; /* Zero means the given polygon was closed,
+ one means that we auto closed it. */
+} PolygonItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption smoothOption = {
+ (Tk_OptionParseProc *) TkSmoothParseProc,
+ TkSmoothPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption dashOption = {
+ (Tk_OptionParseProc *) TkCanvasDashParseProc,
+ TkCanvasDashPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc,
+ (ClientData) (TK_OFFSET_RELATIVE|TK_OFFSET_INDEX)
+};
+static Tk_CustomOption pixelOption = {
+ (Tk_OptionParseProc *) TkPixelParseProc,
+ TkPixelPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, activeFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-activeoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.activeColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activeoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, activeFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-activewidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(PolygonItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-dash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(PolygonItem, outline.offset),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-disableddash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, disabledFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, disabledFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(PolygonItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(PolygonItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL,
+ "round", Tk_Offset(PolygonItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(PolygonItem, tsoffset),
+ TK_CONFIG_NULL_OK, &offsetOption},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.color),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-outlineoffset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(PolygonItem, outline.tsoffset),
+ TK_CONFIG_NULL_OK, &offsetOption},
+ {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.stipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(PolygonItem, smooth),
+ TK_CONFIG_DONT_SET_DEFAULT, &smoothOption},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(PolygonItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", (char *) NULL, (char *) NULL,
+ "1.0", Tk_Offset(PolygonItem, outline.width),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputePolygonBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ PolygonItem *polyPtr));
+static int ConfigurePolygon _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreatePolygon _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void DeletePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayPolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int GetPolygonIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ Tcl_Obj *obj, int *indexPtr));
+static int PolygonCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void PolygonDeleteCoords _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last));
+static void PolygonInsert _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, Tcl_Obj *obj));
+static int PolygonToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double PolygonToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static int PolygonToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ScalePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslatePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the polygon item type by means
+ * of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkPolygonType = {
+ "polygon", /* name */
+ sizeof(PolygonItem), /* itemSize */
+ CreatePolygon, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigurePolygon, /* configureProc */
+ PolygonCoords, /* coordProc */
+ DeletePolygon, /* deleteProc */
+ DisplayPolygon, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ PolygonToPoint, /* pointProc */
+ PolygonToArea, /* areaProc */
+ PolygonToPostscript, /* postscriptProc */
+ ScalePolygon, /* scaleProc */
+ TranslatePolygon, /* translateProc */
+ (Tk_ItemIndexProc *) GetPolygonIndex,/* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) PolygonInsert,/* insertProc */
+ PolygonDeleteCoords, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+
+/*
+ * The definition below determines how large are static arrays
+ * used to hold spline points (splines larger than this have to
+ * have their arrays malloc-ed).
+ */
+
+#define MAX_STATIC_POINTS 200
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CreatePolygon --
+ *
+ * This procedure is invoked to create a new polygon item in
+ * a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new polygon item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreatePolygon(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing polygon. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int i;
+
+ /*
+ * Carry out initialization that is needed in order to clean
+ * up after errors during the the remainder of this procedure.
+ */
+
+ Tk_CreateOutline(&(polyPtr->outline));
+ polyPtr->numPoints = 0;
+ polyPtr->pointsAllocated = 0;
+ polyPtr->coordPtr = NULL;
+ polyPtr->joinStyle = JoinRound;
+ polyPtr->tsoffset.flags = 0;
+ polyPtr->tsoffset.xoffset = 0;
+ polyPtr->tsoffset.yoffset = 0;
+ polyPtr->fillColor = NULL;
+ polyPtr->activeFillColor = NULL;
+ polyPtr->disabledFillColor = NULL;
+ polyPtr->fillStipple = None;
+ polyPtr->activeFillStipple = None;
+ polyPtr->disabledFillStipple = None;
+ polyPtr->fillGC = None;
+ polyPtr->smooth = (Tk_SmoothMethod *) NULL;
+ polyPtr->splineSteps = 12;
+ polyPtr->autoClosed = 0;
+
+ /*
+ * Count the number of points and then parse them into a point
+ * array. Leading arguments are assumed to be points if they
+ * start with a digit or a minus sign followed by a digit.
+ */
+
+ for (i = 0; i < objc; i++) {
+ char *arg = Tcl_GetString(objv[i]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ break;
+ }
+ }
+ if (i && PolygonCoords(interp, canvas, itemPtr, i, objv) != TCL_OK) {
+ goto error;
+ }
+
+ if (ConfigurePolygon(interp, canvas, itemPtr, objc-i, objv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeletePolygon(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on polygons. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonCoords(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int i, numPoints;
+
+ if (objc == 0) {
+ /*
+ * Print the coords used to create the polygon. If we auto
+ * closed the polygon then we don't report the last point.
+ */
+ Tcl_Obj *subobj, *obj = Tcl_NewObj();
+ for (i = 0; i < 2*(polyPtr->numPoints - polyPtr->autoClosed); i++) {
+ subobj = Tcl_NewDoubleObj(polyPtr->coordPtr[i]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ }
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (objc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for polygon",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = objc/2;
+ if (polyPtr->pointsAllocated <= numPoints) {
+ if (polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+
+ /*
+ * One extra point gets allocated here, because we always
+ * add another point to close the polygon.
+ */
+
+ polyPtr->coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * (objc+2)));
+ polyPtr->pointsAllocated = numPoints+1;
+ }
+ for (i = objc-1; i >= 0; i--) {
+ if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i],
+ &polyPtr->coordPtr[i]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ polyPtr->numPoints = numPoints;
+ polyPtr->autoClosed = 0;
+
+ /*
+ * Close the polygon if it isn't already closed.
+ */
+
+ if (objc>2 && ((polyPtr->coordPtr[objc-2] != polyPtr->coordPtr[0])
+ || (polyPtr->coordPtr[objc-1] != polyPtr->coordPtr[1]))) {
+ polyPtr->autoClosed = 1;
+ polyPtr->numPoints++;
+ polyPtr->coordPtr[objc] = polyPtr->coordPtr[0];
+ polyPtr->coordPtr[objc+1] = polyPtr->coordPtr[1];
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigurePolygon --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a polygon item such as its background color.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigurePolygon(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Polygon item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) polyPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ state = itemPtr->state;
+
+ if (polyPtr->outline.activeWidth > polyPtr->outline.width ||
+ polyPtr->outline.activeDash.number != 0 ||
+ polyPtr->outline.activeColor != NULL ||
+ polyPtr->outline.activeStipple != None ||
+ polyPtr->activeFillColor != NULL ||
+ polyPtr->activeFillStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ ComputePolygonBbox(canvas, polyPtr);
+ return TCL_OK;
+ }
+
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &(polyPtr->outline));
+ if (mask) {
+ gcValues.cap_style = CapRound;
+ gcValues.join_style = polyPtr->joinStyle;
+ mask |= GCCapStyle|GCJoinStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (polyPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->outline.gc);
+ }
+ polyPtr->outline.gc = newGC;
+
+ color = polyPtr->fillColor;
+ stipple = polyPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->activeFillColor!=NULL) {
+ color = polyPtr->activeFillColor;
+ }
+ if (polyPtr->activeFillStipple!=None) {
+ stipple = polyPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->disabledFillColor!=NULL) {
+ color = polyPtr->disabledFillColor;
+ }
+ if (polyPtr->disabledFillStipple!=None) {
+ stipple = polyPtr->disabledFillStipple;
+ }
+ }
+
+ if (color == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = color->pixel;
+ mask = GCForeground;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (polyPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->fillGC);
+ }
+ polyPtr->fillGC = newGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+
+ if (polyPtr->splineSteps < 1) {
+ polyPtr->splineSteps = 1;
+ } else if (polyPtr->splineSteps > 100) {
+ polyPtr->splineSteps = 100;
+ }
+
+ ComputePolygonBbox(canvas, polyPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeletePolygon --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeletePolygon(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+
+ Tk_DeleteOutline(display,&(polyPtr->outline));
+ if (polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+ if (polyPtr->fillColor != NULL) {
+ Tk_FreeColor(polyPtr->fillColor);
+ }
+ if (polyPtr->activeFillColor != NULL) {
+ Tk_FreeColor(polyPtr->activeFillColor);
+ }
+ if (polyPtr->disabledFillColor != NULL) {
+ Tk_FreeColor(polyPtr->disabledFillColor);
+ }
+ if (polyPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->fillStipple);
+ }
+ if (polyPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->activeFillStipple);
+ }
+ if (polyPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->disabledFillStipple);
+ }
+ if (polyPtr->fillGC != None) {
+ Tk_FreeGC(display, polyPtr->fillGC);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputePolygonBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputePolygonBbox(canvas, polyPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ PolygonItem *polyPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ double *coordPtr;
+ int i;
+ double width;
+ Tk_State state = polyPtr->header.state;
+ Tk_TSOffset *tsoffset;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = polyPtr->outline.width;
+ if (polyPtr->coordPtr == NULL || (polyPtr->numPoints < 1) || (state==TK_STATE_HIDDEN)) {
+ polyPtr->header.x1 = polyPtr->header.x2 =
+ polyPtr->header.y1 = polyPtr->header.y2 = -1;
+ return;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)polyPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+
+ coordPtr = polyPtr->coordPtr;
+ polyPtr->header.x1 = polyPtr->header.x2 = (int) *coordPtr;
+ polyPtr->header.y1 = polyPtr->header.y2 = (int) coordPtr[1];
+
+ /*
+ * Compute the bounding box of all the points in the polygon,
+ * then expand in all directions by the outline's width to take
+ * care of butting or rounded corners and projecting or
+ * rounded caps. This expansion is an overestimate (worst-case
+ * is square root of two over two) but it's simple. Don't do
+ * anything special for curves. This causes an additional
+ * overestimate in the bounding box, but is faster.
+ */
+
+ for (i = 1, coordPtr = polyPtr->coordPtr+2; i < polyPtr->numPoints-1;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, coordPtr);
+ }
+
+ tsoffset = &polyPtr->tsoffset;
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ int index = tsoffset->flags & ~TK_OFFSET_INDEX;
+ if (tsoffset->flags == INT_MAX) {
+ index = (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ if (index < 0) {
+ index = 0;
+ }
+ }
+ index %= (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ if (index <0) {
+ index += (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ }
+ tsoffset->xoffset = (int) (polyPtr->coordPtr[index] + 0.5);
+ tsoffset->yoffset = (int) (polyPtr->coordPtr[index+1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = polyPtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (polyPtr->header.x1 + polyPtr->header.x2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = polyPtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = polyPtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (polyPtr->header.y1 + polyPtr->header.y2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = polyPtr->header.y2;
+ }
+ }
+
+ if (polyPtr->outline.gc != None) {
+ tsoffset = &polyPtr->outline.tsoffset;
+ if (tsoffset) {
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ int index = tsoffset->flags & ~TK_OFFSET_INDEX;
+ if (tsoffset->flags == INT_MAX) {
+ index = (polyPtr->numPoints - 1) * 2;
+ }
+ index %= (polyPtr->numPoints - 1) * 2;
+ if (index <0) {
+ index += (polyPtr->numPoints - 1) * 2;
+ }
+ tsoffset->xoffset = (int) (polyPtr->coordPtr[index] + 0.5);
+ tsoffset->yoffset = (int) (polyPtr->coordPtr[index+1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = polyPtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (polyPtr->header.x1 + polyPtr->header.x2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = polyPtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = polyPtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (polyPtr->header.y1 + polyPtr->header.y2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = polyPtr->header.y2;
+ }
+ }
+ }
+
+ i = (int) ((width+1.5)/2.0);
+ polyPtr->header.x1 -= i;
+ polyPtr->header.x2 += i;
+ polyPtr->header.y1 -= i;
+ polyPtr->header.y2 += i;
+
+ /*
+ * For mitered lines, make a second pass through all the points.
+ * Compute the locations of the two miter vertex points and add
+ * those into the bounding box.
+ */
+
+ if (polyPtr->joinStyle == JoinMiter) {
+ double miter[4];
+ int j;
+ coordPtr = polyPtr->coordPtr;
+ if (polyPtr->numPoints>3) {
+ if (TkGetMiterPoints(coordPtr+2*(polyPtr->numPoints-2),
+ coordPtr, coordPtr+2, width,
+ miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, miter+j);
+ }
+ }
+ }
+ for (i = polyPtr->numPoints ; i >= 3;
+ i--, coordPtr += 2) {
+
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, miter+j);
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Add one more pixel of fudge factor just to be safe (e.g.
+ * X may round differently than we do).
+ */
+
+ polyPtr->header.x1 -= 1;
+ polyPtr->header.x2 += 1;
+ polyPtr->header.y1 -= 1;
+ polyPtr->header.y2 += 1;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFillPolygon --
+ *
+ * This procedure is invoked to convert a polygon to screen
+ * coordinates and display it using a particular GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkFillPolygon(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC)
+ Tk_Canvas canvas; /* Canvas whose coordinate system
+ * is to be used for drawing. */
+ double *coordPtr; /* Array of coordinates for polygon:
+ * x1, y1, x2, y2, .... */
+ int numPoints; /* Twice this many coordinates are
+ * present at *coordPtr. */
+ Display *display; /* Display on which to draw polygon. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * polygon. */
+ GC gc; /* Graphics context for drawing. */
+ GC outlineGC; /* If not None, use this to draw an
+ * outline around the polygon after
+ * filling it. */
+{
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+ XPoint *pPtr;
+ int i;
+
+ /*
+ * Build up an array of points in screen coordinates. Use a
+ * static array unless the polygon has an enormous number of points;
+ * in this case, dynamically allocate an array.
+ */
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint)));
+ }
+
+ for (i = 0, pPtr = pointPtr; i < numPoints; i += 1, coordPtr += 2, pPtr++) {
+ Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1], &pPtr->x,
+ &pPtr->y);
+ }
+
+ /*
+ * Display polygon, then free up polygon storage if it was dynamically
+ * allocated.
+ */
+
+ if (gc != None && numPoints>3) {
+ XFillPolygon(display, drawable, gc, pointPtr, numPoints, Complex,
+ CoordModeOrigin);
+ }
+ if (outlineGC != None) {
+ XDrawLines(display, drawable, outlineGC, pointPtr,
+ numPoints, CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayPolygon --
+ *
+ * This procedure is invoked to draw a polygon item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayPolygon(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple = polyPtr->fillStipple;
+ double linewidth = polyPtr->outline.width;
+
+ if (((polyPtr->fillGC == None) && (polyPtr->outline.gc == None)) ||
+ (polyPtr->numPoints < 1) ||
+ (polyPtr->numPoints < 3 && polyPtr->outline.gc == None)) {
+ return;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>linewidth) {
+ linewidth = polyPtr->outline.activeWidth;
+ }
+ if (polyPtr->activeFillStipple != None) {
+ stipple = polyPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ linewidth = polyPtr->outline.disabledWidth;
+ }
+ if (polyPtr->disabledFillStipple != None) {
+ stipple = polyPtr->disabledFillStipple;
+ }
+ }
+ /*
+ * If we're stippling then modify the stipple offset in the GC. Be
+ * sure to reset the offset when done, since the GC is supposed to be
+ * read-only.
+ */
+
+ if ((stipple != None) && (polyPtr->fillGC != None)) {
+ Tk_TSOffset *tsoffset = &polyPtr->tsoffset;
+ int w=0; int h=0;
+ int flags = tsoffset->flags;
+ if (!(flags & TK_OFFSET_INDEX) && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) {
+ Tk_SizeOfBitmap(display, stipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ Tk_CanvasSetOffset(canvas, polyPtr->fillGC, tsoffset);
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ }
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(polyPtr->outline));
+
+ if(polyPtr->numPoints < 3) {
+ short x,y;
+ int intLineWidth = (int) (linewidth + 0.5);
+ if (intLineWidth < 1) {
+ intLineWidth = 1;
+ }
+ Tk_CanvasDrawableCoords(canvas, polyPtr->coordPtr[0],
+ polyPtr->coordPtr[1], &x,&y);
+ XFillArc(display, drawable, polyPtr->outline.gc,
+ x - intLineWidth/2, y - intLineWidth/2,
+ (unsigned int)intLineWidth+1, (unsigned int)intLineWidth+1,
+ 0, 64*360);
+ } else if (!polyPtr->smooth || polyPtr->numPoints < 4) {
+ TkFillPolygon(canvas, polyPtr->coordPtr, polyPtr->numPoints,
+ display, drawable, polyPtr->fillGC, polyPtr->outline.gc);
+ } else {
+ int numPoints;
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+
+ /*
+ * This is a smoothed polygon. Display using a set of generated
+ * spline points rather than the original points.
+ */
+
+ numPoints = polyPtr->smooth->coordProc(canvas, (double *) NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned)
+ (numPoints * sizeof(XPoint)));
+ }
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, pointPtr,
+ (double *) NULL);
+ if (polyPtr->fillGC != None) {
+ XFillPolygon(display, drawable, polyPtr->fillGC, pointPtr,
+ numPoints, Complex, CoordModeOrigin);
+ }
+ if (polyPtr->outline.gc != None) {
+ XDrawLines(display, drawable, polyPtr->outline.gc, pointPtr,
+ numPoints, CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+ }
+ Tk_ResetOutlineGC(canvas, itemPtr, &(polyPtr->outline));
+ if ((stipple != None) && (polyPtr->fillGC != None)) {
+ XSetTSOrigin(display, polyPtr->fillGC, 0, 0);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonInsert --
+ *
+ * Insert coords into a polugon item at a given index.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The coords in the given item is modified.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PolygonInsert(canvas, itemPtr, beforeThis, obj)
+ Tk_Canvas canvas; /* Canvas containing text item. */
+ Tk_Item *itemPtr; /* Line item to be modified. */
+ int beforeThis; /* Index before which new coordinates
+ * are to be inserted. */
+ Tcl_Obj *obj; /* New coordinates to be inserted. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int length, objc, i;
+ Tcl_Obj **objv;
+ double *new;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ if (!obj || (Tcl_ListObjGetElements((Tcl_Interp *) NULL, obj, &objc, &objv) != TCL_OK)
+ || !objc || objc&1) {
+ return;
+ }
+ length = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+ while(beforeThis>length) beforeThis-=length;
+ while(beforeThis<0) beforeThis+=length;
+ new = (double *) ckalloc((unsigned)(sizeof(double) * (length + 2 + objc)));
+ for (i=0; i<beforeThis; i++) {
+ new[i] = polyPtr->coordPtr[i];
+ }
+ for (i=0; i<objc; i++) {
+ if (Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,objv[i],
+ new+(i+beforeThis))!=TCL_OK) {
+ ckfree((char *) new);
+ return;
+ }
+ }
+
+ for(i=beforeThis; i<length; i++) {
+ new[i+objc] = polyPtr->coordPtr[i];
+ }
+ if(polyPtr->coordPtr) ckfree((char *) polyPtr->coordPtr);
+ length+=objc;
+ polyPtr->coordPtr = new;
+ polyPtr->numPoints = (length/2) + polyPtr->autoClosed;
+
+ /*
+ * Close the polygon if it isn't already closed, or remove autoclosing
+ * if the user's coordinates are now closed.
+ */
+
+ if (polyPtr->autoClosed) {
+ if ((new[length-2] == new[0]) && (new[length-1] == new[1])) {
+ polyPtr->autoClosed = 0;
+ polyPtr->numPoints--;
+ }
+ }
+ else {
+ if ((new[length-2] != new[0]) || (new[length-1] != new[1])) {
+ polyPtr->autoClosed = 1;
+ polyPtr->numPoints++;
+ }
+ }
+
+ new[length] = new[0];
+ new[length+1] = new[1];
+ if (((length-objc)>3) && (state != TK_STATE_HIDDEN)) {
+ /*
+ * This is some optimizing code that will result that only the part
+ * of the polygon that changed (and the objects that are overlapping
+ * with that part) need to be redrawn. A special flag is set that
+ * instructs the general canvas code not to redraw the whole
+ * object. If this flag is not set, the canvas will do the redrawing,
+ * otherwise I have to do it here.
+ */
+ double width;
+ int j;
+ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW;
+
+ /*
+ * The header elements that normally are used for the
+ * bounding box, are now used to calculate the bounding
+ * box for only the part that has to be redrawn. That
+ * doesn't matter, because afterwards the bounding
+ * box has to be re-calculated anyway.
+ */
+
+ itemPtr->x1 = itemPtr->x2 = (int) polyPtr->coordPtr[beforeThis];
+ itemPtr->y1 = itemPtr->y2 = (int) polyPtr->coordPtr[beforeThis+1];
+ beforeThis-=2; objc+=4;
+ if(polyPtr->smooth) {
+ beforeThis-=2; objc+=4;
+ } /* be carefull; beforeThis could now be negative */
+ for(i=beforeThis; i<beforeThis+objc; i+=2) {
+ j=i;
+ if(j<0) j+=length;
+ if(j>=length) j-=length;
+ TkIncludePoint(itemPtr, polyPtr->coordPtr+j);
+ }
+ width = polyPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+ itemPtr->x1 -= (int) width; itemPtr->y1 -= (int) width;
+ itemPtr->x2 += (int) width; itemPtr->y2 += (int) width;
+ Tk_CanvasEventuallyRedraw(canvas,
+ itemPtr->x1, itemPtr->y1,
+ itemPtr->x2, itemPtr->y2);
+ }
+
+ ComputePolygonBbox(canvas, polyPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonDeleteCoords --
+ *
+ * Delete one or more coordinates from a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters between "first" and "last", inclusive, get
+ * deleted from itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PolygonDeleteCoords(canvas, itemPtr, first, last)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item in which to delete characters. */
+ int first; /* Index of first character to delete. */
+ int last; /* Index of last character to delete. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int count, i;
+ int length = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+
+ while(first>=length) first-=length;
+ while(first<0) first+=length;
+ while(last>=length) last-=length;
+ while(last<0) last+=length;
+
+ first &= -2;
+ last &= -2;
+
+ count = last + 2 - first;
+ if(count<=0) count +=length;
+
+ if(count >= length) {
+ polyPtr->numPoints = 0;
+ if(polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+ return;
+ }
+
+ if(last>=first) {
+ for(i=last+2; i<length; i++) {
+ polyPtr->coordPtr[i-count] = polyPtr->coordPtr[i];
+ }
+ } else {
+ for(i=last; i<=first; i++) {
+ polyPtr->coordPtr[i-last] = polyPtr->coordPtr[i];
+ }
+ }
+ polyPtr->coordPtr[length-count] = polyPtr->coordPtr[0];
+ polyPtr->coordPtr[length-count+1] = polyPtr->coordPtr[1];
+ polyPtr->numPoints -= count/2;
+ ComputePolygonBbox(canvas, polyPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * polygon, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the polygon. If the
+ * point isn't inside the polygon then the return value is the
+ * distance from the point to the polygon.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+PolygonToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr, *polyPoints;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double poly[10];
+ double radius;
+ double bestDist, dist;
+ int numPoints, count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner
+ * had to be treated as beveled after all
+ * because the angle was < 11 degrees. */
+ double width;
+ Tk_State state = itemPtr->state;
+
+ bestDist = 1.0e36;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = polyPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+ radius = width/2.0;
+
+ /*
+ * Handle smoothed polygons by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((polyPtr->smooth) && (polyPtr->numPoints>2)) {
+ numPoints = polyPtr->smooth->coordProc(canvas, (double *) NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ polyPoints = staticSpace;
+ } else {
+ polyPoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ polyPoints);
+ } else {
+ numPoints = polyPtr->numPoints;
+ polyPoints = polyPtr->coordPtr;
+ }
+
+ bestDist = TkPolygonToPoint(polyPoints, numPoints, pointPtr);
+ if (bestDist<=0.0) {
+ goto donepoint;
+ }
+ if ((polyPtr->outline.gc != None) && (polyPtr->joinStyle == JoinRound)) {
+ dist = bestDist - radius;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else {
+ bestDist = dist;
+ }
+ }
+
+ if ((polyPtr->outline.gc == None) || (width <= 1)) goto donepoint;
+
+ /*
+ * The overall idea is to iterate through all of the edges of
+ * the line, computing a polygon for each edge and testing the
+ * point against that polygon. In addition, there are additional
+ * tests to deal with rounded joints and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = polyPoints; count >= 2;
+ count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point then compute
+ * the distance between the point and the point.
+ */
+
+ if (polyPtr->joinStyle == JoinRound) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - radius;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge,
+ * consisting of two points for the first point of the edge
+ * and two points for the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, (double) width,
+ 0, poly, poly+2);
+ } else if ((polyPtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, (double) width, 0,
+ poly, poly+2);
+
+ /*
+ * If this line uses beveled joints, then check the distance
+ * to a polygon comprising the last two points of the previous
+ * polygon and the first two from this polygon; this checks
+ * the wedges that fill the mitered joint.
+ */
+
+ if ((polyPtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) width,
+ 0, poly+4, poly+6);
+ } else if (polyPtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) width, 0,
+ poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ donepoint:
+ if ((polyPoints != staticSpace) && polyPoints != polyPtr->coordPtr) {
+ ckfree((char *) polyPoints);
+ }
+ return bestDist;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+PolygonToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against polygon. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double *polyPoints, poly[10];
+ double radius;
+ int numPoints, count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner
+ * had to be treated as beveled after all
+ * because the angle was < 11 degrees. */
+ int inside; /* Tentative guess about what to return,
+ * based on all points seen so far: one
+ * means everything seen so far was
+ * inside the area; -1 means everything
+ * was outside the area. 0 means overlap
+ * has been found. */
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = polyPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+
+ radius = width/2.0;
+ inside = -1;
+
+ if ((state==TK_STATE_HIDDEN) || polyPtr->numPoints<2) {
+ return -1;
+ } else if (polyPtr->numPoints <3) {
+ double oval[4];
+ oval[0] = polyPtr->coordPtr[0]-radius;
+ oval[1] = polyPtr->coordPtr[1]-radius;
+ oval[2] = polyPtr->coordPtr[0]+radius;
+ oval[3] = polyPtr->coordPtr[1]+radius;
+ return TkOvalToArea(oval, rectPtr);
+ }
+ /*
+ * Handle smoothed polygons by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if (polyPtr->smooth) {
+ numPoints = polyPtr->smooth->coordProc(canvas, (double *) NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ polyPoints = staticSpace;
+ } else {
+ polyPoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ polyPoints);
+ } else {
+ numPoints = polyPtr->numPoints;
+ polyPoints = polyPtr->coordPtr;
+ }
+
+ /*
+ * Simple test to see if we are in the polygon. Polygons are
+ * different from othe canvas items in that they register points
+ * being inside even if it isn't filled.
+ */
+ inside = TkPolygonToArea(polyPoints, numPoints, rectPtr);
+ if (inside==0) goto donearea;
+
+ if (polyPtr->outline.gc == None) goto donearea ;
+
+ /*
+ * Iterate through all of the edges of the line, computing a polygon
+ * for each edge and testing the area against that polygon. In
+ * addition, there are additional tests to deal with rounded joints
+ * and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = polyPoints; count >= 2;
+ count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point of the edge
+ * then test a circular region around the point with the
+ * area.
+ */
+
+ if (polyPtr->joinStyle == JoinRound) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ inside = 0;
+ goto donearea;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge,
+ * consisting of two points for the first point of the edge
+ * and two points for the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, width,
+ 0, poly, poly+2);
+ } else if ((polyPtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0,
+ poly, poly+2);
+
+ /*
+ * If the last joint was beveled, then also check a
+ * polygon comprising the last two points of the previous
+ * polygon and the first two from this polygon; this checks
+ * the wedges that fill the beveled joint.
+ */
+
+ if ((polyPtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ inside = 0;
+ goto donearea;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ 0, poly+4, poly+6);
+ } else if (polyPtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0,
+ poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ inside = 0;
+ goto donearea;
+ }
+ }
+
+ donearea:
+ if ((polyPoints != staticSpace) && (polyPoints != polyPtr->coordPtr)) {
+ ckfree((char *) polyPoints);
+ }
+ return inside;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ScalePolygon --
+ *
+ * This procedure is invoked to rescale a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The polygon referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScalePolygon(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing polygon. */
+ Tk_Item *itemPtr; /* Polygon to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ *coordPtr = originX + scaleX*(*coordPtr - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPolygonIndex --
+ *
+ * Parse an index into a polygon item and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the index (into itemPtr) corresponding to
+ * string. Otherwise an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetPolygonIndex(interp, canvas, itemPtr, obj, indexPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item for which the index is being
+ * specified. */
+ Tcl_Obj *obj; /* Specification of a particular coord
+ * in itemPtr's line. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ size_t length;
+ char *string = Tcl_GetStringFromObj(obj, (int *) &length);
+
+ if (string[0] == 'e') {
+ if (strncmp(string, "end", length) == 0) {
+ *indexPtr = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+ } 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 index \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (string[0] == '@') {
+ int i;
+ double x ,y, bestDist, dist, *coordPtr;
+ char *end, *p;
+
+ p = string+1;
+ x = strtod(p, &end);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ p = end+1;
+ y = strtod(p, &end);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ bestDist = 1.0e36;
+ coordPtr = polyPtr->coordPtr;
+ *indexPtr = 0;
+ for(i=0; i<(polyPtr->numPoints-1); i++) {
+ dist = hypot(coordPtr[0] - x, coordPtr[1] - y);
+ if (dist<bestDist) {
+ bestDist = dist;
+ *indexPtr = 2*i;
+ }
+ coordPtr += 2;
+ }
+ } else {
+ int count = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+ if (Tcl_GetIntFromObj(interp, obj, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ *indexPtr &= -2; /* if odd, make it even */
+ if (count) {
+ if (*indexPtr > 0) {
+ *indexPtr = ((*indexPtr - 2) % count) + 2;
+ } else {
+ *indexPtr = -((-(*indexPtr)) % count);
+ }
+ } else {
+ *indexPtr = 0;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslatePolygon --
+ *
+ * This procedure is called to move a polygon by a given
+ * amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the polygon is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the
+ * item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslatePolygon(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ *coordPtr += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * polygon items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ char *style;
+ XColor *color;
+ XColor *fillColor;
+ Pixmap stipple;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+ double width;
+
+ if (polyPtr->numPoints<2 || polyPtr->coordPtr==NULL) {
+ return TCL_OK;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = polyPtr->outline.width;
+ color = polyPtr->outline.color;
+ stipple = polyPtr->fillStipple;
+ fillColor = polyPtr->fillColor;
+ fillStipple = polyPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ if (polyPtr->outline.activeColor!=NULL) {
+ color = polyPtr->outline.activeColor;
+ }
+ if (polyPtr->outline.activeStipple!=None) {
+ stipple = polyPtr->outline.activeStipple;
+ }
+ if (polyPtr->activeFillColor!=NULL) {
+ fillColor = polyPtr->activeFillColor;
+ }
+ if (polyPtr->activeFillStipple!=None) {
+ fillStipple = polyPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ if (polyPtr->outline.disabledColor!=NULL) {
+ color = polyPtr->outline.disabledColor;
+ }
+ if (polyPtr->outline.disabledStipple!=None) {
+ stipple = polyPtr->outline.disabledStipple;
+ }
+ if (polyPtr->disabledFillColor!=NULL) {
+ fillColor = polyPtr->disabledFillColor;
+ }
+ if (polyPtr->disabledFillStipple!=None) {
+ fillStipple = polyPtr->disabledFillStipple;
+ }
+ }
+ if (polyPtr->numPoints==2) {
+ char string[128];
+ sprintf(string, "%.15g %.15g translate %.15g %.15g",
+ polyPtr->coordPtr[0], Tk_CanvasPsY(canvas, polyPtr->coordPtr[1]),
+ width/2.0, width/2.0);
+ Tcl_AppendResult(interp, "matrix currentmatrix\n",string,
+ " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, color)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Fill the area of the polygon.
+ */
+
+ if (fillColor != NULL && polyPtr->numPoints>3) {
+ if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (fillStipple != None) {
+ Tcl_AppendResult(interp, "eoclip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (color != NULL) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "eofill\n", (char *) NULL);
+ }
+ }
+
+ /*
+ * Now draw the outline, if there is one.
+ */
+
+ if (color != NULL) {
+
+ if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps);
+ }
+
+ if (polyPtr->joinStyle == JoinRound) {
+ style = "1";
+ } else if (polyPtr->joinStyle == JoinBevel) {
+ style = "2";
+ } else {
+ style = "0";
+ }
+ Tcl_AppendResult(interp, style," setlinejoin 1 setlinecap\n",
+ (char *) NULL);
+ if (Tk_CanvasPsOutline(canvas, itemPtr,
+ &(polyPtr->outline)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
--- /dev/null
+/*
+ * tkCanvPs.c --
+ *
+ * This module provides Postscript output support for canvases,
+ * including the "postscript" widget command plus a few utility
+ * procedures used for generating Postscript.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+/*
+ * One of the following structures is created to keep track of Postscript
+ * output being generated. It consists mostly of information provided on
+ * the widget command line.
+ */
+
+typedef struct TkPostscriptInfo {
+ int x, y, width, height; /* Area to print, in canvas pixel
+ * coordinates. */
+ int x2, y2; /* x+width and y+height. */
+ char *pageXString; /* String value of "-pagex" option or NULL. */
+ char *pageYString; /* String value of "-pagey" option or NULL. */
+ double pageX, pageY; /* Postscript coordinates (in points)
+ * corresponding to pageXString and
+ * pageYString. Don't forget that y-values
+ * grow upwards for Postscript! */
+ char *pageWidthString; /* Printed width of output. */
+ char *pageHeightString; /* Printed height of output. */
+ double scale; /* Scale factor for conversion: each pixel
+ * maps into this many points. */
+ Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */
+ int rotate; /* Non-zero means output should be rotated
+ * on page (landscape mode). */
+ char *fontVar; /* If non-NULL, gives name of global variable
+ * containing font mapping information.
+ * Malloc'ed. */
+ char *colorVar; /* If non-NULL, give name of global variable
+ * containing color mapping information.
+ * Malloc'ed. */
+ char *colorMode; /* Mode for handling colors: "monochrome",
+ * "gray", or "color". Malloc'ed. */
+ int colorLevel; /* Numeric value corresponding to colorMode:
+ * 0 for mono, 1 for gray, 2 for color. */
+ char *fileName; /* Name of file in which to write Postscript;
+ * NULL means return Postscript info as
+ * result. Malloc'ed. */
+ char *channelName; /* If -channel is specified, the name of
+ * the channel to use. */
+ Tcl_Channel chan; /* Open channel corresponding to fileName. */
+ Tcl_HashTable fontTable; /* Hash table containing names of all font
+ * families used in output. The hash table
+ * values are not used. */
+ int prepass; /* Non-zero means that we're currently in
+ * the pre-pass that collects font information,
+ * so the Postscript generated isn't
+ * relevant. */
+ int prolog; /* Non-zero means output should contain
+ the file prolog.ps in the header. */
+} TkPostscriptInfo;
+
+/*
+ * The table below provides a template that's used to process arguments
+ * to the canvas "postscript" command and fill in TkPostscriptInfo
+ * structures.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorVar), 0},
+ {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorMode), 0},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, fileName), 0},
+ {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, channelName), 0},
+ {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, fontVar), 0},
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, height), 0},
+ {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
+ {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
+ {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
+ {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageXString), 0},
+ {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageYString), 0},
+ {TK_CONFIG_BOOLEAN, "-prolog", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, prolog), 0},
+ {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, rotate), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, width), 0},
+ {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, x), 0},
+ {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, y), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, double *doublePtr));
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvPostscriptCmd --
+ *
+ * This procedure is invoked to process the "postscript" options
+ * of the widget command for canvas widgets. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
+ TkCanvas *canvasPtr; /* Information about canvas widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. Caller has
+ * already parsed this command enough
+ * to know that argv[1] is
+ * "postscript". */
+{
+ TkPostscriptInfo psInfo;
+ Tk_PostscriptInfo oldInfoPtr;
+ int result;
+ Tk_Item *itemPtr;
+#define STRING_LENGTH 400
+ char string[STRING_LENGTH+1];
+ CONST char *p;
+ time_t now;
+ size_t length;
+ Tk_Window tkwin = canvasPtr->tkwin;
+ int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of
+ * area to be marked up, measured
+ * in canvas units from the positioning
+ * point on the page (reflects
+ * anchor position). Initial values
+ * needed only to stop compiler
+ * warnings. */
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString buffer;
+ char psenccmd[]="::tk::ensure_psenc_is_loaded";
+
+ /*
+ *----------------------------------------------------------------
+ * Initialize the data structure describing Postscript generation,
+ * then process all the arguments to fill the data structure in.
+ *----------------------------------------------------------------
+ */
+ result = Tcl_EvalEx(interp,psenccmd,-1,TCL_EVAL_GLOBAL);
+ if (result != TCL_OK) {
+ return result;
+ }
+ oldInfoPtr = canvasPtr->psInfo;
+ canvasPtr->psInfo = (Tk_PostscriptInfo) &psInfo;
+ psInfo.x = canvasPtr->xOrigin;
+ psInfo.y = canvasPtr->yOrigin;
+ psInfo.width = -1;
+ psInfo.height = -1;
+ psInfo.pageXString = NULL;
+ psInfo.pageYString = NULL;
+ psInfo.pageX = 72*4.25;
+ psInfo.pageY = 72*5.5;
+ psInfo.pageWidthString = NULL;
+ psInfo.pageHeightString = NULL;
+ psInfo.scale = 1.0;
+ psInfo.pageAnchor = TK_ANCHOR_CENTER;
+ psInfo.rotate = 0;
+ psInfo.fontVar = NULL;
+ psInfo.colorVar = NULL;
+ psInfo.colorMode = NULL;
+ psInfo.colorLevel = 0;
+ psInfo.fileName = NULL;
+ psInfo.channelName = NULL;
+ psInfo.chan = NULL;
+ psInfo.prepass = 0;
+ psInfo.prolog = 1;
+ Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
+ result = Tk_ConfigureWidget(interp, tkwin,
+ configSpecs, argc-2, argv+2, (char *) &psInfo,
+ TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ goto cleanup;
+ }
+
+ if (psInfo.width == -1) {
+ psInfo.width = Tk_Width(tkwin);
+ }
+ if (psInfo.height == -1) {
+ psInfo.height = Tk_Height(tkwin);
+ }
+ psInfo.x2 = psInfo.x + psInfo.width;
+ psInfo.y2 = psInfo.y + psInfo.height;
+
+ if (psInfo.pageXString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageXString,
+ &psInfo.pageX) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageYString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageYString,
+ &psInfo.pageY) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageWidthString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageWidthString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.width;
+ } else if (psInfo.pageHeightString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageHeightString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.height;
+ } else {
+ psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tkwin));
+ psInfo.scale /= WidthOfScreen(Tk_Screen(tkwin));
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ deltaX = 0;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ deltaX = -psInfo.width/2;
+ break;
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ deltaX = -psInfo.width;
+ break;
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ deltaY = - psInfo.height;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ deltaY = -psInfo.height/2;
+ break;
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ deltaY = 0;
+ break;
+ }
+
+ if (psInfo.colorMode == NULL) {
+ psInfo.colorLevel = 2;
+ } else {
+ length = strlen(psInfo.colorMode);
+ if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
+ psInfo.colorLevel = 0;
+ } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
+ psInfo.colorLevel = 1;
+ } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
+ psInfo.colorLevel = 2;
+ } else {
+ Tcl_AppendResult(interp, "bad color mode \"",
+ psInfo.colorMode, "\": must be monochrome, ",
+ "gray, or color", (char *) NULL);
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.fileName != NULL) {
+
+ /*
+ * Check that -file and -channel are not both specified.
+ */
+
+ if (psInfo.channelName != NULL) {
+ Tcl_AppendResult(interp, "can't specify both -file",
+ " and -channel", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ /*
+ * Check that we are not in a safe interpreter. If we are, disallow
+ * the -file specification.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't specify -file in a",
+ " safe interpreter", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
+ if (p == NULL) {
+ goto cleanup;
+ }
+ psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666);
+ Tcl_DStringFree(&buffer);
+ if (psInfo.chan == NULL) {
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.channelName != NULL) {
+ int mode;
+
+ /*
+ * Check that the channel is found in this interpreter and that it
+ * is open for writing.
+ */
+
+ psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName,
+ &mode);
+ if (psInfo.chan == (Tcl_Channel) NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if ((mode & TCL_WRITABLE) == 0) {
+ Tcl_AppendResult(interp, "channel \"",
+ psInfo.channelName, "\" wasn't opened for writing",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ /*
+ *--------------------------------------------------------
+ * Make a pre-pass over all of the items, generating Postscript
+ * and then throwing it away. The purpose of this pass is just
+ * to collect information about all the fonts in use, so that
+ * we can output font information in the proper form required
+ * by the Document Structuring Conventions.
+ *--------------------------------------------------------
+ */
+
+ psInfo.prepass = 1;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
+ || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
+ continue;
+ }
+ if (itemPtr->typePtr->postscriptProc == NULL) {
+ continue;
+ }
+ result = (*itemPtr->typePtr->postscriptProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 1);
+ Tcl_ResetResult(interp);
+ if (result != TCL_OK) {
+ /*
+ * An error just occurred. Just skip out of this loop.
+ * There's no need to report the error now; it can be
+ * reported later (errors can happen later that don't
+ * happen now, so we still have to check for errors later
+ * anyway).
+ */
+ break;
+ }
+ }
+ psInfo.prepass = 0;
+
+ /*
+ *--------------------------------------------------------
+ * Generate the header and prolog for the Postscript.
+ *--------------------------------------------------------
+ */
+
+ if (psInfo.prolog) {
+ Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
+ "%%Creator: Tk Canvas Widget\n", (char *) NULL);
+#ifdef HAVE_PW_GECOS
+ if (!Tcl_IsSafe(interp)) {
+ struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */
+ Tcl_AppendResult(interp, "%%For: ",
+ (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
+ (char *) NULL);
+ endpwent();
+ }
+#endif /* HAVE_PW_GECOS */
+ Tcl_AppendResult(interp, "%%Title: Window ",
+ Tk_PathName(tkwin), "\n", (char *) NULL);
+ time(&now);
+ Tcl_AppendResult(interp, "%%CreationDate: ",
+ ctime(&now), (char *) NULL); /* INTL: Native. */
+ if (!psInfo.rotate) {
+ sprintf(string, "%d %d %d %d",
+ (int) (psInfo.pageX + psInfo.scale*deltaX),
+ (int) (psInfo.pageY + psInfo.scale*deltaY),
+ (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
+ + 1.0));
+ } else {
+ sprintf(string, "%d %d %d %d",
+ (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
+ (int) (psInfo.pageY + psInfo.scale*deltaX),
+ (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0));
+ }
+ Tcl_AppendResult(interp, "%%BoundingBox: ", string,
+ "\n", (char *) NULL);
+ Tcl_AppendResult(interp, "%%Pages: 1\n",
+ "%%DocumentData: Clean7Bit\n", (char *) NULL);
+ Tcl_AppendResult(interp, "%%Orientation: ",
+ psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
+ p = "%%DocumentNeededResources: font ";
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(interp, p,
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr),
+ "\n", (char *) NULL);
+ p = "%%+ font ";
+ }
+ Tcl_AppendResult(interp, "%%EndComments\n\n", (char *) NULL);
+
+ /*
+ * Insert the prolog
+ */
+ Tcl_AppendResult(interp, Tcl_GetVar(interp,"::tk::ps_preamable",TCL_GLOBAL_ONLY), (char *) NULL);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+
+ /*
+ *-----------------------------------------------------------
+ * Document setup: set the color level and include fonts.
+ *-----------------------------------------------------------
+ */
+
+ sprintf(string, "/CL %d def\n", psInfo.colorLevel);
+ Tcl_AppendResult(interp, "%%BeginSetup\n", string,
+ (char *) NULL);
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(interp, "%%IncludeResource: font ",
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "%%EndSetup\n\n", (char *) NULL);
+
+ /*
+ *-----------------------------------------------------------
+ * Page setup: move to page positioning point, rotate if
+ * needed, set scale factor, offset for proper anchor position,
+ * and set clip region.
+ *-----------------------------------------------------------
+ */
+
+ Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n",
+ (char *) NULL);
+ sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ if (psInfo.rotate) {
+ Tcl_AppendResult(interp, "90 rotate\n", (char *) NULL);
+ }
+ sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
+ psInfo.x,
+ Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo),
+ psInfo.x2,
+ Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo),
+ psInfo.x2,
+ Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo),
+ psInfo.x,
+ Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo));
+ Tcl_AppendResult(interp, string,
+ " lineto closepath clip newpath\n", (char *) NULL);
+ }
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Iterate through all the items, having each relevant one draw itself.
+ * Quit if any of the items returns an error.
+ *---------------------------------------------------------------------
+ */
+
+ result = TCL_OK;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
+ || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
+ continue;
+ }
+ if (itemPtr->typePtr->postscriptProc == NULL) {
+ continue;
+ }
+ if (itemPtr->state == TK_STATE_HIDDEN) {
+ continue;
+ }
+ Tcl_AppendResult(interp, "gsave\n", (char *) NULL);
+ result = (*itemPtr->typePtr->postscriptProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 0);
+ if (result != TCL_OK) {
+ char msg[64 + TCL_INTEGER_SPACE];
+
+ sprintf(msg, "\n (generating Postscript for item %d)",
+ itemPtr->id);
+ Tcl_AddErrorInfo(interp, msg);
+ goto cleanup;
+ }
+ Tcl_AppendResult(interp, "grestore\n", (char *) NULL);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(interp);
+ }
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Output page-end information, such as commands to print the page
+ * and document trailer stuff.
+ *---------------------------------------------------------------------
+ */
+
+ if (psInfo.prolog) {
+ Tcl_AppendResult(interp, "restore showpage\n\n",
+ "%%Trailer\nend\n%%EOF\n", (char *) NULL);
+ }
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+ /*
+ * Clean up psInfo to release malloc'ed stuff.
+ */
+
+ cleanup:
+ if (psInfo.pageXString != NULL) {
+ ckfree(psInfo.pageXString);
+ }
+ if (psInfo.pageYString != NULL) {
+ ckfree(psInfo.pageYString);
+ }
+ if (psInfo.pageWidthString != NULL) {
+ ckfree(psInfo.pageWidthString);
+ }
+ if (psInfo.pageHeightString != NULL) {
+ ckfree(psInfo.pageHeightString);
+ }
+ if (psInfo.fontVar != NULL) {
+ ckfree(psInfo.fontVar);
+ }
+ if (psInfo.colorVar != NULL) {
+ ckfree(psInfo.colorVar);
+ }
+ if (psInfo.colorMode != NULL) {
+ ckfree(psInfo.colorMode);
+ }
+ if (psInfo.fileName != NULL) {
+ ckfree(psInfo.fileName);
+ }
+ if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
+ Tcl_Close(interp, psInfo.chan);
+ }
+ if (psInfo.channelName != NULL) {
+ ckfree(psInfo.channelName);
+ }
+ Tcl_DeleteHashTable(&psInfo.fontTable);
+ canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr;
+ return result;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptColor --
+ *
+ * This procedure is called by individual canvas items when
+ * they want to set a color value for output. Given information
+ * about an X color, this procedure will generate Postscript
+ * commands to set up an appropriate color in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptColor(interp, psInfo, colorPtr)
+ Tcl_Interp *interp;
+ Tk_PostscriptInfo psInfo; /* Postscript info. */
+ XColor *colorPtr; /* Information about color. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ int tmp;
+ double red, green, blue;
+ char string[200];
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * If there is a color map defined, then look up the color's name
+ * in the map and use the Postscript commands found there, if there
+ * are any.
+ */
+
+ if (psInfoPtr->colorVar != NULL) {
+ CONST char *cmdString;
+
+ cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
+ Tk_NameOfColor(colorPtr), 0);
+ if (cmdString != NULL) {
+ Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * No color map entry for this color. Grab the color's intensities
+ * and output Postscript commands for them. Special note: X uses
+ * a range of 0-65535 for intensities, but most displays only use
+ * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
+ * X scale. This means that there's no way to get perfect white,
+ * since the highest intensity is only 65280 out of 65535. To
+ * work around this problem, rescale the X intensity to a 0-255
+ * scale and use that as the basis for the Postscript colors. This
+ * scheme still won't work if the display only uses 4 bits per color,
+ * but most diplays use at least 8 bits.
+ */
+
+ tmp = colorPtr->red;
+ red = ((double) (tmp >> 8))/255.0;
+ tmp = colorPtr->green;
+ green = ((double) (tmp >> 8))/255.0;
+ tmp = colorPtr->blue;
+ blue = ((double) (tmp >> 8))/255.0;
+ sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
+ red, green, blue);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptFont --
+ *
+ * This procedure is called by individual canvas items when
+ * they want to output text. Given information about an X
+ * font, this procedure will generate Postscript commands
+ * to set up an appropriate font in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * The Postscript font name is entered into psInfoPtr->fontTable
+ * if it wasn't already there.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptFont(interp, psInfo, tkfont)
+ Tcl_Interp *interp;
+ Tk_PostscriptInfo psInfo; /* Postscript Info. */
+ Tk_Font tkfont; /* Information about font in which text
+ * is to be printed. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ char *end;
+ char pointString[TCL_INTEGER_SPACE];
+ Tcl_DString ds;
+ int i, points;
+
+ /*
+ * First, look up the font's name in the font map, if there is one.
+ * If there is an entry for this font, it consists of a list
+ * containing font name and size. Use this information.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ if (psInfoPtr->fontVar != NULL) {
+ CONST char *list;
+ int argc;
+ double size;
+ CONST char **argv;
+ CONST char *name;
+
+ name = Tk_NameOfFont(tkfont);
+ list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
+ if (list != NULL) {
+ if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
+ badMapEntry:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad font map entry for \"", name,
+ "\": \"", list, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc != 2) {
+ goto badMapEntry;
+ }
+ size = strtod(argv[1], &end);
+ if ((size <= 0) || (*end != 0)) {
+ goto badMapEntry;
+ }
+
+ Tcl_DStringAppend(&ds, argv[0], -1);
+ points = (int) size;
+
+ ckfree((char *) argv);
+ goto findfont;
+ }
+ }
+
+ points = Tk_PostscriptFontName(tkfont, &ds);
+
+ findfont:
+ sprintf(pointString, "%d", points);
+ Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
+ pointString, " scalefont ", (char *) NULL);
+ if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
+ Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
+ Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptBitmap --
+ *
+ * This procedure is called to output the contents of a
+ * sub-region of a bitmap in proper image data format for
+ * Postscript (i.e. data between angle brackets, one bit
+ * per pixel).
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, startX, startY, width,
+ height)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psInfo; /* Postscript info. */
+ Pixmap bitmap; /* Bitmap for which to generate
+ * Postscript. */
+ int startX, startY; /* Coordinates of upper-left corner
+ * of rectangular region to output. */
+ int width, height; /* Height of rectangular region. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ XImage *imagePtr;
+ int charsInLine, x, y, lastX, lastY, value, mask;
+ unsigned int totalWidth, totalHeight;
+ char string[100];
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom
+ * item types that create their own bitmaps without registering them
+ * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
+ * it shouldn't matter here.
+ */
+
+ XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
+ (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
+ imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0,
+ totalWidth, totalHeight, 1, XYPixmap);
+ Tcl_AppendResult(interp, "<", (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine = 0;
+ lastX = startX + width - 1;
+ lastY = startY + height - 1;
+ for (y = lastY; y >= startY; y--) {
+ for (x = startX; x <= lastX; x++) {
+ if (XGetPixel(imagePtr, x, y)) {
+ value |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(string, "%02x", value);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ if (charsInLine >= 60) {
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ charsInLine = 0;
+ }
+ }
+ }
+ if (mask != 0x80) {
+ sprintf(string, "%02x", value);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ }
+ }
+ Tcl_AppendResult(interp, ">", (char *) NULL);
+ XDestroyImage(imagePtr);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptStipple --
+ *
+ * This procedure is called by individual canvas items when
+ * they have created a path that they'd like to be filled with
+ * a stipple pattern. Given information about an X bitmap,
+ * this procedure will generate Postscript commands to fill
+ * the current clip region using a stipple pattern defined by the
+ * bitmap.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptStipple(interp, tkwin, psInfo, bitmap)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psInfo; /* Interpreter for returning Postscript
+ * or error message. */
+ Pixmap bitmap; /* Bitmap to use for stippling. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ int width, height;
+ char string[TCL_INTEGER_SPACE * 2];
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom
+ * item types that create their own bitmaps without registering them
+ * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
+ * it shouldn't matter here.
+ */
+
+ XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
+ (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
+ sprintf(string, "%d %d ", width, height);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0,
+ width, height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptY --
+ *
+ * Given a y-coordinate in local coordinates, this procedure
+ * returns a y-coordinate to use for Postscript output.
+ *
+ * Results:
+ * Returns the Postscript coordinate that corresponds to
+ * "y".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+Tk_PostscriptY(y, psInfo)
+ double y; /* Y-coordinate in canvas coords. */
+ Tk_PostscriptInfo psInfo; /* Postscript info */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+
+ return psInfoPtr->y2 - y;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptPath --
+ *
+ * Given an array of points for a path, generate Postscript
+ * commands to create the path.
+ *
+ * Results:
+ * Postscript commands get appended to what's in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_PostscriptPath(interp, psInfo, coordPtr, numPoints)
+ Tcl_Interp *interp;
+ Tk_PostscriptInfo psInfo; /* Canvas on whose behalf Postscript
+ * is being generated. */
+ double *coordPtr; /* Pointer to first in array of
+ * 2*numPoints coordinates giving
+ * points for path. */
+ int numPoints; /* Number of points at *coordPtr. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ char buffer[200];
+
+ if (psInfoPtr->prepass) {
+ return;
+ }
+ sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
+ Tk_PostscriptY(coordPtr[1], psInfo));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ for (numPoints--, coordPtr += 2; numPoints > 0;
+ numPoints--, coordPtr += 2) {
+ sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
+ Tk_PostscriptY(coordPtr[1], psInfo));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPostscriptPoints --
+ *
+ * Given a string, returns the number of Postscript points
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * screen distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetPostscriptPoints(interp, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a screen distance. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 'c':
+ d *= 72.0/2.54;
+ end++;
+ break;
+ case 'i':
+ d *= 72.0;
+ end++;
+ break;
+ case 'm':
+ d *= 72.0/25.4;
+ end++;
+ break;
+ case 0:
+ break;
+ case 'p':
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkImageGetColor --
+ *
+ * This procedure converts a pixel value to three floating
+ * point numbers, representing the amount of red, green, and
+ * blue in that pixel on the screen. It makes use of colormap
+ * data passed as an argument, and should work for all Visual
+ * types.
+ *
+ * Results:
+ * Returns red, green, and blue color values in the range
+ * 0 to 1. There are no error returns.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TkImageGetColor(cdata, pixel, red, green, blue)
+ TkColormapData *cdata; /* Colormap data */
+ unsigned long pixel; /* Pixel value to look up */
+ double *red, *green, *blue; /* Color data to return */
+{
+ if (cdata->separated) {
+ int r = (pixel & cdata->red_mask) >> cdata->red_shift;
+ int g = (pixel & cdata->green_mask) >> cdata->green_shift;
+ int b = (pixel & cdata->blue_mask) >> cdata->blue_shift;
+ *red = cdata->colors[r].red / 65535.0;
+ *green = cdata->colors[g].green / 65535.0;
+ *blue = cdata->colors[b].blue / 65535.0;
+ } else {
+ *red = cdata->colors[pixel].red / 65535.0;
+ *green = cdata->colors[pixel].green / 65535.0;
+ *blue = cdata->colors[pixel].blue / 65535.0;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostscriptImage --
+ *
+ * This procedure is called to output the contents of an
+ * image in Postscript, using a format appropriate for the
+ * current color mode (i.e. one bit per pixel in monochrome,
+ * one byte per pixel in gray, and three bytes per pixel in
+ * color).
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkPostscriptImage(interp, tkwin, psInfo, ximage, x, y, width, height)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psInfo; /* postscript info */
+ XImage *ximage; /* Image to draw */
+ int x, y; /* First pixel to output */
+ int width, height; /* Width and height of area */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ char buffer[256];
+ int xx, yy, band, maxRows;
+ double red, green, blue;
+ int bytesPerLine=0, maxWidth=0;
+ int level = psInfoPtr->colorLevel;
+ Colormap cmap;
+ int i, depth, ncolors;
+ Visual *visual;
+ TkColormapData cdata;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ cmap = Tk_Colormap(tkwin);
+ depth = Tk_Depth(tkwin);
+ visual = Tk_Visual(tkwin);
+
+ /*
+ * Obtain information about the colormap, ie the mapping between
+ * pixel values and RGB values. The code below should work
+ * for all Visual types.
+ */
+
+ ncolors = visual->map_entries;
+ cdata.colors = (XColor *) ckalloc(sizeof(XColor) * ncolors);
+ cdata.ncolors = ncolors;
+
+ if (visual->class == DirectColor || visual->class == TrueColor) {
+ cdata.separated = 1;
+ cdata.red_mask = visual->red_mask;
+ cdata.green_mask = visual->green_mask;
+ cdata.blue_mask = visual->blue_mask;
+ cdata.red_shift = 0;
+ cdata.green_shift = 0;
+ cdata.blue_shift = 0;
+ while ((0x0001 & (cdata.red_mask >> cdata.red_shift)) == 0)
+ cdata.red_shift ++;
+ while ((0x0001 & (cdata.green_mask >> cdata.green_shift)) == 0)
+ cdata.green_shift ++;
+ while ((0x0001 & (cdata.blue_mask >> cdata.blue_shift)) == 0)
+ cdata.blue_shift ++;
+ for (i = 0; i < ncolors; i ++)
+ cdata.colors[i].pixel =
+ ((i << cdata.red_shift) & cdata.red_mask) |
+ ((i << cdata.green_shift) & cdata.green_mask) |
+ ((i << cdata.blue_shift) & cdata.blue_mask);
+ } else {
+ cdata.separated=0;
+ for (i = 0; i < ncolors; i ++)
+ cdata.colors[i].pixel = i;
+ }
+ if (visual->class == StaticGray || visual->class == GrayScale)
+ cdata.color = 0;
+ else
+ cdata.color = 1;
+
+
+ XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors);
+
+ /*
+ * Figure out which color level to use (possibly lower than the
+ * one specified by the user). For example, if the user specifies
+ * color with monochrome screen, use gray or monochrome mode instead.
+ */
+
+ if (!cdata.color && level == 2) {
+ level = 1;
+ }
+
+ if (!cdata.color && cdata.ncolors == 2) {
+ level = 0;
+ }
+
+ /*
+ * Check that at least one row of the image can be represented
+ * with a string less than 64 KB long (this is a limit in the
+ * Postscript interpreter).
+ */
+
+ switch (level)
+ {
+ case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break;
+ case 1: bytesPerLine = width; maxWidth = 60000; break;
+ case 2: bytesPerLine = 3 * width; maxWidth = 20000; break;
+ }
+
+ if (bytesPerLine > 60000) {
+ Tcl_ResetResult(interp);
+ sprintf(buffer,
+ "Can't generate Postscript for images more than %d pixels wide",
+ maxWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ ckfree((char *) cdata.colors);
+ return TCL_ERROR;
+ }
+
+ maxRows = 60000 / bytesPerLine;
+
+ for (band = height-1; band >= 0; band -= maxRows) {
+ int rows = (band >= maxRows) ? maxRows : band + 1;
+ int lineLen = 0;
+ switch (level) {
+ case 0:
+ sprintf(buffer, "%d %d 1 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ case 1:
+ sprintf(buffer, "%d %d 8 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ case 2:
+ sprintf(buffer, "%d %d 8 matrix {\n<",
+ width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ }
+ for (yy = band; yy > band - rows; yy--) {
+ switch (level) {
+ case 0: {
+ /*
+ * Generate data for image in monochrome mode.
+ * No attempt at dithering is made--instead, just
+ * set a threshold.
+ */
+ unsigned char mask=0x80;
+ unsigned char data=0x00;
+ for (xx = x; xx< x+width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ if (0.30 * red + 0.59 * green + 0.11 * blue > 0.5)
+ data |= mask;
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ mask=0x80;
+ data=0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ mask=0x80;
+ data=0x00;
+ }
+ break;
+ }
+ case 1: {
+ /*
+ * Generate data in gray mode--in this case, take a
+ * weighted sum of the red, green, and blue values.
+ */
+ for (xx = x; xx < x+width; xx ++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 *
+ (0.30 * red +
+ 0.59 * green +
+ 0.11 * blue)));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ case 2: {
+ /*
+ * Finally, color mode. Here, just output the red, green,
+ * and blue values directly.
+ */
+ for (xx = x; xx < x+width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ sprintf(buffer, "%02X%02X%02X",
+ (int) floor(0.5 + 255.0 * red),
+ (int) floor(0.5 + 255.0 * green),
+ (int) floor(0.5 + 255.0 * blue));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 6;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ }
+ }
+ switch (level) {
+ case 0: sprintf(buffer, ">\n} image\n"); break;
+ case 1: sprintf(buffer, ">\n} image\n"); break;
+ case 2: sprintf(buffer, ">\n} false 3 colorimage\n"); break;
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "0 %d translate\n", rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+ ckfree((char *) cdata.colors);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptPhoto --
+ *
+ * This procedure is called to output the contents of a
+ * photo image in Postscript, using a format appropriate for
+ * the requested postscript color mode (i.e. one byte per pixel
+ * in gray, and three bytes per pixel in color).
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interpreter's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tk_PostscriptPhoto(interp, blockPtr, psInfo, width, height)
+ Tcl_Interp *interp;
+ Tk_PhotoImageBlock *blockPtr;
+ Tk_PostscriptInfo psInfo;
+ int width, height;
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ int colorLevel = psInfoPtr->colorLevel;
+ static int codeIncluded = 0;
+
+ unsigned char *pixelPtr;
+ char buffer[256], cspace[40], decode[40];
+ int bpc;
+ int xx, yy, lineLen;
+ float red, green, blue;
+ int alpha;
+ int bytesPerLine=0, maxWidth=0;
+
+ unsigned char opaque = 255;
+ unsigned char *alphaPtr;
+ int alphaOffset, alphaPitch, alphaIncr;
+
+ if (psInfoPtr->prepass) {
+ codeIncluded = 0;
+ return TCL_OK;
+ }
+
+ /*
+ * Define the "TkPhoto" function, which is a modified version
+ * of the original "transparentimage" function posted
+ * by ian@five-d.com (Ian Kemmish) to comp.lang.postscript.
+ * For a monochrome colorLevel this is a slightly different
+ * version that uses the imagemask command instead of image.
+ */
+
+ if( !codeIncluded && (colorLevel != 0) ) {
+ /*
+ * Color and gray-scale code.
+ */
+
+ codeIncluded = !0;
+ Tcl_AppendResult( interp,
+ "/TkPhoto { \n",
+ " gsave \n",
+ " 32 dict begin \n",
+ " /tinteger exch def \n",
+ " /transparent 1 string def \n",
+ " transparent 0 tinteger put \n",
+ " /olddict exch def \n",
+ " olddict /DataSource get dup type /filetype ne { \n",
+ " olddict /DataSource 3 -1 roll \n",
+ " 0 () /SubFileDecode filter put \n",
+ " } { \n",
+ " pop \n",
+ " } ifelse \n",
+ " /newdict olddict maxlength dict def \n",
+ " olddict newdict copy pop \n",
+ " /w newdict /Width get def \n",
+ " /crpp newdict /Decode get length 2 idiv def \n",
+ " /str w string def \n",
+ " /pix w crpp mul string def \n",
+ " /substrlen 2 w log 2 log div floor exp cvi def \n",
+ " /substrs [ \n",
+ " { \n",
+ " substrlen string \n",
+ " 0 1 substrlen 1 sub { \n",
+ " 1 index exch tinteger put \n",
+ " } for \n",
+ " /substrlen substrlen 2 idiv def \n",
+ " substrlen 0 eq {exit} if \n",
+ " } loop \n",
+ " ] def \n",
+ " /h newdict /Height get def \n",
+ " 1 w div 1 h div matrix scale \n",
+ " olddict /ImageMatrix get exch matrix concatmatrix \n",
+ " matrix invertmatrix concat \n",
+ " newdict /Height 1 put \n",
+ " newdict /DataSource pix put \n",
+ " /mat [w 0 0 h 0 0] def \n",
+ " newdict /ImageMatrix mat put \n",
+ " 0 1 h 1 sub { \n",
+ " mat 5 3 -1 roll neg put \n",
+ " olddict /DataSource get str readstring pop pop \n",
+ " /tail str def \n",
+ " /x 0 def \n",
+ " olddict /DataSource get pix readstring pop pop \n",
+ " { \n",
+ " tail transparent search dup /done exch not def \n",
+ " {exch pop exch pop} if \n",
+ " /w1 exch length def \n",
+ " w1 0 ne { \n",
+ " newdict /DataSource ",
+ " pix x crpp mul w1 crpp mul getinterval put \n",
+ " newdict /Width w1 put \n",
+ " mat 4 x neg put \n",
+ " /x x w1 add def \n",
+ " newdict image \n",
+ " /tail tail w1 tail length w1 sub getinterval def \n",
+ " } if \n",
+ " done {exit} if \n",
+ " tail substrs { \n",
+ " anchorsearch {pop} if \n",
+ " } forall \n",
+ " /tail exch def \n",
+ " tail length 0 eq {exit} if \n",
+ " /x w tail length sub def \n",
+ " } loop \n",
+ " } for \n",
+ " end \n",
+ " grestore \n",
+ "} bind def \n\n\n", (char *) NULL);
+ } else if( !codeIncluded && (colorLevel == 0) ) {
+ /*
+ * Monochrome-only code
+ */
+
+ codeIncluded = !0;
+ Tcl_AppendResult( interp,
+ "/TkPhoto { \n",
+ " gsave \n",
+ " 32 dict begin \n",
+ " /dummyInteger exch def \n",
+ " /olddict exch def \n",
+ " olddict /DataSource get dup type /filetype ne { \n",
+ " olddict /DataSource 3 -1 roll \n",
+ " 0 () /SubFileDecode filter put \n",
+ " } { \n",
+ " pop \n",
+ " } ifelse \n",
+ " /newdict olddict maxlength dict def \n",
+ " olddict newdict copy pop \n",
+ " /w newdict /Width get def \n",
+ " /pix w 7 add 8 idiv string def \n",
+ " /h newdict /Height get def \n",
+ " 1 w div 1 h div matrix scale \n",
+ " olddict /ImageMatrix get exch matrix concatmatrix \n",
+ " matrix invertmatrix concat \n",
+ " newdict /Height 1 put \n",
+ " newdict /DataSource pix put \n",
+ " /mat [w 0 0 h 0 0] def \n",
+ " newdict /ImageMatrix mat put \n",
+ " 0 1 h 1 sub { \n",
+ " mat 5 3 -1 roll neg put \n",
+ " 0.000 0.000 0.000 setrgbcolor \n",
+ " olddict /DataSource get pix readstring pop pop \n",
+ " newdict /DataSource pix put \n",
+ " newdict imagemask \n",
+ " 1.000 1.000 1.000 setrgbcolor \n",
+ " olddict /DataSource get pix readstring pop pop \n",
+ " newdict /DataSource pix put \n",
+ " newdict imagemask \n",
+ " } for \n",
+ " end \n",
+ " grestore \n",
+ "} bind def \n\n\n", (char *) NULL);
+ }
+
+ /*
+ * Check that at least one row of the image can be represented
+ * with a string less than 64 KB long (this is a limit in the
+ * Postscript interpreter).
+ */
+
+ switch (colorLevel)
+ {
+ case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break;
+ case 1: bytesPerLine = width; maxWidth = 60000; break;
+ case 2: bytesPerLine = 3 * width; maxWidth = 20000; break;
+ }
+ if (bytesPerLine > 60000) {
+ Tcl_ResetResult(interp);
+ sprintf(buffer,
+ "Can't generate Postscript for images more than %d pixels wide",
+ maxWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set up the postscript code except for the image-data stream.
+ */
+
+ switch (colorLevel) {
+ case 0:
+ strcpy( cspace, "/DeviceGray");
+ strcpy( decode, "[1 0]");
+ bpc = 1;
+ break;
+ case 1:
+ strcpy( cspace, "/DeviceGray");
+ strcpy( decode, "[0 1]");
+ bpc = 8;
+ break;
+ default:
+ strcpy( cspace, "/DeviceRGB");
+ strcpy( decode, "[0 1 0 1 0 1]");
+ bpc = 8;
+ break;
+ }
+
+
+ Tcl_AppendResult(interp,
+ cspace, " setcolorspace\n\n", (char *) NULL);
+
+ sprintf(buffer,
+ " /Width %d\n /Height %d\n /BitsPerComponent %d\n",
+ width, height, bpc);
+ Tcl_AppendResult(interp,
+ "<<\n /ImageType 1\n", buffer,
+ " /DataSource currentfile",
+ " /ASCIIHexDecode filter\n", (char *) NULL);
+
+
+ sprintf(buffer,
+ " /ImageMatrix [1 0 0 -1 0 %d]\n", height);
+ Tcl_AppendResult(interp, buffer,
+ " /Decode ", decode, "\n>>\n1 TkPhoto\n", (char *) NULL);
+
+
+ /*
+ * Check the PhotoImageBlock information.
+ * We assume that:
+ * if pixelSize is 1,2 or 4, the image is R,G,B,A;
+ * if pixelSize is 3, the image is R,G,B and offset[3] is bogus.
+ */
+
+ if (blockPtr->pixelSize == 3) {
+ /*
+ * No alpha information: the whole image is opaque.
+ */
+
+ alphaPtr = &opaque;
+ alphaPitch = alphaIncr = alphaOffset = 0;
+ } else {
+ /*
+ * Set up alpha handling.
+ */
+
+ alphaPtr = blockPtr->pixelPtr;
+ alphaPitch = blockPtr->pitch;
+ alphaIncr = blockPtr->pixelSize;
+ alphaOffset = blockPtr->offset[3];
+ }
+
+
+ for (yy = 0, lineLen=0; yy < height; yy++) {
+ switch (colorLevel) {
+ case 0: {
+ /*
+ * Generate data for image in monochrome mode.
+ * No attempt at dithering is made--instead, just
+ * set a threshold.
+ * To handle transparecies we need to output two lines:
+ * one for the black pixels, one for the white ones.
+ */
+
+ unsigned char mask=0x80;
+ unsigned char data=0x00;
+ for (xx = 0; xx< width; xx ++) {
+ pixelPtr = blockPtr->pixelPtr
+ + (yy * blockPtr->pitch)
+ + (xx *blockPtr->pixelSize);
+
+ red = pixelPtr[blockPtr->offset[0]];
+ green = pixelPtr[blockPtr->offset[1]];
+ blue = pixelPtr[blockPtr->offset[2]];
+
+ alpha = *(alphaPtr + (yy * alphaPitch)
+ + (xx * alphaIncr) + alphaOffset);
+
+ /*
+ * If pixel is less than threshold, then it is black.
+ */
+
+ if ((alpha != 0) &&
+ ( 0.3086 * red
+ + 0.6094 * green
+ + 0.082 * blue < 128)) {
+ data |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ mask=0x80;
+ data=0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ mask=0x80;
+ data=0x00;
+ }
+
+ mask=0x80;
+ data=0x00;
+ for (xx = 0; xx< width; xx ++) {
+ pixelPtr = blockPtr->pixelPtr
+ + (yy * blockPtr->pitch)
+ + (xx *blockPtr->pixelSize);
+
+ red = pixelPtr[blockPtr->offset[0]];
+ green = pixelPtr[blockPtr->offset[1]];
+ blue = pixelPtr[blockPtr->offset[2]];
+
+ alpha = *(alphaPtr + (yy * alphaPitch)
+ + (xx * alphaIncr) + alphaOffset);
+
+ /*
+ * If pixel is greater than threshold, then it is white.
+ */
+
+ if ((alpha != 0) &&
+ ( 0.3086 * red
+ + 0.6094 * green
+ + 0.082 * blue >= 128)) {
+ data |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ mask=0x80;
+ data=0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ mask=0x80;
+ data=0x00;
+ }
+ break;
+ }
+ case 1: {
+ /*
+ * Generate transparency data.
+ * We must prevent a transparent value of 0
+ * because of a bug in some HP printers.
+ */
+
+ for (xx = 0; xx < width; xx ++) {
+ alpha = *(alphaPtr + (yy * alphaPitch)
+ + (xx * alphaIncr) + alphaOffset);
+ sprintf(buffer, "%02X", alpha | 0x01);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+
+
+ /*
+ * Generate data in gray mode--in this case, take a
+ * weighted sum of the red, green, and blue values.
+ */
+
+ for (xx = 0; xx < width; xx ++) {
+ pixelPtr = blockPtr->pixelPtr
+ + (yy * blockPtr->pitch)
+ + (xx *blockPtr->pixelSize);
+
+ red = pixelPtr[blockPtr->offset[0]];
+ green = pixelPtr[blockPtr->offset[1]];
+ blue = pixelPtr[blockPtr->offset[2]];
+
+ sprintf(buffer, "%02X", (int) floor(0.5 +
+ ( 0.3086 * red + 0.6094 * green + 0.0820 * blue)));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ default: {
+ /*
+ * Generate transparency data.
+ * We must prevent a transparent value of 0
+ * because of a bug in some HP printers.
+ */
+
+ for (xx = 0; xx < width; xx ++) {
+ alpha = *(alphaPtr + (yy * alphaPitch)
+ + (xx * alphaIncr) + alphaOffset);
+ sprintf(buffer, "%02X", alpha | 0x01);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+
+
+ /*
+ * Finally, color mode. Here, just output the red, green,
+ * and blue values directly.
+ */
+
+ for (xx = 0; xx < width; xx ++) {
+ pixelPtr = blockPtr->pixelPtr
+ + (yy * blockPtr->pitch)
+ + (xx *blockPtr->pixelSize);
+
+ sprintf(buffer, "%02X%02X%02X",
+ pixelPtr[blockPtr->offset[0]],
+ pixelPtr[blockPtr->offset[1]],
+ pixelPtr[blockPtr->offset[2]]);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 6;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ }
+ }
+
+ Tcl_AppendResult(interp, ">\n", (char *) NULL);
+ return TCL_OK;
+}
--- /dev/null
+/*
+ * tkCanvText.c --
+ *
+ * This file implements text items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+#include "default.h"
+
+/*
+ * The structure below defines the record for each text item.
+ */
+
+typedef struct TextItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_CanvasTextInfo *textInfoPtr;
+ /* Pointer to a structure containing
+ * information about the selection and
+ * insertion cursor. The structure is owned
+ * by (and shared with) the generic canvas
+ * code. */
+ /*
+ * Fields that are set by widget commands other than "configure".
+ */
+
+ double x, y; /* Positioning point for text. */
+ int insertPos; /* Character index of character just before
+ * which the insertion cursor is displayed. */
+
+ /*
+ * Configuration settings that are updated by Tk_ConfigureWidget.
+ */
+
+ Tk_Anchor anchor; /* Where to anchor text relative to (x,y). */
+ Tk_TSOffset tsoffset;
+ XColor *color; /* Color for text. */
+ XColor *activeColor; /* Color for text. */
+ XColor *disabledColor; /* Color for text. */
+ Tk_Font tkfont; /* Font for drawing text. */
+ Tk_Justify justify; /* Justification mode for text. */
+ Pixmap stipple; /* Stipple bitmap for text, or None. */
+ Pixmap activeStipple; /* Stipple bitmap for text, or None. */
+ Pixmap disabledStipple; /* Stipple bitmap for text, or None. */
+ char *text; /* Text for item (malloc-ed). */
+ int width; /* Width of lines for word-wrap, pixels.
+ * Zero means no word-wrap. */
+
+ /*
+ * Fields whose values are derived from the current values of the
+ * configuration settings above.
+ */
+
+ int numChars; /* Length of text in characters. */
+ int numBytes; /* Length of text in bytes. */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int leftEdge; /* Pixel location of the left edge of the
+ * text item; where the left border of the
+ * text layout is drawn. */
+ int rightEdge; /* Pixel just to right of right edge of
+ * area of text item. Used for selecting up
+ * to end of line. */
+ GC gc; /* Graphics context for drawing text. */
+ GC selTextGC; /* Graphics context for selected text. */
+ GC cursorOffGC; /* If not None, this gives a graphics context
+ * to use to draw the insertion cursor when
+ * it's off. Used if the selection and
+ * insertion cursor colors are the same. */
+} TextItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc, (ClientData) (TK_OFFSET_RELATIVE)
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, activeColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, activeStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(TextItem, anchor),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, disabledColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, disabledStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(TextItem, color), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
+ DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0},
+ {TK_CONFIG_JUSTIFY, "-justify", (char *) NULL, (char *) NULL,
+ "left", Tk_Offset(TextItem, justify),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(TextItem, tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_STRING, "-text", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TextItem, text), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeTextBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ TextItem *textPtr));
+static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateText _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, Tcl_Obj *CONST objv[]));
+static void DeleteText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayCanvText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int GetSelText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int offset, char *buffer,
+ int maxBytes));
+static int GetTextIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ Tcl_Obj *obj, int *indexPtr));
+static void ScaleText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void SetTextCursor _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int index));
+static int TextCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, Tcl_Obj *CONST objv[]));
+static void TextDeleteChars _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last));
+static void TextInsert _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, char *string));
+static int TextToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double TextToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static int TextToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void TranslateText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the rectangle and oval item types
+ * by means of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkTextType = {
+ "text", /* name */
+ sizeof(TextItem), /* itemSize */
+ CreateText, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureText, /* configureProc */
+ TextCoords, /* coordProc */
+ DeleteText, /* deleteProc */
+ DisplayCanvText, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ TextToPoint, /* pointProc */
+ TextToArea, /* areaProc */
+ TextToPostscript, /* postscriptProc */
+ ScaleText, /* scaleProc */
+ TranslateText, /* translateProc */
+ (Tk_ItemIndexProc *) GetTextIndex,/* indexProc */
+ SetTextCursor, /* icursorProc */
+ GetSelText, /* selectionProc */
+ TextInsert, /* insertProc */
+ TextDeleteChars, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateText --
+ *
+ * This procedure is invoked to create a new text item
+ * in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item then an error message is left in
+ * the interp's result; in this case itemPtr is left uninitialized
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new text item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateText(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing rectangle. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int i = 2;
+
+ if (objc == 1) {
+ i = 1;
+ } else if (objc > 1) {
+ char *arg = Tcl_GetString(objv[1]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+
+ if (objc < i) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x y ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean up after
+ * errors during the the remainder of this procedure.
+ */
+
+ textPtr->textInfoPtr = Tk_CanvasGetTextInfo(canvas);
+
+ textPtr->insertPos = 0;
+
+ textPtr->anchor = TK_ANCHOR_CENTER;
+ textPtr->tsoffset.flags = 0;
+ textPtr->tsoffset.xoffset = 0;
+ textPtr->tsoffset.yoffset = 0;
+ textPtr->color = NULL;
+ textPtr->activeColor = NULL;
+ textPtr->disabledColor = NULL;
+ textPtr->tkfont = NULL;
+ textPtr->justify = TK_JUSTIFY_LEFT;
+ textPtr->stipple = None;
+ textPtr->activeStipple = None;
+ textPtr->disabledStipple = None;
+ textPtr->text = NULL;
+ textPtr->width = 0;
+
+ textPtr->numChars = 0;
+ textPtr->numBytes = 0;
+ textPtr->textLayout = NULL;
+ textPtr->leftEdge = 0;
+ textPtr->rightEdge = 0;
+ textPtr->gc = None;
+ textPtr->selTextGC = None;
+ textPtr->cursorOffGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((TextCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureText(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TextCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on text items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextCoords(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be read or
+ * modified. */
+ int objc; /* Number of coordinates supplied in objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(textPtr->x);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(textPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if (objc < 3) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &textPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &textPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeTextBbox(canvas, textPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureText --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a text item, such as its border and background colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureText(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC, newSelGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+ XColor *selBgColorPtr;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) textPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ state = itemPtr->state;
+
+ if (textPtr->activeColor != NULL ||
+ textPtr->activeStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ color = textPtr->color;
+ stipple = textPtr->stipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (textPtr->activeColor!=NULL) {
+ color = textPtr->activeColor;
+ }
+ if (textPtr->activeStipple!=None) {
+ stipple = textPtr->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (textPtr->disabledColor!=NULL) {
+ color = textPtr->disabledColor;
+ }
+ if (textPtr->disabledStipple!=None) {
+ stipple = textPtr->disabledStipple;
+ }
+ }
+
+ newGC = newSelGC = None;
+ if (textPtr->tkfont != NULL) {
+ gcValues.font = Tk_FontId(textPtr->tkfont);
+ mask = GCFont;
+ if (color != NULL) {
+ gcValues.foreground = color->pixel;
+ mask |= GCForeground;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ mask &= ~(GCTile|GCFillStyle|GCStipple);
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ gcValues.foreground = textInfoPtr->selFgColorPtr->pixel;
+ newSelGC = Tk_GetGC(tkwin, mask|GCForeground, &gcValues);
+ }
+ if (textPtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->gc);
+ }
+ textPtr->gc = newGC;
+ if (textPtr->selTextGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->selTextGC);
+ }
+ textPtr->selTextGC = newSelGC;
+
+ selBgColorPtr = Tk_3DBorderColor(textInfoPtr->selBorder);
+ if (Tk_3DBorderColor(textInfoPtr->insertBorder)->pixel
+ == selBgColorPtr->pixel) {
+ if (selBgColorPtr->pixel == BlackPixelOfScreen(Tk_Screen(tkwin))) {
+ gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+ } else {
+ gcValues.foreground = BlackPixelOfScreen(Tk_Screen(tkwin));
+ }
+ newGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (textPtr->cursorOffGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->cursorOffGC);
+ }
+ textPtr->cursorOffGC = newGC;
+
+
+ /*
+ * If the text was changed, move the selection and insertion indices
+ * to keep them inside the item.
+ */
+
+ textPtr->numBytes = strlen(textPtr->text);
+ textPtr->numChars = Tcl_NumUtfChars(textPtr->text, textPtr->numBytes);
+ if (textInfoPtr->selItemPtr == itemPtr) {
+
+ if (textInfoPtr->selectFirst >= textPtr->numChars) {
+ textInfoPtr->selItemPtr = NULL;
+ } else {
+ if (textInfoPtr->selectLast >= textPtr->numChars) {
+ textInfoPtr->selectLast = textPtr->numChars - 1;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor >= textPtr->numChars)) {
+ textInfoPtr->selectAnchor = textPtr->numChars - 1;
+ }
+ }
+ }
+ if (textPtr->insertPos >= textPtr->numChars) {
+ textPtr->insertPos = textPtr->numChars;
+ }
+
+ ComputeTextBbox(canvas, textPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteText --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteText(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for canvas. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (textPtr->color != NULL) {
+ Tk_FreeColor(textPtr->color);
+ }
+ if (textPtr->activeColor != NULL) {
+ Tk_FreeColor(textPtr->activeColor);
+ }
+ if (textPtr->disabledColor != NULL) {
+ Tk_FreeColor(textPtr->disabledColor);
+ }
+ Tk_FreeFont(textPtr->tkfont);
+ if (textPtr->stipple != None) {
+ Tk_FreeBitmap(display, textPtr->stipple);
+ }
+ if (textPtr->activeStipple != None) {
+ Tk_FreeBitmap(display, textPtr->activeStipple);
+ }
+ if (textPtr->disabledStipple != None) {
+ Tk_FreeBitmap(display, textPtr->disabledStipple);
+ }
+ if (textPtr->text != NULL) {
+ ckfree(textPtr->text);
+ }
+
+ Tk_FreeTextLayout(textPtr->textLayout);
+ if (textPtr->gc != None) {
+ Tk_FreeGC(display, textPtr->gc);
+ }
+ if (textPtr->selTextGC != None) {
+ Tk_FreeGC(display, textPtr->selTextGC);
+ }
+ if (textPtr->cursorOffGC != None) {
+ Tk_FreeGC(display, textPtr->cursorOffGC);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeTextBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a text item.
+ * In addition, it recomputes all of the geometry information
+ * used to display a text item or check for mouse hits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr, and the linePtr structure is regenerated
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeTextBbox(canvas, textPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ TextItem *textPtr; /* Item whose bbox is to be recomputed. */
+{
+ Tk_CanvasTextInfo *textInfoPtr;
+ int leftX, topY, width, height, fudge;
+ Tk_State state = textPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ Tk_FreeTextLayout(textPtr->textLayout);
+ textPtr->textLayout = Tk_ComputeTextLayout(textPtr->tkfont,
+ textPtr->text, textPtr->numChars, textPtr->width,
+ textPtr->justify, 0, &width, &height);
+
+ if (state == TK_STATE_HIDDEN || textPtr->color == NULL) {
+ width = height = 0;
+ }
+
+ /*
+ * Use overall geometry information to compute the top-left corner
+ * of the bounding box for the text item.
+ */
+
+ leftX = (int) floor(textPtr->x + 0.5);
+ topY = (int) floor(textPtr->y + 0.5);
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ break;
+
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ topY -= height / 2;
+ break;
+
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ topY -= height;
+ break;
+ }
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ break;
+
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ leftX -= width / 2;
+ break;
+
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ leftX -= width;
+ break;
+ }
+
+ textPtr->leftEdge = leftX;
+ textPtr->rightEdge = leftX + width;
+
+ /*
+ * Last of all, update the bounding box for the item. The item's
+ * bounding box includes the bounding box of all its lines, plus
+ * an extra fudge factor for the cursor border (which could
+ * potentially be quite large).
+ */
+
+ textInfoPtr = textPtr->textInfoPtr;
+ fudge = (textInfoPtr->insertWidth + 1) / 2;
+ if (textInfoPtr->selBorderWidth > fudge) {
+ fudge = textInfoPtr->selBorderWidth;
+ }
+ textPtr->header.x1 = leftX - fudge;
+ textPtr->header.y1 = topY;
+ textPtr->header.x2 = leftX + width + fudge;
+ textPtr->header.y2 = topY + height;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayCanvText --
+ *
+ * This procedure is invoked to draw a text item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw item. */
+ int x, y, width, height; /* Describes region of canvas that must be
+ * redisplayed (not used). */
+{
+ TextItem *textPtr;
+ Tk_CanvasTextInfo *textInfoPtr;
+ int selFirstChar, selLastChar;
+ short drawableX, drawableY;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+
+ textPtr = (TextItem *) itemPtr;
+ textInfoPtr = textPtr->textInfoPtr;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ stipple = textPtr->stipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (textPtr->activeStipple!=None) {
+ stipple = textPtr->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (textPtr->disabledStipple!=None) {
+ stipple = textPtr->disabledStipple;
+ }
+ }
+
+ if (textPtr->gc == None) {
+ return;
+ }
+
+ /*
+ * If we're stippling, then modify the stipple offset in the GC. Be
+ * sure to reset the offset when done, since the GC is supposed to be
+ * read-only.
+ */
+
+ if (stipple != None) {
+ Tk_CanvasSetOffset(canvas, textPtr->gc, &textPtr->tsoffset);
+ }
+
+ selFirstChar = -1;
+ selLastChar = 0; /* lint. */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ selFirstChar = textInfoPtr->selectFirst;
+ selLastChar = textInfoPtr->selectLast;
+ if (selLastChar > textPtr->numChars) {
+ selLastChar = textPtr->numChars - 1;
+ }
+ if ((selFirstChar >= 0) && (selFirstChar <= selLastChar)) {
+ int xFirst, yFirst, hFirst;
+ int xLast, yLast, wLast;
+
+ /*
+ * Draw a special background under the selection.
+ */
+
+ Tk_CharBbox(textPtr->textLayout, selFirstChar, &xFirst, &yFirst,
+ NULL, &hFirst);
+ Tk_CharBbox(textPtr->textLayout, selLastChar, &xLast, &yLast,
+ &wLast, NULL);
+
+ /*
+ * If the selection spans the end of this line, then display
+ * selection background all the way to the end of the line.
+ * However, for the last line we only want to display up to the
+ * last character, not the end of the line.
+ */
+
+ x = xFirst;
+ height = hFirst;
+ for (y = yFirst ; y <= yLast; y += height) {
+ if (y == yLast) {
+ width = xLast + wLast - x;
+ } else {
+ width = textPtr->rightEdge - textPtr->leftEdge - x;
+ }
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (textPtr->leftEdge + x
+ - textInfoPtr->selBorderWidth),
+ (double) (textPtr->header.y1 + y),
+ &drawableX, &drawableY);
+ Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable,
+ textInfoPtr->selBorder, drawableX, drawableY,
+ width + 2 * textInfoPtr->selBorderWidth,
+ height, textInfoPtr->selBorderWidth, TK_RELIEF_RAISED);
+ x = 0;
+ }
+ }
+ }
+
+ /*
+ * If the insertion point should be displayed, then draw a special
+ * background for the cursor before drawing the text. Note: if
+ * we're the cursor item but the cursor is turned off, then redraw
+ * background over the area of the cursor. This guarantees that
+ * the selection won't make the cursor invisible on mono displays,
+ * where both are drawn in the same color.
+ */
+
+ if ((textInfoPtr->focusItemPtr == itemPtr) && (textInfoPtr->gotFocus)) {
+ if (Tk_CharBbox(textPtr->textLayout, textPtr->insertPos,
+ &x, &y, NULL, &height)) {
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (textPtr->leftEdge + x
+ - (textInfoPtr->insertWidth / 2)),
+ (double) (textPtr->header.y1 + y),
+ &drawableX, &drawableY);
+ Tk_SetCaretPos(Tk_CanvasTkwin(canvas), drawableX, drawableY,
+ height);
+ if (textInfoPtr->cursorOn) {
+ Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable,
+ textInfoPtr->insertBorder,
+ drawableX, drawableY,
+ textInfoPtr->insertWidth, height,
+ textInfoPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (textPtr->cursorOffGC != None) {
+ /*
+ * Redraw the background over the area of the cursor,
+ * even though the cursor is turned off. This
+ * guarantees that the selection won't make the cursor
+ * invisible on mono displays, where both may be drawn
+ * in the same color.
+ */
+
+ XFillRectangle(display, drawable, textPtr->cursorOffGC,
+ drawableX, drawableY,
+ (unsigned) textInfoPtr->insertWidth,
+ (unsigned) height);
+ }
+ }
+ }
+
+
+ /*
+ * Display the text in two pieces: draw the entire text item, then
+ * draw the selected text on top of it. The selected text then
+ * will only need to be drawn if it has different attributes (such
+ * as foreground color) than regular text.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, (double) textPtr->leftEdge,
+ (double) textPtr->header.y1, &drawableX, &drawableY);
+ Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout,
+ drawableX, drawableY, 0, -1);
+
+ if ((selFirstChar >= 0) && (textPtr->selTextGC != textPtr->gc)) {
+ Tk_DrawTextLayout(display, drawable, textPtr->selTextGC,
+ textPtr->textLayout, drawableX, drawableY, selFirstChar,
+ selLastChar + 1);
+ }
+
+ if (stipple != None) {
+ XSetTSOrigin(display, textPtr->gc, 0, 0);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TextInsert --
+ *
+ * Insert characters into a text item at a given position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The text in the given item is modified. The cursor and
+ * selection positions are also modified to reflect the
+ * insertion.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TextInsert(canvas, itemPtr, index, string)
+ Tk_Canvas canvas; /* Canvas containing text item. */
+ Tk_Item *itemPtr; /* Text item to be modified. */
+ int index; /* Character index before which string is
+ * to be inserted. */
+ char *string; /* New characters to be inserted. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteIndex, byteCount, charsAdded;
+ char *new, *text;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ string = Tcl_GetStringFromObj((Tcl_Obj *) string, &byteCount);
+
+ text = textPtr->text;
+
+ if (index < 0) {
+ index = 0;
+ }
+ if (index > textPtr->numChars) {
+ index = textPtr->numChars;
+ }
+ byteIndex = Tcl_UtfAtIndex(text, index) - text;
+ byteCount = strlen(string);
+ if (byteCount == 0) {
+ return;
+ }
+
+ new = (char *) ckalloc((unsigned) textPtr->numBytes + byteCount + 1);
+ memcpy(new, text, (size_t) byteIndex);
+ strcpy(new + byteIndex, string);
+ strcpy(new + byteIndex + byteCount, text + byteIndex);
+
+ ckfree(text);
+ textPtr->text = new;
+ charsAdded = Tcl_NumUtfChars(string, byteCount);
+ textPtr->numChars += charsAdded;
+ textPtr->numBytes += byteCount;
+
+ /*
+ * Inserting characters invalidates indices such as those for the
+ * selection and cursor. Update the indices appropriately.
+ */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst >= index) {
+ textInfoPtr->selectFirst += charsAdded;
+ }
+ if (textInfoPtr->selectLast >= index) {
+ textInfoPtr->selectLast += charsAdded;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor >= index)) {
+ textInfoPtr->selectAnchor += charsAdded;
+ }
+ }
+ if (textPtr->insertPos >= index) {
+ textPtr->insertPos += charsAdded;
+ }
+ ComputeTextBbox(canvas, textPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TextDeleteChars --
+ *
+ * Delete one or more characters from a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters between "first" and "last", inclusive, get
+ * deleted from itemPtr, and things like the selection
+ * position get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TextDeleteChars(canvas, itemPtr, first, last)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item in which to delete characters. */
+ int first; /* Character index of first character to
+ * delete. */
+ int last; /* Character index of last character to
+ * delete (inclusive). */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteIndex, byteCount, charsRemoved;
+ char *new, *text;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ text = textPtr->text;
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= textPtr->numChars) {
+ last = textPtr->numChars - 1;
+ }
+ if (first > last) {
+ return;
+ }
+ charsRemoved = last + 1 - first;
+
+ byteIndex = Tcl_UtfAtIndex(text, first) - text;
+ byteCount = Tcl_UtfAtIndex(text + byteIndex, charsRemoved)
+ - (text + byteIndex);
+
+ new = (char *) ckalloc((unsigned) (textPtr->numBytes + 1 - byteCount));
+ memcpy(new, text, (size_t) byteIndex);
+ strcpy(new + byteIndex, text + byteIndex + byteCount);
+
+ ckfree(text);
+ textPtr->text = new;
+ textPtr->numChars -= charsRemoved;
+ textPtr->numBytes -= byteCount;
+
+ /*
+ * Update indexes for the selection and cursor to reflect the
+ * renumbering of the remaining characters.
+ */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst > first) {
+ textInfoPtr->selectFirst -= charsRemoved;
+ if (textInfoPtr->selectFirst < first) {
+ textInfoPtr->selectFirst = first;
+ }
+ }
+ if (textInfoPtr->selectLast >= first) {
+ textInfoPtr->selectLast -= charsRemoved;
+ if (textInfoPtr->selectLast < first - 1) {
+ textInfoPtr->selectLast = first - 1;
+ }
+ }
+ if (textInfoPtr->selectFirst > textInfoPtr->selectLast) {
+ textInfoPtr->selItemPtr = NULL;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor > first)) {
+ textInfoPtr->selectAnchor -= charsRemoved;
+ if (textInfoPtr->selectAnchor < first) {
+ textInfoPtr->selectAnchor = first;
+ }
+ }
+ }
+ if (textPtr->insertPos > first) {
+ textPtr->insertPos -= charsRemoved;
+ if (textPtr->insertPos < first) {
+ textPtr->insertPos = first;
+ }
+ }
+ ComputeTextBbox(canvas, textPtr);
+ return;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * text item, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the text item. If
+ * the point isn't inside the text item then the return value
+ * is the distance from the point to the text item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+TextToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ TextItem *textPtr;
+ Tk_State state = itemPtr->state;
+ double value;
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ textPtr = (TextItem *) itemPtr;
+ value = (double) Tk_DistanceToTextLayout(textPtr->textLayout,
+ (int) pointPtr[0] - textPtr->leftEdge,
+ (int) pointPtr[1] - textPtr->header.y1);
+
+ if ((state == TK_STATE_HIDDEN) || (textPtr->color == NULL) ||
+ (textPtr->text == NULL) || (*textPtr->text == 0)) {
+ value = 1.0e36;
+ }
+ return value;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ TextItem *textPtr;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ textPtr = (TextItem *) itemPtr;
+ return Tk_IntersectTextLayout(textPtr->textLayout,
+ (int) (rectPtr[0] + 0.5) - textPtr->leftEdge,
+ (int) (rectPtr[1] + 0.5) - textPtr->header.y1,
+ (int) (rectPtr[2] - rectPtr[0] + 0.5),
+ (int) (rectPtr[3] - rectPtr[1] + 0.5));
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleText --
+ *
+ * This procedure is invoked to rescale a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Scales the position of the text, but not the size
+ * of the font for the text.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ScaleText(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing rectangle. */
+ Tk_Item *itemPtr; /* Rectangle to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ textPtr->x = originX + scaleX*(textPtr->x - originX);
+ textPtr->y = originY + scaleY*(textPtr->y - originY);
+ ComputeTextBbox(canvas, textPtr);
+ return;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateText --
+ *
+ * This procedure is called to move a text item by a
+ * given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the text item is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the
+ * item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateText(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be moved. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ textPtr->x += deltaX;
+ textPtr->y += deltaY;
+ ComputeTextBbox(canvas, textPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GetTextIndex --
+ *
+ * Parse an index into a text item and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the index (into itemPtr) corresponding to
+ * string. Otherwise an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetTextIndex(interp, canvas, itemPtr, obj, indexPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item for which the index is being
+ * specified. */
+ Tcl_Obj *obj; /* Specification of a particular character
+ * in itemPtr's text. */
+ int *indexPtr; /* Where to store converted character
+ * index. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ size_t length;
+ int c;
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+ char *string = Tcl_GetStringFromObj(obj, (int *) &length);
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
+ *indexPtr = textPtr->numChars;
+ } else if ((c == 'i') && (strncmp(string, "insert", length) == 0)) {
+ *indexPtr = textPtr->insertPos;
+ } else if ((c == 's') && (strncmp(string, "sel.first", length) == 0)
+ && (length >= 5)) {
+ if (textInfoPtr->selItemPtr != itemPtr) {
+ Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ *indexPtr = textInfoPtr->selectFirst;
+ } else if ((c == 's') && (strncmp(string, "sel.last", length) == 0)
+ && (length >= 5)) {
+ if (textInfoPtr->selItemPtr != itemPtr) {
+ Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ *indexPtr = textInfoPtr->selectLast;
+ } else if (c == '@') {
+ int x, y;
+ double tmp;
+ char *end, *p;
+
+ p = string+1;
+ tmp = strtod(p, &end);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ x = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5);
+ p = end+1;
+ tmp = strtod(p, &end);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ y = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5);
+ *indexPtr = Tk_PointToChar(textPtr->textLayout,
+ x + canvasPtr->scrollX1 - textPtr->leftEdge,
+ y + canvasPtr->scrollY1 - textPtr->header.y1);
+ } else if (Tcl_GetIntFromObj((Tcl_Interp *)NULL, obj, indexPtr) == TCL_OK) {
+ if (*indexPtr < 0){
+ *indexPtr = 0;
+ } else if (*indexPtr > textPtr->numChars) {
+ *indexPtr = textPtr->numChars;
+ }
+ } else {
+ /*
+ * Some of the paths here leave messages in the interp's result,
+ * so we have to clear it out before storing our own message.
+ */
+
+ badIndex:
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(interp, "bad index \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * SetTextCursor --
+ *
+ * Set the position of the insertion cursor in this item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor position will change.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+SetTextCursor(canvas, itemPtr, index)
+ Tk_Canvas canvas; /* Record describing canvas widget. */
+ Tk_Item *itemPtr; /* Text item in which cursor position is to
+ * be set. */
+ int index; /* Character index of character just before
+ * which cursor is to be positioned. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (index < 0) {
+ textPtr->insertPos = 0;
+ } else if (index > textPtr->numChars) {
+ textPtr->insertPos = textPtr->numChars;
+ } else {
+ textPtr->insertPos = index;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GetSelText --
+ *
+ * This procedure is invoked to return the selected portion
+ * of a text item. It is only called when this item has
+ * the selection.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetSelText(canvas, itemPtr, offset, buffer, maxBytes)
+ Tk_Canvas canvas; /* Canvas containing selection. */
+ Tk_Item *itemPtr; /* Text item containing selection. */
+ int offset; /* Byte offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place selection. */
+ int maxBytes; /* Maximum number of bytes to place at
+ * buffer, not including terminating NULL
+ * character. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteCount;
+ char *text;
+ CONST char *selStart, *selEnd;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ if ((textInfoPtr->selectFirst < 0) ||
+ (textInfoPtr->selectFirst > textInfoPtr->selectLast)) {
+ return 0;
+ }
+ text = textPtr->text;
+ selStart = Tcl_UtfAtIndex(text, textInfoPtr->selectFirst);
+ selEnd = Tcl_UtfAtIndex(selStart,
+ textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst);
+ byteCount = selEnd - selStart - offset;
+ if (byteCount > maxBytes) {
+ byteCount = maxBytes;
+ }
+ if (byteCount <= 0) {
+ return 0;
+ }
+ memcpy(buffer, selStart + offset, (size_t) byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * text items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is wanted. */
+ int prepass; /* 1 means this is a prepass to collect
+ * font information; 0 means final Postscript
+ * is being created. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int x, y;
+ Tk_FontMetrics fm;
+ char *justify;
+ char buffer[500];
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ color = textPtr->color;
+ stipple = textPtr->stipple;
+ if (state == TK_STATE_HIDDEN || textPtr->color == NULL ||
+ textPtr->text == NULL || *textPtr->text == 0) {
+ return TCL_OK;
+ } else if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (textPtr->activeColor!=NULL) {
+ color = textPtr->activeColor;
+ }
+ if (textPtr->activeStipple!=None) {
+ stipple = textPtr->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (textPtr->disabledColor!=NULL) {
+ color = textPtr->disabledColor;
+ }
+ if (textPtr->disabledStipple!=None) {
+ stipple = textPtr->disabledStipple;
+ }
+ }
+
+ if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (prepass != 0) {
+ return TCL_OK;
+ }
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "/StippleText {\n ",
+ (char *) NULL);
+ Tk_CanvasPsStipple(interp, canvas, stipple);
+ Tcl_AppendResult(interp, "} bind def\n", (char *) NULL);
+ }
+
+ sprintf(buffer, "%.15g %.15g [\n", textPtr->x,
+ Tk_CanvasPsY(canvas, textPtr->y));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ Tk_TextLayoutToPostscript(interp, textPtr->textLayout);
+
+ x = 0; y = 0; justify = NULL; /* lint. */
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW: x = 0; y = 0; break;
+ case TK_ANCHOR_N: x = 1; y = 0; break;
+ case TK_ANCHOR_NE: x = 2; y = 0; break;
+ case TK_ANCHOR_E: x = 2; y = 1; break;
+ case TK_ANCHOR_SE: x = 2; y = 2; break;
+ case TK_ANCHOR_S: x = 1; y = 2; break;
+ case TK_ANCHOR_SW: x = 0; y = 2; break;
+ case TK_ANCHOR_W: x = 0; y = 1; break;
+ case TK_ANCHOR_CENTER: x = 1; y = 1; break;
+ }
+ switch (textPtr->justify) {
+ case TK_JUSTIFY_LEFT: justify = "0"; break;
+ case TK_JUSTIFY_CENTER: justify = "0.5";break;
+ case TK_JUSTIFY_RIGHT: justify = "1"; break;
+ }
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ sprintf(buffer, "] %d %g %g %s %s DrawText\n",
+ fm.linespace, x / -2.0, y / 2.0, justify,
+ ((stipple == None) ? "false" : "true"));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ return TCL_OK;
+}
--- /dev/null
+/*
+ * tkCanvUtil.c --
+ *
+ * This procedure contains a collection of utility procedures
+ * used by the implementations of various canvas item types.
+ *
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasTkwin --
+ *
+ * Given a token for a canvas, this procedure returns the
+ * widget that represents the canvas.
+ *
+ * Results:
+ * The return value is a handle for the widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CanvasTkwin(canvas)
+ Tk_Canvas canvas; /* Token for the canvas. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ return canvasPtr->tkwin;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasDrawableCoords --
+ *
+ * Given an (x,y) coordinate pair within a canvas, this procedure
+ * returns the corresponding coordinates at which the point should
+ * be drawn in the drawable used for display.
+ *
+ * Results:
+ * There is no return value. The values at *drawableXPtr and
+ * *drawableYPtr are filled in with the coordinates at which
+ * x and y should be drawn. These coordinates are clipped
+ * to fit within a "short", since this is what X uses in
+ * most cases for drawing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasDrawableCoords(canvas, x, y, drawableXPtr, drawableYPtr)
+ Tk_Canvas canvas; /* Token for the canvas. */
+ double x, y; /* Coordinates in canvas space. */
+ short *drawableXPtr, *drawableYPtr; /* Screen coordinates are stored
+ * here. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ double tmp;
+
+ tmp = x - canvasPtr->drawableXOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *drawableXPtr = 32767;
+ } else if (tmp < -32768) {
+ *drawableXPtr = -32768;
+ } else {
+ *drawableXPtr = (short) tmp;
+ }
+
+ tmp = y - canvasPtr->drawableYOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *drawableYPtr = 32767;
+ } else if (tmp < -32768) {
+ *drawableYPtr = -32768;
+ } else {
+ *drawableYPtr = (short) tmp;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasWindowCoords --
+ *
+ * Given an (x,y) coordinate pair within a canvas, this procedure
+ * returns the corresponding coordinates in the canvas's window.
+ *
+ * Results:
+ * There is no return value. The values at *screenXPtr and
+ * *screenYPtr are filled in with the coordinates at which
+ * (x,y) appears in the canvas's window. These coordinates
+ * are clipped to fit within a "short", since this is what X
+ * uses in most cases for drawing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr)
+ Tk_Canvas canvas; /* Token for the canvas. */
+ double x, y; /* Coordinates in canvas space. */
+ short *screenXPtr, *screenYPtr; /* Screen coordinates are stored
+ * here. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ double tmp;
+
+ tmp = x - canvasPtr->xOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *screenXPtr = 32767;
+ } else if (tmp < -32768) {
+ *screenXPtr = -32768;
+ } else {
+ *screenXPtr = (short) tmp;
+ }
+
+ tmp = y - canvasPtr->yOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *screenYPtr = 32767;
+ } else if (tmp < -32768) {
+ *screenYPtr = -32768;
+ } else {
+ *screenYPtr = (short) tmp;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasGetCoord --
+ *
+ * Given a string, returns a floating-point canvas coordinate
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * canvas coordinate is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasGetCoord(interp, canvas, string, doublePtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to which coordinate applies. */
+ CONST char *string; /* Describes coordinate (any screen
+ * coordinate form may be used here). */
+ double *doublePtr; /* Place to store converted coordinate. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if (Tk_GetScreenMM(canvasPtr->interp, canvasPtr->tkwin, string,
+ doublePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *doublePtr *= canvasPtr->pixelsPerMM;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasGetCoordFromObj --
+ *
+ * Given a string, returns a floating-point canvas coordinate
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * canvas coordinate is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasGetCoordFromObj(interp, canvas, obj, doublePtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to which coordinate applies. */
+ Tcl_Obj *obj; /* Describes coordinate (any screen
+ * coordinate form may be used here). */
+ double *doublePtr; /* Place to store converted coordinate. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if (Tk_GetMMFromObj(canvasPtr->interp, canvasPtr->tkwin, obj,
+ doublePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *doublePtr *= canvasPtr->pixelsPerMM;
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasSetStippleOrigin --
+ *
+ * This procedure sets the stipple origin in a graphics context
+ * so that stipples drawn with the GC will line up with other
+ * stipples previously drawn in the canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The graphics context is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasSetStippleOrigin(canvas, gc)
+ Tk_Canvas canvas; /* Token for a canvas. */
+ GC gc; /* Graphics context that is about to be
+ * used to draw a stippled pattern as
+ * part of redisplaying the canvas. */
+
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+
+ XSetTSOrigin(canvasPtr->display, gc, -canvasPtr->drawableXOrigin,
+ -canvasPtr->drawableYOrigin);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasSetOffset--
+ *
+ * This procedure sets the stipple offset in a graphics
+ * context so that stipples drawn with the GC will
+ * line up with other stipples with the same offset.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The graphics context is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasSetOffset(canvas, gc, offset)
+ Tk_Canvas canvas; /* Token for a canvas. */
+ GC gc; /* Graphics context that is about to be
+ * used to draw a stippled pattern as
+ * part of redisplaying the canvas. */
+ Tk_TSOffset *offset; /* offset (may be NULL pointer)*/
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ int flags = 0;
+ int x = - canvasPtr->drawableXOrigin;
+ int y = - canvasPtr->drawableYOrigin;
+
+ if (offset != NULL) {
+ flags = offset->flags;
+ x += offset->xoffset;
+ y += offset->yoffset;
+ }
+ if ((flags & TK_OFFSET_RELATIVE) && !(flags & TK_OFFSET_INDEX)) {
+ Tk_SetTSOrigin(canvasPtr->tkwin, gc, x - canvasPtr->xOrigin,
+ y - canvasPtr->yOrigin);
+ } else {
+ XSetTSOrigin(canvasPtr->display, gc, x, y);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasGetTextInfo --
+ *
+ * This procedure returns a pointer to a structure containing
+ * information about the selection and insertion cursor for
+ * a canvas widget. Items such as text items save the pointer
+ * and use it to share access to the information with the generic
+ * canvas code.
+ *
+ * Results:
+ * The return value is a pointer to the structure holding text
+ * information for the canvas. Most of the fields should not
+ * be modified outside the generic canvas code; see the user
+ * documentation for details.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_CanvasTextInfo *
+Tk_CanvasGetTextInfo(canvas)
+ Tk_Canvas canvas; /* Token for the canvas widget. */
+{
+ return &((TkCanvas *) canvas)->textInfo;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasTagsParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * "-tags" options for canvas items.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The tags for a given item get replaced by those indicated
+ * in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasTagsParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option (list of tag
+ * names). */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item (ignored). */
+{
+ register Tk_Item *itemPtr = (Tk_Item *) widgRec;
+ int argc, i;
+ CONST char **argv;
+ Tk_Uid *newPtr;
+
+ /*
+ * Break the value up into the individual tag names.
+ */
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that there's enough space in the item to hold the
+ * tag names.
+ */
+
+ if (itemPtr->tagSpace < argc) {
+ newPtr = (Tk_Uid *) ckalloc((unsigned) (argc * sizeof(Tk_Uid)));
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ newPtr[i] = itemPtr->tagPtr[i];
+ }
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ itemPtr->tagPtr = newPtr;
+ itemPtr->tagSpace = argc;
+ }
+ itemPtr->numTags = argc;
+ for (i = 0; i < argc; i++) {
+ itemPtr->tagPtr[i] = Tk_GetUid(argv[i]);
+ }
+ ckfree((char *) argv);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasTagsPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-tags" configuration
+ * option for canvas items.
+ *
+ * Results:
+ * The return value is a string describing all the tags for
+ * the item referred to by "widgRec". In addition, *freeProcPtr
+ * is filled in with the address of a procedure to call to free
+ * the result string when it's no longer needed (or NULL to
+ * indicate that the string doesn't need to be freed).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_CanvasTagsPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Tk_Item *itemPtr = (Tk_Item *) widgRec;
+
+ if (itemPtr->numTags == 0) {
+ *freeProcPtr = (Tcl_FreeProc *) NULL;
+ return "";
+ }
+ if (itemPtr->numTags == 1) {
+ *freeProcPtr = (Tcl_FreeProc *) NULL;
+ return (char *) itemPtr->tagPtr[0];
+ }
+ *freeProcPtr = TCL_DYNAMIC;
+ return Tcl_Merge(itemPtr->numTags, (CONST char **) itemPtr->tagPtr);
+}
+\f
+
+static int DashConvert _ANSI_ARGS_((char *l, CONST char *p,
+ int n, double width));
+#define ABS(a) ((a>=0)?(a):(-(a)))
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvasDashParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * "-dash", "-activedash" and "-disableddash" options for canvas
+ * objects.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The dash list for a given canvas object gets replaced by
+ * those indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkCanvasDashParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ return Tk_GetDash(interp, value, (Tk_Dash *)(widgRec+offset));
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvasDashPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-dash", "-activedash"
+ * and "-disableddash" configuration options for canvas items.
+ *
+ * Results:
+ * The return value is a string describing all the dash list for
+ * the item referred to by "widgRec"and "offset". In addition,
+ * *freeProcPtr is filled in with the address of a procedure to
+ * call to free the result string when it's no longer needed (or
+ * NULL to indicate that the string doesn't need to be freed).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+TkCanvasDashPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset in record for item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ Tk_Dash *dash = (Tk_Dash *) (widgRec+offset);
+ char *buffer;
+ char *p;
+ int i = dash->number;
+
+ if (i < 0) {
+ i = -i;
+ *freeProcPtr = TCL_DYNAMIC;
+ buffer = (char *) ckalloc((unsigned int) (i+1));
+ p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ memcpy(buffer, p, (unsigned int) i);
+ buffer[i] = 0;
+ return buffer;
+ } else if (!i) {
+ *freeProcPtr = (Tcl_FreeProc *) NULL;
+ return "";
+ }
+ buffer = (char *)ckalloc((unsigned int) (4*i));
+ *freeProcPtr = TCL_DYNAMIC;
+
+ p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ sprintf(buffer, "%d", *p++ & 0xff);
+ while(--i) {
+ sprintf(buffer+strlen(buffer), " %d", *p++ & 0xff);
+ }
+ return buffer;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateSmoothMethod --
+ *
+ * This procedure is invoked to add additional values
+ * for the "-smooth" option to the list.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * In the future "-smooth <name>" will be accepted as
+ * smooth method for the line and polygon.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_SmoothMethod tkBezierSmoothMethod = {
+ "bezier",
+ TkMakeBezierCurve,
+ (void (*) _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas,
+ double *coordPtr, int numPoints, int numSteps)))
+ TkMakeBezierPostscript,
+};
+
+static void SmoothMethodCleanupProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp));
+
+typedef struct SmoothAssocData {
+ struct SmoothAssocData *nextPtr; /* pointer to next SmoothAssocData */
+ Tk_SmoothMethod smooth; /* name and functions associated with this
+ * option */
+} SmoothAssocData;
+
+void
+Tk_CreateSmoothMethod(interp, smooth)
+ Tcl_Interp *interp;
+ Tk_SmoothMethod *smooth;
+{
+ SmoothAssocData *methods, *typePtr2, *prevPtr, *ptr;
+ methods = (SmoothAssocData *) Tcl_GetAssocData(interp, "smoothMethod",
+ (Tcl_InterpDeleteProc **) NULL);
+
+ /*
+ * If there's already a smooth method with the given name, remove it.
+ */
+
+ for (typePtr2 = methods, prevPtr = NULL; typePtr2 != NULL;
+ prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
+ if (!strcmp(typePtr2->smooth.name, smooth->name)) {
+ if (prevPtr == NULL) {
+ methods = typePtr2->nextPtr;
+ } else {
+ prevPtr->nextPtr = typePtr2->nextPtr;
+ }
+ ckfree((char *) typePtr2);
+ break;
+ }
+ }
+ ptr = (SmoothAssocData *) ckalloc(sizeof(SmoothAssocData));
+ ptr->smooth.name = smooth->name;
+ ptr->smooth.coordProc = smooth->coordProc;
+ ptr->smooth.postscriptProc = smooth->postscriptProc;
+ ptr->nextPtr = methods;
+ Tcl_SetAssocData(interp, "smoothMethod", SmoothMethodCleanupProc,
+ (ClientData) ptr);
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * SmoothMethodCleanupProc --
+ *
+ * This procedure is invoked whenever an interpreter is deleted
+ * to cleanup the smooth methods.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Smooth methods are removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SmoothMethodCleanupProc(clientData, interp)
+ ClientData clientData; /* Points to "smoothMethod" AssocData
+ * for the interpreter. */
+ Tcl_Interp *interp; /* Interpreter that is being deleted. */
+{
+ SmoothAssocData *ptr, *methods = (SmoothAssocData *) clientData;
+
+ while (methods != NULL) {
+ methods = (ptr = methods)->nextPtr;
+ ckfree((char *) ptr);
+ }
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSmoothParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * the "-smooth" option.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The smooth option for a given item gets replaced by the value
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkSmoothParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ register Tk_SmoothMethod **smoothPtr =
+ (Tk_SmoothMethod **) (widgRec + offset);
+ Tk_SmoothMethod *smooth = NULL;
+ int b;
+ size_t length;
+ SmoothAssocData *methods;
+
+ if (value == NULL || *value == 0) {
+ *smoothPtr = (Tk_SmoothMethod *) NULL;
+ return TCL_OK;
+ }
+ length = strlen(value);
+ methods = (SmoothAssocData *) Tcl_GetAssocData(interp, "smoothMethod",
+ (Tcl_InterpDeleteProc **) NULL);
+ while (methods != (SmoothAssocData *) NULL) {
+ if (strncmp(value, methods->smooth.name, length) == 0) {
+ if (smooth != (Tk_SmoothMethod *) NULL) {
+ Tcl_AppendResult(interp, "ambigeous smooth method \"", value,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ smooth = &methods->smooth;
+ }
+ methods = methods->nextPtr;
+ }
+ if (smooth) {
+ *smoothPtr = smooth;
+ return TCL_OK;
+ } else if (strncmp(value, tkBezierSmoothMethod.name, length) == 0) {
+ /*
+ * We need to do handle the built-in bezier method.
+ */
+ *smoothPtr = &tkBezierSmoothMethod;
+ return TCL_OK;
+ }
+
+
+ if (Tcl_GetBoolean(interp, (char *) value, &b) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *smoothPtr = b ? &tkBezierSmoothMethod : (Tk_SmoothMethod*) NULL;
+ return TCL_OK;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSmoothPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-smooth"
+ * configuration option.
+ *
+ * Results:
+ * The return value is a string describing the smooth option for
+ * the item referred to by "widgRec". In addition, *freeProcPtr
+ * is filled in with the address of a procedure to call to free
+ * the result string when it's no longer needed (or NULL to
+ * indicate that the string doesn't need to be freed).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+TkSmoothPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Tk_SmoothMethod **smoothPtr = (Tk_SmoothMethod **) (widgRec + offset);
+
+ return (*smoothPtr) ? (*smoothPtr)->name : "0";
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetDash
+ *
+ * This procedure is used to parse a string, assuming
+ * it is dash information.
+ *
+ * Results:
+ * The return value is a standard Tcl result: TCL_OK means
+ * that the dash information was parsed ok, and
+ * TCL_ERROR means it couldn't be parsed.
+ *
+ * Side effects:
+ * Dash information in the dash structure is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetDash(interp, value, dash)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ CONST char *value; /* Textual specification of dash list. */
+ Tk_Dash *dash; /* Pointer to record in which to
+ * store dash information. */
+{
+ int argc, i;
+ CONST char **largv, **argv = NULL;
+ char *pt;
+
+ if ((value==(char *) NULL) || (*value==0) ) {
+ dash->number = 0;
+ return TCL_OK;
+ }
+ if ((*value == '.') || (*value == ',') ||
+ (*value == '-') || (*value == '_')) {
+ i = DashConvert((char *) NULL, value, -1, 0.0);
+ if (i>0) {
+ i = strlen(value);
+ } else {
+ goto badDashList;
+ }
+ if (i > sizeof(char *)) {
+ dash->pattern.pt = pt = (char *) ckalloc(strlen(value));
+ } else {
+ pt = dash->pattern.array;
+ }
+ memcpy(pt,value, (unsigned int) i);
+ dash->number = -i;
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ badDashList:
+ Tcl_AppendResult(interp, "bad dash list \"", value,
+ "\": must be a list of integers or a format like \"-..\"",
+ (char *) NULL);
+ syntaxError:
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ if (ABS(dash->number) > sizeof(char *))
+ ckfree((char *) dash->pattern.pt);
+ dash->number = 0;
+ return TCL_ERROR;
+ }
+
+ if (ABS(dash->number) > sizeof(char *)) {
+ ckfree((char *) dash->pattern.pt);
+ }
+ if (argc > sizeof(char *)) {
+ dash->pattern.pt = pt = (char *) ckalloc((unsigned int) argc);
+ } else {
+ pt = dash->pattern.array;
+ }
+ dash->number = argc;
+
+ largv = argv;
+ while(argc>0) {
+ if (Tcl_GetInt(interp, *largv, &i) != TCL_OK ||
+ i < 1 || i>255) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "expected integer in the range 1..255 but got \"",
+ *largv, "\"", (char *) NULL);
+ goto syntaxError;
+ }
+ *pt++ = i;
+ argc--; largv++;
+ }
+
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateOutline
+ *
+ * This procedure initializes the Tk_Outline structure
+ * with default values.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+void Tk_CreateOutline(outline)
+ Tk_Outline *outline;
+{
+ outline->gc = None;
+ outline->width = 1.0;
+ outline->activeWidth = 0.0;
+ outline->disabledWidth = 0.0;
+ outline->offset = 0;
+ outline->dash.number = 0;
+ outline->activeDash.number = 0;
+ outline->disabledDash.number = 0;
+ outline->tsoffset.flags = 0;
+ outline->tsoffset.xoffset = 0;
+ outline->tsoffset.yoffset = 0;
+ outline->color = NULL;
+ outline->activeColor = NULL;
+ outline->disabledColor = NULL;
+ outline->stipple = None;
+ outline->activeStipple = None;
+ outline->disabledStipple = None;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteOutline
+ *
+ * This procedure frees all memory that might be
+ * allocated and referenced in the Tk_Outline structure.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+void Tk_DeleteOutline(display, outline)
+ Display *display; /* Display containing window */
+ Tk_Outline *outline;
+{
+ if (outline->gc != None) {
+ Tk_FreeGC(display, outline->gc);
+ }
+ if (ABS(outline->dash.number) > sizeof(char *)) {
+ ckfree((char *) outline->dash.pattern.pt);
+ }
+ if (ABS(outline->activeDash.number) > sizeof(char *)) {
+ ckfree((char *) outline->activeDash.pattern.pt);
+ }
+ if (ABS(outline->disabledDash.number) > sizeof(char *)) {
+ ckfree((char *) outline->disabledDash.pattern.pt);
+ }
+ if (outline->color != NULL) {
+ Tk_FreeColor(outline->color);
+ }
+ if (outline->activeColor != NULL) {
+ Tk_FreeColor(outline->activeColor);
+ }
+ if (outline->disabledColor != NULL) {
+ Tk_FreeColor(outline->disabledColor);
+ }
+ if (outline->stipple != None) {
+ Tk_FreeBitmap(display, outline->stipple);
+ }
+ if (outline->activeStipple != None) {
+ Tk_FreeBitmap(display, outline->activeStipple);
+ }
+ if (outline->disabledStipple != None) {
+ Tk_FreeBitmap(display, outline->disabledStipple);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ConfigOutlineGC
+ *
+ * This procedure should be called in the canvas object
+ * during the configure command. The graphics context
+ * description in gcValues is updated according to the
+ * information in the dash structure, as far as possible.
+ *
+ * Results:
+ * The return-value is a mask, indicating which
+ * elements of gcValues have been updated.
+ * 0 means there is no outline.
+ *
+ * Side effects:
+ * GC information in gcValues is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int Tk_ConfigOutlineGC(gcValues, canvas, item, outline)
+ XGCValues *gcValues;
+ Tk_Canvas canvas;
+ Tk_Item *item;
+ Tk_Outline *outline;
+{
+ int mask = 0;
+ double width;
+ Tk_Dash *dash;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = item->state;
+
+ if (outline->width < 0.0) {
+ outline->width = 0.0;
+ }
+ if (outline->activeWidth < 0.0) {
+ outline->activeWidth = 0.0;
+ }
+ if (outline->disabledWidth < 0) {
+ outline->disabledWidth = 0.0;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ return 0;
+ }
+
+ width = outline->width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ dash = &(outline->dash);
+ color = outline->color;
+ stipple = outline->stipple;
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == item) {
+ if (outline->activeWidth>width) {
+ width = outline->activeWidth;
+ }
+ if (outline->activeDash.number != 0) {
+ dash = &(outline->activeDash);
+ }
+ if (outline->activeColor!=NULL) {
+ color = outline->activeColor;
+ }
+ if (outline->activeStipple!=None) {
+ stipple = outline->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (outline->disabledWidth>0) {
+ width = outline->disabledWidth;
+ }
+ if (outline->disabledDash.number != 0) {
+ dash = &(outline->disabledDash);
+ }
+ if (outline->disabledColor!=NULL) {
+ color = outline->disabledColor;
+ }
+ if (outline->disabledStipple!=None) {
+ stipple = outline->disabledStipple;
+ }
+ }
+
+ if (color==NULL) {
+ return 0;
+ }
+
+ gcValues->line_width = (int) (width + 0.5);
+ if (color != NULL) {
+ gcValues->foreground = color->pixel;
+ mask = GCForeground|GCLineWidth;
+ if (stipple != None) {
+ gcValues->stipple = stipple;
+ gcValues->fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ }
+ if (mask && (dash->number != 0)) {
+ gcValues->line_style = LineOnOffDash;
+ gcValues->dash_offset = outline->offset;
+ if (dash->number >= 2) {
+ gcValues->dashes = 4;
+ } else if (dash->number > 0) {
+ gcValues->dashes = dash->pattern.array[0];
+ } else {
+ gcValues->dashes = (char) (4 * width);
+ }
+ mask |= GCLineStyle|GCDashList|GCDashOffset;
+ }
+ return mask;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ChangeOutlineGC
+ *
+ * Updates the GC to represent the full information of
+ * the dash structure. Partly this is already done in
+ * Tk_ConfigOutlineGC().
+ * This function should be called just before drawing
+ * the dashed item.
+ *
+ * Results:
+ * 1 if there is a stipple pattern.
+ * 0 otherwise.
+ *
+ * Side effects:
+ * GC is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ChangeOutlineGC(canvas, item, outline)
+ Tk_Canvas canvas;
+ Tk_Item *item;
+ Tk_Outline *outline;
+{
+ CONST char *p;
+ double width;
+ Tk_Dash *dash;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = item->state;
+
+ width = outline->width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ dash = &(outline->dash);
+ color = outline->color;
+ stipple = outline->stipple;
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == item) {
+ if (outline->activeWidth > width) {
+ width = outline->activeWidth;
+ }
+ if (outline->activeDash.number != 0) {
+ dash = &(outline->activeDash);
+ }
+ if (outline->activeColor != NULL) {
+ color = outline->activeColor;
+ }
+ if (outline->activeStipple != None) {
+ stipple = outline->activeStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (outline->disabledWidth > width) {
+ width = outline->disabledWidth;
+ }
+ if (outline->disabledDash.number != 0) {
+ dash = &(outline->disabledDash);
+ }
+ if (outline->disabledColor != NULL) {
+ color = outline->disabledColor;
+ }
+ if (outline->disabledStipple != None) {
+ stipple = outline->disabledStipple;
+ }
+ }
+ if (color==NULL) {
+ return 0;
+ }
+
+ if ((dash->number<-1) || ((dash->number == -1) && (dash->pattern.array[1]!=','))) {
+ char *q;
+ int i = -dash->number;
+
+ p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ q = (char *) ckalloc(2*(unsigned int)i);
+ i = DashConvert(q, p, i, width);
+ XSetDashes(((TkCanvas *)canvas)->display, outline->gc, outline->offset, q, i);
+ ckfree(q);
+ } else if ( dash->number>2 || (dash->number==2 &&
+ (dash->pattern.array[0]!=dash->pattern.array[1]))) {
+ p = (char *) (dash->number > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ XSetDashes(((TkCanvas *)canvas)->display, outline->gc, outline->offset, p, dash->number);
+ }
+ if (stipple!=None) {
+ int w=0; int h=0;
+ Tk_TSOffset *tsoffset = &outline->tsoffset;
+ int flags = tsoffset->flags;
+ if (!(flags & TK_OFFSET_INDEX) && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) {
+ Tk_SizeOfBitmap(((TkCanvas *)canvas)->display, stipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ Tk_CanvasSetOffset(canvas, outline->gc, tsoffset);
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ return 1;
+ }
+ return 0;
+}
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ResetOutlineGC
+ *
+ * Restores the GC to the situation before
+ * Tk_ChangeDashGC() was called.
+ * This function should be called just after the dashed
+ * item is drawn, because the GC is supposed to be
+ * read-only.
+ *
+ * Results:
+ * 1 if there is a stipple pattern.
+ * 0 otherwise.
+ *
+ * Side effects:
+ * GC is updated.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tk_ResetOutlineGC(canvas, item, outline)
+ Tk_Canvas canvas;
+ Tk_Item *item;
+ Tk_Outline *outline;
+{
+ char dashList;
+ double width;
+ Tk_Dash *dash;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = item->state;
+
+ width = outline->width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ dash = &(outline->dash);
+ color = outline->color;
+ stipple = outline->stipple;
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == item) {
+ if (outline->activeWidth>width) {
+ width = outline->activeWidth;
+ }
+ if (outline->activeDash.number != 0) {
+ dash = &(outline->activeDash);
+ }
+ if (outline->activeColor!=NULL) {
+ color = outline->activeColor;
+ }
+ if (outline->activeStipple!=None) {
+ stipple = outline->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (outline->disabledWidth>width) {
+ width = outline->disabledWidth;
+ }
+ if (outline->disabledDash.number != 0) {
+ dash = &(outline->disabledDash);
+ }
+ if (outline->disabledColor!=NULL) {
+ color = outline->disabledColor;
+ }
+ if (outline->disabledStipple!=None) {
+ stipple = outline->disabledStipple;
+ }
+ }
+ if (color==NULL) {
+ return 0;
+ }
+
+ if ((dash->number > 2) || (dash->number < -1) || (dash->number==2 &&
+ (dash->pattern.array[0] != dash->pattern.array[1])) ||
+ ((dash->number == -1) && (dash->pattern.array[1] != ','))) {
+ if (dash->number < 0) {
+ dashList = (int) (4 * width + 0.5);
+ } else if (dash->number<3) {
+ dashList = dash->pattern.array[0];
+ } else {
+ dashList = 4;
+ }
+ XSetDashes(((TkCanvas *)canvas)->display, outline->gc,
+ outline->offset, &dashList , 1);
+ }
+ if (stipple != None) {
+ XSetTSOrigin(((TkCanvas *)canvas)->display, outline->gc, 0, 0);
+ return 1;
+ }
+ return 0;
+}
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsOutline
+ *
+ * Creates the postscript command for the correct
+ * Outline-information (width, dash, color and stipple).
+ *
+ * Results:
+ * TCL_OK if succeeded, otherwise TCL_ERROR.
+ *
+ * Side effects:
+ * canvas->interp->result contains the postscript string,
+ * or an error message if the result was TCL_ERROR.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tk_CanvasPsOutline(canvas, item, outline)
+ Tk_Canvas canvas;
+ Tk_Item *item;
+ Tk_Outline *outline;
+{
+ char string[41];
+ char pattern[11];
+ int i;
+ char *ptr;
+ char *str = string;
+ char *lptr = pattern;
+ Tcl_Interp *interp = ((TkCanvas *)canvas)->interp;
+ double width;
+ Tk_Dash *dash;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = item->state;
+
+ width = outline->width;
+ dash = &(outline->dash);
+ color = outline->color;
+ stipple = outline->stipple;
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == item) {
+ if (outline->activeWidth > width) {
+ width = outline->activeWidth;
+ }
+ if (outline->activeDash.number > 0) {
+ dash = &(outline->activeDash);
+ }
+ if (outline->activeColor != NULL) {
+ color = outline->activeColor;
+ }
+ if (outline->activeStipple != None) {
+ stipple = outline->activeStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (outline->disabledWidth > 0) {
+ width = outline->disabledWidth;
+ }
+ if (outline->disabledDash.number > 0) {
+ dash = &(outline->disabledDash);
+ }
+ if (outline->disabledColor != NULL) {
+ color = outline->disabledColor;
+ }
+ if (outline->disabledStipple != None) {
+ stipple = outline->disabledStipple;
+ }
+ }
+ sprintf(string, "%.15g setlinewidth\n", width);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+
+ if (dash->number > 10) {
+ str = (char *)ckalloc((unsigned int) (1 + 4*dash->number));
+ } else if (dash->number < -5) {
+ str = (char *)ckalloc((unsigned int) (1 - 8*dash->number));
+ lptr = (char *)ckalloc((unsigned int) (1 - 2*dash->number));
+ }
+ ptr = (char *) ((ABS(dash->number) > sizeof(char *)) ) ?
+ dash->pattern.pt : dash->pattern.array;
+ if (dash->number > 0) {
+ char *ptr0 = ptr;
+ sprintf(str, "[%d", *ptr++ & 0xff);
+ i = dash->number-1;
+ while (i--) {
+ sprintf(str+strlen(str), " %d", *ptr++ & 0xff);
+ }
+ Tcl_AppendResult(interp, str, (char *)NULL);
+ if (dash->number&1) {
+ Tcl_AppendResult(interp, " ", str+1, (char *)NULL);
+ }
+ sprintf(str, "] %d setdash\n", outline->offset);
+ Tcl_AppendResult(interp, str, (char *)NULL);
+ ptr = ptr0;
+ } else if (dash->number < 0) {
+ if ((i = DashConvert(lptr, ptr, -dash->number, width)) != 0) {
+ char *lptr0 = lptr;
+ sprintf(str, "[%d", *lptr++ & 0xff);
+ while (--i) {
+ sprintf(str+strlen(str), " %d", *lptr++ & 0xff);
+ }
+ Tcl_AppendResult(interp, str, (char *)NULL);
+ sprintf(str, "] %d setdash\n", outline->offset);
+ Tcl_AppendResult(interp, str, (char *)NULL);
+ lptr = lptr0;
+ } else {
+ Tcl_AppendResult(interp, "[] 0 setdash\n", (char *)NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "[] 0 setdash\n", (char *)NULL);
+ }
+ if (str != string) {
+ ckfree(str);
+ }
+ if (lptr != pattern) {
+ ckfree(lptr);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+
+ return TCL_OK;
+}
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DashConvert
+ *
+ * Converts a character-like dash-list (e.g. "-..")
+ * into an X11-style. l must point to a string that
+ * holds room to at least 2*n characters. if
+ * l == NULL, this function can be used for
+ * syntax checking only.
+ *
+ * Results:
+ * The length of the resulting X11 compatible
+ * dash-list. -1 if failed.
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DashConvert (l, p, n, width)
+ char *l;
+ CONST char *p;
+ int n;
+ double width;
+{
+ int result = 0;
+ int size, intWidth;
+
+ if (n<0) {
+ n = strlen(p);
+ }
+ intWidth = (int) (width + 0.5);
+ if (intWidth < 1) {
+ intWidth = 1;
+ }
+ while (n-- && *p) {
+ switch (*p++) {
+ case ' ':
+ if (result) {
+ if (l) {
+ l[-1] += intWidth + 1;
+ }
+ continue;
+ } else {
+ return 0;
+ }
+ break;
+ case '_':
+ size = 8;
+ break;
+ case '-':
+ size = 6;
+ break;
+ case ',':
+ size = 4;
+ break;
+ case '.':
+ size = 2;
+ break;
+ default:
+ return -1;
+ }
+ if (l) {
+ *l++ = size * intWidth;
+ *l++ = 4 * intWidth;
+ }
+ result += 2;
+ }
+ return result;
+}
--- /dev/null
+/*
+ * tkCanvWind.c --
+ *
+ * This file implements window items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each window item.
+ */
+
+typedef struct WindowItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double x, y; /* Coordinates of positioning point for
+ * window. */
+ Tk_Window tkwin; /* Window associated with item. NULL means
+ * window has been destroyed. */
+ int width; /* Width to use for window (<= 0 means use
+ * window's requested width). */
+ int height; /* Width to use for window (<= 0 means use
+ * window's requested width). */
+ Tk_Anchor anchor; /* Where to anchor window relative to
+ * (x,y). */
+ Tk_Canvas canvas; /* Canvas containing this item. */
+} WindowItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(WindowItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(WindowItem, height), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(WindowItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(WindowItem, tkwin), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeWindowBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ WindowItem *winItemPtr));
+static int ConfigureWinItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateWinItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void DeleteWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+static int WinItemCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static void WinItemLostSlaveProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin));
+static void WinItemRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void WinItemStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static int WinItemToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static int WinItemToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static double WinItemToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+#ifdef X_GetImage
+static int xerrorhandler _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *e));
+#endif
+static int CanvasPsWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Canvas canvas, double x,
+ double y, int width, int height));
+
+/*
+ * The structure below defines the window item type by means of procedures
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkWindowType = {
+ "window", /* name */
+ sizeof(WindowItem), /* itemSize */
+ CreateWinItem, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureWinItem, /* configureProc */
+ WinItemCoords, /* coordProc */
+ DeleteWinItem, /* deleteProc */
+ DisplayWinItem, /* displayProc */
+ 1|TK_CONFIG_OBJS, /* flags */
+ WinItemToPoint, /* pointProc */
+ WinItemToArea, /* areaProc */
+ WinItemToPostscript, /* postscriptProc */
+ ScaleWinItem, /* scaleProc */
+ TranslateWinItem, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* cursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+
+
+/*
+ * The structure below defines the official type record for the
+ * placer:
+ */
+
+static Tk_GeomMgr canvasGeomType = {
+ "canvas", /* name */
+ WinItemRequestProc, /* requestProc */
+ WinItemLostSlaveProc, /* lostSlaveProc */
+};
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateWinItem --
+ *
+ * This procedure is invoked to create a new window
+ * item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new window item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateWinItem(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing window. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ int i = 2;
+
+ if (objc == 1) {
+ i = 1;
+ } else if (objc > 1) {
+ char *arg = Tcl_GetString(objv[1]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+
+ if (objc < i) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x y ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ winItemPtr->tkwin = NULL;
+ winItemPtr->width = 0;
+ winItemPtr->height = 0;
+ winItemPtr->anchor = TK_ANCHOR_CENTER;
+ winItemPtr->canvas = canvas;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((WinItemCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureWinItem(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteWinItem(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on window items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemCoords(interp, canvas, itemPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(winItemPtr->x);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(winItemPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if (objc < 3) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &winItemPtr->x)
+ != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &winItemPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeWindowBbox(canvas, winItemPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureWinItem --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a window item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureWinItem(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Window item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ Tk_Window oldWindow;
+ Tk_Window canvasTkwin;
+
+ oldWindow = winItemPtr->tkwin;
+ canvasTkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) winItemPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing.
+ */
+
+ if (oldWindow != winItemPtr->tkwin) {
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ Tk_UnmaintainGeometry(oldWindow, canvasTkwin);
+ Tk_UnmapWindow(oldWindow);
+ }
+ if (winItemPtr->tkwin != NULL) {
+ Tk_Window ancestor, parent;
+
+ /*
+ * Make sure that the canvas is either the parent of the
+ * window associated with the item or a descendant of that
+ * parent. Also, don't allow a top-of-hierarchy window to be
+ * managed inside a canvas.
+ */
+
+ parent = Tk_Parent(winItemPtr->tkwin);
+ for (ancestor = canvasTkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_HIERARCHY) {
+ badWindow:
+ Tcl_AppendResult(interp, "can't use ",
+ Tk_PathName(winItemPtr->tkwin),
+ " in a window item of this canvas", (char *) NULL);
+ winItemPtr->tkwin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (((Tk_FakeWin *) (winItemPtr->tkwin))->flags & TK_TOP_HIERARCHY) {
+ goto badWindow;
+ }
+ if (winItemPtr->tkwin == canvasTkwin) {
+ goto badWindow;
+ }
+ Tk_CreateEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(winItemPtr->tkwin, &canvasGeomType,
+ (ClientData) winItemPtr);
+ }
+ }
+
+ ComputeWindowBbox(canvas, winItemPtr);
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteWinItem --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a window item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteWinItem(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Overall info about widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas);
+
+ if (winItemPtr->tkwin != NULL) {
+ Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(winItemPtr->tkwin, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeWindowBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a window item.
+ * This procedure is where the child window's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeWindowBbox(canvas, winItemPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ WindowItem *winItemPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height, x, y;
+ Tk_State state = winItemPtr->header.state;
+
+ x = (int) (winItemPtr->x + ((winItemPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (winItemPtr->y + ((winItemPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if ((winItemPtr->tkwin == NULL) || (state == TK_STATE_HIDDEN)) {
+ /*
+ * There is no window for this item yet. Just give it a 1x1
+ * bounding box. Don't give it a 0x0 bounding box; there are
+ * strange cases where this bounding box might be used as the
+ * dimensions of the window, and 0x0 causes problems under X.
+ */
+
+ winItemPtr->header.x1 = x;
+ winItemPtr->header.x2 = winItemPtr->header.x1 + 1;
+ winItemPtr->header.y1 = y;
+ winItemPtr->header.y2 = winItemPtr->header.y1 + 1;
+ return;
+ }
+
+ /*
+ * Compute dimensions of window.
+ */
+
+ width = winItemPtr->width;
+ if (width <= 0) {
+ width = Tk_ReqWidth(winItemPtr->tkwin);
+ if (width <= 0) {
+ width = 1;
+ }
+ }
+ height = winItemPtr->height;
+ if (height <= 0) {
+ height = Tk_ReqHeight(winItemPtr->tkwin);
+ if (height <= 0) {
+ height = 1;
+ }
+ }
+
+ /*
+ * Compute location of window, using anchor information.
+ */
+
+ switch (winItemPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ winItemPtr->header.x1 = x;
+ winItemPtr->header.y1 = y;
+ winItemPtr->header.x2 = x + width;
+ winItemPtr->header.y2 = y + height;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayWinItem --
+ *
+ * This procedure is invoked to "draw" a window item in a given
+ * drawable. Since the window draws itself, we needn't do any
+ * actual redisplay here. However, this procedure takes care
+ * of actually repositioning the child window so that it occupies
+ * the correct screen position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The child window's position may get changed. Note: this
+ * procedure gets called both when a window needs to be displayed
+ * and when it ceases to be visible on the screen (e.g. it was
+ * scrolled or moved off-screen or the enclosing canvas is
+ * unmapped).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayWinItem(canvas, itemPtr, display, drawable, regionX, regionY,
+ regionWidth, regionHeight)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int regionX, regionY, regionWidth, regionHeight;
+ /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ int width, height;
+ short x, y;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas);
+ Tk_State state = itemPtr->state;
+
+ if (winItemPtr->tkwin == NULL) {
+ return;
+ }
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state == TK_STATE_HIDDEN) {
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ return;
+ }
+ Tk_CanvasWindowCoords(canvas, (double) winItemPtr->header.x1,
+ (double) winItemPtr->header.y1, &x, &y);
+ width = winItemPtr->header.x2 - winItemPtr->header.x1;
+ height = winItemPtr->header.y2 - winItemPtr->header.y1;
+
+ /*
+ * If the window is completely out of the visible area of the canvas
+ * then unmap it. This code used not to be present (why unmap the
+ * window if it isn't visible anyway?) but this could cause the
+ * window to suddenly reappear if the canvas window got resized.
+ */
+
+ if (((x + width) <= 0) || ((y + height) <= 0)
+ || (x >= Tk_Width(canvasTkwin)) || (y >= Tk_Height(canvasTkwin))) {
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ return;
+ }
+
+ /*
+ * Reposition and map the window (but in different ways depending
+ * on whether the canvas is the window's parent).
+ */
+
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ if ((x != Tk_X(winItemPtr->tkwin)) || (y != Tk_Y(winItemPtr->tkwin))
+ || (width != Tk_Width(winItemPtr->tkwin))
+ || (height != Tk_Height(winItemPtr->tkwin))) {
+ Tk_MoveResizeWindow(winItemPtr->tkwin, x, y, width, height);
+ }
+ Tk_MapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(winItemPtr->tkwin, canvasTkwin, x, y,
+ width, height);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * window, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the window. If the
+ * point isn't inside the window then the return value is the
+ * distance from the point to the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+WinItemToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = winItemPtr->header.x1;
+ y1 = winItemPtr->header.y1;
+ x2 = winItemPtr->header.x2;
+ y2 = winItemPtr->header.y2;
+
+ /*
+ * Point is outside window.
+ */
+
+ if (pointPtr[0] < x1) {
+ xDiff = x1 - pointPtr[0];
+ } else if (pointPtr[0] >= x2) {
+ xDiff = pointPtr[0] + 1 - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (pointPtr[1] < y1) {
+ yDiff = y1 - pointPtr[1];
+ } else if (pointPtr[1] >= y2) {
+ yDiff = pointPtr[1] + 1 - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ if ((rectPtr[2] <= winItemPtr->header.x1)
+ || (rectPtr[0] >= winItemPtr->header.x2)
+ || (rectPtr[3] <= winItemPtr->header.y1)
+ || (rectPtr[1] >= winItemPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= winItemPtr->header.x1)
+ && (rectPtr[1] <= winItemPtr->header.y1)
+ && (rectPtr[2] >= winItemPtr->header.x2)
+ && (rectPtr[3] >= winItemPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * xerrorhandler --
+ *
+ * This is a dummy function to catch X11 errors during an
+ * attempt to print a canvas window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+#ifdef X_GetImage
+static int
+xerrorhandler(clientData, e)
+ ClientData clientData;
+ XErrorEvent *e;
+{
+ return 0;
+}
+#endif
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * window items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used to be there.
+ * If no error occurs, then Postscript for the item is appended
+ * to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created.*/
+{
+ WindowItem *winItemPtr = (WindowItem *)itemPtr;
+
+ double x, y;
+ int width, height;
+ Tk_Window tkwin = winItemPtr->tkwin;
+
+ if (prepass || winItemPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
+
+ width = Tk_Width(tkwin);
+ height = Tk_Height(tkwin);
+
+ /*
+ * Compute the coordinates of the lower-left corner of the window,
+ * taking into account the anchor position for the window.
+ */
+
+ x = winItemPtr->x;
+ y = Tk_CanvasPsY(canvas, winItemPtr->y);
+
+ switch (winItemPtr->anchor) {
+ case TK_ANCHOR_NW: y -= height; break;
+ case TK_ANCHOR_N: x -= width/2.0; y -= height; break;
+ case TK_ANCHOR_NE: x -= width; y -= height; break;
+ case TK_ANCHOR_E: x -= width; y -= height/2.0; break;
+ case TK_ANCHOR_SE: x -= width; break;
+ case TK_ANCHOR_S: x -= width/2.0; break;
+ case TK_ANCHOR_SW: break;
+ case TK_ANCHOR_W: y -= height/2.0; break;
+ case TK_ANCHOR_CENTER: x -= width/2.0; y -= height/2.0; break;
+ }
+
+ return CanvasPsWindow(interp, tkwin, canvas, x, y, width, height);
+}
+
+static int
+CanvasPsWindow(interp, tkwin, canvas, x, y, width, height)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Window tkwin; /* window to be printed */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ double x, y; /* origin of window. */
+ int width, height; /* width/height of window. */
+{
+ char buffer[256];
+ TkWindow *winPtr;
+ XImage *ximage;
+ int result;
+ Tcl_DString buffer1, buffer2;
+#ifdef X_GetImage
+ Tk_ErrorHandler handle;
+#endif
+
+ sprintf(buffer, "\n%%%% %s item (%s, %d x %d)\n%.15g %.15g translate\n",
+ Tk_Class(tkwin), Tk_PathName(tkwin), width, height, x, y);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ /* first try if the widget has its own "postscript" command. If it
+ * exists, this will produce much better postscript than
+ * when a pixmap is used.
+ */
+
+ Tcl_DStringInit(&buffer1);
+ Tcl_DStringInit(&buffer2);
+ Tcl_DStringGetResult(interp, &buffer2);
+ sprintf (buffer, "%s postscript -prolog 0\n", Tk_PathName(tkwin));
+ result = Tcl_Eval(interp, buffer);
+ Tcl_DStringGetResult(interp, &buffer1);
+ Tcl_DStringResult(interp, &buffer2);
+ Tcl_DStringFree(&buffer2);
+
+ if (result == TCL_OK) {
+ Tcl_AppendResult(interp,
+ "50 dict begin\nsave\ngsave\n",
+ (char *) NULL);
+ sprintf (buffer,
+ "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d",
+ height, width, height, width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ Tcl_AppendResult(interp, " 0 rlineto closepath\n",
+ "1.000 1.000 1.000 setrgbcolor AdjustColor\nfill\ngrestore\n",
+ Tcl_DStringValue(&buffer1), "\nrestore\nend\n\n\n",
+ (char *) NULL);
+ Tcl_DStringFree(&buffer1);
+
+ for (winPtr = ((TkWindow *) tkwin)->childList; winPtr != NULL;
+ winPtr = winPtr->nextPtr) {
+ if (Tk_IsMapped(winPtr)) {
+/* printf("child window: %s\n", winPtr->pathName);*/
+ }
+ }
+ return result;
+ }
+ Tcl_DStringFree(&buffer1);
+
+ /*
+ * If the window is off the screen it will generate an BadMatch/XError
+ * We catch any BadMatch errors here
+ */
+#ifdef X_GetImage
+ handle = Tk_CreateErrorHandler(Tk_Display(tkwin), BadMatch,
+ X_GetImage, -1, xerrorhandler, (ClientData) tkwin);
+#endif
+
+ /*
+ * Generate an XImage from the window. We can then read pixel
+ * values out of the XImage.
+ */
+
+ ximage = XGetImage(Tk_Display(tkwin), Tk_WindowId(tkwin), 0, 0,
+ (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap);
+
+#ifdef X_GetImage
+ Tk_DeleteErrorHandler(handle);
+#endif
+
+ if (ximage == (XImage*) NULL) {
+ return TCL_OK;
+ }
+
+ result = TkPostscriptImage(interp, tkwin,
+ ((TkCanvas *)canvas)->psInfo, ximage, 0, 0, width, height);
+
+ XDestroyImage(ximage);
+ return result;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleWinItem --
+ *
+ * This procedure is invoked to rescale a window item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window referred to by itemPtr is rescaled
+ * so that the following transformation is applied to all
+ * point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleWinItem(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing window. */
+ Tk_Item *itemPtr; /* Window to be scaled. */
+ double originX, originY; /* Origin about which to scale window. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ winItemPtr->x = originX + scaleX*(winItemPtr->x - originX);
+ winItemPtr->y = originY + scaleY*(winItemPtr->y - originY);
+ if (winItemPtr->width > 0) {
+ winItemPtr->width = (int) (scaleX*winItemPtr->width);
+ }
+ if (winItemPtr->height > 0) {
+ winItemPtr->height = (int) (scaleY*winItemPtr->height);
+ }
+ ComputeWindowBbox(canvas, winItemPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateWinItem --
+ *
+ * This procedure is called to move a window by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the window is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the
+ * item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateWinItem(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ winItemPtr->x += deltaX;
+ winItemPtr->y += deltaY;
+ ComputeWindowBbox(canvas, winItemPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemStructureProc --
+ *
+ * This procedure is invoked whenever StructureNotify events
+ * occur for a window that's managed as part of a canvas window
+ * item. This procudure's only purpose is to clean up when
+ * windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window item when it is
+ * deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WinItemStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ winItemPtr->tkwin = NULL;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemRequestProc --
+ *
+ * This procedure is invoked whenever a window that's associated
+ * with a window canvas item changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change,
+ * depending on the options specified for the window item.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WinItemRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record for window item. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+
+ ComputeWindowBbox(winItemPtr->canvas, winItemPtr);
+ DisplayWinItem(winItemPtr->canvas, (Tk_Item *) winItemPtr,
+ (Display *) NULL, (Drawable) None, 0, 0, 0, 0);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all canvas-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+WinItemLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* WindowItem structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(winItemPtr->canvas);
+
+ Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ winItemPtr->tkwin = NULL;
+}
--- /dev/null
+/*
+ * tkCanvas.c --
+ *
+ * This module implements canvas widgets for the Tk toolkit.
+ * A canvas displays a background and a collection of graphical
+ * objects such as rectangles, lines, and texts.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/* #define USE_OLD_TAG_SEARCH 1 */
+
+#include "default.h"
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+#ifdef USE_OLD_TAG_SEARCH
+/*
+ * The structure defined below is used to keep track of a tag search
+ * in progress. No field should be accessed by anyone other than
+ * StartTagSearch and NextItem.
+ */
+
+typedef struct TagSearch {
+ TkCanvas *canvasPtr; /* Canvas widget being searched. */
+ Tk_Uid tag; /* Tag to search for. 0 means return
+ * all items. */
+ Tk_Item *currentPtr; /* Pointer to last item returned. */
+ Tk_Item *lastPtr; /* The item right before the currentPtr
+ * is tracked so if the currentPtr is
+ * deleted we don't have to start from the
+ * beginning. */
+ int searchOver; /* Non-zero means NextItem should always
+ * return NULL. */
+} TagSearch;
+
+#else /* USE_OLD_TAG_SEARCH */
+/*
+ * The structure defined below is used to keep track of a tag search
+ * in progress. No field should be accessed by anyone other than
+ * TagSearchScan, TagSearchFirst, TagSearchNext,
+ * TagSearchScanExpr, TagSearchEvalExpr,
+ * TagSearchExprInit, TagSearchExprDestroy,
+ * TagSearchDestroy.
+ * (
+ * Not quite accurate: the TagSearch structure is also accessed from:
+ * CanvasWidgetCmd, FindItems, RelinkItems
+ * The only instances of the structure are owned by:
+ * CanvasWidgetCmd
+ * CanvasWidgetCmd is the only function that calls:
+ * FindItems, RelinkItems
+ * CanvasWidgetCmd, FindItems, RelinkItems, are the only functions that call
+ * TagSearch*
+ * )
+ */
+
+typedef struct TagSearch {
+ TkCanvas *canvasPtr; /* Canvas widget being searched. */
+ Tk_Item *currentPtr; /* Pointer to last item returned. */
+ Tk_Item *lastPtr; /* The item right before the currentPtr
+ * is tracked so if the currentPtr is
+ * deleted we don't have to start from the
+ * beginning. */
+ int searchOver; /* Non-zero means NextItem should always
+ * return NULL. */
+ int type; /* search type */
+ int id; /* item id for searches by id */
+
+ char *string; /* tag expression string */
+ int stringIndex; /* current position in string scan */
+ int stringLength; /* length of tag expression string */
+
+ char *rewritebuffer; /* tag string (after removing escapes) */
+ unsigned int rewritebufferAllocated; /* available space for rewrites */
+
+ TagSearchExpr *expr; /* compiled tag expression */
+} TagSearch;
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * Custom option for handling "-state" and "-offset"
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc,
+ (ClientData) NULL /* only "normal" and "disabled" */
+};
+
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc,
+ (ClientData) TK_OFFSET_RELATIVE
+};
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CANVAS_BG_COLOR, Tk_Offset(TkCanvas, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CANVAS_BG_MONO, Tk_Offset(TkCanvas, bgBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_CANVAS_BORDER_WIDTH, Tk_Offset(TkCanvas, borderWidth), 0},
+ {TK_CONFIG_DOUBLE, "-closeenough", "closeEnough", "CloseEnough",
+ DEF_CANVAS_CLOSE_ENOUGH, Tk_Offset(TkCanvas, closeEnough), 0},
+ {TK_CONFIG_BOOLEAN, "-confine", "confine", "Confine",
+ DEF_CANVAS_CONFINE, Tk_Offset(TkCanvas, confine), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_CANVAS_CURSOR, Tk_Offset(TkCanvas, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_CANVAS_HEIGHT, Tk_Offset(TkCanvas, height), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_CANVAS_HIGHLIGHT_BG,
+ Tk_Offset(TkCanvas, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_CANVAS_HIGHLIGHT, Tk_Offset(TkCanvas, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_CANVAS_HIGHLIGHT_WIDTH, Tk_Offset(TkCanvas, highlightWidth), 0},
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_CANVAS_INSERT_BG, Tk_Offset(TkCanvas, textInfo.insertBorder), 0},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_CANVAS_INSERT_BD_COLOR,
+ Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_CANVAS_INSERT_BD_MONO,
+ Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_CANVAS_INSERT_OFF_TIME, Tk_Offset(TkCanvas, insertOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0},
+ {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0",
+ Tk_Offset(TkCanvas, tsoffset),TK_CONFIG_DONT_SET_DEFAULT,
+ &offsetOption},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_CANVAS_RELIEF, Tk_Offset(TkCanvas, relief), 0},
+ {TK_CONFIG_STRING, "-scrollregion", "scrollRegion", "ScrollRegion",
+ DEF_CANVAS_SCROLL_REGION, Tk_Offset(TkCanvas, regionString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_CANVAS_SELECT_COLOR, Tk_Offset(TkCanvas, textInfo.selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_CANVAS_SELECT_MONO, Tk_Offset(TkCanvas, textInfo.selBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_CANVAS_SELECT_BD_COLOR,
+ Tk_Offset(TkCanvas, textInfo.selBorderWidth), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_CANVAS_SELECT_BD_MONO, Tk_Offset(TkCanvas, textInfo.selBorderWidth),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_CANVAS_SELECT_FG_COLOR, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_CANVAS_SELECT_FG_MONO, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_CUSTOM, "-state", "state", "State",
+ "normal", Tk_Offset(TkCanvas, canvas_state), TK_CONFIG_DONT_SET_DEFAULT,
+ &stateOption},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_CANVAS_TAKE_FOCUS, Tk_Offset(TkCanvas, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_CANVAS_WIDTH, Tk_Offset(TkCanvas, width), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_CANVAS_X_SCROLL_CMD, Tk_Offset(TkCanvas, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-xscrollincrement", "xScrollIncrement",
+ "ScrollIncrement",
+ DEF_CANVAS_X_SCROLL_INCREMENT, Tk_Offset(TkCanvas, xScrollIncrement),
+ 0},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_CANVAS_Y_SCROLL_CMD, Tk_Offset(TkCanvas, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-yscrollincrement", "yScrollIncrement",
+ "ScrollIncrement",
+ DEF_CANVAS_Y_SCROLL_INCREMENT, Tk_Offset(TkCanvas, yScrollIncrement),
+ 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * List of all the item types known at present:
+ */
+
+static Tk_ItemType *typeList = NULL; /* NULL means initialization hasn't
+ * been done yet. */
+
+#ifndef USE_OLD_TAG_SEARCH
+/*
+ * Uids for operands in compiled advanced tag search expressions
+ * Initialization is done by InitCanvas()
+ */
+static Tk_Uid allUid = NULL;
+static Tk_Uid currentUid = NULL;
+static Tk_Uid andUid = NULL;
+static Tk_Uid orUid = NULL;
+static Tk_Uid xorUid = NULL;
+static Tk_Uid parenUid = NULL;
+static Tk_Uid negparenUid = NULL;
+static Tk_Uid endparenUid = NULL;
+static Tk_Uid tagvalUid = NULL;
+static Tk_Uid negtagvalUid = NULL;
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * Standard item types provided by Tk:
+ */
+
+extern Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType;
+extern Tk_ItemType tkOvalType, tkPolygonType;
+extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType;
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void CanvasBindProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void CanvasBlinkProc _ANSI_ARGS_((ClientData clientData));
+static void CanvasCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void CanvasDoEvent _ANSI_ARGS_((TkCanvas *canvasPtr,
+ XEvent *eventPtr));
+static void CanvasEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int CanvasFetchSelection _ANSI_ARGS_((
+ ClientData clientData, int offset,
+ char *buffer, int maxBytes));
+static Tk_Item * CanvasFindClosest _ANSI_ARGS_((TkCanvas *canvasPtr,
+ double coords[2]));
+static void CanvasFocusProc _ANSI_ARGS_((TkCanvas *canvasPtr,
+ int gotFocus));
+static void CanvasLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+static void CanvasSelectTo _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tk_Item *itemPtr, int index));
+static void CanvasSetOrigin _ANSI_ARGS_((TkCanvas *canvasPtr,
+ int xOrigin, int yOrigin));
+static void CanvasUpdateScrollbars _ANSI_ARGS_((
+ TkCanvas *canvasPtr));
+static int CanvasWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, Tcl_Obj *CONST *argv));
+static void CanvasWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int ConfigureCanvas _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *argv,
+ int flags));
+static void DestroyCanvas _ANSI_ARGS_((char *memPtr));
+static void DisplayCanvas _ANSI_ARGS_((ClientData clientData));
+static void DoItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Item *itemPtr, Tk_Uid tag));
+static void EventuallyRedrawItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr));
+#ifdef USE_OLD_TAG_SEARCH
+static int FindItems _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *argv,
+ Tcl_Obj *newTagObj, int first));
+#else /* USE_OLD_TAG_SEARCH */
+static int FindItems _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *argv,
+ Tcl_Obj *newTagObj, int first,
+ TagSearch **searchPtrPtr));
+#endif /* USE_OLD_TAG_SEARCH */
+static int FindArea _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, Tcl_Obj *CONST *argv, Tk_Uid uid,
+ int enclosed));
+static double GridAlign _ANSI_ARGS_((double coord, double spacing));
+static CONST char** GetStringsFromObjs _ANSI_ARGS_((int argc,
+ Tcl_Obj *CONST *objv));
+static void InitCanvas _ANSI_ARGS_((void));
+#ifdef USE_OLD_TAG_SEARCH
+static Tk_Item * NextItem _ANSI_ARGS_((TagSearch *searchPtr));
+#endif /* USE_OLD_TAG_SEARCH */
+static void PickCurrentItem _ANSI_ARGS_((TkCanvas *canvasPtr,
+ XEvent *eventPtr));
+static Tcl_Obj * ScrollFractions _ANSI_ARGS_((int screen1,
+ int screen2, int object1, int object2));
+#ifdef USE_OLD_TAG_SEARCH
+static void RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tag, Tk_Item *prevPtr));
+static Tk_Item * StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tag, TagSearch *searchPtr));
+#else /* USE_OLD_TAG_SEARCH */
+static int RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tag, Tk_Item *prevPtr,
+ TagSearch **searchPtrPtr));
+static void TagSearchExprInit _ANSI_ARGS_ ((
+ TagSearchExpr **exprPtrPtr));
+static void TagSearchExprDestroy _ANSI_ARGS_((TagSearchExpr *expr));
+static void TagSearchDestroy _ANSI_ARGS_((TagSearch *searchPtr));
+static int TagSearchScan _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tag, TagSearch **searchPtrPtr));
+static int TagSearchScanExpr _ANSI_ARGS_((Tcl_Interp *interp,
+ TagSearch *searchPtr, TagSearchExpr *expr));
+static int TagSearchEvalExpr _ANSI_ARGS_((TagSearchExpr *expr,
+ Tk_Item *itemPtr));
+static Tk_Item * TagSearchFirst _ANSI_ARGS_((TagSearch *searchPtr));
+static Tk_Item * TagSearchNext _ANSI_ARGS_((TagSearch *searchPtr));
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * The structure below defines canvas class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs canvasClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ CanvasWorldChanged, /* worldChangedProc */
+};
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasObjCmd --
+ *
+ * This procedure is invoked to process the "canvas" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasObjCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST argv[]; /* Argument objects. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkCanvas *canvasPtr;
+ Tk_Window new;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ if (argc < 2) {
+ Tcl_WrongNumArgs(interp, 1, argv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin,
+ Tcl_GetString(argv[1]), (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureCanvas,
+ * or which ConfigureCanvas expects to have reasonable values
+ * (e.g. resource pointers).
+ */
+
+ canvasPtr = (TkCanvas *) ckalloc(sizeof(TkCanvas));
+ canvasPtr->tkwin = new;
+ canvasPtr->display = Tk_Display(new);
+ canvasPtr->interp = interp;
+ canvasPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd,
+ (ClientData) canvasPtr, CanvasCmdDeletedProc);
+ canvasPtr->firstItemPtr = NULL;
+ canvasPtr->lastItemPtr = NULL;
+ canvasPtr->borderWidth = 0;
+ canvasPtr->bgBorder = NULL;
+ canvasPtr->relief = TK_RELIEF_FLAT;
+ canvasPtr->highlightWidth = 0;
+ canvasPtr->highlightBgColorPtr = NULL;
+ canvasPtr->highlightColorPtr = NULL;
+ canvasPtr->inset = 0;
+ canvasPtr->pixmapGC = None;
+ canvasPtr->width = None;
+ canvasPtr->height = None;
+ canvasPtr->confine = 0;
+ canvasPtr->textInfo.selBorder = NULL;
+ canvasPtr->textInfo.selBorderWidth = 0;
+ canvasPtr->textInfo.selFgColorPtr = NULL;
+ canvasPtr->textInfo.selItemPtr = NULL;
+ canvasPtr->textInfo.selectFirst = -1;
+ canvasPtr->textInfo.selectLast = -1;
+ canvasPtr->textInfo.anchorItemPtr = NULL;
+ canvasPtr->textInfo.selectAnchor = 0;
+ canvasPtr->textInfo.insertBorder = NULL;
+ canvasPtr->textInfo.insertWidth = 0;
+ canvasPtr->textInfo.insertBorderWidth = 0;
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ canvasPtr->textInfo.gotFocus = 0;
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertOnTime = 0;
+ canvasPtr->insertOffTime = 0;
+ canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ canvasPtr->xOrigin = canvasPtr->yOrigin = 0;
+ canvasPtr->drawableXOrigin = canvasPtr->drawableYOrigin = 0;
+ canvasPtr->bindingTable = NULL;
+ canvasPtr->currentItemPtr = NULL;
+ canvasPtr->newCurrentPtr = NULL;
+ canvasPtr->closeEnough = 0.0;
+ canvasPtr->pickEvent.type = LeaveNotify;
+ canvasPtr->pickEvent.xcrossing.x = 0;
+ canvasPtr->pickEvent.xcrossing.y = 0;
+ canvasPtr->state = 0;
+ canvasPtr->xScrollCmd = NULL;
+ canvasPtr->yScrollCmd = NULL;
+ canvasPtr->scrollX1 = 0;
+ canvasPtr->scrollY1 = 0;
+ canvasPtr->scrollX2 = 0;
+ canvasPtr->scrollY2 = 0;
+ canvasPtr->regionString = NULL;
+ canvasPtr->xScrollIncrement = 0;
+ canvasPtr->yScrollIncrement = 0;
+ canvasPtr->scanX = 0;
+ canvasPtr->scanXOrigin = 0;
+ canvasPtr->scanY = 0;
+ canvasPtr->scanYOrigin = 0;
+ canvasPtr->hotPtr = NULL;
+ canvasPtr->hotPrevPtr = NULL;
+ canvasPtr->cursor = None;
+ canvasPtr->takeFocus = NULL;
+ canvasPtr->pixelsPerMM = WidthOfScreen(Tk_Screen(new));
+ canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(new));
+ canvasPtr->flags = 0;
+ canvasPtr->nextId = 1;
+ canvasPtr->psInfo = NULL;
+ canvasPtr->canvas_state = TK_STATE_NORMAL;
+ canvasPtr->tsoffset.flags = 0;
+ canvasPtr->tsoffset.xoffset = 0;
+ canvasPtr->tsoffset.yoffset = 0;
+#ifndef USE_OLD_TAG_SEARCH
+ canvasPtr->bindTagExprs = NULL;
+#endif
+ Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS);
+
+ Tk_SetClass(canvasPtr->tkwin, "Canvas");
+ Tk_SetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr);
+ Tk_CreateEventHandler(canvasPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ CanvasEventProc, (ClientData) canvasPtr);
+ Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask
+ |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
+ |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
+ CanvasBindProc, (ClientData) canvasPtr);
+ Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING,
+ CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING);
+ if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(canvasPtr->tkwin);
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CanvasWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about canvas
+ * widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST argv[]; /* Argument objects. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ unsigned int length;
+ int c, result;
+ Tk_Item *itemPtr = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#else /* USE_OLD_TAG_SEARCH */
+ TagSearch *searchPtr = NULL; /* Allocated by first TagSearchScan
+ * Freed by TagSearchDestroy */
+#endif /* USE_OLD_TAG_SEARCH */
+
+ int index;
+ static CONST char *optionStrings[] = {
+ "addtag", "bbox", "bind", "canvasx",
+ "canvasy", "cget", "configure", "coords",
+ "create", "dchars", "delete", "dtag",
+ "find", "focus", "gettags", "icursor",
+ "index", "insert", "itemcget", "itemconfigure",
+ "lower", "move", "postscript", "raise",
+ "scale", "scan", "select", "type",
+ "xview", "yview",
+ NULL
+ };
+ enum options {
+ CANV_ADDTAG, CANV_BBOX, CANV_BIND, CANV_CANVASX,
+ CANV_CANVASY, CANV_CGET, CANV_CONFIGURE, CANV_COORDS,
+ CANV_CREATE, CANV_DCHARS, CANV_DELETE, CANV_DTAG,
+ CANV_FIND, CANV_FOCUS, CANV_GETTAGS, CANV_ICURSOR,
+ CANV_INDEX, CANV_INSERT, CANV_ITEMCGET, CANV_ITEMCONFIGURE,
+ CANV_LOWER, CANV_MOVE, CANV_POSTSCRIPT,CANV_RAISE,
+ CANV_SCALE, CANV_SCAN, CANV_SELECT, CANV_TYPE,
+ CANV_XVIEW, CANV_YVIEW
+ };
+
+ if (argc < 2) {
+ Tcl_WrongNumArgs(interp, 1, argv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, argv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) canvasPtr);
+
+ result = TCL_OK;
+ switch ((enum options) index) {
+ case CANV_ADDTAG: {
+ if (argc < 4) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tag searchCommand ?arg arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ result = FindItems(interp, canvasPtr, argc, argv, argv[2], 3);
+#else /* USE_OLD_TAG_SEARCH */
+ result = FindItems(interp, canvasPtr, argc, argv, argv[2], 3, &searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ break;
+ }
+
+ case CANV_BBOX: {
+ int i, gotAny;
+ int x1 = 0, y1 = 0, x2 = 0, y2 = 0; /* Initializations needed
+ * only to prevent compiler
+ * warnings. */
+
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagOrId ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ gotAny = 0;
+ for (i = 2; i < argc; i++) {
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[i], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+
+ if ((itemPtr->x1 >= itemPtr->x2)
+ || (itemPtr->y1 >= itemPtr->y2)) {
+ continue;
+ }
+ if (!gotAny) {
+ x1 = itemPtr->x1;
+ y1 = itemPtr->y1;
+ x2 = itemPtr->x2;
+ y2 = itemPtr->y2;
+ gotAny = 1;
+ } else {
+ if (itemPtr->x1 < x1) {
+ x1 = itemPtr->x1;
+ }
+ if (itemPtr->y1 < y1) {
+ y1 = itemPtr->y1;
+ }
+ if (itemPtr->x2 > x2) {
+ x2 = itemPtr->x2;
+ }
+ if (itemPtr->y2 > y2) {
+ y2 = itemPtr->y2;
+ }
+ }
+ }
+ }
+ if (gotAny) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", x1, y1, x2, y2);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ break;
+ }
+ case CANV_BIND: {
+ ClientData object;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?sequence? ?command?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Figure out what object to use for the binding (individual
+ * item vs. tag).
+ */
+
+ object = 0;
+#ifdef USE_OLD_TAG_SEARCH
+ if (isdigit(UCHAR(Tcl_GetString(argv[2])[0]))) {
+ int id;
+ char *end;
+ Tcl_HashEntry *entryPtr;
+
+ id = strtoul(Tcl_GetString(argv[2]), &end, 0);
+ if (*end != 0) {
+ goto bindByTag;
+ }
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
+ if (entryPtr != NULL) {
+ itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr);
+ object = (ClientData) itemPtr;
+ }
+
+ if (object == 0) {
+ Tcl_AppendResult(interp, "item \"", Tcl_GetString(argv[2]),
+ "\" doesn't exist", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ bindByTag:
+ object = (ClientData) Tk_GetUid(Tcl_GetString(argv[2]));
+ }
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ if (searchPtr->type == 1) {
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) searchPtr->id);
+ if (entryPtr != NULL) {
+ itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr);
+ object = (ClientData) itemPtr;
+ }
+
+ if (object == 0) {
+ Tcl_AppendResult(interp, "item \"", Tcl_GetString(argv[2]),
+ "\" doesn't exist", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ object = (ClientData) searchPtr->expr->uid;
+ }
+#endif /* USE_OLD_TAG_SEARCH */
+
+ /*
+ * Make a binding table if the canvas doesn't already have
+ * one.
+ */
+
+ if (canvasPtr->bindingTable == NULL) {
+ canvasPtr->bindingTable = Tk_CreateBindingTable(interp);
+ }
+
+ if (argc == 5) {
+ int append = 0;
+ unsigned long mask;
+ char* argv4 = Tcl_GetStringFromObj(argv[4],NULL);
+
+ if (argv4[0] == 0) {
+ result = Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetStringFromObj(argv[3], NULL));
+ goto done;
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ if (searchPtr->type == 4) {
+ /*
+ * if new tag expression, then insert in linked list
+ */
+ TagSearchExpr *expr, **lastPtr;
+
+ lastPtr = &(canvasPtr->bindTagExprs);
+ while ((expr = *lastPtr) != NULL) {
+ if (expr->uid == searchPtr->expr->uid) {
+ break;
+ }
+ lastPtr = &(expr->next);
+ }
+ if (!expr) {
+ /*
+ * transfer ownership of expr to bindTagExprs list
+ */
+ *lastPtr = searchPtr->expr;
+ searchPtr->expr->next = NULL;
+
+ /*
+ * flag in TagSearch that expr has changed ownership
+ * so that TagSearchDestroy doesn't try to free it
+ */
+ searchPtr->expr = NULL;
+ }
+ }
+#endif /* not USE_OLD_TAG_SEARCH */
+ if (argv4[0] == '+') {
+ argv4++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetStringFromObj(argv[3],NULL), argv4, append);
+ if (mask == 0) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
+ |Button2MotionMask|Button3MotionMask|Button4MotionMask
+ |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
+ |EnterWindowMask|LeaveWindowMask|KeyPressMask
+ |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
+ Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetStringFromObj(argv[3], NULL));
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "requested illegal events; ",
+ "only key, button, motion, enter, leave, and virtual ",
+ "events may be used", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if (argc == 4) {
+ CONST char *command;
+
+ command = Tk_GetBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetStringFromObj(argv[3], NULL));
+ if (command == NULL) {
+ CONST char *string;
+
+ string = Tcl_GetStringResult(interp);
+ /*
+ * Ignore missing binding errors. This is a special hack
+ * that relies on the error message returned by FindSequence
+ * in tkBind.c.
+ */
+
+ if (string[0] != '\0') {
+ result = TCL_ERROR;
+ goto done;
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ } else {
+ Tcl_SetResult(interp, (char *) command, TCL_STATIC);
+ }
+ } else {
+ Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
+ }
+ break;
+ }
+ case CANV_CANVASX: {
+ int x;
+ double grid;
+ char buf[TCL_DOUBLE_SPACE];
+
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "screenx ?gridspacing?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 4) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &grid) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ grid = 0.0;
+ }
+ x += canvasPtr->xOrigin;
+ Tcl_PrintDouble(interp, GridAlign((double) x, grid), buf);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_CANVASY: {
+ int y;
+ double grid;
+ char buf[TCL_DOUBLE_SPACE];
+
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "screeny ?gridspacing?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 4) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ argv[3], &grid) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ grid = 0.0;
+ }
+ y += canvasPtr->yOrigin;
+ Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_CGET: {
+ if (argc != 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, Tcl_GetString(argv[2]), 0);
+ break;
+ }
+ case CANV_CONFIGURE: {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, Tcl_GetString(argv[2]), 0);
+ } else {
+ result = ConfigureCanvas(interp, canvasPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ break;
+ }
+ case CANV_COORDS: {
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?x y x y ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ if (argc != 3) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ if (itemPtr->typePtr->coordProc != NULL) {
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = (*itemPtr->typePtr->coordProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3);
+ } else {
+ CONST char **args = GetStringsFromObjs(argc-3, argv+3);
+ result = (*itemPtr->typePtr->coordProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, (Tcl_Obj **) args);
+ if (args) ckfree((char *) args);
+ }
+ }
+ if (argc != 3) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ }
+ break;
+ }
+ case CANV_CREATE: {
+ Tk_ItemType *typePtr;
+ Tk_ItemType *matchPtr = NULL;
+ Tk_Item *itemPtr;
+ char buf[TCL_INTEGER_SPACE];
+ int isNew = 0;
+ Tcl_HashEntry *entryPtr;
+ char *arg;
+
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "type ?arg arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ arg = Tcl_GetStringFromObj(argv[2], (int *) &length);
+ c = arg[0];
+ for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) {
+ if ((c == typePtr->name[0])
+ && (strncmp(arg, typePtr->name, length) == 0)) {
+ if (matchPtr != NULL) {
+ badType:
+ Tcl_AppendResult(interp,
+ "unknown or ambiguous item type \"",
+ arg, "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ matchPtr = typePtr;
+ }
+ }
+ if (matchPtr == NULL) {
+ goto badType;
+ }
+ typePtr = matchPtr;
+ itemPtr = (Tk_Item *) ckalloc((unsigned) typePtr->itemSize);
+ itemPtr->id = canvasPtr->nextId;
+ canvasPtr->nextId++;
+ itemPtr->tagPtr = itemPtr->staticTagSpace;
+ itemPtr->tagSpace = TK_TAG_SPACE;
+ itemPtr->numTags = 0;
+ itemPtr->typePtr = typePtr;
+ itemPtr->state = TK_STATE_NULL;
+ itemPtr->redraw_flags = 0;
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argc-3, argv+3);
+ } else {
+ CONST char **args = GetStringsFromObjs(argc-3, argv+3);
+ result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argc-3, (Tcl_Obj **) args);
+ if (args) ckfree((char *) args);
+ }
+ if (result != TCL_OK) {
+ ckfree((char *) itemPtr);
+ result = TCL_ERROR;
+ goto done;
+ }
+ itemPtr->nextPtr = NULL;
+ entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable,
+ (char *) itemPtr->id, &isNew);
+ Tcl_SetHashValue(entryPtr, itemPtr);
+ itemPtr->prevPtr = canvasPtr->lastItemPtr;
+ canvasPtr->hotPtr = itemPtr;
+ canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr;
+ if (canvasPtr->lastItemPtr == NULL) {
+ canvasPtr->firstItemPtr = itemPtr;
+ } else {
+ canvasPtr->lastItemPtr->nextPtr = itemPtr;
+ }
+ canvasPtr->lastItemPtr = itemPtr;
+ itemPtr->redraw_flags |= FORCE_REDRAW;
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ sprintf(buf, "%d", itemPtr->id);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_DCHARS: {
+ int first, last;
+ int x1,x2,y1,y2;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId first ?last?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->dCharsProc == NULL)) {
+ continue;
+ }
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[3], &first);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &first);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (argc == 5) {
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[4], &last);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[4], NULL), &last);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ } else {
+ last = first;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible
+ * that a delete could result in a new area larger than
+ * the old area. Except if the insertProc sets the
+ * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done.
+ */
+
+ x1 = itemPtr->x1; y1 = itemPtr->y1;
+ x2 = itemPtr->x2; y2 = itemPtr->y2;
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ (*itemPtr->typePtr->dCharsProc)((Tk_Canvas) canvasPtr,
+ itemPtr, first, last);
+ if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ x1, y1, x2, y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ }
+ break;
+ }
+ case CANV_DELETE: {
+ int i;
+ Tcl_HashEntry *entryPtr;
+
+ for (i = 2; i < argc; i++) {
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[i], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ if (canvasPtr->bindingTable != NULL) {
+ Tk_DeleteAllBindings(canvasPtr->bindingTable,
+ (ClientData) itemPtr);
+ }
+ (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display);
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable,
+ (char *) itemPtr->id);
+ Tcl_DeleteHashEntry(entryPtr);
+ if (itemPtr->nextPtr != NULL) {
+ itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
+ }
+ if (itemPtr->prevPtr != NULL) {
+ itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
+ }
+ if (canvasPtr->firstItemPtr == itemPtr) {
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ if (canvasPtr->firstItemPtr == NULL) {
+ canvasPtr->lastItemPtr = NULL;
+ }
+ }
+ if (canvasPtr->lastItemPtr == itemPtr) {
+ canvasPtr->lastItemPtr = itemPtr->prevPtr;
+ }
+ ckfree((char *) itemPtr);
+ if (itemPtr == canvasPtr->currentItemPtr) {
+ canvasPtr->currentItemPtr = NULL;
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if (itemPtr == canvasPtr->newCurrentPtr) {
+ canvasPtr->newCurrentPtr = NULL;
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if (itemPtr == canvasPtr->textInfo.focusItemPtr) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ }
+ if (itemPtr == canvasPtr->textInfo.selItemPtr) {
+ canvasPtr->textInfo.selItemPtr = NULL;
+ }
+ if ((itemPtr == canvasPtr->hotPtr)
+ || (itemPtr == canvasPtr->hotPrevPtr)) {
+ canvasPtr->hotPtr = NULL;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_DTAG: {
+ Tk_Uid tag;
+ int i;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagToDelete?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 4) {
+ tag = Tk_GetUid(Tcl_GetStringFromObj(argv[3], NULL));
+ } else {
+ tag = Tk_GetUid(Tcl_GetStringFromObj(argv[2], NULL));
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ if (itemPtr->tagPtr[i] == tag) {
+ itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
+ itemPtr->numTags--;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_FIND: {
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "searchCommand ?arg arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ result = FindItems(interp, canvasPtr, argc, argv, (Tcl_Obj *) NULL, 2);
+#else /* USE_OLD_TAG_SEARCH */
+ result = FindItems(interp, canvasPtr, argc, argv,
+ (Tcl_Obj *) NULL, 2, &searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ break;
+ }
+ case CANV_FOCUS: {
+ if (argc > 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "?tagOrId?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ if (argc == 2) {
+ if (itemPtr != NULL) {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", itemPtr->id);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ goto done;
+ }
+ if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ if (Tcl_GetStringFromObj(argv[2], NULL)[0] == 0) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr->typePtr->icursorProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ goto done;
+ }
+ canvasPtr->textInfo.focusItemPtr = itemPtr;
+ if (canvasPtr->textInfo.gotFocus) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ break;
+ }
+ case CANV_GETTAGS: {
+ if (argc != 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ int i;
+ for (i = 0; i < itemPtr->numTags; i++) {
+ Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]);
+ }
+ }
+ break;
+ }
+ case CANV_ICURSOR: {
+ int index;
+
+ if (argc != 4) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->icursorProc == NULL)) {
+ goto done;
+ }
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[3], &index);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &index);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ (*itemPtr->typePtr->icursorProc)((Tk_Canvas) canvasPtr, itemPtr,
+ index);
+ if ((itemPtr == canvasPtr->textInfo.focusItemPtr)
+ && (canvasPtr->textInfo.cursorOn)) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ }
+ break;
+ }
+ case CANV_INDEX: {
+
+ int index;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (argc != 4) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId string");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr->typePtr->indexProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp, "can't find an indexable item \"",
+ Tcl_GetStringFromObj(argv[2], NULL), "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[3], &index);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &index);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ sprintf(buf, "%d", index);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_INSERT: {
+ int beforeThis;
+ int x1,x2,y1,y2;
+
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId beforeThis string");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->insertProc == NULL)) {
+ continue;
+ }
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[3], &beforeThis);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &beforeThis);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible
+ * that an insertion could result in a new area either
+ * larger or smaller than the old area. Except if the
+ * insertProc sets the TK_ITEM_DONT_REDRAW flag, nothing
+ * more needs to be done.
+ */
+
+ x1 = itemPtr->x1; y1 = itemPtr->y1;
+ x2 = itemPtr->x2; y2 = itemPtr->y2;
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
+ itemPtr, beforeThis, (char *) argv[4]);
+ } else {
+ (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
+ itemPtr, beforeThis, Tcl_GetStringFromObj(argv[4], NULL));
+ }
+ if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ x1, y1, x2, y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ }
+ break;
+ }
+ case CANV_ITEMCGET: {
+ if (argc != 4) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId option");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ result = Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ Tcl_GetStringFromObj(argv[3], NULL), 0);
+ }
+ break;
+ }
+ case CANV_ITEMCONFIGURE: {
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?option value ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if (argc == 3) {
+ result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ (char *) NULL, 0);
+ } else if (argc == 4) {
+ result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ Tcl_GetString(argv[3]), 0);
+ } else {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = (*itemPtr->typePtr->configProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3,
+ TK_CONFIG_ARGV_ONLY);
+ } else {
+ CONST char **args = GetStringsFromObjs(argc-3, argv+3);
+ result = (*itemPtr->typePtr->configProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, (Tcl_Obj **) args,
+ TK_CONFIG_ARGV_ONLY);
+ if (args) ckfree((char *) args);
+ }
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if ((result != TCL_OK) || (argc < 5)) {
+ break;
+ }
+ }
+ break;
+ }
+ case CANV_LOWER: {
+ Tk_Item *itemPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?belowThis?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * First find the item just after which we'll insert the
+ * named items.
+ */
+
+ if (argc == 3) {
+ itemPtr = NULL;
+ } else {
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp, "tag \"", Tcl_GetString(argv[3]),
+ "\" doesn't match any items", (char *) NULL);
+ goto done;
+ }
+ itemPtr = itemPtr->prevPtr;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ RelinkItems(canvasPtr, argv[2], itemPtr);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = RelinkItems(canvasPtr, argv[2], itemPtr, &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+#endif /* USE_OLD_TAG_SEARCH */
+ break;
+ }
+ case CANV_MOVE: {
+ double xAmount, yAmount;
+
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xAmount yAmount");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &xAmount) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
+ (Tk_Canvas) canvasPtr, argv[4], &yAmount) != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ (void) (*itemPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr,
+ itemPtr, xAmount, yAmount);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ break;
+ }
+ case CANV_POSTSCRIPT: {
+ CONST char **args = GetStringsFromObjs(argc, argv);
+ result = TkCanvPostscriptCmd(canvasPtr, interp, argc, args);
+ if (args) ckfree((char *) args);
+ break;
+ }
+ case CANV_RAISE: {
+ Tk_Item *prevPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?aboveThis?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * First find the item just after which we'll insert the
+ * named items.
+ */
+
+ if (argc == 3) {
+ prevPtr = canvasPtr->lastItemPtr;
+ } else {
+ prevPtr = NULL;
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ prevPtr = itemPtr;
+ }
+ if (prevPtr == NULL) {
+ Tcl_AppendResult(interp, "tagOrId \"", Tcl_GetStringFromObj(argv[3], NULL),
+ "\" doesn't match any items", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ RelinkItems(canvasPtr, argv[2], prevPtr);
+#else /* USE_OLD_TAG_SEARCH */
+ result = RelinkItems(canvasPtr, argv[2], prevPtr, &searchPtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+#endif /* USE_OLD_TAG_SEARCH */
+ break;
+ }
+ case CANV_SCALE: {
+ double xOrigin, yOrigin, xScale, yScale;
+
+ if (argc != 7) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xOrigin yOrigin xScale yScale");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ argv[3], &xOrigin) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ argv[4], &yOrigin) != TCL_OK)
+ || (Tcl_GetDoubleFromObj(interp, argv[5], &xScale) != TCL_OK)
+ || (Tcl_GetDoubleFromObj(interp, argv[6], &yScale) != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((xScale == 0.0) || (yScale == 0.0)) {
+ Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC);
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr,
+ itemPtr, xOrigin, yOrigin, xScale, yScale);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ break;
+ }
+ case CANV_SCAN: {
+ int x, y, gain=10;
+ static CONST char *optionStrings[] = {
+ "mark", "dragto", NULL
+ };
+
+ if (argc < 5) {
+ Tcl_WrongNumArgs(interp, 2, argv, "mark|dragto x y ?dragGain?");
+ result = TCL_ERROR;
+ } else if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings,
+ "scan option", 0, &index) != TCL_OK) {
+ result = TCL_ERROR;
+ } else if ((argc != 5) && (argc != 5+index)) {
+ Tcl_WrongNumArgs(interp, 3, argv, index?"x y ?gain?":"x y");
+ result = TCL_ERROR;
+ } else if ((Tcl_GetIntFromObj(interp, argv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, argv[4], &y) != TCL_OK)){
+ result = TCL_ERROR;
+ } else if ((argc == 6) &&
+ (Tcl_GetIntFromObj(interp, argv[5], &gain) != TCL_OK)) {
+ result = TCL_ERROR;
+ } else if (!index) {
+ canvasPtr->scanX = x;
+ canvasPtr->scanXOrigin = canvasPtr->xOrigin;
+ canvasPtr->scanY = y;
+ canvasPtr->scanYOrigin = canvasPtr->yOrigin;
+ } else {
+ int newXOrigin, newYOrigin, tmp;
+
+ /*
+ * Compute a new view origin for the canvas, amplifying the
+ * mouse motion.
+ */
+
+ tmp = canvasPtr->scanXOrigin - gain*(x - canvasPtr->scanX)
+ - canvasPtr->scrollX1;
+ newXOrigin = canvasPtr->scrollX1 + tmp;
+ tmp = canvasPtr->scanYOrigin - gain*(y - canvasPtr->scanY)
+ - canvasPtr->scrollY1;
+ newYOrigin = canvasPtr->scrollY1 + tmp;
+ CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin);
+ }
+ break;
+ }
+ case CANV_SELECT: {
+ int index, optionindex;
+ static CONST char *optionStrings[] = {
+ "adjust", "clear", "from", "item", "to", NULL
+ };
+ enum options {
+ CANV_ADJUST, CANV_CLEAR, CANV_FROM, CANV_ITEM, CANV_TO
+ };
+
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "option ?tagOrId? ?arg?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc >= 4) {
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if ((itemPtr->typePtr->indexProc != NULL)
+ && (itemPtr->typePtr->selectionProc != NULL)){
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp,
+ "can't find an indexable and selectable item \"",
+ Tcl_GetStringFromObj(argv[3], NULL), "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (argc == 5) {
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[4], &index);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[4], NULL), &index);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ }
+ if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings, "select option", 0,
+ &optionindex) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ switch ((enum options) optionindex) {
+ case CANV_ADJUST: {
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (canvasPtr->textInfo.selItemPtr == itemPtr) {
+ if (index < (canvasPtr->textInfo.selectFirst
+ + canvasPtr->textInfo.selectLast)/2) {
+ canvasPtr->textInfo.selectAnchor =
+ canvasPtr->textInfo.selectLast + 1;
+ } else {
+ canvasPtr->textInfo.selectAnchor =
+ canvasPtr->textInfo.selectFirst;
+ }
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ break;
+ }
+ case CANV_CLEAR: {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, 3, argv, (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
+ canvasPtr->textInfo.selItemPtr = NULL;
+ }
+ goto done;
+ break;
+ }
+ case CANV_FROM: {
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ break;
+ }
+ case CANV_ITEM: {
+ if (argc != 3) {
+ Tcl_WrongNumArgs(interp, 3, argv, (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", canvasPtr->textInfo.selItemPtr->id);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ break;
+ }
+ case CANV_TO: {
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ break;
+ }
+ }
+ break;
+ }
+ case CANV_TYPE: {
+ if (argc != 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tag");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC);
+ }
+ break;
+ }
+ case CANV_XVIEW: {
+ int count, type;
+ int newX = 0; /* Initialization needed only to prevent
+ * gcc warnings. */
+ double fraction;
+
+ if (argc == 2) {
+ Tcl_SetObjResult(interp, ScrollFractions(
+ canvasPtr->xOrigin + canvasPtr->inset,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
+ - canvasPtr->inset, canvasPtr->scrollX1,
+ canvasPtr->scrollX2));
+ } else {
+ CONST char **args = GetStringsFromObjs(argc, argv);
+ type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
+ if (args) ckfree((char *) args);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ result = TCL_ERROR;
+ goto done;
+ case TK_SCROLL_MOVETO:
+ newX = canvasPtr->scrollX1 - canvasPtr->inset
+ + (int) (fraction * (canvasPtr->scrollX2
+ - canvasPtr->scrollX1) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ newX = (int) (canvasPtr->xOrigin + count * .9
+ * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset));
+ break;
+ case TK_SCROLL_UNITS:
+ if (canvasPtr->xScrollIncrement > 0) {
+ newX = canvasPtr->xOrigin
+ + count*canvasPtr->xScrollIncrement;
+ } else {
+ newX = (int) (canvasPtr->xOrigin + count * .1
+ * (Tk_Width(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ }
+ break;
+ }
+ CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin);
+ }
+ break;
+ }
+ case CANV_YVIEW: {
+ int count, type;
+ int newY = 0; /* Initialization needed only to prevent
+ * gcc warnings. */
+ double fraction;
+
+ if (argc == 2) {
+ Tcl_SetObjResult(interp,ScrollFractions(\
+ canvasPtr->yOrigin + canvasPtr->inset,
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
+ - canvasPtr->inset, canvasPtr->scrollY1,
+ canvasPtr->scrollY2));
+ } else {
+ CONST char **args = GetStringsFromObjs(argc, argv);
+ type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
+ if (args) ckfree((char *) args);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ result = TCL_ERROR;
+ goto done;
+ case TK_SCROLL_MOVETO:
+ newY = canvasPtr->scrollY1 - canvasPtr->inset
+ + (int) (fraction*(canvasPtr->scrollY2
+ - canvasPtr->scrollY1) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ newY = (int) (canvasPtr->yOrigin + count * .9
+ * (Tk_Height(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ break;
+ case TK_SCROLL_UNITS:
+ if (canvasPtr->yScrollIncrement > 0) {
+ newY = canvasPtr->yOrigin
+ + count*canvasPtr->yScrollIncrement;
+ } else {
+ newY = (int) (canvasPtr->yOrigin + count * .1
+ * (Tk_Height(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ }
+ break;
+ }
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY);
+ }
+ break;
+ }
+ }
+ done:
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchDestroy(searchPtr);
+#endif /* not USE_OLD_TAG_SEARCH */
+ Tcl_Release((ClientData) canvasPtr);
+ return result;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyCanvas --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a canvas at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the canvas is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyCanvas(memPtr)
+ char *memPtr; /* Info about canvas widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) memPtr;
+ Tk_Item *itemPtr;
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchExpr *expr, *next;
+#endif
+
+ /*
+ * Free up all of the items in the canvas.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = canvasPtr->firstItemPtr) {
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display);
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ ckfree((char *) itemPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling,
+ * then let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ Tcl_DeleteHashTable(&canvasPtr->idTable);
+ if (canvasPtr->pixmapGC != None) {
+ Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ next = expr->next;
+ TagSearchExprDestroy(expr);
+ expr = next;
+ }
+#endif
+ Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
+ if (canvasPtr->bindingTable != NULL) {
+ Tk_DeleteBindingTable(canvasPtr->bindingTable);
+ }
+ Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0);
+ canvasPtr->tkwin = NULL;
+ ckfree((char *) canvasPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureCanvas --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a canvas widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for canvasPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureCanvas(interp, canvasPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ TkCanvas *canvasPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST argv[]; /* Argument objects. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ XGCValues gcValues;
+ GC new;
+
+ if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs,
+ argc, (CONST char **) argv, (char *) canvasPtr,
+ flags|TK_CONFIG_OBJS) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border and creating a GC for copying
+ * bits to the screen.
+ */
+
+ Tk_SetBackgroundFromBorder(canvasPtr->tkwin, canvasPtr->bgBorder);
+
+ if (canvasPtr->highlightWidth < 0) {
+ canvasPtr->highlightWidth = 0;
+ }
+ canvasPtr->inset = canvasPtr->borderWidth + canvasPtr->highlightWidth;
+
+ gcValues.function = GXcopy;
+ gcValues.graphics_exposures = False;
+ gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel;
+ new = Tk_GetGC(canvasPtr->tkwin,
+ GCFunction|GCGraphicsExposures|GCForeground, &gcValues);
+ if (canvasPtr->pixmapGC != None) {
+ Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
+ }
+ canvasPtr->pixmapGC = new;
+
+ /*
+ * Reset the desired dimensions for the window.
+ */
+
+ Tk_GeometryRequest(canvasPtr->tkwin, canvasPtr->width + 2*canvasPtr->inset,
+ canvasPtr->height + 2*canvasPtr->inset);
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or off-time
+ * just changed.
+ */
+
+ if (canvasPtr->textInfo.gotFocus) {
+ CanvasFocusProc(canvasPtr, 1);
+ }
+
+ /*
+ * Recompute the scroll region.
+ */
+
+ canvasPtr->scrollX1 = 0;
+ canvasPtr->scrollY1 = 0;
+ canvasPtr->scrollX2 = 0;
+ canvasPtr->scrollY2 = 0;
+ if (canvasPtr->regionString != NULL) {
+ int argc2;
+ CONST char **argv2;
+
+ if (Tcl_SplitList(canvasPtr->interp, canvasPtr->regionString,
+ &argc2, &argv2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc2 != 4) {
+ Tcl_AppendResult(interp, "bad scrollRegion \"",
+ canvasPtr->regionString, "\"", (char *) NULL);
+ badRegion:
+ ckfree(canvasPtr->regionString);
+ ckfree((char *) argv2);
+ canvasPtr->regionString = NULL;
+ return TCL_ERROR;
+ }
+ if ((Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[0], &canvasPtr->scrollX1) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[1], &canvasPtr->scrollY1) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[2], &canvasPtr->scrollX2) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[3], &canvasPtr->scrollY2) != TCL_OK)) {
+ goto badRegion;
+ }
+ ckfree((char *) argv2);
+ }
+
+ flags = canvasPtr->tsoffset.flags;
+ if (flags & TK_OFFSET_LEFT) {
+ canvasPtr->tsoffset.xoffset = 0;
+ } else if (flags & TK_OFFSET_CENTER) {
+ canvasPtr->tsoffset.xoffset = canvasPtr->width/2;
+ } else if (flags & TK_OFFSET_RIGHT) {
+ canvasPtr->tsoffset.xoffset = canvasPtr->width;
+ }
+ if (flags & TK_OFFSET_TOP) {
+ canvasPtr->tsoffset.yoffset = 0;
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ canvasPtr->tsoffset.yoffset = canvasPtr->height/2;
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ canvasPtr->tsoffset.yoffset = canvasPtr->height;
+ }
+
+ /*
+ * Reset the canvas's origin (this is a no-op unless confine
+ * mode has just been turned on or the scroll region has changed).
+ */
+
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
+ canvasPtr->flags |= UPDATE_SCROLLBARS|REDRAW_BORDERS;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanvasWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configures all items in the canvas with a empty argc/argv, for
+ * the side effect of causing all the items to recompute their
+ * geometry and to be redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+CanvasWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ TkCanvas *canvasPtr;
+ Tk_Item *itemPtr;
+ int result;
+
+ canvasPtr = (TkCanvas *) instanceData;
+ itemPtr = canvasPtr->firstItemPtr;
+ for ( ; itemPtr != NULL; itemPtr = itemPtr->nextPtr) {
+ result = (*itemPtr->typePtr->configProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 0, NULL,
+ TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+ }
+ canvasPtr->flags |= REPICK_NEEDED;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayCanvas --
+ *
+ * This procedure redraws the contents of a canvas window.
+ * It is invoked as a do-when-idle handler, so it only runs
+ * when there's nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayCanvas(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ Tk_Window tkwin = canvasPtr->tkwin;
+ Tk_Item *itemPtr;
+ Pixmap pixmap;
+ int screenX1, screenX2, screenY1, screenY2, width, height;
+
+ if (canvasPtr->tkwin == NULL) {
+ return;
+ }
+
+ if (!Tk_IsMapped(tkwin)) {
+ goto done;
+ }
+
+ /*
+ * Choose a new current item if that is needed (this could cause
+ * event handlers to be invoked).
+ */
+
+ while (canvasPtr->flags & REPICK_NEEDED) {
+ Tcl_Preserve((ClientData) canvasPtr);
+ canvasPtr->flags &= ~REPICK_NEEDED;
+ PickCurrentItem(canvasPtr, &canvasPtr->pickEvent);
+ tkwin = canvasPtr->tkwin;
+ Tcl_Release((ClientData) canvasPtr);
+ if (tkwin == NULL) {
+ return;
+ }
+ }
+
+ /*
+ * Scan through the item list, registering the bounding box
+ * for all items that didn't do that for the final coordinates
+ * yet. This can be determined by the FORCE_REDRAW flag.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->redraw_flags & FORCE_REDRAW) {
+ itemPtr->redraw_flags &= ~FORCE_REDRAW;
+ EventuallyRedrawItem((Tk_Canvas)canvasPtr, itemPtr);
+ itemPtr->redraw_flags &= ~FORCE_REDRAW;
+ }
+ }
+ /*
+ * Compute the intersection between the area that needs redrawing
+ * and the area that's visible on the screen.
+ */
+
+ if ((canvasPtr->redrawX1 < canvasPtr->redrawX2)
+ && (canvasPtr->redrawY1 < canvasPtr->redrawY2)) {
+ screenX1 = canvasPtr->xOrigin + canvasPtr->inset;
+ screenY1 = canvasPtr->yOrigin + canvasPtr->inset;
+ screenX2 = canvasPtr->xOrigin + Tk_Width(tkwin) - canvasPtr->inset;
+ screenY2 = canvasPtr->yOrigin + Tk_Height(tkwin) - canvasPtr->inset;
+ if (canvasPtr->redrawX1 > screenX1) {
+ screenX1 = canvasPtr->redrawX1;
+ }
+ if (canvasPtr->redrawY1 > screenY1) {
+ screenY1 = canvasPtr->redrawY1;
+ }
+ if (canvasPtr->redrawX2 < screenX2) {
+ screenX2 = canvasPtr->redrawX2;
+ }
+ if (canvasPtr->redrawY2 < screenY2) {
+ screenY2 = canvasPtr->redrawY2;
+ }
+ if ((screenX1 >= screenX2) || (screenY1 >= screenY2)) {
+ goto borders;
+ }
+
+ /*
+ * Redrawing is done in a temporary pixmap that is allocated
+ * here and freed at the end of the procedure. All drawing
+ * is done to the pixmap, and the pixmap is copied to the
+ * screen at the end of the procedure. The temporary pixmap
+ * serves two purposes:
+ *
+ * 1. It provides a smoother visual effect (no clearing and
+ * gradual redraw will be visible to users).
+ * 2. It allows us to redraw only the objects that overlap
+ * the redraw area. Otherwise incorrect results could
+ * occur from redrawing things that stick outside of
+ * the redraw area (we'd have to redraw everything in
+ * order to make the overlaps look right).
+ *
+ * Some tricky points about the pixmap:
+ *
+ * 1. We only allocate a large enough pixmap to hold the
+ * area that has to be redisplayed. This saves time in
+ * in the X server for large objects that cover much
+ * more than the area being redisplayed: only the area
+ * of the pixmap will actually have to be redrawn.
+ * 2. Some X servers (e.g. the one for DECstations) have troubles
+ * with characters that overlap an edge of the pixmap (on the
+ * DEC servers, as of 8/18/92, such characters are drawn one
+ * pixel too far to the right). To handle this problem,
+ * make the pixmap a bit larger than is absolutely needed
+ * so that for normal-sized fonts the characters that overlap
+ * the edge of the pixmap will be outside the area we care
+ * about.
+ */
+
+ canvasPtr->drawableXOrigin = screenX1 - 30;
+ canvasPtr->drawableYOrigin = screenY1 - 30;
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ (screenX2 + 30 - canvasPtr->drawableXOrigin),
+ (screenY2 + 30 - canvasPtr->drawableYOrigin),
+ Tk_Depth(tkwin));
+
+ /*
+ * Clear the area to be redrawn.
+ */
+
+ width = screenX2 - screenX1;
+ height = screenY2 - screenY1;
+
+ XFillRectangle(Tk_Display(tkwin), pixmap, canvasPtr->pixmapGC,
+ screenX1 - canvasPtr->drawableXOrigin,
+ screenY1 - canvasPtr->drawableYOrigin, (unsigned int) width,
+ (unsigned int) height);
+
+ /*
+ * Scan through the item list, redrawing those items that need it.
+ * An item must be redraw if either (a) it intersects the smaller
+ * on-screen area or (b) it intersects the full canvas area and its
+ * type requests that it be redrawn always (e.g. so subwindows can
+ * be unmapped when they move off-screen).
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= screenX2)
+ || (itemPtr->y1 >= screenY2)
+ || (itemPtr->x2 < screenX1)
+ || (itemPtr->y2 < screenY1)) {
+ if (!(itemPtr->typePtr->alwaysRedraw & 1)
+ || (itemPtr->x1 >= canvasPtr->redrawX2)
+ || (itemPtr->y1 >= canvasPtr->redrawY2)
+ || (itemPtr->x2 < canvasPtr->redrawX1)
+ || (itemPtr->y2 < canvasPtr->redrawY1)) {
+ continue;
+ }
+ }
+ if (itemPtr->state == TK_STATE_HIDDEN ||
+ (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ continue;
+ }
+ (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display, pixmap, screenX1, screenY1, width,
+ height);
+ }
+
+ /*
+ * Copy from the temporary pixmap to the screen, then free up
+ * the temporary pixmap.
+ */
+
+ XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin),
+ canvasPtr->pixmapGC,
+ screenX1 - canvasPtr->drawableXOrigin,
+ screenY1 - canvasPtr->drawableYOrigin,
+ (unsigned) (screenX2 - screenX1),
+ (unsigned) (screenY2 - screenY1),
+ screenX1 - canvasPtr->xOrigin, screenY1 - canvasPtr->yOrigin);
+ Tk_FreePixmap(Tk_Display(tkwin), pixmap);
+ }
+
+ /*
+ * Draw the window borders, if needed.
+ */
+
+ borders:
+ if (canvasPtr->flags & REDRAW_BORDERS) {
+ canvasPtr->flags &= ~REDRAW_BORDERS;
+ if (canvasPtr->borderWidth > 0) {
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin),
+ canvasPtr->bgBorder, canvasPtr->highlightWidth,
+ canvasPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*canvasPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*canvasPtr->highlightWidth,
+ canvasPtr->borderWidth, canvasPtr->relief);
+ }
+ if (canvasPtr->highlightWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ if (canvasPtr->textInfo.gotFocus) {
+ fgGC = Tk_GCForColor(canvasPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
+ canvasPtr->highlightWidth, Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
+ canvasPtr->highlightWidth, Tk_WindowId(tkwin));
+ }
+ }
+ }
+
+ done:
+ canvasPtr->flags &= ~(REDRAW_PENDING|BBOX_NOT_EMPTY);
+ canvasPtr->redrawX1 = canvasPtr->redrawX2 = 0;
+ canvasPtr->redrawY1 = canvasPtr->redrawY2 = 0;
+ if (canvasPtr->flags & UPDATE_SCROLLBARS) {
+ CanvasUpdateScrollbars(canvasPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on canvases.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (eventPtr->type == Expose) {
+ int x, y;
+
+ x = eventPtr->xexpose.x + canvasPtr->xOrigin;
+ y = eventPtr->xexpose.y + canvasPtr->yOrigin;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x, y,
+ x + eventPtr->xexpose.width,
+ y + eventPtr->xexpose.height);
+ if ((eventPtr->xexpose.x < canvasPtr->inset)
+ || (eventPtr->xexpose.y < canvasPtr->inset)
+ || ((eventPtr->xexpose.x + eventPtr->xexpose.width)
+ > (Tk_Width(canvasPtr->tkwin) - canvasPtr->inset))
+ || ((eventPtr->xexpose.y + eventPtr->xexpose.height)
+ > (Tk_Height(canvasPtr->tkwin) - canvasPtr->inset))) {
+ canvasPtr->flags |= REDRAW_BORDERS;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (canvasPtr->tkwin != NULL) {
+ canvasPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(canvasPtr->interp,
+ canvasPtr->widgetCmd);
+ }
+ if (canvasPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr);
+ }
+ Tcl_EventuallyFree((ClientData) canvasPtr,
+ (Tcl_FreeProc *) DestroyCanvas);
+ } else if (eventPtr->type == ConfigureNotify) {
+ canvasPtr->flags |= UPDATE_SCROLLBARS;
+
+ /*
+ * The call below is needed in order to recenter the canvas if
+ * it's confined and its scroll region is smaller than the window.
+ */
+
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, canvasPtr->xOrigin,
+ canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ canvasPtr->flags |= REDRAW_BORDERS;
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ CanvasFocusProc(canvasPtr, 1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ CanvasFocusProc(canvasPtr, 0);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ Tk_Item *itemPtr;
+
+ /*
+ * Special hack: if the canvas is unmapped, then must notify
+ * all items with "alwaysRedraw" set, so that they know that
+ * they are no longer displayed.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->typePtr->alwaysRedraw & 1) {
+ (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr,
+ itemPtr, canvasPtr->display, None, 0, 0, 0, 0);
+ }
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ Tk_Window tkwin = canvasPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ canvasPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasEventuallyRedraw --
+ *
+ * Arrange for part or all of a canvas widget to redrawn at
+ * some convenient time in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The screen will eventually be refreshed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2)
+ Tk_Canvas canvas; /* Information about widget. */
+ int x1, y1; /* Upper left corner of area to redraw.
+ * Pixels on edge are redrawn. */
+ int x2, y2; /* Lower right corner of area to redraw.
+ * Pixels on edge are not redrawn. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ /*
+ * If tkwin is NULL, the canvas has been destroyed, so we can't really
+ * redraw it.
+ */
+ if (canvasPtr->tkwin == NULL) {
+ return;
+ }
+
+ if ((x1 >= x2) || (y1 >= y2) ||
+ (x2 < canvasPtr->xOrigin) || (y2 < canvasPtr->yOrigin) ||
+ (x1 >= canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)) ||
+ (y1 >= canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin))) {
+ return;
+ }
+ if (canvasPtr->flags & BBOX_NOT_EMPTY) {
+ if (x1 <= canvasPtr->redrawX1) {
+ canvasPtr->redrawX1 = x1;
+ }
+ if (y1 <= canvasPtr->redrawY1) {
+ canvasPtr->redrawY1 = y1;
+ }
+ if (x2 >= canvasPtr->redrawX2) {
+ canvasPtr->redrawX2 = x2;
+ }
+ if (y2 >= canvasPtr->redrawY2) {
+ canvasPtr->redrawY2 = y2;
+ }
+ } else {
+ canvasPtr->redrawX1 = x1;
+ canvasPtr->redrawY1 = y1;
+ canvasPtr->redrawX2 = x2;
+ canvasPtr->redrawY2 = y2;
+ canvasPtr->flags |= BBOX_NOT_EMPTY;
+ }
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * EventuallyRedrawItem --
+ *
+ * Arrange for part or all of a canvas widget to redrawn at
+ * some convenient time in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The screen will eventually be refreshed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EventuallyRedrawItem(canvas, itemPtr)
+ Tk_Canvas canvas; /* Information about widget. */
+ Tk_Item *itemPtr; /* item to be redrawn. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if ((itemPtr->x1 >= itemPtr->x2) || (itemPtr->y1 >= itemPtr->y2) ||
+ (itemPtr->x2 < canvasPtr->xOrigin) ||
+ (itemPtr->y2 < canvasPtr->yOrigin) ||
+ (itemPtr->x1 >= canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)) ||
+ (itemPtr->y1 >= canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin))) {
+ if (!(itemPtr->typePtr->alwaysRedraw & 1)) {
+ return;
+ }
+ }
+ if (!(itemPtr->redraw_flags & FORCE_REDRAW)) {
+ if (canvasPtr->flags & BBOX_NOT_EMPTY) {
+ if (itemPtr->x1 <= canvasPtr->redrawX1) {
+ canvasPtr->redrawX1 = itemPtr->x1;
+ }
+ if (itemPtr->y1 <= canvasPtr->redrawY1) {
+ canvasPtr->redrawY1 = itemPtr->y1;
+ }
+ if (itemPtr->x2 >= canvasPtr->redrawX2) {
+ canvasPtr->redrawX2 = itemPtr->x2;
+ }
+ if (itemPtr->y2 >= canvasPtr->redrawY2) {
+ canvasPtr->redrawY2 = itemPtr->y2;
+ }
+ } else {
+ canvasPtr->redrawX1 = itemPtr->x1;
+ canvasPtr->redrawY1 = itemPtr->y1;
+ canvasPtr->redrawX2 = itemPtr->x2;
+ canvasPtr->redrawY2 = itemPtr->y2;
+ canvasPtr->flags |= BBOX_NOT_EMPTY;
+ }
+ itemPtr->redraw_flags |= FORCE_REDRAW;
+ }
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateItemType --
+ *
+ * This procedure may be invoked to add a new kind of canvas
+ * element to the core item types supported by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, the new item type will be useable in canvas
+ * widgets (e.g. typePtr->name can be used as the item type
+ * in "create" widget commands). If there was already a
+ * type with the same name as in typePtr, it is replaced with
+ * the new type.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateItemType(typePtr)
+ Tk_ItemType *typePtr; /* Information about item type;
+ * storage must be statically
+ * allocated (must live forever). */
+{
+ Tk_ItemType *typePtr2, *prevPtr;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ /*
+ * If there's already an item type with the given name, remove it.
+ */
+
+ for (typePtr2 = typeList, prevPtr = NULL; typePtr2 != NULL;
+ prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
+ if (strcmp(typePtr2->name, typePtr->name) == 0) {
+ if (prevPtr == NULL) {
+ typeList = typePtr2->nextPtr;
+ } else {
+ prevPtr->nextPtr = typePtr2->nextPtr;
+ }
+ break;
+ }
+ }
+ typePtr->nextPtr = typeList;
+ typeList = typePtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetItemTypes --
+ *
+ * This procedure returns a pointer to the list of all item
+ * types.
+ *
+ * Results:
+ * The return value is a pointer to the first in the list
+ * of item types currently supported by canvases.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_ItemType *
+Tk_GetItemTypes()
+{
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+ return typeList;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * InitCanvas --
+ *
+ * This procedure is invoked to perform once-only-ever
+ * initialization for the module, such as setting up
+ * the type table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitCanvas()
+{
+ if (typeList != NULL) {
+ return;
+ }
+ typeList = &tkRectangleType;
+ tkRectangleType.nextPtr = &tkTextType;
+ tkTextType.nextPtr = &tkLineType;
+ tkLineType.nextPtr = &tkPolygonType;
+ tkPolygonType.nextPtr = &tkImageType;
+ tkImageType.nextPtr = &tkOvalType;
+ tkOvalType.nextPtr = &tkBitmapType;
+ tkBitmapType.nextPtr = &tkArcType;
+ tkArcType.nextPtr = &tkWindowType;
+ tkWindowType.nextPtr = NULL;
+#ifndef USE_OLD_TAG_SEARCH
+ allUid = Tk_GetUid("all");
+ currentUid = Tk_GetUid("current");
+ andUid = Tk_GetUid("&&");
+ orUid = Tk_GetUid("||");
+ xorUid = Tk_GetUid("^");
+ parenUid = Tk_GetUid("(");
+ endparenUid = Tk_GetUid(")");
+ negparenUid = Tk_GetUid("!(");
+ tagvalUid = Tk_GetUid("!!");
+ negtagvalUid = Tk_GetUid("!");
+#endif /* USE_OLD_TAG_SEARCH */
+}
+\f
+#ifdef USE_OLD_TAG_SEARCH
+/*
+ *--------------------------------------------------------------
+ *
+ * StartTagSearch --
+ *
+ * This procedure is called to initiate an enumeration of
+ * all items in a given canvas that contain a given tag.
+ *
+ * Results:
+ * The return value is a pointer to the first item in
+ * canvasPtr that matches tag, or NULL if there is no
+ * such item. The information at *searchPtr is initialized
+ * such that successive calls to NextItem will return
+ * successive items that match tag.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress
+ * on canvasPtr, so that elements can safely be deleted
+ * while the search is in progress. EndTagSearch must be
+ * called at the end of the search to unlink searchPtr from
+ * this list.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+StartTagSearch(canvasPtr, tagObj, searchPtr)
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ Tcl_Obj *tagObj; /* Object giving tag value. */
+ TagSearch *searchPtr; /* Record describing tag search;
+ * will be initialized here. */
+{
+ int id;
+ Tk_Item *itemPtr, *lastPtr;
+ Tk_Uid *tagPtr;
+ Tk_Uid uid;
+ char *tag = Tcl_GetString(tagObj);
+ int count;
+ TkWindow *tkwin;
+ TkDisplay *dispPtr;
+
+ tkwin = (TkWindow *) canvasPtr->tkwin;
+ dispPtr = tkwin->dispPtr;
+
+ /*
+ * Initialize the search.
+ */
+
+ searchPtr->canvasPtr = canvasPtr;
+ searchPtr->searchOver = 0;
+
+ /*
+ * Find the first matching item in one of several ways. If the tag
+ * is a number then it selects the single item with the matching
+ * identifier. In this case see if the item being requested is the
+ * hot item, in which case the search can be skipped.
+ */
+
+ if (isdigit(UCHAR(*tag))) {
+ char *end;
+ Tcl_HashEntry *entryPtr;
+
+ dispPtr->numIdSearches++;
+ id = strtoul(tag, &end, 0);
+ if (*end == 0) {
+ itemPtr = canvasPtr->hotPtr;
+ lastPtr = canvasPtr->hotPrevPtr;
+ if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL)
+ || (lastPtr->nextPtr != itemPtr)) {
+ dispPtr->numSlowSearches++;
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
+ if (entryPtr != NULL) {
+ itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
+ lastPtr = itemPtr->prevPtr;
+ } else {
+ lastPtr = itemPtr = NULL;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ canvasPtr->hotPtr = itemPtr;
+ canvasPtr->hotPrevPtr = lastPtr;
+ return itemPtr;
+ }
+ }
+
+ searchPtr->tag = uid = Tk_GetUid(tag);
+ if (uid == Tk_GetUid("all")) {
+ /*
+ * All items match.
+ */
+
+ searchPtr->tag = NULL;
+ searchPtr->lastPtr = NULL;
+ searchPtr->currentPtr = canvasPtr->firstItemPtr;
+ return canvasPtr->firstItemPtr;
+ }
+
+ /*
+ * None of the above. Search for an item with a matching tag.
+ */
+
+ for (lastPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * NextItem --
+ *
+ * This procedure returns successive items that match a given
+ * tag; it should be called only after StartTagSearch has been
+ * used to begin a search.
+ *
+ * Results:
+ * The return value is a pointer to the next item that matches
+ * the tag specified to StartTagSearch, or NULL if no such
+ * item exists. *SearchPtr is updated so that the next call
+ * to this procedure will return the next item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+NextItem(searchPtr)
+ TagSearch *searchPtr; /* Record describing search in
+ * progress. */
+{
+ Tk_Item *itemPtr, *lastPtr;
+ int count;
+ Tk_Uid uid;
+ Tk_Uid *tagPtr;
+
+ /*
+ * Find next item in list (this may not actually be a suitable
+ * one to return), and return if there are no items left.
+ */
+
+ lastPtr = searchPtr->lastPtr;
+ if (lastPtr == NULL) {
+ itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ } else {
+ itemPtr = lastPtr->nextPtr;
+ }
+ if ((itemPtr == NULL) || (searchPtr->searchOver)) {
+ searchPtr->searchOver = 1;
+ return NULL;
+ }
+ if (itemPtr != searchPtr->currentPtr) {
+ /*
+ * The structure of the list has changed. Probably the
+ * previously-returned item was removed from the list.
+ * In this case, don't advance lastPtr; just return
+ * its new successor (i.e. do nothing here).
+ */
+ } else {
+ lastPtr = itemPtr;
+ itemPtr = lastPtr->nextPtr;
+ }
+
+ /*
+ * Handle special case of "all" search by returning next item.
+ */
+
+ uid = searchPtr->tag;
+ if (uid == NULL) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+
+ /*
+ * Look for an item with a particular tag.
+ */
+
+ for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+\f
+#else /* USE_OLD_TAG_SEARCH */
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchExprInit --
+ *
+ * This procedure allocates and initializes one TagSearchExpr struct.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchExprInit(exprPtrPtr)
+TagSearchExpr **exprPtrPtr;
+{
+ TagSearchExpr* expr = *exprPtrPtr;
+
+ if (! expr) {
+ expr = (TagSearchExpr *) ckalloc(sizeof(TagSearchExpr));
+ expr->allocated = 0;
+ expr->uids = NULL;
+ expr->next = NULL;
+ }
+ expr->uid = NULL;
+ expr->index = 0;
+ expr->length = 0;
+ *exprPtrPtr = expr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchExprDestroy --
+ *
+ * This procedure destroys one TagSearchExpr structure.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchExprDestroy(expr)
+ TagSearchExpr *expr;
+{
+ if (expr) {
+ if (expr->uids) {
+ ckfree((char *)expr->uids);
+ }
+ ckfree((char *)expr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchScan --
+ *
+ * This procedure is called to initiate an enumeration of
+ * all items in a given canvas that contain a tag that matches
+ * the tagOrId expression.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * was successfully scanned (syntax).
+ * The information at *searchPtr is initialized
+ * such that a call to TagSearchFirst, followed by
+ * successive calls to TagSearchNext will return items
+ * that match tag.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress
+ * on canvasPtr, so that elements can safely be deleted
+ * while the search is in progress.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchScan(canvasPtr, tagObj, searchPtrPtr)
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ Tcl_Obj *tagObj; /* Object giving tag value. */
+ TagSearch **searchPtrPtr; /* Record describing tag search;
+ * will be initialized here. */
+{
+ char *tag = Tcl_GetStringFromObj(tagObj,NULL);
+ int i;
+ TagSearch *searchPtr;
+
+ /*
+ * Initialize the search.
+ */
+
+ if (*searchPtrPtr) {
+ searchPtr = *searchPtrPtr;
+ } else {
+ /* Allocate primary search struct on first call */
+ *searchPtrPtr = searchPtr = (TagSearch *) ckalloc(sizeof(TagSearch));
+ searchPtr->expr = NULL;
+
+ /* Allocate buffer for rewritten tags (after de-escaping) */
+ searchPtr->rewritebufferAllocated = 100;
+ searchPtr->rewritebuffer =
+ ckalloc(searchPtr->rewritebufferAllocated);
+ }
+ TagSearchExprInit(&(searchPtr->expr));
+
+ /* How long is the tagOrId ? */
+ searchPtr->stringLength = strlen(tag);
+
+ /* Make sure there is enough buffer to hold rewritten tags */
+ if ((unsigned int)searchPtr->stringLength >=
+ searchPtr->rewritebufferAllocated) {
+ searchPtr->rewritebufferAllocated = searchPtr->stringLength + 100;
+ searchPtr->rewritebuffer =
+ ckrealloc(searchPtr->rewritebuffer,
+ searchPtr->rewritebufferAllocated);
+ }
+
+ /* Initialize search */
+ searchPtr->canvasPtr = canvasPtr;
+ searchPtr->searchOver = 0;
+ searchPtr->type = 0;
+
+ /*
+ * Find the first matching item in one of several ways. If the tag
+ * is a number then it selects the single item with the matching
+ * identifier. In this case see if the item being requested is the
+ * hot item, in which case the search can be skipped.
+ */
+
+ if (searchPtr->stringLength && isdigit(UCHAR(*tag))) {
+ char *end;
+
+ searchPtr->id = strtoul(tag, &end, 0);
+ if (*end == 0) {
+ searchPtr->type = 1;
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * For all other tags and tag expressions convert to a UID.
+ * This UID is kept forever, but this should be thought of
+ * as a cache rather than as a memory leak.
+ */
+ searchPtr->expr->uid = Tk_GetUid(tag);
+
+ /* short circuit impossible searches for null tags */
+ if (searchPtr->stringLength == 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * Pre-scan tag for at least one unquoted "&&" "||" "^" "!"
+ * if not found then use string as simple tag
+ */
+ for (i = 0; i < searchPtr->stringLength ; i++) {
+ if (tag[i] == '"') {
+ i++;
+ for ( ; i < searchPtr->stringLength; i++) {
+ if (tag[i] == '\\') {
+ i++;
+ continue;
+ }
+ if (tag[i] == '"') {
+ break;
+ }
+ }
+ } else {
+ if ((tag[i] == '&' && tag[i+1] == '&')
+ || (tag[i] == '|' && tag[i+1] == '|')
+ || (tag[i] == '^')
+ || (tag[i] == '!')) {
+ searchPtr->type = 4;
+ break;
+ }
+ }
+ }
+
+ searchPtr->string = tag;
+ searchPtr->stringIndex = 0;
+ if (searchPtr->type == 4) {
+ /*
+ * an operator was found in the prescan, so
+ * now compile the tag expression into array of Tk_Uid
+ * flagging any syntax errors found
+ */
+ if (TagSearchScanExpr(canvasPtr->interp, searchPtr, searchPtr->expr) != TCL_OK) {
+ /* Syntax error in tag expression */
+ /* Result message set by TagSearchScanExpr */
+ return TCL_ERROR;
+ }
+ searchPtr->expr->length = searchPtr->expr->index;
+ } else {
+ if (searchPtr->expr->uid == allUid) {
+ /*
+ * All items match.
+ */
+ searchPtr->type = 2;
+ } else {
+ /*
+ * Optimized single-tag search
+ */
+ searchPtr->type = 3;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchDestroy --
+ *
+ * This procedure destroys any dynamic structures that
+ * may have been allocated by TagSearchScan.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchDestroy(searchPtr)
+ TagSearch *searchPtr; /* Record describing tag search */
+{
+ if (searchPtr) {
+ TagSearchExprDestroy(searchPtr->expr);
+ ckfree((char *)searchPtr->rewritebuffer);
+ ckfree((char *)searchPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchScanExpr --
+ *
+ * This recursive procedure is called to scan a tag expression
+ * and compile it into an array of Tk_Uids.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * was successfully scanned (syntax).
+ * The information at *searchPtr is initialized
+ * such that a call to TagSearchFirst, followed by
+ * successive calls to TagSearchNext will return items
+ * that match tag.
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchScanExpr(interp, searchPtr, expr)
+ Tcl_Interp *interp; /* Current interpreter. */
+ TagSearch *searchPtr; /* Search data */
+ TagSearchExpr *expr; /* compiled expression result */
+{
+ int looking_for_tag; /* When true, scanner expects
+ * next char(s) to be a tag,
+ * else operand expected */
+ int found_tag; /* One or more tags found */
+ int found_endquote; /* For quoted tag string parsing */
+ int negate_result; /* Pending negation of next tag value */
+ char *tag; /* tag from tag expression string */
+ char c;
+
+ negate_result = 0;
+ found_tag = 0;
+ looking_for_tag = 1;
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex++];
+
+ if (expr->allocated == expr->index) {
+ expr->allocated += 15;
+ if (expr->uids) {
+ expr->uids =
+ (Tk_Uid *) ckrealloc((char *)(expr->uids),
+ (expr->allocated)*sizeof(Tk_Uid));
+ } else {
+ expr->uids =
+ (Tk_Uid *) ckalloc((expr->allocated)*sizeof(Tk_Uid));
+ }
+ }
+
+ if (looking_for_tag) {
+
+ switch (c) {
+ case ' ' : /* ignore unquoted whitespace */
+ case '\t' :
+ case '\n' :
+ case '\r' :
+ break;
+
+ case '!' : /* negate next tag or subexpr */
+ if (looking_for_tag > 1) {
+ Tcl_AppendResult(interp,
+ "Too many '!' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ looking_for_tag++;
+ negate_result = 1;
+ break;
+
+ case '(' : /* scan (negated) subexpr recursively */
+ if (negate_result) {
+ expr->uids[expr->index++] = negparenUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = parenUid;
+ }
+ if (TagSearchScanExpr(interp, searchPtr, expr) != TCL_OK) {
+ /* Result string should be already set
+ * by nested call to tag_expr_scan() */
+ return TCL_ERROR;
+ }
+ looking_for_tag = 0;
+ found_tag = 1;
+ break;
+
+ case '"' : /* quoted tag string */
+ if (negate_result) {
+ expr->uids[expr->index++] = negtagvalUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = tagvalUid;
+ }
+ tag = searchPtr->rewritebuffer;
+ found_endquote = 0;
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c == '\\') {
+ c = searchPtr->string[searchPtr->stringIndex++];
+ }
+ if (c == '"') {
+ found_endquote = 1;
+ break;
+ }
+ *tag++ = c;
+ }
+ if (! found_endquote) {
+ Tcl_AppendResult(interp,
+ "Missing endquote in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (! (tag - searchPtr->rewritebuffer)) {
+ Tcl_AppendResult(interp,
+ "Null quoted tag string in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ *tag++ = '\0';
+ expr->uids[expr->index++] =
+ Tk_GetUid(searchPtr->rewritebuffer);
+ looking_for_tag = 0;
+ found_tag = 1;
+ break;
+
+ case '&' : /* illegal chars when looking for tag */
+ case '|' :
+ case '^' :
+ case ')' :
+ Tcl_AppendResult(interp,
+ "Unexpected operator in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+
+ default : /* unquoted tag string */
+ if (negate_result) {
+ expr->uids[expr->index++] = negtagvalUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = tagvalUid;
+ }
+ tag = searchPtr->rewritebuffer;
+ *tag++ = c;
+ /* copy rest of tag, including any embedded whitespace */
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex];
+ if (c == '!' || c == '&' || c == '|' || c == '^'
+ || c == '(' || c == ')' || c == '"') {
+ break;
+ }
+ *tag++ = c;
+ searchPtr->stringIndex++;
+ }
+ /* remove trailing whitespace */
+ while (1) {
+ c = *--tag;
+ /* there must have been one non-whitespace char,
+ * so this will terminate */
+ if (c != ' ' && c != '\t' && c != '\n' && c != '\r') {
+ break;
+ }
+ }
+ *++tag = '\0';
+ expr->uids[expr->index++] =
+ Tk_GetUid(searchPtr->rewritebuffer);
+ looking_for_tag = 0;
+ found_tag = 1;
+ }
+
+ } else { /* ! looking_for_tag */
+
+ switch (c) {
+ case ' ' : /* ignore whitespace */
+ case '\t' :
+ case '\n' :
+ case '\r' :
+ break;
+
+ case '&' : /* AND operator */
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c != '&') {
+ Tcl_AppendResult(interp,
+ "Singleton '&' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ expr->uids[expr->index++] = andUid;
+ looking_for_tag = 1;
+ break;
+
+ case '|' : /* OR operator */
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c != '|') {
+ Tcl_AppendResult(interp,
+ "Singleton '|' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ expr->uids[expr->index++] = orUid;
+ looking_for_tag = 1;
+ break;
+
+ case '^' : /* XOR operator */
+ expr->uids[expr->index++] = xorUid;
+ looking_for_tag = 1;
+ break;
+
+ case ')' : /* end subexpression */
+ expr->uids[expr->index++] = endparenUid;
+ goto breakwhile;
+
+ default : /* syntax error */
+ Tcl_AppendResult(interp,
+ "Invalid boolean operator in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ breakwhile:
+ if (found_tag && ! looking_for_tag) {
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, "Missing tag in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchEvalExpr --
+ *
+ * This recursive procedure is called to eval a tag expression.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * successfully matched the tags of the current item.
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchEvalExpr(expr, itemPtr)
+ TagSearchExpr *expr; /* Search expression */
+ Tk_Item *itemPtr; /* Item being test for match */
+{
+ int looking_for_tag; /* When true, scanner expects
+ * next char(s) to be a tag,
+ * else operand expected */
+ int negate_result; /* Pending negation of next tag value */
+ Tk_Uid uid;
+ Tk_Uid *tagPtr;
+ int count;
+ int result; /* Value of expr so far */
+ int parendepth;
+
+ result = 0; /* just to keep the compiler quiet */
+
+ negate_result = 0;
+ looking_for_tag = 1;
+ while (expr->index < expr->length) {
+ uid = expr->uids[expr->index++];
+ if (looking_for_tag) {
+ if (uid == tagvalUid) {
+/*
+ * assert(expr->index < expr->length);
+ */
+ uid = expr->uids[expr->index++];
+ result = 0;
+ /*
+ * set result 1 if tag is found in item's tags
+ */
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ result = 1;
+ break;
+ }
+ }
+
+ } else if (uid == negtagvalUid) {
+ negate_result = ! negate_result;
+/*
+ * assert(expr->index < expr->length);
+ */
+ uid = expr->uids[expr->index++];
+ result = 0;
+ /*
+ * set result 1 if tag is found in item's tags
+ */
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ result = 1;
+ break;
+ }
+ }
+
+ } else if (uid == parenUid) {
+ /*
+ * evaluate subexpressions with recursion
+ */
+ result = TagSearchEvalExpr(expr, itemPtr);
+
+ } else if (uid == negparenUid) {
+ negate_result = ! negate_result;
+ /*
+ * evaluate subexpressions with recursion
+ */
+ result = TagSearchEvalExpr(expr, itemPtr);
+/*
+ * } else {
+ * assert(0);
+ */
+ }
+ if (negate_result) {
+ result = ! result;
+ negate_result = 0;
+ }
+ looking_for_tag = 0;
+ } else { /* ! looking_for_tag */
+ if (((uid == andUid) && (!result)) || ((uid == orUid) && result)) {
+ /*
+ * short circuit expression evaluation
+ *
+ * if result before && is 0, or result before || is 1,
+ * then the expression is decided and no further
+ * evaluation is needed.
+ */
+
+ parendepth = 0;
+ while (expr->index < expr->length) {
+ uid = expr->uids[expr->index++];
+ if (uid == tagvalUid || uid == negtagvalUid) {
+ expr->index++;
+ continue;
+ }
+ if (uid == parenUid || uid == negparenUid) {
+ parendepth++;
+ continue;
+ }
+ if (uid == endparenUid) {
+ parendepth--;
+ if (parendepth < 0) {
+ break;
+ }
+ }
+ }
+ return result;
+
+ } else if (uid == xorUid) {
+ /*
+ * if the previous result was 1
+ * then negate the next result
+ */
+ negate_result = result;
+
+ } else if (uid == endparenUid) {
+ return result;
+/*
+ * } else {
+ * assert(0);
+ */
+ }
+ looking_for_tag = 1;
+ }
+ }
+/*
+ * assert(! looking_for_tag);
+ */
+ return result;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchFirst --
+ *
+ * This procedure is called to get the first item
+ * item that matches a preestablished search predicate
+ * that was set by TagSearchScan.
+ *
+ * Results:
+ * The return value is a pointer to the first item, or NULL
+ * if there is no such item. The information at *searchPtr
+ * is updated such that successive calls to TagSearchNext
+ * will return successive items.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress
+ * on canvasPtr, so that elements can safely be deleted
+ * while the search is in progress.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+TagSearchFirst(searchPtr)
+ TagSearch *searchPtr; /* Record describing tag search */
+{
+ Tk_Item *itemPtr, *lastPtr;
+ Tk_Uid uid, *tagPtr;
+ int count;
+
+ /* short circuit impossible searches for null tags */
+ if (searchPtr->stringLength == 0) {
+ return NULL;
+ }
+
+ /*
+ * Find the first matching item in one of several ways. If the tag
+ * is a number then it selects the single item with the matching
+ * identifier. In this case see if the item being requested is the
+ * hot item, in which case the search can be skipped.
+ */
+
+ if (searchPtr->type == 1) {
+ Tcl_HashEntry *entryPtr;
+
+ itemPtr = searchPtr->canvasPtr->hotPtr;
+ lastPtr = searchPtr->canvasPtr->hotPrevPtr;
+ if ((itemPtr == NULL) || (itemPtr->id != searchPtr->id) || (lastPtr == NULL)
+ || (lastPtr->nextPtr != itemPtr)) {
+ entryPtr = Tcl_FindHashEntry(&searchPtr->canvasPtr->idTable,
+ (char *) searchPtr->id);
+ if (entryPtr != NULL) {
+ itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
+ lastPtr = itemPtr->prevPtr;
+ } else {
+ lastPtr = itemPtr = NULL;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ searchPtr->canvasPtr->hotPtr = itemPtr;
+ searchPtr->canvasPtr->hotPrevPtr = lastPtr;
+ return itemPtr;
+ }
+
+ if (searchPtr->type == 2) {
+
+ /*
+ * All items match.
+ */
+
+ searchPtr->lastPtr = NULL;
+ searchPtr->currentPtr = searchPtr->canvasPtr->firstItemPtr;
+ return searchPtr->canvasPtr->firstItemPtr;
+ }
+
+ if (searchPtr->type == 3) {
+
+ /*
+ * Optimized single-tag search
+ */
+
+ uid = searchPtr->expr->uid;
+ for (lastPtr = NULL, itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ } else {
+
+ /*
+ * None of the above. Search for an item matching the tag expression.
+ */
+
+ for (lastPtr = NULL, itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ searchPtr->expr->index = 0;
+ if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchNext --
+ *
+ * This procedure returns successive items that match a given
+ * tag; it should be called only after TagSearchFirst has been
+ * used to begin a search.
+ *
+ * Results:
+ * The return value is a pointer to the next item that matches
+ * the tag expr specified to TagSearchScan, or NULL if no such
+ * item exists. *SearchPtr is updated so that the next call
+ * to this procedure will return the next item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+TagSearchNext(searchPtr)
+ TagSearch *searchPtr; /* Record describing search in
+ * progress. */
+{
+ Tk_Item *itemPtr, *lastPtr;
+ Tk_Uid uid, *tagPtr;
+ int count;
+
+ /*
+ * Find next item in list (this may not actually be a suitable
+ * one to return), and return if there are no items left.
+ */
+
+ lastPtr = searchPtr->lastPtr;
+ if (lastPtr == NULL) {
+ itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ } else {
+ itemPtr = lastPtr->nextPtr;
+ }
+ if ((itemPtr == NULL) || (searchPtr->searchOver)) {
+ searchPtr->searchOver = 1;
+ return NULL;
+ }
+ if (itemPtr != searchPtr->currentPtr) {
+ /*
+ * The structure of the list has changed. Probably the
+ * previously-returned item was removed from the list.
+ * In this case, don't advance lastPtr; just return
+ * its new successor (i.e. do nothing here).
+ */
+ } else {
+ lastPtr = itemPtr;
+ itemPtr = lastPtr->nextPtr;
+ }
+
+ if (searchPtr->type == 2) {
+
+ /*
+ * All items match.
+ */
+
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+
+ if (searchPtr->type == 3) {
+
+ /*
+ * Optimized single-tag search
+ */
+
+ uid = searchPtr->expr->uid;
+ for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+ }
+
+ /*
+ * Else.... evaluate tag expression
+ */
+
+ for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ searchPtr->expr->index = 0;
+ if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+#endif /* USE_OLD_TAG_SEARCH */
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DoItem --
+ *
+ * This is a utility procedure called by FindItems. It
+ * either adds itemPtr's id to the result forming in interp,
+ * or it adds a new tag to itemPtr, depending on the value
+ * of tag.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If tag is NULL then itemPtr's id is added as a list element
+ * to the interp's result; otherwise tag is added to itemPtr's
+ * list of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DoItem(interp, itemPtr, tag)
+ Tcl_Interp *interp; /* Interpreter in which to (possibly)
+ * record item id. */
+ Tk_Item *itemPtr; /* Item to (possibly) modify. */
+ Tk_Uid tag; /* Tag to add to those already
+ * present for item, or NULL. */
+{
+ Tk_Uid *tagPtr;
+ int count;
+
+ /*
+ * Handle the "add-to-result" case and return, if appropriate.
+ */
+
+ if (tag == NULL) {
+ char msg[TCL_INTEGER_SPACE];
+
+ sprintf(msg, "%d", itemPtr->id);
+ Tcl_AppendElement(interp, msg);
+ return;
+ }
+
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (tag == *tagPtr) {
+ return;
+ }
+ }
+
+ /*
+ * Grow the tag space if there's no more room left in the current
+ * block.
+ */
+
+ if (itemPtr->tagSpace == itemPtr->numTags) {
+ Tk_Uid *newTagPtr;
+
+ itemPtr->tagSpace += 5;
+ newTagPtr = (Tk_Uid *) ckalloc((unsigned)
+ (itemPtr->tagSpace * sizeof(Tk_Uid)));
+ memcpy((VOID *) newTagPtr, (VOID *) itemPtr->tagPtr,
+ (itemPtr->numTags * sizeof(Tk_Uid)));
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ itemPtr->tagPtr = newTagPtr;
+ tagPtr = &itemPtr->tagPtr[itemPtr->numTags];
+ }
+
+ /*
+ * Add in the new tag.
+ */
+
+ *tagPtr = tag;
+ itemPtr->numTags++;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * FindItems --
+ *
+ * This procedure does all the work of implementing the
+ * "find" and "addtag" options of the canvas widget command,
+ * which locate items that have certain features (location,
+ * tags, position in display list, etc.).
+ *
+ * Results:
+ * A standard Tcl return value. If newTag is NULL, then a
+ * list of ids from all the items that match argc/argv is
+ * returned in the interp's result. If newTag is NULL, then
+ * the normal the interp's result is an empty string. If an error
+ * occurs, then the interp's result will hold an error message.
+ *
+ * Side effects:
+ * If newTag is non-NULL, then all the items that match the
+ * information in argc/argv have that tag added to their
+ * lists of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+#ifdef USE_OLD_TAG_SEARCH
+FindItems(interp, canvasPtr, argc, argv, newTag, first)
+#else /* USE_OLD_TAG_SEARCH */
+FindItems(interp, canvasPtr, argc, argv, newTag, first, searchPtrPtr)
+#endif /* USE_OLD_TAG_SEARCH */
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ int argc; /* Number of entries in argv. Must be
+ * greater than zero. */
+ Tcl_Obj *CONST *argv; /* Arguments that describe what items
+ * to search for (see user doc on
+ * "find" and "addtag" options). */
+ Tcl_Obj *newTag; /* If non-NULL, gives new tag to set
+ * on all found items; if NULL, then
+ * ids of found items are returned
+ * in the interp's result. */
+ int first; /* For error messages: gives number
+ * of elements of argv which are already
+ * handled. */
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearch **searchPtrPtr; /* From CanvasWidgetCmd local vars*/
+#endif /* not USE_OLD_TAG_SEARCH */
+{
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#endif /* USE_OLD_TAG_SEARCH */
+ Tk_Item *itemPtr;
+ Tk_Uid uid;
+ int index;
+ static CONST char *optionStrings[] = {
+ "above", "all", "below", "closest",
+ "enclosed", "overlapping", "withtag", NULL
+ };
+ enum options {
+ CANV_ABOVE, CANV_ALL, CANV_BELOW, CANV_CLOSEST,
+ CANV_ENCLOSED, CANV_OVERLAPPING, CANV_WITHTAG
+ };
+
+ if (newTag != NULL) {
+ uid = Tk_GetUid(Tcl_GetStringFromObj(newTag, NULL));
+ } else {
+ uid = NULL;
+ }
+ if (Tcl_GetIndexFromObj(interp, argv[first], optionStrings, "search command", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case CANV_ABOVE: {
+ Tk_Item *lastPtr = NULL;
+ if (argc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
+ return TCL_ERROR;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (itemPtr = TagSearchFirst(*searchPtrPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ lastPtr = itemPtr;
+ }
+ if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) {
+ DoItem(interp, lastPtr->nextPtr, uid);
+ }
+ break;
+ }
+ case CANV_ALL: {
+ if (argc != first+1) {
+ Tcl_WrongNumArgs(interp, first+1, argv, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ DoItem(interp, itemPtr, uid);
+ }
+ break;
+ }
+ case CANV_BELOW: {
+ Tk_Item *itemPtr;
+
+ if (argc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
+ return TCL_ERROR;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ itemPtr = TagSearchFirst(*searchPtrPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ if (itemPtr->prevPtr != NULL) {
+ DoItem(interp, itemPtr->prevPtr, uid);
+ }
+ }
+ break;
+ }
+ case CANV_CLOSEST: {
+ double closestDist;
+ Tk_Item *startPtr, *closestPtr;
+ double coords[2], halo;
+ int x1, y1, x2, y2;
+
+ if ((argc < first+3) || (argc > first+5)) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "x y ?halo? ?start?");
+ return TCL_ERROR;
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[first+1],
+ &coords[0]) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
+ (Tk_Canvas) canvasPtr, argv[first+2], &coords[1]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (argc > first+3) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[first+3],
+ &halo) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (halo < 0.0) {
+ Tcl_AppendResult(interp, "can't have negative halo value \"",
+ Tcl_GetString(argv[3]), "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ halo = 0.0;
+ }
+
+ /*
+ * Find the item at which to start the search.
+ */
+
+ startPtr = canvasPtr->firstItemPtr;
+ if (argc == first+5) {
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[first+4], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, argv[first+4], searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ itemPtr = TagSearchFirst(*searchPtrPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ startPtr = itemPtr;
+ }
+ }
+
+ /*
+ * The code below is optimized so that it can eliminate most
+ * items without having to call their item-specific procedures.
+ * This is done by keeping a bounding box (x1, y1, x2, y2) that
+ * an item's bbox must overlap if the item is to have any
+ * chance of being closer than the closest so far.
+ */
+
+ itemPtr = startPtr;
+ while(itemPtr && (itemPtr->state == TK_STATE_HIDDEN ||
+ (itemPtr->state == TK_STATE_NULL && canvasPtr->canvas_state == TK_STATE_HIDDEN))) {
+ itemPtr = itemPtr->nextPtr;
+ }
+ if (itemPtr == NULL) {
+ return TCL_OK;
+ }
+ closestDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) - halo;
+ if (closestDist < 0.0) {
+ closestDist = 0.0;
+ }
+ while (1) {
+ double newDist;
+
+ /*
+ * Update the bounding box using itemPtr, which is the
+ * new closest item.
+ */
+
+ x1 = (int) (coords[0] - closestDist - halo - 1);
+ y1 = (int) (coords[1] - closestDist - halo - 1);
+ x2 = (int) (coords[0] + closestDist + halo + 1);
+ y2 = (int) (coords[1] + closestDist + halo + 1);
+ closestPtr = itemPtr;
+
+ /*
+ * Search for an item that beats the current closest one.
+ * Work circularly through the canvas's item list until
+ * getting back to the starting item.
+ */
+
+ while (1) {
+ itemPtr = itemPtr->nextPtr;
+ if (itemPtr == NULL) {
+ itemPtr = canvasPtr->firstItemPtr;
+ }
+ if (itemPtr == startPtr) {
+ DoItem(interp, closestPtr, uid);
+ return TCL_OK;
+ }
+ if (itemPtr->state == TK_STATE_HIDDEN || (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ continue;
+ }
+ if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
+ || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
+ continue;
+ }
+ newDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) - halo;
+ if (newDist < 0.0) {
+ newDist = 0.0;
+ }
+ if (newDist <= closestDist) {
+ closestDist = newDist;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_ENCLOSED: {
+ if (argc != first+5) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "x1 y1 x2 y2");
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, argv+first+1, uid, 1);
+ }
+ case CANV_OVERLAPPING: {
+ if (argc != first+5) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "x1 y1 x2 y2");
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, argv+first+1, uid, 0);
+ }
+ case CANV_WITHTAG: {
+ if (argc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
+ return TCL_ERROR;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (itemPtr = TagSearchFirst(*searchPtrPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ DoItem(interp, itemPtr, uid);
+ }
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * FindArea --
+ *
+ * This procedure implements area searches for the "find"
+ * and "addtag" options.
+ *
+ * Results:
+ * A standard Tcl return value. If newTag is NULL, then a
+ * list of ids from all the items overlapping or enclosed
+ * by the rectangle given by argc is returned in the interp's result.
+ * If newTag is NULL, then the normal the interp's result is an
+ * empty string. If an error occurs, then the interp's result will
+ * hold an error message.
+ *
+ * Side effects:
+ * If uid is non-NULL, then all the items overlapping
+ * or enclosed by the area in argv have that tag added to
+ * their lists of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FindArea(interp, canvasPtr, argv, uid, enclosed)
+ Tcl_Interp *interp; /* Interpreter for error reporting
+ * and result storing. */
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ Tcl_Obj *CONST *argv; /* Array of four arguments that
+ * give the coordinates of the
+ * rectangular area to search. */
+ Tk_Uid uid; /* If non-NULL, gives new tag to set
+ * on all found items; if NULL, then
+ * ids of found items are returned
+ * in the interp's result. */
+ int enclosed; /* 0 means overlapping or enclosed
+ * items are OK, 1 means only enclosed
+ * items are OK. */
+{
+ double rect[4], tmp;
+ int x1, y1, x2, y2;
+ Tk_Item *itemPtr;
+
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[0],
+ &rect[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[1],
+ &rect[1]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[2],
+ &rect[2]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &rect[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (rect[0] > rect[2]) {
+ tmp = rect[0]; rect[0] = rect[2]; rect[2] = tmp;
+ }
+ if (rect[1] > rect[3]) {
+ tmp = rect[1]; rect[1] = rect[3]; rect[3] = tmp;
+ }
+
+ /*
+ * Use an integer bounding box for a quick test, to avoid
+ * calling item-specific code except for items that are close.
+ */
+
+ x1 = (int) (rect[0]-1.0);
+ y1 = (int) (rect[1]-1.0);
+ x2 = (int) (rect[2]+1.0);
+ y2 = (int) (rect[3]+1.0);
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->state == TK_STATE_HIDDEN || (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ continue;
+ }
+ if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
+ || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->areaProc)((Tk_Canvas) canvasPtr, itemPtr, rect)
+ >= enclosed) {
+ DoItem(interp, itemPtr, uid);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * RelinkItems --
+ *
+ * Move one or more items to a different place in the
+ * display order for a canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The items identified by "tag" are moved so that they
+ * are all together in the display list and immediately
+ * after prevPtr. The order of the moved items relative
+ * to each other is not changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+#ifdef USE_OLD_TAG_SEARCH
+static void
+RelinkItems(canvasPtr, tag, prevPtr)
+#else /* USE_OLD_TAG_SEARCH */
+static int
+RelinkItems(canvasPtr, tag, prevPtr, searchPtrPtr)
+#endif /* USE_OLD_TAG_SEARCH */
+ TkCanvas *canvasPtr; /* Canvas to be modified. */
+ Tcl_Obj *tag; /* Tag identifying items to be moved
+ * in the redisplay list. */
+ Tk_Item *prevPtr; /* Reposition the items so that they
+ * go just after this item (NULL means
+ * put at beginning of list). */
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearch **searchPtrPtr; /* From CanvasWidgetCmd local vars */
+#endif /* not USE_OLD_TAG_SEARCH */
+{
+ Tk_Item *itemPtr;
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#endif /* USE_OLD_TAG_SEARCH */
+ Tk_Item *firstMovePtr, *lastMovePtr;
+
+ /*
+ * Find all of the items to be moved and remove them from
+ * the list, making an auxiliary list running from firstMovePtr
+ * to lastMovePtr. Record their areas for redisplay.
+ */
+
+ firstMovePtr = lastMovePtr = NULL;
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, tag, &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, tag, searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (itemPtr = TagSearchFirst(*searchPtrPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr == prevPtr) {
+ /*
+ * Item after which insertion is to occur is being
+ * moved! Switch to insert after its predecessor.
+ */
+
+ prevPtr = prevPtr->prevPtr;
+ }
+ if (itemPtr->prevPtr == NULL) {
+ if (itemPtr->nextPtr != NULL) {
+ itemPtr->nextPtr->prevPtr = NULL;
+ }
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ } else {
+ if (itemPtr->nextPtr != NULL) {
+ itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
+ }
+ itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
+ }
+ if (canvasPtr->lastItemPtr == itemPtr) {
+ canvasPtr->lastItemPtr = itemPtr->prevPtr;
+ }
+ if (firstMovePtr == NULL) {
+ itemPtr->prevPtr = NULL;
+ firstMovePtr = itemPtr;
+ } else {
+ itemPtr->prevPtr = lastMovePtr;
+ lastMovePtr->nextPtr = itemPtr;
+ }
+ lastMovePtr = itemPtr;
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+
+ /*
+ * Insert the list of to-be-moved items back into the canvas's
+ * at the desired position.
+ */
+
+ if (firstMovePtr == NULL) {
+#ifdef USE_OLD_TAG_SEARCH
+ return;
+#else /* USE_OLD_TAG_SEARCH */
+ return TCL_OK;
+#endif /* USE_OLD_TAG_SEARCH */
+ }
+ if (prevPtr == NULL) {
+ if (canvasPtr->firstItemPtr != NULL) {
+ canvasPtr->firstItemPtr->prevPtr = lastMovePtr;
+ }
+ lastMovePtr->nextPtr = canvasPtr->firstItemPtr;
+ canvasPtr->firstItemPtr = firstMovePtr;
+ } else {
+ if (prevPtr->nextPtr != NULL) {
+ prevPtr->nextPtr->prevPtr = lastMovePtr;
+ }
+ lastMovePtr->nextPtr = prevPtr->nextPtr;
+ if (firstMovePtr != NULL) {
+ firstMovePtr->prevPtr = prevPtr;
+ }
+ prevPtr->nextPtr = firstMovePtr;
+ }
+ if (canvasPtr->lastItemPtr == prevPtr) {
+ canvasPtr->lastItemPtr = lastMovePtr;
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ return TCL_OK;
+#endif /* not USE_OLD_TAG_SEARCH */
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasBindProc --
+ *
+ * This procedure is invoked by the Tk dispatcher to handle
+ * events associated with bindings on items.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command invoked as part of the binding
+ * (if there was any).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasBindProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to canvas structure. */
+ XEvent *eventPtr; /* Pointer to X event that just
+ * happened. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ Tcl_Preserve((ClientData) canvasPtr);
+
+ /*
+ * This code below keeps track of the current modifier state in
+ * canvasPtr>state. This information is used to defer repicks of
+ * the current item while buttons are down.
+ */
+
+ if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) {
+ int mask;
+
+ switch (eventPtr->xbutton.button) {
+ case Button1:
+ mask = Button1Mask;
+ break;
+ case Button2:
+ mask = Button2Mask;
+ break;
+ case Button3:
+ mask = Button3Mask;
+ break;
+ case Button4:
+ mask = Button4Mask;
+ break;
+ case Button5:
+ mask = Button5Mask;
+ break;
+ default:
+ mask = 0;
+ break;
+ }
+
+ /*
+ * For button press events, repick the current item using the
+ * button state before the event, then process the event. For
+ * button release events, first process the event, then repick
+ * the current item using the button state *after* the event
+ * (the button has logically gone up before we change the
+ * current item).
+ */
+
+ if (eventPtr->type == ButtonPress) {
+ /*
+ * On a button press, first repick the current item using
+ * the button state before the event, the process the event.
+ */
+
+ canvasPtr->state = eventPtr->xbutton.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ canvasPtr->state ^= mask;
+ CanvasDoEvent(canvasPtr, eventPtr);
+ } else {
+ /*
+ * Button release: first process the event, with the button
+ * still considered to be down. Then repick the current
+ * item under the assumption that the button is no longer down.
+ */
+
+ canvasPtr->state = eventPtr->xbutton.state;
+ CanvasDoEvent(canvasPtr, eventPtr);
+ eventPtr->xbutton.state ^= mask;
+ canvasPtr->state = eventPtr->xbutton.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ eventPtr->xbutton.state ^= mask;
+ }
+ goto done;
+ } else if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ canvasPtr->state = eventPtr->xcrossing.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ goto done;
+ } else if (eventPtr->type == MotionNotify) {
+ canvasPtr->state = eventPtr->xmotion.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ }
+ CanvasDoEvent(canvasPtr, eventPtr);
+
+ done:
+ Tcl_Release((ClientData) canvasPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * PickCurrentItem --
+ *
+ * Find the topmost item in a canvas that contains a given
+ * location and mark the the current item. If the current
+ * item has changed, generate a fake exit event on the old
+ * current item, a fake enter event on the new current item
+ * item and force a redraw of the two items. Canvas items
+ * that are hidden or disabled are ignored.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current item for canvasPtr may change. If it does,
+ * then the commands associated with item entry and exit
+ * could do just about anything. A binding script could
+ * delete the canvas, so callers should protect themselves
+ * with Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PickCurrentItem(canvasPtr, eventPtr)
+ TkCanvas *canvasPtr; /* Canvas widget in which to select
+ * current item. */
+ XEvent *eventPtr; /* Event describing location of
+ * mouse cursor. Must be EnterWindow,
+ * LeaveWindow, ButtonRelease, or
+ * MotionNotify. */
+{
+ double coords[2];
+ int buttonDown;
+ Tk_Item *prevItemPtr;
+
+ /*
+ * Check whether or not a button is down. If so, we'll log entry
+ * and exit into and out of the current item, but not entry into
+ * any other item. This implements a form of grabbing equivalent
+ * to what the X server does for windows.
+ */
+
+ buttonDown = canvasPtr->state
+ & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask);
+ if (!buttonDown) {
+ canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
+ }
+
+ /*
+ * Save information about this event in the canvas. The event in
+ * the canvas is used for two purposes:
+ *
+ * 1. Event bindings: if the current item changes, fake events are
+ * generated to allow item-enter and item-leave bindings to trigger.
+ * 2. Reselection: if the current item gets deleted, can use the
+ * saved event to find a new current item.
+ * Translate MotionNotify events into EnterNotify events, since that's
+ * what gets reported to item handlers.
+ */
+
+ if (eventPtr != &canvasPtr->pickEvent) {
+ if ((eventPtr->type == MotionNotify)
+ || (eventPtr->type == ButtonRelease)) {
+ canvasPtr->pickEvent.xcrossing.type = EnterNotify;
+ canvasPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial;
+ canvasPtr->pickEvent.xcrossing.send_event
+ = eventPtr->xmotion.send_event;
+ canvasPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display;
+ canvasPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window;
+ canvasPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root;
+ canvasPtr->pickEvent.xcrossing.subwindow = None;
+ canvasPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time;
+ canvasPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x;
+ canvasPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y;
+ canvasPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root;
+ canvasPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root;
+ canvasPtr->pickEvent.xcrossing.mode = NotifyNormal;
+ canvasPtr->pickEvent.xcrossing.detail = NotifyNonlinear;
+ canvasPtr->pickEvent.xcrossing.same_screen
+ = eventPtr->xmotion.same_screen;
+ canvasPtr->pickEvent.xcrossing.focus = False;
+ canvasPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state;
+ } else {
+ canvasPtr->pickEvent = *eventPtr;
+ }
+ }
+
+ /*
+ * If this is a recursive call (there's already a partially completed
+ * call pending on the stack; it's in the middle of processing a
+ * Leave event handler for the old current item) then just return;
+ * the pending call will do everything that's needed.
+ */
+
+ if (canvasPtr->flags & REPICK_IN_PROGRESS) {
+ return;
+ }
+
+ /*
+ * A LeaveNotify event automatically means that there's no current
+ * object, so the check for closest item can be skipped.
+ */
+
+ coords[0] = canvasPtr->pickEvent.xcrossing.x + canvasPtr->xOrigin;
+ coords[1] = canvasPtr->pickEvent.xcrossing.y + canvasPtr->yOrigin;
+ if (canvasPtr->pickEvent.type != LeaveNotify) {
+ canvasPtr->newCurrentPtr = CanvasFindClosest(canvasPtr, coords);
+ } else {
+ canvasPtr->newCurrentPtr = NULL;
+ }
+
+ if ((canvasPtr->newCurrentPtr == canvasPtr->currentItemPtr)
+ && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
+ /*
+ * Nothing to do: the current item hasn't changed.
+ */
+
+ return;
+ }
+
+ /*
+ * Simulate a LeaveNotify event on the previous current item and
+ * an EnterNotify event on the new current item. Remove the "current"
+ * tag from the previous current item and place it on the new current
+ * item.
+ */
+
+ if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr)
+ && (canvasPtr->currentItemPtr != NULL)
+ && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
+ XEvent event;
+ Tk_Item *itemPtr = canvasPtr->currentItemPtr;
+ int i;
+
+ event = canvasPtr->pickEvent;
+ event.type = LeaveNotify;
+
+ /*
+ * If the event's detail happens to be NotifyInferior the
+ * binding mechanism will discard the event. To be consistent,
+ * always use NotifyAncestor.
+ */
+
+ event.xcrossing.detail = NotifyAncestor;
+ canvasPtr->flags |= REPICK_IN_PROGRESS;
+ CanvasDoEvent(canvasPtr, &event);
+ canvasPtr->flags &= ~REPICK_IN_PROGRESS;
+
+ /*
+ * The check below is needed because there could be an event
+ * handler for <LeaveNotify> that deletes the current item.
+ */
+
+ if ((itemPtr == canvasPtr->currentItemPtr) && !buttonDown) {
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+#ifdef USE_OLD_TAG_SEARCH
+ if (itemPtr->tagPtr[i] == Tk_GetUid("current")) {
+#else /* USE_OLD_TAG_SEARCH */
+ if (itemPtr->tagPtr[i] == currentUid) {
+#endif /* USE_OLD_TAG_SEARCH */
+ itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
+ itemPtr->numTags--;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Note: during CanvasDoEvent above, it's possible that
+ * canvasPtr->newCurrentPtr got reset to NULL because the
+ * item was deleted.
+ */
+ }
+ if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr) && buttonDown) {
+ canvasPtr->flags |= LEFT_GRABBED_ITEM;
+ return;
+ }
+
+ /*
+ * Special note: it's possible that canvasPtr->newCurrentPtr ==
+ * canvasPtr->currentItemPtr here. This can happen, for example,
+ * if LEFT_GRABBED_ITEM was set.
+ */
+
+ prevItemPtr = canvasPtr->currentItemPtr;
+ canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
+ canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr;
+ if (prevItemPtr != NULL && prevItemPtr != canvasPtr->currentItemPtr &&
+ (prevItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT)) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, prevItemPtr);
+ (*prevItemPtr->typePtr->configProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, prevItemPtr, 0, (Tcl_Obj **) NULL,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ if (canvasPtr->currentItemPtr != NULL) {
+ XEvent event;
+
+#ifdef USE_OLD_TAG_SEARCH
+ DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr,
+ Tk_GetUid("current"));
+#else /* USE_OLD_TAG_SEARCH */
+ DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, currentUid);
+#endif /* USE_OLD_TAG_SEA */
+ if ((canvasPtr->currentItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT &&
+ prevItemPtr != canvasPtr->currentItemPtr)) {
+ (*canvasPtr->currentItemPtr->typePtr->configProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, canvasPtr->currentItemPtr, 0, (Tcl_Obj **) NULL,
+ TK_CONFIG_ARGV_ONLY);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->currentItemPtr);
+ }
+ event = canvasPtr->pickEvent;
+ event.type = EnterNotify;
+ event.xcrossing.detail = NotifyAncestor;
+ CanvasDoEvent(canvasPtr, &event);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasFindClosest --
+ *
+ * Given x and y coordinates, find the topmost canvas item that
+ * is "close" to the coordinates. Canvas items that are hidden
+ * or disabled are ignored.
+ *
+ * Results:
+ * The return value is a pointer to the topmost item that is
+ * close to (x,y), or NULL if no item is close.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_Item *
+CanvasFindClosest(canvasPtr, coords)
+ TkCanvas *canvasPtr; /* Canvas widget to search. */
+ double coords[2]; /* Desired x,y position in canvas,
+ * not screen, coordinates.) */
+{
+ Tk_Item *itemPtr;
+ Tk_Item *bestPtr;
+ int x1, y1, x2, y2;
+
+ x1 = (int) (coords[0] - canvasPtr->closeEnough);
+ y1 = (int) (coords[1] - canvasPtr->closeEnough);
+ x2 = (int) (coords[0] + canvasPtr->closeEnough);
+ y2 = (int) (coords[1] + canvasPtr->closeEnough);
+
+ bestPtr = NULL;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->state == TK_STATE_HIDDEN || itemPtr->state==TK_STATE_DISABLED ||
+ (itemPtr->state == TK_STATE_NULL && (canvasPtr->canvas_state == TK_STATE_HIDDEN ||
+ canvasPtr->canvas_state == TK_STATE_DISABLED))) {
+ continue;
+ }
+ if ((itemPtr->x1 > x2) || (itemPtr->x2 < x1)
+ || (itemPtr->y1 > y2) || (itemPtr->y2 < y1)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) <= canvasPtr->closeEnough) {
+ bestPtr = itemPtr;
+ }
+ }
+ return bestPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasDoEvent --
+ *
+ * This procedure is called to invoke binding processing
+ * for a new event that is associated with the current item
+ * for a canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the bindings for the canvas. A binding script
+ * could delete the canvas, so callers should protect themselves
+ * with Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasDoEvent(canvasPtr, eventPtr)
+ TkCanvas *canvasPtr; /* Canvas widget in which event
+ * occurred. */
+ XEvent *eventPtr; /* Real or simulated X event that
+ * is to be processed. */
+{
+#define NUM_STATIC 3
+ ClientData staticObjects[NUM_STATIC];
+ ClientData *objectPtr;
+ int numObjects, i;
+ Tk_Item *itemPtr;
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchExpr *expr;
+ int numExprs;
+#endif /* not USE_OLD_TAG_SEARCH */
+
+ if (canvasPtr->bindingTable == NULL) {
+ return;
+ }
+
+ itemPtr = canvasPtr->currentItemPtr;
+ if ((eventPtr->type == KeyPress) || (eventPtr->type == KeyRelease)) {
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ }
+ if (itemPtr == NULL) {
+ return;
+ }
+
+#ifdef USE_OLD_TAG_SEARCH
+ /*
+ * Set up an array with all the relevant objects for processing
+ * this event. The relevant objects are (a) the event's item,
+ * (b) the tags associated with the event's item, and (c) the
+ * tag "all". If there are a lot of tags then malloc an array
+ * to hold all of the objects.
+ */
+
+ numObjects = itemPtr->numTags + 2;
+#else /* USE_OLD_TAG_SEARCH */
+ /*
+ * Set up an array with all the relevant objects for processing
+ * this event. The relevant objects are:
+ * (a) the event's item,
+ * (b) the tags associated with the event's item,
+ * (c) the expressions that are true for the event's item's tags, and
+ * (d) the tag "all".
+ *
+ * If there are a lot of tags then malloc an array to hold all of
+ * the objects.
+ */
+
+ /*
+ * flag and count all expressions that match item's tags
+ */
+ numExprs = 0;
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ expr->index = 0;
+ expr->match = TagSearchEvalExpr(expr, itemPtr);
+ if (expr->match) {
+ numExprs++;
+ }
+ expr = expr->next;
+ }
+
+ numObjects = itemPtr->numTags + numExprs + 2;
+#endif /* not USE_OLD_TAG_SEARCH */
+ if (numObjects <= NUM_STATIC) {
+ objectPtr = staticObjects;
+ } else {
+ objectPtr = (ClientData *) ckalloc((unsigned)
+ (numObjects * sizeof(ClientData)));
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ objectPtr[0] = (ClientData) Tk_GetUid("all");
+#else /* USE_OLD_TAG_SEARCH */
+ objectPtr[0] = (ClientData) allUid;
+#endif /* USE_OLD_TAG_SEARCH */
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i];
+ }
+ objectPtr[itemPtr->numTags+1] = (ClientData) itemPtr;
+#ifndef USE_OLD_TAG_SEARCH
+ /*
+ * copy uids of matching expressions into object array
+ */
+ i = itemPtr->numTags+2;
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ if (expr->match) {
+ objectPtr[i++] = (int *) expr->uid;
+ }
+ expr = expr->next;
+ }
+#endif /* not USE_OLD_TAG_SEARCH */
+
+ /*
+ * Invoke the binding system, then free up the object array if
+ * it was malloc-ed.
+ */
+
+ if (canvasPtr->tkwin != NULL) {
+ Tk_BindEvent(canvasPtr->bindingTable, eventPtr, canvasPtr->tkwin,
+ numObjects, objectPtr);
+ }
+ if (objectPtr != staticObjects) {
+ ckfree((char *) objectPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasBlinkProc --
+ *
+ * This procedure is called as a timer handler to blink the
+ * insertion cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked,
+ * and this procedure reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasBlinkProc(clientData)
+ ClientData clientData; /* Pointer to record describing entry. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (!canvasPtr->textInfo.gotFocus || (canvasPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (canvasPtr->textInfo.cursorOn) {
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOffTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ } else {
+ canvasPtr->textInfo.cursorOn = 1;
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOnTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ }
+ if (canvasPtr->textInfo.focusItemPtr != NULL) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasFocusProc --
+ *
+ * This procedure is called whenever a canvas gets or loses the
+ * input focus. It's also called whenever the window is
+ * reconfigured while it has the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasFocusProc(canvasPtr, gotFocus)
+ TkCanvas *canvasPtr; /* Canvas that just got or lost focus. */
+ int gotFocus; /* 1 means window is getting focus, 0 means
+ * it's losing it. */
+{
+ Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
+ if (gotFocus) {
+ canvasPtr->textInfo.gotFocus = 1;
+ canvasPtr->textInfo.cursorOn = 1;
+ if (canvasPtr->insertOffTime != 0) {
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOffTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ }
+ } else {
+ canvasPtr->textInfo.gotFocus = 0;
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ }
+ if (canvasPtr->textInfo.focusItemPtr != NULL) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr);
+ }
+ if (canvasPtr->highlightWidth > 0) {
+ canvasPtr->flags |= REDRAW_BORDERS;
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasSelectTo --
+ *
+ * Modify the selection by moving its un-anchored end. This could
+ * make the selection either larger or smaller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasSelectTo(canvasPtr, itemPtr, index)
+ TkCanvas *canvasPtr; /* Information about widget. */
+ Tk_Item *itemPtr; /* Item that is to hold selection. */
+ int index; /* Index of element that is to become the
+ * "other" end of the selection. */
+{
+ int oldFirst, oldLast;
+ Tk_Item *oldSelPtr;
+
+ oldFirst = canvasPtr->textInfo.selectFirst;
+ oldLast = canvasPtr->textInfo.selectLast;
+ oldSelPtr = canvasPtr->textInfo.selItemPtr;
+
+ /*
+ * Grab the selection if we don't own it already.
+ */
+
+ if (canvasPtr->textInfo.selItemPtr == NULL) {
+ Tk_OwnSelection(canvasPtr->tkwin, XA_PRIMARY, CanvasLostSelection,
+ (ClientData) canvasPtr);
+ } else if (canvasPtr->textInfo.selItemPtr != itemPtr) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
+ }
+ canvasPtr->textInfo.selItemPtr = itemPtr;
+
+ if (canvasPtr->textInfo.anchorItemPtr != itemPtr) {
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ }
+ if (canvasPtr->textInfo.selectAnchor <= index) {
+ canvasPtr->textInfo.selectFirst = canvasPtr->textInfo.selectAnchor;
+ canvasPtr->textInfo.selectLast = index;
+ } else {
+ canvasPtr->textInfo.selectFirst = index;
+ canvasPtr->textInfo.selectLast = canvasPtr->textInfo.selectAnchor - 1;
+ }
+ if ((canvasPtr->textInfo.selectFirst != oldFirst)
+ || (canvasPtr->textInfo.selectLast != oldLast)
+ || (itemPtr != oldSelPtr)) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasFetchSelection --
+ *
+ * This procedure is invoked by Tk to return part or all of
+ * the selection, when the selection is in a canvas widget.
+ * This procedure always returns the selection as a STRING.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CanvasFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about canvas widget. */
+ int offset; /* Offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place
+ * selection. */
+ int maxBytes; /* Maximum number of bytes to place
+ * at buffer, not including terminating
+ * NULL character. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (canvasPtr->textInfo.selItemPtr == NULL) {
+ return -1;
+ }
+ if (canvasPtr->textInfo.selItemPtr->typePtr->selectionProc == NULL) {
+ return -1;
+ }
+ return (*canvasPtr->textInfo.selItemPtr->typePtr->selectionProc)(
+ (Tk_Canvas) canvasPtr, canvasPtr->textInfo.selItemPtr, offset,
+ buffer, maxBytes);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a canvas widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasLostSelection(clientData)
+ ClientData clientData; /* Information about entry widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
+ }
+ canvasPtr->textInfo.selItemPtr = NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GridAlign --
+ *
+ * Given a coordinate and a grid spacing, this procedure
+ * computes the location of the nearest grid line to the
+ * coordinate.
+ *
+ * Results:
+ * The return value is the location of the grid line nearest
+ * to coord.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+GridAlign(coord, spacing)
+ double coord; /* Coordinate to grid-align. */
+ double spacing; /* Spacing between grid lines. If <= 0
+ * then no alignment is done. */
+{
+ if (spacing <= 0.0) {
+ return coord;
+ }
+ if (coord < 0) {
+ return -((int) ((-coord)/spacing + 0.5)) * spacing;
+ }
+ return ((int) (coord/spacing + 0.5)) * spacing;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollFractions --
+ *
+ * Given the range that's visible in the window and the "100%
+ * range" for what's in the canvas, return a list of two
+ * doubles representing the scroll fractions. This procedure
+ * is used for both x and y scrolling.
+ *
+ * Results:
+ * The memory pointed to by string is modified to hold
+ * two real numbers containing the scroll fractions (between
+ * 0 and 1) corresponding to the other arguments.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ScrollFractions(screen1, screen2, object1, object2)
+ int screen1; /* Lowest coordinate visible in the window. */
+ int screen2; /* Highest coordinate visible in the window. */
+ int object1; /* Lowest coordinate in the object. */
+ int object2; /* Highest coordinate in the object. */
+{
+ double range, f1, f2;
+ char buffer[2*TCL_DOUBLE_SPACE+2];
+
+ range = object2 - object1;
+ if (range <= 0) {
+ f1 = 0;
+ f2 = 1.0;
+ } else {
+ f1 = (screen1 - object1)/range;
+ if (f1 < 0) {
+ f1 = 0.0;
+ }
+ f2 = (screen2 - object1)/range;
+ if (f2 > 1.0) {
+ f2 = 1.0;
+ }
+ if (f2 < f1) {
+ f2 = f1;
+ }
+ }
+ sprintf(buffer, "%g %g", f1, f2);
+ return Tcl_NewStringObj(buffer, -1);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasUpdateScrollbars --
+ *
+ * This procedure is invoked whenever a canvas has changed in
+ * a way that requires scrollbars to be redisplayed (e.g. the
+ * view in the canvas has changed).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there are scrollbars associated with the canvas, then
+ * their scrolling commands are invoked to cause them to
+ * redisplay. If errors occur, additional Tcl commands may
+ * be invoked to process the errors.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasUpdateScrollbars(canvasPtr)
+ TkCanvas *canvasPtr; /* Information about canvas. */
+{
+ int result;
+ Tcl_Interp *interp;
+ int xOrigin, yOrigin, inset, width, height, scrollX1, scrollX2,
+ scrollY1, scrollY2;
+ char *xScrollCmd, *yScrollCmd;
+
+ /*
+ * Save all the relevant values from the canvasPtr, because it might be
+ * deleted as part of either of the two calls to Tcl_VarEval below.
+ */
+
+ interp = canvasPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ xScrollCmd = canvasPtr->xScrollCmd;
+ if (xScrollCmd != (char *) NULL) {
+ Tcl_Preserve((ClientData) xScrollCmd);
+ }
+ yScrollCmd = canvasPtr->yScrollCmd;
+ if (yScrollCmd != (char *) NULL) {
+ Tcl_Preserve((ClientData) yScrollCmd);
+ }
+ xOrigin = canvasPtr->xOrigin;
+ yOrigin = canvasPtr->yOrigin;
+ inset = canvasPtr->inset;
+ width = Tk_Width(canvasPtr->tkwin);
+ height = Tk_Height(canvasPtr->tkwin);
+ scrollX1 = canvasPtr->scrollX1;
+ scrollX2 = canvasPtr->scrollX2;
+ scrollY1 = canvasPtr->scrollY1;
+ scrollY2 = canvasPtr->scrollY2;
+ canvasPtr->flags &= ~UPDATE_SCROLLBARS;
+ if (canvasPtr->xScrollCmd != NULL) {
+ Tcl_Obj *fractions = ScrollFractions(xOrigin + inset,
+ xOrigin + width - inset, scrollX1, scrollX2);
+ result = Tcl_VarEval(interp, xScrollCmd, " ",
+ Tcl_GetString(fractions), (char *) NULL);
+ Tcl_DecrRefCount(fractions);
+ if (result != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release((ClientData) xScrollCmd);
+ }
+
+ if (yScrollCmd != NULL) {
+ Tcl_Obj *fractions = ScrollFractions(yOrigin + inset,
+ yOrigin + height - inset, scrollY1, scrollY2);
+ result = Tcl_VarEval(interp, yScrollCmd, " ",
+ Tcl_GetString(fractions), (char *) NULL);
+ Tcl_DecrRefCount(fractions);
+ if (result != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release((ClientData) yScrollCmd);
+ }
+ Tcl_Release((ClientData) interp);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasSetOrigin --
+ *
+ * This procedure is invoked to change the mapping between
+ * canvas coordinates and screen coordinates in the canvas
+ * window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The canvas will be redisplayed to reflect the change in
+ * view. In addition, scrollbars will be updated if there
+ * are any.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasSetOrigin(canvasPtr, xOrigin, yOrigin)
+ TkCanvas *canvasPtr; /* Information about canvas. */
+ int xOrigin; /* New X origin for canvas (canvas x-coord
+ * corresponding to left edge of canvas
+ * window). */
+ int yOrigin; /* New Y origin for canvas (canvas y-coord
+ * corresponding to top edge of canvas
+ * window). */
+{
+ int left, right, top, bottom, delta;
+
+ /*
+ * If scroll increments have been set, round the window origin
+ * to the nearest multiple of the increments. Remember, the
+ * origin is the place just inside the borders, not the upper
+ * left corner.
+ */
+
+ if (canvasPtr->xScrollIncrement > 0) {
+ if (xOrigin >= 0) {
+ xOrigin += canvasPtr->xScrollIncrement/2;
+ xOrigin -= (xOrigin + canvasPtr->inset)
+ % canvasPtr->xScrollIncrement;
+ } else {
+ xOrigin = (-xOrigin) + canvasPtr->xScrollIncrement/2;
+ xOrigin = -(xOrigin - (xOrigin - canvasPtr->inset)
+ % canvasPtr->xScrollIncrement);
+ }
+ }
+ if (canvasPtr->yScrollIncrement > 0) {
+ if (yOrigin >= 0) {
+ yOrigin += canvasPtr->yScrollIncrement/2;
+ yOrigin -= (yOrigin + canvasPtr->inset)
+ % canvasPtr->yScrollIncrement;
+ } else {
+ yOrigin = (-yOrigin) + canvasPtr->yScrollIncrement/2;
+ yOrigin = -(yOrigin - (yOrigin - canvasPtr->inset)
+ % canvasPtr->yScrollIncrement);
+ }
+ }
+
+ /*
+ * Adjust the origin if necessary to keep as much as possible of the
+ * canvas in the view. The variables left, right, etc. keep track of
+ * how much extra space there is on each side of the view before it
+ * will stick out past the scroll region. If one side sticks out past
+ * the edge of the scroll region, adjust the view to bring that side
+ * back to the edge of the scrollregion (but don't move it so much that
+ * the other side sticks out now). If scroll increments are in effect,
+ * be sure to adjust only by full increments.
+ */
+
+ if ((canvasPtr->confine) && (canvasPtr->regionString != NULL)) {
+ left = xOrigin + canvasPtr->inset - canvasPtr->scrollX1;
+ right = canvasPtr->scrollX2
+ - (xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset);
+ top = yOrigin + canvasPtr->inset - canvasPtr->scrollY1;
+ bottom = canvasPtr->scrollY2
+ - (yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset);
+ if ((left < 0) && (right > 0)) {
+ delta = (right > -left) ? -left : right;
+ if (canvasPtr->xScrollIncrement > 0) {
+ delta -= delta % canvasPtr->xScrollIncrement;
+ }
+ xOrigin += delta;
+ } else if ((right < 0) && (left > 0)) {
+ delta = (left > -right) ? -right : left;
+ if (canvasPtr->xScrollIncrement > 0) {
+ delta -= delta % canvasPtr->xScrollIncrement;
+ }
+ xOrigin -= delta;
+ }
+ if ((top < 0) && (bottom > 0)) {
+ delta = (bottom > -top) ? -top : bottom;
+ if (canvasPtr->yScrollIncrement > 0) {
+ delta -= delta % canvasPtr->yScrollIncrement;
+ }
+ yOrigin += delta;
+ } else if ((bottom < 0) && (top > 0)) {
+ delta = (top > -bottom) ? -bottom : top;
+ if (canvasPtr->yScrollIncrement > 0) {
+ delta -= delta % canvasPtr->yScrollIncrement;
+ }
+ yOrigin -= delta;
+ }
+ }
+
+ if ((xOrigin == canvasPtr->xOrigin) && (yOrigin == canvasPtr->yOrigin)) {
+ return;
+ }
+
+ /*
+ * Tricky point: must redisplay not only everything that's visible
+ * in the window's final configuration, but also everything that was
+ * visible in the initial configuration. This is needed because some
+ * item types, like windows, need to know when they move off-screen
+ * so they can explicitly undisplay themselves.
+ */
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ canvasPtr->xOrigin = xOrigin;
+ canvasPtr->yOrigin = yOrigin;
+ canvasPtr->flags |= UPDATE_SCROLLBARS;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetStringsFromObjs
+ *
+ * Results:
+ * Converts object list into string list.
+ *
+ * Side effects:
+ * Memory is allocated for the argv array, which must
+ * be freed using ckfree() when no longer needed.
+ *
+ *----------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static CONST char **
+GetStringsFromObjs(argc, objv)
+ int argc;
+ Tcl_Obj *CONST objv[];
+{
+ register int i;
+ CONST char **argv;
+ if (argc <= 0) {
+ return NULL;
+ }
+ argv = (CONST char **) ckalloc((argc+1) * sizeof(char *));
+ for (i = 0; i < argc; i++) {
+ argv[i]=Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ }
+ argv[argc] = 0;
+ return argv;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsColor --
+ *
+ * This procedure is called by individual canvas items when
+ * they want to set a color value for output. Given information
+ * about an X color, this procedure will generate Postscript
+ * commands to set up an appropriate color in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsColor(interp, canvas, colorPtr)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ XColor *colorPtr; /* Information about color. */
+{
+ return Tk_PostscriptColor(interp, ((TkCanvas *) canvas)->psInfo,
+ colorPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsFont --
+ *
+ * This procedure is called by individual canvas items when
+ * they want to output text. Given information about an X
+ * font, this procedure will generate Postscript commands
+ * to set up an appropriate font in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp->result.
+ *
+ * Side effects:
+ * The Postscript font name is entered into psInfoPtr->fontTable
+ * if it wasn't already there.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsFont(interp, canvas, tkfont)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ Tk_Font tkfont; /* Information about font in which text
+ * is to be printed. */
+{
+ return Tk_PostscriptFont(interp, ((TkCanvas *) canvas)->psInfo, tkfont);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsBitmap --
+ *
+ * This procedure is called to output the contents of a
+ * sub-region of a bitmap in proper image data format for
+ * Postscript (i.e. data between angle brackets, one bit
+ * per pixel).
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ Pixmap bitmap; /* Bitmap for which to generate
+ * Postscript. */
+ int startX, startY; /* Coordinates of upper-left corner
+ * of rectangular region to output. */
+ int width, height; /* Height of rectangular region. */
+{
+ return Tk_PostscriptBitmap(interp, ((TkCanvas *) canvas)->tkwin,
+ ((TkCanvas *) canvas)->psInfo, bitmap, startX, startY,
+ width, height);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsStipple --
+ *
+ * This procedure is called by individual canvas items when
+ * they have created a path that they'd like to be filled with
+ * a stipple pattern. Given information about an X bitmap,
+ * this procedure will generate Postscript commands to fill
+ * the current clip region using a stipple pattern defined by the
+ * bitmap.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsStipple(interp, canvas, bitmap)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ Pixmap bitmap; /* Bitmap to use for stippling. */
+{
+ return Tk_PostscriptStipple(interp, ((TkCanvas *) canvas)->tkwin,
+ ((TkCanvas *) canvas)->psInfo, bitmap);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsY --
+ *
+ * Given a y-coordinate in canvas coordinates, this procedure
+ * returns a y-coordinate to use for Postscript output.
+ *
+ * Results:
+ * Returns the Postscript coordinate that corresponds to
+ * "y".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+Tk_CanvasPsY(canvas, y)
+ Tk_Canvas canvas; /* Token for canvas on whose behalf
+ * Postscript is being generated. */
+ double y; /* Y-coordinate in canvas coords. */
+{
+ return Tk_PostscriptY(y, ((TkCanvas *) canvas)->psInfo);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsPath --
+ *
+ * Given an array of points for a path, generate Postscript
+ * commands to create the path.
+ *
+ * Results:
+ * Postscript commands get appended to what's in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
+ Tcl_Interp *interp; /* Put generated Postscript in this
+ * interpreter's result field. */
+ Tk_Canvas canvas; /* Canvas on whose behalf Postscript
+ * is being generated. */
+ double *coordPtr; /* Pointer to first in array of
+ * 2*numPoints coordinates giving
+ * points for path. */
+ int numPoints; /* Number of points at *coordPtr. */
+{
+ Tk_PostscriptPath(interp, ((TkCanvas *) canvas)->psInfo,
+ coordPtr, numPoints);
+}
--- /dev/null
+/*
+ * tkClipboard.c --
+ *
+ * This file manages the clipboard for the Tk toolkit,
+ * maintaining a collection of data buffers that will be
+ * supplied on demand to requesting applications.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkSelect.h"
+
+/*
+ * Prototypes for procedures used only in this file:
+ */
+
+static int ClipboardAppHandler _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static int ClipboardHandler _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static int ClipboardWindowHandler _ANSI_ARGS_((
+ ClientData clientData, int offset, char *buffer,
+ int maxBytes));
+static void ClipboardLostSel _ANSI_ARGS_((ClientData clientData));
+static int ClipboardGetProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *portion));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardHandler --
+ *
+ * This procedure acts as selection handler for the
+ * clipboard manager. It extracts the required chunk of
+ * data from the buffer chain for a given selection target.
+ *
+ * Results:
+ * The return value is a count of the number of bytes
+ * actually stored at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about data to fetch. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ TkClipboardTarget *targetPtr = (TkClipboardTarget*) clientData;
+ TkClipboardBuffer *cbPtr;
+ char *srcPtr, *destPtr;
+ int count = 0;
+ int scanned = 0;
+ size_t length, freeCount;
+
+ /*
+ * Skip to buffer containing offset byte
+ */
+
+ for (cbPtr = targetPtr->firstBufferPtr; ; cbPtr = cbPtr->nextPtr) {
+ if (cbPtr == NULL) {
+ return 0;
+ }
+ if (scanned + cbPtr->length > offset) {
+ break;
+ }
+ scanned += cbPtr->length;
+ }
+
+ /*
+ * Copy up to maxBytes or end of list, switching buffers as needed.
+ */
+
+ freeCount = maxBytes;
+ srcPtr = cbPtr->buffer + (offset - scanned);
+ destPtr = buffer;
+ length = cbPtr->length - (offset - scanned);
+ while (1) {
+ if (length > freeCount) {
+ strncpy(destPtr, srcPtr, freeCount);
+ return maxBytes;
+ } else {
+ strncpy(destPtr, srcPtr, length);
+ destPtr += length;
+ count += length;
+ freeCount -= length;
+ }
+ cbPtr = cbPtr->nextPtr;
+ if (cbPtr == NULL) {
+ break;
+ }
+ srcPtr = cbPtr->buffer;
+ length = cbPtr->length;
+ }
+ return count;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardAppHandler --
+ *
+ * This procedure acts as selection handler for retrievals of type
+ * TK_APPLICATION. It returns the name of the application that
+ * owns the clipboard. Note: we can't use the default Tk
+ * selection handler for this selection type, because the clipboard
+ * window isn't a "real" window and doesn't have the necessary
+ * information.
+ *
+ * Results:
+ * The return value is a count of the number of bytes
+ * actually stored at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardAppHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Pointer to TkDisplay structure. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ size_t length;
+ CONST char *p;
+
+ p = dispPtr->clipboardAppPtr->winPtr->nameUid;
+ length = strlen(p);
+ length -= offset;
+ if (length <= 0) {
+ return 0;
+ }
+ if (length > (size_t) maxBytes) {
+ length = maxBytes;
+ }
+ strncpy(buffer, p, length);
+ return length;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardWindowHandler --
+ *
+ * This procedure acts as selection handler for retrievals of
+ * type TK_WINDOW. Since the clipboard doesn't correspond to
+ * any particular window, we just return ".". We can't use Tk's
+ * default handler for this selection type, because the clipboard
+ * window isn't a valid window.
+ *
+ * Results:
+ * The return value is 1, the number of non-null bytes stored
+ * at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardWindowHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Not used. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ buffer[0] = '.';
+ buffer[1] = 0;
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardLostSel --
+ *
+ * This procedure is invoked whenever clipboard ownership is
+ * claimed by another window. It just sets a flag so that we
+ * know the clipboard was taken away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The clipboard is marked as inactive.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClipboardLostSel(clientData)
+ ClientData clientData; /* Pointer to TkDisplay structure. */
+{
+ TkDisplay *dispPtr = (TkDisplay*) clientData;
+
+ dispPtr->clipboardActive = 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardClear --
+ *
+ * Take control of the clipboard and clear out the previous
+ * contents. This procedure must be invoked before any
+ * calls to Tk_ClipboardAppend.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs, an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * From now on, requests for the CLIPBOARD selection will be
+ * directed to the clipboard manager routines associated with
+ * clipWindow for the display of tkwin. In order to guarantee
+ * atomicity, no event handling should occur between
+ * Tk_ClipboardClear and the following Tk_ClipboardAppend
+ * calls. This procedure may cause a user-defined LostSel command
+ * to be invoked when the CLIPBOARD is claimed, so any calling
+ * function should be reentrant at the point Tk_ClipboardClear is
+ * invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardClear(interp, tkwin)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in application that is clearing
+ * clipboard; identifies application and
+ * display. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkClipboardTarget *targetPtr, *nextTargetPtr;
+ TkClipboardBuffer *cbPtr, *nextCbPtr;
+
+ if (dispPtr->clipWindow == NULL) {
+ int result;
+
+ result = TkClipInit(interp, dispPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ /*
+ * Discard any existing clipboard data and delete the selection
+ * handler(s) associated with that data.
+ */
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = nextTargetPtr) {
+ for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
+ cbPtr = nextCbPtr) {
+ ckfree(cbPtr->buffer);
+ nextCbPtr = cbPtr->nextPtr;
+ ckfree((char *) cbPtr);
+ }
+ nextTargetPtr = targetPtr->nextPtr;
+ Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ targetPtr->type);
+ ckfree((char *) targetPtr);
+ }
+ dispPtr->clipTargetPtr = NULL;
+
+ /*
+ * Reclaim the clipboard selection if we lost it.
+ */
+
+ if (!dispPtr->clipboardActive) {
+ Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ ClipboardLostSel, (ClientData) dispPtr);
+ dispPtr->clipboardActive = 1;
+ }
+ dispPtr->clipboardAppPtr = winPtr->mainPtr;
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardAppend --
+ *
+ * Append a buffer of data to the clipboard. The first buffer of
+ * a given type determines the format for that type. Any successive
+ * appends to that type must have the same format or an error will
+ * be returned. Tk_ClipboardClear must be called before a sequence
+ * of Tk_ClipboardAppend calls can be issued. In order to guarantee
+ * atomicity, no event handling should occur between Tk_ClipboardClear
+ * and the following Tk_ClipboardAppend calls.
+ *
+ * Results:
+ * A standard Tcl result. If an error is returned, an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * The specified buffer will be copied onto the end of the clipboard.
+ * The clipboard maintains a list of buffers which will be used to
+ * supply the data for a selection get request. The first time a given
+ * type is appended, Tk_ClipboardAppend will register a selection
+ * handler of the appropriate type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardAppend(interp, tkwin, type, format, buffer)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Window that selects a display. */
+ Atom type; /* The desired conversion type for this
+ * clipboard item, e.g. STRING or LENGTH. */
+ Atom format; /* Format in which the selection
+ * information should be returned to
+ * the requestor. */
+ char* buffer; /* NULL terminated string containing the data
+ * to be added to the clipboard. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkClipboardTarget *targetPtr;
+ TkClipboardBuffer *cbPtr;
+
+ /*
+ * If this application doesn't already own the clipboard, clear
+ * the clipboard. If we don't own the clipboard selection, claim it.
+ */
+
+ if (dispPtr->clipboardAppPtr != winPtr->mainPtr) {
+ Tk_ClipboardClear(interp, tkwin);
+ } else if (!dispPtr->clipboardActive) {
+ Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ ClipboardLostSel, (ClientData) dispPtr);
+ dispPtr->clipboardActive = 1;
+ }
+
+ /*
+ * Check to see if the specified target is already present on the
+ * clipboard. If it isn't, we need to create a new target; otherwise,
+ * we just append the new buffer to the clipboard list.
+ */
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = targetPtr->nextPtr) {
+ if (targetPtr->type == type)
+ break;
+ }
+ if (targetPtr == NULL) {
+ targetPtr = (TkClipboardTarget*) ckalloc(sizeof(TkClipboardTarget));
+ targetPtr->type = type;
+ targetPtr->format = format;
+ targetPtr->firstBufferPtr = targetPtr->lastBufferPtr = NULL;
+ targetPtr->nextPtr = dispPtr->clipTargetPtr;
+ dispPtr->clipTargetPtr = targetPtr;
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ type, ClipboardHandler, (ClientData) targetPtr, format);
+ } else if (targetPtr->format != format) {
+ Tcl_AppendResult(interp, "format \"", Tk_GetAtomName(tkwin, format),
+ "\" does not match current format \"",
+ Tk_GetAtomName(tkwin, targetPtr->format),"\" for ",
+ Tk_GetAtomName(tkwin, type), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Append a new buffer to the buffer chain.
+ */
+
+ cbPtr = (TkClipboardBuffer*) ckalloc(sizeof(TkClipboardBuffer));
+ cbPtr->nextPtr = NULL;
+ if (targetPtr->lastBufferPtr != NULL) {
+ targetPtr->lastBufferPtr->nextPtr = cbPtr;
+ } else {
+ targetPtr->firstBufferPtr = cbPtr;
+ }
+ targetPtr->lastBufferPtr = cbPtr;
+
+ cbPtr->length = strlen(buffer);
+ cbPtr->buffer = (char *) ckalloc((unsigned) (cbPtr->length + 1));
+ strcpy(cbPtr->buffer, buffer);
+
+ TkSelUpdateClipboard((TkWindow*)(dispPtr->clipWindow), targetPtr);
+
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardObjCmd --
+ *
+ * This procedure is invoked to process the "clipboard" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ char *path = NULL;
+ Atom selection;
+ static CONST char *optionStrings[] = { "append", "clear", "get", NULL };
+ enum options { CLIPBOARD_APPEND, CLIPBOARD_CLEAR, CLIPBOARD_GET };
+ int index, i;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case CLIPBOARD_APPEND: {
+ Atom target, format;
+ char *targetName = NULL;
+ char *formatName = NULL;
+ char *string;
+ static CONST char *appendOptionStrings[] = {
+ "-displayof", "-format", "-type", NULL
+ };
+ enum appendOptions { APPEND_DISPLAYOF, APPEND_FORMAT,
+ APPEND_TYPE };
+ int subIndex, length;
+
+ for (i = 2; i < objc - 1; i++) {
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ if (string[0] != '-') {
+ break;
+ }
+
+ /*
+ * If the argument is "--", it signifies the end of arguments.
+ */
+ if (string[1] == '-' && length == 2) {
+ i++;
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], appendOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Increment i so that it points to the value for the flag
+ * instead of the flag itself.
+ */
+
+ i++;
+ if (i >= objc) {
+ Tcl_AppendResult(interp, "value for \"", string,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ switch ((enum appendOptions) subIndex) {
+ case APPEND_DISPLAYOF:
+ path = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_FORMAT:
+ formatName = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_TYPE:
+ targetName = Tcl_GetString(objv[i]);
+ break;
+ }
+ }
+ if (objc - i != 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options? data");
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+ if (formatName != NULL) {
+ format = Tk_InternAtom(tkwin, formatName);
+ } else {
+ format = XA_STRING;
+ }
+ return Tk_ClipboardAppend(interp, tkwin, target, format,
+ Tcl_GetString(objv[i]));
+ }
+ case CLIPBOARD_CLEAR: {
+ static CONST char *clearOptionStrings[] = { "-displayof", NULL };
+ enum clearOptions { CLEAR_DISPLAYOF };
+ int subIndex;
+ if (objc != 2 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 4) {
+ if (Tcl_GetIndexFromObj(interp, objv[2], clearOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((enum clearOptions) subIndex == CLEAR_DISPLAYOF) {
+ path = Tcl_GetString(objv[3]);
+ }
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_ClipboardClear(interp, tkwin);
+ }
+ case CLIPBOARD_GET: {
+ Atom target;
+ char *targetName = NULL;
+ Tcl_DString selBytes;
+ int result;
+ char *string;
+ static CONST char *getOptionStrings[] = {
+ "-displayof", "-type", NULL
+ };
+ enum getOptions { APPEND_DISPLAYOF, APPEND_TYPE };
+ int subIndex;
+
+ for (i = 2; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], getOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i++;
+ if (i >= objc) {
+ Tcl_AppendResult(interp, "value for \"", string,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ switch ((enum getOptions) subIndex) {
+ case APPEND_DISPLAYOF:
+ path = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_TYPE:
+ targetName = Tcl_GetString(objv[i]);
+ break;
+ }
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ selection = Tk_InternAtom(tkwin, "CLIPBOARD");
+
+ if (objc - i > 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options?");
+ return TCL_ERROR;
+ } else if (objc - i == 1) {
+ target = Tk_InternAtom(tkwin, Tcl_GetString(objv[i]));
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+
+ Tcl_DStringInit(&selBytes);
+ result = Tk_GetSelection(interp, tkwin, selection, target,
+ ClipboardGetProc, (ClientData) &selBytes);
+ if (result == TCL_OK) {
+ Tcl_DStringResult(interp, &selBytes);
+ } else {
+ Tcl_DStringFree(&selBytes);
+ }
+ return result;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkClipCleanup --
+ *
+ * This procedure is called to cleanup resources associated with
+ * claiming clipboard ownership and for receiving selection get
+ * results. This function is called in tkWindow.c. This has to be
+ * called by the display cleanup function because we still need the
+ * access display elements.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources are freed - the clipboard may no longer be used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkClipCleanup(dispPtr)
+ TkDisplay *dispPtr; /* display associated with clipboard */
+{
+ if (dispPtr->clipWindow != NULL) {
+ Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->applicationAtom);
+ Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->windowAtom);
+
+ Tk_DestroyWindow(dispPtr->clipWindow);
+ Tcl_Release((ClientData) dispPtr->clipWindow);
+ dispPtr->clipWindow = NULL;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkClipInit --
+ *
+ * This procedure is called to initialize the window for claiming
+ * clipboard ownership and for receiving selection get results. This
+ * function is called from tkSelect.c as well as tkClipboard.c.
+ *
+ * Results:
+ * The result is a standard Tcl return value, which is normally TCL_OK.
+ * If an error occurs then an error message is left in the interp's
+ * result and TCL_ERROR is returned.
+ *
+ * Side effects:
+ * Sets up the clipWindow and related data structures.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkClipInit(interp, dispPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ register TkDisplay *dispPtr;/* Display to initialize. */
+{
+ XSetWindowAttributes atts;
+
+ dispPtr->clipTargetPtr = NULL;
+ dispPtr->clipboardActive = 0;
+ dispPtr->clipboardAppPtr = NULL;
+
+ /*
+ * Create the window used for clipboard ownership and selection retrieval,
+ * and set up an event handler for it.
+ */
+
+ dispPtr->clipWindow = Tk_CreateWindow(interp, (Tk_Window) NULL,
+ "_clip", DisplayString(dispPtr->display));
+ if (dispPtr->clipWindow == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) dispPtr->clipWindow);
+ atts.override_redirect = True;
+ Tk_ChangeWindowAttributes(dispPtr->clipWindow, CWOverrideRedirect, &atts);
+ Tk_MakeWindowExist(dispPtr->clipWindow);
+
+ if (dispPtr->multipleAtom == None) {
+ /*
+ * Need to invoke selection initialization to make sure that
+ * atoms we depend on below are defined.
+ */
+
+ TkSelInit(dispPtr->clipWindow);
+ }
+
+ /*
+ * Create selection handlers for types TK_APPLICATION and TK_WINDOW
+ * on this window. Can't use the default handlers for these types
+ * because this isn't a full-fledged window.
+ */
+
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->applicationAtom, ClipboardAppHandler,
+ (ClientData) dispPtr, XA_STRING);
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->windowAtom, ClipboardWindowHandler,
+ (ClientData) dispPtr, XA_STRING);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ClipboardGetProc --
+ *
+ * This procedure is invoked to process pieces of the selection
+ * as they arrive during "clipboard get" commands.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Bytes get appended to the dynamic string pointed to by the
+ * clientData argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ClipboardGetProc(clientData, interp, portion)
+ ClientData clientData; /* Dynamic string holding partially
+ * assembled selection. */
+ Tcl_Interp *interp; /* Interpreter used for error
+ * reporting (not used). */
+ char *portion; /* New information to be appended. */
+{
+ Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1);
+ return TCL_OK;
+}
+
--- /dev/null
+/*
+ * tkCmds.c --
+ *
+ * This file contains a collection of Tk-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-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include <errno.h>
+
+#if defined(WIN32)
+#include "tkWinInt.h"
+#elif defined(MAC_TCL)
+#include "tkMacInt.h"
+#elif defined(MAC_OSX_TK)
+#include "tkMacOSXInt.h"
+#else
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static TkWindow * GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
+static char * WaitVariableProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static void WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void WaitWindowProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BellObjCmd --
+ *
+ * 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
+Tk_BellObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *bellOptions[] = {"-displayof", "-nice", (char *) NULL};
+ enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE };
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int i, index, nice = 0;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?-nice?");
+ return TCL_ERROR;
+ }
+
+ for (i = 1; i < objc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], bellOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case TK_BELL_DISPLAYOF:
+ if (++i >= objc) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-displayof window? ?-nice?");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_BELL_NICE:
+ nice = 1;
+ break;
+ }
+ }
+ XBell(Tk_Display(tkwin), 0);
+ if (!nice) {
+ XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
+ }
+ XFlush(Tk_Display(tkwin));
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindObjCmd --
+ *
+ * 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
+Tk_BindObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr;
+ ClientData object;
+ char *string;
+
+ if ((objc < 2) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[1]);
+
+ /*
+ * Bind tags either a window name or a tag name for the first argument.
+ * If the argument starts with ".", assume it is a window; otherwise, it
+ * is a tag.
+ */
+
+ if (string[0] == '.') {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ object = (ClientData) winPtr->pathName;
+ } else {
+ winPtr = (TkWindow *) clientData;
+ object = (ClientData) Tk_GetUid(string);
+ }
+
+ /*
+ * If there are four arguments, the command is modifying a binding. If
+ * there are three arguments, the command is querying a binding. If there
+ * are only two arguments, the command is querying all the bindings for
+ * the given tag/window.
+ */
+
+ if (objc == 4) {
+ int append = 0;
+ unsigned long mask;
+ char *sequence, *script;
+ sequence = Tcl_GetString(objv[2]);
+ script = Tcl_GetString(objv[3]);
+
+ /*
+ * If the script is null, just delete the binding.
+ */
+
+ if (script[0] == 0) {
+ return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
+ object, sequence);
+ }
+
+ /*
+ * If the script begins with "+", append this script to the existing
+ * binding.
+ */
+
+ if (script[0] == '+') {
+ script++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
+ object, sequence, script, append);
+ if (mask == 0) {
+ return TCL_ERROR;
+ }
+ } else if (objc == 3) {
+ CONST char *command;
+
+ command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
+ object, Tcl_GetString(objv[2]));
+ if (command == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+ Tcl_SetResult(interp, (char *) command, TCL_STATIC);
+ } else {
+ Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBindEventProc --
+ *
+ * This procedure is invoked by Tk_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
+TkBindEventProc(winPtr, eventPtr)
+ TkWindow *winPtr; /* Pointer to info about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+#define MAX_OBJS 20
+ ClientData objects[MAX_OBJS], *objPtr;
+ TkWindow *topLevPtr;
+ int i, count;
+ char *p;
+ Tcl_HashEntry *hPtr;
+
+ 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((unsigned)
+ (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 = ((TkWindow *) 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 & TK_TOP_HIERARCHY);
+ topLevPtr = topLevPtr->parentPtr) {
+ /* Empty loop body. */
+ }
+ if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
+ count = 4;
+ objPtr[2] = (ClientData) topLevPtr->pathName;
+ } else {
+ count = 3;
+ }
+ objPtr[count-1] = (ClientData) Tk_GetUid("all");
+ }
+ Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
+ count, objPtr);
+ if (objPtr != objects) {
+ ckfree((char *) objPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindtagsObjCmd --
+ *
+ * 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
+Tk_BindtagsObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr, *winPtr2;
+ int i, length;
+ char *p;
+ Tcl_Obj *listPtr, **tags;
+
+ if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?taglist?");
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]),
+ tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ listPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(listPtr);
+ if (winPtr->numTags == 0) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(winPtr->pathName, -1));
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(winPtr->classUid, -1));
+ winPtr2 = winPtr;
+ while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) {
+ winPtr2 = winPtr2->parentPtr;
+ }
+ if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(winPtr2->pathName, -1));
+ }
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj("all", -1));
+ } else {
+ for (i = 0; i < winPtr->numTags; i++) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1));
+ }
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ Tcl_DecrRefCount(listPtr);
+ return TCL_OK;
+ }
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ if (Tcl_ListObjGetElements(interp, objv[2], &length, &tags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (length == 0) {
+ return TCL_OK;
+ }
+
+ winPtr->numTags = length;
+ winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
+ (length * sizeof(ClientData)));
+ for (i = 0; i < length; i++) {
+ p = Tcl_GetString(tags[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) Tk_GetUid(p);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeBindingTags --
+ *
+ * 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
+TkFreeBindingTags(winPtr)
+ TkWindow *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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DestroyObjCmd --
+ *
+ * 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
+Tk_DestroyObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window window;
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int i;
+
+ for (i = 1; i < objc; i++) {
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
+ if (window == NULL) {
+ Tcl_ResetResult(interp);
+ continue;
+ }
+ Tk_DestroyWindow(window);
+ if (window == tkwin) {
+ /*
+ * We just deleted the main window for the application! This
+ * makes it impossible to do anything more (tkwin isn't
+ * valid anymore).
+ */
+
+ break;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_LowerObjCmd --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_LowerObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window mainwin = (Tk_Window) clientData;
+ Tk_Window tkwin, other;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?belowThis?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ other = NULL;
+ } else {
+ other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
+ Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]),
+ "\" below \"", (other ? Tcl_GetString(objv[2]) : ""),
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RaiseObjCmd --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_RaiseObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window mainwin = (Tk_Window) clientData;
+ Tk_Window tkwin, other;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?aboveThis?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ other = NULL;
+ } else {
+ other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
+ Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]),
+ "\" above \"", (other ? Tcl_GetString(objv[2]) : ""),
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TkObjCmd --
+ *
+ * This procedure is invoked to process the "tk" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_TkObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index;
+ Tk_Window tkwin;
+ static CONST char *optionStrings[] = {
+ "appname", "caret", "scaling", "useinputmethods",
+ "windowingsystem", NULL
+ };
+ enum options {
+ TK_APPNAME, TK_CARET, TK_SCALING, TK_USE_IM,
+ TK_WINDOWINGSYSTEM
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case TK_APPNAME: {
+ TkWindow *winPtr;
+ char *string;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "appname not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) tkwin;
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
+ }
+ Tcl_AppendResult(interp, winPtr->nameUid, NULL);
+ break;
+ }
+ case TK_CARET: {
+ Tcl_Obj *objPtr;
+ TkCaret *caretPtr;
+ Tk_Window window;
+ static CONST char *caretStrings[]
+ = { "-x", "-y", "-height", NULL };
+ enum caretOptions
+ { TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT };
+
+ if ((objc < 3) || ((objc > 4) && !(objc & 1))) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?-x x? ?-y y? ?-height height?");
+ return TCL_ERROR;
+ }
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ caretPtr = &(((TkWindow *) window)->dispPtr->caret);
+ if (objc == 3) {
+ /*
+ * Return all the current values
+ */
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-height", 7));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->height));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-x", 2));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->x));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-y", 2));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->y));
+ Tcl_SetObjResult(interp, objPtr);
+ } else if (objc == 4) {
+ int value;
+ /*
+ * Return the current value of the selected option
+ */
+ if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings,
+ "caret option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == TK_CARET_X) {
+ value = caretPtr->x;
+ } else if (index == TK_CARET_Y) {
+ value = caretPtr->y;
+ } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
+ value = caretPtr->height;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), value);
+ } else {
+ int i, value, x = 0, y = 0, height = -1;
+
+ for (i = 3; i < objc; i += 2) {
+ if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings,
+ "caret option", 0, &index) != TCL_OK) ||
+ (Tcl_GetIntFromObj(interp, objv[i+1], &value)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (index == TK_CARET_X) {
+ x = value;
+ } else if (index == TK_CARET_Y) {
+ y = value;
+ } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
+ height = value;
+ }
+ }
+ if (height < 0) {
+ height = Tk_Height(window);
+ }
+ Tk_SetCaretPos(window, x, y, height);
+ }
+ break;
+ }
+ case TK_SCALING: {
+ Screen *screenPtr;
+ int skip, width, height;
+ double d;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "scaling not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ screenPtr = Tk_Screen(tkwin);
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip == 2) {
+ d = 25.4 / 72;
+ d *= WidthOfScreen(screenPtr);
+ d /= WidthMMOfScreen(screenPtr);
+ Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
+ } else if (objc - skip == 3) {
+ if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ d = (25.4 / 72) / d;
+ width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
+ if (width <= 0) {
+ width = 1;
+ }
+ height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
+ if (height <= 0) {
+ height = 1;
+ }
+ WidthMMOfScreen(screenPtr) = width;
+ HeightMMOfScreen(screenPtr) = height;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? ?factor?");
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case TK_USE_IM: {
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ int skip;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "useinputmethods not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ } else if (skip) {
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ }
+ if ((objc - skip) == 3) {
+ /*
+ * In the case where TK_USE_INPUT_METHODS is not defined,
+ * this will be ignored and we will always return 0.
+ * That will indicate to the user that input methods
+ * are just not available.
+ */
+ int boolVal;
+ if (Tcl_GetBooleanFromObj(interp, objv[2+skip], &boolVal)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+#ifdef TK_USE_INPUT_METHODS
+ if (boolVal) {
+ dispPtr->flags |= TK_DISPLAY_USE_IM;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_USE_IM;
+ }
+#endif /* TK_USE_INPUT_METHODS */
+ } else if ((objc - skip) != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? ?boolean?");
+ return TCL_ERROR;
+ }
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ (int) (dispPtr->flags & TK_DISPLAY_USE_IM));
+ break;
+ }
+ case TK_WINDOWINGSYSTEM: {
+ CONST char *windowingsystem;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+#if defined(WIN32)
+ windowingsystem = "win32";
+#elif defined(MAC_TCL)
+ windowingsystem = "classic";
+#elif defined(MAC_OSX_TK)
+ windowingsystem = "aqua";
+#else
+ windowingsystem = "x11";
+#endif
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TkwaitObjCmd --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_TkwaitObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int done, index;
+ static CONST char *optionStrings[] = { "variable", "visibility", "window",
+ (char *) NULL };
+ enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case TKWAIT_VARIABLE: {
+ if (Tcl_TraceVar(interp, Tcl_GetString(objv[2]),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, (ClientData) &done) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ Tcl_UntraceVar(interp, Tcl_GetString(objv[2]),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, (ClientData) &done);
+ break;
+ }
+
+ case TKWAIT_VISIBILITY: {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(window,
+ VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, (ClientData) &done);
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ if (done != 1) {
+ /*
+ * Note that we do not delete the event handler because it
+ * was deleted automatically when the window was destroyed.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]),
+ "\" was deleted before its visibility changed",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_DeleteEventHandler(window,
+ VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, (ClientData) &done);
+ break;
+ }
+
+ case TKWAIT_WINDOW: {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(window, StructureNotifyMask,
+ WaitWindowProc, (ClientData) &done);
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ /*
+ * Note: there's no need to delete the event handler. It was
+ * deleted automatically when the window was destroyed.
+ */
+ break;
+ }
+ }
+
+ /*
+ * Clear out the interpreter's result, since it may have been set
+ * by event handlers.
+ */
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+ /* ARGSUSED */
+static char *
+WaitVariableProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ CONST char *name1; /* Name of variable. */
+ CONST char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ int *donePtr = (int *) clientData;
+
+ *donePtr = 1;
+ return (char *) NULL;
+}
+
+ /*ARGSUSED*/
+static void
+WaitVisibilityProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ XEvent *eventPtr; /* Information about event (not used). */
+{
+ int *donePtr = (int *) clientData;
+
+ if (eventPtr->type == VisibilityNotify) {
+ *donePtr = 1;
+ }
+ if (eventPtr->type == DestroyNotify) {
+ *donePtr = 2;
+ }
+}
+
+static void
+WaitWindowProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ int *donePtr = (int *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ *donePtr = 1;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UpdateObjCmd --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_UpdateObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
+ int flags, index;
+ TkDisplay *dispPtr;
+
+ if (objc == 1) {
+ flags = TCL_DONT_WAIT;
+ } else if (objc == 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ flags = TCL_IDLE_EVENTS;
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Handle all pending events, sync all displays, and repeat over
+ * and over again until all pending events have been handled.
+ * Special note: it's possible that the entire application could
+ * be destroyed by an event handler that occurs during the update.
+ * Thus, don't use any information from tkwin after calling
+ * Tcl_DoOneEvent.
+ */
+
+ while (1) {
+ while (Tcl_DoOneEvent(flags) != 0) {
+ /* Empty loop body */
+ }
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ XSync(dispPtr->display, False);
+ }
+ if (Tcl_DoOneEvent(flags) == 0) {
+ break;
+ }
+ }
+
+ /*
+ * Must clear the interpreter's result because event handlers could
+ * have executed commands.
+ */
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WinfoObjCmd --
+ *
+ * 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
+Tk_WinfoObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index, x, y, width, height, useX, useY, class, skip;
+ char *string;
+ TkWindow *winPtr;
+ Tk_Window tkwin;
+ Tcl_Obj *resultPtr;
+
+ static TkStateMap visualMap[] = {
+ {PseudoColor, "pseudocolor"},
+ {GrayScale, "grayscale"},
+ {DirectColor, "directcolor"},
+ {TrueColor, "truecolor"},
+ {StaticColor, "staticcolor"},
+ {StaticGray, "staticgray"},
+ {-1, NULL}
+ };
+ static CONST char *optionStrings[] = {
+ "cells", "children", "class", "colormapfull",
+ "depth", "geometry", "height", "id",
+ "ismapped", "manager", "name", "parent",
+ "pointerx", "pointery", "pointerxy", "reqheight",
+ "reqwidth", "rootx", "rooty", "screen",
+ "screencells", "screendepth", "screenheight", "screenwidth",
+ "screenmmheight","screenmmwidth","screenvisual","server",
+ "toplevel", "viewable", "visual", "visualid",
+ "vrootheight", "vrootwidth", "vrootx", "vrooty",
+ "width", "x", "y",
+
+ "atom", "atomname", "containing", "interps",
+ "pathname",
+
+ "exists", "fpixels", "pixels", "rgb",
+ "visualsavailable",
+
+ NULL
+ };
+ enum options {
+ WIN_CELLS, WIN_CHILDREN, WIN_CLASS, WIN_COLORMAPFULL,
+ WIN_DEPTH, WIN_GEOMETRY, WIN_HEIGHT, WIN_ID,
+ WIN_ISMAPPED, WIN_MANAGER, WIN_NAME, WIN_PARENT,
+ WIN_POINTERX, WIN_POINTERY, WIN_POINTERXY, WIN_REQHEIGHT,
+ WIN_REQWIDTH, WIN_ROOTX, WIN_ROOTY, WIN_SCREEN,
+ WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,
+ WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,
+ WIN_TOPLEVEL, WIN_VIEWABLE, WIN_VISUAL, WIN_VISUALID,
+ WIN_VROOTHEIGHT,WIN_VROOTWIDTH, WIN_VROOTX, WIN_VROOTY,
+ WIN_WIDTH, WIN_X, WIN_Y,
+
+ WIN_ATOM, WIN_ATOMNAME, WIN_CONTAINING, WIN_INTERPS,
+ WIN_PATHNAME,
+
+ WIN_EXISTS, WIN_FPIXELS, WIN_PIXELS, WIN_RGB,
+ WIN_VISUALSAVAILABLE
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index < WIN_ATOM) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ winPtr = (TkWindow *) tkwin;
+ resultPtr = Tcl_GetObjResult(interp);
+
+ switch ((enum options) index) {
+ case WIN_CELLS: {
+ Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
+ break;
+ }
+ case WIN_CHILDREN: {
+ Tcl_Obj *strPtr;
+
+ winPtr = winPtr->childList;
+ for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
+ if (!(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
+ strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+ }
+ break;
+ }
+ case WIN_CLASS: {
+ Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
+ break;
+ }
+ case WIN_COLORMAPFULL: {
+ Tcl_SetBooleanObj(resultPtr,
+ TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
+ break;
+ }
+ case WIN_DEPTH: {
+ Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
+ break;
+ }
+ case WIN_GEOMETRY: {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
+ Tk_X(tkwin), Tk_Y(tkwin));
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ break;
+ }
+ case WIN_HEIGHT: {
+ Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
+ break;
+ }
+ case WIN_ID: {
+ char buf[TCL_INTEGER_SPACE];
+
+ Tk_MakeWindowExist(tkwin);
+ TkpPrintWindowId(buf, Tk_WindowId(tkwin));
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ break;
+ }
+ case WIN_ISMAPPED: {
+ Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
+ break;
+ }
+ case WIN_MANAGER: {
+ if (winPtr->geomMgrPtr != NULL) {
+ Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
+ }
+ break;
+ }
+ case WIN_NAME: {
+ Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
+ break;
+ }
+ case WIN_PARENT: {
+ if (winPtr->parentPtr != NULL) {
+ Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
+ }
+ break;
+ }
+ case WIN_POINTERX: {
+ useX = 1;
+ useY = 0;
+ goto pointerxy;
+ }
+ case WIN_POINTERY: {
+ useX = 0;
+ useY = 1;
+ goto pointerxy;
+ }
+ case WIN_POINTERXY: {
+ useX = 1;
+ useY = 1;
+
+ pointerxy:
+ winPtr = GetToplevel(tkwin);
+ if (winPtr == NULL) {
+ x = -1;
+ y = -1;
+ } else {
+ TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
+ }
+ if (useX & useY) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", x, y);
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ } else if (useX) {
+ Tcl_SetIntObj(resultPtr, x);
+ } else {
+ Tcl_SetIntObj(resultPtr, y);
+ }
+ break;
+ }
+ case WIN_REQHEIGHT: {
+ Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
+ break;
+ }
+ case WIN_REQWIDTH: {
+ Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
+ break;
+ }
+ case WIN_ROOTX: {
+ Tk_GetRootCoords(tkwin, &x, &y);
+ Tcl_SetIntObj(resultPtr, x);
+ break;
+ }
+ case WIN_ROOTY: {
+ Tk_GetRootCoords(tkwin, &x, &y);
+ Tcl_SetIntObj(resultPtr, y);
+ break;
+ }
+ case WIN_SCREEN: {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
+ Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".",
+ buf, NULL);
+ break;
+ }
+ case WIN_SCREENCELLS: {
+ Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENDEPTH: {
+ Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENHEIGHT: {
+ Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENWIDTH: {
+ Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENMMHEIGHT: {
+ Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENMMWIDTH: {
+ Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENVISUAL: {
+ class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
+ goto visual;
+ }
+ case WIN_SERVER: {
+ TkGetServerInfo(interp, tkwin);
+ break;
+ }
+ case WIN_TOPLEVEL: {
+ winPtr = GetToplevel(tkwin);
+ if (winPtr != NULL) {
+ Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
+ }
+ break;
+ }
+ case WIN_VIEWABLE: {
+ int viewable = 0;
+ for ( ; ; winPtr = winPtr->parentPtr) {
+ if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
+ break;
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ viewable = 1;
+ break;
+ }
+ }
+
+ Tcl_SetBooleanObj(resultPtr, viewable);
+ break;
+ }
+ case WIN_VISUAL: {
+ class = Tk_Visual(tkwin)->class;
+
+ visual:
+ string = TkFindStateString(visualMap, class);
+ if (string == NULL) {
+ string = "unknown";
+ }
+ Tcl_SetStringObj(resultPtr, string, -1);
+ break;
+ }
+ case WIN_VISUALID: {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "0x%x",
+ (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ break;
+ }
+ case WIN_VROOTHEIGHT: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetIntObj(resultPtr, height);
+ break;
+ }
+ case WIN_VROOTWIDTH: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetIntObj(resultPtr, width);
+ break;
+ }
+ case WIN_VROOTX: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetIntObj(resultPtr, x);
+ break;
+ }
+ case WIN_VROOTY: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetIntObj(resultPtr, y);
+ break;
+ }
+ case WIN_WIDTH: {
+ Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
+ break;
+ }
+ case WIN_X: {
+ Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
+ break;
+ }
+ case WIN_Y: {
+ Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
+ break;
+ }
+
+ /*
+ * Uses -displayof.
+ */
+
+ case WIN_ATOM: {
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
+ break;
+ }
+ case WIN_ATOMNAME: {
+ CONST char *name;
+ long id;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ name = Tk_GetAtomName(tkwin, (Atom) id);
+ if (strcmp(name, "?bad atom?") == 0) {
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ Tcl_AppendStringsToObj(resultPtr,
+ "no atom exists with id \"", string, "\"", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetStringObj(resultPtr, name, -1);
+ break;
+ }
+ case WIN_CONTAINING: {
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? rootX rootY");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_CoordsToWindow(x, y, tkwin);
+ if (tkwin != NULL) {
+ Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
+ }
+ break;
+ }
+ case WIN_INTERPS: {
+ int result;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+ result = TkGetInterpNames(interp, tkwin);
+ return result;
+ }
+ case WIN_PATHNAME: {
+ Window id;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2 + skip], NULL);
+ if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *)Tk_IdToWindow(Tk_Display(tkwin), id);
+ if ((winPtr == NULL) ||
+ (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
+ Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
+ "\" doesn't exist in this application", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the window is a utility window with no associated path
+ * (such as a wrapper window or send communication window), just
+ * return an empty string.
+ */
+
+ tkwin = (Tk_Window) winPtr;
+ if (Tk_PathName(tkwin) != NULL) {
+ Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
+ }
+ break;
+ }
+
+ /*
+ * objv[3] is window.
+ */
+
+ case WIN_EXISTS: {
+ int alive;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
+ Tcl_ResetResult(interp);
+ resultPtr = Tcl_GetObjResult(interp);
+
+ alive = 1;
+ if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
+ alive = 0;
+ }
+ Tcl_SetBooleanObj(resultPtr, alive);
+ break;
+ }
+ case WIN_FPIXELS: {
+ double mm, pixels;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window number");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
+ / WidthMMOfScreen(Tk_Screen(tkwin));
+ Tcl_SetDoubleObj(resultPtr, pixels);
+ break;
+ }
+ case WIN_PIXELS: {
+ int pixels;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window number");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetIntObj(resultPtr, pixels);
+ break;
+ }
+ case WIN_RGB: {
+ XColor *colorPtr;
+ char buf[TCL_INTEGER_SPACE * 3];
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ colorPtr = Tk_GetColor(interp, tkwin, string);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
+ colorPtr->blue);
+ Tk_FreeColor(colorPtr);
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ break;
+ }
+ case WIN_VISUALSAVAILABLE: {
+ XVisualInfo template, *visInfoPtr;
+ int count, i;
+ int includeVisualId;
+ Tcl_Obj *strPtr;
+ char buf[16 + TCL_INTEGER_SPACE];
+ char visualIdString[TCL_INTEGER_SPACE];
+
+ if (objc == 3) {
+ includeVisualId = 0;
+ } else if ((objc == 4)
+ && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),
+ "includeids") == 0)) {
+ includeVisualId = 1;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ template.screen = Tk_ScreenNumber(tkwin);
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
+ &template, &count);
+ if (visInfoPtr == NULL) {
+ Tcl_SetStringObj(resultPtr,
+ "can't find any visuals for screen", -1);
+ return TCL_ERROR;
+ }
+ for (i = 0; i < count; i++) {
+ string = TkFindStateString(visualMap, visInfoPtr[i].class);
+ if (string == NULL) {
+ strcpy(buf, "unknown");
+ } else {
+ sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
+ }
+ if (includeVisualId) {
+ sprintf(visualIdString, " 0x%x",
+ (unsigned int) visInfoPtr[i].visualid);
+ strcat(buf, visualIdString);
+ }
+ strPtr = Tcl_NewStringObj(buf, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+ XFree((char *) visInfoPtr);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+\f
+#if 0
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WmObjCmd --
+ *
+ * This procedure is invoked to process the "wm" 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_WmObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin;
+ TkWindow *winPtr;
+
+ static CONST char *optionStrings[] = {
+ "aspect", "client", "command", "deiconify",
+ "focusmodel", "frame", "geometry", "grid",
+ "group", "iconbitmap", "iconify", "iconmask",
+ "iconname", "iconposition", "iconwindow", "maxsize",
+ "minsize", "overrideredirect", "positionfrom", "protocol",
+ "resizable", "sizefrom", "state", "title",
+ "tracing", "transient", "withdraw", (char *) NULL
+ };
+ enum options {
+ TKWM_ASPECT, TKWM_CLIENT, TKWM_COMMAND, TKWM_DEICONIFY,
+ TKWM_FOCUSMOD, TKWM_FRAME, TKWM_GEOMETRY, TKWM_GRID,
+ TKWM_GROUP, TKWM_ICONBMP, TKWM_ICONIFY, TKWM_ICONMASK,
+ TKWM_ICONNAME, TKWM_ICONPOS, TKWM_ICONWIN, TKWM_MAXSIZE,
+ TKWM_MINSIZE, TKWM_OVERRIDE, TKWM_POSFROM, TKWM_PROTOCOL,
+ TKWM_RESIZABLE, TKWM_SIZEFROM, TKWM_STATE, TKWM_TITLE,
+ TKWM_TRACING, TKWM_TRANSIENT, TKWM_WITHDRAW
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index == TKWM_TRACING) {
+ int wmTracing;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "tracing ?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING));
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmTracing) {
+ dispPtr->flags |= TK_DISPLAY_WM_TRACING;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
+ }
+ return TCL_OK;
+ }
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?arg?");
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case TKWM_ASPECT: {
+ TkpWmAspectCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_CLIENT: {
+ TkpWmClientCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_COMMAND: {
+ TkpWmCommandCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_DEICONIFY: {
+ TkpWmDeiconifyCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_FOCUSMOD: {
+ TkpWmFocusmodCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_FRAME: {
+ TkpWmFrameCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_GEOMETRY: {
+ TkpWmGeometryCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_GRID: {
+ TkpWmGridCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_GROUP: {
+ TkpWmGroupCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONBMP: {
+ TkpWmIconbitmapCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONIFY: {
+ TkpWmIconifyCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONMASK: {
+ TkpWmIconmaskCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONNAME: {
+ /* slight Unix variation */
+ TkpWmIconnameCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONPOS: {
+ /* nearly same - 1 line more on Unix */
+ TkpWmIconpositionCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONWIN: {
+ TkpWmIconwindowCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_MAXSIZE: {
+ /* nearly same, win diffs */
+ TkpWmMaxsizeCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_MINSIZE: {
+ /* nearly same, win diffs */
+ TkpWmMinsizeCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_OVERRIDE: {
+ /* almost same */
+ TkpWmOverrideCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_POSFROM: {
+ /* Equal across platforms */
+ TkpWmPositionfromCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_PROTOCOL: {
+ /* Equal across platforms */
+ TkpWmProtocolCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_RESIZABLE: {
+ /* almost same */
+ TkpWmResizableCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_SIZEFROM: {
+ /* Equal across platforms */
+ TkpWmSizefromCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_STATE: {
+ TkpWmStateCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_TITLE: {
+ TkpWmTitleCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_TRANSIENT: {
+ TkpWmTransientCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_WITHDRAW: {
+ TkpWmWithdrawCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ }
+
+ updateGeom:
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+}
+#endif
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDisplayOf --
+ *
+ * Parses a "-displayof window" option for various commands. If
+ * present, the literal "-displayof" should be in objv[0] and the
+ * window name in objv[1].
+ *
+ * Results:
+ * The return value is 0 if the argument strings did not contain
+ * the "-displayof" option. The return value is 2 if the
+ * argument strings contained both the "-displayof" option and
+ * a valid window name. Otherwise, the return value is -1 if
+ * the window name was missing or did not specify a valid window.
+ *
+ * If the return value was 2, *tkwinPtr is filled with the
+ * token for the window specified on the command line. If the
+ * return value was -1, an error message is left in interp's
+ * result object.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetDisplayOf(interp, objc, objv, tkwinPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. If it is present,
+ * "-displayof" should be in objv[0] and
+ * objv[1] the name of a window. */
+ Tk_Window *tkwinPtr; /* On input, contains main window of
+ * application associated with interp. On
+ * output, filled with window specified as
+ * option to "-displayof" argument, or
+ * unmodified if "-displayof" argument was not
+ * present. */
+{
+ char *string;
+ int length;
+
+ if (objc < 1) {
+ return 0;
+ }
+ string = Tcl_GetStringFromObj(objv[0], &length);
+ if ((length >= 2) &&
+ (strncmp(string, "-displayof", (unsigned) length) == 0)) {
+ if (objc < 2) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "value for \"-displayof\" missing", -1);
+ return -1;
+ }
+ string = Tcl_GetStringFromObj(objv[1], NULL);
+ *tkwinPtr = Tk_NameToWindow(interp, string, *tkwinPtr);
+ if (*tkwinPtr == NULL) {
+ return -1;
+ }
+ return 2;
+ }
+ return 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeadAppCmd --
+ *
+ * If an application has been deleted then all Tk commands will be
+ * re-bound to this procedure.
+ *
+ * Results:
+ * A standard Tcl error is reported to let the user know that
+ * the application is dead.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkDeadAppCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Dummy. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ Tcl_AppendResult(interp, "can't invoke \"", argv[0],
+ "\" command: application has been destroyed", (char *) NULL);
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetToplevel --
+ *
+ * Retrieves the toplevel window which is the nearest ancestor of
+ * of the specified window.
+ *
+ * Results:
+ * Returns the toplevel window or NULL if the window has no
+ * ancestor which is a toplevel.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+GetToplevel(tkwin)
+ Tk_Window tkwin; /* Window for which the toplevel should be
+ * deterined. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ return NULL;
+ }
+ }
+ return winPtr;
+}
--- /dev/null
+/*
+ * tkColor.c --
+ *
+ * This file maintains a database of color values for the Tk
+ * toolkit, in order to avoid round-trips to the server to
+ * map color names to pixel values.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkColor.h"
+
+/*
+ * Structures of the following following type are used as keys for
+ * colorValueTable (in TkDisplay).
+ */
+
+typedef struct {
+ int red, green, blue; /* Values for desired color. */
+ Colormap colormap; /* Colormap from which color will be
+ * allocated. */
+ Display *display; /* Display for colormap. */
+} ValueKey;
+
+
+/*
+ * The structure below is used to allocate thread-local data.
+ */
+
+typedef struct ThreadSpecificData {
+ char rgbString[20]; /* */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void ColorInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupColorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeColorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void InitColorObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "color" Tcl
+ * object, which maps a string color name to a TkColor object. The
+ * ptr1 field of the Tcl_Obj points to a TkColor object.
+ */
+
+Tcl_ObjType tkColorObjType = {
+ "color", /* name */
+ FreeColorObjProc, /* freeIntRepProc */
+ DupColorObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocColorFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * XColor structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the red, blue, and green intensities for the color
+ * given by the string in objPtr, and also specifies a pixel value
+ * to use to draw in that color. If an error occurs, NULL is
+ * returned and an error message will be left in interp's result
+ * (unless interp is NULL).
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeColorFromObj so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_AllocColorFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Used only for error reporting. If NULL,
+ * then no messages are provided. */
+ Tk_Window tkwin; /* Window in which the color will be used.*/
+ Tcl_Obj *objPtr; /* Object that describes the color; string
+ * value is a color name such as "red" or
+ * "#ff0000".*/
+{
+ TkColor *tkColPtr;
+
+ if (objPtr->typePtr != &tkColorObjType) {
+ InitColorObj(objPtr);
+ }
+ tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkColor, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (tkColPtr != NULL) {
+ if (tkColPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkColor that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeColorObjProc(objPtr);
+ tkColPtr = NULL;
+ } else if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ return (XColor *) tkColPtr;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkColor that we wanted. Search
+ * the list of TkColors with the same name to see if one of the
+ * other TkColors is the right one.
+ */
+
+ if (tkColPtr != NULL) {
+ TkColor *firstColorPtr =
+ (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
+ FreeColorObjProc(objPtr);
+ for (tkColPtr = firstColorPtr; tkColPtr != NULL;
+ tkColPtr = tkColPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ tkColPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+ return (XColor *) tkColPtr;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call Tk_GetColor to allocate a new TkColor object.
+ */
+
+ tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount++;
+ }
+ return (XColor *) tkColPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColor --
+ *
+ * Given a string name for a color, map the name to a corresponding
+ * XColor structure.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the red, blue, and green intensities for the color
+ * given by "name", and also specifies a pixel value to use to
+ * draw in that color. If an error occurs, NULL is returned and
+ * an error message will be left in the interp's result.
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeColor so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColor(interp, tkwin, name)
+ Tcl_Interp *interp; /* Place to leave error message if
+ * color can't be found. */
+ Tk_Window tkwin; /* Window in which color will be used. */
+ Tk_Uid name; /* Name of color to be allocated (in form
+ * suitable for passing to XParseColor). */
+{
+ Tcl_HashEntry *nameHashPtr;
+ int new;
+ TkColor *tkColPtr;
+ TkColor *existingColPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->colorInit) {
+ ColorInit(dispPtr);
+ }
+
+ /*
+ * First, check to see if there's already a mapping for this color
+ * name.
+ */
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &new);
+ if (!new) {
+ existingColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);
+ for (tkColPtr = existingColPtr; tkColPtr != NULL;
+ tkColPtr = tkColPtr->nextPtr) {
+ if ((tkColPtr->screen == Tk_Screen(tkwin))
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ return &tkColPtr->color;
+ }
+ }
+ } else {
+ existingColPtr = NULL;
+ }
+
+ /*
+ * The name isn't currently known. Map from the name to a pixel
+ * value.
+ */
+
+ tkColPtr = TkpGetColor(tkwin, name);
+ if (tkColPtr == NULL) {
+ if (interp != NULL) {
+ if (*name == '#') {
+ Tcl_AppendResult(interp, "invalid color name \"", name,
+ "\"", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "unknown color name \"", name,
+ "\"", (char *) NULL);
+ }
+ }
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return (XColor *) NULL;
+ }
+
+ /*
+ * Now create a new TkColor structure and add it to colorNameTable
+ * (in TkDisplay).
+ */
+
+ tkColPtr->magic = COLOR_MAGIC;
+ tkColPtr->gc = None;
+ tkColPtr->screen = Tk_Screen(tkwin);
+ tkColPtr->colormap = Tk_Colormap(tkwin);
+ tkColPtr->visual = Tk_Visual(tkwin);
+ tkColPtr->resourceRefCount = 1;
+ tkColPtr->objRefCount = 0;
+ tkColPtr->type = TK_COLOR_BY_NAME;
+ tkColPtr->hashPtr = nameHashPtr;
+ tkColPtr->nextPtr = existingColPtr;
+ Tcl_SetHashValue(nameHashPtr, tkColPtr);
+
+ return &tkColPtr->color;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColorByValue --
+ *
+ * Given a desired set of red-green-blue intensities for a color,
+ * locate a pixel value to use to draw that color in a given
+ * window.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the closest red, blue, and green intensities available
+ * to those specified in colorPtr, and also specifies a pixel
+ * value to use to draw in that color.
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeColor, so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColorByValue(tkwin, colorPtr)
+ Tk_Window tkwin; /* Window where color will be used. */
+ XColor *colorPtr; /* Red, green, and blue fields indicate
+ * desired color. */
+{
+ ValueKey valueKey;
+ Tcl_HashEntry *valueHashPtr;
+ int new;
+ TkColor *tkColPtr;
+ Display *display = Tk_Display(tkwin);
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->colorInit) {
+ ColorInit(dispPtr);
+ }
+
+ /*
+ * First, check to see if there's already a mapping for this color
+ * name.
+ */
+
+ valueKey.red = colorPtr->red;
+ valueKey.green = colorPtr->green;
+ valueKey.blue = colorPtr->blue;
+ valueKey.colormap = Tk_Colormap(tkwin);
+ valueKey.display = display;
+ valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable,
+ (char *) &valueKey, &new);
+ if (!new) {
+ tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr);
+ tkColPtr->resourceRefCount++;
+ return &tkColPtr->color;
+ }
+
+ /*
+ * The name isn't currently known. Find a pixel value for this
+ * color and add a new structure to colorValueTable (in TkDisplay).
+ */
+
+ tkColPtr = TkpGetColorByValue(tkwin, colorPtr);
+ tkColPtr->magic = COLOR_MAGIC;
+ tkColPtr->gc = None;
+ tkColPtr->screen = Tk_Screen(tkwin);
+ tkColPtr->colormap = valueKey.colormap;
+ tkColPtr->visual = Tk_Visual(tkwin);
+ tkColPtr->resourceRefCount = 1;
+ tkColPtr->objRefCount = 0;
+ tkColPtr->type = TK_COLOR_BY_VALUE;
+ tkColPtr->hashPtr = valueHashPtr;
+ tkColPtr->nextPtr = NULL;
+ Tcl_SetHashValue(valueHashPtr, tkColPtr);
+ return &tkColPtr->color;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfColor --
+ *
+ * Given a color, return a textual string identifying
+ * the color.
+ *
+ * Results:
+ * If colorPtr was created by Tk_GetColor, then the return
+ * value is the "string" that was used to create it.
+ * Otherwise the return value is a string that could have
+ * been passed to Tk_GetColor to allocate that color. The
+ * storage for the returned string is only guaranteed to
+ * persist up until the next call to this procedure.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfColor(colorPtr)
+ XColor *colorPtr; /* Color whose name is desired. */
+{
+ register TkColor *tkColPtr = (TkColor *) colorPtr;
+
+ if ((tkColPtr->magic == COLOR_MAGIC) &&
+ (tkColPtr->type == TK_COLOR_BY_NAME)) {
+ return tkColPtr->hashPtr->key.string;
+ } else {
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red,
+ colorPtr->green, colorPtr->blue);
+ return tsdPtr->rgbString;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GCForColor --
+ *
+ * Given a color allocated from this module, this procedure
+ * returns a GC that can be used for simple drawing with that
+ * color.
+ *
+ * Results:
+ * The return value is a GC with color set as its foreground
+ * color and all other fields defaulted. This GC is only valid
+ * as long as the color exists; it is freed automatically when
+ * the last reference to the color is freed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+GC
+Tk_GCForColor(colorPtr, drawable)
+ XColor *colorPtr; /* Color for which a GC is desired. Must
+ * have been allocated by Tk_GetColor. */
+ Drawable drawable; /* Drawable in which the color will be
+ * used (must have same screen and depth
+ * as the one for which the color was
+ * allocated). */
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ XGCValues gcValues;
+
+ /*
+ * Do a quick sanity check to make sure this color was really
+ * allocated by Tk_GetColor.
+ */
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ panic("Tk_GCForColor called with bogus color");
+ }
+
+ if (tkColPtr->gc == None) {
+ gcValues.foreground = tkColPtr->color.pixel;
+ tkColPtr->gc = XCreateGC(DisplayOfScreen(tkColPtr->screen),
+ drawable, GCForeground, &gcValues);
+ }
+ return tkColPtr->gc;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColor --
+ *
+ * This procedure is called to release a color allocated by
+ * Tk_GetColor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with colorPtr is deleted, and
+ * the color is released to X if there are no remaining uses
+ * for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColor(colorPtr)
+ XColor *colorPtr; /* Color to be released. Must have been
+ * allocated by Tk_GetColor or
+ * Tk_GetColorByValue. */
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ Screen *screen = tkColPtr->screen;
+ TkColor *prevPtr;
+
+ /*
+ * Do a quick sanity check to make sure this color was really
+ * allocated by Tk_GetColor.
+ */
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ panic("Tk_FreeColor called with bogus color");
+ }
+
+ tkColPtr->resourceRefCount--;
+ if (tkColPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ /*
+ * This color is no longer being actively used, so free the color
+ * resources associated with it and remove it from the hash table.
+ * no longer any objects referencing it.
+ */
+
+ if (tkColPtr->gc != None) {
+ XFreeGC(DisplayOfScreen(screen), tkColPtr->gc);
+ tkColPtr->gc = None;
+ }
+ TkpFreeColor(tkColPtr);
+
+ prevPtr = (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
+ if (prevPtr == tkColPtr) {
+ if (tkColPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(tkColPtr->hashPtr);
+ } else {
+ Tcl_SetHashValue(tkColPtr->hashPtr, tkColPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != tkColPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = tkColPtr->nextPtr;
+ }
+
+ /*
+ * Free the TkColor structure if there are no objects referencing
+ * it. However, if there are objects referencing it then keep the
+ * structure around; it will get freed when the last reference is
+ * cleared
+ */
+
+ if (tkColPtr->objRefCount == 0) {
+ ckfree((char *) tkColPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColorFromObj --
+ *
+ * This procedure is called to release a color allocated by
+ * Tk_AllocColorFromObj. It does not throw away the Tcl_Obj *;
+ * it only gets rid of the hash table entry for this color
+ * and clears the cached value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the color represented by
+ * objPtr is decremented, and the color is released to X if there are
+ * no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColorFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this color lives in. Needed
+ * for the screen and colormap values. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr));
+ FreeColorObjProc(objPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeColorObjProc --
+ *
+ * This proc is called to release an object reference to a color.
+ * Called when the object's internal rep is released or when
+ * the cached tkColPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the color's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeColorObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount--;
+ if ((tkColPtr->objRefCount == 0)
+ && (tkColPtr->resourceRefCount == 0)) {
+ ckfree((char *) tkColPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupColorObjProc --
+ *
+ * When a cached color object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The color's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupColorObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkColor *tkColPtr = (TkColor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount++;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColorFromObj --
+ *
+ * Returns the color referred to by a Tcl object. The color must
+ * already have been allocated via a call to Tk_AllocColorFromObj
+ * or Tk_GetColor.
+ *
+ * Results:
+ * Returns the XColor * that matches the tkwin and the string rep
+ * of objPtr.
+ *
+ * Side effects:
+ * If the object is not already a color, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColorFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window in which the color will be
+ * used. */
+ Tcl_Obj *objPtr; /* String value contains the name of the
+ * desired color. */
+{
+ TkColor *tkColPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkColorObjType) {
+ InitColorObj(objPtr);
+ }
+
+ /*
+ * First check to see if the internal representation of the object
+ * is defined and is a color that is valid for the current screen
+ * and color map. If it is, we are done.
+ */
+ tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
+ if ((tkColPtr != NULL)
+ && (tkColPtr->resourceRefCount > 0)
+ && (Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ /*
+ * The object already points to the right TkColor structure.
+ * Just return it.
+ */
+
+ return (XColor *) tkColPtr;
+ }
+
+ /*
+ * If we reach this point, it means that the TkColor structure
+ * that we have cached in the internal representation is not valid
+ * for the current screen and colormap. But there is a list of
+ * other TkColor structures attached to the TkDisplay. Walk this
+ * list looking for the right TkColor structure.
+ */
+
+ hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable,
+ Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ for (tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
+ (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ FreeColorObjProc(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+ tkColPtr->objRefCount++;
+ return (XColor *) tkColPtr;
+ }
+ }
+
+ error:
+ panic(" Tk_GetColorFromObj called with non-existent color!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitColorObj --
+ *
+ * Bookeeping procedure to change an objPtr to a color type.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old internal rep of the object is freed. The object's
+ * type is set to color with a NULL TkColor pointer (the pointer
+ * will be set later by either Tk_AllocColorFromObj or
+ * Tk_GetColorFromObj).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitColorObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkColorObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ColorInit --
+ *
+ * Initialize the structure used for color management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ColorInit(dispPtr)
+ TkDisplay *dispPtr;
+{
+ if (!dispPtr->colorInit) {
+ dispPtr->colorInit = 1;
+ Tcl_InitHashTable(&dispPtr->colorNameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->colorValueTable,
+ sizeof(ValueKey)/sizeof(int));
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugColor --
+ *
+ * This procedure returns debugging information about a color.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkColor
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkColor structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugColor(tkwin, name)
+ Tk_Window tkwin; /* The window in which the color will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkColor *tkColPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name);
+ if (hashPtr != NULL) {
+ tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
+ if (tkColPtr == NULL) {
+ panic("TkDebugColor found empty hash table entry");
+ }
+ for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(tkColPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(tkColPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
--- /dev/null
+/*
+ * tkConfig.c --
+ *
+ * This file contains procedures that manage configuration options
+ * for widgets and other things.
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * Temporary flag for working on new config package.
+ */
+
+#if 0
+
+/*
+ * used only for removing the old config code
+ */
+
+#define __NO_OLD_CONFIG
+#endif
+
+#include "tk.h"
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkFont.h"
+
+/*
+ * The following definition is an AssocData key used to keep track of
+ * all of the option tables that have been created for an interpreter.
+ */
+
+#define OPTION_HASH_KEY "TkOptionTable"
+
+/*
+ * The following two structures are used along with Tk_OptionSpec
+ * structures to manage configuration options. Tk_OptionSpec is
+ * static templates that are compiled into the code of a widget
+ * or other object manager. However, to look up options efficiently
+ * we need to supplement the static information with additional
+ * dynamic information, and this dynamic information may be different
+ * for each application. Thus we create structures of the following
+ * two types to hold all of the dynamic information; this is done
+ * by Tk_CreateOptionTable.
+ *
+ * One of the following structures corresponds to each Tk_OptionSpec.
+ * These structures exist as arrays inside TkOptionTable structures.
+ */
+
+typedef struct TkOption {
+ CONST Tk_OptionSpec *specPtr; /* The original spec from the template
+ * passed to Tk_CreateOptionTable.*/
+ Tk_Uid dbNameUID; /* The Uid form of the option database
+ * name. */
+ Tk_Uid dbClassUID; /* The Uid form of the option database
+ * class name. */
+ Tcl_Obj *defaultPtr; /* Default value for this option. */
+ union {
+ Tcl_Obj *monoColorPtr; /* For color and border options, this
+ * is an alternate default value to
+ * use on monochrome displays. */
+ struct TkOption *synonymPtr; /* For synonym options, this points to
+ * the master entry. */
+ struct Tk_ObjCustomOption *custom; /* For TK_OPTION_CUSTOM. */
+ } extra;
+ int flags; /* Miscellaneous flag values; see
+ * below for definitions. */
+} Option;
+
+/*
+ * Flag bits defined for Option structures:
+ *
+ * OPTION_NEEDS_FREEING - 1 means that FreeResources must be
+ * invoke to free resources associated with
+ * the option when it is no longer needed.
+ */
+
+#define OPTION_NEEDS_FREEING 1
+
+/*
+ * One of the following exists for each Tk_OptionSpec array that has
+ * been passed to Tk_CreateOptionTable.
+ */
+
+typedef struct OptionTable {
+ int refCount; /* Counts the number of uses of this
+ * table (the number of times
+ * Tk_CreateOptionTable has returned
+ * it). This can be greater than 1 if
+ * it is shared along several option
+ * table chains, or if the same table
+ * is used for multiple purposes. */
+ Tcl_HashEntry *hashEntryPtr; /* Hash table entry that refers to this
+ * table; used to delete the entry. */
+ struct OptionTable *nextPtr; /* If templatePtr was part of a chain
+ * of templates, this points to the
+ * table corresponding to the next
+ * template in the chain. */
+ int numOptions; /* The number of items in the options
+ * array below. */
+ Option options[1]; /* Information about the individual
+ * options in the table. This must be
+ * the last field in the structure:
+ * the actual size of the array will
+ * be numOptions, not 1. */
+} OptionTable;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int DoObjConfig _ANSI_ARGS_((Tcl_Interp *interp,
+ char *recordPtr, Option *optionPtr,
+ Tcl_Obj *valuePtr, Tk_Window tkwin,
+ Tk_SavedOption *savePtr));
+static void DestroyOptionHashTable _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+static void FreeResources _ANSI_ARGS_((Option *optionPtr,
+ Tcl_Obj *objPtr, char *internalPtr,
+ Tk_Window tkwin));
+static Tcl_Obj * GetConfigList _ANSI_ARGS_((char *recordPtr,
+ Option *optionPtr, Tk_Window tkwin));
+static Tcl_Obj * GetObjectForOption _ANSI_ARGS_((char *recordPtr,
+ Option *optionPtr, Tk_Window tkwin));
+static Option * GetOption _ANSI_ARGS_((CONST char *name,
+ OptionTable *tablePtr));
+static Option * GetOptionFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, OptionTable *tablePtr));
+static int ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int SetOptionFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The structure below defines an object type that is used to cache the
+ * result of looking up an option name. If an object has this type, then
+ * its internalPtr1 field points to the OptionTable in which it was looked up,
+ * and the internalPtr2 field points to the entry that matched.
+ */
+
+Tcl_ObjType tkOptionObjType = {
+ "option", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ SetOptionFromAny /* setFromAnyProc */
+};
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateOptionTable --
+ *
+ * Given a template for configuration options, this procedure
+ * creates a table that may be used to look up options efficiently.
+ *
+ * Results:
+ * Returns a token to a structure that can be passed to procedures
+ * such as Tk_InitOptions, Tk_SetOptions, and Tk_FreeConfigOptions.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_OptionTable
+Tk_CreateOptionTable(interp, templatePtr)
+ Tcl_Interp *interp; /* Interpreter associated with the
+ * application in which this table
+ * will be used. */
+ CONST Tk_OptionSpec *templatePtr; /* Static information about the
+ * configuration options. */
+{
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hashEntryPtr;
+ int newEntry;
+ OptionTable *tablePtr;
+ CONST Tk_OptionSpec *specPtr, *specPtr2;
+ Option *optionPtr;
+ int numOptions, i;
+
+ /*
+ * We use an AssocData value in the interpreter to keep a hash
+ * table of all the option tables we've created for this application.
+ * This is used for two purposes. First, it allows us to share the
+ * tables (e.g. in several chains) and second, we use the deletion
+ * callback for the AssocData to delete all the option tables when
+ * the interpreter is deleted. The code below finds the hash table
+ * or creates a new one if it doesn't already exist.
+ */
+
+ hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY,
+ NULL);
+ if (hashTablePtr == NULL) {
+ hashTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(hashTablePtr, TCL_ONE_WORD_KEYS);
+ Tcl_SetAssocData(interp, OPTION_HASH_KEY, DestroyOptionHashTable,
+ (ClientData) hashTablePtr);
+ }
+
+ /*
+ * See if a table has already been created for this template. If
+ * so, just reuse the existing table.
+ */
+
+ hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr,
+ &newEntry);
+ if (!newEntry) {
+ tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr);
+ tablePtr->refCount++;
+ return (Tk_OptionTable) tablePtr;
+ }
+
+ /*
+ * Count the number of options in the template, then create the
+ * table structure.
+ */
+
+ numOptions = 0;
+ for (specPtr = templatePtr; specPtr->type != TK_OPTION_END; specPtr++) {
+ numOptions++;
+ }
+ tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable)
+ + ((numOptions - 1) * sizeof(Option))));
+ tablePtr->refCount = 1;
+ tablePtr->hashEntryPtr = hashEntryPtr;
+ tablePtr->nextPtr = NULL;
+ tablePtr->numOptions = numOptions;
+
+ /*
+ * Initialize all of the Option structures in the table.
+ */
+
+ for (specPtr = templatePtr, optionPtr = tablePtr->options;
+ specPtr->type != TK_OPTION_END; specPtr++, optionPtr++) {
+ optionPtr->specPtr = specPtr;
+ optionPtr->dbNameUID = NULL;
+ optionPtr->dbClassUID = NULL;
+ optionPtr->defaultPtr = NULL;
+ optionPtr->extra.monoColorPtr = NULL;
+ optionPtr->flags = 0;
+
+ if (specPtr->type == TK_OPTION_SYNONYM) {
+ /*
+ * This is a synonym option; find the master option that it
+ * refers to and create a pointer from the synonym to the
+ * master.
+ */
+
+ for (specPtr2 = templatePtr, i = 0; ; specPtr2++, i++) {
+ if (specPtr2->type == TK_OPTION_END) {
+ panic("Tk_CreateOptionTable couldn't find synonym");
+ }
+ if (strcmp(specPtr2->optionName,
+ (char *) specPtr->clientData) == 0) {
+ optionPtr->extra.synonymPtr = tablePtr->options + i;
+ break;
+ }
+ }
+ } else {
+ if (specPtr->dbName != NULL) {
+ optionPtr->dbNameUID = Tk_GetUid(specPtr->dbName);
+ }
+ if (specPtr->dbClass != NULL) {
+ optionPtr->dbClassUID =
+ Tk_GetUid(specPtr->dbClass);
+ }
+ if (specPtr->defValue != NULL) {
+ optionPtr->defaultPtr =
+ Tcl_NewStringObj(specPtr->defValue, -1);
+ Tcl_IncrRefCount(optionPtr->defaultPtr);
+ }
+ if (((specPtr->type == TK_OPTION_COLOR)
+ || (specPtr->type == TK_OPTION_BORDER))
+ && (specPtr->clientData != NULL)) {
+ optionPtr->extra.monoColorPtr =
+ Tcl_NewStringObj((char *) specPtr->clientData, -1);
+ Tcl_IncrRefCount(optionPtr->extra.monoColorPtr);
+ }
+
+ if (specPtr->type == TK_OPTION_CUSTOM) {
+ /*
+ * Get the custom parsing, etc., functions.
+ */
+ optionPtr->extra.custom =
+ (Tk_ObjCustomOption *)specPtr->clientData;
+ }
+ }
+ if (((specPtr->type == TK_OPTION_STRING)
+ && (specPtr->internalOffset >= 0))
+ || (specPtr->type == TK_OPTION_COLOR)
+ || (specPtr->type == TK_OPTION_FONT)
+ || (specPtr->type == TK_OPTION_BITMAP)
+ || (specPtr->type == TK_OPTION_BORDER)
+ || (specPtr->type == TK_OPTION_CURSOR)
+ || (specPtr->type == TK_OPTION_CUSTOM)) {
+ optionPtr->flags |= OPTION_NEEDS_FREEING;
+ }
+ }
+ tablePtr->hashEntryPtr = hashEntryPtr;
+ Tcl_SetHashValue(hashEntryPtr, tablePtr);
+
+ /*
+ * Finally, check to see if this template chains to another template
+ * with additional options. If so, call ourselves recursively to
+ * create the next table(s).
+ */
+
+ if (specPtr->clientData != NULL) {
+ tablePtr->nextPtr = (OptionTable *) Tk_CreateOptionTable(interp,
+ (Tk_OptionSpec *) specPtr->clientData);
+ }
+
+ return (Tk_OptionTable) tablePtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteOptionTable --
+ *
+ * Called to release resources used by an option table when
+ * the table is no longer needed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option table and associated resources (such as additional
+ * option tables chained off it) are destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteOptionTable(optionTable)
+ Tk_OptionTable optionTable; /* The option table to delete. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+
+ tablePtr->refCount--;
+ if (tablePtr->refCount > 0) {
+ return;
+ }
+
+ if (tablePtr->nextPtr != NULL) {
+ Tk_DeleteOptionTable((Tk_OptionTable) tablePtr->nextPtr);
+ }
+
+ for (count = tablePtr->numOptions - 1, optionPtr = tablePtr->options;
+ count > 0; count--, optionPtr++) {
+ if (optionPtr->defaultPtr != NULL) {
+ Tcl_DecrRefCount(optionPtr->defaultPtr);
+ }
+ if (((optionPtr->specPtr->type == TK_OPTION_COLOR)
+ || (optionPtr->specPtr->type == TK_OPTION_BORDER))
+ && (optionPtr->extra.monoColorPtr != NULL)) {
+ Tcl_DecrRefCount(optionPtr->extra.monoColorPtr);
+ }
+ }
+ Tcl_DeleteHashEntry(tablePtr->hashEntryPtr);
+ ckfree((char *) tablePtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyOptionHashTable --
+ *
+ * This procedure is the deletion callback associated with the
+ * AssocData entry created by Tk_CreateOptionTable. It is
+ * invoked when an interpreter is deleted, and deletes all of
+ * the option tables associated with that interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option hash table is destroyed along with all of the
+ * OptionTable structures that it refers to.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyOptionHashTable(clientData, interp)
+ ClientData clientData; /* The hash table we are destroying */
+ Tcl_Interp *interp; /* The interpreter we are destroying */
+{
+ Tcl_HashTable *hashTablePtr = (Tcl_HashTable *) clientData;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hashEntryPtr;
+ OptionTable *tablePtr;
+
+ for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
+ hashEntryPtr != NULL;
+ hashEntryPtr = Tcl_NextHashEntry(&search)) {
+ tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr);
+
+ /*
+ * The following statements do two tricky things:
+ * 1. They ensure that the option table is deleted, even if
+ * there are outstanding references to it.
+ * 2. They ensure that Tk_DeleteOptionTable doesn't delete
+ * other tables chained from this one; we'll do it when
+ * we come across the hash table entry for the chained
+ * table (in fact, the chained table may already have
+ * been deleted).
+ */
+
+ tablePtr->refCount = 1;
+ tablePtr->nextPtr = NULL;
+ Tk_DeleteOptionTable((Tk_OptionTable) tablePtr);
+ }
+ Tcl_DeleteHashTable(hashTablePtr);
+ ckfree((char *) hashTablePtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_InitOptions --
+ *
+ * This procedure is invoked when an object such as a widget
+ * is created. It supplies an initial value for each configuration
+ * option (the value may come from the option database, a system
+ * default, or the default in the option table).
+ *
+ * Results:
+ * The return value is TCL_OK if the procedure completed
+ * successfully, and TCL_ERROR if one of the initial values was
+ * bogus. If an error occurs and interp isn't NULL, then an
+ * error message will be left in its result.
+ *
+ * Side effects:
+ * Fields of recordPtr are filled in with initial values.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_InitOptions(interp, recordPtr, optionTable, tkwin)
+ Tcl_Interp *interp; /* Interpreter for error reporting. NULL
+ * means don't leave an error message. */
+ char *recordPtr; /* Pointer to the record to configure.
+ * Note: the caller should have properly
+ * initialized the record with NULL
+ * pointers for each option value. */
+ Tk_OptionTable optionTable; /* The token which matches the config
+ * specs for the widget in question. */
+ Tk_Window tkwin; /* Certain options types (such as
+ * TK_OPTION_COLOR) need fields out
+ * of the window they are used in to
+ * be able to calculate their values.
+ * Not needed unless one of these
+ * options is in the configSpecs record. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+ Tk_Uid value;
+ Tcl_Obj *valuePtr;
+ enum {
+ OPTION_DATABASE, SYSTEM_DEFAULT, TABLE_DEFAULT
+ } source;
+
+ /*
+ * If this table chains to other tables, handle their initialization
+ * first. That way, if both tables refer to the same field of the
+ * record, the value in the first table will win.
+ */
+
+ if (tablePtr->nextPtr != NULL) {
+ if (Tk_InitOptions(interp, recordPtr,
+ (Tk_OptionTable) tablePtr->nextPtr, tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Iterate over all of the options in the table, initializing each in
+ * turn.
+ */
+
+ for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
+ count > 0; optionPtr++, count--) {
+
+ /*
+ * If we specify TK_OPTION_DONT_SET_DEFAULT, then the user has
+ * processed and set a default for this already.
+ */
+ if ((optionPtr->specPtr->type == TK_OPTION_SYNONYM) ||
+ (optionPtr->specPtr->flags & TK_OPTION_DONT_SET_DEFAULT)) {
+ continue;
+ }
+ source = TABLE_DEFAULT;
+
+ /*
+ * We look in three places for the initial value, using the first
+ * non-NULL value that we find. First, check the option database.
+ */
+
+ valuePtr = NULL;
+ if (optionPtr->dbNameUID != NULL) {
+ value = Tk_GetOption(tkwin, optionPtr->dbNameUID,
+ optionPtr->dbClassUID);
+ if (value != NULL) {
+ valuePtr = Tcl_NewStringObj(value, -1);
+ source = OPTION_DATABASE;
+ }
+ }
+
+ /*
+ * Second, check for a system-specific default value.
+ */
+ if ((valuePtr == NULL)
+ && (optionPtr->dbNameUID != NULL)) {
+ valuePtr = TkpGetSystemDefault(tkwin, optionPtr->dbNameUID,
+ optionPtr->dbClassUID);
+ if (valuePtr != NULL) {
+ source = SYSTEM_DEFAULT;
+ }
+ }
+
+ /*
+ * Third and last, use the default value supplied by the option
+ * table. In the case of color objects, we pick one of two
+ * values depending on whether the screen is mono or color.
+ */
+
+ if (valuePtr == NULL) {
+ if ((tkwin != NULL)
+ && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
+ || (optionPtr->specPtr->type == TK_OPTION_BORDER))
+ && (Tk_Depth(tkwin) <= 1)
+ && (optionPtr->extra.monoColorPtr != NULL)) {
+ valuePtr = optionPtr->extra.monoColorPtr;
+ } else {
+ valuePtr = optionPtr->defaultPtr;
+ }
+ }
+
+ if (valuePtr == NULL) {
+ continue;
+ }
+
+ /*
+ * Bump the reference count on valuePtr, so that it is strongly
+ * referenced here, and will be properly free'd when finished,
+ * regardless of what DoObjConfig does.
+ */
+ Tcl_IncrRefCount(valuePtr);
+
+ if (DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin,
+ (Tk_SavedOption *) NULL) != TCL_OK) {
+ if (interp != NULL) {
+ char msg[200];
+
+ switch (source) {
+ case OPTION_DATABASE:
+ sprintf(msg, "\n (database entry for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ break;
+ case SYSTEM_DEFAULT:
+ sprintf(msg, "\n (system default for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ break;
+ case TABLE_DEFAULT:
+ sprintf(msg, "\n (default value for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ }
+ if (tkwin != NULL) {
+ sprintf(msg + strlen(msg) - 1, " in widget \"%.50s\")",
+ Tk_PathName(tkwin));
+ }
+ Tcl_AddErrorInfo(interp, msg);
+ }
+ Tcl_DecrRefCount(valuePtr);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(valuePtr);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DoObjConfig --
+ *
+ * This procedure applies a new value for a configuration option
+ * to the record being configured.
+ *
+ * Results:
+ * The return value is TCL_OK if the procedure completed
+ * successfully. If an error occurred then TCL_ERROR is
+ * returned and an error message is left in interp's result, if
+ * interp isn't NULL. In addition, if oldValuePtrPtr isn't
+ * NULL then it *oldValuePtrPtr is filled in with a pointer
+ * to the option's old value.
+ *
+ * Side effects:
+ * RecordPtr gets modified to hold the new value in the form of
+ * a Tcl_Obj, an internal representation, or both. The old
+ * value is freed if oldValuePtrPtr is NULL.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin, savedOptionPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. If
+ * NULL, then no message is left if an error
+ * occurs. */
+ char *recordPtr; /* The record to modify to hold the new
+ * option value. */
+ Option *optionPtr; /* Pointer to information about the
+ * option. */
+ Tcl_Obj *valuePtr; /* New value for option. */
+ Tk_Window tkwin; /* Window in which option will be used (needed
+ * to allocate resources for some options).
+ * May be NULL if the option doesn't
+ * require window-related resources. */
+ Tk_SavedOption *savedOptionPtr;
+ /* If NULL, the old value for the option will
+ * be freed. If non-NULL, the old value will
+ * be stored here, and it becomes the property
+ * of the caller (the caller must eventually
+ * free the old value). */
+{
+ Tcl_Obj **slotPtrPtr, *oldPtr;
+ char *internalPtr; /* Points to location in record where
+ * internal representation of value should
+ * be stored, or NULL. */
+ char *oldInternalPtr; /* Points to location in which to save old
+ * internal representation of value. */
+ Tk_SavedOption internal; /* Used to save the old internal representation
+ * of the value if savedOptionPtr is NULL. */
+ CONST Tk_OptionSpec *specPtr;
+ int nullOK;
+
+ /*
+ * Save the old object form for the value, if there is one.
+ */
+
+ specPtr = optionPtr->specPtr;
+ if (specPtr->objOffset >= 0) {
+ slotPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
+ oldPtr = *slotPtrPtr;
+ } else {
+ slotPtrPtr = NULL;
+ oldPtr = NULL;
+ }
+
+ /*
+ * Apply the new value in a type-specific way. Also remember the
+ * old object and internal forms, if they exist.
+ */
+
+ if (specPtr->internalOffset >= 0) {
+ internalPtr = recordPtr + specPtr->internalOffset;
+ } else {
+ internalPtr = NULL;
+ }
+ if (savedOptionPtr != NULL) {
+ savedOptionPtr->optionPtr = optionPtr;
+ savedOptionPtr->valuePtr = oldPtr;
+ oldInternalPtr = (char *) &savedOptionPtr->internalForm;
+ } else {
+ oldInternalPtr = (char *) &internal.internalForm;
+ }
+ nullOK = (optionPtr->specPtr->flags & TK_OPTION_NULL_OK);
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_BOOLEAN: {
+ int new;
+
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &new)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_INT: {
+ int new;
+
+ if (Tcl_GetIntFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_DOUBLE: {
+ double new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = 0;
+ } else {
+ if (Tcl_GetDoubleFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (internalPtr != NULL) {
+ *((double *) oldInternalPtr) = *((double *) internalPtr);
+ *((double *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_STRING: {
+ char *new, *value;
+ int length;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ }
+ if (internalPtr != NULL) {
+ if (valuePtr != NULL) {
+ value = Tcl_GetStringFromObj(valuePtr, &length);
+ new = ckalloc((unsigned) (length + 1));
+ strcpy(new, value);
+ } else {
+ new = NULL;
+ }
+ *((char **) oldInternalPtr) = *((char **) internalPtr);
+ *((char **) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_STRING_TABLE: {
+ int new;
+
+ if (Tcl_GetIndexFromObj(interp, valuePtr,
+ (CONST char **) optionPtr->specPtr->clientData,
+ optionPtr->specPtr->optionName+1, 0, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_COLOR: {
+ XColor *newPtr;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newPtr = NULL;
+ } else {
+ newPtr = Tk_AllocColorFromObj(interp, tkwin, valuePtr);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((XColor **) oldInternalPtr) = *((XColor **) internalPtr);
+ *((XColor **) internalPtr) = newPtr;
+ }
+ break;
+ }
+ case TK_OPTION_FONT: {
+ Tk_Font new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = NULL;
+ } else {
+ new = Tk_AllocFontFromObj(interp, tkwin, valuePtr);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Font *) oldInternalPtr) = *((Tk_Font *) internalPtr);
+ *((Tk_Font *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_STYLE: {
+ Tk_Style new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = NULL;
+ } else {
+ new = Tk_AllocStyleFromObj(interp, valuePtr);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Style *) oldInternalPtr) = *((Tk_Style *) internalPtr);
+ *((Tk_Style *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ Pixmap new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = None;
+ } else {
+ new = Tk_AllocBitmapFromObj(interp, tkwin, valuePtr);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Pixmap *) oldInternalPtr) = *((Pixmap *) internalPtr);
+ *((Pixmap *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ Tk_3DBorder new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = NULL;
+ } else {
+ new = Tk_Alloc3DBorderFromObj(interp, tkwin, valuePtr);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_3DBorder *) oldInternalPtr) =
+ *((Tk_3DBorder *) internalPtr);
+ *((Tk_3DBorder *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_RELIEF: {
+ int new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = TK_RELIEF_NULL;
+ } else {
+ if (Tk_GetReliefFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_CURSOR: {
+ Tk_Cursor new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ new = None;
+ valuePtr = NULL;
+ } else {
+ new = Tk_AllocCursorFromObj(interp, tkwin, valuePtr);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Cursor *) oldInternalPtr) = *((Tk_Cursor *) internalPtr);
+ *((Tk_Cursor *) internalPtr) = new;
+ }
+ Tk_DefineCursor(tkwin, new);
+ break;
+ }
+ case TK_OPTION_JUSTIFY: {
+ Tk_Justify new;
+
+ if (Tk_GetJustifyFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Justify *) oldInternalPtr)
+ = *((Tk_Justify *) internalPtr);
+ *((Tk_Justify *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_ANCHOR: {
+ Tk_Anchor new;
+
+ if (Tk_GetAnchorFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Anchor *) oldInternalPtr)
+ = *((Tk_Anchor *) internalPtr);
+ *((Tk_Anchor *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_PIXELS: {
+ int new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = 0;
+ } else {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
+ &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ Tk_Window new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = None;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, valuePtr, &new)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Window *) oldInternalPtr) = *((Tk_Window *) internalPtr);
+ *((Tk_Window *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_CUSTOM: {
+ Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ if (custom->setProc(custom->clientData, interp, tkwin,
+ &valuePtr, recordPtr, optionPtr->specPtr->internalOffset,
+ (char *)oldInternalPtr,
+ optionPtr->specPtr->flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+
+ default: {
+ char buf[40+TCL_INTEGER_SPACE];
+ sprintf(buf, "bad config table: unknown type %d",
+ optionPtr->specPtr->type);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Release resources associated with the old value, if we're not
+ * returning it to the caller, then install the new object value into
+ * the record.
+ */
+
+ if (savedOptionPtr == NULL) {
+ if (optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
+ }
+ if (oldPtr != NULL) {
+ Tcl_DecrRefCount(oldPtr);
+ }
+ }
+ if (slotPtrPtr != NULL) {
+ *slotPtrPtr = valuePtr;
+ if (valuePtr != NULL) {
+ Tcl_IncrRefCount(valuePtr);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ObjectIsEmpty --
+ *
+ * This procedure tests whether the string value of an object is
+ * empty.
+ *
+ * Results:
+ * The return value is 1 if the string value of objPtr has length
+ * zero, and 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ObjectIsEmpty(objPtr)
+ Tcl_Obj *objPtr; /* Object to test. May be NULL. */
+{
+ int length;
+
+ if (objPtr == NULL) {
+ return 1;
+ }
+ if (objPtr->bytes != NULL) {
+ return (objPtr->length == 0);
+ }
+ Tcl_GetStringFromObj(objPtr, &length);
+ return (length == 0);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOption --
+ *
+ * This procedure searches through a chained option table to find
+ * the entry for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry, or NULL
+ * if no matching entry could be found.
+ * Note: if the matching entry is a synonym then this procedure
+ * returns a pointer to the synonym entry, *not* the "real" entry
+ * that the synonym refers to.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Option *
+GetOption(name, tablePtr)
+ CONST char *name; /* String balue to be looked up in the
+ * option table. */
+ OptionTable *tablePtr; /* Table in which to look up name. */
+{
+ Option *bestPtr, *optionPtr;
+ OptionTable *tablePtr2;
+ CONST char *p1, *p2;
+ int count;
+
+ /*
+ * Search through all of the option tables in the chain to find the
+ * best match. Some tricky aspects:
+ *
+ * 1. We have to accept unique abbreviations.
+ * 2. The same name could appear in different tables in the chain.
+ * If this happens, we use the entry from the first table. We
+ * have to be careful to distinguish this case from an ambiguous
+ * abbreviation.
+ */
+
+ bestPtr = NULL;
+ for (tablePtr2 = tablePtr; tablePtr2 != NULL;
+ tablePtr2 = tablePtr2->nextPtr) {
+ for (optionPtr = tablePtr2->options, count = tablePtr2->numOptions;
+ count > 0; optionPtr++, count--) {
+ for (p1 = name, p2 = optionPtr->specPtr->optionName;
+ *p1 == *p2; p1++, p2++) {
+ if (*p1 == 0) {
+ /*
+ * This is an exact match. We're done.
+ */
+
+ bestPtr = optionPtr;
+ goto done;
+ }
+ }
+ if (*p1 == 0) {
+ /*
+ * The name is an abbreviation for this option. Keep
+ * to make sure that the abbreviation only matches one
+ * option name. If we've already found a match in the
+ * past, then it is an error unless the full names for
+ * the two options are identical; in this case, the first
+ * option overrides the second.
+ */
+
+ if (bestPtr == NULL) {
+ bestPtr = optionPtr;
+ } else {
+ if (strcmp(bestPtr->specPtr->optionName,
+ optionPtr->specPtr->optionName) != 0) {
+ goto error;
+ }
+ }
+ }
+ }
+ }
+
+ done:
+ return bestPtr;
+
+ error:
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOptionFromObj --
+ *
+ * This procedure searches through a chained option table to find
+ * the entry for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry, or NULL
+ * if no matching entry could be found. If NULL is returned and
+ * interp is not NULL than an error message is left in its result.
+ * Note: if the matching entry is a synonym then this procedure
+ * returns a pointer to the synonym entry, *not* the "real" entry
+ * that the synonym refers to.
+ *
+ * Side effects:
+ * Information about the matching entry is cached in the object
+ * containing the name, so that future lookups can proceed more
+ * quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Option *
+GetOptionFromObj(interp, objPtr, tablePtr)
+ Tcl_Interp *interp; /* Used only for error reporting; if NULL
+ * no message is left after an error. */
+ Tcl_Obj *objPtr; /* Object whose string value is to be
+ * looked up in the option table. */
+ OptionTable *tablePtr; /* Table in which to look up objPtr. */
+{
+ Option *bestPtr;
+ char *name;
+
+ /*
+ * First, check to see if the object already has the answer cached.
+ */
+
+ if (objPtr->typePtr == &tkOptionObjType) {
+ if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) {
+ return (Option *) objPtr->internalRep.twoPtrValue.ptr2;
+ }
+ }
+
+ /*
+ * The answer isn't cached.
+ */
+
+ name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+ bestPtr = GetOption(name, tablePtr);
+ if (bestPtr == NULL) {
+ goto error;
+ }
+
+ if ((objPtr->typePtr != NULL)
+ && (objPtr->typePtr->freeIntRepProc != NULL)) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) bestPtr;
+ objPtr->typePtr = &tkOptionObjType;
+ return bestPtr;
+
+ error:
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "unknown option \"", name,
+ "\"", (char *) NULL);
+ }
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetOptionSpec --
+ *
+ * This procedure searches through a chained option table to find
+ * the option spec for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the option spec of the matching
+ * entry, or NULL if no matching entry could be found.
+ * Note: if the matching entry is a synonym then this procedure
+ * returns a pointer to the option spec of the synonym entry, *not*
+ * the "real" entry that the synonym refers to.
+ * Note: this call is primarily used by the style management code
+ * (tkStyle.c) to look up an element's option spec into a widget's
+ * option table.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST Tk_OptionSpec *
+TkGetOptionSpec(name, optionTable)
+ CONST char *name; /* String value to be looked up. */
+ Tk_OptionTable optionTable; /* Table in which to look up name. */
+{
+ Option *optionPtr;
+
+ optionPtr = GetOption(name, (OptionTable *) optionTable);
+ if (optionPtr == NULL) {
+ return NULL;
+ }
+ return optionPtr->specPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetOptionFromAny --
+ *
+ * This procedure is called to convert a Tcl object to option
+ * internal form. However, this doesn't make sense (need to have a
+ * table of options in order to do the conversion) so the
+ * procedure always generates an error.
+ *
+ * Results:
+ * The return value is always TCL_ERROR, and an error message is
+ * left in interp's result if interp isn't NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetOptionFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "can't convert value to option except via GetOptionFromObj API",
+ -1);
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SetOptions --
+ *
+ * Process one or more name-value pairs for configuration options
+ * and fill in fields of a record with new values.
+ *
+ * Results:
+ * If all goes well then TCL_OK is returned and the old values of
+ * any modified objects are saved in *savePtr, if it isn't NULL (the
+ * caller must eventually call Tk_RestoreSavedOptions or
+ * Tk_FreeSavedOptions to free the contents of *savePtr). In
+ * addition, if maskPtr isn't NULL then *maskPtr is filled in with
+ * the OR of the typeMask bits from all modified options. If an
+ * error occurs then TCL_ERROR is returned and a message
+ * is left in interp's result unless interp is NULL; nothing is
+ * saved in *savePtr or *maskPtr in this case.
+ *
+ * Side effects:
+ * The fields of recordPtr get filled in with object pointers
+ * from objc/objv. Old information in widgRec's fields gets
+ * recycled. Information may be left at *savePtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SetOptions(interp, recordPtr, optionTable, objc, objv, tkwin, savePtr,
+ maskPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting.
+ * If NULL, then no error message is
+ * returned.*/
+ char *recordPtr; /* The record to configure. */
+ Tk_OptionTable optionTable; /* Describes valid options. */
+ int objc; /* The number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Contains one or more name-value
+ * pairs. */
+ Tk_Window tkwin; /* Window associated with the thing
+ * being configured; needed for some
+ * options (such as colors). */
+ Tk_SavedOptions *savePtr; /* If non-NULL, the old values of
+ * modified options are saved here
+ * so that they can be restored
+ * after an error. */
+ int *maskPtr; /* It non-NULL, this word is modified
+ * on a successful return to hold the
+ * bit-wise OR of the typeMask fields
+ * of all options that were modified
+ * by this call. Used by the caller
+ * to figure out which options
+ * actually changed. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ Tk_SavedOptions *lastSavePtr, *newSavePtr;
+ int mask;
+
+ if (savePtr != NULL) {
+ savePtr->recordPtr = recordPtr;
+ savePtr->tkwin = tkwin;
+ savePtr->numItems = 0;
+ savePtr->nextPtr = NULL;
+ }
+ lastSavePtr = savePtr;
+
+ /*
+ * Scan through all of the arguments, processing those
+ * that match entries in the option table.
+ */
+
+ mask = 0;
+ for ( ; objc > 0; objc -= 2, objv += 2) {
+ optionPtr = GetOptionFromObj(interp, objv[0], tablePtr);
+ if (optionPtr == NULL) {
+ goto error;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+
+ if (objc < 2) {
+ if (interp != NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "value for \"", Tcl_GetStringFromObj(*objv, NULL),
+ "\" missing", (char *) NULL);
+ goto error;
+ }
+ }
+ if ((savePtr != NULL)
+ && (lastSavePtr->numItems >= TK_NUM_SAVED_OPTIONS)) {
+ /*
+ * We've run out of space for saving old option values. Allocate
+ * more space.
+ */
+
+ newSavePtr = (Tk_SavedOptions *) ckalloc(sizeof(
+ Tk_SavedOptions));
+ newSavePtr->recordPtr = recordPtr;
+ newSavePtr->tkwin = tkwin;
+ newSavePtr->numItems = 0;
+ newSavePtr->nextPtr = NULL;
+ lastSavePtr->nextPtr = newSavePtr;
+ lastSavePtr = newSavePtr;
+ }
+ if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin,
+ (savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems]
+ : (Tk_SavedOption *) NULL) != TCL_OK) {
+ char msg[100];
+
+ sprintf(msg, "\n (processing \"%.40s\" option)",
+ Tcl_GetStringFromObj(*objv, NULL));
+ Tcl_AddErrorInfo(interp, msg);
+ goto error;
+ }
+ if (savePtr != NULL) {
+ lastSavePtr->numItems++;
+ }
+ mask |= optionPtr->specPtr->typeMask;
+ }
+ if (maskPtr != NULL) {
+ *maskPtr = mask;
+ }
+ return TCL_OK;
+
+ error:
+ if (savePtr != NULL) {
+ Tk_RestoreSavedOptions(savePtr);
+ }
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestoreSavedOptions --
+ *
+ * This procedure undoes the effect of a previous call to
+ * Tk_SetOptions by restoring all of the options to their value
+ * before the call to Tk_SetOptions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The configutation record is restored and all the information
+ * stored in savePtr is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_RestoreSavedOptions(savePtr)
+ Tk_SavedOptions *savePtr; /* Holds saved option information; must
+ * have been passed to Tk_SetOptions. */
+{
+ int i;
+ Option *optionPtr;
+ Tcl_Obj *newPtr; /* New object value of option, which we
+ * replace with old value and free. Taken
+ * from record. */
+ char *internalPtr; /* Points to internal value of option in
+ * record. */
+ CONST Tk_OptionSpec *specPtr;
+
+ /*
+ * Be sure to restore the options in the opposite order they were
+ * set. This is important because it's possible that the same
+ * option name was used twice in a single call to Tk_SetOptions.
+ */
+
+ if (savePtr->nextPtr != NULL) {
+ Tk_RestoreSavedOptions(savePtr->nextPtr);
+ ckfree((char *) savePtr->nextPtr);
+ savePtr->nextPtr = NULL;
+ }
+ for (i = savePtr->numItems - 1; i >= 0; i--) {
+ optionPtr = savePtr->items[i].optionPtr;
+ specPtr = optionPtr->specPtr;
+
+ /*
+ * First free the new value of the option, which is currently
+ * in the record.
+ */
+
+ if (specPtr->objOffset >= 0) {
+ newPtr = *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset));
+ } else {
+ newPtr = NULL;
+ }
+ if (specPtr->internalOffset >= 0) {
+ internalPtr = savePtr->recordPtr + specPtr->internalOffset;
+ } else {
+ internalPtr = NULL;
+ }
+ if (optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(optionPtr, newPtr, internalPtr, savePtr->tkwin);
+ }
+ if (newPtr != NULL) {
+ Tcl_DecrRefCount(newPtr);
+ }
+
+ /*
+ * Now restore the old value of the option.
+ */
+
+ if (specPtr->objOffset >= 0) {
+ *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset))
+ = savePtr->items[i].valuePtr;
+ }
+ if (specPtr->internalOffset >= 0) {
+ switch (specPtr->type) {
+ case TK_OPTION_BOOLEAN: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_INT: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_DOUBLE: {
+ *((double *) internalPtr)
+ = *((double *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_STRING: {
+ *((char **) internalPtr)
+ = *((char **) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_STRING_TABLE: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_COLOR: {
+ *((XColor **) internalPtr)
+ = *((XColor **) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_FONT: {
+ *((Tk_Font *) internalPtr)
+ = *((Tk_Font *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_STYLE: {
+ *((Tk_Style *) internalPtr)
+ = *((Tk_Style *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ *((Pixmap *) internalPtr)
+ = *((Pixmap *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ *((Tk_3DBorder *) internalPtr)
+ = *((Tk_3DBorder *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_RELIEF: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_CURSOR: {
+ *((Tk_Cursor *) internalPtr)
+ = *((Tk_Cursor *) &savePtr->items[i].internalForm);
+ Tk_DefineCursor(savePtr->tkwin,
+ *((Tk_Cursor *) internalPtr));
+ break;
+ }
+ case TK_OPTION_JUSTIFY: {
+ *((Tk_Justify *) internalPtr)
+ = *((Tk_Justify *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_ANCHOR: {
+ *((Tk_Anchor *) internalPtr)
+ = *((Tk_Anchor *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_PIXELS: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ *((Tk_Window *) internalPtr)
+ = *((Tk_Window *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_CUSTOM: {
+ Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ if (custom->restoreProc != NULL) {
+ custom->restoreProc(custom->clientData, savePtr->tkwin,
+ internalPtr,
+ (char *)&savePtr->items[i].internalForm);
+ }
+ break;
+ }
+ default: {
+ panic("bad option type in Tk_RestoreSavedOptions");
+ }
+ }
+ }
+ }
+ savePtr->numItems = 0;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FreeSavedOptions --
+ *
+ * Free all of the saved configuration option values from a
+ * previous call to Tk_SetOptions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage and system resources are freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_FreeSavedOptions(savePtr)
+ Tk_SavedOptions *savePtr; /* Contains options saved in a previous
+ * call to Tk_SetOptions. */
+{
+ int count;
+ Tk_SavedOption *savedOptionPtr;
+
+ if (savePtr->nextPtr != NULL) {
+ Tk_FreeSavedOptions(savePtr->nextPtr);
+ ckfree((char *) savePtr->nextPtr);
+ }
+ for (count = savePtr->numItems,
+ savedOptionPtr = &savePtr->items[savePtr->numItems-1];
+ count > 0; count--, savedOptionPtr--) {
+ if (savedOptionPtr->optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(savedOptionPtr->optionPtr, savedOptionPtr->valuePtr,
+ (char *) &savedOptionPtr->internalForm, savePtr->tkwin);
+ }
+ if (savedOptionPtr->valuePtr != NULL) {
+ Tcl_DecrRefCount(savedOptionPtr->valuePtr);
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeConfigOptions --
+ *
+ * Free all resources associated with configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All of the Tcl_Obj's in recordPtr that are controlled by
+ * configuration options in optionTable are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+Tk_FreeConfigOptions(recordPtr, optionTable, tkwin)
+ char *recordPtr; /* Record whose fields contain current
+ * values for options. */
+ Tk_OptionTable optionTable; /* Describes legal options. */
+ Tk_Window tkwin; /* Window associated with recordPtr; needed
+ * for freeing some options. */
+{
+ OptionTable *tablePtr;
+ Option *optionPtr;
+ int count;
+ Tcl_Obj **oldPtrPtr, *oldPtr;
+ char *oldInternalPtr;
+ CONST Tk_OptionSpec *specPtr;
+
+ for (tablePtr = (OptionTable *) optionTable; tablePtr != NULL;
+ tablePtr = tablePtr->nextPtr) {
+ for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
+ count > 0; optionPtr++, count--) {
+ specPtr = optionPtr->specPtr;
+ if (specPtr->type == TK_OPTION_SYNONYM) {
+ continue;
+ }
+ if (specPtr->objOffset >= 0) {
+ oldPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
+ oldPtr = *oldPtrPtr;
+ *oldPtrPtr = NULL;
+ } else {
+ oldPtr = NULL;
+ }
+ if (specPtr->internalOffset >= 0) {
+ oldInternalPtr = recordPtr + specPtr->internalOffset;
+ } else {
+ oldInternalPtr = NULL;
+ }
+ if (optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
+ }
+ if (oldPtr != NULL) {
+ Tcl_DecrRefCount(oldPtr);
+ }
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeResources --
+ *
+ * Free system resources associated with a configuration option,
+ * such as colors or fonts.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any system resources associated with objPtr are released. However,
+ * objPtr itself is not freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeResources(optionPtr, objPtr, internalPtr, tkwin)
+ Option *optionPtr; /* Description of the configuration option. */
+ Tcl_Obj *objPtr; /* The current value of the option, specified
+ * as an object. */
+ char *internalPtr; /* A pointer to an internal representation for
+ * the option's value, such as an int or
+ * (XColor *). Only valid if
+ * optionPtr->specPtr->internalOffset >= 0. */
+ Tk_Window tkwin; /* The window in which this option is used. */
+{
+ int internalFormExists;
+
+ /*
+ * If there exists an internal form for the value, use it to free
+ * resources (also zero out the internal form). If there is no
+ * internal form, then use the object form.
+ */
+
+ internalFormExists = optionPtr->specPtr->internalOffset >= 0;
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_STRING:
+ if (internalFormExists) {
+ if (*((char **) internalPtr) != NULL) {
+ ckfree(*((char **) internalPtr));
+ *((char **) internalPtr) = NULL;
+ }
+ }
+ break;
+ case TK_OPTION_COLOR:
+ if (internalFormExists) {
+ if (*((XColor **) internalPtr) != NULL) {
+ Tk_FreeColor(*((XColor **) internalPtr));
+ *((XColor **) internalPtr) = NULL;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeColorFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_FONT:
+ if (internalFormExists) {
+ Tk_FreeFont(*((Tk_Font *) internalPtr));
+ *((Tk_Font *) internalPtr) = NULL;
+ } else if (objPtr != NULL) {
+ Tk_FreeFontFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_STYLE:
+ if (internalFormExists) {
+ Tk_FreeStyle(*((Tk_Style *) internalPtr));
+ *((Tk_Style *) internalPtr) = NULL;
+ } else if (objPtr != NULL) {
+ Tk_FreeStyleFromObj(objPtr);
+ }
+ break;
+ case TK_OPTION_BITMAP:
+ if (internalFormExists) {
+ if (*((Pixmap *) internalPtr) != None) {
+ Tk_FreeBitmap(Tk_Display(tkwin), *((Pixmap *) internalPtr));
+ *((Pixmap *) internalPtr) = None;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeBitmapFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_BORDER:
+ if (internalFormExists) {
+ if (*((Tk_3DBorder *) internalPtr) != NULL) {
+ Tk_Free3DBorder(*((Tk_3DBorder *) internalPtr));
+ *((Tk_3DBorder *) internalPtr) = NULL;
+ }
+ } else if (objPtr != NULL) {
+ Tk_Free3DBorderFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_CURSOR:
+ if (internalFormExists) {
+ if (*((Tk_Cursor *) internalPtr) != None) {
+ Tk_FreeCursor(Tk_Display(tkwin),
+ *((Tk_Cursor *) internalPtr));
+ *((Tk_Cursor *) internalPtr) = None;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeCursorFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_CUSTOM: {
+ Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ if (internalFormExists && custom->freeProc != NULL) {
+ custom->freeProc(custom->clientData, tkwin, internalPtr);
+ }
+ break;
+ }
+ default:
+ break;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetOptionInfo --
+ *
+ * Returns a list object containing complete information about
+ * either a single option or all the configuration options in a
+ * table.
+ *
+ * Results:
+ * This procedure normally returns a pointer to an object.
+ * If namePtr isn't NULL, then the result object is a list with
+ * five elements: the option's name, its database name, database
+ * class, default value, and current value. If the option is a
+ * synonym then the list will contain only two values: the option
+ * name and the name of the option it refers to. If namePtr is
+ * NULL, then information is returned for every option in the
+ * option table: the result will have one sub-list (in the form
+ * described above) for each option in the table. If an error
+ * occurs (e.g. because namePtr isn't valid) then NULL is returned
+ * and an error message will be left in interp's result unless
+ * interp is NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tk_GetOptionInfo(interp, recordPtr, optionTable, namePtr, tkwin)
+ Tcl_Interp *interp; /* Interpreter for error reporting. If
+ * NULL, then no error message is created. */
+ char *recordPtr; /* Record whose fields contain current
+ * values for options. */
+ Tk_OptionTable optionTable; /* Describes all the legal options. */
+ Tcl_Obj *namePtr; /* If non-NULL, the string value selects
+ * a single option whose info is to be
+ * returned. Otherwise info is returned for
+ * all options in optionTable. */
+ Tk_Window tkwin; /* Window associated with recordPtr; needed
+ * to compute correct default value for some
+ * options. */
+{
+ Tcl_Obj *resultPtr;
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+
+ /*
+ * If information is only wanted for a single configuration
+ * spec, then handle that one spec specially.
+ */
+
+ if (namePtr != NULL) {
+ optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
+ if (optionPtr == NULL) {
+ return (Tcl_Obj *) NULL;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+ return GetConfigList(recordPtr, optionPtr, tkwin);
+ }
+
+ /*
+ * Loop through all the specs, creating a big list with all
+ * their information.
+ */
+
+ resultPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ for (; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
+ for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
+ count > 0; optionPtr++, count--) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ GetConfigList(recordPtr, optionPtr, tkwin));
+ }
+ }
+ return resultPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GetConfigList --
+ *
+ * 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 Tcl_Obj *
+GetConfigList(recordPtr, optionPtr, tkwin)
+ char *recordPtr; /* Pointer to record holding current
+ * values of configuration options. */
+ Option *optionPtr; /* Pointer to information describing a
+ * particular option. */
+ Tk_Window tkwin; /* Window corresponding to recordPtr. */
+{
+ Tcl_Obj *listPtr, *elementPtr;
+
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr,
+ Tcl_NewStringObj(optionPtr->specPtr->optionName, -1));
+
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ elementPtr = Tcl_NewStringObj(
+ optionPtr->extra.synonymPtr->specPtr->optionName, -1);
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+ } else {
+ if (optionPtr->dbNameUID == NULL) {
+ elementPtr = Tcl_NewObj();
+ } else {
+ elementPtr = Tcl_NewStringObj(optionPtr->dbNameUID, -1);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+
+ if (optionPtr->dbClassUID == NULL) {
+ elementPtr = Tcl_NewObj();
+ } else {
+ elementPtr = Tcl_NewStringObj(optionPtr->dbClassUID, -1);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+
+ if ((tkwin != NULL) && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
+ || (optionPtr->specPtr->type == TK_OPTION_BORDER))
+ && (Tk_Depth(tkwin) <= 1)
+ && (optionPtr->extra.monoColorPtr != NULL)) {
+ elementPtr = optionPtr->extra.monoColorPtr;
+ } else if (optionPtr->defaultPtr != NULL) {
+ elementPtr = optionPtr->defaultPtr;
+ } else {
+ elementPtr = Tcl_NewObj();
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+
+ if (optionPtr->specPtr->objOffset >= 0) {
+ elementPtr = *((Tcl_Obj **) (recordPtr
+ + optionPtr->specPtr->objOffset));
+ if (elementPtr == NULL) {
+ elementPtr = Tcl_NewObj();
+ }
+ } else {
+ elementPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+ }
+ return listPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetObjectForOption --
+ *
+ * This procedure is called to create an object that contains the
+ * value for an option. It is invoked by GetConfigList and
+ * Tk_GetOptionValue when only the internal form of an option is
+ * stored in the record.
+ *
+ * Results:
+ * The return value is a pointer to a Tcl object. The caller
+ * must call Tcl_IncrRefCount on this object to preserve it.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetObjectForOption(recordPtr, optionPtr, tkwin)
+ char *recordPtr; /* Pointer to record holding current
+ * values of configuration options. */
+ Option *optionPtr; /* Pointer to information describing an
+ * option whose internal value is stored
+ * in *recordPtr. */
+ Tk_Window tkwin; /* Window corresponding to recordPtr. */
+{
+ Tcl_Obj *objPtr;
+ char *internalPtr; /* Points to internal value of option in
+ * record. */
+
+ internalPtr = recordPtr + optionPtr->specPtr->internalOffset;
+ objPtr = NULL;
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_BOOLEAN: {
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ }
+ case TK_OPTION_INT: {
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ }
+ case TK_OPTION_DOUBLE: {
+ objPtr = Tcl_NewDoubleObj(*((double *) internalPtr));
+ break;
+ }
+ case TK_OPTION_STRING: {
+ objPtr = Tcl_NewStringObj(*((char **) internalPtr), -1);
+ break;
+ }
+ case TK_OPTION_STRING_TABLE: {
+ objPtr = Tcl_NewStringObj(
+ ((char **) optionPtr->specPtr->clientData)[
+ *((int *) internalPtr)], -1);
+ break;
+ }
+ case TK_OPTION_COLOR: {
+ XColor *colorPtr = *((XColor **) internalPtr);
+ if (colorPtr != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfColor(colorPtr), -1);
+ }
+ break;
+ }
+ case TK_OPTION_FONT: {
+ Tk_Font tkfont = *((Tk_Font *) internalPtr);
+ if (tkfont != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfFont(tkfont), -1);
+ }
+ break;
+ }
+ case TK_OPTION_STYLE: {
+ Tk_Style style = *((Tk_Style *) internalPtr);
+ if (style != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfStyle(style), -1);
+ }
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ Pixmap pixmap = *((Pixmap *) internalPtr);
+ if (pixmap != None) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfBitmap(Tk_Display(tkwin),
+ pixmap), -1);
+ }
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ Tk_3DBorder border = *((Tk_3DBorder *) internalPtr);
+ if (border != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOf3DBorder(border), -1);
+ }
+ break;
+ }
+ case TK_OPTION_RELIEF: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfRelief(
+ *((int *) internalPtr)), -1);
+ break;
+ }
+ case TK_OPTION_CURSOR: {
+ Tk_Cursor cursor = *((Tk_Cursor *) internalPtr);
+ if (cursor != None) {
+ objPtr = Tcl_NewStringObj(
+ Tk_NameOfCursor(Tk_Display(tkwin), cursor), -1);
+ }
+ break;
+ }
+ case TK_OPTION_JUSTIFY: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfJustify(
+ *((Tk_Justify *) internalPtr)), -1);
+ break;
+ }
+ case TK_OPTION_ANCHOR: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfAnchor(
+ *((Tk_Anchor *) internalPtr)), -1);
+ break;
+ }
+ case TK_OPTION_PIXELS: {
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ Tk_Window tkwin = *((Tk_Window *) internalPtr);
+ if (tkwin != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
+ }
+ break;
+ }
+ case TK_OPTION_CUSTOM: {
+ Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ objPtr = custom->getProc(custom->clientData, tkwin, recordPtr,
+ optionPtr->specPtr->internalOffset);
+ break;
+ }
+ default: {
+ panic("bad option type in GetObjectForOption");
+ }
+ }
+ if (objPtr == NULL) {
+ objPtr = Tcl_NewObj();
+ }
+ return objPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOptionValue --
+ *
+ * This procedure returns the current value of a configuration
+ * option.
+ *
+ * Results:
+ * The return value is the object holding the current value of
+ * the option given by namePtr. If no such option exists, then
+ * the return value is NULL and an error message is left in
+ * interp's result (if interp isn't NULL).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tk_GetOptionValue(interp, recordPtr, optionTable, namePtr, tkwin)
+ Tcl_Interp *interp; /* Interpreter for error reporting. If
+ * NULL then no messages are provided for
+ * errors. */
+ char *recordPtr; /* Record whose fields contain current
+ * values for options. */
+ Tk_OptionTable optionTable; /* Describes legal options. */
+ Tcl_Obj *namePtr; /* Gives the command-line name for the
+ * option whose value is to be returned. */
+ Tk_Window tkwin; /* Window corresponding to recordPtr. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ Tcl_Obj *resultPtr;
+
+ optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
+ if (optionPtr == NULL) {
+ return NULL;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+ if (optionPtr->specPtr->objOffset >= 0) {
+ resultPtr = *((Tcl_Obj **) (recordPtr + optionPtr->specPtr->objOffset));
+ if (resultPtr == NULL) {
+ /*
+ * This option has a null value and is represented by a null
+ * object pointer. We can't return the null pointer, since that
+ * would indicate an error. Instead, return a new empty object.
+ */
+
+ resultPtr = Tcl_NewObj();
+ }
+ } else {
+ resultPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
+ }
+ return resultPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugConfig --
+ *
+ * This is a debugging procedure that returns information about
+ * one of the configuration tables that currently exists for an
+ * interpreter.
+ *
+ * Results:
+ * If the specified table exists in the given interpreter, then a
+ * list is returned describing the table and any other tables that
+ * it chains to: for each table there will be three list elements
+ * giving the reference count for the table, the number of elements
+ * in the table, and the command-line name for the first option
+ * in the table. If the table doesn't exist in the interpreter
+ * then an empty object is returned. The reference count for the
+ * returned object is 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugConfig(interp, table)
+ Tcl_Interp *interp; /* Interpreter in which the table is
+ * defined. */
+ Tk_OptionTable table; /* Table about which information is to
+ * be returned. May not necessarily
+ * exist in the interpreter anymore. */
+{
+ OptionTable *tablePtr = (OptionTable *) table;
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hashEntryPtr;
+ Tcl_HashSearch search;
+ Tcl_Obj *objPtr;
+
+ objPtr = Tcl_NewObj();
+ hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY,
+ NULL);
+ if (hashTablePtr == NULL) {
+ return objPtr;
+ }
+
+ /*
+ * Scan all the tables for this interpreter to make sure that the
+ * one we want still is valid.
+ */
+
+ for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
+ hashEntryPtr != NULL;
+ hashEntryPtr = Tcl_NextHashEntry(&search)) {
+ if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) {
+ for ( ; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewIntObj(tablePtr->refCount));
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewIntObj(tablePtr->numOptions));
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewStringObj(
+ tablePtr->options[0].specPtr->optionName,
+ -1));
+ }
+ break;
+ }
+ }
+ return objPtr;
+}
--- /dev/null
+/*
+ * tkConsole.c --
+ *
+ * This file implements a Tcl console for systems that may not
+ * otherwise have access to a console. It uses the Text widget
+ * and provides special access via a console command.
+ *
+ * Copyright (c) 1995-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$
+ */
+
+#include "tk.h"
+#include <string.h>
+
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type holds information for each console
+ * which a handler (i.e. a Tcl command) has been defined for a particular
+ * top-level window.
+ */
+
+typedef struct ConsoleInfo {
+ Tcl_Interp *consoleInterp; /* Interpreter for the console. */
+ Tcl_Interp *interp; /* Interpreter to send console commands. */
+} ConsoleInfo;
+
+typedef struct ThreadSpecificData {
+ Tcl_Interp *gStdoutInterp;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+static int consoleInitialized = 0;
+
+/*
+ * The Mutex below is used to lock access to the consoleIntialized flag
+ */
+
+TCL_DECLARE_MUTEX(consoleMutex)
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ *
+ * The first three will be used in the tk app shells...
+ */
+
+static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ CONST char *buf, int toWrite, int *errorCode));
+static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ NULL, /* Always non-blocking.*/
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ ConsoleWatch, /* Watch for events on console. */
+ ConsoleHandle, /* Get a handle from the device. */
+};
+
+\f
+#ifdef __WIN32__
+
+#include <windows.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShouldUseConsoleChannel
+ *
+ * Check to see if console window should be used for a given
+ * standard channel
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates the console channel and installs it as the standard
+ * channels.
+ *
+ *----------------------------------------------------------------------
+ */
+static int ShouldUseConsoleChannel(type)
+ int type;
+{
+ DWORD handleId; /* Standard handle to retrieve. */
+ DCB dcb;
+ DWORD consoleParams;
+ DWORD fileType;
+ int mode;
+ char *bufMode;
+ HANDLE handle;
+
+ switch (type) {
+ case TCL_STDIN:
+ handleId = STD_INPUT_HANDLE;
+ mode = TCL_READABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDOUT:
+ handleId = STD_OUTPUT_HANDLE;
+ mode = TCL_WRITABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDERR:
+ handleId = STD_ERROR_HANDLE;
+ mode = TCL_WRITABLE;
+ bufMode = "none";
+ break;
+ default:
+ return 0;
+ break;
+ }
+
+ handle = GetStdHandle(handleId);
+
+ /*
+ * Note that we need to check for 0 because Windows will return 0 if this
+ * is not a console mode application, even though this is not a valid
+ * handle.
+ */
+
+ if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
+ return 1;
+ }
+
+ /*
+ * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears
+ * to be a valid handle. See TclpGetDefaultStdChannel() for this change
+ * implemented. We didn't change it here because GetFileType() [below]
+ * will catch this with FILE_TYPE_UNKNOWN and appropriately return a
+ * value of 1, anyways.
+ *
+ * char dummyBuff[1];
+ * DWORD dummyWritten;
+ *
+ * if ((type == TCL_STDOUT)
+ * && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
+ * return 1;
+ * }
+ */
+
+ fileType = GetFileType(handle);
+
+ /*
+ * If the file is a character device, we need to try to figure out
+ * whether it is a serial port, a console, or something else. We
+ * test for the console case first because this is more common.
+ */
+
+ if (fileType == FILE_TYPE_CHAR) {
+ dcb.DCBlength = sizeof( DCB ) ;
+ if (!GetConsoleMode(handle, &consoleParams) &&
+ !GetCommState(handle, &dcb)) {
+ /*
+ * Don't use a CHAR type channel for stdio, otherwise Tk
+ * runs into trouble with the MS DevStudio debugger.
+ */
+
+ return 1;
+ }
+ } else if (fileType == FILE_TYPE_UNKNOWN) {
+ return 1;
+ } else if (Tcl_GetStdChannel(type) == NULL) {
+ return 1;
+ }
+
+ return 0;
+}
+#else
+/*
+ * Mac should always use a console channel, Unix should if it's trying to
+ */
+
+#define ShouldUseConsoleChannel(chan) (1)
+#endif
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_InitConsoleChannels --
+ *
+ * Create the console channels and install them as the standard
+ * channels. All I/O will be discarded until TkConsoleInit is
+ * called to attach the console to a text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates the console channel and installs it as the standard
+ * channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_InitConsoleChannels(interp)
+ Tcl_Interp *interp;
+{
+ Tcl_Channel consoleChannel;
+
+ /*
+ * Ensure that we are getting the matching version of Tcl. This is
+ * really only an issue when Tk is loaded dynamically.
+ */
+
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return;
+ }
+
+ Tcl_MutexLock(&consoleMutex);
+ if (!consoleInitialized) {
+
+ consoleInitialized = 1;
+
+ /*
+ * check for STDIN, otherwise create it
+ *
+ * Don't do this check on the Mac, because it is hard to prevent
+ * callbacks from the SIOUX layer from opening stdout & stdin, but
+ * we don't want to use the SIOUX console. Since the console is not
+ * actually created till something is written to the channel, it is
+ * okay to just ignore it here.
+ *
+ * This is still a bit of a hack, however, and should be cleaned up
+ * when we have a better abstraction for the console.
+ */
+
+ if (ShouldUseConsoleChannel(TCL_STDIN)) {
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
+ (ClientData) TCL_STDIN, TCL_READABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-buffering", "none");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
+ }
+
+ /*
+ * check for STDOUT, otherwise create it
+ */
+
+ if (ShouldUseConsoleChannel(TCL_STDOUT)) {
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
+ (ClientData) TCL_STDOUT, TCL_WRITABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-buffering", "none");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
+ }
+
+ /*
+ * check for STDERR, otherwise create it
+ */
+
+ if (ShouldUseConsoleChannel(TCL_STDERR)) {
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
+ (ClientData) TCL_STDERR, TCL_WRITABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-buffering", "none");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
+ }
+ }
+ Tcl_MutexUnlock(&consoleMutex);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateConsoleWindow --
+ *
+ * Initialize the console. This code actually creates a new
+ * application and associated interpreter. This effectivly hides
+ * the implementation from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_CreateConsoleWindow(interp)
+ Tcl_Interp *interp; /* Interpreter to use for prompting. */
+{
+ Tcl_Interp *consoleInterp;
+ ConsoleInfo *info;
+ Tk_Window mainWindow = Tk_MainWindow(interp);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+#ifdef MAC_TCL
+ static char initCmd[] = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
+#else
+ static char initCmd[] = "source $tk_library/console.tcl";
+#endif
+
+ consoleInterp = Tcl_CreateInterp();
+ if (consoleInterp == NULL) {
+ goto error;
+ }
+
+ /*
+ * Initialized Tcl and Tk.
+ */
+
+ if (Tcl_Init(consoleInterp) != TCL_OK) {
+ goto error;
+ }
+ if (Tk_Init(consoleInterp) != TCL_OK) {
+ goto error;
+ }
+ tsdPtr->gStdoutInterp = interp;
+
+ /*
+ * Add console commands to the interp
+ */
+ info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
+ info->interp = interp;
+ info->consoleInterp = consoleInterp;
+ Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
+ (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
+ Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
+ (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
+
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
+ (ClientData) info);
+
+ Tcl_Preserve((ClientData) consoleInterp);
+ if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
+ /* goto error; -- no problem for now... */
+ printf("Eval error: %s", consoleInterp->result);
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return TCL_OK;
+
+ error:
+ if (consoleInterp != NULL) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleOutput(instanceData, buf, toWrite, errorCode)
+ ClientData instanceData; /* Indicates which device to use. */
+ CONST char *buf; /* The data buffer. */
+ int toWrite; /* How many bytes to write? */
+ int *errorCode; /* Where to store error code. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ *errorCode = 0;
+ Tcl_SetErrno(0);
+
+ if (tsdPtr->gStdoutInterp != NULL) {
+ TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf,
+ toWrite);
+ }
+
+ return toWrite;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleInput(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* Unused. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(instanceData, interp)
+ ClientData instanceData; /* Unused. */
+ Tcl_Interp *interp; /* Unused. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ tsdPtr->gStdoutInterp = NULL;
+ return 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatch --
+ *
+ * Called by the notifier to set up the console device so that
+ * events will be noticed. Since there are no events on the
+ * console, this routine just returns without doing anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ConsoleWatch(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleHandle --
+ *
+ * Invoked by the generic IO layer to get a handle from a channel.
+ * Because console channels are not devices, this function always
+ * fails.
+ *
+ * Results:
+ * Always returns TCL_ERROR.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleHandle(instanceData, direction, handlePtr)
+ ClientData instanceData; /* Device ID for the channel. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
+ * which direction of the channel is being
+ * requested. */
+ ClientData *handlePtr; /* Where to store handle */
+{
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ size_t length;
+ int result;
+ Tcl_Interp *consoleInterp;
+ Tcl_DString dString;
+
+ 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]);
+ result = TCL_OK;
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_DStringInit(&dString);
+
+ if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
+ Tcl_DStringAppend(&dString, "wm title . ", -1);
+ if (argc == 3) {
+ Tcl_DStringAppendElement(&dString, argv[2]);
+ }
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
+ Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
+ Tcl_DStringAppend(&dString, "wm deiconify . ", -1);
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
+ if (argc == 3) {
+ result = Tcl_Eval(consoleInterp, argv[2]);
+ Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
+ (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " eval command\"", (char *) NULL);
+ result = TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be hide, show, or title",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+ Tcl_DStringFree(&dString);
+ Tcl_Release((ClientData) consoleInterp);
+ return result;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterCmd --
+ *
+ * This command allows the console interp to communicate with the
+ * main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ size_t length;
+ int result;
+ Tcl_Interp *otherInterp;
+
+ 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]);
+ otherInterp = info->interp;
+ Tcl_Preserve((ClientData) otherInterp);
+ if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
+ result = Tcl_GlobalEval(otherInterp, argv[2]);
+ Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
+ } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
+ Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
+ result = TCL_OK;
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be eval or record",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+ Tcl_Release((ClientData) otherInterp);
+ return result;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window
+ * and all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleDeleteProc(clientData)
+ ClientData clientData;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+
+ Tcl_DeleteInterp(info->consoleInterp);
+ info->consoleInterp = NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event procedure is registered on the main window of the
+ * slave interpreter. If the user or a running script causes the
+ * main window to be destroyed, then we need to inform the console
+ * interpreter by invoking "::tk::ConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "::tk::ConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleEventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ Tcl_Interp *consoleInterp;
+ Tcl_DString dString;
+
+ if (eventPtr->type == DestroyNotify) {
+
+ Tcl_DStringInit(&dString);
+
+ consoleInterp = info->consoleInterp;
+
+ /*
+ * It is possible that the console interpreter itself has
+ * already been deleted. In that case the consoleInterp
+ * field will be set to NULL. If the interpreter is already
+ * gone, we do not have to do any work here.
+ */
+
+ if (consoleInterp == (Tcl_Interp *) NULL) {
+ return;
+ }
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_DStringAppend(&dString, "::tk::ConsoleExit", -1);
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ Tcl_DStringFree(&dString);
+ Tcl_Release((ClientData) consoleInterp);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsolePrint --
+ *
+ * Prints to the give text to the console. Given the main interp
+ * this functions find the appropiate console interp and forwards
+ * the text to be added to that console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsolePrint(interp, devId, buffer, size)
+ Tcl_Interp *interp; /* Main interpreter. */
+ int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
+ * stderr. */
+ CONST char *buffer; /* Text buffer. */
+ long size; /* Size of text buffer. */
+{
+ Tcl_DString command, output;
+ Tcl_CmdInfo cmdInfo;
+ char *cmd;
+ ConsoleInfo *info;
+ Tcl_Interp *consoleInterp;
+ int result;
+
+ if (interp == NULL) {
+ return;
+ }
+
+ if (devId == TCL_STDERR) {
+ cmd = "::tk::ConsoleOutput stderr ";
+ } else {
+ cmd = "::tk::ConsoleOutput stdout ";
+ }
+
+ result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
+ if (result == 0) {
+ return;
+ }
+ info = (ConsoleInfo *) cmdInfo.clientData;
+
+ Tcl_DStringInit(&output);
+ Tcl_DStringAppend(&output, buffer, size);
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, cmd, (int) strlen(cmd));
+ Tcl_DStringAppendElement(&command, output.string);
+
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, command.string);
+ Tcl_Release((ClientData) consoleInterp);
+
+ Tcl_DStringFree(&command);
+ Tcl_DStringFree(&output);
+}
--- /dev/null
+/*
+ * tkCursor.c --
+ *
+ * This file maintains a database of read-only cursors for the Tk
+ * toolkit. This allows cursors to be shared between widgets and
+ * also avoids round-trips to the X server.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * A TkCursor structure exists for each cursor that is currently
+ * active. Each structure is indexed with two hash tables defined
+ * below. One of the tables is cursorIdTable, and the other is either
+ * cursorNameTable or cursorDataTable, each of which are stored in the
+ * TkDisplay structure for the current thread.
+ */
+
+typedef struct {
+ CONST char *source; /* Cursor bits. */
+ CONST char *mask; /* Mask bits. */
+ int width, height; /* Dimensions of cursor (and data
+ * and mask). */
+ int xHot, yHot; /* Location of cursor hot-spot. */
+ Tk_Uid fg, bg; /* Colors for cursor. */
+ Display *display; /* Display on which cursor will be used. */
+} DataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void CursorInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupCursorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));
+static void FreeCursorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static TkCursor * GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *name));
+static TkCursor * GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj *objPtr));
+static void InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "cursor" Tcl
+ * object, used for drawing. The color object remembers the hash table
+ * entry associated with a color. The actual allocation and deallocation
+ * of the color should be done by the configuration package when the cursor
+ * option is set.
+ */
+
+Tcl_ObjType tkCursorObjType = {
+ "cursor", /* name */
+ FreeCursorObjProc, /* freeIntRepProc */
+ DupCursorObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocCursorFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * Tk_Cursor structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor,
+ * unless objPtr couldn't be parsed correctly. In this case,
+ * None is returned and an error message is left in the interp's result.
+ * The caller should never modify the cursor that is returned, and
+ * should eventually call Tk_FreeCursorFromObj when the cursor is no
+ * longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursorFromObj, so that the database can be cleaned up
+ * when cursors aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_AllocCursorFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for error results. */
+ Tk_Window tkwin; /* Window in which the cursor will be used.*/
+ Tcl_Obj *objPtr; /* Object describing cursor; see manual
+ * entry for description of legal
+ * syntax of this obj's string rep. */
+{
+ TkCursor *cursorPtr;
+
+ if (objPtr->typePtr != &tkCursorObjType) {
+ InitCursorObj(objPtr);
+ }
+ cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkCursor, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (cursorPtr != NULL) {
+ if (cursorPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkCursor that's
+ * no longer in use. Clear the reference.
+ */
+ FreeCursorObjProc(objPtr);
+ cursorPtr = NULL;
+ } else if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ return cursorPtr->cursor;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkCursor that we wanted. Search
+ * the list of TkCursors with the same name to see if one of the
+ * other TkCursors is the right one.
+ */
+
+ if (cursorPtr != NULL) {
+ TkCursor *firstCursorPtr =
+ (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
+ FreeCursorObjProc(objPtr);
+ for (cursorPtr = firstCursorPtr; cursorPtr != NULL;
+ cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ cursorPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+ return cursorPtr->cursor;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call GetCursor to allocate a new TkCursor object.
+ */
+
+ cursorPtr = GetCursor(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+ if (cursorPtr == NULL) {
+ return None;
+ } else {
+ cursorPtr->objRefCount++;
+ return cursorPtr->cursor;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursor --
+ *
+ * Given a string describing a cursor, locate (or create if necessary)
+ * a cursor that fits the description.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor,
+ * unless string couldn't be parsed correctly. In this case,
+ * None is returned and an error message is left in the interp's result.
+ * The caller should never modify the cursor that is returned, and
+ * should eventually call Tk_FreeCursor when the cursor is no longer
+ * needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursor(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ Tk_Uid string; /* Description of cursor. See manual entry
+ * for details on legal syntax. */
+{
+ TkCursor *cursorPtr = GetCursor(interp, tkwin, string);
+ if (cursorPtr == NULL) {
+ return None;
+ }
+ return cursorPtr->cursor;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCursor --
+ *
+ * Given a string describing a cursor, locate (or create if necessary)
+ * a cursor that fits the description. This routine returns the
+ * internal data structure for the cursor, which avoids extra
+ * hash table lookups in Tk_AllocCursorFromObj.
+ *
+ * Results:
+ * The return value is a pointer to the TkCursor for the desired
+ * cursor, unless string couldn't be parsed correctly. In this
+ * case, NULL is returned and an error message is left in the
+ * interp's result. The caller should never modify the cursor that
+ * is returned, and should eventually call Tk_FreeCursor when the
+ * cursor is no longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkCursor *
+GetCursor(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ CONST char *string; /* Description of cursor. See manual entry
+ * for details on legal syntax. */
+{
+ Tcl_HashEntry *nameHashPtr;
+ register TkCursor *cursorPtr;
+ TkCursor *existingCursorPtr = NULL;
+ int new;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
+ }
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable,
+ string, &new);
+ if (!new) {
+ existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);
+ for (cursorPtr = existingCursorPtr; cursorPtr != NULL;
+ cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ return cursorPtr;
+ }
+ }
+ } else {
+ existingCursorPtr = NULL;
+ }
+
+ cursorPtr = TkGetCursorByName(interp, tkwin, string);
+
+ if (cursorPtr == NULL) {
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
+ }
+
+ /*
+ * Add information about this cursor to our database.
+ */
+
+ cursorPtr->display = Tk_Display(tkwin);
+ cursorPtr->resourceRefCount = 1;
+ cursorPtr->objRefCount = 0;
+ cursorPtr->otherTable = &dispPtr->cursorNameTable;
+ cursorPtr->hashPtr = nameHashPtr;
+ cursorPtr->nextPtr = existingCursorPtr;
+ cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
+ (char *) cursorPtr->cursor, &new);
+ if (!new) {
+ panic("cursor already registered in Tk_GetCursor");
+ }
+ Tcl_SetHashValue(nameHashPtr, cursorPtr);
+ Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
+
+ return cursorPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursorFromData --
+ *
+ * Given a description of the bits and colors for a cursor,
+ * make a cursor that has the given properties.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor,
+ * unless it couldn't be created properly. In this case, None is
+ * returned and an error message is left in the interp's result. The
+ * caller should never modify the cursor that is returned, and
+ * should eventually call Tk_FreeCursor when the cursor is no
+ * longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
+ xHot, yHot, fg, bg)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ CONST char *source; /* Bitmap data for cursor shape. */
+ CONST char *mask; /* Bitmap data for cursor mask. */
+ int width, height; /* Dimensions of cursor. */
+ int xHot, yHot; /* Location of hot-spot in cursor. */
+ Tk_Uid fg; /* Foreground color for cursor. */
+ Tk_Uid bg; /* Background color for cursor. */
+{
+ DataKey dataKey;
+ Tcl_HashEntry *dataHashPtr;
+ register TkCursor *cursorPtr;
+ int new;
+ XColor fgColor, bgColor;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
+ }
+
+ dataKey.source = source;
+ dataKey.mask = mask;
+ dataKey.width = width;
+ dataKey.height = height;
+ dataKey.xHot = xHot;
+ dataKey.yHot = yHot;
+ dataKey.fg = fg;
+ dataKey.bg = bg;
+ dataKey.display = Tk_Display(tkwin);
+ dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable,
+ (char *) &dataKey, &new);
+ if (!new) {
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
+ cursorPtr->resourceRefCount++;
+ return cursorPtr->cursor;
+ }
+
+ /*
+ * No suitable cursor exists yet. Make one using the data
+ * available and add it to the database.
+ */
+
+ if (XParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", fg, "\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (XParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", bg, "\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ cursorPtr = TkCreateCursorFromData(tkwin, source, mask, width, height,
+ xHot, yHot, fgColor, bgColor);
+
+ if (cursorPtr == NULL) {
+ goto error;
+ }
+
+ cursorPtr->resourceRefCount = 1;
+ cursorPtr->otherTable = &dispPtr->cursorDataTable;
+ cursorPtr->hashPtr = dataHashPtr;
+ cursorPtr->objRefCount = 0;
+ cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
+ (char *) cursorPtr->cursor, &new);
+ cursorPtr->nextPtr = NULL;
+
+ if (!new) {
+ panic("cursor already registered in Tk_GetCursorFromData");
+ }
+ Tcl_SetHashValue(dataHashPtr, cursorPtr);
+ Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
+ return cursorPtr->cursor;
+
+ error:
+ Tcl_DeleteHashEntry(dataHashPtr);
+ return None;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfCursor --
+ *
+ * Given a cursor, return a textual string identifying it.
+ *
+ * Results:
+ * If cursor was created by Tk_GetCursor, then the return
+ * value is the "string" that was used to create it.
+ * Otherwise the return value is a string giving the X
+ * identifier for the cursor. The storage for the returned
+ * string is only guaranteed to persist up until the next
+ * call to this procedure.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfCursor(display, cursor)
+ Display *display; /* Display for which cursor was allocated. */
+ Tk_Cursor cursor; /* Identifier for cursor whose name is
+ * wanted. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkCursor *cursorPtr;
+ TkDisplay *dispPtr;
+
+ dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->cursorInit) {
+ printid:
+ sprintf(dispPtr->cursorString, "cursor id 0x%x",
+ (unsigned int) cursor);
+ return dispPtr->cursorString;
+ }
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
+ if (idHashPtr == NULL) {
+ goto printid;
+ }
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
+ if (cursorPtr->otherTable != &dispPtr->cursorNameTable) {
+ goto printid;
+ }
+ return cursorPtr->hashPtr->key.string;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeCursor --
+ *
+ * This procedure is invoked by both Tk_FreeCursor and
+ * Tk_FreeCursorFromObj; it does all the real work of deallocating
+ * a cursor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with cursor is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeCursor(cursorPtr)
+ TkCursor *cursorPtr; /* Cursor to be released. */
+{
+ TkCursor *prevPtr;
+
+ cursorPtr->resourceRefCount--;
+ if (cursorPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ Tcl_DeleteHashEntry(cursorPtr->idHashPtr);
+ prevPtr = (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
+ if (prevPtr == cursorPtr) {
+ if (cursorPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(cursorPtr->hashPtr);
+ } else {
+ Tcl_SetHashValue(cursorPtr->hashPtr, cursorPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != cursorPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = cursorPtr->nextPtr;
+ }
+ TkpFreeCursor(cursorPtr);
+ if (cursorPtr->objRefCount == 0) {
+ ckfree((char *) cursorPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeCursor --
+ *
+ * This procedure is called to release a cursor allocated by
+ * Tk_GetCursor or TkGetCursorFromData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with cursor is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeCursor(display, cursor)
+ Display *display; /* Display for which cursor was allocated. */
+ Tk_Cursor cursor; /* Identifier for cursor to be released. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->cursorInit) {
+ panic("Tk_FreeCursor called before Tk_GetCursor");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeCursor received unknown cursor argument");
+ }
+ FreeCursor((TkCursor *) Tcl_GetHashValue(idHashPtr));
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeCursorFromObj --
+ *
+ * This procedure is called to release a cursor allocated by
+ * Tk_AllocCursorFromObj. It does not throw away the Tcl_Obj *;
+ * it only gets rid of the hash table entry for this cursor
+ * and clears the cached value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the cursor represented by
+ * objPtr is decremented, and the cursor is released to X if there are
+ * no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeCursorFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this cursor lives in. Needed
+ * for the display value. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ FreeCursor(GetCursorFromObj(tkwin, objPtr));
+ FreeCursorObjProc(objPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeCursorFromObjProc --
+ *
+ * This proc is called to release an object reference to a cursor.
+ * Called when the object's internal rep is released or when
+ * the cached tkColPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the color's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeCursorObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (cursorPtr != NULL) {
+ cursorPtr->objRefCount--;
+ if ((cursorPtr->objRefCount == 0)
+ && (cursorPtr->resourceRefCount == 0)) {
+ ckfree((char *) cursorPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupCursorObjProc --
+ *
+ * When a cached cursor object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The color's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupCursorObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkCursor *cursorPtr = (TkCursor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+
+ if (cursorPtr != NULL) {
+ cursorPtr->objRefCount++;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursorFromObj --
+ *
+ * Returns the cursor referred to buy a Tcl object. The cursor must
+ * already have been allocated via a call to Tk_AllocCursorFromObj or
+ * Tk_GetCursor.
+ *
+ * Results:
+ * Returns the Tk_Cursor that matches the tkwin and the string rep
+ * of the name of the cursor given in objPtr.
+ *
+ * Side effects:
+ * If the object is not already a cursor, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursorFromObj(tkwin, objPtr)
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get pixels. */
+{
+ TkCursor *cursorPtr = GetCursorFromObj(tkwin, objPtr);
+ /* GetCursorFromObj should never return NULL */
+ return cursorPtr->cursor;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCursorFromObj --
+ *
+ * Returns the cursor referred to by a Tcl object. The cursor must
+ * already have been allocated via a call to Tk_AllocCursorFromObj
+ * or Tk_GetCursor.
+ *
+ * Results:
+ * Returns the TkCursor * that matches the tkwin and the string rep
+ * of the name of the cursor given in objPtr.
+ *
+ * Side effects:
+ * If the object is not already a cursor, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkCursor *
+GetCursorFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* Window in which the cursor will be used. */
+ Tcl_Obj *objPtr; /* The object that describes the desired
+ * cursor. */
+{
+ TkCursor *cursorPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkCursorObjType) {
+ InitCursorObj(objPtr);
+ }
+
+ /*
+ * The internal representation is a cache of the last cursor used
+ * with the given name. But there can be lots different cursors
+ * for each cursor name; one cursor for each display. Check to
+ * see if the cursor we have cached is the one that is needed.
+ */
+ cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
+ if ((cursorPtr != NULL) && (Tk_Display(tkwin) == cursorPtr->display)) {
+ return cursorPtr;
+ }
+
+ /*
+ * If we get to here, it means the cursor we need is not in the cache.
+ * Try to look up the cursor in the TkDisplay structure of the window.
+ */
+
+ hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable,
+ Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
+ cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ FreeCursorObjProc(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+ cursorPtr->objRefCount++;
+ return cursorPtr;
+ }
+ }
+
+ error:
+ panic("GetCursorFromObj called with non-existent cursor!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitCursorObj --
+ *
+ * Bookeeping procedure to change an objPtr to a cursor type.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old internal rep of the object is freed. The internal
+ * rep is cleared. The final form of the object is set
+ * by either Tk_AllocCursorFromObj or GetCursorFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitCursorObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkCursorObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CursorInit --
+ *
+ * Initialize the structures used for cursor management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CursorInit(dispPtr)
+ TkDisplay *dispPtr; /* Display used to store thread-specific data. */
+{
+ Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int));
+
+ /*
+ * The call below is tricky: can't use sizeof(IdKey) because it
+ * gets padded with extra unpredictable bytes on some 64-bit
+ * machines.
+ */
+
+ /*
+ * Old code....
+ * Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *)
+ * /sizeof(int));
+ *
+ * The comment above doesn't make sense.
+ * However, XIDs should only be 32 bits, by the definition of X,
+ * so the code above causes Tk to crash. Here is the real code:
+ */
+
+ Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS);
+
+ dispPtr->cursorInit = 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugCursor --
+ *
+ * This procedure returns debugging information about a cursor.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkCursor
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkCursor structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugCursor(tkwin, name)
+ Tk_Window tkwin; /* The window in which the cursor will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkCursor *cursorPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name);
+ if (hashPtr != NULL) {
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
+ if (cursorPtr == NULL) {
+ panic("TkDebugCursor found empty hash table entry");
+ }
+ for ( ; (cursorPtr != NULL); cursorPtr = cursorPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(cursorPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(cursorPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
--- /dev/null
+/*
+ * Entry.c --
+ *
+ * This module implements entry and spinbox widgets for the Tk toolkit.
+ * An entry displays a string and allows the string to be edited.
+ * A spinbox expands on the entry by adding up/down buttons that control
+ * the value of the entry widget.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
+ * Copyright (c) 2002 ActiveState Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "default.h"
+
+enum EntryType {
+ TK_ENTRY, TK_SPINBOX
+};
+
+/*
+ * A data structure of the following type is kept for each Entry
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the entry. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with entry. */
+ Tcl_Command widgetCmd; /* Token for entry's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ enum EntryType type; /* Specialized type of Entry widget */
+
+ /*
+ * Fields that are set by widget commands other than "configure".
+ */
+
+ CONST char *string; /* Pointer to storage for string;
+ * NULL-terminated; malloc-ed. */
+ int insertPos; /* Character index before which next typed
+ * character will be inserted. */
+
+ /*
+ * Information about what's selected, if any.
+ */
+
+ int selectFirst; /* Character index of first selected
+ * character (-1 means nothing selected. */
+ int selectLast; /* Character index just after 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). */
+
+ /*
+ * Information for scanning:
+ */
+
+ int scanMarkX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkIndex; /* Character index of character that was at
+ * left of window when scan started. */
+
+ /*
+ * Configuration settings that are updated by Tk_ConfigureWidget.
+ */
+
+ Tk_3DBorder normalBorder; /* Used for drawing border around whole
+ * window, plus used for background. */
+ Tk_3DBorder disabledBorder; /* Used for drawing border around whole
+ * window in disabled state, plus used for
+ * background. */
+ Tk_3DBorder readonlyBorder; /* Used for drawing border around whole
+ * window in readonly state, plus used for
+ * background. */
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ int exportSelection; /* Non-zero means tie internal entry selection
+ * to X selection. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Text color in normal mode. */
+ XColor *dfgColorPtr; /* Text color in disabled mode. */
+ XColor *highlightBgColorPtr;/* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertWidth; /* Total width of insert cursor. */
+ Tk_Justify justify; /* Justification to use for text within
+ * window. */
+ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. */
+ int selBorderWidth; /* Width of border around selection. */
+ XColor *selFgColorPtr; /* Foreground color for selected text. */
+ int state; /* Normal or disabled. Entry is read-only
+ * when disabled. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL.
+ * If non-NULL, entry's string tracks the
+ * contents of this variable and vice versa. */
+ 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 prefWidth; /* Desired width of window, measured in
+ * average characters. */
+ char *scrollCmd; /* Command prefix for communicating with
+ * scrollbar(s). Malloc'ed. NULL means
+ * no command to issue. */
+ char *showChar; /* Value of -show option. If non-NULL, first
+ * character is used for displaying all
+ * characters in entry. Malloc'ed.
+ * This is only used by the Entry widget. */
+
+ /*
+ * Fields whose values are derived from the current values of the
+ * configuration settings above.
+ */
+
+ CONST char *displayString; /* String to use when displaying. This may
+ * be a pointer to string, or a pointer to
+ * malloced memory with the same character
+ * length as string but whose characters
+ * are all equal to showChar. */
+ int numBytes; /* Length of string in bytes. */
+ int numChars; /* Length of string in characters. Both
+ * string and displayString have the same
+ * character length, but may have different
+ * byte lengths due to being made from
+ * different UTF-8 characters. */
+ int numDisplayBytes; /* Length of displayString in bytes. */
+ int inset; /* Number of pixels on the left and right
+ * sides that are taken up by XPAD, borderWidth
+ * (if any), and highlightWidth (if any). */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int layoutX, layoutY; /* Origin for layout. */
+ int leftX; /* X position at which character at leftIndex
+ * is drawn (varies depending on justify). */
+ int leftIndex; /* Character index of left-most character
+ * visible in window. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+ GC textGC; /* For drawing normal text. */
+ GC selTextGC; /* For drawing selected text. */
+ GC highlightGC; /* For drawing traversal highlight. */
+ int avgWidth; /* Width of average character. */
+ int xWidth; /* Extra width to reserve for widget.
+ * Used by spinboxes for button space. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+
+ int validate; /* Non-zero means try to validate */
+ char *validateCmd; /* Command prefix to use when invoking
+ * validate command. NULL means don't
+ * invoke commands. Malloc'ed. */
+ char *invalidCmd; /* Command called when a validation returns 0
+ * (successfully fails), defaults to {}. */
+
+} Entry;
+
+/*
+ * A data structure of the following type is kept for each spinbox
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Entry entry; /* A pointer to the generic entry structure.
+ * This must be the first element of the
+ * Spinbox. */
+
+ /*
+ * Spinbox specific configuration settings.
+ */
+
+ Tk_3DBorder activeBorder; /* Used for drawing border around active
+ * buttons. */
+ Tk_3DBorder buttonBorder; /* Used for drawing border around buttons. */
+ Tk_Cursor bCursor; /* cursor for buttons, or None. */
+ int bdRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ int buRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ char *command; /* Command to invoke for spin buttons.
+ * NULL means no command to issue. */
+
+ /*
+ * Spinbox specific fields for use with configuration settings above.
+ */
+
+ int wrap; /* whether to wrap around when spinning */
+
+ int selElement; /* currently selected control */
+ int curElement; /* currently mouseover control */
+
+ int repeatDelay; /* repeat delay */
+ int repeatInterval; /* repeat interval */
+
+ double fromValue; /* Value corresponding to left/top of dial */
+ double toValue; /* Value corresponding to right/bottom
+ * of dial */
+ double increment; /* If > 0, all values are rounded to an
+ * even multiple of this value. */
+ char *formatBuf; /* string into which to format value.
+ * Malloc'ed. */
+ char *reqFormat; /* Sprintf conversion specifier used for the
+ * value that the users requests. Malloc'ed. */
+ char *valueFormat; /* Sprintf conversion specifier used for
+ * the value. */
+ char digitFormat[10]; /* Sprintf conversion specifier computed from
+ * digits and other information; used for
+ * the value. */
+
+ char *valueStr; /* Values List. Malloc'ed. */
+ Tcl_Obj *listObj; /* Pointer to the list object being used */
+ int eIndex; /* Holds the current index into elements */
+ int nElements; /* Holds the current count of elements */
+
+} Spinbox;
+
+/*
+ * 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.
+ * BORDER_NEEDED: Non-zero means 3-D border must be redrawn
+ * around window during redisplay. Normally
+ * only text portion needs to be redrawn.
+ * CURSOR_ON: Non-zero means insert cursor is displayed at
+ * present. 0 means it isn't displayed.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ * UPDATE_SCROLLBAR: Non-zero means scrollbar should be updated
+ * during next redisplay operation.
+ * GOT_SELECTION: Non-zero means we've claimed the selection.
+ * ENTRY_DELETED: This entry has been effectively destroyed.
+ * VALIDATING: Non-zero means we are in a validateCmd
+ * VALIDATE_VAR: Non-zero means we are attempting to validate
+ * the entry's textvariable with validateCmd
+ * VALIDATE_ABORT: Non-zero if validatecommand signals an abort
+ * for current procedure and make no changes
+ */
+
+#define REDRAW_PENDING 1
+#define BORDER_NEEDED 2
+#define CURSOR_ON 4
+#define GOT_FOCUS 8
+#define UPDATE_SCROLLBAR 0x10
+#define GOT_SELECTION 0x20
+#define ENTRY_DELETED 0x40
+#define VALIDATING 0x80
+#define VALIDATE_VAR 0x100
+#define VALIDATE_ABORT 0x200
+
+/*
+ * The following macro defines how many extra pixels to leave on each
+ * side of the text in the entry.
+ */
+
+#define XPAD 1
+#define YPAD 1
+
+/*
+ * A comparison function for double values. For Spinboxes.
+ */
+#define MIN_DBL_VAL 1E-9
+#define DOUBLES_EQ(d1, d2) (fabs((d1) - (d2)) < MIN_DBL_VAL)
+
+/*
+ * The following enum is used to define a type for the -state option
+ * of the Entry widget. These values are used as indices into the
+ * string table below.
+ */
+
+enum state {
+ STATE_DISABLED, STATE_NORMAL, STATE_READONLY
+};
+
+static char *stateStrings[] = {
+ "disabled", "normal", "readonly", (char *) NULL
+};
+
+/*
+ * Definitions for -validate option values:
+ */
+
+static char *validateStrings[] = {
+ "all", "key", "focus", "focusin", "focusout", "none", (char *) NULL
+};
+enum validateType {
+ VALIDATE_ALL, VALIDATE_KEY, VALIDATE_FOCUS,
+ VALIDATE_FOCUSIN, VALIDATE_FOCUSOUT, VALIDATE_NONE,
+ /*
+ * These extra enums are for use with EntryValidateChange
+ */
+ VALIDATE_FORCED, VALIDATE_DELETE, VALIDATE_INSERT, VALIDATE_BUTTON
+};
+#define DEF_ENTRY_VALIDATE "none"
+#define DEF_ENTRY_INVALIDCMD ""
+
+/*
+ * Information used for Entry objv parsing.
+ */
+
+static Tk_OptionSpec entryOptSpec[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder),
+ 0, (ClientData) DEF_ENTRY_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BORDER, "-disabledbackground", "disabledBackground",
+ "DisabledBackground", DEF_ENTRY_DISABLED_BG_COLOR, -1,
+ Tk_Offset(Entry, disabledBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_DISABLED_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_ENTRY_DISABLED_FG, -1,
+ Tk_Offset(Entry, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1,
+ Tk_Offset(Entry, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0,
+ 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
+ -1, Tk_Offset(Entry, highlightBgColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Entry, highlightWidth), 0, 0, 0},
+ {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_ENTRY_INSERT_BG,
+ -1, Tk_Offset(Entry, insertBorder),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth",
+ "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1,
+ Tk_Offset(Entry, insertBorderWidth), 0,
+ (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0},
+ {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand",
+ DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-invcmd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-invalidcommand", 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0},
+ {TK_OPTION_BORDER, "-readonlybackground", "readonlyBackground",
+ "ReadonlyBackground", DEF_ENTRY_READONLY_BG_COLOR, -1,
+ Tk_Offset(Entry, readonlyBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_READONLY_BG_MONO, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder),
+ 0, (ClientData) DEF_ENTRY_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1,
+ Tk_Offset(Entry, selBorderWidth),
+ 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr),
+ 0, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0},
+ {TK_OPTION_STRING, "-show", "show", "Show",
+ DEF_ENTRY_SHOW, -1, Tk_Offset(Entry, showChar),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_ENTRY_TEXT_VARIABLE, -1, Tk_Offset(Entry, textVarName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate",
+ DEF_ENTRY_VALIDATE, -1, Tk_Offset(Entry, validate),
+ 0, (ClientData) validateStrings, 0},
+ {TK_OPTION_STRING, "-validatecommand", "validateCommand", "ValidateCommand",
+ (char *) NULL, -1, Tk_Offset(Entry, validateCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-vcmd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-validatecommand", 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_ENTRY_SCROLL_COMMAND, -1, Tk_Offset(Entry, scrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * Information used for Spinbox objv parsing.
+ */
+
+#define DEF_SPINBOX_REPEAT_DELAY "400"
+#define DEF_SPINBOX_REPEAT_INTERVAL "100"
+
+#define DEF_SPINBOX_CMD ""
+
+#define DEF_SPINBOX_FROM "0"
+#define DEF_SPINBOX_TO "0"
+#define DEF_SPINBOX_INCREMENT "1"
+#define DEF_SPINBOX_FORMAT ""
+
+#define DEF_SPINBOX_VALUES ""
+#define DEF_SPINBOX_WRAP "0"
+
+static Tk_OptionSpec sbOptSpec[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Background",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(Spinbox, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder),
+ 0, (ClientData) DEF_ENTRY_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-buttonbackground", "Button.background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(Spinbox, buttonBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_CURSOR, "-buttoncursor", "Button.cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(Spinbox, bCursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-buttondownrelief", "Button.relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(Spinbox, bdRelief),
+ 0, 0, 0},
+ {TK_OPTION_RELIEF, "-buttonuprelief", "Button.relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(Spinbox, buRelief),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_SPINBOX_CMD, -1, Tk_Offset(Spinbox, command),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BORDER, "-disabledbackground", "disabledBackground",
+ "DisabledBackground", DEF_ENTRY_DISABLED_BG_COLOR, -1,
+ Tk_Offset(Entry, disabledBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_DISABLED_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_ENTRY_DISABLED_FG, -1,
+ Tk_Offset(Entry, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1,
+ Tk_Offset(Entry, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0,
+ 0, 0},
+ {TK_OPTION_STRING, "-format", "format", "Format",
+ DEF_SPINBOX_FORMAT, -1, Tk_Offset(Spinbox, reqFormat),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-from", "from", "From",
+ DEF_SPINBOX_FROM, -1, Tk_Offset(Spinbox, fromValue), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
+ -1, Tk_Offset(Entry, highlightBgColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Entry, highlightWidth), 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-increment", "increment", "Increment",
+ DEF_SPINBOX_INCREMENT, -1, Tk_Offset(Spinbox, increment), 0, 0, 0},
+ {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_ENTRY_INSERT_BG, -1, Tk_Offset(Entry, insertBorder),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth",
+ "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1,
+ Tk_Offset(Entry, insertBorderWidth), 0,
+ (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0},
+ {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand",
+ DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-invcmd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-invalidcommand", 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-readonlybackground", "readonlyBackground",
+ "ReadonlyBackground", DEF_ENTRY_READONLY_BG_COLOR, -1,
+ Tk_Offset(Entry, readonlyBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_READONLY_BG_MONO, 0},
+ {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SPINBOX_REPEAT_DELAY, -1, Tk_Offset(Spinbox, repeatDelay),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SPINBOX_REPEAT_INTERVAL, -1, Tk_Offset(Spinbox, repeatInterval),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder),
+ 0, (ClientData) DEF_ENTRY_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1,
+ Tk_Offset(Entry, selBorderWidth),
+ 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr),
+ 0, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_ENTRY_TEXT_VARIABLE, -1, Tk_Offset(Entry, textVarName),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-to", "to", "To",
+ DEF_SPINBOX_TO, -1, Tk_Offset(Spinbox, toValue), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate",
+ DEF_ENTRY_VALIDATE, -1, Tk_Offset(Entry, validate),
+ 0, (ClientData) validateStrings, 0},
+ {TK_OPTION_STRING, "-validatecommand", "validateCommand", "ValidateCommand",
+ (char *) NULL, -1, Tk_Offset(Entry, validateCmd),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-values", "values", "Values",
+ DEF_SPINBOX_VALUES, -1, Tk_Offset(Spinbox, valueStr),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-vcmd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-validatecommand", 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0},
+ {TK_OPTION_BOOLEAN, "-wrap", "wrap", "Wrap",
+ DEF_SPINBOX_WRAP, -1, Tk_Offset(Spinbox, wrap), 0, 0, 0},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_ENTRY_SCROLL_COMMAND, -1, Tk_Offset(Entry, scrollCmd),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following tables define the entry widget commands (and sub-
+ * commands) and map the indexes into the string tables into
+ * enumerated types used to dispatch the entry widget command.
+ */
+
+static CONST char *entryCmdNames[] = {
+ "bbox", "cget", "configure", "delete", "get", "icursor", "index",
+ "insert", "scan", "selection", "validate", "xview", (char *) NULL
+};
+
+enum entryCmd {
+ COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELETE,
+ COMMAND_GET, COMMAND_ICURSOR, COMMAND_INDEX, COMMAND_INSERT,
+ COMMAND_SCAN, COMMAND_SELECTION, COMMAND_VALIDATE, COMMAND_XVIEW
+};
+
+static CONST char *selCmdNames[] = {
+ "adjust", "clear", "from", "present", "range", "to", (char *) NULL
+};
+
+enum selCmd {
+ SELECTION_ADJUST, SELECTION_CLEAR, SELECTION_FROM,
+ SELECTION_PRESENT, SELECTION_RANGE, SELECTION_TO
+};
+
+/*
+ * The following tables define the spinbox widget commands (and sub-
+ * commands) and map the indexes into the string tables into
+ * enumerated types used to dispatch the spinbox widget command.
+ */
+
+static CONST char *sbCmdNames[] = {
+ "bbox", "cget", "configure", "delete", "get", "icursor", "identify",
+ "index", "insert", "invoke", "scan", "selection", "set",
+ "validate", "xview", (char *) NULL
+};
+
+enum sbCmd {
+ SB_CMD_BBOX, SB_CMD_CGET, SB_CMD_CONFIGURE, SB_CMD_DELETE,
+ SB_CMD_GET, SB_CMD_ICURSOR, SB_CMD_IDENTIFY, SB_CMD_INDEX,
+ SB_CMD_INSERT, SB_CMD_INVOKE, SB_CMD_SCAN, SB_CMD_SELECTION,
+ SB_CMD_SET, SB_CMD_VALIDATE, SB_CMD_XVIEW
+};
+
+static CONST char *sbSelCmdNames[] = {
+ "adjust", "clear", "element", "from", "present", "range", "to",
+ (char *) NULL
+};
+
+enum sbselCmd {
+ SB_SEL_ADJUST, SB_SEL_CLEAR, SB_SEL_ELEMENT, SB_SEL_FROM,
+ SB_SEL_PRESENT, SB_SEL_RANGE, SB_SEL_TO
+};
+
+/*
+ * Extra for selection of elements
+ */
+
+static CONST char *selElementNames[] = {
+ "none", "buttondown", "buttonup", (char *) NULL, "entry"
+};
+enum selelement {
+ SEL_NONE, SEL_BUTTONDOWN, SEL_BUTTONUP, SEL_NULL, SEL_ENTRY
+};
+
+/*
+ * 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 objc,
+ Tcl_Obj *CONST objv[], int flags));
+static void DeleteChars _ANSI_ARGS_((Entry *entryPtr, int index,
+ int count));
+static void DestroyEntry _ANSI_ARGS_((char *memPtr));
+static void DisplayEntry _ANSI_ARGS_((ClientData clientData));
+static void EntryBlinkProc _ANSI_ARGS_((ClientData clientData));
+static void EntryCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void EntryComputeGeometry _ANSI_ARGS_((Entry *entryPtr));
+static void EntryEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EntryFocusProc _ANSI_ARGS_ ((Entry *entryPtr,
+ int gotFocus));
+static int EntryFetchSelection _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static void EntryLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+static void EventuallyRedraw _ANSI_ARGS_((Entry *entryPtr));
+static void EntryScanTo _ANSI_ARGS_((Entry *entryPtr, int y));
+static void EntrySetValue _ANSI_ARGS_((Entry *entryPtr,
+ CONST char *value));
+static void EntrySelectTo _ANSI_ARGS_((
+ Entry *entryPtr, int index));
+static char * EntryTextVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static void EntryUpdateScrollbar _ANSI_ARGS_((Entry *entryPtr));
+static int EntryValidate _ANSI_ARGS_((Entry *entryPtr,
+ char *cmd));
+static int EntryValidateChange _ANSI_ARGS_((Entry *entryPtr,
+ char *change, CONST char *new, int index,
+ int type));
+static void ExpandPercents _ANSI_ARGS_((Entry *entryPtr,
+ CONST char *before, char *change, CONST char *new,
+ int index, int type, Tcl_DString *dsPtr));
+static void EntryValueChanged _ANSI_ARGS_((Entry *entryPtr,
+ CONST char *newValue));
+static void EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr,
+ double *firstPtr, double *lastPtr));
+static int EntryWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void EntryWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+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));
+
+/*
+ * These forward declarations are the spinbox specific ones:
+ */
+
+static int SpinboxWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int GetSpinboxElement _ANSI_ARGS_((Spinbox *sbPtr,
+ int x, int y));
+static int SpinboxInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+ Spinbox *sbPtr, int element));
+static int ComputeFormat _ANSI_ARGS_((Spinbox *sbPtr));
+
+/*
+ * The structure below defines widget class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs entryClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ EntryWorldChanged, /* worldChangedProc */
+};
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_EntryObjCmd --
+ *
+ * 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
+Tk_EntryObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Entry *entryPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ char *tmp;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, Tk will return the cached value.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, entryOptSpec);
+
+ /*
+ * 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). Only the non-NULL/0
+ * data must be initialized as memset covers the rest.
+ */
+
+ entryPtr = (Entry *) ckalloc(sizeof(Entry));
+ memset((VOID *) entryPtr, 0, sizeof(Entry));
+
+ entryPtr->tkwin = tkwin;
+ entryPtr->display = Tk_Display(tkwin);
+ entryPtr->interp = interp;
+ entryPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd,
+ (ClientData) entryPtr, EntryCmdDeletedProc);
+ entryPtr->optionTable = optionTable;
+ entryPtr->type = TK_ENTRY;
+ tmp = (char *) ckalloc(1);
+ tmp[0] = '\0';
+ entryPtr->string = tmp;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->justify = TK_JUSTIFY_LEFT;
+ entryPtr->relief = TK_RELIEF_FLAT;
+ entryPtr->state = STATE_NORMAL;
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->inset = XPAD;
+ entryPtr->textGC = None;
+ entryPtr->selTextGC = None;
+ entryPtr->highlightGC = None;
+ entryPtr->avgWidth = 1;
+ entryPtr->validate = VALIDATE_NONE;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the listbox,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve((ClientData) entryPtr->tkwin);
+
+ Tk_SetClass(entryPtr->tkwin, "Entry");
+ Tk_SetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr);
+ Tk_CreateEventHandler(entryPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ EntryEventProc, (ClientData) entryPtr);
+ Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, (ClientData) entryPtr, XA_STRING);
+
+ if ((Tk_InitOptions(interp, (char *) entryPtr, optionTable, tkwin)
+ != TCL_OK) ||
+ (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK)) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryWidgetObjCmd --
+ *
+ * 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
+EntryWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about entry widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ int cmdIndex, selIndex, result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the widget command by looking up the second token in
+ * the list of valid command names.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], entryCmdNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve((ClientData) entryPtr);
+ switch ((enum entryCmd) cmdIndex) {
+ case COMMAND_BBOX: {
+ int index, x, y, width, height;
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index == entryPtr->numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->textLayout, index, &x, &y,
+ &width, &height);
+ sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX,
+ y + entryPtr->layoutY, width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) entryPtr,
+ entryPtr->optionTable, objv[2], entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+
+ case COMMAND_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr,
+ entryPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0);
+ }
+ break;
+ }
+
+ case COMMAND_DELETE: {
+ int first, last;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &first) != TCL_OK) {
+ goto error;
+ }
+ if (objc == 3) {
+ last = first + 1;
+ } else {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]),
+ &last) != TCL_OK) {
+ goto error;
+ }
+ }
+ if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
+ DeleteChars(entryPtr, first, last - first);
+ }
+ break;
+ }
+
+ case COMMAND_GET: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ goto error;
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ break;
+ }
+
+ case COMMAND_ICURSOR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &entryPtr->insertPos) != TCL_OK) {
+ goto error;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+
+ case COMMAND_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ break;
+ }
+
+ case COMMAND_INSERT: {
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state == STATE_NORMAL) {
+ InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ }
+ break;
+ }
+
+ case COMMAND_SCAN: {
+ int x;
+ char *minorCmd;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x");
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ goto error;
+ }
+
+ minorCmd = Tcl_GetString(objv[2]);
+ if (minorCmd[0] == 'm'
+ && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) {
+ entryPtr->scanMarkX = x;
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ } else if ((minorCmd[0] == 'd')
+ && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) {
+ EntryScanTo(entryPtr, x);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"",
+ Tcl_GetString(objv[2]), "\": must be mark or dragto",
+ (char *) NULL);
+ goto error;
+ }
+ break;
+ }
+
+ case COMMAND_SELECTION: {
+ int index, index2;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?index?");
+ goto error;
+ }
+
+ /*
+ * Parse the selection sub-command, using the command
+ * table "selCmdNames" defined above.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], selCmdNames,
+ "selection option", 0, &selIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Disabled entries don't allow the selection to be modified.
+ */
+
+ if (entryPtr->state == STATE_DISABLED) {
+ goto done;
+ }
+
+ switch(selIndex) {
+ case SELECTION_ADJUST: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ 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);
+ break;
+ }
+
+ case SELECTION_CLEAR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+ goto done;
+ }
+
+ case SELECTION_FROM: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ entryPtr->selectAnchor = index;
+ break;
+ }
+
+ case SELECTION_PRESENT: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst < 0) {
+ Tcl_SetResult(interp, "0", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "1", TCL_STATIC);
+ }
+ goto done;
+ }
+
+ case SELECTION_RANGE: {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "start end");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[4]),& index2) != TCL_OK) {
+ goto error;
+ }
+ if (index >= index2) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ } else {
+ entryPtr->selectFirst = index;
+ entryPtr->selectLast = index2;
+ }
+ if (!(entryPtr->flags & GOT_SELECTION)
+ && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY,
+ EntryLostSelection, (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+
+ case SELECTION_TO: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+ }
+ }
+ break;
+ }
+
+ case COMMAND_VALIDATE: {
+ int code;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ goto error;
+ }
+ selIndex = entryPtr->validate;
+ entryPtr->validate = VALIDATE_ALL;
+ code = EntryValidateChange(entryPtr, (char *) NULL,
+ entryPtr->string, -1, VALIDATE_FORCED);
+ if (entryPtr->validate != VALIDATE_NONE) {
+ entryPtr->validate = selIndex;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK)));
+ break;
+ }
+
+ case COMMAND_XVIEW: {
+ int index;
+
+ if (objc == 2) {
+ double first, last;
+ char buf[TCL_DOUBLE_SPACE * 2];
+
+ EntryVisibleRange(entryPtr, &first, &last);
+ sprintf(buf, "%g %g", first, last);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ goto done;
+ } else if (objc == 3) {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ double fraction;
+ int count;
+
+ index = entryPtr->leftIndex;
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction,
+ &count)) {
+ case TK_SCROLL_ERROR: {
+ goto error;
+ }
+ case TK_SCROLL_MOVETO: {
+ index = (int) ((fraction * entryPtr->numChars) + 0.5);
+ break;
+ }
+ case TK_SCROLL_PAGES: {
+ int charsPerPage;
+
+ charsPerPage = ((Tk_Width(entryPtr->tkwin)
+ - 2 * entryPtr->inset)
+ / entryPtr->avgWidth) - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ index += count * charsPerPage;
+ break;
+ }
+ case TK_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);
+ break;
+ }
+ }
+
+ done:
+ Tcl_Release((ClientData) entryPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) entryPtr);
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyEntry --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_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(memPtr)
+ char *memPtr; /* Info about entry widget. */
+{
+ Entry *entryPtr = (Entry *) memPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ ckfree((char *)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->textGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->textGC);
+ }
+ if (entryPtr->selTextGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
+ }
+ Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
+ if (entryPtr->displayString != entryPtr->string) {
+ ckfree((char *)entryPtr->displayString);
+ }
+ if (entryPtr->type == TK_SPINBOX) {
+ Spinbox *sbPtr = (Spinbox *) entryPtr;
+
+ if (sbPtr->listObj != NULL) {
+ Tcl_DecrRefCount(sbPtr->listObj);
+ sbPtr->listObj = NULL;
+ }
+ if (sbPtr->formatBuf) {
+ ckfree(sbPtr->formatBuf);
+ }
+ }
+ Tk_FreeTextLayout(entryPtr->textLayout);
+ Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable,
+ entryPtr->tkwin);
+ Tcl_Release((ClientData) entryPtr->tkwin);
+ entryPtr->tkwin = NULL;
+
+ ckfree((char *) entryPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 the interp's 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, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Entry *entryPtr; /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ Tk_SavedOptions savedOptions;
+ Tk_3DBorder border;
+ Tcl_Obj *errorResult = NULL;
+ Spinbox *sbPtr = (Spinbox *) entryPtr; /* Only used when this widget
+ * is of type TK_SPINBOX */
+ char *oldValues = NULL; /* lint initialization */
+ char *oldFormat = NULL; /* lint initialization */
+ int error;
+ int oldExport = 0; /* lint initialization */
+ int valuesChanged = 0; /* lint initialization */
+ double oldFrom = 0.0; /* lint initialization */
+ double oldTo = 0.0; /* lint initialization */
+
+ /*
+ * 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);
+ }
+
+ /*
+ * Store old values that we need to effect certain behavior if
+ * they change value
+ */
+ oldExport = entryPtr->exportSelection;
+ if (entryPtr->type == TK_SPINBOX) {
+ oldValues = sbPtr->valueStr;
+ oldFormat = sbPtr->reqFormat;
+ oldFrom = sbPtr->fromValue;
+ oldTo = sbPtr->toValue;
+ }
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) entryPtr,
+ entryPtr->optionTable, objc, objv,
+ entryPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few other options also need special processing, such as parsing
+ * the geometry and setting the background from a 3-D border.
+ */
+
+ if ((entryPtr->state == STATE_DISABLED) &&
+ (entryPtr->disabledBorder != NULL)) {
+ border = entryPtr->disabledBorder;
+ } else if ((entryPtr->state == STATE_READONLY) &&
+ (entryPtr->readonlyBorder != NULL)) {
+ border = entryPtr->readonlyBorder;
+ } else {
+ border = entryPtr->normalBorder;
+ }
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, border);
+
+ if (entryPtr->insertWidth <= 0) {
+ entryPtr->insertWidth = 2;
+ }
+ if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) {
+ entryPtr->insertBorderWidth = entryPtr->insertWidth/2;
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ if (sbPtr->fromValue > sbPtr->toValue) {
+ Tcl_SetResult(interp,
+ "-to value must be greater than -from value",
+ TCL_VOLATILE);
+ continue;
+ }
+
+ if (sbPtr->reqFormat && (oldFormat != sbPtr->reqFormat)) {
+ /*
+ * Make sure that the given format is somewhat correct, and
+ * calculate the minimum space we'll need for the values as
+ * strings.
+ */
+ int min, max;
+ size_t formatLen, formatSpace = TCL_DOUBLE_SPACE;
+ char fbuf[4], *fmt = sbPtr->reqFormat;
+
+ formatLen = strlen(fmt);
+ if ((fmt[0] != '%') || (fmt[formatLen-1] != 'f')) {
+ badFormatOpt:
+ Tcl_AppendResult(interp, "bad spinbox format specifier \"",
+ sbPtr->reqFormat, "\"", (char *) NULL);
+ continue;
+ }
+ if ((sscanf(fmt, "%%%d.%d%[f]", &min, &max, fbuf) == 3)
+ && (max >= 0)) {
+ formatSpace = min + max + 1;
+ } else if (((sscanf(fmt, "%%.%d%[f]", &min, fbuf) == 2)
+ || (sscanf(fmt, "%%%d%[f]", &min, fbuf) == 2)
+ || (sscanf(fmt, "%%%d.%[f]", &min, fbuf) == 2))
+ && (min >= 0)) {
+ formatSpace = min + 1;
+ } else {
+ goto badFormatOpt;
+ }
+ if (formatSpace < TCL_DOUBLE_SPACE) {
+ formatSpace = TCL_DOUBLE_SPACE;
+ }
+ sbPtr->formatBuf = ckrealloc(sbPtr->formatBuf, formatSpace);
+ /*
+ * We perturb the value of oldFrom to allow us to go into
+ * the branch below that will reformat the displayed value.
+ */
+ oldFrom = sbPtr->fromValue - 1;
+ }
+
+ /*
+ * See if we have to rearrange our listObj data
+ */
+ if (oldValues != sbPtr->valueStr) {
+ if (sbPtr->listObj != NULL) {
+ Tcl_DecrRefCount(sbPtr->listObj);
+ }
+ sbPtr->listObj = NULL;
+ if (sbPtr->valueStr != NULL) {
+ Tcl_Obj *newObjPtr;
+ int nelems;
+
+ newObjPtr = Tcl_NewStringObj(sbPtr->valueStr, -1);
+ if (Tcl_ListObjLength(interp, newObjPtr, &nelems)
+ != TCL_OK) {
+ valuesChanged = -1;
+ continue;
+ }
+ sbPtr->listObj = newObjPtr;
+ Tcl_IncrRefCount(sbPtr->listObj);
+ sbPtr->nElements = nelems;
+ sbPtr->eIndex = 0;
+ valuesChanged++;
+ }
+ }
+ }
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or
+ * off-time just changed. Set validate temporarily to none,
+ * so the configure doesn't cause it to be triggered.
+ */
+
+ if (entryPtr->flags & GOT_FOCUS) {
+ int validate = entryPtr->validate;
+ entryPtr->validate = VALIDATE_NONE;
+ EntryFocusProc(entryPtr, 1);
+ entryPtr->validate = validate;
+ }
+
+ /*
+ * Claim the selection if we've suddenly started exporting it.
+ */
+
+ if (entryPtr->exportSelection && (!oldExport)
+ && (entryPtr->selectFirst != -1)
+ && !(entryPtr->flags & GOT_SELECTION)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
+ (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+
+ /*
+ * Recompute the window's geometry and arrange for it to be
+ * redisplayed.
+ */
+
+ Tk_SetInternalBorder(entryPtr->tkwin,
+ entryPtr->borderWidth + entryPtr->highlightWidth);
+ if (entryPtr->highlightWidth <= 0) {
+ entryPtr->highlightWidth = 0;
+ }
+ entryPtr->inset = entryPtr->highlightWidth
+ + entryPtr->borderWidth + XPAD;
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * If the entry is tied to the value of a variable, create the variable if
+ * it doesn't exist, and set the entry's value from the variable's value.
+ */
+
+ if (entryPtr->textVarName != NULL) {
+ CONST char *value;
+
+ value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ EntryValueChanged(entryPtr, NULL);
+ } else {
+ EntrySetValue(entryPtr, value);
+ }
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ ComputeFormat(sbPtr);
+
+ if (valuesChanged > 0) {
+ Tcl_Obj *objPtr;
+
+ /*
+ * No check for error return, because there shouldn't be one
+ * given the check for valid list above
+ */
+ Tcl_ListObjIndex(interp, sbPtr->listObj, 0, &objPtr);
+ EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
+ } else if ((sbPtr->valueStr == NULL)
+ && !DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)
+ && (!DOUBLES_EQ(sbPtr->fromValue, oldFrom)
+ || !DOUBLES_EQ(sbPtr->toValue, oldTo))) {
+ /*
+ * If the valueStr is empty and -from && -to are specified, check
+ * to see if the current string is within the range. If not,
+ * it will be constrained to the nearest edge. If the current
+ * string isn't a double value, we set it to -from.
+ */
+ int code;
+ double dvalue;
+
+ code = Tcl_GetDouble(NULL, entryPtr->string, &dvalue);
+ if (code != TCL_OK) {
+ dvalue = sbPtr->fromValue;
+ } else {
+ if (dvalue > sbPtr->toValue) {
+ dvalue = sbPtr->toValue;
+ } else if (dvalue < sbPtr->fromValue) {
+ dvalue = sbPtr->fromValue;
+ }
+ }
+ sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue);
+ EntryValueChanged(entryPtr, sbPtr->formatBuf);
+ }
+ }
+
+ /*
+ * Set up a trace on the variable's value after we've possibly
+ * constrained the value according to new -from/-to values.
+ */
+
+ if (entryPtr->textVarName != NULL) {
+ Tcl_TraceVar(interp, entryPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, (ClientData) entryPtr);
+ }
+
+ EntryWorldChanged((ClientData) entryPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EntryWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Entry will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+EntryWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc = None;
+ unsigned long mask;
+ Tk_3DBorder border;
+ XColor *colorPtr;
+ Entry *entryPtr = (Entry *) instanceData;
+
+ entryPtr->avgWidth = Tk_TextWidth(entryPtr->tkfont, "0", 1);
+ if (entryPtr->avgWidth == 0) {
+ entryPtr->avgWidth = 1;
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ /*
+ * Compute the button width for a spinbox
+ */
+
+ entryPtr->xWidth = entryPtr->avgWidth + 2 * (1+XPAD);
+ if (entryPtr->xWidth < 11) {
+ entryPtr->xWidth = 11; /* we want a min visible size */
+ }
+ }
+
+ /*
+ * Default background and foreground are from the normal state.
+ * In a disabled state, both of those may be overridden; in the readonly
+ * state, the background may be overridden.
+ */
+
+ border = entryPtr->normalBorder;
+ colorPtr = entryPtr->fgColorPtr;
+ switch (entryPtr->state) {
+ case STATE_DISABLED:
+ if (entryPtr->disabledBorder != NULL) {
+ border = entryPtr->disabledBorder;
+ }
+ if (entryPtr->dfgColorPtr != NULL) {
+ colorPtr = entryPtr->dfgColorPtr;
+ }
+ break;
+ case STATE_READONLY:
+ if (entryPtr->readonlyBorder != NULL) {
+ border = entryPtr->readonlyBorder;
+ }
+ break;
+ }
+
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, border);
+ gcValues.foreground = colorPtr->pixel;
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
+ if (entryPtr->textGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->textGC);
+ }
+ entryPtr->textGC = gc;
+
+ gcValues.foreground = entryPtr->selFgColorPtr->pixel;
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ mask = GCForeground | GCFont;
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
+ if (entryPtr->selTextGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
+ }
+ entryPtr->selTextGC = gc;
+
+ /*
+ * Recompute the window's geometry and arrange for it to be
+ * redisplayed.
+ */
+
+ EntryComputeGeometry(entryPtr);
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EventuallyRedraw(entryPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ Tk_Window tkwin = entryPtr->tkwin;
+ int baseY, selStartX, selEndX, cursorX;
+ int showSelection, xBound;
+ Tk_FontMetrics fm;
+ Pixmap pixmap;
+ Tk_3DBorder border;
+
+ entryPtr->flags &= ~REDRAW_PENDING;
+ if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ Tk_GetFontMetrics(entryPtr->tkfont, &fm);
+
+ /*
+ * Update the scrollbar if that's needed.
+ */
+
+ if (entryPtr->flags & UPDATE_SCROLLBAR) {
+ entryPtr->flags &= ~UPDATE_SCROLLBAR;
+
+ /*
+ * Preserve/Release because updating the scrollbar can have
+ * the side-effect of destroying or unmapping the entry widget.
+ */
+
+ Tcl_Preserve((ClientData) entryPtr);
+ EntryUpdateScrollbar(entryPtr);
+
+ if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(tkwin)) {
+ Tcl_Release((ClientData) entryPtr);
+ return;
+ }
+ Tcl_Release((ClientData) entryPtr);
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws the
+ * textual area of the entry into off-screen memory, then copies
+ * it back on-screen in a single operation. This means there's
+ * no point in time where the on-screen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(entryPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ /*
+ * Compute x-coordinate of the pixel just after last visible
+ * one, plus vertical position of baseline of text.
+ */
+
+ xBound = Tk_Width(tkwin) - entryPtr->inset - entryPtr->xWidth;
+ baseY = (Tk_Height(tkwin) + fm.ascent - fm.descent) / 2;
+
+ /*
+ * On Windows and Mac, we need to hide the selection whenever we
+ * don't have the focus.
+ */
+
+#ifdef ALWAYS_SHOW_SELECTION
+ showSelection = 1;
+#else
+ showSelection = (entryPtr->flags & GOT_FOCUS);
+#endif
+
+ /*
+ * Draw the background in three layers. From bottom to top the
+ * layers are: normal background, selection background, and
+ * insertion cursor background.
+ */
+
+ if ((entryPtr->state == STATE_DISABLED) &&
+ (entryPtr->disabledBorder != NULL)) {
+ border = entryPtr->disabledBorder;
+ } else if ((entryPtr->state == STATE_READONLY) &&
+ (entryPtr->readonlyBorder != NULL)) {
+ border = entryPtr->readonlyBorder;
+ } else {
+ border = entryPtr->normalBorder;
+ }
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ if (showSelection && (entryPtr->state != STATE_DISABLED)
+ && (entryPtr->selectLast > entryPtr->leftIndex)) {
+ if (entryPtr->selectFirst <= entryPtr->leftIndex) {
+ selStartX = entryPtr->leftX;
+ } else {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->selectFirst,
+ &selStartX, NULL, NULL, NULL);
+ selStartX += entryPtr->layoutX;
+ }
+ if ((selStartX - entryPtr->selBorderWidth) < xBound) {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast,
+ &selEndX, NULL, NULL, NULL);
+ selEndX += entryPtr->layoutX;
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->selBorder,
+ selStartX - entryPtr->selBorderWidth,
+ baseY - fm.ascent - entryPtr->selBorderWidth,
+ (selEndX - selStartX) + 2*entryPtr->selBorderWidth,
+ (fm.ascent + fm.descent) + 2*entryPtr->selBorderWidth,
+ entryPtr->selBorderWidth, TK_RELIEF_RAISED);
+ }
+ }
+
+ /*
+ * Draw a special background for the insertion cursor, overriding
+ * even the selection background. As a special hack to keep the
+ * cursor visible when the insertion cursor color is the same as
+ * the color for selected text (e.g., on mono displays), write
+ * background in the cursor area (instead of nothing) when the
+ * cursor isn't on. Otherwise the selection would hide the cursor.
+ */
+
+ if ((entryPtr->state == STATE_NORMAL) && (entryPtr->flags & GOT_FOCUS)) {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos, &cursorX, NULL,
+ NULL, NULL);
+ cursorX += entryPtr->layoutX;
+ cursorX -= (entryPtr->insertWidth)/2;
+ Tk_SetCaretPos(entryPtr->tkwin, cursorX, baseY - fm.ascent,
+ fm.ascent + fm.descent);
+ if (entryPtr->insertPos >= entryPtr->leftIndex) {
+ if (cursorX < xBound) {
+ if (entryPtr->flags & CURSOR_ON) {
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->insertBorder,
+ cursorX, baseY - fm.ascent, entryPtr->insertWidth,
+ fm.ascent + fm.descent,
+ entryPtr->insertBorderWidth,
+ TK_RELIEF_RAISED);
+ } else if (entryPtr->insertBorder == entryPtr->selBorder) {
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ cursorX, baseY - fm.ascent, entryPtr->insertWidth,
+ fm.ascent + fm.descent, 0, TK_RELIEF_FLAT);
+ }
+ }
+ }
+ }
+
+ /*
+ * Draw the text in two pieces: first the unselected portion, then the
+ * selected portion on top of it.
+ */
+
+ Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->textGC,
+ entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
+ entryPtr->leftIndex, entryPtr->numChars);
+
+ if (showSelection && (entryPtr->state != STATE_DISABLED)
+ && (entryPtr->selTextGC != entryPtr->textGC)
+ && (entryPtr->selectFirst < entryPtr->selectLast)) {
+ int selFirst;
+
+ if (entryPtr->selectFirst < entryPtr->leftIndex) {
+ selFirst = entryPtr->leftIndex;
+ } else {
+ selFirst = entryPtr->selectFirst;
+ }
+ Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->selTextGC,
+ entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
+ selFirst, entryPtr->selectLast);
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ int startx, height, inset, pad, tHeight, xWidth;
+ Spinbox *sbPtr = (Spinbox *) entryPtr;
+
+ /*
+ * Draw the spin button controls.
+ */
+ xWidth = entryPtr->xWidth;
+ pad = XPAD + 1;
+ inset = entryPtr->inset - XPAD;
+ startx = Tk_Width(tkwin) - (xWidth + inset);
+ height = (Tk_Height(tkwin) - 2*inset)/2;
+#if 0
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset, xWidth, height, 1, sbPtr->buRelief);
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset+height, xWidth, height, 1, sbPtr->bdRelief);
+#else
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset, xWidth, height, 1,
+ (sbPtr->selElement == SEL_BUTTONUP) ?
+ TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset+height, xWidth, height, 1,
+ (sbPtr->selElement == SEL_BUTTONDOWN) ?
+ TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
+#endif
+
+ xWidth -= 2*pad;
+ /*
+ * Only draw the triangles if we have enough display space
+ */
+ if ((xWidth > 1)) {
+ XPoint points[3];
+ int starty, space, offset;
+
+ space = height - 2*pad;
+ /*
+ * Ensure width of triangle is odd to guarantee a sharp tip
+ */
+ if (!(xWidth % 2)) {
+ xWidth++;
+ }
+ tHeight = (xWidth + 1) / 2;
+ if (tHeight > space) {
+ tHeight = space;
+ }
+ space = (space - tHeight) / 2;
+ startx += pad;
+ starty = inset + height - pad - space;
+ offset = (sbPtr->selElement == SEL_BUTTONUP);
+ /*
+ * The points are slightly different for the up and down arrows
+ * because (for *.x), we need to account for a bug in the way
+ * XFillPolygon draws triangles, and we want to shift
+ * the arrows differently when allowing for depressed behavior.
+ */
+ points[0].x = startx + offset;
+ points[0].y = starty + (offset ? 0 : -1);
+ points[1].x = startx + xWidth/2 + offset;
+ points[1].y = starty - tHeight + (offset ? 0 : -1);
+ points[2].x = startx + xWidth + offset;
+ points[2].y = points[0].y;
+ XFillPolygon(entryPtr->display, pixmap, entryPtr->textGC,
+ points, 3, Convex, CoordModeOrigin);
+
+ starty = inset + height + pad + space;
+ offset = (sbPtr->selElement == SEL_BUTTONDOWN);
+ points[0].x = startx + 1 + offset;
+ points[0].y = starty + (offset ? 1 : 0);
+ points[1].x = startx + xWidth/2 + offset;
+ points[1].y = starty + tHeight + (offset ? 0 : -1);
+ points[2].x = startx - 1 + xWidth + offset;
+ points[2].y = points[0].y;
+ XFillPolygon(entryPtr->display, pixmap, entryPtr->textGC,
+ points, 3, Convex, CoordModeOrigin);
+ }
+ }
+
+ /*
+ * Draw the border and focus highlight last, so they will overwrite
+ * any text that extends past the viewable part of the window.
+ */
+
+ xBound = entryPtr->highlightWidth;
+ if (entryPtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, border, xBound, xBound,
+ Tk_Width(tkwin) - 2 * xBound,
+ Tk_Height(tkwin) - 2 * xBound,
+ entryPtr->borderWidth, entryPtr->relief);
+ }
+ if (xBound > 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(entryPtr->highlightBgColorPtr, pixmap);
+ if (entryPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, xBound, pixmap);
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, xBound, pixmap);
+ }
+ }
+
+ /*
+ * Everything's been redisplayed; now copy the pixmap onto the screen
+ * and free up the pixmap.
+ */
+
+ XCopyArea(entryPtr->display, pixmap, Tk_WindowId(tkwin), entryPtr->textGC,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(entryPtr->display, pixmap);
+ entryPtr->flags &= ~BORDER_NEEDED;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 leftX and tabOrigin fields are recomputed for entryPtr,
+ * and leftIndex may be adjusted. Tk_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, rightX;
+ int height, width, i;
+ Tk_FontMetrics fm;
+ char *p;
+
+ if (entryPtr->displayString != entryPtr->string) {
+ ckfree((char *)entryPtr->displayString);
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * If we're displaying a special character instead of the value of
+ * the entry, recompute the displayString.
+ */
+
+ if (entryPtr->showChar != NULL) {
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX];
+ int size;
+
+ /*
+ * Normalize the special character so we can safely duplicate it
+ * in the display string. If we didn't do this, then two malformed
+ * characters might end up looking like one valid UTF character in
+ * the resulting string.
+ */
+
+ Tcl_UtfToUniChar(entryPtr->showChar, &ch);
+ size = Tcl_UniCharToUtf(ch, buf);
+
+ entryPtr->numDisplayBytes = entryPtr->numChars * size;
+ p = (char *) ckalloc((unsigned) (entryPtr->numDisplayBytes + 1));
+ entryPtr->displayString = p;
+
+ for (i = entryPtr->numChars; --i >= 0; ) {
+ p += Tcl_UniCharToUtf(ch, p);
+ }
+ *p = '\0';
+ }
+
+ Tk_FreeTextLayout(entryPtr->textLayout);
+ entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont,
+ entryPtr->displayString, entryPtr->numChars, 0,
+ entryPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height);
+
+ entryPtr->layoutY = (Tk_Height(entryPtr->tkwin) - height) / 2;
+
+ /*
+ * 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.
+ */
+
+ overflow = totalLength -
+ (Tk_Width(entryPtr->tkwin) - 2*entryPtr->inset - entryPtr->xWidth);
+ if (overflow <= 0) {
+ entryPtr->leftIndex = 0;
+ if (entryPtr->justify == TK_JUSTIFY_LEFT) {
+ entryPtr->leftX = entryPtr->inset;
+ } else if (entryPtr->justify == TK_JUSTIFY_RIGHT) {
+ entryPtr->leftX = Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - entryPtr->xWidth - totalLength;
+ } else {
+ entryPtr->leftX = (Tk_Width(entryPtr->tkwin)
+ - entryPtr->xWidth - totalLength)/2;
+ }
+ entryPtr->layoutX = entryPtr->leftX;
+ } else {
+ /*
+ * 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 = Tk_PointToChar(entryPtr->textLayout, overflow, 0);
+ Tk_CharBbox(entryPtr->textLayout, maxOffScreen,
+ &rightX, NULL, NULL, NULL);
+ if (rightX < overflow) {
+ maxOffScreen++;
+ }
+ if (entryPtr->leftIndex > maxOffScreen) {
+ entryPtr->leftIndex = maxOffScreen;
+ }
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex, &rightX,
+ NULL, NULL, NULL);
+ entryPtr->leftX = entryPtr->inset;
+ entryPtr->layoutX = entryPtr->leftX - rightX;
+ }
+
+ Tk_GetFontMetrics(entryPtr->tkfont, &fm);
+ height = fm.linespace + 2*entryPtr->inset + 2*(YPAD-XPAD);
+ if (entryPtr->prefWidth > 0) {
+ width = entryPtr->prefWidth*entryPtr->avgWidth + 2*entryPtr->inset;
+ } else {
+ if (totalLength == 0) {
+ width = entryPtr->avgWidth + 2*entryPtr->inset;
+ } else {
+ width = totalLength + 2*entryPtr->inset;
+ }
+ }
+
+ /*
+ * Add one extra length for the spin buttons
+ */
+ width += entryPtr->xWidth;
+
+ Tk_GeometryRequest(entryPtr->tkwin, width, height);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, value)
+ Entry *entryPtr; /* Entry that is to get the new elements. */
+ int index; /* Add the new elements before this
+ * character index. */
+ char *value; /* New characters to add (NULL-terminated
+ * string). */
+{
+ int byteIndex, byteCount, oldChars, charsAdded, newByteCount;
+ CONST char *string;
+ char *new;
+
+ string = entryPtr->string;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = strlen(value);
+ if (byteCount == 0) {
+ return;
+ }
+
+ newByteCount = entryPtr->numBytes + byteCount + 1;
+ new = (char *) ckalloc((unsigned) newByteCount);
+ memcpy(new, string, (size_t) byteIndex);
+ strcpy(new + byteIndex, value);
+ strcpy(new + byteIndex + byteCount, string + byteIndex);
+
+ if ((entryPtr->validate == VALIDATE_KEY ||
+ entryPtr->validate == VALIDATE_ALL) &&
+ EntryValidateChange(entryPtr, value, new, index,
+ VALIDATE_INSERT) != TCL_OK) {
+ ckfree(new);
+ return;
+ }
+
+ ckfree((char *)string);
+ entryPtr->string = new;
+
+ /*
+ * The following construction is used because inserting improperly
+ * formed UTF-8 sequences between other improperly formed UTF-8
+ * sequences could result in actually forming valid UTF-8 sequences;
+ * the number of characters added may not be Tcl_NumUtfChars(string, -1),
+ * because of context. The actual number of characters added is how
+ * many characters are in the string now minus the number that
+ * used to be there.
+ */
+
+ oldChars = entryPtr->numChars;
+ entryPtr->numChars = Tcl_NumUtfChars(new, -1);
+ charsAdded = entryPtr->numChars - oldChars;
+ entryPtr->numBytes += byteCount;
+
+ if (entryPtr->displayString == string) {
+ entryPtr->displayString = new;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * 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 += charsAdded;
+ }
+ if (entryPtr->selectLast > index) {
+ entryPtr->selectLast += charsAdded;
+ }
+ if ((entryPtr->selectAnchor > index)
+ || (entryPtr->selectFirst >= index)) {
+ entryPtr->selectAnchor += charsAdded;
+ }
+ if (entryPtr->leftIndex > index) {
+ entryPtr->leftIndex += charsAdded;
+ }
+ if (entryPtr->insertPos >= index) {
+ entryPtr->insertPos += charsAdded;
+ }
+ EntryValueChanged(entryPtr, NULL);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+ Entry *entryPtr; /* Entry widget to modify. */
+ int index; /* Index of first character to delete. */
+ int count; /* How many characters to delete. */
+{
+ int byteIndex, byteCount, newByteCount;
+ CONST char *string;
+ char *new, *todelete;
+
+ if ((index + count) > entryPtr->numChars) {
+ count = entryPtr->numChars - index;
+ }
+ if (count <= 0) {
+ return;
+ }
+
+ string = entryPtr->string;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = Tcl_UtfAtIndex(string + byteIndex, count) - (string + byteIndex);
+
+ newByteCount = entryPtr->numBytes + 1 - byteCount;
+ new = (char *) ckalloc((unsigned) newByteCount);
+ memcpy(new, string, (size_t) byteIndex);
+ strcpy(new + byteIndex, string + byteIndex + byteCount);
+
+ todelete = (char *) ckalloc((unsigned) (byteCount + 1));
+ memcpy(todelete, string + byteIndex, (size_t) byteCount);
+ todelete[byteCount] = '\0';
+
+ if ((entryPtr->validate == VALIDATE_KEY ||
+ entryPtr->validate == VALIDATE_ALL) &&
+ EntryValidateChange(entryPtr, todelete, new, index,
+ VALIDATE_DELETE) != TCL_OK) {
+ ckfree(new);
+ ckfree(todelete);
+ return;
+ }
+
+ ckfree(todelete);
+ ckfree((char *)entryPtr->string);
+ entryPtr->string = new;
+ entryPtr->numChars -= count;
+ entryPtr->numBytes -= byteCount;
+
+ if (entryPtr->displayString == string) {
+ entryPtr->displayString = new;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * 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 = -1;
+ 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;
+ }
+ }
+ EntryValueChanged(entryPtr, NULL);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryValueChanged --
+ *
+ * This procedure is invoked when characters are inserted into
+ * an entry or deleted from it. It updates the entry's associated
+ * variable, if there is one, and does other bookkeeping such
+ * as arranging for redisplay.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryValueChanged(entryPtr, newValue)
+ Entry *entryPtr; /* Entry whose value just changed. */
+ CONST char *newValue; /* If this value is not NULL, we first
+ * force the value of the entry to this */
+{
+ if (newValue != NULL) {
+ EntrySetValue(entryPtr, newValue);
+ }
+
+ if (entryPtr->textVarName == NULL) {
+ newValue = NULL;
+ } else {
+ newValue = Tcl_SetVar(entryPtr->interp, entryPtr->textVarName,
+ entryPtr->string, TCL_GLOBAL_ONLY);
+ }
+
+ if ((newValue != NULL) && (strcmp(newValue, entryPtr->string) != 0)) {
+ /*
+ * The value of the variable is different than what we asked for.
+ * This means that a trace on the variable modified it. In this
+ * case our trace procedure wasn't invoked since the modification
+ * came while a trace was already active on the variable. So,
+ * update our value to reflect the variable's latest value.
+ */
+
+ EntrySetValue(entryPtr, newValue);
+ } else {
+ /*
+ * Arrange for redisplay.
+ */
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. The selection,
+ * insertion point, and view may have to be adjusted to keep them
+ * within the bounds of the new string. Note: this procedure does
+ * *not* update the entry's associated variable, since that could
+ * result in an infinite loop.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntrySetValue(entryPtr, value)
+ Entry *entryPtr; /* Entry whose value is to be changed. */
+ CONST char *value; /* New text to display in entry. */
+{
+ CONST char *oldSource;
+ int code, valueLen, malloced = 0;
+
+ if (strcmp(value, entryPtr->string) == 0) {
+ return;
+ }
+ valueLen = strlen(value);
+
+ if (entryPtr->flags & VALIDATE_VAR) {
+ entryPtr->flags |= VALIDATE_ABORT;
+ } else {
+ /*
+ * If we validate, we create a copy of the value, as it may
+ * point to volatile memory, like the value of the -textvar
+ * which may get freed during validation
+ */
+ char *tmp = (char *) ckalloc((unsigned) (valueLen + 1));
+ strcpy(tmp, value);
+ value = tmp;
+ malloced = 1;
+
+ entryPtr->flags |= VALIDATE_VAR;
+ code = EntryValidateChange(entryPtr, (char *) NULL, value, -1,
+ VALIDATE_FORCED);
+ entryPtr->flags &= ~VALIDATE_VAR;
+ /*
+ * If VALIDATE_ABORT has been set, then this operation should be
+ * aborted because the validatecommand did something else instead
+ */
+ if (entryPtr->flags & VALIDATE_ABORT) {
+ entryPtr->flags &= ~VALIDATE_ABORT;
+ ckfree((char *)value);
+ return;
+ }
+ }
+
+ oldSource = entryPtr->string;
+ ckfree((char *)entryPtr->string);
+
+ if (malloced) {
+ entryPtr->string = value;
+ } else {
+ char *tmp = (char *) ckalloc((unsigned) (valueLen + 1));
+ strcpy(tmp, value);
+ entryPtr->string = tmp;
+ }
+ entryPtr->numBytes = valueLen;
+ entryPtr->numChars = Tcl_NumUtfChars(value, valueLen);
+
+ if (entryPtr->displayString == oldSource) {
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ if (entryPtr->selectFirst >= 0) {
+ if (entryPtr->selectFirst >= entryPtr->numChars) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ } else if (entryPtr->selectLast > entryPtr->numChars) {
+ entryPtr->selectLast = entryPtr->numChars;
+ }
+ }
+ if (entryPtr->leftIndex >= entryPtr->numChars) {
+ if (entryPtr->numChars > 0) {
+ entryPtr->leftIndex = entryPtr->numChars - 1;
+ } else {
+ entryPtr->leftIndex = 0;
+ }
+ }
+ if (entryPtr->insertPos > entryPtr->numChars) {
+ entryPtr->insertPos = entryPtr->numChars;
+ }
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on entries.
+ *
+ * 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. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+
+ if ((entryPtr->type == TK_SPINBOX) && (eventPtr->type == MotionNotify)) {
+ Spinbox *sbPtr = (Spinbox *) clientData;
+ int elem;
+
+ elem = GetSpinboxElement(sbPtr, eventPtr->xmotion.x,
+ eventPtr->xmotion.y);
+ if (elem != sbPtr->curElement) {
+ Tk_Cursor cursor;
+
+ sbPtr->curElement = elem;
+ if (elem == SEL_ENTRY) {
+ cursor = entryPtr->cursor;
+ } else if ((elem == SEL_BUTTONDOWN) || (elem == SEL_BUTTONUP)) {
+ cursor = sbPtr->bCursor;
+ } else {
+ cursor = None;
+ }
+ if (cursor != None) {
+ Tk_DefineCursor(entryPtr->tkwin, cursor);
+ } else {
+ Tk_UndefineCursor(entryPtr->tkwin);
+ }
+ }
+ return;
+ }
+
+ switch (eventPtr->type) {
+ case Expose:
+ EventuallyRedraw(entryPtr);
+ entryPtr->flags |= BORDER_NEEDED;
+ break;
+ case DestroyNotify:
+ if (!(entryPtr->flags & ENTRY_DELETED)) {
+ entryPtr->flags |= (ENTRY_DELETED | VALIDATE_ABORT);
+ Tcl_DeleteCommandFromToken(entryPtr->interp,
+ entryPtr->widgetCmd);
+ if (entryPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayEntry, clientData);
+ }
+ Tcl_EventuallyFree(clientData, DestroyEntry);
+ }
+ break;
+ case ConfigureNotify:
+ Tcl_Preserve((ClientData) entryPtr);
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ Tcl_Release((ClientData) entryPtr);
+ break;
+ case FocusIn:
+ case FocusOut:
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ EntryFocusProc(entryPtr, (eventPtr->type == FocusIn));
+ }
+ break;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ /*
+ * 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 (!(entryPtr->flags & ENTRY_DELETED)) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 character 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 the interp's 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 character
+ * index. */
+{
+ size_t length;
+
+ 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 the interp's result,
+ * so we have to clear it out before storing our own message.
+ */
+
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(interp, "bad ",
+ (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox",
+ " 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 < 0) {
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(interp, "selection isn't in widget ",
+ Tk_PathName(entryPtr->tkwin), (char *) NULL);
+ 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, maxWidth;
+
+ if (Tcl_GetInt(interp, string + 1, &x) != TCL_OK) {
+ goto badIndex;
+ }
+ if (x < entryPtr->inset) {
+ x = entryPtr->inset;
+ }
+ roundUp = 0;
+ maxWidth = Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - entryPtr->xWidth - 1;
+ if (x > maxWidth) {
+ x = maxWidth;
+ roundUp = 1;
+ }
+ *indexPtr = Tk_PointToChar(entryPtr->textLayout,
+ x - entryPtr->layoutX, 0);
+
+ /*
+ * Special trick: if the x-position was off-screen to the right,
+ * round the index up to refer to the character just after the
+ * last visible one on the screen. This is needed to enable the
+ * last character to be selected, for example.
+ */
+
+ if (roundUp && (*indexPtr < entryPtr->numChars)) {
+ *indexPtr += 1;
+ }
+ } 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryScanTo --
+ *
+ * Given a y-coordinate (presumably of the curent mouse location)
+ * drag the view in the window to implement the scan operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in the window may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryScanTo(entryPtr, x)
+ Entry *entryPtr; /* Information about widget. */
+ int x; /* X-coordinate to use for scan operation. */
+{
+ int newLeftIndex;
+
+ /*
+ * Compute new leftIndex for entry by amplifying the difference
+ * between the current position and the place where the scan
+ * started (the "mark" position). If we run off the left or right
+ * side of the entry, then reset the mark point so that the current
+ * position continues to correspond to the edge of the window.
+ * This means that the picture will start dragging as soon as the
+ * mouse reverses direction (without this reset, might have to slide
+ * mouse a long ways back before the picture starts moving again).
+ */
+
+ newLeftIndex = entryPtr->scanMarkIndex
+ - (10 * (x - entryPtr->scanMarkX)) / entryPtr->avgWidth;
+ if (newLeftIndex >= entryPtr->numChars) {
+ newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars - 1;
+ entryPtr->scanMarkX = x;
+ }
+ if (newLeftIndex < 0) {
+ newLeftIndex = entryPtr->scanMarkIndex = 0;
+ entryPtr->scanMarkX = x;
+ }
+
+ if (newLeftIndex != entryPtr->leftIndex) {
+ entryPtr->leftIndex = newLeftIndex;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ if (newLeftIndex != entryPtr->leftIndex) {
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ entryPtr->scanMarkX = x;
+ }
+ EventuallyRedraw(entryPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+ Entry *entryPtr; /* Information about widget. */
+ int index; /* Character index of element that is to
+ * become the "other" end of the selection. */
+{
+ int newFirst, newLast;
+
+ /*
+ * Grab the selection if we don't own it already.
+ */
+
+ if (!(entryPtr->flags & GOT_SELECTION) && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
+ (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+
+ /*
+ * 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);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EntryFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about entry widget. */
+ int offset; /* Byte offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place selection. */
+ int maxBytes; /* Maximum number of bytes to place at
+ * buffer, not including terminating NULL
+ * character. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ int byteCount;
+ CONST char *string;
+ CONST char *selStart, *selEnd;
+
+ if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) {
+ return -1;
+ }
+ string = entryPtr->displayString;
+ selStart = Tcl_UtfAtIndex(string, entryPtr->selectFirst);
+ selEnd = Tcl_UtfAtIndex(selStart,
+ entryPtr->selectLast - entryPtr->selectFirst);
+ byteCount = selEnd - selStart - offset;
+ if (byteCount > maxBytes) {
+ byteCount = maxBytes;
+ }
+ if (byteCount <= 0) {
+ return 0;
+ }
+ memcpy(buffer, selStart + offset, (size_t) byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from an entry widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryLostSelection(clientData)
+ ClientData clientData; /* Information about entry widget. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+
+ entryPtr->flags &= ~GOT_SELECTION;
+
+ /*
+ * On Windows and Mac systems, we want to remember the selection
+ * for the next time the focus enters the window. On Unix, we need
+ * to clear the selection since it is always visible.
+ */
+
+#ifdef ALWAYS_SHOW_SELECTION
+ if ((entryPtr->selectFirst >= 0) && entryPtr->exportSelection) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+#endif
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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->flags & ENTRY_DELETED) || !Tk_IsMapped(entryPtr->tkwin)) {
+ 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;
+ Tcl_DoWhenIdle(DisplayEntry, (ClientData) entryPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ int charsInWindow;
+
+ if (entryPtr->numChars == 0) {
+ *firstPtr = 0.0;
+ *lastPtr = 1.0;
+ } else {
+ charsInWindow = Tk_PointToChar(entryPtr->textLayout,
+ Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - entryPtr->xWidth - entryPtr->layoutX - 1, 0);
+ if (charsInWindow < entryPtr->numChars) {
+ charsInWindow++;
+ }
+ charsInWindow -= entryPtr->leftIndex;
+ if (charsInWindow == 0) {
+ charsInWindow = 1;
+ }
+
+ *firstPtr = (double) entryPtr->leftIndex / entryPtr->numChars;
+ *lastPtr = (double) (entryPtr->leftIndex + charsInWindow)
+ / entryPtr->numChars;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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[TCL_DOUBLE_SPACE * 2];
+ int code;
+ double first, last;
+ Tcl_Interp *interp;
+
+ if (entryPtr->scrollCmd == NULL) {
+ return;
+ }
+
+ interp = entryPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ EntryVisibleRange(entryPtr, &first, &last);
+ sprintf(args, " %g %g", first, last);
+ code = Tcl_VarEval(interp, entryPtr->scrollCmd, args, (char *) NULL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by ");
+ Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin));
+ Tcl_AddErrorInfo(interp, ")");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_Release((ClientData) interp);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryBlinkProc --
+ *
+ * This procedure is called as a timer handler to blink the
+ * insertion cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked,
+ * and this procedure reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryBlinkProc(clientData)
+ ClientData clientData; /* Pointer to record describing entry. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+
+ if ((entryPtr->state == STATE_DISABLED) ||
+ (entryPtr->state == STATE_READONLY) ||
+ !(entryPtr->flags & GOT_FOCUS) || (entryPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (entryPtr->flags & CURSOR_ON) {
+ entryPtr->flags &= ~CURSOR_ON;
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOffTime, EntryBlinkProc, (ClientData) entryPtr);
+ } else {
+ entryPtr->flags |= CURSOR_ON;
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOnTime, EntryBlinkProc, (ClientData) entryPtr);
+ }
+ EventuallyRedraw(entryPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
+ if (gotFocus) {
+ entryPtr->flags |= GOT_FOCUS | CURSOR_ON;
+ if (entryPtr->insertOffTime != 0) {
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOnTime, EntryBlinkProc,
+ (ClientData) entryPtr);
+ }
+ if (entryPtr->validate == VALIDATE_ALL ||
+ entryPtr->validate == VALIDATE_FOCUS ||
+ entryPtr->validate == VALIDATE_FOCUSIN) {
+ EntryValidateChange(entryPtr, (char *) NULL,
+ entryPtr->string, -1, VALIDATE_FOCUSIN);
+ }
+ } else {
+ entryPtr->flags &= ~(GOT_FOCUS | CURSOR_ON);
+ entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ if (entryPtr->validate == VALIDATE_ALL ||
+ entryPtr->validate == VALIDATE_FOCUS ||
+ entryPtr->validate == VALIDATE_FOCUSOUT) {
+ EntryValidateChange(entryPtr, (char *) NULL,
+ entryPtr->string, -1, VALIDATE_FOCUSOUT);
+ }
+ }
+ EventuallyRedraw(entryPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+EntryTextVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ CONST char *name1; /* Not used. */
+ CONST char *name2; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ CONST 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 = "";
+ }
+ EntrySetValue(entryPtr, value);
+ return (char *) NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryValidate --
+ *
+ * This procedure is invoked when any character is added or
+ * removed from the entry widget, or a focus has trigerred validation.
+ *
+ * Results:
+ * TCL_OK if the validatecommand passes the new string.
+ * TCL_BREAK if the vcmd executed OK, but rejects the string.
+ * TCL_ERROR if an error occurred while executing the vcmd
+ * or a valid Tcl_Bool is not returned.
+ *
+ * Side effects:
+ * An error condition may arise
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EntryValidate(entryPtr, cmd)
+ register Entry *entryPtr; /* Entry that needs validation. */
+ register char *cmd; /* Validation command (NULL-terminated
+ * string). */
+{
+ register Tcl_Interp *interp = entryPtr->interp;
+ int code, bool;
+
+ code = Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+
+ /*
+ * We accept TCL_OK and TCL_RETURN as valid return codes from the
+ * command callback.
+ */
+ if (code != TCL_OK && code != TCL_RETURN) {
+ Tcl_AddErrorInfo(interp, "\n\t(in validation command executed by ");
+ Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin));
+ Tcl_AddErrorInfo(interp, ")");
+ Tcl_BackgroundError(interp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * The command callback should return an acceptable Tcl boolean.
+ */
+ if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
+ &bool) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\nvalid boolean not returned by validation command");
+ Tcl_BackgroundError(interp);
+ Tcl_SetResult(interp, NULL, 0);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, NULL, 0);
+ return (bool ? TCL_OK : TCL_BREAK);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryValidateChange --
+ *
+ * This procedure is invoked when any character is added or
+ * removed from the entry widget, or a focus has trigerred validation.
+ *
+ * Results:
+ * TCL_OK if the validatecommand accepts the new string,
+ * TCL_ERROR if any problems occured with validatecommand.
+ *
+ * Side effects:
+ * The insertion/deletion may be aborted, and the
+ * validatecommand might turn itself off (if an error
+ * or loop condition arises).
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EntryValidateChange(entryPtr, change, new, index, type)
+ register Entry *entryPtr; /* Entry that needs validation. */
+ char *change; /* Characters to be added/deleted
+ * (NULL-terminated string). */
+ CONST char *new; /* Potential new value of entry string */
+ int index; /* index of insert/delete, -1 otherwise */
+ int type; /* forced, delete, insert,
+ * focusin or focusout */
+{
+ int code, varValidate = (entryPtr->flags & VALIDATE_VAR);
+ char *p;
+ Tcl_DString script;
+
+ if (entryPtr->validateCmd == NULL ||
+ entryPtr->validate == VALIDATE_NONE) {
+ return (varValidate ? TCL_ERROR : TCL_OK);
+ }
+
+ /*
+ * If we're already validating, then we're hitting a loop condition
+ * Return and set validate to 0 to disallow further validations
+ * and prevent current validation from finishing
+ */
+ if (entryPtr->flags & VALIDATING) {
+ entryPtr->validate = VALIDATE_NONE;
+ return (varValidate ? TCL_ERROR : TCL_OK);
+ }
+
+ entryPtr->flags |= VALIDATING;
+
+ /*
+ * Now form command string and run through the -validatecommand
+ */
+
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, entryPtr->validateCmd,
+ change, new, index, type, &script);
+ Tcl_DStringAppend(&script, "", 1);
+
+ p = Tcl_DStringValue(&script);
+ code = EntryValidate(entryPtr, p);
+ Tcl_DStringFree(&script);
+
+ /*
+ * If e->validate has become VALIDATE_NONE during the validation, or
+ * we now have VALIDATE_VAR set (from EntrySetValue) and didn't before,
+ * it means that a loop condition almost occured. Do not allow
+ * this validation result to finish.
+ */
+
+ if (entryPtr->validate == VALIDATE_NONE
+ || (!varValidate && (entryPtr->flags & VALIDATE_VAR))) {
+ code = TCL_ERROR;
+ }
+
+ /*
+ * It's possible that the user deleted the entry during validation.
+ * In that case, abort future validation and return an error.
+ */
+
+ if (entryPtr->flags & ENTRY_DELETED) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If validate will return ERROR, then disallow further validations
+ * Otherwise, if it didn't accept the new string (returned TCL_BREAK)
+ * then eval the invalidCmd (if it's set)
+ */
+
+ if (code == TCL_ERROR) {
+ entryPtr->validate = VALIDATE_NONE;
+ } else if (code == TCL_BREAK) {
+ /*
+ * If we were doing forced validation (like via a variable
+ * trace) and the command returned 0, the we turn off validation
+ * because we assume that textvariables have precedence in
+ * managing the value. We also don't call the invcmd, as it
+ * may want to do entry manipulation which the setting of the
+ * var will later wipe anyway.
+ */
+
+ if (varValidate) {
+ entryPtr->validate = VALIDATE_NONE;
+ } else if (entryPtr->invalidCmd != NULL) {
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, entryPtr->invalidCmd,
+ change, new, index, type, &script);
+ Tcl_DStringAppend(&script, "", 1);
+ p = Tcl_DStringValue(&script);
+ if (Tcl_EvalEx(entryPtr->interp, p, -1,
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) != TCL_OK) {
+ Tcl_AddErrorInfo(entryPtr->interp,
+ "\n\t(in invalidcommand executed by entry)");
+ Tcl_BackgroundError(entryPtr->interp);
+ code = TCL_ERROR;
+ entryPtr->validate = VALIDATE_NONE;
+ }
+ Tcl_DStringFree(&script);
+
+ /*
+ * It's possible that the user deleted the entry during validation.
+ * In that case, abort future validation and return an error.
+ */
+
+ if (entryPtr->flags & ENTRY_DELETED) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ entryPtr->flags &= ~VALIDATING;
+
+ return code;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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(entryPtr, before, change, new, index, type, dsPtr)
+ register Entry *entryPtr; /* Entry that needs validation. */
+ register CONST char *before;
+ /* Command containing percent
+ * expressions to be replaced. */
+ char *change; /* Characters to added/deleted
+ * (NULL-terminated string). */
+ CONST char *new; /* Potential new value of entry string */
+ int index; /* index of insert/delete */
+ int type; /* INSERT or DELETE */
+ 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, length;
+ register CONST char *string;
+ Tcl_UniChar ch;
+ char numStorage[2*TCL_INTEGER_SPACE];
+
+ while (1) {
+ if (*before == '\0') {
+ break;
+ }
+ /*
+ * Find everything up to the next % character and append it
+ * to the result string.
+ */
+
+ string = before;
+ /* No need to convert '%', as it is in ascii range */
+ string = Tcl_UtfFindFirst(before, '%');
+ if (string == (char *) NULL) {
+ Tcl_DStringAppend(dsPtr, before, -1);
+ break;
+ } else if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, string-before);
+ before = string;
+ }
+
+ /*
+ * There's a percent sequence here. Process it.
+ */
+
+ before++; /* skip over % */
+ if (*before != '\0') {
+ before += Tcl_UtfToUniChar(before, &ch);
+ } else {
+ ch = '%';
+ }
+ if (type == VALIDATE_BUTTON) {
+ /*
+ * -command %-substitution
+ */
+ switch (ch) {
+ case 's': /* Current string value of spinbox */
+ string = entryPtr->string;
+ break;
+ case 'd': /* direction, up or down */
+ string = change;
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(entryPtr->tkwin);
+ break;
+ default:
+ length = Tcl_UniCharToUtf(ch, numStorage);
+ numStorage[length] = '\0';
+ string = numStorage;
+ break;
+ }
+ } else {
+ /*
+ * -validatecommand / -invalidcommand %-substitution
+ */
+ switch (ch) {
+ case 'd': /* Type of call that caused validation */
+ switch (type) {
+ case VALIDATE_INSERT:
+ number = 1;
+ break;
+ case VALIDATE_DELETE:
+ number = 0;
+ break;
+ default:
+ number = -1;
+ break;
+ }
+ sprintf(numStorage, "%d", number);
+ string = numStorage;
+ break;
+ case 'i': /* index of insert/delete */
+ sprintf(numStorage, "%d", index);
+ string = numStorage;
+ break;
+ case 'P': /* 'Peeked' new value of the string */
+ string = new;
+ break;
+ case 's': /* Current string value of spinbox */
+ string = entryPtr->string;
+ break;
+ case 'S': /* string to be inserted/deleted, if any */
+ string = change;
+ break;
+ case 'v': /* type of validation currently set */
+ string = validateStrings[entryPtr->validate];
+ break;
+ case 'V': /* type of validation in effect */
+ switch (type) {
+ case VALIDATE_INSERT:
+ case VALIDATE_DELETE:
+ string = validateStrings[VALIDATE_KEY];
+ break;
+ case VALIDATE_FORCED:
+ string = "forced";
+ break;
+ default:
+ string = validateStrings[type];
+ break;
+ }
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(entryPtr->tkwin);
+ break;
+ default:
+ length = Tcl_UniCharToUtf(ch, numStorage);
+ numStorage[length] = '\0';
+ string = numStorage;
+ break;
+ }
+ }
+
+ spaceNeeded = Tcl_ScanCountedElement(string, -1, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertCountedElement(string, -1,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SpinboxObjCmd --
+ *
+ * This procedure is invoked to process the "spinbox" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SpinboxObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Entry *entryPtr;
+ register Spinbox *sbPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ char *tmp;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, Tk will return the cached value.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, sbOptSpec);
+
+ /*
+ * 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). Only the non-NULL/0
+ * data must be initialized as memset covers the rest.
+ */
+
+ sbPtr = (Spinbox *) ckalloc(sizeof(Spinbox));
+ entryPtr = (Entry *) sbPtr;
+ memset((VOID *) sbPtr, 0, sizeof(Spinbox));
+
+ entryPtr->tkwin = tkwin;
+ entryPtr->display = Tk_Display(tkwin);
+ entryPtr->interp = interp;
+ entryPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(entryPtr->tkwin), SpinboxWidgetObjCmd,
+ (ClientData) sbPtr, EntryCmdDeletedProc);
+ entryPtr->optionTable = optionTable;
+ entryPtr->type = TK_SPINBOX;
+ tmp = (char *) ckalloc(1);
+ tmp[0] = '\0';
+ entryPtr->string = tmp;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->justify = TK_JUSTIFY_LEFT;
+ entryPtr->relief = TK_RELIEF_FLAT;
+ entryPtr->state = STATE_NORMAL;
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->inset = XPAD;
+ entryPtr->textGC = None;
+ entryPtr->selTextGC = None;
+ entryPtr->highlightGC = None;
+ entryPtr->avgWidth = 1;
+ entryPtr->validate = VALIDATE_NONE;
+
+ sbPtr->selElement = SEL_NONE;
+ sbPtr->curElement = SEL_NONE;
+ sbPtr->bCursor = None;
+ sbPtr->repeatDelay = 400;
+ sbPtr->repeatInterval = 100;
+ sbPtr->fromValue = 0.0;
+ sbPtr->toValue = 100.0;
+ sbPtr->increment = 1.0;
+ sbPtr->formatBuf = (char *) ckalloc(TCL_DOUBLE_SPACE);
+ sbPtr->bdRelief = TK_RELIEF_FLAT;
+ sbPtr->buRelief = TK_RELIEF_FLAT;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the listbox,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve((ClientData) entryPtr->tkwin);
+
+ Tk_SetClass(entryPtr->tkwin, "Spinbox");
+ Tk_SetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr);
+ Tk_CreateEventHandler(entryPtr->tkwin,
+ PointerMotionMask|ExposureMask|StructureNotifyMask|FocusChangeMask,
+ EntryEventProc, (ClientData) entryPtr);
+ Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, (ClientData) entryPtr, XA_STRING);
+
+ if (Tk_InitOptions(interp, (char *) sbPtr, optionTable, tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+ }
+ if (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * SpinboxWidgetObjCmd --
+ *
+ * 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
+SpinboxWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about spinbox widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ Spinbox *sbPtr = (Spinbox *) clientData;
+ int cmdIndex, selIndex, result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the widget command by looking up the second token in
+ * the list of valid command names.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], sbCmdNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve((ClientData) entryPtr);
+ switch ((enum sbCmd) cmdIndex) {
+ case SB_CMD_BBOX: {
+ int index, x, y, width, height;
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index == entryPtr->numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->textLayout, index, &x, &y,
+ &width, &height);
+ sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX,
+ y + entryPtr->layoutY, width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+
+ case SB_CMD_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) entryPtr,
+ entryPtr->optionTable, objv[2], entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+
+ case SB_CMD_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr,
+ entryPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0);
+ }
+ break;
+ }
+
+ case SB_CMD_DELETE: {
+ int first, last;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &first) != TCL_OK) {
+ goto error;
+ }
+ if (objc == 3) {
+ last = first + 1;
+ } else {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]),
+ &last) != TCL_OK) {
+ goto error;
+ }
+ }
+ if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
+ DeleteChars(entryPtr, first, last - first);
+ }
+ break;
+ }
+
+ case SB_CMD_GET: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ goto error;
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ break;
+ }
+
+ case SB_CMD_ICURSOR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &entryPtr->insertPos) != TCL_OK) {
+ goto error;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+
+ case SB_CMD_IDENTIFY: {
+ int x, y, elem;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) ||
+ (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ elem = GetSpinboxElement(sbPtr, x, y);
+ if (elem != SEL_NONE) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ selElementNames[elem], -1);
+ }
+ break;
+ }
+
+ case SB_CMD_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ break;
+ }
+
+ case SB_CMD_INSERT: {
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state == STATE_NORMAL) {
+ InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ }
+ break;
+ }
+
+ case SB_CMD_INVOKE: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "elemName");
+ goto error;
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[2],
+ selElementNames, "element", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state != STATE_DISABLED) {
+ if (SpinboxInvoke(interp, sbPtr, cmdIndex) != TCL_OK) {
+ goto error;
+ }
+ }
+ break;
+ }
+
+ case SB_CMD_SCAN: {
+ int x;
+ char *minorCmd;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x");
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ goto error;
+ }
+
+ minorCmd = Tcl_GetString(objv[2]);
+ if (minorCmd[0] == 'm'
+ && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) {
+ entryPtr->scanMarkX = x;
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ } else if ((minorCmd[0] == 'd')
+ && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) {
+ EntryScanTo(entryPtr, x);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"",
+ Tcl_GetString(objv[2]), "\": must be mark or dragto",
+ (char *) NULL);
+ goto error;
+ }
+ break;
+ }
+
+ case SB_CMD_SELECTION: {
+ int index, index2;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?index?");
+ goto error;
+ }
+
+ /*
+ * Parse the selection sub-command, using the command
+ * table "sbSelCmdNames" defined above.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], sbSelCmdNames,
+ "selection option", 0, &selIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Disabled entries don't allow the selection to be modified.
+ */
+
+ if (entryPtr->state == STATE_DISABLED) {
+ goto done;
+ }
+
+ switch(selIndex) {
+ case SB_SEL_ADJUST: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ 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);
+ break;
+ }
+
+ case SB_SEL_CLEAR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+ goto done;
+ }
+
+ case SB_SEL_FROM: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ entryPtr->selectAnchor = index;
+ break;
+ }
+
+ case SB_SEL_PRESENT: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj((entryPtr->selectFirst >= 0)));
+ goto done;
+ }
+
+ case SB_SEL_RANGE: {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "start end");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[4]),& index2) != TCL_OK) {
+ goto error;
+ }
+ if (index >= index2) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ } else {
+ entryPtr->selectFirst = index;
+ entryPtr->selectLast = index2;
+ }
+ if (!(entryPtr->flags & GOT_SELECTION)
+ && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY,
+ EntryLostSelection, (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+
+ case SB_SEL_TO: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+ }
+
+ case SB_SEL_ELEMENT: {
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?elemName?");
+ goto error;
+ }
+ if (objc == 3) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ selElementNames[sbPtr->selElement], -1);
+ } else {
+ int lastElement = sbPtr->selElement;
+
+ result = Tcl_GetIndexFromObj(interp, objv[3],
+ selElementNames, "selection element", 0,
+ &(sbPtr->selElement));
+ if (result != TCL_OK) {
+ goto error;
+ }
+ if (lastElement != sbPtr->selElement) {
+ EventuallyRedraw(entryPtr);
+ }
+ }
+ break;
+ }
+ }
+ break;
+ }
+
+ case SB_CMD_SET: {
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?string?");
+ goto error;
+ }
+ if (objc == 3) {
+ EntryValueChanged(entryPtr, Tcl_GetString(objv[2]));
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ break;
+ }
+
+ case SB_CMD_VALIDATE: {
+ int code;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ goto error;
+ }
+ selIndex = entryPtr->validate;
+ entryPtr->validate = VALIDATE_ALL;
+ code = EntryValidateChange(entryPtr, (char *) NULL,
+ entryPtr->string, -1, VALIDATE_FORCED);
+ if (entryPtr->validate != VALIDATE_NONE) {
+ entryPtr->validate = selIndex;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK)));
+ break;
+ }
+
+ case SB_CMD_XVIEW: {
+ int index;
+
+ if (objc == 2) {
+ double first, last;
+ char buf[TCL_DOUBLE_SPACE * 2];
+
+ EntryVisibleRange(entryPtr, &first, &last);
+ sprintf(buf, "%g %g", first, last);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ goto done;
+ } else if (objc == 3) {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ double fraction;
+ int count;
+
+ index = entryPtr->leftIndex;
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction,
+ &count)) {
+ case TK_SCROLL_ERROR: {
+ goto error;
+ }
+ case TK_SCROLL_MOVETO: {
+ index = (int) ((fraction * entryPtr->numChars) + 0.5);
+ break;
+ }
+ case TK_SCROLL_PAGES: {
+ int charsPerPage;
+
+ charsPerPage = ((Tk_Width(entryPtr->tkwin)
+ - 2 * entryPtr->inset - entryPtr->xWidth)
+ / entryPtr->avgWidth) - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ index += count * charsPerPage;
+ break;
+ }
+ case TK_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);
+ break;
+ }
+ }
+
+ done:
+ Tcl_Release((ClientData) entryPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) entryPtr);
+ return TCL_ERROR;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetSpinboxElement --
+ *
+ * Return the element associated with an x,y coord.
+ *
+ * Results:
+ * Element type as enum selelement.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetSpinboxElement(sbPtr, x, y)
+ Spinbox *sbPtr; /* Spinbox for which the index is being
+ * specified. */
+ int x; /* x coord */
+ int y; /* y coord */
+{
+ Entry *entryPtr = (Entry *) sbPtr;
+
+ if ((x < 0) || (y < 0) || (y > Tk_Height(entryPtr->tkwin))
+ || (x > Tk_Width(entryPtr->tkwin))) {
+ return SEL_NONE;
+ }
+
+ if (x > (Tk_Width(entryPtr->tkwin) - entryPtr->inset - entryPtr->xWidth)) {
+ if (y > (Tk_Height(entryPtr->tkwin) / 2)) {
+ return SEL_BUTTONDOWN;
+ } else {
+ return SEL_BUTTONUP;
+ }
+ }
+ return SEL_ENTRY;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * SpinboxInvoke --
+ *
+ * This procedure is invoked when the invoke method for the
+ * widget is called.
+ *
+ * Results:
+ * TCL_OK.
+ *
+ * Side effects:
+ * An background error condition may arise when invoking the
+ * callback. The widget value may change.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SpinboxInvoke(interp, sbPtr, element)
+ register Tcl_Interp *interp; /* Current interpreter. */
+ register Spinbox *sbPtr; /* Spinbox to invoke. */
+ int element; /* element to invoke, either the "up"
+ * or "down" button. */
+{
+ Entry *entryPtr = (Entry *) sbPtr;
+ char *type;
+ int code, up;
+ Tcl_DString script;
+
+ switch (element) {
+ case SEL_BUTTONUP:
+ type = "up";
+ up = 1;
+ break;
+ case SEL_BUTTONDOWN:
+ type = "down";
+ up = 0;
+ break;
+ default:
+ return TCL_OK;
+ }
+
+ if (fabs(sbPtr->increment) > MIN_DBL_VAL) {
+ if (sbPtr->listObj != NULL) {
+ Tcl_Obj *objPtr;
+
+ Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr);
+ if (strcmp(Tcl_GetString(objPtr), entryPtr->string)) {
+ /*
+ * Somehow the string changed from what we expected,
+ * so let's do a search on the list to see if the current
+ * value is there. If not, move to the first element of
+ * the list.
+ */
+ int i, listc, elemLen, length = entryPtr->numChars;
+ char *bytes;
+ Tcl_Obj **listv;
+
+ Tcl_ListObjGetElements(interp, sbPtr->listObj, &listc, &listv);
+ for (i = 0; i < listc; i++) {
+ bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
+ if ((length == elemLen) &&
+ (memcmp(bytes, entryPtr->string,
+ (size_t) length) == 0)) {
+ sbPtr->eIndex = i;
+ break;
+ }
+ }
+ }
+ if (up) {
+ if (++sbPtr->eIndex >= sbPtr->nElements) {
+ if (sbPtr->wrap) {
+ sbPtr->eIndex = 0;
+ } else {
+ sbPtr->eIndex = sbPtr->nElements-1;
+ }
+ }
+ } else {
+ if (--sbPtr->eIndex < 0) {
+ if (sbPtr->wrap) {
+ sbPtr->eIndex = sbPtr->nElements-1;
+ } else {
+ sbPtr->eIndex = 0;
+ }
+ }
+ }
+ Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr);
+ EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
+ } else if (!DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)) {
+ double dvalue;
+
+ if (Tcl_GetDouble(NULL, entryPtr->string, &dvalue) != TCL_OK) {
+ /*
+ * If the string is empty, or isn't a valid double value,
+ * just use the -from value
+ */
+ dvalue = sbPtr->fromValue;
+ } else {
+ if (up) {
+ dvalue += sbPtr->increment;
+ if (dvalue > sbPtr->toValue) {
+ if (sbPtr->wrap) {
+ dvalue = sbPtr->fromValue;
+ } else {
+ dvalue = sbPtr->toValue;
+ }
+ } else if (dvalue < sbPtr->fromValue) {
+ /*
+ * It's possible that when pressing up, we are
+ * still less than the fromValue, because the
+ * user may have manipulated the value by hand.
+ */
+ dvalue = sbPtr->fromValue;
+ }
+ } else {
+ dvalue -= sbPtr->increment;
+ if (dvalue < sbPtr->fromValue) {
+ if (sbPtr->wrap) {
+ dvalue = sbPtr->toValue;
+ } else {
+ dvalue = sbPtr->fromValue;
+ }
+ } else if (dvalue > sbPtr->toValue) {
+ /*
+ * It's possible that when pressing down, we are
+ * still greater than the toValue, because the
+ * user may have manipulated the value by hand.
+ */
+ dvalue = sbPtr->toValue;
+ }
+ }
+ }
+ sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue);
+ EntryValueChanged(entryPtr, sbPtr->formatBuf);
+ }
+ }
+
+ if (sbPtr->command != NULL) {
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, sbPtr->command, type, "", 0,
+ VALIDATE_BUTTON, &script);
+ Tcl_DStringAppend(&script, "", 1);
+
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&script), -1,
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+ Tcl_DStringFree(&script);
+
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n\t(in command executed by spinbox)");
+ Tcl_BackgroundError(interp);
+ /*
+ * Yes, it's an error, but a bg one, so we return OK
+ */
+ return TCL_OK;
+ }
+
+ Tcl_SetResult(interp, NULL, 0);
+ }
+
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFormat --
+ *
+ * This procedure is invoked to recompute the "format" fields
+ * of a spinbox's widget record, which determines how the value
+ * of the dial is converted to a string.
+ *
+ * Results:
+ * Tcl result code.
+ *
+ * Side effects:
+ * The format fields of the spinbox are modified.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ComputeFormat(sbPtr)
+ Spinbox *sbPtr; /* Information about dial widget. */
+{
+ double maxValue, x;
+ int mostSigDigit, numDigits, leastSigDigit, afterDecimal;
+ int eDigits, fDigits;
+
+ /*
+ * Compute the displacement from the decimal of the most significant
+ * digit required for any number in the dial's range.
+ */
+
+ if (sbPtr->reqFormat) {
+ sbPtr->valueFormat = sbPtr->reqFormat;
+ return TCL_OK;
+ }
+
+ maxValue = fabs(sbPtr->fromValue);
+ x = fabs(sbPtr->toValue);
+ if (x > maxValue) {
+ maxValue = x;
+ }
+ if (maxValue == 0) {
+ maxValue = 1;
+ }
+ mostSigDigit = (int) floor(log10(maxValue));
+
+ if (fabs(sbPtr->increment) > MIN_DBL_VAL) {
+ /*
+ * A increment was specified, so use it.
+ */
+ leastSigDigit = (int) floor(log10(sbPtr->increment));
+ } else {
+ leastSigDigit = 0;
+ }
+ numDigits = mostSigDigit - leastSigDigit + 1;
+ if (numDigits < 1) {
+ numDigits = 1;
+ }
+
+ /*
+ * Compute the number of characters required using "e" format and
+ * "f" format, and then choose whichever one takes fewer characters.
+ */
+
+ eDigits = numDigits + 4;
+ if (numDigits > 1) {
+ eDigits++; /* Decimal point. */
+ }
+ afterDecimal = numDigits - mostSigDigit - 1;
+ if (afterDecimal < 0) {
+ afterDecimal = 0;
+ }
+ fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal;
+ if (afterDecimal > 0) {
+ fDigits++; /* Decimal point. */
+ }
+ if (mostSigDigit < 0) {
+ fDigits++; /* Zero to left of decimal point. */
+ }
+ if (fDigits <= eDigits) {
+ sprintf(sbPtr->digitFormat, "%%.%df", afterDecimal);
+ } else {
+ sprintf(sbPtr->digitFormat, "%%.%de", numDigits-1);
+ }
+ sbPtr->valueFormat = sbPtr->digitFormat;
+ return TCL_OK;
+}
--- /dev/null
+/*
+ * tkError.c --
+ *
+ * This file provides a high-performance mechanism for
+ * selectively dealing with errors that occur in talking
+ * to the X server. This is useful, for example, when
+ * communicating with a window that may not exist.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The default X error handler gets saved here, so that it can
+ * be invoked if an error occurs that we can't handle.
+ */
+
+static int (*defaultHandler) _ANSI_ARGS_((Display *display,
+ XErrorEvent *eventPtr)) = NULL;
+
+
+/*
+ * Forward references to procedures declared later in this file:
+ */
+
+static int ErrorProc _ANSI_ARGS_((Display *display,
+ XErrorEvent *errEventPtr));
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateErrorHandler --
+ *
+ * Arrange for all a given procedure to be invoked whenever
+ * certain errors occur.
+ *
+ * Results:
+ * The return value is a token identifying the handler;
+ * it must be passed to Tk_DeleteErrorHandler to delete the
+ * handler.
+ *
+ * Side effects:
+ * If an X error occurs that matches the error, request,
+ * and minor arguments, then errorProc will be invoked.
+ * ErrorProc should have the following structure:
+ *
+ * int
+ * errorProc(clientData, errorEventPtr)
+ * caddr_t clientData;
+ * XErrorEvent *errorEventPtr;
+ * {
+ * }
+ *
+ * The clientData argument will be the same as the clientData
+ * argument to this procedure, and errorEvent will describe
+ * the error. If errorProc returns 0, it means that it
+ * completely "handled" the error: no further processing
+ * should be done. If errorProc returns 1, it means that it
+ * didn't know how to deal with the error, so we should look
+ * for other error handlers, or invoke the default error
+ * handler if no other handler returns zero. Handlers are
+ * invoked in order of age: youngest handler first.
+ *
+ * Note: errorProc will only be called for errors associated
+ * with X requests made AFTER this call, but BEFORE the handler
+ * is deleted by calling Tk_DeleteErrorHandler.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_ErrorHandler
+Tk_CreateErrorHandler(display, error, request, minorCode, errorProc, clientData)
+ Display *display; /* Display for which to handle
+ * errors. */
+ int error; /* Consider only errors with this
+ * error_code (-1 means consider
+ * all errors). */
+ int request; /* Consider only errors with this
+ * major request code (-1 means
+ * consider all major codes). */
+ int minorCode; /* Consider only errors with this
+ * minor request code (-1 means
+ * consider all minor codes). */
+ Tk_ErrorProc *errorProc; /* Procedure to invoke when a
+ * matching error occurs. NULL means
+ * just ignore matching errors. */
+ ClientData clientData; /* Arbitrary value to pass to
+ * errorProc. */
+{
+ register TkErrorHandler *errorPtr;
+ register TkDisplay *dispPtr;
+
+ /*
+ * Find the display. If Tk doesn't know about this display then
+ * it's an error: panic.
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ panic("Unknown display passed to Tk_CreateErrorHandler");
+ }
+
+ /*
+ * Make sure that X calls us whenever errors occur.
+ */
+
+ if (defaultHandler == NULL) {
+ defaultHandler = XSetErrorHandler(ErrorProc);
+ }
+
+ /*
+ * Create the handler record.
+ */
+
+ errorPtr = (TkErrorHandler *) ckalloc(sizeof(TkErrorHandler));
+ errorPtr->dispPtr = dispPtr;
+ errorPtr->firstRequest = NextRequest(display);
+ errorPtr->lastRequest = (unsigned) -1;
+ errorPtr->error = error;
+ errorPtr->request = request;
+ errorPtr->minorCode = minorCode;
+ errorPtr->errorProc = errorProc;
+ errorPtr->clientData = clientData;
+ errorPtr->nextPtr = dispPtr->errorPtr;
+ dispPtr->errorPtr = errorPtr;
+
+ return (Tk_ErrorHandler) errorPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteErrorHandler --
+ *
+ * Do not use an error handler anymore.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The handler denoted by the "handler" argument will not
+ * be invoked for any X errors associated with requests
+ * made after this call. However, if errors arrive later
+ * for requests made BEFORE this call, then the handler
+ * will still be invoked. Call XSync if you want to be
+ * sure that all outstanding errors have been received
+ * and processed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteErrorHandler(handler)
+ Tk_ErrorHandler handler; /* Token for handler to delete;
+ * was previous return value from
+ * Tk_CreateErrorHandler. */
+{
+ register TkErrorHandler *errorPtr = (TkErrorHandler *) handler;
+ register TkDisplay *dispPtr = errorPtr->dispPtr;
+
+ errorPtr->lastRequest = NextRequest(dispPtr->display) - 1;
+
+ /*
+ * Every once-in-a-while, cleanup handlers that are no longer
+ * active. We probably won't be able to free the handler that
+ * was just deleted (need to wait for any outstanding requests to
+ * be processed by server), but there may be previously-deleted
+ * handlers that are now ready for garbage collection. To reduce
+ * the cost of the cleanup, let a few dead handlers pile up, then
+ * clean them all at once. This adds a bit of overhead to errors
+ * that might occur while the dead handlers are hanging around,
+ * but reduces the overhead of scanning the list to clean up
+ * (particularly if there are many handlers that stay around
+ * forever).
+ */
+
+ dispPtr->deleteCount += 1;
+ if (dispPtr->deleteCount >= 10) {
+ register TkErrorHandler *prevPtr;
+ TkErrorHandler *nextPtr;
+ int lastSerial;
+
+ dispPtr->deleteCount = 0;
+ lastSerial = LastKnownRequestProcessed(dispPtr->display);
+ errorPtr = dispPtr->errorPtr;
+ for (prevPtr = NULL; errorPtr != NULL; errorPtr = nextPtr) {
+ nextPtr = errorPtr->nextPtr;
+ if ((errorPtr->lastRequest != (unsigned long) -1)
+ && (errorPtr->lastRequest <= (unsigned long) lastSerial)) {
+ if (prevPtr == NULL) {
+ dispPtr->errorPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ ckfree((char *) errorPtr);
+ continue;
+ }
+ prevPtr = errorPtr;
+ }
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ErrorProc --
+ *
+ * This procedure is invoked by the X system when error
+ * events arrive.
+ *
+ * Results:
+ * If it returns, the return value is zero. However,
+ * it is possible that one of the error handlers may
+ * just exit.
+ *
+ * Side effects:
+ * This procedure does two things. First, it uses the
+ * serial # in the error event to eliminate handlers whose
+ * expiration serials are now in the past. Second, it
+ * invokes any handlers that want to deal with the error.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ErrorProc(display, errEventPtr)
+ Display *display; /* Display for which error
+ * occurred. */
+ register XErrorEvent *errEventPtr; /* Information about error. */
+{
+ register TkDisplay *dispPtr;
+ register TkErrorHandler *errorPtr;
+
+ /*
+ * See if we know anything about the display. If not, then
+ * invoke the default error handler.
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ goto couldntHandle;
+ }
+
+ /*
+ * Otherwise invoke any relevant handlers for the error, in order.
+ */
+
+ for (errorPtr = dispPtr->errorPtr; errorPtr != NULL;
+ errorPtr = errorPtr->nextPtr) {
+ if ((errorPtr->firstRequest > errEventPtr->serial)
+ || ((errorPtr->error != -1)
+ && (errorPtr->error != errEventPtr->error_code))
+ || ((errorPtr->request != -1)
+ && (errorPtr->request != errEventPtr->request_code))
+ || ((errorPtr->minorCode != -1)
+ && (errorPtr->minorCode != errEventPtr->minor_code))
+ || ((errorPtr->lastRequest != (unsigned long) -1)
+ && (errorPtr->lastRequest < errEventPtr->serial))) {
+ continue;
+ }
+ if (errorPtr->errorProc == NULL) {
+ return 0;
+ } else {
+ if ((*errorPtr->errorProc)(errorPtr->clientData,
+ errEventPtr) == 0) {
+ return 0;
+ }
+ }
+ }
+
+ /*
+ * See if the error is a BadWindow error. If so, and it refers
+ * to a window that still exists in our window table, then ignore
+ * the error. Errors like this can occur if a window owned by us
+ * is deleted by someone externally, like a window manager. We'll
+ * ignore the errors at least long enough to clean up internally and
+ * remove the entry from the window table.
+ *
+ * NOTE: For embedding, we must also check whether the window was
+ * recently deleted. If so, it may be that Tk generated operations on
+ * windows that were deleted by the container. Now we are getting
+ * the errors (BadWindow) after Tk already deleted the window itself.
+ */
+
+ if ((errEventPtr->error_code == BadWindow) &&
+ ((Tk_IdToWindow(display, (Window) errEventPtr->resourceid) !=
+ NULL) ||
+ (TkpWindowWasRecentlyDeleted((Window) errEventPtr->resourceid,
+ dispPtr)))) {
+ return 0;
+ }
+
+ /*
+ * We couldn't handle the error. Use the default handler.
+ */
+
+ couldntHandle:
+ return (*defaultHandler)(display, errEventPtr);
+}
--- /dev/null
+/*
+ * tkEvent.c --
+ *
+ * This file provides basic low-level facilities for managing
+ * X events in Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include <signal.h>
+
+/*
+ * There's a potential problem if a handler is deleted while it's
+ * current (i.e. its procedure is executing), since Tk_HandleEvent
+ * will need to read the handler's "nextPtr" field when the procedure
+ * returns. To handle this problem, structures of the type below
+ * indicate the next handler to be processed for any (recursively
+ * nested) dispatches in progress. The nextHandler fields get
+ * updated if the handlers pointed to are deleted. Tk_HandleEvent
+ * also needs to know if the entire window gets deleted; the winPtr
+ * field is set to zero if that particular window gets deleted.
+ */
+
+typedef struct InProgress {
+ XEvent *eventPtr; /* Event currently being handled. */
+ TkWindow *winPtr; /* Window for event. Gets set to None if
+ * window is deleted while event is being
+ * handled. */
+ TkEventHandler *nextHandler; /* Next handler in search. */
+ struct InProgress *nextPtr; /* Next higher nested search. */
+} InProgress;
+
+/*
+ * For each call to Tk_CreateGenericHandler, an instance of the following
+ * structure will be created. All of the active handlers are linked into a
+ * list.
+ */
+
+typedef struct GenericHandler {
+ Tk_GenericProc *proc; /* Procedure to dispatch on all X events. */
+ ClientData clientData; /* Client data to pass to procedure. */
+ int deleteFlag; /* Flag to set when this handler is deleted. */
+ struct GenericHandler *nextPtr;
+ /* Next handler in list of all generic
+ * handlers, or NULL for end of list. */
+} GenericHandler;
+
+/*
+ * There's a potential problem if Tk_HandleEvent is entered recursively.
+ * A handler cannot be deleted physically until we have returned from
+ * calling it. Otherwise, we're looking at unallocated memory in advancing to
+ * its `next' entry. We deal with the problem by using the `delete flag' and
+ * deleting handlers only when it's known that there's no handler active.
+ *
+ */
+
+/*
+ * The following structure is used for queueing X-style events on the
+ * Tcl event queue.
+ */
+
+typedef struct TkWindowEvent {
+ Tcl_Event header; /* Standard information for all events. */
+ XEvent event; /* The X event. */
+} TkWindowEvent;
+
+/*
+ * Array of event masks corresponding to each X event:
+ */
+
+static unsigned long eventMasks[TK_LASTEVENT] = {
+ 0,
+ 0,
+ KeyPressMask, /* KeyPress */
+ KeyReleaseMask, /* KeyRelease */
+ ButtonPressMask, /* ButtonPress */
+ ButtonReleaseMask, /* ButtonRelease */
+ PointerMotionMask|PointerMotionHintMask|ButtonMotionMask
+ |Button1MotionMask|Button2MotionMask|Button3MotionMask
+ |Button4MotionMask|Button5MotionMask,
+ /* MotionNotify */
+ EnterWindowMask, /* EnterNotify */
+ LeaveWindowMask, /* LeaveNotify */
+ FocusChangeMask, /* FocusIn */
+ FocusChangeMask, /* FocusOut */
+ KeymapStateMask, /* KeymapNotify */
+ ExposureMask, /* Expose */
+ ExposureMask, /* GraphicsExpose */
+ ExposureMask, /* NoExpose */
+ VisibilityChangeMask, /* VisibilityNotify */
+ SubstructureNotifyMask, /* CreateNotify */
+ StructureNotifyMask, /* DestroyNotify */
+ StructureNotifyMask, /* UnmapNotify */
+ StructureNotifyMask, /* MapNotify */
+ SubstructureRedirectMask, /* MapRequest */
+ StructureNotifyMask, /* ReparentNotify */
+ StructureNotifyMask, /* ConfigureNotify */
+ SubstructureRedirectMask, /* ConfigureRequest */
+ StructureNotifyMask, /* GravityNotify */
+ ResizeRedirectMask, /* ResizeRequest */
+ StructureNotifyMask, /* CirculateNotify */
+ SubstructureRedirectMask, /* CirculateRequest */
+ PropertyChangeMask, /* PropertyNotify */
+ 0, /* SelectionClear */
+ 0, /* SelectionRequest */
+ 0, /* SelectionNotify */
+ ColormapChangeMask, /* ColormapNotify */
+ 0, /* ClientMessage */
+ 0, /* Mapping Notify */
+ VirtualEventMask, /* VirtualEvents */
+ ActivateMask, /* ActivateNotify */
+ ActivateMask, /* DeactivateNotify */
+ MouseWheelMask /* MouseWheelEvent */
+};
+
+
+/*
+ * The structure below is used to store Data for the Event module that
+ * must be kept thread-local. The "dataKey" is used to fetch the
+ * thread-specific storage for the current thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int handlersActive; /* The following variable has a non-zero
+ * value when a handler is active. */
+ InProgress *pendingPtr; /* Topmost search in progress, or
+ * NULL if none. */
+
+ GenericHandler *genericList; /* First handler in the list, or NULL. */
+ GenericHandler *lastGenericPtr; /* Last handler in list. */
+
+ GenericHandler *cmList; /* First handler in the list, or NULL. */
+ GenericHandler *lastCmPtr; /* Last handler in list. */
+
+ /*
+ * If someone has called Tk_RestrictEvents, the information below
+ * keeps track of it.
+ */
+
+ Tk_RestrictProc *restrictProc;
+ /* Procedure to call. NULL means no
+ * restrictProc is currently in effect. */
+ ClientData restrictArg; /* Argument to pass to restrictProc. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for procedures that are only referenced locally within
+ * this file.
+ */
+
+static void DelayedMotionProc _ANSI_ARGS_((ClientData clientData));
+static int WindowEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static int TkXErrorHandler _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errEventPtr));
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateEventHandler --
+ *
+ * Arrange for a given procedure to be invoked whenever
+ * events from a given class occur in a given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, whenever an event of the type given by
+ * mask occurs for token and is processed by Tk_HandleEvent,
+ * proc will be called. See the manual entry for details
+ * of the calling sequence and return value for proc.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateEventHandler(token, mask, proc, clientData)
+ Tk_Window token; /* Token for window in which to
+ * create handler. */
+ unsigned long mask; /* Events for which proc should
+ * be called. */
+ Tk_EventProc *proc; /* Procedure to call for each
+ * selected event */
+ ClientData clientData; /* Arbitrary data to pass to proc. */
+{
+ register TkEventHandler *handlerPtr;
+ register TkWindow *winPtr = (TkWindow *) token;
+ int found;
+
+ /*
+ * Skim through the list of existing handlers to (a) compute the
+ * overall event mask for the window (so we can pass this new
+ * value to the X system) and (b) see if there's already a handler
+ * declared with the same callback and clientData (if so, just
+ * change the mask). If no existing handler matches, then create
+ * a new handler.
+ */
+
+ found = 0;
+ if (winPtr->handlerList == NULL) {
+ handlerPtr = (TkEventHandler *) ckalloc(
+ (unsigned) sizeof(TkEventHandler));
+ winPtr->handlerList = handlerPtr;
+ goto initHandler;
+ } else {
+ for (handlerPtr = winPtr->handlerList; ;
+ handlerPtr = handlerPtr->nextPtr) {
+ if ((handlerPtr->proc == proc)
+ && (handlerPtr->clientData == clientData)) {
+ handlerPtr->mask = mask;
+ found = 1;
+ }
+ if (handlerPtr->nextPtr == NULL) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Create a new handler if no matching old handler was found.
+ */
+
+ if (!found) {
+ handlerPtr->nextPtr = (TkEventHandler *)
+ ckalloc(sizeof(TkEventHandler));
+ handlerPtr = handlerPtr->nextPtr;
+ initHandler:
+ handlerPtr->mask = mask;
+ handlerPtr->proc = proc;
+ handlerPtr->clientData = clientData;
+ handlerPtr->nextPtr = NULL;
+ }
+
+ /*
+ * No need to call XSelectInput: Tk always selects on all events
+ * for all windows (needed to support bindings on classes and "all").
+ */
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteEventHandler --
+ *
+ * Delete a previously-created handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there existed a handler as described by the
+ * parameters, the handler is deleted so that proc
+ * will not be invoked again.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteEventHandler(token, mask, proc, clientData)
+ Tk_Window token; /* Same as corresponding arguments passed */
+ unsigned long mask; /* previously to Tk_CreateEventHandler. */
+ Tk_EventProc *proc;
+ ClientData clientData;
+{
+ register TkEventHandler *handlerPtr;
+ register InProgress *ipPtr;
+ TkEventHandler *prevPtr;
+ register TkWindow *winPtr = (TkWindow *) token;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the event handler to be deleted, or return
+ * immediately if it doesn't exist.
+ */
+
+ for (handlerPtr = winPtr->handlerList, prevPtr = NULL; ;
+ prevPtr = handlerPtr, handlerPtr = handlerPtr->nextPtr) {
+ if (handlerPtr == NULL) {
+ return;
+ }
+ if ((handlerPtr->mask == mask) && (handlerPtr->proc == proc)
+ && (handlerPtr->clientData == clientData)) {
+ break;
+ }
+ }
+
+ /*
+ * If Tk_HandleEvent is about to process this handler, tell it to
+ * process the next one instead.
+ */
+
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->nextHandler == handlerPtr) {
+ ipPtr->nextHandler = handlerPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Free resources associated with the handler.
+ */
+
+ if (prevPtr == NULL) {
+ winPtr->handlerList = handlerPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = handlerPtr->nextPtr;
+ }
+ ckfree((char *) handlerPtr);
+
+
+ /*
+ * No need to call XSelectInput: Tk always selects on all events
+ * for all windows (needed to support bindings on classes and "all").
+ */
+}
+\f
+/*--------------------------------------------------------------
+ *
+ * Tk_CreateGenericHandler --
+ *
+ * Register a procedure to be called on each X event, regardless
+ * of display or window. Generic handlers are useful for capturing
+ * events that aren't associated with windows, or events for windows
+ * not managed by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * From now on, whenever an X event is given to Tk_HandleEvent,
+ * invoke proc, giving it clientData and the event as arguments.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateGenericHandler(proc, clientData)
+ Tk_GenericProc *proc; /* Procedure to call on every event. */
+ ClientData clientData; /* One-word value to pass to proc. */
+{
+ GenericHandler *handlerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler));
+
+ handlerPtr->proc = proc;
+ handlerPtr->clientData = clientData;
+ handlerPtr->deleteFlag = 0;
+ handlerPtr->nextPtr = NULL;
+ if (tsdPtr->genericList == NULL) {
+ tsdPtr->genericList = handlerPtr;
+ } else {
+ tsdPtr->lastGenericPtr->nextPtr = handlerPtr;
+ }
+ tsdPtr->lastGenericPtr = handlerPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteGenericHandler --
+ *
+ * Delete a previously-created generic handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * If there existed a handler as described by the parameters,
+ * that handler is logically deleted so that proc will not be
+ * invoked again. The physical deletion happens in the event
+ * loop in Tk_HandleEvent.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteGenericHandler(proc, clientData)
+ Tk_GenericProc *proc;
+ ClientData clientData;
+{
+ GenericHandler * handler;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (handler = tsdPtr->genericList; handler; handler = handler->nextPtr) {
+ if ((handler->proc == proc) && (handler->clientData == clientData)) {
+ handler->deleteFlag = 1;
+ }
+ }
+}
+\f
+/*--------------------------------------------------------------
+ *
+ * Tk_CreateClientMessageHandler --
+ *
+ * Register a procedure to be called on each ClientMessage event.
+ * ClientMessage handlers are useful for Drag&Drop extensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * From now on, whenever a ClientMessage event is received that isn't
+ * a WM_PROTOCOL event or SelectionEvent, invoke proc, giving it
+ * tkwin and the event as arguments.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateClientMessageHandler(proc)
+ Tk_ClientMessageProc *proc; /* Procedure to call on event. */
+{
+ GenericHandler *handlerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * We use a GenericHandler struct, because it's basically the same,
+ * except with an extra clientData field we'll never use.
+ */
+ handlerPtr = (GenericHandler *)
+ ckalloc (sizeof (GenericHandler));
+
+ handlerPtr->proc = (Tk_GenericProc *) proc;
+ handlerPtr->clientData = NULL; /* never used */
+ handlerPtr->deleteFlag = 0;
+ handlerPtr->nextPtr = NULL;
+ if (tsdPtr->cmList == NULL) {
+ tsdPtr->cmList = handlerPtr;
+ } else {
+ tsdPtr->lastCmPtr->nextPtr = handlerPtr;
+ }
+ tsdPtr->lastCmPtr = handlerPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteClientMessageHandler --
+ *
+ * Delete a previously-created ClientMessage 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 TkClientMessageEventProc.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteClientMessageHandler(proc)
+ Tk_ClientMessageProc *proc;
+{
+ GenericHandler * handler;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (handler = tsdPtr->cmList; handler != NULL;
+ handler = handler->nextPtr) {
+ if (handler->proc == (Tk_GenericProc *) proc) {
+ handler->deleteFlag = 1;
+ }
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkEventInit --
+ *
+ * This procedures initializes all the event module
+ * structures used by the current thread. It must be
+ * called before any other procedure in this file is
+ * called.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkEventInit _ANSI_ARGS_((void))
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->handlersActive = 0;
+ tsdPtr->pendingPtr = NULL;
+ tsdPtr->genericList = NULL;
+ tsdPtr->lastGenericPtr = NULL;
+ tsdPtr->cmList = NULL;
+ tsdPtr->lastCmPtr = NULL;
+ tsdPtr->restrictProc = NULL;
+ tsdPtr->restrictArg = NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkXErrorHandler --
+ *
+ * TkXErrorHandler is an error handler, to be installed
+ * via Tk_CreateErrorHandler, that will set a flag if an
+ * X error occurred.
+ *
+ * Results:
+ * Always returns 0, indicating that the X error was
+ * handled.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TkXErrorHandler (clientData, errEventPtr)
+ ClientData clientData; /* Pointer to flag we set */
+ XErrorEvent *errEventPtr; /* X error info */
+{
+ int *error;
+
+ error = (int *) clientData;
+ *error = 1;
+ return 0;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ParentXId --
+ *
+ * Returns the parent of the given window, or "None"
+ * if the window doesn't exist.
+ *
+ * Results:
+ * Returns an X window ID.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Window
+ParentXId(display, w)
+ Display *display;
+ Window w;
+{
+ Tk_ErrorHandler handler;
+ int gotXError;
+ Status status;
+ Window parent;
+ Window root;
+ Window *childList;
+ unsigned int nChildren;
+
+ /* Handle errors ourselves. */
+
+ gotXError = 0;
+ handler = Tk_CreateErrorHandler(display, -1, -1, -1,
+ TkXErrorHandler, (ClientData) (&gotXError));
+
+ /* Get the parent window. */
+
+ status = XQueryTree(display, w, &root, &parent, &childList, &nChildren);
+
+ /* Do some cleanup; gotta return "None" if we got an error. */
+
+ Tk_DeleteErrorHandler(handler);
+ XSync(display, False);
+ if (status != 0 && childList != NULL) {
+ XFree(childList);
+ }
+ if (status == 0) {
+ parent = None;
+ }
+
+ return parent;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_HandleEvent --
+ *
+ * Given an event, invoke all the handlers that have
+ * been registered for the event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the handlers.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_HandleEvent(eventPtr)
+ XEvent *eventPtr; /* Event to dispatch. */
+{
+ register TkEventHandler *handlerPtr;
+ register GenericHandler *genericPtr;
+ register GenericHandler *genPrevPtr;
+ TkWindow *winPtr;
+ unsigned long mask;
+ InProgress ip;
+ Window handlerWindow;
+ Window parentXId;
+ TkDisplay *dispPtr;
+ Tcl_Interp *interp = (Tcl_Interp *) NULL;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Hack for simulated X-events: Correct the state field
+ * of the event record to match with the ButtonPress
+ * and ButtonRelease events.
+ */
+
+ if (eventPtr->type==ButtonPress) {
+ dispPtr = TkGetDisplay(eventPtr->xbutton.display);
+ eventPtr->xbutton.state |= dispPtr->mouseButtonState;
+ switch (eventPtr->xbutton.button) {
+ case 1: dispPtr->mouseButtonState |= Button1Mask; break;
+ case 2: dispPtr->mouseButtonState |= Button2Mask; break;
+ case 3: dispPtr->mouseButtonState |= Button3Mask; break;
+ }
+ } else if (eventPtr->type==ButtonRelease) {
+ dispPtr = TkGetDisplay(eventPtr->xbutton.display);
+ switch (eventPtr->xbutton.button) {
+ case 1: dispPtr->mouseButtonState &= ~Button1Mask; break;
+ case 2: dispPtr->mouseButtonState &= ~Button2Mask; break;
+ case 3: dispPtr->mouseButtonState &= ~Button3Mask; break;
+ }
+ eventPtr->xbutton.state |= dispPtr->mouseButtonState;
+ } else if (eventPtr->type==MotionNotify) {
+ dispPtr = TkGetDisplay(eventPtr->xmotion.display);
+ eventPtr->xmotion.state |= dispPtr->mouseButtonState;
+ }
+
+ /*
+ * Next, invoke all the generic event handlers (those that are
+ * invoked for all events). If a generic event handler reports that
+ * an event is fully processed, go no further.
+ */
+
+ for (genPrevPtr = NULL, genericPtr = tsdPtr->genericList;
+ genericPtr != NULL; ) {
+ if (genericPtr->deleteFlag) {
+ if (!tsdPtr->handlersActive) {
+ GenericHandler *tmpPtr;
+
+ /*
+ * This handler needs to be deleted and there are no
+ * calls pending through the handler, so now is a safe
+ * time to delete it.
+ */
+
+ tmpPtr = genericPtr->nextPtr;
+ if (genPrevPtr == NULL) {
+ tsdPtr->genericList = tmpPtr;
+ } else {
+ genPrevPtr->nextPtr = tmpPtr;
+ }
+ if (tmpPtr == NULL) {
+ tsdPtr->lastGenericPtr = genPrevPtr;
+ }
+ (void) ckfree((char *) genericPtr);
+ genericPtr = tmpPtr;
+ continue;
+ }
+ } else {
+ int done;
+
+ tsdPtr->handlersActive++;
+ done = (*genericPtr->proc)(genericPtr->clientData, eventPtr);
+ tsdPtr->handlersActive--;
+ if (done) {
+ return;
+ }
+ }
+ genPrevPtr = genericPtr;
+ genericPtr = genPrevPtr->nextPtr;
+ }
+
+ /*
+ * If the event is a MappingNotify event, find its display and
+ * refresh the keyboard mapping information for the display.
+ * After that there's nothing else to do with the event, so just
+ * quit.
+ */
+
+ if (eventPtr->type == MappingNotify) {
+ dispPtr = TkGetDisplay(eventPtr->xmapping.display);
+ if (dispPtr != NULL) {
+ XRefreshKeyboardMapping(&eventPtr->xmapping);
+ dispPtr->bindInfoStale = 1;
+ }
+ return;
+ }
+
+ /*
+ * Events selected by StructureNotify require special handling.
+ * They look the same as those selected by SubstructureNotify.
+ * The only difference is whether the "event" and "window" fields
+ * are the same. Compare the two fields and convert StructureNotify
+ * to SubstructureNotify if necessary.
+ */
+
+ handlerWindow = eventPtr->xany.window;
+ mask = eventMasks[eventPtr->xany.type];
+ if (mask == StructureNotifyMask) {
+ if (eventPtr->xmap.event != eventPtr->xmap.window) {
+ mask = SubstructureNotifyMask;
+ handlerWindow = eventPtr->xmap.event;
+ }
+ }
+ winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, handlerWindow);
+ if (winPtr == NULL) {
+ /*
+ * There isn't a TkWindow structure for this window.
+ * However, if the event is a PropertyNotify event then call
+ * the selection manager (it deals beneath-the-table with
+ * certain properties). Also, if the window's parent is a
+ * Tk window that has the TK_PROP_PROPCHANGE flag set, then
+ * we must propagate the PropertyNotify event up to the parent.
+ */
+
+ if (eventPtr->type != PropertyNotify) {
+ return;
+ }
+
+ TkSelPropProc(eventPtr);
+
+ /* Get handlerWindow's parent. */
+
+ parentXId = ParentXId(eventPtr->xany.display, handlerWindow);
+ if (parentXId == None) {
+ return;
+ }
+
+ winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, parentXId);
+ if (winPtr == NULL) {
+ return;
+ }
+
+ if (!(winPtr->flags & TK_PROP_PROPCHANGE)) {
+ return;
+ }
+
+ handlerWindow = parentXId;
+ }
+
+ /*
+ * Once a window has started getting deleted, don't process any more
+ * events for it except for the DestroyNotify event. This check is
+ * needed because a DestroyNotify handler could re-invoke the event
+ * loop, causing other pending events to be handled for the window
+ * (the window doesn't get totally expunged from our tables until
+ * after the DestroyNotify event has been completely handled).
+ */
+
+ if ((winPtr->flags & TK_ALREADY_DEAD)
+ && (eventPtr->type != DestroyNotify)) {
+ return;
+ }
+
+ if (winPtr->mainPtr != NULL) {
+
+ /*
+ * Protect interpreter for this window from possible deletion
+ * while we are dealing with the event for this window. Thus,
+ * widget writers do not have to worry about protecting the
+ * interpreter in their own code.
+ */
+
+ interp = winPtr->mainPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * Call focus-related code to look at FocusIn, FocusOut, Enter,
+ * and Leave events; depending on its return value, ignore the
+ * event.
+ */
+
+ if ((mask & (FocusChangeMask|EnterWindowMask|LeaveWindowMask))
+ && !TkFocusFilterEvent(winPtr, eventPtr)) {
+ Tcl_Release((ClientData) interp);
+ return;
+ }
+
+ /*
+ * Redirect KeyPress and KeyRelease events to the focus window,
+ * or ignore them entirely if there is no focus window. We also
+ * route the MouseWheel event to the focus window. The MouseWheel
+ * event is an extension to the X event set. Currently, it is only
+ * available on the Windows version of Tk.
+ */
+
+ if (mask & (KeyPressMask|KeyReleaseMask|MouseWheelMask)) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xkey.time;
+ winPtr = TkFocusKeyEvent(winPtr, eventPtr);
+ if (winPtr == NULL) {
+ Tcl_Release((ClientData) interp);
+ return;
+ }
+ }
+
+ /*
+ * Call a grab-related procedure to do special processing on
+ * pointer events.
+ */
+
+ if (mask & (ButtonPressMask|ButtonReleaseMask|PointerMotionMask
+ |EnterWindowMask|LeaveWindowMask)) {
+ if (mask & (ButtonPressMask|ButtonReleaseMask)) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xbutton.time;
+ } else if (mask & PointerMotionMask) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xmotion.time;
+ } else {
+ winPtr->dispPtr->lastEventTime = eventPtr->xcrossing.time;
+ }
+ if (TkPointerEvent(eventPtr, winPtr) == 0) {
+ goto done;
+ }
+ }
+ }
+
+#ifdef TK_USE_INPUT_METHODS
+ /*
+ * Pass the event to the input method(s), if there are any, and
+ * discard the event if the input method(s) insist. Create the
+ * input context for the window if it hasn't already been done
+ * (XFilterEvent needs this context). XIM is only ever enabled on
+ * Unix, but this hasn't been factored out of the generic code yet.
+ */
+ dispPtr = winPtr->dispPtr;
+ if ((dispPtr->flags & TK_DISPLAY_USE_IM)) {
+ if (!(winPtr->flags & (TK_CHECKED_IC|TK_ALREADY_DEAD))) {
+ winPtr->flags |= TK_CHECKED_IC;
+ if (dispPtr->inputMethod != NULL) {
+#if TK_XIM_SPOT
+ if (dispPtr->flags & TK_DISPLAY_XIM_SPOT) {
+ XVaNestedList preedit_attr;
+ XPoint spot = {0, 0};
+
+ if (dispPtr->inputXfs == NULL) {
+ /*
+ * We only need to create one XFontSet
+ */
+ char **missing_list;
+ int missing_count;
+ char *def_string;
+
+ dispPtr->inputXfs = XCreateFontSet(dispPtr->display,
+ "-*-*-*-R-Normal--14-130-75-75-*-*",
+ &missing_list, &missing_count, &def_string);
+ if (missing_count > 0) {
+ XFreeStringList(missing_list);
+ }
+ }
+
+ preedit_attr = XVaCreateNestedList(0, XNSpotLocation,
+ &spot, XNFontSet, dispPtr->inputXfs, NULL);
+ if (winPtr->inputContext != NULL)
+ panic("inputContext not NULL");
+ winPtr->inputContext = XCreateIC(dispPtr->inputMethod,
+ XNInputStyle, XIMPreeditPosition|XIMStatusNothing,
+ XNClientWindow, winPtr->window,
+ XNFocusWindow, winPtr->window,
+ XNPreeditAttributes, preedit_attr,
+ NULL);
+ XFree(preedit_attr);
+ } else
+#endif
+ if (winPtr->inputContext != NULL)
+ panic("inputContext not NULL");
+ winPtr->inputContext = XCreateIC(dispPtr->inputMethod,
+ XNInputStyle, XIMPreeditNothing|XIMStatusNothing,
+ XNClientWindow, winPtr->window,
+ XNFocusWindow, winPtr->window,
+ NULL);
+ }
+ }
+ if (XFilterEvent(eventPtr, None)) {
+ goto done;
+ }
+ }
+#endif /* TK_USE_INPUT_METHODS */
+
+ /*
+ * For events where it hasn't already been done, update the current
+ * time in the display.
+ */
+
+ if (eventPtr->type == PropertyNotify) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xproperty.time;
+ }
+
+ /*
+ * There's a potential interaction here with Tk_DeleteEventHandler.
+ * Read the documentation for pendingPtr.
+ */
+
+ ip.eventPtr = eventPtr;
+ ip.winPtr = winPtr;
+ ip.nextHandler = NULL;
+ ip.nextPtr = tsdPtr->pendingPtr;
+ tsdPtr->pendingPtr = &ip;
+ if (mask == 0) {
+ if ((eventPtr->type == SelectionClear)
+ || (eventPtr->type == SelectionRequest)
+ || (eventPtr->type == SelectionNotify)) {
+ TkSelEventProc((Tk_Window) winPtr, eventPtr);
+ } else if (eventPtr->type == ClientMessage) {
+ if (eventPtr->xclient.message_type ==
+ Tk_InternAtom((Tk_Window) winPtr, "WM_PROTOCOLS")) {
+ TkWmProtocolEventProc(winPtr, eventPtr);
+ } else {
+ /*
+ * Finally, invoke any ClientMessage event handlers.
+ */
+
+ for (genPrevPtr = NULL, genericPtr = tsdPtr->cmList;
+ genericPtr != NULL; ) {
+ if (genericPtr->deleteFlag) {
+ if (!tsdPtr->handlersActive) {
+ GenericHandler *tmpPtr;
+
+ /*
+ * This handler needs to be deleted and there are
+ * no calls pending through any handlers, so now
+ * is a safe time to delete it.
+ */
+
+ tmpPtr = genericPtr->nextPtr;
+ if (genPrevPtr == NULL) {
+ tsdPtr->cmList = tmpPtr;
+ } else {
+ genPrevPtr->nextPtr = tmpPtr;
+ }
+ if (tmpPtr == NULL) {
+ tsdPtr->lastGenericPtr = genPrevPtr;
+ }
+ (void) ckfree((char *) genericPtr);
+ genericPtr = tmpPtr;
+ continue;
+ }
+ } else {
+ int done;
+
+ tsdPtr->handlersActive++;
+ done = (*(Tk_ClientMessageProc *)genericPtr->proc)
+ ((Tk_Window) winPtr, eventPtr);
+ tsdPtr->handlersActive--;
+ if (done) {
+ break;
+ }
+ }
+ genPrevPtr = genericPtr;
+ genericPtr = genPrevPtr->nextPtr;
+ }
+ }
+ }
+ } else {
+ for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) {
+ if ((handlerPtr->mask & mask) != 0) {
+ ip.nextHandler = handlerPtr->nextPtr;
+ (*(handlerPtr->proc))(handlerPtr->clientData, eventPtr);
+ handlerPtr = ip.nextHandler;
+ } else {
+ handlerPtr = handlerPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Pass the event to the "bind" command mechanism. But, don't
+ * do this for SubstructureNotify events. The "bind" command
+ * doesn't support them anyway, and it's easier to filter out
+ * these events here than in the lower-level procedures.
+ */
+
+ /*
+ * ...well, except when we use the tkwm patches, in which case
+ * we DO handle CreateNotify events, so we gotta pass 'em through.
+ */
+
+ if ((ip.winPtr != None)
+ && ((mask != SubstructureNotifyMask)
+ || (eventPtr->type == CreateNotify))) {
+ TkBindEventProc(winPtr, eventPtr);
+ }
+ }
+ tsdPtr->pendingPtr = ip.nextPtr;
+done:
+
+ /*
+ * Release the interpreter for this window so that it can be potentially
+ * deleted if requested.
+ */
+
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_Release((ClientData) interp);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkEventDeadWindow --
+ *
+ * This procedure is invoked when it is determined that
+ * a window is dead. It cleans up event-related information
+ * about the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various things get cleaned up and recycled.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkEventDeadWindow(winPtr)
+ TkWindow *winPtr; /* Information about the window
+ * that is being deleted. */
+{
+ register TkEventHandler *handlerPtr;
+ register InProgress *ipPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * While deleting all the handlers, be careful to check for
+ * Tk_HandleEvent being about to process one of the deleted
+ * handlers. If it is, tell it to quit (all of the handlers
+ * are being deleted).
+ */
+
+ while (winPtr->handlerList != NULL) {
+ handlerPtr = winPtr->handlerList;
+ winPtr->handlerList = handlerPtr->nextPtr;
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->nextHandler == handlerPtr) {
+ ipPtr->nextHandler = NULL;
+ }
+ if (ipPtr->winPtr == winPtr) {
+ ipPtr->winPtr = None;
+ }
+ }
+ ckfree((char *) handlerPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCurrentTime --
+ *
+ * Try to deduce the current time. "Current time" means the time
+ * of the event that led to the current code being executed, which
+ * means the time in the most recently-nested invocation of
+ * Tk_HandleEvent.
+ *
+ * Results:
+ * The return value is the time from the current event, or
+ * CurrentTime if there is no current event or if the current
+ * event contains no time.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Time
+TkCurrentTime(dispPtr)
+ TkDisplay *dispPtr; /* Display for which the time is desired. */
+{
+ register XEvent *eventPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->pendingPtr == NULL) {
+ return dispPtr->lastEventTime;
+ }
+ eventPtr = tsdPtr->pendingPtr->eventPtr;
+ switch (eventPtr->type) {
+ case ButtonPress:
+ case ButtonRelease:
+ return eventPtr->xbutton.time;
+ case KeyPress:
+ case KeyRelease:
+ return eventPtr->xkey.time;
+ case MotionNotify:
+ return eventPtr->xmotion.time;
+ case EnterNotify:
+ case LeaveNotify:
+ return eventPtr->xcrossing.time;
+ case PropertyNotify:
+ return eventPtr->xproperty.time;
+ }
+ return dispPtr->lastEventTime;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestrictEvents --
+ *
+ * This procedure is used to globally restrict the set of events
+ * that will be dispatched. The restriction is done by filtering
+ * all incoming X events through a procedure that determines
+ * whether they are to be processed immediately, deferred, or
+ * discarded.
+ *
+ * Results:
+ * The return value is the previous restriction procedure in effect,
+ * if there was one, or NULL if there wasn't.
+ *
+ * Side effects:
+ * From now on, proc will be called to determine whether to process,
+ * defer or discard each incoming X event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_RestrictProc *
+Tk_RestrictEvents(proc, arg, prevArgPtr)
+ Tk_RestrictProc *proc; /* Procedure to call for each incoming
+ * event. */
+ ClientData arg; /* Arbitrary argument to pass to proc. */
+ ClientData *prevArgPtr; /* Place to store information about previous
+ * argument. */
+{
+ Tk_RestrictProc *prev;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ prev = tsdPtr->restrictProc;
+ *prevArgPtr = tsdPtr->restrictArg;
+ tsdPtr->restrictProc = proc;
+ tsdPtr->restrictArg = arg;
+ return prev;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CollapseMotionEvents --
+ *
+ * This procedure controls whether we collapse motion events in a
+ * particular display or not.
+ *
+ * Results:
+ * The return value is the previous collapse value in effect.
+ *
+ * Side effects:
+ * Filtering of motion events may be changed after calling this.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_CollapseMotionEvents(display, collapse)
+ Display *display; /* Display handling these events. */
+ int collapse; /* boolean value that specifies whether
+ * motion events should be collapsed. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) display;
+ int prev = (dispPtr->flags & TK_DISPLAY_COLLAPSE_MOTION_EVENTS);
+
+ if (collapse) {
+ dispPtr->flags |= TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
+ }
+ return prev;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_QueueWindowEvent --
+ *
+ * Given an X-style window event, this procedure adds it to the
+ * Tcl event queue at the given position. This procedure also
+ * performs mouse motion event collapsing if possible.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds stuff to the event queue, which will eventually be
+ * processed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_QueueWindowEvent(eventPtr, position)
+ XEvent *eventPtr; /* Event to add to queue. This
+ * procedures copies it before adding
+ * it to the queue. */
+ Tcl_QueuePosition position; /* Where to put it on the queue:
+ * TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ * or TCL_QUEUE_MARK. */
+{
+ TkWindowEvent *wevPtr;
+ TkDisplay *dispPtr;
+
+ /*
+ * Find our display structure for the event's display.
+ */
+
+ for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ return;
+ }
+ if (dispPtr->display == eventPtr->xany.display) {
+ break;
+ }
+ }
+
+ /*
+ * Don't filter motion events if the user
+ * defaulting to true (1), which could be set to false (0) when the
+ * user wishes to receive all the motion data)
+ */
+ if (!(dispPtr->flags & TK_DISPLAY_COLLAPSE_MOTION_EVENTS)) {
+ wevPtr = (TkWindowEvent *) ckalloc(sizeof(TkWindowEvent));
+ wevPtr->header.proc = WindowEventProc;
+ wevPtr->event = *eventPtr;
+ Tcl_QueueEvent(&wevPtr->header, position);
+ return;
+ }
+
+ if ((dispPtr->delayedMotionPtr != NULL) && (position == TCL_QUEUE_TAIL)) {
+ if ((eventPtr->type == MotionNotify) && (eventPtr->xmotion.window
+ == dispPtr->delayedMotionPtr->event.xmotion.window)) {
+ /*
+ * The new event is a motion event in the same window as the
+ * saved motion event. Just replace the saved event with the
+ * new one.
+ */
+
+ dispPtr->delayedMotionPtr->event = *eventPtr;
+ return;
+ } else if ((eventPtr->type != GraphicsExpose)
+ && (eventPtr->type != NoExpose)
+ && (eventPtr->type != Expose)) {
+ /*
+ * The new event may conflict with the saved motion event. Queue
+ * the saved motion event now so that it will be processed before
+ * the new event.
+ */
+
+ Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, position);
+ dispPtr->delayedMotionPtr = NULL;
+ Tcl_CancelIdleCall(DelayedMotionProc, (ClientData) dispPtr);
+ }
+ }
+
+ wevPtr = (TkWindowEvent *) ckalloc(sizeof(TkWindowEvent));
+ wevPtr->header.proc = WindowEventProc;
+ wevPtr->event = *eventPtr;
+ if ((eventPtr->type == MotionNotify) && (position == TCL_QUEUE_TAIL)) {
+ /*
+ * The new event is a motion event so don't queue it immediately;
+ * save it around in case another motion event arrives that it can
+ * be collapsed with.
+ */
+
+ if (dispPtr->delayedMotionPtr != NULL) {
+ panic("Tk_QueueWindowEvent found unexpected delayed motion event");
+ }
+ dispPtr->delayedMotionPtr = wevPtr;
+ Tcl_DoWhenIdle(DelayedMotionProc, (ClientData) dispPtr);
+ } else {
+ Tcl_QueueEvent(&wevPtr->header, position);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkQueueEventForAllChildren --
+ *
+ * Given an XEvent, recursively queue the event for this window and
+ * all non-toplevel children of the given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Events queued.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkQueueEventForAllChildren(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window to which event is sent. */
+ XEvent *eventPtr; /* The event to be sent. */
+{
+ TkWindow *childPtr;
+
+ eventPtr->xany.window = winPtr->window;
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_TAIL);
+
+ childPtr = winPtr->childList;
+ while (childPtr != NULL) {
+ if (!Tk_TopWinHierarchy(childPtr)) {
+ TkQueueEventForAllChildren(childPtr, eventPtr);
+ }
+ childPtr = childPtr->nextPtr;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowEventProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent when a window event
+ * reaches the front of the event queue. This procedure is responsible
+ * for actually handling the event.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The event isn't handled if the
+ * TCL_WINDOW_EVENTS bit isn't set in flags, if a restrict proc
+ * prevents the event from being handled.
+ *
+ * Side effects:
+ * Whatever the event handlers for the event do.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WindowEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event to service. */
+ int flags; /* Flags that indicate what events to
+ * handle, such as TCL_WINDOW_EVENTS. */
+{
+ TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr;
+ Tk_RestrictAction result;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!(flags & TCL_WINDOW_EVENTS)) {
+ return 0;
+ }
+ if (tsdPtr->restrictProc != NULL) {
+ result = (*tsdPtr->restrictProc)(tsdPtr->restrictArg, &wevPtr->event);
+ if (result != TK_PROCESS_EVENT) {
+ if (result == TK_DEFER_EVENT) {
+ return 0;
+ } else {
+ /*
+ * TK_DELETE_EVENT: return and say we processed the event,
+ * even though we didn't do anything at all.
+ */
+ return 1;
+ }
+ }
+ }
+ Tk_HandleEvent(&wevPtr->event);
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DelayedMotionProc --
+ *
+ * This procedure is invoked as an idle handler when a mouse motion
+ * event has been delayed. It queues the delayed event so that it
+ * will finally be serviced.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The delayed mouse motion event gets added to the Tcl event
+ * queue for servicing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DelayedMotionProc(clientData)
+ ClientData clientData; /* Pointer to display containing a delayed
+ * motion event to be serviced. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+
+ if (dispPtr->delayedMotionPtr == NULL) {
+ panic("DelayedMotionProc found no delayed mouse motion event");
+ }
+ Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, TCL_QUEUE_TAIL);
+ dispPtr->delayedMotionPtr = NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MainLoop --
+ *
+ * Call Tcl_DoOneEvent over and over again in an infinite
+ * loop as long as there exist any main windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arbitrary; depends on handlers for events.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MainLoop()
+{
+ while (Tk_GetNumMainWindows() > 0) {
+ Tcl_DoOneEvent(0);
+ }
+}
--- /dev/null
+/*
+ * tkFileFilter.c --
+ *
+ * Process the -filetypes option for the file dialogs on Windows and the
+ * Mac.
+ *
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkFileFilter.h"
+
+static int AddClause _ANSI_ARGS_((
+ Tcl_Interp * interp, FileFilter * filterPtr,
+ CONST char * patternsStr, CONST char * ostypesStr,
+ int isWindows));
+static void FreeClauses _ANSI_ARGS_((FileFilter * filterPtr));
+static void FreeGlobPatterns _ANSI_ARGS_((
+ FileFilterClause * clausePtr));
+static void FreeMacFileTypes _ANSI_ARGS_((
+ FileFilterClause * clausePtr));
+static FileFilter * GetFilter _ANSI_ARGS_((FileFilterList * flistPtr,
+ CONST char * name));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInitFileFilters --
+ *
+ * Initializes a FileFilterList data structure. A FileFilterList
+ * must be initialized EXACTLY ONCE before any calls to
+ * TkGetFileFilters() is made. The usual flow of control is:
+ * TkInitFileFilters(&flist);
+ * TkGetFileFilters(&flist, ...);
+ * TkGetFileFilters(&flist, ...);
+ * ...
+ * TkFreeFileFilters(&flist);
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields in flistPtr are initialized.
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInitFileFilters(flistPtr)
+ FileFilterList * flistPtr; /* The structure to be initialized. */
+{
+ flistPtr->filters = NULL;
+ flistPtr->filtersTail = NULL;
+ flistPtr->numFilters = 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetFileFilters --
+ *
+ * This function is called by the Mac and Windows implementation
+ * of tk_getOpenFile and tk_getSaveFile to translate the string
+ * value of the -filetypes option of into an easy-to-parse C
+ * structure (flistPtr). The caller of this function will then use
+ * flistPtr to perform filetype matching in a platform specific way.
+ *
+ * flistPtr must be initialized (See comments in TkInitFileFilters).
+ *
+ * Results:
+ * A standard TCL return value.
+ *
+ * Side effects:
+ * The fields in flistPtr are changed according to string.
+ *----------------------------------------------------------------------
+ */
+int
+TkGetFileFilters(interp, flistPtr, string, isWindows)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ FileFilterList * flistPtr; /* Stores the list of file filters. */
+ char * string; /* Value of the -filetypes option. */
+ int isWindows; /* True if we are running on Windows. */
+{
+ int listArgc;
+ CONST char ** listArgv = NULL;
+ CONST char ** typeInfo = NULL;
+ int code = TCL_OK;
+ int i;
+
+ if (Tcl_SplitList(interp, string, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (listArgc == 0) {
+ goto done;
+ }
+
+ /*
+ * Free the filter information that have been allocated the previous
+ * time -- the -filefilters option may have been used more than once in
+ * the command line.
+ */
+ TkFreeFileFilters(flistPtr);
+
+ for (i = 0; i<listArgc; i++) {
+ /*
+ * Each file type should have two or three elements: the first one
+ * is the name of the type and the second is the filter of the type.
+ * The third is the Mac OSType ID, but we don't care about them here.
+ */
+ int count;
+ FileFilter * filterPtr;
+
+ if (Tcl_SplitList(interp, listArgv[i], &count, &typeInfo) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (count != 2 && count != 3) {
+ Tcl_AppendResult(interp, "bad file type \"", listArgv[i], "\", ",
+ "should be \"typeName {extension ?extensions ...?} ",
+ "?{macType ?macTypes ...?}?\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ filterPtr = GetFilter(flistPtr, typeInfo[0]);
+
+ if (count == 2) {
+ code = AddClause(interp, filterPtr, typeInfo[1], NULL,
+ isWindows);
+ } else {
+ code = AddClause(interp, filterPtr, typeInfo[1], typeInfo[2],
+ isWindows);
+ }
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ if (typeInfo) {
+ ckfree((char*)typeInfo);
+ }
+ typeInfo = NULL;
+ }
+
+ done:
+ if (typeInfo) {
+ ckfree((char*)typeInfo);
+ }
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return code;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeFileFilters --
+ *
+ * Frees the malloc'ed file filter information.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields allocated by TkGetFileFilters() are freed.
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeFileFilters(flistPtr)
+ FileFilterList * flistPtr; /* List of file filters to free */
+{
+ FileFilter * filterPtr, *toFree;
+
+ filterPtr=flistPtr->filters;
+ while (filterPtr) {
+ toFree = filterPtr;
+ filterPtr=filterPtr->next;
+ FreeClauses(toFree);
+ ckfree((char*)toFree->name);
+ ckfree((char*)toFree);
+ }
+ flistPtr->filters = NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddClause --
+ *
+ * Add one FileFilterClause to filterPtr.
+ *
+ * Results:
+ * A standard TCL result.
+ *
+ * Side effects:
+ * The list of filter clauses are updated in filterPtr.
+ *----------------------------------------------------------------------
+ */
+
+static int AddClause(interp, filterPtr, patternsStr, ostypesStr, isWindows)
+ Tcl_Interp * interp; /* Interpreter to use for error reporting. */
+ FileFilter * filterPtr; /* Stores the new filter clause */
+ CONST char * patternsStr; /* A TCL list of glob patterns. */
+ CONST char * ostypesStr; /* A TCL list of Mac OSType strings. */
+ int isWindows; /* True if we are running on Windows; False
+ * if we are running on the Mac; Glob
+ * patterns need to be processed differently
+ * on these two platforms */
+{
+ CONST char ** globList = NULL;
+ int globCount;
+ CONST char ** ostypeList = NULL;
+ int ostypeCount;
+ FileFilterClause * clausePtr;
+ int i;
+ int code = TCL_OK;
+
+ if (Tcl_SplitList(interp, patternsStr, &globCount, &globList)!= TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (ostypesStr != NULL) {
+ if (Tcl_SplitList(interp, ostypesStr, &ostypeCount, &ostypeList)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ for (i=0; i<ostypeCount; i++) {
+ if (strlen(ostypeList[i]) != 4) {
+ Tcl_AppendResult(interp, "bad Macintosh file type \"",
+ ostypeList[i], "\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ /*
+ * Add the clause into the list of clauses
+ */
+
+ clausePtr = (FileFilterClause*)ckalloc(sizeof(FileFilterClause));
+ clausePtr->patterns = NULL;
+ clausePtr->patternsTail = NULL;
+ clausePtr->macTypes = NULL;
+ clausePtr->macTypesTail = NULL;
+
+ if (filterPtr->clauses == NULL) {
+ filterPtr->clauses = filterPtr->clausesTail = clausePtr;
+ } else {
+ filterPtr->clausesTail->next = clausePtr;
+ filterPtr->clausesTail = clausePtr;
+ }
+ clausePtr->next = NULL;
+
+ if (globCount > 0 && globList != NULL) {
+ for (i=0; i<globCount; i++) {
+ GlobPattern * globPtr = (GlobPattern*)ckalloc(sizeof(GlobPattern));
+ int len;
+
+ len = (strlen(globList[i]) + 1) * sizeof(char);
+
+ if (globList[i][0] && globList[i][0] != '*') {
+ /*
+ * Prepend a "*" to patterns that do not have a leading "*"
+ */
+ globPtr->pattern = (char*)ckalloc((unsigned int) len+1);
+ globPtr->pattern[0] = '*';
+ strcpy(globPtr->pattern+1, globList[i]);
+ }
+ else if (isWindows) {
+ if (strcmp(globList[i], "*") == 0) {
+ globPtr->pattern = (char*)ckalloc(4*sizeof(char));
+ strcpy(globPtr->pattern, "*.*");
+ }
+ else if (strcmp(globList[i], "") == 0) {
+ /*
+ * An empty string means "match all files with no
+ * extensions"
+ * BUG: "*." actually matches with all files on Win95
+ */
+ globPtr->pattern = (char*)ckalloc(3*sizeof(char));
+ strcpy(globPtr->pattern, "*.");
+ }
+ else {
+ globPtr->pattern = (char*)ckalloc((unsigned int) len);
+ strcpy(globPtr->pattern, globList[i]);
+ }
+ } else {
+ globPtr->pattern = (char*)ckalloc((unsigned int) len);
+ strcpy(globPtr->pattern, globList[i]);
+ }
+
+ /*
+ * Add the glob pattern into the list of patterns.
+ */
+
+ if (clausePtr->patterns == NULL) {
+ clausePtr->patterns = clausePtr->patternsTail = globPtr;
+ } else {
+ clausePtr->patternsTail->next = globPtr;
+ clausePtr->patternsTail = globPtr;
+ }
+ globPtr->next = NULL;
+ }
+ }
+ if (ostypeCount > 0 && ostypeList != NULL) {
+ for (i=0; i<ostypeCount; i++) {
+ MacFileType * mfPtr = (MacFileType*)ckalloc(sizeof(MacFileType));
+
+ memcpy(&mfPtr->type, ostypeList[i], sizeof(OSType));
+
+ /*
+ * Add the Mac type pattern into the list of Mac types
+ */
+ if (clausePtr->macTypes == NULL) {
+ clausePtr->macTypes = clausePtr->macTypesTail = mfPtr;
+ } else {
+ clausePtr->macTypesTail->next = mfPtr;
+ clausePtr->macTypesTail = mfPtr;
+ }
+ mfPtr->next = NULL;
+ }
+ }
+
+ done:
+ if (globList) {
+ ckfree((char*)globList);
+ }
+ if (ostypeList) {
+ ckfree((char*)ostypeList);
+ }
+
+ return code;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFilter --
+ *
+ * Add one FileFilter to flistPtr.
+ *
+ * Results:
+ * A standard TCL result.
+ *
+ * Side effects:
+ * The list of filters are updated in flistPtr.
+ *----------------------------------------------------------------------
+ */
+
+static FileFilter * GetFilter(flistPtr, name)
+ FileFilterList * flistPtr; /* The FileFilterList that contains the
+ * newly created filter */
+ CONST char * name; /* Name of the filter. It is usually displayed
+ * in the "File Types" listbox in the file
+ * dialogs. */
+{
+ FileFilter * filterPtr;
+
+ for (filterPtr=flistPtr->filters; filterPtr; filterPtr=filterPtr->next) {
+ if (strcmp(filterPtr->name, name)==0) {
+ return filterPtr;
+ }
+ }
+
+ filterPtr = (FileFilter*)ckalloc(sizeof(FileFilter));
+ filterPtr->clauses = NULL;
+ filterPtr->clausesTail = NULL;
+ filterPtr->name = (char*)ckalloc((strlen(name)+1) * sizeof(char));
+ strcpy(filterPtr->name, name);
+
+ if (flistPtr->filters == NULL) {
+ flistPtr->filters = flistPtr->filtersTail = filterPtr;
+ } else {
+ flistPtr->filtersTail->next = filterPtr;
+ flistPtr->filtersTail = filterPtr;
+ }
+ filterPtr->next = NULL;
+
+ ++flistPtr->numFilters;
+ return filterPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeClauses --
+ *
+ * Frees the malloc'ed file type clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of clauses in filterPtr->clauses are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeClauses(filterPtr)
+ FileFilter * filterPtr; /* FileFilter whose clauses are to be freed */
+{
+ FileFilterClause * clausePtr, * toFree;
+
+ clausePtr = filterPtr->clauses;
+ while (clausePtr) {
+ toFree = clausePtr;
+ clausePtr=clausePtr->next;
+ FreeGlobPatterns(toFree);
+ FreeMacFileTypes(toFree);
+ ckfree((char*)toFree);
+ }
+ filterPtr->clauses = NULL;
+ filterPtr->clausesTail = NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeGlobPatterns --
+ *
+ * Frees the malloc'ed glob patterns in a clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of glob patterns in clausePtr->patterns are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeGlobPatterns(clausePtr)
+ FileFilterClause * clausePtr;/* The clause whose patterns are to be freed*/
+{
+ GlobPattern * globPtr, * toFree;
+
+ globPtr = clausePtr->patterns;
+ while (globPtr) {
+ toFree = globPtr;
+ globPtr=globPtr->next;
+
+ ckfree((char*)toFree->pattern);
+ ckfree((char*)toFree);
+ }
+ clausePtr->patterns = NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMacFileTypes --
+ *
+ * Frees the malloc'ed Mac file types in a clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of Mac file types in clausePtr->macTypes are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMacFileTypes(clausePtr)
+ FileFilterClause * clausePtr; /* The clause whose mac types are to be
+ * freed */
+{
+ MacFileType * mfPtr, * toFree;
+
+ mfPtr = clausePtr->macTypes;
+ while (mfPtr) {
+ toFree = mfPtr;
+ mfPtr=mfPtr->next;
+ ckfree((char*)toFree);
+ }
+ clausePtr->macTypes = NULL;
+}
--- /dev/null
+/*
+ * tkFocus.c --
+ *
+ * This file contains procedures that manage the input
+ * focus for Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+
+/*
+ * For each top-level window that has ever received the focus, there
+ * is a record of the following type:
+ */
+
+typedef struct TkToplevelFocusInfo {
+ TkWindow *topLevelPtr; /* Information about top-level window. */
+ TkWindow *focusWinPtr; /* The next time the focus comes to this
+ * top-level, it will be given to this
+ * window. */
+ struct TkToplevelFocusInfo *nextPtr;
+ /* Next in list of all toplevel focus records
+ * for a given application. */
+} ToplevelFocusInfo;
+
+/*
+ * One of the following structures exists for each display used by
+ * each application. These are linked together from the TkMainInfo
+ * structure. These structures are needed because it isn't
+ * sufficient to store a single piece of focus information in each
+ * display or in each application: we need the cross-product.
+ * There needs to be separate information for each display, because
+ * it's possible to have multiple focus windows active simultaneously
+ * on different displays. There also needs to be separate information
+ * for each application, because of embedding: if an embedded
+ * application has the focus, its container application also has
+ * the focus. Thus we keep a list of structures for each application:
+ * the same display can appear in structures for several applications
+ * at once.
+ */
+
+typedef struct TkDisplayFocusInfo {
+ TkDisplay *dispPtr; /* Display that this information pertains
+ * to. */
+ struct TkWindow *focusWinPtr;
+ /* Window that currently has the focus for
+ * this application on this display, or NULL
+ * if none. */
+ struct TkWindow *focusOnMapPtr;
+ /* This points to a toplevel window that is
+ * supposed to receive the X input focus as
+ * soon as it is mapped (needed to handle the
+ * fact that X won't allow the focus on an
+ * unmapped window). NULL means no delayed
+ * focus op in progress for this display. */
+ int forceFocus; /* Associated with focusOnMapPtr: non-zero
+ * means claim the focus even if some other
+ * application currently has it. */
+ unsigned long focusSerial; /* Serial number of last request this
+ * application made to change the focus on
+ * this display. Used to identify stale
+ * focus notifications coming from the
+ * X server. */
+ struct TkDisplayFocusInfo *nextPtr;
+ /* Next in list of all display focus
+ * records for a given application. */
+} DisplayFocusInfo;
+
+/*
+ * The following magic value is stored in the "send_event" field of
+ * FocusIn and FocusOut events that are generated in this file. This
+ * allows us to separate "real" events coming from the server from
+ * those that we generated.
+ */
+
+#define GENERATED_EVENT_MAGIC ((Bool) 0x547321ac)
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+
+static DisplayFocusInfo *FindDisplayFocusInfo _ANSI_ARGS_((TkMainInfo *mainPtr,
+ TkDisplay *dispPtr));
+static void FocusMapProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void GenerateFocusEvents _ANSI_ARGS_((TkWindow *sourcePtr,
+ TkWindow *destPtr));
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FocusObjCmd --
+ *
+ * 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
+Tk_FocusObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *focusOptions[] = {
+ "-displayof", "-force", "-lastfor", (char *) NULL
+ };
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr = (TkWindow *) clientData;
+ TkWindow *newPtr, *focusWinPtr, *topLevelPtr;
+ ToplevelFocusInfo *tlFocusPtr;
+ char *windowName;
+ int index;
+
+ /*
+ * If invoked with no arguments, just return the current focus window.
+ */
+
+ if (objc == 1) {
+ focusWinPtr = TkGetFocusWin(winPtr);
+ if (focusWinPtr != NULL) {
+ Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * If invoked with a single argument beginning with "." then focus
+ * on that window.
+ */
+
+ if (objc == 2) {
+ windowName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+
+ /*
+ * The empty string case exists for backwards compatibility.
+ */
+
+ if (windowName[0] == '\0') {
+ return TCL_OK;
+ }
+ if (windowName[0] == '.') {
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!(newPtr->flags & TK_ALREADY_DEAD)) {
+ TkSetFocusWin(newPtr, 0);
+ }
+ return TCL_OK;
+ }
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], focusOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case 0: { /* -displayof */
+ windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ newPtr = TkGetFocusWin(newPtr);
+ if (newPtr != NULL) {
+ Tcl_SetResult(interp, newPtr->pathName, TCL_STATIC);
+ }
+ break;
+ }
+ case 1: { /* -force */
+ windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+
+ /*
+ * The empty string case exists for backwards compatibility.
+ */
+
+ if (windowName[0] == '\0') {
+ return TCL_OK;
+ }
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ TkSetFocusWin(newPtr, 1);
+ break;
+ }
+ case 2: { /* -lastfor */
+ windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ for (topLevelPtr = newPtr; topLevelPtr != NULL;
+ topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr->flags & TK_TOP_HIERARCHY) {
+ for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr;
+ tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ Tcl_SetResult(interp,
+ tlFocusPtr->focusWinPtr->pathName,
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ break;
+ }
+ default: {
+ panic("bad const entries to focusOptions in focus command");
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFocusFilterEvent --
+ *
+ * This procedure is invoked by Tk_HandleEvent when it encounters
+ * a FocusIn, FocusOut, Enter, or Leave event.
+ *
+ * Results:
+ * A return value of 1 means that Tk_HandleEvent should process
+ * the event normally (i.e. event handlers should be invoked).
+ * A return value of 0 means that this event should be ignored.
+ *
+ * Side effects:
+ * Additional events may be generated, and the focus may switch.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkFocusFilterEvent(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window that focus event is directed to. */
+ XEvent *eventPtr; /* FocusIn, FocusOut, Enter, or Leave
+ * event. */
+{
+ /*
+ * Design notes: the window manager and X server work together to
+ * transfer the focus among top-level windows. This procedure takes
+ * care of transferring the focus from a top-level or wrapper window
+ * to the actual window within that top-level that has the focus.
+ * We do this by synthesizing X events to move the focus around.
+ * None of the FocusIn and FocusOut events generated by X are ever
+ * used outside of this procedure; only the synthesized events get
+ * through to the rest of the application. At one point (e.g.
+ * Tk4.0b1) Tk used to call X to move the focus from a top-level to
+ * one of its descendants, then just pass through the events
+ * generated by X. This approach didn't work very well, for a
+ * variety of reasons. For example, if X generates the events they
+ * go at the back of the event queue, which could cause problems if
+ * other things have already happened, such as moving the focus to
+ * yet another window.
+ */
+
+ ToplevelFocusInfo *tlFocusPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkWindow *newFocusPtr;
+ int retValue, delta;
+
+ /*
+ * If this was a generated event, just turn off the generated
+ * flag and pass the event through to Tk bindings.
+ */
+
+ if (eventPtr->xfocus.send_event == GENERATED_EVENT_MAGIC) {
+ eventPtr->xfocus.send_event = 0;
+ return 1;
+ }
+
+ /*
+ * Check for special events generated by embedded applications to
+ * request the input focus. If this is one of those events, make
+ * the change in focus and return without any additional processing
+ * of the event (note: the "detail" field of the event indicates
+ * whether to claim the focus even if we don't already have it).
+ */
+
+ if ((eventPtr->xfocus.mode == EMBEDDED_APP_WANTS_FOCUS)
+ && (eventPtr->type == FocusIn)) {
+ TkSetFocusWin(winPtr, eventPtr->xfocus.detail);
+ return 0;
+ }
+
+ /*
+ * This was not a generated event. We'll return 1 (so that the
+ * event will be processed) if it's an Enter or Leave event, and
+ * 0 (so that the event won't be processed) if it's a FocusIn or
+ * FocusOut event.
+ */
+
+ retValue = 0;
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ if (eventPtr->type == FocusIn) {
+ /*
+ * Skip FocusIn events that cause confusion
+ * NotifyVirtual and NotifyNonlinearVirtual - Virtual events occur
+ * on windows in between the origin and destination of the
+ * focus change. For FocusIn we may see this when focus
+ * goes into an embedded child. We don't care about this,
+ * although we may end up getting a NotifyPointer later.
+ * NotifyInferior - focus is coming to us from an embedded child.
+ * When focus is on an embeded focus, we still think we have
+ * the focus, too, so this message doesn't change our state.
+ * NotifyPointerRoot - should never happen because this is sent
+ * to the root window.
+ *
+ * Interesting FocusIn events are
+ * NotifyAncestor - focus is coming from our parent, probably the root.
+ * NotifyNonlinear - focus is coming from a different branch, probably
+ * another toplevel.
+ * NotifyPointer - implicit focus because of the mouse position.
+ * This is only interesting on toplevels, when it means that the
+ * focus has been set to the root window but the mouse is over
+ * this toplevel. We take the focus implicitly (probably no
+ * window manager)
+ */
+
+ if ((eventPtr->xfocus.detail == NotifyVirtual)
+ || (eventPtr->xfocus.detail == NotifyNonlinearVirtual)
+ || (eventPtr->xfocus.detail == NotifyPointerRoot)
+ || (eventPtr->xfocus.detail == NotifyInferior)) {
+ return retValue;
+ }
+ } else if (eventPtr->type == FocusOut) {
+ /*
+ * Skip FocusOut events that cause confusion.
+ * NotifyPointer - the pointer is in us or a child, and we are losing
+ * focus because of an XSetInputFocus. Other focus events
+ * will set our state properly.
+ * NotifyPointerRoot - should never happen because this is sent
+ * to the root window.
+ * NotifyInferior - focus leaving us for an embedded child. We
+ * retain a notion of focus when an embedded child has focus.
+ *
+ * Interesting events are:
+ * NotifyAncestor - focus is going to root.
+ * NotifyNonlinear - focus is going to another branch, probably
+ * another toplevel.
+ * NotifyVirtual, NotifyNonlinearVirtual - focus is passing through,
+ * and we need to make sure we track this.
+ */
+
+ if ((eventPtr->xfocus.detail == NotifyPointer)
+ || (eventPtr->xfocus.detail == NotifyPointerRoot)
+ || (eventPtr->xfocus.detail == NotifyInferior)) {
+ return retValue;
+ }
+ } else {
+ retValue = 1;
+ if (eventPtr->xcrossing.detail == NotifyInferior) {
+ return retValue;
+ }
+ }
+
+ /*
+ * If winPtr isn't a top-level window than just ignore the event.
+ */
+
+ winPtr = TkWmFocusToplevel(winPtr);
+ if (winPtr == NULL) {
+ return retValue;
+ }
+
+ /*
+ * If there is a grab in effect and this window is outside the
+ * grabbed tree, then ignore the event.
+ */
+
+ if (TkGrabState(winPtr) == TK_GRAB_EXCLUDED) {
+ return retValue;
+ }
+
+ /*
+ * It is possible that there were outstanding FocusIn and FocusOut
+ * events on their way to us at the time the focus was changed
+ * internally with the "focus" command. If so, these events could
+ * potentially cause us to lose the focus (switch it to the window
+ * of the last FocusIn event) even though the focus change occurred
+ * after those events. The following code detects this and ignores
+ * the stale events.
+ *
+ * Note: the focusSerial is only generated by TkpChangeFocus,
+ * whereas in Tk 4.2 there was always a nop marker generated.
+ */
+
+ delta = eventPtr->xfocus.serial - displayFocusPtr->focusSerial;
+ if (delta < 0) {
+ return retValue;
+ }
+
+ /*
+ * Find the ToplevelFocusInfo structure for the window, and make a new one
+ * if there isn't one already.
+ */
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == winPtr) {
+ break;
+ }
+ }
+ if (tlFocusPtr == NULL) {
+ tlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo));
+ tlFocusPtr->topLevelPtr = tlFocusPtr->focusWinPtr = winPtr;
+ tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
+ }
+ newFocusPtr = tlFocusPtr->focusWinPtr;
+
+ if (eventPtr->type == FocusIn) {
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
+ displayFocusPtr->focusWinPtr = newFocusPtr;
+ dispPtr->focusPtr = newFocusPtr;
+
+ /*
+ * NotifyPointer gets set when the focus has been set to the root window
+ * but we have the pointer. We'll treat this like an implicit
+ * focus in event so that upon Leave events we release focus.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (eventPtr->xfocus.detail == NotifyPointer) {
+ dispPtr->implicitWinPtr = winPtr;
+ } else {
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, (TkWindow *) NULL);
+
+ /*
+ * Reset dispPtr->focusPtr, but only if it currently is the same
+ * as this application's focusWinPtr: this check is needed to
+ * handle embedded applications in the same process.
+ */
+
+ if (dispPtr->focusPtr == displayFocusPtr->focusWinPtr) {
+ dispPtr->focusPtr = NULL;
+ }
+ displayFocusPtr->focusWinPtr = NULL;
+ } else if (eventPtr->type == EnterNotify) {
+ /*
+ * If there is no window manager, or if the window manager isn't
+ * moving the focus around (e.g. the disgusting "NoTitleFocus"
+ * option has been selected in twm), then we won't get FocusIn
+ * or FocusOut events. Instead, the "focus" field will be set
+ * in an Enter event to indicate that we've already got the focus
+ * when the mouse enters the window (even though we didn't get
+ * a FocusIn event). Watch for this and grab the focus when it
+ * happens. Note: if this is an embedded application then don't
+ * accept the focus implicitly like this; the container
+ * application will give us the focus explicitly if it wants us
+ * to have it.
+ */
+
+ if (eventPtr->xcrossing.focus &&
+ (displayFocusPtr->focusWinPtr == NULL)
+ && !(winPtr->flags & TK_EMBEDDED)) {
+ if (dispPtr->focusDebug) {
+ printf("Focussed implicitly on %s\n",
+ newFocusPtr->pathName);
+ }
+
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
+ displayFocusPtr->focusWinPtr = newFocusPtr;
+ dispPtr->implicitWinPtr = winPtr;
+ dispPtr->focusPtr = newFocusPtr;
+ }
+ } else if (eventPtr->type == LeaveNotify) {
+ /*
+ * If the pointer just left a window for which we automatically
+ * claimed the focus on enter, move the focus back to the root
+ * window, where it was before we claimed it above. Note:
+ * dispPtr->implicitWinPtr may not be the same as
+ * displayFocusPtr->focusWinPtr (e.g. because the "focus"
+ * command was used to redirect the focus after it arrived at
+ * dispPtr->implicitWinPtr)!! In addition, we generate events
+ * because the window manager won't give us a FocusOut event when
+ * we focus on the root.
+ */
+
+ if ((dispPtr->implicitWinPtr != NULL)
+ && !(winPtr->flags & TK_EMBEDDED)) {
+ if (dispPtr->focusDebug) {
+ printf("Defocussed implicit Async\n");
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr,
+ (TkWindow *) NULL);
+ XSetInputFocus(dispPtr->display, PointerRoot, RevertToPointerRoot,
+ CurrentTime);
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ return retValue;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetFocusWin --
+ *
+ * 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
+TkSetFocusWin(winPtr, force)
+ TkWindow *winPtr; /* Window that is to be the new focus for
+ * its display and application. */
+ int force; /* If non-zero, set the X focus to this
+ * window even if the application doesn't
+ * currently have the X focus. */
+{
+ ToplevelFocusInfo *tlFocusPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkWindow *topLevelPtr;
+ int allMapped, serial;
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+
+ /*
+ * If force is set, we should make sure we grab the focus regardless
+ * of the current focus window since under Windows, we may need to
+ * take control away from another application.
+ */
+
+ if (winPtr == displayFocusPtr->focusWinPtr && !force) {
+ return;
+ }
+
+ /*
+ * Find the top-level window for winPtr, then find (or create)
+ * a record for the top-level. Also see whether winPtr and all its
+ * ancestors are mapped.
+ */
+
+ allMapped = 1;
+ for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr == NULL) {
+ /*
+ * The window is being deleted. No point in worrying about
+ * giving it the focus.
+ */
+ return;
+ }
+ if (!(topLevelPtr->flags & TK_MAPPED)) {
+ allMapped = 0;
+ }
+ if (topLevelPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+
+ /*
+ * If the new focus window isn't mapped, then we can't focus on it
+ * (X will generate an error, for example). Instead, create an
+ * event handler that will set the focus to this window once it gets
+ * mapped. At the same time, delete any old handler that might be
+ * around; it's no longer relevant.
+ */
+
+ if (displayFocusPtr->focusOnMapPtr != NULL) {
+ Tk_DeleteEventHandler(
+ (Tk_Window) displayFocusPtr->focusOnMapPtr,
+ StructureNotifyMask, FocusMapProc,
+ (ClientData) displayFocusPtr->focusOnMapPtr);
+ displayFocusPtr->focusOnMapPtr = NULL;
+ }
+ if (!allMapped) {
+ Tk_CreateEventHandler((Tk_Window) winPtr,
+ VisibilityChangeMask, FocusMapProc,
+ (ClientData) winPtr);
+ displayFocusPtr->focusOnMapPtr = winPtr;
+ displayFocusPtr->forceFocus = force;
+ return;
+ }
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ break;
+ }
+ }
+ if (tlFocusPtr == NULL) {
+ tlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo));
+ tlFocusPtr->topLevelPtr = topLevelPtr;
+ tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
+ }
+ tlFocusPtr->focusWinPtr = winPtr;
+
+ /*
+ * Reset the window system's focus window and generate focus events,
+ * with two special cases:
+ *
+ * 1. If the application is embedded and doesn't currently have the
+ * focus, don't set the focus directly. Instead, see if the
+ * embedding code can claim the focus from the enclosing
+ * container.
+ * 2. Otherwise, if the application doesn't currently have the
+ * focus, don't change the window system's focus unless it was
+ * already in this application or "force" was specified.
+ */
+
+ if ((topLevelPtr->flags & TK_EMBEDDED)
+ && (displayFocusPtr->focusWinPtr == NULL)) {
+ TkpClaimFocus(topLevelPtr, force);
+ } else if ((displayFocusPtr->focusWinPtr != NULL) || force) {
+ /*
+ * Generate events to shift focus between Tk windows.
+ * We do this regardless of what TkpChangeFocus does with
+ * the real X focus so that Tk widgets track focus commands
+ * when there is no window manager. GenerateFocusEvents will
+ * set up a serial number marker so we discard focus events
+ * that are triggered by the ChangeFocus.
+ */
+
+ serial = TkpChangeFocus(TkpGetWrapperWindow(topLevelPtr), force);
+ if (serial != 0) {
+ displayFocusPtr->focusSerial = serial;
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, winPtr);
+ displayFocusPtr->focusWinPtr = winPtr;
+ winPtr->dispPtr->focusPtr = winPtr;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetFocusWin --
+ *
+ * Given a window, this procedure returns the current focus
+ * window for its application and display.
+ *
+ * Results:
+ * The return value is a pointer to the window that currently
+ * has the input focus for the specified application and
+ * display, or NULL if none.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkGetFocusWin(winPtr)
+ TkWindow *winPtr; /* Window that selects an application
+ * and a display. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+
+ if (winPtr == NULL) {
+ return (TkWindow *) NULL;
+ }
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ return displayFocusPtr->focusWinPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusKeyEvent --
+ *
+ * Given a window and a key press or release event that arrived for
+ * the window, use information about the keyboard focus to compute
+ * which window should really get the event. In addition, update
+ * the event to refer to its new window.
+ *
+ * Results:
+ * The return value is a pointer to the window that has the input
+ * focus in winPtr's application, or NULL if winPtr's application
+ * doesn't have the input focus. If a non-NULL value is returned,
+ * eventPtr will be updated to refer properly to the focus window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkFocusKeyEvent(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window that selects an application
+ * and a display. */
+ XEvent *eventPtr; /* X event to redirect (should be KeyPress
+ * or KeyRelease). */
+{
+ DisplayFocusInfo *displayFocusPtr;
+ TkWindow *focusWinPtr;
+ int focusX, focusY, vRootX, vRootY, vRootWidth, vRootHeight;
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ focusWinPtr = displayFocusPtr->focusWinPtr;
+
+ /*
+ * The code below is a debugging aid to make sure that dispPtr->focusPtr
+ * is kept properly in sync with the "truth", which is the value in
+ * displayFocusPtr->focusWinPtr.
+ */
+
+#ifdef TCL_MEM_DEBUG
+ if (focusWinPtr != winPtr->dispPtr->focusPtr) {
+ printf("TkFocusKeyEvent found dispPtr->focusPtr out of sync:\n");
+ printf("expected %s, got %s\n",
+ (focusWinPtr != NULL) ? focusWinPtr->pathName : "??",
+ (winPtr->dispPtr->focusPtr != NULL) ?
+ winPtr->dispPtr->focusPtr->pathName : "??");
+ }
+#endif
+
+ if ((focusWinPtr != NULL) && (focusWinPtr->mainPtr == winPtr->mainPtr)) {
+ /*
+ * Map the x and y coordinates to make sense in the context of
+ * the focus window, if possible (make both -1 if the map-from
+ * and map-to windows don't share the same screen).
+ */
+
+ if ((focusWinPtr->display != winPtr->display)
+ || (focusWinPtr->screenNum != winPtr->screenNum)) {
+ eventPtr->xkey.x = -1;
+ eventPtr->xkey.y = -1;
+ } else {
+ Tk_GetVRootGeometry((Tk_Window) focusWinPtr, &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ Tk_GetRootCoords((Tk_Window) focusWinPtr, &focusX, &focusY);
+ eventPtr->xkey.x = eventPtr->xkey.x_root - vRootX - focusX;
+ eventPtr->xkey.y = eventPtr->xkey.y_root - vRootY - focusY;
+ }
+ eventPtr->xkey.window = focusWinPtr->window;
+ return focusWinPtr;
+ }
+
+ /*
+ * The event doesn't belong to us. Perhaps, due to embedding, it
+ * really belongs to someone else. Give the embedding code a chance
+ * to redirect the event.
+ */
+
+ TkpRedirectKeyEvent(winPtr, eventPtr);
+ return (TkWindow *) NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusDeadWindow --
+ *
+ * This procedure is invoked when it is determined that
+ * a window is dead. It cleans up focus-related information
+ * about the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various things get cleaned up and recycled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusDeadWindow(winPtr)
+ register TkWindow *winPtr; /* Information about the window
+ * that is being deleted. */
+{
+ ToplevelFocusInfo *tlFocusPtr, *prevPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ /*
+ * Certain special windows like those used for send and clipboard
+ * have no mainPtr.
+ */
+
+ if (winPtr->mainPtr == NULL)
+ return;
+
+ /*
+ * Search for focus records that refer to this window either as
+ * the top-level window or the current focus window.
+ */
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ for (prevPtr = NULL, tlFocusPtr = winPtr->mainPtr->tlFocusPtr;
+ tlFocusPtr != NULL;
+ prevPtr = tlFocusPtr, tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (winPtr == tlFocusPtr->topLevelPtr) {
+ /*
+ * The top-level window is the one being deleted: free
+ * the focus record and release the focus back to PointerRoot
+ * if we acquired it implicitly.
+ */
+
+ if (dispPtr->implicitWinPtr == winPtr) {
+ if (dispPtr->focusDebug) {
+ printf("releasing focus to root after %s died\n",
+ tlFocusPtr->topLevelPtr->pathName);
+ }
+ dispPtr->implicitWinPtr = NULL;
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ }
+ if (displayFocusPtr->focusWinPtr == tlFocusPtr->focusWinPtr) {
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ }
+ if (prevPtr == NULL) {
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = tlFocusPtr->nextPtr;
+ }
+ ckfree((char *) tlFocusPtr);
+ break;
+ } else if (winPtr == tlFocusPtr->focusWinPtr) {
+ /*
+ * The deleted window had the focus for its top-level:
+ * move the focus to the top-level itself.
+ */
+
+ tlFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
+ if ((displayFocusPtr->focusWinPtr == winPtr)
+ && !(tlFocusPtr->topLevelPtr->flags & TK_ALREADY_DEAD)) {
+ if (dispPtr->focusDebug) {
+ printf("forwarding focus to %s after %s died\n",
+ tlFocusPtr->topLevelPtr->pathName,
+ winPtr->pathName);
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr,
+ tlFocusPtr->topLevelPtr);
+ displayFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
+ dispPtr->focusPtr = tlFocusPtr->topLevelPtr;
+ }
+ break;
+ }
+ }
+
+ if (displayFocusPtr->focusOnMapPtr == winPtr) {
+ displayFocusPtr->focusOnMapPtr = NULL;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateFocusEvents --
+ *
+ * This procedure is called to create FocusIn and FocusOut events to
+ * move the input focus from one window to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * FocusIn and FocusOut events are generated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateFocusEvents(sourcePtr, destPtr)
+ TkWindow *sourcePtr; /* Window that used to have the focus (may
+ * be NULL). */
+ TkWindow *destPtr; /* New window to have the focus (may be
+ * NULL). */
+
+{
+ XEvent event;
+ TkWindow *winPtr;
+
+ winPtr = sourcePtr;
+ if (winPtr == NULL) {
+ winPtr = destPtr;
+ if (winPtr == NULL) {
+ return;
+ }
+ }
+
+ event.xfocus.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xfocus.send_event = GENERATED_EVENT_MAGIC;
+ event.xfocus.display = winPtr->display;
+ event.xfocus.mode = NotifyNormal;
+ TkInOutEvents(&event, sourcePtr, destPtr, FocusOut, FocusIn,
+ TCL_QUEUE_MARK);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FocusMapProc --
+ *
+ * This procedure is called as an event handler for VisibilityNotify
+ * events, if a window receives the focus at a time when its
+ * toplevel isn't mapped. The procedure is needed because X
+ * won't allow the focus to be set to an unmapped window; we
+ * detect when the toplevel is mapped and set the focus to it then.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If this is a map event, the focus gets set to the toplevel
+ * given by clientData.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FocusMapProc(clientData, eventPtr)
+ ClientData clientData; /* Toplevel window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ DisplayFocusInfo *displayFocusPtr;
+
+ if (eventPtr->type == VisibilityNotify) {
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr,
+ winPtr->dispPtr);
+ if (winPtr->dispPtr->focusDebug) {
+ printf("auto-focussing on %s, force %d\n", winPtr->pathName,
+ displayFocusPtr->forceFocus);
+ }
+ Tk_DeleteEventHandler((Tk_Window) winPtr, VisibilityChangeMask,
+ FocusMapProc, clientData);
+ displayFocusPtr->focusOnMapPtr = NULL;
+ TkSetFocusWin(winPtr, displayFocusPtr->forceFocus);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindDisplayFocusInfo --
+ *
+ * Given an application and a display, this procedure locate the
+ * focus record for that combination. If no such record exists,
+ * it creates a new record and initializes it.
+ *
+ * Results:
+ * The return value is a pointer to the record.
+ *
+ * Side effects:
+ * A new record will be allocated if there wasn't one already.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DisplayFocusInfo *
+FindDisplayFocusInfo(mainPtr, dispPtr)
+ TkMainInfo *mainPtr; /* Record that identifies a particular
+ * application. */
+ TkDisplay *dispPtr; /* Display whose focus information is
+ * needed. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+
+ for (displayFocusPtr = mainPtr->displayFocusPtr;
+ displayFocusPtr != NULL;
+ displayFocusPtr = displayFocusPtr->nextPtr) {
+ if (displayFocusPtr->dispPtr == dispPtr) {
+ return displayFocusPtr;
+ }
+ }
+
+ /*
+ * The record doesn't exist yet. Make a new one.
+ */
+
+ displayFocusPtr = (DisplayFocusInfo *) ckalloc(sizeof(DisplayFocusInfo));
+ displayFocusPtr->dispPtr = dispPtr;
+ displayFocusPtr->focusWinPtr = NULL;
+ displayFocusPtr->focusOnMapPtr = NULL;
+ displayFocusPtr->forceFocus = 0;
+ displayFocusPtr->focusSerial = 0;
+ displayFocusPtr->nextPtr = mainPtr->displayFocusPtr;
+ mainPtr->displayFocusPtr = displayFocusPtr;
+ return displayFocusPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusFree --
+ *
+ * Free resources associated with maintaining the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This mainPtr should no long access focus information.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusFree(mainPtr)
+ TkMainInfo *mainPtr; /* Record that identifies a particular
+ * application. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+ ToplevelFocusInfo *tlFocusPtr;
+
+ while (mainPtr->displayFocusPtr != NULL) {
+ displayFocusPtr = mainPtr->displayFocusPtr;
+ mainPtr->displayFocusPtr = mainPtr->displayFocusPtr->nextPtr;
+ ckfree((char *) displayFocusPtr);
+ }
+ while (mainPtr->tlFocusPtr != NULL) {
+ tlFocusPtr = mainPtr->tlFocusPtr;
+ mainPtr->tlFocusPtr = mainPtr->tlFocusPtr->nextPtr;
+ ckfree((char *) tlFocusPtr);
+ }
+}
--- /dev/null
+/*
+ * tkFont.c --
+ *
+ * This file maintains a database of fonts for the Tk toolkit.
+ * It also provides several utility procedures for measuring and
+ * displaying text.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkFont.h"
+
+/*
+ * The following structure is used to keep track of all the fonts that
+ * exist in the current application. It must be stored in the
+ * TkMainInfo for the application.
+ */
+
+typedef struct TkFontInfo {
+ Tcl_HashTable fontCache; /* Map a string to an existing Tk_Font.
+ * Keys are string font names, values are
+ * TkFont pointers. */
+ Tcl_HashTable namedTable; /* Map a name to a set of attributes for a
+ * font, used when constructing a Tk_Font from
+ * a named font description. Keys are
+ * strings, values are NamedFont pointers. */
+ TkMainInfo *mainPtr; /* Application that owns this structure. */
+ int updatePending; /* Non-zero when a World Changed event has
+ * already been queued to handle a change to
+ * a named font. */
+} TkFontInfo;
+
+/*
+ * The following data structure is used to keep track of the font attributes
+ * for each named font that has been defined. The named font is only deleted
+ * when the last reference to it goes away.
+ */
+
+typedef struct NamedFont {
+ int refCount; /* Number of users of named font. */
+ int deletePending; /* Non-zero if font should be deleted when
+ * last reference goes away. */
+ TkFontAttributes fa; /* Desired attributes for named font. */
+} NamedFont;
+
+/*
+ * The following two structures are used to keep track of string
+ * measurement information when using the text layout facilities.
+ *
+ * A LayoutChunk represents a contiguous range of text that can be measured
+ * and displayed by low-level text calls. In general, chunks will be
+ * delimited by newlines and tabs. Low-level, platform-specific things
+ * like kerning and non-integer character widths may occur between the
+ * characters in a single chunk, but not between characters in different
+ * chunks.
+ *
+ * A TextLayout is a collection of LayoutChunks. It can be displayed with
+ * respect to any origin. It is the implementation of the Tk_TextLayout
+ * opaque token.
+ */
+
+typedef struct LayoutChunk {
+ CONST char *start; /* Pointer to simple string to be displayed.
+ * This is a pointer into the TkTextLayout's
+ * string. */
+ int numBytes; /* The number of bytes in this chunk. */
+ int numChars; /* The number of characters in this chunk. */
+ int numDisplayChars; /* The number of characters to display when
+ * this chunk is displayed. Can be less than
+ * numChars if extra space characters were
+ * absorbed by the end of the chunk. This
+ * will be < 0 if this is a chunk that is
+ * holding a tab or newline. */
+ int x, y; /* The origin of the first character in this
+ * chunk with respect to the upper-left hand
+ * corner of the TextLayout. */
+ int totalWidth; /* Width in pixels of this chunk. Used
+ * when hit testing the invisible spaces at
+ * the end of a chunk. */
+ int displayWidth; /* Width in pixels of the displayable
+ * characters in this chunk. Can be less than
+ * width if extra space characters were
+ * absorbed by the end of the chunk. */
+} LayoutChunk;
+
+typedef struct TextLayout {
+ Tk_Font tkfont; /* The font used when laying out the text. */
+ CONST char *string; /* The string that was layed out. */
+ int width; /* The maximum width of all lines in the
+ * text layout. */
+ int numChunks; /* Number of chunks actually used in
+ * following array. */
+ LayoutChunk chunks[1]; /* Array of chunks. The actual size will
+ * be maxChunks. THIS FIELD MUST BE THE LAST
+ * IN THE STRUCTURE. */
+} TextLayout;
+
+/*
+ * The following structures are used as two-way maps between the values for
+ * the fields in the TkFontAttributes structure and the strings used in
+ * Tcl, when parsing both option-value format and style-list format font
+ * name strings.
+ */
+
+static TkStateMap weightMap[] = {
+ {TK_FW_NORMAL, "normal"},
+ {TK_FW_BOLD, "bold"},
+ {TK_FW_UNKNOWN, NULL}
+};
+
+static TkStateMap slantMap[] = {
+ {TK_FS_ROMAN, "roman"},
+ {TK_FS_ITALIC, "italic"},
+ {TK_FS_UNKNOWN, NULL}
+};
+
+static TkStateMap underlineMap[] = {
+ {1, "underline"},
+ {0, NULL}
+};
+
+static TkStateMap overstrikeMap[] = {
+ {1, "overstrike"},
+ {0, NULL}
+};
+
+/*
+ * The following structures are used when parsing XLFD's into a set of
+ * TkFontAttributes.
+ */
+
+static TkStateMap xlfdWeightMap[] = {
+ {TK_FW_NORMAL, "normal"},
+ {TK_FW_NORMAL, "medium"},
+ {TK_FW_NORMAL, "book"},
+ {TK_FW_NORMAL, "light"},
+ {TK_FW_BOLD, "bold"},
+ {TK_FW_BOLD, "demi"},
+ {TK_FW_BOLD, "demibold"},
+ {TK_FW_NORMAL, NULL} /* Assume anything else is "normal". */
+};
+
+static TkStateMap xlfdSlantMap[] = {
+ {TK_FS_ROMAN, "r"},
+ {TK_FS_ITALIC, "i"},
+ {TK_FS_OBLIQUE, "o"},
+ {TK_FS_ROMAN, NULL} /* Assume anything else is "roman". */
+};
+
+static TkStateMap xlfdSetwidthMap[] = {
+ {TK_SW_NORMAL, "normal"},
+ {TK_SW_CONDENSE, "narrow"},
+ {TK_SW_CONDENSE, "semicondensed"},
+ {TK_SW_CONDENSE, "condensed"},
+ {TK_SW_UNKNOWN, NULL}
+};
+
+/*
+ * The following structure and defines specify the valid builtin options
+ * when configuring a set of font attributes.
+ */
+
+static CONST char *fontOpt[] = {
+ "-family",
+ "-size",
+ "-weight",
+ "-slant",
+ "-underline",
+ "-overstrike",
+ NULL
+};
+
+#define FONT_FAMILY 0
+#define FONT_SIZE 1
+#define FONT_WEIGHT 2
+#define FONT_SLANT 3
+#define FONT_UNDERLINE 4
+#define FONT_OVERSTRIKE 5
+#define FONT_NUMFIELDS 6
+
+/*
+ * Hardcoded font aliases. These are used to describe (mostly) identical
+ * fonts whose names differ from platform to platform. If the
+ * user-supplied font name matches any of the names in one of the alias
+ * lists, the other names in the alias list are also automatically tried.
+ */
+
+static char *timesAliases[] = {
+ "Times", /* Unix. */
+ "Times New Roman", /* Windows. */
+ "New York", /* Mac. */
+ NULL
+};
+
+static char *helveticaAliases[] = {
+ "Helvetica", /* Unix. */
+ "Arial", /* Windows. */
+ "Geneva", /* Mac. */
+ NULL
+};
+
+static char *courierAliases[] = {
+ "Courier", /* Unix and Mac. */
+ "Courier New", /* Windows. */
+ NULL
+};
+
+static char *minchoAliases[] = {
+ "mincho", /* Unix. */
+ "\357\274\255\357\274\263 \346\230\216\346\234\235",
+ /* Windows (MS mincho). */
+ "\346\234\254\346\230\216\346\234\235\342\210\222\357\274\255",
+ /* Mac (honmincho-M). */
+ NULL
+};
+
+static char *gothicAliases[] = {
+ "gothic", /* Unix. */
+ "\357\274\255\357\274\263 \343\202\264\343\202\267\343\203\203\343\202\257",
+ /* Windows (MS goshikku). */
+ "\344\270\270\343\202\264\343\202\267\343\203\203\343\202\257\342\210\222\357\274\255",
+ /* Mac (goshikku-M). */
+ NULL
+};
+
+static char *dingbatsAliases[] = {
+ "dingbats", "zapfdingbats", "itc zapfdingbats",
+ /* Unix. */
+ /* Windows. */
+ "zapf dingbats", /* Mac. */
+ NULL
+};
+
+static char **fontAliases[] = {
+ timesAliases,
+ helveticaAliases,
+ courierAliases,
+ minchoAliases,
+ gothicAliases,
+ dingbatsAliases,
+ NULL
+};
+
+/*
+ * Hardcoded font classes. If the character cannot be found in the base
+ * font, the classes are examined in order to see if some other similar
+ * font should be examined also.
+ */
+
+static char *systemClass[] = {
+ "fixed", /* Unix. */
+ /* Windows. */
+ "chicago", "osaka", "sistemny", /* Mac. */
+ NULL
+};
+
+static char *serifClass[] = {
+ "times", "palatino", "mincho", /* All platforms. */
+ "song ti", /* Unix. */
+ "ms serif", "simplified arabic", /* Windows. */
+ "latinski", /* Mac. */
+ NULL
+};
+
+static char *sansClass[] = {
+ "helvetica", "gothic", /* All platforms. */
+ /* Unix. */
+ "ms sans serif", "traditional arabic",
+ /* Windows. */
+ "bastion", /* Mac. */
+ NULL
+};
+
+static char *monoClass[] = {
+ "courier", "gothic", /* All platforms. */
+ "fangsong ti", /* Unix. */
+ "simplified arabic fixed", /* Windows. */
+ "monaco", "pryamoy", /* Mac. */
+ NULL
+};
+
+static char *symbolClass[] = {
+ "symbol", "dingbats", "wingdings", NULL
+};
+
+static char **fontFallbacks[] = {
+ systemClass,
+ serifClass,
+ sansClass,
+ monoClass,
+ symbolClass,
+ NULL
+};
+
+/*
+ * Global fallbacks. If the character could not be found in the preferred
+ * fallback list, this list is examined. If the character still cannot be
+ * found, all font families in the system are examined.
+ */
+
+static char *globalFontClass[] = {
+ "symbol", /* All platforms. */
+ /* Unix. */
+ "lucida sans unicode", /* Windows. */
+ "bitstream cyberbit", /* Windows popular CJK font */
+ "chicago", /* Mac. */
+ NULL
+};
+
+#define GetFontAttributes(tkfont) \
+ ((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa)
+
+#define GetFontMetrics(tkfont) \
+ ((CONST TkFontMetrics *) &((TkFont *) (tkfont))->fm)
+
+
+static int ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[],
+ TkFontAttributes *faPtr));
+static int CreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *name,
+ TkFontAttributes *faPtr));
+static void DupFontObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static int FieldSpecified _ANSI_ARGS_((CONST char *field));
+static void FreeFontObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr));
+static LayoutChunk * NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr,
+ int *maxPtr, CONST char *start, int numChars,
+ int curX, int newX, int y));
+static int ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr,
+ TkFontAttributes *faPtr));
+static void RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr));
+static int SetFontFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static void TheWorldHasChanged _ANSI_ARGS_((
+ ClientData clientData));
+static void UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
+ Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));
+
+/*
+ * The following structure defines the implementation of the "font" Tcl
+ * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of
+ * each font object points to the TkFont structure for the font, or
+ * NULL.
+ */
+
+Tcl_ObjType tkFontObjType = {
+ "font", /* name */
+ FreeFontObjProc, /* freeIntRepProc */
+ DupFontObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetFontFromAny /* setFromAnyProc */
+};
+
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the font
+ * package on a per application basis.
+ *
+ * Results:
+ * Stores a token in the mainPtr to hold information needed by this
+ * package on a per application basis.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+TkFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ TkFontInfo *fiPtr;
+
+ fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
+ Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS);
+ fiPtr->mainPtr = mainPtr;
+ fiPtr->updatePending = 0;
+ mainPtr->fontInfoPtr = fiPtr;
+
+ TkpFontPkgInit(mainPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontPkgFree --
+ *
+ * This procedure is called when an application is deleted. It
+ * deletes all the structures that were used by the font package
+ * for this application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkFontPkgFree(mainPtr)
+ TkMainInfo *mainPtr; /* The application being deleted. */
+{
+ TkFontInfo *fiPtr;
+ Tcl_HashEntry *hPtr, *searchPtr;
+ Tcl_HashSearch search;
+ int fontsLeft;
+
+ fiPtr = mainPtr->fontInfoPtr;
+
+ fontsLeft = 0;
+ for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
+ searchPtr != NULL;
+ searchPtr = Tcl_NextHashEntry(&search)) {
+ fontsLeft++;
+ fprintf(stderr, "Font %s still in cache.\n",
+ Tcl_GetHashKey(&fiPtr->fontCache, searchPtr));
+ }
+#ifdef PURIFY
+ if (fontsLeft) {
+ panic("TkFontPkgFree: all fonts should have been freed already");
+ }
+#endif
+ Tcl_DeleteHashTable(&fiPtr->fontCache);
+
+ hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
+ while (hPtr != NULL) {
+ ckfree((char *) Tcl_GetHashValue(hPtr));
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&fiPtr->namedTable);
+ if (fiPtr->updatePending != 0) {
+ Tcl_CancelIdleCall(TheWorldHasChanged, (ClientData) fiPtr);
+ }
+ ckfree((char *) fiPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FontObjCmd --
+ *
+ * This procedure is implemented to process the "font" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_FontObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index;
+ Tk_Window tkwin;
+ TkFontInfo *fiPtr;
+ static CONST char *optionStrings[] = {
+ "actual", "configure", "create", "delete",
+ "families", "measure", "metrics", "names",
+ NULL
+ };
+ enum options {
+ FONT_ACTUAL, FONT_CONFIGURE, FONT_CREATE, FONT_DELETE,
+ FONT_FAMILIES, FONT_MEASURE, FONT_METRICS, FONT_NAMES
+ };
+
+ tkwin = (Tk_Window) clientData;
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case FONT_ACTUAL: {
+ int skip, result;
+ Tk_Font tkfont;
+ Tcl_Obj *objPtr;
+ CONST TkFontAttributes *faPtr;
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if ((objc < 3) || (objc - skip > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? ?option?");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ objc -= skip;
+ objv += skip;
+ faPtr = GetFontAttributes(tkfont);
+ objPtr = NULL;
+ if (objc > 3) {
+ objPtr = objv[3];
+ }
+ result = GetAttributeInfoObj(interp, faPtr, objPtr);
+ Tk_FreeFont(tkfont);
+ return result;
+ }
+ case FONT_CONFIGURE: {
+ int result;
+ char *string;
+ Tcl_Obj *objPtr;
+ NamedFont *nfPtr;
+ Tcl_HashEntry *namedHashPtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[2]);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
+ nfPtr = NULL; /* lint. */
+ if (namedHashPtr != NULL) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ }
+ if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) {
+ Tcl_AppendResult(interp, "named font \"", string,
+ "\" doesn't exist", NULL);
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ objPtr = NULL;
+ } else if (objc == 4) {
+ objPtr = objv[3];
+ } else {
+ result = ConfigAttributesObj(interp, tkwin, objc - 3,
+ objv + 3, &nfPtr->fa);
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
+ return result;
+ }
+ return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
+ }
+ case FONT_CREATE: {
+ int skip, i;
+ char *name;
+ char buf[16 + TCL_INTEGER_SPACE];
+ TkFontAttributes fa;
+ Tcl_HashEntry *namedHashPtr;
+
+ skip = 3;
+ if (objc < 3) {
+ name = NULL;
+ } else {
+ name = Tcl_GetString(objv[2]);
+ if (name[0] == '-') {
+ name = NULL;
+ }
+ }
+ if (name == NULL) {
+ /*
+ * No font name specified. Generate one of the form "fontX".
+ */
+
+ for (i = 1; ; i++) {
+ sprintf(buf, "font%d", i);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf);
+ if (namedHashPtr == NULL) {
+ break;
+ }
+ }
+ name = buf;
+ skip = 2;
+ }
+ TkInitFontAttributes(&fa);
+ if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
+ &fa) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, name, NULL);
+ break;
+ }
+ case FONT_DELETE: {
+ int i;
+ char *string;
+ NamedFont *nfPtr;
+ Tcl_HashEntry *namedHashPtr;
+
+ /*
+ * Delete the named font. If there are still widgets using this
+ * font, then it isn't deleted right away.
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
+ return TCL_ERROR;
+ }
+ for (i = 2; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
+ if (namedHashPtr == NULL) {
+ Tcl_AppendResult(interp, "named font \"", string,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->refCount != 0) {
+ nfPtr->deletePending = 1;
+ } else {
+ Tcl_DeleteHashEntry(namedHashPtr);
+ ckfree((char *) nfPtr);
+ }
+ }
+ break;
+ }
+ case FONT_FAMILIES: {
+ int skip;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+ TkpGetFontFamilies(interp, tkwin);
+ break;
+ }
+ case FONT_MEASURE: {
+ char *string;
+ Tk_Font tkfont;
+ int length, skip;
+ Tcl_Obj *resultPtr;
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? text");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3 + skip], &length);
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length));
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ case FONT_METRICS: {
+ Tk_Font tkfont;
+ int skip, index, i;
+ CONST TkFontMetrics *fmPtr;
+ static CONST char *switches[] = {
+ "-ascent", "-descent", "-linespace", "-fixed", NULL
+ };
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if ((objc < 3) || ((objc - skip) > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? ?option?");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ objc -= skip;
+ objv += skip;
+ fmPtr = GetFontMetrics(tkfont);
+ if (objc == 3) {
+ char buf[64 + TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
+ fmPtr->ascent, fmPtr->descent,
+ fmPtr->ascent + fmPtr->descent,
+ fmPtr->fixed);
+ Tcl_AppendResult(interp, buf, NULL);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], switches,
+ "metric", 0, &index) != TCL_OK) {
+ Tk_FreeFont(tkfont);
+ return TCL_ERROR;
+ }
+ i = 0; /* Needed only to prevent compiler
+ * warning. */
+ switch (index) {
+ case 0: i = fmPtr->ascent; break;
+ case 1: i = fmPtr->descent; break;
+ case 2: i = fmPtr->ascent + fmPtr->descent; break;
+ case 3: i = fmPtr->fixed; break;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), i);
+ }
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ case FONT_NAMES: {
+ char *string;
+ NamedFont *nfPtr;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *namedHashPtr;
+ Tcl_Obj *strPtr, *resultPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "names");
+ return TCL_ERROR;
+ }
+ resultPtr = Tcl_GetObjResult(interp);
+ namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
+ while (namedHashPtr != NULL) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->deletePending == 0) {
+ string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
+ strPtr = Tcl_NewStringObj(string, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+ namedHashPtr = Tcl_NextHashEntry(&search);
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * UpdateDependentFonts, TheWorldHasChanged, RecomputeWidgets --
+ *
+ * Called when the attributes of a named font changes. Updates all
+ * the instantiated fonts that depend on that named font and then
+ * uses the brute force approach and prepares every widget to
+ * recompute its geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Things get queued for redisplay.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+UpdateDependentFonts(fiPtr, tkwin, namedHashPtr)
+ TkFontInfo *fiPtr; /* Info about application's fonts. */
+ Tk_Window tkwin; /* A window in the application. */
+ Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */
+{
+ Tcl_HashEntry *cacheHashPtr;
+ Tcl_HashSearch search;
+ TkFont *fontPtr;
+ NamedFont *nfPtr;
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->refCount == 0) {
+ /*
+ * Well nobody's using this named font, so don't have to tell
+ * any widgets to recompute themselves.
+ */
+
+ return;
+ }
+
+ cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
+ while (cacheHashPtr != NULL) {
+ for (fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
+ fontPtr != NULL; fontPtr = fontPtr->nextPtr) {
+ if (fontPtr->namedHashPtr == namedHashPtr) {
+ TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
+ if (fiPtr->updatePending == 0) {
+ fiPtr->updatePending = 1;
+ Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);
+ }
+ }
+ }
+ cacheHashPtr = Tcl_NextHashEntry(&search);
+ }
+}
+
+static void
+TheWorldHasChanged(clientData)
+ ClientData clientData; /* Info about application's fonts. */
+{
+ TkFontInfo *fiPtr;
+
+ fiPtr = (TkFontInfo *) clientData;
+ fiPtr->updatePending = 0;
+
+ RecomputeWidgets(fiPtr->mainPtr->winPtr);
+}
+
+static void
+RecomputeWidgets(winPtr)
+ TkWindow *winPtr; /* Window to which command is sent. */
+{
+ Tk_ClassWorldChangedProc *proc;
+ proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc);
+ if (proc != NULL) {
+ (*proc)(winPtr->instanceData);
+ }
+
+ /*
+ * Notify all the descendants of this window that the world has changed.
+ *
+ * This could be done recursively or iteratively. The recursive version
+ * is easier to implement and understand, and typically, windows with a
+ * -font option will be leaf nodes in the widget heirarchy (buttons,
+ * labels, etc.), so the recursion depth will be shallow.
+ *
+ * However, the additional overhead of the recursive calls may become
+ * a performance problem if typical usage alters such that -font'ed widgets
+ * appear high in the heirarchy, causing deep recursion. This could happen
+ * with text widgets, or more likely with the (not yet existant) labeled
+ * frame widget. With these widgets it is possible, even likely, that a
+ * -font'ed widget (text or labeled frame) will not be a leaf node, but
+ * will instead have many descendants. If this is ever found to cause
+ * a performance problem, it may be worth investigating an iterative
+ * version of the code below.
+ */
+ for (winPtr = winPtr->childList; winPtr != NULL; winPtr = winPtr->nextPtr) {
+ RecomputeWidgets(winPtr);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CreateNamedFont --
+ *
+ * Create the specified named font with the given attributes in the
+ * named font table associated with the interp.
+ *
+ * Results:
+ * Returns TCL_OK if the font was successfully created, or TCL_ERROR
+ * if the named font already existed. If TCL_ERROR is returned, an
+ * error message is left in the interp's result.
+ *
+ * Side effects:
+ * Assume there used to exist a named font by the specified name, and
+ * that the named font had been deleted, but there were still some
+ * widgets using the named font at the time it was deleted. If a
+ * new named font is created with the same name, all those widgets
+ * that were using the old named font will be redisplayed using
+ * the new named font's attributes.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+CreateNamedFont(interp, tkwin, name, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tk_Window tkwin; /* A window associated with interp. */
+ CONST char *name; /* Name for the new named font. */
+ TkFontAttributes *faPtr; /* Attributes for the new named font. */
+{
+ TkFontInfo *fiPtr;
+ Tcl_HashEntry *namedHashPtr;
+ int new;
+ NamedFont *nfPtr;
+
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+
+ namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
+
+ if (new == 0) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->deletePending == 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "named font \"", name,
+ "\" already exists", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Recreating a named font with the same name as a previous
+ * named font. Some widgets were still using that named
+ * font, so they need to get redisplayed.
+ */
+
+ nfPtr->fa = *faPtr;
+ nfPtr->deletePending = 0;
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
+ return TCL_OK;
+ }
+
+ nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont));
+ nfPtr->deletePending = 0;
+ Tcl_SetHashValue(namedHashPtr, nfPtr);
+ nfPtr->fa = *faPtr;
+ nfPtr->refCount = 0;
+ nfPtr->deletePending = 0;
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFont --
+ *
+ * Given a string description of a font, map the description to a
+ * corresponding Tk_Font that represents the font.
+ *
+ * Results:
+ * The return value is token for the font, or NULL if an error
+ * prevented the font from being created. If NULL is returned, an
+ * error message will be left in the interp's result.
+ *
+ * Side effects:
+ * The font is added to an internal database with a reference
+ * count. For each call to this procedure, there should eventually
+ * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
+ * database is cleaned up when fonts aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_GetFont(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interp for database and error return. */
+ Tk_Window tkwin; /* For display on which font will be used. */
+ CONST char *string; /* String describing font, as: named font,
+ * native format, or parseable string. */
+{
+ Tk_Font tkfont;
+ Tcl_Obj *strPtr;
+
+ strPtr = Tcl_NewStringObj((char *) string, -1);
+ Tcl_IncrRefCount(strPtr);
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
+ Tcl_DecrRefCount(strPtr);
+ return tkfont;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_AllocFontFromObj --
+ *
+ * Given a string description of a font, map the description to a
+ * corresponding Tk_Font that represents the font.
+ *
+ * Results:
+ * The return value is token for the font, or NULL if an error
+ * prevented the font from being created. If NULL is returned, an
+ * error message will be left in interp's result object.
+ *
+ * Side effects:
+ * The font is added to an internal database with a reference
+ * count. For each call to this procedure, there should eventually
+ * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
+ * database is cleaned up when fonts aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_AllocFontFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for database and error return. */
+ Tk_Window tkwin; /* For screen on which font will be used. */
+ Tcl_Obj *objPtr; /* Object describing font, as: named font,
+ * native format, or parseable string. */
+{
+ TkFontInfo *fiPtr;
+ Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
+ TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
+ int new, descent;
+ NamedFont *nfPtr;
+
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ if (objPtr->typePtr != &tkFontObjType) {
+ SetFontFromAny(interp, objPtr);
+ }
+
+ oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (oldFontPtr != NULL) {
+ if (oldFontPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkFont that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeFontObjProc(objPtr);
+ oldFontPtr = NULL;
+ } else if (Tk_Screen(tkwin) == oldFontPtr->screen) {
+ oldFontPtr->resourceRefCount++;
+ return (Tk_Font) oldFontPtr;
+ }
+ }
+
+ /*
+ * Next, search the list of fonts that have the name we want, to see
+ * if one of them is for the right screen.
+ */
+
+ new = 0;
+ if (oldFontPtr != NULL) {
+ cacheHashPtr = oldFontPtr->cacheHashPtr;
+ FreeFontObjProc(objPtr);
+ } else {
+ cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache,
+ Tcl_GetString(objPtr), &new);
+ }
+ firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
+ for (fontPtr = firstFontPtr; (fontPtr != NULL);
+ fontPtr = fontPtr->nextPtr) {
+ if (Tk_Screen(tkwin) == fontPtr->screen) {
+ fontPtr->resourceRefCount++;
+ fontPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+ return (Tk_Font) fontPtr;
+ }
+ }
+
+ /*
+ * The desired font isn't in the table. Make a new one.
+ */
+
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
+ Tcl_GetString(objPtr));
+ if (namedHashPtr != NULL) {
+ /*
+ * Construct a font based on a named font.
+ */
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ nfPtr->refCount++;
+
+ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
+ } else {
+ /*
+ * Native font?
+ */
+
+ fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
+ if (fontPtr == NULL) {
+ TkFontAttributes fa;
+ Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);
+
+ if (ParseFontNameObj(interp, tkwin, dupObjPtr, &fa) != TCL_OK) {
+ if (new) {
+ Tcl_DeleteHashEntry(cacheHashPtr);
+ }
+ Tcl_DecrRefCount(dupObjPtr);
+ return NULL;
+ }
+ Tcl_DecrRefCount(dupObjPtr);
+
+ /*
+ * String contained the attributes inline.
+ */
+
+ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
+ }
+ }
+
+ fontPtr->resourceRefCount = 1;
+ fontPtr->objRefCount = 1;
+ fontPtr->cacheHashPtr = cacheHashPtr;
+ fontPtr->namedHashPtr = namedHashPtr;
+ fontPtr->screen = Tk_Screen(tkwin);
+ fontPtr->nextPtr = firstFontPtr;
+ Tcl_SetHashValue(cacheHashPtr, fontPtr);
+
+ Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth);
+ if (fontPtr->tabWidth == 0) {
+ fontPtr->tabWidth = fontPtr->fm.maxWidth;
+ }
+ fontPtr->tabWidth *= 8;
+
+ /*
+ * Make sure the tab width isn't zero (some fonts may not have enough
+ * information to set a reasonable tab width).
+ */
+
+ if (fontPtr->tabWidth == 0) {
+ fontPtr->tabWidth = 1;
+ }
+
+ /*
+ * Get information used for drawing underlines in generic code on a
+ * non-underlined font.
+ */
+
+ descent = fontPtr->fm.descent;
+ fontPtr->underlinePos = descent / 2;
+ fontPtr->underlineHeight = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10;
+ if (fontPtr->underlineHeight == 0) {
+ fontPtr->underlineHeight = 1;
+ }
+ if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
+ /*
+ * If this set of values would cause the bottom of the underline
+ * bar to stick below the descent of the font, jack the underline
+ * up a bit higher.
+ */
+
+ fontPtr->underlineHeight = descent - fontPtr->underlinePos;
+ if (fontPtr->underlineHeight == 0) {
+ fontPtr->underlinePos--;
+ fontPtr->underlineHeight = 1;
+ }
+ }
+
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+ return (Tk_Font) fontPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetFontFromObj --
+ *
+ * Find the font that corresponds to a given object. The font must
+ * have already been created by Tk_GetFont or Tk_AllocFontFromObj.
+ *
+ * Results:
+ * The return value is a token for the font that matches objPtr
+ * and is suitable for use in tkwin.
+ *
+ * Side effects:
+ * If the object is not already a font ref, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_GetFontFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window that the font will be used in. */
+ Tcl_Obj *objPtr; /* The object from which to get the font. */
+{
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ TkFont *fontPtr;
+ Tcl_HashEntry *hashPtr;
+
+ if (objPtr->typePtr != &tkFontObjType) {
+ SetFontFromAny((Tcl_Interp *) NULL, objPtr);
+ }
+
+ fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (fontPtr != NULL) {
+ if (fontPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkFont that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeFontObjProc(objPtr);
+ fontPtr = NULL;
+ } else if (Tk_Screen(tkwin) == fontPtr->screen) {
+ return (Tk_Font) fontPtr;
+ }
+ }
+
+ /*
+ * Next, search the list of fonts that have the name we want, to see
+ * if one of them is for the right screen.
+ */
+
+ if (fontPtr != NULL) {
+ hashPtr = fontPtr->cacheHashPtr;
+ FreeFontObjProc(objPtr);
+ } else {
+ hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr));
+ }
+ if (hashPtr != NULL) {
+ for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL;
+ fontPtr = fontPtr->nextPtr) {
+ if (Tk_Screen(tkwin) == fontPtr->screen) {
+ fontPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+ return (Tk_Font) fontPtr;
+ }
+ }
+ }
+
+ panic("Tk_GetFontFromObj called with non-existent font!");
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetFontFromAny --
+ *
+ * Convert the internal representation of a Tcl object to the
+ * font internal form.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * The object is left with its typePtr pointing to tkFontObjType.
+ * The TkFont pointer is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetFontFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkFontObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_NameOfFont --
+ *
+ * Given a font, return a textual string identifying it.
+ *
+ * Results:
+ * The return value is the description that was passed to
+ * Tk_GetFont() to create the font. The storage for the returned
+ * string is only guaranteed to persist until the font is deleted.
+ * The caller should not modify this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfFont(tkfont)
+ Tk_Font tkfont; /* Font whose name is desired. */
+{
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ return fontPtr->cacheHashPtr->key.string;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeFont --
+ *
+ * Called to release a font allocated by Tk_GetFont().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with font is decremented, and
+ * only deallocated when no one is using it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeFont(tkfont)
+ Tk_Font tkfont; /* Font to be released. */
+{
+ TkFont *fontPtr, *prevPtr;
+ NamedFont *nfPtr;
+
+ if (tkfont == NULL) {
+ return;
+ }
+ fontPtr = (TkFont *) tkfont;
+ fontPtr->resourceRefCount--;
+ if (fontPtr->resourceRefCount > 0) {
+ return;
+ }
+ if (fontPtr->namedHashPtr != NULL) {
+ /*
+ * This font derived from a named font. Reduce the reference
+ * count on the named font and free it if no-one else is
+ * using it.
+ */
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr);
+ nfPtr->refCount--;
+ if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) {
+ Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
+ ckfree((char *) nfPtr);
+ }
+ }
+
+ prevPtr = (TkFont *) Tcl_GetHashValue(fontPtr->cacheHashPtr);
+ if (prevPtr == fontPtr) {
+ if (fontPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
+ } else {
+ Tcl_SetHashValue(fontPtr->cacheHashPtr, fontPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != fontPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = fontPtr->nextPtr;
+ }
+
+ TkpDeleteFont(fontPtr);
+ if (fontPtr->objRefCount == 0) {
+ ckfree((char *) fontPtr);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeFontFromObj --
+ *
+ * Called to release a font inside a Tcl_Obj *. Decrements the refCount
+ * of the font and removes it from the hash tables if necessary.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with font is decremented, and
+ * only deallocated when no one is using it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeFontFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this font lives in. Needed
+ * for the screen value. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ Tk_FreeFont(Tk_GetFontFromObj(tkwin, objPtr));
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeFontObjProc --
+ *
+ * This proc is called to release an object reference to a font.
+ * Called when the object's internal rep is released or when
+ * the cached fontPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the font's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeFontObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkFont *fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (fontPtr != NULL) {
+ fontPtr->objRefCount--;
+ if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) {
+ ckfree((char *) fontPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ }
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupFontObjProc --
+ *
+ * When a cached font object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The font's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupFontObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkFont *fontPtr = (TkFont *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+
+ if (fontPtr != NULL) {
+ fontPtr->objRefCount++;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FontId --
+ *
+ * Given a font, return an opaque handle that should be selected
+ * into the XGCValues structure in order to get the constructed
+ * gc to use this font. This procedure would go away if the
+ * XGCValues structure were replaced with a TkGCValues structure.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Font
+Tk_FontId(tkfont)
+ Tk_Font tkfont; /* Font that is going to be selected into GC. */
+{
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ return fontPtr->fid;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFontMetrics --
+ *
+ * Returns overall ascent and descent metrics for the given font.
+ * These values can be used to space multiple lines of text and
+ * to align the baselines of text in different fonts.
+ *
+ * Results:
+ * If *heightPtr is non-NULL, it is filled with the overall height
+ * of the font, which is the sum of the ascent and descent.
+ * If *ascentPtr or *descentPtr is non-NULL, they are filled with
+ * the ascent and/or descent information for the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+Tk_GetFontMetrics(tkfont, fmPtr)
+ Tk_Font tkfont; /* Font in which metrics are calculated. */
+ Tk_FontMetrics *fmPtr; /* Pointer to structure in which font
+ * metrics for tkfont will be stored. */
+{
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ fmPtr->ascent = fontPtr->fm.ascent;
+ fmPtr->descent = fontPtr->fm.descent;
+ fmPtr->linespace = fontPtr->fm.ascent + fontPtr->fm.descent;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_PostscriptFontName --
+ *
+ * Given a Tk_Font, return the name of the corresponding Postscript
+ * font.
+ *
+ * Results:
+ * The return value is the pointsize of the given Tk_Font.
+ * The name of the Postscript font is appended to dsPtr.
+ *
+ * Side effects:
+ * If the font does not exist on the printer, the print job will
+ * fail at print time. Given a "reasonable" Postscript printer,
+ * the following Tk_Font font families should print correctly:
+ *
+ * Avant Garde, Arial, Bookman, Courier, Courier New, Geneva,
+ * Helvetica, Monaco, New Century Schoolbook, New York,
+ * Palatino, Symbol, Times, Times New Roman, Zapf Chancery,
+ * and Zapf Dingbats.
+ *
+ * Any other Tk_Font font families may not print correctly
+ * because the computed Postscript font name may be incorrect.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptFontName(tkfont, dsPtr)
+ Tk_Font tkfont; /* Font in which text will be printed. */
+ Tcl_DString *dsPtr; /* Pointer to an initialized Tcl_DString to
+ * which the name of the Postscript font that
+ * corresponds to tkfont will be appended. */
+{
+ TkFont *fontPtr;
+ Tk_Uid family, weightString, slantString;
+ char *src, *dest;
+ int upper, len;
+
+ len = Tcl_DStringLength(dsPtr);
+ fontPtr = (TkFont *) tkfont;
+
+ /*
+ * Convert the case-insensitive Tk_Font family name to the
+ * case-sensitive Postscript family name. Take out any spaces and
+ * capitalize the first letter of each word.
+ */
+
+ family = fontPtr->fa.family;
+ if (strncasecmp(family, "itc ", 4) == 0) {
+ family = family + 4;
+ }
+ if ((strcasecmp(family, "Arial") == 0)
+ || (strcasecmp(family, "Geneva") == 0)) {
+ family = "Helvetica";
+ } else if ((strcasecmp(family, "Times New Roman") == 0)
+ || (strcasecmp(family, "New York") == 0)) {
+ family = "Times";
+ } else if ((strcasecmp(family, "Courier New") == 0)
+ || (strcasecmp(family, "Monaco") == 0)) {
+ family = "Courier";
+ } else if (strcasecmp(family, "AvantGarde") == 0) {
+ family = "AvantGarde";
+ } else if (strcasecmp(family, "ZapfChancery") == 0) {
+ family = "ZapfChancery";
+ } else if (strcasecmp(family, "ZapfDingbats") == 0) {
+ family = "ZapfDingbats";
+ } else {
+ Tcl_UniChar ch;
+
+ /*
+ * Inline, capitalize the first letter of each word, lowercase the
+ * rest of the letters in each word, and then take out the spaces
+ * between the words. This may make the DString shorter, which is
+ * safe to do.
+ */
+
+ Tcl_DStringAppend(dsPtr, family, -1);
+
+ src = dest = Tcl_DStringValue(dsPtr) + len;
+ upper = 1;
+ for (; *src != '\0'; ) {
+ while (isspace(UCHAR(*src))) { /* INTL: ISO space */
+ src++;
+ upper = 1;
+ }
+ src += Tcl_UtfToUniChar(src, &ch);
+ if (upper) {
+ ch = Tcl_UniCharToUpper(ch);
+ upper = 0;
+ } else {
+ ch = Tcl_UniCharToLower(ch);
+ }
+ dest += Tcl_UniCharToUtf(ch, dest);
+ }
+ *dest = '\0';
+ Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+ if (family != Tcl_DStringValue(dsPtr) + len) {
+ Tcl_DStringAppend(dsPtr, family, -1);
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+
+ if (strcasecmp(family, "NewCenturySchoolbook") == 0) {
+ Tcl_DStringSetLength(dsPtr, len);
+ Tcl_DStringAppend(dsPtr, "NewCenturySchlbk", -1);
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+
+ /*
+ * Get the string to use for the weight.
+ */
+
+ weightString = NULL;
+ if (fontPtr->fa.weight == TK_FW_NORMAL) {
+ if (strcmp(family, "Bookman") == 0) {
+ weightString = "Light";
+ } else if (strcmp(family, "AvantGarde") == 0) {
+ weightString = "Book";
+ } else if (strcmp(family, "ZapfChancery") == 0) {
+ weightString = "Medium";
+ }
+ } else {
+ if ((strcmp(family, "Bookman") == 0)
+ || (strcmp(family, "AvantGarde") == 0)) {
+ weightString = "Demi";
+ } else {
+ weightString = "Bold";
+ }
+ }
+
+ /*
+ * Get the string to use for the slant.
+ */
+
+ slantString = NULL;
+ if (fontPtr->fa.slant == TK_FS_ROMAN) {
+ ;
+ } else {
+ if ((strcmp(family, "Helvetica") == 0)
+ || (strcmp(family, "Courier") == 0)
+ || (strcmp(family, "AvantGarde") == 0)) {
+ slantString = "Oblique";
+ } else {
+ slantString = "Italic";
+ }
+ }
+
+ /*
+ * The string "Roman" needs to be added to some fonts that are not bold
+ * and not italic.
+ */
+
+ if ((slantString == NULL) && (weightString == NULL)) {
+ if ((strcmp(family, "Times") == 0)
+ || (strcmp(family, "NewCenturySchlbk") == 0)
+ || (strcmp(family, "Palatino") == 0)) {
+ Tcl_DStringAppend(dsPtr, "-Roman", -1);
+ }
+ } else {
+ Tcl_DStringAppend(dsPtr, "-", -1);
+ if (weightString != NULL) {
+ Tcl_DStringAppend(dsPtr, weightString, -1);
+ }
+ if (slantString != NULL) {
+ Tcl_DStringAppend(dsPtr, slantString, -1);
+ }
+ }
+
+ return fontPtr->fa.size;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_TextWidth --
+ *
+ * A wrapper function for the more complicated interface of
+ * Tk_MeasureChars. Computes how much space the given
+ * simple string needs.
+ *
+ * Results:
+ * The return value is the width (in pixels) of the given string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_TextWidth(tkfont, string, numBytes)
+ Tk_Font tkfont; /* Font in which text will be measured. */
+ CONST char *string; /* String whose width will be computed. */
+ int numBytes; /* Number of bytes to consider from
+ * string, or < 0 for strlen(). */
+{
+ int width;
+
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+ Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width);
+ return width;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_UnderlineChars --
+ *
+ * This procedure draws an underline for a given range of characters
+ * in a given string. It doesn't draw the characters (which are
+ * assumed to have been displayed previously); it just draws the
+ * underline. This procedure would mainly be used to quickly
+ * underline a few characters without having to construct an
+ * underlined font. To produce properly underlined text, the
+ * appropriate underlined font should be constructed and used.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets displayed in "drawable".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstByte,
+ lastByte)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context for actually drawing
+ * line. */
+ Tk_Font tkfont; /* Font used in GC; must have been allocated
+ * by Tk_GetFont(). Used for character
+ * dimensions, etc. */
+ CONST char *string; /* String containing characters to be
+ * underlined or overstruck. */
+ int x, y; /* Coordinates at which first character of
+ * string is drawn. */
+ int firstByte; /* Index of first byte of first character. */
+ int lastByte; /* Index of first byte after the last
+ * character. */
+{
+ TkFont *fontPtr;
+ int startX, endX;
+
+ fontPtr = (TkFont *) tkfont;
+
+ Tk_MeasureChars(tkfont, string, firstByte, -1, 0, &startX);
+ Tk_MeasureChars(tkfont, string, lastByte, -1, 0, &endX);
+
+ XFillRectangle(display, drawable, gc, x + startX,
+ y + fontPtr->underlinePos, (unsigned int) (endX - startX),
+ (unsigned int) fontPtr->underlineHeight);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_ComputeTextLayout --
+ *
+ * Computes the amount of screen space needed to display a
+ * multi-line, justified string of text. Records all the
+ * measurements that were done to determine to size and
+ * positioning of the individual lines of text; this information
+ * can be used by the Tk_DrawTextLayout() procedure to
+ * display the text quickly (without remeasuring it).
+ *
+ * This procedure is useful for simple widgets that want to
+ * display single-font, multi-line text and want Tk to handle the
+ * details.
+ *
+ * Results:
+ * The return value is a Tk_TextLayout token that holds the
+ * measurement information for the given string. The token is
+ * only valid for the given string. If the string is freed,
+ * the token is no longer valid and must also be freed. To free
+ * the token, call Tk_FreeTextLayout().
+ *
+ * The dimensions of the screen area needed to display the text
+ * are stored in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * Memory is allocated to hold the measurement information.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_TextLayout
+Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
+ widthPtr, heightPtr)
+ Tk_Font tkfont; /* Font that will be used to display text. */
+ CONST char *string; /* String whose dimensions are to be
+ * computed. */
+ int numChars; /* Number of characters to consider from
+ * string, or < 0 for strlen(). */
+ int wrapLength; /* Longest permissible line length, in
+ * pixels. <= 0 means no automatic wrapping:
+ * just let lines get as long as needed. */
+ Tk_Justify justify; /* How to justify lines. */
+ int flags; /* Flag bits OR-ed together.
+ * TK_IGNORE_TABS means that tab characters
+ * should not be expanded. TK_IGNORE_NEWLINES
+ * means that newline characters should not
+ * cause a line break. */
+ int *widthPtr; /* Filled with width of string. */
+ int *heightPtr; /* Filled with height of string. */
+{
+ TkFont *fontPtr;
+ CONST char *start, *end, *special;
+ int n, y, bytesThisChunk, maxChunks;
+ int baseline, height, curX, newX, maxWidth;
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ CONST TkFontMetrics *fmPtr;
+ Tcl_DString lineBuffer;
+ int *lineLengths;
+ int curLine, layoutHeight;
+
+ Tcl_DStringInit(&lineBuffer);
+
+ fontPtr = (TkFont *) tkfont;
+ if ((fontPtr == NULL) || (string == NULL)) {
+ if (widthPtr != NULL) {
+ *widthPtr = 0;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = 0;
+ }
+ return NULL;
+ }
+
+ fmPtr = &fontPtr->fm;
+
+ height = fmPtr->ascent + fmPtr->descent;
+
+ if (numChars < 0) {
+ numChars = Tcl_NumUtfChars(string, -1);
+ }
+ if (wrapLength == 0) {
+ wrapLength = -1;
+ }
+
+ maxChunks = 1;
+
+ layoutPtr = (TextLayout *) ckalloc(sizeof(TextLayout)
+ + (maxChunks - 1) * sizeof(LayoutChunk));
+ layoutPtr->tkfont = tkfont;
+ layoutPtr->string = string;
+ layoutPtr->numChunks = 0;
+
+ baseline = fmPtr->ascent;
+ maxWidth = 0;
+
+ /*
+ * Divide the string up into simple strings and measure each string.
+ */
+
+ curX = 0;
+
+ end = Tcl_UtfAtIndex(string, numChars);
+ special = string;
+
+ flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
+ flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;
+ for (start = string; start < end; ) {
+ if (start >= special) {
+ /*
+ * Find the next special character in the string.
+ *
+ * INTL: Note that it is safe to increment by byte, because we are
+ * looking for 7-bit characters that will appear unchanged in
+ * UTF-8. At some point we may need to support the full Unicode
+ * whitespace set.
+ */
+
+ for (special = start; special < end; special++) {
+ if (!(flags & TK_IGNORE_NEWLINES)) {
+ if ((*special == '\n') || (*special == '\r')) {
+ break;
+ }
+ }
+ if (!(flags & TK_IGNORE_TABS)) {
+ if (*special == '\t') {
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * Special points at the next special character (or the end of the
+ * string). Process characters between start and special.
+ */
+
+ chunkPtr = NULL;
+ if (start < special) {
+ bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start,
+ wrapLength - curX, flags, &newX);
+ newX += curX;
+ flags &= ~TK_AT_LEAST_ONE;
+ if (bytesThisChunk > 0) {
+ chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
+ bytesThisChunk, curX, newX, baseline);
+
+ start += bytesThisChunk;
+ curX = newX;
+ }
+ }
+
+ if ((start == special) && (special < end)) {
+ /*
+ * Handle the special character.
+ *
+ * INTL: Special will be pointing at a 7-bit character so we
+ * can safely treat it as a single byte.
+ */
+
+ chunkPtr = NULL;
+ if (*special == '\t') {
+ newX = curX + fontPtr->tabWidth;
+ newX -= newX % fontPtr->tabWidth;
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,
+ baseline)->numDisplayChars = -1;
+ start++;
+ if ((start < end) &&
+ ((wrapLength <= 0) || (newX <= wrapLength))) {
+ /*
+ * More chars can still fit on this line.
+ */
+
+ curX = newX;
+ flags &= ~TK_AT_LEAST_ONE;
+ continue;
+ }
+ } else {
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, curX,
+ baseline)->numDisplayChars = -1;
+ start++;
+ goto wrapLine;
+ }
+ }
+
+ /*
+ * No more characters are going to go on this line, either because
+ * no more characters can fit or there are no more characters left.
+ * Consume all extra spaces at end of line.
+ */
+
+ while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */
+ if (!(flags & TK_IGNORE_NEWLINES)) {
+ if ((*start == '\n') || (*start == '\r')) {
+ break;
+ }
+ }
+ if (!(flags & TK_IGNORE_TABS)) {
+ if (*start == '\t') {
+ break;
+ }
+ }
+ start++;
+ }
+ if (chunkPtr != NULL) {
+ CONST char *end;
+
+ /*
+ * Append all the extra spaces on this line to the end of the
+ * last text chunk. This is a little tricky because we are
+ * switching back and forth between characters and bytes.
+ */
+
+ end = chunkPtr->start + chunkPtr->numBytes;
+ bytesThisChunk = start - end;
+ if (bytesThisChunk > 0) {
+ bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk,
+ -1, 0, &chunkPtr->totalWidth);
+ chunkPtr->numBytes += bytesThisChunk;
+ chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk);
+ chunkPtr->totalWidth += curX;
+ }
+ }
+
+ wrapLine:
+ flags |= TK_AT_LEAST_ONE;
+
+ /*
+ * Save current line length, then move current position to start of
+ * next line.
+ */
+
+ if (curX > maxWidth) {
+ maxWidth = curX;
+ }
+
+ /*
+ * Remember width of this line, so that all chunks on this line
+ * can be centered or right justified, if necessary.
+ */
+
+ Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
+
+ curX = 0;
+ baseline += height;
+ }
+
+ /*
+ * If last line ends with a newline, then we need to make a 0 width
+ * chunk on the next line. Otherwise "Hello" and "Hello\n" are the
+ * same height.
+ */
+
+ if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
+ if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
+ chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
+ curX, baseline);
+ chunkPtr->numDisplayChars = -1;
+ Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
+ baseline += height;
+ }
+ }
+
+ layoutPtr->width = maxWidth;
+ layoutHeight = baseline - fmPtr->ascent;
+ if (layoutPtr->numChunks == 0) {
+ layoutHeight = height;
+
+ /*
+ * This fake chunk is used by the other procedures so that they can
+ * pretend that there is a chunk with no chars in it, which makes
+ * the coding simpler.
+ */
+
+ layoutPtr->numChunks = 1;
+ layoutPtr->chunks[0].start = string;
+ layoutPtr->chunks[0].numBytes = 0;
+ layoutPtr->chunks[0].numChars = 0;
+ layoutPtr->chunks[0].numDisplayChars = -1;
+ layoutPtr->chunks[0].x = 0;
+ layoutPtr->chunks[0].y = fmPtr->ascent;
+ layoutPtr->chunks[0].totalWidth = 0;
+ layoutPtr->chunks[0].displayWidth = 0;
+ } else {
+ /*
+ * Using maximum line length, shift all the chunks so that the lines
+ * are all justified correctly.
+ */
+
+ curLine = 0;
+ chunkPtr = layoutPtr->chunks;
+ y = chunkPtr->y;
+ lineLengths = (int *) Tcl_DStringValue(&lineBuffer);
+ for (n = 0; n < layoutPtr->numChunks; n++) {
+ int extra;
+
+ if (chunkPtr->y != y) {
+ curLine++;
+ y = chunkPtr->y;
+ }
+ extra = maxWidth - lineLengths[curLine];
+ if (justify == TK_JUSTIFY_CENTER) {
+ chunkPtr->x += extra / 2;
+ } else if (justify == TK_JUSTIFY_RIGHT) {
+ chunkPtr->x += extra;
+ }
+ chunkPtr++;
+ }
+ }
+
+ if (widthPtr != NULL) {
+ *widthPtr = layoutPtr->width;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = layoutHeight;
+ }
+ Tcl_DStringFree(&lineBuffer);
+
+ return (Tk_TextLayout) layoutPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeTextLayout --
+ *
+ * This procedure is called to release the storage associated with
+ * a Tk_TextLayout when it is no longer needed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeTextLayout(textLayout)
+ Tk_TextLayout textLayout; /* The text layout to be released. */
+{
+ TextLayout *layoutPtr;
+
+ layoutPtr = (TextLayout *) textLayout;
+ if (layoutPtr != NULL) {
+ ckfree((char *) layoutPtr);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawTextLayout --
+ *
+ * Use the information in the Tk_TextLayout token to display a
+ * multi-line, justified string of text.
+ *
+ * This procedure is useful for simple widgets that need to
+ * display single-font, multi-line text and want Tk to handle
+ * the details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Text drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context to use for drawing text. */
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ int firstChar; /* The index of the first character to draw
+ * from the given text item. 0 specfies the
+ * beginning. */
+ int lastChar; /* The index just after the last character
+ * to draw from the given text item. A number
+ * < 0 means to draw all characters. */
+{
+ TextLayout *layoutPtr;
+ int i, numDisplayChars, drawX;
+ CONST char *firstByte;
+ CONST char *lastByte;
+ LayoutChunk *chunkPtr;
+
+ layoutPtr = (TextLayout *) layout;
+ if (layoutPtr == NULL) {
+ return;
+ }
+
+ if (lastChar < 0) {
+ lastChar = 100000000;
+ }
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ numDisplayChars = chunkPtr->numDisplayChars;
+ if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
+ if (firstChar <= 0) {
+ drawX = 0;
+ firstChar = 0;
+ firstByte = chunkPtr->start;
+ } else {
+ firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar);
+ Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start,
+ firstByte - chunkPtr->start, -1, 0, &drawX);
+ }
+ if (lastChar < numDisplayChars) {
+ numDisplayChars = lastChar;
+ }
+ lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars);
+ Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
+ firstByte, lastByte - firstByte,
+ x + chunkPtr->x + drawX, y + chunkPtr->y);
+ }
+ firstChar -= chunkPtr->numChars;
+ lastChar -= chunkPtr->numChars;
+ if (lastChar <= 0) {
+ break;
+ }
+ chunkPtr++;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_UnderlineTextLayout --
+ *
+ * Use the information in the Tk_TextLayout token to display an
+ * underline below an individual character. This procedure does
+ * not draw the text, just the underline.
+ *
+ * This procedure is useful for simple widgets that need to
+ * display single-font, multi-line text with an individual
+ * character underlined and want Tk to handle the details.
+ * To display larger amounts of underlined text, construct
+ * and use an underlined font.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Underline drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context to use for drawing text. */
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ int underline; /* Index of the single character to
+ * underline, or -1 for no underline. */
+{
+ TextLayout *layoutPtr;
+ TkFont *fontPtr;
+ int xx, yy, width, height;
+
+ if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
+ && (width != 0)) {
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ XFillRectangle(display, drawable, gc, x + xx,
+ y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
+ (unsigned int) width, (unsigned int) fontPtr->underlineHeight);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_PointToChar --
+ *
+ * Use the information in the Tk_TextLayout token to determine the
+ * character closest to the given point. The point must be
+ * specified with respect to the upper-left hand corner of the
+ * text layout, which is considered to be located at (0, 0).
+ *
+ * Any point whose y-value is less that 0 will be considered closest
+ * to the first character in the text layout; any point whose y-value
+ * is greater than the height of the text layout will be considered
+ * closest to the last character in the text layout.
+ *
+ * Any point whose x-value is less than 0 will be considered closest
+ * to the first character on that line; any point whose x-value is
+ * greater than the width of the text layout will be considered
+ * closest to the last character on that line.
+ *
+ * Results:
+ * The return value is the index of the character that was
+ * closest to the point. Given a text layout with no characters,
+ * the value 0 will always be returned, referring to a hypothetical
+ * zero-width placeholder character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_PointToChar(layout, x, y)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Coordinates of point to check, with
+ * respect to the upper-left corner of the
+ * text layout. */
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr, *lastPtr;
+ TkFont *fontPtr;
+ int i, n, dummy, baseline, pos, numChars;
+
+ if (y < 0) {
+ /*
+ * Point lies above any line in this layout. Return the index of
+ * the first char.
+ */
+
+ return 0;
+ }
+
+ /*
+ * Find which line contains the point.
+ */
+
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+ lastPtr = chunkPtr = layoutPtr->chunks;
+ numChars = 0;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ baseline = chunkPtr->y;
+ if (y < baseline + fontPtr->fm.descent) {
+ if (x < chunkPtr->x) {
+ /*
+ * Point is to the left of all chunks on this line. Return
+ * the index of the first character on this line.
+ */
+
+ return numChars;
+ }
+ if (x >= layoutPtr->width) {
+ /*
+ * If point lies off right side of the text layout, return
+ * the last char in the last chunk on this line. Without
+ * this, it might return the index of the first char that
+ * was located outside of the text layout.
+ */
+
+ x = INT_MAX;
+ }
+
+ /*
+ * Examine all chunks on this line to see which one contains
+ * the specified point.
+ */
+
+ lastPtr = chunkPtr;
+ while ((i < layoutPtr->numChunks) && (chunkPtr->y == baseline)) {
+ if (x < chunkPtr->x + chunkPtr->totalWidth) {
+ /*
+ * Point falls on one of the characters in this chunk.
+ */
+
+ if (chunkPtr->numDisplayChars < 0) {
+ /*
+ * This is a special chunk that encapsulates a single
+ * tab or newline char.
+ */
+
+ return numChars;
+ }
+ n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
+ chunkPtr->numBytes, x - chunkPtr->x,
+ 0, &dummy);
+ return numChars + Tcl_NumUtfChars(chunkPtr->start, n);
+ }
+ numChars += chunkPtr->numChars;
+ lastPtr = chunkPtr;
+ chunkPtr++;
+ i++;
+ }
+
+ /*
+ * Point is to the right of all chars in all the chunks on this
+ * line. Return the index just past the last char in the last
+ * chunk on this line.
+ */
+
+ pos = numChars;
+ if (i < layoutPtr->numChunks) {
+ pos--;
+ }
+ return pos;
+ }
+ numChars += chunkPtr->numChars;
+ lastPtr = chunkPtr;
+ chunkPtr++;
+ }
+
+ /*
+ * Point lies below any line in this text layout. Return the index
+ * just past the last char.
+ */
+
+ return (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_CharBbox --
+ *
+ * Use the information in the Tk_TextLayout token to return the
+ * bounding box for the character specified by index.
+ *
+ * The width of the bounding box is the advance width of the
+ * character, and does not include and left- or right-bearing.
+ * Any character that extends partially outside of the
+ * text layout is considered to be truncated at the edge. Any
+ * character which is located completely outside of the text
+ * layout is considered to be zero-width and pegged against
+ * the edge.
+ *
+ * The height of the bounding box is the line height for this font,
+ * extending from the top of the ascent to the bottom of the
+ * descent. Information about the actual height of the individual
+ * letter is not available.
+ *
+ * A text layout that contains no characters is considered to
+ * contain a single zero-width placeholder character.
+ *
+ * Results:
+ * The return value is 0 if the index did not specify a character
+ * in the text layout, or non-zero otherwise. In that case,
+ * *bbox is filled with the bounding box of the character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr)
+ Tk_TextLayout layout; /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int index; /* The index of the character whose bbox is
+ * desired. */
+ int *xPtr, *yPtr; /* Filled with the upper-left hand corner, in
+ * pixels, of the bounding box for the character
+ * specified by index, if non-NULL. */
+ int *widthPtr, *heightPtr;
+ /* Filled with the width and height of the
+ * bounding box for the character specified by
+ * index, if non-NULL. */
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ int i, x, w;
+ Tk_Font tkfont;
+ TkFont *fontPtr;
+ CONST char *end;
+
+ if (index < 0) {
+ return 0;
+ }
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ tkfont = layoutPtr->tkfont;
+ fontPtr = (TkFont *) tkfont;
+
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->numDisplayChars < 0) {
+ if (index == 0) {
+ x = chunkPtr->x;
+ w = chunkPtr->totalWidth;
+ goto check;
+ }
+ } else if (index < chunkPtr->numChars) {
+ end = Tcl_UtfAtIndex(chunkPtr->start, index);
+ if (xPtr != NULL) {
+ Tk_MeasureChars(tkfont, chunkPtr->start,
+ end - chunkPtr->start, -1, 0, &x);
+ x += chunkPtr->x;
+ }
+ if (widthPtr != NULL) {
+ Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end,
+ -1, 0, &w);
+ }
+ goto check;
+ }
+ index -= chunkPtr->numChars;
+ chunkPtr++;
+ }
+ if (index == 0) {
+ /*
+ * Special case to get location just past last char in layout.
+ */
+
+ chunkPtr--;
+ x = chunkPtr->x + chunkPtr->totalWidth;
+ w = 0;
+ } else {
+ return 0;
+ }
+
+ /*
+ * Ensure that the bbox lies within the text layout. This forces all
+ * chars that extend off the right edge of the text layout to have
+ * truncated widths, and all chars that are completely off the right
+ * edge of the text layout to peg to the edge and have 0 width.
+ */
+ check:
+ if (yPtr != NULL) {
+ *yPtr = chunkPtr->y - fontPtr->fm.ascent;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = fontPtr->fm.ascent + fontPtr->fm.descent;
+ }
+
+ if (x > layoutPtr->width) {
+ x = layoutPtr->width;
+ }
+ if (xPtr != NULL) {
+ *xPtr = x;
+ }
+ if (widthPtr != NULL) {
+ if (x + w > layoutPtr->width) {
+ w = layoutPtr->width - x;
+ }
+ *widthPtr = w;
+ }
+
+ return 1;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DistanceToTextLayout --
+ *
+ * Computes the distance in pixels from the given point to the
+ * given text layout. Non-displaying space characters that occur
+ * at the end of individual lines in the text layout are ignored
+ * for hit detection purposes.
+ *
+ * Results:
+ * The return value is 0 if the point (x, y) is inside the text
+ * layout. If the point isn't inside the text layout then the
+ * return value is the distance in pixels from the point to the
+ * text item.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_DistanceToTextLayout(layout, x, y)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Coordinates of point to check, with
+ * respect to the upper-left corner of the
+ * text layout (in pixels). */
+{
+ int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
+ LayoutChunk *chunkPtr;
+ TextLayout *layoutPtr;
+ TkFont *fontPtr;
+
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+ ascent = fontPtr->fm.ascent;
+ descent = fontPtr->fm.descent;
+
+ minDist = 0;
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing distance
+ * (but tab characters would still be considered).
+ */
+
+ chunkPtr++;
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + descent;
+
+ if (x < x1) {
+ xDiff = x1 - x;
+ } else if (x >= x2) {
+ xDiff = x - x2 + 1;
+ } else {
+ xDiff = 0;
+ }
+
+ if (y < y1) {
+ yDiff = y1 - y;
+ } else if (y >= y2) {
+ yDiff = y - y2 + 1;
+ } else {
+ yDiff = 0;
+ }
+ if ((xDiff == 0) && (yDiff == 0)) {
+ return 0;
+ }
+ dist = (int) hypot((double) xDiff, (double) yDiff);
+ if ((dist < minDist) || (minDist == 0)) {
+ minDist = dist;
+ }
+ chunkPtr++;
+ }
+ return minDist;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_IntersectTextLayout --
+ *
+ * Determines whether a text layout lies entirely inside,
+ * entirely outside, or overlaps a given rectangle. Non-displaying
+ * space characters that occur at the end of individual lines in
+ * the text layout are ignored for intersection calculations.
+ *
+ * Results:
+ * The return value is -1 if the text layout is entirely outside of
+ * the rectangle, 0 if it overlaps, and 1 if it is entirely inside
+ * of the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_IntersectTextLayout(layout, x, y, width, height)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner, in pixels, of
+ * rectangular area to compare with text
+ * layout. Coordinates are with respect to
+ * the upper-left hand corner of the text
+ * layout itself. */
+ int width, height; /* The width and height of the above
+ * rectangular area, in pixels. */
+{
+ int result, i, x1, y1, x2, y2;
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ TkFont *fontPtr;
+ int left, top, right, bottom;
+
+ /*
+ * Scan the chunks one at a time, seeing whether each is entirely in,
+ * entirely out, or overlapping the rectangle. If an overlap is
+ * detected, return immediately; otherwise wait until all chunks have
+ * been processed and see if they were all inside or all outside.
+ */
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ left = x;
+ top = y;
+ right = x + width;
+ bottom = y + height;
+
+ result = 0;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing area
+ * intersection (but tab characters would still be considered).
+ */
+
+ chunkPtr++;
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - fontPtr->fm.ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + fontPtr->fm.descent;
+
+ if ((right < x1) || (left >= x2)
+ || (bottom < y1) || (top >= y2)) {
+ if (result == 1) {
+ return 0;
+ }
+ result = -1;
+ } else if ((x1 < left) || (x2 >= right)
+ || (y1 < top) || (y2 >= bottom)) {
+ return 0;
+ } else if (result == -1) {
+ return 0;
+ } else {
+ result = 1;
+ }
+ chunkPtr++;
+ }
+ return result;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_TextLayoutToPostscript --
+ *
+ * Outputs the contents of a text layout in Postscript format.
+ * The set of lines in the text layout will be rendered by the user
+ * supplied Postscript function. The function should be of the form:
+ *
+ * justify x y string function --
+ *
+ * Justify is -1, 0, or 1, depending on whether the following string
+ * should be left, center, or right justified, x and y is the
+ * location for the origin of the string, string is the sequence
+ * of characters to be printed, and function is the name of the
+ * caller-provided function; the function should leave nothing
+ * on the stack.
+ *
+ * The meaning of the origin of the string (x and y) depends on
+ * the justification. For left justification, x is where the
+ * left edge of the string should appear. For center justification,
+ * x is where the center of the string should appear. And for right
+ * justification, x is where the right edge of the string should
+ * appear. This behavior is necessary because, for example, right
+ * justified text on the screen is justified with screen metrics.
+ * The same string needs to be justified with printer metrics on
+ * the printer to appear in the correct place with respect to other
+ * similarly justified strings. In all circumstances, y is the
+ * location of the baseline for the string.
+ *
+ * Results:
+ * The interp's result is modified to hold the Postscript code that
+ * will render the text layout.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_TextLayoutToPostscript(interp, layout)
+ Tcl_Interp *interp; /* Filled with Postscript code. */
+ Tk_TextLayout layout; /* The layout to be rendered. */
+{
+#define MAXUSE 128
+ char buf[MAXUSE+30];
+ LayoutChunk *chunkPtr;
+ int i, j, used, c, baseline;
+ Tcl_UniChar ch;
+ CONST char *p, *last_p,*glyphname;
+ TextLayout *layoutPtr;
+ char uindex[5]="\0\0\0\0";
+ char one_char[5];
+ int charsize;
+ int bytecount=0;
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ baseline = chunkPtr->y;
+ used = 0;
+ buf[used++] = '[';
+ buf[used++] = '(';
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (baseline != chunkPtr->y) {
+ buf[used++] = ')';
+ buf[used++] = ']';
+ buf[used++] = '\n';
+ buf[used++] = '[';
+ buf[used++] = '(';
+ baseline = chunkPtr->y;
+ }
+ if (chunkPtr->numDisplayChars <= 0) {
+ if (chunkPtr->start[0] == '\t') {
+ buf[used++] = '\\';
+ buf[used++] = 't';
+ }
+ } else {
+ p = chunkPtr->start;
+ for (j = 0; j < chunkPtr->numDisplayChars; j++) {
+ /*
+ * INTL: For now we just treat the characters as binary
+ * data and display the lower byte. Eventually this should
+ * be revised to handle international postscript fonts.
+ */
+ last_p=p;
+ p +=(charsize= Tcl_UtfToUniChar(p,&ch));
+ Tcl_UtfToExternal(interp,NULL,last_p,charsize,0,NULL,one_char,4,
+ NULL,&bytecount,NULL);
+ if (bytecount == 1) {
+ c = UCHAR(one_char[0]);
+ /* c = UCHAR( ch & 0xFF) */;
+ if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
+ || (c >= UCHAR(0x7f))) {
+ /*
+ * Tricky point: the "03" is necessary in the sprintf
+ * below, so that a full three digits of octal are
+ * always generated. Without the "03", a number
+ * following this sequence could be interpreted by
+ * Postscript as part of this sequence.
+ */
+
+ sprintf(buf + used, "\\%03o", c);
+ used += 4;
+ } else {
+ buf[used++] = c;
+ }
+ } else {
+ /* This character doesn't belong to system character set.
+ * So, we must use full glyph name */
+ sprintf(uindex,"%04X",ch); /* endianness? */
+ if ((glyphname = Tcl_GetVar2( interp , "::tk::psglyphs",uindex,0))) {
+ if (used > 0 && buf [used-1] == '(')
+ --used;
+ else
+ buf[used++] = ')';
+ buf[used++] = '/';
+ while( (*glyphname) && (used < (MAXUSE+27)))
+ buf[used++] = *glyphname++ ;
+ buf[used++] = '(';
+ }
+
+ }
+ if (used >= MAXUSE) {
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ used = 0;
+ }
+ }
+ }
+ if (used >= MAXUSE) {
+ /*
+ * If there are a whole bunch of returns or tabs in a row,
+ * then buf[] could get filled up.
+ */
+
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ used = 0;
+ }
+ chunkPtr++;
+ }
+ buf[used++] = ')';
+ buf[used++] = ']';
+ buf[used++] = '\n';
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ConfigAttributesObj --
+ *
+ * Process command line options to fill in fields of a properly
+ * initialized font attributes structure.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned, an
+ * error message will be left in interp's result object.
+ *
+ * Side effects:
+ * The fields of the font attributes structure get filled in with
+ * information from argc/argv. If an error occurs while parsing,
+ * the font attributes structure will contain all modifications
+ * specified in the command line options up to the point of the
+ * error.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tk_Window tkwin; /* For display on which font will be used. */
+ int objc; /* Number of elements in argv. */
+ Tcl_Obj *CONST objv[]; /* Command line options. */
+ TkFontAttributes *faPtr; /* Font attributes structure whose fields
+ * are to be modified. Structure must already
+ * be properly initialized. */
+{
+ int i, n, index;
+ Tcl_Obj *optionPtr, *valuePtr;
+ char *value;
+
+ for (i = 0; i < objc; i += 2) {
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, fontOpt, "option", 1,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((i+2 >= objc) && (objc & 1)) {
+ /*
+ * This test occurs after Tcl_GetIndexFromObj() so that
+ * "font create xyz -xyz" will return the error message
+ * that "-xyz" is a bad option, rather than that the value
+ * for "-xyz" is missing.
+ */
+
+ Tcl_AppendResult(interp, "value for \"",
+ Tcl_GetString(optionPtr), "\" option missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case FONT_FAMILY: {
+ value = Tcl_GetString(valuePtr);
+ faPtr->family = Tk_GetUid(value);
+ break;
+ }
+ case FONT_SIZE: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->size = n;
+ break;
+ }
+ case FONT_WEIGHT: {
+ n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr);
+ if (n == TK_FW_UNKNOWN) {
+ return TCL_ERROR;
+ }
+ faPtr->weight = n;
+ break;
+ }
+ case FONT_SLANT: {
+ n = TkFindStateNumObj(interp, optionPtr, slantMap, valuePtr);
+ if (n == TK_FS_UNKNOWN) {
+ return TCL_ERROR;
+ }
+ faPtr->slant = n;
+ break;
+ }
+ case FONT_UNDERLINE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->underline = n;
+ break;
+ }
+ case FONT_OVERSTRIKE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->overstrike = n;
+ break;
+ }
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetAttributeInfoObj --
+ *
+ * Return information about the font attributes as a Tcl list.
+ *
+ * Results:
+ * The return value is TCL_OK if the objPtr was non-NULL and
+ * specified a valid font attribute, TCL_ERROR otherwise. If TCL_OK
+ * is returned, the interp's result object is modified to hold a
+ * description of either the current value of a single option, or a
+ * list of all options and their current values for the given font
+ * attributes. If TCL_ERROR is returned, the interp's result is
+ * set to an error message describing that the objPtr did not refer
+ * to a valid option.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetAttributeInfoObj(interp, faPtr, objPtr)
+ Tcl_Interp *interp; /* Interp to hold result. */
+ CONST TkFontAttributes *faPtr; /* The font attributes to inspect. */
+ Tcl_Obj *objPtr; /* If non-NULL, indicates the single
+ * option whose value is to be
+ * returned. Otherwise information is
+ * returned for all options. */
+{
+ int i, index, start, end;
+ CONST char *str;
+ Tcl_Obj *optionPtr, *valuePtr, *resultPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+
+ start = 0;
+ end = FONT_NUMFIELDS;
+ if (objPtr != NULL) {
+ if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ start = index;
+ end = index + 1;
+ }
+
+ valuePtr = NULL;
+ for (i = start; i < end; i++) {
+ switch (i) {
+ case FONT_FAMILY:
+ str = faPtr->family;
+ valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1));
+ break;
+
+ case FONT_SIZE:
+ valuePtr = Tcl_NewIntObj(faPtr->size);
+ break;
+
+ case FONT_WEIGHT:
+ str = TkFindStateString(weightMap, faPtr->weight);
+ valuePtr = Tcl_NewStringObj(str, -1);
+ break;
+
+ case FONT_SLANT:
+ str = TkFindStateString(slantMap, faPtr->slant);
+ valuePtr = Tcl_NewStringObj(str, -1);
+ break;
+
+ case FONT_UNDERLINE:
+ valuePtr = Tcl_NewBooleanObj(faPtr->underline);
+ break;
+
+ case FONT_OVERSTRIKE:
+ valuePtr = Tcl_NewBooleanObj(faPtr->overstrike);
+ break;
+ }
+ if (objPtr != NULL) {
+ Tcl_SetObjResult(interp, valuePtr);
+ return TCL_OK;
+ }
+ optionPtr = Tcl_NewStringObj(fontOpt[i], -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseFontNameObj --
+ *
+ * Converts a object into a set of font attributes that can be used
+ * to construct a font.
+ *
+ * The string rep of the object can be one of the following forms:
+ * XLFD (see X documentation)
+ * "family [size] [style1 [style2 ...]"
+ * "-option value [-option value ...]"
+ *
+ * Results:
+ * The return value is TCL_ERROR if the object was syntactically
+ * invalid. In that case an error message is left in interp's
+ * result object. Otherwise, fills the font attribute buffer with
+ * the values parsed from the string and returns TCL_OK;
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseFontNameObj(interp, tkwin, objPtr, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. Must not be
+ * NULL. */
+ Tk_Window tkwin; /* For display on which font is used. */
+ Tcl_Obj *objPtr; /* Parseable font description object. */
+ TkFontAttributes *faPtr; /* Filled with attributes parsed from font
+ * name. Any attributes that were not
+ * specified in font name are filled with
+ * default values. */
+{
+ char *dash;
+ int objc, result, i, n;
+ Tcl_Obj **objv;
+ char *string;
+
+ TkInitFontAttributes(faPtr);
+
+ string = Tcl_GetString(objPtr);
+ if (*string == '-') {
+ /*
+ * This may be an XLFD or an "-option value" string.
+ *
+ * If the string begins with "-*" or a "-foundry-family-*" pattern,
+ * then consider it an XLFD.
+ */
+
+ if (string[1] == '*') {
+ goto xlfd;
+ }
+ dash = strchr(string + 1, '-');
+ if ((dash != NULL)
+ && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */
+ goto xlfd;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
+ }
+
+ if (*string == '*') {
+ /*
+ * This is appears to be an XLFD. Under Unix, all valid XLFDs were
+ * already handled by TkpGetNativeFont. If we are here, either we
+ * have something that initially looks like an XLFD but isn't or we
+ * have encountered an XLFD on Windows or Mac.
+ */
+
+ xlfd:
+ result = TkFontParseXLFD(string, faPtr, NULL);
+ if (result == TCL_OK) {
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * Wasn't an XLFD or "-option value" string. Try it as a
+ * "font size style" list.
+ */
+
+ if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)
+ || (objc < 1)) {
+ Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
+ if (objc > 1) {
+ if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->size = n;
+ }
+
+ i = 2;
+ if (objc == 3) {
+ if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i = 0;
+ }
+ for ( ; i < objc; i++) {
+ n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]);
+ if (n != TK_FW_UNKNOWN) {
+ faPtr->weight = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]);
+ if (n != TK_FS_UNKNOWN) {
+ faPtr->slant = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]);
+ if (n != 0) {
+ faPtr->underline = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]);
+ if (n != 0) {
+ faPtr->overstrike = n;
+ continue;
+ }
+
+ /*
+ * Unknown style.
+ */
+
+ Tcl_AppendResult(interp, "unknown font style \"",
+ Tcl_GetString(objv[i]), "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NewChunk --
+ *
+ * Helper function for Tk_ComputeTextLayout(). Encapsulates a
+ * measured set of characters in a chunk that can be quickly
+ * drawn.
+ *
+ * Results:
+ * A pointer to the new chunk in the text layout.
+ *
+ * Side effects:
+ * The text layout is reallocated to hold more chunks as necessary.
+ *
+ * Currently, Tk_ComputeTextLayout() stores contiguous ranges of
+ * "normal" characters in a chunk, along with individual tab
+ * and newline chars in their own chunks. All characters in the
+ * text layout are accounted for.
+ *
+ *---------------------------------------------------------------------------
+ */
+static LayoutChunk *
+NewChunk(layoutPtrPtr, maxPtr, start, numBytes, curX, newX, y)
+ TextLayout **layoutPtrPtr;
+ int *maxPtr;
+ CONST char *start;
+ int numBytes;
+ int curX;
+ int newX;
+ int y;
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ int maxChunks, numChars;
+ size_t s;
+
+ layoutPtr = *layoutPtrPtr;
+ maxChunks = *maxPtr;
+ if (layoutPtr->numChunks == maxChunks) {
+ maxChunks *= 2;
+ s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
+ layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);
+
+ *layoutPtrPtr = layoutPtr;
+ *maxPtr = maxChunks;
+ }
+ numChars = Tcl_NumUtfChars(start, numBytes);
+ chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
+ chunkPtr->start = start;
+ chunkPtr->numBytes = numBytes;
+ chunkPtr->numChars = numChars;
+ chunkPtr->numDisplayChars = numChars;
+ chunkPtr->x = curX;
+ chunkPtr->y = y;
+ chunkPtr->totalWidth = newX - curX;
+ chunkPtr->displayWidth = newX - curX;
+ layoutPtr->numChunks++;
+
+ return chunkPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontParseXLFD --
+ *
+ * Break up a fully specified XLFD into a set of font attributes.
+ *
+ * Results:
+ * Return value is TCL_ERROR if string was not a fully specified XLFD.
+ * Otherwise, fills font attribute buffer with the values parsed
+ * from the XLFD and returns TCL_OK.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontParseXLFD(string, faPtr, xaPtr)
+ CONST char *string; /* Parseable font description string. */
+ TkFontAttributes *faPtr; /* Filled with attributes parsed from font
+ * name. Any attributes that were not
+ * specified in font name are filled with
+ * default values. */
+ TkXLFDAttributes *xaPtr; /* Filled with X-specific attributes parsed
+ * from font name. Any attributes that were
+ * not specified in font name are filled with
+ * default values. May be NULL if such
+ * information is not desired. */
+{
+ char *src;
+ CONST char *str;
+ int i, j;
+ char *field[XLFD_NUMFIELDS + 2];
+ Tcl_DString ds;
+ TkXLFDAttributes xa;
+
+ if (xaPtr == NULL) {
+ xaPtr = &xa;
+ }
+ TkInitFontAttributes(faPtr);
+ TkInitXLFDAttributes(xaPtr);
+
+ memset(field, '\0', sizeof(field));
+
+ str = string;
+ if (*str == '-') {
+ str++;
+ }
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, (char *) str, -1);
+ src = Tcl_DStringValue(&ds);
+
+ field[0] = src;
+ for (i = 0; *src != '\0'; src++) {
+ if (!(*src & 0x80)
+ && Tcl_UniCharIsUpper(UCHAR(*src))) {
+ *src = (char) Tcl_UniCharToLower(UCHAR(*src));
+ }
+ if (*src == '-') {
+ i++;
+ if (i == XLFD_NUMFIELDS) {
+ continue;
+ }
+ *src = '\0';
+ field[i] = src + 1;
+ if (i > XLFD_NUMFIELDS) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
+ * but it is (strictly) malformed, because the first * is eliding both
+ * the Setwidth and the Addstyle fields. If the Addstyle field is a
+ * number, then assume the above incorrect form was used and shift all
+ * the rest of the fields right by one, so the number gets interpreted
+ * as a pixelsize. This fix is so that we don't get a million reports
+ * that "it works under X (as a native font name), but gives a syntax
+ * error under Windows (as a parsed set of attributes)".
+ */
+
+ if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) {
+ if (atoi(field[XLFD_ADD_STYLE]) != 0) {
+ for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
+ field[j + 1] = field[j];
+ }
+ field[XLFD_ADD_STYLE] = NULL;
+ i++;
+ }
+ }
+
+ /*
+ * Bail if we don't have enough of the fields (up to pointsize).
+ */
+
+ if (i < XLFD_FAMILY) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+
+ if (FieldSpecified(field[XLFD_FOUNDRY])) {
+ xaPtr->foundry = Tk_GetUid(field[XLFD_FOUNDRY]);
+ }
+
+ if (FieldSpecified(field[XLFD_FAMILY])) {
+ faPtr->family = Tk_GetUid(field[XLFD_FAMILY]);
+ }
+ if (FieldSpecified(field[XLFD_WEIGHT])) {
+ faPtr->weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
+ field[XLFD_WEIGHT]);
+ }
+ if (FieldSpecified(field[XLFD_SLANT])) {
+ xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
+ field[XLFD_SLANT]);
+ if (xaPtr->slant == TK_FS_ROMAN) {
+ faPtr->slant = TK_FS_ROMAN;
+ } else {
+ faPtr->slant = TK_FS_ITALIC;
+ }
+ }
+ if (FieldSpecified(field[XLFD_SETWIDTH])) {
+ xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
+ field[XLFD_SETWIDTH]);
+ }
+
+ /* XLFD_ADD_STYLE ignored. */
+
+ /*
+ * Pointsize in tenths of a point, but treat it as tenths of a pixel
+ * for historical compatibility.
+ */
+
+ faPtr->size = 12;
+
+ if (FieldSpecified(field[XLFD_POINT_SIZE])) {
+ if (field[XLFD_POINT_SIZE][0] == '[') {
+ /*
+ * Some X fonts have the point size specified as follows:
+ *
+ * [ N1 N2 N3 N4 ]
+ *
+ * where N1 is the point size (in points, not decipoints!), and
+ * N2, N3, and N4 are some additional numbers that I don't know
+ * the purpose of, so I ignore them.
+ */
+
+ faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1);
+ } else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
+ &faPtr->size) == TCL_OK) {
+ faPtr->size /= 10;
+ } else {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Pixel height of font. If specified, overrides pointsize.
+ */
+
+ if (FieldSpecified(field[XLFD_PIXEL_SIZE])) {
+ if (field[XLFD_PIXEL_SIZE][0] == '[') {
+ /*
+ * Some X fonts have the pixel size specified as follows:
+ *
+ * [ N1 N2 N3 N4 ]
+ *
+ * where N1 is the pixel size, and where N2, N3, and N4
+ * are some additional numbers that I don't know
+ * the purpose of, so I ignore them.
+ */
+
+ faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1);
+ } else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
+ &faPtr->size) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ faPtr->size = -faPtr->size;
+
+ /* XLFD_RESOLUTION_X ignored. */
+
+ /* XLFD_RESOLUTION_Y ignored. */
+
+ /* XLFD_SPACING ignored. */
+
+ /* XLFD_AVERAGE_WIDTH ignored. */
+
+ if (FieldSpecified(field[XLFD_CHARSET])) {
+ xaPtr->charset = Tk_GetUid(field[XLFD_CHARSET]);
+ } else {
+ xaPtr->charset = Tk_GetUid("iso8859-1");
+ }
+ Tcl_DStringFree(&ds);
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FieldSpecified --
+ *
+ * Helper function for TkParseXLFD(). Determines if a field in the
+ * XLFD was set to a non-null, non-don't-care value.
+ *
+ * Results:
+ * The return value is 0 if the field in the XLFD was not set and
+ * should be ignored, non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+FieldSpecified(field)
+ CONST char *field; /* The field of the XLFD to check. Strictly
+ * speaking, only when the string is "*" does it mean
+ * don't-care. However, an unspecified or question
+ * mark is also interpreted as don't-care. */
+{
+ char ch;
+
+ if (field == NULL) {
+ return 0;
+ }
+ ch = field[0];
+ return (ch != '*' && ch != '?');
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontGetPixels --
+ *
+ * Given a font size specification (as described in the TkFontAttributes
+ * structure) return the number of pixels it represents.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontGetPixels(tkwin, size)
+ Tk_Window tkwin; /* For point->pixel conversion factor. */
+ int size; /* Font size. */
+{
+ double d;
+
+ if (size < 0) {
+ return -size;
+ }
+
+ d = size * 25.4 / 72.0;
+ d *= WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ return (int) (d + 0.5);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontGetPoints --
+ *
+ * Given a font size specification (as described in the TkFontAttributes
+ * structure) return the number of points it represents.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontGetPoints(tkwin, size)
+ Tk_Window tkwin; /* For pixel->point conversion factor. */
+ int size; /* Font size. */
+{
+ double d;
+
+ if (size >= 0) {
+ return size;
+ }
+
+ d = -size * 72.0 / 25.4;
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ return (int) (d + 0.5);
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetAliasList --
+ *
+ * Given a font name, find the list of all aliases for that font
+ * name. One of the names in this list will probably be the name
+ * that this platform expects when asking for the font.
+ *
+ * Results:
+ * As above. The return value is NULL if the font name has no
+ * aliases.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char **
+TkFontGetAliasList(faceName)
+ CONST char *faceName; /* Font name to test for aliases. */
+{
+ int i, j;
+
+ for (i = 0; fontAliases[i] != NULL; i++) {
+ for (j = 0; fontAliases[i][j] != NULL; j++) {
+ if (strcasecmp(faceName, fontAliases[i][j]) == 0) {
+ return fontAliases[i];
+ }
+ }
+ }
+ return NULL;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetFallbacks --
+ *
+ * Get the list of font fallbacks that the platform-specific code
+ * can use to try to find the closest matching font the name
+ * requested.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char ***
+TkFontGetFallbacks()
+{
+ return fontFallbacks;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetGlobalClass --
+ *
+ * Get the list of fonts to try if the requested font name does not
+ * exist and no fallbacks for that font name could be used either.
+ * The names in this list are considered preferred over all the other
+ * font names in the system when looking for a last-ditch fallback.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char **
+TkFontGetGlobalClass()
+{
+ return globalFontClass;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetSymbolClass --
+ *
+ * Get the list of fonts that are symbolic; used if the operating
+ * system cannot apriori identify symbolic fonts on its own.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char **
+TkFontGetSymbolClass()
+{
+ return symbolClass;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugFont --
+ *
+ * This procedure returns debugging information about a font.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkFont
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkFont structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugFont(tkwin, name)
+ Tk_Window tkwin; /* The window in which the font will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkFont *fontPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(
+ &((TkWindow *) tkwin)->mainPtr->fontInfoPtr->fontCache, name);
+ if (hashPtr != NULL) {
+ fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr);
+ if (fontPtr == NULL) {
+ panic("TkDebugFont found empty hash table entry");
+ }
+ for ( ; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(fontPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(fontPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFontGetFirstTextLayout --
+ *
+ * This procedure returns the first chunk of a Tk_TextLayout,
+ * i.e. until the first font change on the first line (or the
+ * whole first line if there is no such font change).
+ *
+ * Results:
+ * The return value is the byte length of the chunk, the chunk
+ * itself is copied into dst and its Tk_Font into font.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkFontGetFirstTextLayout(
+ Tk_TextLayout layout, /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ Tk_Font * font,
+ char * dst)
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ int numBytesInChunk;
+
+ layoutPtr = (TextLayout *)layout;
+ if ((layoutPtr==NULL)
+ || (layoutPtr->numChunks==0)
+ || (layoutPtr->chunks->numDisplayChars <= 0)) {
+ dst[0] = '\0';
+ return 0;
+ }
+ chunkPtr = layoutPtr->chunks;
+ numBytesInChunk = chunkPtr->numBytes;
+ strncpy(dst, chunkPtr->start, (size_t) numBytesInChunk);
+ *font = layoutPtr->tkfont;
+ return numBytesInChunk;
+}
--- /dev/null
+/*
+ * tkFrame.c --
+ *
+ * This module implements "frame", "labelframe" and "toplevel" widgets
+ * for the Tk toolkit. Frames are windows with a background color
+ * and possibly a 3-D effect, but not much else in the way of
+ * attributes.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following enum is used to define the type of the frame.
+ */
+
+enum FrameType {
+ TYPE_FRAME, TYPE_TOPLEVEL, TYPE_LABELFRAME
+};
+
+/*
+ * A data structure of the following type is kept for each
+ * frame that currently exists for this process:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the frame. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up. */
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. Used
+ * to delete widget command. */
+ Tcl_Command widgetCmd; /* Token for frame's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ char *className; /* Class name for widget (from configuration
+ * option). Malloc-ed. */
+ enum FrameType type; /* Type of widget, such as TYPE_FRAME. */
+ char *screenName; /* Screen on which widget is created. Non-null
+ * only for top-levels. Malloc-ed, may be
+ * NULL. */
+ char *visualName; /* Textual description of visual for window,
+ * from -visual option. Malloc-ed, may be
+ * NULL. */
+ char *colormapName; /* Textual description of colormap for window,
+ * from -colormap option. Malloc-ed, may be
+ * NULL. */
+ char *menuName; /* Textual description of menu to use for
+ * menubar. Malloc-ed, may be NULL. */
+ Colormap colormap; /* If not None, identifies a colormap
+ * allocated for this window, which must be
+ * freed when the window is deleted. */
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * background. NULL means no background
+ * or border. */
+ int borderWidth; /* Width of 3-D border (if any). */
+ int relief; /* 3-d effect: TK_RELIEF_RAISED etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int 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. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int isContainer; /* 1 means this window is a container, 0 means
+ * that it isn't. */
+ char *useThis; /* If the window is embedded, this points to
+ * the name of the window in which it is
+ * embedded (malloc'ed). For non-embedded
+ * windows this is NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+ Tcl_Obj *padXPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave on left and
+ * right of child area. */
+ int padX; /* Integer value corresponding to padXPtr. */
+ Tcl_Obj *padYPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave above and
+ * below child area. */
+ int padY; /* Integer value corresponding to padYPtr. */
+} Frame;
+
+/*
+ * A data structure of the following type is kept for each labelframe
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Frame frame; /* A pointer to the generic frame structure.
+ * This must be the first element of the
+ * Labelframe. */
+
+ /*
+ * Labelframe specific configuration settings.
+ */
+
+ Tcl_Obj *textPtr; /* Value of -text option: specifies text to
+ * display in button. */
+ Tk_Font tkfont; /* Value of -font option: specifies font
+ * to use for display text. */
+ XColor *textColorPtr; /* Value of -fg option: specifies foreground
+ * color in normal mode. */
+ int labelAnchor; /* Value of -labelanchor option: specifies
+ * where to place the label. */
+ Tk_Window labelWin; /* Value of -labelwidget option: Window to
+ * use as label for the frame. */
+
+ /*
+ * Labelframe specific fields for use with configuration settings above.
+ */
+
+ GC textGC; /* GC for drawing text in normal mode. */
+ Tk_TextLayout textLayout; /* Stored text layout information. */
+ XRectangle labelBox; /* The label's actual size and position. */
+ int labelReqWidth; /* The label's requested width. */
+ int labelReqHeight; /* The label's requested height. */
+ int labelTextX, labelTextY; /* Position of the text to be drawn. */
+
+} Labelframe;
+
+/*
+ * The following macros define how many extra pixels to leave
+ * around a label's text.
+ */
+
+#define LABELSPACING 1
+#define LABELMARGIN 4
+
+/*
+ * Flag bits for frames:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * GOT_FOCUS: Non-zero means this widget currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define GOT_FOCUS 4
+
+/*
+ * The following enum is used to define a type for the -labelanchor option
+ * of the Labelframe widget. These values are used as indices into the
+ * string table below.
+ */
+
+enum labelanchor {
+ LABELANCHOR_E, LABELANCHOR_EN, LABELANCHOR_ES,
+ LABELANCHOR_N, LABELANCHOR_NE, LABELANCHOR_NW,
+ LABELANCHOR_S, LABELANCHOR_SE, LABELANCHOR_SW,
+ LABELANCHOR_W, LABELANCHOR_WN, LABELANCHOR_WS
+};
+
+static char *labelAnchorStrings[] = {
+ "e", "en", "es", "n", "ne", "nw", "s", "se", "sw", "w", "wn", "ws",
+ (char *) NULL
+};
+
+/*
+ * Information used for parsing configuration options. There are
+ * one common table used by all and one table for each widget class.
+ */
+
+static Tk_OptionSpec commonOptSpec[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_FRAME_BG_COLOR, -1, Tk_Offset(Frame, border),
+ TK_OPTION_NULL_OK, (ClientData) DEF_FRAME_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_STRING, "-colormap", "colormap", "Colormap",
+ DEF_FRAME_COLORMAP, -1, Tk_Offset(Frame, colormapName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-container", "container", "Container",
+ DEF_FRAME_CONTAINER, -1, Tk_Offset(Frame, isContainer),
+ 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_FRAME_CURSOR, -1, Tk_Offset(Frame, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ DEF_FRAME_HEIGHT, -1, Tk_Offset(Frame, height),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_FRAME_HIGHLIGHT_BG, -1,
+ Tk_Offset(Frame, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_FRAME_HIGHLIGHT, -1, Tk_Offset(Frame, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_FRAME_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Frame, highlightWidth), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_FRAME_PADX, Tk_Offset(Frame, padXPtr),
+ Tk_Offset(Frame, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_FRAME_PADY, Tk_Offset(Frame, padYPtr),
+ Tk_Offset(Frame, padY), 0, 0, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_FRAME_TAKE_FOCUS, -1, Tk_Offset(Frame, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-visual", "visual", "Visual",
+ DEF_FRAME_VISUAL, -1, Tk_Offset(Frame, visualName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ DEF_FRAME_WIDTH, -1, Tk_Offset(Frame, width),
+ 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, 0, 0}
+};
+
+static Tk_OptionSpec frameOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_FRAME_CLASS, -1, Tk_Offset(Frame, className),
+ 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief),
+ 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0}
+};
+
+static Tk_OptionSpec toplevelOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_TOPLEVEL_CLASS, -1, Tk_Offset(Frame, className),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-menu", "menu", "Menu",
+ DEF_TOPLEVEL_MENU, -1, Tk_Offset(Frame, menuName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-screen", "screen", "Screen",
+ DEF_TOPLEVEL_SCREEN, -1, Tk_Offset(Frame, screenName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-use", "use", "Use",
+ DEF_TOPLEVEL_USE, -1, Tk_Offset(Frame, useThis),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0}
+};
+
+static Tk_OptionSpec labelframeOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_LABELFRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_LABELFRAME_CLASS, -1, Tk_Offset(Frame, className),
+ 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_LABELFRAME_FONT, -1, Tk_Offset(Labelframe, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_LABELFRAME_FG, -1, Tk_Offset(Labelframe, textColorPtr), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-labelanchor", "labelAnchor", "LabelAnchor",
+ DEF_LABELFRAME_LABELANCHOR, -1, Tk_Offset(Labelframe, labelAnchor),
+ 0, (ClientData) labelAnchorStrings, 0},
+ {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget",
+ (char *) NULL, -1, Tk_Offset(Labelframe, labelWin),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABELFRAME_RELIEF, -1, Tk_Offset(Frame, relief),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_LABELFRAME_TEXT, Tk_Offset(Labelframe, textPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0}
+};
+
+/*
+ * Class names for widgets, indexed by FrameType.
+ */
+
+static char *classNames[] = {"Frame", "Toplevel", "Labelframe"};
+
+/*
+ * The following table maps from FrameType to the option template for
+ * that class of widgets.
+ */
+
+static Tk_OptionSpec *optionSpecs[] = {
+ frameOptSpec,
+ toplevelOptSpec,
+ labelframeOptSpec,
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ComputeFrameGeometry _ANSI_ARGS_((Frame *framePtr));
+static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp,
+ Frame *framePtr, int objc, Tcl_Obj *CONST objv[]));
+static int CreateFrame _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST argv[],
+ enum FrameType type, char *appName));
+static void DestroyFrame _ANSI_ARGS_((char *memPtr));
+static void DestroyFramePartly _ANSI_ARGS_((Frame *framePtr));
+static void DisplayFrame _ANSI_ARGS_((ClientData clientData));
+static void FrameCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void FrameEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void FrameLostSlaveProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin));
+static void FrameRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void FrameStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static int FrameWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static void FrameWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static void MapFrame _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * The structure below defines frame class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs frameClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ FrameWorldChanged /* worldChangedProc */
+};
+
+/*
+ * The structure below defines the official type record for the
+ * labelframe's geometry manager:
+ */
+
+static Tk_GeomMgr frameGeomType = {
+ "labelframe", /* name */
+ FrameRequestProc, /* requestProc */
+ FrameLostSlaveProc /* lostSlaveProc */
+};
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FrameObjCmd, Tk_ToplevelObjCmd, Tk_LabelframeObjCmd --
+ *
+ * These procedures are invoked to process the "frame",
+ * "toplevel" and "labelframe" Tcl commands. See the user
+ * documentation for details on what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation. These procedures are just wrappers;
+ * they call CreateFrame to do all of the real work.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_FrameObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_FRAME,
+ (char *) NULL);
+}
+
+int
+Tk_ToplevelObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_TOPLEVEL,
+ (char *) NULL);
+}
+
+int
+Tk_LabelframeObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_LABELFRAME,
+ (char *) NULL);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCreateFrame --
+ *
+ * This procedure is the old command procedure for the "frame"
+ * and "toplevel" commands. Now it is used directly by Tk_Init to
+ * create a new main window. See the user documentation for the
+ * "frame" and "toplevel" commands for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+ int toplevel; /* Non-zero means create a toplevel window,
+ * zero means create a frame. */
+ char *appName; /* Should only be non-NULL if there is no main
+ * window associated with the interpreter.
+ * Gives the base name to use for the
+ * new application. */
+{
+ int result, i;
+ Tcl_Obj **objv = (Tcl_Obj **) ckalloc((argc+1) * sizeof(Tcl_Obj **));
+ for (i=0; i<argc; i++) {
+ objv[i] = Tcl_NewStringObj(argv[i], -1);
+ Tcl_IncrRefCount(objv[i]);
+ }
+ objv[argc] = NULL;
+ result = CreateFrame(clientData, interp, argc, objv,
+ toplevel ? TYPE_TOPLEVEL : TYPE_FRAME, appName);
+ for (i=0; i<argc; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ ckfree((char *) objv);
+ return result;
+}
+
+static int
+CreateFrame(clientData, interp, objc, objv, type, appName)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ enum FrameType type; /* What widget type to create. */
+ char *appName; /* Should only be non-NULL if there are no
+ * Main window associated with the interpreter.
+ * Gives the base name to use for the
+ * new application. */
+{
+ Tk_Window tkwin;
+ Frame *framePtr;
+ Tk_OptionTable optionTable;
+ Tk_Window new;
+ CONST char *className, *screenName, *visualName, *colormapName, *arg, *useOption;
+ int i, c, depth;
+ size_t length;
+ unsigned int mask;
+ Colormap colormap;
+ Visual *visual;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]);
+
+ /*
+ * Pre-process the argument list. Scan through it to find any
+ * "-class", "-screen", "-visual", and "-colormap" options. These
+ * arguments need to be processed specially, before the window
+ * is configured using the usual Tk mechanisms.
+ */
+
+ className = colormapName = screenName = visualName = useOption = NULL;
+ colormap = None;
+ for (i = 2; i < objc; i += 2) {
+ arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
+ if (length < 2) {
+ continue;
+ }
+ c = arg[1];
+ if ((c == 'c') && (strncmp(arg, "-class", length) == 0)
+ && (length >= 3)) {
+ className = Tcl_GetString(objv[i+1]);
+ } else if ((c == 'c')
+ && (strncmp(arg, "-colormap", length) == 0)) {
+ colormapName = Tcl_GetString(objv[i+1]);
+ } else if ((c == 's') && (type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-screen", length) == 0)) {
+ screenName = Tcl_GetString(objv[i+1]);
+ } else if ((c == 'u') && (type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-use", length) == 0)) {
+ useOption = Tcl_GetString(objv[i+1]);
+ } else if ((c == 'v')
+ && (strncmp(arg, "-visual", length) == 0)) {
+ visualName = Tcl_GetString(objv[i+1]);
+ }
+ }
+
+ /*
+ * Create the window, and deal with the special options -use,
+ * -classname, -colormap, -screenname, and -visual. These options
+ * must be handle before calling ConfigureFrame below, and they must
+ * also be processed in a particular order, for the following
+ * reasons:
+ * 1. Must set the window's class before calling ConfigureFrame,
+ * so that unspecified options are looked up in the option
+ * database using the correct class.
+ * 2. Must set visual information before calling ConfigureFrame
+ * so that colors are allocated in a proper colormap.
+ * 3. Must call TkpUseWindow before setting non-default visual
+ * information, since TkpUseWindow changes the defaults.
+ */
+
+ if (screenName == NULL) {
+ screenName = (type == TYPE_TOPLEVEL) ? "" : NULL;
+ }
+
+ /*
+ * Main window associated with interpreter.
+ * If we're called by Tk_Init to create a
+ * new application, then this is NULL.
+ */
+
+ tkwin = Tk_MainWindow(interp);
+ if (tkwin != NULL) {
+ new = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]),
+ screenName);
+ } else {
+ /*
+ * We were called from Tk_Init; create a new application.
+ */
+
+ if (appName == NULL) {
+ panic("TkCreateFrame didn't get application name");
+ }
+ new = TkCreateMainWindow(interp, screenName, appName);
+ }
+ if (new == NULL) {
+ goto error;
+ }
+ if (className == NULL) {
+ className = Tk_GetOption(new, "class", "Class");
+ if (className == NULL) {
+ className = classNames[type];
+ }
+ }
+ Tk_SetClass(new, className);
+ if (useOption == NULL) {
+ useOption = Tk_GetOption(new, "use", "Use");
+ }
+ if (useOption != NULL) {
+ if (TkpUseWindow(interp, new, useOption) != TCL_OK) {
+ goto error;
+ }
+ }
+ if (visualName == NULL) {
+ visualName = Tk_GetOption(new, "visual", "Visual");
+ }
+ if (colormapName == NULL) {
+ colormapName = Tk_GetOption(new, "colormap", "Colormap");
+ }
+ if (visualName != NULL) {
+ visual = Tk_GetVisual(interp, new, visualName, &depth,
+ (colormapName == NULL) ? &colormap : (Colormap *) NULL);
+ if (visual == NULL) {
+ goto error;
+ }
+ Tk_SetWindowVisual(new, visual, depth, colormap);
+ }
+ if (colormapName != NULL) {
+ colormap = Tk_GetColormap(interp, new, colormapName);
+ if (colormap == None) {
+ goto error;
+ }
+ Tk_SetWindowColormap(new, colormap);
+ }
+
+ /*
+ * For top-level windows, provide an initial geometry request of
+ * 200x200, just so the window looks nicer on the screen if it
+ * doesn't request a size for itself.
+ */
+
+ if (type == TYPE_TOPLEVEL) {
+ Tk_GeometryRequest(new, 200, 200);
+ }
+
+ /*
+ * Create the widget record, process configuration options, and
+ * create event handlers. Then fill in a few additional fields
+ * in the widget record from the special options.
+ */
+
+ if (type == TYPE_LABELFRAME) {
+ framePtr = (Frame *) ckalloc(sizeof(Labelframe));
+ memset((void *) framePtr, 0, (sizeof(Labelframe)));
+ } else {
+ framePtr = (Frame *) ckalloc(sizeof(Frame));
+ memset((void *) framePtr, 0, (sizeof(Frame)));
+ }
+ framePtr->tkwin = new;
+ framePtr->display = Tk_Display(new);
+ framePtr->interp = interp;
+ framePtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(new), FrameWidgetObjCmd,
+ (ClientData) framePtr, FrameCmdDeletedProc);
+ framePtr->optionTable = optionTable;
+ framePtr->type = type;
+ framePtr->colormap = colormap;
+ framePtr->relief = TK_RELIEF_FLAT;
+ framePtr->cursor = None;
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+ labelframePtr->labelAnchor = LABELANCHOR_NW;
+ labelframePtr->textGC = None;
+ }
+
+ /*
+ * Store backreference to frame widget in window structure.
+ */
+ Tk_SetClassProcs(new, &frameClass, (ClientData) framePtr);
+
+ mask = ExposureMask | StructureNotifyMask | FocusChangeMask;
+ if (type == TYPE_TOPLEVEL) {
+ mask |= ActivateMask;
+ }
+ Tk_CreateEventHandler(new, mask, FrameEventProc, (ClientData) framePtr);
+ if ((Tk_InitOptions(interp, (char *) framePtr, optionTable, new)
+ != TCL_OK) ||
+ (ConfigureFrame(interp, framePtr, objc-2, objv+2) != TCL_OK)) {
+ goto error;
+ }
+ if ((framePtr->isContainer)) {
+ if (framePtr->useThis == NULL) {
+ TkpMakeContainer(framePtr->tkwin);
+ } else {
+ Tcl_AppendResult(interp, "A window cannot have both the -use ",
+ "and the -container option set.", (char *) NULL);
+ goto error;
+ }
+ }
+ if (type == TYPE_TOPLEVEL) {
+ Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr);
+ }
+ Tcl_SetResult(interp, Tk_PathName(new), TCL_STATIC);
+ return TCL_OK;
+
+ error:
+ if (new != NULL) {
+ Tk_DestroyWindow(new);
+ }
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameWidgetObjCmd --
+ *
+ * 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
+FrameWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about frame widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *frameOptions[] = {
+ "cget", "configure", (char *) NULL
+ };
+ enum options {
+ FRAME_CGET, FRAME_CONFIGURE
+ };
+ register Frame *framePtr = (Frame *) clientData;
+ int result = TCL_OK, index;
+ size_t length;
+ int c, i;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], frameOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) framePtr);
+ switch ((enum options) index) {
+ case FRAME_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) framePtr,
+ framePtr->optionTable, objv[2], framePtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+ case FRAME_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) framePtr,
+ framePtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ framePtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ /*
+ * Don't allow the options -class, -colormap, -container,
+ * -newcmap, -screen, -use, or -visual to be changed.
+ */
+
+ for (i = 2; i < objc; i++) {
+ char *arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
+ if (length < 2) {
+ continue;
+ }
+ c = arg[1];
+ if (((c == 'c') && (strncmp(arg, "-class", length) == 0)
+ && (length >= 2))
+ || ((c == 'c')
+ && (strncmp(arg, "-colormap", length) == 0)
+ && (length >= 3))
+ || ((c == 'c')
+ && (strncmp(arg, "-container", length) == 0)
+ && (length >= 3))
+ || ((c == 's') && (framePtr->type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-screen", length) == 0))
+ || ((c == 'u') && (framePtr->type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-use", length) == 0))
+ || ((c == 'v')
+ && (strncmp(arg, "-visual", length) == 0))) {
+ Tcl_AppendResult(interp, "can't modify ", arg,
+ " option after widget is created", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ result = ConfigureFrame(interp, framePtr, objc-2, objv+2);
+ }
+ break;
+ }
+ }
+
+ done:
+ Tcl_Release((ClientData) framePtr);
+ return result;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyFrame --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_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(memPtr)
+ char *memPtr; /* Info about frame widget. */
+{
+ register Frame *framePtr = (Frame *) memPtr;
+ register Labelframe *labelframePtr = (Labelframe *) memPtr;
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ Tk_FreeTextLayout(labelframePtr->textLayout);
+ if (labelframePtr->textGC != None) {
+ Tk_FreeGC(framePtr->display, labelframePtr->textGC);
+ }
+ }
+ if (framePtr->colormap != None) {
+ Tk_FreeColormap(framePtr->display, framePtr->colormap);
+ }
+ ckfree((char *) framePtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyFramePartly --
+ *
+ * This procedure is invoked to clean up everything that needs
+ * tkwin to be defined when deleted. During the destruction
+ * process tkwin is always set to NULL and this procedure must
+ * be called before that happens.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Some things associated with the frame are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyFramePartly(framePtr)
+ Frame *framePtr; /* Info about frame widget. */
+{
+ register Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ if (framePtr->type == TYPE_LABELFRAME && labelframePtr->labelWin != NULL) {
+ Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask,
+ FrameStructureProc, (ClientData) framePtr);
+ Tk_ManageGeometry(labelframePtr->labelWin, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) {
+ Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin);
+ }
+ Tk_UnmapWindow(labelframePtr->labelWin);
+ labelframePtr->labelWin = NULL;
+ }
+
+ Tk_FreeConfigOptions((char *) framePtr, framePtr->optionTable,
+ framePtr->tkwin);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureFrame --
+ *
+ * This procedure is called to process an objv/objc list, plus
+ * the Tk 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 the interp's 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, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Frame *framePtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int objc; /* Number of valid entries in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+{
+ Tk_SavedOptions savedOptions;
+ char *oldMenuName;
+ Tk_Window oldWindow = NULL;
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ /*
+ * Need the old menubar name for the menu code to delete it.
+ */
+
+ if (framePtr->menuName == NULL) {
+ oldMenuName = NULL;
+ } else {
+ oldMenuName = ckalloc(strlen(framePtr->menuName) + 1);
+ strcpy(oldMenuName, framePtr->menuName);
+ }
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ oldWindow = labelframePtr->labelWin;
+ }
+ if (Tk_SetOptions(interp, (char *) framePtr,
+ framePtr->optionTable, objc, objv,
+ framePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ if (oldMenuName != NULL) {
+ ckfree(oldMenuName);
+ }
+ return TCL_ERROR;
+ } else {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few of the options require additional processing.
+ */
+
+ if (((oldMenuName == NULL) && (framePtr->menuName != NULL))
+ || ((oldMenuName != NULL) && (framePtr->menuName == NULL))
+ || ((oldMenuName != NULL) && (framePtr->menuName != NULL)
+ && strcmp(oldMenuName, framePtr->menuName) != 0)) {
+ TkSetWindowMenuBar(interp, framePtr->tkwin, oldMenuName,
+ framePtr->menuName);
+ }
+
+ if (oldMenuName != NULL) {
+ ckfree(oldMenuName);
+ }
+
+ if (framePtr->border != NULL) {
+ Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border);
+ } else {
+ Tk_SetWindowBackgroundPixmap(framePtr->tkwin, None);
+ }
+
+ if (framePtr->highlightWidth < 0) {
+ framePtr->highlightWidth = 0;
+ }
+ if (framePtr->padX < 0) {
+ framePtr->padX = 0;
+ }
+ if (framePtr->padY < 0) {
+ framePtr->padY = 0;
+ }
+
+ /*
+ * If a -labelwidget is specified, check that it is valid and set
+ * up geometry management for it.
+ */
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ if (oldWindow != labelframePtr->labelWin) {
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ FrameStructureProc, (ClientData) framePtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ Tk_UnmaintainGeometry(oldWindow, framePtr->tkwin);
+ Tk_UnmapWindow(oldWindow);
+ }
+ if (labelframePtr->labelWin != NULL) {
+ Tk_Window ancestor, parent, sibling = NULL;
+
+ /*
+ * Make sure that the frame is either the parent of the
+ * window used as label or a descendant of that
+ * parent. Also, don't allow a top-level window to be
+ * managed inside the frame.
+ */
+
+ parent = Tk_Parent(labelframePtr->labelWin);
+ for (ancestor = framePtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ sibling = ancestor;
+ if (Tk_IsTopLevel(ancestor)) {
+ badWindow:
+ Tcl_AppendResult(interp, "can't use ",
+ Tk_PathName(labelframePtr->labelWin),
+ " as label in this frame", (char *) NULL);
+ labelframePtr->labelWin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_IsTopLevel(labelframePtr->labelWin)) {
+ goto badWindow;
+ }
+ if (labelframePtr->labelWin == framePtr->tkwin) {
+ goto badWindow;
+ }
+ Tk_CreateEventHandler(labelframePtr->labelWin,
+ StructureNotifyMask, FrameStructureProc,
+ (ClientData) framePtr);
+ Tk_ManageGeometry(labelframePtr->labelWin, &frameGeomType,
+ (ClientData) framePtr);
+
+ /*
+ * If the frame is not parent to the label, make
+ * sure the label is above its sibling in the stacking
+ * order.
+ */
+
+ if (sibling != NULL) {
+ Tk_RestackWindow(labelframePtr->labelWin, Above, sibling);
+ }
+ }
+ }
+ }
+
+ FrameWorldChanged((ClientData) framePtr);
+
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FrameWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frame will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FrameWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ Frame *framePtr = (Frame *) instanceData;
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+ Tk_Window tkwin = framePtr->tkwin;
+ XGCValues gcValues;
+ GC gc;
+ int anyTextLabel, anyWindowLabel;
+ int bWidthLeft, bWidthRight, bWidthTop, bWidthBottom;
+ char *labelText;
+
+ anyTextLabel = (framePtr->type == TYPE_LABELFRAME) &&
+ (labelframePtr->textPtr != NULL) &&
+ (labelframePtr->labelWin == NULL);
+ anyWindowLabel = (framePtr->type == TYPE_LABELFRAME) &&
+ (labelframePtr->labelWin != NULL);
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ /*
+ * The textGC is needed even in the labelWin case, so it's
+ * always created for a labelframe.
+ */
+
+ gcValues.font = Tk_FontId(labelframePtr->tkfont);
+ gcValues.foreground = labelframePtr->textColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+ gc = Tk_GetGC(tkwin, GCForeground | GCFont | GCGraphicsExposures,
+ &gcValues);
+ if (labelframePtr->textGC != None) {
+ Tk_FreeGC(framePtr->display, labelframePtr->textGC);
+ }
+ labelframePtr->textGC = gc;
+
+ /*
+ * Calculate label size.
+ */
+
+ labelframePtr->labelReqWidth = labelframePtr->labelReqHeight = 0;
+
+ if (anyTextLabel) {
+ labelText = Tcl_GetString(labelframePtr->textPtr);
+ Tk_FreeTextLayout(labelframePtr->textLayout);
+ labelframePtr->textLayout = Tk_ComputeTextLayout(labelframePtr->tkfont,
+ labelText, -1, 0, TK_JUSTIFY_CENTER, 0,
+ &labelframePtr->labelReqWidth, &labelframePtr->labelReqHeight);
+ labelframePtr->labelReqWidth += 2 * LABELSPACING;
+ labelframePtr->labelReqHeight += 2 * LABELSPACING;
+ } else if (anyWindowLabel) {
+ labelframePtr->labelReqWidth = Tk_ReqWidth(labelframePtr->labelWin);
+ labelframePtr->labelReqHeight = Tk_ReqHeight(labelframePtr->labelWin);
+ }
+
+ /*
+ * Make sure label size is at least as big as the border.
+ * This simplifies later calculations and gives a better
+ * appearance with thick borders.
+ */
+
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ if (labelframePtr->labelReqHeight < framePtr->borderWidth) {
+ labelframePtr->labelReqHeight = framePtr->borderWidth;
+ }
+ } else {
+ if (labelframePtr->labelReqWidth < framePtr->borderWidth) {
+ labelframePtr->labelReqWidth = framePtr->borderWidth;
+ }
+ }
+ }
+
+ /*
+ * Calculate individual border widths.
+ */
+
+ bWidthBottom = bWidthTop = bWidthRight = bWidthLeft =
+ framePtr->borderWidth + framePtr->highlightWidth;
+
+ bWidthLeft += framePtr->padX;
+ bWidthRight += framePtr->padX;
+ bWidthTop += framePtr->padY;
+ bWidthBottom += framePtr->padY;
+
+ if (anyTextLabel || anyWindowLabel) {
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ bWidthRight += labelframePtr->labelReqWidth -
+ framePtr->borderWidth;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ bWidthTop += labelframePtr->labelReqHeight - framePtr->borderWidth;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ bWidthBottom += labelframePtr->labelReqHeight -
+ framePtr->borderWidth;
+ break;
+ default:
+ bWidthLeft += labelframePtr->labelReqWidth - framePtr->borderWidth;
+ break;
+ }
+ }
+
+ Tk_SetInternalBorderEx(tkwin, bWidthLeft, bWidthRight, bWidthTop,
+ bWidthBottom);
+
+ ComputeFrameGeometry(framePtr);
+
+ /*
+ * A labelframe should request size for its label.
+ */
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ int minwidth = labelframePtr->labelReqWidth;
+ int minheight = labelframePtr->labelReqHeight;
+ int padding = framePtr->highlightWidth;
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+ padding *= 2;
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ minwidth += padding;
+ minheight += framePtr->borderWidth + framePtr->highlightWidth;
+ } else {
+ minheight += padding;
+ minwidth += framePtr->borderWidth + framePtr->highlightWidth;
+ }
+ Tk_SetMinimumRequestSize(tkwin, minwidth, minheight);
+ }
+
+ if ((framePtr->width > 0) || (framePtr->height > 0)) {
+ Tk_GeometryRequest(tkwin, framePtr->width, framePtr->height);
+ }
+
+ if (Tk_IsMapped(tkwin)) {
+ if (!(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
+ }
+ framePtr->flags |= REDRAW_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFrameGeometry --
+ *
+ * This procedure is called to compute various geometrical
+ * information for a frame, such as where various things get
+ * displayed. It's called when the window is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Display-related numbers get changed in *framePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeFrameGeometry(framePtr)
+ register Frame *framePtr; /* Information about widget. */
+{
+ int otherWidth, otherHeight, otherWidthT, otherHeightT, padding;
+ int maxWidth, maxHeight;
+ Tk_Window tkwin;
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ /*
+ * We have nothing to do here unless there is a label.
+ */
+
+ if (framePtr->type != TYPE_LABELFRAME) return;
+ if ((labelframePtr->textPtr == NULL) &&
+ (labelframePtr->labelWin == NULL)) return;
+
+ tkwin = framePtr->tkwin;
+
+ /*
+ * Calculate the available size for the label
+ */
+
+ labelframePtr->labelBox.width = labelframePtr->labelReqWidth;
+ labelframePtr->labelBox.height = labelframePtr->labelReqHeight;
+
+ padding = framePtr->highlightWidth;
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+ padding *= 2;
+
+ maxHeight = Tk_Height(tkwin);
+ maxWidth = Tk_Width(tkwin);
+
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ maxWidth -= padding;
+ if (maxWidth < 1) maxWidth = 1;
+ } else {
+ maxHeight -= padding;
+ if (maxHeight < 1) maxHeight = 1;
+ }
+ if (labelframePtr->labelBox.width > maxWidth) {
+ labelframePtr->labelBox.width = maxWidth;
+ }
+ if (labelframePtr->labelBox.height > maxHeight) {
+ labelframePtr->labelBox.height = maxHeight;
+ }
+
+ /*
+ * Calculate label and text position.
+ * The text's position is based on the requested size (= the text's
+ * real size) to get proper alignment if the text does not fit.
+ */
+
+ otherWidth = Tk_Width(tkwin) - labelframePtr->labelBox.width;
+ otherHeight = Tk_Height(tkwin) - labelframePtr->labelBox.height;
+ otherWidthT = Tk_Width(tkwin) - labelframePtr->labelReqWidth;
+ otherHeightT = Tk_Height(tkwin) - labelframePtr->labelReqHeight;
+ padding = framePtr->highlightWidth;
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ labelframePtr->labelTextX = otherWidthT - padding;
+ labelframePtr->labelBox.x = otherWidth - padding;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ labelframePtr->labelTextY = padding;
+ labelframePtr->labelBox.y = padding;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ labelframePtr->labelTextY = otherHeightT - padding;
+ labelframePtr->labelBox.y = otherHeight - padding;
+ break;
+ default:
+ labelframePtr->labelTextX = padding;
+ labelframePtr->labelBox.x = padding;
+ break;
+ }
+
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_NW:
+ case LABELANCHOR_SW:
+ labelframePtr->labelTextX = padding;
+ labelframePtr->labelBox.x = padding;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_S:
+ labelframePtr->labelTextX = otherWidthT / 2;
+ labelframePtr->labelBox.x = otherWidth / 2;
+ break;
+ case LABELANCHOR_NE:
+ case LABELANCHOR_SE:
+ labelframePtr->labelTextX = otherWidthT - padding;
+ labelframePtr->labelBox.x = otherWidth - padding;
+ break;
+ case LABELANCHOR_EN:
+ case LABELANCHOR_WN:
+ labelframePtr->labelTextY = padding;
+ labelframePtr->labelBox.y = padding;
+ break;
+ case LABELANCHOR_E:
+ case LABELANCHOR_W:
+ labelframePtr->labelTextY = otherHeightT / 2;
+ labelframePtr->labelBox.y = otherHeight / 2;
+ break;
+ default:
+ labelframePtr->labelTextY = otherHeightT - padding;
+ labelframePtr->labelBox.y = otherHeight - padding;
+ break;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayFrame --
+ *
+ * This procedure is invoked to display a frame widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the frame in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayFrame(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register Frame *framePtr = (Frame *) clientData;
+ register Tk_Window tkwin = framePtr->tkwin;
+ int bdX1, bdY1, bdX2, bdY2, hlWidth;
+ Pixmap pixmap;
+ TkRegion clipRegion = NULL;
+
+ framePtr->flags &= ~REDRAW_PENDING;
+ if ((framePtr->tkwin == NULL) || !Tk_IsMapped(tkwin)
+ || framePtr->isContainer) {
+ return;
+ }
+
+ /*
+ * Highlight shall always be drawn if it exists, so do that first.
+ */
+
+ hlWidth = framePtr->highlightWidth;
+
+ if (hlWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(framePtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ if (framePtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(framePtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, hlWidth,
+ Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, hlWidth,
+ Tk_WindowId(tkwin));
+ }
+ }
+
+ /*
+ * If -background is set to "", no interior is drawn.
+ */
+
+ if (framePtr->border == NULL) return;
+
+ if (framePtr->type != TYPE_LABELFRAME) {
+ /*
+ * There is no label so there is just a simple rectangle to draw.
+ */
+
+ noLabel:
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
+ framePtr->border, hlWidth, hlWidth,
+ Tk_Width(tkwin) - 2 * hlWidth,
+ Tk_Height(tkwin) - 2 * hlWidth,
+ framePtr->borderWidth, framePtr->relief);
+ } else {
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ if ((labelframePtr->textPtr == NULL) &&
+ (labelframePtr->labelWin == NULL)) {
+ goto noLabel;
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws the
+ * frame into off-screen memory, then copies it back on-screen
+ * in a single operation. This means there's no point in time
+ * where the on-screen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(framePtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ /*
+ * Clear the pixmap.
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap, framePtr->border, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Calculate how the label affects the border's position.
+ */
+
+ bdX1 = bdY1 = hlWidth;
+ bdX2 = Tk_Width(tkwin) - hlWidth;
+ bdY2 = Tk_Height(tkwin) - hlWidth;
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ bdX2 -= (labelframePtr->labelBox.width - framePtr->borderWidth)
+ / 2;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ /*
+ * Since the glyphs of the text tend to be in the lower part
+ * we favor a lower border position by rounding up.
+ */
+
+ bdY1 += (labelframePtr->labelBox.height - framePtr->borderWidth +1)
+ / 2;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ bdY2 -= (labelframePtr->labelBox.height - framePtr->borderWidth)
+ / 2;
+ break;
+ default:
+ bdX1 += (labelframePtr->labelBox.width - framePtr->borderWidth)
+ / 2;
+ break;
+ }
+
+ /*
+ * Draw border
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, framePtr->border, bdX1, bdY1,
+ bdX2 - bdX1, bdY2 - bdY1, framePtr->borderWidth,
+ framePtr->relief);
+
+ if (labelframePtr->labelWin == NULL) {
+ /*
+ * Clear behind the label
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap,
+ framePtr->border, labelframePtr->labelBox.x,
+ labelframePtr->labelBox.y, labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Draw label.
+ * If there is not room for the entire label, use clipping to
+ * get a nice appearance.
+ */
+
+ if ((labelframePtr->labelBox.width < labelframePtr->labelReqWidth)
+ || (labelframePtr->labelBox.height <
+ labelframePtr->labelReqHeight)) {
+ clipRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&labelframePtr->labelBox, clipRegion,
+ clipRegion);
+ TkSetRegion(framePtr->display, labelframePtr->textGC,
+ clipRegion);
+ }
+
+ Tk_DrawTextLayout(framePtr->display, pixmap,
+ labelframePtr->textGC, labelframePtr->textLayout,
+ labelframePtr->labelTextX + LABELSPACING,
+ labelframePtr->labelTextY + LABELSPACING, 0, -1);
+
+ if (clipRegion != NULL) {
+ XSetClipMask(framePtr->display, labelframePtr->textGC, None);
+ TkDestroyRegion(clipRegion);
+ }
+ } else {
+ /*
+ * Reposition and map the window (but in different ways depending
+ * on whether the frame is the window's parent).
+ */
+
+ if (framePtr->tkwin == Tk_Parent(labelframePtr->labelWin)) {
+ if ((labelframePtr->labelBox.x != Tk_X(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.y !=
+ Tk_Y(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.width !=
+ Tk_Width(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.height !=
+ Tk_Height(labelframePtr->labelWin))) {
+ Tk_MoveResizeWindow(labelframePtr->labelWin,
+ labelframePtr->labelBox.x, labelframePtr->labelBox.y,
+ labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height);
+ }
+ Tk_MapWindow(labelframePtr->labelWin);
+ } else {
+ Tk_MaintainGeometry(labelframePtr->labelWin, framePtr->tkwin,
+ labelframePtr->labelBox.x, labelframePtr->labelBox.y,
+ labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height);
+ }
+ }
+
+
+ /*
+ * Everything's been redisplayed; now copy the pixmap onto the screen
+ * and free up the pixmap.
+ */
+
+ XCopyArea(framePtr->display, pixmap, Tk_WindowId(tkwin),
+ labelframePtr->textGC, hlWidth, hlWidth,
+ (unsigned) (Tk_Width(tkwin) - 2 * hlWidth),
+ (unsigned) (Tk_Height(tkwin) - 2 * hlWidth),
+ hlWidth, hlWidth);
+ Tk_FreePixmap(framePtr->display, pixmap);
+ }
+
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher on
+ * structure changes to a frame. For frames 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
+FrameEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ register XEvent *eventPtr; /* Information about event. */
+{
+ register Frame *framePtr = (Frame *) clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ ComputeFrameGeometry(framePtr);
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName, NULL);
+ ckfree(framePtr->menuName);
+ framePtr->menuName = NULL;
+ }
+ if (framePtr->tkwin != NULL) {
+
+ /*
+ * If this window is a container, then this event could be
+ * coming from the embedded application, in which case
+ * Tk_DestroyWindow hasn't been called yet. When Tk_DestroyWindow
+ * is called later, then another destroy event will be generated.
+ * We need to be sure we ignore the second event, since the frame
+ * could be gone by then. To do so, delete the event handler
+ * explicitly (normally it's done implicitly by Tk_DestroyWindow).
+ */
+
+ /*
+ * Since the tkwin pointer will be gone when we reach
+ * DestroyFrame, we must free all options now.
+ */
+
+ DestroyFramePartly(framePtr);
+
+ Tk_DeleteEventHandler(framePtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ FrameEventProc, (ClientData) framePtr);
+ framePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(framePtr->interp, framePtr->widgetCmd);
+ }
+ if (framePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayFrame, (ClientData) framePtr);
+ }
+ Tcl_CancelIdleCall(MapFrame, (ClientData) framePtr);
+ Tcl_EventuallyFree((ClientData) framePtr, DestroyFrame);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ framePtr->flags |= GOT_FOCUS;
+ if (framePtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ framePtr->flags &= ~GOT_FOCUS;
+ if (framePtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == ActivateNotify) {
+ TkpSetMainMenubar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName);
+ }
+ return;
+
+ redraw:
+ if ((framePtr->tkwin != NULL) && !(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
+ framePtr->flags |= REDRAW_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ Tk_Window tkwin = framePtr->tkwin;
+
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName, NULL);
+ ckfree(framePtr->menuName);
+ framePtr->menuName = NULL;
+ }
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ /*
+ * Some options need tkwin to be freed, so we free them here,
+ * before setting tkwin to NULL.
+ */
+
+ DestroyFramePartly(framePtr);
+
+ framePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * MapFrame --
+ *
+ * This procedure is invoked as a when-idle handler to map a
+ * newly-created top-level frame.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The frame given by the clientData argument is mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MapFrame(clientData)
+ ClientData clientData; /* Pointer to frame structure. */
+{
+ Frame *framePtr = (Frame *) clientData;
+
+ /*
+ * Wait for all other background events to be processed before
+ * mapping window. This ensures that the window's correct geometry
+ * will have been determined before it is first mapped, so that the
+ * window manager doesn't get a false idea of its desired geometry.
+ */
+
+ Tcl_Preserve((ClientData) framePtr);
+ while (1) {
+ if (Tcl_DoOneEvent(TCL_IDLE_EVENTS) == 0) {
+ break;
+ }
+
+ /*
+ * After each event, make sure that the window still exists
+ * and quit if the window has been destroyed.
+ */
+
+ if (framePtr->tkwin == NULL) {
+ Tcl_Release((ClientData) framePtr);
+ return;
+ }
+ }
+ Tk_MapWindow(framePtr->tkwin);
+ Tcl_Release((ClientData) framePtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkInstallFrameMenu --
+ *
+ * This function is needed when a Windows HWND is created
+ * and a menubar has been set to the window with a system
+ * menu. It notifies the menu package so that the system
+ * menu can be rebuilt.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The system menu (if any) is created for the menubar
+ * associated with this frame.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkInstallFrameMenu(tkwin)
+ Tk_Window tkwin; /* The window that was just created. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->mainPtr != NULL) {
+ Frame *framePtr;
+ framePtr = (Frame*) winPtr->instanceData;
+ if (framePtr == NULL) {
+ panic("TkInstallFrameMenu couldn't get frame pointer");
+ }
+ TkpMenuNotifyToplevelCreate(winPtr->mainPtr->interp,
+ framePtr->menuName);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameStructureProc --
+ *
+ * This procedure is invoked whenever StructureNotify events
+ * occur for a window that's managed as label for the frame.
+ * This procudure's only purpose is to clean up when windows
+ * are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the frame when it is
+ * deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing frame. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ Labelframe *labelframePtr = (Labelframe *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ /*
+ * This should only happen in a labelframe but it doesn't
+ * hurt to be careful.
+ */
+
+ if (labelframePtr->frame.type == TYPE_LABELFRAME) {
+ labelframePtr->labelWin = NULL;
+ FrameWorldChanged((ClientData) labelframePtr);
+ }
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameRequestProc --
+ *
+ * This procedure is invoked whenever a window that's associated
+ * with a frame changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change.
+ * depending on the options specified for the frame.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record for frame. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ Frame *framePtr = (Frame *) clientData;
+
+ FrameWorldChanged((ClientData) framePtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all frame-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Frame structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ Frame *framePtr = (Frame *) clientData;
+ Labelframe *labelframePtr = (Labelframe *) clientData;
+
+ /*
+ * This should only happen in a labelframe but it doesn't
+ * hurt to be careful.
+ */
+
+ if (labelframePtr->frame.type == TYPE_LABELFRAME) {
+ Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask,
+ FrameStructureProc, (ClientData) labelframePtr);
+ if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) {
+ Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin);
+ }
+ Tk_UnmapWindow(labelframePtr->labelWin);
+ labelframePtr->labelWin = NULL;
+ }
+ FrameWorldChanged((ClientData) framePtr);
+}
--- /dev/null
+/*
+ * tkGC.c --
+ *
+ * This file maintains a database of read-only graphics contexts
+ * for the Tk toolkit, in order to allow GC's to be shared.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * One of the following data structures exists for each GC that is
+ * currently active. The structure is indexed with two hash tables,
+ * one based on the values in the graphics context and the other
+ * based on the display and GC identifier.
+ */
+
+typedef struct {
+ GC gc; /* Graphics context. */
+ Display *display; /* Display to which gc belongs. */
+ int refCount; /* Number of active uses of gc. */
+ Tcl_HashEntry *valueHashPtr;/* Entry in valueTable (needed when deleting
+ * this structure). */
+} TkGC;
+
+typedef struct {
+ XGCValues values; /* Desired values for GC. */
+ Display *display; /* Display for which GC is valid. */
+ int screenNum; /* screen number of display */
+ int depth; /* and depth for which GC is valid. */
+} ValueKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void GCInit _ANSI_ARGS_((TkDisplay *dispPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetGC --
+ *
+ * Given a desired set of values for a graphics context, find
+ * a read-only graphics context with the desired values.
+ *
+ * Results:
+ * The return value is the X identifer for the desired graphics
+ * context. The caller should never modify this GC, and should
+ * call Tk_FreeGC when the GC is no longer needed.
+ *
+ * Side effects:
+ * The GC is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeGC, so that the database can be cleaned up when GC's
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+GC
+Tk_GetGC(tkwin, valueMask, valuePtr)
+ Tk_Window tkwin; /* Window in which GC will be used. */
+ register unsigned long valueMask;
+ /* 1 bits correspond to values specified
+ * in *valuesPtr; other values are set
+ * from defaults. */
+ register XGCValues *valuePtr;
+ /* Values are specified here for bits set
+ * in valueMask. */
+{
+ ValueKey valueKey;
+ Tcl_HashEntry *valueHashPtr, *idHashPtr;
+ register TkGC *gcPtr;
+ int new;
+ Drawable d, freeDrawable;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (dispPtr->gcInit <= 0) {
+ GCInit(dispPtr);
+ }
+
+ /*
+ * Must zero valueKey at start to clear out pad bytes that may be
+ * part of structure on some systems.
+ */
+
+ memset((VOID *) &valueKey, 0, sizeof(valueKey));
+
+ /*
+ * First, check to see if there's already a GC that will work
+ * for this request (exact matches only, sorry).
+ */
+
+ if (valueMask & GCFunction) {
+ valueKey.values.function = valuePtr->function;
+ } else {
+ valueKey.values.function = GXcopy;
+ }
+ if (valueMask & GCPlaneMask) {
+ valueKey.values.plane_mask = valuePtr->plane_mask;
+ } else {
+ valueKey.values.plane_mask = (unsigned) ~0;
+ }
+ if (valueMask & GCForeground) {
+ valueKey.values.foreground = valuePtr->foreground;
+ } else {
+ valueKey.values.foreground = 0;
+ }
+ if (valueMask & GCBackground) {
+ valueKey.values.background = valuePtr->background;
+ } else {
+ valueKey.values.background = 1;
+ }
+ if (valueMask & GCLineWidth) {
+ valueKey.values.line_width = valuePtr->line_width;
+ } else {
+ valueKey.values.line_width = 0;
+ }
+ if (valueMask & GCLineStyle) {
+ valueKey.values.line_style = valuePtr->line_style;
+ } else {
+ valueKey.values.line_style = LineSolid;
+ }
+ if (valueMask & GCCapStyle) {
+ valueKey.values.cap_style = valuePtr->cap_style;
+ } else {
+ valueKey.values.cap_style = CapButt;
+ }
+ if (valueMask & GCJoinStyle) {
+ valueKey.values.join_style = valuePtr->join_style;
+ } else {
+ valueKey.values.join_style = JoinMiter;
+ }
+ if (valueMask & GCFillStyle) {
+ valueKey.values.fill_style = valuePtr->fill_style;
+ } else {
+ valueKey.values.fill_style = FillSolid;
+ }
+ if (valueMask & GCFillRule) {
+ valueKey.values.fill_rule = valuePtr->fill_rule;
+ } else {
+ valueKey.values.fill_rule = EvenOddRule;
+ }
+ if (valueMask & GCArcMode) {
+ valueKey.values.arc_mode = valuePtr->arc_mode;
+ } else {
+ valueKey.values.arc_mode = ArcPieSlice;
+ }
+ if (valueMask & GCTile) {
+ valueKey.values.tile = valuePtr->tile;
+ } else {
+ valueKey.values.tile = None;
+ }
+ if (valueMask & GCStipple) {
+ valueKey.values.stipple = valuePtr->stipple;
+ } else {
+ valueKey.values.stipple = None;
+ }
+ if (valueMask & GCTileStipXOrigin) {
+ valueKey.values.ts_x_origin = valuePtr->ts_x_origin;
+ } else {
+ valueKey.values.ts_x_origin = 0;
+ }
+ if (valueMask & GCTileStipYOrigin) {
+ valueKey.values.ts_y_origin = valuePtr->ts_y_origin;
+ } else {
+ valueKey.values.ts_y_origin = 0;
+ }
+ if (valueMask & GCFont) {
+ valueKey.values.font = valuePtr->font;
+ } else {
+ valueKey.values.font = None;
+ }
+ if (valueMask & GCSubwindowMode) {
+ valueKey.values.subwindow_mode = valuePtr->subwindow_mode;
+ } else {
+ valueKey.values.subwindow_mode = ClipByChildren;
+ }
+ if (valueMask & GCGraphicsExposures) {
+ valueKey.values.graphics_exposures = valuePtr->graphics_exposures;
+ } else {
+ valueKey.values.graphics_exposures = True;
+ }
+ if (valueMask & GCClipXOrigin) {
+ valueKey.values.clip_x_origin = valuePtr->clip_x_origin;
+ } else {
+ valueKey.values.clip_x_origin = 0;
+ }
+ if (valueMask & GCClipYOrigin) {
+ valueKey.values.clip_y_origin = valuePtr->clip_y_origin;
+ } else {
+ valueKey.values.clip_y_origin = 0;
+ }
+ if (valueMask & GCClipMask) {
+ valueKey.values.clip_mask = valuePtr->clip_mask;
+ } else {
+ valueKey.values.clip_mask = None;
+ }
+ if (valueMask & GCDashOffset) {
+ valueKey.values.dash_offset = valuePtr->dash_offset;
+ } else {
+ valueKey.values.dash_offset = 0;
+ }
+ if (valueMask & GCDashList) {
+ valueKey.values.dashes = valuePtr->dashes;
+ } else {
+ valueKey.values.dashes = 4;
+ }
+ valueKey.display = Tk_Display(tkwin);
+ valueKey.screenNum = Tk_ScreenNumber(tkwin);
+ valueKey.depth = Tk_Depth(tkwin);
+ valueHashPtr = Tcl_CreateHashEntry(&dispPtr->gcValueTable,
+ (char *) &valueKey, &new);
+ if (!new) {
+ gcPtr = (TkGC *) Tcl_GetHashValue(valueHashPtr);
+ gcPtr->refCount++;
+ return gcPtr->gc;
+ }
+
+ /*
+ * No GC is currently available for this set of values. Allocate a
+ * new GC and add a new structure to the database.
+ */
+
+ gcPtr = (TkGC *) ckalloc(sizeof(TkGC));
+
+ /*
+ * Find or make a drawable to use to specify the screen and depth
+ * of the GC. We may have to make a small pixmap, to avoid doing
+ * Tk_MakeWindowExist on the window.
+ */
+
+ freeDrawable = None;
+ if (Tk_WindowId(tkwin) != None) {
+ d = Tk_WindowId(tkwin);
+ } else if (valueKey.depth ==
+ DefaultDepth(valueKey.display, valueKey.screenNum)) {
+ d = RootWindow(valueKey.display, valueKey.screenNum);
+ } else {
+ d = Tk_GetPixmap(valueKey.display,
+ RootWindow(valueKey.display, valueKey.screenNum),
+ 1, 1, valueKey.depth);
+ freeDrawable = d;
+ }
+
+ gcPtr->gc = XCreateGC(valueKey.display, d, valueMask, &valueKey.values);
+ gcPtr->display = valueKey.display;
+ gcPtr->refCount = 1;
+ gcPtr->valueHashPtr = valueHashPtr;
+ idHashPtr = Tcl_CreateHashEntry(&dispPtr->gcIdTable,
+ (char *) gcPtr->gc, &new);
+ if (!new) {
+ panic("GC already registered in Tk_GetGC");
+ }
+ Tcl_SetHashValue(valueHashPtr, gcPtr);
+ Tcl_SetHashValue(idHashPtr, gcPtr);
+ if (freeDrawable != None) {
+ Tk_FreePixmap(valueKey.display, freeDrawable);
+ }
+
+ return gcPtr->gc;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeGC --
+ *
+ * This procedure is called to release a graphics context allocated by
+ * Tk_GetGC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with gc is decremented, and
+ * gc is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeGC(display, gc)
+ Display *display; /* Display for which gc was allocated. */
+ GC gc; /* Graphics context to be released. */
+{
+ Tcl_HashEntry *idHashPtr;
+ register TkGC *gcPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->gcInit) {
+ panic("Tk_FreeGC called before Tk_GetGC");
+ }
+ if (dispPtr->gcInit < 0) {
+ /*
+ * The GCCleanup has been called, and remaining GCs have been
+ * freed. This may still get called by other things shutting
+ * down, but the GCs should no longer be in use.
+ */
+ return;
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->gcIdTable, (char *) gc);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeGC received unknown gc argument");
+ }
+ gcPtr = (TkGC *) Tcl_GetHashValue(idHashPtr);
+ gcPtr->refCount--;
+ if (gcPtr->refCount == 0) {
+ Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
+ XFreeGC(gcPtr->display, gcPtr->gc);
+ Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
+ Tcl_DeleteHashEntry(idHashPtr);
+ ckfree((char *) gcPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGCCleanup --
+ *
+ * Frees the structures used for GC management.
+ * We need to have it called near the end, when other cleanup that
+ * calls Tk_FreeGC is all done.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * GC resources are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGCCleanup(dispPtr)
+ TkDisplay *dispPtr; /* display to clean up resources in */
+{
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ TkGC *gcPtr;
+
+ for (entryPtr = Tcl_FirstHashEntry(&dispPtr->gcIdTable, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ gcPtr = (TkGC *) Tcl_GetHashValue(entryPtr);
+ /*
+ * This call is not needed, as it is only used on Unix to restore
+ * the Id to the stack pool, and we don't want to use them anymore.
+ * Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
+ */
+ XFreeGC(gcPtr->display, gcPtr->gc);
+ Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
+ Tcl_DeleteHashEntry(entryPtr);
+ ckfree((char *) gcPtr);
+ }
+ Tcl_DeleteHashTable(&dispPtr->gcValueTable);
+ Tcl_DeleteHashTable(&dispPtr->gcIdTable);
+ dispPtr->gcInit = -1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GCInit --
+ *
+ * Initialize the structures used for GC management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GCInit(dispPtr)
+ TkDisplay *dispPtr;
+{
+ if (dispPtr->gcInit < 0) {
+ panic("called GCInit after GCCleanup");
+ }
+ dispPtr->gcInit = 1;
+ Tcl_InitHashTable(&dispPtr->gcValueTable, sizeof(ValueKey)/sizeof(int));
+ Tcl_InitHashTable(&dispPtr->gcIdTable, TCL_ONE_WORD_KEYS);
+}
--- /dev/null
+/*
+ * tkGeometry.c --
+ *
+ * This file contains generic Tk 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.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.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 {
+ Tk_Window slave; /* The slave window being positioned. */
+ Tk_Window 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 {
+ Tk_Window 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;
+
+/*
+ * Prototypes for static procedures in this file:
+ */
+
+static void MaintainCheckProc _ANSI_ARGS_((ClientData clientData));
+static void MaintainMasterProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void MaintainSlaveProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_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
+Tk_ManageGeometry(tkwin, mgrPtr, clientData)
+ Tk_Window tkwin; /* Window whose geometry is to
+ * be managed by proc. */
+ Tk_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. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if ((winPtr->geomMgrPtr != NULL) && (mgrPtr != NULL)
+ && ((winPtr->geomMgrPtr != mgrPtr)
+ || (winPtr->geomData != clientData))
+ && (winPtr->geomMgrPtr->lostSlaveProc != NULL)) {
+ (*winPtr->geomMgrPtr->lostSlaveProc)(winPtr->geomData, tkwin);
+ }
+
+ winPtr->geomMgrPtr = mgrPtr;
+ winPtr->geomData = clientData;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_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 Tk_ResizeWindow.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The geometry manager for tkwin (if any) is invoked to
+ * handle the request. If possible, it will reconfigure
+ * tkwin and/or other windows to satisfy the request. The
+ * caller gets no indication of success or failure, but it
+ * will get X events if the window size was actually
+ * changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_GeometryRequest(tkwin, reqWidth, reqHeight)
+ Tk_Window tkwin; /* Window that geometry information
+ * pertains to. */
+ int reqWidth, reqHeight; /* Minimum desired dimensions for
+ * window, in pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * X gets very upset if a window requests a width or height of
+ * zero, so rounds requested sizes up to at least 1.
+ */
+
+ 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, tkwin);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetInternalBorderEx --
+ *
+ * Notify relevant geometry managers that a window has an internal
+ * border of a given width and that child windows should not be
+ * placed on that border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The border widths are recorded for the window, and all geometry
+ * managers of all children are notified so that can re-layout, if
+ * necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetInternalBorderEx(tkwin, left, right, top, bottom)
+ Tk_Window tkwin; /* Window that will have internal border. */
+ int left, right; /* Width of internal border, in pixels. */
+ int top, bottom;
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ register int changed = 0;
+
+ if (left < 0) {
+ left = 0;
+ }
+ if (left != winPtr->internalBorderLeft) {
+ winPtr->internalBorderLeft = left;
+ changed = 1;
+ }
+
+ if (right < 0) {
+ right = 0;
+ }
+ if (right != winPtr->internalBorderRight) {
+ winPtr->internalBorderRight = right;
+ changed = 1;
+ }
+
+ if (top < 0) {
+ top = 0;
+ }
+ if (top != winPtr->internalBorderTop) {
+ winPtr->internalBorderTop = top;
+ changed = 1;
+ }
+
+ if (bottom < 0) {
+ bottom = 0;
+ }
+ if (bottom != winPtr->internalBorderBottom) {
+ winPtr->internalBorderBottom = bottom;
+ changed = 1;
+ }
+
+ /*
+ * All the slaves for which this is the master window must now be
+ * repositioned to take account of the new internal border width.
+ * To signal all the geometry managers to do this, just resize the
+ * window to its current size. The ConfigureNotify event will
+ * cause geometry managers to recompute everything.
+ */
+
+ if (changed) {
+ Tk_ResizeWindow(tkwin, Tk_Width(tkwin), Tk_Height(tkwin));
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetInternalBorder --
+ *
+ * Notify relevant geometry managers that a window has an internal
+ * border of a given width and that child windows should not be
+ * placed on that border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The border width is recorded for the window, and all geometry
+ * managers of all children are notified so that can re-layout, if
+ * necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetInternalBorder(tkwin, width)
+ Tk_Window tkwin; /* Window that will have internal border. */
+ int width; /* Width of internal border, in pixels. */
+{
+ Tk_SetInternalBorderEx(tkwin, width, width, width, width);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetMinimumRequestSize --
+ *
+ * Notify relevant geometry managers that a window has a minimum
+ * request size.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The minimum request size is recorded for the window, and
+ * a new size is requested for the window, if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetMinimumRequestSize(tkwin, minWidth, minHeight)
+ Tk_Window tkwin; /* Window that will have internal border. */
+ int minWidth, minHeight; /* Minimum requested size, in pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if ((winPtr->minReqWidth == minWidth) &&
+ (winPtr->minReqHeight == minHeight)) {
+ return;
+ }
+
+ winPtr->minReqWidth = minWidth;
+ winPtr->minReqHeight = minHeight;
+
+ /*
+ * The changed min size may cause geometry managers to get a
+ * different result, so make them recompute.
+ * To signal all the geometry managers to do this, just resize the
+ * window to its current size. The ConfigureNotify event will
+ * cause geometry managers to recompute everything.
+ */
+
+ Tk_ResizeWindow(tkwin, Tk_Width(tkwin), Tk_Height(tkwin));
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_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
+Tk_MaintainGeometry(slave, master, x, y, width, height)
+ Tk_Window slave; /* Slave for geometry management. */
+ Tk_Window 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;
+ Tk_Window ancestor, parent;
+ TkDisplay *dispPtr = ((TkWindow *) master)->dispPtr;
+
+ if (master == Tk_Parent(slave)) {
+ /*
+ * If the slave is a direct descendant of the master, don't bother
+ * setting up the extra infrastructure for management, just make a
+ * call to Tk_MoveResizeWindow; the parent/child relationship will
+ * take care of the rest.
+ */
+ Tk_MoveResizeWindow(slave, x, y, width, height);
+
+ /*
+ * Map the slave if the master is already mapped; otherwise, wait
+ * until the master is mapped later (in which case mapping the slave
+ * is taken care of elsewhere).
+ */
+ if (Tk_IsMapped(master)) {
+ Tk_MapWindow(slave);
+ }
+ return;
+ }
+
+ if (!dispPtr->geomInit) {
+ dispPtr->geomInit = 1;
+ Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there is already a MaintainMaster structure for the master;
+ * if not, then create one.
+ */
+
+ parent = Tk_Parent(slave);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->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;
+ Tk_CreateEventHandler(slave, StructureNotifyMask, 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 = Tk_Parent(ancestor)) {
+ if (ancestor == masterPtr->ancestor) {
+ Tk_CreateEventHandler(ancestor, StructureNotifyMask,
+ MaintainMasterProc, (ClientData) masterPtr);
+ masterPtr->ancestor = Tk_Parent(ancestor);
+ }
+ }
+
+ /*
+ * 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 = Tk_Parent(ancestor)) {
+ if (!Tk_IsMapped(ancestor) && (ancestor != parent)) {
+ map = 0;
+ }
+ if (ancestor == parent) {
+ if ((x != Tk_X(slavePtr->slave))
+ || (y != Tk_Y(slavePtr->slave))
+ || (width != Tk_Width(slavePtr->slave))
+ || (height != Tk_Height(slavePtr->slave))) {
+ Tk_MoveResizeWindow(slavePtr->slave, x, y, width, height);
+ }
+ if (map) {
+ Tk_MapWindow(slavePtr->slave);
+ } else {
+ Tk_UnmapWindow(slavePtr->slave);
+ }
+ break;
+ }
+ x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
+ y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UnmaintainGeometry --
+ *
+ * This procedure cancels a previous Tk_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
+Tk_UnmaintainGeometry(slave, master)
+ Tk_Window slave; /* Slave for geometry management. */
+ Tk_Window master; /* Master for slave; must be a descendant
+ * of slave's parent. */
+{
+ Tcl_HashEntry *hPtr;
+ MaintainMaster *masterPtr;
+ register MaintainSlave *slavePtr, *prevPtr;
+ Tk_Window ancestor;
+ TkDisplay *dispPtr = ((TkWindow *) slave)->dispPtr;
+
+ if (master == Tk_Parent(slave)) {
+ /*
+ * If the slave is a direct descendant of the master,
+ * Tk_MaintainGeometry will not have set up any of the extra
+ * infrastructure. Don't even bother to look for it, just return.
+ */
+ return;
+ }
+
+ if (!dispPtr->geomInit) {
+ dispPtr->geomInit = 1;
+ Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ if (!(((TkWindow *) slave)->flags & TK_ALREADY_DEAD)) {
+ Tk_UnmapWindow(slave);
+ }
+ hPtr = Tcl_FindHashEntry(&dispPtr->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;
+ }
+ }
+ }
+ Tk_DeleteEventHandler(slavePtr->slave, StructureNotifyMask,
+ MaintainSlaveProc, (ClientData) slavePtr);
+ ckfree((char *) slavePtr);
+ if (masterPtr->slavePtr == NULL) {
+ if (masterPtr->ancestor != NULL) {
+ for (ancestor = master; ; ancestor = Tk_Parent(ancestor)) {
+ Tk_DeleteEventHandler(ancestor, StructureNotifyMask,
+ MaintainMasterProc, (ClientData) masterPtr);
+ if (ancestor == masterPtr->ancestor) {
+ break;
+ }
+ }
+ }
+ if (masterPtr->checkScheduled) {
+ Tcl_CancelIdleCall(MaintainCheckProc, (ClientData) masterPtr);
+ }
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainMasterProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in
+ * response to StructureNotify events on the master or one
+ * of its ancestors, on behalf of Tk_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. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ MaintainMaster *masterPtr = (MaintainMaster *) clientData;
+ MaintainSlave *slavePtr;
+ int done;
+
+ if ((eventPtr->type == ConfigureNotify)
+ || (eventPtr->type == MapNotify)
+ || (eventPtr->type == UnmapNotify)) {
+ if (!masterPtr->checkScheduled) {
+ masterPtr->checkScheduled = 1;
+ Tcl_DoWhenIdle(MaintainCheckProc, (ClientData) masterPtr);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ /*
+ * 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;
+ }
+ Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master);
+ } while (!done);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ MaintainSlave *slavePtr = (MaintainSlave *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ Tk_Window ancestor, parent;
+ int x, y, map;
+
+ masterPtr->checkScheduled = 0;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ parent = Tk_Parent(slavePtr->slave);
+ x = slavePtr->x;
+ y = slavePtr->y;
+ map = 1;
+ for (ancestor = slavePtr->master; ; ancestor = Tk_Parent(ancestor)) {
+ if (!Tk_IsMapped(ancestor) && (ancestor != parent)) {
+ map = 0;
+ }
+ if (ancestor == parent) {
+ if ((x != Tk_X(slavePtr->slave))
+ || (y != Tk_Y(slavePtr->slave))) {
+ Tk_MoveWindow(slavePtr->slave, x, y);
+ }
+ if (map) {
+ Tk_MapWindow(slavePtr->slave);
+ } else {
+ Tk_UnmapWindow(slavePtr->slave);
+ }
+ break;
+ }
+ x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
+ y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
+ }
+ }
+}
--- /dev/null
+/*
+ * tkGet.c --
+ *
+ * This file contains a number of "Tk_GetXXX" procedures, which
+ * parse text strings into useful forms for Tk. This file has
+ * the simpler procedures, like Tk_GetDirection and Tk_GetUid.
+ * The more complex procedures like Tk_GetColor are in separate
+ * files.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * One of these structures is created per thread to store
+ * thread-specific data. In this case, it is used to house the
+ * Tk_Uid structs used by each thread. The "dataKey" below is
+ * used to locate the ThreadSpecificData for the current thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_HashTable uidTable;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+static void FreeUidThreadExitProc _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * The following tables defines the string values for reliefs, which are
+ * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
+ */
+
+static CONST char *anchorStrings[] = {
+ "n", "ne", "e", "se", "s", "sw", "w", "nw", "center", (char *) NULL
+};
+static CONST char *justifyStrings[] = {
+ "left", "right", "center", (char *) NULL
+};
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetAnchorFromObj --
+ *
+ * Return a Tk_Anchor value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Obj *objPtr; /* The object we are trying to get the
+ * value from. */
+ Tk_Anchor *anchorPtr; /* Where to place the Tk_Anchor that
+ * corresponds to the string value of
+ * objPtr. */
+{
+ int index, code;
+
+ code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0,
+ &index);
+ if (code == TCL_OK) {
+ *anchorPtr = (Tk_Anchor) index;
+ }
+ return code;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAnchor --
+ *
+ * Given a string, return the corresponding Tk_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
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetAnchor(interp, string, anchorPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ CONST char *string; /* String describing a direction. */
+ Tk_Anchor *anchorPtr; /* Where to store Tk_Anchor corresponding
+ * to string. */
+{
+ switch (string[0]) {
+ case 'n':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_N;
+ return TCL_OK;
+ } else if ((string[1] == 'e') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_NE;
+ return TCL_OK;
+ } else if ((string[1] == 'w') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_NW;
+ return TCL_OK;
+ }
+ goto error;
+ case 's':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_S;
+ return TCL_OK;
+ } else if ((string[1] == 'e') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_SE;
+ return TCL_OK;
+ } else if ((string[1] == 'w') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_SW;
+ return TCL_OK;
+ } else {
+ goto error;
+ }
+ case 'e':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_E;
+ return TCL_OK;
+ }
+ goto error;
+ case 'w':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_W;
+ return TCL_OK;
+ }
+ goto error;
+ case 'c':
+ if (strncmp(string, "center", strlen(string)) == 0) {
+ *anchorPtr = TK_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;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfAnchor --
+ *
+ * Given a Tk_Anchor, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfAnchor(anchor)
+ Tk_Anchor anchor; /* Anchor for which identifying string
+ * is desired. */
+{
+ switch (anchor) {
+ case TK_ANCHOR_N: return "n";
+ case TK_ANCHOR_NE: return "ne";
+ case TK_ANCHOR_E: return "e";
+ case TK_ANCHOR_SE: return "se";
+ case TK_ANCHOR_S: return "s";
+ case TK_ANCHOR_SW: return "sw";
+ case TK_ANCHOR_W: return "w";
+ case TK_ANCHOR_NW: return "nw";
+ case TK_ANCHOR_CENTER: return "center";
+ }
+ return "unknown anchor position";
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetJoinStyle --
+ *
+ * Given a string, return the corresponding Tk JoinStyle.
+ *
+ * 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 *joinPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJoinStyle(interp, string, joinPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ CONST char *string; /* String describing a justification style. */
+ int *joinPtr; /* Where to store join style corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
+ *joinPtr = JoinBevel;
+ return TCL_OK;
+ }
+ if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
+ *joinPtr = JoinMiter;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
+ *joinPtr = JoinRound;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad join style \"", string,
+ "\": must be bevel, miter, or round",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfJoinStyle --
+ *
+ * Given a Tk JoinStyle, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfJoinStyle(join)
+ int join; /* Join style for which identifying string
+ * is desired. */
+{
+ switch (join) {
+ case JoinBevel: return "bevel";
+ case JoinMiter: return "miter";
+ case JoinRound: return "round";
+ }
+ return "unknown join style";
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetCapStyle --
+ *
+ * Given a string, return the corresponding Tk CapStyle.
+ *
+ * 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 *capPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetCapStyle(interp, string, capPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ CONST char *string; /* String describing a justification style. */
+ int *capPtr; /* Where to store cap style corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
+ *capPtr = CapButt;
+ return TCL_OK;
+ }
+ if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
+ *capPtr = CapProjecting;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
+ *capPtr = CapRound;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad cap style \"", string,
+ "\": must be butt, projecting, or round",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfCapStyle --
+ *
+ * Given a Tk CapStyle, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfCapStyle(cap)
+ int cap; /* Cap style for which identifying string
+ * is desired. */
+{
+ switch (cap) {
+ case CapButt: return "butt";
+ case CapProjecting: return "projecting";
+ case CapRound: return "round";
+ }
+ return "unknown cap style";
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetJustifyFromObj --
+ *
+ * Return a Tk_Justify value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetJustifyFromObj(interp, objPtr, justifyPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Obj *objPtr; /* The object we are trying to get the
+ * value from. */
+ Tk_Justify *justifyPtr; /* Where to place the Tk_Justify that
+ * corresponds to the string value of
+ * objPtr. */
+{
+ int index, code;
+
+ code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings,
+ "justification", 0, &index);
+ if (code == TCL_OK) {
+ *justifyPtr = (Tk_Justify) index;
+ }
+ return code;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetJustify --
+ *
+ * Given a string, return the corresponding Tk_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
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJustify(interp, string, justifyPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ CONST char *string; /* String describing a justification style. */
+ Tk_Justify *justifyPtr; /* Where to store Tk_Justify corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_LEFT;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_RIGHT;
+ return TCL_OK;
+ }
+ if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_CENTER;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad justification \"", string,
+ "\": must be left, right, or center",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfJustify --
+ *
+ * Given a Tk_Justify, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfJustify(justify)
+ Tk_Justify justify; /* Justification style for which
+ * identifying string is desired. */
+{
+ switch (justify) {
+ case TK_JUSTIFY_LEFT: return "left";
+ case TK_JUSTIFY_RIGHT: return "right";
+ case TK_JUSTIFY_CENTER: return "center";
+ }
+ return "unknown justification style";
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeUidThreadExitProc --
+ *
+ * Cleans up memory used for Tk_Uids in the thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All information in the identifier table is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeUidThreadExitProc(clientData)
+ ClientData clientData; /* Not used. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_DeleteHashTable(&tsdPtr->uidTable);
+ tsdPtr->initialized = 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetUid --
+ *
+ * Given a string, this procedure returns a unique identifier
+ * for the string.
+ *
+ * Results:
+ * This procedure returns a Tk_Uid corresponding to the "string"
+ * argument. The Tk_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 Tk_Uid
+ * *values* directly, without having to call strcmp on what they
+ * point to).
+ *
+ * Side effects:
+ * New information may be entered into the identifier table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Uid
+Tk_GetUid(string)
+ CONST char *string; /* String to convert. */
+{
+ int dummy;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashTable *tablePtr = &tsdPtr->uidTable;
+
+ if (!tsdPtr->initialized) {
+ Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+ Tcl_CreateThreadExitHandler(FreeUidThreadExitProc, NULL);
+ tsdPtr->initialized = 1;
+ }
+ return (Tk_Uid) Tcl_GetHashKey(tablePtr,
+ Tcl_CreateHashEntry(tablePtr, string, &dummy));
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetScreenMM --
+ *
+ * Given a string, returns the number of screen millimeters
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * screen distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetScreenMM(interp, tkwin, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ Tk_Window tkwin; /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ CONST char *string; /* String describing a screen distance. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 0:
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ break;
+ case 'c':
+ d *= 10;
+ end++;
+ break;
+ case 'i':
+ d *= 25.4;
+ end++;
+ break;
+ case 'm':
+ end++;
+ break;
+ case 'p':
+ d *= 25.4/72.0;
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetPixels --
+ *
+ * Given a string, returns the number of pixels corresponding
+ * to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * rounded pixel distance is stored at *intPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetPixels(interp, tkwin, string, intPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ Tk_Window tkwin; /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ CONST char *string; /* String describing a number of pixels. */
+ int *intPtr; /* Place to store converted result. */
+{
+ double d;
+
+ if (TkGetDoublePixels(interp, tkwin, string, &d) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (d < 0) {
+ *intPtr = (int) (d - 0.5);
+ } else {
+ *intPtr = (int) (d + 0.5);
+ }
+ return TCL_OK;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetDoublePixels --
+ *
+ * Given a string, returns the number of pixels corresponding
+ * to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * pixel distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetDoublePixels(interp, tkwin, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ Tk_Window tkwin; /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ CONST char *string; /* String describing a number of pixels. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod((char *) string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 0:
+ break;
+ case 'c':
+ d *= 10*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'i':
+ d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'm':
+ d *= WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'p':
+ d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+
+
--- /dev/null
+/*
+ * tkGrab.c --
+ *
+ * This file provides procedures that implement grabs for Tk.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * The grab state machine has four states: ungrabbed, button pressed,
+ * grabbed, and button pressed while grabbed. In addition, there are
+ * three pieces of grab state information: the current grab window,
+ * the current restrict window, and whether the mouse is captured.
+ *
+ * The current grab window specifies the point in the Tk window
+ * heirarchy above which pointer events will not be reported. Any
+ * window within the subtree below the grab window will continue to
+ * receive events as normal. Events outside of the grab tree will be
+ * reported to the grab window.
+ *
+ * If the current restrict window is set, then all pointer events will
+ * be reported only to the restrict window. The restrict window is
+ * normally set during an automatic button grab.
+ *
+ * The mouse capture state specifies whether the window system will
+ * report mouse events outside of any Tk toplevels. This is set
+ * during a global grab or an automatic button grab.
+ *
+ * The transitions between different states is given in the following
+ * table:
+ *
+ * Event\State U B G GB
+ * ----------- -- -- -- --
+ * FirstPress B B GB GB
+ * Press B B G GB
+ * Release U B G GB
+ * LastRelease U U G G
+ * Grab G G G G
+ * Ungrab U B U U
+ *
+ * Note: U=Ungrabbed, B=Button, G=Grabbed, GB=Grab and Button
+ *
+ * In addition, the following conditions are always true:
+ *
+ * State\Variable Grab Restrict Capture
+ * -------------- ---- -------- -------
+ * Ungrabbed 0 0 0
+ * Button 0 1 1
+ * Grabbed 1 0 b/g
+ * Grab and Button 1 1 1
+ *
+ * Note: 0 means variable is set to NULL, 1 means variable is set to
+ * some window, b/g means the variable is set to a window if a button
+ * is currently down or a global grab is in effect.
+ *
+ * The final complication to all of this is enter and leave events.
+ * In order to correctly handle all of the various cases, Tk cannot
+ * rely on X enter/leave events in all situations. The following
+ * describes the correct sequence of enter and leave events that
+ * should be observed by Tk scripts:
+ *
+ * Event(state) Enter/Leave From -> To
+ * ------------ ----------------------
+ * LastRelease(B | GB): restrict window -> anc(grab window, event window)
+ * Grab(U | B): event window -> anc(grab window, event window)
+ * Grab(G): anc(old grab window, event window) ->
+ * anc(new grab window, event window)
+ * Grab(GB): restrict window -> anc(new grab window, event window)
+ * Ungrab(G): anc(grab window, event window) -> event window
+ * Ungrab(GB): restrict window -> event window
+ *
+ * Note: anc(x,y) returns the least ancestor of y that is in the tree
+ * of x, terminating at toplevels.
+ */
+
+/*
+ * The following structure is used to pass information to
+ * GrabRestrictProc from EatGrabEvents.
+ */
+
+typedef struct {
+ Display *display; /* Display from which to discard events. */
+ unsigned int serial; /* Serial number with which to compare. */
+} GrabInfo;
+
+/*
+ * Bit definitions for grabFlags field of TkDisplay structures:
+ *
+ * GRAB_GLOBAL 1 means this is a global grab (we grabbed via
+ * the server so all applications are locked out).
+ * 0 means this is a local grab that affects
+ * only this application.
+ * GRAB_TEMP_GLOBAL 1 means we've temporarily grabbed via the
+ * server because a button is down and we want
+ * to make sure that we get the button-up
+ * event. The grab will be released when the
+ * last mouse button goes up.
+ */
+
+#define GRAB_GLOBAL 1
+#define GRAB_TEMP_GLOBAL 4
+
+/*
+ * The following structure is a Tcl_Event that triggers a change in
+ * the grabWinPtr field of a display. This event guarantees that
+ * the change occurs in the proper order relative to enter and leave
+ * events.
+ */
+
+typedef struct NewGrabWinEvent {
+ Tcl_Event header; /* Standard information for all Tcl events. */
+ TkDisplay *dispPtr; /* Display whose grab window is to change. */
+ Window grabWindow; /* New grab window for display. This is
+ * recorded instead of a (TkWindow *) because
+ * it will allow us to detect cases where
+ * the window is destroyed before this event
+ * is processed. */
+} NewGrabWinEvent;
+
+/*
+ * The following magic value is stored in the "send_event" field of
+ * EnterNotify and LeaveNotify events that are generated in this
+ * file. This allows us to separate "real" events coming from the
+ * server from those that we generated.
+ */
+
+#define GENERATED_EVENT_MAGIC ((Bool) 0x147321ac)
+
+/*
+ * Mask that selects any of the state bits corresponding to buttons,
+ * plus masks that select individual buttons' bits:
+ */
+
+#define ALL_BUTTONS \
+ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
+static unsigned int buttonStates[] = {
+ Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
+};
+
+/*
+ * Forward declarations for procedures declared later in this file:
+ */
+
+static void EatGrabEvents _ANSI_ARGS_((TkDisplay *dispPtr,
+ unsigned int serial));
+static TkWindow * FindCommonAncestor _ANSI_ARGS_((TkWindow *winPtr1,
+ TkWindow *winPtr2, int *countPtr1,
+ int *countPtr2));
+static Tk_RestrictAction GrabRestrictProc _ANSI_ARGS_((ClientData arg,
+ XEvent *eventPtr));
+static int GrabWinEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static void MovePointer2 _ANSI_ARGS_((TkWindow *sourcePtr,
+ TkWindow *destPtr, int mode, int leaveEvents,
+ int EnterEvents));
+static void QueueGrabWindowChange _ANSI_ARGS_((TkDisplay *dispPtr,
+ TkWindow *grabWinPtr));
+static void ReleaseButtonGrab _ANSI_ARGS_((TkDisplay *dispPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GrabObjCmd --
+ *
+ * This procedure is invoked to process the "grab" 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_GrabObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int globalGrab;
+ Tk_Window tkwin;
+ TkDisplay *dispPtr;
+ char *arg;
+ int index;
+ int len;
+ static CONST char *optionStrings[] = { "current", "release",
+ "set", "status", (char *) NULL };
+
+ static CONST char *flagStrings[] = { "-global", (char *) NULL };
+
+ enum options { GRABCMD_CURRENT, GRABCMD_RELEASE,
+ GRABCMD_SET, GRABCMD_STATUS };
+
+ if (objc < 2) {
+ /*
+ * Can't use Tcl_WrongNumArgs here because we want the message to
+ * read:
+ * wrong # args: should be "cmd ?-global window" or "cmd option
+ * ?arg arg ...?"
+ * We can fake it with Tcl_WrongNumArgs if we assume the command name
+ * is "grab", but if it has been aliased, the message will be
+ * incorrect.
+ */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tcl_GetString(objv[0]), " ?-global? window\" or \"",
+ Tcl_GetString(objv[0]), " option ?arg arg ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * First check for a window name or "-global" as the first argument.
+ */
+
+ arg = Tcl_GetStringFromObj(objv[1], &len);
+ if (arg[0] == '.') {
+ /* [grab window] */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, arg, (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 0);
+ } else if (arg[0] == '-' && len > 1) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], flagStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* [grab -global window] */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 1);
+ }
+
+ /*
+ * First argument is not a window name and not "-global", find out
+ * which option it is.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case GRABCMD_CURRENT: {
+ /* [grab current ?window?] */
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "current ?window?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ Tcl_SetResult(interp,
+ dispPtr->eventualGrabWinPtr->pathName, TCL_STATIC);
+ }
+ } else {
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ Tcl_AppendElement(interp,
+ dispPtr->eventualGrabWinPtr->pathName);
+ }
+ }
+ }
+ return TCL_OK;
+ }
+
+ case GRABCMD_RELEASE: {
+ /* [grab release window] */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "release window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tk_Ungrab(tkwin);
+ }
+ break;
+ }
+
+ case GRABCMD_SET: {
+ /* [grab set ?-global? window] */
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "set ?-global? window");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ globalGrab = 0;
+ tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), (Tk_Window) clientData);
+ } else {
+ globalGrab = 1;
+ /*
+ * We could just test the argument by hand instead of using
+ * Tcl_GetIndexFromObj; the benefit of using the function is
+ * that it sets up the error message for us, so we are
+ * certain to be consistant with the rest of Tcl.
+ */
+ if (Tcl_GetIndexFromObj(interp, objv[2], flagStrings, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[3]), (Tk_Window) clientData);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, globalGrab);
+ }
+
+ case GRABCMD_STATUS: {
+ /* [grab status window] */
+ TkWindow *winPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "status window");
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), (Tk_Window) clientData);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ dispPtr = winPtr->dispPtr;
+ if (dispPtr->eventualGrabWinPtr != winPtr) {
+ Tcl_SetResult(interp, "none", TCL_STATIC);
+ } else if (dispPtr->grabFlags & GRAB_GLOBAL) {
+ Tcl_SetResult(interp, "global", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "local", TCL_STATIC);
+ }
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Grab --
+ *
+ * Grabs the pointer and keyboard, so that mouse-related events are
+ * only reported relative to a given window and its descendants.
+ *
+ * Results:
+ * A standard Tcl result is returned. TCL_OK is the normal return
+ * value; if the grab could not be set then TCL_ERROR is returned
+ * and the interp's result will hold an error message.
+ *
+ * Side effects:
+ * Once this call completes successfully, no window outside the
+ * tree rooted at tkwin will receive pointer- or keyboard-related
+ * events until the next call to Tk_Ungrab. If a previous grab was
+ * in effect within this application, then it is replaced with a new
+ * one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_Grab(interp, tkwin, grabGlobal)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Window on whose behalf the pointer
+ * is to be grabbed. */
+ int grabGlobal; /* Non-zero means issue a grab to the
+ * server so that no other application
+ * gets mouse or keyboard events.
+ * Zero means the grab only applies
+ * within this application. */
+{
+ int grabResult, numTries;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkWindow *winPtr2;
+ unsigned int serial;
+
+ ReleaseButtonGrab(dispPtr);
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ if ((dispPtr->eventualGrabWinPtr == winPtr)
+ && (grabGlobal == ((dispPtr->grabFlags & GRAB_GLOBAL) != 0))) {
+ return TCL_OK;
+ }
+ if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) {
+ alreadyGrabbed:
+ Tcl_SetResult(interp, "grab failed: another application has grab",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
+ }
+
+ Tk_MakeWindowExist(tkwin);
+ if (!grabGlobal) {
+ Window dummy1, dummy2;
+ int dummy3, dummy4, dummy5, dummy6;
+ unsigned int state;
+
+ /*
+ * Local grab. However, if any mouse buttons are down, turn
+ * it into a global grab temporarily, until the last button
+ * goes up. This does two things: (a) it makes sure that we
+ * see the button-up event; and (b) it allows us to track mouse
+ * motion among all of the windows of this application.
+ */
+
+ dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL);
+ XQueryPointer(dispPtr->display, winPtr->window, &dummy1,
+ &dummy2, &dummy3, &dummy4, &dummy5, &dummy6, &state);
+ if ((state & ALL_BUTTONS) != 0) {
+ dispPtr->grabFlags |= GRAB_TEMP_GLOBAL;
+ goto setGlobalGrab;
+ }
+ } else {
+ dispPtr->grabFlags |= GRAB_GLOBAL;
+ setGlobalGrab:
+
+ /*
+ * Tricky point: must ungrab before grabbing. This is needed
+ * in case there is a button auto-grab already in effect. If
+ * there is, and the mouse has moved to a different window, X
+ * won't generate enter and leave events to move the mouse if
+ * we grab without ungrabbing.
+ */
+
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ serial = NextRequest(dispPtr->display);
+
+ /*
+ * Another tricky point: there are races with some window
+ * managers that can cause grabs to fail because the window
+ * manager hasn't released its grab quickly enough. To work
+ * around this problem, retry a few times after AlreadyGrabbed
+ * errors to give the grab release enough time to register with
+ * the server.
+ */
+
+ grabResult = 0; /* Needed only to prevent gcc
+ * compiler warnings. */
+ for (numTries = 0; numTries < 10; numTries++) {
+ grabResult = XGrabPointer(dispPtr->display, winPtr->window,
+ True, ButtonPressMask|ButtonReleaseMask|ButtonMotionMask
+ |PointerMotionMask, GrabModeAsync, GrabModeAsync, None,
+ None, CurrentTime);
+ if (grabResult != AlreadyGrabbed) {
+ break;
+ }
+ Tcl_Sleep(100);
+ }
+ if (grabResult != 0) {
+ grabError:
+ if (grabResult == GrabNotViewable) {
+ Tcl_SetResult(interp, "grab failed: window not viewable",
+ TCL_STATIC);
+ } else if (grabResult == AlreadyGrabbed) {
+ goto alreadyGrabbed;
+ } else if (grabResult == GrabFrozen) {
+ Tcl_SetResult(interp,
+ "grab failed: keyboard or pointer frozen", TCL_STATIC);
+ } else if (grabResult == GrabInvalidTime) {
+ Tcl_SetResult(interp, "grab failed: invalid time",
+ TCL_STATIC);
+ } else {
+ char msg[64 + TCL_INTEGER_SPACE];
+
+ sprintf(msg, "grab failed for unknown reason (code %d)",
+ grabResult);
+ Tcl_AppendResult(interp, msg, (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ grabResult = XGrabKeyboard(dispPtr->display, Tk_WindowId(tkwin),
+ False, GrabModeAsync, GrabModeAsync, CurrentTime);
+ if (grabResult != 0) {
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ goto grabError;
+ }
+
+ /*
+ * Eat up any grab-related events generated by the server for the
+ * grab. There are several reasons for doing this:
+ *
+ * 1. We have to synthesize the events for local grabs anyway, since
+ * the server doesn't participate in them.
+ * 2. The server doesn't always generate the right events for global
+ * grabs (e.g. it generates events even if the current window is
+ * in the grab tree, which we don't want).
+ * 3. We want all the grab-related events to be processed immediately
+ * (before other events that are already queued); events coming
+ * from the server will be in the wrong place, but events we
+ * synthesize here will go to the front of the queue.
+ */
+
+ EatGrabEvents(dispPtr, serial);
+ }
+
+ /*
+ * Synthesize leave events to move the pointer from its current window
+ * up to the lowest ancestor that it has in common with the grab window.
+ * However, only do this if the pointer is outside the grab window's
+ * subtree but inside the grab window's application.
+ */
+
+ if ((dispPtr->serverWinPtr != NULL)
+ && (dispPtr->serverWinPtr->mainPtr == winPtr->mainPtr)) {
+ for (winPtr2 = dispPtr->serverWinPtr; ; winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == winPtr) {
+ break;
+ }
+ if (winPtr2 == NULL) {
+ MovePointer2(dispPtr->serverWinPtr, winPtr, NotifyGrab, 1, 0);
+ break;
+ }
+ }
+ }
+ QueueGrabWindowChange(dispPtr, winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Ungrab --
+ *
+ * Releases a grab on the mouse pointer and keyboard, if there
+ * is one set on the specified window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Pointer and keyboard events will start being delivered to other
+ * windows again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Ungrab(tkwin)
+ Tk_Window tkwin; /* Window whose grab should be
+ * released. */
+{
+ TkDisplay *dispPtr;
+ TkWindow *grabWinPtr, *winPtr;
+ unsigned int serial;
+
+ grabWinPtr = (TkWindow *) tkwin;
+ dispPtr = grabWinPtr->dispPtr;
+ if (grabWinPtr != dispPtr->eventualGrabWinPtr) {
+ return;
+ }
+ ReleaseButtonGrab(dispPtr);
+ QueueGrabWindowChange(dispPtr, (TkWindow *) NULL);
+ if (dispPtr->grabFlags & (GRAB_GLOBAL|GRAB_TEMP_GLOBAL)) {
+ dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL);
+ serial = NextRequest(dispPtr->display);
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ XUngrabKeyboard(dispPtr->display, CurrentTime);
+ EatGrabEvents(dispPtr, serial);
+ }
+
+ /*
+ * Generate events to move the pointer back to the window where it
+ * really is. Some notes:
+ * 1. As with grabs, only do this if the "real" window is not a
+ * descendant of the grab window, since in this case the pointer
+ * is already where it's supposed to be.
+ * 2. If the "real" window is in some other application then don't
+ * generate any events at all, since everything's already been
+ * reported correctly.
+ * 3. Only generate enter events. Don't generate leave events,
+ * because we never told the lower-level windows that they
+ * had the pointer in the first place.
+ */
+
+ for (winPtr = dispPtr->serverWinPtr; ; winPtr = winPtr->parentPtr) {
+ if (winPtr == grabWinPtr) {
+ break;
+ }
+ if (winPtr == NULL) {
+ if ((dispPtr->serverWinPtr == NULL) ||
+ (dispPtr->serverWinPtr->mainPtr == grabWinPtr->mainPtr)) {
+ MovePointer2(grabWinPtr, dispPtr->serverWinPtr,
+ NotifyUngrab, 0, 1);
+ }
+ break;
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseButtonGrab --
+ *
+ * This procedure is called to release a simulated button grab, if
+ * there is one in effect. A button grab is present whenever
+ * dispPtr->buttonWinPtr is non-NULL or when the GRAB_TEMP_GLOBAL
+ * flag is set.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr->buttonWinPtr is reset to NULL, and enter and leave
+ * events are generated if necessary to move the pointer from
+ * the button grab window to its current window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseButtonGrab(dispPtr)
+ register TkDisplay *dispPtr; /* Display whose button grab is to be
+ * released. */
+{
+ unsigned int serial;
+
+ if (dispPtr->buttonWinPtr != NULL) {
+ if (dispPtr->buttonWinPtr != dispPtr->serverWinPtr) {
+ MovePointer2(dispPtr->buttonWinPtr, dispPtr->serverWinPtr,
+ NotifyUngrab, 1, 1);
+ }
+ dispPtr->buttonWinPtr = NULL;
+ }
+ if (dispPtr->grabFlags & GRAB_TEMP_GLOBAL) {
+ dispPtr->grabFlags &= ~GRAB_TEMP_GLOBAL;
+ serial = NextRequest(dispPtr->display);
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ XUngrabKeyboard(dispPtr->display, CurrentTime);
+ EatGrabEvents(dispPtr, serial);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPointerEvent --
+ *
+ * This procedure is called for each pointer-related event, before
+ * the event has been processed. It does various things to make
+ * grabs work correctly.
+ *
+ * Results:
+ * If the return value is 1 it means the event should be processed
+ * (event handlers should be invoked). If the return value is 0
+ * it means the event should be ignored in order to make grabs
+ * work correctly. In some cases this procedure modifies the event.
+ *
+ * Side effects:
+ * Grab state information may be updated. New events may also be
+ * pushed back onto the event queue to replace or augment the
+ * one passed in here.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPointerEvent(eventPtr, winPtr)
+ register XEvent *eventPtr; /* Pointer to the event. */
+ TkWindow *winPtr; /* Tk's information for window
+ * where event was reported. */
+{
+ register TkWindow *winPtr2;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ unsigned int serial;
+ int outsideGrabTree = 0;
+ int ancestorOfGrab = 0;
+ int appGrabbed = 0; /* Non-zero means event is being
+ * reported to an application that is
+ * affected by the grab. */
+
+ /*
+ * Collect information about the grab (if any).
+ */
+
+ switch (TkGrabState(winPtr)) {
+ case TK_GRAB_IN_TREE:
+ appGrabbed = 1;
+ break;
+ case TK_GRAB_ANCESTOR:
+ appGrabbed = 1;
+ outsideGrabTree = 1;
+ ancestorOfGrab = 1;
+ break;
+ case TK_GRAB_EXCLUDED:
+ appGrabbed = 1;
+ outsideGrabTree = 1;
+ break;
+ }
+
+ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
+ /*
+ * Keep track of what window the mouse is *really* over.
+ * Any events that we generate have a special send_event value,
+ * which is detected below and used to ignore the event for
+ * purposes of setting serverWinPtr.
+ */
+
+ if (eventPtr->xcrossing.send_event != GENERATED_EVENT_MAGIC) {
+ if ((eventPtr->type == LeaveNotify) &&
+ (winPtr->flags & TK_TOP_HIERARCHY)) {
+ dispPtr->serverWinPtr = NULL;
+ } else {
+ dispPtr->serverWinPtr = winPtr;
+ }
+ }
+
+ /*
+ * When a grab is active, X continues to report enter and leave
+ * events for windows outside the tree of the grab window:
+ * 1. Detect these events and ignore them except for
+ * windows above the grab window.
+ * 2. Allow Enter and Leave events to pass through the
+ * windows above the grab window, but never let them
+ * end up with the pointer *in* one of those windows.
+ */
+
+ if (dispPtr->grabWinPtr != NULL) {
+ if (outsideGrabTree && appGrabbed) {
+ if (!ancestorOfGrab) {
+ return 0;
+ }
+ switch (eventPtr->xcrossing.detail) {
+ case NotifyInferior:
+ return 0;
+ case NotifyAncestor:
+ eventPtr->xcrossing.detail = NotifyVirtual;
+ break;
+ case NotifyNonlinear:
+ eventPtr->xcrossing.detail = NotifyNonlinearVirtual;
+ break;
+ }
+ }
+
+ /*
+ * Make buttons have the same grab-like behavior inside a grab
+ * as they do outside a grab: do this by ignoring enter and
+ * leave events except for the window in which the button was
+ * pressed.
+ */
+
+ if ((dispPtr->buttonWinPtr != NULL)
+ && (winPtr != dispPtr->buttonWinPtr)) {
+ return 0;
+ }
+ }
+ return 1;
+ }
+
+ if (!appGrabbed) {
+ return 1;
+ }
+
+ if (eventPtr->type == MotionNotify) {
+ /*
+ * When grabs are active, X reports motion events relative to the
+ * window under the pointer. Instead, it should report the events
+ * relative to the window the button went down in, if there is a
+ * button down. Otherwise, if the pointer window is outside the
+ * subtree of the grab window, the events should be reported
+ * relative to the grab window. Otherwise, the event should be
+ * reported to the pointer window.
+ */
+
+ winPtr2 = winPtr;
+ if (dispPtr->buttonWinPtr != NULL) {
+ winPtr2 = dispPtr->buttonWinPtr;
+ } else if (outsideGrabTree || (dispPtr->serverWinPtr == NULL)) {
+ winPtr2 = dispPtr->grabWinPtr;
+ }
+ if (winPtr2 != winPtr) {
+ TkChangeEventWindow(eventPtr, winPtr2);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0;
+ }
+ return 1;
+ }
+
+ /*
+ * Process ButtonPress and ButtonRelease events:
+ * 1. Keep track of whether a button is down and what window it
+ * went down in.
+ * 2. If the first button goes down outside the grab tree, pretend
+ * it went down in the grab window. Note: it's important to
+ * redirect events to the grab window like this in order to make
+ * things like menus work, where button presses outside the
+ * grabbed menu need to be seen. An application can always
+ * ignore the events if they occur outside its window.
+ * 3. If a button press or release occurs outside the window where
+ * the first button was pressed, retarget the event so it's reported
+ * to the window where the first button was pressed.
+ * 4. If the last button is released in a window different than where
+ * the first button was pressed, generate Enter/Leave events to
+ * move the mouse from the button window to its current window.
+ * 5. If the grab is set at a time when a button is already down, or
+ * if the window where the button was pressed was deleted, then
+ * dispPtr->buttonWinPtr will stay NULL. Just forget about the
+ * auto-grab for the button press; events will go to whatever
+ * window contains the pointer. If this window isn't in the grab
+ * tree then redirect events to the grab window.
+ * 6. When a button is pressed during a local grab, the X server sets
+ * a grab of its own, since it doesn't even know about our local
+ * grab. This causes enter and leave events no longer to be
+ * generated in the same way as for global grabs. To eliminate this
+ * problem, set a temporary global grab when the first button goes
+ * down and release it when the last button comes up.
+ */
+
+ if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) {
+ winPtr2 = dispPtr->buttonWinPtr;
+ if (winPtr2 == NULL) {
+ if (outsideGrabTree) {
+ winPtr2 = dispPtr->grabWinPtr; /* Note 5. */
+ } else {
+ winPtr2 = winPtr; /* Note 5. */
+ }
+ }
+ if (eventPtr->type == ButtonPress) {
+ if ((eventPtr->xbutton.state & ALL_BUTTONS) == 0) {
+ if (outsideGrabTree) {
+ TkChangeEventWindow(eventPtr, dispPtr->grabWinPtr);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0; /* Note 2. */
+ }
+ if (!(dispPtr->grabFlags & GRAB_GLOBAL)) { /* Note 6. */
+ serial = NextRequest(dispPtr->display);
+ if (XGrabPointer(dispPtr->display,
+ dispPtr->grabWinPtr->window, True,
+ ButtonPressMask|ButtonReleaseMask|ButtonMotionMask,
+ GrabModeAsync, GrabModeAsync, None, None,
+ CurrentTime) == 0) {
+ EatGrabEvents(dispPtr, serial);
+ if (XGrabKeyboard(dispPtr->display, winPtr->window,
+ False, GrabModeAsync, GrabModeAsync,
+ CurrentTime) == 0) {
+ dispPtr->grabFlags |= GRAB_TEMP_GLOBAL;
+ } else {
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ }
+ }
+ }
+ dispPtr->buttonWinPtr = winPtr;
+ return 1;
+ }
+ } else {
+ if ((eventPtr->xbutton.state & ALL_BUTTONS)
+ == buttonStates[eventPtr->xbutton.button - Button1]) {
+ ReleaseButtonGrab(dispPtr); /* Note 4. */
+ }
+ }
+ if (winPtr2 != winPtr) {
+ TkChangeEventWindow(eventPtr, winPtr2);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0; /* Note 3. */
+ }
+ }
+
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkChangeEventWindow --
+ *
+ * Given an event and a new window to which the event should be
+ * retargeted, modify fields of the event so that the event is
+ * properly retargeted to the new window.
+ *
+ * Results:
+ * The following fields of eventPtr are modified: window,
+ * subwindow, x, y, same_screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkChangeEventWindow(eventPtr, winPtr)
+ register XEvent *eventPtr; /* Event to retarget. Must have
+ * type ButtonPress, ButtonRelease, KeyPress,
+ * KeyRelease, MotionNotify, EnterNotify,
+ * or LeaveNotify. */
+ TkWindow *winPtr; /* New target window for event. */
+{
+ int x, y, sameScreen, bd;
+ register TkWindow *childPtr;
+
+ eventPtr->xmotion.window = Tk_WindowId(winPtr);
+ if (eventPtr->xmotion.root ==
+ RootWindow(winPtr->display, winPtr->screenNum)) {
+ Tk_GetRootCoords((Tk_Window) winPtr, &x, &y);
+ eventPtr->xmotion.x = eventPtr->xmotion.x_root - x;
+ eventPtr->xmotion.y = eventPtr->xmotion.y_root - y;
+ eventPtr->xmotion.subwindow = None;
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (childPtr->flags & TK_TOP_HIERARCHY) {
+ continue;
+ }
+ x = eventPtr->xmotion.x - childPtr->changes.x;
+ y = eventPtr->xmotion.y - childPtr->changes.y;
+ bd = childPtr->changes.border_width;
+ if ((x >= -bd) && (y >= -bd)
+ && (x < (childPtr->changes.width + bd))
+ && (y < (childPtr->changes.height + bd))) {
+ eventPtr->xmotion.subwindow = childPtr->window;
+ }
+ }
+ sameScreen = 1;
+ } else {
+ eventPtr->xmotion.x = 0;
+ eventPtr->xmotion.y = 0;
+ eventPtr->xmotion.subwindow = None;
+ sameScreen = 0;
+ }
+ if (eventPtr->type == MotionNotify) {
+ eventPtr->xmotion.same_screen = sameScreen;
+ } else {
+ eventPtr->xbutton.same_screen = sameScreen;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInOutEvents --
+ *
+ * This procedure synthesizes EnterNotify and LeaveNotify events
+ * to correctly transfer the pointer from one window to another.
+ * It can also be used to generate FocusIn and FocusOut events
+ * to move the input focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Synthesized events may be pushed back onto the event queue.
+ * The event pointed to by eventPtr is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInOutEvents(eventPtr, sourcePtr, destPtr, leaveType, enterType, position)
+ XEvent *eventPtr; /* A template X event. Must have all fields
+ * properly set except for type, window,
+ * subwindow, x, y, detail, and same_screen
+ * (Not all of these fields are valid for
+ * FocusIn/FocusOut events; x_root and y_root
+ * must be valid for Enter/Leave events, even
+ * though x and y needn't be valid). */
+ TkWindow *sourcePtr; /* Window that used to have the pointer or
+ * focus (NULL means it was not in a window
+ * managed by this process). */
+ TkWindow *destPtr; /* Window that is to end up with the pointer
+ * or focus (NULL means it's not one managed
+ * by this process). */
+ int leaveType; /* Type of events to generate for windows
+ * being left (LeaveNotify or FocusOut). 0
+ * means don't generate leave events. */
+ int enterType; /* Type of events to generate for windows
+ * being entered (EnterNotify or FocusIn). 0
+ * means don't generate enter events. */
+ Tcl_QueuePosition position; /* Position at which events are added to
+ * the system event queue. */
+{
+ register TkWindow *winPtr;
+ int upLevels, downLevels, i, j, focus;
+
+ /*
+ * There are four possible cases to deal with:
+ *
+ * 1. SourcePtr and destPtr are the same. There's nothing to do in
+ * this case.
+ * 2. SourcePtr is an ancestor of destPtr in the same top-level
+ * window. Must generate events down the window tree from source
+ * to dest.
+ * 3. DestPtr is an ancestor of sourcePtr in the same top-level
+ * window. Must generate events up the window tree from sourcePtr
+ * to destPtr.
+ * 4. All other cases. Must first generate events up the window tree
+ * from sourcePtr to its top-level, then down from destPtr's
+ * top-level to destPtr. This form is called "non-linear."
+ *
+ * The call to FindCommonAncestor separates these four cases and decides
+ * how many levels up and down events have to be generated for.
+ */
+
+ if (sourcePtr == destPtr) {
+ return;
+ }
+ if ((leaveType == FocusOut) || (enterType == FocusIn)) {
+ focus = 1;
+ } else {
+ focus = 0;
+ }
+ FindCommonAncestor(sourcePtr, destPtr, &upLevels, &downLevels);
+
+ /*
+ * Generate enter/leave events and add them to the grab event queue.
+ */
+
+
+#define QUEUE(w, t, d) \
+ if (w->window != None) { \
+ eventPtr->type = t; \
+ if (focus) { \
+ eventPtr->xfocus.window = w->window; \
+ eventPtr->xfocus.detail = d; \
+ } else { \
+ eventPtr->xcrossing.detail = d; \
+ TkChangeEventWindow(eventPtr, w); \
+ } \
+ Tk_QueueWindowEvent(eventPtr, position); \
+ }
+
+ if (downLevels == 0) {
+
+ /*
+ * SourcePtr is an inferior of destPtr.
+ */
+
+ if (leaveType != 0) {
+ QUEUE(sourcePtr, leaveType, NotifyAncestor);
+ for (winPtr = sourcePtr->parentPtr, i = upLevels-1; i > 0;
+ winPtr = winPtr->parentPtr, i--) {
+ QUEUE(winPtr, leaveType, NotifyVirtual);
+ }
+ }
+ if ((enterType != 0) && (destPtr != NULL)) {
+ QUEUE(destPtr, enterType, NotifyInferior);
+ }
+ } else if (upLevels == 0) {
+
+ /*
+ * DestPtr is an inferior of sourcePtr.
+ */
+
+ if ((leaveType != 0) && (sourcePtr != NULL)) {
+ QUEUE(sourcePtr, leaveType, NotifyInferior);
+ }
+ if (enterType != 0) {
+ for (i = downLevels-1; i > 0; i--) {
+ for (winPtr = destPtr->parentPtr, j = 1; j < i;
+ winPtr = winPtr->parentPtr, j++) {
+ }
+ QUEUE(winPtr, enterType, NotifyVirtual);
+ }
+ if (destPtr != NULL) {
+ QUEUE(destPtr, enterType, NotifyAncestor);
+ }
+ }
+ } else {
+
+ /*
+ * Non-linear: neither window is an inferior of the other.
+ */
+
+ if (leaveType != 0) {
+ QUEUE(sourcePtr, leaveType, NotifyNonlinear);
+ for (winPtr = sourcePtr->parentPtr, i = upLevels-1; i > 0;
+ winPtr = winPtr->parentPtr, i--) {
+ QUEUE(winPtr, leaveType, NotifyNonlinearVirtual);
+ }
+ }
+ if (enterType != 0) {
+ for (i = downLevels-1; i > 0; i--) {
+ for (winPtr = destPtr->parentPtr, j = 1; j < i;
+ winPtr = winPtr->parentPtr, j++) {
+ }
+ QUEUE(winPtr, enterType, NotifyNonlinearVirtual);
+ }
+ if (destPtr != NULL) {
+ QUEUE(destPtr, enterType, NotifyNonlinear);
+ }
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * MovePointer2 --
+ *
+ * This procedure synthesizes EnterNotify and LeaveNotify events
+ * to correctly transfer the pointer from one window to another.
+ * It is different from TkInOutEvents in that no template X event
+ * needs to be supplied; this procedure generates the template
+ * event and calls TkInOutEvents.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Synthesized events may be pushed back onto the event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MovePointer2(sourcePtr, destPtr, mode, leaveEvents, enterEvents)
+ TkWindow *sourcePtr; /* Window currently containing pointer (NULL
+ * means it's not one managed by this
+ * process). */
+ TkWindow *destPtr; /* Window that is to end up containing the
+ * pointer (NULL means it's not one managed
+ * by this process). */
+ int mode; /* Mode for enter/leave events, such as
+ * NotifyNormal or NotifyUngrab. */
+ int leaveEvents; /* Non-zero means generate leave events for the
+ * windows being left. Zero means don't
+ * generate leave events. */
+ int enterEvents; /* Non-zero means generate enter events for the
+ * windows being entered. Zero means don't
+ * generate enter events. */
+{
+ XEvent event;
+ Window dummy1, dummy2;
+ int dummy3, dummy4;
+ TkWindow *winPtr;
+
+ winPtr = sourcePtr;
+ if ((winPtr == NULL) || (winPtr->window == None)) {
+ winPtr = destPtr;
+ if ((winPtr == NULL) || (winPtr->window == None)) {
+ return;
+ }
+ }
+
+ event.xcrossing.serial = LastKnownRequestProcessed(
+ winPtr->display);
+ event.xcrossing.send_event = GENERATED_EVENT_MAGIC;
+ event.xcrossing.display = winPtr->display;
+ event.xcrossing.root = RootWindow(winPtr->display,
+ winPtr->screenNum);
+ event.xcrossing.time = TkCurrentTime(winPtr->dispPtr);
+ XQueryPointer(winPtr->display, winPtr->window, &dummy1, &dummy2,
+ &event.xcrossing.x_root, &event.xcrossing.y_root,
+ &dummy3, &dummy4, &event.xcrossing.state);
+ event.xcrossing.mode = mode;
+ event.xcrossing.focus = False;
+ TkInOutEvents(&event, sourcePtr, destPtr, (leaveEvents) ? LeaveNotify : 0,
+ (enterEvents) ? EnterNotify : 0, TCL_QUEUE_MARK);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGrabDeadWindow --
+ *
+ * This procedure is invoked whenever a window is deleted, so that
+ * grab-related cleanup can be performed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various cleanups happen, such as generating events to move the
+ * pointer back to its "natural" window as if an ungrab had been
+ * done. See the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGrabDeadWindow(winPtr)
+ register TkWindow *winPtr; /* Window that is in the process
+ * of being deleted. */
+{
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ if (dispPtr->eventualGrabWinPtr == winPtr) {
+ /*
+ * Grab window was deleted. Release the grab.
+ */
+
+ Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
+ } else if (dispPtr->buttonWinPtr == winPtr) {
+ ReleaseButtonGrab(dispPtr);
+ }
+ if (dispPtr->serverWinPtr == winPtr) {
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ dispPtr->serverWinPtr = NULL;
+ } else {
+ dispPtr->serverWinPtr = winPtr->parentPtr;
+ }
+ }
+ if (dispPtr->grabWinPtr == winPtr) {
+ dispPtr->grabWinPtr = NULL;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EatGrabEvents --
+ *
+ * This procedure is called to eliminate any Enter, Leave,
+ * FocusIn, or FocusOut events in the event queue for a
+ * display that have mode NotifyGrab or NotifyUngrab and
+ * have a serial number no less than a given value and are not
+ * generated by the grab module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr's display gets sync-ed, and some of the events get
+ * removed from the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EatGrabEvents(dispPtr, serial)
+ TkDisplay *dispPtr; /* Display from which to consume events. */
+ unsigned int serial; /* Only discard events that have a serial
+ * number at least this great. */
+{
+ Tk_RestrictProc *oldProc;
+ GrabInfo info;
+ ClientData oldArg, dummy;
+
+ info.display = dispPtr->display;
+ info.serial = serial;
+ TkpSync(info.display);
+ oldProc = Tk_RestrictEvents(GrabRestrictProc, (ClientData)&info, &oldArg);
+ while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
+ }
+ Tk_RestrictEvents(oldProc, oldArg, &dummy);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrabRestrictProc --
+ *
+ * A Tk_RestrictProc used by EatGrabEvents to eliminate any
+ * Enter, Leave, FocusIn, or FocusOut events in the event queue
+ * for a display that has mode NotifyGrab or NotifyUngrab and
+ * have a serial number no less than a given value.
+ *
+ * Results:
+ * Returns either TK_DISCARD_EVENT or TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+GrabRestrictProc(arg, eventPtr)
+ ClientData arg;
+ XEvent *eventPtr;
+{
+ GrabInfo *info = (GrabInfo *) arg;
+ int mode, diff;
+
+ /*
+ * The diff caculation is trickier than it may seem. Don't forget
+ * that serial numbers can wrap around, so can't compare the two
+ * serial numbers directly.
+ */
+
+ diff = eventPtr->xany.serial - info->serial;
+ if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ mode = eventPtr->xcrossing.mode;
+ } else if ((eventPtr->type == FocusIn)
+ || (eventPtr->type == FocusOut)) {
+ mode = eventPtr->xfocus.mode;
+ } else {
+ mode = NotifyNormal;
+ }
+ if ((info->display != eventPtr->xany.display) || (mode == NotifyNormal)
+ || (diff < 0)) {
+ return TK_DEFER_EVENT;
+ } else {
+ return TK_DISCARD_EVENT;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * QueueGrabWindowChange --
+ *
+ * This procedure queues a special event in the Tcl event queue,
+ * which will cause the "grabWinPtr" field for the display to get
+ * modified when the event is processed. This is needed to make
+ * sure that the grab window changes at the proper time relative
+ * to grab-related enter and leave events that are also in the
+ * queue. In particular, this approach works even when multiple
+ * grabs and ungrabs happen back-to-back.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr->grabWinPtr will be modified later (by GrabWinEventProc)
+ * when the event is removed from the grab event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+QueueGrabWindowChange(dispPtr, grabWinPtr)
+ TkDisplay *dispPtr; /* Display on which to change the grab
+ * window. */
+ TkWindow *grabWinPtr; /* Window that is to become the new grab
+ * window (may be NULL). */
+{
+ NewGrabWinEvent *grabEvPtr;
+
+ grabEvPtr = (NewGrabWinEvent *) ckalloc(sizeof(NewGrabWinEvent));
+ grabEvPtr->header.proc = GrabWinEventProc;
+ grabEvPtr->dispPtr = dispPtr;
+ if (grabWinPtr == NULL) {
+ grabEvPtr->grabWindow = None;
+ } else {
+ grabEvPtr->grabWindow = grabWinPtr->window;
+ }
+ Tcl_QueueEvent(&grabEvPtr->header, TCL_QUEUE_MARK);
+ dispPtr->eventualGrabWinPtr = grabWinPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrabWinEventProc --
+ *
+ * This procedure is invoked as a handler for Tcl_Events of type
+ * NewGrabWinEvent. It updates the current grab window field in
+ * a display.
+ *
+ * Results:
+ * Returns 1 if the event was processed, 0 if it should be deferred
+ * for processing later.
+ *
+ * Side effects:
+ * The grabWinPtr field is modified in the display associated with
+ * the event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GrabWinEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event of type NewGrabWinEvent. */
+ int flags; /* Flags argument to Tk_DoOneEvent: indicates
+ * what kinds of events are being processed
+ * right now. */
+{
+ NewGrabWinEvent *grabEvPtr = (NewGrabWinEvent *) evPtr;
+
+ grabEvPtr->dispPtr->grabWinPtr = (TkWindow *) Tk_IdToWindow(
+ grabEvPtr->dispPtr->display, grabEvPtr->grabWindow);
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindCommonAncestor --
+ *
+ * Given two windows, this procedure finds their least common
+ * ancestor and also computes how many levels up this ancestor
+ * is from each of the original windows.
+ *
+ * Results:
+ * If the windows are in different applications or top-level
+ * windows, then NULL is returned and *countPtr1 and *countPtr2
+ * are set to the depths of the two windows in their respective
+ * top-level windows (1 means the window is a top-level, 2 means
+ * its parent is a top-level, and so on). Otherwise, the return
+ * value is a pointer to the common ancestor and the counts are
+ * set to the distance of winPtr1 and winPtr2 from this ancestor
+ * (1 means they're children, 2 means grand-children, etc.).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+FindCommonAncestor(winPtr1, winPtr2, countPtr1, countPtr2)
+ TkWindow *winPtr1; /* First window. May be NULL. */
+ TkWindow *winPtr2; /* Second window. May be NULL. */
+ int *countPtr1; /* Store nesting level of winPtr1 within
+ * common ancestor here. */
+ int *countPtr2; /* Store nesting level of winPtr2 within
+ * common ancestor here. */
+{
+ register TkWindow *winPtr;
+ TkWindow *ancestorPtr;
+ int count1, count2, i;
+
+ /*
+ * Mark winPtr1 and all of its ancestors with a special flag bit.
+ */
+
+ if (winPtr1 != NULL) {
+ for (winPtr = winPtr1; winPtr != NULL; winPtr = winPtr->parentPtr) {
+ winPtr->flags |= TK_GRAB_FLAG;
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Search upwards from winPtr2 until an ancestor of winPtr1 is
+ * found or a top-level window is reached.
+ */
+
+ winPtr = winPtr2;
+ count2 = 0;
+ ancestorPtr = NULL;
+ if (winPtr2 != NULL) {
+ for (; winPtr != NULL; count2++, winPtr = winPtr->parentPtr) {
+ if (winPtr->flags & TK_GRAB_FLAG) {
+ ancestorPtr = winPtr;
+ break;
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ count2++;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Search upwards from winPtr1 again, clearing the flag bits and
+ * remembering how many levels up we had to go.
+ */
+
+ if (winPtr1 == NULL) {
+ count1 = 0;
+ } else {
+ count1 = -1;
+ for (i = 0, winPtr = winPtr1; winPtr != NULL;
+ i++, winPtr = winPtr->parentPtr) {
+ winPtr->flags &= ~TK_GRAB_FLAG;
+ if (winPtr == ancestorPtr) {
+ count1 = i;
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ if (count1 == -1) {
+ count1 = i+1;
+ }
+ break;
+ }
+ }
+ }
+
+ *countPtr1 = count1;
+ *countPtr2 = count2;
+ return ancestorPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPositionInTree --
+ *
+ * Compute where the given window is relative to a particular
+ * subtree of the window hierarchy.
+ *
+ * Results:
+ *
+ * Returns TK_GRAB_IN_TREE if the window is contained in the
+ * subtree. Returns TK_GRAB_ANCESTOR if the window is an
+ * ancestor of the subtree, in the same toplevel. Otherwise
+ * it returns TK_GRAB_EXCLUDED.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPositionInTree(winPtr, treePtr)
+ TkWindow *winPtr; /* Window to be checked. */
+ TkWindow *treePtr; /* Root of tree to compare against. */
+{
+ TkWindow *winPtr2;
+
+ for (winPtr2 = winPtr; winPtr2 != treePtr;
+ winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == NULL) {
+ for (winPtr2 = treePtr; winPtr2 != NULL;
+ winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == winPtr) {
+ return TK_GRAB_ANCESTOR;
+ }
+ if (winPtr2->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+ return TK_GRAB_EXCLUDED;
+ }
+ }
+ return TK_GRAB_IN_TREE;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGrabState --
+ *
+ * Given a window, this procedure returns a value that indicates
+ * the grab state of the application relative to the window.
+ *
+ * Results:
+ * The return value is one of three things:
+ * TK_GRAB_NONE - no grab is in effect.
+ * TK_GRAB_IN_TREE - there is a grab in effect, and winPtr
+ * is in the grabbed subtree.
+ * TK_GRAB_ANCESTOR - there is a grab in effect; winPtr is
+ * an ancestor of the grabbed window, in
+ * the same toplevel.
+ * TK_GRAB_EXCLUDED - there is a grab in effect; winPtr is
+ * outside the tree of the grab and is not
+ * an ancestor of the grabbed window in the
+ * same toplevel.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGrabState(winPtr)
+ TkWindow *winPtr; /* Window for which grab information is
+ * needed. */
+{
+ TkWindow *grabWinPtr = winPtr->dispPtr->grabWinPtr;
+
+ if (grabWinPtr == NULL) {
+ return TK_GRAB_NONE;
+ }
+ if ((winPtr->mainPtr != grabWinPtr->mainPtr)
+ && !(winPtr->dispPtr->grabFlags & GRAB_GLOBAL)) {
+ return TK_GRAB_NONE;
+ }
+
+ return TkPositionInTree(winPtr, grabWinPtr);
+}
--- /dev/null
+/*
+ * tkGrid.c --
+ *
+ * Grid based geometry manager.
+ *
+ * Copyright (c) 1996-1997 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+
+/*
+ * Convenience Macros
+ */
+
+#ifdef MAX
+# undef MAX
+#endif
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#ifdef MIN
+# undef MIN
+#endif
+#define MIN(x,y) ((x) > (y) ? (y) : (x))
+
+#define COLUMN (1) /* working on column offsets */
+#define ROW (2) /* working on row offsets */
+
+#define CHECK_ONLY (1) /* check max slot constraint */
+#define CHECK_SPACE (2) /* alloc more space, don't change max */
+
+/*
+ * Pre-allocate enough row and column slots for "typical" sized tables
+ * this value should be chosen so by the time the extra malloc's are
+ * required, the layout calculations overwehlm them. [A "slot" contains
+ * information for either a row or column, depending upon the context.]
+ */
+
+#define TYPICAL_SIZE 25 /* (arbitrary guess) */
+#define PREALLOC 10 /* extra slots to allocate */
+
+/*
+ * Pre-allocate room for uniform groups during layout.
+ */
+
+#define UNIFORM_PREALLOC 10
+
+/*
+ * Data structures are allocated dynamically to support arbitrary sized tables.
+ * However, the space is proportional to the highest numbered slot with
+ * some non-default property. This limit is used to head off mistakes and
+ * denial of service attacks by limiting the amount of storage required.
+ */
+
+#define MAX_ELEMENT 10000
+
+/*
+ * Special characters to support relative layouts.
+ */
+
+#define REL_SKIP 'x' /* Skip this column. */
+#define REL_HORIZ '-' /* Extend previous widget horizontally. */
+#define REL_VERT '^' /* Extend widget from row above. */
+
+/*
+ * Structure to hold information for grid masters. A slot is either
+ * a row or column.
+ */
+
+typedef struct SlotInfo {
+ int minSize; /* The minimum size of this slot (in pixels).
+ * It is set via the rowconfigure or
+ * columnconfigure commands. */
+ int weight; /* The resize weight of this slot. (0) means
+ * this slot doesn't resize. Extra space in
+ * the layout is given distributed among slots
+ * inproportion to their weights. */
+ int pad; /* Extra padding, in pixels, required for
+ * this slot. This amount is "added" to the
+ * largest slave in the slot. */
+ Tk_Uid uniform; /* Value of -uniform option. It is used to
+ * group slots that should have the same
+ * size. */
+ int offset; /* This is a cached value used for
+ * introspection. It is the pixel
+ * offset of the right or bottom edge
+ * of this slot from the beginning of the
+ * layout. */
+ int temp; /* This is a temporary value used for
+ * calculating adjusted weights when
+ * shrinking the layout below its
+ * nominal size. */
+} SlotInfo;
+
+/*
+ * Structure to hold information during layout calculations. There
+ * is one of these for each slot, an array for each of the rows or columns.
+ */
+
+typedef struct GridLayout {
+ struct Gridder *binNextPtr; /* The next slave window in this bin.
+ * Each bin contains a list of all
+ * slaves whose spans are >1 and whose
+ * right edges fall in this slot. */
+ int minSize; /* Minimum size needed for this slot,
+ * in pixels. This is the space required
+ * to hold any slaves contained entirely
+ * in this slot, adjusted for any slot
+ * constrants, such as size or padding. */
+ int pad; /* Padding needed for this slot */
+ int weight; /* Slot weight, controls resizing. */
+ Tk_Uid uniform; /* Value of -uniform option. It is used to
+ * group slots that should have the same
+ * size. */
+ int minOffset; /* The minimum offset, in pixels, from
+ * the beginning of the layout to the
+ * right/bottom edge of the slot calculated
+ * from top/left to bottom/right. */
+ int maxOffset; /* The maximum offset, in pixels, from
+ * the beginning of the layout to the
+ * right-or-bottom edge of the slot calculated
+ * from bottom-or-right to top-or-left. */
+} GridLayout;
+
+/*
+ * Keep one of these for each geometry master.
+ */
+
+typedef struct {
+ SlotInfo *columnPtr; /* Pointer to array of column constraints. */
+ SlotInfo *rowPtr; /* Pointer to array of row constraints. */
+ int columnEnd; /* The last column occupied by any slave. */
+ int columnMax; /* The number of columns with constraints. */
+ int columnSpace; /* The number of slots currently allocated for
+ * column constraints. */
+ int rowEnd; /* The last row occupied by any slave. */
+ int rowMax; /* The number of rows with constraints. */
+ int rowSpace; /* The number of slots currently allocated
+ * for row constraints. */
+ int startX; /* Pixel offset of this layout within its
+ * parent. */
+ int startY; /* Pixel offset of this layout within its
+ * parent. */
+} GridMaster;
+
+/*
+ * For each window that the grid cares about (either because
+ * the window is managed by the grid or because the window
+ * has slaves that are managed by the grid), there is a
+ * structure of the following type:
+ */
+
+typedef struct Gridder {
+ Tk_Window tkwin; /* Tk token for window. NULL means that
+ * the window has been deleted, but the
+ * gridder hasn't had a chance to clean up
+ * yet because the structure is still in
+ * use. */
+ struct Gridder *masterPtr; /* Master window within which this window
+ * is managed (NULL means this window
+ * isn't managed by the gridder). */
+ struct Gridder *nextPtr; /* Next window managed within same
+ * parent. List order doesn't matter. */
+ struct Gridder *slavePtr; /* First in list of slaves managed
+ * inside this window (NULL means
+ * no grid slaves). */
+ GridMaster *masterDataPtr; /* Additional data for geometry master. */
+ int column, row; /* Location in the grid (starting
+ * from zero). */
+ int numCols, numRows; /* Number of columns or rows this slave spans.
+ * Should be at least 1. */
+ int padX, padY; /* Total additional pixels to leave around the
+ * window. Some is of this space is on each
+ * side. This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int padLeft, padTop; /* The part of padX or padY to use on the
+ * left or top of the widget, respectively.
+ * By default, this is half of padX or padY. */
+ int iPadX, iPadY; /* Total extra pixels to allocate inside the
+ * window (half this amount will appear on
+ * each side). */
+ int sticky; /* which sides of its cavity this window
+ * sticks to. See below for definitions */
+ int doubleBw; /* Twice the window's last known border
+ * width. If this changes, the window
+ * must be re-arranged within its parent. */
+ 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 tkwin or any of its slaves
+ * is deleted. */
+ int flags; /* Miscellaneous flags; see below
+ * for definitions. */
+
+ /*
+ * These fields are used temporarily for layout calculations only.
+ */
+
+ struct Gridder *binNextPtr; /* Link to next span>1 slave in this bin. */
+ int size; /* Nominal size (width or height) in pixels
+ * of the slave. This includes the padding. */
+} Gridder;
+
+/* Flag values for "sticky"ness The 16 combinations subsume the packer's
+ * notion of anchor and fill.
+ *
+ * STICK_NORTH This window sticks to the top of its cavity.
+ * STICK_EAST This window sticks to the right edge of its cavity.
+ * STICK_SOUTH This window sticks to the bottom of its cavity.
+ * STICK_WEST This window sticks to the left edge of its cavity.
+ */
+
+#define STICK_NORTH 1
+#define STICK_EAST 2
+#define STICK_SOUTH 4
+#define STICK_WEST 8
+
+
+/*
+ * Structure to gather information about uniform groups during layout.
+ */
+
+typedef struct UniformGroup {
+ Tk_Uid group;
+ int minSize;
+} UniformGroup;
+
+/*
+ * Flag values for Grid structures:
+ *
+ * REQUESTED_RELAYOUT: 1 means a Tcl_DoWhenIdle request
+ * has already been made to re-arrange
+ * all the slaves of this 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_RELAYOUT 1
+#define DONT_PROPAGATE 2
+
+/*
+ * Prototypes for procedures used only in this file:
+ */
+
+static void AdjustForSticky _ANSI_ARGS_((Gridder *slavePtr, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr));
+static int AdjustOffsets _ANSI_ARGS_((int width,
+ int elements, SlotInfo *slotPtr));
+static void ArrangeGrid _ANSI_ARGS_((ClientData clientData));
+static int CheckSlotData _ANSI_ARGS_((Gridder *masterPtr, int slot,
+ int slotType, int checkOnly));
+static int ConfigureSlaves _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[]));
+static void DestroyGrid _ANSI_ARGS_((char *memPtr));
+static Gridder *GetGrid _ANSI_ARGS_((Tk_Window tkwin));
+static int GridBboxCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridForgetRemoveCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridInfoCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridLocationCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridPropagateCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridRowColumnConfigureCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridSizeCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridSlavesCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static void GridStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void GridLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void GridReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void InitMasterData _ANSI_ARGS_((Gridder *masterPtr));
+static Tcl_Obj *NewPairObj _ANSI_ARGS_((Tcl_Interp*, int, int));
+static Tcl_Obj *NewQuadObj _ANSI_ARGS_((Tcl_Interp*, int, int, int, int));
+static int ResolveConstraints _ANSI_ARGS_((Gridder *gridPtr,
+ int rowOrColumn, int maxOffset));
+static void SetGridSize _ANSI_ARGS_((Gridder *gridPtr));
+static void StickyToString _ANSI_ARGS_((int flags, char *result));
+static int StringToSticky _ANSI_ARGS_((char *string));
+static void Unlink _ANSI_ARGS_((Gridder *gridPtr));
+
+/*
+ * Prototypes for procedures contained in other files but not exported
+ * using tkIntDecls.h
+ */
+
+void TkPrintPadAmount _ANSI_ARGS_((Tcl_Interp*, char*, int, int));
+int TkParsePadAmount _ANSI_ARGS_((Tcl_Interp*, Tk_Window, Tcl_Obj*, int*, int*));
+
+static Tk_GeomMgr gridMgrType = {
+ "grid", /* name */
+ GridReqProc, /* requestProc */
+ GridLostSlaveProc, /* lostSlaveProc */
+};
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_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
+Tk_GridObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ static CONST char *optionStrings[] = {
+ "bbox", "columnconfigure", "configure", "forget",
+ "info", "location", "propagate", "remove",
+ "rowconfigure", "size", "slaves", (char *) NULL };
+ enum options {
+ GRID_BBOX, GRID_COLUMNCONFIGURE, GRID_CONFIGURE, GRID_FORGET,
+ GRID_INFO, GRID_LOCATION, GRID_PROPAGATE, GRID_REMOVE,
+ GRID_ROWCONFIGURE, GRID_SIZE, GRID_SLAVES };
+ int index;
+
+
+ if (objc >= 2) {
+ char *argv1 = Tcl_GetString(objv[1]);
+ if ((argv1[0] == '.') || (argv1[0] == REL_SKIP) ||
+ (argv1[0] == REL_VERT)) {
+ return ConfigureSlaves(interp, tkwin, objc-1, objv+1);
+ }
+ }
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case GRID_BBOX:
+ return GridBboxCommand(tkwin, interp, objc, objv);
+ case GRID_CONFIGURE:
+ return ConfigureSlaves(interp, tkwin, objc-2, objv+2);
+ case GRID_FORGET:
+ case GRID_REMOVE:
+ return GridForgetRemoveCommand(tkwin, interp, objc, objv);
+ case GRID_INFO:
+ return GridInfoCommand(tkwin, interp, objc, objv);
+ case GRID_LOCATION:
+ return GridLocationCommand(tkwin, interp, objc, objv);
+ case GRID_PROPAGATE:
+ return GridPropagateCommand(tkwin, interp, objc, objv);
+ case GRID_SIZE:
+ return GridSizeCommand(tkwin, interp, objc, objv);
+ case GRID_SLAVES:
+ return GridSlavesCommand(tkwin, interp, objc, objv);
+
+ /*
+ * Sample argument combinations:
+ * grid columnconfigure <master> <index> -option
+ * grid columnconfigure <master> <index> -option value -option value
+ * grid rowconfigure <master> <index>
+ * grid rowconfigure <master> <index> -option
+ * grid rowconfigure <master> <index> -option value -option value.
+ */
+
+ case GRID_COLUMNCONFIGURE:
+ case GRID_ROWCONFIGURE:
+ return GridRowColumnConfigureCommand(tkwin, interp, objc, objv);
+ }
+
+ /* This should not happen */
+ Tcl_SetResult(interp, "Internal error in grid.", TCL_STATIC);
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridBboxCommand --
+ *
+ * Implementation of the [grid bbox] subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Places bounding box information in the interp's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridBboxCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* master grid record */
+ GridMaster *gridPtr; /* pointer to grid data */
+ int row, column; /* origin for bounding box */
+ int row2, column2; /* end of bounding box */
+ int endX, endY; /* last column/row in the layout */
+ int x=0, y=0; /* starting pixels for this bounding box */
+ int width, height; /* size of the bounding box */
+
+ if (objc!=3 && objc != 5 && objc != 7) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master ?column row ?column row??");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (objc >= 5) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &column) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[4], &row) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ column2 = column;
+ row2 = row;
+ }
+
+ if (objc == 7) {
+ if (Tcl_GetIntFromObj(interp, objv[5], &column2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[6], &row2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ gridPtr = masterPtr->masterDataPtr;
+ if (gridPtr == NULL) {
+ Tcl_SetObjResult(interp, NewQuadObj(interp, 0, 0, 0, 0));
+ return TCL_OK;
+ }
+
+ SetGridSize(masterPtr);
+ endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
+ endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);
+
+ if ((endX == 0) || (endY == 0)) {
+ Tcl_SetObjResult(interp, NewQuadObj(interp, 0, 0, 0, 0));
+ return TCL_OK;
+ }
+ if (objc == 3) {
+ row = column = 0;
+ row2 = endY;
+ column2 = endX;
+ }
+
+ if (column > column2) {
+ int temp = column;
+ column = column2, column2 = temp;
+ }
+ if (row > row2) {
+ int temp = row;
+ row = row2, row2 = temp;
+ }
+
+ if (column > 0 && column < endX) {
+ x = gridPtr->columnPtr[column-1].offset;
+ } else if (column > 0) {
+ x = gridPtr->columnPtr[endX-1].offset;
+ }
+
+ if (row > 0 && row < endY) {
+ y = gridPtr->rowPtr[row-1].offset;
+ } else if (row > 0) {
+ y = gridPtr->rowPtr[endY-1].offset;
+ }
+
+ if (column2 < 0) {
+ width = 0;
+ } else if (column2 >= endX) {
+ width = gridPtr->columnPtr[endX-1].offset - x;
+ } else {
+ width = gridPtr->columnPtr[column2].offset - x;
+ }
+
+ if (row2 < 0) {
+ height = 0;
+ } else if (row2 >= endY) {
+ height = gridPtr->rowPtr[endY-1].offset - y;
+ } else {
+ height = gridPtr->rowPtr[row2].offset - y;
+ }
+
+ Tcl_SetObjResult(interp, NewQuadObj(interp,
+ x + gridPtr->startX, y + gridPtr->startY, width, height));
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridForgetRemoveCommand --
+ *
+ * Implementation of the [grid forget]/[grid remove] subcommands.
+ * See the user documentation for details on what these do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Removes a window from a grid layout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridForgetRemoveCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window slave;
+ Gridder *slavePtr;
+ int i;
+ char *string = Tcl_GetString(objv[1]);
+ char c = string[0];
+
+ for (i = 2; i < objc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr != NULL) {
+
+ /*
+ * For "forget", reset all the settings to their defaults
+ */
+
+ if (c == 'f') {
+ slavePtr->column = slavePtr->row = -1;
+ slavePtr->numCols = 1;
+ slavePtr->numRows = 1;
+ slavePtr->padX = slavePtr->padY = 0;
+ slavePtr->padLeft = slavePtr->padTop = 0;
+ slavePtr->iPadX = slavePtr->iPadY = 0;
+ slavePtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ if (slavePtr->flags & REQUESTED_RELAYOUT) {
+ Tcl_CancelIdleCall(ArrangeGrid, (ClientData) slavePtr);
+ }
+ slavePtr->flags = 0;
+ slavePtr->sticky = 0;
+ }
+ Tk_ManageGeometry(slave, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridInfoCommand --
+ *
+ * Implementation of the [grid info] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts gridding information in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridInfoCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Gridder *slavePtr;
+ Tk_Window slave;
+ char buffer[64 + TCL_INTEGER_SPACE * 4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ Tcl_AppendElement(interp, "-in");
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
+ sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d",
+ slavePtr->column, slavePtr->row,
+ slavePtr->numCols, slavePtr->numRows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
+ TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY);
+ TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX);
+ TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY);
+ StickyToString(slavePtr->sticky, buffer);
+ Tcl_AppendResult(interp, " -sticky ", buffer, (char *) NULL);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridLocationCommand --
+ *
+ * Implementation of the [grid location] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts location information in the interpreter's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridLocationCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* master grid record */
+ GridMaster *gridPtr; /* pointer to grid data */
+ register SlotInfo *slotPtr;
+ int x, y; /* Offset in pixels, from edge of parent. */
+ int i, j; /* Corresponding column and row indeces. */
+ int endX, endY; /* end of grid */
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master x y");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixelsFromObj(interp, master, objv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_GetPixelsFromObj(interp, master, objv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ masterPtr = GetGrid(master);
+ if (masterPtr->masterDataPtr == NULL) {
+ Tcl_SetObjResult(interp, NewPairObj(interp, -1, -1));
+ return TCL_OK;
+ }
+ gridPtr = masterPtr->masterDataPtr;
+
+ /*
+ * Update any pending requests. This is not always the
+ * steady state value, as more configure events could be in
+ * the pipeline, but its as close as its easy to get.
+ */
+
+ while (masterPtr->flags & REQUESTED_RELAYOUT) {
+ Tcl_CancelIdleCall(ArrangeGrid, (ClientData) masterPtr);
+ ArrangeGrid ((ClientData) masterPtr);
+ }
+ SetGridSize(masterPtr);
+ endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
+ endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);
+
+ slotPtr = masterPtr->masterDataPtr->columnPtr;
+ if (x < masterPtr->masterDataPtr->startX) {
+ i = -1;
+ } else {
+ x -= masterPtr->masterDataPtr->startX;
+ for (i = 0; slotPtr[i].offset < x && i < endX; i++) {
+ /* null body */
+ }
+ }
+
+ slotPtr = masterPtr->masterDataPtr->rowPtr;
+ if (y < masterPtr->masterDataPtr->startY) {
+ j = -1;
+ } else {
+ y -= masterPtr->masterDataPtr->startY;
+ for (j = 0; slotPtr[j].offset < y && j < endY; j++) {
+ /* null body */
+ }
+ }
+
+ Tcl_SetObjResult(interp, NewPairObj(interp, i, j));
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridPropagateCommand --
+ *
+ * Implementation of the [grid propagate] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May alter geometry propagation for a widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridPropagateCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ int propagate, old;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+ if (objc == 3) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(!(masterPtr->flags & DONT_PROPAGATE)));
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &propagate) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Only request a relayout if the propagation bit changes */
+
+ old = !(masterPtr->flags & DONT_PROPAGATE);
+ if (propagate != old) {
+ if (propagate) {
+ masterPtr->flags &= ~DONT_PROPAGATE;
+ } else {
+ 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;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridRowColumnConfigureCommand --
+ *
+ * Implementation of the [grid rowconfigure] and [grid columnconfigure]
+ * subcommands. See the user documentation for details on what these
+ * do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on arguments; see user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridRowColumnConfigureCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ SlotInfo *slotPtr = NULL;
+ int slot; /* the column or row number */
+ int slotType; /* COLUMN or ROW */
+ int size; /* the configuration value */
+ int checkOnly; /* check the size only */
+ int lObjc; /* Number of items in index list */
+ Tcl_Obj **lObjv; /* array of indices */
+ int ok; /* temporary TCL result code */
+ int i, j;
+ char *string;
+ static CONST char *optionStrings[] = {
+ "-minsize", "-pad", "-uniform", "-weight", (char *) NULL };
+ enum options { ROWCOL_MINSIZE, ROWCOL_PAD, ROWCOL_UNIFORM, ROWCOL_WEIGHT };
+ int index;
+
+ if (((objc % 2 != 0) && (objc > 6)) || (objc < 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master index ?-option value...?");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objv[3], &lObjc, &lObjv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetString(objv[1]);
+ checkOnly = ((objc == 4) || (objc == 5));
+ masterPtr = GetGrid(master);
+ slotType = (*string == 'c') ? COLUMN : ROW;
+ if (checkOnly && lObjc > 1) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[3]),
+ " must be a single element.", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (j = 0; j < lObjc; j++) {
+ if (Tcl_GetIntFromObj(interp, lObjv[j], &slot) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ok = CheckSlotData(masterPtr, slot, slotType, checkOnly);
+ if ((ok != TCL_OK) && ((objc < 4) || (objc > 5))) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ",
+ Tcl_GetString(objv[1]), ": \"", Tcl_GetString(lObjv[j]),
+ "\" is out of range", (char *) NULL);
+ return TCL_ERROR;
+ } else if (ok == TCL_OK) {
+ slotPtr = (slotType == COLUMN) ?
+ masterPtr->masterDataPtr->columnPtr :
+ masterPtr->masterDataPtr->rowPtr;
+ }
+
+ /*
+ * Return all of the options for this row or column. If the
+ * request is out of range, return all 0's.
+ */
+
+ if (objc == 4) {
+ int minsize = 0, pad = 0, weight = 0;
+ Tk_Uid uniform = NULL;
+ Tcl_Obj *res = Tcl_NewListObj(0, NULL);
+
+ if (ok == TCL_OK) {
+ minsize = slotPtr[slot].minSize;
+ pad = slotPtr[slot].pad;
+ weight = slotPtr[slot].weight;
+ uniform = slotPtr[slot].uniform;
+ }
+
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-minsize", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(minsize));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-pad", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(pad));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-uniform", -1));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj(uniform == NULL ? "" : uniform, -1));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-weight", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(weight));
+ Tcl_SetObjResult(interp, res);
+ return TCL_OK;
+ }
+
+ /*
+ * Loop through each option value pair, setting the values as
+ * required. If only one option is given, with no value, the
+ * current value is returned.
+ */
+
+ for (i = 4; i < objc; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == ROWCOL_MINSIZE) {
+ if (objc == 5) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].minSize : 0));
+ } else if (Tk_GetPixelsFromObj(interp, master, objv[i+1], &size)
+ != TCL_OK) {
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].minSize = size;
+ }
+ }
+ else if (index == ROWCOL_WEIGHT) {
+ int wt;
+ if (objc == 5) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].weight : 0));
+ } else if (Tcl_GetIntFromObj(interp, objv[i+1], &wt)
+ != TCL_OK) {
+ return TCL_ERROR;
+ } else if (wt < 0) {
+ Tcl_AppendResult(interp, "invalid arg \"",
+ Tcl_GetString(objv[i]),
+ "\": should be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].weight = wt;
+ }
+ }
+ else if (index == ROWCOL_UNIFORM) {
+ if (objc == 5) {
+ Tk_Uid value;
+ value = (ok == TCL_OK) ? slotPtr[slot].uniform : "";
+ if (value == NULL) {
+ value = "";
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
+ } else {
+ slotPtr[slot].uniform = Tk_GetUid(Tcl_GetString(objv[i+1]));
+ if (slotPtr[slot].uniform != NULL &&
+ slotPtr[slot].uniform[0] == 0) {
+ slotPtr[slot].uniform = NULL;
+ }
+ }
+ }
+ else if (index == ROWCOL_PAD) {
+ if (objc == 5) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].pad : 0));
+ } else if (Tk_GetPixelsFromObj(interp, master, objv[i+1], &size)
+ != TCL_OK) {
+ return TCL_ERROR;
+ } else if (size < 0) {
+ Tcl_AppendResult(interp, "invalid arg \"",
+ Tcl_GetString(objv[i]),
+ "\": should be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].pad = size;
+ }
+ }
+ }
+ }
+
+ /*
+ * If we changed a property, re-arrange the table,
+ * and check for constraint shrinkage.
+ */
+
+ if (objc != 5) {
+ if (slotType == ROW) {
+ int last = masterPtr->masterDataPtr->rowMax - 1;
+ while ((last >= 0) && (slotPtr[last].weight == 0)
+ && (slotPtr[last].pad == 0)
+ && (slotPtr[last].minSize == 0)
+ && (slotPtr[last].uniform == NULL)) {
+ last--;
+ }
+ masterPtr->masterDataPtr->rowMax = last+1;
+ } else {
+ int last = masterPtr->masterDataPtr->columnMax - 1;
+ while ((last >= 0) && (slotPtr[last].weight == 0)
+ && (slotPtr[last].pad == 0)
+ && (slotPtr[last].minSize == 0)
+ && (slotPtr[last].uniform == NULL)) {
+ last--;
+ }
+ masterPtr->masterDataPtr->columnMax = last + 1;
+ }
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridSizeCommand --
+ *
+ * Implementation of the [grid size] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts grid size information in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridSizeCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ GridMaster *gridPtr; /* pointer to grid data */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ gridPtr = masterPtr->masterDataPtr;
+ Tcl_SetObjResult(interp, NewPairObj(interp,
+ MAX(gridPtr->columnEnd, gridPtr->columnMax),
+ MAX(gridPtr->rowEnd, gridPtr->rowMax)));
+ } else {
+ Tcl_SetObjResult(interp, NewPairObj(interp, 0, 0));
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridSlavesCommand --
+ *
+ * Implementation of the [grid slaves] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Places a list of slaves of the specified window in the
+ * interpreter's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridSlavesCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* master grid record */
+ Gridder *slavePtr;
+ int i, value;
+ int row = -1, column = -1;
+ static CONST char *optionStrings[] = {
+ "-column", "-row", (char *) NULL };
+ enum options { SLAVES_COLUMN, SLAVES_ROW };
+ int index;
+ Tcl_Obj *res;
+
+ if ((objc < 3) || ((objc % 2) == 0)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?-option value...?");
+ return TCL_ERROR;
+ }
+
+ for (i = 3; i < objc; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value < 0) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[i]),
+ " is an invalid value: should NOT be < 0",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (index == SLAVES_COLUMN) {
+ column = value;
+ } else {
+ row = value;
+ }
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ res = Tcl_NewListObj(0, NULL);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if (column>=0 && (slavePtr->column > column
+ || slavePtr->column+slavePtr->numCols-1 < column)) {
+ continue;
+ }
+ if (row>=0 && (slavePtr->row > row ||
+ slavePtr->row+slavePtr->numRows-1 < row)) {
+ continue;
+ }
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin), -1));
+ }
+ Tcl_SetObjResult(interp, res);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GridReqProc --
+ *
+ * This procedure is invoked by Tk_GeometryRequest for
+ * windows managed by the grid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to
+ * be re-arranged at the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GridReqProc(clientData, tkwin)
+ ClientData clientData; /* Grid's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ register Gridder *gridPtr = (Gridder *) clientData;
+
+ gridPtr = gridPtr->masterPtr;
+ if (gridPtr && !(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GridLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all grid-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GridLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Grid structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register Gridder *slavePtr = (Gridder *) clientData;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * AdjustOffsets --
+ *
+ * This procedure adjusts the size of the layout to fit in the
+ * space provided. If it needs more space, the extra is added
+ * according to the weights. If it needs less, the space is removed
+ * according to the weights, but at no time does the size drop below
+ * the minsize specified for that slot.
+ *
+ * Results:
+ * The initial offset of the layout,
+ * if all the weights are zero, else 0.
+ *
+ * Side effects:
+ * The slot offsets are modified to shrink the layout.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+AdjustOffsets(size, slots, slotPtr)
+ int size; /* The total layout size (in pixels). */
+ int slots; /* Number of slots. */
+ register SlotInfo *slotPtr; /* Pointer to slot array. */
+{
+ register int slot; /* Current slot. */
+ int diff; /* Extra pixels needed to add to the layout. */
+ int totalWeight = 0; /* Sum of the weights for all the slots. */
+ int weight = 0; /* Sum of the weights so far. */
+ int minSize = 0; /* Minimum possible layout size. */
+ int newDiff; /* The most pixels that can be added on
+ * the current pass. */
+
+ diff = size - slotPtr[slots-1].offset;
+
+ /*
+ * The layout is already the correct size; all done.
+ */
+
+ if (diff == 0) {
+ return(0);
+ }
+
+ /*
+ * If all the weights are zero, center the layout in its parent if
+ * there is extra space, else clip on the bottom/right.
+ */
+
+ for (slot=0; slot < slots; slot++) {
+ totalWeight += slotPtr[slot].weight;
+ }
+
+ if (totalWeight == 0 ) {
+ return(diff > 0 ? diff/2 : 0);
+ }
+
+ /*
+ * Add extra space according to the slot weights. This is done
+ * cumulatively to prevent round-off error accumulation.
+ */
+
+ if (diff > 0) {
+ for (weight=slot=0; slot < slots; slot++) {
+ weight += slotPtr[slot].weight;
+ slotPtr[slot].offset += diff * weight / totalWeight;
+ }
+ return(0);
+ }
+
+ /*
+ * The layout must shrink below its requested size. Compute the
+ * minimum possible size by looking at the slot minSizes.
+ */
+
+ for (slot=0; slot < slots; slot++) {
+ if (slotPtr[slot].weight > 0) {
+ minSize += slotPtr[slot].minSize;
+ } else if (slot > 0) {
+ minSize += slotPtr[slot].offset - slotPtr[slot-1].offset;
+ } else {
+ minSize += slotPtr[slot].offset;
+ }
+ }
+
+ /*
+ * If the requested size is less than the minimum required size,
+ * set the slot sizes to their minimum values, then clip on the
+ * bottom/right.
+ */
+
+ if (size <= minSize) {
+ int offset = 0;
+ for (slot=0; slot < slots; slot++) {
+ if (slotPtr[slot].weight > 0) {
+ offset += slotPtr[slot].minSize;
+ } else if (slot > 0) {
+ offset += slotPtr[slot].offset - slotPtr[slot-1].offset;
+ } else {
+ offset += slotPtr[slot].offset;
+ }
+ slotPtr[slot].offset = offset;
+ }
+ return(0);
+ }
+
+ /*
+ * Remove space from slots according to their weights. The weights
+ * get renormalized anytime a slot shrinks to its minimum size.
+ */
+
+ while (diff < 0) {
+
+ /*
+ * Find the total weight for the shrinkable slots.
+ */
+
+ for (totalWeight=slot=0; slot < slots; slot++) {
+ int current = (slot == 0) ? slotPtr[slot].offset :
+ slotPtr[slot].offset - slotPtr[slot-1].offset;
+ if (current > slotPtr[slot].minSize) {
+ totalWeight += slotPtr[slot].weight;
+ slotPtr[slot].temp = slotPtr[slot].weight;
+ } else {
+ slotPtr[slot].temp = 0;
+ }
+ }
+ if (totalWeight == 0) {
+ break;
+ }
+
+ /*
+ * Find the maximum amount of space we can distribute this pass.
+ */
+
+ newDiff = diff;
+ for (slot = 0; slot < slots; slot++) {
+ int current; /* current size of this slot */
+ int maxDiff; /* max diff that would cause
+ * this slot to equal its minsize */
+ if (slotPtr[slot].temp == 0) {
+ continue;
+ }
+ current = (slot == 0) ? slotPtr[slot].offset :
+ slotPtr[slot].offset - slotPtr[slot-1].offset;
+ maxDiff = totalWeight * (slotPtr[slot].minSize - current)
+ / slotPtr[slot].temp;
+ if (maxDiff > newDiff) {
+ newDiff = maxDiff;
+ }
+ }
+
+ /*
+ * Now distribute the space.
+ */
+
+ for (weight=slot=0; slot < slots; slot++) {
+ weight += slotPtr[slot].temp;
+ slotPtr[slot].offset += newDiff * weight / totalWeight;
+ }
+ diff -= newDiff;
+ }
+ return(0);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * AdjustForSticky --
+ *
+ * This procedure adjusts the size of a slave in its cavity based
+ * on its "sticky" flags.
+ *
+ * Results:
+ * The input x, y, width, and height are changed to represent the
+ * desired coordinates of the slave.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AdjustForSticky(slavePtr, xPtr, yPtr, widthPtr, heightPtr)
+ Gridder *slavePtr; /* Slave window to arrange in its cavity. */
+ int *xPtr; /* Pixel location of the left edge of the cavity. */
+ int *yPtr; /* Pixel location of the top edge of the cavity. */
+ int *widthPtr; /* Width of the cavity (in pixels). */
+ int *heightPtr; /* Height of the cavity (in pixels). */
+{
+ int diffx=0; /* Cavity width - slave width. */
+ int diffy=0; /* Cavity hight - slave height. */
+ int sticky = slavePtr->sticky;
+
+ *xPtr += slavePtr->padLeft;
+ *widthPtr -= slavePtr->padX;
+ *yPtr += slavePtr->padTop;
+ *heightPtr -= slavePtr->padY;
+
+ if (*widthPtr > (Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX)) {
+ diffx = *widthPtr - (Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX);
+ *widthPtr = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX;
+ }
+
+ if (*heightPtr > (Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY)) {
+ diffy = *heightPtr - (Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY);
+ *heightPtr = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY;
+ }
+
+ if (sticky&STICK_EAST && sticky&STICK_WEST) {
+ *widthPtr += diffx;
+ }
+ if (sticky&STICK_NORTH && sticky&STICK_SOUTH) {
+ *heightPtr += diffy;
+ }
+ if (!(sticky&STICK_WEST)) {
+ *xPtr += (sticky&STICK_EAST) ? diffx : diffx/2;
+ }
+ if (!(sticky&STICK_NORTH)) {
+ *yPtr += (sticky&STICK_SOUTH) ? diffy : diffy/2;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrangeGrid --
+ *
+ * This procedure is invoked (using the Tcl_DoWhenIdle
+ * mechanism) to re-layout a set of windows managed by
+ * the grid. It is invoked at idle time so that a
+ * series of grid 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. */
+{
+ register Gridder *masterPtr = (Gridder *) clientData;
+ register Gridder *slavePtr;
+ GridMaster *slotPtr = masterPtr->masterDataPtr;
+ int abort;
+ int width, height; /* requested size of layout, in pixels */
+ int realWidth, realHeight; /* actual size layout should take-up */
+
+ 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. Otherwise there is
+ * no way to "relinquish" control over the parent so another geometry
+ * manager can take over.
+ */
+
+ if (masterPtr->slavePtr == NULL) {
+ return;
+ }
+
+ if (masterPtr->masterDataPtr == 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;
+ Tcl_Preserve((ClientData) masterPtr);
+
+ /*
+ * Call the constraint engine to fill in the row and column offsets.
+ */
+
+ SetGridSize(masterPtr);
+ width = ResolveConstraints(masterPtr, COLUMN, 0);
+ height = ResolveConstraints(masterPtr, ROW, 0);
+ width += Tk_InternalBorderLeft(masterPtr->tkwin) +
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ height += Tk_InternalBorderTop(masterPtr->tkwin) +
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+
+ if (width < Tk_MinReqWidth(masterPtr->tkwin)) {
+ width = Tk_MinReqWidth(masterPtr->tkwin);
+ }
+ if (height < Tk_MinReqHeight(masterPtr->tkwin)) {
+ height = Tk_MinReqHeight(masterPtr->tkwin);
+ }
+
+ if (((width != Tk_ReqWidth(masterPtr->tkwin))
+ || (height != Tk_ReqHeight(masterPtr->tkwin)))
+ && !(masterPtr->flags & DONT_PROPAGATE)) {
+ Tk_GeometryRequest(masterPtr->tkwin, width, height);
+ if (width>1 && height>1) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ masterPtr->abortPtr = NULL;
+ Tcl_Release((ClientData) masterPtr);
+ return;
+ }
+
+ /*
+ * If the currently requested layout size doesn't match the parent's
+ * window size, then adjust the slot offsets according to the
+ * weights. If all of the weights are zero, center the layout in
+ * its parent. I haven't decided what to do if the parent is smaller
+ * than the requested size.
+ */
+
+ realWidth = Tk_Width(masterPtr->tkwin) -
+ Tk_InternalBorderLeft(masterPtr->tkwin) -
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ realHeight = Tk_Height(masterPtr->tkwin) -
+ Tk_InternalBorderTop(masterPtr->tkwin) -
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+ slotPtr->startX = AdjustOffsets(realWidth,
+ MAX(slotPtr->columnEnd,slotPtr->columnMax), slotPtr->columnPtr);
+ slotPtr->startY = AdjustOffsets(realHeight,
+ MAX(slotPtr->rowEnd,slotPtr->rowMax), slotPtr->rowPtr);
+ slotPtr->startX += Tk_InternalBorderLeft(masterPtr->tkwin);
+ slotPtr->startY += Tk_InternalBorderTop(masterPtr->tkwin);
+
+ /*
+ * Now adjust the actual size of the slave to its cavity by
+ * computing the cavity size, and adjusting the widget according
+ * to its stickyness.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL && !abort;
+ slavePtr = slavePtr->nextPtr) {
+ int x, y; /* top left coordinate */
+ int width, height; /* slot or slave size */
+ int col = slavePtr->column;
+ int row = slavePtr->row;
+
+ x = (col>0) ? slotPtr->columnPtr[col-1].offset : 0;
+ y = (row>0) ? slotPtr->rowPtr[row-1].offset : 0;
+
+ width = slotPtr->columnPtr[slavePtr->numCols+col-1].offset - x;
+ height = slotPtr->rowPtr[slavePtr->numRows+row-1].offset - y;
+
+ x += slotPtr->startX;
+ y += slotPtr->startY;
+
+ AdjustForSticky(slavePtr, &x, &y, &width, &height);
+
+ /*
+ * Now put the window in the proper spot. (This was taken directly
+ * from tkPack.c.) If the slave is a child of the master, then
+ * do this here. Otherwise let Tk_MaintainGeometry do the work.
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+ if (abort) {
+ break;
+ }
+
+ /*
+ * Don't map the slave if the master isn't mapped: wait
+ * until the master gets mapped later.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+ }
+
+ masterPtr->abortPtr = NULL;
+ Tcl_Release((ClientData) masterPtr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ResolveConstraints --
+ *
+ * Resolve all of the column and row boundaries. Most of
+ * the calculations are identical for rows and columns, so this procedure
+ * is called twice, once for rows, and again for columns.
+ *
+ * Results:
+ * The offset (in pixels) from the left/top edge of this layout is
+ * returned.
+ *
+ * Side effects:
+ * The slot offsets are copied into the SlotInfo structure for the
+ * geometry master.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ResolveConstraints(masterPtr, slotType, maxOffset)
+ Gridder *masterPtr; /* The geometry master for this grid. */
+ int slotType; /* Either ROW or COLUMN. */
+ int maxOffset; /* The actual maximum size of this layout
+ * in pixels, or 0 (not currently used). */
+{
+ register SlotInfo *slotPtr; /* Pointer to row/col constraints. */
+ register Gridder *slavePtr; /* List of slave windows in this grid. */
+ int constraintCount; /* Count of rows or columns that have
+ * constraints. */
+ int slotCount; /* Last occupied row or column. */
+ int gridCount; /* The larger of slotCount and constraintCount.
+ */
+ GridLayout *layoutPtr; /* Temporary layout structure. */
+ int requiredSize; /* The natural size of the grid (pixels).
+ * This is the minimum size needed to
+ * accomodate all of the slaves at their
+ * requested sizes. */
+ int offset; /* The pixel offset of the right edge of the
+ * current slot from the beginning of the
+ * layout. */
+ int slot; /* The current slot. */
+ int start; /* The first slot of a contiguous set whose
+ * constraints are not yet fully resolved. */
+ int end; /* The Last slot of a contiguous set whose
+ * constraints are not yet fully resolved. */
+ UniformGroup uniformPre[UNIFORM_PREALLOC];
+ /* Pre-allocated space for uniform groups. */
+ UniformGroup *uniformGroupPtr;
+ /* Uniform groups data. */
+ int uniformGroups; /* Number of currently used uniform groups. */
+ int uniformGroupsAlloced; /* Size of allocated space for uniform groups.
+ */
+ int weight, minSize;
+
+ /*
+ * For typical sized tables, we'll use stack space for the layout data
+ * to avoid the overhead of a malloc and free for every layout.
+ */
+
+ GridLayout layoutData[TYPICAL_SIZE + 1];
+
+ if (slotType == COLUMN) {
+ constraintCount = masterPtr->masterDataPtr->columnMax;
+ slotCount = masterPtr->masterDataPtr->columnEnd;
+ slotPtr = masterPtr->masterDataPtr->columnPtr;
+ } else {
+ constraintCount = masterPtr->masterDataPtr->rowMax;
+ slotCount = masterPtr->masterDataPtr->rowEnd;
+ slotPtr = masterPtr->masterDataPtr->rowPtr;
+ }
+
+ /*
+ * Make sure there is enough memory for the layout.
+ */
+
+ gridCount = MAX(constraintCount,slotCount);
+ if (gridCount >= TYPICAL_SIZE) {
+ layoutPtr = (GridLayout *) ckalloc(sizeof(GridLayout) * (1+gridCount));
+ } else {
+ layoutPtr = layoutData;
+ }
+
+ /*
+ * Allocate an extra layout slot to represent the left/top edge of
+ * the 0th slot to make it easier to calculate slot widths from
+ * offsets without special case code.
+ * Initialize the "dummy" slot to the left/top of the table.
+ * This slot avoids special casing the first slot.
+ */
+
+ layoutPtr->minOffset = 0;
+ layoutPtr->maxOffset = 0;
+ layoutPtr++;
+
+ /*
+ * Step 1.
+ * Copy the slot constraints into the layout structure,
+ * and initialize the rest of the fields.
+ */
+
+ for (slot=0; slot < constraintCount; slot++) {
+ layoutPtr[slot].minSize = slotPtr[slot].minSize;
+ layoutPtr[slot].weight = slotPtr[slot].weight;
+ layoutPtr[slot].uniform = slotPtr[slot].uniform;
+ layoutPtr[slot].pad = slotPtr[slot].pad;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+ for(;slot<gridCount;slot++) {
+ layoutPtr[slot].minSize = 0;
+ layoutPtr[slot].weight = 0;
+ layoutPtr[slot].uniform = NULL;
+ layoutPtr[slot].pad = 0;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+
+ /*
+ * Step 2.
+ * Slaves with a span of 1 are used to determine the minimum size of
+ * each slot. Slaves whose span is two or more slots don't
+ * contribute to the minimum size of each slot directly, but can cause
+ * slots to grow if their size exceeds the the sizes of the slots they
+ * span.
+ *
+ * Bin all slaves whose spans are > 1 by their right edges. This
+ * allows the computation on minimum and maximum possible layout
+ * sizes at each slot boundary, without the need to re-sort the slaves.
+ */
+
+ switch (slotType) {
+ case COLUMN:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ int rightEdge = slavePtr->column + slavePtr->numCols - 1;
+ slavePtr->size = Tk_ReqWidth(slavePtr->tkwin) +
+ slavePtr->padX + slavePtr->iPadX + slavePtr->doubleBw;
+ if (slavePtr->numCols > 1) {
+ slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr;
+ layoutPtr[rightEdge].binNextPtr = slavePtr;
+ } else {
+ int size = slavePtr->size + layoutPtr[rightEdge].pad;
+ if (size > layoutPtr[rightEdge].minSize) {
+ layoutPtr[rightEdge].minSize = size;
+ }
+ }
+ }
+ break;
+ case ROW:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ int rightEdge = slavePtr->row + slavePtr->numRows - 1;
+ slavePtr->size = Tk_ReqHeight(slavePtr->tkwin) +
+ slavePtr->padY + slavePtr->iPadY + slavePtr->doubleBw;
+ if (slavePtr->numRows > 1) {
+ slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr;
+ layoutPtr[rightEdge].binNextPtr = slavePtr;
+ } else {
+ int size = slavePtr->size + layoutPtr[rightEdge].pad;
+ if (size > layoutPtr[rightEdge].minSize) {
+ layoutPtr[rightEdge].minSize = size;
+ }
+ }
+ }
+ break;
+ }
+
+ /*
+ * Step 2b.
+ * Consider demands on uniform sizes.
+ */
+
+ uniformGroupPtr = uniformPre;
+ uniformGroupsAlloced = UNIFORM_PREALLOC;
+ uniformGroups = 0;
+
+ for (slot = 0; slot < gridCount; slot++) {
+ if (layoutPtr[slot].uniform != NULL) {
+ for (start = 0; start < uniformGroups; start++) {
+ if (uniformGroupPtr[start].group == layoutPtr[slot].uniform) {
+ break;
+ }
+ }
+ if (start >= uniformGroups) {
+ /*
+ * Have not seen that group before, set up data for it.
+ */
+
+ if (uniformGroups >= uniformGroupsAlloced) {
+ /*
+ * We need to allocate more space.
+ */
+
+ size_t oldSize = uniformGroupsAlloced
+ * sizeof(UniformGroup);
+ size_t newSize = (uniformGroupsAlloced + UNIFORM_PREALLOC)
+ * sizeof(UniformGroup);
+ UniformGroup *new = (UniformGroup *) ckalloc(newSize);
+ UniformGroup *old = uniformGroupPtr;
+ memcpy((VOID *) new, (VOID *) old, oldSize);
+ if (old != uniformPre) {
+ ckfree((char *) old);
+ }
+ uniformGroupPtr = new;
+ uniformGroupsAlloced += UNIFORM_PREALLOC;
+ }
+ uniformGroups++;
+ uniformGroupPtr[start].group = layoutPtr[slot].uniform;
+ uniformGroupPtr[start].minSize = 0;
+ }
+ weight = layoutPtr[slot].weight;
+ weight = weight > 0 ? weight : 1;
+ minSize = (layoutPtr[slot].minSize + weight - 1) / weight;
+ if (minSize > uniformGroupPtr[start].minSize) {
+ uniformGroupPtr[start].minSize = minSize;
+ }
+ }
+ }
+
+ /*
+ * Data has been gathered about uniform groups. Now relayout accordingly.
+ */
+
+ if (uniformGroups > 0) {
+ for (slot = 0; slot < gridCount; slot++) {
+ if (layoutPtr[slot].uniform != NULL) {
+ for (start = 0; start < uniformGroups; start++) {
+ if (uniformGroupPtr[start].group ==
+ layoutPtr[slot].uniform) {
+ weight = layoutPtr[slot].weight;
+ weight = weight > 0 ? weight : 1;
+ layoutPtr[slot].minSize =
+ uniformGroupPtr[start].minSize * weight;
+ break;
+ }
+ }
+ }
+ }
+ }
+
+ if (uniformGroupPtr != uniformPre) {
+ ckfree((char *) uniformGroupPtr);
+ }
+
+ /*
+ * Step 3.
+ * Determine the minimum slot offsets going from left to right
+ * that would fit all of the slaves. This determines the minimum
+ */
+
+ for (offset=slot=0; slot < gridCount; slot++) {
+ layoutPtr[slot].minOffset = layoutPtr[slot].minSize + offset;
+ for (slavePtr = layoutPtr[slot].binNextPtr; slavePtr != NULL;
+ slavePtr = slavePtr->binNextPtr) {
+ int span = (slotType == COLUMN) ? slavePtr->numCols : slavePtr->numRows;
+ int required = slavePtr->size + layoutPtr[slot - span].minOffset;
+ if (required > layoutPtr[slot].minOffset) {
+ layoutPtr[slot].minOffset = required;
+ }
+ }
+ offset = layoutPtr[slot].minOffset;
+ }
+
+ /*
+ * At this point, we know the minimum required size of the entire layout.
+ * It might be prudent to stop here if our "master" will resize itself
+ * to this size.
+ */
+
+ requiredSize = offset;
+ if (maxOffset > offset) {
+ offset=maxOffset;
+ }
+
+ /*
+ * Step 4.
+ * Determine the minimum slot offsets going from right to left,
+ * bounding the pixel range of each slot boundary.
+ * Pre-fill all of the right offsets with the actual size of the table;
+ * they will be reduced as required.
+ */
+
+ for (slot=0; slot < gridCount; slot++) {
+ layoutPtr[slot].maxOffset = offset;
+ }
+ for (slot=gridCount-1; slot > 0;) {
+ for (slavePtr = layoutPtr[slot].binNextPtr; slavePtr != NULL;
+ slavePtr = slavePtr->binNextPtr) {
+ int span = (slotType == COLUMN) ? slavePtr->numCols : slavePtr->numRows;
+ int require = offset - slavePtr->size;
+ int startSlot = slot - span;
+ if (startSlot >=0 && require < layoutPtr[startSlot].maxOffset) {
+ layoutPtr[startSlot].maxOffset = require;
+ }
+ }
+ offset -= layoutPtr[slot].minSize;
+ slot--;
+ if (layoutPtr[slot].maxOffset < offset) {
+ offset = layoutPtr[slot].maxOffset;
+ } else {
+ layoutPtr[slot].maxOffset = offset;
+ }
+ }
+
+ /*
+ * Step 5.
+ * At this point, each slot boundary has a range of values that
+ * will satisfy the overall layout size.
+ * Make repeated passes over the layout structure looking for
+ * spans of slot boundaries where the minOffsets are less than
+ * the maxOffsets, and adjust the offsets according to the slot
+ * weights. At each pass, at least one slot boundary will have
+ * its range of possible values fixed at a single value.
+ */
+
+ for (start=0; start < gridCount;) {
+ int totalWeight = 0; /* Sum of the weights for all of the
+ * slots in this span. */
+ int need = 0; /* The minimum space needed to layout
+ * this span. */
+ int have; /* The actual amount of space that will
+ * be taken up by this span. */
+ int weight; /* Cumulative weights of the columns in
+ * this span. */
+ int noWeights = 0; /* True if the span has no weights. */
+
+ /*
+ * Find a span by identifying ranges of slots whose edges are
+ * already constrained at fixed offsets, but whose internal
+ * slot boundaries have a range of possible positions.
+ */
+
+ if (layoutPtr[start].minOffset == layoutPtr[start].maxOffset) {
+ start++;
+ continue;
+ }
+
+ for (end=start+1; end<gridCount; end++) {
+ if (layoutPtr[end].minOffset == layoutPtr[end].maxOffset) {
+ break;
+ }
+ }
+
+ /*
+ * We found a span. Compute the total weight, minumum space required,
+ * for this span, and the actual amount of space the span should
+ * use.
+ */
+
+ for (slot=start; slot<=end; slot++) {
+ totalWeight += layoutPtr[slot].weight;
+ need += layoutPtr[slot].minSize;
+ }
+ have = layoutPtr[end].maxOffset - layoutPtr[start-1].minOffset;
+
+ /*
+ * If all the weights in the span are zero, then distribute the
+ * extra space evenly.
+ */
+
+ if (totalWeight == 0) {
+ noWeights++;
+ totalWeight = end - start + 1;
+ }
+
+ /*
+ * It might not be possible to give the span all of the space
+ * available on this pass without violating the size constraints
+ * of one or more of the internal slot boundaries.
+ * Determine the maximum amount of space that when added to the
+ * entire span, would cause a slot boundary to have its possible
+ * range reduced to one value, and reduce the amount of extra
+ * space allocated on this pass accordingly.
+ *
+ * The calculation is done cumulatively to avoid accumulating
+ * roundoff errors.
+ */
+
+ for (weight=0,slot=start; slot<end; slot++) {
+ int diff = layoutPtr[slot].maxOffset - layoutPtr[slot].minOffset;
+ weight += noWeights ? 1 : layoutPtr[slot].weight;
+ if ((noWeights || layoutPtr[slot].weight>0) &&
+ (diff*totalWeight/weight) < (have-need)) {
+ have = diff * totalWeight / weight + need;
+ }
+ }
+
+ /*
+ * Now distribute the extra space among the slots by
+ * adjusting the minSizes and minOffsets.
+ */
+
+ for (weight=0,slot=start; slot<end; slot++) {
+ weight += noWeights ? 1 : layoutPtr[slot].weight;
+ layoutPtr[slot].minOffset +=
+ (int)((double) (have-need) * weight/totalWeight + 0.5);
+ layoutPtr[slot].minSize = layoutPtr[slot].minOffset
+ - layoutPtr[slot-1].minOffset;
+ }
+ layoutPtr[slot].minSize = layoutPtr[slot].minOffset
+ - layoutPtr[slot-1].minOffset;
+
+ /*
+ * Having pushed the top/left boundaries of the slots to
+ * take up extra space, the bottom/right space is recalculated
+ * to propagate the new space allocation.
+ */
+
+ for (slot=end; slot > start; slot--) {
+ layoutPtr[slot-1].maxOffset =
+ layoutPtr[slot].maxOffset-layoutPtr[slot].minSize;
+ }
+ }
+
+
+ /*
+ * Step 6.
+ * All of the space has been apportioned; copy the
+ * layout information back into the master.
+ */
+
+ for (slot=0; slot < gridCount; slot++) {
+ slotPtr[slot].offset = layoutPtr[slot].minOffset;
+ }
+
+ --layoutPtr;
+ if (layoutPtr != layoutData) {
+ ckfree((char *)layoutPtr);
+ }
+ return requiredSize;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * GetGrid --
+ *
+ * This internal procedure is used to locate a Grid
+ * structure for a given window, creating one if one
+ * doesn't exist already.
+ *
+ * Results:
+ * The return value is a pointer to the Grid structure
+ * corresponding to tkwin.
+ *
+ * Side effects:
+ * A new grid structure may be created. If so, then
+ * a callback is set up to clean things up when the
+ * window is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Gridder *
+GetGrid(tkwin)
+ Tk_Window tkwin; /* Token for window for which
+ * grid structure is desired. */
+{
+ register Gridder *gridPtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->gridInit) {
+ Tcl_InitHashTable(&dispPtr->gridHashTable, TCL_ONE_WORD_KEYS);
+ dispPtr->gridInit = 1;
+ }
+
+ /*
+ * See if there's already grid for this window. If not,
+ * then create a new one.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->gridHashTable, (char *) tkwin, &new);
+ if (!new) {
+ return (Gridder *) Tcl_GetHashValue(hPtr);
+ }
+ gridPtr = (Gridder *) ckalloc(sizeof(Gridder));
+ gridPtr->tkwin = tkwin;
+ gridPtr->masterPtr = NULL;
+ gridPtr->masterDataPtr = NULL;
+ gridPtr->nextPtr = NULL;
+ gridPtr->slavePtr = NULL;
+ gridPtr->binNextPtr = NULL;
+
+ gridPtr->column = gridPtr->row = -1;
+ gridPtr->numCols = 1;
+ gridPtr->numRows = 1;
+
+ gridPtr->padX = gridPtr->padY = 0;
+ gridPtr->padLeft = gridPtr->padTop = 0;
+ gridPtr->iPadX = gridPtr->iPadY = 0;
+ gridPtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ gridPtr->abortPtr = NULL;
+ gridPtr->flags = 0;
+ gridPtr->sticky = 0;
+ gridPtr->size = 0;
+ gridPtr->masterDataPtr = NULL;
+ Tcl_SetHashValue(hPtr, gridPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ GridStructureProc, (ClientData) gridPtr);
+ return gridPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * SetGridSize --
+ *
+ * This internal procedure sets the size of the grid occupied
+ * by slaves.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * The width and height arguments are filled in the master data structure.
+ * Additional space is allocated for the constraints to accomodate
+ * the offsets.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SetGridSize(masterPtr)
+ Gridder *masterPtr; /* The geometry master for this grid. */
+{
+ register Gridder *slavePtr; /* Current slave window. */
+ int maxX = 0, maxY = 0;
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ maxX = MAX(maxX,slavePtr->numCols + slavePtr->column);
+ maxY = MAX(maxY,slavePtr->numRows + slavePtr->row);
+ }
+ masterPtr->masterDataPtr->columnEnd = maxX;
+ masterPtr->masterDataPtr->rowEnd = maxY;
+ CheckSlotData(masterPtr, maxX, COLUMN, CHECK_SPACE);
+ CheckSlotData(masterPtr, maxY, ROW, CHECK_SPACE);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * CheckSlotData --
+ *
+ * This internal procedure is used to manage the storage for
+ * row and column (slot) constraints.
+ *
+ * Results:
+ * TRUE if the index is OK, False otherwise.
+ *
+ * Side effects:
+ * A new master grid structure may be created. If so, then
+ * it is initialized. In addition, additional storage for
+ * a row or column constraints may be allocated, and the constraint
+ * maximums are adjusted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CheckSlotData(masterPtr, slot, slotType, checkOnly)
+ Gridder *masterPtr; /* the geometry master for this grid */
+ int slot; /* which slot to look at */
+ int slotType; /* ROW or COLUMN */
+ int checkOnly; /* don't allocate new space if true */
+{
+ int numSlot; /* number of slots already allocated (Space) */
+ int end; /* last used constraint */
+
+ /*
+ * If slot is out of bounds, return immediately.
+ */
+
+ if (slot < 0 || slot >= MAX_ELEMENT) {
+ return TCL_ERROR;
+ }
+
+ if ((checkOnly == CHECK_ONLY) && (masterPtr->masterDataPtr == NULL)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If we need to allocate more space, allocate a little extra to avoid
+ * repeated re-alloc's for large tables. We need enough space to
+ * hold all of the offsets as well.
+ */
+
+ InitMasterData(masterPtr);
+ end = (slotType == ROW) ? masterPtr->masterDataPtr->rowMax :
+ masterPtr->masterDataPtr->columnMax;
+ if (checkOnly == CHECK_ONLY) {
+ return (end < slot) ? TCL_ERROR : TCL_OK;
+ } else {
+ numSlot = (slotType == ROW) ? masterPtr->masterDataPtr->rowSpace
+ : masterPtr->masterDataPtr->columnSpace;
+ if (slot >= numSlot) {
+ int newNumSlot = slot + PREALLOC ;
+ size_t oldSize = numSlot * sizeof(SlotInfo) ;
+ size_t newSize = newNumSlot * sizeof(SlotInfo) ;
+ SlotInfo *new = (SlotInfo *) ckalloc(newSize);
+ SlotInfo *old = (slotType == ROW) ?
+ masterPtr->masterDataPtr->rowPtr :
+ masterPtr->masterDataPtr->columnPtr;
+ memcpy((VOID *) new, (VOID *) old, oldSize );
+ memset((VOID *) (new+numSlot), 0, newSize - oldSize );
+ ckfree((char *) old);
+ if (slotType == ROW) {
+ masterPtr->masterDataPtr->rowPtr = new ;
+ masterPtr->masterDataPtr->rowSpace = newNumSlot ;
+ } else {
+ masterPtr->masterDataPtr->columnPtr = new;
+ masterPtr->masterDataPtr->columnSpace = newNumSlot ;
+ }
+ }
+ if (slot >= end && checkOnly != CHECK_SPACE) {
+ if (slotType == ROW) {
+ masterPtr->masterDataPtr->rowMax = slot+1;
+ } else {
+ masterPtr->masterDataPtr->columnMax = slot+1;
+ }
+ }
+ return TCL_OK;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * InitMasterData --
+ *
+ * This internal procedure is used to allocate and initialize
+ * the data for a geometry master, if the data
+ * doesn't exist already.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * A new master grid structure may be created. If so, then
+ * it is initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitMasterData(masterPtr)
+ Gridder *masterPtr;
+{
+ size_t size;
+ if (masterPtr->masterDataPtr == NULL) {
+ GridMaster *gridPtr = masterPtr->masterDataPtr =
+ (GridMaster *) ckalloc(sizeof(GridMaster));
+ size = sizeof(SlotInfo) * TYPICAL_SIZE;
+
+ gridPtr->columnEnd = 0;
+ gridPtr->columnMax = 0;
+ gridPtr->columnPtr = (SlotInfo *) ckalloc(size);
+ gridPtr->columnSpace = TYPICAL_SIZE;
+ gridPtr->rowEnd = 0;
+ gridPtr->rowMax = 0;
+ gridPtr->rowPtr = (SlotInfo *) ckalloc(size);
+ gridPtr->rowSpace = TYPICAL_SIZE;
+ gridPtr->startX = 0;
+ gridPtr->startY = 0;
+
+ memset((VOID *) gridPtr->columnPtr, 0, size);
+ memset((VOID *) gridPtr->rowPtr, 0, size);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a grid from its parent's list of slaves.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The parent will be scheduled for re-arranging, and the size of the
+ * grid will be adjusted accordingly
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(slavePtr)
+ register Gridder *slavePtr; /* Window to unlink. */
+{
+ register Gridder *masterPtr, *slavePtr2;
+ GridMaster *gridPtr; /* pointer to grid data */
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+
+ gridPtr = masterPtr->masterDataPtr;
+ if (masterPtr->slavePtr == slavePtr) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ }
+ else {
+ for (slavePtr2 = masterPtr->slavePtr; ; slavePtr2 = slavePtr2->nextPtr) {
+ if (slavePtr2 == NULL) {
+ panic("Unlink couldn't find previous window");
+ }
+ if (slavePtr2->nextPtr == slavePtr) {
+ slavePtr2->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+
+ if ((slavePtr->numCols+slavePtr->column == gridPtr->columnMax)
+ || (slavePtr->numRows+slavePtr->row == gridPtr->rowMax)) {
+ }
+ slavePtr->masterPtr = NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyGrid --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a grid at a safe time
+ * (when no-one is using it anymore). Cleaning up the grid involves
+ * freeing the main structure for all windows. and the master structure
+ * for geometry managers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the grid is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyGrid(memPtr)
+ char *memPtr; /* Info about window that is now dead. */
+{
+ register Gridder *gridPtr = (Gridder *) memPtr;
+
+ if (gridPtr->masterDataPtr != NULL) {
+ if (gridPtr->masterDataPtr->rowPtr != NULL) {
+ ckfree((char *) gridPtr->masterDataPtr -> rowPtr);
+ }
+ if (gridPtr->masterDataPtr->columnPtr != NULL) {
+ ckfree((char *) gridPtr->masterDataPtr -> columnPtr);
+ }
+ ckfree((char *) gridPtr->masterDataPtr);
+ }
+ ckfree((char *) gridPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response
+ * to StructureNotify events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a window was just deleted, clean up all its grid-related
+ * information. If it was just resized, re-configure its slaves, if
+ * any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GridStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Our information about window
+ * referred to by eventPtr. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register Gridder *gridPtr = (Gridder *) clientData;
+ TkDisplay *dispPtr = ((TkWindow *) gridPtr->tkwin)->dispPtr;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+ if (gridPtr->doubleBw != 2*Tk_Changes(gridPtr->tkwin)->border_width) {
+ if ((gridPtr->masterPtr != NULL) &&
+ !(gridPtr->masterPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->doubleBw = 2*Tk_Changes(gridPtr->tkwin)->border_width;
+ gridPtr->masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr->masterPtr);
+ }
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ register Gridder *gridPtr2, *nextPtr;
+
+ if (gridPtr->masterPtr != NULL) {
+ Unlink(gridPtr);
+ }
+ for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
+ gridPtr2 = nextPtr) {
+ Tk_UnmapWindow(gridPtr2->tkwin);
+ gridPtr2->masterPtr = NULL;
+ nextPtr = gridPtr2->nextPtr;
+ gridPtr2->nextPtr = NULL;
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->gridHashTable,
+ (char *) gridPtr->tkwin));
+ if (gridPtr->flags & REQUESTED_RELAYOUT) {
+ Tcl_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr);
+ }
+ gridPtr->tkwin = NULL;
+ Tcl_EventuallyFree((ClientData) gridPtr, DestroyGrid);
+ } else if (eventPtr->type == MapNotify) {
+ if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ register Gridder *gridPtr2;
+
+ for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
+ gridPtr2 = gridPtr2->nextPtr) {
+ Tk_UnmapWindow(gridPtr2->tkwin);
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * This implements the guts of the "grid configure" command. Given
+ * a list of slaves and configuration options, it arranges for the
+ * grid to manage the slaves and sets the specified options.
+ * arguments consist of windows or window shortcuts followed by
+ * "-option value" pairs.
+ *
+ * Results:
+ * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is
+ * returned and the interp's result is set to contain an error message.
+ *
+ * Side effects:
+ * Slave windows get taken over by the grid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(interp, tkwin, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int objc; /* Number of elements in argv. */
+ Tcl_Obj *CONST objv[]; /* Argument objects: 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. */
+{
+ Gridder *masterPtr;
+ Gridder *slavePtr;
+ Tk_Window other, slave, parent, ancestor;
+ int i, j, tmp;
+ int length;
+ int numWindows;
+ int width;
+ int defaultColumn = 0; /* default column number */
+ int defaultColumnSpan = 1; /* default number of columns */
+ char *lastWindow; /* use this window to base current
+ * Row/col on */
+ int numSkip; /* number of 'x' found */
+ static CONST char *optionStrings[] = {
+ "-column", "-columnspan", "-in", "-ipadx", "-ipady",
+ "-padx", "-pady", "-row", "-rowspan", "-sticky",
+ (char *) NULL };
+ enum options {
+ CONF_COLUMN, CONF_COLUMNSPAN, CONF_IN, CONF_IPADX, CONF_IPADY,
+ CONF_PADX, CONF_PADY, CONF_ROW, CONF_ROWSPAN, CONF_STICKY };
+ int index;
+ char *string;
+ char firstChar, prevChar;
+
+ /*
+ * Count the number of windows, or window short-cuts.
+ */
+
+ firstChar = 0;
+ for (numWindows = i = 0; i < objc; i++) {
+ prevChar = firstChar;
+ string = Tcl_GetStringFromObj(objv[i], (int *) &length);
+ firstChar = string[0];
+
+ if (firstChar == '.') {
+ numWindows++;
+ continue;
+ }
+ if (length > 1 && i == 0) {
+ Tcl_AppendResult(interp, "bad argument \"", string,
+ "\": must be name of window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (length > 1 && firstChar == '-') {
+ break;
+ }
+ if (length > 1) {
+ Tcl_AppendResult(interp, "unexpected parameter, \"",
+ string, "\", in configure list. ",
+ "Should be window name or option", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_HORIZ) && ((numWindows == 0) ||
+ (prevChar == REL_SKIP) || (prevChar == REL_VERT))) {
+ Tcl_AppendResult(interp,
+ "Must specify window before shortcut '-'.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_VERT) || (firstChar == REL_SKIP)
+ || (firstChar == REL_HORIZ)) {
+ continue;
+ }
+
+ Tcl_AppendResult(interp, "invalid window shortcut, \"",
+ string, "\" should be '-', 'x', or '^'", (char *) NULL);
+ return TCL_ERROR;
+ }
+ numWindows = i;
+
+ if ((objc - numWindows) & 1) {
+ Tcl_AppendResult(interp, "extra option or",
+ " option with no value", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Iterate over all of the slave windows and short-cuts, parsing
+ * 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;
+ for (j = 0; j < numWindows; j++) {
+ string = Tcl_GetString(objv[j]);
+ firstChar = string[0];
+
+ /*
+ * '^' and 'x' cause us to skip a column. '-' is processed
+ * as part of its preceeding slave.
+ */
+
+ if ((firstChar == REL_VERT) || (firstChar == REL_SKIP)) {
+ defaultColumn++;
+ continue;
+ }
+ if (firstChar == REL_HORIZ) {
+ continue;
+ }
+
+ for (defaultColumnSpan = 1; j + defaultColumnSpan < numWindows;
+ defaultColumnSpan++) {
+ char *string = Tcl_GetString(objv[j + defaultColumnSpan]);
+ if (*string != REL_HORIZ) {
+ break;
+ }
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[j], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_TopWinHierarchy(slave)) {
+ Tcl_AppendResult(interp, "can't manage \"", Tcl_GetString(objv[j]),
+ "\": it's a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(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 [D.S.] 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 the
+ * defaults can be reestablished by hand, without having to worry
+ * about keeping track of the old state.
+ */
+
+ for (i = numWindows; i < objc; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == CONF_COLUMN) {
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK ||
+ tmp < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad column value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a non-negative integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->column = tmp;
+ } else if (index == CONF_COLUMNSPAN) {
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK ||
+ tmp <= 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad columnspan value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a positive integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->numCols = tmp;
+ } else if (index == CONF_IN) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other) !=
+ TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (other == slave) {
+ Tcl_SetResult(interp, "Window can't be managed in itself",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(other);
+ InitMasterData(masterPtr);
+ } else if (index == CONF_IPADX) {
+ if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp)
+ != TCL_OK)
+ || (tmp < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipadx value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp*2;
+ } else if (index == CONF_IPADY) {
+ if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp)
+ != TCL_OK)
+ || (tmp < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipady value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadY = tmp*2;
+ } else if (index == CONF_PADX) {
+ if (TkParsePadAmount(interp, tkwin, objv[i+1],
+ &slavePtr->padLeft, &slavePtr->padX) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if (index == CONF_PADY) {
+ if (TkParsePadAmount(interp, tkwin, objv[i+1],
+ &slavePtr->padTop, &slavePtr->padY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if (index == CONF_ROW) {
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK
+ || tmp < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad grid value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a non-negative integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->row = tmp;
+ } else if (index == CONF_ROWSPAN) {
+ if ((Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK)
+ || tmp <= 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad rowspan value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a positive integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->numRows = tmp;
+ } else if (index == CONF_STICKY) {
+ int sticky = StringToSticky(Tcl_GetString(objv[i+1]));
+ if (sticky == -1) {
+ Tcl_AppendResult(interp, "bad stickyness value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a string containing n, e, s, and/or w",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->sticky = sticky;
+ }
+ }
+
+ /*
+ * Make sure we have a geometry master. We look at:
+ * 1) the -in flag
+ * 2) the geometry master of the first slave (if specified)
+ * 3) the parent of the first slave.
+ */
+
+ if (masterPtr == NULL) {
+ masterPtr = slavePtr->masterPtr;
+ }
+ parent = Tk_Parent(slave);
+ if (masterPtr == NULL) {
+ masterPtr = GetGrid(parent);
+ InitMasterData(masterPtr);
+ }
+
+ if (slavePtr->masterPtr != NULL && slavePtr->masterPtr != masterPtr) {
+ Unlink(slavePtr);
+ slavePtr->masterPtr = NULL;
+ }
+
+ if (slavePtr->masterPtr == NULL) {
+ Gridder *tempPtr = masterPtr->slavePtr;
+ slavePtr->masterPtr = masterPtr;
+ masterPtr->slavePtr = slavePtr;
+ slavePtr->nextPtr = tempPtr;
+ }
+
+ /*
+ * Make sure that the slave's parent is either the master or
+ * an ancestor of the master, and that the master and slave
+ * aren't the same.
+ */
+
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_TopWinHierarchy(ancestor)) {
+ Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]),
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Try to make sure our master isn't managed by us.
+ */
+
+ if (masterPtr->masterPtr == slavePtr) {
+ Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]),
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ ", would cause management loop.",
+ (char *) NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+
+ Tk_ManageGeometry(slave, &gridMgrType, (ClientData) slavePtr);
+
+ /*
+ * Assign default position information.
+ */
+
+ if (slavePtr->column == -1) {
+ slavePtr->column = defaultColumn;
+ }
+ slavePtr->numCols += defaultColumnSpan - 1;
+ if (slavePtr->row == -1) {
+ if (masterPtr->masterDataPtr == NULL) {
+ slavePtr->row = 0;
+ } else {
+ slavePtr->row = masterPtr->masterDataPtr->rowEnd;
+ }
+ }
+ defaultColumn += slavePtr->numCols;
+ defaultColumnSpan = 1;
+
+ /*
+ * Arrange for the parent to be re-arranged at the first
+ * idle moment.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+
+ /* Now look for all the "^"'s. */
+
+ lastWindow = NULL;
+ numSkip = 0;
+ for (j = 0; j < numWindows; j++) {
+ struct Gridder *otherPtr;
+ int match; /* found a match for the ^ */
+ int lastRow, lastColumn; /* implied end of table */
+
+ string = Tcl_GetString(objv[j]);
+ firstChar = string[0];
+
+ if (firstChar == '.') {
+ lastWindow = string;
+ numSkip = 0;
+ }
+ if (firstChar == REL_SKIP) {
+ numSkip++;
+ }
+ if (firstChar != REL_VERT) {
+ continue;
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_AppendResult(interp, "can't use '^', cant find master",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Count the number of consecutive ^'s starting from this position */
+ for (width = 1; width + j < numWindows; width++) {
+ char *string = Tcl_GetString(objv[j+width]);
+ if (*string != REL_VERT) break;
+ }
+
+ /*
+ * Find the implied grid location of the ^
+ */
+
+ if (lastWindow == NULL) {
+ if (masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ lastRow = masterPtr->masterDataPtr->rowEnd - 2;
+ } else {
+ lastRow = 0;
+ }
+ lastColumn = 0;
+ } else {
+ other = Tk_NameToWindow(interp, lastWindow, tkwin);
+ otherPtr = GetGrid(other);
+ lastRow = otherPtr->row + otherPtr->numRows - 2;
+ lastColumn = otherPtr->column + otherPtr->numCols;
+ }
+
+ lastColumn += numSkip;
+
+ for (match=0, slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+
+ if (slavePtr->column == lastColumn
+ && slavePtr->row + slavePtr->numRows - 1 == lastRow) {
+ if (slavePtr->numCols <= width) {
+ slavePtr->numRows++;
+ match++;
+ j += slavePtr->numCols - 1;
+ lastWindow = Tk_PathName(slavePtr->tkwin);
+ numSkip = 0;
+ break;
+ }
+ }
+ }
+ if (!match) {
+ Tcl_AppendResult(interp, "can't find slave to extend with \"^\".",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_AppendResult(interp, "can't determine master window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ SetGridSize(masterPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * StickyToString
+ *
+ * Converts the internal boolean combination of "sticky" bits onto
+ * a TCL list element containing zero or mor of n, s, e, or w.
+ *
+ * Results:
+ * A string is placed into the "result" pointer.
+ *
+ * Side effects:
+ * none.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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,"{}");
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringToSticky --
+ *
+ * Converts an ascii string representing a widgets stickyness
+ * into the boolean result.
+ *
+ * Results:
+ * The boolean combination of the "sticky" bits is retuned. If an
+ * error occurs, such as an invalid character, -1 is returned instead.
+ *
+ * Side effects:
+ * none
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewPairObj --
+ *
+ * Creates a new list object and fills it with two integer objects.
+ *
+ * Results:
+ * The newly created list object is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewPairObj(interp, val1, val2)
+ Tcl_Interp *interp; /* Current interpreter. */
+ int val1, val2;
+{
+ Tcl_Obj *res = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val2));
+ return res;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewQuadObj --
+ *
+ * Creates a new list object and fills it with four integer objects.
+ *
+ * Results:
+ * The newly created list object is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewQuadObj(interp, val1, val2, val3, val4)
+ Tcl_Interp *interp; /* Current interpreter. */
+ int val1, val2, val3, val4;
+{
+ Tcl_Obj *res = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val2));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val3));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val4));
+ return res;
+}
--- /dev/null
+/*
+ * tkImage.c --
+ *
+ * This module implements the image protocol, which allows lots
+ * of different kinds of images to be used in lots of different
+ * widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * Each call to Tk_GetImage returns a pointer to one of the following
+ * structures, which is used as a token by clients (widgets) that
+ * display images.
+ */
+
+typedef struct Image {
+ Tk_Window tkwin; /* Window passed to Tk_GetImage (needed to
+ * "re-get" the image later if the manager
+ * changes). */
+ Display *display; /* Display for tkwin. Needed because when
+ * the image is eventually freed tkwin may
+ * not exist anymore. */
+ struct ImageMaster *masterPtr;
+ /* Master for this image (identifiers image
+ * manager, for example). */
+ ClientData instanceData;
+ /* One word argument to pass to image manager
+ * when dealing with this image instance. */
+ Tk_ImageChangedProc *changeProc;
+ /* Code in widget to call when image changes
+ * in a way that affects redisplay. */
+ ClientData widgetClientData;
+ /* Argument to pass to changeProc. */
+ struct Image *nextPtr; /* Next in list of all image instances
+ * associated with the same name. */
+
+} Image;
+
+/*
+ * For each image master there is one of the following structures,
+ * which represents a name in the image table and all of the images
+ * instantiated from it. Entries in mainPtr->imageTable point to
+ * these structures.
+ */
+
+typedef struct ImageMaster {
+ Tk_ImageType *typePtr; /* Information about image type. NULL means
+ * that no image manager owns this image: the
+ * image was deleted. */
+ ClientData masterData; /* One-word argument to pass to image mgr
+ * when dealing with the master, as opposed
+ * to instances. */
+ int width, height; /* Last known dimensions for image. */
+ Tcl_HashTable *tablePtr; /* Pointer to hash table containing image
+ * (the imageTable field in some TkMainInfo
+ * structure). */
+ Tcl_HashEntry *hPtr; /* Hash entry in mainPtr->imageTable for
+ * this structure (used to delete the hash
+ * entry). */
+ Image *instancePtr; /* Pointer to first in list of instances
+ * derived from this name. */
+ int deleted; /* Flag set when image is being deleted. */
+ TkWindow *winPtr; /* Main window of interpreter (used to
+ * detect when the world is falling apart.) */
+} ImageMaster;
+
+typedef struct ThreadSpecificData {
+ Tk_ImageType *imageTypeList;/* First in a list of all known image
+ * types. */
+ Tk_ImageType *oldImageTypeList;/* First in a list of all known old-style image
+ * types. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for local procedures:
+ */
+
+static void DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));
+static void EventuallyDeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateOldImageType, Tk_CreateImageType --
+ *
+ * This procedure is invoked by an image manager to tell Tk about
+ * a new kind of image and the procedures that manage the new type.
+ * The procedure is typically invoked during Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image type is entered into a table used in the "image
+ * create" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreateOldImageType(typePtr)
+ Tk_ImageType *typePtr; /* Structure describing the type. All of
+ * the fields except "nextPtr" must be filled
+ * in by caller. Must not have been passed
+ * to Tk_CreateImageType previously. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ typePtr->nextPtr = tsdPtr->oldImageTypeList;
+ tsdPtr->oldImageTypeList = typePtr;
+}
+
+void
+Tk_CreateImageType(typePtr)
+ Tk_ImageType *typePtr; /* Structure describing the type. All of
+ * the fields except "nextPtr" must be filled
+ * in by caller. Must not have been passed
+ * to Tk_CreateImageType previously. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ typePtr->nextPtr = tsdPtr->imageTypeList;
+ tsdPtr->imageTypeList = typePtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ImageObjCmd --
+ *
+ * This procedure is invoked to process the "image" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ImageObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ static CONST char *imageOptions[] = {
+ "create", "delete", "height", "inuse", "names", "type", "types",
+ "width", (char *) NULL
+ };
+ enum options {
+ IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_INUSE, IMAGE_NAMES,
+ IMAGE_TYPE, IMAGE_TYPES, IMAGE_WIDTH
+ };
+ TkWindow *winPtr = (TkWindow *) clientData;
+ int i, new, firstOption, index;
+ Tk_ImageType *typePtr;
+ ImageMaster *masterPtr;
+ Image *imagePtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ char idString[16 + TCL_INTEGER_SPACE], *name;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], imageOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case IMAGE_CREATE: {
+ char *arg;
+ Tcl_Obj **args;
+ int oldimage = 0;
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type ?name? ?options?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the image type.
+ */
+
+ arg = Tcl_GetString(objv[2]);
+ for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ if ((*arg == typePtr->name[0])
+ && (strcmp(arg, typePtr->name) == 0)) {
+ break;
+ }
+ }
+ if (typePtr == NULL) {
+ oldimage = 1;
+ for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ if ((*arg == typePtr->name[0])
+ && (strcmp(arg, typePtr->name) == 0)) {
+ break;
+ }
+ }
+ }
+ if (typePtr == NULL) {
+ Tcl_AppendResult(interp, "image type \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Figure out a name to use for the new image.
+ */
+
+ if ((objc == 3) || (*(arg = Tcl_GetString(objv[3])) == '-')) {
+ dispPtr->imageId++;
+ sprintf(idString, "image%d", dispPtr->imageId);
+ name = idString;
+ firstOption = 3;
+ } else {
+ name = arg;
+ firstOption = 4;
+ }
+
+ /*
+ * Create the data structure for the new image.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->mainPtr->imageTable,
+ name, &new);
+ if (new) {
+ masterPtr = (ImageMaster *) ckalloc(sizeof(ImageMaster));
+ masterPtr->typePtr = NULL;
+ masterPtr->masterData = NULL;
+ masterPtr->width = masterPtr->height = 1;
+ masterPtr->tablePtr = &winPtr->mainPtr->imageTable;
+ masterPtr->hPtr = hPtr;
+ masterPtr->instancePtr = NULL;
+ masterPtr->deleted = 0;
+ masterPtr->winPtr = winPtr->mainPtr->winPtr;
+ Tcl_Preserve((ClientData) masterPtr->winPtr);
+ Tcl_SetHashValue(hPtr, masterPtr);
+ } else {
+ /*
+ * An image already exists by this name. Disconnect the
+ * instances from the master.
+ */
+
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*masterPtr->typePtr->freeProc)(
+ imagePtr->instanceData, imagePtr->display);
+ (*imagePtr->changeProc)(imagePtr->widgetClientData,
+ 0, 0, masterPtr->width, masterPtr->height,
+ masterPtr->width, masterPtr->height);
+ }
+ (*masterPtr->typePtr->deleteProc)(masterPtr->masterData);
+ masterPtr->typePtr = NULL;
+ }
+ }
+
+ /*
+ * Call the image type manager so that it can perform its own
+ * initialization, then re-"get" for any existing instances of
+ * the image.
+ */
+
+ objv += firstOption;
+ objc -= firstOption;
+ args = (Tcl_Obj **) objv;
+ if (oldimage) {
+ int i;
+ args = (Tcl_Obj **) ckalloc((objc+1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ args[i] = (Tcl_Obj *) Tcl_GetString(objv[i]);
+ }
+ args[objc] = NULL;
+ }
+ Tcl_Preserve((ClientData) masterPtr);
+ if ((*typePtr->createProc)(interp, name, objc,
+ args, typePtr, (Tk_ImageMaster) masterPtr,
+ &masterPtr->masterData) != TCL_OK) {
+ EventuallyDeleteImage(masterPtr);
+ Tcl_Release((ClientData) masterPtr);
+ if (oldimage) {
+ ckfree((char *) args);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_Release((ClientData) masterPtr);
+ if (oldimage) {
+ ckfree((char *) args);
+ }
+ masterPtr->typePtr = typePtr;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ imagePtr->instanceData = (*typePtr->getProc)(
+ imagePtr->tkwin, masterPtr->masterData);
+ }
+ Tcl_SetResult(interp,
+ Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr),
+ TCL_STATIC);
+ break;
+ }
+ case IMAGE_DELETE: {
+ for (i = 2; i < objc; i++) {
+ char *arg = Tcl_GetString(objv[i]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ DeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr));
+ }
+ break;
+ }
+ case IMAGE_HEIGHT: {
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->height);
+ break;
+ }
+
+ case IMAGE_INUSE: {
+ int count = 0;
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL && masterPtr->instancePtr != NULL) {
+ count = 1;
+ }
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), count);
+ break;
+ }
+
+ case IMAGE_NAMES: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(
+ &winPtr->mainPtr->imageTable, hPtr));
+ }
+ break;
+ }
+
+ case IMAGE_TYPE: {
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL) {
+ Tcl_SetResult(interp, masterPtr->typePtr->name, TCL_STATIC);
+ }
+ break;
+ }
+ case IMAGE_TYPES: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ Tcl_AppendElement(interp, typePtr->name);
+ }
+ for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ Tcl_AppendElement(interp, typePtr->name);
+ }
+ break;
+ }
+ case IMAGE_WIDTH: {
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->width);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ImageChanged --
+ *
+ * This procedure is called by an image manager whenever something
+ * has happened that requires the image to be redrawn (some of its
+ * pixels have changed, or its size has changed).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any widgets that display the image are notified so that they
+ * can redisplay themselves as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_ImageChanged(imageMaster, x, y, width, height, imageWidth,
+ imageHeight)
+ Tk_ImageMaster imageMaster; /* Image that needs redisplay. */
+ int x, y; /* Coordinates of upper-left pixel of
+ * region of image that needs to be
+ * redrawn. */
+ int width, height; /* Dimensions (in pixels) of region of
+ * image to redraw. If either dimension
+ * is zero then the image doesn't need to
+ * be redrawn (perhaps all that happened is
+ * that its size changed). */
+ int imageWidth, imageHeight;/* New dimensions of image. */
+{
+ ImageMaster *masterPtr = (ImageMaster *) imageMaster;
+ Image *imagePtr;
+
+ masterPtr->width = imageWidth;
+ masterPtr->height = imageHeight;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*imagePtr->changeProc)(imagePtr->widgetClientData, x, y,
+ width, height, imageWidth, imageHeight);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_NameOfImage --
+ *
+ * Given a token for an image master, this procedure returns
+ * the name of the image.
+ *
+ * Results:
+ * The return value is the string name for imageMaster.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfImage(imageMaster)
+ Tk_ImageMaster imageMaster; /* Token for image. */
+{
+ ImageMaster *masterPtr = (ImageMaster *) imageMaster;
+
+ return Tcl_GetHashKey(masterPtr->tablePtr, masterPtr->hPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetImage --
+ *
+ * This procedure is invoked by a widget when it wants to use
+ * a particular image in a particular window.
+ *
+ * Results:
+ * The return value is a token for the image. If there is no image
+ * by the given name, then NULL is returned and an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * Tk records the fact that the widget is using the image, and
+ * it will invoke changeProc later if the widget needs redisplay
+ * (i.e. its size changes or some of its pixels change). The
+ * caller must eventually invoke Tk_FreeImage when it no longer
+ * needs the image.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Image
+Tk_GetImage(interp, tkwin, name, changeProc, clientData)
+ Tcl_Interp *interp; /* Place to leave error message if image
+ * can't be found. */
+ Tk_Window tkwin; /* Token for window in which image will
+ * be used. */
+ CONST char *name; /* Name of desired image. */
+ Tk_ImageChangedProc *changeProc;
+ /* Procedure to invoke when redisplay is
+ * needed because image's pixels or size
+ * changed. */
+ ClientData clientData; /* One-word argument to pass to damageProc. */
+{
+ Tcl_HashEntry *hPtr;
+ ImageMaster *masterPtr;
+ Image *imagePtr;
+
+ hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ goto noSuchImage;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr == NULL) {
+ goto noSuchImage;
+ }
+ imagePtr = (Image *) ckalloc(sizeof(Image));
+ imagePtr->tkwin = tkwin;
+ imagePtr->display = Tk_Display(tkwin);
+ imagePtr->masterPtr = masterPtr;
+ imagePtr->instanceData =
+ (*masterPtr->typePtr->getProc)(tkwin, masterPtr->masterData);
+ imagePtr->changeProc = changeProc;
+ imagePtr->widgetClientData = clientData;
+ imagePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = imagePtr;
+ return (Tk_Image) imagePtr;
+
+ noSuchImage:
+ Tcl_AppendResult(interp, "image \"", name, "\" doesn't exist",
+ (char *) NULL);
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeImage --
+ *
+ * This procedure is invoked by a widget when it no longer needs
+ * an image acquired by a previous call to Tk_GetImage. For each
+ * call to Tk_GetImage there must be exactly one call to Tk_FreeImage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The association between the image and the widget is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeImage(image)
+ Tk_Image image; /* Token for image that is no longer
+ * needed by a widget. */
+{
+ Image *imagePtr = (Image *) image;
+ ImageMaster *masterPtr = imagePtr->masterPtr;
+ Image *prevPtr;
+
+ /*
+ * Clean up the particular instance.
+ */
+
+ if (masterPtr->typePtr != NULL) {
+ (*masterPtr->typePtr->freeProc)(imagePtr->instanceData,
+ imagePtr->display);
+ }
+ prevPtr = masterPtr->instancePtr;
+ if (prevPtr == imagePtr) {
+ masterPtr->instancePtr = imagePtr->nextPtr;
+ } else {
+ while (prevPtr->nextPtr != imagePtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = imagePtr->nextPtr;
+ }
+ ckfree((char *) imagePtr);
+
+ /*
+ * If there are no more instances left for the master, and if the
+ * master image has been deleted, then delete the master too.
+ */
+
+ if ((masterPtr->typePtr == NULL) && (masterPtr->instancePtr == NULL)) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PostscriptImage --
+ *
+ * This procedure is called by widgets that contain images in order
+ * to redisplay an image on the screen or an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image's manager is notified, and it redraws the desired
+ * portion of the image before returning.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptImage(image, interp, tkwin, psinfo, x, y, width, height, prepass)
+ Tk_Image image; /* Token for image to redisplay. */
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psinfo; /* postscript info */
+ int x, y; /* Upper-left pixel of region in image that
+ * needs to be redisplayed. */
+ int width, height; /* Dimensions of region to redraw. */
+ int prepass;
+{
+ Image *imagePtr = (Image *) image;
+ int result;
+ XImage *ximage;
+ Pixmap pmap;
+ GC newGC;
+ XGCValues gcValues;
+
+ if (imagePtr->masterPtr->typePtr == NULL) {
+ /*
+ * No master for image, so nothing to display on postscript.
+ */
+ return TCL_OK;
+ }
+
+ /*
+ * Check if an image specific postscript-generation function
+ * exists; otherwise go on with generic code.
+ */
+
+ if (imagePtr->masterPtr->typePtr->postscriptProc != NULL) {
+ return (*imagePtr->masterPtr->typePtr->postscriptProc)(
+ imagePtr->masterPtr->masterData, interp, tkwin, psinfo,
+ x, y, width, height, prepass);
+ }
+
+ if (prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * Create a Pixmap, tell the image to redraw itself there, and then
+ * generate an XImage from the Pixmap. We can then read pixel
+ * values out of the XImage.
+ */
+
+ pmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ width, height, Tk_Depth(tkwin));
+
+ gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+ newGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ if (newGC != None) {
+ XFillRectangle(Tk_Display(tkwin), pmap, newGC,
+ 0, 0, (unsigned int)width, (unsigned int)height);
+ Tk_FreeGC(Tk_Display(tkwin), newGC);
+ }
+
+ Tk_RedrawImage(image, x, y, width, height, pmap, 0, 0);
+
+ ximage = XGetImage(Tk_Display(tkwin), pmap, 0, 0,
+ (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap);
+
+ Tk_FreePixmap(Tk_Display(tkwin), pmap);
+
+ if (ximage == NULL) {
+ /* The XGetImage() function is apparently not
+ * implemented on this system. Just ignore it.
+ */
+ return TCL_OK;
+ }
+ result = TkPostscriptImage(interp, tkwin, psinfo, ximage, x, y,
+ width, height);
+
+ XDestroyImage(ximage);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RedrawImage --
+ *
+ * This procedure is called by widgets that contain images in order
+ * to redisplay an image on the screen or an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image's manager is notified, and it redraws the desired
+ * portion of the image before returning.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_RedrawImage(image, imageX, imageY, width, height, drawable,
+ drawableX, drawableY)
+ Tk_Image image; /* Token for image to redisplay. */
+ int imageX, imageY; /* Upper-left pixel of region in image that
+ * needs to be redisplayed. */
+ int width, height; /* Dimensions of region to redraw. */
+ Drawable drawable; /* Drawable in which to display image
+ * (window or pixmap). If this is a pixmap,
+ * it must have the same depth as the window
+ * used in the Tk_GetImage call for the
+ * image. */
+ int drawableX, drawableY; /* Coordinates in drawable that correspond
+ * to imageX and imageY. */
+{
+ Image *imagePtr = (Image *) image;
+
+ if (imagePtr->masterPtr->typePtr == NULL) {
+ /*
+ * No master for image, so nothing to display.
+ */
+
+ return;
+ }
+
+ /*
+ * Clip the redraw area to the area of the image.
+ */
+
+ if (imageX < 0) {
+ width += imageX;
+ drawableX -= imageX;
+ imageX = 0;
+ }
+ if (imageY < 0) {
+ height += imageY;
+ drawableY -= imageY;
+ imageY = 0;
+ }
+ if ((imageX + width) > imagePtr->masterPtr->width) {
+ width = imagePtr->masterPtr->width - imageX;
+ }
+ if ((imageY + height) > imagePtr->masterPtr->height) {
+ height = imagePtr->masterPtr->height - imageY;
+ }
+ (*imagePtr->masterPtr->typePtr->displayProc)(
+ imagePtr->instanceData, imagePtr->display, drawable,
+ imageX, imageY, width, height, drawableX, drawableY);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SizeOfImage --
+ *
+ * This procedure returns the current dimensions of an image.
+ *
+ * Results:
+ * The width and height of the image are returned in *widthPtr
+ * and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SizeOfImage(image, widthPtr, heightPtr)
+ Tk_Image image; /* Token for image whose size is wanted. */
+ int *widthPtr; /* Return width of image here. */
+ int *heightPtr; /* Return height of image here. */
+{
+ Image *imagePtr = (Image *) image;
+
+ *widthPtr = imagePtr->masterPtr->width;
+ *heightPtr = imagePtr->masterPtr->height;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteImage --
+ *
+ * Given the name of an image, this procedure destroys the
+ * image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is destroyed; existing instances will display as
+ * blank areas. If no such image exists then the procedure does
+ * nothing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteImage(interp, name)
+ Tcl_Interp *interp; /* Interpreter in which the image was
+ * created. */
+ CONST char *name; /* Name of image. */
+{
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ if (winPtr == NULL) {
+ return;
+ }
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ return;
+ }
+ DeleteImage((ImageMaster *)Tcl_GetHashValue(hPtr));
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteImage --
+ *
+ * This procedure is responsible for deleting an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The connection is dropped between instances of this image and
+ * an image master. Image instances will redisplay themselves
+ * as empty areas, but existing instances will not be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteImage(masterPtr)
+ ImageMaster *masterPtr; /* Pointer to main data structure for image. */
+{
+ Image *imagePtr;
+ Tk_ImageType *typePtr;
+
+ typePtr = masterPtr->typePtr;
+ masterPtr->typePtr = NULL;
+ if (typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*typePtr->freeProc)(imagePtr->instanceData,
+ imagePtr->display);
+ (*imagePtr->changeProc)(imagePtr->widgetClientData, 0, 0,
+ masterPtr->width, masterPtr->height, masterPtr->width,
+ masterPtr->height);
+ }
+ (*typePtr->deleteProc)(masterPtr->masterData);
+ }
+ if (masterPtr->instancePtr == NULL) {
+ if ((masterPtr->winPtr->flags & TK_ALREADY_DEAD) == 0) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ }
+ Tcl_Release((ClientData) masterPtr->winPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EventuallyDeleteImage --
+ *
+ * Arrange for an image to be deleted when it is safe to do so.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Image will get freed, though not until it is no longer
+ * Tcl_Preserve()d by anything. May be called multiple times on
+ * the same image without ill effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EventuallyDeleteImage(masterPtr)
+ ImageMaster *masterPtr; /* Pointer to main data structure for image. */
+{
+ if (!masterPtr->deleted) {
+ masterPtr->deleted = 1;
+ Tcl_EventuallyFree((ClientData) masterPtr,
+ (Tcl_FreeProc *)DeleteImage);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeleteAllImages --
+ *
+ * This procedure is called when an application is deleted. It
+ * calls back all of the managers for all images so that they
+ * can cleanup, then it deletes all of Tk's internal information
+ * about images.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All information for all images gets deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDeleteAllImages(mainPtr)
+ TkMainInfo *mainPtr; /* Structure describing application that is
+ * going away. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ EventuallyDeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(&mainPtr->imageTable);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetImageMasterData --
+ *
+ * Given the name of an image, this procedure returns the type
+ * of the image and the clientData associated with its master.
+ *
+ * Results:
+ * If there is no image by the given name, then NULL is returned
+ * and a NULL value is stored at *typePtrPtr. Otherwise the return
+ * value is the clientData returned by the createProc when the
+ * image was created and a pointer to the type structure for the
+ * image is stored at *typePtrPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tk_GetImageMasterData(interp, name, typePtrPtr)
+ Tcl_Interp *interp; /* Interpreter in which the image was
+ * created. */
+ CONST char *name; /* Name of image. */
+ Tk_ImageType **typePtrPtr; /* Points to location to fill in with
+ * pointer to type information for image. */
+{
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+ ImageMaster *masterPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ *typePtrPtr = NULL;
+ return NULL;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ *typePtrPtr = masterPtr->typePtr;
+ return masterPtr->masterData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetTSOrigin --
+ *
+ * Set the pattern origin of the tile to a common point (i.e. the
+ * origin (0,0) of the top level window) so that tiles from two
+ * different widgets will match up. This done by setting the
+ * GCTileStipOrigin field is set to the translated origin of the
+ * toplevel window in the hierarchy.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * The GCTileStipOrigin is reset in the GC. This will cause the
+ * tile origin to change when the GC is used for drawing.
+ *
+ *----------------------------------------------------------------------
+ */
+/*ARGSUSED*/
+void
+Tk_SetTSOrigin(tkwin, gc, x, y)
+ Tk_Window tkwin;
+ GC gc;
+ int x, y;
+{
+ while (!Tk_TopWinHierarchy(tkwin)) {
+ x -= Tk_X(tkwin) + Tk_Changes(tkwin)->border_width;
+ y -= Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width;
+ tkwin = Tk_Parent(tkwin);
+ }
+ XSetTSOrigin(Tk_Display(tkwin), gc, x, y);
+}
+
--- /dev/null
+/*
+ * tkImgBmap.c --
+ *
+ * This procedure implements images of type "bitmap" for Tk.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The following data structure represents the master for a bitmap
+ * image:
+ */
+
+typedef struct BitmapMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter for application that is
+ * using image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ int width, height; /* Dimensions of image. */
+ char *data; /* Data comprising bitmap (suitable for
+ * input to XCreateBitmapFromData). May
+ * be NULL if no data. Malloc'ed. */
+ char *maskData; /* Data for bitmap's mask (suitable for
+ * input to XCreateBitmapFromData).
+ * Malloc'ed. */
+ Tk_Uid fgUid; /* Value of -foreground option (malloc'ed). */
+ Tk_Uid bgUid; /* Value of -background option (malloc'ed). */
+ char *fileString; /* Value of -file option (malloc'ed). */
+ char *dataString; /* Value of -data option (malloc'ed). */
+ char *maskFileString; /* Value of -maskfile option (malloc'ed). */
+ char *maskDataString; /* Value of -maskdata option (malloc'ed). */
+ struct BitmapInstance *instancePtr;
+ /* First in list of all instances associated
+ * with this master. */
+} BitmapMaster;
+
+/*
+ * The following data structure represents all of the instances of an
+ * image that lie within a particular window:
+ */
+
+typedef struct BitmapInstance {
+ int refCount; /* Number of instances that share this
+ * data structure. */
+ BitmapMaster *masterPtr; /* Pointer to master for image. */
+ Tk_Window tkwin; /* Window in which the instances will be
+ * displayed. */
+ XColor *fg; /* Foreground color for displaying image. */
+ XColor *bg; /* Background color for displaying image. */
+ Pixmap bitmap; /* The bitmap to display. */
+ Pixmap mask; /* Mask: only display bitmap pixels where
+ * there are 1's here. */
+ GC gc; /* Graphics context for displaying bitmap.
+ * None means there was an error while
+ * setting up the instance, so it cannot
+ * be displayed. */
+ struct BitmapInstance *nextPtr;
+ /* Next in list of all instance structures
+ * associated with masterPtr (NULL means
+ * end of list). */
+} BitmapInstance;
+
+/*
+ * The type record for bitmap images:
+ */
+
+static int GetByte _ANSI_ARGS_((Tcl_Channel chan));
+static int ImgBmapCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, Tcl_Obj *CONST objv[],
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgBmapGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgBmapDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgBmapFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgBmapDelete _ANSI_ARGS_((ClientData clientData));
+static int ImgBmapPostscript _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psinfo, int x, int y,
+ int width, int height, int prepass));
+
+Tk_ImageType tkBitmapImageType = {
+ "bitmap", /* name */
+ ImgBmapCreate, /* createProc */
+ ImgBmapGet, /* getProc */
+ ImgBmapDisplay, /* displayProc */
+ ImgBmapFree, /* freeProc */
+ ImgBmapDelete, /* deleteProc */
+ ImgBmapPostscript, /* postscriptProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_UID, "-background", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(BitmapMaster, bgUid), 0},
+ {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, dataString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, fileString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-foreground", (char *) NULL, (char *) NULL,
+ "#000000", Tk_Offset(BitmapMaster, fgUid), 0},
+ {TK_CONFIG_STRING, "-maskdata", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, maskDataString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-maskfile", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, maskFileString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The following data structure is used to describe the state of
+ * parsing a bitmap file or string. It is used for communication
+ * between TkGetBitmapData and NextBitmapWord.
+ */
+
+#define MAX_WORD_LENGTH 100
+typedef struct ParseInfo {
+ char *string; /* Next character of string data for bitmap,
+ * or NULL if bitmap is being read from
+ * file. */
+ Tcl_Channel chan; /* File containing bitmap data, or NULL
+ * if no file. */
+ char word[MAX_WORD_LENGTH+1];
+ /* Current word of bitmap data, NULL
+ * terminated. */
+ int wordLength; /* Number of non-NULL bytes in word. */
+} ParseInfo;
+
+/*
+ * Prototypes for procedures used only locally in this file:
+ */
+
+static int ImgBmapCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
+static void ImgBmapCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ImgBmapConfigureInstance _ANSI_ARGS_((
+ BitmapInstance *instancePtr));
+static int ImgBmapConfigureMaster _ANSI_ARGS_((
+ BitmapMaster *masterPtr, int argc, Tcl_Obj *CONST objv[],
+ int flags));
+static int NextBitmapWord _ANSI_ARGS_((ParseInfo *parseInfoPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapCreate --
+ *
+ * This procedure is called by the Tk image code to create "test"
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImgBmapCreate(interp, name, argc, argv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST argv[]; /* Argument objects for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ BitmapMaster *masterPtr;
+
+ masterPtr = (BitmapMaster *) ckalloc(sizeof(BitmapMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgBmapCmd,
+ (ClientData) masterPtr, ImgBmapCmdDeletedProc);
+ masterPtr->width = masterPtr->height = 0;
+ masterPtr->data = NULL;
+ masterPtr->maskData = NULL;
+ masterPtr->fgUid = NULL;
+ masterPtr->bgUid = NULL;
+ masterPtr->fileString = NULL;
+ masterPtr->dataString = NULL;
+ masterPtr->maskFileString = NULL;
+ masterPtr->maskDataString = NULL;
+ masterPtr->instancePtr = NULL;
+ if (ImgBmapConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
+ ImgBmapDelete((ClientData) masterPtr);
+ return TCL_ERROR;
+ }
+ *clientDataPtr = (ClientData) masterPtr;
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapConfigureMaster --
+ *
+ * This procedure is called when a bitmap image is created or
+ * reconfigured. It process configuration options and resets
+ * any instances of the image.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned then
+ * an error message is left in the masterPtr->interp's result.
+ *
+ * Side effects:
+ * Existing instances of the image will be redisplayed to match
+ * the new configuration options.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapConfigureMaster(masterPtr, objc, objv, flags)
+ BitmapMaster *masterPtr; /* Pointer to data structure describing
+ * overall bitmap image to (reconfigure). */
+ int objc; /* Number of entries in objv. */
+ Tcl_Obj *CONST objv[]; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ BitmapInstance *instancePtr;
+ int maskWidth, maskHeight, dummy1, dummy2;
+
+ CONST char **argv = (CONST char **) ckalloc((objc+1) * sizeof(char *));
+ for (dummy1 = 0; dummy1 < objc; dummy1++) {
+ argv[dummy1]=Tcl_GetString(objv[dummy1]);
+ }
+ argv[objc] = NULL;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp),
+ configSpecs, objc, argv, (char *) masterPtr, flags)
+ != TCL_OK) {
+ ckfree((char *) argv);
+ return TCL_ERROR;
+ }
+ ckfree((char *) argv);
+
+ /*
+ * Parse the bitmap and/or mask to create binary data. Make sure that
+ * the bitmap and mask have the same dimensions.
+ */
+
+ if (masterPtr->data != NULL) {
+ ckfree(masterPtr->data);
+ masterPtr->data = NULL;
+ }
+ if ((masterPtr->fileString != NULL) || (masterPtr->dataString != NULL)) {
+ masterPtr->data = TkGetBitmapData(masterPtr->interp,
+ masterPtr->dataString, masterPtr->fileString,
+ &masterPtr->width, &masterPtr->height, &dummy1, &dummy2);
+ if (masterPtr->data == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (masterPtr->maskData != NULL) {
+ ckfree(masterPtr->maskData);
+ masterPtr->maskData = NULL;
+ }
+ if ((masterPtr->maskFileString != NULL)
+ || (masterPtr->maskDataString != NULL)) {
+ if (masterPtr->data == NULL) {
+ Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ masterPtr->maskData = TkGetBitmapData(masterPtr->interp,
+ masterPtr->maskDataString, masterPtr->maskFileString,
+ &maskWidth, &maskHeight, &dummy1, &dummy2);
+ if (masterPtr->maskData == NULL) {
+ return TCL_ERROR;
+ }
+ if ((maskWidth != masterPtr->width)
+ || (maskHeight != masterPtr->height)) {
+ ckfree(masterPtr->maskData);
+ masterPtr->maskData = NULL;
+ Tcl_SetResult(masterPtr->interp,
+ "bitmap and mask have different sizes", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating
+ * the information for each instance. Then force the image to be
+ * redisplayed everywhere that it is used.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgBmapConfigureInstance(instancePtr);
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapConfigureInstance --
+ *
+ * This procedure is called to create displaying information for
+ * a bitmap image instance based on the configuration information
+ * in the master. It is invoked both when new instances are
+ * created and when the master is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tcl_BackgroundError if there are problems
+ * in setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapConfigureInstance(instancePtr)
+ BitmapInstance *instancePtr; /* Instance to reconfigure. */
+{
+ BitmapMaster *masterPtr = instancePtr->masterPtr;
+ XColor *colorPtr;
+ XGCValues gcValues;
+ GC gc;
+ unsigned int mask;
+ Pixmap oldMask;
+
+ /*
+ * For each of the options in masterPtr, translate the string
+ * form into an internal form appropriate for instancePtr.
+ */
+
+ if (*masterPtr->bgUid != 0) {
+ colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
+ masterPtr->bgUid);
+ if (colorPtr == NULL) {
+ goto error;
+ }
+ } else {
+ colorPtr = NULL;
+ }
+ if (instancePtr->bg != NULL) {
+ Tk_FreeColor(instancePtr->bg);
+ }
+ instancePtr->bg = colorPtr;
+
+ colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
+ masterPtr->fgUid);
+ if (colorPtr == NULL) {
+ goto error;
+ }
+ if (instancePtr->fg != NULL) {
+ Tk_FreeColor(instancePtr->fg);
+ }
+ instancePtr->fg = colorPtr;
+
+ if (instancePtr->bitmap != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->bitmap);
+ instancePtr->bitmap = None;
+ }
+ if (masterPtr->data != NULL) {
+ instancePtr->bitmap = XCreateBitmapFromData(
+ Tk_Display(instancePtr->tkwin),
+ RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
+ masterPtr->data, (unsigned) masterPtr->width,
+ (unsigned) masterPtr->height);
+ }
+
+ /*
+ * Careful: We have to allocate a new mask Pixmap before deleting
+ * the old one. Otherwise, The XID allocator will always return
+ * the same XID for the new Pixmap as was used for the old Pixmap.
+ * And that will prevent the mask from changing in the GC below.
+ */
+ oldMask = instancePtr->mask;
+ instancePtr->mask = None;
+ if (masterPtr->maskData != NULL) {
+ instancePtr->mask = XCreateBitmapFromData(
+ Tk_Display(instancePtr->tkwin),
+ RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
+ masterPtr->maskData, (unsigned) masterPtr->width,
+ (unsigned) masterPtr->height);
+ }
+ if (oldMask != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldMask);
+ }
+
+ if (masterPtr->data != NULL) {
+ gcValues.foreground = instancePtr->fg->pixel;
+ gcValues.graphics_exposures = False;
+ mask = GCForeground|GCGraphicsExposures;
+ if (instancePtr->bg != NULL) {
+ gcValues.background = instancePtr->bg->pixel;
+ mask |= GCBackground;
+ if (instancePtr->mask != None) {
+ gcValues.clip_mask = instancePtr->mask;
+ mask |= GCClipMask;
+ }
+ } else {
+ gcValues.clip_mask = instancePtr->bitmap;
+ mask |= GCClipMask;
+ }
+ gc = Tk_GetGC(instancePtr->tkwin, mask, &gcValues);
+ } else {
+ gc = None;
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = gc;
+ return;
+
+ error:
+ /*
+ * An error occurred: clear the graphics context in the instance to
+ * make it clear that this instance cannot be displayed. Then report
+ * the error.
+ */
+
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = None;
+ Tcl_AddErrorInfo(masterPtr->interp, "\n (while configuring image \"");
+ Tcl_AddErrorInfo(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ Tcl_AddErrorInfo(masterPtr->interp, "\")");
+ Tcl_BackgroundError(masterPtr->interp);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetBitmapData --
+ *
+ * Given a file name or ASCII string, this procedure parses the
+ * file or string contents to produce binary data for a bitmap.
+ *
+ * Results:
+ * If the bitmap description was parsed successfully then the
+ * return value is a malloc-ed array containing the bitmap data.
+ * The dimensions of the data are stored in *widthPtr and
+ * *heightPtr. *hotXPtr and *hotYPtr are set to the bitmap
+ * hotspot if one is defined, otherwise they are set to -1, -1.
+ * If an error occurred, NULL is returned and an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * A bitmap is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr,
+ hotXPtr, hotYPtr)
+ Tcl_Interp *interp; /* For reporting errors, or NULL. */
+ char *string; /* String describing bitmap. May
+ * be NULL. */
+ char *fileName; /* Name of file containing bitmap
+ * description. Used only if string
+ * is NULL. Must not be NULL if
+ * string is NULL. */
+ int *widthPtr, *heightPtr; /* Dimensions of bitmap get returned
+ * here. */
+ int *hotXPtr, *hotYPtr; /* Position of hot spot or -1,-1. */
+{
+ int width, height, numBytes, hotX, hotY;
+ CONST char *expandedFileName;
+ char *p, *end;
+ ParseInfo pi;
+ char *data = NULL;
+ Tcl_DString buffer;
+
+ pi.string = string;
+ if (string == NULL) {
+ if ((interp != NULL) && Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get bitmap data from a file in a",
+ " safe interpreter", (char *) NULL);
+ return NULL;
+ }
+ expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer);
+ if (expandedFileName == NULL) {
+ return NULL;
+ }
+ pi.chan = Tcl_OpenFileChannel(interp, expandedFileName, "r", 0);
+ Tcl_DStringFree(&buffer);
+ if (pi.chan == NULL) {
+ if (interp != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't read bitmap file \"",
+ fileName, "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
+ }
+ return NULL;
+ }
+
+ if (Tcl_SetChannelOption(interp, pi.chan, "-translation", "binary")
+ != TCL_OK) {
+ return NULL;
+ }
+ if (Tcl_SetChannelOption(interp, pi.chan, "-encoding", "binary")
+ != TCL_OK) {
+ return NULL;
+ }
+ } else {
+ pi.chan = NULL;
+ }
+
+ /*
+ * Parse the lines that define the dimensions of the bitmap,
+ * plus the first line that defines the bitmap data (it declares
+ * the name of a data variable but doesn't include any actual
+ * data). These lines look something like the following:
+ *
+ * #define foo_width 16
+ * #define foo_height 16
+ * #define foo_x_hot 3
+ * #define foo_y_hot 3
+ * static char foo_bits[] = {
+ *
+ * The x_hot and y_hot lines may or may not be present. It's
+ * important to check for "char" in the last line, in order to
+ * reject old X10-style bitmaps that used shorts.
+ */
+
+ width = 0;
+ height = 0;
+ hotX = -1;
+ hotY = -1;
+ while (1) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_width") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ width = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 7) && (pi.word[pi.wordLength-7] == '_')
+ && (strcmp(pi.word+pi.wordLength-7, "_height") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ height = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_x_hot") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ hotX = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_y_hot") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ hotY = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.word[0] == 'c') && (strcmp(pi.word, "char") == 0)) {
+ while (1) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ if ((pi.word[0] == '{') && (pi.word[1] == 0)) {
+ goto getData;
+ }
+ }
+ } else if ((pi.word[0] == '{') && (pi.word[1] == 0)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "format error in bitmap data; ",
+ "looks like it's an obsolete X10 bitmap file",
+ (char *) NULL);
+ }
+ goto errorCleanup;
+ }
+ }
+
+ /*
+ * Now we've read everything but the data. Allocate an array
+ * and read in the data.
+ */
+
+ getData:
+ if ((width <= 0) || (height <= 0)) {
+ goto error;
+ }
+ numBytes = ((width+7)/8) * height;
+ data = (char *) ckalloc((unsigned) numBytes);
+ for (p = data; numBytes > 0; p++, numBytes--) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ *p = (char) strtol(pi.word, &end, 0);
+ if (end == pi.word) {
+ goto error;
+ }
+ }
+
+ /*
+ * All done. Clean up and return.
+ */
+
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ *widthPtr = width;
+ *heightPtr = height;
+ *hotXPtr = hotX;
+ *hotYPtr = hotY;
+ return data;
+
+ error:
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC);
+ }
+
+ errorCleanup:
+ if (data != NULL) {
+ ckfree(data);
+ }
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * NextBitmapWord --
+ *
+ * This procedure retrieves the next word of information (stuff
+ * between commas or white space) from a bitmap description.
+ *
+ * Results:
+ * Returns TCL_OK if all went well. In this case the next word,
+ * and its length, will be availble in *parseInfoPtr. If the end
+ * of the bitmap description was reached then TCL_ERROR is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NextBitmapWord(parseInfoPtr)
+ ParseInfo *parseInfoPtr; /* Describes what we're reading
+ * and where we are in it. */
+{
+ char *src, *dst;
+ int c;
+
+ parseInfoPtr->wordLength = 0;
+ dst = parseInfoPtr->word;
+ if (parseInfoPtr->string != NULL) {
+ for (src = parseInfoPtr->string; isspace(UCHAR(*src)) || (*src == ',');
+ src++) {
+ if (*src == 0) {
+ return TCL_ERROR;
+ }
+ }
+ for ( ; !isspace(UCHAR(*src)) && (*src != ',') && (*src != 0); src++) {
+ *dst = *src;
+ dst++;
+ parseInfoPtr->wordLength++;
+ if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) {
+ return TCL_ERROR;
+ }
+ }
+ parseInfoPtr->string = src;
+ } else {
+ for (c = GetByte(parseInfoPtr->chan); isspace(UCHAR(c)) || (c == ',');
+ c = GetByte(parseInfoPtr->chan)) {
+ if (c == EOF) {
+ return TCL_ERROR;
+ }
+ }
+ for ( ; !isspace(UCHAR(c)) && (c != ',') && (c != EOF);
+ c = GetByte(parseInfoPtr->chan)) {
+ *dst = c;
+ dst++;
+ parseInfoPtr->wordLength++;
+ if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ if (parseInfoPtr->wordLength == 0) {
+ return TCL_ERROR;
+ }
+ parseInfoPtr->word[parseInfoPtr->wordLength] = 0;
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ImgBmapCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to an image 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
+ImgBmapCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about the image master. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *bmapOptions[] = {"cget", "configure", (char *) NULL};
+ BitmapMaster *masterPtr = (BitmapMaster *) clientData;
+ int code, index;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], bmapOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case 0: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, Tcl_GetString(objv[2]), 0);
+ }
+ case 1: {
+ if (objc == 2) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ } else if (objc == 3) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr,
+ Tcl_GetString(objv[2]), 0);
+ } else {
+ code = ImgBmapConfigureMaster(masterPtr, objc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ return code;
+ }
+ default: {
+ panic("bad const entries to bmapOptions in ImgBmapCmd");
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapGet --
+ *
+ * This procedure is called for each use of a bitmap image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgBmapDisplay and ImgBmapFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgBmapGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) masterData;
+ BitmapInstance *instancePtr;
+
+ /*
+ * See if there is already an instance for this window. If so
+ * then just re-use it.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->tkwin == tkwin) {
+ instancePtr->refCount++;
+ return (ClientData) instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in this window. Make a new
+ * instance of the image.
+ */
+
+ instancePtr = (BitmapInstance *) ckalloc(sizeof(BitmapInstance));
+ instancePtr->refCount = 1;
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->tkwin = tkwin;
+ instancePtr->fg = NULL;
+ instancePtr->bg = NULL;
+ instancePtr->bitmap = None;
+ instancePtr->mask = None;
+ instancePtr->gc = None;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = instancePtr;
+ ImgBmapConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+
+ if (instancePtr->nextPtr == NULL) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width,
+ masterPtr->height);
+ }
+
+ return (ClientData) instancePtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapDisplay --
+ *
+ * This procedure is invoked to draw a bitmap image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to BitmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw. */
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ BitmapInstance *instancePtr = (BitmapInstance *) clientData;
+ int masking;
+
+ /*
+ * If there's no graphics context, it means that an error occurred
+ * while creating the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->gc == None) {
+ return;
+ }
+
+ /*
+ * If masking is in effect, must modify the mask origin within
+ * the graphics context to line up with the image's origin.
+ * Then draw the image and reset the clip origin, if there's
+ * a mask.
+ */
+
+ masking = (instancePtr->mask != None) || (instancePtr->bg == NULL);
+ if (masking) {
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ }
+ XCopyPlane(display, instancePtr->bitmap, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY, 1);
+ if (masking) {
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapFree(clientData, display)
+ ClientData clientData; /* Pointer to BitmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image. */
+{
+ BitmapInstance *instancePtr = (BitmapInstance *) clientData;
+ BitmapInstance *prevPtr;
+
+ instancePtr->refCount--;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget. Free
+ * the instance structure.
+ */
+
+ if (instancePtr->fg != NULL) {
+ Tk_FreeColor(instancePtr->fg);
+ }
+ if (instancePtr->bg != NULL) {
+ Tk_FreeColor(instancePtr->bg);
+ }
+ if (instancePtr->bitmap != None) {
+ Tk_FreePixmap(display, instancePtr->bitmap);
+ }
+ if (instancePtr->mask != None) {
+ Tk_FreePixmap(display, instancePtr->mask);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(display, instancePtr->gc);
+ }
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ ckfree((char *) instancePtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapDelete(masterData)
+ ClientData masterData; /* Pointer to BitmapMaster structure for
+ * image. Must not have any more instances. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) masterData;
+
+ if (masterPtr->instancePtr != NULL) {
+ panic("tried to delete bitmap image when instances still exist");
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
+ }
+ if (masterPtr->data != NULL) {
+ ckfree(masterPtr->data);
+ }
+ if (masterPtr->maskData != NULL) {
+ ckfree(masterPtr->maskData);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
+ ckfree((char *) masterPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to BitmapMaster structure for
+ * image. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetByte --
+ *
+ * Get the next byte from the open channel.
+ *
+ * Results:
+ * The next byte or EOF.
+ *
+ * Side effects:
+ * We read from the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetByte(chan)
+ Tcl_Channel chan; /* The channel we read from. */
+{
+ char buffer;
+ int size;
+
+ size = Tcl_Read(chan, &buffer, 1);
+ if (size <= 0) {
+ return EOF;
+ } else {
+ return buffer;
+ }
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapPsImagemask --
+ *
+ * This procedure generates postscript suitable for rendering a
+ * single bitmap of an image. A single bitmap image might contain both
+ * a foreground and a background bitmap. This routine is called once
+ * for each such bitmap in a bitmap image.
+ *
+ * Prior to invoking this routine, the following setup has occurred:
+ *
+ * 1. The postscript foreground color has been set to the color
+ * used to render the bitmap.
+ *
+ * 2. The origin of the postscript coordinate system is set to
+ * the lower left corner of the bitmap.
+ *
+ * 3. The postscript coordinate system has been scaled so that
+ * the entire bitmap is one unit squared.
+ *
+ * Some postscript implementations cannot handle bitmap strings
+ * longer than about 60k characters. If the bitmap data is that big
+ * or bigger, then we render it by splitting it into several smaller
+ * bitmaps.
+ *
+ * Results:
+ * Returns TCL_OK on success. Returns TCL_ERROR and leaves and error
+ * message in interp->result if there is a problem.
+ *
+ * Side effects:
+ * Postscript code is appended to interp->result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapPsImagemask(interp, width, height, data)
+ Tcl_Interp *interp; /* Append postscript to this interpreter */
+ int width, height; /* Width and height of the bitmap in pixels */
+ char *data; /* Data for the bitmap */
+{
+ int i, j, nBytePerRow;
+ char buffer[200];
+
+ /*
+ * The bit order of bitmaps in Tk is the opposite of the bit order that
+ * postscript uses. (In Tk, the least significant bit is on the right
+ * side of the bitmap and in postscript the least significant bit is shown
+ * on the left.) The following array is used to reverse the order of bits
+ * within a byte so that the bits will be in the order postscript expects.
+ */
+ static unsigned char bit_reverse[] = {
+ 0, 128, 64, 192, 32, 160, 96, 224, 16, 144, 80, 208, 48, 176, 112, 240,
+ 8, 136, 72, 200, 40, 168, 104, 232, 24, 152, 88, 216, 56, 184, 120, 248,
+ 4, 132, 68, 196, 36, 164, 100, 228, 20, 148, 84, 212, 52, 180, 116, 244,
+ 12, 140, 76, 204, 44, 172, 108, 236, 28, 156, 92, 220, 60, 188, 124, 252,
+ 2, 130, 66, 194, 34, 162, 98, 226, 18, 146, 82, 210, 50, 178, 114, 242,
+ 10, 138, 74, 202, 42, 170, 106, 234, 26, 154, 90, 218, 58, 186, 122, 250,
+ 6, 134, 70, 198, 38, 166, 102, 230, 22, 150, 86, 214, 54, 182, 118, 246,
+ 14, 142, 78, 206, 46, 174, 110, 238, 30, 158, 94, 222, 62, 190, 126, 254,
+ 1, 129, 65, 193, 33, 161, 97, 225, 17, 145, 81, 209, 49, 177, 113, 241,
+ 9, 137, 73, 201, 41, 169, 105, 233, 25, 153, 89, 217, 57, 185, 121, 249,
+ 5, 133, 69, 197, 37, 165, 101, 229, 21, 149, 85, 213, 53, 181, 117, 245,
+ 13, 141, 77, 205, 45, 173, 109, 237, 29, 157, 93, 221, 61, 189, 125, 253,
+ 3, 131, 67, 195, 35, 163, 99, 227, 19, 147, 83, 211, 51, 179, 115, 243,
+ 11, 139, 75, 203, 43, 171, 107, 235, 27, 155, 91, 219, 59, 187, 123, 251,
+ 7, 135, 71, 199, 39, 167, 103, 231, 23, 151, 87, 215, 55, 183, 119, 247,
+ 15, 143, 79, 207, 47, 175, 111, 239, 31, 159, 95, 223, 63, 191, 127, 255,
+ };
+
+ if (width*height > 60000) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "unable to generate postscript for bitmaps "
+ "larger than 60000 pixels", 0);
+ return TCL_ERROR;
+ }
+ sprintf(buffer, "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n",
+ width, height, width, -height, height);
+ Tcl_AppendResult(interp, buffer, 0);
+ nBytePerRow = (width+7)/8;
+ for(i=0; i<height; i++){
+ for(j=0; j<nBytePerRow; j++){
+ sprintf(buffer, " %02x", bit_reverse[0xff & data[i*nBytePerRow + j]]);
+ Tcl_AppendResult(interp, buffer, 0);
+ }
+ Tcl_AppendResult(interp, "\n", 0);
+ }
+ Tcl_AppendResult(interp, ">} imagemask \n", 0);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapPostscript --
+ *
+ * This procedure generates postscript for rendering a bitmap image.
+ *
+ * Results:
+ * On success, this routine writes postscript code into interp->result
+ * and returns TCL_OK TCL_ERROR is returned and an error
+ * message is left in interp->result if anything goes wrong.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapPostscript(clientData, interp, tkwin, psinfo, x, y, width, height,
+ prepass)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psinfo;
+ int x, y, width, height, prepass;
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) clientData;
+ char buffer[200];
+
+ if (prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * There is nothing to do for bitmaps with zero width or height
+ */
+ if( width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<=0 ){
+ return TCL_OK;
+ }
+
+ /*
+ * Translate the origin of the coordinate system to be the lower-left
+ * corner of the bitmap and adjust the scale of the coordinate system
+ * so that entire bitmap covers one square unit of the page.
+ * The calling function put a "gsave" into the postscript and
+ * will add a "grestore" at after this routine returns, so it is safe
+ * to make whatever changes are necessary here.
+ */
+ if( x!=0 || y!=0 ){
+ sprintf(buffer, "%d %d moveto\n", x, y);
+ Tcl_AppendResult(interp, buffer, 0);
+ }
+ if( width!=1 || height!=1 ){
+ sprintf(buffer, "%d %d scale\n", width, height);
+ Tcl_AppendResult(interp, buffer, 0);
+ }
+
+ /*
+ * Color the background, if there is one. This step is skipped if the
+ * background is transparent. If the background is not transparent and
+ * there is no background mask, then color the complete rectangle that
+ * encloses the bitmap. If there is a background mask, then only apply
+ * color to the bits specified by the mask.
+ */
+ if ((masterPtr->bgUid != NULL) && (masterPtr->bgUid[0] != '\000')) {
+ XColor color;
+ XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid,
+ &color);
+ if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (masterPtr->maskData == NULL) {
+ Tcl_AppendResult(interp,
+ "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto "
+ "closepath fill\n", 0
+ );
+ } else if (ImgBmapPsImagemask(interp, masterPtr->width,
+ masterPtr->height, masterPtr->maskData) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Draw the bitmap foreground, assuming there is one.
+ */
+ if ( (masterPtr->fgUid != NULL) && (masterPtr->data != NULL) ) {
+ XColor color;
+ XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->fgUid,
+ &color);
+ if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (ImgBmapPsImagemask(interp, masterPtr->width, masterPtr->height,
+ masterPtr->data) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
--- /dev/null
+/*
+ * tkImgGIF.c --
+ *
+ * A photo image file handler for GIF files. Reads 87a and 89a GIF
+ * files. At present, there only is a file write function. GIF images
+ * may be read using the -data option of the photo image. The data may be
+ * given as a binary string in a Tcl_Obj or by representing
+ * the data as BASE64 encoded ascii. Derived from the giftoppm code
+ * found in the pbmplus package and tkImgFmtPPM.c in the tk4.0b2
+ * distribution.
+ *
+ * Copyright (c) Reed Wade (wade@cs.utk.edu), University of Tennessee
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1997 Australian National University
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * This file also contains code from the giftoppm program, which is
+ * copyrighted as follows:
+ *
+ * +--------------------------------------------------------------------+
+ * | Copyright 1990, David Koblas. |
+ * | 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 and that both that copyright notice and this permission |
+ * | notice appear in supporting documentation. This software is |
+ * | provided "as is" without express or implied warranty. |
+ * +-------------------------------------------------------------------+
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * GIF's are represented as data in base64 format.
+ * base64 strings consist of 4 6-bit characters -> 3 8 bit bytes.
+ * A-Z, a-z, 0-9, + and / represent the 64 values (in order).
+ * '=' is a trailing padding char when the un-encoded data is not a
+ * multiple of 3 bytes. We'll ignore white space when encountered.
+ * Any other invalid character is treated as an EOF
+ */
+
+#define GIF_SPECIAL (256)
+#define GIF_PAD (GIF_SPECIAL+1)
+#define GIF_SPACE (GIF_SPECIAL+2)
+#define GIF_BAD (GIF_SPECIAL+3)
+#define GIF_DONE (GIF_SPECIAL+4)
+
+/*
+ * structure to "mimic" FILE for Mread, so we can look like fread.
+ * The decoder state keeps track of which byte we are about to read,
+ * or EOF.
+ */
+
+typedef struct mFile {
+ unsigned char *data; /* mmencoded source string */
+ int c; /* bits left over from previous character */
+ int state; /* decoder state (0-4 or GIF_DONE) */
+} MFile;
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * Non-ASCII encoding support:
+ * Most data in a GIF image is binary and is treated as such. However,
+ * a few key bits are stashed in ASCII. If we try to compare those pieces
+ * to the char they represent, it will fail on any non-ASCII (eg, EBCDIC)
+ * system. To accomodate these systems, we test against the numeric value
+ * of the ASCII characters instead of the characters themselves. This is
+ * encoding independant.
+ */
+
+static CONST char GIF87a[] = { /* ASCII GIF87a */
+ 0x47, 0x49, 0x46, 0x38, 0x37, 0x61, 0x00
+};
+static CONST char GIF89a[] = { /* ASCII GIF89a */
+ 0x47, 0x49, 0x46, 0x38, 0x39, 0x61, 0x00
+};
+# define GIF_TERMINATOR 0x3b /* ASCII ; */
+# define GIF_EXTENSION 0x21 /* ASCII ! */
+# define GIF_START 0x2c /* ASCII , */
+
+/*
+ * HACK ALERT!! HACK ALERT!! HACK ALERT!!
+ * This code is hard-wired for reading from files. In order to read
+ * from a data stream, we'll trick fread so we can reuse the same code.
+ * 0==from file; 1==from base64 encoded data; 2==from binary data
+ */
+
+typedef struct ThreadSpecificData {
+ int fromData;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The format record for the GIF file format:
+ */
+
+static int FileMatchGIF _ANSI_ARGS_((Tcl_Channel chan, CONST char *fileName,
+ Tcl_Obj *format, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp));
+static int FileReadGIF _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, CONST char *fileName, Tcl_Obj *format,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY));
+static int StringMatchGIF _ANSI_ARGS_(( Tcl_Obj *dataObj,
+ Tcl_Obj *format, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp));
+static int StringReadGIF _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *dataObj,
+ Tcl_Obj *format, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY));
+static int FileWriteGIF _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *filename, Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr));
+static int CommonWriteGIF _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel handle, Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr));
+
+Tk_PhotoImageFormat tkImgFmtGIF = {
+ "gif", /* name */
+ FileMatchGIF, /* fileMatchProc */
+ StringMatchGIF, /* stringMatchProc */
+ FileReadGIF, /* fileReadProc */
+ StringReadGIF, /* stringReadProc */
+ FileWriteGIF, /* fileWriteProc */
+ NULL, /* stringWriteProc */
+};
+
+#define INTERLACE 0x40
+#define LOCALCOLORMAP 0x80
+#define BitSet(byte, bit) (((byte) & (bit)) == (bit))
+#define MAXCOLORMAPSIZE 256
+#define CM_RED 0
+#define CM_GREEN 1
+#define CM_BLUE 2
+#define CM_ALPHA 3
+#define MAX_LWZ_BITS 12
+#define LM_to_uint(a,b) (((b)<<8)|(a))
+#define ReadOK(file,buffer,len) (Fread(buffer, len, 1, file) != 0)
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static int DoExtension _ANSI_ARGS_((Tcl_Channel chan, int label,
+ int *transparent));
+static int GetCode _ANSI_ARGS_((Tcl_Channel chan, int code_size,
+ int flag));
+static int GetDataBlock _ANSI_ARGS_((Tcl_Channel chan,
+ unsigned char *buf));
+static int ReadColorMap _ANSI_ARGS_((Tcl_Channel chan, int number,
+ unsigned char buffer[MAXCOLORMAPSIZE][4]));
+static int ReadGIFHeader _ANSI_ARGS_((Tcl_Channel chan,
+ int *widthPtr, int *heightPtr));
+static int ReadImage _ANSI_ARGS_((Tcl_Interp *interp,
+ char *imagePtr, Tcl_Channel chan,
+ int len, int rows,
+ unsigned char cmap[MAXCOLORMAPSIZE][4],
+ int width, int height, int srcX, int srcY,
+ int interlace, int transparent));
+
+/*
+ * these are for the BASE64 image reader code only
+ */
+
+static int Fread _ANSI_ARGS_((unsigned char *dst, size_t size,
+ size_t count, Tcl_Channel chan));
+static int Mread _ANSI_ARGS_((unsigned char *dst, size_t size,
+ size_t count, MFile *handle));
+static int Mgetc _ANSI_ARGS_((MFile *handle));
+static int char64 _ANSI_ARGS_((int c));
+static void mInit _ANSI_ARGS_((unsigned char *string,
+ MFile *handle));
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchGIF --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * a file contains image data in GIF format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in file f look
+ * like GIF data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchGIF(chan, fileName, format, widthPtr, heightPtr, interp)
+ Tcl_Channel chan; /* The image file, open for reading. */
+ CONST char *fileName; /* The name of the image file. */
+ Tcl_Obj *format; /* User-specified format object, or NULL. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here if the file is a valid
+ * raw GIF file. */
+ Tcl_Interp *interp; /* not used */
+{
+ return ReadGIFHeader(chan, widthPtr, heightPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadGIF --
+ *
+ * This procedure is called by the photo image type to read
+ * GIF format data from a file and write it into a given
+ * photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in the interp's result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is
+ * added to the image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadGIF(interp, chan, fileName, format, imageHandle, destX, destY,
+ width, height, srcX, srcY)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ CONST char *fileName; /* The name of the image file. */
+ Tcl_Obj *format; /* User-specified format object, or NULL. */
+ Tk_PhotoHandle imageHandle; /* The photo image to write into. */
+ int destX, destY; /* Coordinates of top-left pixel in
+ * photo image to be written to. */
+ int width, height; /* Dimensions of block of photo image to
+ * be written to. */
+ int srcX, srcY; /* Coordinates of top-left pixel to be used
+ * in image being read. */
+{
+ int fileWidth, fileHeight;
+ int nBytes, index = 0, argc = 0, i;
+ Tcl_Obj **objv;
+ Tk_PhotoImageBlock block;
+ unsigned char buf[100];
+ unsigned char *trashBuffer = NULL;
+ int bitPixel;
+ unsigned char colorMap[MAXCOLORMAPSIZE][4];
+ int transparent = -1;
+ static CONST char *optionStrings[] = {
+ "-index", NULL
+ };
+
+ if (format && Tcl_ListObjGetElements(interp, format,
+ &argc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (i = 1; i < argc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option name", 0,
+ &nBytes) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i == (argc-1)) {
+ Tcl_AppendResult(interp, "no value given for \"",
+ Tcl_GetStringFromObj(objv[i], NULL),
+ "\" option", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (!ReadGIFHeader(chan, &fileWidth, &fileHeight)) {
+ Tcl_AppendResult(interp, "couldn't read GIF header from file \"",
+ fileName, "\"", NULL);
+ return TCL_ERROR;
+ }
+ if ((fileWidth <= 0) || (fileHeight <= 0)) {
+ Tcl_AppendResult(interp, "GIF image file \"", fileName,
+ "\" has dimension(s) <= 0", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Fread(buf, 1, 3, chan) != 3) {
+ return TCL_OK;
+ }
+ bitPixel = 2<<(buf[0]&0x07);
+
+ if (BitSet(buf[0], LOCALCOLORMAP)) { /* Global Colormap */
+ if (!ReadColorMap(chan, bitPixel, colorMap)) {
+ Tcl_AppendResult(interp, "error reading color map",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ Tk_PhotoExpand(imageHandle, destX + width, destY + height);
+
+ block.width = width;
+ block.height = height;
+ block.pixelSize = 4;
+ block.pitch = block.pixelSize * block.width;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ block.offset[3] = 3;
+ block.pixelPtr = NULL;
+
+ while (1) {
+ if (Fread(buf, 1, 1, chan) != 1) {
+ /*
+ * Premature end of image. We should really notify
+ * the user, but for now just show garbage.
+ */
+
+ break;
+ }
+
+ if (buf[0] == GIF_TERMINATOR) {
+ /*
+ * GIF terminator.
+ */
+
+ Tcl_AppendResult(interp,"no image data for this index",
+ (char *) NULL);
+ goto error;
+ }
+
+ if (buf[0] == GIF_EXTENSION) {
+ /*
+ * This is a GIF extension.
+ */
+
+ if (Fread(buf, 1, 1, chan) != 1) {
+ Tcl_SetResult(interp,
+ "error reading extension function code in GIF image",
+ TCL_STATIC);
+ goto error;
+ }
+ if (DoExtension(chan, buf[0], &transparent) < 0) {
+ Tcl_SetResult(interp, "error reading extension in GIF image",
+ TCL_STATIC);
+ goto error;
+ }
+ continue;
+ }
+
+ if (buf[0] != GIF_START) {
+ /*
+ * Not a valid start character; ignore it.
+ */
+ continue;
+ }
+
+ if (Fread(buf, 1, 9, chan) != 9) {
+ Tcl_SetResult(interp,
+ "couldn't read left/top/width/height in GIF image",
+ TCL_STATIC);
+ goto error;
+ }
+
+ fileWidth = LM_to_uint(buf[4],buf[5]);
+ fileHeight = LM_to_uint(buf[6],buf[7]);
+
+ bitPixel = 1<<((buf[8]&0x07)+1);
+
+ if (index--) {
+ /*
+ * This is not the image we want to read: skip it.
+ */
+ if (BitSet(buf[8], LOCALCOLORMAP)) {
+ if (!ReadColorMap(chan, bitPixel, colorMap)) {
+ Tcl_AppendResult(interp,
+ "error reading color map", (char *) NULL);
+ goto error;
+ }
+ }
+
+ /*
+ * If we've not yet allocated a trash buffer, do so now.
+ */
+ if (trashBuffer == NULL) {
+ nBytes = fileWidth * fileHeight * 3;
+ trashBuffer =
+ (unsigned char *) ckalloc((unsigned int) nBytes);
+ }
+
+ /*
+ * Slurp! Process the data for this image and stuff it in
+ * a trash buffer.
+ *
+ * Yes, it might be more efficient here to *not* store the
+ * data (we're just going to throw it away later).
+ * However, I elected to implement it this way for good
+ * reasons. First, I wanted to avoid duplicating the
+ * (fairly complex) LWZ decoder in ReadImage. Fine, you
+ * say, why didn't you just modify it to allow the use of
+ * a NULL specifier for the output buffer? I tried that,
+ * but it negatively impacted the performance of what I
+ * think will be the common case: reading the first image
+ * in the file. Rather than marginally improve the speed
+ * of the less frequent case, I chose to maintain high
+ * performance for the common case.
+ */
+ if (ReadImage(interp, (char *) trashBuffer, chan, fileWidth,
+ fileHeight, colorMap, 0, 0, 0, 0, 0, -1) != TCL_OK) {
+ goto error;
+ }
+ continue;
+ }
+
+ /*
+ * If a trash buffer has been allocated, free it now.
+ */
+ if (trashBuffer != NULL) {
+ ckfree((char *)trashBuffer);
+ trashBuffer = NULL;
+ }
+ if (BitSet(buf[8], LOCALCOLORMAP)) {
+ if (!ReadColorMap(chan, bitPixel, colorMap)) {
+ Tcl_AppendResult(interp, "error reading color map",
+ (char *) NULL);
+ goto error;
+ }
+ }
+
+ index = LM_to_uint(buf[0],buf[1]);
+ srcX -= index;
+ if (srcX<0) {
+ destX -= srcX; width += srcX;
+ srcX = 0;
+ }
+
+ if (width > fileWidth) {
+ width = fileWidth;
+ }
+
+ index = LM_to_uint(buf[2],buf[3]);
+ srcY -= index;
+ if (index > srcY) {
+ destY -= srcY; height += srcY;
+ srcY = 0;
+ }
+ if (height > fileHeight) {
+ height = fileHeight;
+ }
+
+ if ((width <= 0) || (height <= 0)) {
+ block.pixelPtr = 0;
+ goto noerror;
+ }
+
+ block.width = width;
+ block.height = height;
+ block.pixelSize = (transparent>=0) ? 4 : 3;
+ block.offset[3] = (transparent>=0) ? 3 : 0;
+ block.pitch = block.pixelSize * fileWidth;
+ nBytes = block.pitch * fileHeight;
+ block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+
+ if (ReadImage(interp, (char *) block.pixelPtr, chan, fileWidth,
+ fileHeight, colorMap, fileWidth, fileHeight, srcX, srcY,
+ BitSet(buf[8], INTERLACE), transparent) != TCL_OK) {
+ goto error;
+ }
+ break;
+ }
+
+ Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, height,
+ TK_PHOTO_COMPOSITE_SET);
+
+ noerror:
+ if (block.pixelPtr) {
+ ckfree((char *) block.pixelPtr);
+ }
+ Tcl_AppendResult(interp, tkImgFmtGIF.name, (char *) NULL);
+ return TCL_OK;
+
+ error:
+ if (block.pixelPtr) {
+ ckfree((char *) block.pixelPtr);
+ }
+ return TCL_ERROR;
+
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMatchGIF --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * an object contains image data in GIF format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in the data are
+ * like GIF data, and 0 otherwise.
+ *
+ * Side effects:
+ * the size of the image is placed in widthPre and heightPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringMatchGIF(dataObj, format, widthPtr, heightPtr, interp)
+ Tcl_Obj *dataObj; /* the object containing the image data */
+ Tcl_Obj *format; /* the image format object, or NULL */
+ int *widthPtr; /* where to put the string width */
+ int *heightPtr; /* where to put the string height */
+ Tcl_Interp *interp; /* not used */
+{
+ unsigned char *data, header[10];
+ int got, length;
+ MFile handle;
+
+ data = Tcl_GetByteArrayFromObj(dataObj, &length);
+
+ /*
+ * Header is a minimum of 10 bytes.
+ */
+ if (length < 10) {
+ return 0;
+ }
+
+ /*
+ * Check whether the data is Base64 encoded.
+ */
+
+ if ((strncmp(GIF87a, (char *) data, 6) != 0) &&
+ (strncmp(GIF89a, (char *) data, 6) != 0)) {
+ /*
+ * Try interpreting the data as Base64 encoded
+ */
+ mInit((unsigned char *) data, &handle);
+ got = Mread(header, 10, 1, &handle);
+ if (got != 10
+ || ((strncmp(GIF87a, (char *) header, 6) != 0)
+ && (strncmp(GIF89a, (char *) header, 6) != 0))) {
+ return 0;
+ }
+ } else {
+ memcpy((VOID *) header, (VOID *) data, 10);
+ }
+ *widthPtr = LM_to_uint(header[6],header[7]);
+ *heightPtr = LM_to_uint(header[8],header[9]);
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringReadGif -- --
+ *
+ * This procedure is called by the photo image type to read
+ * GIF format data from an object, optionally base64 encoded,
+ * and give it to the photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in the interp's result.
+ *
+ * Side effects:
+ * new data is added to the image given by imageHandle. This
+ * procedure calls FileReadGif by redefining the operation of
+ * fprintf temporarily.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringReadGIF(interp, dataObj, format, imageHandle,
+ destX, destY, width, height, srcX, srcY)
+ Tcl_Interp *interp; /* interpreter for reporting errors in */
+ Tcl_Obj *dataObj; /* object containing the image */
+ Tcl_Obj *format; /* format object, or NULL */
+ Tk_PhotoHandle imageHandle; /* the image to write this data into */
+ int destX, destY; /* The rectangular region of the */
+ int width, height; /* image to copy */
+ int srcX, srcY;
+{
+ int result;
+ MFile handle;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_Channel dataSrc;
+ char *data;
+
+ /*
+ * Check whether the data is Base64 encoded
+ */
+ data = (char *) Tcl_GetByteArrayFromObj(dataObj, NULL);
+ if ((strncmp(GIF87a, data, 6) != 0) && (strncmp(GIF89a, data, 6) != 0)) {
+ mInit((unsigned char *)data, &handle);
+ tsdPtr->fromData = 1;
+ dataSrc = (Tcl_Channel) &handle;
+ } else {
+ tsdPtr->fromData = 2;
+ mInit((unsigned char *)data, &handle);
+ dataSrc = (Tcl_Channel) &handle;
+ }
+ result = FileReadGIF(interp, dataSrc, "inline data",
+ format, imageHandle, destX, destY, width, height, srcX, srcY);
+ tsdPtr->fromData = 0;
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadGIFHeader --
+ *
+ * This procedure reads the GIF header from the beginning of a
+ * GIF file and returns the dimensions of the image.
+ *
+ * Results:
+ * The return value is 1 if file "f" appears to start with
+ * a valid GIF header, 0 otherwise. If the header is valid,
+ * then *widthPtr and *heightPtr are modified to hold the
+ * dimensions of the image.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadGIFHeader(chan, widthPtr, heightPtr)
+ Tcl_Channel chan; /* Image file to read the header from */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+{
+ unsigned char buf[7];
+
+ if ((Fread(buf, 1, 6, chan) != 6)
+ || ((strncmp(GIF87a, (char *) buf, 6) != 0)
+ && (strncmp(GIF89a, (char *) buf, 6) != 0))) {
+ return 0;
+ }
+
+ if (Fread(buf, 1, 4, chan) != 4) {
+ return 0;
+ }
+
+ *widthPtr = LM_to_uint(buf[0],buf[1]);
+ *heightPtr = LM_to_uint(buf[2],buf[3]);
+ return 1;
+}
+
+/*
+ *-----------------------------------------------------------------
+ * The code below is copied from the giftoppm program and modified
+ * just slightly.
+ *-----------------------------------------------------------------
+ */
+
+static int
+ReadColorMap(chan, number, buffer)
+ Tcl_Channel chan;
+ int number;
+ unsigned char buffer[MAXCOLORMAPSIZE][4];
+{
+ int i;
+ unsigned char rgb[3];
+
+ for (i = 0; i < number; ++i) {
+ if (! ReadOK(chan, rgb, sizeof(rgb))) {
+ return 0;
+ }
+
+ if (buffer) {
+ buffer[i][CM_RED] = rgb[0] ;
+ buffer[i][CM_GREEN] = rgb[1] ;
+ buffer[i][CM_BLUE] = rgb[2] ;
+ buffer[i][CM_ALPHA] = 255 ;
+ }
+ }
+ return 1;
+}
+
+
+
+static int
+DoExtension(chan, label, transparent)
+ Tcl_Channel chan;
+ int label;
+ int *transparent;
+{
+ static unsigned char buf[256];
+ int count;
+
+ switch (label) {
+ case 0x01: /* Plain Text Extension */
+ break;
+
+ case 0xff: /* Application Extension */
+ break;
+
+ case 0xfe: /* Comment Extension */
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+
+ case 0xf9: /* Graphic Control Extension */
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ if (count < 0) {
+ return 1;
+ }
+ if ((buf[0] & 0x1) != 0) {
+ *transparent = buf[3];
+ }
+
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+ }
+
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+}
+
+static int ZeroDataBlock = 0;
+
+static int
+GetDataBlock(chan, buf)
+ Tcl_Channel chan;
+ unsigned char *buf;
+{
+ unsigned char count;
+
+ if (! ReadOK(chan, &count,1)) {
+ return -1;
+ }
+
+ ZeroDataBlock = count == 0;
+
+ if ((count != 0) && (! ReadOK(chan, buf, count))) {
+ return -1;
+ }
+
+ return count;
+}
+
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadImage --
+ *
+ * Process a GIF image from a given source, with a given height,
+ * width, transparency, etc.
+ *
+ * This code is based on the code found in the ImageMagick GIF decoder,
+ * which is (c) 2000 ImageMagick Studio.
+ *
+ * Some thoughts on our implementation:
+ * It sure would be nice if ReadImage didn't take 11 parameters! I think
+ * that if we were smarter, we could avoid doing that.
+ *
+ * Possible further optimizations: we could pull the GetCode function
+ * directly into ReadImage, which would improve our speed.
+ *
+ * Results:
+ * Processes a GIF image and loads the pixel data into a memory array.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadImage(interp, imagePtr, chan, len, rows, cmap,
+ width, height, srcX, srcY, interlace, transparent)
+ Tcl_Interp *interp;
+ char *imagePtr;
+ Tcl_Channel chan;
+ int len, rows;
+ unsigned char cmap[MAXCOLORMAPSIZE][4];
+ int width, height;
+ int srcX, srcY;
+ int interlace;
+ int transparent;
+{
+ unsigned char initialCodeSize;
+ int v;
+ int xpos = 0, ypos = 0, pass = 0, i;
+ register char *pixelPtr;
+ CONST static int interlaceStep[] = { 8, 8, 4, 2 };
+ CONST static int interlaceStart[] = { 0, 4, 2, 1 };
+ unsigned short prefix[(1 << MAX_LWZ_BITS)];
+ unsigned char append[(1 << MAX_LWZ_BITS)];
+ unsigned char stack[(1 << MAX_LWZ_BITS)*2];
+ register unsigned char *top;
+ int codeSize, clearCode, inCode, endCode, oldCode, maxCode;
+ int code, firstCode;
+
+ /*
+ * Initialize the decoder
+ */
+ if (! ReadOK(chan, &initialCodeSize, 1)) {
+ Tcl_AppendResult(interp, "error reading GIF image: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (transparent != -1) {
+ cmap[transparent][CM_RED] = 0;
+ cmap[transparent][CM_GREEN] = 0;
+ cmap[transparent][CM_BLUE] = 0;
+ cmap[transparent][CM_ALPHA] = 0;
+ }
+
+ pixelPtr = imagePtr;
+
+ /*
+ * Initialize the decoder.
+ *
+ * Set values for "special" numbers:
+ * clear code reset the decoder
+ * end code stop decoding
+ * code size size of the next code to retrieve
+ * max code next available table position
+ */
+ clearCode = 1 << (int) initialCodeSize;
+ endCode = clearCode + 1;
+ codeSize = (int) initialCodeSize + 1;
+ maxCode = clearCode + 2;
+ oldCode = -1;
+ firstCode = -1;
+
+ memset((void *)prefix, 0, (1 << MAX_LWZ_BITS) * sizeof(short));
+ memset((void *)append, 0, (1 << MAX_LWZ_BITS) * sizeof(char));
+ for (i = 0; i < clearCode; i++) {
+ append[i] = i;
+ }
+ top = stack;
+
+ GetCode(chan, 0, 1);
+
+ /*
+ * Read until we finish the image
+ */
+ for (i = 0, ypos = 0; i < rows; i++) {
+ for (xpos = 0; xpos < len; ) {
+
+ if (top == stack) {
+ /*
+ * Bummer -- our stack is empty. Now we have to work!
+ */
+ code = GetCode(chan, codeSize, 0);
+ if (code < 0) {
+ return TCL_OK;
+ }
+
+ if (code > maxCode || code == endCode) {
+ /*
+ * If we're doing things right, we should never
+ * receive a code that is greater than our current
+ * maximum code. If we do, bail, because our decoder
+ * does not yet have that code set up.
+ *
+ * If the code is the magic endCode value, quit.
+ */
+ return TCL_OK;
+ }
+
+ if (code == clearCode) {
+ /*
+ * Reset the decoder.
+ */
+ codeSize = initialCodeSize + 1;
+ maxCode = clearCode + 2;
+ oldCode = -1;
+ continue;
+ }
+
+ if (oldCode == -1) {
+ /*
+ * Last pass reset the decoder, so the first code we
+ * see must be a singleton. Seed the stack with it,
+ * and set up the old/first code pointers for
+ * insertion into the string table. We can't just
+ * roll this into the clearCode test above, because
+ * at that point we have not yet read the next code.
+ */
+ *top++ = append[code];
+ oldCode = code;
+ firstCode = code;
+ continue;
+ }
+
+ inCode = code;
+
+ if (code == maxCode) {
+ /*
+ * maxCode is always one bigger than our highest assigned
+ * code. If the code we see is equal to maxCode, then
+ * we are about to add a new string to the table. ???
+ */
+ *top++ = firstCode;
+ code = oldCode;
+ }
+
+ while (code > clearCode) {
+ /*
+ * Populate the stack by tracing the string in the
+ * string table from its tail to its head
+ */
+ *top++ = append[code];
+ code = prefix[code];
+ }
+ firstCode = append[code];
+
+ /*
+ * If there's no more room in our string table, quit.
+ * Otherwise, add a new string to the table
+ */
+ if (maxCode >= (1 << MAX_LWZ_BITS)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Push the head of the string onto the stack.
+ */
+ *top++ = firstCode;
+
+ /*
+ * Add a new string to the string table
+ */
+ prefix[maxCode] = oldCode;
+ append[maxCode] = firstCode;
+ maxCode++;
+
+ /*
+ * maxCode tells us the maximum code value we can accept.
+ * If we see that we need more bits to represent it than
+ * we are requesting from the unpacker, we need to increase
+ * the number we ask for.
+ */
+ if ((maxCode >= (1 << codeSize))
+ && (maxCode < (1<<MAX_LWZ_BITS))) {
+ codeSize++;
+ }
+ oldCode = inCode;
+ }
+
+ /*
+ * Pop the next color index off the stack.
+ */
+ v = *(--top);
+ if (v < 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * If pixelPtr is null, we're skipping this image (presumably
+ * there are more in the file and we will be called to read
+ * one of them later)
+ */
+ *pixelPtr++ = cmap[v][CM_RED];
+ *pixelPtr++ = cmap[v][CM_GREEN];
+ *pixelPtr++ = cmap[v][CM_BLUE];
+ if (transparent >= 0) {
+ *pixelPtr++ = cmap[v][CM_ALPHA];
+ }
+ xpos++;
+
+ }
+
+ /*
+ * If interlacing, the next ypos is not just +1
+ */
+ if (interlace) {
+ ypos += interlaceStep[pass];
+ while (ypos >= height) {
+ pass++;
+ if (pass > 3) {
+ return TCL_OK;
+ }
+ ypos = interlaceStart[pass];
+ }
+ } else {
+ ypos++;
+ }
+ pixelPtr = imagePtr + (ypos) * len * ((transparent>=0)?4:3);
+ }
+ return TCL_OK;
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCode --
+ *
+ * Extract the next compression code from the file. In GIF's, the
+ * compression codes are between 3 and 12 bits long and are then
+ * packed into 8 bit bytes, left to right, for example:
+ * bbbaaaaa
+ * dcccccbb
+ * eeeedddd
+ * ...
+ * We use a byte buffer read from the file and a sliding window
+ * to unpack the bytes. Thanks to ImageMagick for the sliding window
+ * idea.
+ * args: chan the channel to read from
+ * code_size size of the code to extract
+ * flag boolean indicating whether the extractor
+ * should be reset or not
+ *
+ * Results:
+ * code the next compression code
+ *
+ * Side effects:
+ * May consume more input from chan.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetCode(chan, code_size, flag)
+ Tcl_Channel chan;
+ int code_size;
+ int flag;
+{
+ static unsigned char buf[280];
+ static int bytes = 0, done;
+ static unsigned char *c;
+
+ static unsigned int window;
+ static int bitsInWindow = 0;
+ int ret;
+
+ if (flag) {
+ /*
+ * Initialize the decoder.
+ */
+ bitsInWindow = 0;
+ bytes = 0;
+ window = 0;
+ done = 0;
+ c = NULL;
+ return 0;
+ }
+
+ while (bitsInWindow < code_size) {
+ /*
+ * Not enough bits in our window to cover the request.
+ */
+ if (done) {
+ return -1;
+ }
+ if (bytes == 0) {
+ /*
+ * Not enough bytes in our buffer to add to the window.
+ */
+ bytes = GetDataBlock(chan, buf);
+ c = buf;
+ if (bytes <= 0) {
+ done = 1;
+ break;
+ }
+ }
+ /*
+ * Tack another byte onto the window, see if that's enough.
+ */
+ window += (*c) << bitsInWindow;
+ c++;
+ bitsInWindow += 8;
+ bytes--;
+ }
+
+
+ /*
+ * The next code will always be the last code_size bits of the window.
+ */
+ ret = window & ((1 << code_size) - 1);
+
+ /*
+ * Shift data in the window to put the next code at the end.
+ */
+ window >>= code_size;
+ bitsInWindow -= code_size;
+ return ret;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Minit -- --
+ *
+ * This procedure initializes a base64 decoder handle
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * the base64 handle is initialized
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+mInit(string, handle)
+ unsigned char *string; /* string containing initial mmencoded data */
+ MFile *handle; /* mmdecode "file" handle */
+{
+ handle->data = string;
+ handle->state = 0;
+ handle->c = 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mread --
+ *
+ * This procedure is invoked by the GIF file reader as a
+ * temporary replacement for "fread", to get GIF data out
+ * of a string (using Mgetc).
+ *
+ * Results:
+ * The return value is the number of characters "read"
+ *
+ * Side effects:
+ * The base64 handle will change state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Mread(dst, chunkSize, numChunks, handle)
+ unsigned char *dst; /* where to put the result */
+ size_t chunkSize; /* size of each transfer */
+ size_t numChunks; /* number of chunks */
+ MFile *handle; /* mmdecode "file" handle */
+{
+ register int i, c;
+ int count = chunkSize * numChunks;
+
+ for(i=0; i<count && (c=Mgetc(handle)) != GIF_DONE; i++) {
+ *dst++ = c;
+ }
+ return i;
+}
+
+/*
+ * get the next decoded character from an mmencode handle
+ * This causes at least 1 character to be "read" from the encoded string
+ */
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mgetc --
+ *
+ * This procedure decodes and returns the next byte from a base64
+ * encoded string.
+ *
+ * Results:
+ * The next byte (or GIF_DONE) is returned.
+ *
+ * Side effects:
+ * The base64 handle will change state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Mgetc(handle)
+ MFile *handle; /* Handle containing decoder data and state */
+{
+ int c;
+ int result = 0; /* Initialization needed only to prevent
+ * gcc compiler warning. */
+
+ if (handle->state == GIF_DONE) {
+ return GIF_DONE;
+ }
+
+ do {
+ c = char64(*handle->data);
+ handle->data++;
+ } while (c == GIF_SPACE);
+
+ if (c>GIF_SPECIAL) {
+ handle->state = GIF_DONE;
+ return handle->c;
+ }
+
+ switch (handle->state++) {
+ case 0:
+ handle->c = c<<2;
+ result = Mgetc(handle);
+ break;
+ case 1:
+ result = handle->c | (c>>4);
+ handle->c = (c&0xF)<<4;
+ break;
+ case 2:
+ result = handle->c | (c>>2);
+ handle->c = (c&0x3) << 6;
+ break;
+ case 3:
+ result = handle->c | c;
+ handle->state = 0;
+ break;
+ }
+ return result;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * char64 --
+ *
+ * This procedure converts a base64 ascii character into its binary
+ * equivalent. This code is a slightly modified version of the
+ * char64 proc in N. Borenstein's metamail decoder.
+ *
+ * Results:
+ * The binary value, or an error code.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+static int
+char64(c)
+int c;
+{
+ switch(c) {
+ case 'A': return 0; case 'B': return 1; case 'C': return 2;
+ case 'D': return 3; case 'E': return 4; case 'F': return 5;
+ case 'G': return 6; case 'H': return 7; case 'I': return 8;
+ case 'J': return 9; case 'K': return 10; case 'L': return 11;
+ case 'M': return 12; case 'N': return 13; case 'O': return 14;
+ case 'P': return 15; case 'Q': return 16; case 'R': return 17;
+ case 'S': return 18; case 'T': return 19; case 'U': return 20;
+ case 'V': return 21; case 'W': return 22; case 'X': return 23;
+ case 'Y': return 24; case 'Z': return 25; case 'a': return 26;
+ case 'b': return 27; case 'c': return 28; case 'd': return 29;
+ case 'e': return 30; case 'f': return 31; case 'g': return 32;
+ case 'h': return 33; case 'i': return 34; case 'j': return 35;
+ case 'k': return 36; case 'l': return 37; case 'm': return 38;
+ case 'n': return 39; case 'o': return 40; case 'p': return 41;
+ case 'q': return 42; case 'r': return 43; case 's': return 44;
+ case 't': return 45; case 'u': return 46; case 'v': return 47;
+ case 'w': return 48; case 'x': return 49; case 'y': return 50;
+ case 'z': return 51; case '0': return 52; case '1': return 53;
+ case '2': return 54; case '3': return 55; case '4': return 56;
+ case '5': return 57; case '6': return 58; case '7': return 59;
+ case '8': return 60; case '9': return 61; case '+': return 62;
+ case '/': return 63;
+
+ case ' ': case '\t': case '\n': case '\r': case '\f':
+ return GIF_SPACE;
+ case '=':
+ return GIF_PAD;
+ case '\0':
+ return GIF_DONE;
+ default:
+ return GIF_BAD;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Fread --
+ *
+ * This procedure calls either fread or Mread to read data
+ * from a file or a base64 encoded string.
+ *
+ * Results: - same as fread
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Fread(dst, hunk, count, chan)
+ unsigned char *dst; /* where to put the result */
+ size_t hunk,count; /* how many */
+ Tcl_Channel chan;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ MFile *handle;
+
+ switch (tsdPtr->fromData) {
+ case 1:
+ return Mread(dst, hunk, count, (MFile *) chan);
+ case 2:
+ handle = (MFile *) chan;
+ memcpy((VOID *)dst, (VOID *) handle->data, (size_t) (hunk * count));
+ handle->data += hunk * count;
+ return (int)(hunk * count);
+ default:
+ return Tcl_Read(chan, (char *) dst, (int) (hunk * count));
+ }
+}
+
+\f
+/*
+ * ChanWriteGIF - writes a image in GIF format.
+ *-------------------------------------------------------------------------
+ * Author: Lolo
+ * Engeneering Projects Area
+ * Department of Mining
+ * University of Oviedo
+ * e-mail zz11425958@zeus.etsimo.uniovi.es
+ * lolo@pcsig22.etsimo.uniovi.es
+ * Date: Fri September 20 1996
+ *
+ * Modified for transparency handling (gif89a) and miGIF compression
+ * by Jan Nijtmans <j.nijtmans@chello.nl>
+ *
+ *----------------------------------------------------------------------
+ * FileWriteGIF-
+ *
+ * This procedure is called by the photo image type to write
+ * GIF format data from a photo image into a given file
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in interp->result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /*
+ * Types, defines and variables needed to write and compress a GIF.
+ */
+
+typedef int (* ifunptr) _ANSI_ARGS_((void));
+
+#define LSB(a) ((unsigned char) (((short)(a)) & 0x00FF))
+#define MSB(a) ((unsigned char) (((short)(a)) >> 8))
+
+#define GIFBITS 12
+#define HSIZE 5003 /* 80% occupancy */
+
+static int ssize;
+static int csize;
+static int rsize;
+static unsigned char *pixelo;
+static int pixelSize;
+static int pixelPitch;
+static int greenOffset;
+static int blueOffset;
+static int alphaOffset;
+static int num;
+static unsigned char mapa[MAXCOLORMAPSIZE][3];
+
+/*
+ * Definition of new functions to write GIFs
+ */
+
+static int color _ANSI_ARGS_((int red,int green, int blue,
+ unsigned char mapa[MAXCOLORMAPSIZE][3]));
+static void compress _ANSI_ARGS_((int init_bits, Tcl_Channel handle,
+ ifunptr readValue));
+static int nuevo _ANSI_ARGS_((int red, int green ,int blue,
+ unsigned char mapa[MAXCOLORMAPSIZE][3]));
+static void savemap _ANSI_ARGS_((Tk_PhotoImageBlock *blockPtr,
+ unsigned char mapa[MAXCOLORMAPSIZE][3]));
+static int ReadValue _ANSI_ARGS_((void));
+
+static int
+FileWriteGIF(interp, filename, format, blockPtr)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ CONST char *filename;
+ Tcl_Obj *format;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ Tcl_Channel chan = NULL;
+ int result;
+
+ chan = Tcl_OpenFileChannel(interp, (char *) filename, "w", 0644);
+ if (!chan) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ result = CommonWriteGIF(interp, chan, format, blockPtr);
+ if (Tcl_Close(interp, chan) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ return result;
+}
+
+#define Mputc(c,handle) Tcl_Write(handle,(char *) &c,1)
+
+static int
+CommonWriteGIF(interp, handle, format, blockPtr)
+ Tcl_Interp *interp;
+ Tcl_Channel handle;
+ Tcl_Obj *format;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ int resolution;
+
+ long width,height,x;
+ unsigned char c;
+ unsigned int top,left;
+
+ top = 0;
+ left = 0;
+
+ pixelSize = blockPtr->pixelSize;
+ greenOffset = blockPtr->offset[1]-blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2]-blockPtr->offset[0];
+ alphaOffset = blockPtr->offset[0];
+ if (alphaOffset < blockPtr->offset[2]) {
+ alphaOffset = blockPtr->offset[2];
+ }
+ if (++alphaOffset < pixelSize) {
+ alphaOffset -= blockPtr->offset[0];
+ } else {
+ alphaOffset = 0;
+ }
+
+ Tcl_Write(handle, (char *) (alphaOffset ? GIF89a : GIF87a), 6);
+
+ for (x=0 ; x<MAXCOLORMAPSIZE ; x++) {
+ mapa[x][CM_RED] = 255;
+ mapa[x][CM_GREEN] = 255;
+ mapa[x][CM_BLUE] = 255;
+ }
+
+
+ width = blockPtr->width;
+ height = blockPtr->height;
+ pixelo = blockPtr->pixelPtr + blockPtr->offset[0];
+ pixelPitch = blockPtr->pitch;
+ savemap(blockPtr,mapa);
+ if (num >= MAXCOLORMAPSIZE) {
+ Tcl_AppendResult(interp, "too many colors", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (num<2) {
+ num = 2;
+ }
+ c = LSB(width);
+ Mputc(c,handle);
+ c = MSB(width);
+ Mputc(c,handle);
+ c = LSB(height);
+ Mputc(c,handle);
+ c = MSB(height);
+ Mputc(c,handle);
+
+ resolution = 0;
+ while (num >> resolution) {
+ resolution++;
+ }
+ c = 111 + resolution * 17;
+ Mputc(c,handle);
+
+ num = 1 << resolution;
+
+ /*
+ * background color
+ */
+
+ c = 0;
+ Mputc(c,handle);
+
+ /*
+ * zero for future expansion.
+ */
+
+ Mputc(c,handle);
+
+ for (x=0 ; x<num ; x++) {
+ c = mapa[x][CM_RED];
+ Mputc(c,handle);
+ c = mapa[x][CM_GREEN];
+ Mputc(c,handle);
+ c = mapa[x][CM_BLUE];
+ Mputc(c,handle);
+ }
+
+ /*
+ * Write out extension for transparent colour index, if necessary.
+ */
+
+ if (alphaOffset) {
+ c = GIF_EXTENSION;
+ Mputc(c, handle);
+ Tcl_Write(handle, "\371\4\1\0\0\0", 7);
+ }
+
+ c = GIF_START;
+ Mputc(c,handle);
+ c = LSB(top);
+ Mputc(c,handle);
+ c = MSB(top);
+ Mputc(c,handle);
+ c = LSB(left);
+ Mputc(c,handle);
+ c = MSB(left);
+ Mputc(c,handle);
+
+ c = LSB(width);
+ Mputc(c,handle);
+ c = MSB(width);
+ Mputc(c,handle);
+
+ c = LSB(height);
+ Mputc(c,handle);
+ c = MSB(height);
+ Mputc(c,handle);
+
+ c = 0;
+ Mputc(c,handle);
+ c = resolution;
+ Mputc(c,handle);
+
+ ssize = rsize = blockPtr->width;
+ csize = blockPtr->height;
+ compress(resolution+1, handle, ReadValue);
+
+ c = 0;
+ Mputc(c,handle);
+ c = GIF_TERMINATOR;
+ Mputc(c,handle);
+
+ return TCL_OK;
+}
+
+static int
+color(red, green, blue, mapa)
+ int red;
+ int green;
+ int blue;
+ unsigned char mapa[MAXCOLORMAPSIZE][3];
+{
+ int x;
+ for (x=(alphaOffset != 0) ; x<=MAXCOLORMAPSIZE ; x++) {
+ if ((mapa[x][CM_RED] == red) && (mapa[x][CM_GREEN] == green) &&
+ (mapa[x][CM_BLUE] == blue)) {
+ return x;
+ }
+ }
+ return -1;
+}
+
+\f
+static int
+nuevo(red, green, blue, mapa)
+ int red,green,blue;
+ unsigned char mapa[MAXCOLORMAPSIZE][3];
+{
+ int x = (alphaOffset != 0);
+ for (; x<=num ; x++) {
+ if ((mapa[x][CM_RED] == red) && (mapa[x][CM_GREEN] == green) &&
+ (mapa[x][CM_BLUE] == blue)) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
+static void
+savemap(blockPtr,mapa)
+ Tk_PhotoImageBlock *blockPtr;
+ unsigned char mapa[MAXCOLORMAPSIZE][3];
+{
+ unsigned char *colores;
+ int x,y;
+ unsigned char red,green,blue;
+
+ if (alphaOffset) {
+ num = 0;
+ mapa[0][CM_RED] = 0xd9;
+ mapa[0][CM_GREEN] = 0xd9;
+ mapa[0][CM_BLUE] = 0xd9;
+ } else {
+ num = -1;
+ }
+
+ for(y=0 ; y<blockPtr->height ; y++) {
+ colores = blockPtr->pixelPtr + blockPtr->offset[0]
+ + y * blockPtr->pitch;
+ for(x=0 ; x<blockPtr->width ; x++) {
+ if (!alphaOffset || (colores[alphaOffset] != 0)) {
+ red = colores[0];
+ green = colores[greenOffset];
+ blue = colores[blueOffset];
+ if (nuevo(red,green,blue,mapa)) {
+ num++;
+ if (num >= MAXCOLORMAPSIZE) {
+ return;
+ }
+ mapa[num][CM_RED] = red;
+ mapa[num][CM_GREEN] = green;
+ mapa[num][CM_BLUE] = blue;
+ }
+ }
+ colores += pixelSize;
+ }
+ }
+ return;
+}
+
+static int
+ReadValue()
+{
+ unsigned int col;
+
+ if (csize == 0) {
+ return EOF;
+ }
+ if (alphaOffset && (pixelo[alphaOffset] == 0)) {
+ col = 0;
+ } else {
+ col = color(pixelo[0], pixelo[greenOffset], pixelo[blueOffset], mapa);
+ }
+ pixelo += pixelSize;
+ if (--ssize <= 0) {
+ ssize = rsize;
+ csize--;
+ pixelo += pixelPitch - (rsize * pixelSize);
+ }
+
+ return col;
+}
+
+\f
+
+/*
+ *-----------------------------------------------------------------------
+ *
+ * miGIF Compression - mouse and ivo's GIF-compatible compression
+ *
+ * -run length encoding compression routines-
+ *
+ * Copyright (C) 1998 Hutchison Avenue Software Corporation
+ * http://www.hasc.com
+ * info@hasc.com
+ *
+ * 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 and that both that copyright notice and this permission
+ * notice appear in supporting documentation. This software is
+ * provided "AS IS." The Hutchison Avenue Software Corporation
+ * disclaims all warranties, either express or implied, including but
+ * not limited to implied warranties of merchantability and fitness
+ * for a particular purpose, with respect to this code and
+ * accompanying documentation.
+ *
+ * The miGIF compression routines do not, strictly speaking, generate
+ * files conforming to the GIF spec, since the image data is not
+ * LZW-compressed (this is the point: in order to avoid transgression
+ * of the Unisys patent on the LZW algorithm.) However, miGIF
+ * generates data streams that any reasonably sane LZW decompresser
+ * will decompress to what we want.
+ *
+ * miGIF compression uses run length encoding. It compresses
+ * horizontal runs of pixels of the same color. This type of
+ * compression gives good results on images with many runs, for
+ * example images with lines, text and solid shapes on a solid-colored
+ * background. It gives little or no compression on images with few
+ * runs, for example digital or scanned photos.
+ *
+ * der Mouse
+ * mouse@rodents.montreal.qc.ca
+ * 7D C8 61 52 5D E7 2D 39 4E F1 31 3E E8 B3 27 4B
+ *
+ * ivo@hasc.com
+ *
+ * The Graphics Interchange Format(c) is the Copyright property of
+ * CompuServe Incorporated. GIF(sm) is a Service Mark property of
+ * CompuServe Incorporated.
+ *
+ *-----------------------------------------------------------------------
+ */
+
+static int rl_pixel;
+static int rl_basecode;
+static int rl_count;
+static int rl_table_pixel;
+static int rl_table_max;
+static int just_cleared;
+static int out_bits;
+static int out_bits_init;
+static int out_count;
+static int out_bump;
+static int out_bump_init;
+static int out_clear;
+static int out_clear_init;
+static int max_ocodes;
+static int code_clear;
+static int code_eof;
+static unsigned int obuf;
+static int obits;
+static Tcl_Channel ofile;
+static unsigned char oblock[256];
+static int oblen;
+
+/*
+ * Used only when debugging GIF compression code
+ */
+/* #define MIGIF_DEBUGGING_ENVARS */
+
+#ifdef MIGIF_DEBUGGING_ENVARS
+
+static int verbose_set = 0;
+static int verbose;
+#define MIGIF_VERBOSE (verbose_set?verbose:set_verbose())
+#define DEBUGMSG(printf_args) if (MIGIF_VERBOSE) { printf printf_args; }
+
+static int
+set_verbose(void)
+{
+ verbose = !!getenv("MIGIF_VERBOSE");
+ verbose_set = 1;
+ return verbose;
+}
+
+static CONST char *
+binformat(v, nbits)
+ unsigned int v;
+ int nbits;
+{
+ static char bufs[8][64];
+ static int bhand = 0;
+ unsigned int bit;
+ int bno;
+ char *bp;
+
+ bhand--;
+ if (bhand < 0) {
+ bhand = (sizeof(bufs) / sizeof(bufs[0])) - 1;
+ }
+ bp = &bufs[bhand][0];
+ for (bno=nbits-1,bit=((unsigned int)1)<<bno ; bno>=0 ; bno--,bit>>=1) {
+ *bp++ = (v & bit) ? '1' : '0';
+ if (((bno&3) == 0) && (bno != 0)) {
+ *bp++ = '.';
+ }
+ }
+ *bp = '\0';
+ return &bufs[bhand][0];
+}
+
+#else
+
+#define MIGIF_VERBOSE 0
+#define DEBUGMSG(printf_args) /* do nothing */
+
+#endif
+
+static void
+write_block()
+{
+ int i;
+ unsigned char c;
+
+ if (MIGIF_VERBOSE) {
+ printf("write_block %d:", oblen);
+ for (i=0 ; i<oblen ; i++) {
+ printf(" %02x", oblock[i]);
+ }
+ printf("\n");
+ }
+ c = oblen;
+ Tcl_Write(ofile, (char *) &c, 1);
+ Tcl_Write(ofile, (char *) &oblock[0], oblen);
+ oblen = 0;
+}
+
+static void
+block_out(c)
+ unsigned char c;
+{
+ DEBUGMSG(("block_out %s\n", binformat(c, 8)));
+ oblock[oblen++] = c;
+ if (oblen >= 255) {
+ write_block();
+ }
+}
+
+static void
+block_flush()
+{
+ DEBUGMSG(("block_flush\n"));
+ if (oblen > 0) {
+ write_block();
+ }
+}
+
+static void
+output(val)
+ int val;
+{
+ DEBUGMSG(("output %s [%s %d %d]\n", binformat(val, out_bits),
+ binformat(obuf, obits), obits, out_bits));
+ obuf |= val << obits;
+ obits += out_bits;
+ while (obits >= 8) {
+ block_out(obuf&0xff);
+ obuf >>= 8;
+ obits -= 8;
+ }
+ DEBUGMSG(("output leaving [%s %d]\n", binformat(obuf, obits), obits));
+}
+
+static void
+output_flush()
+{
+ DEBUGMSG(("output_flush\n"));
+ if (obits > 0) {
+ block_out(obuf);
+ }
+ block_flush();
+}
+
+static void
+did_clear()
+{
+ DEBUGMSG(("did_clear\n"));
+ out_bits = out_bits_init;
+ out_bump = out_bump_init;
+ out_clear = out_clear_init;
+ out_count = 0;
+ rl_table_max = 0;
+ just_cleared = 1;
+}
+
+static void
+output_plain(c)
+ int c;
+{
+ DEBUGMSG(("output_plain %s\n", binformat(c, out_bits)));
+ just_cleared = 0;
+ output(c);
+ out_count++;
+ if (out_count >= out_bump) {
+ out_bits++;
+ out_bump += 1 << (out_bits - 1);
+ }
+ if (out_count >= out_clear) {
+ output(code_clear);
+ did_clear();
+ }
+}
+
+static unsigned int
+isqrt(x)
+ unsigned int x;
+{
+ unsigned int r;
+ unsigned int v;
+
+ if (x < 2) {
+ return x;
+ }
+ for (v=x,r=1 ; v ; v>>=2,r<<=1);
+ while (1) {
+ v = ((x / r) + r) / 2;
+ if (v==r || v==r+1) {
+ return r;
+ }
+ r = v;
+ }
+}
+
+static unsigned int
+compute_triangle_count(count, nrepcodes)
+ unsigned int count;
+ unsigned int nrepcodes;
+{
+ unsigned int perrep;
+ unsigned int cost;
+
+ cost = 0;
+ perrep = (nrepcodes * (nrepcodes+1)) / 2;
+ while (count >= perrep) {
+ cost += nrepcodes;
+ count -= perrep;
+ }
+ if (count > 0) {
+ unsigned int n;
+ n = isqrt(count);
+ while (n*(n+1) >= 2*count) {
+ n--;
+ }
+ while (n*(n+1) < 2*count) {
+ n++;
+ }
+ cost += n;
+ }
+ return cost;
+}
+
+static void
+max_out_clear()
+{
+ out_clear = max_ocodes;
+}
+
+static void
+reset_out_clear()
+{
+ out_clear = out_clear_init;
+ if (out_count >= out_clear) {
+ output(code_clear);
+ did_clear();
+ }
+}
+
+static void
+rl_flush_fromclear(count)
+ int count;
+{
+ int n;
+
+ DEBUGMSG(("rl_flush_fromclear %d\n", count));
+ max_out_clear();
+ rl_table_pixel = rl_pixel;
+ n = 1;
+ while (count > 0) {
+ if (n == 1) {
+ rl_table_max = 1;
+ output_plain(rl_pixel);
+ count--;
+ } else if (count >= n) {
+ rl_table_max = n;
+ output_plain(rl_basecode+n-2);
+ count -= n;
+ } else if (count == 1) {
+ rl_table_max++;
+ output_plain(rl_pixel);
+ count = 0;
+ } else {
+ rl_table_max++;
+ output_plain(rl_basecode+count-2);
+ count = 0;
+ }
+ if (out_count == 0) {
+ n = 1;
+ } else {
+ n++;
+ }
+ }
+ reset_out_clear();
+ DEBUGMSG(("rl_flush_fromclear leaving table_max=%d\n", rl_table_max));
+}
+
+static void
+rl_flush_clearorrep(count)
+ int count;
+{
+ int withclr;
+
+ DEBUGMSG(("rl_flush_clearorrep %d\n", count));
+ withclr = 1 + compute_triangle_count(count, max_ocodes);
+ if (withclr < count) {
+ output(code_clear);
+ did_clear();
+ rl_flush_fromclear(count);
+ } else {
+ for (; count>0 ; count--) {
+ output_plain(rl_pixel);
+ }
+ }
+}
+
+static void
+rl_flush_withtable(count)
+ int count;
+{
+ int repmax;
+ int repleft;
+ int leftover;
+
+ DEBUGMSG(("rl_flush_withtable %d\n", count));
+ repmax = count / rl_table_max;
+ leftover = count % rl_table_max;
+ repleft = (leftover ? 1 : 0);
+ if (out_count+repmax+repleft > max_ocodes) {
+ repmax = max_ocodes - out_count;
+ leftover = count - (repmax * rl_table_max);
+ repleft = 1 + compute_triangle_count(leftover, max_ocodes);
+ }
+ DEBUGMSG(("rl_flush_withtable repmax=%d leftover=%d repleft=%d\n",
+ repmax, leftover, repleft));
+ if (1+(int)compute_triangle_count(count, max_ocodes) < repmax+repleft) {
+ output(code_clear);
+ did_clear();
+ rl_flush_fromclear(count);
+ return;
+ }
+ max_out_clear();
+ for (; repmax>0 ; repmax--) {
+ output_plain(rl_basecode + rl_table_max - 2);
+ }
+ if (leftover) {
+ if (just_cleared) {
+ rl_flush_fromclear(leftover);
+ } else if (leftover == 1) {
+ output_plain(rl_pixel);
+ } else {
+ output_plain(rl_basecode + leftover - 2);
+ }
+ }
+ reset_out_clear();
+}
+
+static void
+rl_flush()
+{
+ DEBUGMSG(("rl_flush [ %d %d\n", rl_count, rl_pixel));
+ if (rl_count == 1) {
+ output_plain(rl_pixel);
+ rl_count = 0;
+ DEBUGMSG(("rl_flush ]\n"));
+ return;
+ }
+ if (just_cleared) {
+ rl_flush_fromclear(rl_count);
+ } else if ((rl_table_max < 2) || (rl_table_pixel != rl_pixel)) {
+ rl_flush_clearorrep(rl_count);
+ } else {
+ rl_flush_withtable(rl_count);
+ }
+ DEBUGMSG(("rl_flush ]\n"));
+ rl_count = 0;
+}
+
+
+static void
+compress(init_bits, handle, readValue)
+ int init_bits;
+ Tcl_Channel handle;
+ ifunptr readValue;
+{
+ int c;
+
+ ofile = handle;
+ obuf = 0;
+ obits = 0;
+ oblen = 0;
+ code_clear = 1 << (init_bits - 1);
+ code_eof = code_clear + 1;
+ rl_basecode = code_eof + 1;
+ out_bump_init = (1 << (init_bits - 1)) - 1;
+ /*
+ * For images with a lot of runs, making out_clear_init larger
+ * will give better compression.
+ */
+ out_clear_init = (init_bits <= 3) ? 9 : (out_bump_init-1);
+#ifdef MIGIF_DEBUGGING_ENVARS
+ {
+ const char *ocienv;
+ ocienv = getenv("MIGIF_OUT_CLEAR_INIT");
+ if (ocienv) {
+ out_clear_init = atoi(ocienv);
+ DEBUGMSG(("[overriding out_clear_init to %d]\n", out_clear_init));
+ }
+ }
+#endif
+ out_bits_init = init_bits;
+ max_ocodes = (1 << GIFBITS) - ((1 << (out_bits_init - 1)) + 3);
+ did_clear();
+ output(code_clear);
+ rl_count = 0;
+ while (1) {
+ c = readValue();
+ if ((rl_count > 0) && (c != rl_pixel)) {
+ rl_flush();
+ }
+ if (c == EOF) {
+ break;
+ }
+ if (rl_pixel == c) {
+ rl_count++;
+ } else {
+ rl_pixel = c;
+ rl_count = 1;
+ }
+ }
+ output(code_eof);
+ output_flush();
+}
+
+/*
+ *-----------------------------------------------------------------------
+ *
+ * End of miGIF section - See copyright notice at start of section.
+ *
+ *-----------------------------------------------------------------------
+ */
--- /dev/null
+/*
+ * tkImgPPM.c --
+ *
+ * A photo image file handler for PPM (Portable PixMap) files.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * Author: Paul Mackerras (paulus@cs.anu.edu.au),
+ * Department of Computer Science,
+ * Australian National University.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define USE_OLD_IMAGE
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The maximum amount of memory to allocate for data read from the
+ * file. If we need more than this, we do it in pieces.
+ */
+
+#define MAX_MEMORY 10000 /* don't allocate > 10KB */
+
+/*
+ * Define PGM and PPM, i.e. gray images and color images.
+ */
+
+#define PGM 1
+#define PPM 2
+
+/*
+ * The format record for the PPM file format:
+ */
+
+static int FileMatchPPM _ANSI_ARGS_((Tcl_Channel chan,
+ char *fileName, char *formatString,
+ int *widthPtr, int *heightPtr));
+static int FileReadPPM _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, char *fileName,
+ char *formatString, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY));
+static int FileWritePPM _ANSI_ARGS_((Tcl_Interp *interp,
+ char *fileName, char *formatString,
+ Tk_PhotoImageBlock *blockPtr));
+
+Tk_PhotoImageFormat tkImgFmtPPM = {
+ "PPM", /* name */
+ FileMatchPPM, /* fileMatchProc */
+ NULL, /* stringMatchProc */
+ FileReadPPM, /* fileReadProc */
+ NULL, /* stringReadProc */
+ FileWritePPM, /* fileWriteProc */
+ NULL, /* stringWriteProc */
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static int ReadPPMFileHeader _ANSI_ARGS_((Tcl_Channel chan,
+ int *widthPtr, int *heightPtr,
+ int *maxIntensityPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchPPM --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * a file contains image data in PPM format.
+ *
+ * Results:
+ * The return value is >0 if the first characters in file "f" look
+ * like PPM data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchPPM(chan, fileName, formatString, widthPtr, heightPtr)
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here if the file is a valid
+ * raw PPM file. */
+{
+ int dummy;
+
+ return ReadPPMFileHeader(chan, widthPtr, heightPtr, &dummy);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadPPM --
+ *
+ * This procedure is called by the photo image type to read
+ * PPM format data from a file and write it into a given
+ * photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in the interp's result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is
+ * added to the image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY,
+ width, height, srcX, srcY)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoHandle imageHandle; /* The photo image to write into. */
+ int destX, destY; /* Coordinates of top-left pixel in
+ * photo image to be written to. */
+ int width, height; /* Dimensions of block of photo image to
+ * be written to. */
+ int srcX, srcY; /* Coordinates of top-left pixel to be used
+ * in image being read. */
+{
+ int fileWidth, fileHeight, maxIntensity;
+ int nLines, nBytes, h, type, count;
+ unsigned char *pixelPtr;
+ Tk_PhotoImageBlock block;
+
+ type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity);
+ if (type == 0) {
+ Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"",
+ fileName, "\"", NULL);
+ return TCL_ERROR;
+ }
+ if ((fileWidth <= 0) || (fileHeight <= 0)) {
+ Tcl_AppendResult(interp, "PPM image file \"", fileName,
+ "\" has dimension(s) <= 0", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((maxIntensity <= 0) || (maxIntensity >= 256)) {
+ char buffer[TCL_INTEGER_SPACE];
+
+ sprintf(buffer, "%d", maxIntensity);
+ Tcl_AppendResult(interp, "PPM image file \"", fileName,
+ "\" has bad maximum intensity value ", buffer,
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ if (type == PGM) {
+ block.pixelSize = 1;
+ block.offset[0] = 0;
+ block.offset[1] = 0;
+ block.offset[2] = 0;
+ }
+ else {
+ block.pixelSize = 3;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ }
+ block.offset[3] = 0;
+ block.width = width;
+ block.pitch = block.pixelSize * fileWidth;
+
+ Tk_PhotoExpand(imageHandle, destX + width, destY + height);
+
+ if (srcY > 0) {
+ Tcl_Seek(chan, (Tcl_WideInt)(srcY * block.pitch), SEEK_CUR);
+ }
+
+ nLines = (MAX_MEMORY + block.pitch - 1) / block.pitch;
+ if (nLines > height) {
+ nLines = height;
+ }
+ if (nLines <= 0) {
+ nLines = 1;
+ }
+ nBytes = nLines * block.pitch;
+ pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+ block.pixelPtr = pixelPtr + srcX * block.pixelSize;
+
+ for (h = height; h > 0; h -= nLines) {
+ if (nLines > h) {
+ nLines = h;
+ nBytes = nLines * block.pitch;
+ }
+ count = Tcl_Read(chan, (char *) pixelPtr, nBytes);
+ if (count != nBytes) {
+ Tcl_AppendResult(interp, "error reading PPM image file \"",
+ fileName, "\": ",
+ Tcl_Eof(chan) ? "not enough data" : Tcl_PosixError(interp),
+ (char *) NULL);
+ ckfree((char *) pixelPtr);
+ return TCL_ERROR;
+ }
+ if (maxIntensity != 255) {
+ unsigned char *p;
+
+ for (p = pixelPtr; count > 0; count--, p++) {
+ *p = (((int) *p) * 255)/maxIntensity;
+ }
+ }
+ block.height = nLines;
+ Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, nLines,
+ TK_PHOTO_COMPOSITE_SET);
+ destY += nLines;
+ }
+
+ ckfree((char *) pixelPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWritePPM --
+ *
+ * This procedure is invoked to write image data to a file in PPM
+ * format.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Data is written to the file given by "fileName".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileWritePPM(interp, fileName, formatString, blockPtr)
+ Tcl_Interp *interp;
+ char *fileName;
+ char *formatString;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ Tcl_Channel chan;
+ int w, h;
+ int greenOffset, blueOffset, nBytes;
+ unsigned char *pixelPtr, *pixLinePtr;
+ char header[16 + TCL_INTEGER_SPACE * 2];
+
+ chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
+ Tcl_Write(chan, header, -1);
+
+ pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
+ && (blockPtr->pitch == (blockPtr->width * 3))) {
+ nBytes = blockPtr->height * blockPtr->pitch;
+ if (Tcl_Write(chan, (char *) pixLinePtr, nBytes) != nBytes) {
+ goto writeerror;
+ }
+ } else {
+ for (h = blockPtr->height; h > 0; h--) {
+ pixelPtr = pixLinePtr;
+ for (w = blockPtr->width; w > 0; w--) {
+ if ((Tcl_Write(chan, (char *) &pixelPtr[0], 1) == -1)
+ || (Tcl_Write(chan, (char *) &pixelPtr[greenOffset], 1) == -1)
+ || (Tcl_Write(chan, (char *) &pixelPtr[blueOffset], 1) == -1)) {
+ goto writeerror;
+ }
+ pixelPtr += blockPtr->pixelSize;
+ }
+ pixLinePtr += blockPtr->pitch;
+ }
+ }
+
+ if (Tcl_Close(NULL, chan) == 0) {
+ return TCL_OK;
+ }
+ chan = NULL;
+
+ writeerror:
+ Tcl_AppendResult(interp, "error writing \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadPPMFileHeader --
+ *
+ * This procedure reads the PPM header from the beginning of a
+ * PPM file and returns information from the header.
+ *
+ * Results:
+ * The return value is PGM if file "f" appears to start with
+ * a valid PGM header, PPM if "f" appears to start with a valid
+ * PPM header, and 0 otherwise. If the header is valid,
+ * then *widthPtr and *heightPtr are modified to hold the
+ * dimensions of the image and *maxIntensityPtr is modified to
+ * hold the value of a "fully on" intensity value.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
+ Tcl_Channel chan; /* Image file to read the header from */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+ int *maxIntensityPtr; /* The maximum intensity value for
+ * the image is stored here. */
+{
+#define BUFFER_SIZE 1000
+ char buffer[BUFFER_SIZE];
+ int i, numFields;
+ int type = 0;
+ char c;
+
+ /*
+ * Read 4 space-separated fields from the file, ignoring
+ * comments (any line that starts with "#").
+ */
+
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ i = 0;
+ for (numFields = 0; numFields < 4; numFields++) {
+ /*
+ * Skip comments and white space.
+ */
+
+ while (1) {
+ while (isspace(UCHAR(c))) {
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ }
+ if (c != '#') {
+ break;
+ }
+ do {
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ } while (c != '\n');
+ }
+
+ /*
+ * Read a field (everything up to the next white space).
+ */
+
+ while (!isspace(UCHAR(c))) {
+ if (i < (BUFFER_SIZE-2)) {
+ buffer[i] = c;
+ i++;
+ }
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ goto done;
+ }
+ }
+ if (i < (BUFFER_SIZE-1)) {
+ buffer[i] = ' ';
+ i++;
+ }
+ }
+ done:
+ buffer[i] = 0;
+
+ /*
+ * Parse the fields, which are: id, width, height, maxIntensity.
+ */
+
+ if (strncmp(buffer, "P6 ", 3) == 0) {
+ type = PPM;
+ } else if (strncmp(buffer, "P5 ", 3) == 0) {
+ type = PGM;
+ } else {
+ return 0;
+ }
+ if (sscanf(buffer+3, "%d %d %d", widthPtr, heightPtr, maxIntensityPtr)
+ != 3) {
+ return 0;
+ }
+ return type;
+}
--- /dev/null
+/*
+ * tkImgPhoto.c --
+ *
+ * Implements images of type "photo" for Tk. Photo images are
+ * stored in full color (32 bits per pixel) and displayed using
+ * dithering if necessary.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2002 Donal K. Fellows
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * Author: Paul Mackerras (paulus@cs.anu.edu.au),
+ * Department of Computer Science,
+ * Australian National University.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tclMath.h"
+#include <ctype.h>
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+/*
+ * Declaration for internal Xlib function used here:
+ */
+
+extern int _XInitImageFuncPtrs _ANSI_ARGS_((XImage *image));
+
+/*
+ * A signed 8-bit integral type. If chars are unsigned and the compiler
+ * isn't an ANSI one, then we have to use short instead (which wastes
+ * space) to get signed behavior.
+ */
+
+#if defined(__STDC__) || defined(_AIX)
+ typedef signed char schar;
+#else
+# ifndef __CHAR_UNSIGNED__
+ typedef char schar;
+# else
+ typedef short schar;
+# endif
+#endif
+
+/*
+ * An unsigned 32-bit integral type, used for pixel values.
+ * We use int rather than long here to accommodate those systems
+ * where longs are 64 bits.
+ */
+
+typedef unsigned int pixel;
+
+/*
+ * The maximum number of pixels to transmit to the server in a
+ * single XPutImage call.
+ */
+
+#define MAX_PIXELS 65536
+
+/*
+ * The set of colors required to display a photo image in a window depends on:
+ * - the visual used by the window
+ * - the palette, which specifies how many levels of each primary
+ * color to use, and
+ * - the gamma value for the image.
+ *
+ * Pixel values allocated for specific colors are valid only for the
+ * colormap in which they were allocated. Sets of pixel values
+ * allocated for displaying photos are re-used in other windows if
+ * possible, that is, if the display, colormap, palette and gamma
+ * values match. A hash table is used to locate these sets of pixel
+ * values, using the following data structure as key:
+ */
+
+typedef struct {
+ Display *display; /* Qualifies the colormap resource ID */
+ Colormap colormap; /* Colormap that the windows are using. */
+ double gamma; /* Gamma exponent value for images. */
+ Tk_Uid palette; /* Specifies how many shades of each primary
+ * we want to allocate. */
+} ColorTableId;
+
+/*
+ * For a particular (display, colormap, palette, gamma) combination,
+ * a data structure of the following type is used to store the allocated
+ * pixel values and other information:
+ */
+
+typedef struct ColorTable {
+ ColorTableId id; /* Information used in selecting this
+ * color table. */
+ int flags; /* See below. */
+ int refCount; /* Number of instances using this map. */
+ int liveRefCount; /* Number of instances which are actually
+ * in use, using this map. */
+ int numColors; /* Number of colors allocated for this map. */
+
+ XVisualInfo visualInfo; /* Information about the visual for windows
+ * using this color table. */
+
+ pixel redValues[256]; /* Maps 8-bit values of red intensity
+ * to a pixel value or index in pixelMap. */
+ pixel greenValues[256]; /* Ditto for green intensity */
+ pixel blueValues[256]; /* Ditto for blue intensity */
+ unsigned long *pixelMap; /* Actual pixel values allocated. */
+
+ unsigned char colorQuant[3][256];
+ /* Maps 8-bit intensities to quantized
+ * intensities. The first index is 0 for
+ * red, 1 for green, 2 for blue. */
+} ColorTable;
+
+/*
+ * Bit definitions for the flags field of a ColorTable.
+ * BLACK_AND_WHITE: 1 means only black and white colors are
+ * available.
+ * COLOR_WINDOW: 1 means a full 3-D color cube has been
+ * allocated.
+ * DISPOSE_PENDING: 1 means a call to DisposeColorTable has
+ * been scheduled as an idle handler, but it
+ * hasn't been invoked yet.
+ * MAP_COLORS: 1 means pixel values should be mapped
+ * through pixelMap.
+ */
+#ifdef COLOR_WINDOW
+#undef COLOR_WINDOW
+#endif
+
+#define BLACK_AND_WHITE 1
+#define COLOR_WINDOW 2
+#define DISPOSE_PENDING 4
+#define MAP_COLORS 8
+
+/*
+ * Definition of the data associated with each photo image master.
+ */
+
+typedef struct PhotoMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter associated with the
+ * application using this image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ int flags; /* Sundry flags, defined below. */
+ int width, height; /* Dimensions of image. */
+ int userWidth, userHeight; /* User-declared image dimensions. */
+ Tk_Uid palette; /* User-specified default palette for
+ * instances of this image. */
+ double gamma; /* Display gamma value to correct for. */
+ char *fileString; /* Name of file to read into image. */
+ Tcl_Obj *dataString; /* Object to use as contents of image. */
+ Tcl_Obj *format; /* User-specified format of data in image
+ * file or string value. */
+ unsigned char *pix24; /* Local storage for 24-bit image. */
+ int ditherX, ditherY; /* Location of first incorrectly
+ * dithered pixel in image. */
+ TkRegion validRegion; /* Tk region indicating which parts of
+ * the image have valid image data. */
+ struct PhotoInstance *instancePtr;
+ /* First in the list of instances
+ * associated with this master. */
+} PhotoMaster;
+
+/*
+ * Bit definitions for the flags field of a PhotoMaster.
+ * COLOR_IMAGE: 1 means that the image has different color
+ * components.
+ * IMAGE_CHANGED: 1 means that the instances of this image
+ * need to be redithered.
+ */
+
+#define COLOR_IMAGE 1
+#define IMAGE_CHANGED 2
+
+/*
+ * The following data structure represents all of the instances of
+ * a photo image in windows on a given screen that are using the
+ * same colormap.
+ */
+
+typedef struct PhotoInstance {
+ PhotoMaster *masterPtr; /* Pointer to master for image. */
+ Display *display; /* Display for windows using this instance. */
+ Colormap colormap; /* The image may only be used in windows with
+ * this particular colormap. */
+ struct PhotoInstance *nextPtr;
+ /* Pointer to the next instance in the list
+ * of instances associated with this master. */
+ int refCount; /* Number of instances using this structure. */
+ Tk_Uid palette; /* Palette for these particular instances. */
+ double gamma; /* Gamma value for these instances. */
+ Tk_Uid defaultPalette; /* Default palette to use if a palette
+ * is not specified for the master. */
+ ColorTable *colorTablePtr; /* Pointer to information about colors
+ * allocated for image display in windows
+ * like this one. */
+ Pixmap pixels; /* X pixmap containing dithered image. */
+ int width, height; /* Dimensions of the pixmap. */
+ schar *error; /* Error image, used in dithering. */
+ XImage *imagePtr; /* Image structure for converted pixels. */
+ XVisualInfo visualInfo; /* Information about the visual that these
+ * windows are using. */
+ GC gc; /* Graphics context for writing images
+ * to the pixmap. */
+} PhotoInstance;
+
+/*
+ * The following data structure is used to return information
+ * from ParseSubcommandOptions:
+ */
+
+struct SubcommandOptions {
+ int options; /* Individual bits indicate which
+ * options were specified - see below. */
+ Tcl_Obj *name; /* Name specified without an option. */
+ int fromX, fromY; /* Values specified for -from option. */
+ int fromX2, fromY2; /* Second coordinate pair for -from option. */
+ int toX, toY; /* Values specified for -to option. */
+ int toX2, toY2; /* Second coordinate pair for -to option. */
+ int zoomX, zoomY; /* Values specified for -zoom option. */
+ int subsampleX, subsampleY; /* Values specified for -subsample option. */
+ Tcl_Obj *format; /* Value specified for -format option. */
+ XColor *background; /* Value specified for -background option. */
+ int compositingRule; /* Value specified for -compositingrule opt */
+};
+
+/*
+ * Bit definitions for use with ParseSubcommandOptions:
+ * Each bit is set in the allowedOptions parameter on a call to
+ * ParseSubcommandOptions if that option is allowed for the current
+ * photo image subcommand. On return, the bit is set in the options
+ * field of the SubcommandOptions structure if that option was specified.
+ *
+ * OPT_BACKGROUND: Set if -format option allowed/specified.
+ * OPT_COMPOSITE: Set if -compositingrule option allowed/spec'd.
+ * OPT_FORMAT: Set if -format option allowed/specified.
+ * OPT_FROM: Set if -from option allowed/specified.
+ * OPT_GRAYSCALE: Set if -grayscale option allowed/specified.
+ * OPT_SHRINK: Set if -shrink option allowed/specified.
+ * OPT_SUBSAMPLE: Set if -subsample option allowed/spec'd.
+ * OPT_TO: Set if -to option allowed/specified.
+ * OPT_ZOOM: Set if -zoom option allowed/specified.
+ */
+
+#define OPT_BACKGROUND 1
+#define OPT_COMPOSITE 2
+#define OPT_FORMAT 4
+#define OPT_FROM 8
+#define OPT_GRAYSCALE 0x10
+#define OPT_SHRINK 0x20
+#define OPT_SUBSAMPLE 0x40
+#define OPT_TO 0x80
+#define OPT_ZOOM 0x100
+
+/*
+ * List of option names. The order here must match the order of
+ * declarations of the OPT_* constants above.
+ */
+
+static char *optionNames[] = {
+ "-background",
+ "-compositingrule",
+ "-format",
+ "-from",
+ "-grayscale",
+ "-shrink",
+ "-subsample",
+ "-to",
+ "-zoom",
+ (char *) NULL
+};
+
+/*
+ * Message to generate when an attempt to resize an image fails due
+ * to memory problems.
+ */
+#define TK_PHOTO_ALLOC_FAILURE_MESSAGE \
+ "not enough free memory for image buffer"
+
+/*
+ * Functions used in the type record for photo images.
+ */
+
+static int ImgPhotoCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int objc, Tcl_Obj *CONST objv[],
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgPhotoGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgPhotoDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgPhotoFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgPhotoDelete _ANSI_ARGS_((ClientData clientData));
+static int ImgPhotoPostscript _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, int x, int y, int width,
+ int height, int prepass));
+
+/*
+ * The type record itself for photo images:
+ */
+
+Tk_ImageType tkPhotoImageType = {
+ "photo", /* name */
+ ImgPhotoCreate, /* createProc */
+ ImgPhotoGet, /* getProc */
+ ImgPhotoDisplay, /* displayProc */
+ ImgPhotoFree, /* freeProc */
+ ImgPhotoDelete, /* deleteProc */
+ ImgPhotoPostscript, /* postscriptProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+typedef struct ThreadSpecificData {
+ Tk_PhotoImageFormat *formatList; /* Pointer to the first in the
+ * list of known photo image formats.*/
+ Tk_PhotoImageFormat *oldFormatList; /* Pointer to the first in the
+ * list of known photo image formats.*/
+ int initialized; /* set to 1 if we've initialized the strucuture */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Default configuration
+ */
+
+#define DEF_PHOTO_GAMMA "1"
+#define DEF_PHOTO_HEIGHT "0"
+#define DEF_PHOTO_PALETTE ""
+#define DEF_PHOTO_WIDTH "0"
+
+/*
+ * Information used for parsing configuration specifications:
+ */
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PhotoMaster, fileString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_DOUBLE, "-gamma", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_GAMMA, Tk_Offset(PhotoMaster, gamma), 0},
+ {TK_CONFIG_INT, "-height", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_HEIGHT, Tk_Offset(PhotoMaster, userHeight), 0},
+ {TK_CONFIG_UID, "-palette", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_PALETTE, Tk_Offset(PhotoMaster, palette), 0},
+ {TK_CONFIG_INT, "-width", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_WIDTH, Tk_Offset(PhotoMaster, userWidth), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Hash table used to hash from (display, colormap, palette, gamma)
+ * to ColorTable address.
+ */
+
+static Tcl_HashTable imgPhotoColorHash;
+static int imgPhotoColorHashInitialized;
+#define N_COLOR_HASH (sizeof(ColorTableId) / sizeof(int))
+
+/*
+ * Forward declarations
+ */
+
+static void PhotoFormatThreadExitProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ImgPhotoCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int ParseSubcommandOptions _ANSI_ARGS_((
+ struct SubcommandOptions *optPtr,
+ Tcl_Interp *interp, int allowedOptions,
+ int *indexPtr, int objc, Tcl_Obj *CONST objv[]));
+static void ImgPhotoCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ImgPhotoConfigureMaster _ANSI_ARGS_((
+ Tcl_Interp *interp, PhotoMaster *masterPtr,
+ int objc, Tcl_Obj *CONST objv[], int flags));
+static void ImgPhotoConfigureInstance _ANSI_ARGS_((
+ PhotoInstance *instancePtr));
+static int ImgPhotoSetSize _ANSI_ARGS_((PhotoMaster *masterPtr,
+ int width, int height));
+static void ImgPhotoInstanceSetSize _ANSI_ARGS_((
+ PhotoInstance *instancePtr));
+static int ImgStringWrite _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *formatString,
+ Tk_PhotoImageBlock *blockPtr));
+static char * ImgGetPhoto _ANSI_ARGS_((PhotoMaster *masterPtr,
+ Tk_PhotoImageBlock *blockPtr,
+ struct SubcommandOptions *optPtr));
+static int IsValidPalette _ANSI_ARGS_((PhotoInstance *instancePtr,
+ CONST char *palette));
+static int CountBits _ANSI_ARGS_((pixel mask));
+static void GetColorTable _ANSI_ARGS_((PhotoInstance *instancePtr));
+static void FreeColorTable _ANSI_ARGS_((ColorTable *colorPtr,
+ int force));
+static void AllocateColors _ANSI_ARGS_((ColorTable *colorPtr));
+static void DisposeColorTable _ANSI_ARGS_((ClientData clientData));
+static void DisposeInstance _ANSI_ARGS_((ClientData clientData));
+static int ReclaimColors _ANSI_ARGS_((ColorTableId *id,
+ int numColors));
+static int MatchFileFormat _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, char *fileName, Tcl_Obj *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr, int *oldformat));
+static int MatchStringFormat _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *data, Tcl_Obj *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr, int *oldformat));
+static Tcl_ObjCmdProc * PhotoOptionFind _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj *obj));
+static void DitherInstance _ANSI_ARGS_((PhotoInstance *instancePtr,
+ int x, int y, int width, int height));
+static void PhotoOptionCleanupProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+
+#undef MIN
+#define MIN(a, b) ((a) < (b)? (a): (b))
+#undef MAX
+#define MAX(a, b) ((a) > (b)? (a): (b))
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateOldPhotoImageFormat, Tk_CreatePhotoImageFormat --
+ *
+ * This procedure is invoked by an image file handler to register
+ * a new photo image format and the procedures that handle the
+ * new format. The procedure is typically invoked during
+ * Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image file format is entered into a table used in the
+ * photo image "read" and "write" subcommands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PhotoFormatThreadExitProc(clientData)
+ ClientData clientData; /* not used */
+{
+ Tk_PhotoImageFormat *freePtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ while (tsdPtr->oldFormatList != NULL) {
+ freePtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = tsdPtr->oldFormatList->nextPtr;
+ ckfree((char *) freePtr->name);
+ ckfree((char *) freePtr);
+ }
+ while (tsdPtr->formatList != NULL) {
+ freePtr = tsdPtr->formatList;
+ tsdPtr->formatList = tsdPtr->formatList->nextPtr;
+ ckfree((char *) freePtr->name);
+ ckfree((char *) freePtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateOldPhotoImageFormat, Tk_CreatePhotoImageFormat --
+ *
+ * This procedure is invoked by an image file handler to register
+ * a new photo image format and the procedures that handle the
+ * new format. The procedure is typically invoked during
+ * Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image file format is entered into a table used in the
+ * photo image "read" and "write" subcommands.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tk_CreateOldPhotoImageFormat(formatPtr)
+ Tk_PhotoImageFormat *formatPtr;
+ /* Structure describing the format. All of
+ * the fields except "nextPtr" must be filled
+ * in by caller. Must not have been passed
+ * to Tk_CreatePhotoImageFormat previously. */
+{
+ Tk_PhotoImageFormat *copyPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL);
+ }
+ copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat));
+ *copyPtr = *formatPtr;
+ copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1));
+ strcpy(copyPtr->name, formatPtr->name);
+ copyPtr->nextPtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = copyPtr;
+}
+
+void
+Tk_CreatePhotoImageFormat(formatPtr)
+ Tk_PhotoImageFormat *formatPtr;
+ /* Structure describing the format. All of
+ * the fields except "nextPtr" must be filled
+ * in by caller. Must not have been passed
+ * to Tk_CreatePhotoImageFormat previously. */
+{
+ Tk_PhotoImageFormat *copyPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL);
+ }
+ copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat));
+ *copyPtr = *formatPtr;
+ copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1));
+ strcpy(copyPtr->name, formatPtr->name);
+ if (isupper((unsigned char) *formatPtr->name)) {
+ copyPtr->nextPtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = copyPtr;
+ } else {
+ copyPtr->nextPtr = tsdPtr->formatList;
+ tsdPtr->formatList = copyPtr;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCreate --
+ *
+ * This procedure is called by the Tk image code to create
+ * a new photo image.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new photo image is allocated and
+ * initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoCreate(interp, name, objc, objv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ PhotoMaster *masterPtr;
+
+ /*
+ * Allocate and initialize the photo image master record.
+ */
+
+ masterPtr = (PhotoMaster *) ckalloc(sizeof(PhotoMaster));
+ memset((void *) masterPtr, 0, sizeof(PhotoMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgPhotoCmd,
+ (ClientData) masterPtr, ImgPhotoCmdDeletedProc);
+ masterPtr->palette = NULL;
+ masterPtr->pix24 = NULL;
+ masterPtr->instancePtr = NULL;
+ masterPtr->validRegion = TkCreateRegion();
+
+ /*
+ * Process configuration options given in the image create command.
+ */
+
+ if (ImgPhotoConfigureMaster(interp, masterPtr, objc, objv, 0) != TCL_OK) {
+ ImgPhotoDelete((ClientData) masterPtr);
+ return TCL_ERROR;
+ }
+
+ *clientDataPtr = (ClientData) masterPtr;
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCmd --
+ *
+ * This procedure is invoked to process the Tcl command that
+ * corresponds to a photo image. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about photo master. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int oldformat = 0;
+ static CONST char *photoOptions[] = {
+ "blank", "cget", "configure", "copy", "data", "get", "put",
+ "read", "redither", "transparency", "write", (char *) NULL
+ };
+ enum options {
+ PHOTO_BLANK, PHOTO_CGET, PHOTO_CONFIGURE, PHOTO_COPY, PHOTO_DATA,
+ PHOTO_GET, PHOTO_PUT, PHOTO_READ, PHOTO_REDITHER, PHOTO_TRANS,
+ PHOTO_WRITE
+ };
+
+ PhotoMaster *masterPtr = (PhotoMaster *) clientData;
+ int result, index;
+ int x, y, width, height;
+ int dataWidth, dataHeight;
+ struct SubcommandOptions options;
+ int listArgc;
+ CONST char **listArgv;
+ CONST char **srcArgv;
+ unsigned char *pixelPtr;
+ Tk_PhotoImageBlock block;
+ Tk_Window tkwin;
+ XColor color;
+ Tk_PhotoImageFormat *imageFormat;
+ int imageWidth, imageHeight;
+ int matched;
+ Tcl_Channel chan;
+ Tk_PhotoHandle srcHandle;
+ size_t length;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], photoOptions, "option", 0,
+ &index) != TCL_OK) {
+ Tcl_ObjCmdProc *proc;
+ proc = PhotoOptionFind(interp, objv[1]);
+ if (proc == (Tcl_ObjCmdProc *) NULL) {
+ return TCL_ERROR;
+ }
+ return proc(clientData, interp, objc, objv);
+ }
+
+ switch ((enum options) index) {
+ case PHOTO_BLANK:
+ /*
+ * photo blank command - just call Tk_PhotoBlank.
+ */
+
+ if (objc == 2) {
+ Tk_PhotoBlank(masterPtr);
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ return TCL_ERROR;
+ }
+ break;
+
+ case PHOTO_CGET: {
+ char *arg;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetStringFromObj(objv[2], (int *) &length);
+ if (strncmp(arg,"-data", length) == 0) {
+ if (masterPtr->dataString) {
+ Tcl_SetObjResult(interp, masterPtr->dataString);
+ }
+ return TCL_OK;
+ }
+ if (strncmp(arg,"-format", length) == 0) {
+ if (masterPtr->format) {
+ Tcl_SetObjResult(interp, masterPtr->format);
+ }
+ return TCL_OK;
+ }
+ Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, Tcl_GetString(objv[2]), 0);
+ break;
+ }
+
+ case PHOTO_CONFIGURE:
+ /*
+ * photo configure command - handle this in the standard way.
+ */
+
+ if (objc == 2) {
+ Tcl_Obj *obj, *subobj;
+ result = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ if (result != TCL_OK) {
+ return result;
+ }
+ obj = Tcl_NewObj();
+ subobj = Tcl_NewStringObj("-data {} {} {}", 14);
+ if (masterPtr->dataString) {
+ Tcl_ListObjAppendElement(interp, subobj, masterPtr->dataString);
+ } else {
+ Tcl_AppendStringsToObj(subobj, " {}", (char *) NULL);
+ }
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewStringObj("-format {} {} {}", 16);
+ if (masterPtr->format) {
+ Tcl_ListObjAppendElement(interp, subobj, masterPtr->format);
+ } else {
+ Tcl_AppendStringsToObj(subobj, " {}", (char *) NULL);
+ }
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_ListObjAppendList(interp, obj, Tcl_GetObjResult(interp));
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (objc == 3) {
+ char *arg = Tcl_GetStringFromObj(objv[2], (int *) &length);
+ if (!strncmp(arg, "-data", length)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "-data {} {} {}", (char *) NULL);
+ if (masterPtr->dataString) {
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ masterPtr->dataString);
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ " {}", (char *) NULL);
+ }
+ return TCL_OK;
+ } else if (!strncmp(arg, "-format", length)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "-format {} {} {}", (char *) NULL);
+ if (masterPtr->format) {
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ masterPtr->format);
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ " {}", (char *) NULL);
+ }
+ return TCL_OK;
+ } else {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, arg, 0);
+ }
+ }
+ return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+
+ case PHOTO_COPY:
+ /*
+ * photo copy command - first parse options.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.zoomX = options.zoomY = 1;
+ options.subsampleX = options.subsampleY = 1;
+ options.name = NULL;
+ options.compositingRule = TK_PHOTO_COMPOSITE_OVERLAY;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK |
+ OPT_COMPOSITE, &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (options.name == NULL || index < objc) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "source-image ?-compositingrule rule? ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for the source image and get a pointer to its image data.
+ * Check the values given for the -from option.
+ */
+
+ srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name));
+ if (srcHandle == NULL) {
+ Tcl_AppendResult(interp, "image \"",
+ Tcl_GetString(options.name), "\" doesn't",
+ " exist or is not a photo image", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_PhotoGetImage(srcHandle, &block);
+ if ((options.fromX2 > block.width) || (options.fromY2 > block.height)
+ || (options.fromX2 > block.width)
+ || (options.fromY2 > block.height)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside source image", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
+ options.fromX2 = block.width;
+ options.fromY2 = block.height;
+ }
+ if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
+ width = options.fromX2 - options.fromX;
+ if (options.subsampleX > 0) {
+ width = (width + options.subsampleX - 1) / options.subsampleX;
+ } else if (options.subsampleX == 0) {
+ width = 0;
+ } else {
+ width = (width - options.subsampleX - 1) / -options.subsampleX;
+ }
+ options.toX2 = options.toX + width * options.zoomX;
+
+ height = options.fromY2 - options.fromY;
+ if (options.subsampleY > 0) {
+ height = (height + options.subsampleY - 1)
+ / options.subsampleY;
+ } else if (options.subsampleY == 0) {
+ height = 0;
+ } else {
+ height = (height - options.subsampleY - 1)
+ / -options.subsampleY;
+ }
+ options.toY2 = options.toY + height * options.zoomY;
+ }
+
+ /*
+ * Set the destination image size if the -shrink option was specified.
+ */
+
+ if (options.options & OPT_SHRINK) {
+ if (ImgPhotoSetSize(masterPtr, options.toX2,
+ options.toY2) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Copy the image data over using Tk_PhotoPutZoomedBlock.
+ */
+
+ block.pixelPtr += options.fromX * block.pixelSize
+ + options.fromY * block.pitch;
+ block.width = options.fromX2 - options.fromX;
+ block.height = options.fromY2 - options.fromY;
+ Tk_PhotoPutZoomedBlock((Tk_PhotoHandle) masterPtr, &block,
+ options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY, options.zoomX, options.zoomY,
+ options.subsampleX, options.subsampleY,
+ options.compositingRule);
+
+ break;
+
+ case PHOTO_DATA: {
+ char *data;
+
+ /*
+ * photo data command - first parse and check any options given.
+ */
+ Tk_ImageStringWriteProc *stringWriteProc = NULL;
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ options.fromX = 0;
+ options.fromY = 0;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
+ &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name != NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options?");
+ return TCL_ERROR;
+ }
+ if ((options.fromX > masterPtr->width)
+ || (options.fromY > masterPtr->height)
+ || (options.fromX2 > masterPtr->width)
+ || (options.fromY2 > masterPtr->height)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside image", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ options.fromX2 = masterPtr->width;
+ options.fromY2 = masterPtr->height;
+ }
+
+ /*
+ * Search for an appropriate image string format handler.
+ */
+
+ if (options.options & OPT_FORMAT) {
+ for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((strncasecmp(Tcl_GetString(options.format),
+ imageFormat->name, strlen(imageFormat->name)) == 0)) {
+ if (imageFormat->stringWriteProc != NULL) {
+ stringWriteProc = imageFormat->stringWriteProc;
+ break;
+ }
+ }
+ }
+ if (stringWriteProc == NULL) {
+ Tcl_AppendResult(interp, "image string format \"",
+ Tcl_GetString(options.format),
+ "\" is not supported", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ stringWriteProc = ImgStringWrite;
+ }
+
+ /*
+ * Call the handler's string write procedure to write out
+ * the image.
+ */
+
+ data = ImgGetPhoto(masterPtr, &block, &options);
+
+ result = ((int (*) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *formatString,
+ Tk_PhotoImageBlock *blockPtr, VOID *dummy))) stringWriteProc)
+ (interp, options.format, &block, (VOID *) NULL);
+ if (options.background) {
+ Tk_FreeColor(options.background);
+ }
+ if (data) {
+ ckfree(data);
+ }
+ return result;
+ break;
+ }
+
+ case PHOTO_GET: {
+ /*
+ * photo get command - first parse and check parameters.
+ */
+
+ char string[TCL_INTEGER_SPACE * 3];
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " get: ",
+ "coordinates out of range", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract the value of the desired pixel and format it as a string.
+ */
+
+ pixelPtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
+ sprintf(string, "%d %d %d", pixelPtr[0], pixelPtr[1],
+ pixelPtr[2]);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ break;
+ }
+
+ case PHOTO_PUT:
+ /*
+ * photo put command - first parse the options and colors specified.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ if (ParseSubcommandOptions(&options, interp, OPT_TO|OPT_FORMAT,
+ &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?options?");
+ return TCL_ERROR;
+ }
+
+ if (MatchStringFormat(interp, options.name ? objv[2]:NULL,
+ options.format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) == TCL_OK) {
+ Tcl_Obj *format, *data;
+
+ if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) {
+ options.toX2 = options.toX + imageWidth;
+ options.toY2 = options.toY + imageHeight;
+ }
+ if (imageWidth > options.toX2 - options.toX) {
+ imageWidth = options.toX2 - options.toX;
+ }
+ if (imageHeight > options.toY2 - options.toY) {
+ imageHeight = options.toY2 - options.toY;
+ }
+ format = options.format;
+ data = objv[2];
+ if (oldformat) {
+ if (format) {
+ format = (Tcl_Obj *) Tcl_GetString(format);
+ }
+ data = (Tcl_Obj *) Tcl_GetString(data);
+ }
+ if ((*imageFormat->stringReadProc)(interp, data,
+ format, (Tk_PhotoHandle) masterPtr,
+ options.toX, options.toY, imageWidth, imageHeight,
+ 0, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr->flags |= IMAGE_CHANGED;
+ return TCL_OK;
+ }
+ if (options.options & OPT_FORMAT) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
+ if (Tcl_SplitList(interp, Tcl_GetString(options.name),
+ &dataHeight, &srcArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_MainWindow(interp);
+ block.pixelPtr = NULL;
+ dataWidth = 0;
+ pixelPtr = NULL;
+ for (y = 0; y < dataHeight; ++y) {
+ if (Tcl_SplitList(interp, srcArgv[y], &listArgc, &listArgv)
+ != TCL_OK) {
+ break;
+ }
+ if (y == 0) {
+ dataWidth = listArgc;
+ pixelPtr = (unsigned char *)
+ ckalloc((unsigned) dataWidth * dataHeight * 3);
+ block.pixelPtr = pixelPtr;
+ } else if (listArgc != dataWidth) {
+ Tcl_AppendResult(interp, "all elements of color list must",
+ " have the same number of elements", (char *) NULL);
+ ckfree((char *) listArgv);
+ break;
+ }
+ for (x = 0; x < dataWidth; ++x) {
+ if (!XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin),
+ listArgv[x], &color)) {
+ Tcl_AppendResult(interp, "can't parse color \"",
+ listArgv[x], "\"", (char *) NULL);
+ break;
+ }
+ *pixelPtr++ = color.red >> 8;
+ *pixelPtr++ = color.green >> 8;
+ *pixelPtr++ = color.blue >> 8;
+ }
+ ckfree((char *) listArgv);
+ if (x < dataWidth) {
+ break;
+ }
+ }
+ ckfree((char *) srcArgv);
+ if (y < dataHeight || dataHeight == 0 || dataWidth == 0) {
+ if (block.pixelPtr != NULL) {
+ ckfree((char *) block.pixelPtr);
+ }
+ if (y < dataHeight) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Fill in default values for the -to option, then
+ * copy the block in using Tk_PhotoPutBlock.
+ */
+
+ if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
+ options.toX2 = options.toX + dataWidth;
+ options.toY2 = options.toY + dataHeight;
+ }
+ block.width = dataWidth;
+ block.height = dataHeight;
+ block.pitch = dataWidth * 3;
+ block.pixelSize = 3;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ block.offset[3] = 0;
+ Tk_PhotoPutBlock((ClientData)masterPtr, &block,
+ options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY, TK_PHOTO_COMPOSITE_SET);
+ ckfree((char *) block.pixelPtr);
+ break;
+
+ case PHOTO_READ: {
+ Tcl_Obj *format;
+
+ /*
+ * photo read command - first parse the options specified.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_TO | OPT_SHRINK,
+ &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?options?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get image from a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Open the image file and look for a handler for it.
+ */
+
+ chan = Tcl_OpenFileChannel(interp,
+ Tcl_GetString(options.name), "r", 0);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ if (MatchFileFormat(interp, chan,
+ Tcl_GetString(options.name), options.format, &imageFormat,
+ &imageWidth, &imageHeight, &oldformat) != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check the values given for the -from option.
+ */
+
+ if ((options.fromX > imageWidth) || (options.fromY > imageHeight)
+ || (options.fromX2 > imageWidth)
+ || (options.fromY2 > imageHeight)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside source image", (char *) NULL);
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ width = imageWidth - options.fromX;
+ height = imageHeight - options.fromY;
+ } else {
+ width = options.fromX2 - options.fromX;
+ height = options.fromY2 - options.fromY;
+ }
+
+ /*
+ * If the -shrink option was specified, set the size of the image.
+ */
+
+ if (options.options & OPT_SHRINK) {
+ if (ImgPhotoSetSize(masterPtr, options.toX + width,
+ options.toY + height) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Call the handler's file read procedure to read the data
+ * into the image.
+ */
+
+ format = options.format;
+ if (oldformat && format) {
+ format = (Tcl_Obj *) Tcl_GetString(format);
+ }
+ result = (*imageFormat->fileReadProc)(interp, chan,
+ Tcl_GetString(options.name),
+ format, (Tk_PhotoHandle) masterPtr, options.toX,
+ options.toY, width, height, options.fromX, options.fromY);
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return result;
+ break;
+ }
+
+ case PHOTO_REDITHER:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call Dither if any part of the image is not correctly
+ * dithered at present.
+ */
+
+ x = masterPtr->ditherX;
+ y = masterPtr->ditherY;
+ if (masterPtr->ditherX != 0) {
+ Tk_DitherPhoto((Tk_PhotoHandle) masterPtr, x, y,
+ masterPtr->width - x, 1);
+ }
+ if (masterPtr->ditherY < masterPtr->height) {
+ x = 0;
+ Tk_DitherPhoto((Tk_PhotoHandle)masterPtr, 0,
+ masterPtr->ditherY, masterPtr->width,
+ masterPtr->height - masterPtr->ditherY);
+ }
+
+ if (y < masterPtr->height) {
+ /*
+ * Tell the core image code that part of the image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y,
+ (masterPtr->width - x), (masterPtr->height - y),
+ masterPtr->width, masterPtr->height);
+ }
+ break;
+
+ case PHOTO_TRANS: {
+ static CONST char *photoTransOptions[] = {
+ "get", "set", (char *) NULL
+ };
+ enum transOptions {
+ PHOTO_TRANS_GET, PHOTO_TRANS_SET
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], photoTransOptions, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum transOptions) index) {
+ case PHOTO_TRANS_GET: {
+ XRectangle testBox;
+ TkRegion testRegion;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "x y");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[0]),
+ " transparency get: coordinates out of range",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ testBox.x = x;
+ testBox.y = y;
+ testBox.width = 1;
+ testBox.height = 1;
+ /* What a way to do a test! */
+ testRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&testBox, testRegion, testRegion);
+ TkIntersectRegion(testRegion, masterPtr->validRegion, testRegion);
+ TkClipBox(testRegion, &testBox);
+ TkDestroyRegion(testRegion);
+
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ (testBox.width==0 && testBox.height==0));
+ return TCL_OK;
+ }
+
+ case PHOTO_TRANS_SET: {
+ int transFlag;
+ XRectangle setBox;
+
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "x y boolean");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)
+ || (Tcl_GetBooleanFromObj(interp, objv[5],
+ &transFlag) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[0]),
+ " transparency set: coordinates out of range",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ setBox.x = x;
+ setBox.y = y;
+ setBox.width = 1;
+ setBox.height = 1;
+ pixelPtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
+
+ if (transFlag) {
+ /*
+ * Make pixel transparent.
+ */
+ TkRegion clearRegion = TkCreateRegion();
+
+ TkUnionRectWithRegion(&setBox, clearRegion, clearRegion);
+ TkSubtractRegion(masterPtr->validRegion, clearRegion,
+ masterPtr->validRegion);
+ TkDestroyRegion(clearRegion);
+ /*
+ * Set the alpha value correctly.
+ */
+ pixelPtr[3] = 0;
+ } else {
+ /*
+ * Make pixel opaque.
+ */
+ TkUnionRectWithRegion(&setBox, masterPtr->validRegion,
+ masterPtr->validRegion);
+ pixelPtr[3] = 255;
+ }
+
+ /*
+ * Inform the generic image code that the image
+ * has (potentially) changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, 1, 1,
+ masterPtr->width, masterPtr->height);
+ masterPtr->flags &= ~IMAGE_CHANGED;
+ }
+
+ }
+ return TCL_OK;
+ }
+
+ case PHOTO_WRITE: {
+ char *data;
+ Tcl_Obj *format;
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't write image to a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * photo write command - first parse and check any options given.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
+ &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?options?");
+ return TCL_ERROR;
+ }
+ if ((options.fromX > masterPtr->width)
+ || (options.fromY > masterPtr->height)
+ || (options.fromX2 > masterPtr->width)
+ || (options.fromY2 > masterPtr->height)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside image", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
+ options.fromX2 = masterPtr->width;
+ options.fromY2 = masterPtr->height;
+ }
+
+ /*
+ * Search for an appropriate image file format handler,
+ * and give an error if none is found.
+ */
+
+ matched = 0;
+ for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((options.format == NULL)
+ || (strncasecmp(Tcl_GetString(options.format),
+ imageFormat->name, strlen(imageFormat->name)) == 0)) {
+ matched = 1;
+ if (imageFormat->fileWriteProc != NULL) {
+ break;
+ }
+ }
+ }
+ if (imageFormat == NULL) {
+ oldformat = 1;
+ for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((options.format == NULL)
+ || (strncasecmp(Tcl_GetString(options.format),
+ imageFormat->name, strlen(imageFormat->name)) == 0)) {
+ matched = 1;
+ if (imageFormat->fileWriteProc != NULL) {
+ break;
+ }
+ }
+ }
+ }
+ if (imageFormat == NULL) {
+ if (options.format == NULL) {
+ Tcl_AppendResult(interp, "no available image file format ",
+ "has file writing capability", (char *) NULL);
+ } else if (!matched) {
+ Tcl_AppendResult(interp, "image file format \"",
+ Tcl_GetString(options.format),
+ "\" is unknown", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "image file format \"",
+ Tcl_GetString(options.format),
+ "\" has no file writing capability",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call the handler's file write procedure to write out
+ * the image.
+ */
+
+ data = ImgGetPhoto(masterPtr, &block, &options);
+ format = options.format;
+ if (oldformat && format) {
+ format = (Tcl_Obj *) Tcl_GetString(options.format);
+ }
+ result = (*imageFormat->fileWriteProc)(interp,
+ Tcl_GetString(options.name), format, &block);
+ if (options.background) {
+ Tk_FreeColor(options.background);
+ }
+ if (data) {
+ ckfree(data);
+ }
+ return result;
+ }
+
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseSubcommandOptions --
+ *
+ * This procedure is invoked to process one of the options
+ * which may be specified for the photo image subcommands,
+ * namely, -from, -to, -zoom, -subsample, -format, -shrink,
+ * and -compositingrule.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Fields in *optPtr get filled in.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, objc, objv)
+ struct SubcommandOptions *optPtr;
+ /* Information about the options specified
+ * and the values given is returned here. */
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ int allowedOptions; /* Indicates which options are valid for
+ * the current command. */
+ int *optIndexPtr; /* Points to a variable containing the
+ * current index in objv; this variable is
+ * updated by this procedure. */
+ int objc; /* Number of arguments in objv[]. */
+ Tcl_Obj *CONST objv[]; /* Arguments to be parsed. */
+{
+ int index, c, bit, currentBit;
+ int length;
+ char *option, **listPtr;
+ int values[4];
+ int numValues, maxValues, argIndex;
+
+ for (index = *optIndexPtr; index < objc; *optIndexPtr = ++index) {
+ /*
+ * We can have one value specified without an option;
+ * it goes into optPtr->name.
+ */
+
+ option = Tcl_GetStringFromObj(objv[index], &length);
+ if (option[0] != '-') {
+ if (optPtr->name == NULL) {
+ optPtr->name = objv[index];
+ continue;
+ }
+ break;
+ }
+
+ /*
+ * Work out which option this is.
+ */
+
+ c = option[0];
+ bit = 0;
+ currentBit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if ((c == *listPtr[0])
+ && (strncmp(option, *listPtr, (size_t) length) == 0)) {
+ if (bit != 0) {
+ bit = 0; /* An ambiguous option. */
+ break;
+ }
+ bit = currentBit;
+ }
+ currentBit <<= 1;
+ }
+
+ /*
+ * If this option is not recognized and allowed, put
+ * an error message in the interpreter and return.
+ */
+
+ if ((allowedOptions & bit) == 0) {
+ Tcl_AppendResult(interp, "unrecognized option \"",
+ Tcl_GetString(objv[index]),
+ "\": must be ", (char *)NULL);
+ bit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if ((allowedOptions & bit) != 0) {
+ if ((allowedOptions & (bit - 1)) != 0) {
+ Tcl_AppendResult(interp, ", ", (char *) NULL);
+ if ((allowedOptions & ~((bit << 1) - 1)) == 0) {
+ Tcl_AppendResult(interp, "or ", (char *) NULL);
+ }
+ }
+ Tcl_AppendResult(interp, *listPtr, (char *) NULL);
+ }
+ bit <<= 1;
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * For the -from, -to, -zoom and -subsample options,
+ * parse the values given. Report an error if too few
+ * or too many values are given.
+ */
+
+ if (bit == OPT_BACKGROUND) {
+ /*
+ * The -background option takes a single XColor value.
+ */
+
+ if (index + 1 < objc) {
+ *optIndexPtr = ++index;
+ optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp),
+ Tk_GetUid(Tcl_GetString(objv[index])));
+ if (!optPtr->background) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "the \"-background\" option ",
+ "requires a value", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (bit == OPT_FORMAT) {
+ /*
+ * The -format option takes a single string value. Note
+ * that parsing this is outside the scope of this
+ * function.
+ */
+
+ if (index + 1 < objc) {
+ *optIndexPtr = ++index;
+ optPtr->format = objv[index];
+ } else {
+ Tcl_AppendResult(interp, "the \"-format\" option ",
+ "requires a value", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (bit == OPT_COMPOSITE) {
+ /*
+ * The -compositingrule option takes a single value from
+ * a well-known set.
+ */
+
+ if (index + 1 < objc) {
+ /*
+ * Note that these must match the TK_PHOTO_COMPOSITE_*
+ * constants.
+ */
+ static CONST char *compositingRules[] = {
+ "overlay", "set",
+ NULL
+ };
+
+ index++;
+ if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules,
+ "compositing rule", 0, &optPtr->compositingRule)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *optIndexPtr = index;
+ } else {
+ Tcl_AppendResult(interp, "the \"-compositingrule\" option ",
+ "requires a value", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) {
+ char *val;
+ maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2;
+ argIndex = index + 1;
+ for (numValues = 0; numValues < maxValues; ++numValues) {
+ if (argIndex >= objc) {
+ break;
+ }
+ val = Tcl_GetString(objv[argIndex]);
+ if ((argIndex < objc) && (isdigit(UCHAR(val[0]))
+ || ((val[0] == '-') && isdigit(UCHAR(val[1]))))) {
+ if (Tcl_GetInt(interp, val, &values[numValues])
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ break;
+ }
+ ++argIndex;
+ }
+
+ if (numValues == 0) {
+ Tcl_AppendResult(interp, "the \"", option, "\" option ",
+ "requires one ", maxValues == 2? "or two": "to four",
+ " integer values", (char *) NULL);
+ return TCL_ERROR;
+ }
+ *optIndexPtr = (index += numValues);
+
+ /*
+ * Y values default to the corresponding X value if not specified.
+ */
+
+ if (numValues == 1) {
+ values[1] = values[0];
+ }
+ if (numValues == 3) {
+ values[3] = values[2];
+ }
+
+ /*
+ * Check the values given and put them in the appropriate
+ * field of the SubcommandOptions structure.
+ */
+
+ switch (bit) {
+ case OPT_FROM:
+ if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
+ && ((values[2] < 0) || (values[3] < 0)))) {
+ Tcl_AppendResult(interp, "value(s) for the -from",
+ " option must be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (numValues <= 2) {
+ optPtr->fromX = values[0];
+ optPtr->fromY = values[1];
+ optPtr->fromX2 = -1;
+ optPtr->fromY2 = -1;
+ } else {
+ optPtr->fromX = MIN(values[0], values[2]);
+ optPtr->fromY = MIN(values[1], values[3]);
+ optPtr->fromX2 = MAX(values[0], values[2]);
+ optPtr->fromY2 = MAX(values[1], values[3]);
+ }
+ break;
+ case OPT_SUBSAMPLE:
+ optPtr->subsampleX = values[0];
+ optPtr->subsampleY = values[1];
+ break;
+ case OPT_TO:
+ if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
+ && ((values[2] < 0) || (values[3] < 0)))) {
+ Tcl_AppendResult(interp, "value(s) for the -to",
+ " option must be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (numValues <= 2) {
+ optPtr->toX = values[0];
+ optPtr->toY = values[1];
+ optPtr->toX2 = -1;
+ optPtr->toY2 = -1;
+ } else {
+ optPtr->toX = MIN(values[0], values[2]);
+ optPtr->toY = MIN(values[1], values[3]);
+ optPtr->toX2 = MAX(values[0], values[2]);
+ optPtr->toY2 = MAX(values[1], values[3]);
+ }
+ break;
+ case OPT_ZOOM:
+ if ((values[0] <= 0) || (values[1] <= 0)) {
+ Tcl_AppendResult(interp, "value(s) for the -zoom",
+ " option must be positive", (char *) NULL);
+ return TCL_ERROR;
+ }
+ optPtr->zoomX = values[0];
+ optPtr->zoomY = values[1];
+ break;
+ }
+ }
+
+ /*
+ * Remember that we saw this option.
+ */
+
+ optPtr->options |= bit;
+ }
+
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoConfigureMaster --
+ *
+ * This procedure is called when a photo image is created or
+ * reconfigured. It processes configuration options and resets
+ * any instances of the image.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned then
+ * an error message is left in the masterPtr->interp's result.
+ *
+ * Side effects:
+ * Existing instances of the image will be redisplayed to match
+ * the new configuration options.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoConfigureMaster(interp, masterPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ PhotoMaster *masterPtr; /* Pointer to data structure describing
+ * overall photo image to (re)configure. */
+ int objc; /* Number of entries in objv. */
+ Tcl_Obj *CONST objv[]; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ PhotoInstance *instancePtr;
+ CONST char *oldFileString, *oldPaletteString;
+ Tcl_Obj *oldData, *data = NULL, *oldFormat, *format = NULL;
+ int length, i, j;
+ double oldGamma;
+ int result;
+ Tcl_Channel chan;
+ Tk_PhotoImageFormat *imageFormat;
+ int imageWidth, imageHeight;
+ CONST char **args;
+ int oldformat;
+ Tcl_Obj *tempdata, *tempformat;
+
+ args = (CONST char **) ckalloc((objc + 1) * sizeof(char *));
+ for (i = 0, j = 0; i < objc; i++,j++) {
+ args[j] = Tcl_GetStringFromObj(objv[i], &length);
+ if ((length > 1) && (args[j][0] == '-')) {
+ if ((args[j][1] == 'd') &&
+ !strncmp(args[j],"-data", (size_t) length)) {
+ if (i < objc) {
+ data = objv[++i];
+ j--;
+ }
+ } else if ((args[j][1] == 'f') &&
+ !strncmp(args[j],"-format", (size_t) length)) {
+ if (i < objc) {
+ format = objv[++i];
+ j--;
+ }
+ }
+ }
+ }
+
+ /*
+ * Save the current values for fileString and dataString, so we
+ * can tell if the user specifies them anew.
+ * IMPORTANT: if the format changes we have to interpret
+ * "-file" and "-data" again as well!!!!!!! It might be
+ * that the format string influences how "-data" or "-file"
+ * is interpreted.
+ */
+
+ oldFileString = masterPtr->fileString;
+ if (oldFileString == NULL) {
+ oldData = masterPtr->dataString;
+ if (oldData != NULL) {
+ Tcl_IncrRefCount(oldData);
+ }
+ } else {
+ oldData = NULL;
+ }
+ oldFormat = masterPtr->format;
+ if (oldFormat != NULL) {
+ Tcl_IncrRefCount(oldFormat);
+ }
+ oldPaletteString = masterPtr->palette;
+ oldGamma = masterPtr->gamma;
+
+ /*
+ * Process the configuration options specified.
+ */
+
+ if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs,
+ j, args, (char *) masterPtr, flags) != TCL_OK) {
+ ckfree((char *) args);
+ goto errorExit;
+ }
+ ckfree((char *) args);
+
+ /*
+ * Regard the empty string for -file, -data or -format as the null
+ * value.
+ */
+
+ if ((masterPtr->fileString != NULL) && (masterPtr->fileString[0] == 0)) {
+ ckfree(masterPtr->fileString);
+ masterPtr->fileString = NULL;
+ }
+ if (data) {
+ if (data->length
+ || (data->typePtr == Tcl_GetObjType("bytearray")
+ && data->internalRep.otherValuePtr != NULL)) {
+ Tcl_IncrRefCount(data);
+ } else {
+ data = NULL;
+ }
+ if (masterPtr->dataString) {
+ Tcl_DecrRefCount(masterPtr->dataString);
+ }
+ masterPtr->dataString = data;
+ }
+ if (format) {
+ if (format->length) {
+ Tcl_IncrRefCount(format);
+ } else {
+ format = NULL;
+ }
+ if (masterPtr->format) {
+ Tcl_DecrRefCount(masterPtr->format);
+ }
+ masterPtr->format = format;
+ }
+ /*
+ * Set the image to the user-requested size, if any,
+ * and make sure storage is correctly allocated for this image.
+ */
+
+ if (ImgPhotoSetSize(masterPtr, masterPtr->width,
+ masterPtr->height) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ goto errorExit;
+ }
+
+ /*
+ * Read in the image from the file or string if the user has
+ * specified the -file or -data option.
+ */
+
+ if ((masterPtr->fileString != NULL)
+ && ((masterPtr->fileString != oldFileString)
+ || (masterPtr->format != oldFormat))) {
+
+ /*
+ * Prevent file system access in a safe interpreter.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't get image from a file in a safe interpreter",
+ (char *) NULL);
+ goto errorExit;
+ }
+
+ chan = Tcl_OpenFileChannel(interp, masterPtr->fileString, "r", 0);
+ if (chan == NULL) {
+ goto errorExit;
+ }
+ /*
+ * -translation binary also sets -encoding binary
+ */
+ if ((Tcl_SetChannelOption(interp, chan,
+ "-translation", "binary") != TCL_OK) ||
+ (MatchFileFormat(interp, chan, masterPtr->fileString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) != TCL_OK)) {
+ Tcl_Close(NULL, chan);
+ goto errorExit;
+ }
+ result = ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
+ if (result != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ goto errorExit;
+ }
+ tempformat = masterPtr->format;
+ if (oldformat && tempformat) {
+ tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
+ }
+ result = (*imageFormat->fileReadProc)(interp, chan,
+ masterPtr->fileString, tempformat,
+ (Tk_PhotoHandle) masterPtr, 0, 0,
+ imageWidth, imageHeight, 0, 0);
+ Tcl_Close(NULL, chan);
+ if (result != TCL_OK) {
+ goto errorExit;
+ }
+
+ Tcl_ResetResult(interp);
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ if ((masterPtr->fileString == NULL) && (masterPtr->dataString != NULL)
+ && ((masterPtr->dataString != oldData)
+ || (masterPtr->format != oldFormat))) {
+
+ if (MatchStringFormat(interp, masterPtr->dataString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) != TCL_OK) {
+ goto errorExit;
+ }
+ if (ImgPhotoSetSize(masterPtr, imageWidth, imageHeight) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ goto errorExit;
+ }
+ tempformat = masterPtr->format;
+ tempdata = masterPtr->dataString;
+ if (oldformat) {
+ if (tempformat) {
+ tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
+ }
+ tempdata = (Tcl_Obj *) Tcl_GetString(tempdata);
+ }
+ if ((*imageFormat->stringReadProc)(interp, tempdata,
+ tempformat, (Tk_PhotoHandle) masterPtr,
+ 0, 0, imageWidth, imageHeight, 0, 0) != TCL_OK) {
+ goto errorExit;
+ }
+
+ Tcl_ResetResult(interp);
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ /*
+ * Enforce a reasonable value for gamma.
+ */
+
+ if (masterPtr->gamma <= 0) {
+ masterPtr->gamma = 1.0;
+ }
+
+ if ((masterPtr->gamma != oldGamma)
+ || (masterPtr->palette != oldPaletteString)) {
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating
+ * the information for each instance. Then force the image to be
+ * redisplayed everywhere that it is used.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgPhotoConfigureInstance(instancePtr);
+ }
+
+ /*
+ * Inform the generic image code that the image
+ * has (potentially) changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ masterPtr->flags &= ~IMAGE_CHANGED;
+
+ if (oldData != NULL) {
+ Tcl_DecrRefCount(oldData);
+ }
+ if (oldFormat != NULL) {
+ Tcl_DecrRefCount(oldFormat);
+ }
+ return TCL_OK;
+
+ errorExit:
+ if (oldData != NULL) {
+ Tcl_DecrRefCount(oldData);
+ }
+ if (oldFormat != NULL) {
+ Tcl_DecrRefCount(oldFormat);
+ }
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoConfigureInstance --
+ *
+ * This procedure is called to create displaying information for
+ * a photo image instance based on the configuration information
+ * in the master. It is invoked both when new instances are
+ * created and when the master is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tcl_BackgroundError if there are problems
+ * in setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoConfigureInstance(instancePtr)
+ PhotoInstance *instancePtr; /* Instance to reconfigure. */
+{
+ PhotoMaster *masterPtr = instancePtr->masterPtr;
+ XImage *imagePtr;
+ int bitsPerPixel;
+ ColorTable *colorTablePtr;
+ XRectangle validBox;
+
+ /*
+ * If the -palette configuration option has been set for the master,
+ * use the value specified for our palette, but only if it is
+ * a valid palette for our windows. Use the gamma value specified
+ * the master.
+ */
+
+ if ((masterPtr->palette && masterPtr->palette[0])
+ && IsValidPalette(instancePtr, masterPtr->palette)) {
+ instancePtr->palette = masterPtr->palette;
+ } else {
+ instancePtr->palette = instancePtr->defaultPalette;
+ }
+ instancePtr->gamma = masterPtr->gamma;
+
+ /*
+ * If we don't currently have a color table, or if the one we
+ * have no longer applies (e.g. because our palette or gamma
+ * has changed), get a new one.
+ */
+
+ colorTablePtr = instancePtr->colorTablePtr;
+ if ((colorTablePtr == NULL)
+ || (instancePtr->colormap != colorTablePtr->id.colormap)
+ || (instancePtr->palette != colorTablePtr->id.palette)
+ || (instancePtr->gamma != colorTablePtr->id.gamma)) {
+ /*
+ * Free up our old color table, and get a new one.
+ */
+
+ if (colorTablePtr != NULL) {
+ colorTablePtr->liveRefCount -= 1;
+ FreeColorTable(colorTablePtr, 0);
+ }
+ GetColorTable(instancePtr);
+
+ /*
+ * Create a new XImage structure for sending data to
+ * the X server, if necessary.
+ */
+
+ if (instancePtr->colorTablePtr->flags & BLACK_AND_WHITE) {
+ bitsPerPixel = 1;
+ } else {
+ bitsPerPixel = instancePtr->visualInfo.depth;
+ }
+
+ if ((instancePtr->imagePtr == NULL)
+ || (instancePtr->imagePtr->bits_per_pixel != bitsPerPixel)) {
+ if (instancePtr->imagePtr != NULL) {
+ XFree((char *) instancePtr->imagePtr);
+ }
+ imagePtr = XCreateImage(instancePtr->display,
+ instancePtr->visualInfo.visual, (unsigned) bitsPerPixel,
+ (bitsPerPixel > 1? ZPixmap: XYBitmap), 0, (char *) NULL,
+ 1, 1, 32, 0);
+ instancePtr->imagePtr = imagePtr;
+
+ /*
+ * Determine the endianness of this machine.
+ * We create images using the local host's endianness, rather
+ * than the endianness of the server; otherwise we would have
+ * to byte-swap any 16 or 32 bit values that we store in the
+ * image in those situations where the server's endianness
+ * is different from ours.
+ *
+ * Can't we use autoconf to figure this out?
+ */
+
+ if (imagePtr != NULL) {
+ union {
+ int i;
+ char c[sizeof(int)];
+ } kludge;
+
+ imagePtr->bitmap_unit = sizeof(pixel) * NBBY;
+ kludge.i = 0;
+ kludge.c[0] = 1;
+ imagePtr->byte_order = (kludge.i == 1) ? LSBFirst : MSBFirst;
+ _XInitImageFuncPtrs(imagePtr);
+ }
+ }
+ }
+
+ /*
+ * If the user has specified a width and/or height for the master
+ * which is different from our current width/height, set the size
+ * to the values specified by the user. If we have no pixmap, we
+ * do this also, since it has the side effect of allocating a
+ * pixmap for us.
+ */
+
+ if ((instancePtr->pixels == None) || (instancePtr->error == NULL)
+ || (instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)) {
+ ImgPhotoInstanceSetSize(instancePtr);
+ }
+
+ /*
+ * Redither this instance if necessary.
+ */
+
+ if ((masterPtr->flags & IMAGE_CHANGED)
+ || (instancePtr->colorTablePtr != colorTablePtr)) {
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.width > 0) && (validBox.height > 0)) {
+ DitherInstance(instancePtr, validBox.x, validBox.y,
+ validBox.width, validBox.height);
+ }
+ }
+
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoGet --
+ *
+ * This procedure is called for each use of a photo image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgPhotoDisplay and ImgPhotoFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgPhotoGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) masterData;
+ PhotoInstance *instancePtr;
+ Colormap colormap;
+ int mono, nRed, nGreen, nBlue;
+ XVisualInfo visualInfo, *visInfoPtr;
+ char buf[TCL_INTEGER_SPACE * 3];
+ int numVisuals;
+ XColor *white, *black;
+ XGCValues gcValues;
+
+ /*
+ * Table of "best" choices for palette for PseudoColor displays
+ * with between 3 and 15 bits/pixel.
+ */
+
+ static int paletteChoice[13][3] = {
+ /* #red, #green, #blue */
+ {2, 2, 2, /* 3 bits, 8 colors */},
+ {2, 3, 2, /* 4 bits, 12 colors */},
+ {3, 4, 2, /* 5 bits, 24 colors */},
+ {4, 5, 3, /* 6 bits, 60 colors */},
+ {5, 6, 4, /* 7 bits, 120 colors */},
+ {7, 7, 4, /* 8 bits, 198 colors */},
+ {8, 10, 6, /* 9 bits, 480 colors */},
+ {10, 12, 8, /* 10 bits, 960 colors */},
+ {14, 15, 9, /* 11 bits, 1890 colors */},
+ {16, 20, 12, /* 12 bits, 3840 colors */},
+ {20, 24, 16, /* 13 bits, 7680 colors */},
+ {26, 30, 20, /* 14 bits, 15600 colors */},
+ {32, 32, 30, /* 15 bits, 30720 colors */}
+ };
+
+ /*
+ * See if there is already an instance for windows using
+ * the same colormap. If so then just re-use it.
+ */
+
+ colormap = Tk_Colormap(tkwin);
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if ((colormap == instancePtr->colormap)
+ && (Tk_Display(tkwin) == instancePtr->display)) {
+
+ /*
+ * Re-use this instance.
+ */
+
+ if (instancePtr->refCount == 0) {
+ /*
+ * We are resurrecting this instance.
+ */
+
+ Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr);
+ if (instancePtr->colorTablePtr != NULL) {
+ FreeColorTable(instancePtr->colorTablePtr, 0);
+ }
+ GetColorTable(instancePtr);
+ }
+ instancePtr->refCount++;
+ return (ClientData) instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in a window with the same colormap.
+ * Make a new instance of the image.
+ */
+
+ instancePtr = (PhotoInstance *) ckalloc(sizeof(PhotoInstance));
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->display = Tk_Display(tkwin);
+ instancePtr->colormap = Tk_Colormap(tkwin);
+ Tk_PreserveColormap(instancePtr->display, instancePtr->colormap);
+ instancePtr->refCount = 1;
+ instancePtr->colorTablePtr = NULL;
+ instancePtr->pixels = None;
+ instancePtr->error = NULL;
+ instancePtr->width = 0;
+ instancePtr->height = 0;
+ instancePtr->imagePtr = 0;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = instancePtr;
+
+ /*
+ * Obtain information about the visual and decide on the
+ * default palette.
+ */
+
+ visualInfo.screen = Tk_ScreenNumber(tkwin);
+ visualInfo.visualid = XVisualIDFromVisual(Tk_Visual(tkwin));
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin),
+ VisualScreenMask | VisualIDMask, &visualInfo, &numVisuals);
+ nRed = 2;
+ nGreen = nBlue = 0;
+ mono = 1;
+ if (visInfoPtr != NULL) {
+ instancePtr->visualInfo = *visInfoPtr;
+ switch (visInfoPtr->class) {
+ case DirectColor:
+ case TrueColor:
+ nRed = 1 << CountBits(visInfoPtr->red_mask);
+ nGreen = 1 << CountBits(visInfoPtr->green_mask);
+ nBlue = 1 << CountBits(visInfoPtr->blue_mask);
+ mono = 0;
+ break;
+ case PseudoColor:
+ case StaticColor:
+ if (visInfoPtr->depth > 15) {
+ nRed = 32;
+ nGreen = 32;
+ nBlue = 32;
+ mono = 0;
+ } else if (visInfoPtr->depth >= 3) {
+ int *ip = paletteChoice[visInfoPtr->depth - 3];
+
+ nRed = ip[0];
+ nGreen = ip[1];
+ nBlue = ip[2];
+ mono = 0;
+ }
+ break;
+ case GrayScale:
+ case StaticGray:
+ nRed = 1 << visInfoPtr->depth;
+ break;
+ }
+ XFree((char *) visInfoPtr);
+
+ } else {
+ panic("ImgPhotoGet couldn't find visual for window");
+ }
+
+ sprintf(buf, ((mono) ? "%d": "%d/%d/%d"), nRed, nGreen, nBlue);
+ instancePtr->defaultPalette = Tk_GetUid(buf);
+
+ /*
+ * Make a GC with background = black and foreground = white.
+ */
+
+ white = Tk_GetColor(masterPtr->interp, tkwin, "white");
+ black = Tk_GetColor(masterPtr->interp, tkwin, "black");
+ gcValues.foreground = (white != NULL)? white->pixel:
+ WhitePixelOfScreen(Tk_Screen(tkwin));
+ gcValues.background = (black != NULL)? black->pixel:
+ BlackPixelOfScreen(Tk_Screen(tkwin));
+ gcValues.graphics_exposures = False;
+ instancePtr->gc = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+
+ /*
+ * Set configuration options and finish the initialization of the instance.
+ * This will also dither the image if necessary.
+ */
+
+ ImgPhotoConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+
+ if (instancePtr->nextPtr == NULL) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+ }
+
+ return (ClientData) instancePtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoDisplay --
+ *
+ * This procedure is invoked to draw a photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to PhotoInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw. */
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+
+ /*
+ * If there's no pixmap, it means that an error occurred
+ * while creating the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->pixels == None) {
+ return;
+ }
+
+ /*
+ * masterPtr->region describes which parts of the image contain
+ * valid data. We set this region as the clip mask for the gc,
+ * setting its origin appropriately, and use it when drawing the
+ * image.
+ */
+
+ TkSetRegion(display, instancePtr->gc, instancePtr->masterPtr->validRegion);
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ XCopyArea(display, instancePtr->pixels, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY);
+ XSetClipMask(display, instancePtr->gc, None);
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image. We don't actually get
+ * rid of the instance until later because we may be about
+ * to get this instance again.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up, later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoFree(clientData, display)
+ ClientData clientData; /* Pointer to PhotoInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+ ColorTable *colorPtr;
+
+ instancePtr->refCount -= 1;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget.
+ * Decrement the count of live uses of its color table, so
+ * that its colors can be reclaimed if necessary, and
+ * set up an idle call to free the instance structure.
+ */
+
+ colorPtr = instancePtr->colorTablePtr;
+ if (colorPtr != NULL) {
+ colorPtr->liveRefCount -= 1;
+ }
+
+ Tcl_DoWhenIdle(DisposeInstance, (ClientData) instancePtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoDelete(masterData)
+ ClientData masterData; /* Pointer to PhotoMaster structure for
+ * image. Must not have any more instances. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) masterData;
+ PhotoInstance *instancePtr;
+
+ while ((instancePtr = masterPtr->instancePtr) != NULL) {
+ if (instancePtr->refCount > 0) {
+ panic("tried to delete photo image when instances still exist");
+ }
+ Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr);
+ DisposeInstance((ClientData) instancePtr);
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
+ }
+ if (masterPtr->pix24 != NULL) {
+ ckfree((char *) masterPtr->pix24);
+ }
+ if (masterPtr->validRegion != NULL) {
+ TkDestroyRegion(masterPtr->validRegion);
+ }
+ if (masterPtr->dataString != NULL) {
+ Tcl_DecrRefCount(masterPtr->dataString);
+ }
+ if (masterPtr->format != NULL) {
+ Tcl_DecrRefCount(masterPtr->format);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
+ ckfree((char *) masterPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to PhotoMaster structure for
+ * image. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoSetSize --
+ *
+ * This procedure reallocates the image storage and instance
+ * pixmaps for a photo image, as necessary, to change the
+ * image's size to `width' x `height' pixels.
+ *
+ * Results:
+ * TCL_OK if successful, TCL_ERROR if failure occurred (currently
+ * just with memory allocation.)
+ *
+ * Side effects:
+ * Storage gets reallocated, for the master and all its instances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoSetSize(masterPtr, width, height)
+ PhotoMaster *masterPtr;
+ int width, height;
+{
+ unsigned char *newPix24 = NULL;
+ int h, offset, pitch;
+ unsigned char *srcPtr, *destPtr;
+ XRectangle validBox, clipBox;
+ TkRegion clipRegion;
+ PhotoInstance *instancePtr;
+
+ if (masterPtr->userWidth > 0) {
+ width = masterPtr->userWidth;
+ }
+ if (masterPtr->userHeight > 0) {
+ height = masterPtr->userHeight;
+ }
+
+ pitch = width * 4;
+
+ /*
+ * Test if we're going to (re)allocate the main buffer now, so
+ * that any failures will leave the photo unchanged.
+ */
+ if ((width != masterPtr->width) || (height != masterPtr->height)
+ || (masterPtr->pix24 == NULL)) {
+ newPix24 = (unsigned char *)
+ attemptckalloc((unsigned) (height * pitch));
+ if (newPix24 == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * We have to trim the valid region if it is currently
+ * larger than the new image size.
+ */
+
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.x + validBox.width > width)
+ || (validBox.y + validBox.height > height)) {
+ clipBox.x = 0;
+ clipBox.y = 0;
+ clipBox.width = width;
+ clipBox.height = height;
+ clipRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&clipBox, clipRegion, clipRegion);
+ TkIntersectRegion(masterPtr->validRegion, clipRegion,
+ masterPtr->validRegion);
+ TkDestroyRegion(clipRegion);
+ TkClipBox(masterPtr->validRegion, &validBox);
+ }
+
+ /*
+ * Use the reallocated storage (allocation above) for the 24-bit
+ * image and copy over valid regions. Note that this test is true
+ * precisely when the allocation has already been done.
+ */
+ if (newPix24 != NULL) {
+ /*
+ * Zero the new array. The dithering code shouldn't read the
+ * areas outside validBox, but they might be copied to another
+ * photo image or written to a file.
+ */
+
+ if ((masterPtr->pix24 != NULL)
+ && ((width == masterPtr->width) || (width == validBox.width))) {
+ if (validBox.y > 0) {
+ memset((VOID *) newPix24, 0, (size_t) (validBox.y * pitch));
+ }
+ h = validBox.y + validBox.height;
+ if (h < height) {
+ memset((VOID *) (newPix24 + h * pitch), 0,
+ (size_t) ((height - h) * pitch));
+ }
+ } else {
+ memset((VOID *) newPix24, 0, (size_t) (height * pitch));
+ }
+
+ if (masterPtr->pix24 != NULL) {
+
+ /*
+ * Copy the common area over to the new array array and
+ * free the old array.
+ */
+
+ if (width == masterPtr->width) {
+
+ /*
+ * The region to be copied is contiguous.
+ */
+
+ offset = validBox.y * pitch;
+ memcpy((VOID *) (newPix24 + offset),
+ (VOID *) (masterPtr->pix24 + offset),
+ (size_t) (validBox.height * pitch));
+
+ } else if ((validBox.width > 0) && (validBox.height > 0)) {
+
+ /*
+ * Area to be copied is not contiguous - copy line by line.
+ */
+
+ destPtr = newPix24 + (validBox.y * width + validBox.x) * 4;
+ srcPtr = masterPtr->pix24 + (validBox.y * masterPtr->width
+ + validBox.x) * 4;
+ for (h = validBox.height; h > 0; h--) {
+ memcpy((VOID *) destPtr, (VOID *) srcPtr,
+ (size_t) (validBox.width * 4));
+ destPtr += width * 4;
+ srcPtr += masterPtr->width * 4;
+ }
+ }
+
+ ckfree((char *) masterPtr->pix24);
+ }
+
+ masterPtr->pix24 = newPix24;
+ masterPtr->width = width;
+ masterPtr->height = height;
+
+ /*
+ * Dithering will be correct up to the end of the last
+ * pre-existing complete scanline.
+ */
+
+ if ((validBox.x > 0) || (validBox.y > 0)) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = 0;
+ } else if (validBox.width == width) {
+ if ((int) validBox.height < masterPtr->ditherY) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = validBox.height;
+ }
+ } else if ((masterPtr->ditherY > 0)
+ || ((int) validBox.width < masterPtr->ditherX)) {
+ masterPtr->ditherX = validBox.width;
+ masterPtr->ditherY = 0;
+ }
+ }
+
+ /*
+ * Now adjust the sizes of the pixmaps for all of the instances.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgPhotoInstanceSetSize(instancePtr);
+ }
+
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoInstanceSetSize --
+ *
+ * This procedure reallocates the instance pixmap and dithering
+ * error array for a photo instance, as necessary, to change the
+ * image's size to `width' x `height' pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage gets reallocated, here and in the X server.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoInstanceSetSize(instancePtr)
+ PhotoInstance *instancePtr; /* Instance whose size is to be
+ * changed. */
+{
+ PhotoMaster *masterPtr;
+ schar *newError;
+ schar *errSrcPtr, *errDestPtr;
+ int h, offset;
+ XRectangle validBox;
+ Pixmap newPixmap;
+
+ masterPtr = instancePtr->masterPtr;
+ TkClipBox(masterPtr->validRegion, &validBox);
+
+ if ((instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)
+ || (instancePtr->pixels == None)) {
+ newPixmap = Tk_GetPixmap(instancePtr->display,
+ RootWindow(instancePtr->display,
+ instancePtr->visualInfo.screen),
+ (masterPtr->width > 0) ? masterPtr->width: 1,
+ (masterPtr->height > 0) ? masterPtr->height: 1,
+ instancePtr->visualInfo.depth);
+ if (!newPixmap) {
+ panic("Fail to create pixmap with Tk_GetPixmap in ImgPhotoInstanceSetSize.\n");
+ return;
+ }
+
+ /*
+ * The following is a gross hack needed to properly support colormaps
+ * under Windows. Before the pixels can be copied to the pixmap,
+ * the relevent colormap must be associated with the drawable.
+ * Normally we can infer this association from the window that
+ * was used to create the pixmap. However, in this case we're
+ * using the root window, so we have to be more explicit.
+ */
+
+ TkSetPixmapColormap(newPixmap, instancePtr->colormap);
+
+ if (instancePtr->pixels != None) {
+ /*
+ * Copy any common pixels from the old pixmap and free it.
+ */
+ XCopyArea(instancePtr->display, instancePtr->pixels, newPixmap,
+ instancePtr->gc, validBox.x, validBox.y,
+ validBox.width, validBox.height, validBox.x, validBox.y);
+ Tk_FreePixmap(instancePtr->display, instancePtr->pixels);
+ }
+ instancePtr->pixels = newPixmap;
+ }
+
+ if ((instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)
+ || (instancePtr->error == NULL)) {
+
+ newError = (schar *) ckalloc((unsigned)
+ (masterPtr->height * masterPtr->width * 3 * sizeof(schar)));
+
+ /*
+ * Zero the new array so that we don't get bogus error values
+ * propagating into areas we dither later.
+ */
+
+ if ((instancePtr->error != NULL)
+ && ((instancePtr->width == masterPtr->width)
+ || (validBox.width == masterPtr->width))) {
+ if (validBox.y > 0) {
+ memset((VOID *) newError, 0, (size_t)
+ (validBox.y * masterPtr->width * 3 * sizeof(schar)));
+ }
+ h = validBox.y + validBox.height;
+ if (h < masterPtr->height) {
+ memset((VOID *) (newError + h * masterPtr->width * 3), 0,
+ (size_t) ((masterPtr->height - h)
+ * masterPtr->width * 3 * sizeof(schar)));
+ }
+ } else {
+ memset((VOID *) newError, 0, (size_t)
+ (masterPtr->height * masterPtr->width * 3 * sizeof(schar)));
+ }
+
+ if (instancePtr->error != NULL) {
+
+ /*
+ * Copy the common area over to the new array
+ * and free the old array.
+ */
+
+ if (masterPtr->width == instancePtr->width) {
+
+ offset = validBox.y * masterPtr->width * 3;
+ memcpy((VOID *) (newError + offset),
+ (VOID *) (instancePtr->error + offset),
+ (size_t) (validBox.height
+ * masterPtr->width * 3 * sizeof(schar)));
+
+ } else if (validBox.width > 0 && validBox.height > 0) {
+
+ errDestPtr = newError
+ + (validBox.y * masterPtr->width + validBox.x) * 3;
+ errSrcPtr = instancePtr->error
+ + (validBox.y * instancePtr->width + validBox.x) * 3;
+ for (h = validBox.height; h > 0; --h) {
+ memcpy((VOID *) errDestPtr, (VOID *) errSrcPtr,
+ validBox.width * 3 * sizeof(schar));
+ errDestPtr += masterPtr->width * 3;
+ errSrcPtr += instancePtr->width * 3;
+ }
+ }
+ ckfree((char *) instancePtr->error);
+ }
+
+ instancePtr->error = newError;
+ }
+
+ instancePtr->width = masterPtr->width;
+ instancePtr->height = masterPtr->height;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsValidPalette --
+ *
+ * This procedure is called to check whether a value given for
+ * the -palette option is valid for a particular instance
+ * of a photo image.
+ *
+ * Results:
+ * A boolean value: 1 if the palette is acceptable, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsValidPalette(instancePtr, palette)
+ PhotoInstance *instancePtr; /* Instance to which the palette
+ * specification is to be applied. */
+ CONST char *palette; /* Palette specification string. */
+{
+ int nRed, nGreen, nBlue, mono, numColors;
+ char *endp;
+
+ /*
+ * First parse the specification: it must be of the form
+ * %d or %d/%d/%d.
+ */
+
+ nRed = strtol(palette, &endp, 10);
+ if ((endp == palette) || ((*endp != 0) && (*endp != '/'))
+ || (nRed < 2) || (nRed > 256)) {
+ return 0;
+ }
+
+ if (*endp == 0) {
+ mono = 1;
+ nGreen = nBlue = nRed;
+ } else {
+ palette = endp + 1;
+ nGreen = strtol(palette, &endp, 10);
+ if ((endp == palette) || (*endp != '/') || (nGreen < 2)
+ || (nGreen > 256)) {
+ return 0;
+ }
+ palette = endp + 1;
+ nBlue = strtol(palette, &endp, 10);
+ if ((endp == palette) || (*endp != 0) || (nBlue < 2)
+ || (nBlue > 256)) {
+ return 0;
+ }
+ mono = 0;
+ }
+
+ switch (instancePtr->visualInfo.class) {
+ case DirectColor:
+ case TrueColor:
+ if ((nRed > (1 << CountBits(instancePtr->visualInfo.red_mask)))
+ || (nGreen > (1
+ << CountBits(instancePtr->visualInfo.green_mask)))
+ || (nBlue > (1
+ << CountBits(instancePtr->visualInfo.blue_mask)))) {
+ return 0;
+ }
+ break;
+ case PseudoColor:
+ case StaticColor:
+ numColors = nRed;
+ if (!mono) {
+ numColors *= nGreen*nBlue;
+ }
+ if (numColors > (1 << instancePtr->visualInfo.depth)) {
+ return 0;
+ }
+ break;
+ case GrayScale:
+ case StaticGray:
+ if (!mono || (nRed > (1 << instancePtr->visualInfo.depth))) {
+ return 0;
+ }
+ break;
+ }
+
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CountBits --
+ *
+ * This procedure counts how many bits are set to 1 in `mask'.
+ *
+ * Results:
+ * The integer number of bits.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CountBits(mask)
+ pixel mask; /* Value to count the 1 bits in. */
+{
+ int n;
+
+ for( n = 0; mask != 0; mask &= mask - 1 )
+ n++;
+ return n;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetColorTable --
+ *
+ * This procedure is called to allocate a table of colormap
+ * information for an instance of a photo image. Only one such
+ * table is allocated for all photo instances using the same
+ * display, colormap, palette and gamma values, so that the
+ * application need only request a set of colors from the X
+ * server once for all such photo widgets. This procedure
+ * maintains a hash table to find previously-allocated
+ * ColorTables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new ColorTable may be allocated and placed in the hash
+ * table, and have colors allocated for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetColorTable(instancePtr)
+ PhotoInstance *instancePtr; /* Instance needing a color table. */
+{
+ ColorTable *colorPtr;
+ Tcl_HashEntry *entry;
+ ColorTableId id;
+ int isNew;
+
+ /*
+ * Look for an existing ColorTable in the hash table.
+ */
+
+ memset((VOID *) &id, 0, sizeof(id));
+ id.display = instancePtr->display;
+ id.colormap = instancePtr->colormap;
+ id.palette = instancePtr->palette;
+ id.gamma = instancePtr->gamma;
+ if (!imgPhotoColorHashInitialized) {
+ Tcl_InitHashTable(&imgPhotoColorHash, N_COLOR_HASH);
+ imgPhotoColorHashInitialized = 1;
+ }
+ entry = Tcl_CreateHashEntry(&imgPhotoColorHash, (char *) &id, &isNew);
+
+ if (!isNew) {
+ /*
+ * Re-use the existing entry.
+ */
+
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+
+ } else {
+ /*
+ * No color table currently available; need to make one.
+ */
+
+ colorPtr = (ColorTable *) ckalloc(sizeof(ColorTable));
+
+ /*
+ * The following line of code should not normally be needed due
+ * to the assignment in the following line. However, it compensates
+ * for bugs in some compilers (HP, for example) where
+ * sizeof(ColorTable) is 24 but the assignment only copies 20 bytes,
+ * leaving 4 bytes uninitialized; these cause problems when using
+ * the id for lookups in imgPhotoColorHash, and can result in
+ * core dumps.
+ */
+
+ memset((VOID *) &colorPtr->id, 0, sizeof(ColorTableId));
+ colorPtr->id = id;
+ Tk_PreserveColormap(colorPtr->id.display, colorPtr->id.colormap);
+ colorPtr->flags = 0;
+ colorPtr->refCount = 0;
+ colorPtr->liveRefCount = 0;
+ colorPtr->numColors = 0;
+ colorPtr->visualInfo = instancePtr->visualInfo;
+ colorPtr->pixelMap = NULL;
+ Tcl_SetHashValue(entry, colorPtr);
+ }
+
+ colorPtr->refCount++;
+ colorPtr->liveRefCount++;
+ instancePtr->colorTablePtr = colorPtr;
+ if (colorPtr->flags & DISPOSE_PENDING) {
+ Tcl_CancelIdleCall(DisposeColorTable, (ClientData) colorPtr);
+ colorPtr->flags &= ~DISPOSE_PENDING;
+ }
+
+ /*
+ * Allocate colors for this color table if necessary.
+ */
+
+ if ((colorPtr->numColors == 0)
+ && ((colorPtr->flags & BLACK_AND_WHITE) == 0)) {
+ AllocateColors(colorPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeColorTable --
+ *
+ * This procedure is called when an instance ceases using a
+ * color table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If no other instances are using this color table, a when-idle
+ * handler is registered to free up the color table and the colors
+ * allocated for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeColorTable(colorPtr, force)
+ ColorTable *colorPtr; /* Pointer to the color table which is
+ * no longer required by an instance. */
+ int force; /* Force free to happen immediately. */
+{
+ colorPtr->refCount--;
+ if (colorPtr->refCount > 0) {
+ return;
+ }
+ if (force) {
+ if ((colorPtr->flags & DISPOSE_PENDING) != 0) {
+ Tcl_CancelIdleCall(DisposeColorTable, (ClientData) colorPtr);
+ colorPtr->flags &= ~DISPOSE_PENDING;
+ }
+ DisposeColorTable((ClientData) colorPtr);
+ } else if ((colorPtr->flags & DISPOSE_PENDING) == 0) {
+ Tcl_DoWhenIdle(DisposeColorTable, (ClientData) colorPtr);
+ colorPtr->flags |= DISPOSE_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocateColors --
+ *
+ * This procedure allocates the colors required by a color table,
+ * and sets up the fields in the color table data structure which
+ * are used in dithering.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Colors are allocated from the X server. Fields in the
+ * color table data structure are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AllocateColors(colorPtr)
+ ColorTable *colorPtr; /* Pointer to the color table requiring
+ * colors to be allocated. */
+{
+ int i, r, g, b, rMult, mono;
+ int numColors, nRed, nGreen, nBlue;
+ double fr, fg, fb, igam;
+ XColor *colors;
+ unsigned long *pixels;
+
+ /* 16-bit intensity value for i/n of full intensity. */
+# define CFRAC(i, n) ((i) * 65535 / (n))
+
+ /* As for CFRAC, but apply exponent of g. */
+# define CGFRAC(i, n, g) ((int)(65535 * pow((double)(i) / (n), (g))))
+
+ /*
+ * First parse the palette specification to get the required number of
+ * shades of each primary.
+ */
+
+ mono = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed, &nGreen, &nBlue)
+ <= 1;
+ igam = 1.0 / colorPtr->id.gamma;
+
+ /*
+ * Each time around this loop, we reduce the number of colors we're
+ * trying to allocate until we succeed in allocating all of the colors
+ * we need.
+ */
+
+ for (;;) {
+ /*
+ * If we are using 1 bit/pixel, we don't need to allocate
+ * any colors (we just use the foreground and background
+ * colors in the GC).
+ */
+
+ if (mono && (nRed <= 2)) {
+ colorPtr->flags |= BLACK_AND_WHITE;
+ return;
+ }
+
+ /*
+ * Calculate the RGB coordinates of the colors we want to
+ * allocate and store them in *colors.
+ */
+
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+
+ /*
+ * Direct/True Color: allocate shades of red, green, blue
+ * independently.
+ */
+
+ if (mono) {
+ numColors = nGreen = nBlue = nRed;
+ } else {
+ numColors = MAX(MAX(nRed, nGreen), nBlue);
+ }
+ colors = (XColor *) ckalloc(numColors * sizeof(XColor));
+
+ for (i = 0; i < numColors; ++i) {
+ if (igam == 1.0) {
+ colors[i].red = CFRAC(i, nRed - 1);
+ colors[i].green = CFRAC(i, nGreen - 1);
+ colors[i].blue = CFRAC(i, nBlue - 1);
+ } else {
+ colors[i].red = CGFRAC(i, nRed - 1, igam);
+ colors[i].green = CGFRAC(i, nGreen - 1, igam);
+ colors[i].blue = CGFRAC(i, nBlue - 1, igam);
+ }
+ }
+ } else {
+ /*
+ * PseudoColor, StaticColor, GrayScale or StaticGray visual:
+ * we have to allocate each color in the color cube separately.
+ */
+
+ numColors = (mono) ? nRed: (nRed * nGreen * nBlue);
+ colors = (XColor *) ckalloc(numColors * sizeof(XColor));
+
+ if (!mono) {
+ /*
+ * Color display using a PseudoColor or StaticColor visual.
+ */
+
+ i = 0;
+ for (r = 0; r < nRed; ++r) {
+ for (g = 0; g < nGreen; ++g) {
+ for (b = 0; b < nBlue; ++b) {
+ if (igam == 1.0) {
+ colors[i].red = CFRAC(r, nRed - 1);
+ colors[i].green = CFRAC(g, nGreen - 1);
+ colors[i].blue = CFRAC(b, nBlue - 1);
+ } else {
+ colors[i].red = CGFRAC(r, nRed - 1, igam);
+ colors[i].green = CGFRAC(g, nGreen - 1, igam);
+ colors[i].blue = CGFRAC(b, nBlue - 1, igam);
+ }
+ i++;
+ }
+ }
+ }
+ } else {
+ /*
+ * Monochrome display - allocate the shades of grey we want.
+ */
+
+ for (i = 0; i < numColors; ++i) {
+ if (igam == 1.0) {
+ r = CFRAC(i, numColors - 1);
+ } else {
+ r = CGFRAC(i, numColors - 1, igam);
+ }
+ colors[i].red = colors[i].green = colors[i].blue = r;
+ }
+ }
+ }
+
+ /*
+ * Now try to allocate the colors we've calculated.
+ */
+
+ pixels = (unsigned long *) ckalloc(numColors * sizeof(unsigned long));
+ for (i = 0; i < numColors; ++i) {
+ if (!XAllocColor(colorPtr->id.display, colorPtr->id.colormap,
+ &colors[i])) {
+
+ /*
+ * Can't get all the colors we want in the default colormap;
+ * first try freeing colors from other unused color tables.
+ */
+
+ if (!ReclaimColors(&colorPtr->id, numColors - i)
+ || !XAllocColor(colorPtr->id.display,
+ colorPtr->id.colormap, &colors[i])) {
+ /*
+ * Still can't allocate the color.
+ */
+ break;
+ }
+ }
+ pixels[i] = colors[i].pixel;
+ }
+
+ /*
+ * If we didn't get all of the colors, reduce the
+ * resolution of the color cube, free the ones we got,
+ * and try again.
+ */
+
+ if (i >= numColors) {
+ break;
+ }
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap, pixels, i, 0);
+ ckfree((char *) colors);
+ ckfree((char *) pixels);
+
+ if (!mono) {
+ if ((nRed == 2) && (nGreen == 2) && (nBlue == 2)) {
+ /*
+ * Fall back to 1-bit monochrome display.
+ */
+
+ mono = 1;
+ } else {
+ /*
+ * Reduce the number of shades of each primary to about
+ * 3/4 of the previous value. This should reduce the
+ * total number of colors required to about half the
+ * previous value for PseudoColor displays.
+ */
+
+ nRed = (nRed * 3 + 2) / 4;
+ nGreen = (nGreen * 3 + 2) / 4;
+ nBlue = (nBlue * 3 + 2) / 4;
+ }
+ } else {
+ /*
+ * Reduce the number of shades of gray to about 1/2.
+ */
+
+ nRed = nRed / 2;
+ }
+ }
+
+ /*
+ * We have allocated all of the necessary colors:
+ * fill in various fields of the ColorTable record.
+ */
+
+ if (!mono) {
+ colorPtr->flags |= COLOR_WINDOW;
+
+ /*
+ * The following is a hairy hack. We only want to index into
+ * the pixelMap on colormap displays. However, if the display
+ * is on Windows, then we actually want to store the index not
+ * the value since we will be passing the color table into the
+ * TkPutImage call.
+ */
+
+#ifndef __WIN32__
+ if ((colorPtr->visualInfo.class != DirectColor)
+ && (colorPtr->visualInfo.class != TrueColor)) {
+ colorPtr->flags |= MAP_COLORS;
+ }
+#endif /* __WIN32__ */
+ }
+
+ colorPtr->numColors = numColors;
+ colorPtr->pixelMap = pixels;
+
+ /*
+ * Set up quantization tables for dithering.
+ */
+ rMult = nGreen * nBlue;
+ for (i = 0; i < 256; ++i) {
+ r = (i * (nRed - 1) + 127) / 255;
+ if (mono) {
+ fr = (double) colors[r].red / 65535.0;
+ if (colorPtr->id.gamma != 1.0 ) {
+ fr = pow(fr, colorPtr->id.gamma);
+ }
+ colorPtr->colorQuant[0][i] = (int)(fr * 255.99);
+ colorPtr->redValues[i] = colors[r].pixel;
+ } else {
+ g = (i * (nGreen - 1) + 127) / 255;
+ b = (i * (nBlue - 1) + 127) / 255;
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+ colorPtr->redValues[i] = colors[r].pixel
+ & colorPtr->visualInfo.red_mask;
+ colorPtr->greenValues[i] = colors[g].pixel
+ & colorPtr->visualInfo.green_mask;
+ colorPtr->blueValues[i] = colors[b].pixel
+ & colorPtr->visualInfo.blue_mask;
+ } else {
+ r *= rMult;
+ g *= nBlue;
+ colorPtr->redValues[i] = r;
+ colorPtr->greenValues[i] = g;
+ colorPtr->blueValues[i] = b;
+ }
+ fr = (double) colors[r].red / 65535.0;
+ fg = (double) colors[g].green / 65535.0;
+ fb = (double) colors[b].blue / 65535.0;
+ if (colorPtr->id.gamma != 1.0) {
+ fr = pow(fr, colorPtr->id.gamma);
+ fg = pow(fg, colorPtr->id.gamma);
+ fb = pow(fb, colorPtr->id.gamma);
+ }
+ colorPtr->colorQuant[0][i] = (int)(fr * 255.99);
+ colorPtr->colorQuant[1][i] = (int)(fg * 255.99);
+ colorPtr->colorQuant[2][i] = (int)(fb * 255.99);
+ }
+ }
+
+ ckfree((char *) colors);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisposeColorTable --
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colors in the argument color table are freed, as is the
+ * color table structure itself. The color table is removed
+ * from the hash table which is used to locate color tables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisposeColorTable(clientData)
+ ClientData clientData; /* Pointer to the ColorTable whose
+ * colors are to be released. */
+{
+ ColorTable *colorPtr;
+ Tcl_HashEntry *entry;
+
+ colorPtr = (ColorTable *) clientData;
+ if (colorPtr->pixelMap != NULL) {
+ if (colorPtr->numColors > 0) {
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap,
+ colorPtr->pixelMap, colorPtr->numColors, 0);
+ Tk_FreeColormap(colorPtr->id.display, colorPtr->id.colormap);
+ }
+ ckfree((char *) colorPtr->pixelMap);
+ }
+
+ entry = Tcl_FindHashEntry(&imgPhotoColorHash, (char *) &colorPtr->id);
+ if (entry == NULL) {
+ panic("DisposeColorTable couldn't find hash entry");
+ }
+ Tcl_DeleteHashEntry(entry);
+
+ ckfree((char *) colorPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReclaimColors --
+ *
+ * This procedure is called to try to free up colors in the
+ * colormap used by a color table. It looks for other color
+ * tables with the same colormap and with a zero live reference
+ * count, and frees their colors. It only does so if there is
+ * the possibility of freeing up at least `numColors' colors.
+ *
+ * Results:
+ * The return value is TRUE if any colors were freed, FALSE
+ * otherwise.
+ *
+ * Side effects:
+ * ColorTables which are not currently in use may lose their
+ * color allocations.
+ *
+ *---------------------------------------------------------------------- */
+
+static int
+ReclaimColors(id, numColors)
+ ColorTableId *id; /* Pointer to information identifying
+ * the color table which needs more colors. */
+ int numColors; /* Number of colors required. */
+{
+ Tcl_HashSearch srch;
+ Tcl_HashEntry *entry;
+ ColorTable *colorPtr;
+ int nAvail;
+
+ /*
+ * First scan through the color hash table to get an
+ * upper bound on how many colors we might be able to free.
+ */
+
+ nAvail = 0;
+ entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch);
+ while (entry != NULL) {
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+ if ((colorPtr->id.display == id->display)
+ && (colorPtr->id.colormap == id->colormap)
+ && (colorPtr->liveRefCount == 0 )&& (colorPtr->numColors != 0)
+ && ((colorPtr->id.palette != id->palette)
+ || (colorPtr->id.gamma != id->gamma))) {
+
+ /*
+ * We could take this guy's colors off him.
+ */
+
+ nAvail += colorPtr->numColors;
+ }
+ entry = Tcl_NextHashEntry(&srch);
+ }
+
+ /*
+ * nAvail is an (over)estimate of the number of colors we could free.
+ */
+
+ if (nAvail < numColors) {
+ return 0;
+ }
+
+ /*
+ * Scan through a second time freeing colors.
+ */
+
+ entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch);
+ while ((entry != NULL) && (numColors > 0)) {
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+ if ((colorPtr->id.display == id->display)
+ && (colorPtr->id.colormap == id->colormap)
+ && (colorPtr->liveRefCount == 0) && (colorPtr->numColors != 0)
+ && ((colorPtr->id.palette != id->palette)
+ || (colorPtr->id.gamma != id->gamma))) {
+
+ /*
+ * Free the colors that this ColorTable has.
+ */
+
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap,
+ colorPtr->pixelMap, colorPtr->numColors, 0);
+ numColors -= colorPtr->numColors;
+ colorPtr->numColors = 0;
+ ckfree((char *) colorPtr->pixelMap);
+ colorPtr->pixelMap = NULL;
+ }
+
+ entry = Tcl_NextHashEntry(&srch);
+ }
+ return 1; /* we freed some colors */
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisposeInstance --
+ *
+ * This procedure is called to finally free up an instance
+ * of a photo image which is no longer required.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance data structure and the resources it references
+ * are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisposeInstance(clientData)
+ ClientData clientData; /* Pointer to the instance whose resources
+ * are to be released. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+ PhotoInstance *prevPtr;
+
+ if (instancePtr->pixels != None) {
+ Tk_FreePixmap(instancePtr->display, instancePtr->pixels);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(instancePtr->display, instancePtr->gc);
+ }
+ if (instancePtr->imagePtr != NULL) {
+ XFree((char *) instancePtr->imagePtr);
+ }
+ if (instancePtr->error != NULL) {
+ ckfree((char *) instancePtr->error);
+ }
+ if (instancePtr->colorTablePtr != NULL) {
+ FreeColorTable(instancePtr->colorTablePtr, 1);
+ }
+
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ Tk_FreeColormap(instancePtr->display, instancePtr->colormap);
+ ckfree((char *) instancePtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchFileFormat --
+ *
+ * This procedure is called to find a photo image file format
+ * handler which can parse the image data in the given file.
+ * If a user-specified format string is provided, only handlers
+ * whose names match a prefix of the format string are tried.
+ *
+ * Results:
+ * A standard TCL return value. If the return value is TCL_OK, a
+ * pointer to the image format record is returned in
+ * *imageFormatPtr, and the width and height of the image are
+ * returned in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MatchFileFormat(interp, chan, fileName, formatObj, imageFormatPtr,
+ widthPtr, heightPtr, oldformat)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ Tcl_Obj *formatObj; /* User-specified format string, or NULL. */
+ Tk_PhotoImageFormat **imageFormatPtr;
+ /* A pointer to the photo image format
+ * record is returned here. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+ int *oldformat;
+{
+ int matched;
+ int useoldformat = 0;
+ Tk_PhotoImageFormat *formatPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ char *formatString = NULL;
+
+ if (formatObj) {
+ formatString = Tcl_GetString(formatObj);
+ }
+
+ /*
+ * Scan through the table of file format handlers to find
+ * one which can handle the image.
+ */
+
+ matched = 0;
+ for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->fileMatchProc == NULL) {
+ Tcl_AppendResult(interp, "-file option isn't supported for ",
+ formatString, " images", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (formatPtr->fileMatchProc != NULL) {
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+
+ if ((*formatPtr->fileMatchProc)(chan, fileName, formatObj,
+ widthPtr, heightPtr, interp)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ break;
+ }
+ }
+ }
+ if (formatPtr == NULL) {
+ useoldformat = 1;
+ for (formatPtr = tsdPtr->oldFormatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatString != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->fileMatchProc == NULL) {
+ Tcl_AppendResult(interp, "-file option isn't supported",
+ " for ", formatString, " images", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (formatPtr->fileMatchProc != NULL) {
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+ if ((*formatPtr->fileMatchProc)(chan, fileName, (Tcl_Obj *)
+ formatString, widthPtr, heightPtr, interp)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ break;
+ }
+ }
+ }
+ }
+
+ if (formatPtr == NULL) {
+ if ((formatObj != NULL) && !matched) {
+ Tcl_AppendResult(interp, "image file format \"",
+ formatString,
+ "\" is not supported", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp,
+ "couldn't recognize data in image file \"",
+ fileName, "\"", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *imageFormatPtr = formatPtr;
+ *oldformat = useoldformat;
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchStringFormat --
+ *
+ * This procedure is called to find a photo image file format
+ * handler which can parse the image data in the given string.
+ * If a user-specified format string is provided, only handlers
+ * whose names match a prefix of the format string are tried.
+ *
+ * Results:
+ * A standard TCL return value. If the return value is TCL_OK, a
+ * pointer to the image format record is returned in
+ * *imageFormatPtr, and the width and height of the image are
+ * returned in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MatchStringFormat(interp, data, formatObj, imageFormatPtr,
+ widthPtr, heightPtr, oldformat)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Obj *data; /* Object containing the image data. */
+ Tcl_Obj *formatObj; /* User-specified format string, or NULL. */
+ Tk_PhotoImageFormat **imageFormatPtr;
+ /* A pointer to the photo image format
+ * record is returned here. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+ int *oldformat; /* returns 1 if the old image API is used */
+{
+ int matched;
+ int useoldformat = 0;
+ Tk_PhotoImageFormat *formatPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ char *formatString = NULL;
+
+ if (formatObj) {
+ formatString = Tcl_GetString(formatObj);
+ }
+
+ /*
+ * Scan through the table of file format handlers to find
+ * one which can handle the image.
+ */
+
+ matched = 0;
+ for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->stringMatchProc == NULL) {
+ Tcl_AppendResult(interp, "-data option isn't supported for ",
+ formatString, " images", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((formatPtr->stringMatchProc != NULL)
+ && (formatPtr->stringReadProc != NULL)
+ && (*formatPtr->stringMatchProc)(data, formatObj,
+ widthPtr, heightPtr, interp)) {
+ break;
+ }
+ }
+
+ if (formatPtr == NULL) {
+ useoldformat = 1;
+ for (formatPtr = tsdPtr->oldFormatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->stringMatchProc == NULL) {
+ Tcl_AppendResult(interp, "-data option isn't supported",
+ " for ", formatString, " images", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((formatPtr->stringMatchProc != NULL)
+ && (formatPtr->stringReadProc != NULL)
+ && (*formatPtr->stringMatchProc)(
+ (Tcl_Obj *) Tcl_GetString(data),
+ (Tcl_Obj *) formatString,
+ widthPtr, heightPtr, interp)) {
+ break;
+ }
+ }
+ }
+ if (formatPtr == NULL) {
+ if ((formatObj != NULL) && !matched) {
+ Tcl_AppendResult(interp, "image format \"", formatString,
+ "\" is not supported", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "couldn't recognize image data",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *imageFormatPtr = formatPtr;
+ *oldformat = useoldformat;
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FindPhoto --
+ *
+ * This procedure is called to get an opaque handle (actually a
+ * PhotoMaster *) for a given image, which can be used in
+ * subsequent calls to Tk_PhotoPutBlock, etc. The `name'
+ * parameter is the name of the image.
+ *
+ * Results:
+ * The handle for the photo image, or NULL if there is no
+ * photo image with the name given.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_PhotoHandle
+Tk_FindPhoto(interp, imageName)
+ Tcl_Interp *interp; /* Interpreter (application) in which image
+ * exists. */
+ CONST char *imageName; /* Name of the desired photo image. */
+{
+ ClientData clientData;
+ Tk_ImageType *typePtr;
+
+ clientData = Tk_GetImageMasterData(interp, imageName, &typePtr);
+ if (typePtr != &tkPhotoImageType) {
+ return NULL;
+ }
+ return (Tk_PhotoHandle) clientData;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutBlock --
+ *
+ * This procedure is called to put image data into a photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image data is stored. The image may be expanded.
+ * The Tk image code is informed that the image has changed.
+ *
+ *---------------------------------------------------------------------- */
+
+void
+Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height, compRule)
+ Tk_PhotoHandle handle; /* Opaque handle for the photo image
+ * to be updated. */
+ register Tk_PhotoImageBlock *blockPtr;
+ /* Pointer to a structure describing the
+ * pixel data to be copied into the image. */
+ int x, y; /* Coordinates of the top-left pixel to
+ * be updated in the image. */
+ int width, height; /* Dimensions of the area of the image
+ * to be updated. */
+ int compRule; /* Compositing rule to use when processing
+ * transparent pixels. */
+{
+ register PhotoMaster *masterPtr;
+ int xEnd, yEnd;
+ int greenOffset, blueOffset, alphaOffset;
+ int wLeft, hLeft;
+ int wCopy, hCopy;
+ unsigned char *srcPtr, *srcLinePtr;
+ unsigned char *destPtr, *destLinePtr;
+ int pitch;
+ XRectangle rect;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) {
+ width = masterPtr->userWidth - x;
+ }
+ if ((masterPtr->userHeight != 0)
+ && ((y + height) > masterPtr->userHeight)) {
+ height = masterPtr->userHeight - y;
+ }
+ if ((width <= 0) || (height <= 0)) {
+ return;
+ }
+
+ xEnd = x + width;
+ yEnd = y + height;
+ if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) {
+ if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height)) == TCL_ERROR) {
+ panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+ }
+
+ if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY)
+ && (x < masterPtr->ditherX))) {
+ /*
+ * The dithering isn't correct past the start of this block.
+ */
+ masterPtr->ditherX = x;
+ masterPtr->ditherY = y;
+ }
+
+ /*
+ * If this image block could have different red, green and blue
+ * components, mark it as a color image.
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ alphaOffset = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
+ alphaOffset = 0;
+ } else {
+ alphaOffset -= blockPtr->offset[0];
+ }
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ masterPtr->flags |= COLOR_IMAGE;
+ }
+
+ /*
+ * Copy the data into our local 24-bit/pixel array.
+ * If we can do it with a single memcpy, we do.
+ */
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
+ pitch = masterPtr->width * 4;
+
+ /*
+ * This test is probably too restrictive. We should also be able to
+ * do a memcpy if pixelSize == 3 and alphaOffset == 0. Maybe other cases
+ * too.
+ */
+ if ((blockPtr->pixelSize == 4)
+ && (greenOffset == 1) && (blueOffset == 2) && (alphaOffset == 3)
+ && (width <= blockPtr->width) && (height <= blockPtr->height)
+ && ((height == 1) || ((x == 0) && (width == masterPtr->width)
+ && (blockPtr->pitch == pitch)))
+ && (compRule == TK_PHOTO_COMPOSITE_SET)) {
+ memcpy((VOID *) destLinePtr,
+ (VOID *) (blockPtr->pixelPtr + blockPtr->offset[0]),
+ (size_t) (height * width * 4));
+ } else {
+ int alpha;
+ for (hLeft = height; hLeft > 0;) {
+ srcLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ hCopy = MIN(hLeft, blockPtr->height);
+ hLeft -= hCopy;
+ for (; hCopy > 0; --hCopy) {
+ if ((blockPtr->pixelSize == 4) && (greenOffset == 1)
+ && (blueOffset == 2) && (alphaOffset == 3)
+ && (width <= blockPtr->width)
+ && (compRule == TK_PHOTO_COMPOSITE_SET)) {
+ memcpy((VOID *) destLinePtr, (VOID *) srcLinePtr,
+ (size_t) (width * 4));
+ } else {
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockPtr->width);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+ for (; wCopy > 0; --wCopy) {
+ alpha = srcPtr[alphaOffset];
+ /*
+ * In the easy case, we can just copy.
+ */
+ if (!alphaOffset || (alpha == 255)) {
+ /* new solid part of the image */
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = 255;
+ srcPtr += blockPtr->pixelSize;
+ continue;
+ }
+
+ /*
+ * Combine according to the compositing rule.
+ */
+ switch (compRule) {
+ case TK_PHOTO_COMPOSITE_SET:
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = alpha;
+ break;
+
+ case TK_PHOTO_COMPOSITE_OVERLAY:
+ if (!destPtr[3]) {
+ /*
+ * There must be a better way to select a
+ * background colour!
+ */
+ destPtr[0] = destPtr[1] = destPtr[2] = 0xd9;
+ }
+
+ if (alpha) {
+ destPtr[0] += (srcPtr[0] - destPtr[0]) * alpha / 255;
+ destPtr[1] += (srcPtr[greenOffset] - destPtr[1]) * alpha / 255;
+ destPtr[2] += (srcPtr[blueOffset] - destPtr[2]) * alpha / 255;
+ destPtr[3] += (255 - destPtr[3]) * alpha / 255;
+ }
+ /*
+ * else should be empty space
+ */
+ destPtr += 4;
+ break;
+
+ default:
+ panic("unknown compositing rule: %d", compRule);
+ }
+ srcPtr += blockPtr->pixelSize;
+ }
+ }
+ }
+ srcLinePtr += blockPtr->pitch;
+ destLinePtr += pitch;
+ }
+ }
+ }
+
+ /*
+ * Add this new block to the region which specifies which data is valid.
+ */
+
+ if (alphaOffset) {
+ int x1, y1, end;
+
+ /*
+ * This block is grossly inefficient. For each row in the image, it
+ * finds each continguous string of nontransparent pixels, then marks
+ * those areas as valid in the validRegion mask. This makes drawing
+ * very efficient, because of the way we use X: we just say, here's
+ * your mask, and here's your data. We need not worry about the
+ * current background color, etc. But this costs us a lot on the
+ * image setup. Still, image setup only happens once, whereas the
+ * drawing happens many times, so this might be the best way to go.
+ *
+ * An alternative might be to not set up this mask, and instead, at
+ * drawing time, for each transparent pixel, set its color to the
+ * color of the background behind that pixel. This is what I suspect
+ * most of programs do. However, they don't have to deal with the
+ * canvas, which could have many different background colors.
+ * Determining the correct bg color for a given pixel might be
+ * expensive.
+ */
+
+ if (compRule != TK_PHOTO_COMPOSITE_OVERLAY) {
+ /*
+ * Don't need this when using the OVERLAY compositing rule,
+ * which always strictly increases the valid region.
+ */
+ TkRegion workRgn = TkCreateRegion();
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, workRgn, workRgn);
+ TkSubtractRegion(masterPtr->validRegion, workRgn,
+ masterPtr->validRegion);
+ TkDestroyRegion(workRgn);
+ }
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4 + 3;
+ for (y1 = 0; y1 < height; y1++) {
+ x1 = 0;
+ destPtr = destLinePtr;
+ while (x1 < width) {
+ /* search for first non-transparent pixel */
+ while ((x1 < width) && !*destPtr) {
+ x1++;
+ destPtr += 4;
+ }
+ end = x1;
+ /* search for first transparent pixel */
+ while ((end < width) && *destPtr) {
+ end++;
+ destPtr += 4;
+ }
+ if (end > x1) {
+ rect.x = x + x1;
+ rect.y = y + y1;
+ rect.width = end - x1;
+ rect.height = 1;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+ x1 = end;
+ }
+ destLinePtr += masterPtr->width * 4;
+ }
+ } else {
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+
+ /*
+ * Update each instance.
+ */
+
+ Tk_DitherPhoto((Tk_PhotoHandle)masterPtr, x, y, width, height);
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width,
+ masterPtr->height);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutZoomedBlock --
+ *
+ * This procedure is called to put image data into a photo image,
+ * with possible subsampling and/or zooming of the pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image data is stored. The image may be expanded.
+ * The Tk image code is informed that the image has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY,
+ subsampleX, subsampleY, compRule)
+ Tk_PhotoHandle handle; /* Opaque handle for the photo image
+ * to be updated. */
+ register Tk_PhotoImageBlock *blockPtr;
+ /* Pointer to a structure describing the
+ * pixel data to be copied into the image. */
+ int x, y; /* Coordinates of the top-left pixel to
+ * be updated in the image. */
+ int width, height; /* Dimensions of the area of the image
+ * to be updated. */
+ int zoomX, zoomY; /* Zoom factors for the X and Y axes. */
+ int subsampleX, subsampleY; /* Subsampling factors for the X and Y axes. */
+ int compRule; /* Compositing rule to use when processing
+ * transparent pixels. */
+{
+ register PhotoMaster *masterPtr;
+ int xEnd, yEnd;
+ int greenOffset, blueOffset, alphaOffset;
+ int wLeft, hLeft;
+ int wCopy, hCopy;
+ int blockWid, blockHt;
+ unsigned char *srcPtr, *srcLinePtr, *srcOrigPtr;
+ unsigned char *destPtr, *destLinePtr;
+ int pitch;
+ int xRepeat, yRepeat;
+ int blockXSkip, blockYSkip;
+ XRectangle rect;
+
+ if (zoomX==1 && zoomY==1 && subsampleX==1 && subsampleY==1) {
+ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height, compRule);
+ return;
+ }
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if (zoomX <= 0 || zoomY <= 0) {
+ return;
+ }
+ if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) {
+ width = masterPtr->userWidth - x;
+ }
+ if ((masterPtr->userHeight != 0)
+ && ((y + height) > masterPtr->userHeight)) {
+ height = masterPtr->userHeight - y;
+ }
+ if (width <= 0 || height <= 0) {
+ return;
+ }
+
+ xEnd = x + width;
+ yEnd = y + height;
+ if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) {
+ int sameSrc = (blockPtr->pixelPtr == masterPtr->pix24);
+ if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height)) == TCL_ERROR) {
+ panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+ if (sameSrc) {
+ blockPtr->pixelPtr = masterPtr->pix24;
+ }
+ }
+
+ if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY)
+ && (x < masterPtr->ditherX))) {
+ /*
+ * The dithering isn't correct past the start of this block.
+ */
+
+ masterPtr->ditherX = x;
+ masterPtr->ditherY = y;
+ }
+
+ /*
+ * If this image block could have different red, green and blue
+ * components, mark it as a color image.
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ alphaOffset = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
+ alphaOffset = 0;
+ } else {
+ alphaOffset -= blockPtr->offset[0];
+ }
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ masterPtr->flags |= COLOR_IMAGE;
+ }
+
+ /*
+ * Work out what area the pixel data in the block expands to after
+ * subsampling and zooming.
+ */
+
+ blockXSkip = subsampleX * blockPtr->pixelSize;
+ blockYSkip = subsampleY * blockPtr->pitch;
+ if (subsampleX > 0) {
+ blockWid = ((blockPtr->width + subsampleX - 1) / subsampleX) * zoomX;
+ } else if (subsampleX == 0) {
+ blockWid = width;
+ } else {
+ blockWid = ((blockPtr->width - subsampleX - 1) / -subsampleX) * zoomX;
+ }
+ if (subsampleY > 0) {
+ blockHt = ((blockPtr->height + subsampleY - 1) / subsampleY) * zoomY;
+ } else if (subsampleY == 0) {
+ blockHt = height;
+ } else {
+ blockHt = ((blockPtr->height - subsampleY - 1) / -subsampleY) * zoomY;
+ }
+
+ /*
+ * Copy the data into our local 24-bit/pixel array.
+ */
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
+ srcOrigPtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ if (subsampleX < 0) {
+ srcOrigPtr += (blockPtr->width - 1) * blockPtr->pixelSize;
+ }
+ if (subsampleY < 0) {
+ srcOrigPtr += (blockPtr->height - 1) * blockPtr->pitch;
+ }
+
+ pitch = masterPtr->width * 4;
+ for (hLeft = height; hLeft > 0; ) {
+ hCopy = MIN(hLeft, blockHt);
+ hLeft -= hCopy;
+ yRepeat = zoomY;
+ srcLinePtr = srcOrigPtr;
+ for (; hCopy > 0; --hCopy) {
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockWid);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+ for (; wCopy > 0; wCopy -= zoomX) {
+ for (xRepeat = MIN(wCopy, zoomX); xRepeat > 0; xRepeat--) {
+ /*
+ * Common case (solid pixels) first
+ */
+ if (!alphaOffset || (srcPtr[alphaOffset] == 255)) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = 255;
+ continue;
+ }
+
+ switch (compRule) {
+ case TK_PHOTO_COMPOSITE_SET:
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = srcPtr[alphaOffset];
+ break;
+ case TK_PHOTO_COMPOSITE_OVERLAY:
+ if (!destPtr[3]) {
+ /*
+ * There must be a better way to select a
+ * background colour!
+ */
+ destPtr[0] = destPtr[1] = destPtr[2] = 0xd9;
+ }
+ if (srcPtr[alphaOffset]) {
+ destPtr[0] += (srcPtr[0] - destPtr[0]) * srcPtr[alphaOffset] / 255;
+ destPtr[1] += (srcPtr[greenOffset] - destPtr[1]) * srcPtr[alphaOffset] / 255;
+ destPtr[2] += (srcPtr[blueOffset] - destPtr[2]) * srcPtr[alphaOffset] / 255;
+ destPtr[3] += (255 - destPtr[3]) * srcPtr[alphaOffset] / 255;
+ }
+ destPtr += 4;
+ break;
+ default:
+ panic("unknown compositing rule: %d", compRule);
+ }
+ }
+ srcPtr += blockXSkip;
+ }
+ }
+ destLinePtr += pitch;
+ yRepeat--;
+ if (yRepeat <= 0) {
+ srcLinePtr += blockYSkip;
+ yRepeat = zoomY;
+ }
+ }
+ }
+
+ /*
+ * Recompute the region of data for which we have valid pixels to plot.
+ */
+
+ if (alphaOffset) {
+ int x1, y1, end;
+
+ if (compRule != TK_PHOTO_COMPOSITE_OVERLAY) {
+ /*
+ * Don't need this when using the OVERLAY compositing rule, which
+ * always strictly increases the valid region.
+ */
+ TkRegion workRgn = TkCreateRegion();
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = 1;
+ TkUnionRectWithRegion(&rect, workRgn, workRgn);
+ TkSubtractRegion(masterPtr->validRegion, workRgn,
+ masterPtr->validRegion);
+ TkDestroyRegion(workRgn);
+ }
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4 + 3;
+ for (y1 = 0; y1 < height; y1++) {
+ x1 = 0;
+ destPtr = destLinePtr;
+ while (x1 < width) {
+ /* search for first non-transparent pixel */
+ while ((x1 < width) && !*destPtr) {
+ x1++;
+ destPtr += 4;
+ }
+ end = x1;
+ /* search for first transparent pixel */
+ while ((end < width) && *destPtr) {
+ end++;
+ destPtr += 4;
+ }
+ if (end > x1) {
+ rect.x = x + x1;
+ rect.y = y + y1;
+ rect.width = end - x1;
+ rect.height = 1;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+ x1 = end;
+ }
+ destLinePtr += masterPtr->width * 4;
+ }
+ } else {
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+
+ /*
+ * Update each instance.
+ */
+
+ Tk_DitherPhoto((Tk_PhotoHandle)masterPtr, x, y, width, height);
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width,
+ masterPtr->height);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DitherPhoto --
+ *
+ * This procedure is called to update an area of each instance's
+ * pixmap by dithering the corresponding area of the image master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The pixmap of each instance of this image gets updated.
+ * The fields in *masterPtr indicating which area of the image
+ * is correctly dithered get updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DitherPhoto(photo, x, y, width, height)
+ Tk_PhotoHandle photo; /* Image master whose instances are
+ * to be updated. */
+ int x, y; /* Coordinates of the top-left pixel
+ * in the area to be dithered. */
+ int width, height; /* Dimensions of the area to be dithered. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) photo;
+ PhotoInstance *instancePtr;
+
+ if ((width <= 0) || (height <= 0)) {
+ return;
+ }
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ DitherInstance(instancePtr, x, y, width, height);
+ }
+
+ /*
+ * Work out whether this block will be correctly dithered
+ * and whether it will extend the correctly dithered region.
+ */
+
+ if (((y < masterPtr->ditherY)
+ || ((y == masterPtr->ditherY) && (x <= masterPtr->ditherX)))
+ && ((y + height) > (masterPtr->ditherY))) {
+
+ /*
+ * This block starts inside (or immediately after) the correctly
+ * dithered region, so the first scan line at least will be right.
+ * Furthermore this block extends into scanline masterPtr->ditherY.
+ */
+
+ if ((x == 0) && (width == masterPtr->width)) {
+ /*
+ * We are doing the full width, therefore the dithering
+ * will be correct to the end.
+ */
+
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = y + height;
+ } else {
+ /*
+ * We are doing partial scanlines, therefore the
+ * correctly-dithered region will be extended by
+ * at most one scan line.
+ */
+
+ if (x <= masterPtr->ditherX) {
+ masterPtr->ditherX = x + width;
+ if (masterPtr->ditherX >= masterPtr->width) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY++;
+ }
+ }
+ }
+ }
+
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DitherInstance --
+ *
+ * This procedure is called to update an area of an instance's
+ * pixmap by dithering the corresponding area of the master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance's pixmap gets updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DitherInstance(instancePtr, xStart, yStart, width, height)
+ PhotoInstance *instancePtr; /* The instance to be updated. */
+ int xStart, yStart; /* Coordinates of the top-left pixel in the
+ * block to be dithered. */
+ int width, height; /* Dimensions of the block to be dithered. */
+{
+ PhotoMaster *masterPtr;
+ ColorTable *colorPtr;
+ XImage *imagePtr;
+ int nLines, bigEndian;
+ int i, c, x, y;
+ int xEnd, yEnd;
+ int bitsPerPixel, bytesPerLine, lineLength;
+ unsigned char *srcLinePtr, *srcPtr;
+ schar *errLinePtr, *errPtr;
+ unsigned char *destBytePtr, *dstLinePtr;
+ pixel *destLongPtr;
+ pixel firstBit, word, mask;
+ int col[3];
+ int doDithering = 1;
+
+ colorPtr = instancePtr->colorTablePtr;
+ masterPtr = instancePtr->masterPtr;
+
+ /*
+ * Turn dithering off in certain cases where it is not
+ * needed (TrueColor, DirectColor with many colors).
+ */
+
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+ int nRed, nGreen, nBlue, result;
+
+ result = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed,
+ &nGreen, &nBlue);
+ if ((nRed >= 256)
+ && ((result == 1) || ((nGreen >= 256) && (nBlue >= 256)))) {
+ doDithering = 0;
+ }
+ }
+
+ /*
+ * First work out how many lines to do at a time,
+ * then how many bytes we'll need for pixel storage,
+ * and allocate it.
+ */
+
+ nLines = (MAX_PIXELS + width - 1) / width;
+ if (nLines < 1) {
+ nLines = 1;
+ }
+ if (nLines > height ) {
+ nLines = height;
+ }
+
+ imagePtr = instancePtr->imagePtr;
+ if (imagePtr == NULL) {
+ return; /* we must be really tight on memory */
+ }
+ bitsPerPixel = imagePtr->bits_per_pixel;
+ bytesPerLine = ((bitsPerPixel * width + 31) >> 3) & ~3;
+ imagePtr->width = width;
+ imagePtr->height = nLines;
+ imagePtr->bytes_per_line = bytesPerLine;
+ imagePtr->data = (char *) ckalloc((unsigned) (imagePtr->bytes_per_line * nLines));
+ bigEndian = imagePtr->bitmap_bit_order == MSBFirst;
+ firstBit = bigEndian? (1 << (imagePtr->bitmap_unit - 1)): 1;
+
+ lineLength = masterPtr->width * 3;
+ srcLinePtr = masterPtr->pix24 + (yStart * masterPtr->width + xStart) * 4;
+ errLinePtr = instancePtr->error + yStart * lineLength + xStart * 3;
+ xEnd = xStart + width;
+
+ /*
+ * Loop over the image, doing at most nLines lines before
+ * updating the screen image.
+ */
+
+ for (; height > 0; height -= nLines) {
+ if (nLines > height) {
+ nLines = height;
+ }
+ dstLinePtr = (unsigned char *) imagePtr->data;
+ yEnd = yStart + nLines;
+ for (y = yStart; y < yEnd; ++y) {
+ srcPtr = srcLinePtr;
+ errPtr = errLinePtr;
+ destBytePtr = dstLinePtr;
+ destLongPtr = (pixel *) dstLinePtr;
+ if (colorPtr->flags & COLOR_WINDOW) {
+ /*
+ * Color window. We dither the three components
+ * independently, using Floyd-Steinberg dithering,
+ * which propagates errors from the quantization of
+ * pixels to the pixels below and to the right.
+ */
+
+ for (x = xStart; x < xEnd; ++x) {
+ if (doDithering) {
+ for (i = 0; i < 3; ++i) {
+ /*
+ * Compute the error propagated into this pixel
+ * for this component.
+ * If e[x,y] is the array of quantization error
+ * values, we compute
+ * 7/16 * e[x-1,y] + 1/16 * e[x-1,y-1]
+ * + 5/16 * e[x,y-1] + 3/16 * e[x+1,y-1]
+ * and round it to an integer.
+ *
+ * The expression ((c + 2056) >> 4) - 128
+ * computes round(c / 16), and works correctly on
+ * machines without a sign-extending right shift.
+ */
+
+ c = (x > 0) ? errPtr[-3] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-3];
+ }
+ c += errPtr[-lineLength] * 5;
+ if ((x + 1) < masterPtr->width) {
+ c += errPtr[-lineLength+3] * 3;
+ }
+ }
+
+ /*
+ * Add the propagated error to the value of this
+ * component, quantize it, and store the
+ * quantization error.
+ */
+
+ c = ((c + 2056) >> 4) - 128 + *srcPtr++;
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ col[i] = colorPtr->colorQuant[i][c];
+ *errPtr++ = c - col[i];
+ }
+ } else {
+ /*
+ * Output is virtually continuous in this case,
+ * so don't bother dithering.
+ */
+
+ col[0] = *srcPtr++;
+ col[1] = *srcPtr++;
+ col[2] = *srcPtr++;
+ }
+ srcPtr++;
+
+ /*
+ * Translate the quantized component values into
+ * an X pixel value, and store it in the image.
+ */
+
+ i = colorPtr->redValues[col[0]]
+ + colorPtr->greenValues[col[1]]
+ + colorPtr->blueValues[col[2]];
+ if (colorPtr->flags & MAP_COLORS) {
+ i = colorPtr->pixelMap[i];
+ }
+ switch (bitsPerPixel) {
+ case NBBY:
+ *destBytePtr++ = i;
+ break;
+#ifndef __WIN32__
+/*
+ * This case is not valid for Windows because the image format is different
+ * from the pixel format in Win32. Eventually we need to fix the image
+ * code in Tk to use the Windows native image ordering. This would speed
+ * up the image code for all of the common sizes.
+ */
+
+ case NBBY * sizeof(pixel):
+ *destLongPtr++ = i;
+ break;
+#endif
+ default:
+ XPutPixel(imagePtr, x - xStart, y - yStart,
+ (unsigned) i);
+ }
+ }
+
+ } else if (bitsPerPixel > 1) {
+ /*
+ * Multibit monochrome window. The operation here is similar
+ * to the color window case above, except that there is only
+ * one component. If the master image is in color, use the
+ * luminance computed as
+ * 0.344 * red + 0.5 * green + 0.156 * blue.
+ */
+
+ for (x = xStart; x < xEnd; ++x) {
+ c = (x > 0) ? errPtr[-1] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-1];
+ }
+ c += errPtr[-lineLength] * 5;
+ if (x + 1 < masterPtr->width) {
+ c += errPtr[-lineLength+1] * 3;
+ }
+ }
+ c = ((c + 2056) >> 4) - 128;
+
+ if ((masterPtr->flags & COLOR_IMAGE) == 0) {
+ c += srcPtr[0];
+ } else {
+ c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5;
+ }
+ srcPtr += 4;
+
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ i = colorPtr->colorQuant[0][c];
+ *errPtr++ = c - i;
+ i = colorPtr->redValues[i];
+ switch (bitsPerPixel) {
+ case NBBY:
+ *destBytePtr++ = i;
+ break;
+#ifndef __WIN32__
+/*
+ * This case is not valid for Windows because the image format is different
+ * from the pixel format in Win32. Eventually we need to fix the image
+ * code in Tk to use the Windows native image ordering. This would speed
+ * up the image code for all of the common sizes.
+ */
+
+ case NBBY * sizeof(pixel):
+ *destLongPtr++ = i;
+ break;
+#endif
+ default:
+ XPutPixel(imagePtr, x - xStart, y - yStart,
+ (unsigned) i);
+ }
+ }
+ } else {
+ /*
+ * 1-bit monochrome window. This is similar to the
+ * multibit monochrome case above, except that the
+ * quantization is simpler (we only have black = 0
+ * and white = 255), and we produce an XY-Bitmap.
+ */
+
+ word = 0;
+ mask = firstBit;
+ for (x = xStart; x < xEnd; ++x) {
+ /*
+ * If we have accumulated a whole word, store it
+ * in the image and start a new word.
+ */
+
+ if (mask == 0) {
+ *destLongPtr++ = word;
+ mask = firstBit;
+ word = 0;
+ }
+
+ c = (x > 0) ? errPtr[-1] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-1];
+ }
+ c += errPtr[-lineLength] * 5;
+ if (x + 1 < masterPtr->width) {
+ c += errPtr[-lineLength+1] * 3;
+ }
+ }
+ c = ((c + 2056) >> 4) - 128;
+
+ if ((masterPtr->flags & COLOR_IMAGE) == 0) {
+ c += srcPtr[0];
+ } else {
+ c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5;
+ }
+ srcPtr += 4;
+
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ if (c >= 128) {
+ word |= mask;
+ *errPtr++ = c - 255;
+ } else {
+ *errPtr++ = c;
+ }
+ mask = bigEndian? (mask >> 1): (mask << 1);
+ }
+ *destLongPtr = word;
+ }
+ srcLinePtr += masterPtr->width * 4;
+ errLinePtr += lineLength;
+ dstLinePtr += bytesPerLine;
+ }
+
+ /*
+ * Update the pixmap for this instance with the block of
+ * pixels that we have just computed.
+ */
+
+ TkPutImage(colorPtr->pixelMap, colorPtr->numColors,
+ instancePtr->display, instancePtr->pixels,
+ instancePtr->gc, imagePtr, 0, 0, xStart, yStart,
+ (unsigned) width, (unsigned) nLines);
+ yStart = yEnd;
+
+ }
+
+ ckfree(imagePtr->data);
+ imagePtr->data = NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoBlank --
+ *
+ * This procedure is called to clear an entire photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The valid region for the image is set to the null region.
+ * The generic image code is notified that the image has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoBlank(handle)
+ Tk_PhotoHandle handle; /* Handle for the image to be blanked. */
+{
+ PhotoMaster *masterPtr;
+ PhotoInstance *instancePtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ masterPtr->ditherX = masterPtr->ditherY = 0;
+ masterPtr->flags = 0;
+
+ /*
+ * The image has valid data nowhere.
+ */
+
+ if (masterPtr->validRegion != NULL) {
+ TkDestroyRegion(masterPtr->validRegion);
+ }
+ masterPtr->validRegion = TkCreateRegion();
+
+ /*
+ * Clear out the 24-bit pixel storage array.
+ * Clear out the dithering error arrays for each instance.
+ */
+
+ memset((VOID *) masterPtr->pix24, 0,
+ (size_t) (masterPtr->width * masterPtr->height * 4));
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->error) {
+ memset((VOID *) instancePtr->error, 0,
+ (size_t) (masterPtr->width * masterPtr->height
+ * 3 * sizeof(schar)));
+ }
+ }
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoExpand --
+ *
+ * This procedure is called to request that a photo image be
+ * expanded if necessary to be at least `width' pixels wide and
+ * `height' pixels high. If the user has declared a definite
+ * image size (using the -width and -height configuration
+ * options) then this call has no effect.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size of the photo image may change; if so the generic
+ * image code is informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoExpand(handle, width, height)
+ Tk_PhotoHandle handle; /* Handle for the image to be expanded. */
+ int width, height; /* Desired minimum dimensions of the image. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if (width <= masterPtr->width) {
+ width = masterPtr->width;
+ }
+ if (height <= masterPtr->height) {
+ height = masterPtr->height;
+ }
+ if ((width != masterPtr->width) || (height != masterPtr->height)) {
+ if (ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width),
+ MAX(height, masterPtr->height)) == TCL_ERROR) {
+ panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width,
+ masterPtr->height);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoGetSize --
+ *
+ * This procedure is called to obtain the current size of a photo
+ * image.
+ *
+ * Results:
+ * The image's width and height are returned in *widthp
+ * and *heightp.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoGetSize(handle, widthPtr, heightPtr)
+ Tk_PhotoHandle handle; /* Handle for the image whose dimensions
+ * are requested. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are returned
+ * here. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ *widthPtr = masterPtr->width;
+ *heightPtr = masterPtr->height;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoSetSize --
+ *
+ * This procedure is called to set size of a photo image.
+ * This call is equivalent to using the -width and -height
+ * configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size of the image may change; if so the generic
+ * image code is informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoSetSize(handle, width, height)
+ Tk_PhotoHandle handle; /* Handle for the image whose size is to
+ * be set. */
+ int width, height; /* New dimensions for the image. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ masterPtr->userWidth = width;
+ masterPtr->userHeight = height;
+ if (ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width),
+ ((height > 0) ? height: masterPtr->height)) == TCL_ERROR) {
+ panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetPhotoValidRegion --
+ *
+ * This procedure is called to get the part of the photo where
+ * there is valid data. Or, conversely, the part of the photo
+ * which is transparent.
+ *
+ * Results:
+ * A TkRegion value that indicates the current area of the photo
+ * that is valid. This value should not be used after any
+ * modification to the photo image.
+ *
+ * Side Effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkRegion
+TkPhotoGetValidRegion(handle)
+ Tk_PhotoHandle handle; /* Handle for the image whose valid region
+ * is to obtained. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ return masterPtr->validRegion;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgGetPhoto --
+ *
+ * This procedure is called to obtain image data from a photo
+ * image. This procedure fills in the Tk_PhotoImageBlock structure
+ * pointed to by `blockPtr' with details of the address and
+ * layout of the image data in memory.
+ *
+ * Results:
+ * A pointer to the allocated data which should be freed later.
+ * NULL if there is no need to free data because
+ * blockPtr->pixelPtr points directly to the image data.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ImgGetPhoto(masterPtr, blockPtr, optPtr)
+ PhotoMaster *masterPtr; /* Handle for the photo image from which
+ * image data is desired. */
+ Tk_PhotoImageBlock *blockPtr;
+ /* Information about the address and layout
+ * of the image data is returned here. */
+ struct SubcommandOptions *optPtr;
+{
+ unsigned char *pixelPtr;
+ int x, y, greenOffset, blueOffset, alphaOffset;
+
+ Tk_PhotoGetImage((Tk_PhotoHandle) masterPtr, blockPtr);
+ blockPtr->pixelPtr += optPtr->fromY * blockPtr->pitch
+ + optPtr->fromX * blockPtr->pixelSize;
+ blockPtr->width = optPtr->fromX2 - optPtr->fromX;
+ blockPtr->height = optPtr->fromY2 - optPtr->fromY;
+
+ if (!(masterPtr->flags & COLOR_IMAGE) &&
+ (!(optPtr->options & OPT_BACKGROUND)
+ || ((optPtr->background->red == optPtr->background->green)
+ && (optPtr->background->red == optPtr->background->blue)))) {
+ blockPtr->offset[0] = blockPtr->offset[1] =
+ blockPtr->offset[2];
+ }
+ alphaOffset = 0;
+ for (y = 0; y < blockPtr->height; y++) {
+ pixelPtr = blockPtr->pixelPtr + (y * blockPtr->pitch)
+ + blockPtr->pixelSize - 1;
+ for (x = 0; x < blockPtr->width; x++) {
+ if (*pixelPtr != 255) {
+ alphaOffset = 3;
+ break;
+ }
+ pixelPtr += blockPtr->pixelSize;
+ }
+ if (alphaOffset) {
+ break;
+ }
+ }
+ if (!alphaOffset) {
+ blockPtr->pixelPtr--;
+ blockPtr->offset[0]++;
+ blockPtr->offset[1]++;
+ blockPtr->offset[2]++;
+ }
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ if (((optPtr->options & OPT_BACKGROUND) && alphaOffset) ||
+ ((optPtr->options & OPT_GRAYSCALE) && (greenOffset || blueOffset))) {
+ int newPixelSize,x,y;
+ unsigned char *srcPtr, *destPtr;
+ char *data;
+
+ newPixelSize = (!(optPtr->options & OPT_BACKGROUND) && alphaOffset) ? 2 : 1;
+ if ((greenOffset || blueOffset) && !(optPtr->options & OPT_GRAYSCALE)) {
+ newPixelSize += 2;
+ }
+ data = ckalloc((unsigned int) (newPixelSize *
+ blockPtr->width * blockPtr->height));
+ srcPtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ destPtr = (unsigned char *) data;
+ if (!greenOffset && !blueOffset) {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = *srcPtr;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ } else if (optPtr->options & OPT_GRAYSCALE) {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = (unsigned char) ((srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5);
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ } else {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] = srcPtr[0];
+ destPtr[1] = srcPtr[1];
+ destPtr[2] = srcPtr[2];
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ }
+ srcPtr = blockPtr->pixelPtr + alphaOffset;
+ destPtr = (unsigned char *) data;
+ if (!alphaOffset) {
+ /* nothing to be done */
+ } else if (optPtr->options & OPT_BACKGROUND) {
+ if (newPixelSize > 2) {
+ int red = optPtr->background->red>>8;
+ int green = optPtr->background->green>>8;
+ int blue = optPtr->background->blue>>8;
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] += (unsigned char) (((255 - *srcPtr) *
+ (red-destPtr[0])) / 255);
+ destPtr[1] += (unsigned char) (((255 - *srcPtr) *
+ (green-destPtr[1])) / 255);
+ destPtr[2] += (unsigned char) (((255 - *srcPtr) *
+ (blue-destPtr[2])) / 255);
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ } else {
+ int gray = (unsigned char) (((optPtr->background->red>>8) * 11
+ + (optPtr->background->green>>8) * 16
+ + (optPtr->background->blue>>8) * 5 + 16) >> 5);
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] += ((255 - *srcPtr) *
+ (gray-destPtr[0])) / 255;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ }
+ } else {
+ destPtr += newPixelSize-1;
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = *srcPtr;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ }
+ blockPtr->pixelPtr = (unsigned char *) data;
+ blockPtr->pixelSize = newPixelSize;
+ blockPtr->pitch = newPixelSize * blockPtr->width;
+ blockPtr->offset[0] = 0;
+ if (newPixelSize>2) {
+ blockPtr->offset[1]= 1;
+ blockPtr->offset[2]= 2;
+ } else {
+ blockPtr->offset[1]= 0;
+ blockPtr->offset[2]= 0;
+ }
+ return data;
+ }
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgStringWrite --
+ *
+ * Default string write function. The data is formatted in
+ * the default format as accepted by the "<img> put" command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgStringWrite(interp, formatString, blockPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *formatString;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ int row,col;
+ char *line, *linePtr;
+ unsigned char *pixelPtr;
+ int greenOffset, blueOffset;
+ Tcl_DString data;
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ Tcl_DStringInit(&data);
+ if ((blockPtr->width > 0) && (blockPtr->height > 0)) {
+ line = (char *) ckalloc((unsigned int) ((8 * blockPtr->width) + 2));
+ for (row=0; row<blockPtr->height; row++) {
+ pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] +
+ row * blockPtr->pitch;
+ linePtr = line;
+ for (col=0; col<blockPtr->width; col++) {
+ sprintf(linePtr, " #%02x%02x%02x", *pixelPtr,
+ pixelPtr[greenOffset], pixelPtr[blueOffset]);
+ pixelPtr += blockPtr->pixelSize;
+ linePtr += 8;
+ }
+ Tcl_DStringAppendElement(&data, line+1);
+ }
+ ckfree (line);
+ }
+ Tcl_DStringResult(interp, &data);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoGetImage --
+ *
+ * This procedure is called to obtain image data from a photo
+ * image. This procedure fills in the Tk_PhotoImageBlock structure
+ * pointed to by `blockPtr' with details of the address and
+ * layout of the image data in memory.
+ *
+ * Results:
+ * TRUE (1) indicating that image data is available,
+ * for backwards compatibility with the old photo widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PhotoGetImage(handle, blockPtr)
+ Tk_PhotoHandle handle; /* Handle for the photo image from which
+ * image data is desired. */
+ Tk_PhotoImageBlock *blockPtr;
+ /* Information about the address and layout
+ * of the image data is returned here. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ blockPtr->pixelPtr = masterPtr->pix24;
+ blockPtr->width = masterPtr->width;
+ blockPtr->height = masterPtr->height;
+ blockPtr->pitch = masterPtr->width * 4;
+ blockPtr->pixelSize = 4;
+ blockPtr->offset[0] = 0;
+ blockPtr->offset[1] = 1;
+ blockPtr->offset[2] = 2;
+ blockPtr->offset[3] = 3;
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PhotoOptionFind --
+ *
+ * Finds a specific Photo option.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * After commands are removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef struct OptionAssocData {
+ struct OptionAssocData *nextPtr; /* pointer to next OptionAssocData */
+ Tcl_ObjCmdProc *command; /* command associated with this
+ * option */
+ char name[1]; /* name of option (remaining chars) */
+} OptionAssocData;
+
+static Tcl_ObjCmdProc *
+PhotoOptionFind(interp, obj)
+ Tcl_Interp *interp; /* Interpreter that is being deleted. */
+ Tcl_Obj *obj; /* Name of option to be found. */
+{
+ size_t length;
+ char *name = Tcl_GetStringFromObj(obj, (int *) &length);
+ OptionAssocData *list;
+ char *prevname = NULL;
+ Tcl_ObjCmdProc *proc = (Tcl_ObjCmdProc *) NULL;
+ list = (OptionAssocData *) Tcl_GetAssocData(interp, "photoOption",
+ (Tcl_InterpDeleteProc **) NULL);
+ while (list != (OptionAssocData *) NULL) {
+ if (strncmp(name, list->name, length) == 0) {
+ if (proc != (Tcl_ObjCmdProc *) NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "ambiguous option \"", name,
+ "\": must be ", prevname, (char *) NULL);
+ while (list->nextPtr != (OptionAssocData *) NULL) {
+ Tcl_AppendResult(interp, prevname, ", ",(char *) NULL);
+ list = list->nextPtr;
+ prevname = list->name;
+ }
+ Tcl_AppendResult(interp, ", or", prevname, (char *) NULL);
+ return (Tcl_ObjCmdProc *) NULL;
+ }
+ proc = list->command;
+ prevname = list->name;
+ }
+ list = list->nextPtr;
+ }
+ if (proc != (Tcl_ObjCmdProc *) NULL) {
+ Tcl_ResetResult(interp);
+ }
+ return proc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PhotoOptionCleanupProc --
+ *
+ * This procedure is invoked whenever an interpreter is deleted
+ * to cleanup the AssocData for "photoVisitor".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Photo Visitor options are removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PhotoOptionCleanupProc(clientData, interp)
+ ClientData clientData; /* Points to "photoVisitor" AssocData
+ * for the interpreter. */
+ Tcl_Interp *interp; /* Interpreter that is being deleted. */
+{
+ OptionAssocData *list = (OptionAssocData *) clientData;
+ OptionAssocData *ptr;
+
+ while (list != NULL) {
+ list = (ptr = list)->nextPtr;
+ ckfree((char *) ptr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreatePhotoOption --
+ *
+ * This procedure may be invoked to add a new kind of photo
+ * option to the core photo command supported by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, the new option will be useable by the
+ * photo command.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreatePhotoOption(interp, name, proc)
+ Tcl_Interp *interp; /* interpreter */
+ CONST char *name; /* option name */
+ Tcl_ObjCmdProc *proc; /* proc to execute command */
+{
+ OptionAssocData *typePtr2, *prevPtr, *ptr;
+ OptionAssocData *list;
+
+ list = (OptionAssocData *) Tcl_GetAssocData(interp, "photoOption",
+ (Tcl_InterpDeleteProc **) NULL);
+
+ /*
+ * If there's already a photo option with the given name, remove it.
+ */
+
+ for (typePtr2 = list, prevPtr = NULL; typePtr2 != NULL;
+ prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
+ if (strcmp(typePtr2->name, name) == 0) {
+ if (prevPtr == NULL) {
+ list = typePtr2->nextPtr;
+ } else {
+ prevPtr->nextPtr = typePtr2->nextPtr;
+ }
+ ckfree((char *) typePtr2);
+ break;
+ }
+ }
+ ptr = (OptionAssocData *) ckalloc(sizeof(OptionAssocData) + strlen(name));
+ strcpy(&(ptr->name[0]), name);
+ ptr->command = proc;
+ ptr->nextPtr = list;
+ Tcl_SetAssocData(interp, "photoOption", PhotoOptionCleanupProc,
+ (ClientData) ptr);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostscriptPhoto --
+ *
+ * This procedure is called to output the contents of a
+ * photo image in Postscript by calling the Tk_PostscriptPhoto
+ * function.
+ *
+ * Results:
+ * Returns a standard Tcl return value.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+ImgPhotoPostscript(clientData, interp, tkwin, psInfo,
+ x, y, width, height, prepass)
+ ClientData clientData; /* Handle for the photo image */
+ Tcl_Interp *interp; /* Interpreter */
+ Tk_Window tkwin; /* (unused) */
+ Tk_PostscriptInfo psInfo; /* postscript info */
+ int x, y; /* First pixel to output */
+ int width, height; /* Width and height of area */
+ int prepass; /* (unused) */
+{
+ Tk_PhotoImageBlock block;
+
+ Tk_PhotoGetImage((Tk_PhotoHandle) clientData, &block);
+ block.pixelPtr += y * block.pitch + x * block.pixelSize;
+
+ return Tk_PostscriptPhoto(interp, &block, psInfo, width, height);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutBlock_NoComposite, Tk_PhotoPutZoomedBlock_NoComposite --
+ *
+ * These backward-compatability functions just exist to fill slots in
+ * stubs table. For the behaviour of *_NoComposite, refer to the
+ * corresponding function without the extra suffix.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tk_PhotoPutBlock_NoComposite(handle, blockPtr, x, y, width, height)
+ Tk_PhotoHandle handle;
+ Tk_PhotoImageBlock *blockPtr;
+ int x, y, width, height;
+{
+ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height,
+ TK_PHOTO_COMPOSITE_OVERLAY);
+}
+
+void
+Tk_PhotoPutZoomedBlock_NoComposite(handle, blockPtr, x, y, width, height,
+ zoomX, zoomY, subsampleX, subsampleY)
+ Tk_PhotoHandle handle;
+ Tk_PhotoImageBlock *blockPtr;
+ int x, y, width, height, zoomX, zoomY, subsampleX, subsampleY;
+{
+ Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height,
+ zoomX, zoomY, subsampleX, subsampleY, TK_PHOTO_COMPOSITE_OVERLAY);
+}
--- /dev/null
+/*
+ * tkImgUtil.c --
+ *
+ * This file contains image related utility functions.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "xbytes.h"
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkAlignImageData --
+ *
+ * This function takes an image and copies the data into an
+ * aligned buffer, performing any necessary bit swapping.
+ *
+ * Results:
+ * Returns a newly allocated buffer that should be freed by the
+ * caller.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkAlignImageData(image, alignment, bitOrder)
+ XImage *image; /* Image to be aligned. */
+ int alignment; /* Number of bytes to which the data should
+ * be aligned (e.g. 2 or 4) */
+ int bitOrder; /* Desired bit order: LSBFirst or MSBFirst. */
+{
+ long dataWidth;
+ char *data, *srcPtr, *destPtr;
+ int i, j;
+
+ if (image->bits_per_pixel != 1) {
+ panic("TkAlignImageData: Can't handle image depths greater than 1.");
+ }
+
+ /*
+ * Compute line width for output data buffer.
+ */
+
+ dataWidth = image->bytes_per_line;
+ if (dataWidth % alignment) {
+ dataWidth += (alignment - (dataWidth % alignment));
+ }
+
+ data = ckalloc(dataWidth * image->height);
+
+ destPtr = data;
+ for (i = 0; i < image->height; i++) {
+ srcPtr = &image->data[i * image->bytes_per_line];
+ for (j = 0; j < dataWidth; j++) {
+ if (j >= image->bytes_per_line) {
+ *destPtr = 0;
+ } else if (image->bitmap_bit_order != bitOrder) {
+ *destPtr = xBitReverseTable[(unsigned char)(*(srcPtr++))];
+ } else {
+ *destPtr = *(srcPtr++);
+ }
+ destPtr++;
+ }
+ }
+ return data;
+}
--- /dev/null
+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.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
--- /dev/null
+# $Id$
+# This file is the basis for a binary Tk Linux RPM.
+
+%define version 8.4.0
+%define directory /usr/local
+
+Summary: Tk graphical toolkit for the Tcl scripting language.
+Name: tk
+Version: %{version}
+Release: 1
+Copyright: BSD
+Group: Development/Languages
+Source: http://prdownloads.sourceforge.net/tcl/tk%{version}-src.tar.gz
+URL: http://www.tcl.tk/
+Packager: Carina
+Buildroot: /var/tmp/%{name}%{version}
+Requires: XFree86-libs >= 3.3.3, XFree86-devel >= 3.3.3, tcl = 8.4.0
+
+%description
+The Tcl (Tool Command Language) provides a powerful platform for
+creating integration applications that tie together diverse
+applications, protocols, devices, and frameworks. When paired with
+the Tk toolkit, Tcl provides the fastest and most powerful way to
+create GUI applications that run on PCs, Unix, and the Macintosh. Tcl
+can also be used for a variety of web-related tasks and for creating
+powerful command languages for applications.
+
+%prep
+
+%build
+./configure --prefix %{directory} --exec-prefix %{directory}
+make CFLAGS=$RPM_OPT_FLAGS
+
+%install
+rm -rf $RPM_BUILD_ROOT
+make INSTALL_ROOT=$RPM_BUILD_ROOT install
+
+%clean
+rm -rf $RPM_BUILD_ROOT
+
+# to create the tcl files list, comment out tk in the install section above,
+# then run "rpm -bi" then do a find from the build root directory,
+# and remove the files in specific directories which suffice by themselves,
+# then to create the files list for tk, uncomment tk, comment out tcl,
+# then rm -rf $RPM_BUILD_ROOT then rpm --short-circuit -bi then redo a find,
+# and remove the files in specific directories which suffice by themselves.
+%files -n tk
+%defattr(-,root,root)
+%{directory}/lib
+%{directory}/bin
+%{directory}/include
+%{directory}/man
--- /dev/null
+/*
+ * tkAppInit.c --
+ *
+ * Provides a default version of the Tcl_AppInit procedure for
+ * use in wish and similar Tk-based applications.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk.h"
+#include "locale.h"
+
+#ifdef TK_TEST
+extern int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TK_TEST */
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_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. */
+{
+ /*
+ * The following #if block allows you to change the AppInit
+ * function by using a #define of TCL_LOCAL_APPINIT instead
+ * of rewriting this entire file. The #if checks for that
+ * #define and uses Tcl_AppInit if it doesn't exist.
+ */
+
+#ifndef TK_LOCAL_APPINIT
+#define TK_LOCAL_APPINIT Tcl_AppInit
+#endif
+ extern int TK_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+
+ /*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tk_Main()
+ */
+
+#ifdef TK_LOCAL_MAIN_HOOK
+ extern int TK_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+ TK_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
+ Tk_Main(argc, argv, TK_LOCAL_APPINIT);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 the interp's 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 (Tk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
+#ifdef TK_TEST
+ if (Tktest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
+ (Tcl_PackageInitProc *) NULL);
+#endif /* TK_TEST */
+
+
+ /*
+ * 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.
+ */
+
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
--- /dev/null
+# tkConfig.sh --
+#
+# This shell script (for sh) is generated automatically by Tk'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 Tk extensions so that they don't have to figure this all
+# out for themselves. This file does not duplicate information
+# already provided by tclConfig.sh, so you may need to use that
+# file in addition to this one.
+#
+# The information in this file is specific to a single platform.
+#
+# RCS: @(#) $Id$
+
+# Tk's version number.
+TK_VERSION='@TK_VERSION@'
+TK_MAJOR_VERSION='@TK_MAJOR_VERSION@'
+TK_MINOR_VERSION='@TK_MINOR_VERSION@'
+TK_PATCH_LEVEL='@TK_PATCH_LEVEL@'
+
+# -D flags for use with the C compiler.
+TK_DEFS='@DEFS@'
+
+# Flag, 1: we built a shared lib, 0 we didn't
+TK_SHARED_BUILD=@TK_SHARED_BUILD@
+
+# This indicates if Tk was build with debugging symbols
+TK_DBGX=@TK_DBGX@
+
+# The name of the Tk library (may be either a .a file or a shared library):
+TK_LIB_FILE='@TK_LIB_FILE@'
+
+# Additional libraries to use when linking Tk.
+TK_LIBS='@XLIBSW@ @DL_LIBS@ @LIBS@ @MATH_LIBS@'
+
+# Top-level directory in which Tcl's platform-independent files are
+# installed.
+TK_PREFIX='@prefix@'
+
+# Top-level directory in which Tcl's platform-specific files (e.g.
+# executables) are installed.
+TK_EXEC_PREFIX='@exec_prefix@'
+
+# -I switch(es) to use to make all of the X11 include files accessible:
+TK_XINCLUDES='@XINCLUDES@'
+
+# Linker switch(es) to use to link with the X11 library archive.
+TK_XLIBSW='@XLIBSW@'
+
+# -l flag to pass to the linker to pick up the Tcl library
+TK_LIB_FLAG='@TK_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tk library from its
+# build directory.
+TK_BUILD_LIB_SPEC='@TK_BUILD_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tk library from its
+# installed directory.
+TK_LIB_SPEC='@TK_LIB_SPEC@'
+
+# Location of the top-level source directory from which Tk was built.
+# This is the directory that contains a README file as well as
+# subdirectories such as generic, unix, etc. If Tk was compiled in a
+# different place than the directory containing the source files, this
+# points to the location of the sources, not the location where Tk was
+# compiled.
+TK_SRC_DIR='@TK_SRC_DIR@'
+
+# Needed if you want to make a 'fat' shared library library
+# containing tk objects or link a different wish.
+TK_CC_SEARCH_FLAGS='@CC_SEARCH_FLAGS@'
+TK_LD_SEARCH_FLAGS='@LD_SEARCH_FLAGS@'
+
+# The name of the Tk stub library (.a):
+TK_STUB_LIB_FILE='@TK_STUB_LIB_FILE@'
+
+# -l flag to pass to the linker to pick up the Tk stub library
+TK_STUB_LIB_FLAG='@TK_STUB_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tk stub library from its
+# build directory.
+TK_BUILD_STUB_LIB_SPEC='@TK_BUILD_STUB_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tk stub library from its
+# installed directory.
+TK_STUB_LIB_SPEC='@TK_STUB_LIB_SPEC@'
+
+# Path to the Tk stub library in the build directory.
+TK_BUILD_STUB_LIB_PATH='@TK_BUILD_STUB_LIB_PATH@'
+
+# Path to the Tk stub library in the install directory.
+TK_STUB_LIB_PATH='@TK_STUB_LIB_PATH@'
--- /dev/null
+/*
+ * tkUnix.c --
+ *
+ * This file contains procedures that are UNIX/X-specific, and
+ * will probably have to be written differently for Windows or
+ * Macintosh platforms.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <tkInt.h>
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetServerInfo --
+ *
+ * Given a window, this procedure returns information about
+ * the window server for that window. This procedure provides
+ * the guts of the "winfo server" command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGetServerInfo(interp, tkwin)
+ Tcl_Interp *interp; /* The server information is returned in
+ * this interpreter's result. */
+ Tk_Window tkwin; /* Token for window; this selects a
+ * particular display and server. */
+{
+ char buffer[8 + TCL_INTEGER_SPACE * 2];
+ char buffer2[TCL_INTEGER_SPACE];
+
+ sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)),
+ ProtocolRevision(Tk_Display(tkwin)));
+ sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin)));
+ Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)),
+ buffer2, (char *) NULL);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDefaultScreenName --
+ *
+ * Returns the name of the screen that Tk should use during
+ * initialization.
+ *
+ * Results:
+ * Returns the argument or a string that should not be freed by
+ * the caller.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+TkGetDefaultScreenName(interp, screenName)
+ Tcl_Interp *interp; /* Interp used to find environment variables. */
+ CONST char *screenName; /* Screen name from command line, or NULL. */
+{
+ if ((screenName == NULL) || (screenName[0] == '\0')) {
+ screenName = Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY);
+ }
+ return screenName;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UpdatePointer --
+ *
+ * Unused function in UNIX
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UpdatePointer(tkwin, x, y, state)
+ Tk_Window tkwin; /* Window to which pointer event
+ * is reported. May be NULL. */
+ int x, y; /* Pointer location in root coords. */
+ int state; /* Modifier state mask. */
+{
+ /*
+ * This function intentionally left blank
+ */
+}
--- /dev/null
+/*
+ * tkUnix3d.c --
+ *
+ * This file contains the platform specific routines for
+ * drawing 3d borders in the Motif style.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <tk3d.h>
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * This structure is used to keep track of the extra colors used
+ * by Unix 3d borders.
+ */
+
+typedef struct {
+ TkBorder info;
+ GC solidGC; /* Used to draw solid relief. */
+} UnixBorder;
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetBorder --
+ *
+ * This function allocates a new TkBorder structure.
+ *
+ * Results:
+ * Returns a newly allocated TkBorder.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkBorder *
+TkpGetBorder()
+{
+ UnixBorder *borderPtr = (UnixBorder *) ckalloc(sizeof(UnixBorder));
+ borderPtr->solidGC = None;
+ return (TkBorder *) borderPtr;
+}
+\f
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeBorder --
+ *
+ * This function frees any colors allocated by the platform
+ * specific part of this module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May deallocate some colors.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeBorder(borderPtr)
+ TkBorder *borderPtr;
+{
+ UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr;
+ Display *display = DisplayOfScreen(borderPtr->screen);
+
+ if (unixBorderPtr->solidGC != None) {
+ Tk_FreeGC(display, unixBorderPtr->solidGC);
+ }
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_3DVerticalBevel --
+ *
+ * This procedure draws a vertical bevel along one side of
+ * an object. The bevel is always rectangular in shape:
+ * |||
+ * |||
+ * |||
+ * |||
+ * |||
+ * |||
+ * An appropriate shadow color is chosen for the bevel based
+ * on the leftBevel and relief arguments. Normally this
+ * procedure is called first, then Tk_3DHorizontalBevel is
+ * called next to draw neat corners.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn in drawable.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_3DVerticalBevel(tkwin, drawable, border, x, y, width, height,
+ leftBevel, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Area of vertical bevel. */
+ int leftBevel; /* Non-zero means this bevel forms the
+ * left side of the object; 0 means it
+ * forms the right side. */
+ int relief; /* Kind of bevel to draw. For example,
+ * TK_RELIEF_RAISED means interior of
+ * object should appear higher than
+ * exterior. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ GC left, right;
+ Display *display = Tk_Display(tkwin);
+
+ if ((borderPtr->lightGC == None) && (relief != TK_RELIEF_FLAT)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ if (relief == TK_RELIEF_RAISED) {
+ XFillRectangle(display, drawable,
+ (leftBevel) ? borderPtr->lightGC : borderPtr->darkGC,
+ x, y, (unsigned) width, (unsigned) height);
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ XFillRectangle(display, drawable,
+ (leftBevel) ? borderPtr->darkGC : borderPtr->lightGC,
+ x, y, (unsigned) width, (unsigned) height);
+ } else if (relief == TK_RELIEF_RIDGE) {
+ int half;
+
+ left = borderPtr->lightGC;
+ right = borderPtr->darkGC;
+ ridgeGroove:
+ half = width/2;
+ if (!leftBevel && (width & 1)) {
+ half++;
+ }
+ XFillRectangle(display, drawable, left, x, y, (unsigned) half,
+ (unsigned) height);
+ XFillRectangle(display, drawable, right, x+half, y,
+ (unsigned) (width-half), (unsigned) height);
+ } else if (relief == TK_RELIEF_GROOVE) {
+ left = borderPtr->darkGC;
+ right = borderPtr->lightGC;
+ goto ridgeGroove;
+ } else if (relief == TK_RELIEF_FLAT) {
+ XFillRectangle(display, drawable, borderPtr->bgGC, x, y,
+ (unsigned) width, (unsigned) height);
+ } else if (relief == TK_RELIEF_SOLID) {
+ UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr;
+ if (unixBorderPtr->solidGC == None) {
+ XGCValues gcValues;
+
+ gcValues.foreground = BlackPixelOfScreen(borderPtr->screen);
+ unixBorderPtr->solidGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ }
+ XFillRectangle(display, drawable, unixBorderPtr->solidGC, x, y,
+ (unsigned) width, (unsigned) height);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_3DHorizontalBevel --
+ *
+ * This procedure draws a horizontal bevel along one side of
+ * an object. The bevel has mitered corners (depending on
+ * leftIn and rightIn arguments).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, height,
+ leftIn, rightIn, topBevel, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Bounding box of area of bevel. Height
+ * gives width of border. */
+ int leftIn, rightIn; /* Describes whether the left and right
+ * edges of the bevel angle in or out as
+ * they go down. For example, if "leftIn"
+ * is true, the left side of the bevel
+ * looks like this:
+ * ___________
+ * __________
+ * _________
+ * ________
+ */
+ int topBevel; /* Non-zero means this bevel forms the
+ * top side of the object; 0 means it
+ * forms the bottom side. */
+ int relief; /* Kind of bevel to draw. For example,
+ * TK_RELIEF_RAISED means interior of
+ * object should appear higher than
+ * exterior. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ Display *display = Tk_Display(tkwin);
+ int bottom, halfway, x1, x2, x1Delta, x2Delta;
+ UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr;
+ GC topGC = None, bottomGC = None;
+ /* Initializations needed only to prevent
+ * compiler warnings. */
+
+ if ((borderPtr->lightGC == None) && (relief != TK_RELIEF_FLAT) &&
+ (relief != TK_RELIEF_SOLID)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ /*
+ * Compute a GC for the top half of the bevel and a GC for the
+ * bottom half (they're the same in many cases).
+ */
+
+ switch (relief) {
+ case TK_RELIEF_FLAT:
+ topGC = bottomGC = borderPtr->bgGC;
+ break;
+ case TK_RELIEF_GROOVE:
+ topGC = borderPtr->darkGC;
+ bottomGC = borderPtr->lightGC;
+ break;
+ case TK_RELIEF_RAISED:
+ topGC = bottomGC =
+ (topBevel) ? borderPtr->lightGC : borderPtr->darkGC;
+ break;
+ case TK_RELIEF_RIDGE:
+ topGC = borderPtr->lightGC;
+ bottomGC = borderPtr->darkGC;
+ break;
+ case TK_RELIEF_SOLID:
+ if (unixBorderPtr->solidGC == None) {
+ XGCValues gcValues;
+
+ gcValues.foreground = BlackPixelOfScreen(borderPtr->screen);
+ unixBorderPtr->solidGC = Tk_GetGC(tkwin, GCForeground,
+ &gcValues);
+ }
+ XFillRectangle(display, drawable, unixBorderPtr->solidGC, x, y,
+ (unsigned) width, (unsigned) height);
+ return;
+ case TK_RELIEF_SUNKEN:
+ topGC = bottomGC =
+ (topBevel) ? borderPtr->darkGC : borderPtr->lightGC;
+ break;
+ }
+
+ /*
+ * Compute various other geometry-related stuff.
+ */
+
+ x1 = x;
+ if (!leftIn) {
+ x1 += height;
+ }
+ x2 = x+width;
+ if (!rightIn) {
+ x2 -= height;
+ }
+ x1Delta = (leftIn) ? 1 : -1;
+ x2Delta = (rightIn) ? -1 : 1;
+ halfway = y + height/2;
+ if (!topBevel && (height & 1)) {
+ halfway++;
+ }
+ bottom = y + height;
+
+ /*
+ * Draw one line for each y-coordinate covered by the bevel.
+ */
+
+ for ( ; y < bottom; y++) {
+ /*
+ * X Dimensions are 16-bit, so avoid wraparound or display errors
+ * by limiting these here.
+ */
+ if (x1 < -32767)
+ x1 = -32767;
+ if (x2 > 32767)
+ x2 = 32767;
+
+ /*
+ * In some weird cases (such as large border widths for skinny
+ * rectangles) x1 can be >= x2. Don't draw the lines
+ * in these cases.
+ */
+
+ if (x1 < x2) {
+ XFillRectangle(display, drawable,
+ (y < halfway) ? topGC : bottomGC, x1, y,
+ (unsigned) (x2-x1), (unsigned) 1);
+ }
+ x1 += x1Delta;
+ x2 += x2Delta;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetShadows --
+ *
+ * This procedure computes the shadow colors for a 3-D border
+ * and fills in the corresponding fields of the Border structure.
+ * It's called lazily, so that the colors aren't allocated until
+ * something is actually drawn with them. That way, if a border
+ * is only used for flat backgrounds the shadow colors will
+ * never be allocated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The lightGC and darkGC fields in borderPtr get filled in,
+ * if they weren't already.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpGetShadows(borderPtr, tkwin)
+ TkBorder *borderPtr; /* Information about border. */
+ Tk_Window tkwin; /* Window where border will be used for
+ * drawing. */
+{
+ XColor lightColor, darkColor;
+ int stressed, tmp1, tmp2;
+ int r, g, b;
+ XGCValues gcValues;
+
+ if (borderPtr->lightGC != None) {
+ return;
+ }
+ stressed = TkpCmapStressed(tkwin, borderPtr->colormap);
+
+ /*
+ * First, handle the case of a color display with lots of colors.
+ * The shadow colors get computed using whichever formula results
+ * in the greatest change in color:
+ * 1. Lighter shadow is half-way to white, darker shadow is half
+ * way to dark.
+ * 2. Lighter shadow is 40% brighter than background, darker shadow
+ * is 40% darker than background.
+ */
+
+ if (!stressed && (Tk_Depth(tkwin) >= 6)) {
+ /*
+ * This is a color display with lots of colors. For the dark
+ * shadow, cut 40% from each of the background color components.
+ * But if the background is already very dark, make the
+ * dark color a little lighter than the background by increasing
+ * each color component 1/4th of the way to MAX_INTENSITY.
+ *
+ * For the light shadow, boost each component by 40% or half-way
+ * to white, whichever is greater (the first approach works
+ * better for unsaturated colors, the second for saturated ones).
+ * But if the background is already very bright, instead choose a
+ * slightly darker color for the light shadow by reducing each
+ * color component by 10%.
+ *
+ * Compute the colors using integers, not using lightColor.red
+ * etc.: these are shorts and may have problems with integer
+ * overflow.
+ */
+
+ /*
+ * Compute the dark shadow color
+ */
+
+ r = (int) borderPtr->bgColorPtr->red;
+ g = (int) borderPtr->bgColorPtr->green;
+ b = (int) borderPtr->bgColorPtr->blue;
+
+ if (r*0.5*r + g*1.0*g + b*0.28*b < MAX_INTENSITY*0.05*MAX_INTENSITY) {
+ darkColor.red = (MAX_INTENSITY + 3*r)/4;
+ darkColor.green = (MAX_INTENSITY + 3*g)/4;
+ darkColor.blue = (MAX_INTENSITY + 3*b)/4;
+ } else {
+ darkColor.red = (60 * r)/100;
+ darkColor.green = (60 * g)/100;
+ darkColor.blue = (60 * b)/100;
+ }
+
+ /*
+ * Allocate the dark shadow color and its GC
+ */
+
+ borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor);
+ gcValues.foreground = borderPtr->darkColorPtr->pixel;
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+
+ /*
+ * Compute the light shadow color
+ */
+
+ if (g > MAX_INTENSITY*0.95) {
+ lightColor.red = (90 * r)/100;
+ lightColor.green = (90 * g)/100;
+ lightColor.blue = (90 * b)/100;
+ } else {
+ tmp1 = (14 * r)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + r)/2;
+ lightColor.red = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * g)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + g)/2;
+ lightColor.green = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * b)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + b)/2;
+ lightColor.blue = (tmp1 > tmp2) ? tmp1 : tmp2;
+ }
+
+ /*
+ * Allocate the light shadow color and its GC
+ */
+
+ borderPtr->lightColorPtr = Tk_GetColorByValue(tkwin, &lightColor);
+ gcValues.foreground = borderPtr->lightColorPtr->pixel;
+ borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return;
+ }
+
+ if (borderPtr->shadow == None) {
+ borderPtr->shadow = Tk_GetBitmap((Tcl_Interp *) NULL, tkwin,
+ Tk_GetUid("gray50"));
+ if (borderPtr->shadow == None) {
+ panic("TkpGetShadows couldn't allocate bitmap for border");
+ }
+ }
+ if (borderPtr->visual->map_entries > 2) {
+ /*
+ * This isn't a monochrome display, but the colormap either
+ * ran out of entries or didn't have very many to begin with.
+ * Generate the light shadows with a white stipple and the
+ * dark shadows with a black stipple.
+ */
+
+ gcValues.foreground = borderPtr->bgColorPtr->pixel;
+ gcValues.background = BlackPixelOfScreen(borderPtr->screen);
+ gcValues.stipple = borderPtr->shadow;
+ gcValues.fill_style = FillOpaqueStippled;
+ borderPtr->darkGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ gcValues.background = WhitePixelOfScreen(borderPtr->screen);
+ borderPtr->lightGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ return;
+ }
+
+ /*
+ * This is just a measly monochrome display, hardly even worth its
+ * existence on this earth. Make one shadow a 50% stipple and the
+ * other the opposite of the background.
+ */
+
+ gcValues.foreground = WhitePixelOfScreen(borderPtr->screen);
+ gcValues.background = BlackPixelOfScreen(borderPtr->screen);
+ gcValues.stipple = borderPtr->shadow;
+ gcValues.fill_style = FillOpaqueStippled;
+ borderPtr->lightGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ if (borderPtr->bgColorPtr->pixel
+ == WhitePixelOfScreen(borderPtr->screen)) {
+ gcValues.foreground = BlackPixelOfScreen(borderPtr->screen);
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ } else {
+ borderPtr->darkGC = borderPtr->lightGC;
+ borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ }
+}
--- /dev/null
+/*
+ * tkUnixButton.c --
+ *
+ * This file implements the Unix specific portion of the button
+ * widgets.
+ *
+ * Copyright (c) 1996-1997 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkButton.h"
+
+/*
+ * Declaration of Unix specific button structure.
+ */
+
+typedef struct UnixButton {
+ TkButton info; /* Generic button info. */
+} UnixButton;
+
+/*
+ * The class procedure table for the button widgets.
+ */
+
+Tk_ClassProcs tkpButtonProcs = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkButtonWorldChanged, /* worldChangedProc */
+};
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateButton --
+ *
+ * Allocate a new TkButton structure.
+ *
+ * Results:
+ * Returns a newly allocated TkButton structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkButton *
+TkpCreateButton(tkwin)
+ Tk_Window tkwin;
+{
+ UnixButton *butPtr = (UnixButton *)ckalloc(sizeof(UnixButton));
+ return (TkButton *) butPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayButton --
+ *
+ * This procedure is invoked to display a button widget. It is
+ * normally invoked as an idle handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the button in its
+ * current mode. The REDRAW_PENDING flag is cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayButton(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+ GC gc;
+ Tk_3DBorder border;
+ Pixmap pixmap;
+ int x = 0; /* Initialization only needed to stop
+ * compiler warning. */
+ int y, relief;
+ Tk_Window tkwin = butPtr->tkwin;
+ int width, height, fullWidth, fullHeight;
+ int imageXOffset, imageYOffset, textXOffset, textYOffset;
+ int haveImage = 0, haveText = 0;
+ int offset; /* 1 means this is a button widget, so we
+ * offset the text to make the button appear
+ * to move up and down as the relief changes.
+ */
+
+ butPtr->flags &= ~REDRAW_PENDING;
+ if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ border = butPtr->normalBorder;
+ if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
+ gc = butPtr->disabledGC;
+ } else if ((butPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(butPtr->tkwin)) {
+ gc = butPtr->activeTextGC;
+ border = butPtr->activeBorder;
+ } else {
+ gc = butPtr->normalTextGC;
+ }
+ if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
+ && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
+ border = butPtr->selectBorder;
+ }
+
+ /*
+ * Override the relief specified for the button if this is a
+ * checkbutton or radiobutton and there's no indicator. The new
+ * relief is as follows:
+ * If the button is select --> "sunken"
+ * If relief==overrelief --> relief
+ * Otherwise --> overrelief
+ *
+ * The effect we are trying to achieve is as follows:
+ *
+ * value mouse-over? --> relief
+ * ------- ------------ --------
+ * off no flat
+ * off yes raised
+ * on no sunken
+ * on yes sunken
+ *
+ * This is accomplished by configuring the checkbutton or radiobutton
+ * like this:
+ *
+ * -indicatoron 0 -overrelief raised -offrelief flat
+ *
+ * Bindings (see library/button.tcl) will copy the -overrelief into
+ * -relief on mouseover. Hence, we can tell if we are in mouse-over by
+ * comparing relief against overRelief. This is an aweful kludge, but
+ * it gives use the desired behavior while keeping the code backwards
+ * compatible.
+ */
+
+ relief = butPtr->relief;
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
+ if (butPtr->flags & SELECTED) {
+ relief = TK_RELIEF_SUNKEN;
+ } else if (butPtr->overRelief != relief) {
+ relief = butPtr->offRelief;
+ }
+ }
+
+ offset = (butPtr->type == TYPE_BUTTON) && !Tk_StrictMotif(butPtr->tkwin);
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the button in a pixmap, then copies the pixmap to the
+ * screen in a single operation. This means that there's no
+ * point in time where the on-sreen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(butPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+ Tk_Fill3DRectangle(tkwin, pixmap, border, 0, 0, Tk_Width(tkwin),
+ Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Display image or bitmap or text for button.
+ */
+
+ if (butPtr->image != NULL) {
+ Tk_SizeOfImage(butPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+ haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0);
+
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ imageXOffset = 0;
+ imageYOffset = 0;
+ textXOffset = 0;
+ textYOffset = 0;
+ fullWidth = 0;
+ fullHeight = 0;
+
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (butPtr->compound == COMPOUND_TOP) {
+ textYOffset = height + butPtr->padY;
+ } else {
+ imageYOffset = butPtr->textHeight + butPtr->padY;
+ }
+ fullHeight = height + butPtr->textHeight + butPtr->padY;
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ if (butPtr->compound == COMPOUND_LEFT) {
+ textXOffset = width + butPtr->padX;
+ } else {
+ imageXOffset = butPtr->textWidth + butPtr->padX;
+ }
+ fullWidth = butPtr->textWidth + butPtr->padX + width;
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + fullWidth, fullHeight, &x, &y);
+
+ x += butPtr->indicatorSpace;
+
+ x += offset;
+ y += offset;
+ if (relief == TK_RELIEF_RAISED) {
+ x -= offset;
+ y -= offset;
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ x += offset;
+ y += offset;
+ }
+
+ if (butPtr->image != NULL) {
+ if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) {
+ Tk_RedrawImage(butPtr->selectImage, 0, 0,
+ width, height, pixmap, x + imageXOffset,
+ y + imageYOffset);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width,
+ height, pixmap, x + imageXOffset, y + imageYOffset);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, gc, x + imageXOffset,
+ y + imageYOffset);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc,
+ 0, 0, (unsigned int) width,
+ (unsigned int) height, x + imageXOffset,
+ y + imageYOffset, 1);
+ XSetClipOrigin(butPtr->display, gc, 0, 0);
+ }
+
+ Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
+ x + textXOffset, y + textYOffset, 0, -1);
+ Tk_UnderlineTextLayout(butPtr->display, pixmap, gc,
+ butPtr->textLayout, x + textXOffset, y + textYOffset,
+ butPtr->underline);
+ y += fullHeight/2;
+ } else {
+ if (haveImage) {
+ TkComputeAnchor(butPtr->anchor, tkwin, 0, 0,
+ butPtr->indicatorSpace + width, height, &x, &y);
+ x += butPtr->indicatorSpace;
+
+ x += offset;
+ y += offset;
+ if (relief == TK_RELIEF_RAISED) {
+ x -= offset;
+ y -= offset;
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ x += offset;
+ y += offset;
+ }
+ if (butPtr->image != NULL) {
+ if ((butPtr->selectImage != NULL) &&
+ (butPtr->flags & SELECTED)) {
+ Tk_RedrawImage(butPtr->selectImage, 0, 0, width,
+ height, pixmap, x, y);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width, height, pixmap,
+ x, y);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, gc, x, y);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0,
+ (unsigned int) width, (unsigned int) height, x, y, 1);
+ XSetClipOrigin(butPtr->display, gc, 0, 0);
+ }
+ y += height/2;
+ } else {
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + butPtr->textWidth,
+ butPtr->textHeight, &x, &y);
+
+ x += butPtr->indicatorSpace;
+
+ x += offset;
+ y += offset;
+ if (relief == TK_RELIEF_RAISED) {
+ x -= offset;
+ y -= offset;
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ x += offset;
+ y += offset;
+ }
+ Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
+ x, y, 0, -1);
+ Tk_UnderlineTextLayout(butPtr->display, pixmap, gc,
+ butPtr->textLayout, x, y, butPtr->underline);
+ y += butPtr->textHeight/2;
+ }
+ }
+
+ /*
+ * Draw the indicator for check buttons and radio buttons. At this
+ * point x and y refer to the top-left corner of the text or image
+ * or bitmap.
+ */
+
+ if ((butPtr->type == TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
+ int dim;
+
+ dim = butPtr->indicatorDiameter;
+ x -= butPtr->indicatorSpace;
+ y -= dim/2;
+ if (dim > 2*butPtr->borderWidth) {
+ Tk_Draw3DRectangle(tkwin, pixmap, border, x, y, dim, dim,
+ butPtr->borderWidth,
+ (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN :
+ TK_RELIEF_RAISED);
+ x += butPtr->borderWidth;
+ y += butPtr->borderWidth;
+ dim -= 2*butPtr->borderWidth;
+ if (butPtr->flags & SELECTED) {
+ GC gc;
+ if (butPtr->state != STATE_DISABLED &&
+ butPtr->selectBorder != NULL) {
+ gc = Tk_3DBorderGC(tkwin, butPtr->selectBorder,
+ TK_3D_FLAT_GC);
+ } else {
+ gc = Tk_3DBorderGC(tkwin, butPtr->normalBorder,
+ TK_3D_FLAT_GC);
+ }
+
+ XFillRectangle(butPtr->display, pixmap, gc, x, y,
+ (unsigned int) dim, (unsigned int) dim);
+ } else {
+ Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, x, y,
+ dim, dim, butPtr->borderWidth, TK_RELIEF_FLAT);
+ }
+ }
+ } else if ((butPtr->type == TYPE_RADIO_BUTTON) && butPtr->indicatorOn) {
+ XPoint points[4];
+ int radius;
+
+ radius = butPtr->indicatorDiameter/2;
+ points[0].x = x - butPtr->indicatorSpace;
+ points[0].y = y;
+ points[1].x = points[0].x + radius;
+ points[1].y = points[0].y + radius;
+ points[2].x = points[1].x + radius;
+ points[2].y = points[0].y;
+ points[3].x = points[1].x;
+ points[3].y = points[0].y - radius;
+ if (butPtr->flags & SELECTED) {
+ GC gc;
+
+ if (butPtr->state != STATE_DISABLED &&
+ butPtr->selectBorder != NULL) {
+ gc = Tk_3DBorderGC(tkwin, butPtr->selectBorder, TK_3D_FLAT_GC);
+ } else {
+ gc = Tk_3DBorderGC(tkwin, butPtr->normalBorder, TK_3D_FLAT_GC);
+ }
+
+ XFillPolygon(butPtr->display, pixmap, gc, points, 4, Convex,
+ CoordModeOrigin);
+ } else {
+ Tk_Fill3DPolygon(tkwin, pixmap, butPtr->normalBorder, points,
+ 4, butPtr->borderWidth, TK_RELIEF_FLAT);
+ }
+ Tk_Draw3DPolygon(tkwin, pixmap, border, points, 4, butPtr->borderWidth,
+ (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN :
+ TK_RELIEF_RAISED);
+ }
+
+ /*
+ * If the button is disabled with a stipple rather than a special
+ * foreground color, generate the stippled effect. If the widget
+ * is selected and we use a different background color when selected,
+ * must temporarily modify the GC.
+ */
+
+ if ((butPtr->state == STATE_DISABLED)
+ && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->selectBorder)->pixel);
+ }
+ XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,
+ butPtr->inset, butPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*butPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*butPtr->inset));
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->normalBorder)->pixel);
+ }
+ }
+
+ /*
+ * Draw the border and traversal highlight last. This way, if the
+ * button's contents overflow they'll be covered up by the border.
+ * This code is complicated by the possible combinations of focus
+ * highlight and default rings. We draw the focus and highlight rings
+ * using the highlight border and highlight foreground color.
+ */
+
+ if (relief != TK_RELIEF_FLAT) {
+ int inset = butPtr->highlightWidth;
+
+ if (butPtr->defaultState == DEFAULT_ACTIVE) {
+ /*
+ * Draw the default ring with 2 pixels of space between the
+ * default ring and the button and the default ring and the
+ * focus ring. Note that we need to explicitly draw the space
+ * in the highlightBorder color to ensure that we overwrite any
+ * overflow text and/or a different button background color.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset,
+ inset, Tk_Width(tkwin) - 2*inset,
+ Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT);
+ inset += 2;
+ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset,
+ inset, Tk_Width(tkwin) - 2*inset,
+ Tk_Height(tkwin) - 2*inset, 1, TK_RELIEF_SUNKEN);
+ inset++;
+ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset,
+ inset, Tk_Width(tkwin) - 2*inset,
+ Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT);
+
+ inset += 2;
+ } else if (butPtr->defaultState == DEFAULT_NORMAL) {
+ /*
+ * Leave room for the default ring and write over any text or
+ * background color.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0,
+ 0, Tk_Width(tkwin), Tk_Height(tkwin), 5, TK_RELIEF_FLAT);
+ inset += 5;
+ }
+
+ /*
+ * Draw the button border.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, border, inset, inset,
+ Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset,
+ butPtr->borderWidth, relief);
+ }
+ if (butPtr->highlightWidth > 0) {
+ GC gc;
+
+ if (butPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(butPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(Tk_3DBorderColor(butPtr->highlightBorder),
+ pixmap);
+ }
+
+ /*
+ * Make sure the focus ring shrink-wraps the actual button, not the
+ * padding space left for a default ring.
+ */
+
+ if (butPtr->defaultState == DEFAULT_NORMAL) {
+ TkDrawInsetFocusHighlight(tkwin, gc, butPtr->highlightWidth,
+ pixmap, 5);
+ } else {
+ Tk_DrawFocusHighlight(tkwin, gc, butPtr->highlightWidth, pixmap);
+ }
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(butPtr->display, pixmap, Tk_WindowId(tkwin),
+ butPtr->copyGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(butPtr->display, pixmap);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeButtonGeometry --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpComputeButtonGeometry(butPtr)
+ register TkButton *butPtr; /* Button whose geometry may have changed. */
+{
+ int width, height, avgWidth, txtWidth, txtHeight;
+ int haveImage = 0, haveText = 0;
+ Tk_FontMetrics fm;
+
+ butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;
+
+ /*
+ * Leave room for the default ring if needed.
+ */
+
+ if (butPtr->defaultState != DEFAULT_DISABLED) {
+ butPtr->inset += 5;
+ }
+ butPtr->indicatorSpace = 0;
+
+ width = 0;
+ height = 0;
+ txtWidth = 0;
+ txtHeight = 0;
+ avgWidth = 0;
+
+ if (butPtr->image != NULL) {
+ Tk_SizeOfImage(butPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+
+ if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) {
+ Tk_FreeTextLayout(butPtr->textLayout);
+
+ butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
+ butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
+
+ txtWidth = butPtr->textWidth;
+ txtHeight = butPtr->textHeight;
+ avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
+ Tk_GetFontMetrics(butPtr->tkfont, &fm);
+ haveText = (txtWidth != 0 && txtHeight != 0);
+ }
+
+ /*
+ * If the button is compound (ie, it shows both an image and text),
+ * the new geometry is a combination of the image and text geometry.
+ * We only honor the compound bit if the button has both text and an
+ * image, because otherwise it is not really a compound button.
+ */
+
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ height += txtHeight + butPtr->padY;
+ width = (width > txtWidth ? width : txtWidth);
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ width += txtWidth + butPtr->padX;
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ width = (width > txtWidth ? width : txtWidth);
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ if (butPtr->width > 0) {
+ width = butPtr->width;
+ }
+ if (butPtr->height > 0) {
+ height = butPtr->height;
+ }
+
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
+ butPtr->indicatorSpace = height;
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ butPtr->indicatorDiameter = (65*height)/100;
+ } else {
+ butPtr->indicatorDiameter = (75*height)/100;
+ }
+ }
+
+ width += 2*butPtr->padX;
+ height += 2*butPtr->padY;
+
+ } else {
+ if (haveImage) {
+ if (butPtr->width > 0) {
+ width = butPtr->width;
+ }
+ if (butPtr->height > 0) {
+ height = butPtr->height;
+ }
+
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
+ butPtr->indicatorSpace = height;
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ butPtr->indicatorDiameter = (65*height)/100;
+ } else {
+ butPtr->indicatorDiameter = (75*height)/100;
+ }
+ }
+ } else {
+ width = txtWidth;
+ height = txtHeight;
+
+ if (butPtr->width > 0) {
+ width = butPtr->width * avgWidth;
+ }
+ if (butPtr->height > 0) {
+ height = butPtr->height * fm.linespace;
+ }
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
+ butPtr->indicatorDiameter = fm.linespace;
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ butPtr->indicatorDiameter =
+ (80*butPtr->indicatorDiameter)/100;
+ }
+ butPtr->indicatorSpace = butPtr->indicatorDiameter + avgWidth;
+ }
+ }
+ }
+
+ /*
+ * When issuing the geometry request, add extra space for the indicator,
+ * if any, and for the border and padding, plus two extra pixels so the
+ * display can be offset by 1 pixel in either direction for the raised
+ * or lowered effect.
+ */
+
+ if ((butPtr->image == NULL) && (butPtr->bitmap == None)) {
+ width += 2*butPtr->padX;
+ height += 2*butPtr->padY;
+ }
+ if ((butPtr->type == TYPE_BUTTON) && !Tk_StrictMotif(butPtr->tkwin)) {
+ width += 2;
+ height += 2;
+ }
+ Tk_GeometryRequest(butPtr->tkwin, (int) (width + butPtr->indicatorSpace
+ + 2*butPtr->inset), (int) (height + 2*butPtr->inset));
+ Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
+}
--- /dev/null
+/*
+ * tkUnixColor.c --
+ *
+ * This file contains the platform specific color routines
+ * needed for X support.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <tkColor.h>
+
+/*
+ * If a colormap fills up, attempts to allocate new colors from that
+ * colormap will fail. When that happens, we'll just choose the
+ * closest color from those that are available in the colormap.
+ * One of the following structures will be created for each "stressed"
+ * colormap to keep track of the colors that are available in the
+ * colormap (otherwise we would have to re-query from the server on
+ * each allocation, which would be very slow). These entries are
+ * flushed after a few seconds, since other clients may release or
+ * reallocate colors over time.
+ */
+
+struct TkStressedCmap {
+ Colormap colormap; /* X's token for the colormap. */
+ int numColors; /* Number of entries currently active
+ * at *colorPtr. */
+ XColor *colorPtr; /* Pointer to malloc'ed array of all
+ * colors that seem to be available in
+ * the colormap. Some may not actually
+ * be available, e.g. because they are
+ * read-write for another client; when
+ * we find this out, we remove them
+ * from the array. */
+ struct TkStressedCmap *nextPtr; /* Next in list of all stressed
+ * colormaps for the display. */
+};
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void DeleteStressedCmap _ANSI_ARGS_((Display *display,
+ Colormap colormap));
+static void FindClosestColor _ANSI_ARGS_((Tk_Window tkwin,
+ XColor *desiredColorPtr, XColor *actualColorPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeColor --
+ *
+ * Release the specified color back to the system.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Invalidates the colormap cache for the colormap associated with
+ * the given color.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeColor(tkColPtr)
+ TkColor *tkColPtr; /* Color to be released. Must have been
+ * allocated by TkpGetColor or
+ * TkpGetColorByValue. */
+{
+ Visual *visual;
+ Screen *screen = tkColPtr->screen;
+
+ /*
+ * Careful! Don't free black or white, since this will
+ * make some servers very unhappy. Also, there is a bug in
+ * some servers (such Sun's X11/NeWS server) where reference
+ * counting is performed incorrectly, so that if a color is
+ * allocated twice in different places and then freed twice,
+ * the second free generates an error (this bug existed as of
+ * 10/1/92). To get around this problem, ignore errors that
+ * occur during the free operation.
+ */
+
+ visual = tkColPtr->visual;
+ if ((visual->class != StaticGray) && (visual->class != StaticColor)
+ && (tkColPtr->color.pixel != BlackPixelOfScreen(screen))
+ && (tkColPtr->color.pixel != WhitePixelOfScreen(screen))) {
+ Tk_ErrorHandler handler;
+
+ handler = Tk_CreateErrorHandler(DisplayOfScreen(screen),
+ -1, -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XFreeColors(DisplayOfScreen(screen), tkColPtr->colormap,
+ &tkColPtr->color.pixel, 1, 0L);
+ Tk_DeleteErrorHandler(handler);
+ }
+ DeleteStressedCmap(DisplayOfScreen(screen), tkColPtr->colormap);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetColor --
+ *
+ * Allocate a new TkColor for the color with the given name.
+ *
+ * Results:
+ * Returns a newly allocated TkColor, or NULL on failure.
+ *
+ * Side effects:
+ * May invalidate the colormap cache associated with tkwin upon
+ * allocating a new colormap entry. Allocates a new TkColor
+ * structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkColor *
+TkpGetColor(tkwin, name)
+ Tk_Window tkwin; /* Window in which color will be used. */
+ Tk_Uid name; /* Name of color to allocated (in form
+ * suitable for passing to XParseColor). */
+{
+ Display *display = Tk_Display(tkwin);
+ Colormap colormap = Tk_Colormap(tkwin);
+ XColor color;
+ TkColor *tkColPtr;
+
+ /*
+ * Map from the name to a pixel value. Call XAllocNamedColor rather than
+ * XParseColor for non-# names: this saves a server round-trip for those
+ * names.
+ */
+
+ if (*name != '#') {
+ XColor screen;
+
+ if (XAllocNamedColor(display, colormap, name, &screen,
+ &color) != 0) {
+ DeleteStressedCmap(display, colormap);
+ } else {
+ /*
+ * Couldn't allocate the color. Try translating the name to
+ * a color value, to see whether the problem is a bad color
+ * name or a full colormap. If the colormap is full, then
+ * pick an approximation to the desired color.
+ */
+
+ if (XLookupColor(display, colormap, name, &color,
+ &screen) == 0) {
+ return (TkColor *) NULL;
+ }
+ FindClosestColor(tkwin, &screen, &color);
+ }
+ } else {
+ if (XParseColor(display, colormap, name, &color) == 0) {
+ return (TkColor *) NULL;
+ }
+ if (XAllocColor(display, colormap, &color) != 0) {
+ DeleteStressedCmap(display, colormap);
+ } else {
+ FindClosestColor(tkwin, &color, &color);
+ }
+ }
+
+ tkColPtr = (TkColor *) ckalloc(sizeof(TkColor));
+ tkColPtr->color = color;
+
+ return tkColPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetColorByValue --
+ *
+ * Given a desired set of red-green-blue intensities for a color,
+ * locate a pixel value to use to draw that color in a given
+ * window.
+ *
+ * Results:
+ * The return value is a pointer to an TkColor structure that
+ * indicates the closest red, blue, and green intensities available
+ * to those specified in colorPtr, and also specifies a pixel
+ * value to use to draw in that color.
+ *
+ * Side effects:
+ * May invalidate the colormap cache for the specified window.
+ * Allocates a new TkColor structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkColor *
+TkpGetColorByValue(tkwin, colorPtr)
+ Tk_Window tkwin; /* Window in which color will be used. */
+ XColor *colorPtr; /* Red, green, and blue fields indicate
+ * desired color. */
+{
+ Display *display = Tk_Display(tkwin);
+ Colormap colormap = Tk_Colormap(tkwin);
+ TkColor *tkColPtr = (TkColor *) ckalloc(sizeof(TkColor));
+
+ tkColPtr->color.red = colorPtr->red;
+ tkColPtr->color.green = colorPtr->green;
+ tkColPtr->color.blue = colorPtr->blue;
+ if (XAllocColor(display, colormap, &tkColPtr->color) != 0) {
+ DeleteStressedCmap(display, colormap);
+ } else {
+ FindClosestColor(tkwin, &tkColPtr->color, &tkColPtr->color);
+ }
+
+ return tkColPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindClosestColor --
+ *
+ * When Tk can't allocate a color because a colormap has filled
+ * up, this procedure is called to find and allocate the closest
+ * available color in the colormap.
+ *
+ * Results:
+ * There is no return value, but *actualColorPtr is filled in
+ * with information about the closest available color in tkwin's
+ * colormap. This color has been allocated via X, so it must
+ * be released by the caller when the caller is done with it.
+ *
+ * Side effects:
+ * A color is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FindClosestColor(tkwin, desiredColorPtr, actualColorPtr)
+ Tk_Window tkwin; /* Window where color will be used. */
+ XColor *desiredColorPtr; /* RGB values of color that was
+ * wanted (but unavailable). */
+ XColor *actualColorPtr; /* Structure to fill in with RGB and
+ * pixel for closest available
+ * color. */
+{
+ TkStressedCmap *stressPtr;
+ double tmp, distance, closestDistance;
+ int i, closest, numFound;
+ XColor *colorPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ Colormap colormap = Tk_Colormap(tkwin);
+ XVisualInfo template, *visInfoPtr;
+
+ /*
+ * Find the TkStressedCmap structure for this colormap, or create
+ * a new one if needed.
+ */
+
+ for (stressPtr = dispPtr->stressPtr; ; stressPtr = stressPtr->nextPtr) {
+ if (stressPtr == NULL) {
+ stressPtr = (TkStressedCmap *) ckalloc(sizeof(TkStressedCmap));
+ stressPtr->colormap = colormap;
+ template.visualid = XVisualIDFromVisual(Tk_Visual(tkwin));
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin),
+ VisualIDMask, &template, &numFound);
+ if (numFound < 1) {
+ panic("FindClosestColor couldn't lookup visual");
+ }
+ stressPtr->numColors = visInfoPtr->colormap_size;
+ XFree((char *) visInfoPtr);
+ stressPtr->colorPtr = (XColor *) ckalloc((unsigned)
+ (stressPtr->numColors * sizeof(XColor)));
+ for (i = 0; i < stressPtr->numColors; i++) {
+ stressPtr->colorPtr[i].pixel = (unsigned long) i;
+ }
+ XQueryColors(dispPtr->display, colormap, stressPtr->colorPtr,
+ stressPtr->numColors);
+ stressPtr->nextPtr = dispPtr->stressPtr;
+ dispPtr->stressPtr = stressPtr;
+ break;
+ }
+ if (stressPtr->colormap == colormap) {
+ break;
+ }
+ }
+
+ /*
+ * Find the color that best approximates the desired one, then
+ * try to allocate that color. If that fails, it must mean that
+ * the color was read-write (so we can't use it, since it's owner
+ * might change it) or else it was already freed. Try again,
+ * over and over again, until something succeeds.
+ */
+
+ while (1) {
+ if (stressPtr->numColors == 0) {
+ panic("FindClosestColor ran out of colors");
+ }
+ closestDistance = 1e30;
+ closest = 0;
+ for (colorPtr = stressPtr->colorPtr, i = 0; i < stressPtr->numColors;
+ colorPtr++, i++) {
+ /*
+ * Use Euclidean distance in RGB space, weighted by Y (of YIQ)
+ * as the objective function; this accounts for differences
+ * in the color sensitivity of the eye.
+ */
+
+ tmp = .30*(((int) desiredColorPtr->red) - (int) colorPtr->red);
+ distance = tmp*tmp;
+ tmp = .61*(((int) desiredColorPtr->green) - (int) colorPtr->green);
+ distance += tmp*tmp;
+ tmp = .11*(((int) desiredColorPtr->blue) - (int) colorPtr->blue);
+ distance += tmp*tmp;
+ if (distance < closestDistance) {
+ closest = i;
+ closestDistance = distance;
+ }
+ }
+ if (XAllocColor(dispPtr->display, colormap,
+ &stressPtr->colorPtr[closest]) != 0) {
+ *actualColorPtr = stressPtr->colorPtr[closest];
+ return;
+ }
+
+ /*
+ * Couldn't allocate the color. Remove it from the table and
+ * go back to look for the next best color.
+ */
+
+ stressPtr->colorPtr[closest] =
+ stressPtr->colorPtr[stressPtr->numColors-1];
+ stressPtr->numColors -= 1;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteStressedCmap --
+ *
+ * This procedure releases the information cached for "colormap"
+ * so that it will be refetched from the X server the next time
+ * it is needed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The TkStressedCmap structure for colormap is deleted; the
+ * colormap is no longer considered to be "stressed".
+ *
+ * Note:
+ * This procedure is invoked whenever a color in a colormap is
+ * freed, and whenever a color allocation in a colormap succeeds.
+ * This guarantees that TkStressedCmap structures are always
+ * deleted before the corresponding Colormap is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteStressedCmap(display, colormap)
+ Display *display; /* Xlib's handle for the display
+ * containing the colormap. */
+ Colormap colormap; /* Colormap to flush. */
+{
+ TkStressedCmap *prevPtr, *stressPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ for (prevPtr = NULL, stressPtr = dispPtr->stressPtr; stressPtr != NULL;
+ prevPtr = stressPtr, stressPtr = stressPtr->nextPtr) {
+ if (stressPtr->colormap == colormap) {
+ if (prevPtr == NULL) {
+ dispPtr->stressPtr = stressPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = stressPtr->nextPtr;
+ }
+ ckfree((char *) stressPtr->colorPtr);
+ ckfree((char *) stressPtr);
+ return;
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCmapStressed --
+ *
+ * Check to see whether a given colormap is known to be out
+ * of entries.
+ *
+ * Results:
+ * 1 is returned if "colormap" is stressed (i.e. it has run out
+ * of entries recently), 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpCmapStressed(tkwin, colormap)
+ Tk_Window tkwin; /* Window that identifies the display
+ * containing the colormap. */
+ Colormap colormap; /* Colormap to check for stress. */
+{
+ TkStressedCmap *stressPtr;
+
+ for (stressPtr = ((TkWindow *) tkwin)->dispPtr->stressPtr;
+ stressPtr != NULL; stressPtr = stressPtr->nextPtr) {
+ if (stressPtr->colormap == colormap) {
+ return 1;
+ }
+ }
+ return 0;
+}
--- /dev/null
+/*
+ * tkUnixConfig.c --
+ *
+ * This module implements the Unix system defaults for
+ * the configuration package.
+ *
+ * Copyright (c) 1997 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk.h"
+#include "tkInt.h"
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetSystemDefault --
+ *
+ * Given a dbName and className for a configuration option,
+ * return a string representation of the option.
+ *
+ * Results:
+ * Returns a Tk_Uid that is the string identifier that identifies
+ * this option. Returns NULL if there are no system defaults
+ * that match this pair.
+ *
+ * Side effects:
+ * None, once the package is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkpGetSystemDefault(tkwin, dbName, className)
+ Tk_Window tkwin; /* A window to use. */
+ CONST char *dbName; /* The option database name. */
+ CONST char *className; /* The name of the option class. */
+{
+ return NULL;
+}
--- /dev/null
+/*
+ * tkUnixCursor.c --
+ *
+ * This file contains X specific cursor manipulation routines.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following data structure is a superset of the TkCursor structure
+ * defined in tkCursor.c. Each system specific cursor module will define
+ * a different cursor structure. All of these structures must have the
+ * same header consisting of the fields in TkCursor.
+ */
+
+
+
+typedef struct {
+ TkCursor info; /* Generic cursor info used by tkCursor.c */
+ Display *display; /* Display for which cursor is valid. */
+} TkUnixCursor;
+
+/*
+ * The table below is used to map from the name of a cursor to its
+ * index in the official cursor font:
+ */
+
+static struct CursorName {
+ char *name;
+ unsigned int shape;
+} cursorNames[] = {
+ {"X_cursor", XC_X_cursor},
+ {"arrow", XC_arrow},
+ {"based_arrow_down", XC_based_arrow_down},
+ {"based_arrow_up", XC_based_arrow_up},
+ {"boat", XC_boat},
+ {"bogosity", XC_bogosity},
+ {"bottom_left_corner", XC_bottom_left_corner},
+ {"bottom_right_corner", XC_bottom_right_corner},
+ {"bottom_side", XC_bottom_side},
+ {"bottom_tee", XC_bottom_tee},
+ {"box_spiral", XC_box_spiral},
+ {"center_ptr", XC_center_ptr},
+ {"circle", XC_circle},
+ {"clock", XC_clock},
+ {"coffee_mug", XC_coffee_mug},
+ {"cross", XC_cross},
+ {"cross_reverse", XC_cross_reverse},
+ {"crosshair", XC_crosshair},
+ {"diamond_cross", XC_diamond_cross},
+ {"dot", XC_dot},
+ {"dotbox", XC_dotbox},
+ {"double_arrow", XC_double_arrow},
+ {"draft_large", XC_draft_large},
+ {"draft_small", XC_draft_small},
+ {"draped_box", XC_draped_box},
+ {"exchange", XC_exchange},
+ {"fleur", XC_fleur},
+ {"gobbler", XC_gobbler},
+ {"gumby", XC_gumby},
+ {"hand1", XC_hand1},
+ {"hand2", XC_hand2},
+ {"heart", XC_heart},
+ {"icon", XC_icon},
+ {"iron_cross", XC_iron_cross},
+ {"left_ptr", XC_left_ptr},
+ {"left_side", XC_left_side},
+ {"left_tee", XC_left_tee},
+ {"leftbutton", XC_leftbutton},
+ {"ll_angle", XC_ll_angle},
+ {"lr_angle", XC_lr_angle},
+ {"man", XC_man},
+ {"middlebutton", XC_middlebutton},
+ {"mouse", XC_mouse},
+ {"pencil", XC_pencil},
+ {"pirate", XC_pirate},
+ {"plus", XC_plus},
+ {"question_arrow", XC_question_arrow},
+ {"right_ptr", XC_right_ptr},
+ {"right_side", XC_right_side},
+ {"right_tee", XC_right_tee},
+ {"rightbutton", XC_rightbutton},
+ {"rtl_logo", XC_rtl_logo},
+ {"sailboat", XC_sailboat},
+ {"sb_down_arrow", XC_sb_down_arrow},
+ {"sb_h_double_arrow", XC_sb_h_double_arrow},
+ {"sb_left_arrow", XC_sb_left_arrow},
+ {"sb_right_arrow", XC_sb_right_arrow},
+ {"sb_up_arrow", XC_sb_up_arrow},
+ {"sb_v_double_arrow", XC_sb_v_double_arrow},
+ {"shuttle", XC_shuttle},
+ {"sizing", XC_sizing},
+ {"spider", XC_spider},
+ {"spraycan", XC_spraycan},
+ {"star", XC_star},
+ {"target", XC_target},
+ {"tcross", XC_tcross},
+ {"top_left_arrow", XC_top_left_arrow},
+ {"top_left_corner", XC_top_left_corner},
+ {"top_right_corner", XC_top_right_corner},
+ {"top_side", XC_top_side},
+ {"top_tee", XC_top_tee},
+ {"trek", XC_trek},
+ {"ul_angle", XC_ul_angle},
+ {"umbrella", XC_umbrella},
+ {"ur_angle", XC_ur_angle},
+ {"watch", XC_watch},
+ {"xterm", XC_xterm},
+ {NULL, 0}
+};
+
+/*
+ * Font to use for cursors:
+ */
+
+#ifndef CURSORFONT
+#define CURSORFONT "cursor"
+#endif
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetCursorByName --
+ *
+ * Retrieve a cursor by name. Parse the cursor name into fields
+ * and create a cursor, either from the standard cursor font or
+ * from bitmap files.
+ *
+ * Results:
+ * Returns a new cursor, or NULL on errors.
+ *
+ * Side effects:
+ * Allocates a new cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkCursor *
+TkGetCursorByName(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ Tk_Uid string; /* Description of cursor. See manual entry
+ * for details on legal syntax. */
+{
+ TkUnixCursor *cursorPtr = NULL;
+ Cursor cursor = None;
+ int argc;
+ CONST char **argv = NULL;
+ Pixmap source = None;
+ Pixmap mask = None;
+ Display *display = Tk_Display(tkwin);
+
+ if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
+ return NULL;
+ }
+ if (argc == 0) {
+ goto badString;
+ }
+ if (argv[0][0] != '@') {
+ XColor fg, bg;
+ unsigned int maskIndex;
+ register struct CursorName *namePtr;
+ TkDisplay *dispPtr;
+
+ /*
+ * The cursor is to come from the standard cursor font. If one
+ * arg, it is cursor name (use black and white for fg and bg).
+ * If two args, they are name and fg color (ignore mask). If
+ * three args, they are name, fg, bg. Some of the code below
+ * is stolen from the XCreateFontCursor Xlib procedure.
+ */
+
+ if (argc > 3) {
+ goto badString;
+ }
+ for (namePtr = cursorNames; ; namePtr++) {
+ if (namePtr->name == NULL) {
+ goto badString;
+ }
+ if ((namePtr->name[0] == argv[0][0])
+ && (strcmp(namePtr->name, argv[0]) == 0)) {
+ break;
+ }
+ }
+ maskIndex = namePtr->shape + 1;
+ if (argc == 1) {
+ fg.red = fg.green = fg.blue = 0;
+ bg.red = bg.green = bg.blue = 65535;
+ } else {
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[1],
+ &fg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", argv[1],
+ "\"", (char *) NULL);
+ goto cleanup;
+ }
+ if (argc == 2) {
+ bg.red = bg.green = bg.blue = 0;
+ maskIndex = namePtr->shape;
+ } else {
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[2],
+ &bg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", argv[2],
+ "\"", (char *) NULL);
+ goto cleanup;
+ }
+ }
+ }
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (dispPtr->cursorFont == None) {
+ dispPtr->cursorFont = XLoadFont(display, CURSORFONT);
+ if (dispPtr->cursorFont == None) {
+ Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC);
+ goto cleanup;
+ }
+ }
+ cursor = XCreateGlyphCursor(display, dispPtr->cursorFont,
+ dispPtr->cursorFont, namePtr->shape, maskIndex,
+ &fg, &bg);
+ } else {
+ int width, height, maskWidth, maskHeight;
+ int xHot, yHot, dummy1, dummy2;
+ XColor fg, bg;
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get cursor from a file in",
+ " a safe interpreter", (char *) NULL);
+ cursorPtr = NULL;
+ goto cleanup;
+ }
+
+ /*
+ * The cursor is to be created by reading bitmap files. There
+ * should be either two elements in the list (source, color) or
+ * four (source mask fg bg).
+ */
+
+ if ((argc != 2) && (argc != 4)) {
+ goto badString;
+ }
+ if (TkReadBitmapFile(display,
+ RootWindowOfScreen(Tk_Screen(tkwin)), &argv[0][1],
+ (unsigned int *) &width, (unsigned int *) &height,
+ &source, &xHot, &yHot) != BitmapSuccess) {
+ Tcl_AppendResult(interp, "cleanup reading bitmap file \"",
+ &argv[0][1], "\"", (char *) NULL);
+ goto cleanup;
+ }
+ if ((xHot < 0) || (yHot < 0) || (xHot >= width) || (yHot >= height)) {
+ Tcl_AppendResult(interp, "bad hot spot in bitmap file \"",
+ &argv[0][1], "\"", (char *) NULL);
+ goto cleanup;
+ }
+ if (argc == 2) {
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[1],
+ &fg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"",
+ argv[1], "\"", (char *) NULL);
+ goto cleanup;
+ }
+ cursor = XCreatePixmapCursor(display, source, source,
+ &fg, &fg, (unsigned) xHot, (unsigned) yHot);
+ } else {
+ if (TkReadBitmapFile(display,
+ RootWindowOfScreen(Tk_Screen(tkwin)), argv[1],
+ (unsigned int *) &maskWidth, (unsigned int *) &maskHeight,
+ &mask, &dummy1, &dummy2) != BitmapSuccess) {
+ Tcl_AppendResult(interp, "cleanup reading bitmap file \"",
+ argv[1], "\"", (char *) NULL);
+ goto cleanup;
+ }
+ if ((maskWidth != width) && (maskHeight != height)) {
+ Tcl_SetResult(interp,
+ "source and mask bitmaps have different sizes",
+ TCL_STATIC);
+ goto cleanup;
+ }
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[2],
+ &fg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", argv[2],
+ "\"", (char *) NULL);
+ goto cleanup;
+ }
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[3],
+ &bg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", argv[3],
+ "\"", (char *) NULL);
+ goto cleanup;
+ }
+ cursor = XCreatePixmapCursor(display, source, mask,
+ &fg, &bg, (unsigned) xHot, (unsigned) yHot);
+ }
+ }
+
+ if (cursor != None) {
+ cursorPtr = (TkUnixCursor *) ckalloc(sizeof(TkUnixCursor));
+ cursorPtr->info.cursor = (Tk_Cursor) cursor;
+ cursorPtr->display = display;
+ }
+
+ cleanup:
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ if (source != None) {
+ Tk_FreePixmap(display, source);
+ }
+ if (mask != None) {
+ Tk_FreePixmap(display, mask);
+ }
+ return (TkCursor *) cursorPtr;
+
+
+ badString:
+ if (argv) {
+ ckfree((char *) argv);
+ }
+ Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
+ (char *) NULL);
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateCursorFromData --
+ *
+ * Creates a cursor from the source and mask bits.
+ *
+ * Results:
+ * Returns a new cursor, or NULL on errors.
+ *
+ * Side effects:
+ * Allocates a new cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkCursor *
+TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
+ fgColor, bgColor)
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ CONST char *source; /* Bitmap data for cursor shape. */
+ CONST char *mask; /* Bitmap data for cursor mask. */
+ int width, height; /* Dimensions of cursor. */
+ int xHot, yHot; /* Location of hot-spot in cursor. */
+ XColor fgColor; /* Foreground color for cursor. */
+ XColor bgColor; /* Background color for cursor. */
+{
+ Cursor cursor;
+ Pixmap sourcePixmap, maskPixmap;
+ TkUnixCursor *cursorPtr = NULL;
+ Display *display = Tk_Display(tkwin);
+
+ sourcePixmap = XCreateBitmapFromData(display,
+ RootWindowOfScreen(Tk_Screen(tkwin)), source, (unsigned) width,
+ (unsigned) height);
+ maskPixmap = XCreateBitmapFromData(display,
+ RootWindowOfScreen(Tk_Screen(tkwin)), mask, (unsigned) width,
+ (unsigned) height);
+ cursor = XCreatePixmapCursor(display, sourcePixmap,
+ maskPixmap, &fgColor, &bgColor, (unsigned) xHot, (unsigned) yHot);
+ Tk_FreePixmap(display, sourcePixmap);
+ Tk_FreePixmap(display, maskPixmap);
+
+ if (cursor != None) {
+ cursorPtr = (TkUnixCursor *) ckalloc(sizeof(TkUnixCursor));
+ cursorPtr->info.cursor = (Tk_Cursor) cursor;
+ cursorPtr->display = display;
+ }
+ return (TkCursor *) cursorPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeCursor --
+ *
+ * This procedure is called to release a cursor allocated by
+ * TkGetCursorByName.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor data structure is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeCursor(cursorPtr)
+ TkCursor *cursorPtr;
+{
+ TkUnixCursor *unixCursorPtr = (TkUnixCursor *) cursorPtr;
+ XFreeCursor(unixCursorPtr->display, (Cursor) unixCursorPtr->info.cursor);
+ Tk_FreeXId(unixCursorPtr->display, (XID) unixCursorPtr->info.cursor);
+}
--- /dev/null
+/*
+ * tkUnixDefault.h --
+ *
+ * This file defines the defaults for all options for all of
+ * the Tk widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKUNIXDEFAULT
+#define _TKUNIXDEFAULT
+
+/*
+ * The definitions below provide symbolic names for the default colors.
+ * NORMAL_BG - Normal background color.
+ * ACTIVE_BG - Background color when widget is active.
+ * SELECT_BG - Background color for selected text.
+ * TROUGH - Background color for troughs in scales and scrollbars.
+ * INDICATOR - Color for indicator when button is selected.
+ * DISABLED - Foreground color when widget is disabled.
+ */
+
+#define BLACK "Black"
+#define WHITE "White"
+
+#define NORMAL_BG "#d9d9d9"
+#define ACTIVE_BG "#ececec"
+#define SELECT_BG "#c3c3c3"
+#define TROUGH "#c3c3c3"
+#define INDICATOR "#b03060"
+#define DISABLED "#a3a3a3"
+
+/*
+ * Defaults for labels, buttons, checkbuttons, and radiobuttons:
+ */
+
+#define DEF_BUTTON_ANCHOR "center"
+#define DEF_BUTTON_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_BUTTON_ACTIVE_BG_MONO BLACK
+#define DEF_BUTTON_ACTIVE_FG_COLOR BLACK
+#define DEF_CHKRAD_ACTIVE_FG_COLOR DEF_BUTTON_ACTIVE_FG_COLOR
+#define DEF_BUTTON_ACTIVE_FG_MONO WHITE
+#define DEF_BUTTON_BG_COLOR NORMAL_BG
+#define DEF_BUTTON_BG_MONO WHITE
+#define DEF_BUTTON_BITMAP ""
+#define DEF_BUTTON_BORDER_WIDTH "2"
+#define DEF_BUTTON_CURSOR ""
+#define DEF_BUTTON_COMPOUND "none"
+#define DEF_BUTTON_COMMAND ""
+#define DEF_BUTTON_DEFAULT "disabled"
+#define DEF_BUTTON_DISABLED_FG_COLOR DISABLED
+#define DEF_BUTTON_DISABLED_FG_MONO ""
+#define DEF_BUTTON_FG BLACK
+#define DEF_CHKRAD_FG DEF_BUTTON_FG
+#define DEF_BUTTON_FONT "Helvetica -12 bold"
+#define DEF_BUTTON_HEIGHT "0"
+#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR
+#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO
+#define DEF_BUTTON_HIGHLIGHT BLACK
+#define DEF_LABEL_HIGHLIGHT_WIDTH "0"
+#define DEF_BUTTON_HIGHLIGHT_WIDTH "1"
+#define DEF_BUTTON_IMAGE (char *) NULL
+#define DEF_BUTTON_INDICATOR "1"
+#define DEF_BUTTON_JUSTIFY "center"
+#define DEF_BUTTON_OFF_VALUE "0"
+#define DEF_BUTTON_ON_VALUE "1"
+#define DEF_BUTTON_OVER_RELIEF ""
+#define DEF_BUTTON_PADX "3m"
+#define DEF_LABCHKRAD_PADX "1"
+#define DEF_BUTTON_PADY "1m"
+#define DEF_LABCHKRAD_PADY "1"
+#define DEF_BUTTON_RELIEF "raised"
+#define DEF_LABCHKRAD_RELIEF "flat"
+#define DEF_BUTTON_REPEAT_DELAY "0"
+#define DEF_BUTTON_REPEAT_INTERVAL "0"
+#define DEF_BUTTON_SELECT_COLOR INDICATOR
+#define DEF_BUTTON_SELECT_MONO BLACK
+#define DEF_BUTTON_SELECT_IMAGE (char *) NULL
+#define DEF_BUTTON_STATE "normal"
+#define DEF_LABEL_TAKE_FOCUS "0"
+#define DEF_BUTTON_TAKE_FOCUS (char *) NULL
+#define DEF_BUTTON_TEXT ""
+#define DEF_BUTTON_TEXT_VARIABLE ""
+#define DEF_BUTTON_UNDERLINE "-1"
+#define DEF_BUTTON_VALUE ""
+#define DEF_BUTTON_WIDTH "0"
+#define DEF_BUTTON_WRAP_LENGTH "0"
+#define DEF_RADIOBUTTON_VARIABLE "selectedButton"
+#define DEF_CHECKBUTTON_VARIABLE ""
+
+/*
+ * Defaults for canvases:
+ */
+
+#define DEF_CANVAS_BG_COLOR NORMAL_BG
+#define DEF_CANVAS_BG_MONO WHITE
+#define DEF_CANVAS_BORDER_WIDTH "0"
+#define DEF_CANVAS_CLOSE_ENOUGH "1"
+#define DEF_CANVAS_CONFINE "1"
+#define DEF_CANVAS_CURSOR ""
+#define DEF_CANVAS_HEIGHT "7c"
+#define DEF_CANVAS_HIGHLIGHT_BG NORMAL_BG
+#define DEF_CANVAS_HIGHLIGHT BLACK
+#define DEF_CANVAS_HIGHLIGHT_WIDTH "1"
+#define DEF_CANVAS_INSERT_BG BLACK
+#define DEF_CANVAS_INSERT_BD_COLOR "0"
+#define DEF_CANVAS_INSERT_BD_MONO "0"
+#define DEF_CANVAS_INSERT_OFF_TIME "300"
+#define DEF_CANVAS_INSERT_ON_TIME "600"
+#define DEF_CANVAS_INSERT_WIDTH "2"
+#define DEF_CANVAS_RELIEF "flat"
+#define DEF_CANVAS_SCROLL_REGION ""
+#define DEF_CANVAS_SELECT_COLOR SELECT_BG
+#define DEF_CANVAS_SELECT_MONO BLACK
+#define DEF_CANVAS_SELECT_BD_COLOR "1"
+#define DEF_CANVAS_SELECT_BD_MONO "0"
+#define DEF_CANVAS_SELECT_FG_COLOR BLACK
+#define DEF_CANVAS_SELECT_FG_MONO WHITE
+#define DEF_CANVAS_TAKE_FOCUS (char *) NULL
+#define DEF_CANVAS_WIDTH "10c"
+#define DEF_CANVAS_X_SCROLL_CMD ""
+#define DEF_CANVAS_X_SCROLL_INCREMENT "0"
+#define DEF_CANVAS_Y_SCROLL_CMD ""
+#define DEF_CANVAS_Y_SCROLL_INCREMENT "0"
+
+/*
+ * Defaults for entries:
+ */
+
+#define DEF_ENTRY_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_BG_MONO WHITE
+#define DEF_ENTRY_BORDER_WIDTH "2"
+#define DEF_ENTRY_CURSOR "xterm"
+#define DEF_ENTRY_DISABLED_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_DISABLED_BG_MONO WHITE
+#define DEF_ENTRY_DISABLED_FG DISABLED
+#define DEF_ENTRY_EXPORT_SELECTION "1"
+#define DEF_ENTRY_FONT "Helvetica -12"
+#define DEF_ENTRY_FG BLACK
+#define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG
+#define DEF_ENTRY_HIGHLIGHT BLACK
+#define DEF_ENTRY_HIGHLIGHT_WIDTH "1"
+#define DEF_ENTRY_INSERT_BG BLACK
+#define DEF_ENTRY_INSERT_BD_COLOR "0"
+#define DEF_ENTRY_INSERT_BD_MONO "0"
+#define DEF_ENTRY_INSERT_OFF_TIME "300"
+#define DEF_ENTRY_INSERT_ON_TIME "600"
+#define DEF_ENTRY_INSERT_WIDTH "2"
+#define DEF_ENTRY_JUSTIFY "left"
+#define DEF_ENTRY_READONLY_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_READONLY_BG_MONO WHITE
+#define DEF_ENTRY_RELIEF "sunken"
+#define DEF_ENTRY_SCROLL_COMMAND ""
+#define DEF_ENTRY_SELECT_COLOR SELECT_BG
+#define DEF_ENTRY_SELECT_MONO BLACK
+#define DEF_ENTRY_SELECT_BD_COLOR "1"
+#define DEF_ENTRY_SELECT_BD_MONO "0"
+#define DEF_ENTRY_SELECT_FG_COLOR BLACK
+#define DEF_ENTRY_SELECT_FG_MONO WHITE
+#define DEF_ENTRY_SHOW (char *) NULL
+#define DEF_ENTRY_STATE "normal"
+#define DEF_ENTRY_TAKE_FOCUS (char *) NULL
+#define DEF_ENTRY_TEXT_VARIABLE ""
+#define DEF_ENTRY_WIDTH "20"
+
+/*
+ * Defaults for frames:
+ */
+
+#define DEF_FRAME_BG_COLOR NORMAL_BG
+#define DEF_FRAME_BG_MONO WHITE
+#define DEF_FRAME_BORDER_WIDTH "0"
+#define DEF_FRAME_CLASS "Frame"
+#define DEF_FRAME_COLORMAP ""
+#define DEF_FRAME_CONTAINER "0"
+#define DEF_FRAME_CURSOR ""
+#define DEF_FRAME_HEIGHT "0"
+#define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG
+#define DEF_FRAME_HIGHLIGHT BLACK
+#define DEF_FRAME_HIGHLIGHT_WIDTH "0"
+#define DEF_FRAME_LABEL ""
+#define DEF_FRAME_PADX "0"
+#define DEF_FRAME_PADY "0"
+#define DEF_FRAME_RELIEF "flat"
+#define DEF_FRAME_TAKE_FOCUS "0"
+#define DEF_FRAME_VISUAL ""
+#define DEF_FRAME_WIDTH "0"
+
+/*
+ * Defaults for labelframes:
+ */
+
+#define DEF_LABELFRAME_BORDER_WIDTH "2"
+#define DEF_LABELFRAME_CLASS "Labelframe"
+#define DEF_LABELFRAME_RELIEF "groove"
+#define DEF_LABELFRAME_FG BLACK
+#define DEF_LABELFRAME_FONT "Helvetica -12 bold"
+#define DEF_LABELFRAME_TEXT ""
+#define DEF_LABELFRAME_LABELANCHOR "nw"
+
+/*
+ * Defaults for listboxes:
+ */
+
+#define DEF_LISTBOX_ACTIVE_STYLE "underline"
+#define DEF_LISTBOX_BG_COLOR NORMAL_BG
+#define DEF_LISTBOX_BG_MONO WHITE
+#define DEF_LISTBOX_BORDER_WIDTH "2"
+#define DEF_LISTBOX_CURSOR ""
+#define DEF_LISTBOX_DISABLED_FG DISABLED
+#define DEF_LISTBOX_EXPORT_SELECTION "1"
+#define DEF_LISTBOX_FONT "Helvetica -12 bold"
+#define DEF_LISTBOX_FG BLACK
+#define DEF_LISTBOX_HEIGHT "10"
+#define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG
+#define DEF_LISTBOX_HIGHLIGHT BLACK
+#define DEF_LISTBOX_HIGHLIGHT_WIDTH "1"
+#define DEF_LISTBOX_RELIEF "sunken"
+#define DEF_LISTBOX_SCROLL_COMMAND ""
+#define DEF_LISTBOX_LIST_VARIABLE ""
+#define DEF_LISTBOX_SELECT_COLOR SELECT_BG
+#define DEF_LISTBOX_SELECT_MONO BLACK
+#define DEF_LISTBOX_SELECT_BD "1"
+#define DEF_LISTBOX_SELECT_FG_COLOR BLACK
+#define DEF_LISTBOX_SELECT_FG_MONO WHITE
+#define DEF_LISTBOX_SELECT_MODE "browse"
+#define DEF_LISTBOX_SET_GRID "0"
+#define DEF_LISTBOX_STATE "normal"
+#define DEF_LISTBOX_TAKE_FOCUS (char *) NULL
+#define DEF_LISTBOX_WIDTH "20"
+
+/*
+ * Defaults for individual entries of menus:
+ */
+
+#define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL
+#define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL
+#define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL
+#define DEF_MENU_ENTRY_BG (char *) NULL
+#define DEF_MENU_ENTRY_BITMAP None
+#define DEF_MENU_ENTRY_COLUMN_BREAK "0"
+#define DEF_MENU_ENTRY_COMMAND (char *) NULL
+#define DEF_MENU_ENTRY_COMPOUND "none"
+#define DEF_MENU_ENTRY_FG (char *) NULL
+#define DEF_MENU_ENTRY_FONT (char *) NULL
+#define DEF_MENU_ENTRY_HIDE_MARGIN "0"
+#define DEF_MENU_ENTRY_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_INDICATOR "1"
+#define DEF_MENU_ENTRY_LABEL (char *) NULL
+#define DEF_MENU_ENTRY_MENU (char *) NULL
+#define DEF_MENU_ENTRY_OFF_VALUE "0"
+#define DEF_MENU_ENTRY_ON_VALUE "1"
+#define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_STATE "normal"
+#define DEF_MENU_ENTRY_VALUE (char *) NULL
+#define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL
+#define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton"
+#define DEF_MENU_ENTRY_SELECT (char *) NULL
+#define DEF_MENU_ENTRY_UNDERLINE "-1"
+
+/*
+ * Defaults for menus overall:
+ */
+
+#define DEF_MENU_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_MENU_ACTIVE_BG_MONO BLACK
+#define DEF_MENU_ACTIVE_BORDER_WIDTH "2"
+#define DEF_MENU_ACTIVE_FG_COLOR BLACK
+#define DEF_MENU_ACTIVE_FG_MONO WHITE
+#define DEF_MENU_BG_COLOR NORMAL_BG
+#define DEF_MENU_BG_MONO WHITE
+#define DEF_MENU_BORDER_WIDTH "2"
+#define DEF_MENU_CURSOR "arrow"
+#define DEF_MENU_DISABLED_FG_COLOR DISABLED
+#define DEF_MENU_DISABLED_FG_MONO ""
+#define DEF_MENU_FONT "Helvetica -12 bold"
+#define DEF_MENU_FG BLACK
+#define DEF_MENU_POST_COMMAND ""
+#define DEF_MENU_RELIEF "raised"
+#define DEF_MENU_SELECT_COLOR INDICATOR
+#define DEF_MENU_SELECT_MONO BLACK
+#define DEF_MENU_TAKE_FOCUS "0"
+#define DEF_MENU_TEAROFF "1"
+#define DEF_MENU_TEAROFF_CMD (char *) NULL
+#define DEF_MENU_TITLE ""
+#define DEF_MENU_TYPE "normal"
+
+/*
+ * Defaults for menubuttons:
+ */
+
+#define DEF_MENUBUTTON_ANCHOR "center"
+#define DEF_MENUBUTTON_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_MENUBUTTON_ACTIVE_BG_MONO BLACK
+#define DEF_MENUBUTTON_ACTIVE_FG_COLOR BLACK
+#define DEF_MENUBUTTON_ACTIVE_FG_MONO WHITE
+#define DEF_MENUBUTTON_BG_COLOR NORMAL_BG
+#define DEF_MENUBUTTON_BG_MONO WHITE
+#define DEF_MENUBUTTON_BITMAP ""
+#define DEF_MENUBUTTON_BORDER_WIDTH "2"
+#define DEF_MENUBUTTON_CURSOR ""
+#define DEF_MENUBUTTON_DIRECTION "below"
+#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED
+#define DEF_MENUBUTTON_DISABLED_FG_MONO ""
+#define DEF_MENUBUTTON_FONT "Helvetica -12 bold"
+#define DEF_MENUBUTTON_FG BLACK
+#define DEF_MENUBUTTON_HEIGHT "0"
+#define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR
+#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO
+#define DEF_MENUBUTTON_HIGHLIGHT BLACK
+#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0"
+#define DEF_MENUBUTTON_IMAGE (char *) NULL
+#define DEF_MENUBUTTON_INDICATOR "0"
+#define DEF_MENUBUTTON_JUSTIFY "center"
+#define DEF_MENUBUTTON_MENU ""
+#define DEF_MENUBUTTON_PADX "4p"
+#define DEF_MENUBUTTON_PADY "3p"
+#define DEF_MENUBUTTON_RELIEF "flat"
+#define DEF_MENUBUTTON_STATE "normal"
+#define DEF_MENUBUTTON_TAKE_FOCUS "0"
+#define DEF_MENUBUTTON_TEXT ""
+#define DEF_MENUBUTTON_TEXT_VARIABLE ""
+#define DEF_MENUBUTTON_UNDERLINE "-1"
+#define DEF_MENUBUTTON_WIDTH "0"
+#define DEF_MENUBUTTON_WRAP_LENGTH "0"
+
+/*
+ * Defaults for messages:
+ */
+
+#define DEF_MESSAGE_ANCHOR "center"
+#define DEF_MESSAGE_ASPECT "150"
+#define DEF_MESSAGE_BG_COLOR NORMAL_BG
+#define DEF_MESSAGE_BG_MONO WHITE
+#define DEF_MESSAGE_BORDER_WIDTH "2"
+#define DEF_MESSAGE_CURSOR ""
+#define DEF_MESSAGE_FG BLACK
+#define DEF_MESSAGE_FONT "Helvetica -12 bold"
+#define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG
+#define DEF_MESSAGE_HIGHLIGHT BLACK
+#define DEF_MESSAGE_HIGHLIGHT_WIDTH "0"
+#define DEF_MESSAGE_JUSTIFY "left"
+#define DEF_MESSAGE_PADX "-1"
+#define DEF_MESSAGE_PADY "-1"
+#define DEF_MESSAGE_RELIEF "flat"
+#define DEF_MESSAGE_TAKE_FOCUS "0"
+#define DEF_MESSAGE_TEXT ""
+#define DEF_MESSAGE_TEXT_VARIABLE ""
+#define DEF_MESSAGE_WIDTH "0"
+
+/*
+ * Defaults for panedwindows
+ */
+
+#define DEF_PANEDWINDOW_BG_COLOR NORMAL_BG
+#define DEF_PANEDWINDOW_BG_MONO WHITE
+#define DEF_PANEDWINDOW_BORDERWIDTH "2"
+#define DEF_PANEDWINDOW_CURSOR ""
+#define DEF_PANEDWINDOW_HANDLEPAD "8"
+#define DEF_PANEDWINDOW_HANDLESIZE "8"
+#define DEF_PANEDWINDOW_HEIGHT ""
+#define DEF_PANEDWINDOW_OPAQUERESIZE "0"
+#define DEF_PANEDWINDOW_ORIENT "horizontal"
+#define DEF_PANEDWINDOW_RELIEF "flat"
+#define DEF_PANEDWINDOW_SASHCURSOR ""
+#define DEF_PANEDWINDOW_SASHPAD "2"
+#define DEF_PANEDWINDOW_SASHRELIEF "raised"
+#define DEF_PANEDWINDOW_SASHWIDTH "2"
+#define DEF_PANEDWINDOW_SHOWHANDLE "1"
+#define DEF_PANEDWINDOW_WIDTH ""
+
+/*
+ * Defaults for panedwindow panes
+ */
+
+#define DEF_PANEDWINDOW_PANE_AFTER ""
+#define DEF_PANEDWINDOW_PANE_BEFORE ""
+#define DEF_PANEDWINDOW_PANE_HEIGHT ""
+#define DEF_PANEDWINDOW_PANE_MINSIZE "0"
+#define DEF_PANEDWINDOW_PANE_PADX "0"
+#define DEF_PANEDWINDOW_PANE_PADY "0"
+#define DEF_PANEDWINDOW_PANE_STICKY "nsew"
+#define DEF_PANEDWINDOW_PANE_WIDTH ""
+
+/*
+ * Defaults for scales:
+ */
+
+#define DEF_SCALE_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_SCALE_ACTIVE_BG_MONO BLACK
+#define DEF_SCALE_BG_COLOR NORMAL_BG
+#define DEF_SCALE_BG_MONO WHITE
+#define DEF_SCALE_BIG_INCREMENT "0"
+#define DEF_SCALE_BORDER_WIDTH "2"
+#define DEF_SCALE_COMMAND ""
+#define DEF_SCALE_CURSOR ""
+#define DEF_SCALE_DIGITS "0"
+#define DEF_SCALE_FONT "Helvetica -12 bold"
+#define DEF_SCALE_FG_COLOR BLACK
+#define DEF_SCALE_FG_MONO BLACK
+#define DEF_SCALE_FROM "0"
+#define DEF_SCALE_HIGHLIGHT_BG_COLOR DEF_SCALE_BG_COLOR
+#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO
+#define DEF_SCALE_HIGHLIGHT BLACK
+#define DEF_SCALE_HIGHLIGHT_WIDTH "1"
+#define DEF_SCALE_LABEL ""
+#define DEF_SCALE_LENGTH "100"
+#define DEF_SCALE_ORIENT "vertical"
+#define DEF_SCALE_RELIEF "flat"
+#define DEF_SCALE_REPEAT_DELAY "300"
+#define DEF_SCALE_REPEAT_INTERVAL "100"
+#define DEF_SCALE_RESOLUTION "1"
+#define DEF_SCALE_TROUGH_COLOR TROUGH
+#define DEF_SCALE_TROUGH_MONO WHITE
+#define DEF_SCALE_SHOW_VALUE "1"
+#define DEF_SCALE_SLIDER_LENGTH "30"
+#define DEF_SCALE_SLIDER_RELIEF "raised"
+#define DEF_SCALE_STATE "normal"
+#define DEF_SCALE_TAKE_FOCUS (char *) NULL
+#define DEF_SCALE_TICK_INTERVAL "0"
+#define DEF_SCALE_TO "100"
+#define DEF_SCALE_VARIABLE ""
+#define DEF_SCALE_WIDTH "15"
+
+/*
+ * Defaults for scrollbars:
+ */
+
+#define DEF_SCROLLBAR_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_SCROLLBAR_ACTIVE_BG_MONO BLACK
+#define DEF_SCROLLBAR_ACTIVE_RELIEF "raised"
+#define DEF_SCROLLBAR_BG_COLOR NORMAL_BG
+#define DEF_SCROLLBAR_BG_MONO WHITE
+#define DEF_SCROLLBAR_BORDER_WIDTH "2"
+#define DEF_SCROLLBAR_COMMAND ""
+#define DEF_SCROLLBAR_CURSOR ""
+#define DEF_SCROLLBAR_EL_BORDER_WIDTH "-1"
+#define DEF_SCROLLBAR_HIGHLIGHT_BG NORMAL_BG
+#define DEF_SCROLLBAR_HIGHLIGHT BLACK
+#define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "1"
+#define DEF_SCROLLBAR_JUMP "0"
+#define DEF_SCROLLBAR_ORIENT "vertical"
+#define DEF_SCROLLBAR_RELIEF "sunken"
+#define DEF_SCROLLBAR_REPEAT_DELAY "300"
+#define DEF_SCROLLBAR_REPEAT_INTERVAL "100"
+#define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL
+#define DEF_SCROLLBAR_TROUGH_COLOR TROUGH
+#define DEF_SCROLLBAR_TROUGH_MONO WHITE
+#define DEF_SCROLLBAR_WIDTH "15"
+
+/*
+ * Defaults for texts:
+ */
+
+#define DEF_TEXT_AUTO_SEPARATORS "1"
+#define DEF_TEXT_BG_COLOR NORMAL_BG
+#define DEF_TEXT_BG_MONO WHITE
+#define DEF_TEXT_BORDER_WIDTH "2"
+#define DEF_TEXT_CURSOR "xterm"
+#define DEF_TEXT_FG BLACK
+#define DEF_TEXT_EXPORT_SELECTION "1"
+#define DEF_TEXT_FONT "Courier -12"
+#define DEF_TEXT_HEIGHT "24"
+#define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG
+#define DEF_TEXT_HIGHLIGHT BLACK
+#define DEF_TEXT_HIGHLIGHT_WIDTH "1"
+#define DEF_TEXT_INSERT_BG BLACK
+#define DEF_TEXT_INSERT_BD_COLOR "0"
+#define DEF_TEXT_INSERT_BD_MONO "0"
+#define DEF_TEXT_INSERT_OFF_TIME "300"
+#define DEF_TEXT_INSERT_ON_TIME "600"
+#define DEF_TEXT_INSERT_WIDTH "2"
+#define DEF_TEXT_MAX_UNDO "0"
+#define DEF_TEXT_PADX "1"
+#define DEF_TEXT_PADY "1"
+#define DEF_TEXT_RELIEF "sunken"
+#define DEF_TEXT_SELECT_COLOR SELECT_BG
+#define DEF_TEXT_SELECT_MONO BLACK
+#define DEF_TEXT_SELECT_BD_COLOR "1"
+#define DEF_TEXT_SELECT_BD_MONO "0"
+#define DEF_TEXT_SELECT_FG_COLOR BLACK
+#define DEF_TEXT_SELECT_FG_MONO WHITE
+#define DEF_TEXT_SELECT_RELIEF "raised"
+#define DEF_TEXT_SET_GRID "0"
+#define DEF_TEXT_SPACING1 "0"
+#define DEF_TEXT_SPACING2 "0"
+#define DEF_TEXT_SPACING3 "0"
+#define DEF_TEXT_STATE "normal"
+#define DEF_TEXT_TABS ""
+#define DEF_TEXT_TAKE_FOCUS (char *) NULL
+#define DEF_TEXT_UNDO "0"
+#define DEF_TEXT_WIDTH "80"
+#define DEF_TEXT_WRAP "char"
+#define DEF_TEXT_XSCROLL_COMMAND ""
+#define DEF_TEXT_YSCROLL_COMMAND ""
+
+/*
+ * Defaults for canvas text:
+ */
+
+#define DEF_CANVTEXT_FONT "Helvetica -12"
+
+/*
+ * Defaults for toplevels (most of the defaults for frames also apply
+ * to toplevels):
+ */
+
+#define DEF_TOPLEVEL_CLASS "Toplevel"
+#define DEF_TOPLEVEL_MENU ""
+#define DEF_TOPLEVEL_SCREEN ""
+#define DEF_TOPLEVEL_USE ""
+
+#endif /* _TKUNIXDEFAULT */
--- /dev/null
+/*
+ * tkUnixDialog.c --
+ *
+ * Contains the Unix implementation of the common dialog boxes:
+ *
+ * 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$
+ *
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkUnixInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EvalArgv --
+ *
+ * Invokes the Tcl procedure with the arguments. argv[0] is set by
+ * the caller of this function. It may be different than cmdName.
+ * The TCL command will see argv[0], not cmdName, as its name if it
+ * invokes [lindex [info level 0] 0]
+ *
+ * Results:
+ * TCL_ERROR if the command does not exist and cannot be autoloaded.
+ * Otherwise, return the result of the evaluation of the command.
+ *
+ * Side effects:
+ * The command may be autoloaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int EvalArgv(interp, cmdName, argc, argv)
+ Tcl_Interp *interp; /* Current interpreter. */
+ char * cmdName; /* Name of the TCL command to call */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tcl_CmdInfo cmdInfo;
+
+ if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
+ char * cmdArgv[2];
+
+ /*
+ * This comand is not in the interpreter yet -- looks like we
+ * have to auto-load it
+ */
+ if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ cmdArgv[0] = "auto_load";
+ cmdArgv[1] = cmdName;
+
+ if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){
+ return TCL_ERROR;
+ }
+
+ if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "cannot auto-load command \"",
+ cmdName, "\"",NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseColorCmd --
+ *
+ * This procedure implements the color dialog box for the Unix
+ * platform. See the user documentation for details on what it
+ * does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * A dialog window is created the first time this procedure is called.
+ * This window is not destroyed and will be reused the next time the
+ * application invokes the "tk_chooseColor" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseColorCmd(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. */
+{
+ return EvalArgv(interp, "tk::ColorDialog", argc, argv);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOpenFileCmd --
+ *
+ * This procedure implements the "open file" dialog box for the
+ * Unix platform. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * A dialog window is created the first this procedure is called.
+ * This window is not destroyed and will be reused the next time
+ * the application invokes the "tk_getOpenFile" or
+ * "tk_getSaveFile" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetOpenFileCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window)clientData;
+
+ if (Tk_StrictMotif(tkwin)) {
+ return EvalArgv(interp, "tk::MotifFDialog", argc, argv);
+ } else {
+ return EvalArgv(interp, "tk::FDialog", argc, argv);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetSaveFileCmd --
+ *
+ * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
+ * instead
+ *
+ * Results:
+ * Same as Tk_GetOpenFileCmd.
+ *
+ * Side effects:
+ * Same as Tk_GetOpenFileCmd.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetSaveFileCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window)clientData;
+
+ if (Tk_StrictMotif(tkwin)) {
+ return EvalArgv(interp, "tk::MotifFDialog", argc, argv);
+ } else {
+ return EvalArgv(interp, "tk::FDialog", argc, argv);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MessageBoxCmd --
+ *
+ * This procedure implements the MessageBox window for the
+ * Unix platform. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * None. The MessageBox window will be destroy before this procedure
+ * returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_MessageBoxCmd(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. */
+{
+ return EvalArgv(interp, "tk::MessageBox", argc, argv);
+}
+
--- /dev/null
+/*
+ * tkUnixDraw.c --
+ *
+ * This file contains X specific drawing routines.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+#if !defined(__WIN32__) && !defined(MAC_TCL)
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * The following structure is used to pass information to
+ * ScrollRestrictProc from TkScrollWindow.
+ */
+
+typedef struct ScrollInfo {
+ int done; /* Flag is 0 until filtering is done. */
+ Display *display; /* Display to filter. */
+ Window window; /* Window to filter. */
+ TkRegion region; /* Region into which damage is accumulated. */
+ int dx, dy; /* Amount by which window was shifted. */
+} ScrollInfo;
+
+/*
+ * Forward declarations for procedures declared later in this file:
+ */
+
+static Tk_RestrictAction ScrollRestrictProc _ANSI_ARGS_((
+ ClientData arg, XEvent *eventPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkScrollWindow --
+ *
+ * Scroll a rectangle of the specified window and accumulate
+ * damage information in the specified Region.
+ *
+ * Results:
+ * Returns 0 if no damage additional damage was generated. Sets
+ * damageRgn to contain the damaged areas and returns 1 if
+ * GraphicsExpose events were detected.
+ *
+ * Side effects:
+ * Scrolls the bits in the window and enters the event loop
+ * looking for damage events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkScrollWindow(tkwin, gc, x, y, width, height, dx, dy, damageRgn)
+ Tk_Window tkwin; /* The window to be scrolled. */
+ GC gc; /* GC for window to be scrolled. */
+ int x, y, width, height; /* Position rectangle to be scrolled. */
+ int dx, dy; /* Distance rectangle should be moved. */
+ TkRegion damageRgn; /* Region to accumulate damage in. */
+{
+ Tk_RestrictProc *oldProc;
+ ClientData oldArg, dummy;
+ ScrollInfo info;
+
+ XCopyArea(Tk_Display(tkwin), Tk_WindowId(tkwin), Tk_WindowId(tkwin), gc,
+ x, y, (unsigned int) width, (unsigned int) height, x + dx, y + dy);
+
+ info.done = 0;
+ info.window = Tk_WindowId(tkwin);
+ info.display = Tk_Display(tkwin);
+ info.region = damageRgn;
+ info.dx = dx;
+ info.dy = dy;
+
+ /*
+ * Sync the event stream so all of the expose events will be on the
+ * Tk event queue before we start filtering. This avoids busy waiting
+ * while we filter events.
+ */
+
+ TkpSync(info.display);
+ oldProc = Tk_RestrictEvents(ScrollRestrictProc, (ClientData) &info,
+ &oldArg);
+ while (!info.done) {
+ Tcl_ServiceEvent(TCL_WINDOW_EVENTS);
+ }
+ Tk_RestrictEvents(oldProc, oldArg, &dummy);
+
+ if (XEmptyRegion((Region) damageRgn)) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollRestrictProc --
+ *
+ * A Tk_RestrictProc used by TkScrollWindow to gather up Expose
+ * information into a single damage region. It accumulates damage
+ * events on the specified window until a NoExpose or the last
+ * GraphicsExpose event is detected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Discards Expose events after accumulating damage information
+ * for a particular window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+ScrollRestrictProc(arg, eventPtr)
+ ClientData arg;
+ XEvent *eventPtr;
+{
+ ScrollInfo *info = (ScrollInfo *) arg;
+ XRectangle rect;
+
+ /*
+ * Defer events which aren't for the specified window.
+ */
+
+ if (info->done || (eventPtr->xany.display != info->display)
+ || (eventPtr->xany.window != info->window)) {
+ return TK_DEFER_EVENT;
+ }
+
+ if (eventPtr->type == NoExpose) {
+ info->done = 1;
+ } else if (eventPtr->type == GraphicsExpose) {
+ rect.x = eventPtr->xgraphicsexpose.x;
+ rect.y = eventPtr->xgraphicsexpose.y;
+ rect.width = eventPtr->xgraphicsexpose.width;
+ rect.height = eventPtr->xgraphicsexpose.height;
+ XUnionRectWithRegion(&rect, (Region) info->region,
+ (Region) info->region);
+
+ if (eventPtr->xgraphicsexpose.count == 0) {
+ info->done = 1;
+ }
+ } else if (eventPtr->type == Expose) {
+
+ /*
+ * This case is tricky. This event was already queued before
+ * the XCopyArea was issued. If this area overlaps the area
+ * being copied, then some of the copied area may be invalid.
+ * The easiest way to handle this case is to mark both the
+ * original area and the shifted area as damaged.
+ */
+
+ rect.x = eventPtr->xexpose.x;
+ rect.y = eventPtr->xexpose.y;
+ rect.width = eventPtr->xexpose.width;
+ rect.height = eventPtr->xexpose.height;
+ XUnionRectWithRegion(&rect, (Region) info->region,
+ (Region) info->region);
+ rect.x += info->dx;
+ rect.y += info->dy;
+ XUnionRectWithRegion(&rect, (Region) info->region,
+ (Region) info->region);
+ } else {
+ return TK_DEFER_EVENT;
+ }
+ return TK_DISCARD_EVENT;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawHighlightBorder --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus.
+ *
+ * On Unix, we just draw the simple inset ring. On other sytems,
+ * e.g. the Mac, the focus ring is a little more complicated, so we
+ * need this abstraction.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawHighlightBorder(tkwin, fgGC, bgGC, highlightWidth, drawable)
+ Tk_Window tkwin;
+ GC fgGC;
+ GC bgGC;
+ int highlightWidth;
+ Drawable drawable;
+{
+ TkDrawInsetFocusHighlight(tkwin, fgGC, highlightWidth, drawable, 0);
+}
--- /dev/null
+/*
+ * tkUnixEmbed.c --
+ *
+ * This file contains platform-specific procedures for UNIX to provide
+ * basic operations needed for application embedding (where one
+ * application can use as its main window an internal window from
+ * some other application).
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkUnixInt.h"
+
+/*
+ * One of the following structures exists for each container in this
+ * application. It keeps track of the container window and its
+ * associated embedded window.
+ */
+
+typedef struct Container {
+ Window parent; /* X's window id for the parent of
+ * the pair (the container). */
+ Window parentRoot; /* Id for the root window of parent's
+ * screen. */
+ TkWindow *parentPtr; /* Tk's information about the container,
+ * or NULL if the container isn't
+ * in this process. */
+ Window wrapper; /* X's window id for the wrapper
+ * window for the embedded window.
+ * Starts off as None, but gets
+ * filled in when the window is
+ * eventually created. */
+ TkWindow *embeddedPtr; /* Tk's information about the embedded
+ * window, or NULL if the embedded
+ * application isn't in this process.
+ * Note that this is *not* the
+ * same window as wrapper: wrapper is
+ * the parent of embeddedPtr. */
+ struct Container *nextPtr; /* Next in list of all containers in
+ * this process. */
+} Container;
+
+typedef struct ThreadSpecificData {
+ Container *firstContainerPtr; /* First in list of all containers
+ * managed by this process. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for static procedures defined in this file:
+ */
+
+static void ContainerEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void EmbeddedEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static int EmbedErrorProc _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errEventPtr));
+static void EmbedFocusProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbedGeometryRequest _ANSI_ARGS_((
+ Container * containerPtr, int width, int height));
+static void EmbedSendConfigure _ANSI_ARGS_((
+ Container *containerPtr));
+static void EmbedStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbedWindowDeleted _ANSI_ARGS_((TkWindow *winPtr));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpUseWindow --
+ *
+ * This procedure causes a Tk window to use a given X window as
+ * its parent window, rather than the root window for the screen.
+ * It is invoked by an embedded application to specify the window
+ * in which it is embedded.
+ *
+ * Results:
+ * The return value is normally TCL_OK. If an error occurs (such
+ * as string not being a valid window spec), then the return value
+ * is TCL_ERROR and an error message is left in the interp's result if
+ * interp is non-NULL.
+ *
+ * Side effects:
+ * Changes the colormap and other visual information to match that
+ * of the parent window given by "string".
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpUseWindow(interp, tkwin, string)
+ Tcl_Interp *interp; /* If not NULL, used for error reporting
+ * if string is bogus. */
+ Tk_Window tkwin; /* Tk window that does not yet have an
+ * associated X window. */
+ CONST char *string; /* String identifying an X window to use
+ * for tkwin; must be an integer value. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *usePtr;
+ int id, anyError;
+ Window parent;
+ Tk_ErrorHandler handler;
+ Container *containerPtr;
+ XWindowAttributes parentAtts;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->window != None) {
+ panic("TkUseWindow: X window already assigned");
+ }
+ if (Tcl_GetInt(interp, string, &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ parent = (Window) id;
+
+ usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, parent);
+ if (usePtr != NULL) {
+ if (!(usePtr->flags & TK_CONTAINER)) {
+ Tcl_AppendResult(interp, "window \"", usePtr->pathName,
+ "\" doesn't have -container option set", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Tk sets the window colormap to the screen default colormap in
+ * tkWindow.c:AllocWindow. This doesn't work well for embedded
+ * windows. So we override the colormap and visual settings to be
+ * the same as the parent window (which is in the container app).
+ */
+
+ anyError = 0;
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ EmbedErrorProc, (ClientData) &anyError);
+ if (!XGetWindowAttributes(winPtr->display, parent, &parentAtts)) {
+ anyError = 1;
+ }
+ XSync(winPtr->display, False);
+ Tk_DeleteErrorHandler(handler);
+ if (anyError) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't create child of window \"",
+ string, "\"", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ Tk_SetWindowVisual(tkwin, parentAtts.visual, parentAtts.depth,
+ parentAtts.colormap);
+
+ /*
+ * Create an event handler to clean up the Container structure when
+ * tkwin is eventually deleted.
+ */
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc,
+ (ClientData) winPtr);
+
+ /*
+ * Save information about the container and the embedded window
+ * in a Container structure. If there is already an existing
+ * Container structure, it means that both container and embedded
+ * app. are in the same process.
+ */
+
+ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->parent == parent) {
+ winPtr->flags |= TK_BOTH_HALVES;
+ containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
+ break;
+ }
+ }
+ if (containerPtr == NULL) {
+ containerPtr = (Container *) ckalloc(sizeof(Container));
+ containerPtr->parent = parent;
+ containerPtr->parentRoot = parentAtts.root;
+ containerPtr->parentPtr = NULL;
+ containerPtr->wrapper = None;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
+ }
+ containerPtr->embeddedPtr = winPtr;
+ winPtr->flags |= TK_EMBEDDED;
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeWindow --
+ *
+ * Create an actual window system window object based on the
+ * current attributes of the specified TkWindow.
+ *
+ * Results:
+ * Returns the handle to the new window, or None on failure.
+ *
+ * Side effects:
+ * Creates a new X window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Window
+TkpMakeWindow(winPtr, parent)
+ TkWindow *winPtr; /* Tk's information about the window that
+ * is to be instantiated. */
+ Window parent; /* Window system token for the parent in
+ * which the window is to be created. */
+{
+ Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ /*
+ * This window is embedded. Don't create the new window in the
+ * given parent; instead, create it as a child of the root window
+ * of the container's screen. The window will get reparented
+ * into a wrapper window later.
+ */
+
+ for (containerPtr = tsdPtr->firstContainerPtr; ;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr == NULL) {
+ panic("TkMakeWindow couldn't find container for window");
+ }
+ if (containerPtr->embeddedPtr == winPtr) {
+ break;
+ }
+ }
+ parent = containerPtr->parentRoot;
+ }
+
+ return XCreateWindow(winPtr->display, parent, winPtr->changes.x,
+ winPtr->changes.y, (unsigned) winPtr->changes.width,
+ (unsigned) winPtr->changes.height,
+ (unsigned) winPtr->changes.border_width, winPtr->depth,
+ InputOutput, winPtr->visual, winPtr->dirtyAtts,
+ &winPtr->atts);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeContainer --
+ *
+ * This procedure is called to indicate that a particular window
+ * will be a container for an embedded application. This changes
+ * certain aspects of the window's behavior, such as whether it
+ * will receive events anymore.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMakeContainer(tkwin)
+ Tk_Window tkwin; /* Token for a window that is about to
+ * become a container. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Register the window as a container so that, for example, we can
+ * find out later if the embedded app. is in the same process.
+ */
+
+ Tk_MakeWindowExist(tkwin);
+ containerPtr = (Container *) ckalloc(sizeof(Container));
+ containerPtr->parent = Tk_WindowId(tkwin);
+ containerPtr->parentRoot = RootWindowOfScreen(Tk_Screen(tkwin));
+ containerPtr->parentPtr = winPtr;
+ containerPtr->wrapper = None;
+ containerPtr->embeddedPtr = NULL;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
+ winPtr->flags |= TK_CONTAINER;
+
+ /*
+ * Request SubstructureNotify events so that we can find out when
+ * the embedded application creates its window or attempts to
+ * resize it. Also watch Configure events on the container so that
+ * we can resize the child to match.
+ */
+
+ winPtr->atts.event_mask |= SubstructureRedirectMask|SubstructureNotifyMask;
+ XSelectInput(winPtr->display, winPtr->window, winPtr->atts.event_mask);
+ Tk_CreateEventHandler(tkwin,
+ SubstructureNotifyMask|SubstructureRedirectMask,
+ ContainerEventProc, (ClientData) winPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbedStructureProc,
+ (ClientData) containerPtr);
+ Tk_CreateEventHandler(tkwin, FocusChangeMask, EmbedFocusProc,
+ (ClientData) containerPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedErrorProc --
+ *
+ * This procedure is invoked if an error occurs while creating
+ * an embedded window.
+ *
+ * Results:
+ * Always returns 0 to indicate that the error has been properly
+ * handled.
+ *
+ * Side effects:
+ * The integer pointed to by the clientData argument is set to 1.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EmbedErrorProc(clientData, errEventPtr)
+ ClientData clientData; /* Points to integer to set. */
+ XErrorEvent *errEventPtr; /* Points to information about error
+ * (not used). */
+{
+ int *iPtr = (int *) clientData;
+
+ *iPtr = 1;
+ return 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbeddedEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when various
+ * useful events are received for a window that is embedded in
+ * another application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Our internal state gets cleaned up when an embedded window is
+ * destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbeddedEventProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ EmbedWindowDeleted(winPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ContainerEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when various
+ * useful events are received for the children of a container
+ * window. It forwards relevant information, such as geometry
+ * requests, from the events into the container's application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the event. For example, when ConfigureRequest events
+ * occur, geometry information gets set for the container window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ContainerEventProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ Container *containerPtr;
+ Tk_ErrorHandler errHandler;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Ignore any X protocol errors that happen in this procedure
+ * (almost any operation could fail, for example, if the embedded
+ * application has deleted its window).
+ */
+
+ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+
+ /*
+ * Find the Container structure associated with the parent window.
+ */
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr->parent != eventPtr->xmaprequest.parent;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr == NULL) {
+ panic("ContainerEventProc couldn't find Container record");
+ }
+ }
+
+ if (eventPtr->type == CreateNotify) {
+ /*
+ * A new child window has been created in the container. Record
+ * its id in the Container structure (if more than one child is
+ * created, just remember the last one and ignore the earlier
+ * ones). Also set the child's size to match the container.
+ */
+
+ containerPtr->wrapper = eventPtr->xcreatewindow.window;
+ XMoveResizeWindow(eventPtr->xcreatewindow.display,
+ containerPtr->wrapper, 0, 0,
+ (unsigned int) Tk_Width(
+ (Tk_Window) containerPtr->parentPtr),
+ (unsigned int) Tk_Height(
+ (Tk_Window) containerPtr->parentPtr));
+ } else if (eventPtr->type == ConfigureRequest) {
+ if ((eventPtr->xconfigurerequest.x != 0)
+ || (eventPtr->xconfigurerequest.y != 0)) {
+ /*
+ * The embedded application is trying to move itself, which
+ * isn't legal. At this point, the window hasn't actually
+ * moved, but we need to send it a ConfigureNotify event to
+ * let it know that its request has been denied. If the
+ * embedded application was also trying to resize itself, a
+ * ConfigureNotify will be sent by the geometry management
+ * code below, so we don't need to do anything. Otherwise,
+ * generate a synthetic event.
+ */
+
+ if ((eventPtr->xconfigurerequest.width == winPtr->changes.width)
+ && (eventPtr->xconfigurerequest.height
+ == winPtr->changes.height)) {
+ EmbedSendConfigure(containerPtr);
+ }
+ }
+ EmbedGeometryRequest(containerPtr,
+ eventPtr->xconfigurerequest.width,
+ eventPtr->xconfigurerequest.height);
+ } else if (eventPtr->type == MapRequest) {
+ /*
+ * The embedded application's map request was ignored and simply
+ * passed on to us, so we have to map the window for it to appear
+ * on the screen.
+ */
+
+ XMapWindow(eventPtr->xmaprequest.display,
+ eventPtr->xmaprequest.window);
+ } else if (eventPtr->type == DestroyNotify) {
+ /*
+ * The embedded application is gone. Destroy the container window.
+ */
+
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ }
+ Tk_DeleteErrorHandler(errHandler);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * a container window owned by this application gets resized
+ * (and also at several other times that we don't care about).
+ * This procedure reflects the size change in the embedded
+ * window that corresponds to the container.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded window gets resized to match the container.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ Container *containerPtr = (Container *) clientData;
+ Tk_ErrorHandler errHandler;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if (containerPtr->wrapper != None) {
+ /*
+ * Ignore errors, since the embedded application could have
+ * deleted its window.
+ */
+
+ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XMoveResizeWindow(eventPtr->xconfigure.display,
+ containerPtr->wrapper, 0, 0,
+ (unsigned int) Tk_Width(
+ (Tk_Window) containerPtr->parentPtr),
+ (unsigned int) Tk_Height(
+ (Tk_Window) containerPtr->parentPtr));
+ Tk_DeleteErrorHandler(errHandler);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ EmbedWindowDeleted(containerPtr->parentPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedFocusProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * FocusIn and FocusOut events occur for a container window owned
+ * by this application. It is responsible for moving the focus
+ * back and forth between a container application and an embedded
+ * application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The X focus may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedFocusProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ Container *containerPtr = (Container *) clientData;
+ Tk_ErrorHandler errHandler;
+ Display *display;
+
+ display = Tk_Display(containerPtr->parentPtr);
+ if (eventPtr->type == FocusIn) {
+ /*
+ * The focus just arrived at the container. Change the X focus
+ * to move it to the embedded application, if there is one.
+ * Ignore X errors that occur during this operation (it's
+ * possible that the new focus window isn't mapped).
+ */
+
+ if (containerPtr->wrapper != None) {
+ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XSetInputFocus(display, containerPtr->wrapper, RevertToParent,
+ CurrentTime);
+ Tk_DeleteErrorHandler(errHandler);
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedGeometryRequest --
+ *
+ * This procedure is invoked when an embedded application requests
+ * a particular size. It processes the request (which may or may
+ * not actually honor the request) and reflects the results back
+ * to the embedded application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If we deny the child's size change request, a Configure event
+ * is synthesized to let the child know how big it ought to be.
+ * Events get processed while we're waiting for the geometry
+ * managers to do their thing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedGeometryRequest(containerPtr, width, height)
+ Container *containerPtr; /* Information about the embedding. */
+ int width, height; /* Size that the child has requested. */
+{
+ TkWindow *winPtr = containerPtr->parentPtr;
+
+ /*
+ * Forward the requested size into our geometry management hierarchy
+ * via the container window. We need to send a Configure event back
+ * to the embedded application if we decide not to honor its
+ * request; to make this happen, process all idle event handlers
+ * synchronously here (so that the geometry managers have had a
+ * chance to do whatever they want to do), and if the window's size
+ * didn't change then generate a configure event.
+ */
+
+ Tk_GeometryRequest((Tk_Window) winPtr, width, height);
+ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {
+ /* Empty loop body. */
+ }
+ if ((winPtr->changes.width != width)
+ || (winPtr->changes.height != height)) {
+ EmbedSendConfigure(containerPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedSendConfigure --
+ *
+ * This procedure synthesizes a ConfigureNotify event to notify an
+ * embedded application of its current size and location. This
+ * procedure is called when the embedded application made a
+ * geometry request that we did not grant, so that the embedded
+ * application knows that its geometry didn't change after all.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedSendConfigure(containerPtr)
+ Container *containerPtr; /* Information about the embedding. */
+{
+ TkWindow *winPtr = containerPtr->parentPtr;
+ XEvent event;
+
+ event.xconfigure.type = ConfigureNotify;
+ event.xconfigure.serial =
+ LastKnownRequestProcessed(winPtr->display);
+ event.xconfigure.send_event = True;
+ event.xconfigure.display = winPtr->display;
+ event.xconfigure.event = containerPtr->wrapper;
+ event.xconfigure.window = containerPtr->wrapper;
+ event.xconfigure.x = 0;
+ event.xconfigure.y = 0;
+ event.xconfigure.width = winPtr->changes.width;
+ event.xconfigure.height = winPtr->changes.height;
+ event.xconfigure.above = None;
+ event.xconfigure.override_redirect = False;
+
+ /*
+ * Note: when sending the event below, the ButtonPressMask
+ * causes the event to be sent only to applications that have
+ * selected for ButtonPress events, which should be just the
+ * embedded application.
+ */
+
+ XSendEvent(winPtr->display, containerPtr->wrapper, False,
+ 0, &event);
+
+ /*
+ * The following needs to be done if the embedded window is
+ * not in the same application as the container window.
+ */
+
+ if (containerPtr->embeddedPtr == NULL) {
+ XMoveResizeWindow(winPtr->display, containerPtr->wrapper, 0, 0,
+ (unsigned int) winPtr->changes.width,
+ (unsigned int) winPtr->changes.height);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetOtherWindow --
+ *
+ * If both the container and embedded window are in the same
+ * process, this procedure will return either one, given the other.
+ *
+ * Results:
+ * If winPtr is a container, the return value is the token for the
+ * embedded window, and vice versa. If the "other" window isn't in
+ * this process, NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkpGetOtherWindow(winPtr)
+ TkWindow *winPtr; /* Tk's structure for a container or
+ * embedded window. */
+{
+ Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ return containerPtr->parentPtr;
+ } else if (containerPtr->parentPtr == winPtr) {
+ return containerPtr->embeddedPtr;
+ }
+ }
+ panic("TkpGetOtherWindow couldn't find window");
+ return NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpRedirectKeyEvent --
+ *
+ * This procedure is invoked when a key press or release event
+ * arrives for an application that does not believe it owns the
+ * input focus. This can happen because of embedding; for example,
+ * X can send an event to an embedded application when the real
+ * focus window is in the container application and is an ancestor
+ * of the container. This procedure's job is to forward the event
+ * back to the application where it really belongs.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The event may get sent to a different application.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpRedirectKeyEvent(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window to which the event was originally
+ * reported. */
+ XEvent *eventPtr; /* X event to redirect (should be KeyPress
+ * or KeyRelease). */
+{
+ Container *containerPtr;
+ Window saved;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * First, find the top-level window corresponding to winPtr.
+ */
+
+ while (1) {
+ if (winPtr == NULL) {
+ /*
+ * This window is being deleted. This is too confusing a
+ * case to handle so discard the event.
+ */
+
+ return;
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ winPtr = winPtr->parentPtr;
+ }
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ /*
+ * This application is embedded. If we got a key event without
+ * officially having the focus, it means that the focus is
+ * really in the container, but the mouse was over the embedded
+ * application. Send the event back to the container.
+ */
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr->embeddedPtr != winPtr;
+ containerPtr = containerPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ saved = eventPtr->xkey.window;
+ eventPtr->xkey.window = containerPtr->parent;
+ XSendEvent(eventPtr->xkey.display, eventPtr->xkey.window, False,
+ KeyPressMask|KeyReleaseMask, eventPtr);
+ eventPtr->xkey.window = saved;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpClaimFocus --
+ *
+ * This procedure is invoked when someone asks or the input focus
+ * to be put on a window in an embedded application, but the
+ * application doesn't currently have the focus. It requests the
+ * input focus from the container application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The input focus may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpClaimFocus(topLevelPtr, force)
+ TkWindow *topLevelPtr; /* Top-level window containing desired
+ * focus window; should be embedded. */
+ int force; /* One means that the container should
+ * claim the focus if it doesn't
+ * currently have it. */
+{
+ XEvent event;
+ Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!(topLevelPtr->flags & TK_EMBEDDED)) {
+ return;
+ }
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr->embeddedPtr != topLevelPtr;
+ containerPtr = containerPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+
+ event.xfocus.type = FocusIn;
+ event.xfocus.serial = LastKnownRequestProcessed(topLevelPtr->display);
+ event.xfocus.send_event = 1;
+ event.xfocus.display = topLevelPtr->display;
+ event.xfocus.window = containerPtr->parent;
+ event.xfocus.mode = EMBEDDED_APP_WANTS_FOCUS;
+ event.xfocus.detail = force;
+ XSendEvent(event.xfocus.display, event.xfocus.window, False, 0, &event);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpTestembedCmd --
+ *
+ * This procedure implements the "testembed" command. It returns
+ * some or all of the information in the list pointed to by
+ * firstContainerPtr.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpTestembedCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ int all;
+ Container *containerPtr;
+ Tcl_DString dString;
+ char buffer[50];
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if ((argc > 1) && (strcmp(argv[1], "all") == 0)) {
+ all = 1;
+ } else {
+ all = 0;
+ }
+ Tcl_DStringInit(&dString);
+ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ Tcl_DStringStartSublist(&dString);
+ if (containerPtr->parent == None) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ if (all) {
+ sprintf(buffer, "0x%x", (int) containerPtr->parent);
+ Tcl_DStringAppendElement(&dString, buffer);
+ } else {
+ Tcl_DStringAppendElement(&dString, "XXX");
+ }
+ }
+ if (containerPtr->parentPtr == NULL) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ Tcl_DStringAppendElement(&dString,
+ containerPtr->parentPtr->pathName);
+ }
+ if (containerPtr->wrapper == None) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ if (all) {
+ sprintf(buffer, "0x%x", (int) containerPtr->wrapper);
+ Tcl_DStringAppendElement(&dString, buffer);
+ } else {
+ Tcl_DStringAppendElement(&dString, "XXX");
+ }
+ }
+ if (containerPtr->embeddedPtr == NULL) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ Tcl_DStringAppendElement(&dString,
+ containerPtr->embeddedPtr->pathName);
+ }
+ Tcl_DStringEndSublist(&dString);
+ }
+ Tcl_DStringResult(interp, &dString);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedWindowDeleted --
+ *
+ * This procedure is invoked when a window involved in embedding
+ * (as either the container or the embedded application) is
+ * destroyed. It cleans up the Container structure for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Container structure may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedWindowDeleted(winPtr)
+ TkWindow *winPtr; /* Tk's information about window that
+ * was deleted. */
+{
+ Container *containerPtr, *prevPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the Container structure for this window work. Delete the
+ * information about the embedded application and free the container's
+ * record.
+ */
+
+ prevPtr = NULL;
+ containerPtr = tsdPtr->firstContainerPtr;
+ while (1) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ containerPtr->wrapper = None;
+ containerPtr->embeddedPtr = NULL;
+ break;
+ }
+ if (containerPtr->parentPtr == winPtr) {
+ containerPtr->parentPtr = NULL;
+ break;
+ }
+ prevPtr = containerPtr;
+ containerPtr = containerPtr->nextPtr;
+ }
+ if ((containerPtr->embeddedPtr == NULL)
+ && (containerPtr->parentPtr == NULL)) {
+ if (prevPtr == NULL) {
+ tsdPtr->firstContainerPtr = containerPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = containerPtr->nextPtr;
+ }
+ ckfree((char *) containerPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnixContainerId --
+ *
+ * Given an embedded window, this procedure returns the X window
+ * identifier for the associated container window.
+ *
+ * Results:
+ * The return value is the X window identifier for winPtr's
+ * container window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Window
+TkUnixContainerId(winPtr)
+ TkWindow *winPtr; /* Tk's structure for an embedded window. */
+{
+ Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr != NULL; containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ return containerPtr->parent;
+ }
+ }
+ panic("TkUnixContainerId couldn't find window");
+ return None;
+}
--- /dev/null
+/*
+ * tkUnixEvent.c --
+ *
+ * This file implements an event source for X displays for the
+ * UNIX version of Tk.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkUnixInt.h"
+#include <signal.h>
+
+/*
+ * The following static indicates whether this module has been initialized
+ * in the current thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for procedures that are referenced only in this file:
+ */
+
+static void DisplayCheckProc _ANSI_ARGS_((ClientData clientData,
+ int flags));
+static void DisplayExitHandler _ANSI_ARGS_((
+ ClientData clientData));
+static void DisplayFileProc _ANSI_ARGS_((ClientData clientData,
+ int flags));
+static void DisplaySetupProc _ANSI_ARGS_((ClientData clientData,
+ int flags));
+static void TransferXEventsToTcl _ANSI_ARGS_((Display *display));
+#ifdef TK_USE_INPUT_METHODS
+static void OpenIM _ANSI_ARGS_((TkDisplay *dispPtr));
+#endif
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateXEventSource --
+ *
+ * This procedure is called during Tk initialization to create
+ * the event source for X Window events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new event source is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkCreateXEventSource()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
+ Tcl_CreateExitHandler(DisplayExitHandler, NULL);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayExitHandler --
+ *
+ * This function is called during finalization to clean up the
+ * display module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayExitHandler(clientData)
+ ClientData clientData; /* Not used. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_DeleteEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
+ tsdPtr->initialized = 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpOpenDisplay --
+ *
+ * Allocates a new TkDisplay, opens the X display, and establishes
+ * the file handler for the connection.
+ *
+ * Results:
+ * A pointer to a Tk display structure.
+ *
+ * Side effects:
+ * Opens a display.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkDisplay *
+TkpOpenDisplay(display_name)
+ CONST char *display_name;
+{
+ TkDisplay *dispPtr;
+ Display *display = XOpenDisplay(display_name);
+
+ if (display == NULL) {
+ return NULL;
+ }
+ dispPtr = (TkDisplay *) ckalloc(sizeof(TkDisplay));
+ memset(dispPtr, 0, sizeof(TkDisplay));
+ dispPtr->display = display;
+#ifdef TK_USE_INPUT_METHODS
+ OpenIM(dispPtr);
+#endif
+ Tcl_CreateFileHandler(ConnectionNumber(display), TCL_READABLE,
+ DisplayFileProc, (ClientData) dispPtr);
+ return dispPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCloseDisplay --
+ *
+ * Cancels notifier callbacks and closes a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deallocates the displayPtr and unix-specific resources.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpCloseDisplay(dispPtr)
+ TkDisplay *dispPtr;
+{
+ TkSendCleanup(dispPtr);
+
+ TkFreeXId(dispPtr);
+
+ TkWmCleanup(dispPtr);
+
+#ifdef TK_USE_INPUT_METHODS
+#if TK_XIM_SPOT
+ if (dispPtr->inputXfs) {
+ XFreeFontSet(dispPtr->display, dispPtr->inputXfs);
+ }
+#endif
+ if (dispPtr->inputMethod) {
+ /*
+ * This caused core dumps on some systems (Solaris 2.3 1/6/95).
+ * The most likely cause of this is a bug in X that accesses
+ * memory that was already deallocated inside XCloseIM().
+ * One can work around this issue by making sure a XDestroyIC()
+ * gets invoked for each XCreateIC().
+ */
+ XCloseIM(dispPtr->inputMethod);
+ }
+#endif
+
+ if (dispPtr->display != 0) {
+ Tcl_DeleteFileHandler(ConnectionNumber(dispPtr->display));
+ (void) XSync(dispPtr->display, False);
+ (void) XCloseDisplay(dispPtr->display);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplaySetupProc --
+ *
+ * This procedure implements the setup part of the UNIX X display
+ * event source. It is invoked by Tcl_DoOneEvent before entering
+ * the notifier to check for events on all displays.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If data is queued on a display inside Xlib, then the maximum
+ * block time will be set to 0 to ensure that the notifier returns
+ * control to Tcl even if there is no more data on the X connection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplaySetupProc(clientData, flags)
+ ClientData clientData; /* Not used. */
+ int flags;
+{
+ TkDisplay *dispPtr;
+ static Tcl_Time blockTime = { 0, 0 };
+
+ if (!(flags & TCL_WINDOW_EVENTS)) {
+ return;
+ }
+
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+
+ /*
+ * Flush the display. If data is pending on the X queue, set
+ * the block time to zero. This ensures that we won't block
+ * in the notifier if there is data in the X queue, but not on
+ * the server socket.
+ */
+
+ XFlush(dispPtr->display);
+ if (QLength(dispPtr->display) > 0) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransferXEventsToTcl
+ *
+ * Transfer events from the X event queue to the Tk event queue.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves queued X events onto the Tcl event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TransferXEventsToTcl(display)
+ Display *display;
+{
+ int numFound;
+ XEvent event;
+
+ numFound = QLength(display);
+
+ /*
+ * Transfer events from the X event queue to the Tk event queue.
+ */
+
+ while (numFound > 0) {
+ XNextEvent(display, &event);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ numFound--;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayCheckProc --
+ *
+ * This procedure checks for events sitting in the X event
+ * queue.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves queued events onto the Tcl event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayCheckProc(clientData, flags)
+ ClientData clientData; /* Not used. */
+ int flags;
+{
+ TkDisplay *dispPtr;
+
+ if (!(flags & TCL_WINDOW_EVENTS)) {
+ return;
+ }
+
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ XFlush(dispPtr->display);
+ TransferXEventsToTcl(dispPtr->display);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayFileProc --
+ *
+ * This procedure implements the file handler for the X connection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Makes entries on the Tcl event queue for all the events available
+ * from all the displays.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayFileProc(clientData, flags)
+ ClientData clientData; /* The display pointer. */
+ int flags; /* Should be TCL_READABLE. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ Display *display = dispPtr->display;
+ int numFound;
+
+ XFlush(display);
+ numFound = XEventsQueued(display, QueuedAfterReading);
+ if (numFound == 0) {
+
+ /*
+ * Things are very tricky if there aren't any events readable
+ * at this point (after all, there was supposedly data
+ * available on the connection). A couple of things could
+ * have occurred:
+ *
+ * One possibility is that there were only error events in the
+ * input from the server. If this happens, we should return
+ * (we don't want to go to sleep in XNextEvent below, since
+ * this would block out other sources of input to the
+ * process).
+ *
+ * Another possibility is that our connection to the server
+ * has been closed. This will not necessarily be detected in
+ * XEventsQueued (!!), so if we just return then there will be
+ * an infinite loop. To detect such an error, generate a NoOp
+ * protocol request to exercise the connection to the server,
+ * then return. However, must disable SIGPIPE while sending
+ * the request, or else the process will die from the signal
+ * and won't invoke the X error function to print a nice (?!)
+ * message.
+ */
+
+ void (*oldHandler)();
+
+ oldHandler = (void (*)()) signal(SIGPIPE, SIG_IGN);
+ XNoOp(display);
+ XFlush(display);
+ (void) signal(SIGPIPE, oldHandler);
+ }
+
+ TransferXEventsToTcl(display);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnixDoOneXEvent --
+ *
+ * This routine waits for an X event to be processed or for
+ * a timeout to occur. The timeout is specified as an absolute
+ * time. This routine is called when Tk needs to wait for a
+ * particular X event without letting arbitrary events be
+ * processed. The caller will typically call Tk_RestrictEvents
+ * to set up an event filter before calling this routine. This
+ * routine will service at most one event per invocation.
+ *
+ * Results:
+ * Returns 0 if the timeout has expired, otherwise returns 1.
+ *
+ * Side effects:
+ * Can invoke arbitrary Tcl scripts.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkUnixDoOneXEvent(timePtr)
+ Tcl_Time *timePtr; /* Specifies the absolute time when the
+ * call should time out. */
+{
+ TkDisplay *dispPtr;
+ static fd_mask readMask[MASK_SIZE];
+ struct timeval blockTime, *timeoutPtr;
+ Tcl_Time now;
+ int fd, index, bit, numFound, numFdBits = 0;
+
+ /*
+ * Look for queued events first.
+ */
+
+ if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
+ return 1;
+ }
+
+ /*
+ * Compute the next block time and check to see if we have timed out.
+ * Note that HP-UX defines tv_sec to be unsigned so we have to be
+ * careful in our arithmetic.
+ */
+
+ if (timePtr) {
+ TclpGetTime(&now);
+ blockTime.tv_sec = timePtr->sec;
+ blockTime.tv_usec = timePtr->usec - now.usec;
+ if (blockTime.tv_usec < 0) {
+ now.sec += 1;
+ blockTime.tv_usec += 1000000;
+ }
+ if (blockTime.tv_sec < now.sec) {
+ blockTime.tv_sec = 0;
+ blockTime.tv_usec = 0;
+ } else {
+ blockTime.tv_sec -= now.sec;
+ }
+ timeoutPtr = &blockTime;
+ } else {
+ timeoutPtr = NULL;
+ }
+
+ /*
+ * Set up the select mask for all of the displays. If a display has
+ * data pending, then we want to poll instead of blocking.
+ */
+
+ memset((VOID *) readMask, 0, MASK_SIZE*sizeof(fd_mask));
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ XFlush(dispPtr->display);
+ if (QLength(dispPtr->display) > 0) {
+ blockTime.tv_sec = 0;
+ blockTime.tv_usec = 0;
+ }
+ fd = ConnectionNumber(dispPtr->display);
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+ readMask[index] |= bit;
+ if (numFdBits <= fd) {
+ numFdBits = fd+1;
+ }
+ }
+
+ numFound = select(numFdBits, (SELECT_MASK *) &readMask[0], NULL, NULL,
+ timeoutPtr);
+ if (numFound <= 0) {
+ /*
+ * Some systems don't clear the masks after an error, so
+ * we have to do it here.
+ */
+
+ memset((VOID *) readMask, 0, MASK_SIZE*sizeof(fd_mask));
+ }
+
+ /*
+ * Process any new events on the display connections.
+ */
+
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ fd = ConnectionNumber(dispPtr->display);
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+ if ((readMask[index] & bit) || (QLength(dispPtr->display) > 0)) {
+ DisplayFileProc((ClientData)dispPtr, TCL_READABLE);
+ }
+ }
+ if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
+ return 1;
+ }
+
+ /*
+ * Check to see if we timed out.
+ */
+
+ if (timePtr) {
+ TclpGetTime(&now);
+ if ((now.sec > timePtr->sec) || ((now.sec == timePtr->sec)
+ && (now.usec > timePtr->usec))) {
+ return 0;
+ }
+ }
+
+ /*
+ * We had an event but we did not generate a Tcl event from it. Behave
+ * as though we dealt with it. (JYL&SS)
+ */
+
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSync --
+ *
+ * This routine ensures that all pending X requests have been
+ * seen by the server, and that any pending X events have been
+ * moved onto the Tk event queue.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Places new events on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSync(display)
+ Display *display; /* Display to sync. */
+{
+ XSync(display, False);
+
+ /*
+ * Transfer events from the X event queue to the Tk event queue.
+ */
+ TransferXEventsToTcl(display);
+}
+#ifdef TK_USE_INPUT_METHODS
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * OpenIM --
+ *
+ * Tries to open an X input method, associated with the
+ * given display. Right now we can only deal with a bare-bones
+ * input style: no preedit, and no status.
+ *
+ * Results:
+ * Stores the input method in dispPtr->inputMethod; if there isn't
+ * a suitable input method, then NULL is stored in dispPtr->inputMethod.
+ *
+ * Side effects:
+ * An input method gets opened.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+OpenIM(dispPtr)
+ TkDisplay *dispPtr; /* Tk's structure for the display. */
+{
+ unsigned short i;
+ XIMStyles *stylePtr;
+ char *modifier_list;
+
+ if ((modifier_list = XSetLocaleModifiers("")) == NULL) {
+ goto error;
+ }
+
+ dispPtr->inputMethod = XOpenIM(dispPtr->display, NULL, NULL, NULL);
+ if (dispPtr->inputMethod == NULL) {
+ return;
+ }
+
+ if ((XGetIMValues(dispPtr->inputMethod, XNQueryInputStyle, &stylePtr,
+ NULL) != NULL) || (stylePtr == NULL)) {
+ goto error;
+ }
+#if TK_XIM_SPOT
+ /*
+ * If we want to do over-the-spot XIM, we have to check that this
+ * mode is supported. If not we will fall-through to the check below.
+ */
+ for (i = 0; i < stylePtr->count_styles; i++) {
+ if (stylePtr->supported_styles[i]
+ == (XIMPreeditPosition | XIMStatusNothing)) {
+ dispPtr->flags |= TK_DISPLAY_XIM_SPOT;
+ XFree(stylePtr);
+ return;
+ }
+ }
+#endif
+ for (i = 0; i < stylePtr->count_styles; i++) {
+ if (stylePtr->supported_styles[i]
+ == (XIMPreeditNothing | XIMStatusNothing)) {
+ XFree(stylePtr);
+ return;
+ }
+ }
+ XFree(stylePtr);
+
+ error:
+
+ if (dispPtr->inputMethod) {
+ /*
+ * This call should not suffer from any core dumping problems
+ * since we have not allocated any input contexts.
+ */
+ XCloseIM(dispPtr->inputMethod);
+ dispPtr->inputMethod = NULL;
+ }
+}
+#endif /* TK_USE_INPUT_METHODS */
--- /dev/null
+/*
+ * tkUnixFocus.c --
+ *
+ * This file contains platform specific procedures that manage
+ * focus for Tk.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkUnixInt.h"
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpChangeFocus --
+ *
+ * This procedure is invoked to move the official X focus from
+ * one window to another.
+ *
+ * Results:
+ * The return value is the serial number of the command that
+ * changed the focus. It may be needed by the caller to filter
+ * out focus change events that were queued before the command.
+ * If the procedure doesn't actually change the focus then
+ * it returns 0.
+ *
+ * Side effects:
+ * The official X focus window changes; the application's focus
+ * window isn't changed by this procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpChangeFocus(winPtr, force)
+ TkWindow *winPtr; /* Window that is to receive the X focus. */
+ int force; /* Non-zero means claim the focus even
+ * if it didn't originally belong to
+ * topLevelPtr's application. */
+{
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ Tk_ErrorHandler errHandler;
+ Window window, root, parent, *children;
+ unsigned int numChildren, serial;
+ TkWindow *winPtr2;
+ int dummy;
+
+ /*
+ * Don't set the X focus to a window that's marked
+ * override-redirect. This is a hack to avoid problems with menus
+ * under olvwm: if we move the focus then the focus can get lost
+ * during keyboard traversal. Fortunately, we don't really need to
+ * move the focus for menus: events will still find their way to the
+ * focus window, and menus aren't decorated anyway so the window
+ * manager doesn't need to hear about the focus change in order to
+ * redecorate the menu.
+ */
+
+ serial = 0;
+ if (winPtr->atts.override_redirect) {
+ return serial;
+ }
+
+ /*
+ * Check to make sure that the focus is still in one of the windows
+ * of this application or one of their descendants. Furthermore,
+ * grab the server to make sure that the focus doesn't change in the
+ * middle of this operation.
+ */
+
+ XGrabServer(dispPtr->display);
+ if (!force) {
+ /*
+ * Find the focus window, then see if it or one of its ancestors
+ * is a window in our application (it's possible that the focus
+ * window is in an embedded application, which may or may not be
+ * in the same process.
+ */
+
+ XGetInputFocus(dispPtr->display, &window, &dummy);
+ while (1) {
+ winPtr2 = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
+ if ((winPtr2 != NULL) && (winPtr2->mainPtr == winPtr->mainPtr)) {
+ break;
+ }
+ if ((window == PointerRoot) || (window == None)) {
+ goto done;
+ }
+ XQueryTree(dispPtr->display, window, &root, &parent, &children,
+ &numChildren);
+ if (children != NULL) {
+ XFree((void *) children);
+ }
+ if (parent == root) {
+ goto done;
+ }
+ window = parent;
+ }
+ }
+
+ /*
+ * Tell X to change the focus. Ignore errors that occur when changing
+ * the focus: it is still possible that the window we're focussing
+ * to could have gotten unmapped, which will generate an error.
+ */
+
+ errHandler = Tk_CreateErrorHandler(dispPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ if (winPtr->window == None) {
+ panic("ChangeXFocus got null X window");
+ }
+ XSetInputFocus(dispPtr->display, winPtr->window, RevertToParent,
+ CurrentTime);
+ Tk_DeleteErrorHandler(errHandler);
+
+ /*
+ * Remember the current serial number for the X server and issue
+ * a dummy server request. This marks the position at which we
+ * changed the focus, so we can distinguish FocusIn and FocusOut
+ * events on either side of the mark.
+ */
+
+ serial = NextRequest(winPtr->display);
+ XNoOp(winPtr->display);
+
+ done:
+ XUngrabServer(dispPtr->display);
+
+ /*
+ * After ungrabbing the server, it's important to flush the output
+ * immediately so that the server sees the ungrab command. Otherwise
+ * we might do something else that needs to communicate with the
+ * server (such as invoking a subprocess that needs to do I/O to
+ * the screen); if the ungrab command is still sitting in our
+ * output buffer, we could deadlock.
+ */
+
+ XFlush(dispPtr->display);
+ return serial;
+}
--- /dev/null
+/*
+ * tkUnixFont.c --
+ *
+ * Contains the Unix implementation of the platform-independant
+ * font package interface.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkUnixInt.h"
+#include "tkFont.h"
+#include <netinet/in.h> /* for htons() prototype */
+#include <arpa/inet.h> /* inet_ntoa() */
+
+/*
+ * The preferred font encodings.
+ */
+
+static CONST char *encodingList[] = {
+ "iso8859-1", "jis0208", "jis0212", NULL
+};
+
+/*
+ * The following structure represents a font family. It is assumed that
+ * all screen fonts constructed from the same "font family" share certain
+ * properties; all screen fonts with the same "font family" point to a
+ * shared instance of this structure. The most important shared property
+ * is the character existence metrics, used to determine if a screen font
+ * can display a given Unicode character.
+ *
+ * Under Unix, there are three attributes that uniquely identify a "font
+ * family": the foundry, face name, and charset.
+ */
+
+#define FONTMAP_SHIFT 10
+
+#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT))
+#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT)
+
+typedef struct FontFamily {
+ struct FontFamily *nextPtr; /* Next in list of all known font families. */
+ int refCount; /* How many SubFonts are referring to this
+ * FontFamily. When the refCount drops to
+ * zero, this FontFamily may be freed. */
+ /*
+ * Key.
+ */
+
+ Tk_Uid foundry; /* Foundry key for this FontFamily. */
+ Tk_Uid faceName; /* Face name key for this FontFamily. */
+ Tcl_Encoding encoding; /* Encoding key for this FontFamily. */
+
+ /*
+ * Derived properties.
+ */
+
+ int isTwoByteFont; /* 1 if this is a double-byte font, 0
+ * otherwise. */
+ char *fontMap[FONTMAP_PAGES];
+ /* Two-level sparse table used to determine
+ * quickly if the specified character exists.
+ * As characters are encountered, more pages
+ * in this table are dynamically alloced. The
+ * contents of each page is a bitmask
+ * consisting of FONTMAP_BITSPERPAGE bits,
+ * representing whether this font can be used
+ * to display the given character at the
+ * corresponding bit position. The high bits
+ * of the character are used to pick which
+ * page of the table is used. */
+} FontFamily;
+
+/*
+ * The following structure encapsulates an individual screen font. A font
+ * object is made up of however many SubFonts are necessary to display a
+ * stream of multilingual characters.
+ */
+
+typedef struct SubFont {
+ char **fontMap; /* Pointer to font map from the FontFamily,
+ * cached here to save a dereference. */
+ XFontStruct *fontStructPtr; /* The specific screen font that will be
+ * used when displaying/measuring chars
+ * belonging to the FontFamily. */
+ FontFamily *familyPtr; /* The FontFamily for this SubFont. */
+} SubFont;
+
+/*
+ * The following structure represents Unix's implementation of a font
+ * object.
+ */
+
+#define SUBFONT_SPACE 3
+#define BASE_CHARS 256
+
+typedef struct UnixFont {
+ TkFont font; /* Stuff used by generic font package. Must
+ * be first in structure. */
+ SubFont staticSubFonts[SUBFONT_SPACE];
+ /* Builtin space for a limited number of
+ * SubFonts. */
+ int numSubFonts; /* Length of following array. */
+ SubFont *subFontArray; /* Array of SubFonts that have been loaded
+ * in order to draw/measure all the characters
+ * encountered by this font so far. All fonts
+ * start off with one SubFont initialized by
+ * AllocFont() from the original set of font
+ * attributes. Usually points to
+ * staticSubFonts, but may point to malloced
+ * space if there are lots of SubFonts. */
+ SubFont controlSubFont; /* Font to use to display control-character
+ * expansions. */
+
+ Display *display; /* Display that owns font. */
+ int pixelSize; /* Original pixel size used when font was
+ * constructed. */
+ TkXLFDAttributes xa; /* Additional attributes that specify the
+ * preferred foundry and encoding to use when
+ * constructing additional SubFonts. */
+ int widths[BASE_CHARS]; /* Widths of first 256 chars in the base
+ * font, for handling common case. */
+ int underlinePos; /* Offset from baseline to origin of
+ * underline bar (used when drawing underlined
+ * font) (pixels). */
+ int barHeight; /* Height of underline or overstrike bar
+ * (used when drawing underlined or strikeout
+ * font) (pixels). */
+} UnixFont;
+
+/*
+ * The following structure and definition is used to keep track of the
+ * alternative names for various encodings. Asking for an encoding that
+ * matches one of the alias patterns will result in actually getting the
+ * encoding by its real name.
+ */
+
+typedef struct EncodingAlias {
+ char *realName; /* The real name of the encoding to load if
+ * the provided name matched the pattern. */
+ char *aliasPattern; /* Pattern for encoding name, of the form
+ * that is acceptable to Tcl_StringMatch. */
+} EncodingAlias;
+
+/*
+ * Just some utility structures used for passing around values in helper
+ * procedures.
+ */
+
+typedef struct FontAttributes {
+ TkFontAttributes fa;
+ TkXLFDAttributes xa;
+} FontAttributes;
+
+
+typedef struct ThreadSpecificData {
+ FontFamily *fontFamilyList; /* The list of font families that are
+ * currently loaded. As screen fonts
+ * are loaded, this list grows to hold
+ * information about what characters
+ * exist in each font family. */
+ FontFamily controlFamily; /* FontFamily used to handle control
+ * character expansions. The encoding
+ * of this FontFamily converts UTF-8 to
+ * backslashed escape sequences. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The set of builtin encoding alises to convert the XLFD names for the
+ * encodings into the names expected by the Tcl encoding package.
+ */
+
+static EncodingAlias encodingAliases[] = {
+ {"gb2312", "gb2312*"},
+ {"big5", "big5*"},
+ {"cns11643-1", "cns11643*-1"},
+ {"cns11643-1", "cns11643*.1-0"},
+ {"cns11643-2", "cns11643*-2"},
+ {"cns11643-2", "cns11643*.2-0"},
+ {"jis0201", "jisx0201*"},
+ {"jis0201", "jisx0202*"},
+ {"jis0208", "jisc6226*"},
+ {"jis0208", "jisx0208*"},
+ {"jis0212", "jisx0212*"},
+ {"tis620", "tis620*"},
+ {"ksc5601", "ksc5601*"},
+ {"dingbats", "*dingbats"},
+ {"ucs-2be", "iso10646-1"},
+ {NULL, NULL}
+};
+
+/*
+ * Procedures used only in this file.
+ */
+
+static void FontPkgCleanup _ANSI_ARGS_((ClientData clientData));
+static FontFamily * AllocFontFamily _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, int base));
+static SubFont * CanUseFallback _ANSI_ARGS_((UnixFont *fontPtr,
+ CONST char *fallbackName, int ch));
+static SubFont * CanUseFallbackWithAliases _ANSI_ARGS_((
+ UnixFont *fontPtr, char *fallbackName,
+ int ch, Tcl_DString *nameTriedPtr));
+static int ControlUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static XFontStruct * CreateClosestFont _ANSI_ARGS_((Tk_Window tkwin,
+ CONST TkFontAttributes *faPtr,
+ CONST TkXLFDAttributes *xaPtr));
+static SubFont * FindSubFontForChar _ANSI_ARGS_((UnixFont *fontPtr,
+ int ch));
+static void FontMapInsert _ANSI_ARGS_((SubFont *subFontPtr,
+ int ch));
+static void FontMapLoadPage _ANSI_ARGS_((SubFont *subFontPtr,
+ int row));
+static int FontMapLookup _ANSI_ARGS_((SubFont *subFontPtr,
+ int ch));
+static void FreeFontFamily _ANSI_ARGS_((FontFamily *afPtr));
+static CONST char * GetEncodingAlias _ANSI_ARGS_((CONST char *name));
+static int GetFontAttributes _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, FontAttributes *faPtr));
+static XFontStruct * GetScreenFont _ANSI_ARGS_((Display *display,
+ FontAttributes *wantPtr, char **nameList,
+ int bestIdx[], unsigned int bestScore[]));
+static XFontStruct * GetSystemFont _ANSI_ARGS_((Display *display));
+static int IdentifySymbolEncodings _ANSI_ARGS_((
+ FontAttributes *faPtr));
+static void InitFont _ANSI_ARGS_((Tk_Window tkwin,
+ XFontStruct *fontStructPtr, UnixFont *fontPtr));
+static void InitSubFont _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, int base,
+ SubFont *subFontPtr));
+static char ** ListFonts _ANSI_ARGS_((Display *display,
+ CONST char *faceName, int *numNamesPtr));
+static char ** ListFontOrAlias _ANSI_ARGS_((Display *display,
+ CONST char *faceName, int *numNamesPtr));
+static unsigned int RankAttributes _ANSI_ARGS_((FontAttributes *wantPtr,
+ FontAttributes *gotPtr));
+static void ReleaseFont _ANSI_ARGS_((UnixFont *fontPtr));
+static void ReleaseSubFont _ANSI_ARGS_((Display *display,
+ SubFont *subFontPtr));
+static int SeenName _ANSI_ARGS_((CONST char *name,
+ Tcl_DString *dsPtr));
+static int Ucs2beToUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static int UtfToUcs2beProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontPkgCleanup --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependent code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases thread-specific resources used by font pkg.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontPkgCleanup(ClientData clientData)
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->controlFamily.encoding != NULL) {
+ FontFamily *familyPtr = &tsdPtr->controlFamily;
+ int i;
+
+ Tcl_FreeEncoding(familyPtr->encoding);
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree(familyPtr->fontMap[i]);
+ }
+ }
+ tsdPtr->controlFamily.encoding = NULL;
+ }
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependent code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_EncodingType type;
+ SubFont dummy;
+ int i;
+
+ if (tsdPtr->controlFamily.encoding == NULL) {
+ type.encodingName = "X11ControlChars";
+ type.toUtfProc = ControlUtfProc;
+ type.fromUtfProc = ControlUtfProc;
+ type.freeProc = NULL;
+ type.clientData = NULL;
+ type.nullSize = 0;
+
+ tsdPtr->controlFamily.refCount = 2;
+ tsdPtr->controlFamily.encoding = Tcl_CreateEncoding(&type);
+ tsdPtr->controlFamily.isTwoByteFont = 0;
+
+ dummy.familyPtr = &tsdPtr->controlFamily;
+ dummy.fontMap = tsdPtr->controlFamily.fontMap;
+ for (i = 0x00; i < 0x20; i++) {
+ FontMapInsert(&dummy, i);
+ FontMapInsert(&dummy, i + 0x80);
+ }
+
+ /*
+ * UCS-2BE is unicode in big-endian format.
+ * It is used in iso10646 fonts.
+ */
+
+ type.encodingName = "ucs-2be";
+ type.toUtfProc = Ucs2beToUtfProc;
+ type.fromUtfProc = UtfToUcs2beProc;
+ type.freeProc = NULL;
+ type.clientData = NULL;
+ type.nullSize = 2;
+ Tcl_CreateEncoding(&type);
+ Tcl_CreateThreadExitHandler(FontPkgCleanup, NULL);
+ }
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ControlUtfProc --
+ *
+ * Convert from UTF-8 into the ASCII expansion of a control
+ * character.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ControlUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* Not used. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *srcEnd;
+ char *dstStart, *dstEnd;
+ Tcl_UniChar ch;
+ int result;
+ static char hexChars[] = "0123456789abcdef";
+ static char mapChars[] = {
+ 0, 0, 0, 0, 0, 0, 0,
+ 'a', 'b', 't', 'n', 'v', 'f', 'r'
+ };
+
+ result = TCL_OK;
+
+ srcEnd = src + srcLen;
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - 6;
+
+ for ( ; src < srcEnd; ) {
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ src += Tcl_UtfToUniChar(src, &ch);
+ dst[0] = '\\';
+ if ((ch < sizeof(mapChars)) && (mapChars[ch] != 0)) {
+ dst[1] = mapChars[ch];
+ dst += 2;
+ } else if (ch < 256) {
+ dst[1] = 'x';
+ dst[2] = hexChars[(ch >> 4) & 0xf];
+ dst[3] = hexChars[ch & 0xf];
+ dst += 4;
+ } else {
+ dst[1] = 'u';
+ dst[2] = hexChars[(ch >> 12) & 0xf];
+ dst[3] = hexChars[(ch >> 8) & 0xf];
+ dst[4] = hexChars[(ch >> 4) & 0xf];
+ dst[5] = hexChars[ch & 0xf];
+ dst += 6;
+ }
+ }
+ *srcReadPtr = src - srcEnd;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = dst - dstStart;
+ return result;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Ucs2beToUtfProc --
+ *
+ * Convert from UCS-2BE (big-endian 16-bit Unicode) to UTF-8.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Ucs2beToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* Not used. */
+ CONST char *src; /* Source string in Unicode. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST Tcl_UniChar *wSrc, *wSrcStart, *wSrcEnd;
+ char *dstEnd, *dstStart;
+ int result, numChars;
+
+ result = TCL_OK;
+ if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
+ result = TCL_CONVERT_MULTIBYTE;
+ srcLen /= sizeof(Tcl_UniChar);
+ srcLen *= sizeof(Tcl_UniChar);
+ }
+
+ wSrc = (Tcl_UniChar *) src;
+
+ wSrcStart = (Tcl_UniChar *) src;
+ wSrcEnd = (Tcl_UniChar *) (src + srcLen);
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - TCL_UTF_MAX;
+
+ for (numChars = 0; wSrc < wSrcEnd; numChars++) {
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ /*
+ * On a little-endian machine (Intel) the UCS-2BE is in the
+ * wrong byte-order in comparison to "unicode", which is
+ * in native host order.
+ */
+ dst += Tcl_UniCharToUtf(htons(*wSrc), dst);
+ wSrc++;
+ }
+
+ *srcReadPtr = (char *) wSrc - (char *) wSrcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * UtfToUcs2beProc --
+ *
+ * Convert from UTF-8 to UCS-2BE.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+UtfToUcs2beProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* TableEncodingData that specifies encoding. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *srcStart, *srcEnd, *srcClose;
+ Tcl_UniChar *wDst, *wDstStart, *wDstEnd;
+ int result, numChars;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+ srcClose = srcEnd;
+ if ((flags & TCL_ENCODING_END) == 0) {
+ srcClose -= TCL_UTF_MAX;
+ }
+
+ wDst = (Tcl_UniChar *) dst;
+ wDstStart = (Tcl_UniChar *) dst;
+ wDstEnd = (Tcl_UniChar *) (dst + dstLen - sizeof(Tcl_UniChar));
+
+ result = TCL_OK;
+ for (numChars = 0; src < srcEnd; numChars++) {
+ if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+ /*
+ * If there is more string to follow, this will ensure that the
+ * last UTF-8 character in the source buffer hasn't been cut off.
+ */
+
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ if (wDst > wDstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ src += Tcl_UtfToUniChar(src, wDst);
+ /*
+ * Byte swap for little-endian machines.
+ */
+ *wDst = htons(*wDst);
+ wDst++;
+ }
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = (char *) wDst - (char *) wDstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetNativeFont --
+ *
+ * Map a platform-specific native font name to a TkFont.
+ *
+ * Results:
+ * The return value is a pointer to a TkFont that represents the
+ * native font. If a native font by the given name could not be
+ * found, the return value is NULL.
+ *
+ * Every call to this procedure returns a new TkFont structure,
+ * even if the name has already been seen before. The caller should
+ * call TkpDeleteFont() when the font is no longer needed.
+ *
+ * The caller is responsible for initializing the memory associated
+ * with the generic TkFont when this function returns and releasing
+ * the contents of the generic TkFont before calling TkpDeleteFont().
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkFont *
+TkpGetNativeFont(tkwin, name)
+ Tk_Window tkwin; /* For display where font will be used. */
+ CONST char *name; /* Platform-specific font name. */
+{
+ UnixFont *fontPtr;
+ XFontStruct *fontStructPtr;
+ FontAttributes fa;
+ CONST char *p;
+ int hasSpace, dashes, hasWild;
+
+ /*
+ * The behavior of X when given a name that isn't an XLFD is unspecified.
+ * For example, Exceed 6 returns a valid font for any random string. This
+ * is awkward since system names have higher priority than the other Tk
+ * font syntaxes. So, we need to perform a quick sanity check on the
+ * name and fail if it looks suspicious. We fail if the name:
+ * - contains a space immediately before a dash
+ * - contains a space, but no '*' characters and fewer than 14 dashes
+ */
+
+ hasSpace = dashes = hasWild = 0;
+ for (p = name; *p != '\0'; p++) {
+ if (*p == ' ') {
+ if (p[1] == '-') {
+ return NULL;
+ }
+ hasSpace = 1;
+ } else if (*p == '-') {
+ dashes++;
+ } else if (*p == '*') {
+ hasWild = 1;
+ }
+ }
+ if ((dashes < 14) && !hasWild && hasSpace) {
+ return NULL;
+ }
+
+ fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name);
+ if (fontStructPtr == NULL) {
+ /*
+ * Handle all names that look like XLFDs here. Otherwise, when
+ * TkpGetFontFromAttributes is called from generic code, any
+ * foundry or encoding information specified in the XLFD will have
+ * been parsed out and lost. But make sure we don't have an
+ * "-option value" string since TkFontParseXLFD would return a
+ * false success when attempting to parse it.
+ */
+
+ if (name[0] == '-') {
+ if (name[1] != '*') {
+ char *dash;
+
+ dash = strchr(name + 1, '-');
+ if ((dash == NULL) || (isspace(UCHAR(dash[-1])))) {
+ return NULL;
+ }
+ }
+ } else if (name[0] != '*') {
+ return NULL;
+ }
+ if (TkFontParseXLFD(name, &fa.fa, &fa.xa) != TCL_OK) {
+ return NULL;
+ }
+ fontStructPtr = CreateClosestFont(tkwin, &fa.fa, &fa.xa);
+ }
+ fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));
+ InitFont(tkwin, fontStructPtr, fontPtr);
+
+ return (TkFont *) fontPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFromAttributes --
+ *
+ * Given a desired set of attributes for a font, find a font with
+ * the closest matching attributes.
+ *
+ * Results:
+ * The return value is a pointer to a TkFont that represents the
+ * font with the desired attributes. If a font with the desired
+ * attributes could not be constructed, some other font will be
+ * substituted automatically.
+ *
+ * Every call to this procedure returns a new TkFont structure,
+ * even if the specified attributes have already been seen before.
+ * The caller should call TkpDeleteFont() to free the platform-
+ * specific data when the font is no longer needed.
+ *
+ * The caller is responsible for initializing the memory associated
+ * with the generic TkFont when this function returns and releasing
+ * the contents of the generic TkFont before calling TkpDeleteFont().
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+TkFont *
+TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
+ TkFont *tkFontPtr; /* If non-NULL, store the information in
+ * this existing TkFont structure, rather than
+ * allocating a new structure to hold the
+ * font; the existing contents of the font
+ * will be released. If NULL, a new TkFont
+ * structure is allocated. */
+ Tk_Window tkwin; /* For display where font will be used. */
+ CONST TkFontAttributes *faPtr;
+ /* Set of attributes to match. */
+{
+ UnixFont *fontPtr;
+ TkXLFDAttributes xa;
+ XFontStruct *fontStructPtr;
+
+ TkInitXLFDAttributes(&xa);
+ fontStructPtr = CreateClosestFont(tkwin, faPtr, &xa);
+
+ fontPtr = (UnixFont *) tkFontPtr;
+ if (fontPtr == NULL) {
+ fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));
+ } else {
+ ReleaseFont(fontPtr);
+ }
+ InitFont(tkwin, fontStructPtr, fontPtr);
+
+ fontPtr->font.fa.underline = faPtr->underline;
+ fontPtr->font.fa.overstrike = faPtr->overstrike;
+
+ return (TkFont *) fontPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpDeleteFont --
+ *
+ * Called to release a font allocated by TkpGetNativeFont() or
+ * TkpGetFontFromAttributes(). The caller should have already
+ * released the fields of the TkFont that are used exclusively by
+ * the generic TkFont code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * TkFont is deallocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkpDeleteFont(tkFontPtr)
+ TkFont *tkFontPtr; /* Token of font to be deleted. */
+{
+ UnixFont *fontPtr;
+
+ fontPtr = (UnixFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFamilies --
+ *
+ * Return information about the font families that are available
+ * on the display of the given window.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list of all the available
+ * font families.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkpGetFontFamilies(interp, tkwin)
+ Tcl_Interp *interp; /* Interp to hold result. */
+ Tk_Window tkwin; /* For display to query. */
+{
+ int i, new, numNames;
+ char *family;
+ Tcl_HashTable familyTable;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ char **nameList;
+ Tcl_Obj *resultPtr, *strPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+
+ Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS);
+ nameList = ListFonts(Tk_Display(tkwin), "*", &numNames);
+ for (i = 0; i < numNames; i++) {
+ family = strchr(nameList[i] + 1, '-') + 1;
+ strchr(family, '-')[0] = '\0';
+ Tcl_CreateHashEntry(&familyTable, family, &new);
+ }
+ XFreeFontNames(nameList);
+
+ hPtr = Tcl_FirstHashEntry(&familyTable, &search);
+ while (hPtr != NULL) {
+ strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&familyTable, hPtr), -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+
+ Tcl_DeleteHashTable(&familyTable);
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpGetSubFonts --
+ *
+ * A function used by the testing package for querying the actual
+ * screen fonts that make up a font object.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list containing the
+ * names of the screen fonts that make up the given font object.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpGetSubFonts(interp, tkfont)
+ Tcl_Interp *interp;
+ Tk_Font tkfont;
+{
+ int i;
+ Tcl_Obj *objv[3];
+ Tcl_Obj *resultPtr, *listPtr;
+ UnixFont *fontPtr;
+ FontFamily *familyPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ fontPtr = (UnixFont *) tkfont;
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ familyPtr = fontPtr->subFontArray[i].familyPtr;
+ objv[0] = Tcl_NewStringObj(familyPtr->faceName, -1);
+ objv[1] = Tcl_NewStringObj(familyPtr->foundry, -1);
+ objv[2] = Tcl_NewStringObj(Tcl_GetEncodingName(familyPtr->encoding), -1);
+ listPtr = Tcl_NewListObj(3, objv);
+ Tcl_ListObjAppendElement(NULL, resultPtr, listPtr);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_MeasureChars --
+ *
+ * Determine the number of characters from the string that will fit
+ * in the given horizontal span. The measurement is done under the
+ * assumption that Tk_DrawChars() will be used to actually display
+ * the characters.
+ *
+ * Results:
+ * The return value is the number of bytes from source that
+ * fit into the span that extends from 0 to maxLength. *lengthPtr is
+ * filled with the x-coordinate of the right edge of the last
+ * character that did fit.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_MeasureChars(tkfont, source, numBytes, maxLength, flags, lengthPtr)
+ Tk_Font tkfont; /* Font in which characters will be drawn. */
+ CONST char *source; /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. */
+ int numBytes; /* Maximum number of bytes to consider
+ * from source string. */
+ int maxLength; /* If >= 0, maxLength specifies the longest
+ * permissible line length in pixels; don't
+ * consider any character that would cross
+ * this x-position. If < 0, then line length
+ * is unbounded and the flags argument is
+ * ignored. */
+ int flags; /* Various flag bits OR-ed together:
+ * TK_PARTIAL_OK means include the last char
+ * which only partially fit on this line.
+ * TK_WHOLE_WORDS means stop on a word
+ * boundary, if possible.
+ * TK_AT_LEAST_ONE means return at least one
+ * character even if no characters fit. */
+ int *lengthPtr; /* Filled with x-location just after the
+ * terminating character. */
+{
+ UnixFont *fontPtr;
+ SubFont *lastSubFontPtr;
+ int curX, curByte;
+
+ /*
+ * Unix does not use kerning or fractional character widths when
+ * displaying text on the screen. So that means we can safely measure
+ * individual characters or spans of characters and add up the widths
+ * w/o any "off-by-one-pixel" errors.
+ */
+
+ fontPtr = (UnixFont *) tkfont;
+
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+
+ if (numBytes == 0) {
+ curX = 0;
+ curByte = 0;
+ } else if (maxLength < 0) {
+ CONST char *p, *end, *next;
+ Tcl_UniChar ch;
+ SubFont *thisSubFontPtr;
+ FontFamily *familyPtr;
+ Tcl_DString runString;
+
+ /*
+ * A three step process:
+ * 1. Find a contiguous range of characters that can all be
+ * represented by a single screen font.
+ * 2. Convert those chars to the encoding of that font.
+ * 3. Measure converted chars.
+ */
+
+ curX = 0;
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ if (familyPtr->isTwoByteFont) {
+ curX += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) / 2);
+ } else {
+ curX += XTextWidth(lastSubFontPtr->fontStructPtr,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ }
+ Tcl_DStringFree(&runString);
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+ }
+ p = next;
+ }
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
+ &runString);
+ if (familyPtr->isTwoByteFont) {
+ curX += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> 1);
+ } else {
+ curX += XTextWidth(lastSubFontPtr->fontStructPtr,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ }
+ Tcl_DStringFree(&runString);
+ curByte = numBytes;
+ } else {
+ CONST char *p, *end, *next, *term;
+ int newX, termX, sawNonSpace, dstWrote;
+ Tcl_UniChar ch;
+ FontFamily *familyPtr;
+ char buf[16];
+
+ /*
+ * How many chars will fit in the space allotted?
+ * This first version may be inefficient because it measures
+ * every character individually.
+ */
+
+ next = source + Tcl_UtfToUniChar(source, &ch);
+ newX = curX = termX = 0;
+
+ term = source;
+ end = source + numBytes;
+
+ sawNonSpace = (ch > 255) || !isspace(ch);
+ familyPtr = lastSubFontPtr->familyPtr;
+ for (p = source; ; ) {
+ if ((ch < BASE_CHARS) && (fontPtr->widths[ch] != 0)) {
+ newX += fontPtr->widths[ch];
+ } else {
+ lastSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p,
+ 0, NULL, buf, sizeof(buf), NULL, &dstWrote, NULL);
+ if (familyPtr->isTwoByteFont) {
+ newX += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) buf, dstWrote >> 1);
+ } else {
+ newX += XTextWidth(lastSubFontPtr->fontStructPtr, buf,
+ dstWrote);
+ }
+ }
+ if (newX > maxLength) {
+ break;
+ }
+ curX = newX;
+ p = next;
+ if (p >= end) {
+ term = end;
+ termX = curX;
+ break;
+ }
+
+ next += Tcl_UtfToUniChar(next, &ch);
+ if ((ch < 256) && isspace(ch)) {
+ if (sawNonSpace) {
+ term = p;
+ termX = curX;
+ sawNonSpace = 0;
+ }
+ } else {
+ sawNonSpace = 1;
+ }
+ }
+
+ /*
+ * 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 & TK_PARTIAL_OK) && (p < end) && (curX < maxLength)) {
+ /*
+ * Include the first character that didn't quite fit in the desired
+ * span. The width returned will include the width of that extra
+ * character.
+ */
+
+ curX = newX;
+ p += Tcl_UtfToUniChar(p, &ch);
+ }
+ if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) {
+ term = p;
+ termX = curX;
+ if (term == source) {
+ term += Tcl_UtfToUniChar(term, &ch);
+ termX = newX;
+ }
+ } else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) {
+ term = p;
+ termX = curX;
+ }
+
+ curX = termX;
+ curByte = term - source;
+ }
+
+ *lengthPtr = curX;
+ return curByte;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawChars --
+ *
+ * Draw a string of characters on the screen. Tk_DrawChars()
+ * expands control characters that occur in the string to
+ * \xNN sequences.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawChars(display, drawable, gc, tkfont, source, numBytes, x, y)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context for drawing characters. */
+ Tk_Font tkfont; /* Font in which characters will be drawn;
+ * must be the same as font used in GC. */
+ CONST char *source; /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. All Tk meta-characters
+ * (tabs, control characters, and newlines)
+ * should be stripped out of the string that
+ * is passed to this function. If they are
+ * not stripped out, they will be displayed as
+ * regular printing characters. */
+ int numBytes; /* Number of bytes in string. */
+ int x, y; /* Coordinates at which to place origin of
+ * string when drawing. */
+{
+ UnixFont *fontPtr;
+ SubFont *thisSubFontPtr, *lastSubFontPtr;
+ Tcl_DString runString;
+ CONST char *p, *end, *next;
+ int xStart, needWidth, window_width;
+ Tcl_UniChar ch;
+ FontFamily *familyPtr;
+ int rx, ry;
+ unsigned int width, height, border_width, depth;
+ int do_width;
+ Drawable root;
+
+ fontPtr = (UnixFont *) tkfont;
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+
+ xStart = x;
+
+ /*
+ * Get the window width so we can abort drawing outside of the window
+ */
+ if (XGetGeometry(display, drawable, &root, &rx, &ry, &width, &height,
+ &border_width, &depth) == False) {
+ window_width = INT_MAX;
+ } else {
+ window_width = width;
+ }
+
+ end = source + numBytes;
+ needWidth = fontPtr->font.fa.underline + fontPtr->font.fa.overstrike;
+ for (p = source; p <= end; ) {
+ if (p < end) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ } else {
+ next = p + 1;
+ thisSubFontPtr = lastSubFontPtr;
+ }
+ if ((thisSubFontPtr != lastSubFontPtr)
+ || (p == end) || (p-source > 200)) {
+ if (p > source) {
+ do_width = (needWidth || (p != end)) ? 1 : 0;
+ familyPtr = lastSubFontPtr->familyPtr;
+
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ if (familyPtr->isTwoByteFont) {
+ XDrawString16(display, drawable, gc, x, y,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) / 2);
+ if (do_width) {
+ x += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) / 2);
+ }
+ } else {
+ XDrawString(display, drawable, gc, x, y,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ if (do_width) {
+ x += XTextWidth(lastSubFontPtr->fontStructPtr,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ }
+ }
+ Tcl_DStringFree(&runString);
+ }
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+ XSetFont(display, gc, lastSubFontPtr->fontStructPtr->fid);
+ if (x > window_width) {
+ break;
+ }
+ }
+ p = next;
+ }
+
+ if (lastSubFontPtr != &fontPtr->subFontArray[0]) {
+ XSetFont(display, gc, fontPtr->subFontArray[0].fontStructPtr->fid);
+ }
+
+ if (fontPtr->font.fa.underline != 0) {
+ XFillRectangle(display, drawable, gc, xStart,
+ y + fontPtr->underlinePos,
+ (unsigned) (x - xStart), (unsigned) fontPtr->barHeight);
+ }
+ if (fontPtr->font.fa.overstrike != 0) {
+ y -= fontPtr->font.fm.descent + (fontPtr->font.fm.ascent) / 10;
+ XFillRectangle(display, drawable, gc, xStart, y,
+ (unsigned) (x - xStart), (unsigned) fontPtr->barHeight);
+ }
+}
+
+
+
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CreateClosestFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Given a set of font attributes, construct a close XFontStruct.
+ * If requested face name is not available, automatically
+ * substitutes an alias for requested face name. If encoding is
+ * not specified (or the requested one is not available),
+ * automatically chooses another encoding from the list of
+ * preferred encodings. If the foundry is not specified (or
+ * is not available) automatically prefers "adobe" foundry.
+ * For all other attributes, if the requested value was not
+ * available, the appropriate "close" value will be used.
+ *
+ * Results:
+ * Return value is the XFontStruct that best matched the
+ * requested attributes. The return value is never NULL; some
+ * font will always be returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static XFontStruct *
+CreateClosestFont(tkwin, faPtr, xaPtr)
+ Tk_Window tkwin; /* For display where font will be used. */
+ CONST TkFontAttributes *faPtr;
+ /* Set of generic attributes to match. */
+ CONST TkXLFDAttributes *xaPtr;
+ /* Set of X-specific attributes to match. */
+{
+ FontAttributes want;
+ char **nameList;
+ int numNames, nameIdx;
+ Display *display;
+ XFontStruct *fontStructPtr;
+ int bestIdx[2];
+ unsigned int bestScore[2];
+
+ want.fa = *faPtr;
+ want.xa = *xaPtr;
+
+ if (want.xa.foundry == NULL) {
+ want.xa.foundry = Tk_GetUid("adobe");
+ }
+ if (want.fa.family == NULL) {
+ want.fa.family = Tk_GetUid("fixed");
+ }
+ want.fa.size = -TkFontGetPixels(tkwin, faPtr->size);
+ if (want.xa.charset == NULL || *want.xa.charset == '\0') {
+ want.xa.charset = Tk_GetUid("iso8859-1"); /* locale. */
+ }
+
+ display = Tk_Display(tkwin);
+
+ /*
+ * Algorithm to get the closest font to the name requested.
+ *
+ * try fontname
+ * try all aliases for fontname
+ * foreach fallback for fontname
+ * try the fallback
+ * try all aliases for the fallback
+ */
+
+ nameList = ListFontOrAlias(display, want.fa.family, &numNames);
+ if (numNames == 0) {
+ char ***fontFallbacks;
+ int i, j;
+ char *fallback;
+
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(want.fa.family, fallback) == 0) {
+ break;
+ }
+ }
+ if (fallback != NULL) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ nameList = ListFontOrAlias(display, fallback, &numNames);
+ if (numNames != 0) {
+ goto found;
+ }
+ }
+ }
+ }
+ nameList = ListFonts(display, "fixed", &numNames);
+ if (numNames == 0) {
+ nameList = ListFonts(display, "*", &numNames);
+ }
+ if (numNames == 0) {
+ return GetSystemFont(display);
+ }
+ }
+ found:
+ bestIdx[0] = -1;
+ bestIdx[1] = -1;
+ bestScore[0] = (unsigned int) -1;
+ bestScore[1] = (unsigned int) -1;
+ for (nameIdx = 0; nameIdx < numNames; nameIdx++) {
+ FontAttributes got;
+ int scalable;
+ unsigned int score;
+
+ if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) {
+ continue;
+ }
+ IdentifySymbolEncodings(&got);
+ scalable = (got.fa.size == 0);
+ score = RankAttributes(&want, &got);
+ if (score <= bestScore[scalable]) {
+ bestIdx[scalable] = nameIdx;
+ bestScore[scalable] = score;
+ }
+ if (score == 0) {
+ break;
+ }
+ }
+
+ fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore);
+ XFreeFontNames(nameList);
+
+ if (fontStructPtr == NULL) {
+ return GetSystemFont(display);
+ }
+ return fontStructPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Initializes the memory for a new UnixFont that wraps the
+ * platform-specific data.
+ *
+ * The caller is responsible for initializing the fields of the
+ * TkFont that are used exclusively by the generic TkFont code, and
+ * for releasing those fields before calling TkpDeleteFont().
+ *
+ * Results:
+ * Fills the WinFont structure.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitFont(tkwin, fontStructPtr, fontPtr)
+ Tk_Window tkwin; /* For screen where font will be used. */
+ XFontStruct *fontStructPtr; /* X information about font. */
+ UnixFont *fontPtr; /* Filled with information constructed from
+ * the above arguments. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ unsigned long value;
+ int minHi, maxHi, minLo, maxLo, fixed, width, limit, i, n;
+ FontAttributes fa;
+ TkFontAttributes *faPtr;
+ TkFontMetrics *fmPtr;
+ SubFont *controlPtr, *subFontPtr;
+ char *pageMap;
+ Display *display;
+
+ /*
+ * Get all font attributes and metrics.
+ */
+
+ display = Tk_Display(tkwin);
+ GetFontAttributes(display, fontStructPtr, &fa);
+
+ minHi = fontStructPtr->min_byte1;
+ maxHi = fontStructPtr->max_byte1;
+ minLo = fontStructPtr->min_char_or_byte2;
+ maxLo = fontStructPtr->max_char_or_byte2;
+
+ fixed = 1;
+ if (fontStructPtr->per_char != NULL) {
+ width = 0;
+ limit = (maxHi - minHi + 1) * (maxLo - minLo + 1);
+ for (i = 0; i < limit; i++) {
+ n = fontStructPtr->per_char[i].width;
+ if (n != 0) {
+ if (width == 0) {
+ width = n;
+ } else if (width != n) {
+ fixed = 0;
+ break;
+ }
+ }
+ }
+ }
+
+ fontPtr->font.fid = fontStructPtr->fid;
+
+ faPtr = &fontPtr->font.fa;
+ faPtr->family = fa.fa.family;
+ faPtr->size = TkFontGetPoints(tkwin, fa.fa.size);
+ faPtr->weight = fa.fa.weight;
+ faPtr->slant = fa.fa.slant;
+ faPtr->underline = 0;
+ faPtr->overstrike = 0;
+
+ fmPtr = &fontPtr->font.fm;
+ fmPtr->ascent = fontStructPtr->ascent;
+ fmPtr->descent = fontStructPtr->descent;
+ fmPtr->maxWidth = fontStructPtr->max_bounds.width;
+ fmPtr->fixed = fixed;
+
+ fontPtr->display = display;
+ fontPtr->pixelSize = TkFontGetPixels(tkwin, fa.fa.size);
+ fontPtr->xa = fa.xa;
+
+ fontPtr->numSubFonts = 1;
+ fontPtr->subFontArray = fontPtr->staticSubFonts;
+ InitSubFont(display, fontStructPtr, 1, &fontPtr->subFontArray[0]);
+
+ fontPtr->controlSubFont = fontPtr->subFontArray[0];
+ subFontPtr = FindSubFontForChar(fontPtr, '0');
+ controlPtr = &fontPtr->controlSubFont;
+ controlPtr->fontStructPtr = subFontPtr->fontStructPtr;
+ controlPtr->familyPtr = &tsdPtr->controlFamily;
+ controlPtr->fontMap = tsdPtr->controlFamily.fontMap;
+
+ pageMap = fontPtr->subFontArray[0].fontMap[0];
+ for (i = 0; i < 256; i++) {
+ if ((minHi > 0) || (i < minLo) || (i > maxLo) ||
+ (((pageMap[i >> 3] >> (i & 7)) & 1) == 0)) {
+ n = 0;
+ } else if (fontStructPtr->per_char == NULL) {
+ n = fontStructPtr->max_bounds.width;
+ } else {
+ n = fontStructPtr->per_char[i - minLo].width;
+ }
+ fontPtr->widths[i] = n;
+ }
+
+
+ if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_POSITION, &value)) {
+ fontPtr->underlinePos = value;
+ } else {
+ /*
+ * If the XA_UNDERLINE_POSITION property does not exist, the X
+ * manual recommends using the following value:
+ */
+
+ fontPtr->underlinePos = fontStructPtr->descent / 2;
+ }
+ fontPtr->barHeight = 0;
+ if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_THICKNESS, &value)) {
+ fontPtr->barHeight = value;
+ }
+ if (fontPtr->barHeight == 0) {
+ /*
+ * If the XA_UNDERLINE_THICKNESS property does not exist, the X
+ * manual recommends using the width of the stem on a capital
+ * letter. I don't know of a way to get the stem width of a letter,
+ * so guess and use 1/3 the width of a capital I.
+ */
+
+ fontPtr->barHeight = fontPtr->widths['I'] / 3;
+ if (fontPtr->barHeight == 0) {
+ fontPtr->barHeight = 1;
+ }
+ }
+ if (fontPtr->underlinePos + fontPtr->barHeight > fontStructPtr->descent) {
+ /*
+ * If this set of cobbled together values would cause the bottom of
+ * the underline bar to stick below the descent of the font, jack
+ * the underline up a bit higher.
+ */
+
+ fontPtr->barHeight = fontStructPtr->descent - fontPtr->underlinePos;
+ if (fontPtr->barHeight == 0) {
+ fontPtr->underlinePos--;
+ fontPtr->barHeight = 1;
+ }
+ }
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseFont --
+ *
+ * Called to release the unix-specific contents of a TkFont.
+ * The caller is responsible for freeing the memory used by the
+ * font itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseFont(fontPtr)
+ UnixFont *fontPtr; /* The font to delete. */
+{
+ int i;
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ ReleaseSubFont(fontPtr->display, &fontPtr->subFontArray[i]);
+ }
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * InitSubFont --
+ *
+ * Wrap a screen font and load the FontFamily that represents
+ * it. Used to prepare a SubFont so that characters can be mapped
+ * from UTF-8 to the charset of the font.
+ *
+ * Results:
+ * The subFontPtr is filled with information about the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+InitSubFont(display, fontStructPtr, base, subFontPtr)
+ Display *display; /* Display in which font will be used. */
+ XFontStruct *fontStructPtr; /* The screen font. */
+ int base; /* Non-zero if this SubFont is being used
+ * as the base font for a font object. */
+ SubFont *subFontPtr; /* Filled with SubFont constructed from
+ * above attributes. */
+{
+ subFontPtr->fontStructPtr = fontStructPtr;
+ subFontPtr->familyPtr = AllocFontFamily(display, fontStructPtr, base);
+ subFontPtr->fontMap = subFontPtr->familyPtr->fontMap;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseSubFont --
+ *
+ * Called to release the contents of a SubFont. The caller is
+ * responsible for freeing the memory used by the SubFont itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and resources are freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseSubFont(display, subFontPtr)
+ Display *display; /* Display which owns screen font. */
+ SubFont *subFontPtr; /* The SubFont to delete. */
+{
+ XFreeFont(display, subFontPtr->fontStructPtr);
+ FreeFontFamily(subFontPtr->familyPtr);
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * AllocFontFamily --
+ *
+ * Find the FontFamily structure associated with the given font
+ * name. The information should be stored by the caller in a
+ * SubFont and used when determining if that SubFont supports a
+ * character.
+ *
+ * Cannot use the string name used to construct the font as the
+ * key, because the capitalization may not be canonical. Therefore
+ * use the face name actually retrieved from the font metrics as
+ * the key.
+ *
+ * Results:
+ * A pointer to a FontFamily. The reference count in the FontFamily
+ * is automatically incremented. When the SubFont is released, the
+ * reference count is decremented. When no SubFont is using this
+ * FontFamily, it may be deleted.
+ *
+ * Side effects:
+ * A new FontFamily structure will be allocated if this font family
+ * has not been seen. TrueType character existence metrics are
+ * loaded into the FontFamily structure.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static FontFamily *
+AllocFontFamily(display, fontStructPtr, base)
+ Display *display; /* Display in which font will be used. */
+ XFontStruct *fontStructPtr; /* Screen font whose FontFamily is to be
+ * returned. */
+ int base; /* Non-zero if this font family is to be
+ * used in the base font of a font object. */
+{
+ FontFamily *familyPtr;
+ FontAttributes fa;
+ Tcl_Encoding encoding;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ GetFontAttributes(display, fontStructPtr, &fa);
+ encoding = Tcl_GetEncoding(NULL, GetEncodingAlias(fa.xa.charset));
+
+ familyPtr = tsdPtr->fontFamilyList;
+ for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
+ if ((familyPtr->faceName == fa.fa.family)
+ && (familyPtr->foundry == fa.xa.foundry)
+ && (familyPtr->encoding == encoding)) {
+ Tcl_FreeEncoding(encoding);
+ familyPtr->refCount++;
+ return familyPtr;
+ }
+ }
+
+ familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
+ memset(familyPtr, 0, sizeof(FontFamily));
+ familyPtr->nextPtr = tsdPtr->fontFamilyList;
+ tsdPtr->fontFamilyList = familyPtr;
+
+ /*
+ * Set key for this FontFamily.
+ */
+
+ familyPtr->foundry = fa.xa.foundry;
+ familyPtr->faceName = fa.fa.family;
+ familyPtr->encoding = encoding;
+
+ /*
+ * An initial refCount of 2 means that FontFamily information will
+ * persist even when the SubFont that loaded the FontFamily is released.
+ * Change it to 1 to cause FontFamilies to be unloaded when not in use.
+ */
+
+ familyPtr->refCount = 2;
+
+ /*
+ * One byte/character fonts have both min_byte1 and max_byte1 0,
+ * and max_char_or_byte2 <= 255.
+ * Anything else specifies a two byte/character font.
+ */
+
+ familyPtr->isTwoByteFont = !(
+ (fontStructPtr->min_byte1 == 0) &&
+ (fontStructPtr->max_byte1 == 0) &&
+ (fontStructPtr->max_char_or_byte2 < 256));
+ return familyPtr;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FreeFontFamily --
+ *
+ * Called to free an FontFamily when the SubFont is finished using
+ * it. Frees the contents of the FontFamily and the memory used by
+ * the FontFamily itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FreeFontFamily(familyPtr)
+ FontFamily *familyPtr; /* The FontFamily to delete. */
+{
+ FontFamily **familyPtrPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int i;
+
+ if (familyPtr == NULL) {
+ return;
+ }
+ familyPtr->refCount--;
+ if (familyPtr->refCount > 0) {
+ return;
+ }
+ Tcl_FreeEncoding(familyPtr->encoding);
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree(familyPtr->fontMap[i]);
+ }
+ }
+
+ /*
+ * Delete from list.
+ */
+
+ for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) {
+ if (*familyPtrPtr == familyPtr) {
+ *familyPtrPtr = familyPtr->nextPtr;
+ break;
+ }
+ familyPtrPtr = &(*familyPtrPtr)->nextPtr;
+ }
+
+ ckfree((char *) familyPtr);
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FindSubFontForChar --
+ *
+ * Determine which screen font is necessary to use to
+ * display the given character. If the font object does not have
+ * a screen font that can display the character, another screen font
+ * may be loaded into the font object, following a set of preferred
+ * fallback rules.
+ *
+ * Results:
+ * The return value is the SubFont to use to display the given
+ * character.
+ *
+ * Side effects:
+ * The contents of fontPtr are modified to cache the results
+ * of the lookup and remember any SubFonts that were dynamically
+ * loaded.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+FindSubFontForChar(fontPtr, ch)
+ UnixFont *fontPtr; /* The font object with which the character
+ * will be displayed. */
+ int ch; /* The Unicode character to be displayed. */
+{
+ int i, j, k, numNames;
+ Tk_Uid faceName;
+ char *fallback;
+ char **aliases, **nameList, **anyFallbacks;
+ char ***fontFallbacks;
+ SubFont *subFontPtr;
+ Tcl_DString ds;
+
+ if (FontMapLookup(&fontPtr->subFontArray[0], ch)) {
+ return &fontPtr->subFontArray[0];
+ }
+
+ for (i = 1; i < fontPtr->numSubFonts; i++) {
+ if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
+ return &fontPtr->subFontArray[i];
+ }
+ }
+
+ if (FontMapLookup(&fontPtr->controlSubFont, ch)) {
+ return &fontPtr->controlSubFont;
+ }
+
+ /*
+ * Keep track of all face names that we check, so we don't check some
+ * name multiple times if it can be reached by multiple paths.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ /*
+ * Are there any other fonts with the same face name as the base
+ * font that could display this character, e.g., if the base font
+ * is adobe:fixed:iso8859-1, we could might be able to use
+ * misc:fixed:iso8859-8 or sony:fixed:jisx0208.1983-0
+ */
+
+ faceName = fontPtr->font.fa.family;
+ if (SeenName(faceName, &ds) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ aliases = TkFontGetAliasList(faceName);
+
+ subFontPtr = NULL;
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(fallback, faceName) == 0) {
+ /*
+ * If the base font has a fallback...
+ */
+
+ goto tryfallbacks;
+ } else if (aliases != NULL) {
+ /*
+ * Or if an alias for the base font has a fallback...
+ */
+
+ for (k = 0; aliases[k] != NULL; k++) {
+ if (strcasecmp(fallback, aliases[k]) == 0) {
+ goto tryfallbacks;
+ }
+ }
+ }
+ }
+ continue;
+
+ tryfallbacks:
+
+ /*
+ * ...then see if we can use one of the fallbacks, or an
+ * alias for one of the fallbacks.
+ */
+
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ /*
+ * See if we can use something from the global fallback list.
+ */
+
+ anyFallbacks = TkFontGetGlobalClass();
+ for (i = 0; (fallback = anyFallbacks[i]) != NULL; i++) {
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * Try all face names available in the whole system until we
+ * find one that can be used.
+ */
+
+ nameList = ListFonts(fontPtr->display, "*", &numNames);
+ for (i = 0; i < numNames; i++) {
+ fallback = strchr(nameList[i] + 1, '-') + 1;
+ strchr(fallback, '-')[0] = '\0';
+ if (SeenName(fallback, &ds) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, fallback, ch);
+ if (subFontPtr != NULL) {
+ XFreeFontNames(nameList);
+ goto end;
+ }
+ }
+ }
+ XFreeFontNames(nameList);
+
+ end:
+ Tcl_DStringFree(&ds);
+
+ if (subFontPtr == NULL) {
+ /*
+ * No font can display this character, so it will be displayed as a
+ * control character expansion.
+ */
+
+ subFontPtr = &fontPtr->controlSubFont;
+ FontMapInsert(subFontPtr, ch);
+ }
+ return subFontPtr;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLookup --
+ *
+ * See if the screen font can display the given character.
+ *
+ * Results:
+ * The return value is 0 if the screen font cannot display the
+ * character, non-zero otherwise.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FontMapLookup(subFontPtr, ch)
+ SubFont *subFontPtr; /* Contains font mapping cache to be queried
+ * and possibly updated. */
+ int ch; /* Character to be tested. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapInsert --
+ *
+ * Tell the font mapping cache that the given screen font should be
+ * used to display the specified character. This is called when no
+ * font on the system can be be found that can display that
+ * character; we lie to the font and tell it that it can display
+ * the character, otherwise we would end up re-searching the entire
+ * fallback hierarchy every time that character was seen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontMapInsert(subFontPtr, ch)
+ SubFont *subFontPtr; /* Contains font mapping cache to be
+ * updated. */
+ int ch; /* Character to be added to cache. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLoadPage --
+ *
+ * Load information about all the characters on a given page.
+ * This information consists of one bit per character that indicates
+ * whether the associated screen font can (1) or cannot (0) display
+ * the characters on the page.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mempry allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+FontMapLoadPage(subFontPtr, row)
+ SubFont *subFontPtr; /* Contains font mapping cache to be
+ * updated. */
+ int row; /* Index of the page to be loaded into
+ * the cache. */
+{
+ char src[TCL_UTF_MAX], buf[16];
+ int minHi, maxHi, minLo, maxLo, scale, checkLo;
+ int i, end, bitOffset, isTwoByteFont, n;
+ Tcl_Encoding encoding;
+ XFontStruct *fontStructPtr;
+ XCharStruct *widths;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
+
+ if (subFontPtr->familyPtr == &tsdPtr->controlFamily) {
+ return;
+ }
+
+ fontStructPtr = subFontPtr->fontStructPtr;
+ encoding = subFontPtr->familyPtr->encoding;
+ isTwoByteFont = subFontPtr->familyPtr->isTwoByteFont;
+
+ widths = fontStructPtr->per_char;
+ minHi = fontStructPtr->min_byte1;
+ maxHi = fontStructPtr->max_byte1;
+ minLo = fontStructPtr->min_char_or_byte2;
+ maxLo = fontStructPtr->max_char_or_byte2;
+ scale = maxLo - minLo + 1;
+ checkLo = minLo;
+
+ if (! isTwoByteFont) {
+ if (minLo < 32) {
+ checkLo = 32;
+ }
+ }
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ int hi, lo;
+
+ if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src),
+ TCL_ENCODING_STOPONERROR, NULL, buf, sizeof(buf), NULL,
+ NULL, NULL) != TCL_OK) {
+ continue;
+ }
+ if (isTwoByteFont) {
+ hi = ((unsigned char *) buf)[0];
+ lo = ((unsigned char *) buf)[1];
+ } else {
+ hi = 0;
+ lo = ((unsigned char *) buf)[0];
+ }
+ if ((hi < minHi) || (hi > maxHi) || (lo < checkLo) || (lo > maxLo)) {
+ continue;
+ }
+ n = (hi - minHi) * scale + lo - minLo;
+ if ((widths == NULL) || ((widths[n].width + widths[n].rbearing) != 0)) {
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanUseFallbackWithAliases --
+ *
+ * Helper function for FindSubFontForChar. Determine if the
+ * specified face name (or an alias of the specified face name)
+ * can be used to construct a screen font that can display the
+ * given character.
+ *
+ * Results:
+ * See CanUseFallback().
+ *
+ * Side effects:
+ * If the name and/or one of its aliases was rejected, the
+ * rejected string is recorded in nameTriedPtr so that it won't
+ * be tried again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallbackWithAliases(fontPtr, faceName, ch, nameTriedPtr)
+ UnixFont *fontPtr; /* The font object that will own the new
+ * screen font. */
+ char *faceName; /* Desired face name for new screen font. */
+ int ch; /* The Unicode character that the new
+ * screen font must be able to display. */
+ Tcl_DString *nameTriedPtr; /* Records face names that have already
+ * been tried. It is possible for the same
+ * face name to be queried multiple times when
+ * trying to find a suitable screen font. */
+{
+ SubFont *subFontPtr;
+ char **aliases;
+ int i;
+
+ if (SeenName(faceName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (SeenName(aliases[i], nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, aliases[i], ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SeenName --
+ *
+ * Used to determine we have already tried and rejected the given
+ * face name when looking for a screen font that can support some
+ * Unicode character.
+ *
+ * Results:
+ * The return value is 0 if this face name has not already been seen,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SeenName(name, dsPtr)
+ CONST char *name; /* The name to check. */
+ Tcl_DString *dsPtr; /* Contains names that have already been
+ * seen. */
+{
+ CONST char *seen, *end;
+
+ seen = Tcl_DStringValue(dsPtr);
+ end = seen + Tcl_DStringLength(dsPtr);
+ while (seen < end) {
+ if (strcasecmp(seen, name) == 0) {
+ return 1;
+ }
+ seen += strlen(seen) + 1;
+ }
+ Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ return 0;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanUseFallback --
+ *
+ * If the specified screen font has not already been loaded
+ * into the font object, determine if the specified screen
+ * font can display the given character.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated SubFont,
+ * owned by the font object. This SubFont can be used to display
+ * the given character. The SubFont represents the screen font
+ * with the base set of font attributes from the font object, but
+ * using the specified face name. NULL is returned if the font
+ * object already holds a reference to the specified font or if
+ * the specified font doesn't exist or cannot display the given
+ * character.
+ *
+ * Side effects:
+ * The font object's subFontArray is updated to contain a reference
+ * to the newly allocated SubFont.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallback(fontPtr, faceName, ch)
+ UnixFont *fontPtr; /* The font object that will own the new
+ * screen font. */
+ CONST char *faceName; /* Desired face name for new screen font. */
+ int ch; /* The Unicode character that the new
+ * screen font must be able to display. */
+{
+ int i, nameIdx, numNames, srcLen;
+ Tk_Uid hateFoundry;
+ int bestIdx[2];
+ CONST char *charset, *hateCharset;
+ unsigned int bestScore[2];
+ char **nameList, **nameListOrig;
+ FontAttributes want, got;
+ char src[TCL_UTF_MAX];
+ Display *display;
+ SubFont subFont;
+ XFontStruct *fontStructPtr;
+ Tcl_DString dsEncodings;
+ int numEncodings;
+ Tcl_Encoding *encodingCachePtr;
+
+ /*
+ * Assume: the face name is times.
+ * Assume: adobe:times:iso8859-1 has already been used.
+ *
+ * Are there any versions of times that can display this
+ * character (e.g., perhaps linotype:times:iso8859-2)?
+ * a. Get list of all times fonts.
+ * b1. Cross out all names whose encodings we've already used.
+ * b2. Cross out all names whose foundry & encoding we've already seen.
+ * c. Cross out all names whose encoding cannot handle the character.
+ * d. Rank each name and pick the best match.
+ * e. If that font cannot actually display the character, cross
+ * out all names with the same foundry and encoding and go
+ * back to (c).
+ */
+
+ display = fontPtr->display;
+ nameList = ListFonts(display, faceName, &numNames);
+ if (numNames == 0) {
+ return NULL;
+ }
+ nameListOrig = nameList;
+
+ srcLen = Tcl_UniCharToUtf(ch, src);
+
+ want.fa = fontPtr->font.fa;
+ want.xa = fontPtr->xa;
+
+ want.fa.family = Tk_GetUid(faceName);
+ want.fa.size = -fontPtr->pixelSize;
+
+ hateFoundry = NULL;
+ hateCharset = NULL;
+ numEncodings = 0;
+ Tcl_DStringInit(&dsEncodings);
+
+ charset = NULL; /* lint, since numNames must be > 0 to get here. */
+
+ retry:
+ bestIdx[0] = -1;
+ bestIdx[1] = -1;
+ bestScore[0] = (unsigned int) -1;
+ bestScore[1] = (unsigned int) -1;
+ for (nameIdx = 0; nameIdx < numNames; nameIdx++) {
+ Tcl_Encoding encoding;
+ char dst[16];
+ int scalable, srcRead, dstWrote;
+ unsigned int score;
+
+ if (nameList[nameIdx] == NULL) {
+ continue;
+ }
+ if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) {
+ goto crossout;
+ }
+ IdentifySymbolEncodings(&got);
+ charset = GetEncodingAlias(got.xa.charset);
+ if (hateFoundry != NULL) {
+ /*
+ * E. If the font we picked cannot actually display the
+ * character, cross out all names with the same foundry and
+ * encoding.
+ */
+
+ if ((hateFoundry == got.xa.foundry)
+ && (strcmp(hateCharset, charset) == 0)) {
+ goto crossout;
+ }
+ } else {
+ /*
+ * B. Cross out all names whose encodings we've already used.
+ */
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ encoding = fontPtr->subFontArray[i].familyPtr->encoding;
+ if (strcmp(charset, Tcl_GetEncodingName(encoding)) == 0) {
+ goto crossout;
+ }
+ }
+ }
+
+ /*
+ * C. Cross out all names whose encoding cannot handle the character.
+ */
+
+ encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings);
+ for (i = numEncodings; --i >= 0; encodingCachePtr++) {
+ encoding = *encodingCachePtr;
+ if (strcmp(Tcl_GetEncodingName(encoding), charset) == 0) {
+ break;
+ }
+ }
+ if (i < 0) {
+ encoding = Tcl_GetEncoding(NULL, charset);
+ if (encoding == NULL) {
+ goto crossout;
+ }
+
+ Tcl_DStringAppend(&dsEncodings, (char *) &encoding,
+ sizeof(encoding));
+ numEncodings++;
+ }
+ Tcl_UtfToExternal(NULL, encoding, src, srcLen,
+ TCL_ENCODING_STOPONERROR, NULL, dst, sizeof(dst), &srcRead,
+ &dstWrote, NULL);
+ if (dstWrote == 0) {
+ goto crossout;
+ }
+
+ /*
+ * D. Rank each name and pick the best match.
+ */
+
+ scalable = (got.fa.size == 0);
+ score = RankAttributes(&want, &got);
+ if (score <= bestScore[scalable]) {
+ bestIdx[scalable] = nameIdx;
+ bestScore[scalable] = score;
+ }
+ if (score == 0) {
+ break;
+ }
+ continue;
+
+ crossout:
+ if (nameList == nameListOrig) {
+ /*
+ * Not allowed to change pointers to memory that X gives you,
+ * so make a copy.
+ */
+
+ nameList = (char **) ckalloc(numNames * sizeof(char *));
+ memcpy(nameList, nameListOrig, numNames * sizeof(char *));
+ }
+ nameList[nameIdx] = NULL;
+ }
+
+ fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore);
+
+ encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings);
+ for (i = numEncodings; --i >= 0; encodingCachePtr++) {
+ Tcl_FreeEncoding(*encodingCachePtr);
+ }
+ Tcl_DStringFree(&dsEncodings);
+ numEncodings = 0;
+
+ if (fontStructPtr == NULL) {
+ if (nameList != nameListOrig) {
+ ckfree((char *) nameList);
+ }
+ XFreeFontNames(nameListOrig);
+ return NULL;
+ }
+
+ InitSubFont(display, fontStructPtr, 0, &subFont);
+ if (FontMapLookup(&subFont, ch) == 0) {
+ /*
+ * E. If the font we picked cannot actually display the character,
+ * cross out all names with the same foundry and encoding and pick
+ * another font.
+ */
+
+ hateFoundry = got.xa.foundry;
+ hateCharset = charset;
+ ReleaseSubFont(display, &subFont);
+ goto retry;
+ }
+ if (nameList != nameListOrig) {
+ ckfree((char *) nameList);
+ }
+ XFreeFontNames(nameListOrig);
+
+ if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
+ SubFont *newPtr;
+
+ newPtr = (SubFont *) ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1));
+ memcpy((char *) newPtr, fontPtr->subFontArray,
+ fontPtr->numSubFonts * sizeof(SubFont));
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+ fontPtr->subFontArray = newPtr;
+ }
+ fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
+ fontPtr->numSubFonts++;
+ return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * RankAttributes --
+ *
+ * Determine how close the attributes of the font in question match
+ * the attributes that we want.
+ *
+ * Results:
+ * The return value is the score; lower numbers are better.
+ * *scalablePtr is set to 0 if the font was not scalable, 1 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static unsigned int
+RankAttributes(wantPtr, gotPtr)
+ FontAttributes *wantPtr; /* The desired attributes. */
+ FontAttributes *gotPtr; /* The attributes we have to live with. */
+{
+ unsigned int penalty;
+
+ penalty = 0;
+ if (gotPtr->xa.foundry != wantPtr->xa.foundry) {
+ penalty += 4500;
+ }
+ if (gotPtr->fa.family != wantPtr->fa.family) {
+ penalty += 9000;
+ }
+ if (gotPtr->fa.weight != wantPtr->fa.weight) {
+ penalty += 90;
+ }
+ if (gotPtr->fa.slant != wantPtr->fa.slant) {
+ penalty += 60;
+ }
+ if (gotPtr->xa.slant != wantPtr->xa.slant) {
+ penalty += 10;
+ }
+ if (gotPtr->xa.setwidth != wantPtr->xa.setwidth) {
+ penalty += 1000;
+ }
+
+ if (gotPtr->fa.size == 0) {
+ /*
+ * A scalable font is almost always acceptable, but the
+ * corresponding bitmapped font would be better.
+ */
+
+ penalty += 10;
+ } else {
+ int diff;
+
+ /*
+ * It's worse to be too large than to be too small.
+ */
+
+ diff = (-gotPtr->fa.size - -wantPtr->fa.size);
+ if (diff > 0) {
+ penalty += 600;
+ } else if (diff < 0) {
+ penalty += 150;
+ diff = -diff;
+ }
+ penalty += 150 * diff;
+ }
+ if (gotPtr->xa.charset != wantPtr->xa.charset) {
+ int i;
+ CONST char *gotAlias, *wantAlias;
+
+ penalty += 65000;
+ gotAlias = GetEncodingAlias(gotPtr->xa.charset);
+ wantAlias = GetEncodingAlias(wantPtr->xa.charset);
+ if (strcmp(gotAlias, wantAlias) != 0) {
+ penalty += 30000;
+ for (i = 0; encodingList[i] != NULL; i++) {
+ if (strcmp(gotAlias, encodingList[i]) == 0) {
+ penalty -= 30000;
+ break;
+ }
+ penalty += 20000;
+ }
+ }
+ }
+ return penalty;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetScreenFont --
+ *
+ * Given the names for the best scalable and best bitmapped font,
+ * actually construct an XFontStruct based on the best XLFD.
+ * This is where all the alias and fallback substitution bottoms
+ * out.
+ *
+ * Results:
+ * The screen font that best corresponds to the set of attributes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static XFontStruct *
+GetScreenFont(display, wantPtr, nameList, bestIdx, bestScore)
+ Display *display; /* Display for new XFontStruct. */
+ FontAttributes *wantPtr; /* Contains desired actual pixel-size if the
+ * best font was scalable. */
+ char **nameList; /* Array of XLFDs. */
+ int bestIdx[2]; /* Indices into above array for XLFD of
+ * best bitmapped and best scalable font. */
+ unsigned int bestScore[2]; /* Scores of best bitmapped and best
+ * scalable font. XLFD corresponding to
+ * lowest score will be constructed. */
+{
+ XFontStruct *fontStructPtr;
+
+ if ((bestIdx[0] < 0) && (bestIdx[1] < 0)) {
+ return NULL;
+ }
+
+ /*
+ * Now we know which is the closest matching scalable font and the
+ * closest matching bitmapped font. If the scalable font was a
+ * better match, try getting the scalable font; however, if the
+ * scalable font was not actually available in the desired
+ * pointsize, fall back to the closest bitmapped font.
+ */
+
+ fontStructPtr = NULL;
+ if (bestScore[1] < bestScore[0]) {
+ char *str, *rest;
+ char buf[256];
+ int i;
+
+ /*
+ * Fill in the desired pixel size for this font.
+ */
+
+ tryscale:
+ str = nameList[bestIdx[1]];
+ for (i = 0; i < XLFD_PIXEL_SIZE; i++) {
+ str = strchr(str + 1, '-');
+ }
+ rest = str;
+ for (i = XLFD_PIXEL_SIZE; i < XLFD_CHARSET; i++) {
+ rest = strchr(rest + 1, '-');
+ }
+ *str = '\0';
+ sprintf(buf, "%.200s-%d-*-*-*-*-*%s", nameList[bestIdx[1]],
+ -wantPtr->fa.size, rest);
+ *str = '-';
+ fontStructPtr = XLoadQueryFont(display, buf);
+ bestScore[1] = INT_MAX;
+ }
+ if (fontStructPtr == NULL) {
+ fontStructPtr = XLoadQueryFont(display, nameList[bestIdx[0]]);
+ if (fontStructPtr == NULL) {
+ /*
+ * This shouldn't happen because the font name is one of the
+ * names that X gave us to use, but it does anyhow.
+ */
+
+ if (bestScore[1] < INT_MAX) {
+ goto tryscale;
+ }
+ return GetSystemFont(display);
+ }
+ }
+ return fontStructPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetSystemFont --
+ *
+ * Absolute fallback mechanism, called when we need a font and no
+ * other font can be found and/or instantiated.
+ *
+ * Results:
+ * A pointer to a font. Never NULL.
+ *
+ * Side effects:
+ * If there are NO fonts installed on the system, this call will
+ * panic, but how did you get X running in that case?
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static XFontStruct *
+GetSystemFont(display)
+ Display *display; /* Display for new XFontStruct. */
+{
+ XFontStruct *fontStructPtr;
+
+ fontStructPtr = XLoadQueryFont(display, "fixed");
+ if (fontStructPtr == NULL) {
+ fontStructPtr = XLoadQueryFont(display, "*");
+ if (fontStructPtr == NULL) {
+ panic("TkpGetFontFromAttributes: cannot get any font");
+ }
+ }
+ return fontStructPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetFontAttributes --
+ *
+ * Given a screen font, determine its actual attributes, which are
+ * not necessarily the attributes that were used to construct it.
+ *
+ * Results:
+ * *faPtr is filled with the screen font's attributes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetFontAttributes(display, fontStructPtr, faPtr)
+ Display *display; /* Display that owns the screen font. */
+ XFontStruct *fontStructPtr; /* Screen font to query. */
+ FontAttributes *faPtr; /* For storing attributes of screen font. */
+{
+ unsigned long value;
+ char *name;
+
+ if ((XGetFontProperty(fontStructPtr, XA_FONT, &value) != False) &&
+ (value != 0)) {
+ name = XGetAtomName(display, (Atom) value);
+ if (TkFontParseXLFD(name, &faPtr->fa, &faPtr->xa) != TCL_OK) {
+ faPtr->fa.family = Tk_GetUid(name);
+ faPtr->xa.foundry = Tk_GetUid("");
+ faPtr->xa.charset = Tk_GetUid("");
+ }
+ XFree(name);
+ } else {
+ TkInitFontAttributes(&faPtr->fa);
+ TkInitXLFDAttributes(&faPtr->xa);
+ faPtr->fa.family = Tk_GetUid("");
+ faPtr->xa.foundry = Tk_GetUid("");
+ faPtr->xa.charset = Tk_GetUid("");
+ }
+ return IdentifySymbolEncodings(faPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ListFonts --
+ *
+ * Utility function to return the array of all XLFDs on the system
+ * with the specified face name.
+ *
+ * Results:
+ * The return value is an array of XLFDs, which should be freed with
+ * XFreeFontNames(), or NULL if no XLFDs matched the requested name.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static char **
+ListFonts(display, faceName, numNamesPtr)
+ Display *display; /* Display to query. */
+ CONST char *faceName; /* Desired face name, or "*" for all. */
+ int *numNamesPtr; /* Filled with length of returned array, or
+ * 0 if no names were found. */
+{
+ char buf[256];
+
+ sprintf(buf, "-*-%.80s-*-*-*-*-*-*-*-*-*-*-*-*", faceName);
+ return XListFonts(display, buf, 10000, numNamesPtr);
+}
+
+static char **
+ListFontOrAlias(display, faceName, numNamesPtr)
+ Display *display; /* Display to query. */
+ CONST char *faceName; /* Desired face name, or "*" for all. */
+ int *numNamesPtr; /* Filled with length of returned array, or
+ * 0 if no names were found. */
+{
+ char **nameList, **aliases;
+ int i;
+
+ nameList = ListFonts(display, faceName, numNamesPtr);
+ if (nameList != NULL) {
+ return nameList;
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ nameList = ListFonts(display, aliases[i], numNamesPtr);
+ if (nameList != NULL) {
+ return nameList;
+ }
+ }
+ }
+ *numNamesPtr = 0;
+ return NULL;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * IdentifySymbolEncodings --
+ *
+ * If the font attributes refer to a symbol font, update the
+ * charset field of the font attributes so that it reflects the
+ * encoding of that symbol font. In general, the raw value for
+ * the charset field parsed from an XLFD is meaningless for symbol
+ * fonts.
+ *
+ * Symbol fonts are all fonts whose name appears in the symbolClass.
+ *
+ * Results:
+ * The return value is non-zero if the font attributes specify a
+ * symbol font, or 0 otherwise. If a non-zero value is returned
+ * the charset field of the font attributes will be changed to
+ * the string that represents the actual encoding for the symbol font.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+IdentifySymbolEncodings(faPtr)
+ FontAttributes *faPtr;
+{
+ int i, j;
+ char **aliases, **symbolClass;
+
+ symbolClass = TkFontGetSymbolClass();
+ for (i = 0; symbolClass[i] != NULL; i++) {
+ if (strcasecmp(faPtr->fa.family, symbolClass[i]) == 0) {
+ faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(symbolClass[i]));
+ return 1;
+ }
+ aliases = TkFontGetAliasList(symbolClass[i]);
+ for (j = 0; (aliases != NULL) && (aliases[j] != NULL); j++) {
+ if (strcasecmp(faPtr->fa.family, aliases[j]) == 0) {
+ faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(aliases[j]));
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetEncodingAlias --
+ *
+ * Map the name of an encoding to another name that should be used
+ * when actually loading the encoding. For instance, the encodings
+ * "jisc6226.1978", "jisx0208.1983", "jisx0208.1990", and
+ * "jisx0208.1996" are well-known names for the same encoding and
+ * are represented by one encoding table: "jis0208".
+ *
+ * Results:
+ * As above. If the name has no alias, the original name is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static CONST char *
+GetEncodingAlias(name)
+ CONST char *name; /* The name to look up. */
+{
+ EncodingAlias *aliasPtr;
+
+ for (aliasPtr = encodingAliases; aliasPtr->aliasPattern != NULL; ) {
+ if (Tcl_StringMatch((char *) name, aliasPtr->aliasPattern)) {
+ return aliasPtr->realName;
+ }
+ aliasPtr++;
+ }
+ return name;
+}
+
+
--- /dev/null
+/*
+ * tkUnixInit.c --
+ *
+ * This file contains Unix-specific interpreter initialization
+ * functions.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkUnixInt.h"
+
+/*
+ * The Init script (common to Windows and Unix platforms) is
+ * defined in tkInitScript.h
+ */
+#include "tkInitScript.h"
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpInit --
+ *
+ * Performs Unix-specific interpreter initialization related to the
+ * tk_library variable.
+ *
+ * Results:
+ * Returns a standard Tcl result. Leaves an error message or result
+ * in the interp's result.
+ *
+ * Side effects:
+ * Sets "tk_library" Tcl variable, runs "tk.tcl" script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpInit(interp)
+ Tcl_Interp *interp;
+{
+ TkCreateXEventSource();
+ return Tcl_Eval(interp, initScript);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetAppName --
+ *
+ * Retrieves the name of the current application from a platform
+ * specific location. For Unix, the application name is the tail
+ * of the path contained in the tcl variable argv0.
+ *
+ * Results:
+ * Returns the application name in the given Tcl_DString.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpGetAppName(interp, namePtr)
+ Tcl_Interp *interp;
+ Tcl_DString *namePtr; /* A previously initialized Tcl_DString. */
+{
+ CONST char *p, *name;
+
+ name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
+ if ((name == NULL) || (*name == 0)) {
+ name = "tk";
+ } else {
+ p = strrchr(name, '/');
+ if (p != NULL) {
+ name = p+1;
+ }
+ }
+ Tcl_DStringAppend(namePtr, name, -1);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayWarning --
+ *
+ * This routines is called from Tk_Main to display warning
+ * messages that occur during startup.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates messages on stdout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayWarning(msg, title)
+ CONST char *msg; /* Message to be displayed. */
+ CONST char *title; /* Title of warning. */
+{
+ Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ if (errChannel) {
+ Tcl_WriteChars(errChannel, title, -1);
+ Tcl_WriteChars(errChannel, ": ", 2);
+ Tcl_WriteChars(errChannel, msg, -1);
+ Tcl_WriteChars(errChannel, "\n", 1);
+ }
+}
--- /dev/null
+/*
+ * tkUnixInt.h --
+ *
+ * This file contains declarations that are shared among the
+ * UNIX-specific parts of Tk but aren't used by the rest of
+ * Tk.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKUNIXINT
+#define _TKUNIXINT
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * Prototypes for procedures that are referenced in files other
+ * than the ones they're defined in.
+ */
+#include "tkIntPlatDecls.h"
+
+#endif /* _TKUNIXINT */
--- /dev/null
+/*
+ * tkUnixKey.c --
+ *
+ * This file contains routines for dealing with international keyboard
+ * input.
+ *
+ * Copyright (c) 1997 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetCaretPos --
+ *
+ * This enables correct placement of the XIM caret. This is called
+ * by widgets to indicate their cursor placement, and the caret
+ * location is used by TkpGetString to place the XIM caret.
+ * This is currently only used for over-the-spot XIM.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetCaretPos(tkwin, x, y, height)
+ Tk_Window tkwin;
+ int x;
+ int y;
+ int height;
+{
+ TkCaret *caretPtr = &(((TkWindow *) tkwin)->dispPtr->caret);
+
+ /*
+ * Use height for best placement of the XIM over-the-spot box.
+ */
+
+ caretPtr->winPtr = ((TkWindow *) tkwin);
+ caretPtr->x = x;
+ caretPtr->y = y;
+ caretPtr->height = height;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetString --
+ *
+ * Retrieve the UTF string associated with a keyboard event.
+ *
+ * Results:
+ * Returns the UTF string.
+ *
+ * Side effects:
+ * Stores the input string in the specified Tcl_DString. Modifies
+ * the internal input state. This routine can only be called
+ * once for a given event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkpGetString(winPtr, eventPtr, dsPtr)
+ TkWindow *winPtr; /* Window where event occurred: needed to
+ * get input context. */
+ XEvent *eventPtr; /* X keyboard event. */
+ Tcl_DString *dsPtr; /* Uninitialized or empty string to hold
+ * result. */
+{
+ int len;
+ Tcl_DString buf;
+ Status status;
+#ifdef TK_USE_INPUT_METHODS
+ TkDisplay *dispPtr = winPtr->dispPtr;
+#endif
+
+ /*
+ * Overallocate the dstring to the maximum stack amount.
+ */
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringSetLength(&buf, TCL_DSTRING_STATIC_SIZE-1);
+
+#ifdef TK_USE_INPUT_METHODS
+ if ((dispPtr->flags & TK_DISPLAY_USE_IM)
+ && (winPtr->inputContext != NULL)
+ && (eventPtr->type == KeyPress)) {
+#if TK_XIM_SPOT
+ XVaNestedList preedit_attr;
+ XPoint spot;
+#endif
+
+ len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey,
+ Tcl_DStringValue(&buf), Tcl_DStringLength(&buf),
+ (KeySym *) NULL, &status);
+ /*
+ * If the buffer wasn't big enough, grow the buffer and try again.
+ */
+
+ if (status == XBufferOverflow) {
+ Tcl_DStringSetLength(&buf, len);
+ len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey,
+ Tcl_DStringValue(&buf), len, (KeySym *) NULL, &status);
+ }
+ if ((status != XLookupChars) && (status != XLookupBoth)) {
+ len = 0;
+ }
+
+#if TK_XIM_SPOT
+ /*
+ * Adjust the XIM caret position. We might want to check that
+ * this is the right caret.winPtr as well.
+ */
+ if (dispPtr->flags & TK_DISPLAY_XIM_SPOT) {
+ spot.x = dispPtr->caret.x;
+ spot.y = dispPtr->caret.y + dispPtr->caret.height;
+ preedit_attr = XVaCreateNestedList(0, XNSpotLocation, &spot, NULL);
+ XSetICValues(winPtr->inputContext,
+ XNPreeditAttributes, preedit_attr, NULL);
+ XFree(preedit_attr);
+ }
+#endif
+ } else {
+ len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf), (KeySym *) NULL,
+ (XComposeStatus *) NULL);
+ }
+#else /* TK_USE_INPUT_METHODS */
+ len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf), (KeySym *) NULL,
+ (XComposeStatus *) NULL);
+#endif /* TK_USE_INPUT_METHODS */
+ Tcl_DStringSetLength(&buf, len);
+
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buf), len, dsPtr);
+ Tcl_DStringFree(&buf);
+
+ return Tcl_DStringValue(dsPtr);
+}
+\f
+/*
+ * When mapping from a keysym to a keycode, need
+ * information about the modifier state that should be used
+ * so that when they call XKeycodeToKeysym taking into
+ * account the xkey.state, they will get back the original
+ * keysym.
+ */
+
+void
+TkpSetKeycodeAndState(tkwin, keySym, eventPtr)
+ Tk_Window tkwin;
+ KeySym keySym;
+ XEvent *eventPtr;
+{
+ Display *display;
+ int state;
+ KeyCode keycode;
+
+ display = Tk_Display(tkwin);
+
+ if (keySym == NoSymbol) {
+ keycode = 0;
+ } else {
+ keycode = XKeysymToKeycode(display, keySym);
+ }
+ if (keycode != 0) {
+ for (state = 0; state < 4; state++) {
+ if (XKeycodeToKeysym(display, keycode, state) == keySym) {
+ if (state & 1) {
+ eventPtr->xkey.state |= ShiftMask;
+ }
+ if (state & 2) {
+ TkDisplay *dispPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ eventPtr->xkey.state |= dispPtr->modeModMask;
+ }
+ break;
+ }
+ }
+ }
+ eventPtr->xkey.keycode = keycode;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetKeySym --
+ *
+ * Given an X KeyPress or KeyRelease event, map the
+ * keycode in the event into a KeySym.
+ *
+ * Results:
+ * The return value is the KeySym corresponding to
+ * eventPtr, or NoSymbol if no matching Keysym could be
+ * found.
+ *
+ * Side effects:
+ * In the first call for a given display, keycode-to-
+ * KeySym maps get loaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkpGetKeySym(dispPtr, eventPtr)
+ TkDisplay *dispPtr; /* Display in which to
+ * map keycode. */
+ XEvent *eventPtr; /* Description of X event. */
+{
+ KeySym sym;
+ int index;
+
+ /*
+ * Refresh the mapping information if it's stale
+ */
+
+ if (dispPtr->bindInfoStale) {
+ TkpInitKeymapInfo(dispPtr);
+ }
+
+ /*
+ * Figure out which of the four slots in the keymap vector to
+ * use for this key. Refer to Xlib documentation for more info
+ * on how this computation works.
+ */
+
+ index = 0;
+ if (eventPtr->xkey.state & dispPtr->modeModMask) {
+ index = 2;
+ }
+ if ((eventPtr->xkey.state & ShiftMask)
+ || ((dispPtr->lockUsage != LU_IGNORE)
+ && (eventPtr->xkey.state & LockMask))) {
+ index += 1;
+ }
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode, index);
+
+ /*
+ * Special handling: if the key was shifted because of Lock, but
+ * lock is only caps lock, not shift lock, and the shifted keysym
+ * isn't upper-case alphabetic, then switch back to the unshifted
+ * keysym.
+ */
+
+ if ((index & 1) && !(eventPtr->xkey.state & ShiftMask)
+ && (dispPtr->lockUsage == LU_CAPS)) {
+ if (!(((sym >= XK_A) && (sym <= XK_Z))
+ || ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis))
+ || ((sym >= XK_Ooblique) && (sym <= XK_Thorn)))) {
+ index &= ~1;
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
+ index);
+ }
+ }
+
+ /*
+ * Another bit of special handling: if this is a shifted key and there
+ * is no keysym defined, then use the keysym for the unshifted key.
+ */
+
+ if ((index & 1) && (sym == NoSymbol)) {
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
+ index & ~1);
+ }
+ return sym;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpInitKeymapInfo --
+ *
+ * This procedure is invoked to scan keymap information
+ * to recompute stuff that's important for binding, such
+ * as the modifier key (if any) that corresponds to "mode
+ * switch".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Keymap-related information in dispPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitKeymapInfo(dispPtr)
+ TkDisplay *dispPtr; /* Display for which to recompute keymap
+ * information. */
+{
+ XModifierKeymap *modMapPtr;
+ KeyCode *codePtr;
+ KeySym keysym;
+ int count, i, j, max, arraySize;
+#define KEYCODE_ARRAY_SIZE 20
+
+ dispPtr->bindInfoStale = 0;
+ modMapPtr = XGetModifierMapping(dispPtr->display);
+
+ /*
+ * Check the keycodes associated with the Lock modifier. If
+ * any of them is associated with the XK_Shift_Lock modifier,
+ * then Lock has to be interpreted as Shift Lock, not Caps Lock.
+ */
+
+ dispPtr->lockUsage = LU_IGNORE;
+ codePtr = modMapPtr->modifiermap + modMapPtr->max_keypermod*LockMapIndex;
+ for (count = modMapPtr->max_keypermod; count > 0; count--, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+ keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
+ if (keysym == XK_Shift_Lock) {
+ dispPtr->lockUsage = LU_SHIFT;
+ break;
+ }
+ if (keysym == XK_Caps_Lock) {
+ dispPtr->lockUsage = LU_CAPS;
+ break;
+ }
+ }
+
+ /*
+ * Look through the keycodes associated with modifiers to see if
+ * the the "mode switch", "meta", or "alt" keysyms are associated
+ * with any modifiers. If so, remember their modifier mask bits.
+ */
+
+ dispPtr->modeModMask = 0;
+ dispPtr->metaModMask = 0;
+ dispPtr->altModMask = 0;
+ codePtr = modMapPtr->modifiermap;
+ max = 8*modMapPtr->max_keypermod;
+ for (i = 0; i < max; i++, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+ keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
+ if (keysym == XK_Mode_switch) {
+ dispPtr->modeModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ if ((keysym == XK_Meta_L) || (keysym == XK_Meta_R)) {
+ dispPtr->metaModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ if ((keysym == XK_Alt_L) || (keysym == XK_Alt_R)) {
+ dispPtr->altModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ }
+
+ /*
+ * Create an array of the keycodes for all modifier keys.
+ */
+
+ if (dispPtr->modKeyCodes != NULL) {
+ ckfree((char *) dispPtr->modKeyCodes);
+ }
+ dispPtr->numModKeyCodes = 0;
+ arraySize = KEYCODE_ARRAY_SIZE;
+ dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned)
+ (KEYCODE_ARRAY_SIZE * sizeof(KeyCode)));
+ for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+
+ /*
+ * Make sure that the keycode isn't already in the array.
+ */
+
+ for (j = 0; j < dispPtr->numModKeyCodes; j++) {
+ if (dispPtr->modKeyCodes[j] == *codePtr) {
+ goto nextModCode;
+ }
+ }
+ if (dispPtr->numModKeyCodes >= arraySize) {
+ KeyCode *new;
+
+ /*
+ * Ran out of space in the array; grow it.
+ */
+
+ arraySize *= 2;
+ new = (KeyCode *) ckalloc((unsigned)
+ (arraySize * sizeof(KeyCode)));
+ memcpy((VOID *) new, (VOID *) dispPtr->modKeyCodes,
+ (dispPtr->numModKeyCodes * sizeof(KeyCode)));
+ ckfree((char *) dispPtr->modKeyCodes);
+ dispPtr->modKeyCodes = new;
+ }
+ dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr;
+ dispPtr->numModKeyCodes++;
+ nextModCode: continue;
+ }
+ XFreeModifiermap(modMapPtr);
+}
--- /dev/null
+/*
+ * tkUnixMenu.c --
+ *
+ * This module implements the UNIX platform-specific features of menus.
+ *
+ * Copyright (c) 1996-1998 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "default.h"
+#include "tkInt.h"
+#include "tkUnixInt.h"
+#include "tkMenu.h"
+
+/*
+ * Constants used for menu drawing.
+ */
+
+#define MENU_MARGIN_WIDTH 2
+#define MENU_DIVIDER_HEIGHT 2
+
+/*
+ * Platform specific flags for Unix.
+ */
+
+#define ENTRY_HELP_MENU ENTRY_PLATFORM_FLAG1
+
+/*
+ * Procedures used internally.
+ */
+
+static void SetHelpMenu _ANSI_ARGS_((TkMenu *menuPtr));
+static void DrawMenuEntryAccelerator _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, GC gc, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr,
+ Tk_3DBorder activeBorder, int x, int y,
+ int width, int height, int drawArrow));
+static void DrawMenuEntryBackground _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, Tk_3DBorder activeBorder,
+ Tk_3DBorder bgBorder, int x, int y,
+ int width, int heigth));
+static void DrawMenuEntryIndicator _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, GC gc, GC indicatorGC,
+ Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int x, int y,
+ int width, int height));
+static void DrawMenuEntryLabel _ANSI_ARGS_((
+ TkMenu * menuPtr, TkMenuEntry *mePtr, Drawable d,
+ GC gc, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int x, int y,
+ int width, int height));
+static void DrawMenuSeparator _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Drawable d, GC gc,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int x, int y, int width, int height));
+static void DrawTearoffEntry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Drawable d, GC gc,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int x, int y, int width, int height));
+static void DrawMenuUnderline _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Drawable d, GC gc,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x,
+ int y, int width, int height));
+static void GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int *widthPtr,
+ int *heightPtr));
+static void GetMenuLabelGeometry _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetMenuIndicatorGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetMenuSeparatorGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetTearoffEntryGeometry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int *widthPtr,
+ int *heightPtr));
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpNewMenu --
+ *
+ * Gets the platform-specific piece of the menu. Invoked during idle
+ * after the generic part of the menu has been created.
+ *
+ * Results:
+ * Standard TCL error.
+ *
+ * Side effects:
+ * Allocates any platform specific allocations and places them
+ * in the platformData field of the menuPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpNewMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ SetHelpMenu(menuPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenu --
+ *
+ * Destroys platform-specific menu structures. Called when the
+ * generic menu structure is destroyed for the menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All platform-specific allocations are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ /*
+ * Nothing to do.
+ */
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenuEntry --
+ *
+ * Cleans up platform-specific menu entry items. Called when entry
+ * is destroyed in the generic code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All platform specific allocations are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenuEntry(mEntryPtr)
+ TkMenuEntry *mEntryPtr;
+{
+ /*
+ * Nothing to do.
+ */
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpConfigureMenuEntry --
+ *
+ * Processes configuration options for menu entries. Called when
+ * the generic options are processed for the menu.
+ *
+ * Results:
+ * Returns standard TCL result. If TCL_ERROR is returned, then
+ * the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information get set for mePtr; old resources
+ * get freed, if any need it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpConfigureMenuEntry(mePtr)
+ register TkMenuEntry *mePtr; /* Information about menu entry; may
+ * or may not already have values for
+ * some fields. */
+{
+ /*
+ * If this is a cascade menu, and the child menu exists, check to
+ * see if the child menu is a help menu.
+ */
+
+ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
+ TkMenuReferences *menuRefPtr;
+
+ menuRefPtr = TkFindMenuReferencesObj(mePtr->menuPtr->interp,
+ mePtr->namePtr);
+ if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) {
+ SetHelpMenu(menuRefPtr->menuPtr);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuNewEntry --
+ *
+ * Called when a new entry is created in a menu. Fills in platform
+ * specific data for the entry. The platformEntryData field
+ * is used to store the indicator diameter for radio button
+ * and check box entries.
+ *
+ * Results:
+ * Standard TCL error.
+ *
+ * Side effects:
+ * None on Unix.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpMenuNewEntry(mePtr)
+ TkMenuEntry *mePtr;
+{
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetWindowMenuBar --
+ *
+ * Sets up the menu as a menubar in the given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Recomputes geometry of given window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetWindowMenuBar(tkwin, menuPtr)
+ Tk_Window tkwin; /* The window we are setting */
+ TkMenu *menuPtr; /* The menu we are setting */
+{
+ if (menuPtr == NULL) {
+ TkUnixSetMenubar(tkwin, NULL);
+ } else {
+ TkUnixSetMenubar(tkwin, menuPtr->tkwin);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetMainMenuBar --
+ *
+ * Called when a toplevel widget is brought to front. On the
+ * Macintosh, sets up the menubar that goes accross the top
+ * of the main monitor. On other platforms, nothing is necessary.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Recompute geometry of given window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetMainMenubar(interp, tkwin, menuName)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ char *menuName;
+{
+ /*
+ * Nothing to do.
+ */
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuIndicatorGeometry --
+ *
+ * Fills out the geometry of the indicator in a menu item. Note
+ * that the mePtr->height field must have already been filled in
+ * by GetMenuLabelGeometry since this height depends on the label
+ * height.
+ *
+ * Results:
+ * widthPtr and heightPtr point to the new geometry values.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ TkMenu *menuPtr; /* The menu we are drawing. */
+ TkMenuEntry *mePtr; /* The entry we are interested in. */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated metrics */
+ int *widthPtr; /* The resulting width */
+ int *heightPtr; /* The resulting height */
+{
+ if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY)) {
+ if (!mePtr->hideMargin && mePtr->indicatorOn) {
+ if ((mePtr->image != NULL) || (mePtr->bitmapPtr != NULL)) {
+ *widthPtr = (14 * mePtr->height) / 10;
+ *heightPtr = mePtr->height;
+ if (mePtr->type == CHECK_BUTTON_ENTRY) {
+ mePtr->platformEntryData =
+ (TkMenuPlatformEntryData) ((65 * mePtr->height)
+ / 100);
+ } else {
+ mePtr->platformEntryData =
+ (TkMenuPlatformEntryData) ((75 * mePtr->height)
+ / 100);
+ }
+ } else {
+ *widthPtr = *heightPtr = mePtr->height;
+ if (mePtr->type == CHECK_BUTTON_ENTRY) {
+ mePtr->platformEntryData = (TkMenuPlatformEntryData)
+ ((80 * mePtr->height) / 100);
+ } else {
+ mePtr->platformEntryData = (TkMenuPlatformEntryData)
+ mePtr->height;
+ }
+ }
+ } else {
+ int borderWidth;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ *heightPtr = 0;
+ *widthPtr = borderWidth;
+ }
+ } else {
+ int borderWidth;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ *heightPtr = 0;
+ *widthPtr = borderWidth;
+ }
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuAccelGeometry --
+ *
+ * Get the geometry of the accelerator area of a menu item.
+ *
+ * Results:
+ * heightPtr and widthPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ TkMenu *menuPtr; /* The menu was are drawing */
+ TkMenuEntry *mePtr; /* The entry we are getting the geometry for */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr;/* The precalculated font metrics */
+ int *widthPtr; /* The width of the acclerator area */
+ int *heightPtr; /* The height of the accelerator area */
+{
+ *heightPtr = fmPtr->linespace;
+ if (mePtr->type == CASCADE_ENTRY) {
+ *widthPtr = 2 * CASCADE_ARROW_WIDTH;
+ } else if ((menuPtr->menuType != MENUBAR)
+ && (mePtr->accelPtr != NULL)) {
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+
+ *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
+ } else {
+ *widthPtr = 0;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryBackground --
+ *
+ * This procedure draws the background part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder, bgBorder, x, y,
+ width, height)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are drawing. */
+ Drawable d; /* The drawable we are drawing into */
+ Tk_3DBorder activeBorder; /* The border for an active item */
+ Tk_3DBorder bgBorder; /* The background border */
+ int x; /* Left coordinate of entry rect */
+ int y; /* Right coordinate of entry rect */
+ int width; /* Width of entry rect */
+ int height; /* Height of entry rect */
+{
+ if (mePtr->state == ENTRY_ACTIVE) {
+ int relief;
+ int activeBorderWidth;
+
+ bgBorder = activeBorder;
+
+ if ((menuPtr->menuType == MENUBAR)
+ && ((menuPtr->postedCascade == NULL)
+ || (menuPtr->postedCascade != mePtr))) {
+ relief = TK_RELIEF_FLAT;
+ } else {
+ relief = TK_RELIEF_RAISED;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
+ activeBorderWidth, relief);
+ } else {
+ Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
+ 0, TK_RELIEF_FLAT);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryAccelerator --
+ *
+ * This procedure draws the background part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder,
+ x, y, width, height, drawArrow)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are drawing */
+ Drawable d; /* The drawable we are drawing into */
+ GC gc; /* The precalculated gc to draw with */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated metrics */
+ Tk_3DBorder activeBorder; /* The border for an active item */
+ int x; /* Left coordinate of entry rect */
+ int y; /* Top coordinate of entry rect */
+ int width; /* Width of entry */
+ int height; /* Height of entry */
+ int drawArrow; /* Whether or not to draw arrow. */
+{
+ XPoint points[3];
+ int borderWidth, activeBorderWidth;
+
+ /*
+ * Draw accelerator or cascade arrow.
+ */
+
+ if (menuPtr->menuType == MENUBAR) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ if ((mePtr->type == CASCADE_ENTRY) && drawArrow) {
+ points[0].x = x + width - borderWidth - activeBorderWidth
+ - CASCADE_ARROW_WIDTH;
+ points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2;
+ points[1].x = points[0].x;
+ points[1].y = points[0].y + CASCADE_ARROW_HEIGHT;
+ points[2].x = points[0].x + CASCADE_ARROW_WIDTH;
+ points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2;
+ Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points, 3,
+ DECORATION_BORDER_WIDTH,
+ (menuPtr->postedCascade == mePtr)
+ ? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
+ } else if (mePtr->accelPtr != NULL) {
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ int left = x + mePtr->labelWidth + activeBorderWidth
+ + mePtr->indicatorSpace;
+
+ if (menuPtr->menuType == MENUBAR) {
+ left += 5;
+ }
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
+ mePtr->accelLength, left,
+ (y + (height + fmPtr->ascent - fmPtr->descent) / 2));
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryIndicator --
+ *
+ * This procedure draws the background part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont, fmPtr,
+ x, y, width, height)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are drawing */
+ Drawable d; /* The drawable to draw into */
+ GC gc; /* The gc to draw with */
+ GC indicatorGC; /* The gc that indicators draw with */
+ Tk_Font tkfont; /* The font to draw with */
+ CONST Tk_FontMetrics *fmPtr; /* The font metrics of the font */
+ int x; /* The left of the entry rect */
+ int y; /* The top of the entry rect */
+ int width; /* Width of menu entry */
+ int height; /* Height of menu entry */
+{
+ /*
+ * Draw check-button indicator.
+ */
+
+ if ((mePtr->type == CHECK_BUTTON_ENTRY) && mePtr->indicatorOn) {
+ int dim, top, left;
+ int activeBorderWidth;
+ Tk_3DBorder border;
+
+ dim = (int) mePtr->platformEntryData;
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ left = x + activeBorderWidth + (mePtr->indicatorSpace - dim)/2;
+ if (menuPtr->menuType == MENUBAR) {
+ left += 5;
+ }
+ top = y + (height - dim)/2;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ menuPtr->borderPtr);
+ Tk_Fill3DRectangle(menuPtr->tkwin, d, border, left, top, dim,
+ dim, DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
+ left += DECORATION_BORDER_WIDTH;
+ top += DECORATION_BORDER_WIDTH;
+ dim -= 2*DECORATION_BORDER_WIDTH;
+ if ((dim > 0) && (mePtr->entryFlags
+ & ENTRY_SELECTED)) {
+ XFillRectangle(menuPtr->display, d, indicatorGC, left, top,
+ (unsigned int) dim, (unsigned int) dim);
+ }
+ }
+
+ /*
+ * Draw radio-button indicator.
+ */
+
+ if ((mePtr->type == RADIO_BUTTON_ENTRY) && mePtr->indicatorOn) {
+ XPoint points[4];
+ int radius;
+ Tk_3DBorder border;
+
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ menuPtr->borderPtr);
+ radius = ((int) mePtr->platformEntryData)/2;
+ points[0].x = x + (mePtr->indicatorSpace
+ - (int) mePtr->platformEntryData)/2;
+ points[0].y = y + (height)/2;
+ points[1].x = points[0].x + radius;
+ points[1].y = points[0].y + radius;
+ points[2].x = points[1].x + radius;
+ points[2].y = points[0].y;
+ points[3].x = points[1].x;
+ points[3].y = points[0].y - radius;
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ XFillPolygon(menuPtr->display, d, indicatorGC, points, 4,
+ Convex, CoordModeOrigin);
+ } else {
+ Tk_Fill3DPolygon(menuPtr->tkwin, d, border, points, 4,
+ DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT);
+ }
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 4,
+ DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuSeparator --
+ *
+ * This procedure draws a separator menu item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are drawing */
+ Drawable d; /* The drawable we are using */
+ GC gc; /* The gc to draw into */
+ Tk_Font tkfont; /* The font to draw with */
+ CONST Tk_FontMetrics *fmPtr; /* The font metrics from the font */
+ int x;
+ int y;
+ int width;
+ int height;
+{
+ XPoint points[2];
+ Tk_3DBorder border;
+
+ if (menuPtr->menuType == MENUBAR) {
+ return;
+ }
+
+ points[0].x = x;
+ points[0].y = y + height/2;
+ points[1].x = width - 1;
+ points[1].y = points[0].y;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryLabel --
+ *
+ * This procedure draws the label part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
+ TkMenu *menuPtr; /* The menu we are drawing. */
+ TkMenuEntry *mePtr; /* The entry we are drawing. */
+ Drawable d; /* What we are drawing into. */
+ GC gc; /* The gc we are drawing into.*/
+ Tk_Font tkfont; /* The precalculated font. */
+ CONST Tk_FontMetrics *fmPtr;/* The precalculated font metrics. */
+ int x; /* Left edge. */
+ int y; /* Top edge. */
+ int width; /* width of entry. */
+ int height; /* height of entry. */
+{
+ int indicatorSpace = mePtr->indicatorSpace;
+ int activeBorderWidth;
+ int leftEdge;
+ int imageHeight, imageWidth;
+ int textHeight = 0, textWidth = 0; /* stop GCC warning */
+ int haveImage = 0, haveText = 0;
+ int imageXOffset = 0, imageYOffset = 0;
+ int textXOffset = 0, textYOffset = 0;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
+ if (menuPtr->menuType == MENUBAR) {
+ leftEdge += 5;
+ }
+
+ /*
+ * Work out what we will need to draw first.
+ */
+
+ if (mePtr->image != NULL) {
+ Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight);
+ haveImage = 1;
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight);
+ haveImage = 1;
+ }
+ if (!haveImage || (mePtr->compound != COMPOUND_NONE)) {
+ if (mePtr->labelLength > 0) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength);
+ textHeight = fmPtr->linespace;
+ haveText = 1;
+ }
+ }
+
+ /*
+ * Now work out what the relative positions are.
+ */
+
+ if (haveImage && haveText) {
+ int fullWidth = (imageWidth > textWidth ? imageWidth : textWidth);
+ switch ((enum compound) mePtr->compound) {
+ case COMPOUND_TOP: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = imageHeight/2 + 2;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = -textHeight/2;
+ break;
+ }
+ case COMPOUND_BOTTOM: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = -imageHeight/2;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = textHeight/2 + 2;
+ break;
+ }
+ case COMPOUND_LEFT: {
+ textXOffset = imageWidth + 2;
+ textYOffset = 0;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_RIGHT: {
+ textXOffset = 0;
+ textYOffset = 0;
+ imageXOffset = textWidth + 2;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = 0;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ } else {
+ textXOffset = 0;
+ textYOffset = 0;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ }
+
+ /*
+ * Draw label and/or bitmap or image for entry.
+ */
+
+ if (mePtr->image != NULL) {
+ if ((mePtr->selectImage != NULL)
+ && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ Tk_RedrawImage(mePtr->selectImage, 0, 0,
+ imageWidth, imageHeight, d, leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset));
+ } else {
+ Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
+ imageHeight, d, leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset));
+ }
+ } else if (mePtr->bitmapPtr != None) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0,
+ (unsigned) imageWidth, (unsigned) imageHeight,
+ leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset), 1);
+ }
+ if ((mePtr->compound != COMPOUND_NONE) || !haveImage) {
+ int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+ if (mePtr->labelLength > 0) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, label,
+ mePtr->labelLength, leftEdge + textXOffset,
+ baseline + textYOffset);
+ DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr,
+ x + textXOffset, y + textYOffset,
+ width, height);
+ }
+ }
+
+ if (mePtr->state == ENTRY_DISABLED) {
+ if (menuPtr->disabledFgPtr == NULL) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
+ (unsigned) width, (unsigned) height);
+ } else if ((mePtr->image != NULL)
+ && (menuPtr->disabledImageGC != None)) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
+ leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset),
+ (unsigned) imageWidth, (unsigned) imageHeight);
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuUnderline --
+ *
+ * On appropriate platforms, draw the underline character for the
+ * menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
+ TkMenu *menuPtr; /* The menu to draw into */
+ TkMenuEntry *mePtr; /* The entry we are drawing */
+ Drawable d; /* What we are drawing into */
+ GC gc; /* The gc to draw into */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated font metrics */
+ int x;
+ int y;
+ int width;
+ int height;
+{
+ int indicatorSpace = mePtr->indicatorSpace;
+
+ if (mePtr->underline >= 0) {
+ int activeBorderWidth;
+ int leftEdge;
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ CONST char *start = Tcl_UtfAtIndex(label, mePtr->underline);
+ CONST char *end = Tcl_UtfNext(start);
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
+ if (menuPtr->menuType == MENUBAR) {
+ leftEdge += 5;
+ }
+
+ Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, label,
+ leftEdge, y + (height + fmPtr->ascent - fmPtr->descent) / 2,
+ start - label, end - label);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPostMenu --
+ *
+ * Posts a menu on the screen
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu is posted and handled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpPostMenu(interp, menuPtr, x, y)
+ Tcl_Interp *interp;
+ TkMenu *menuPtr;
+ int x;
+ int y;
+{
+ return TkPostTearoffMenu(interp, menuPtr, x, y);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuSeparatorGeometry --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr,
+ heightPtr)
+ TkMenu *menuPtr; /* The menu we are measuring */
+ TkMenuEntry *mePtr; /* The entry we are measuring */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalcualted font metrics */
+ int *widthPtr; /* The resulting width */
+ int *heightPtr; /* The resulting height */
+{
+ *widthPtr = 0;
+ *heightPtr = fmPtr->linespace;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTearoffEntryGeometry --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetTearoffEntryGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are measuring */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated font metrics */
+ int *widthPtr; /* The resulting width */
+ int *heightPtr; /* The resulting height */
+{
+ if (menuPtr->menuType != MASTER_MENU) {
+ *heightPtr = 0;
+ *widthPtr = 0;
+ } else {
+ *heightPtr = fmPtr->linespace;
+ *widthPtr = Tk_TextWidth(tkfont, "W", 1);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpComputeMenubarGeometry --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu that is a menubar clone.
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpComputeMenubarGeometry(menuPtr)
+ TkMenu *menuPtr; /* Structure describing menu. */
+{
+ Tk_Font tkfont;
+ Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
+ int width, height;
+ int i, j;
+ int x, y, currentRowHeight, maxWidth;
+ int maxWindowWidth;
+ int lastRowBreak;
+ int helpMenuIndex = -1;
+ TkMenuEntry *mePtr;
+ int lastEntry;
+ Tk_Font menuFont;
+ int borderWidth;
+ int activeBorderWidth;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ maxWidth = 0;
+ if (menuPtr->numEntries == 0) {
+ height = 0;
+ } else {
+ int borderWidth;
+
+ maxWindowWidth = Tk_Width(menuPtr->tkwin);
+ if (maxWindowWidth == 1) {
+ maxWindowWidth = 0x7ffffff;
+ }
+ currentRowHeight = 0;
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ x = y = borderWidth;
+ lastRowBreak = 0;
+
+ /*
+ * On the Mac especially, getting font metrics can be quite slow,
+ * so we want to do it intelligently. We are going to precalculate
+ * them and pass them down to all of the measureing and drawing
+ * routines. We will measure the font metrics of the menu once,
+ * and if an entry has a font set, we will measure it as we come
+ * to it, and then we decide which set to give the geometry routines.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ mePtr->entryFlags &= ~ENTRY_LAST_COLUMN;
+ if (mePtr->fontPtr != NULL) {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ } else {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
+ }
+
+ /*
+ * For every entry, we need to check to see whether or not we
+ * wrap. If we do wrap, then we have to adjust all of the previous
+ * entries' height and y position, because when we see them
+ * the first time, we don't know how big its neighbor might
+ * be.
+ */
+
+ if ((mePtr->type == SEPARATOR_ENTRY)
+ || (mePtr->type == TEAROFF_ENTRY)) {
+ mePtr->height = mePtr->width = 0;
+ } else {
+ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &width, &height);
+ mePtr->height = height + 2 * activeBorderWidth + 10;
+ mePtr->width = width;
+
+ GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr,
+ &width, &height);
+ mePtr->indicatorSpace = width;
+ if (width > 0) {
+ mePtr->width += width;
+ }
+ mePtr->width += 2 * activeBorderWidth + 10;
+ }
+ if (mePtr->entryFlags & ENTRY_HELP_MENU) {
+ helpMenuIndex = i;
+ } else if (x + mePtr->width + borderWidth > maxWindowWidth) {
+
+ if (i == lastRowBreak) {
+ mePtr->y = y;
+ mePtr->x = x;
+ lastRowBreak++;
+ y += mePtr->height;
+ currentRowHeight = 0;
+ } else {
+ x = borderWidth;
+ for (j = lastRowBreak; j < i; j++) {
+ menuPtr->entries[j]->y = y + currentRowHeight
+ - menuPtr->entries[j]->height;
+ menuPtr->entries[j]->x = x;
+ x += menuPtr->entries[j]->width;
+ }
+ lastRowBreak = i;
+ y += currentRowHeight;
+ currentRowHeight = mePtr->height;
+ }
+ if (x > maxWidth) {
+ maxWidth = x;
+ }
+ x = borderWidth;
+ } else {
+ x += mePtr->width;
+ if (mePtr->height > currentRowHeight) {
+ currentRowHeight = mePtr->height;
+ }
+ }
+ }
+
+ lastEntry = menuPtr->numEntries - 1;
+ if (helpMenuIndex == lastEntry) {
+ lastEntry--;
+ }
+ if ((lastEntry >= 0) && (x + menuPtr->entries[lastEntry]->width
+ + borderWidth > maxWidth)) {
+ maxWidth = x + menuPtr->entries[lastEntry]->width + borderWidth;
+ }
+ x = borderWidth;
+ for (j = lastRowBreak; j < menuPtr->numEntries; j++) {
+ if (j == helpMenuIndex) {
+ continue;
+ }
+ menuPtr->entries[j]->y = y + currentRowHeight
+ - menuPtr->entries[j]->height;
+ menuPtr->entries[j]->x = x;
+ x += menuPtr->entries[j]->width;
+ }
+
+
+ if (helpMenuIndex != -1) {
+ mePtr = menuPtr->entries[helpMenuIndex];
+ if (x + mePtr->width + borderWidth > maxWindowWidth) {
+ y += currentRowHeight;
+ currentRowHeight = mePtr->height;
+ x = borderWidth;
+ } else if (mePtr->height > currentRowHeight) {
+ currentRowHeight = mePtr->height;
+ }
+ mePtr->x = maxWindowWidth - borderWidth - mePtr->width;
+ mePtr->y = y + currentRowHeight - mePtr->height;
+ }
+ height = y + currentRowHeight + borderWidth;
+ }
+ width = Tk_Width(menuPtr->tkwin);
+
+ /*
+ * The X server doesn't like zero dimensions, so round up to at least
+ * 1 (a zero-sized menu should never really occur, anyway).
+ */
+
+ if (width <= 0) {
+ width = 1;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+ menuPtr->totalWidth = maxWidth;
+ menuPtr->totalHeight = height;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawTearoffEntry --
+ *
+ * This procedure draws the background part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are drawing */
+ Drawable d; /* The drawable we are drawing into */
+ GC gc; /* The gc we are drawing with */
+ Tk_Font tkfont; /* The font we are drawing with */
+ CONST Tk_FontMetrics *fmPtr; /* The metrics we are drawing with */
+ int x;
+ int y;
+ int width;
+ int height;
+{
+ XPoint points[2];
+ int segmentWidth, maxX;
+ Tk_3DBorder border;
+
+ if (menuPtr->menuType != MASTER_MENU) {
+ return;
+ }
+
+ points[0].x = x;
+ points[0].y = y + height/2;
+ points[1].y = points[0].y;
+ segmentWidth = 6;
+ maxX = width - 1;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+
+ while (points[0].x < maxX) {
+ points[1].x = points[0].x + segmentWidth;
+ if (points[1].x > maxX) {
+ points[1].x = maxX;
+ }
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
+ points[0].x += 2 * segmentWidth;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpInitializeMenuBindings --
+ *
+ * For every interp, initializes the bindings for Windows
+ * menus. Does nothing on Mac or XWindows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * C-level bindings are setup for the interp which will
+ * handle Alt-key sequences for menus without beeping
+ * or interfering with user-defined Alt-key bindings.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitializeMenuBindings(interp, bindingTable)
+ Tcl_Interp *interp; /* The interpreter to set. */
+ Tk_BindingTable bindingTable; /* The table to add to. */
+{
+ /*
+ * Nothing to do.
+ */
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetHelpMenu --
+ *
+ * Given a menu, check to see whether or not it is a help menu
+ * cascade in a menubar. If it is, the entry that points to
+ * this menu will be marked.
+ *
+ * RESULTS:
+ * None.
+ *
+ * Side effects:
+ * Will set the ENTRY_HELP_MENU flag appropriately.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetHelpMenu(menuPtr)
+ TkMenu *menuPtr; /* The menu we are checking */
+{
+ TkMenuEntry *cascadeEntryPtr;
+
+ for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ if ((cascadeEntryPtr->menuPtr->menuType == MENUBAR)
+ && (cascadeEntryPtr->menuPtr->masterMenuPtr->tkwin != NULL)
+ && (menuPtr->masterMenuPtr->tkwin != NULL)) {
+ TkMenu *masterMenuPtr = cascadeEntryPtr->menuPtr->masterMenuPtr;
+ char *helpMenuName = ckalloc(strlen(Tk_PathName(
+ masterMenuPtr->tkwin)) + strlen(".help") + 1);
+
+ strcpy(helpMenuName, Tk_PathName(masterMenuPtr->tkwin));
+ strcat(helpMenuName, ".help");
+ if (strcmp(helpMenuName,
+ Tk_PathName(menuPtr->masterMenuPtr->tkwin)) == 0) {
+ cascadeEntryPtr->entryFlags |= ENTRY_HELP_MENU;
+ } else {
+ cascadeEntryPtr->entryFlags &= ~ENTRY_HELP_MENU;
+ }
+ ckfree(helpMenuName);
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawMenuEntry --
+ *
+ * Draws the given menu entry at the given coordinates with the
+ * given attributes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * X Server commands are executed to display the menu entry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
+ strictMotif, drawArrow)
+ TkMenuEntry *mePtr; /* The entry to draw */
+ Drawable d; /* What to draw into */
+ Tk_Font tkfont; /* Precalculated font for menu */
+ CONST Tk_FontMetrics *menuMetricsPtr;
+ /* Precalculated metrics for menu */
+ int x; /* X-coordinate of topleft of entry */
+ int y; /* Y-coordinate of topleft of entry */
+ int width; /* Width of the entry rectangle */
+ int height; /* Height of the current rectangle */
+ int strictMotif; /* Boolean flag */
+ int drawArrow; /* Whether or not to draw the cascade
+ * arrow for cascade items. Only applies
+ * to Windows. */
+{
+ GC gc, indicatorGC;
+ TkMenu *menuPtr = mePtr->menuPtr;
+ Tk_3DBorder bgBorder, activeBorder;
+ CONST Tk_FontMetrics *fmPtr;
+ Tk_FontMetrics entryMetrics;
+ int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0;
+ int adjustedY = y + padY;
+ int adjustedHeight = height - 2 * padY;
+
+ /*
+ * Choose the gc for drawing the foreground part of the entry.
+ */
+
+ if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) {
+ gc = mePtr->activeGC;
+ if (gc == NULL) {
+ gc = menuPtr->activeGC;
+ }
+ } else {
+ TkMenuEntry *cascadeEntryPtr;
+ int parentDisabled = 0;
+
+ for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ if (cascadeEntryPtr->namePtr != NULL) {
+ char *name = Tcl_GetStringFromObj(cascadeEntryPtr->namePtr,
+ NULL);
+
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
+ if (cascadeEntryPtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+ }
+
+ if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
+ gc = mePtr->disabledGC;
+ if (gc == NULL) {
+ gc = menuPtr->disabledGC;
+ }
+ } else {
+ gc = mePtr->textGC;
+ if (gc == NULL) {
+ gc = menuPtr->textGC;
+ }
+ }
+ }
+ indicatorGC = mePtr->indicatorGC;
+ if (indicatorGC == NULL) {
+ indicatorGC = menuPtr->indicatorGC;
+ }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL)
+ ? menuPtr->borderPtr : mePtr->borderPtr);
+ if (strictMotif) {
+ activeBorder = bgBorder;
+ } else {
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL)
+ ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr);
+ }
+
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = menuMetricsPtr;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ /*
+ * Need to draw the entire background, including padding. On Unix,
+ * for menubars, we have to draw the rest of the entry taking
+ * into account the padding.
+ */
+
+ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder,
+ bgBorder, x, y, width, height);
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont,
+ fmPtr, x, adjustedY, width, adjustedHeight);
+ } else if (mePtr->type == TEAROFF_ENTRY) {
+ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY,
+ width, adjustedHeight);
+ } else {
+ DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY,
+ width, adjustedHeight);
+ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
+ activeBorder, x, adjustedY, width, adjustedHeight, drawArrow);
+ if (!mePtr->hideMargin) {
+ DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont,
+ fmPtr, x, adjustedY, width, adjustedHeight);
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuLabelGeometry --
+ *
+ * Figures out the size of the label portion of a menu item.
+ *
+ * Results:
+ * widthPtr and heightPtr are filled in with the correct geometry
+ * information.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuLabelGeometry(mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ TkMenuEntry *mePtr; /* The entry we are computing */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated metrics */
+ int *widthPtr; /* The resulting width of the label
+ * portion */
+ int *heightPtr; /* The resulting height of the label
+ * portion */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ int haveImage = 0;
+
+ if (mePtr->image != NULL) {
+ Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
+ haveImage = 1;
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
+ haveImage = 1;
+ } else {
+ *heightPtr = 0;
+ *widthPtr = 0;
+ }
+
+ if (haveImage && (mePtr->compound == COMPOUND_NONE)) {
+ /* We don't care about the text in this case */
+ } else {
+ /* Either it is compound or we don't have an image */
+ if (mePtr->labelPtr != NULL) {
+ int textWidth;
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength);
+
+ if ((mePtr->compound != COMPOUND_NONE) && haveImage) {
+ switch ((enum compound) mePtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ if (textWidth > *widthPtr) {
+ *widthPtr = textWidth;
+ }
+ /* Add text and padding */
+ *heightPtr += fmPtr->linespace + 2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ if (fmPtr->linespace > *heightPtr) {
+ *heightPtr = fmPtr->linespace;
+ }
+ /* Add text and padding */
+ *widthPtr += textWidth + 2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ if (fmPtr->linespace > *heightPtr) {
+ *heightPtr = fmPtr->linespace;
+ }
+ if (textWidth > *widthPtr) {
+ *widthPtr = textWidth;
+ }
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ } else {
+ /* We don't have an image or we're not compound */
+ *heightPtr = fmPtr->linespace;
+ *widthPtr = textWidth;
+ }
+ } else {
+ /* An empty entry still has this height */
+ *heightPtr = fmPtr->linespace;
+ }
+ }
+ *heightPtr += 1;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpComputeStandardMenuGeometry --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu that is not a menubar clone.
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpComputeStandardMenuGeometry(
+ menuPtr) /* Structure describing menu. */
+ TkMenu *menuPtr;
+{
+ Tk_Font tkfont, menuFont;
+ Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
+ int x, y, height, width, indicatorSpace, labelWidth, accelWidth;
+ int windowWidth, windowHeight, accelSpace;
+ int i, j, lastColumnBreak = 0;
+ TkMenuEntry *mePtr;
+ int borderWidth, activeBorderWidth;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ x = y = borderWidth;
+ indicatorSpace = labelWidth = accelWidth = 0;
+ windowHeight = windowWidth = 0;
+
+ /*
+ * On the Mac especially, getting font metrics can be quite slow,
+ * so we want to do it intelligently. We are going to precalculate
+ * them and pass them down to all of the measuring and drawing
+ * routines. We will measure the font metrics of the menu once.
+ * If an entry does not have its own font set, then we give
+ * the geometry/drawing routines the menu's font and metrics.
+ * If an entry has its own font, we will measure that font and
+ * give all of the geometry/drawing the entry's font and metrics.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
+ accelSpace = Tk_TextWidth(menuFont, "M", 1);
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (mePtr->fontPtr == NULL) {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ if ((i > 0) && mePtr->columnBreak) {
+ if (accelWidth != 0) {
+ labelWidth += accelSpace;
+ }
+ for (j = lastColumnBreak; j < i; j++) {
+ menuPtr->entries[j]->indicatorSpace = indicatorSpace;
+ menuPtr->entries[j]->labelWidth = labelWidth;
+ menuPtr->entries[j]->width = indicatorSpace + labelWidth
+ + accelWidth + 2 * activeBorderWidth;
+ menuPtr->entries[j]->x = x;
+ menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
+ }
+ x += indicatorSpace + labelWidth + accelWidth
+ + 2 * activeBorderWidth;
+ windowWidth = x;
+ indicatorSpace = labelWidth = accelWidth = 0;
+ lastColumnBreak = i;
+ y = borderWidth;
+ }
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &width, &height);
+ mePtr->height = height;
+ } else if (mePtr->type == TEAROFF_ENTRY) {
+ GetTearoffEntryGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &width, &height);
+ mePtr->height = height;
+ labelWidth = width;
+ } else {
+
+ /*
+ * For each entry, compute the height required by that
+ * particular entry, plus three widths: the width of the
+ * label, the width to allow for an indicator to be displayed
+ * to the left of the label (if any), and the width of the
+ * accelerator to be displayed to the right of the label
+ * (if any). These sizes depend, of course, on the type
+ * of the entry.
+ */
+
+ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &width,
+ &height);
+ mePtr->height = height;
+ if (!mePtr->hideMargin) {
+ width += MENU_MARGIN_WIDTH;
+ }
+ if (width > labelWidth) {
+ labelWidth = width;
+ }
+
+ GetMenuAccelGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &width, &height);
+ if (height > mePtr->height) {
+ mePtr->height = height;
+ }
+ if (!mePtr->hideMargin) {
+ width += MENU_MARGIN_WIDTH;
+ }
+ if (width > accelWidth) {
+ accelWidth = width;
+ }
+
+ GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &width, &height);
+ if (height > mePtr->height) {
+ mePtr->height = height;
+ }
+ if (!mePtr->hideMargin) {
+ width += MENU_MARGIN_WIDTH;
+ }
+ if (width > indicatorSpace) {
+ indicatorSpace = width;
+ }
+
+ mePtr->height += 2 * activeBorderWidth + MENU_DIVIDER_HEIGHT;
+ }
+ mePtr->y = y;
+ y += mePtr->height;
+ if (y > windowHeight) {
+ windowHeight = y;
+ }
+ }
+
+ if (accelWidth != 0) {
+ labelWidth += accelSpace;
+ }
+ for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
+ menuPtr->entries[j]->indicatorSpace = indicatorSpace;
+ menuPtr->entries[j]->labelWidth = labelWidth;
+ menuPtr->entries[j]->width = indicatorSpace + labelWidth
+ + accelWidth + 2 * activeBorderWidth;
+ menuPtr->entries[j]->x = x;
+ menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
+ }
+ windowWidth = x + indicatorSpace + labelWidth + accelWidth
+ + 2 * activeBorderWidth + 2 * borderWidth;
+
+
+ windowHeight += borderWidth;
+
+ /*
+ * The X server doesn't like zero dimensions, so round up to at least
+ * 1 (a zero-sized menu should never really occur, anyway).
+ */
+
+ if (windowWidth <= 0) {
+ windowWidth = 1;
+ }
+ if (windowHeight <= 0) {
+ windowHeight = 1;
+ }
+ menuPtr->totalWidth = windowWidth;
+ menuPtr->totalHeight = windowHeight;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuNotifyToplevelCreate --
+ *
+ * This routine reconfigures the menu and the clones indicated by
+ * menuName becuase a toplevel has been created and any system
+ * menus need to be created. Not applicable to UNIX.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An idle handler is set up to do the reconfiguration.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuNotifyToplevelCreate(interp, menuName)
+ Tcl_Interp *interp; /* The interp the menu lives in. */
+ char *menuName; /* The name of the menu to
+ * reconfigure. */
+{
+ /*
+ * Nothing to do.
+ */
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuInit --
+ *
+ * Does platform-specific initialization of menus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuInit()
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuThreadInit --
+ *
+ * Does platform-specific initialization of thread-specific
+ * menu state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuThreadInit()
+{
+ /*
+ * Nothing to do.
+ */
+}
+
--- /dev/null
+/*
+ * tkUnixMenubu.c --
+ *
+ * This file implements the Unix specific portion of the
+ * menubutton widget.
+ *
+ * Copyright (c) 1996-1997 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkMenubutton.h"
+
+/*
+ * The structure below defines menubutton class behavior by means of
+ * procedures that can be invoked from generic window code.
+ */
+
+Tk_ClassProcs tkpMenubuttonClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkMenuButtonWorldChanged, /* worldChangedProc */
+};
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateMenuButton --
+ *
+ * Allocate a new TkMenuButton structure.
+ *
+ * Results:
+ * Returns a newly allocated TkMenuButton structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuButton *
+TkpCreateMenuButton(tkwin)
+ Tk_Window tkwin;
+{
+ return (TkMenuButton *)ckalloc(sizeof(TkMenuButton));
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayMenuButton --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayMenuButton(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ GC gc;
+ Tk_3DBorder border;
+ Pixmap pixmap;
+ int x = 0; /* Initialization needed only to stop
+ * compiler warning. */
+ int y = 0;
+ register Tk_Window tkwin = mbPtr->tkwin;
+ int width, height, fullWidth, fullHeight;
+ int imageXOffset, imageYOffset, textXOffset, textYOffset;
+ int haveImage = 0, haveText = 0;
+
+ mbPtr->flags &= ~REDRAW_PENDING;
+ if ((mbPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) {
+ gc = mbPtr->disabledGC;
+ border = mbPtr->normalBorder;
+ } else if ((mbPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(mbPtr->tkwin)) {
+ gc = mbPtr->activeTextGC;
+ border = mbPtr->activeBorder;
+ } else {
+ gc = mbPtr->normalTextGC;
+ border = mbPtr->normalBorder;
+ }
+
+ if (mbPtr->image != None) {
+ Tk_SizeOfImage(mbPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+ haveText = (mbPtr->textWidth != 0 && mbPtr->textHeight != 0);
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the menu button in a pixmap, then copies the pixmap to the
+ * screen in a single operation. This means that there's no
+ * point in time where the on-sreen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(mbPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+ Tk_Fill3DRectangle(tkwin, pixmap, border, 0, 0, Tk_Width(tkwin),
+ Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ imageXOffset = 0;
+ imageYOffset = 0;
+ textXOffset = 0;
+ textYOffset = 0;
+ fullWidth = 0;
+ fullHeight = 0;
+
+ if (mbPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+
+ switch ((enum compound) mbPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (mbPtr->compound == COMPOUND_TOP) {
+ textYOffset = height + mbPtr->padY;
+ } else {
+ imageYOffset = mbPtr->textHeight + mbPtr->padY;
+ }
+ fullHeight = height + mbPtr->textHeight + mbPtr->padY;
+ fullWidth = (width > mbPtr->textWidth ? width :
+ mbPtr->textWidth);
+ textXOffset = (fullWidth - mbPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ if (mbPtr->compound == COMPOUND_LEFT) {
+ textXOffset = width + mbPtr->padX;
+ } else {
+ imageXOffset = mbPtr->textWidth + mbPtr->padX;
+ }
+ fullWidth = mbPtr->textWidth + mbPtr->padX + width;
+ fullHeight = (height > mbPtr->textHeight ? height :
+ mbPtr->textHeight);
+ textYOffset = (fullHeight - mbPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ fullWidth = (width > mbPtr->textWidth ? width :
+ mbPtr->textWidth);
+ fullHeight = (height > mbPtr->textHeight ? height :
+ mbPtr->textHeight);
+ textXOffset = (fullWidth - mbPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ textYOffset = (fullHeight - mbPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ mbPtr->indicatorWidth + fullWidth, fullHeight,
+ &x, &y);
+
+ if (mbPtr->image != NULL) {
+ Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap,
+ x + imageXOffset, y + imageYOffset);
+ }
+ if (mbPtr->bitmap != None) {
+ XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap,
+ gc, 0, 0, (unsigned) width, (unsigned) height,
+ x + imageXOffset, y + imageYOffset, 1);
+ }
+ if (haveText) {
+ Tk_DrawTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout,
+ x + textXOffset, y + textYOffset ,
+ 0, -1);
+ Tk_UnderlineTextLayout(mbPtr->display, pixmap, gc,
+ mbPtr->textLayout, x + textXOffset, y + textYOffset ,
+ mbPtr->underline);
+ }
+ } else {
+ if (mbPtr->image != NULL) {
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ width + mbPtr->indicatorWidth, height, &x, &y);
+ Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap,
+ x + imageXOffset, y + imageYOffset);
+ } else if (mbPtr->bitmap != None) {
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ width + mbPtr->indicatorWidth, height, &x, &y);
+ XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap,
+ gc, 0, 0, (unsigned) width, (unsigned) height,
+ x + imageXOffset, y + imageYOffset, 1);
+ } else {
+ TkComputeAnchor(mbPtr->anchor, tkwin, mbPtr->padX, mbPtr->padY,
+ mbPtr->textWidth + mbPtr->indicatorWidth,
+ mbPtr->textHeight, &x, &y);
+ Tk_DrawTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout,
+ x + textXOffset, y + textYOffset ,
+ 0, -1);
+ Tk_UnderlineTextLayout(mbPtr->display, pixmap, gc,
+ mbPtr->textLayout, x + textXOffset, y + textYOffset ,
+ mbPtr->underline);
+ }
+ }
+
+ /*
+ * If the menu button is disabled with a stipple rather than a special
+ * foreground color, generate the stippled effect.
+ */
+
+ if ((mbPtr->state == STATE_DISABLED)
+ && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) {
+ XFillRectangle(mbPtr->display, pixmap, mbPtr->disabledGC,
+ mbPtr->inset, mbPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset));
+ }
+
+ /*
+ * Draw the cascade indicator for the menu button on the
+ * right side of the window, if desired.
+ */
+
+ if (mbPtr->indicatorOn) {
+ int borderWidth;
+
+ borderWidth = (mbPtr->indicatorHeight+1)/3;
+ if (borderWidth < 1) {
+ borderWidth = 1;
+ }
+ /*y += mbPtr->textHeight / 2;*/
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ Tk_Width(tkwin) - mbPtr->inset - mbPtr->indicatorWidth
+ + mbPtr->indicatorHeight,
+ ((int) (Tk_Height(tkwin) - mbPtr->indicatorHeight))/2,
+ mbPtr->indicatorWidth - 2*mbPtr->indicatorHeight,
+ mbPtr->indicatorHeight, borderWidth, TK_RELIEF_RAISED);
+ }
+
+ /*
+ * Draw the border and traversal highlight last. This way, if the
+ * menu button's contents overflow onto the border they'll be covered
+ * up by the border.
+ */
+
+ if (mbPtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, border,
+ mbPtr->highlightWidth, mbPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*mbPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*mbPtr->highlightWidth,
+ mbPtr->borderWidth, mbPtr->relief);
+ }
+ if (mbPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (mbPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(mbPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(mbPtr->highlightBgColorPtr, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, mbPtr->highlightWidth, pixmap);
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(mbPtr->display, pixmap, Tk_WindowId(tkwin),
+ mbPtr->normalTextGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(mbPtr->display, pixmap);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenuButton --
+ *
+ * Free data structures associated with the menubutton control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the default control state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenuButton(mbPtr)
+ TkMenuButton *mbPtr;
+{
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeMenuButtonGeometry --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpComputeMenuButtonGeometry(mbPtr)
+ TkMenuButton *mbPtr; /* Widget record for menu button. */
+{
+ int width, height, mm, pixels;
+ int avgWidth, txtWidth, txtHeight;
+ int haveImage = 0, haveText = 0;
+ Tk_FontMetrics fm;
+
+ mbPtr->inset = mbPtr->highlightWidth + mbPtr->borderWidth;
+
+ width = 0;
+ height = 0;
+ txtWidth = 0;
+ txtHeight = 0;
+ avgWidth = 0;
+
+ if (mbPtr->image != None) {
+ Tk_SizeOfImage(mbPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+
+ if (haveImage == 0 || mbPtr->compound != COMPOUND_NONE) {
+ Tk_FreeTextLayout(mbPtr->textLayout);
+
+ mbPtr->textLayout = Tk_ComputeTextLayout(mbPtr->tkfont, mbPtr->text,
+ -1, mbPtr->wrapLength, mbPtr->justify, 0, &mbPtr->textWidth,
+ &mbPtr->textHeight);
+ txtWidth = mbPtr->textWidth;
+ txtHeight = mbPtr->textHeight;
+ avgWidth = Tk_TextWidth(mbPtr->tkfont, "0", 1);
+ Tk_GetFontMetrics(mbPtr->tkfont, &fm);
+ haveText = (txtWidth != 0 && txtHeight != 0);
+ }
+
+ /*
+ * If the menubutton is compound (ie, it shows both an image and text),
+ * the new geometry is a combination of the image and text geometry.
+ * We only honor the compound bit if the menubutton has both text and
+ * an image, because otherwise it is not really a compound menubutton.
+ */
+
+ if (mbPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ switch ((enum compound) mbPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ height += txtHeight + mbPtr->padY;
+ width = (width > txtWidth ? width : txtWidth);
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ width += txtWidth + mbPtr->padX;
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ width = (width > txtWidth ? width : txtWidth);
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ if (mbPtr->width > 0) {
+ width = mbPtr->width;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height;
+ }
+ width += 2*mbPtr->padX;
+ height += 2*mbPtr->padY;
+ } else {
+ if (haveImage) {
+ if (mbPtr->width > 0) {
+ width = mbPtr->width;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height;
+ }
+ } else {
+ width = txtWidth;
+ height = txtHeight;
+ if (mbPtr->width > 0) {
+ width = mbPtr->width * avgWidth;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height * fm.linespace;
+ }
+ }
+ }
+
+ if (! haveImage) {
+ width += 2*mbPtr->padX;
+ height += 2*mbPtr->padY;
+ }
+
+ if (mbPtr->indicatorOn) {
+ mm = WidthMMOfScreen(Tk_Screen(mbPtr->tkwin));
+ pixels = WidthOfScreen(Tk_Screen(mbPtr->tkwin));
+ mbPtr->indicatorHeight= (INDICATOR_HEIGHT * pixels)/(10*mm);
+ mbPtr->indicatorWidth = (INDICATOR_WIDTH * pixels)/(10*mm)
+ + 2*mbPtr->indicatorHeight;
+ width += mbPtr->indicatorWidth;
+ } else {
+ mbPtr->indicatorHeight = 0;
+ mbPtr->indicatorWidth = 0;
+ }
+
+ Tk_GeometryRequest(mbPtr->tkwin, (int) (width + 2*mbPtr->inset),
+ (int) (height + 2*mbPtr->inset));
+ Tk_SetInternalBorder(mbPtr->tkwin, mbPtr->inset);
+}
--- /dev/null
+/*
+ * tkUnixPort.h --
+ *
+ * This file is included by all of the Tk C files. It contains
+ * information that may be configuration-dependent, such as
+ * #includes for system include files and a few other things.
+ *
+ * Copyright (c) 1991-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _UNIXPORT
+#define _UNIXPORT
+
+#define __UNIX__ 1
+
+/*
+ * Macro to use instead of "void" for arguments that must have
+ * type "void *" in ANSI C; maps them to type "char *" in
+ * non-ANSI systems. This macro may be used in some of the include
+ * files below, which is why it is defined here.
+ */
+
+#ifndef VOID
+# ifdef __STDC__
+# define VOID void
+# else
+# define VOID char
+# endif
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <fcntl.h>
+#ifdef HAVE_LIMITS_H
+# include <limits.h>
+#else
+# include "../compat/limits.h"
+#endif
+#include <math.h>
+#include <pwd.h>
+#ifdef NO_STDLIB_H
+# include "../compat/stdlib.h"
+#else
+# include <stdlib.h>
+#endif
+#include <string.h>
+#include <sys/types.h>
+#include <sys/file.h>
+#ifdef HAVE_SYS_SELECT_H
+# include <sys/select.h>
+#endif
+#include <sys/stat.h>
+#ifndef _TCL
+# include <tcl.h>
+#endif
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#else
+# include "../compat/unistd.h"
+#endif
+#include <X11/Xlib.h>
+#include <X11/cursorfont.h>
+#include <X11/keysym.h>
+#include <X11/Xatom.h>
+#include <X11/Xproto.h>
+#include <X11/Xresource.h>
+#include <X11/Xutil.h>
+
+/*
+ * The following macro defines the type of the mask arguments to
+ * select:
+ */
+
+#ifndef NO_FD_SET
+# define SELECT_MASK fd_set
+#else
+# ifndef _AIX
+ typedef long fd_mask;
+# endif
+# if defined(_IBMR2)
+# define SELECT_MASK void
+# else
+# define SELECT_MASK int
+# endif
+#endif
+
+/*
+ * The following macro defines the number of fd_masks in an fd_set:
+ */
+
+#ifndef FD_SETSIZE
+# ifdef OPEN_MAX
+# define FD_SETSIZE OPEN_MAX
+# else
+# define FD_SETSIZE 256
+# endif
+#endif
+#if !defined(howmany)
+# define howmany(x, y) (((x)+((y)-1))/(y))
+#endif
+#ifndef NFDBITS
+# define NFDBITS NBBY*sizeof(fd_mask)
+#endif
+#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
+
+/*
+ * Not all systems declare the errno variable in errno.h. so this
+ * file does it explicitly.
+ */
+
+extern int errno;
+
+/*
+ * Define "NBBY" (number of bits per byte) if it's not already defined.
+ */
+
+#ifndef NBBY
+# define NBBY 8
+#endif
+
+/*
+ * These macros are just wrappers for the equivalent X Region calls.
+ */
+
+#define TkClipBox(rgn, rect) XClipBox((Region) rgn, rect)
+#define TkCreateRegion() (TkRegion) XCreateRegion()
+#define TkDestroyRegion(rgn) XDestroyRegion((Region) rgn)
+#define TkIntersectRegion(a, b, r) XIntersectRegion((Region) a, \
+ (Region) b, (Region) r)
+#define TkRectInRegion(r, x, y, w, h) XRectInRegion((Region) r, x, y, w, h)
+#define TkSetRegion(d, gc, rgn) XSetRegion(d, gc, (Region) rgn)
+#define TkSubtractRegion(a, b, r) XSubtractRegion((Region) a, \
+ (Region) b, (Region) r)
+#define TkUnionRectWithRegion(rect, src, ret) XUnionRectWithRegion(rect, \
+ (Region) src, (Region) ret)
+
+/*
+ * The TkPutImage macro strips off the color table information, which isn't
+ * needed for X.
+ */
+
+#define TkPutImage(colors, ncolors, display, pixels, gc, image, destx, desty, srcx, srcy, width, height) \
+ XPutImage(display, pixels, gc, image, destx, desty, srcx, \
+ srcy, width, height);
+
+/*
+ * Supply macros for seek offsets, if they're not already provided by
+ * an include file.
+ */
+
+#ifndef SEEK_SET
+# define SEEK_SET 0
+#endif
+
+#ifndef SEEK_CUR
+# define SEEK_CUR 1
+#endif
+
+#ifndef SEEK_END
+# define SEEK_END 2
+#endif
+
+/*
+ * Declarations for various library procedures that may not be declared
+ * in any other header file.
+ */
+
+
+/*
+ * These functions do nothing under Unix, so we just eliminate calls to them.
+ */
+
+#define TkpButtonSetDefaults(specPtr) {}
+#define TkpDestroyButton(butPtr) {}
+#define TkSelUpdateClipboard(a,b) {}
+#define TkSetPixmapColormap(p,c) {}
+
+/*
+ * These calls implement native bitmaps which are not supported under
+ * UNIX. The macros eliminate the calls.
+ */
+
+#define TkpDefineNativeBitmaps()
+#define TkpCreateNativeBitmap(display, source) None
+#define TkpGetNativeAppBitmap(display, name, w, h) None
+
+/*
+ * This macro stores a representation of the window handle in a string.
+ * This should perhaps use the real size of an XID.
+ */
+
+#define TkpPrintWindowId(buf,w) \
+ sprintf((buf), "%#08lx", (unsigned long) (w))
+
+/*
+ * This macro indicates that entry and text widgets should display
+ * the selection highlight regardless of which window has the focus.
+ */
+
+#define ALWAYS_SHOW_SELECTION
+
+/*
+ * The following declaration is used to get access to a private Tcl interface
+ * that is needed for portability reasons.
+ */
+
+#ifndef _TCLINT
+#include <tclInt.h>
+#endif
+
+#endif /* _UNIXPORT */
--- /dev/null
+/*
+ * tkUnixScale.c --
+ *
+ * This file implements the X specific portion of the scrollbar
+ * widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkScale.h"
+#include "tkInt.h"
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void DisplayHorizontalScale _ANSI_ARGS_((TkScale *scalePtr,
+ Drawable drawable, XRectangle *drawnAreaPtr));
+static void DisplayHorizontalValue _ANSI_ARGS_((TkScale *scalePtr,
+ Drawable drawable, double value, int top));
+static void DisplayVerticalScale _ANSI_ARGS_((TkScale *scalePtr,
+ Drawable drawable, XRectangle *drawnAreaPtr));
+static void DisplayVerticalValue _ANSI_ARGS_((TkScale *scalePtr,
+ Drawable drawable, double value, int rightEdge));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateScale --
+ *
+ * Allocate a new TkScale structure.
+ *
+ * Results:
+ * Returns a newly allocated TkScale structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkScale *
+TkpCreateScale(tkwin)
+ Tk_Window tkwin;
+{
+ return (TkScale *) ckalloc(sizeof(TkScale));
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyScale --
+ *
+ * Destroy a TkScale structure. It's necessary to do this with
+ * Tcl_EventuallyFree to allow the Tcl_Preserve(scalePtr) to work
+ * as expected in TkpDisplayScale. (hobbs)
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyScale(scalePtr)
+ TkScale *scalePtr;
+{
+ Tcl_EventuallyFree((ClientData) scalePtr, TCL_DYNAMIC);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayVerticalScale --
+ *
+ * This procedure redraws the contents of a vertical scale
+ * 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:
+ * There is no return value. If only a part of the scale needs
+ * to be redrawn, then drawnAreaPtr is modified to reflect the
+ * area that was actually modified.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr)
+ TkScale *scalePtr; /* Widget record for scale. */
+ Drawable drawable; /* Where to display scale (window
+ * or pixmap). */
+ XRectangle *drawnAreaPtr; /* Initally contains area of window;
+ * if only a part of the scale is
+ * redrawn, gets modified to reflect
+ * the part of the window that was
+ * redrawn. */
+{
+ Tk_Window tkwin = scalePtr->tkwin;
+ int x, y, width, height, shadowWidth;
+ double tickValue, tickInterval = scalePtr->tickInterval;
+ Tk_3DBorder sliderBorder;
+
+ /*
+ * Display the information from left to right across the window.
+ */
+
+ if (!(scalePtr->flags & REDRAW_OTHER)) {
+ drawnAreaPtr->x = scalePtr->vertTickRightX;
+ drawnAreaPtr->y = scalePtr->inset;
+ drawnAreaPtr->width = scalePtr->vertTroughX + scalePtr->width
+ + 2*scalePtr->borderWidth - scalePtr->vertTickRightX;
+ drawnAreaPtr->height -= 2*scalePtr->inset;
+ }
+ Tk_Fill3DRectangle(tkwin, drawable, scalePtr->bgBorder,
+ drawnAreaPtr->x, drawnAreaPtr->y, drawnAreaPtr->width,
+ drawnAreaPtr->height, 0, TK_RELIEF_FLAT);
+ if (scalePtr->flags & REDRAW_OTHER) {
+ /*
+ * Display the tick marks.
+ */
+
+ if (tickInterval != 0) {
+ double ticks, maxTicks;
+
+ /*
+ * Ensure that we will only draw enough of the tick values
+ * such that they don't overlap
+ */
+ ticks = fabs((scalePtr->toValue - scalePtr->fromValue)
+ / tickInterval);
+ maxTicks = (double) Tk_Height(tkwin)
+ / (double) scalePtr->fontHeight;
+ if (ticks > maxTicks) {
+ tickInterval *= (ticks / maxTicks);
+ }
+ for (tickValue = scalePtr->fromValue; ;
+ tickValue += tickInterval) {
+ /*
+ * The TkRoundToResolution call gets rid of accumulated
+ * round-off errors, if any.
+ */
+
+ tickValue = TkRoundToResolution(scalePtr, tickValue);
+ if (scalePtr->toValue >= scalePtr->fromValue) {
+ if (tickValue > scalePtr->toValue) {
+ break;
+ }
+ } else {
+ if (tickValue < scalePtr->toValue) {
+ break;
+ }
+ }
+ DisplayVerticalValue(scalePtr, drawable, tickValue,
+ scalePtr->vertTickRightX);
+ }
+ }
+ }
+
+ /*
+ * Display the value, if it is desired.
+ */
+
+ if (scalePtr->showValue) {
+ DisplayVerticalValue(scalePtr, drawable, scalePtr->value,
+ scalePtr->vertValueRightX);
+ }
+
+ /*
+ * Display the trough and the slider.
+ */
+
+ Tk_Draw3DRectangle(tkwin, drawable,
+ scalePtr->bgBorder, scalePtr->vertTroughX, scalePtr->inset,
+ scalePtr->width + 2*scalePtr->borderWidth,
+ Tk_Height(tkwin) - 2*scalePtr->inset, scalePtr->borderWidth,
+ TK_RELIEF_SUNKEN);
+ XFillRectangle(scalePtr->display, drawable, scalePtr->troughGC,
+ scalePtr->vertTroughX + scalePtr->borderWidth,
+ scalePtr->inset + scalePtr->borderWidth,
+ (unsigned) scalePtr->width,
+ (unsigned) (Tk_Height(tkwin) - 2*scalePtr->inset
+ - 2*scalePtr->borderWidth));
+ if (scalePtr->state == STATE_ACTIVE) {
+ sliderBorder = scalePtr->activeBorder;
+ } else {
+ sliderBorder = scalePtr->bgBorder;
+ }
+ width = scalePtr->width;
+ height = scalePtr->sliderLength/2;
+ x = scalePtr->vertTroughX + scalePtr->borderWidth;
+ y = TkScaleValueToPixel(scalePtr, scalePtr->value) - height;
+ shadowWidth = scalePtr->borderWidth/2;
+ if (shadowWidth == 0) {
+ shadowWidth = 1;
+ }
+ Tk_Draw3DRectangle(tkwin, drawable, sliderBorder, x, y, width,
+ 2*height, shadowWidth, scalePtr->sliderRelief);
+ x += shadowWidth;
+ y += shadowWidth;
+ width -= 2*shadowWidth;
+ height -= shadowWidth;
+ Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y, width,
+ height, shadowWidth, scalePtr->sliderRelief);
+ Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y+height,
+ width, height, shadowWidth, scalePtr->sliderRelief);
+
+ /*
+ * Draw the label to the right of the scale.
+ */
+
+ if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
+ scalePtr->tkfont, scalePtr->label,
+ scalePtr->labelLength, scalePtr->vertLabelX,
+ scalePtr->inset + (3*fm.ascent)/2);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayVerticalValue --
+ *
+ * This procedure is called to display values (scale readings)
+ * for vertically-oriented scales.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The numerical value corresponding to value is displayed with
+ * its right edge at "rightEdge", and at a vertical position in
+ * the scale that corresponds to "value".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayVerticalValue(scalePtr, drawable, value, rightEdge)
+ register TkScale *scalePtr; /* Information about widget in which to
+ * display value. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * the value. */
+ double value; /* Y-coordinate of number to display,
+ * specified in application coords, not
+ * in pixels (we'll compute pixels). */
+ int rightEdge; /* X-coordinate of right edge of text,
+ * specified in pixels. */
+{
+ register Tk_Window tkwin = scalePtr->tkwin;
+ int y, width, length;
+ char valueString[PRINT_CHARS];
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ y = TkScaleValueToPixel(scalePtr, value) + fm.ascent/2;
+ sprintf(valueString, scalePtr->format, value);
+ length = (int) strlen(valueString);
+ width = Tk_TextWidth(scalePtr->tkfont, valueString, length);
+
+ /*
+ * Adjust the y-coordinate if necessary to keep the text entirely
+ * inside the window.
+ */
+
+ if ((y - fm.ascent) < (scalePtr->inset + SPACING)) {
+ y = scalePtr->inset + SPACING + fm.ascent;
+ }
+ if ((y + fm.descent) > (Tk_Height(tkwin) - scalePtr->inset - SPACING)) {
+ y = Tk_Height(tkwin) - scalePtr->inset - SPACING - fm.descent;
+ }
+ Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
+ scalePtr->tkfont, valueString, length, rightEdge - width, y);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayHorizontalScale --
+ *
+ * This procedure redraws the contents of a horizontal scale
+ * 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:
+ * There is no return value. If only a part of the scale needs
+ * to be redrawn, then drawnAreaPtr is modified to reflect the
+ * area that was actually modified.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayHorizontalScale(scalePtr, drawable, drawnAreaPtr)
+ TkScale *scalePtr; /* Widget record for scale. */
+ Drawable drawable; /* Where to display scale (window
+ * or pixmap). */
+ XRectangle *drawnAreaPtr; /* Initally contains area of window;
+ * if only a part of the scale is
+ * redrawn, gets modified to reflect
+ * the part of the window that was
+ * redrawn. */
+{
+ register Tk_Window tkwin = scalePtr->tkwin;
+ int x, y, width, height, shadowWidth;
+ double tickValue, tickInterval = scalePtr->tickInterval;
+ Tk_3DBorder sliderBorder;
+
+ /*
+ * Display the information from bottom to top across the window.
+ */
+
+ if (!(scalePtr->flags & REDRAW_OTHER)) {
+ drawnAreaPtr->x = scalePtr->inset;
+ drawnAreaPtr->y = scalePtr->horizValueY;
+ drawnAreaPtr->width -= 2*scalePtr->inset;
+ drawnAreaPtr->height = scalePtr->horizTroughY + scalePtr->width
+ + 2*scalePtr->borderWidth - scalePtr->horizValueY;
+ }
+ Tk_Fill3DRectangle(tkwin, drawable, scalePtr->bgBorder,
+ drawnAreaPtr->x, drawnAreaPtr->y, drawnAreaPtr->width,
+ drawnAreaPtr->height, 0, TK_RELIEF_FLAT);
+ if (scalePtr->flags & REDRAW_OTHER) {
+ /*
+ * Display the tick marks.
+ */
+
+ if (tickInterval != 0) {
+ char valueString[PRINT_CHARS];
+ double ticks, maxTicks;
+
+ /*
+ * Ensure that we will only draw enough of the tick values
+ * such that they don't overlap. We base this off the width that
+ * fromValue would take. Not exact, but better than no constraint.
+ */
+ ticks = fabs((scalePtr->toValue - scalePtr->fromValue)
+ / tickInterval);
+ sprintf(valueString, scalePtr->format, scalePtr->fromValue);
+ maxTicks = (double) Tk_Width(tkwin)
+ / (double) Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+ if (ticks > maxTicks) {
+ tickInterval *= (ticks / maxTicks);
+ }
+ for (tickValue = scalePtr->fromValue; ;
+ tickValue += tickInterval) {
+ /*
+ * The TkRoundToResolution call gets rid of accumulated
+ * round-off errors, if any.
+ */
+
+ tickValue = TkRoundToResolution(scalePtr, tickValue);
+ if (scalePtr->toValue >= scalePtr->fromValue) {
+ if (tickValue > scalePtr->toValue) {
+ break;
+ }
+ } else {
+ if (tickValue < scalePtr->toValue) {
+ break;
+ }
+ }
+ DisplayHorizontalValue(scalePtr, drawable, tickValue,
+ scalePtr->horizTickY);
+ }
+ }
+ }
+
+ /*
+ * Display the value, if it is desired.
+ */
+
+ if (scalePtr->showValue) {
+ DisplayHorizontalValue(scalePtr, drawable, scalePtr->value,
+ scalePtr->horizValueY);
+ }
+
+ /*
+ * Display the trough and the slider.
+ */
+
+ y = scalePtr->horizTroughY;
+ Tk_Draw3DRectangle(tkwin, drawable,
+ scalePtr->bgBorder, scalePtr->inset, y,
+ Tk_Width(tkwin) - 2*scalePtr->inset,
+ scalePtr->width + 2*scalePtr->borderWidth,
+ scalePtr->borderWidth, TK_RELIEF_SUNKEN);
+ XFillRectangle(scalePtr->display, drawable, scalePtr->troughGC,
+ scalePtr->inset + scalePtr->borderWidth,
+ y + scalePtr->borderWidth,
+ (unsigned) (Tk_Width(tkwin) - 2*scalePtr->inset
+ - 2*scalePtr->borderWidth),
+ (unsigned) scalePtr->width);
+ if (scalePtr->state == STATE_ACTIVE) {
+ sliderBorder = scalePtr->activeBorder;
+ } else {
+ sliderBorder = scalePtr->bgBorder;
+ }
+ width = scalePtr->sliderLength/2;
+ height = scalePtr->width;
+ x = TkScaleValueToPixel(scalePtr, scalePtr->value) - width;
+ y += scalePtr->borderWidth;
+ shadowWidth = scalePtr->borderWidth/2;
+ if (shadowWidth == 0) {
+ shadowWidth = 1;
+ }
+ Tk_Draw3DRectangle(tkwin, drawable, sliderBorder,
+ x, y, 2*width, height, shadowWidth, scalePtr->sliderRelief);
+ x += shadowWidth;
+ y += shadowWidth;
+ width -= shadowWidth;
+ height -= 2*shadowWidth;
+ Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y, width, height,
+ shadowWidth, scalePtr->sliderRelief);
+ Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x+width, y,
+ width, height, shadowWidth, scalePtr->sliderRelief);
+
+ /*
+ * Draw the label at the top of the scale.
+ */
+
+ if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
+ scalePtr->tkfont, scalePtr->label,
+ scalePtr->labelLength, scalePtr->inset + fm.ascent/2,
+ scalePtr->horizLabelY + fm.ascent);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayHorizontalValue --
+ *
+ * This procedure is called to display values (scale readings)
+ * for horizontally-oriented scales.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The numerical value corresponding to value is displayed with
+ * its bottom edge at "bottom", and at a horizontal position in
+ * the scale that corresponds to "value".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayHorizontalValue(scalePtr, drawable, value, top)
+ register TkScale *scalePtr; /* Information about widget in which to
+ * display value. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * the value. */
+ double value; /* X-coordinate of number to display,
+ * specified in application coords, not
+ * in pixels (we'll compute pixels). */
+ int top; /* Y-coordinate of top edge of text,
+ * specified in pixels. */
+{
+ register Tk_Window tkwin = scalePtr->tkwin;
+ int x, y, length, width;
+ char valueString[PRINT_CHARS];
+ Tk_FontMetrics fm;
+
+ x = TkScaleValueToPixel(scalePtr, value);
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ y = top + fm.ascent;
+ sprintf(valueString, scalePtr->format, value);
+ length = (int) strlen(valueString);
+ width = Tk_TextWidth(scalePtr->tkfont, valueString, length);
+
+ /*
+ * Adjust the x-coordinate if necessary to keep the text entirely
+ * inside the window.
+ */
+
+ x -= (width)/2;
+ if (x < (scalePtr->inset + SPACING)) {
+ x = scalePtr->inset + SPACING;
+ }
+ if (x > (Tk_Width(tkwin) - scalePtr->inset)) {
+ x = Tk_Width(tkwin) - scalePtr->inset - SPACING - width;
+ }
+ Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
+ scalePtr->tkfont, valueString, length, x, y);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayScale --
+ *
+ * This procedure is invoked as an idle handler to redisplay
+ * the contents of a scale widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The scale gets redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayScale(clientData)
+ ClientData clientData; /* Widget record for scale. */
+{
+ TkScale *scalePtr = (TkScale *) clientData;
+ Tk_Window tkwin = scalePtr->tkwin;
+ Tcl_Interp *interp = scalePtr->interp;
+ Pixmap pixmap;
+ int result;
+ char string[PRINT_CHARS];
+ XRectangle drawnArea;
+
+ scalePtr->flags &= ~REDRAW_PENDING;
+ if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
+ goto done;
+ }
+
+ /*
+ * Invoke the scale's command if needed.
+ */
+ Tcl_Preserve((ClientData) scalePtr);
+ if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {
+ Tcl_Preserve((ClientData) interp);
+ sprintf(string, scalePtr->format, scalePtr->value);
+ result = Tcl_VarEval(interp, scalePtr->command, " ", string,
+ (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (command executed by scale)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+ }
+ scalePtr->flags &= ~INVOKE_COMMAND;
+ if (scalePtr->flags & SCALE_DELETED) {
+ Tcl_Release((ClientData) scalePtr);
+ return;
+ }
+ Tcl_Release((ClientData) scalePtr);
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the scale in a pixmap, then copies the pixmap to the
+ * screen in a single operation. This means that there's no
+ * point in time where the on-sreen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(scalePtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+ drawnArea.x = 0;
+ drawnArea.y = 0;
+ drawnArea.width = Tk_Width(tkwin);
+ drawnArea.height = Tk_Height(tkwin);
+
+ /*
+ * Much of the redisplay is done totally differently for
+ * horizontal and vertical scales. Handle the part that's
+ * different.
+ */
+
+ if (scalePtr->orient == ORIENT_VERTICAL) {
+ DisplayVerticalScale(scalePtr, pixmap, &drawnArea);
+ } else {
+ DisplayHorizontalScale(scalePtr, pixmap, &drawnArea);
+ }
+
+ /*
+ * Now handle the part of redisplay that is the same for
+ * horizontal and vertical scales: border and traversal
+ * highlight.
+ */
+
+ if (scalePtr->flags & REDRAW_OTHER) {
+ if (scalePtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, scalePtr->bgBorder,
+ scalePtr->highlightWidth, scalePtr->highlightWidth,
+ Tk_Width(tkwin) - 2*scalePtr->highlightWidth,
+ Tk_Height(tkwin) - 2*scalePtr->highlightWidth,
+ scalePtr->borderWidth, scalePtr->relief);
+ }
+ if (scalePtr->highlightWidth != 0) {
+ GC gc;
+
+ if (scalePtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(
+ Tk_3DBorderColor(scalePtr->highlightBorder), pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap);
+ }
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(scalePtr->display, pixmap, Tk_WindowId(tkwin),
+ scalePtr->copyGC, drawnArea.x, drawnArea.y, drawnArea.width,
+ drawnArea.height, drawnArea.x, drawnArea.y);
+ Tk_FreePixmap(scalePtr->display, pixmap);
+
+ done:
+ scalePtr->flags &= ~REDRAW_ALL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpScaleElement --
+ *
+ * Determine which part of a scale widget lies under a given
+ * point.
+ *
+ * Results:
+ * The return value is either TROUGH1, SLIDER, TROUGH2, or
+ * OTHER, depending on which of the scale's active elements
+ * (if any) is under the point at (x,y).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpScaleElement(scalePtr, x, y)
+ TkScale *scalePtr; /* Widget record for scale. */
+ int x, y; /* Coordinates within scalePtr's window. */
+{
+ int sliderFirst;
+
+ if (scalePtr->orient == ORIENT_VERTICAL) {
+ if ((x < scalePtr->vertTroughX)
+ || (x >= (scalePtr->vertTroughX + 2*scalePtr->borderWidth +
+ scalePtr->width))) {
+ return OTHER;
+ }
+ if ((y < scalePtr->inset)
+ || (y >= (Tk_Height(scalePtr->tkwin) - scalePtr->inset))) {
+ return OTHER;
+ }
+ sliderFirst = TkScaleValueToPixel(scalePtr, scalePtr->value)
+ - scalePtr->sliderLength/2;
+ if (y < sliderFirst) {
+ return TROUGH1;
+ }
+ if (y < (sliderFirst+scalePtr->sliderLength)) {
+ return SLIDER;
+ }
+ return TROUGH2;
+ }
+
+ if ((y < scalePtr->horizTroughY)
+ || (y >= (scalePtr->horizTroughY + 2*scalePtr->borderWidth +
+ scalePtr->width))) {
+ return OTHER;
+ }
+ if ((x < scalePtr->inset)
+ || (x >= (Tk_Width(scalePtr->tkwin) - scalePtr->inset))) {
+ return OTHER;
+ }
+ sliderFirst = TkScaleValueToPixel(scalePtr, scalePtr->value)
+ - scalePtr->sliderLength/2;
+ if (x < sliderFirst) {
+ return TROUGH1;
+ }
+ if (x < (sliderFirst+scalePtr->sliderLength)) {
+ return SLIDER;
+ }
+ return TROUGH2;
+}
--- /dev/null
+/*
+ * tkUnixScrollbar.c --
+ *
+ * This file implements the Unix specific portion of the scrollbar
+ * widget.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkScrollbar.h"
+
+/*
+ * Minimum slider length, in pixels (designed to make sure that the slider
+ * is always easy to grab with the mouse).
+ */
+
+#define MIN_SLIDER_LENGTH 5
+
+/*
+ * Declaration of Unix specific scrollbar structure.
+ */
+
+typedef struct UnixScrollbar {
+ TkScrollbar info; /* Generic scrollbar info. */
+ GC troughGC; /* For drawing trough. */
+ GC copyGC; /* Used for copying from pixmap onto screen. */
+} UnixScrollbar;
+
+/*
+ * The class procedure table for the scrollbar widget. All fields except
+ * size are left initialized to NULL, which should happen automatically
+ * since the variable is declared at this scope.
+ */
+
+Tk_ClassProcs tkpScrollbarProcs = {
+ sizeof(Tk_ClassProcs) /* size */
+};
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateScrollbar --
+ *
+ * Allocate a new TkScrollbar structure.
+ *
+ * Results:
+ * Returns a newly allocated TkScrollbar structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkScrollbar *
+TkpCreateScrollbar(tkwin)
+ Tk_Window tkwin;
+{
+ UnixScrollbar *scrollPtr = (UnixScrollbar *)ckalloc(sizeof(UnixScrollbar));
+ scrollPtr->troughGC = None;
+ scrollPtr->copyGC = None;
+
+ Tk_CreateEventHandler(tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ TkScrollbarEventProc, (ClientData) scrollPtr);
+
+ return (TkScrollbar *) scrollPtr;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpDisplayScrollbar --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpDisplayScrollbar(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+ register Tk_Window tkwin = scrollPtr->tkwin;
+ XPoint points[7];
+ Tk_3DBorder border;
+ int relief, width, elementBorderWidth;
+ Pixmap pixmap;
+
+ if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ goto done;
+ }
+
+ if (scrollPtr->vertical) {
+ width = Tk_Width(tkwin) - 2*scrollPtr->inset;
+ } else {
+ width = Tk_Height(tkwin) - 2*scrollPtr->inset;
+ }
+ elementBorderWidth = scrollPtr->elementBorderWidth;
+ if (elementBorderWidth < 0) {
+ elementBorderWidth = scrollPtr->borderWidth;
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the scrollbar in a pixmap, then copies the pixmap to the
+ * screen in a single operation. This means that there's no
+ * point in time where the on-sreen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(scrollPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ if (scrollPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (scrollPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(scrollPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(scrollPtr->highlightBgColorPtr, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, scrollPtr->highlightWidth, pixmap);
+ }
+ Tk_Draw3DRectangle(tkwin, pixmap, scrollPtr->bgBorder,
+ scrollPtr->highlightWidth, scrollPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*scrollPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*scrollPtr->highlightWidth,
+ scrollPtr->borderWidth, scrollPtr->relief);
+ XFillRectangle(scrollPtr->display, pixmap,
+ ((UnixScrollbar*)scrollPtr)->troughGC,
+ scrollPtr->inset, scrollPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*scrollPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*scrollPtr->inset));
+
+ /*
+ * Draw the top or left arrow. The coordinates of the polygon
+ * points probably seem odd, but they were carefully chosen with
+ * respect to X's rules for filling polygons. These point choices
+ * cause the arrows to just fill the narrow dimension of the
+ * scrollbar and be properly centered.
+ */
+
+ if (scrollPtr->activeField == TOP_ARROW) {
+ border = scrollPtr->activeBorder;
+ relief = scrollPtr->activeField == TOP_ARROW ? scrollPtr->activeRelief
+ : TK_RELIEF_RAISED;
+ } else {
+ border = scrollPtr->bgBorder;
+ relief = TK_RELIEF_RAISED;
+ }
+ if (scrollPtr->vertical) {
+ points[0].x = scrollPtr->inset - 1;
+ points[0].y = scrollPtr->arrowLength + scrollPtr->inset - 1;
+ points[1].x = width + scrollPtr->inset;
+ points[1].y = points[0].y;
+ points[2].x = width/2 + scrollPtr->inset;
+ points[2].y = scrollPtr->inset - 1;
+ Tk_Fill3DPolygon(tkwin, pixmap, border, points, 3,
+ elementBorderWidth, relief);
+ } else {
+ points[0].x = scrollPtr->arrowLength + scrollPtr->inset - 1;
+ points[0].y = scrollPtr->inset - 1;
+ points[1].x = scrollPtr->inset;
+ points[1].y = width/2 + scrollPtr->inset;
+ points[2].x = points[0].x;
+ points[2].y = width + scrollPtr->inset;
+ Tk_Fill3DPolygon(tkwin, pixmap, border, points, 3,
+ elementBorderWidth, relief);
+ }
+
+ /*
+ * Display the bottom or right arrow.
+ */
+
+ if (scrollPtr->activeField == BOTTOM_ARROW) {
+ border = scrollPtr->activeBorder;
+ relief = scrollPtr->activeField == BOTTOM_ARROW
+ ? scrollPtr->activeRelief : TK_RELIEF_RAISED;
+ } else {
+ border = scrollPtr->bgBorder;
+ relief = TK_RELIEF_RAISED;
+ }
+ if (scrollPtr->vertical) {
+ points[0].x = scrollPtr->inset;
+ points[0].y = Tk_Height(tkwin) - scrollPtr->arrowLength
+ - scrollPtr->inset + 1;
+ points[1].x = width/2 + scrollPtr->inset;
+ points[1].y = Tk_Height(tkwin) - scrollPtr->inset;
+ points[2].x = width + scrollPtr->inset;
+ points[2].y = points[0].y;
+ Tk_Fill3DPolygon(tkwin, pixmap, border,
+ points, 3, elementBorderWidth, relief);
+ } else {
+ points[0].x = Tk_Width(tkwin) - scrollPtr->arrowLength
+ - scrollPtr->inset + 1;
+ points[0].y = scrollPtr->inset - 1;
+ points[1].x = points[0].x;
+ points[1].y = width + scrollPtr->inset;
+ points[2].x = Tk_Width(tkwin) - scrollPtr->inset;
+ points[2].y = width/2 + scrollPtr->inset;
+ Tk_Fill3DPolygon(tkwin, pixmap, border,
+ points, 3, elementBorderWidth, relief);
+ }
+
+ /*
+ * Display the slider.
+ */
+
+ if (scrollPtr->activeField == SLIDER) {
+ border = scrollPtr->activeBorder;
+ relief = scrollPtr->activeField == SLIDER ? scrollPtr->activeRelief
+ : TK_RELIEF_RAISED;
+ } else {
+ border = scrollPtr->bgBorder;
+ relief = TK_RELIEF_RAISED;
+ }
+ if (scrollPtr->vertical) {
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ scrollPtr->inset, scrollPtr->sliderFirst,
+ width, scrollPtr->sliderLast - scrollPtr->sliderFirst,
+ elementBorderWidth, relief);
+ } else {
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ scrollPtr->sliderFirst, scrollPtr->inset,
+ scrollPtr->sliderLast - scrollPtr->sliderFirst, width,
+ elementBorderWidth, relief);
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(scrollPtr->display, pixmap, Tk_WindowId(tkwin),
+ ((UnixScrollbar*)scrollPtr)->copyGC, 0, 0,
+ (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(scrollPtr->display, pixmap);
+
+ done:
+ scrollPtr->flags &= ~REDRAW_PENDING;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeScrollbarGeometry --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TkpComputeScrollbarGeometry(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Scrollbar whose geometry may
+ * have changed. */
+{
+ int width, fieldLength;
+
+ if (scrollPtr->highlightWidth < 0) {
+ scrollPtr->highlightWidth = 0;
+ }
+ scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth;
+ width = (scrollPtr->vertical) ? Tk_Width(scrollPtr->tkwin)
+ : Tk_Height(scrollPtr->tkwin);
+ scrollPtr->arrowLength = width - 2*scrollPtr->inset + 1;
+ fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin)
+ : Tk_Width(scrollPtr->tkwin))
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ if (fieldLength < 0) {
+ fieldLength = 0;
+ }
+ scrollPtr->sliderFirst = fieldLength*scrollPtr->firstFraction;
+ scrollPtr->sliderLast = 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 - 2*scrollPtr->borderWidth)) {
+ scrollPtr->sliderFirst = fieldLength - 2*scrollPtr->borderWidth;
+ }
+ 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 += scrollPtr->arrowLength + scrollPtr->inset;
+ scrollPtr->sliderLast += scrollPtr->arrowLength + scrollPtr->inset;
+
+ /*
+ * 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) {
+ Tk_GeometryRequest(scrollPtr->tkwin,
+ scrollPtr->width + 2*scrollPtr->inset,
+ 2*(scrollPtr->arrowLength + scrollPtr->borderWidth
+ + scrollPtr->inset));
+ } else {
+ Tk_GeometryRequest(scrollPtr->tkwin,
+ 2*(scrollPtr->arrowLength + scrollPtr->borderWidth
+ + scrollPtr->inset), scrollPtr->width + 2*scrollPtr->inset);
+ }
+ Tk_SetInternalBorder(scrollPtr->tkwin, scrollPtr->inset);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyScrollbar --
+ *
+ * Free data structures associated with the scrollbar control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the GCs associated with the scrollbar.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyScrollbar(scrollPtr)
+ TkScrollbar *scrollPtr;
+{
+ UnixScrollbar *unixScrollPtr = (UnixScrollbar *)scrollPtr;
+
+ if (unixScrollPtr->troughGC != None) {
+ Tk_FreeGC(scrollPtr->display, unixScrollPtr->troughGC);
+ }
+ if (unixScrollPtr->copyGC != None) {
+ Tk_FreeGC(scrollPtr->display, unixScrollPtr->copyGC);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpConfigureScrollbar --
+ *
+ * This procedure is called after the generic code has finished
+ * processing configuration options, in order to configure
+ * platform specific options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configuration info may get changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpConfigureScrollbar(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Information about widget; may or
+ * may not already have values for
+ * some fields. */
+{
+ XGCValues gcValues;
+ GC new;
+ UnixScrollbar *unixScrollPtr = (UnixScrollbar *) scrollPtr;
+
+ Tk_SetBackgroundFromBorder(scrollPtr->tkwin, scrollPtr->bgBorder);
+
+ gcValues.foreground = scrollPtr->troughColorPtr->pixel;
+ new = Tk_GetGC(scrollPtr->tkwin, GCForeground, &gcValues);
+ if (unixScrollPtr->troughGC != None) {
+ Tk_FreeGC(scrollPtr->display, unixScrollPtr->troughGC);
+ }
+ unixScrollPtr->troughGC = new;
+ if (unixScrollPtr->copyGC == None) {
+ gcValues.graphics_exposures = False;
+ unixScrollPtr->copyGC = Tk_GetGC(scrollPtr->tkwin, GCGraphicsExposures,
+ &gcValues);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpScrollbarPosition --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkpScrollbarPosition(scrollPtr, x, y)
+ register TkScrollbar *scrollPtr; /* Scrollbar widget record. */
+ int x, y; /* Coordinates within scrollPtr's
+ * window. */
+{
+ int length, width, tmp;
+
+ if (scrollPtr->vertical) {
+ length = Tk_Height(scrollPtr->tkwin);
+ width = Tk_Width(scrollPtr->tkwin);
+ } else {
+ tmp = x;
+ x = y;
+ y = tmp;
+ length = Tk_Width(scrollPtr->tkwin);
+ width = Tk_Height(scrollPtr->tkwin);
+ }
+
+ if ((x < scrollPtr->inset) || (x >= (width - scrollPtr->inset))
+ || (y < scrollPtr->inset) || (y >= (length - scrollPtr->inset))) {
+ return OUTSIDE;
+ }
+
+ /*
+ * All of the calculations in this procedure mirror those in
+ * TkpDisplayScrollbar. Be sure to keep the two consistent.
+ */
+
+ if (y < (scrollPtr->inset + scrollPtr->arrowLength)) {
+ return TOP_ARROW;
+ }
+ if (y < scrollPtr->sliderFirst) {
+ return TOP_GAP;
+ }
+ if (y < scrollPtr->sliderLast) {
+ return SLIDER;
+ }
+ if (y >= (length - (scrollPtr->arrowLength + scrollPtr->inset))) {
+ return BOTTOM_ARROW;
+ }
+ return BOTTOM_GAP;
+}
--- /dev/null
+/*
+ * tkUnixSelect.c --
+ *
+ * This file contains X specific routines for manipulating
+ * selections.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+typedef struct ConvertInfo {
+ int offset; /* The starting byte offset into the selection
+ * for the next chunk; -1 means all data has
+ * been transferred for this conversion. -2
+ * means only the final zero-length transfer
+ * still has to be done. Otherwise it is the
+ * offset of the next chunk of data to
+ * transfer. */
+ Tcl_EncodingState state; /* The encoding state needed across chunks. */
+ char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character
+ * that is split across chunks.*/
+} ConvertInfo;
+
+/*
+ * When handling INCR-style selection retrievals, the selection owner
+ * uses the following data structure to communicate between the
+ * ConvertSelection procedure and TkSelPropProc.
+ */
+
+typedef struct IncrInfo {
+ TkWindow *winPtr; /* Window that owns selection. */
+ Atom selection; /* Selection that is being retrieved. */
+ Atom *multAtoms; /* Information about conversions to
+ * perform: one or more pairs of
+ * (target, property). This either
+ * points to a retrieved property (for
+ * MULTIPLE retrievals) or to a static
+ * array. */
+ unsigned long numConversions;
+ /* Number of entries in converts (same as
+ * # of pairs in multAtoms). */
+ ConvertInfo *converts; /* One entry for each pair in multAtoms.
+ * This array is malloc-ed. */
+ char **tempBufs; /* One pointer for each pair in multAtoms;
+ * each pointer is either NULL, or it points
+ * to a small bit of character data that was
+ * left over from the previous chunk. */
+ Tcl_EncodingState *state; /* One state info per pair in multAtoms:
+ * State info for encoding conversions
+ * that span multiple buffers. */
+ int *flags; /* One state flag per pair in multAtoms:
+ * Encoding flags, set to TCL_ENCODING_START
+ * at the beginning of an INCR transfer. */
+ int numIncrs; /* Number of entries in converts that
+ * aren't -1 (i.e. # of INCR-mode transfers
+ * not yet completed). */
+ Tcl_TimerToken timeout; /* Token for timer procedure. */
+ int idleTime; /* Number of seconds since we heard
+ * anything from the selection
+ * requestor. */
+ Window reqWindow; /* Requestor's window id. */
+ Time time; /* Timestamp corresponding to
+ * selection at beginning of request;
+ * used to abort transfer if selection
+ * changes. */
+ struct IncrInfo *nextPtr; /* Next in list of all INCR-style
+ * retrievals currently pending. */
+} IncrInfo;
+
+
+typedef struct ThreadSpecificData {
+ IncrInfo *pendingIncrs; /* List of all incr structures
+ * currently active. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Largest property that we'll accept when sending or receiving the
+ * selection:
+ */
+
+#define MAX_PROP_WORDS 100000
+
+static TkSelRetrievalInfo *pendingRetrievals = NULL;
+ /* List of all retrievals currently
+ * being waited for. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
+ XSelectionRequestEvent *eventPtr));
+static void IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
+static char * SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
+ Atom type, Tk_Window tkwin));
+static long * SelCvtToX _ANSI_ARGS_((char *string, Atom type,
+ Tk_Window tkwin, int *numLongsPtr));
+static int SelectionSize _ANSI_ARGS_((TkSelHandler *selPtr));
+static void SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelGetSelection --
+ *
+ * Retrieve the specified selection from another process.
+ *
+ * Results:
+ * The return value is a standard Tcl return value.
+ * If an error occurs (such as no selection exists)
+ * then an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
+ Tcl_Interp *interp; /* Interpreter to use for reporting
+ * errors. */
+ Tk_Window tkwin; /* Window on whose behalf to retrieve
+ * the selection (determines display
+ * from which to retrieve). */
+ Atom selection; /* Selection to retrieve. */
+ Atom target; /* Desired form in which selection
+ * is to be returned. */
+ Tk_GetSelProc *proc; /* Procedure to call to process the
+ * selection, once it has been retrieved. */
+ ClientData clientData; /* Arbitrary value to pass to proc. */
+{
+ TkSelRetrievalInfo retr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ /*
+ * The selection is owned by some other process. To
+ * retrieve it, first record information about the retrieval
+ * in progress. Use an internal window as the requestor.
+ */
+
+ retr.interp = interp;
+ if (dispPtr->clipWindow == NULL) {
+ int result;
+
+ result = TkClipInit(interp, dispPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ retr.winPtr = (TkWindow *) dispPtr->clipWindow;
+ retr.selection = selection;
+ retr.property = selection;
+ retr.target = target;
+ retr.proc = proc;
+ retr.clientData = clientData;
+ retr.result = -1;
+ retr.idleTime = 0;
+ retr.encFlags = TCL_ENCODING_START;
+ retr.nextPtr = pendingRetrievals;
+ Tcl_DStringInit(&retr.buf);
+ pendingRetrievals = &retr;
+
+ /*
+ * Initiate the request for the selection. Note: can't use
+ * TkCurrentTime for the time. If we do, and this application hasn't
+ * received any X events in a long time, the current time will be way
+ * in the past and could even predate the time when the selection was
+ * made; if this happens, the request will be rejected.
+ */
+
+ XConvertSelection(winPtr->display, retr.selection, retr.target,
+ retr.property, retr.winPtr->window, CurrentTime);
+
+ /*
+ * Enter a loop processing X events until the selection
+ * has been retrieved and processed. If no response is
+ * received within a few seconds, then timeout.
+ */
+
+ retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
+ (ClientData) &retr);
+ while (retr.result == -1) {
+ Tcl_DoOneEvent(0);
+ }
+ Tcl_DeleteTimerHandler(retr.timeout);
+
+ /*
+ * Unregister the information about the selection retrieval
+ * in progress.
+ */
+
+ if (pendingRetrievals == &retr) {
+ pendingRetrievals = retr.nextPtr;
+ } else {
+ TkSelRetrievalInfo *retrPtr;
+
+ for (retrPtr = pendingRetrievals; retrPtr != NULL;
+ retrPtr = retrPtr->nextPtr) {
+ if (retrPtr->nextPtr == &retr) {
+ retrPtr->nextPtr = retr.nextPtr;
+ break;
+ }
+ }
+ }
+ Tcl_DStringFree(&retr.buf);
+ return retr.result;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelPropProc --
+ *
+ * This procedure is invoked when property-change events
+ * occur on windows not known to the toolkit. Its function
+ * is to implement the sending side of the INCR selection
+ * retrieval protocol when the selection requestor deletes
+ * the property containing a part of the selection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the property that is receiving the selection was just
+ * deleted, then a new piece of the selection is fetched and
+ * placed in the property, until eventually there's no more
+ * selection to fetch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelPropProc(eventPtr)
+ register XEvent *eventPtr; /* X PropertyChange event. */
+{
+ register IncrInfo *incrPtr;
+ int i, length, numItems, flags;
+ Tcl_Encoding encoding;
+ int srcLen, dstLen, result, srcRead, dstWrote, soFar;
+ Tcl_DString ds;
+ char *src, *dst;
+ Atom target, formatType;
+ register TkSelHandler *selPtr;
+ long buffer[TK_SEL_WORDS_AT_ONCE];
+ char *propPtr;
+ TkDisplay *dispPtr = TkGetDisplay(eventPtr->xany.display);
+ Tk_ErrorHandler errorHandler;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * See if this event announces the deletion of a property being
+ * used for an INCR transfer. If so, then add the next chunk of
+ * data to the property.
+ */
+
+ if (eventPtr->xproperty.state != PropertyDelete) {
+ return;
+ }
+ for (incrPtr = tsdPtr->pendingIncrs; incrPtr != NULL;
+ incrPtr = incrPtr->nextPtr) {
+ if (incrPtr->reqWindow != eventPtr->xproperty.window) {
+ continue;
+ }
+
+ /*
+ * For each conversion that has been requested, handle any
+ * chunks that haven't been transmitted yet.
+ */
+
+ for (i = 0; i < incrPtr->numConversions; i++) {
+ if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
+ || (incrPtr->converts[i].offset == -1)) {
+ continue;
+ }
+ target = incrPtr->multAtoms[2*i];
+ incrPtr->idleTime = 0;
+
+ /*
+ * Look for a matching selection handler.
+ */
+
+ for (selPtr = incrPtr->winPtr->selHandlerList; ;
+ selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ /*
+ * No handlers match, so mark the conversion as done.
+ */
+
+ incrPtr->multAtoms[2*i + 1] = None;
+ incrPtr->converts[i].offset = -1;
+ incrPtr->numIncrs --;
+ return;
+ }
+ if ((selPtr->target == target)
+ && (selPtr->selection == incrPtr->selection)) {
+ break;
+ }
+ }
+
+ /*
+ * We found a handler, so get the next chunk from it.
+ */
+
+ formatType = selPtr->format;
+ if (incrPtr->converts[i].offset == -2) {
+ /*
+ * We already got the last chunk, so send a null chunk
+ * to indicate that we are finished.
+ */
+
+ numItems = 0;
+ length = 0;
+ } else {
+ TkSelInProgress ip;
+ ip.selPtr = selPtr;
+ ip.nextPtr = TkSelGetInProgress();
+ TkSelSetInProgress(&ip);
+
+ /*
+ * Copy any bytes left over from a partial character at the end
+ * of the previous chunk into the beginning of the buffer.
+ * Pass the rest of the buffer space into the selection
+ * handler.
+ */
+
+ length = strlen(incrPtr->converts[i].buffer);
+ strcpy((char *)buffer, incrPtr->converts[i].buffer);
+
+ numItems = (*selPtr->proc)(selPtr->clientData,
+ incrPtr->converts[i].offset,
+ ((char *) buffer) + length,
+ TK_SEL_BYTES_AT_ONCE - length);
+ TkSelSetInProgress(ip.nextPtr);
+ if (ip.selPtr == NULL) {
+ /*
+ * The selection handler deleted itself.
+ */
+
+ return;
+ }
+ if (numItems < 0) {
+ numItems = 0;
+ }
+ numItems += length;
+ if (numItems > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ }
+ }
+ ((char *) buffer)[numItems] = 0;
+
+ /*
+ * Encode the data using the proper format for each type.
+ */
+
+ if ((formatType == XA_STRING)
+ || (dispPtr
+ && (formatType == dispPtr->compoundTextAtom))) {
+ /*
+ * Set up the encoding state based on the format and whether
+ * this is the first and/or last chunk.
+ */
+
+ flags = 0;
+ if (incrPtr->converts[i].offset == 0) {
+ flags |= TCL_ENCODING_START;
+ }
+ if (numItems < TK_SEL_BYTES_AT_ONCE) {
+ flags |= TCL_ENCODING_END;
+ }
+ if (formatType == XA_STRING) {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ } else {
+ encoding = Tcl_GetEncoding(NULL, "iso2022");
+ }
+
+ /*
+ * Now convert the data.
+ */
+
+ src = (char *)buffer;
+ srcLen = numItems;
+ Tcl_DStringInit(&ds);
+ dst = Tcl_DStringValue(&ds);
+ dstLen = ds.spaceAvl - 1;
+
+
+ /*
+ * Now convert the data, growing the destination buffer
+ * as needed.
+ */
+
+ while (1) {
+ result = Tcl_UtfToExternal(NULL, encoding,
+ src, srcLen, flags,
+ &incrPtr->converts[i].state,
+ dst, dstLen, &srcRead, &dstWrote, NULL);
+ soFar = dst + dstWrote - Tcl_DStringValue(&ds);
+ flags &= ~TCL_ENCODING_START;
+ src += srcRead;
+ srcLen -= srcRead;
+ if (result != TCL_CONVERT_NOSPACE) {
+ Tcl_DStringSetLength(&ds, soFar);
+ break;
+ }
+ if (Tcl_DStringLength(&ds) == 0) {
+ Tcl_DStringSetLength(&ds, dstLen);
+ }
+ Tcl_DStringSetLength(&ds,
+ 2 * Tcl_DStringLength(&ds) + 1);
+ dst = Tcl_DStringValue(&ds) + soFar;
+ dstLen = Tcl_DStringLength(&ds) - soFar - 1;
+ }
+ Tcl_DStringSetLength(&ds, soFar);
+
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+
+ /*
+ * Set the property to the encoded string value.
+ */
+
+ errorHandler = Tk_CreateErrorHandler(
+ eventPtr->xproperty.display, -1, -1, -1,
+ (int (*)()) NULL, (ClientData) NULL);
+ XChangeProperty(eventPtr->xproperty.display,
+ eventPtr->xproperty.window,
+ eventPtr->xproperty.atom, formatType, 8,
+ PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tk_DeleteErrorHandler(errorHandler);
+
+ /*
+ * Preserve any left-over bytes.
+ */
+
+ if (srcLen > TCL_UTF_MAX) {
+ panic("selection conversion left too many bytes unconverted");
+ }
+ memcpy(incrPtr->converts[i].buffer, src, (size_t) srcLen+1);
+ Tcl_DStringFree(&ds);
+ } else {
+ propPtr = (char *) SelCvtToX((char *) buffer,
+ formatType, (Tk_Window) incrPtr->winPtr,
+ &numItems);
+
+ /*
+ * Set the property to the encoded string value.
+ */
+
+ errorHandler = Tk_CreateErrorHandler(
+ eventPtr->xproperty.display, -1, -1, -1,
+ (int (*)()) NULL, (ClientData) NULL);
+ XChangeProperty(eventPtr->xproperty.display,
+ eventPtr->xproperty.window,
+ eventPtr->xproperty.atom, formatType, 8,
+ PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&ds), numItems);
+ Tk_DeleteErrorHandler(errorHandler);
+
+ ckfree(propPtr);
+ }
+
+ /*
+ * Compute the next offset value. If this was the last chunk,
+ * then set the offset to -2. If this was an empty chunk,
+ * then set the offset to -1 to indicate we are done.
+ */
+
+ if (numItems < TK_SEL_BYTES_AT_ONCE) {
+ if (numItems <= 0) {
+ incrPtr->converts[i].offset = -1;
+ incrPtr->numIncrs--;
+ } else {
+ incrPtr->converts[i].offset = -2;
+ }
+ } else {
+ /*
+ * Advance over the selection data that was consumed
+ * this time.
+ */
+
+ incrPtr->converts[i].offset += numItems - length;
+ }
+ return;
+ }
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSelEventProc --
+ *
+ * This procedure is invoked whenever a selection-related
+ * event occurs. It does the lion's share of the work
+ * in implementing the selection protocol.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lots: depends on the type of event.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkSelEventProc(tkwin, eventPtr)
+ Tk_Window tkwin; /* Window for which event was
+ * targeted. */
+ register XEvent *eventPtr; /* X event: either SelectionClear,
+ * SelectionRequest, or
+ * SelectionNotify. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ Tcl_Interp *interp;
+
+ /*
+ * Case #1: SelectionClear events.
+ */
+
+ if (eventPtr->type == SelectionClear) {
+ TkSelClearSelection(tkwin, eventPtr);
+ }
+
+ /*
+ * Case #2: SelectionNotify events. Call the relevant procedure
+ * to handle the incoming selection.
+ */
+
+ if (eventPtr->type == SelectionNotify) {
+ register TkSelRetrievalInfo *retrPtr;
+ char *propInfo;
+ Atom type;
+ int format, result;
+ unsigned long numItems, bytesAfter;
+ Tcl_DString ds;
+
+ for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
+ if (retrPtr == NULL) {
+ return;
+ }
+ if ((retrPtr->winPtr == winPtr)
+ && (retrPtr->selection == eventPtr->xselection.selection)
+ && (retrPtr->target == eventPtr->xselection.target)
+ && (retrPtr->result == -1)) {
+ if (retrPtr->property == eventPtr->xselection.property) {
+ break;
+ }
+ if (eventPtr->xselection.property == None) {
+ Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(retrPtr->interp,
+ Tk_GetAtomName(tkwin, retrPtr->selection),
+ " selection doesn't exist or form \"",
+ Tk_GetAtomName(tkwin, retrPtr->target),
+ "\" not defined", (char *) NULL);
+ retrPtr->result = TCL_ERROR;
+ return;
+ }
+ }
+ }
+
+ propInfo = NULL;
+ result = XGetWindowProperty(eventPtr->xselection.display,
+ eventPtr->xselection.requestor, retrPtr->property,
+ 0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
+ &type, &format, &numItems, &bytesAfter,
+ (unsigned char **) &propInfo);
+ if ((result != Success) || (type == None)) {
+ return;
+ }
+ if (bytesAfter != 0) {
+ Tcl_SetResult(retrPtr->interp, "selection property too large",
+ TCL_STATIC);
+ retrPtr->result = TCL_ERROR;
+ XFree(propInfo);
+ return;
+ }
+ if ((type == XA_STRING) || (type == dispPtr->textAtom)
+ || (type == dispPtr->compoundTextAtom)) {
+ Tcl_Encoding encoding;
+ if (format != 8) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for string selection: wanted \"8\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ return;
+ }
+ interp = retrPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * Convert the X selection data into UTF before passing it
+ * to the selection callback. Note that the COMPOUND_TEXT
+ * uses a modified iso2022 encoding, not the current system
+ * encoding. For now we'll just blindly apply the iso2022
+ * encoding. This is probably wrong, but it's a placeholder
+ * until we figure out what we're really supposed to do. For
+ * STRING, we need to use Latin-1 instead. Again, it's not
+ * really the full iso8859-1 space, but this is close enough.
+ */
+
+ if (type == dispPtr->compoundTextAtom) {
+ encoding = Tcl_GetEncoding(NULL, "iso2022");
+ } else {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ }
+ Tcl_ExternalToUtfDString(encoding, propInfo, (int)numItems, &ds);
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+
+ retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
+ interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ Tcl_Release((ClientData) interp);
+ } else if (type == dispPtr->utf8Atom) {
+ /*
+ * The X selection data is in UTF-8 format already.
+ * We can't guarantee that propInfo is NULL-terminated,
+ * so we might have to copy the string.
+ */
+ char *propData = propInfo;
+
+ if (format != 8) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for string selection: wanted \"8\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ return;
+ }
+
+ if (propInfo[numItems] != '\0') {
+ propData = ckalloc((size_t) numItems + 1);
+ strcpy(propData, propInfo);
+ propData[numItems] = '\0';
+ }
+ retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
+ retrPtr->interp, propData);
+ if (propData != propInfo) {
+ ckfree((char *) propData);
+ }
+ } else if (type == dispPtr->incrAtom) {
+
+ /*
+ * It's a !?#@!?!! INCR-style reception. Arrange to receive
+ * the selection in pieces, using the ICCCM protocol, then
+ * hang around until either the selection is all here or a
+ * timeout occurs.
+ */
+
+ retrPtr->idleTime = 0;
+ Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
+ (ClientData) retrPtr);
+ XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ retrPtr->property);
+ while (retrPtr->result == -1) {
+ Tcl_DoOneEvent(0);
+ }
+ Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
+ (ClientData) retrPtr);
+ } else {
+ char *string;
+
+ if (format != 32) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for selection: wanted \"32\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ return;
+ }
+ string = SelCvtFromX((long *) propInfo, (int) numItems, type,
+ (Tk_Window) winPtr);
+ interp = retrPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
+ interp, string);
+ Tcl_Release((ClientData) interp);
+ ckfree(string);
+ }
+ XFree(propInfo);
+ return;
+ }
+
+ /*
+ * Case #3: SelectionRequest events. Call ConvertSelection to
+ * do the dirty work.
+ */
+
+ if (eventPtr->type == SelectionRequest) {
+ ConvertSelection(winPtr, &eventPtr->xselectionrequest);
+ return;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelTimeoutProc --
+ *
+ * This procedure is invoked once every second while waiting for
+ * the selection to be returned. After a while it gives up and
+ * aborts the selection retrieval.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new timer callback is created to call us again in another
+ * second, unless time has expired, in which case an error is
+ * recorded for the retrieval.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SelTimeoutProc(clientData)
+ ClientData clientData; /* Information about retrieval
+ * in progress. */
+{
+ register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
+
+ /*
+ * Make sure that the retrieval is still in progress. Then
+ * see how long it's been since any sort of response was received
+ * from the other side.
+ */
+
+ if (retrPtr->result != -1) {
+ return;
+ }
+ retrPtr->idleTime++;
+ if (retrPtr->idleTime >= 5) {
+
+ /*
+ * Use a careful procedure to store the error message, because
+ * the result could already be partially filled in with a partial
+ * selection return.
+ */
+
+ Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
+ TCL_STATIC);
+ retrPtr->result = TCL_ERROR;
+ } else {
+ retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
+ (ClientData) retrPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertSelection --
+ *
+ * This procedure is invoked to handle SelectionRequest events.
+ * It responds to the requests, obeying the ICCCM protocols.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties are created for the selection requestor, and a
+ * SelectionNotify event is generated for the selection
+ * requestor. In the event of long selections, this procedure
+ * implements INCR-mode transfers, using the ICCCM protocol.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConvertSelection(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window that received the
+ * conversion request; may not be
+ * selection's current owner, be we
+ * set it to the current owner. */
+ register XSelectionRequestEvent *eventPtr;
+ /* Event describing request. */
+{
+ XSelectionEvent reply; /* Used to notify requestor that
+ * selection info is ready. */
+ int multiple; /* Non-zero means a MULTIPLE request
+ * is being handled. */
+ IncrInfo incr; /* State of selection conversion. */
+ Atom singleInfo[2]; /* incr.multAtoms points here except
+ * for multiple conversions. */
+ int i;
+ Tk_ErrorHandler errorHandler;
+ TkSelectionInfo *infoPtr;
+ TkSelInProgress ip;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
+ (int (*)()) NULL, (ClientData) NULL);
+
+ /*
+ * Initialize the reply event.
+ */
+
+ reply.type = SelectionNotify;
+ reply.serial = 0;
+ reply.send_event = True;
+ reply.display = eventPtr->display;
+ reply.requestor = eventPtr->requestor;
+ reply.selection = eventPtr->selection;
+ reply.target = eventPtr->target;
+ reply.property = eventPtr->property;
+ if (reply.property == None) {
+ reply.property = reply.target;
+ }
+ reply.time = eventPtr->time;
+
+ for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == eventPtr->selection)
+ break;
+ }
+ if (infoPtr == NULL) {
+ goto refuse;
+ }
+ winPtr = (TkWindow *) infoPtr->owner;
+
+ /*
+ * Figure out which kind(s) of conversion to perform. If handling
+ * a MULTIPLE conversion, then read the property describing which
+ * conversions to perform.
+ */
+
+ incr.winPtr = winPtr;
+ incr.selection = eventPtr->selection;
+ if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
+ multiple = 0;
+ singleInfo[0] = reply.target;
+ singleInfo[1] = reply.property;
+ incr.multAtoms = singleInfo;
+ incr.numConversions = 1;
+ } else {
+ Atom type;
+ int format, result;
+ unsigned long bytesAfter;
+
+ multiple = 1;
+ incr.multAtoms = NULL;
+ if (eventPtr->property == None) {
+ goto refuse;
+ }
+ result = XGetWindowProperty(eventPtr->display,
+ eventPtr->requestor, eventPtr->property,
+ 0, MAX_PROP_WORDS, False, XA_ATOM,
+ &type, &format, &incr.numConversions, &bytesAfter,
+ (unsigned char **) &incr.multAtoms);
+ if ((result != Success) || (bytesAfter != 0) || (format != 32)
+ || (type == None)) {
+ if (incr.multAtoms != NULL) {
+ XFree((char *) incr.multAtoms);
+ }
+ goto refuse;
+ }
+ incr.numConversions /= 2; /* Two atoms per conversion. */
+ }
+
+ /*
+ * Loop through all of the requested conversions, and either return
+ * the entire converted selection, if it can be returned in a single
+ * bunch, or return INCR information only (the actual selection will
+ * be returned below).
+ */
+
+ incr.converts = (ConvertInfo *) ckalloc((unsigned)
+ (incr.numConversions*sizeof(ConvertInfo)));
+ incr.numIncrs = 0;
+ for (i = 0; i < incr.numConversions; i++) {
+ Atom target, property, type;
+ long buffer[TK_SEL_WORDS_AT_ONCE];
+ register TkSelHandler *selPtr;
+ int numItems, format;
+ char *propPtr;
+
+ target = incr.multAtoms[2*i];
+ property = incr.multAtoms[2*i + 1];
+ incr.converts[i].offset = -1;
+ incr.converts[i].buffer[0] = '\0';
+
+ for (selPtr = winPtr->selHandlerList; selPtr != NULL;
+ selPtr = selPtr->nextPtr) {
+ if ((selPtr->target == target)
+ && (selPtr->selection == eventPtr->selection)) {
+ break;
+ }
+ }
+
+ if (selPtr == NULL) {
+ /*
+ * Nobody seems to know about this kind of request. If
+ * it's of a sort that we can handle without any help, do
+ * it. Otherwise mark the request as an errror.
+ */
+
+ numItems = TkSelDefaultSelection(infoPtr, target, (char *) buffer,
+ TK_SEL_BYTES_AT_ONCE, &type);
+ if (numItems < 0) {
+ incr.multAtoms[2*i + 1] = None;
+ continue;
+ }
+ } else {
+ ip.selPtr = selPtr;
+ ip.nextPtr = TkSelGetInProgress();
+ TkSelSetInProgress(&ip);
+ type = selPtr->format;
+ numItems = (*selPtr->proc)(selPtr->clientData, 0,
+ (char *) buffer, TK_SEL_BYTES_AT_ONCE);
+ TkSelSetInProgress(ip.nextPtr);
+ if ((ip.selPtr == NULL) || (numItems < 0)) {
+ incr.multAtoms[2*i + 1] = None;
+ continue;
+ }
+ if (numItems > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ }
+ ((char *) buffer)[numItems] = '\0';
+ }
+
+ /*
+ * Got the selection; store it back on the requestor's property.
+ */
+
+ if (numItems == TK_SEL_BYTES_AT_ONCE) {
+ /*
+ * Selection is too big to send at once; start an
+ * INCR-mode transfer.
+ */
+
+ incr.numIncrs++;
+ type = winPtr->dispPtr->incrAtom;
+ buffer[0] = SelectionSize(selPtr);
+ if (buffer[0] == 0) {
+ incr.multAtoms[2*i + 1] = None;
+ continue;
+ }
+ numItems = 1;
+ propPtr = (char *) buffer;
+ format = 32;
+ incr.converts[i].offset = 0;
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, format, PropModeReplace,
+ (unsigned char *) propPtr, numItems);
+ } else if (type == winPtr->dispPtr->utf8Atom) {
+ /*
+ * This matches selection requests of type UTF8_STRING,
+ * which allows us to pass our utf-8 information untouched.
+ */
+
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, 8, PropModeReplace,
+ (unsigned char *) buffer, numItems);
+ } else if ((type == XA_STRING)
+ || (type == winPtr->dispPtr->compoundTextAtom)) {
+ Tcl_DString ds;
+ Tcl_Encoding encoding;
+
+ /*
+ * STRING is Latin-1, COMPOUND_TEXT is an iso2022 variant.
+ * We need to convert the selection text into these external
+ * forms before modifying the property.
+ */
+
+ if (type == XA_STRING) {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ } else {
+ encoding = Tcl_GetEncoding(NULL, "iso2022");
+ }
+ Tcl_UtfToExternalDString(encoding, (char*)buffer, -1, &ds);
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, 8, PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+ Tcl_DStringFree(&ds);
+ } else {
+ propPtr = (char *) SelCvtToX((char *) buffer,
+ type, (Tk_Window) winPtr, &numItems);
+ format = 32;
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, format, PropModeReplace,
+ (unsigned char *) propPtr, numItems);
+ ckfree(propPtr);
+ }
+ }
+
+ /*
+ * Send an event back to the requestor to indicate that the
+ * first stage of conversion is complete (everything is done
+ * except for long conversions that have to be done in INCR
+ * mode).
+ */
+
+ if (incr.numIncrs > 0) {
+ XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
+ incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
+ (ClientData) &incr);
+ incr.idleTime = 0;
+ incr.reqWindow = reply.requestor;
+ incr.time = infoPtr->time;
+ incr.nextPtr = tsdPtr->pendingIncrs;
+ tsdPtr->pendingIncrs = &incr;
+ }
+ if (multiple) {
+ XChangeProperty(reply.display, reply.requestor, reply.property,
+ XA_ATOM, 32, PropModeReplace,
+ (unsigned char *) incr.multAtoms,
+ (int) incr.numConversions*2);
+ } else {
+
+ /*
+ * Not a MULTIPLE request. The first property in "multAtoms"
+ * got set to None if there was an error in conversion.
+ */
+
+ reply.property = incr.multAtoms[1];
+ }
+ XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
+ Tk_DeleteErrorHandler(errorHandler);
+
+ /*
+ * Handle any remaining INCR-mode transfers. This all happens
+ * in callbacks to TkSelPropProc, so just wait until the number
+ * of uncompleted INCR transfers drops to zero.
+ */
+
+ if (incr.numIncrs > 0) {
+ IncrInfo *incrPtr2;
+
+ while (incr.numIncrs > 0) {
+ Tcl_DoOneEvent(0);
+ }
+ Tcl_DeleteTimerHandler(incr.timeout);
+ errorHandler = Tk_CreateErrorHandler(winPtr->display,
+ -1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
+ XSelectInput(reply.display, reply.requestor, 0L);
+ Tk_DeleteErrorHandler(errorHandler);
+ if (tsdPtr->pendingIncrs == &incr) {
+ tsdPtr->pendingIncrs = incr.nextPtr;
+ } else {
+ for (incrPtr2 = tsdPtr->pendingIncrs; incrPtr2 != NULL;
+ incrPtr2 = incrPtr2->nextPtr) {
+ if (incrPtr2->nextPtr == &incr) {
+ incrPtr2->nextPtr = incr.nextPtr;
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * All done. Cleanup and return.
+ */
+
+ ckfree((char *) incr.converts);
+ if (multiple) {
+ XFree((char *) incr.multAtoms);
+ }
+ return;
+
+ /*
+ * An error occurred. Send back a refusal message.
+ */
+
+ refuse:
+ reply.property = None;
+ XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
+ Tk_DeleteErrorHandler(errorHandler);
+ return;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelRcvIncrProc --
+ *
+ * This procedure handles the INCR protocol on the receiving
+ * side. It is invoked in response to property changes on
+ * the requestor's window (which hopefully are because a new
+ * chunk of the selection arrived).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a new piece of selection has arrived, a procedure is
+ * invoked to deal with that piece. When the whole selection
+ * is here, a flag is left for the higher-level procedure that
+ * initiated the selection retrieval.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SelRcvIncrProc(clientData, eventPtr)
+ ClientData clientData; /* Information about retrieval. */
+ register XEvent *eventPtr; /* X PropertyChange event. */
+{
+ register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
+ char *propInfo, *dst, *src;
+ Atom type;
+ int format, result, srcLen, dstLen, srcRead, dstWrote, soFar;
+ unsigned long numItems, bytesAfter;
+ Tcl_DString *dstPtr, temp;
+ Tcl_Interp *interp;
+ Tcl_Encoding encoding;
+
+ if ((eventPtr->xproperty.atom != retrPtr->property)
+ || (eventPtr->xproperty.state != PropertyNewValue)
+ || (retrPtr->result != -1)) {
+ return;
+ }
+ propInfo = NULL;
+ result = XGetWindowProperty(eventPtr->xproperty.display,
+ eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
+ True, (Atom) AnyPropertyType, &type, &format, &numItems,
+ &bytesAfter, (unsigned char **) &propInfo);
+ if ((result != Success) || (type == None)) {
+ return;
+ }
+ if (bytesAfter != 0) {
+ Tcl_SetResult(retrPtr->interp, "selection property too large",
+ TCL_STATIC);
+ retrPtr->result = TCL_ERROR;
+ goto done;
+ }
+ if ((type == XA_STRING)
+ || (type == retrPtr->winPtr->dispPtr->textAtom)
+ || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
+ if (format != 8) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for string selection: wanted \"8\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ goto done;
+ }
+ interp = retrPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ if (type == retrPtr->winPtr->dispPtr->compoundTextAtom) {
+ encoding = Tcl_GetEncoding(NULL, "iso2022");
+ } else {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ }
+
+ /*
+ * Check to see if there is any data left over from the previous
+ * chunk. If there is, copy the old data and the new data into
+ * a new buffer.
+ */
+
+ Tcl_DStringInit(&temp);
+ if (Tcl_DStringLength(&retrPtr->buf) > 0) {
+ Tcl_DStringAppend(&temp, Tcl_DStringValue(&retrPtr->buf),
+ Tcl_DStringLength(&retrPtr->buf));
+ if (numItems > 0) {
+ Tcl_DStringAppend(&temp, propInfo, (int)numItems);
+ }
+ src = Tcl_DStringValue(&temp);
+ srcLen = Tcl_DStringLength(&temp);
+ } else if (numItems == 0) {
+ /*
+ * There is no new data, so we're done.
+ */
+
+ retrPtr->result = TCL_OK;
+ Tcl_Release((ClientData) interp);
+ goto done;
+ } else {
+ src = propInfo;
+ srcLen = numItems;
+ }
+
+ /*
+ * Set up the destination buffer so we can use as much space as
+ * is available.
+ */
+
+ dstPtr = &retrPtr->buf;
+ dst = Tcl_DStringValue(dstPtr);
+ dstLen = dstPtr->spaceAvl - 1;
+
+ /*
+ * Now convert the data, growing the destination buffer as needed.
+ */
+
+ while (1) {
+ result = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+ retrPtr->encFlags, &retrPtr->encState,
+ dst, dstLen, &srcRead, &dstWrote, NULL);
+ soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
+ retrPtr->encFlags &= ~TCL_ENCODING_START;
+ src += srcRead;
+ srcLen -= srcRead;
+ if (result != TCL_CONVERT_NOSPACE) {
+ Tcl_DStringSetLength(dstPtr, soFar);
+ break;
+ }
+ if (Tcl_DStringLength(dstPtr) == 0) {
+ Tcl_DStringSetLength(dstPtr, dstLen);
+ }
+ Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
+ dst = Tcl_DStringValue(dstPtr) + soFar;
+ dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
+ }
+ Tcl_DStringSetLength(dstPtr, soFar);
+
+ result = (*retrPtr->proc)(retrPtr->clientData, interp,
+ Tcl_DStringValue(dstPtr));
+ Tcl_Release((ClientData) interp);
+
+ /*
+ * Copy any unused data into the destination buffer so we can
+ * pick it up next time around.
+ */
+
+ Tcl_DStringSetLength(dstPtr, 0);
+ Tcl_DStringAppend(dstPtr, src, srcLen);
+
+ Tcl_DStringFree(&temp);
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+ if (result != TCL_OK) {
+ retrPtr->result = result;
+ }
+ } else if (numItems == 0) {
+ retrPtr->result = TCL_OK;
+ } else {
+ char *string;
+
+ if (format != 32) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for selection: wanted \"32\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ goto done;
+ }
+ string = SelCvtFromX((long *) propInfo, (int) numItems, type,
+ (Tk_Window) retrPtr->winPtr);
+ interp = retrPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = (*retrPtr->proc)(retrPtr->clientData, interp, string);
+ Tcl_Release((ClientData) interp);
+ if (result != TCL_OK) {
+ retrPtr->result = result;
+ }
+ ckfree(string);
+ }
+
+ done:
+ XFree(propInfo);
+ retrPtr->idleTime = 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelectionSize --
+ *
+ * This procedure is called when the selection is too large to
+ * send in a single buffer; it computes the total length of
+ * the selection in bytes.
+ *
+ * Results:
+ * The return value is the number of bytes in the selection
+ * given by selPtr.
+ *
+ * Side effects:
+ * The selection is retrieved from its current owner (this is
+ * the only way to compute its size).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SelectionSize(selPtr)
+ TkSelHandler *selPtr; /* Information about how to retrieve
+ * the selection whose size is wanted. */
+{
+ char buffer[TK_SEL_BYTES_AT_ONCE+1];
+ int size, chunkSize;
+ TkSelInProgress ip;
+
+ size = TK_SEL_BYTES_AT_ONCE;
+ ip.selPtr = selPtr;
+ ip.nextPtr = TkSelGetInProgress();
+ TkSelSetInProgress(&ip);
+ do {
+ chunkSize = (*selPtr->proc)(selPtr->clientData, size,
+ (char *) buffer, TK_SEL_BYTES_AT_ONCE);
+ if (ip.selPtr == NULL) {
+ size = 0;
+ break;
+ }
+ size += chunkSize;
+ } while (chunkSize == TK_SEL_BYTES_AT_ONCE);
+ TkSelSetInProgress(ip.nextPtr);
+ return size;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * IncrTimeoutProc --
+ *
+ * This procedure is invoked once a second while sending the
+ * selection to a requestor in INCR mode. After a while it
+ * gives up and aborts the selection operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new timeout gets registered so that this procedure gets
+ * called again in another second, unless too many seconds
+ * have elapsed, in which case incrPtr is marked as "all done".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IncrTimeoutProc(clientData)
+ ClientData clientData; /* Information about INCR-mode
+ * selection retrieval for which
+ * we are selection owner. */
+{
+ register IncrInfo *incrPtr = (IncrInfo *) clientData;
+
+ incrPtr->idleTime++;
+ if (incrPtr->idleTime >= 5) {
+ incrPtr->numIncrs = 0;
+ } else {
+ incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
+ (ClientData) incrPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelCvtToX --
+ *
+ * Given a selection represented as a string (the normal Tcl form),
+ * convert it to the ICCCM-mandated format for X, depending on
+ * the type argument. This procedure and SelCvtFromX are inverses.
+ *
+ * Results:
+ * The return value is a malloc'ed buffer holding a value
+ * equivalent to "string", but formatted as for "type". It is
+ * the caller's responsibility to free the string when done with
+ * it. The word at *numLongsPtr is filled in with the number of
+ * 32-bit words returned in the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static long *
+SelCvtToX(string, type, tkwin, numLongsPtr)
+ char *string; /* String representation of selection. */
+ Atom type; /* Atom specifying the X format that is
+ * desired for the selection. Should not
+ * be XA_STRING (if so, don't bother calling
+ * this procedure at all). */
+ Tk_Window tkwin; /* Window that governs atom conversion. */
+ int *numLongsPtr; /* Number of 32-bit words contained in the
+ * result. */
+{
+ register char *p;
+ char *field;
+ int numFields;
+ long *propPtr, *longPtr;
+#define MAX_ATOM_NAME_LENGTH 100
+ char atomName[MAX_ATOM_NAME_LENGTH+1];
+
+ /*
+ * The string is assumed to consist of fields separated by spaces.
+ * The property gets generated by converting each field to an
+ * integer number, in one of two ways:
+ * 1. If type is XA_ATOM, convert each field to its corresponding
+ * atom.
+ * 2. If type is anything else, convert each field from an ASCII number
+ * to a 32-bit binary number.
+ */
+
+ numFields = 1;
+ for (p = string; *p != 0; p++) {
+ if (isspace(UCHAR(*p))) {
+ numFields++;
+ }
+ }
+ propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
+
+ /*
+ * Convert the fields one-by-one.
+ */
+
+ for (longPtr = propPtr, *numLongsPtr = 0, p = string;
+ ; longPtr++, (*numLongsPtr)++) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == 0) {
+ break;
+ }
+ field = p;
+ while ((*p != 0) && !isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (type == XA_ATOM) {
+ int length;
+
+ length = p - field;
+ if (length > MAX_ATOM_NAME_LENGTH) {
+ length = MAX_ATOM_NAME_LENGTH;
+ }
+ strncpy(atomName, field, (unsigned) length);
+ atomName[length] = 0;
+ *longPtr = (long) Tk_InternAtom(tkwin, atomName);
+ } else {
+ char *dummy;
+
+ *longPtr = strtol(field, &dummy, 0);
+ }
+ }
+ return propPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelCvtFromX --
+ *
+ * Given an X property value, formatted as a collection of 32-bit
+ * values according to "type" and the ICCCM conventions, convert
+ * the value to a string suitable for manipulation by Tcl. This
+ * procedure is the inverse of SelCvtToX.
+ *
+ * Results:
+ * The return value is the string equivalent of "property". It is
+ * malloc-ed and should be freed by the caller when no longer
+ * needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+SelCvtFromX(propPtr, numValues, type, tkwin)
+ register long *propPtr; /* Property value from X. */
+ int numValues; /* Number of 32-bit values in property. */
+ Atom type; /* Type of property Should not be
+ * XA_STRING (if so, don't bother calling
+ * this procedure at all). */
+ Tk_Window tkwin; /* Window to use for atom conversion. */
+{
+ char *result;
+ int resultSpace, curSize, fieldSize;
+ CONST char *atomName;
+
+ /*
+ * Convert each long in the property to a string value, which is
+ * either the name of an atom (if type is XA_ATOM) or a hexadecimal
+ * string. Make an initial guess about the size of the result, but
+ * be prepared to enlarge the result if necessary.
+ */
+
+ resultSpace = 12*numValues+1;
+ curSize = 0;
+ atomName = ""; /* Not needed, but eliminates compiler warning. */
+ result = (char *) ckalloc((unsigned) resultSpace);
+ *result = '\0';
+ for ( ; numValues > 0; propPtr++, numValues--) {
+ if (type == XA_ATOM) {
+ atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
+ fieldSize = strlen(atomName) + 1;
+ } else {
+ fieldSize = 12;
+ }
+ if (curSize+fieldSize >= resultSpace) {
+ char *newResult;
+
+ resultSpace *= 2;
+ if (curSize+fieldSize >= resultSpace) {
+ resultSpace = curSize + fieldSize + 1;
+ }
+ newResult = (char *) ckalloc((unsigned) resultSpace);
+ strncpy(newResult, result, (unsigned) curSize);
+ ckfree(result);
+ result = newResult;
+ }
+ if (curSize != 0) {
+ result[curSize] = ' ';
+ curSize++;
+ }
+ if (type == XA_ATOM) {
+ strcpy(result+curSize, atomName);
+ } else {
+ sprintf(result+curSize, "0x%x", (unsigned int) *propPtr);
+ }
+ curSize += strlen(result+curSize);
+ }
+ return result;
+}
--- /dev/null
+/*
+ * tkUnixSend.c --
+ *
+ * This file provides procedures that implement the "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkUnixInt.h"
+
+/*
+ * The following structure is used to keep track of the interpreters
+ * registered by this process.
+ */
+
+typedef struct RegisteredInterp {
+ char *name; /* Interpreter's name (malloc-ed). */
+ Tcl_Interp *interp; /* Interpreter associated with name. NULL
+ * means that the application was unregistered
+ * or deleted while a send was in progress
+ * to it. */
+ TkDisplay *dispPtr; /* Display for the application. Needed
+ * because we may need to unregister the
+ * interpreter after its main window has
+ * been deleted. */
+ struct RegisteredInterp *nextPtr;
+ /* Next in list of names associated
+ * with interps in this process.
+ * NULL means end of list. */
+} RegisteredInterp;
+
+/*
+ * A registry of all interpreters for a display is kept in a
+ * property "InterpRegistry" on the root window of the display.
+ * It is organized as a series of zero or more concatenated strings
+ * (in no particular order), each of the form
+ * window space name '\0'
+ * where "window" is the hex id of the comm. window to use to talk
+ * to an interpreter named "name".
+ *
+ * When the registry is being manipulated by an application (e.g. to
+ * add or remove an entry), it is loaded into memory using a structure
+ * of the following type:
+ */
+
+typedef struct NameRegistry {
+ TkDisplay *dispPtr; /* Display from which the registry was
+ * read. */
+ int locked; /* Non-zero means that the display was
+ * locked when the property was read in. */
+ int modified; /* Non-zero means that the property has
+ * been modified, so it needs to be written
+ * out when the NameRegistry is closed. */
+ unsigned long propLength; /* Length of the property, in bytes. */
+ char *property; /* The contents of the property, or NULL
+ * if none. See format description above;
+ * this is *not* terminated by the first
+ * null character. Dynamically allocated. */
+ int allocedByX; /* Non-zero means must free property with
+ * XFree; zero means use ckfree. */
+} NameRegistry;
+
+/*
+ * When a result is being awaited from a sent command, one of
+ * the following structures is present on a list of all outstanding
+ * sent commands. The information in the structure is used to
+ * process the result when it arrives. You're probably wondering
+ * how there could ever be multiple outstanding sent commands.
+ * This could happen if interpreters invoke each other recursively.
+ * It's unlikely, but possible.
+ */
+
+typedef struct PendingCommand {
+ int serial; /* Serial number expected in
+ * result. */
+ TkDisplay *dispPtr; /* Display being used for communication. */
+ CONST char *target; /* Name of interpreter command is
+ * being sent to. */
+ Window commWindow; /* Target's communication window. */
+ Tcl_Interp *interp; /* Interpreter from which the send
+ * was invoked. */
+ int code; /* Tcl return code for command
+ * will be stored here. */
+ char *result; /* String result for command (malloc'ed),
+ * or NULL. */
+ char *errorInfo; /* Information for "errorInfo" variable,
+ * or NULL (malloc'ed). */
+ char *errorCode; /* Information for "errorCode" variable,
+ * or NULL (malloc'ed). */
+ int gotResponse; /* 1 means a response has been received,
+ * 0 means the command is still outstanding. */
+ struct PendingCommand *nextPtr;
+ /* Next in list of all outstanding
+ * commands. NULL means end of
+ * list. */
+} PendingCommand;
+
+typedef struct ThreadSpecificData {
+ PendingCommand *pendingCommands;
+ /* List of all commands currently
+ * being waited for. */
+ RegisteredInterp *interpListPtr;
+ /* List of all interpreters registered
+ * in the current process. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The information below is used for communication between processes
+ * during "send" commands. Each process keeps a private window, never
+ * even mapped, with one property, "Comm". When a command is sent to
+ * an interpreter, the command is appended to the comm property of the
+ * communication window associated with the interp's process. Similarly,
+ * when a result is returned from a sent command, it is also appended
+ * to the comm property.
+ *
+ * Each command and each result takes the form of ASCII text. For a
+ * command, the text consists of a zero character followed by several
+ * null-terminated ASCII strings. The first string consists of the
+ * single letter "c". Subsequent strings have the form "option value"
+ * where the following options are supported:
+ *
+ * -r commWindow serial
+ *
+ * This option means that a response should be sent to the window
+ * whose X identifier is "commWindow" (in hex), and the response should
+ * be identified with the serial number given by "serial" (in decimal).
+ * If this option isn't specified then the send is asynchronous and
+ * no response is sent.
+ *
+ * -n name
+ * "Name" gives the name of the application for which the command is
+ * intended. This option must be present.
+ *
+ * -s script
+ *
+ * "Script" is the script to be executed. This option must be present.
+ *
+ * The options may appear in any order. The -n and -s options must be
+ * present, but -r may be omitted for asynchronous RPCs. For compatibility
+ * with future releases that may add new features, there may be additional
+ * options present; as long as they start with a "-" character, they will
+ * be ignored.
+ *
+ * A result also consists of a zero character followed by several null-
+ * terminated ASCII strings. The first string consists of the single
+ * letter "r". Subsequent strings have the form "option value" where
+ * the following options are supported:
+ *
+ * -s serial
+ *
+ * Identifies the command for which this is the result. It is the
+ * same as the "serial" field from the -s option in the command. This
+ * option must be present.
+ *
+ * -c code
+ *
+ * "Code" is the completion code for the script, in decimal. If the
+ * code is omitted it defaults to TCL_OK.
+ *
+ * -r result
+ *
+ * "Result" is the result string for the script, which may be either
+ * a result or an error message. If this field is omitted then it
+ * defaults to an empty string.
+ *
+ * -i errorInfo
+ *
+ * "ErrorInfo" gives a string with which to initialize the errorInfo
+ * variable. This option may be omitted; it is ignored unless the
+ * completion code is TCL_ERROR.
+ *
+ * -e errorCode
+ *
+ * "ErrorCode" gives a string with with to initialize the errorCode
+ * variable. This option may be omitted; it is ignored unless the
+ * completion code is TCL_ERROR.
+ *
+ * Options may appear in any order, and only the -s option must be
+ * present. As with commands, there may be additional options besides
+ * these; unknown options are ignored.
+ */
+
+/*
+ * The following variable is the serial number that was used in the
+ * last "send" command. It is exported only for testing purposes.
+ */
+
+int tkSendSerial = 0;
+
+/*
+ * Maximum size property that can be read at one time by
+ * this module:
+ */
+
+#define MAX_PROP_WORDS 100000
+
+/*
+ * The following variable can be set while debugging to do things like
+ * skip locking the server.
+ */
+
+static int sendDebug = 0;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int AppendErrorProc _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errorPtr));
+static void AppendPropCarefully _ANSI_ARGS_((Display *display,
+ Window window, Atom property, char *value,
+ int length, PendingCommand *pendingPtr));
+static void DeleteProc _ANSI_ARGS_((ClientData clientData));
+static void RegAddName _ANSI_ARGS_((NameRegistry *regPtr,
+ CONST char *name, Window commWindow));
+static void RegClose _ANSI_ARGS_((NameRegistry *regPtr));
+static void RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
+ CONST char *name));
+static Window RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
+ CONST char *name));
+static NameRegistry * RegOpen _ANSI_ARGS_((Tcl_Interp *interp,
+ TkDisplay *dispPtr, int lock));
+static void SendEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int SendInit _ANSI_ARGS_((Tcl_Interp *interp,
+ TkDisplay *dispPtr));
+static Tk_RestrictAction SendRestrictProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr));
+static void UpdateCommWindow _ANSI_ARGS_((TkDisplay *dispPtr));
+static int ValidateName _ANSI_ARGS_((TkDisplay *dispPtr,
+ CONST char *name, Window commWindow, int oldOK));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegOpen --
+ *
+ * This procedure loads the name registry for a display into
+ * memory so that it can be manipulated.
+ *
+ * Results:
+ * The return value is a pointer to the loaded registry.
+ *
+ * Side effects:
+ * If "lock" is set then the server will be locked. It is the
+ * caller's responsibility to call RegClose when finished with
+ * the registry, so that we can write back the registry if
+ * needed, unlock the server if needed, and free memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static NameRegistry *
+RegOpen(interp, dispPtr, lock)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting
+ * (errors cause a panic so in fact no
+ * error is ever returned, but the interpreter
+ * is needed anyway). */
+ TkDisplay *dispPtr; /* Display whose name registry is to be
+ * opened. */
+ int lock; /* Non-zero means lock the window server
+ * when opening the registry, so no-one
+ * else can use the registry until we
+ * close it. */
+{
+ NameRegistry *regPtr;
+ int result, actualFormat;
+ unsigned long bytesAfter;
+ Atom actualType;
+
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, dispPtr);
+ }
+
+ regPtr = (NameRegistry *) ckalloc(sizeof(NameRegistry));
+ regPtr->dispPtr = dispPtr;
+ regPtr->locked = 0;
+ regPtr->modified = 0;
+ regPtr->allocedByX = 1;
+
+ if (lock && !sendDebug) {
+ XGrabServer(dispPtr->display);
+ regPtr->locked = 1;
+ }
+
+ /*
+ * Read the registry property.
+ */
+
+ result = XGetWindowProperty(dispPtr->display,
+ RootWindow(dispPtr->display, 0),
+ dispPtr->registryProperty, 0, MAX_PROP_WORDS,
+ False, XA_STRING, &actualType, &actualFormat,
+ ®Ptr->propLength, &bytesAfter,
+ (unsigned char **) ®Ptr->property);
+
+ if (actualType == None) {
+ regPtr->propLength = 0;
+ regPtr->property = NULL;
+ } else if ((result != Success) || (actualFormat != 8)
+ || (actualType != XA_STRING)) {
+ /*
+ * The property is improperly formed; delete it.
+ */
+
+ if (regPtr->property != NULL) {
+ XFree(regPtr->property);
+ regPtr->propLength = 0;
+ regPtr->property = NULL;
+ }
+ XDeleteProperty(dispPtr->display,
+ RootWindow(dispPtr->display, 0),
+ dispPtr->registryProperty);
+ }
+
+ /*
+ * Xlib placed an extra null byte after the end of the property, just
+ * to make sure that it is always NULL-terminated. Be sure to include
+ * this byte in our count if it's needed to ensure null termination
+ * (note: as of 8/95 I'm no longer sure why this code is needed; seems
+ * like it shouldn't be).
+ */
+
+ if ((regPtr->propLength > 0)
+ && (regPtr->property[regPtr->propLength-1] != 0)) {
+ regPtr->propLength++;
+ }
+ return regPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegFindName --
+ *
+ * Given an open name registry, this procedure finds an entry
+ * with a given name, if there is one, and returns information
+ * about that entry.
+ *
+ * Results:
+ * The return value is the X identifier for the comm window for
+ * the application named "name", or None if there is no such
+ * entry in the registry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Window
+RegFindName(regPtr, name)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ CONST char *name; /* Name of an application. */
+{
+ char *p, *entry;
+ unsigned int id;
+
+ for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
+ entry = p;
+ while ((*p != 0) && (!isspace(UCHAR(*p)))) {
+ p++;
+ }
+ if ((*p != 0) && (strcmp(name, p+1) == 0)) {
+ if (sscanf(entry, "%x", &id) == 1) {
+ /*
+ * Must cast from an unsigned int to a Window in case we
+ * are on a 64-bit architecture.
+ */
+
+ return (Window) id;
+ }
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+ return None;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegDeleteName --
+ *
+ * This procedure deletes the entry for a given name from
+ * an open registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there used to be an entry named "name" in the registry,
+ * then it is deleted and the registry is marked as modified
+ * so it will be written back when closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegDeleteName(regPtr, name)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ CONST char *name; /* Name of an application. */
+{
+ char *p, *entry, *entryName;
+ int count;
+
+ for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
+ entry = p;
+ while ((*p != 0) && (!isspace(UCHAR(*p)))) {
+ p++;
+ }
+ if (*p != 0) {
+ p++;
+ }
+ entryName = p;
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ if ((strcmp(name, entryName) == 0)) {
+ /*
+ * Found the matching entry. Copy everything after it
+ * down on top of it.
+ */
+
+ count = regPtr->propLength - (p - regPtr->property);
+ if (count > 0) {
+ char *src, *dst;
+
+ for (src = p, dst = entry; count > 0; src++, dst++, count--) {
+ *dst = *src;
+ }
+ }
+ regPtr->propLength -= p - entry;
+ regPtr->modified = 1;
+ return;
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegAddName --
+ *
+ * Add a new entry to an open registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The open registry is expanded; it is marked as modified so that
+ * it will be written back when closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegAddName(regPtr, name, commWindow)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ CONST char *name; /* Name of an application. The caller
+ * must ensure that this name isn't
+ * already registered. */
+ Window commWindow; /* X identifier for comm. window of
+ * application. */
+{
+ char id[30];
+ char *newProp;
+ int idLength, newBytes;
+
+ sprintf(id, "%x ", (unsigned int) commWindow);
+ idLength = strlen(id);
+ newBytes = idLength + strlen(name) + 1;
+ newProp = (char *) ckalloc((unsigned) (regPtr->propLength + newBytes));
+ strcpy(newProp, id);
+ strcpy(newProp+idLength, name);
+ if (regPtr->property != NULL) {
+ memcpy((VOID *) (newProp + newBytes), (VOID *) regPtr->property,
+ regPtr->propLength);
+ if (regPtr->allocedByX) {
+ XFree(regPtr->property);
+ } else {
+ ckfree(regPtr->property);
+ }
+ }
+ regPtr->modified = 1;
+ regPtr->propLength += newBytes;
+ regPtr->property = newProp;
+ regPtr->allocedByX = 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegClose --
+ *
+ * This procedure is called to end a series of operations on
+ * a name registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The registry is written back if it has been modified, and the
+ * X server is unlocked if it was locked. Memory for the
+ * registry is freed, so the caller should never use regPtr
+ * again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegClose(regPtr)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+{
+ if (regPtr->modified) {
+ if (!regPtr->locked && !sendDebug) {
+ panic("The name registry was modified without being locked!");
+ }
+ XChangeProperty(regPtr->dispPtr->display,
+ RootWindow(regPtr->dispPtr->display, 0),
+ regPtr->dispPtr->registryProperty, XA_STRING, 8,
+ PropModeReplace, (unsigned char *) regPtr->property,
+ (int) regPtr->propLength);
+ }
+
+ if (regPtr->locked) {
+ XUngrabServer(regPtr->dispPtr->display);
+ }
+
+ /*
+ * After ungrabbing the server, it's important to flush the output
+ * immediately so that the server sees the ungrab command. Otherwise
+ * we might do something else that needs to communicate with the
+ * server (such as invoking a subprocess that needs to do I/O to
+ * the screen); if the ungrab command is still sitting in our
+ * output buffer, we could deadlock.
+ */
+
+ XFlush(regPtr->dispPtr->display);
+
+ if (regPtr->property != NULL) {
+ if (regPtr->allocedByX) {
+ XFree(regPtr->property);
+ } else {
+ ckfree(regPtr->property);
+ }
+ }
+ ckfree((char *) regPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidateName --
+ *
+ * This procedure checks to see if an entry in the registry
+ * is still valid.
+ *
+ * Results:
+ * The return value is 1 if the given commWindow exists and its
+ * name is "name". Otherwise 0 is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ValidateName(dispPtr, name, commWindow, oldOK)
+ TkDisplay *dispPtr; /* Display for which to perform the
+ * validation. */
+ CONST char *name; /* The name of an application. */
+ Window commWindow; /* X identifier for the application's
+ * comm. window. */
+ int oldOK; /* Non-zero means that we should consider
+ * an application to be valid even if it
+ * looks like an old-style (pre-4.0) one;
+ * 0 means consider these invalid. */
+{
+ int result, actualFormat, argc, i;
+ unsigned long length, bytesAfter;
+ Atom actualType;
+ char *property;
+ Tk_ErrorHandler handler;
+ CONST char **argv;
+
+ property = NULL;
+
+ /*
+ * Ignore X errors when reading the property (e.g., the window
+ * might not exist). If an error occurs, result will be some
+ * value other than Success.
+ */
+
+ handler = Tk_CreateErrorHandler(dispPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ result = XGetWindowProperty(dispPtr->display, commWindow,
+ dispPtr->appNameProperty, 0, MAX_PROP_WORDS,
+ False, XA_STRING, &actualType, &actualFormat,
+ &length, &bytesAfter, (unsigned char **) &property);
+
+ if ((result == Success) && (actualType == None)) {
+ XWindowAttributes atts;
+
+ /*
+ * The comm. window exists but the property we're looking for
+ * doesn't exist. This probably means that the application
+ * comes from an older version of Tk (< 4.0) that didn't set the
+ * property; if this is the case, then assume for compatibility's
+ * sake that everything's OK. However, it's also possible that
+ * some random application has re-used the window id for something
+ * totally unrelated. Check a few characteristics of the window,
+ * such as its dimensions and mapped state, to be sure that it
+ * still "smells" like a commWindow.
+ */
+
+ if (!oldOK
+ || !XGetWindowAttributes(dispPtr->display, commWindow, &atts)
+ || (atts.width != 1) || (atts.height != 1)
+ || (atts.map_state != IsUnmapped)) {
+ result = 0;
+ } else {
+ result = 1;
+ }
+ } else if ((result == Success) && (actualFormat == 8)
+ && (actualType == XA_STRING)) {
+ result = 0;
+ if (Tcl_SplitList((Tcl_Interp *) NULL, property, &argc, &argv)
+ == TCL_OK) {
+ for (i = 0; i < argc; i++) {
+ if (strcmp(argv[i], name) == 0) {
+ result = 1;
+ break;
+ }
+ }
+ ckfree((char *) argv);
+ }
+ } else {
+ result = 0;
+ }
+ Tk_DeleteErrorHandler(handler);
+ if (property != NULL) {
+ XFree(property);
+ }
+ return result;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ServerSecure --
+ *
+ * Check whether a server is secure enough for us to trust
+ * Tcl scripts arriving via that server.
+ *
+ * Results:
+ * The return value is 1 if the server is secure, which means
+ * that host-style authentication is turned on but there are
+ * no hosts in the enabled list. This means that some other
+ * form of authorization (presumably more secure, such as xauth)
+ * is in use.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ServerSecure(dispPtr)
+ TkDisplay *dispPtr; /* Display to check. */
+{
+#ifdef TK_NO_SECURITY
+ return 1;
+#else
+ XHostAddress *addrPtr;
+ int numHosts, secure;
+ Bool enabled;
+
+ secure = 0;
+ addrPtr = XListHosts(dispPtr->display, &numHosts, &enabled);
+ if (enabled && (numHosts == 0)) {
+ secure = 1;
+ }
+ if (addrPtr != NULL) {
+ XFree((char *) addrPtr);
+ }
+ return secure;
+#endif /* TK_NO_SECURITY */
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SetAppName --
+ *
+ * This procedure is called to associate an ASCII name with a Tk
+ * application. If the application has already been named, the
+ * name replaces the old one.
+ *
+ * Results:
+ * The return value is the name actually given to the application.
+ * This will normally be the same as name, but if name was already
+ * in use for an application then a name of the form "name #2" will
+ * be chosen, with a high enough number to make the name unique.
+ *
+ * Side effects:
+ * Registration info is saved, thereby allowing the "send" command
+ * to be used later to invoke commands in the application. In
+ * addition, the "send" command is created in the application's
+ * interpreter. The registration will be removed automatically
+ * if the interpreter is deleted or the "send" command is removed.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_SetAppName(tkwin, name)
+ Tk_Window tkwin; /* Token for any window in the application
+ * to be named: it is just used to identify
+ * the application and the display. */
+ CONST char *name; /* The name that will be used to
+ * refer to the interpreter in later
+ * "send" commands. Must be globally
+ * unique. */
+{
+ RegisteredInterp *riPtr, *riPtr2;
+ Window w;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ NameRegistry *regPtr;
+ Tcl_Interp *interp;
+ CONST char *actualName;
+ Tcl_DString dString;
+ int offset, i;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ interp = winPtr->mainPtr->interp;
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, winPtr->dispPtr);
+ }
+
+ /*
+ * See if the application is already registered; if so, remove its
+ * current name from the registry.
+ */
+
+ regPtr = RegOpen(interp, winPtr->dispPtr, 1);
+ for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
+ if (riPtr == NULL) {
+
+ /*
+ * This interpreter isn't currently registered; create
+ * the data structure that will be used to register it locally,
+ * plus add the "send" command to the interpreter.
+ */
+
+ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr->interp = interp;
+ riPtr->dispPtr = winPtr->dispPtr;
+ riPtr->nextPtr = tsdPtr->interpListPtr;
+ tsdPtr->interpListPtr = riPtr;
+ riPtr->name = NULL;
+ Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
+ DeleteProc);
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "send", "send");
+ }
+ break;
+ }
+ if (riPtr->interp == interp) {
+ /*
+ * The interpreter is currently registered; remove it from
+ * the name registry.
+ */
+
+ if (riPtr->name) {
+ RegDeleteName(regPtr, riPtr->name);
+ ckfree(riPtr->name);
+ }
+ break;
+ }
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * larger and larger numbers until we eventually find one that is
+ * unique.
+ */
+
+ actualName = name;
+ offset = 0; /* Needed only to avoid "used before
+ * set" compiler warnings. */
+ for (i = 1; ; i++) {
+ if (i > 1) {
+ if (i == 2) {
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ sprintf(Tcl_DStringValue(&dString) + offset, "%d", i);
+ }
+ w = RegFindName(regPtr, actualName);
+ if (w == None) {
+ break;
+ }
+
+ /*
+ * The name appears to be in use already, but double-check to
+ * be sure (perhaps the application died without removing its
+ * name from the registry?).
+ */
+
+ if (w == Tk_WindowId(dispPtr->commTkwin)) {
+ for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL;
+ riPtr2 = riPtr2->nextPtr) {
+ if ((riPtr2->interp != interp) &&
+ (strcmp(riPtr2->name, actualName) == 0)) {
+ goto nextSuffix;
+ }
+ }
+ RegDeleteName(regPtr, actualName);
+ break;
+ } else if (!ValidateName(winPtr->dispPtr, actualName, w, 1)) {
+ RegDeleteName(regPtr, actualName);
+ break;
+ }
+ nextSuffix:
+ continue;
+ }
+
+ /*
+ * We've now got a name to use. Store it in the name registry and
+ * in the local entry for this application, plus put it in a property
+ * on the commWindow.
+ */
+
+ RegAddName(regPtr, actualName, Tk_WindowId(dispPtr->commTkwin));
+ RegClose(regPtr);
+ riPtr->name = (char *) ckalloc((unsigned) (strlen(actualName) + 1));
+ strcpy(riPtr->name, actualName);
+ if (actualName != name) {
+ Tcl_DStringFree(&dString);
+ }
+ UpdateCommWindow(dispPtr);
+
+ return riPtr->name;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SendCmd --
+ *
+ * This procedure is invoked to process the "send" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SendCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about sender (only
+ * dispPtr field is used). */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr;
+ Window commWindow;
+ PendingCommand pending;
+ register RegisteredInterp *riPtr;
+ CONST char *destName;
+ int result, c, async, i, firstArg;
+ size_t length;
+ Tk_RestrictProc *prevRestrictProc;
+ ClientData prevArg;
+ TkDisplay *dispPtr;
+ Tcl_Time timeout;
+ NameRegistry *regPtr;
+ Tcl_DString request;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_Interp *localInterp; /* Used when the interpreter to
+ * send the command to is within
+ * the same process. */
+
+ /*
+ * Process options, if any.
+ */
+
+ async = 0;
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ for (i = 1; i < (argc-1); ) {
+ if (argv[i][0] != '-') {
+ break;
+ }
+ c = argv[i][1];
+ length = strlen(argv[i]);
+ if ((c == 'a') && (strncmp(argv[i], "-async", length) == 0)) {
+ async = 1;
+ i++;
+ } else if ((c == 'd') && (strncmp(argv[i], "-displayof",
+ length) == 0)) {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[i+1],
+ (Tk_Window) winPtr);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ i += 2;
+ } else if (strcmp(argv[i], "--") == 0) {
+ i++;
+ break;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[i],
+ "\": must be -async, -displayof, or --", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (argc < (i+2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ?options? interpName arg ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ destName = argv[i];
+ firstArg = i+1;
+
+ dispPtr = winPtr->dispPtr;
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, winPtr->dispPtr);
+ }
+
+ /*
+ * See if the target interpreter is local. If so, execute
+ * the command directly without going through the X server.
+ * The only tricky thing is passing the result from the target
+ * interpreter to the invoking interpreter. Watch out: they
+ * could be the same!
+ */
+
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if ((riPtr->dispPtr != dispPtr)
+ || (strcmp(riPtr->name, destName) != 0)) {
+ continue;
+ }
+ Tcl_Preserve((ClientData) riPtr);
+ localInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) localInterp);
+ if (firstArg == (argc-1)) {
+ result = Tcl_GlobalEval(localInterp, argv[firstArg]);
+ } else {
+ Tcl_DStringInit(&request);
+ Tcl_DStringAppend(&request, argv[firstArg], -1);
+ for (i = firstArg+1; i < argc; i++) {
+ Tcl_DStringAppend(&request, " ", 1);
+ Tcl_DStringAppend(&request, argv[i], -1);
+ }
+ result = Tcl_GlobalEval(localInterp, Tcl_DStringValue(&request));
+ Tcl_DStringFree(&request);
+ }
+ if (interp != localInterp) {
+ if (result == TCL_ERROR) {
+ Tcl_Obj *errorObjPtr;
+
+ /*
+ * An error occurred, so transfer error information from the
+ * destination interpreter back to our interpreter. Must clear
+ * interp's result before calling Tcl_AddErrorInfo, since
+ * Tcl_AddErrorInfo will store the interp's result in errorInfo
+ * before appending riPtr's $errorInfo; we've already got
+ * everything we need in riPtr's $errorInfo.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
+ "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
+ errorObjPtr = Tcl_GetVar2Ex(localInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetObjErrorCode(interp, errorObjPtr);
+ }
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));
+ Tcl_ResetResult(localInterp);
+ }
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) localInterp);
+ return result;
+ }
+
+ /*
+ * Bind the interpreter name to a communication window.
+ */
+
+ regPtr = RegOpen(interp, winPtr->dispPtr, 0);
+ commWindow = RegFindName(regPtr, destName);
+ RegClose(regPtr);
+ if (commWindow == None) {
+ Tcl_AppendResult(interp, "no application named \"",
+ destName, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Send the command to the target interpreter by appending it to the
+ * comm window in the communication window.
+ */
+
+ tkSendSerial++;
+ Tcl_DStringInit(&request);
+ Tcl_DStringAppend(&request, "\0c\0-n ", 6);
+ Tcl_DStringAppend(&request, destName, -1);
+ if (!async) {
+ char buffer[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buffer, "%x %d",
+ (unsigned int) Tk_WindowId(dispPtr->commTkwin),
+ tkSendSerial);
+ Tcl_DStringAppend(&request, "\0-r ", 4);
+ Tcl_DStringAppend(&request, buffer, -1);
+ }
+ Tcl_DStringAppend(&request, "\0-s ", 4);
+ Tcl_DStringAppend(&request, argv[firstArg], -1);
+ for (i = firstArg+1; i < argc; i++) {
+ Tcl_DStringAppend(&request, " ", 1);
+ Tcl_DStringAppend(&request, argv[i], -1);
+ }
+ (void) AppendPropCarefully(dispPtr->display, commWindow,
+ dispPtr->commProperty, Tcl_DStringValue(&request),
+ Tcl_DStringLength(&request) + 1,
+ (async) ? (PendingCommand *) NULL : &pending);
+ Tcl_DStringFree(&request);
+ if (async) {
+ /*
+ * This is an asynchronous send: return immediately without
+ * waiting for a response.
+ */
+
+ return TCL_OK;
+ }
+
+ /*
+ * Register the fact that we're waiting for a command to complete
+ * (this is needed by SendEventProc and by AppendErrorProc to pass
+ * back the command's results). Set up a timeout handler so that
+ * we can check during long sends to make sure that the destination
+ * application is still alive.
+ */
+
+ pending.serial = tkSendSerial;
+ pending.dispPtr = dispPtr;
+ pending.target = destName;
+ pending.commWindow = commWindow;
+ pending.interp = interp;
+ pending.result = NULL;
+ pending.errorInfo = NULL;
+ pending.errorCode = NULL;
+ pending.gotResponse = 0;
+ pending.nextPtr = tsdPtr->pendingCommands;
+ tsdPtr->pendingCommands = &pending;
+
+ /*
+ * Enter a loop processing X events until the result comes
+ * in or the target is declared to be dead. While waiting
+ * for a result, look only at send-related events so that
+ * the send is synchronous with respect to other events in
+ * the application.
+ */
+
+ prevRestrictProc = Tk_RestrictEvents(SendRestrictProc,
+ (ClientData) NULL, &prevArg);
+ Tcl_GetTime(&timeout);
+ timeout.sec += 2;
+ while (!pending.gotResponse) {
+ if (!TkUnixDoOneXEvent(&timeout)) {
+ /*
+ * An unusually long amount of time has elapsed during the
+ * processing of a sent command. Check to make sure that the
+ * target application still exists. If it does, reset the timeout.
+ */
+
+ if (!ValidateName(pending.dispPtr, pending.target,
+ pending.commWindow, 0)) {
+ char *msg;
+ if (ValidateName(pending.dispPtr, pending.target,
+ pending.commWindow, 1)) {
+ msg = "target application died or uses a Tk version before 4.0";
+ } else {
+ msg = "target application died";
+ }
+ pending.code = TCL_ERROR;
+ pending.result = (char *) ckalloc((unsigned) (strlen(msg) + 1));
+ strcpy(pending.result, msg);
+ pending.gotResponse = 1;
+ } else {
+ Tcl_GetTime(&timeout);
+ timeout.sec += 2;
+ }
+ }
+ }
+ (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);
+
+ /*
+ * Unregister the information about the pending command
+ * and return the result.
+ */
+
+ if (tsdPtr->pendingCommands != &pending) {
+ panic("Tk_SendCmd: corrupted send stack");
+ }
+ tsdPtr->pendingCommands = pending.nextPtr;
+ if (pending.errorInfo != NULL) {
+ /*
+ * Special trick: must clear the interp's result before calling
+ * Tcl_AddErrorInfo, since Tcl_AddErrorInfo will store the interp's
+ * result in errorInfo before appending pending.errorInfo; we've
+ * already got everything we need in pending.errorInfo.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AddErrorInfo(interp, pending.errorInfo);
+ ckfree(pending.errorInfo);
+ }
+ if (pending.errorCode != NULL) {
+ Tcl_Obj *errorObjPtr;
+ errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1);
+ Tcl_SetObjErrorCode(interp, errorObjPtr);
+ ckfree(pending.errorCode);
+ }
+ Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
+ return pending.code;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetInterpNames --
+ *
+ * This procedure is invoked to fetch a list of all the
+ * interpreter names currently registered for the display
+ * of a particular window.
+ *
+ * Results:
+ * A standard Tcl return value. The interp's result will be set
+ * to hold a list of all the interpreter names defined for
+ * tkwin's display. If an error occurs, then TCL_ERROR
+ * is returned and the interp's result will hold an error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetInterpNames(interp, tkwin)
+ Tcl_Interp *interp; /* Interpreter for returning a result. */
+ Tk_Window tkwin; /* Window whose display is to be used
+ * for the lookup. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ char *p, *entry, *entryName;
+ NameRegistry *regPtr;
+ Window commWindow;
+ int count;
+ unsigned int id;
+
+ /*
+ * Read the registry property, then scan through all of its entries.
+ * Validate each entry to be sure that its application still exists.
+ */
+
+ regPtr = RegOpen(interp, winPtr->dispPtr, 1);
+ for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
+ entry = p;
+ if (sscanf(p, "%x",(unsigned int *) &id) != 1) {
+ commWindow = None;
+ } else {
+ commWindow = id;
+ }
+ while ((*p != 0) && (!isspace(UCHAR(*p)))) {
+ p++;
+ }
+ if (*p != 0) {
+ p++;
+ }
+ entryName = p;
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ if (ValidateName(winPtr->dispPtr, entryName, commWindow, 1)) {
+ /*
+ * The application still exists; add its name to the result.
+ */
+
+ Tcl_AppendElement(interp, entryName);
+ } else {
+ /*
+ * This name is bogus (perhaps the application died without
+ * cleaning up its entry in the registry?). Delete the name.
+ */
+
+ count = regPtr->propLength - (p - regPtr->property);
+ if (count > 0) {
+ char *src, *dst;
+
+ for (src = p, dst = entry; count > 0; src++, dst++, count--) {
+ *dst = *src;
+ }
+ }
+ regPtr->propLength -= p - entry;
+ regPtr->modified = 1;
+ p = entry;
+ }
+ }
+ RegClose(regPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSendCleanup --
+ *
+ * This procedure is called to free resources used by the
+ * communication channels for sending commands and
+ * receiving results.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees various data structures and windows.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkSendCleanup(dispPtr)
+ TkDisplay *dispPtr;
+{
+ if (dispPtr->commTkwin != NULL) {
+ Tk_DeleteEventHandler(dispPtr->commTkwin, PropertyChangeMask,
+ SendEventProc, (ClientData) dispPtr);
+ Tk_DestroyWindow(dispPtr->commTkwin);
+ Tcl_Release((ClientData) dispPtr->commTkwin);
+ dispPtr->commTkwin = NULL;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * SendInit --
+ *
+ * This procedure is called to initialize the
+ * communication channels for sending commands and
+ * receiving results.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up various data structures and windows.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SendInit(interp, dispPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting
+ * (no errors are ever returned, but the
+ * interpreter is needed anyway). */
+ TkDisplay *dispPtr; /* Display to initialize. */
+{
+ XSetWindowAttributes atts;
+
+ /*
+ * Create the window used for communication, and set up an
+ * event handler for it.
+ */
+
+ dispPtr->commTkwin = Tk_CreateWindow(interp, (Tk_Window) NULL,
+ "_comm", DisplayString(dispPtr->display));
+ if (dispPtr->commTkwin == NULL) {
+ panic("Tk_CreateWindow failed in SendInit!");
+ }
+ Tcl_Preserve((ClientData) dispPtr->commTkwin);
+ atts.override_redirect = True;
+ Tk_ChangeWindowAttributes(dispPtr->commTkwin,
+ CWOverrideRedirect, &atts);
+ Tk_CreateEventHandler(dispPtr->commTkwin, PropertyChangeMask,
+ SendEventProc, (ClientData) dispPtr);
+ Tk_MakeWindowExist(dispPtr->commTkwin);
+
+ /*
+ * Get atoms used as property names.
+ */
+
+ dispPtr->commProperty = Tk_InternAtom(dispPtr->commTkwin, "Comm");
+ dispPtr->registryProperty = Tk_InternAtom(dispPtr->commTkwin,
+ "InterpRegistry");
+ dispPtr->appNameProperty = Tk_InternAtom(dispPtr->commTkwin,
+ "TK_APPLICATION");
+
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * SendEventProc --
+ *
+ * This procedure is invoked automatically by the toolkit
+ * event manager when a property changes on the communication
+ * window. This procedure reads the property and handles
+ * command requests and responses.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there are command requests in the property, they
+ * are executed. If there are responses in the property,
+ * their information is saved for the (ostensibly waiting)
+ * "send" commands. The property is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SendEventProc(clientData, eventPtr)
+ ClientData clientData; /* Display information. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ char *propInfo;
+ register char *p;
+ int result, actualFormat;
+ unsigned long numItems, bytesAfter;
+ Atom actualType;
+ Tcl_Interp *remoteInterp; /* Interp in which to execute the command. */
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if ((eventPtr->xproperty.atom != dispPtr->commProperty)
+ || (eventPtr->xproperty.state != PropertyNewValue)) {
+ return;
+ }
+
+ /*
+ * Read the comm property and delete it.
+ */
+
+ propInfo = NULL;
+ result = XGetWindowProperty(dispPtr->display,
+ Tk_WindowId(dispPtr->commTkwin),
+ dispPtr->commProperty, 0, MAX_PROP_WORDS, True,
+ XA_STRING, &actualType, &actualFormat,
+ &numItems, &bytesAfter, (unsigned char **) &propInfo);
+
+ /*
+ * If the property doesn't exist or is improperly formed
+ * then ignore it.
+ */
+
+ if ((result != Success) || (actualType != XA_STRING)
+ || (actualFormat != 8)) {
+ if (propInfo != NULL) {
+ XFree(propInfo);
+ }
+ return;
+ }
+
+ /*
+ * Several commands and results could arrive in the property at
+ * one time; each iteration through the outer loop handles a
+ * single command or result.
+ */
+
+ for (p = propInfo; (p-propInfo) < (int) numItems; ) {
+ /*
+ * Ignore leading NULLs; each command or result starts with a
+ * NULL so that no matter how badly formed a preceding command
+ * is, we'll be able to tell that a new command/result is
+ * starting.
+ */
+
+ if (*p == 0) {
+ p++;
+ continue;
+ }
+
+ if ((*p == 'c') && (p[1] == 0)) {
+ Window commWindow;
+ char *interpName, *script, *serial, *end;
+ Tcl_DString reply;
+ RegisteredInterp *riPtr;
+
+ /*
+ *----------------------------------------------------------
+ * This is an incoming command from some other application.
+ * Iterate over all of its options. Stop when we reach
+ * the end of the property or something that doesn't look
+ * like an option.
+ *----------------------------------------------------------
+ */
+
+ p += 2;
+ interpName = NULL;
+ commWindow = None;
+ serial = "";
+ script = NULL;
+ while (((p-propInfo) < (int) numItems) && (*p == '-')) {
+ switch (p[1]) {
+ case 'r':
+ commWindow = (Window) strtoul(p+2, &end, 16);
+ if ((end == p+2) || (*end != ' ')) {
+ commWindow = None;
+ } else {
+ p = serial = end+1;
+ }
+ break;
+ case 'n':
+ if (p[2] == ' ') {
+ interpName = p+3;
+ }
+ break;
+ case 's':
+ if (p[2] == ' ') {
+ script = p+3;
+ }
+ break;
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+
+ if ((script == NULL) || (interpName == NULL)) {
+ continue;
+ }
+
+ /*
+ * Initialize the result property, so that we're ready at any
+ * time if we need to return an error.
+ */
+
+ if (commWindow != None) {
+ Tcl_DStringInit(&reply);
+ Tcl_DStringAppend(&reply, "\0r\0-s ", 6);
+ Tcl_DStringAppend(&reply, serial, -1);
+ Tcl_DStringAppend(&reply, "\0-r ", 4);
+ }
+
+ if (!ServerSecure(dispPtr)) {
+ if (commWindow != None) {
+ Tcl_DStringAppend(&reply, "X server insecure (must use xauth-style authorization); command ignored", -1);
+ }
+ result = TCL_ERROR;
+ goto returnResult;
+ }
+
+ /*
+ * Locate the application, then execute the script.
+ */
+
+ for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
+ if (riPtr == NULL) {
+ if (commWindow != None) {
+ Tcl_DStringAppend(&reply,
+ "receiver never heard of interpreter \"", -1);
+ Tcl_DStringAppend(&reply, interpName, -1);
+ Tcl_DStringAppend(&reply, "\"", 1);
+ }
+ result = TCL_ERROR;
+ goto returnResult;
+ }
+ if (strcmp(riPtr->name, interpName) == 0) {
+ break;
+ }
+ }
+ Tcl_Preserve((ClientData) riPtr);
+
+ /*
+ * We must protect the interpreter because the script may
+ * enter another event loop, which might call Tcl_DeleteInterp.
+ */
+
+ remoteInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) remoteInterp);
+
+ result = Tcl_GlobalEval(remoteInterp, script);
+
+ /*
+ * The call to Tcl_Release may have released the interpreter
+ * which will cause the "send" command for that interpreter
+ * to be deleted. The command deletion callback will set the
+ * riPtr->interp field to NULL, hence the check below for NULL.
+ */
+
+ if (commWindow != None) {
+ Tcl_DStringAppend(&reply, Tcl_GetStringResult(remoteInterp),
+ -1);
+ if (result == TCL_ERROR) {
+ CONST char *varValue;
+
+ varValue = Tcl_GetVar2(remoteInterp, "errorInfo",
+ (char *) NULL, TCL_GLOBAL_ONLY);
+ if (varValue != NULL) {
+ Tcl_DStringAppend(&reply, "\0-i ", 4);
+ Tcl_DStringAppend(&reply, varValue, -1);
+ }
+ varValue = Tcl_GetVar2(remoteInterp, "errorCode",
+ (char *) NULL, TCL_GLOBAL_ONLY);
+ if (varValue != NULL) {
+ Tcl_DStringAppend(&reply, "\0-e ", 4);
+ Tcl_DStringAppend(&reply, varValue, -1);
+ }
+ }
+ }
+ Tcl_Release((ClientData) remoteInterp);
+ Tcl_Release((ClientData) riPtr);
+
+ /*
+ * Return the result to the sender if a commWindow was
+ * specified (if none was specified then this is an asynchronous
+ * call). Right now reply has everything but the completion
+ * code, but it needs the NULL to terminate the current option.
+ */
+
+ returnResult:
+ if (commWindow != None) {
+ if (result != TCL_OK) {
+ char buffer[TCL_INTEGER_SPACE];
+
+ sprintf(buffer, "%d", result);
+ Tcl_DStringAppend(&reply, "\0-c ", 4);
+ Tcl_DStringAppend(&reply, buffer, -1);
+ }
+ (void) AppendPropCarefully(dispPtr->display, commWindow,
+ dispPtr->commProperty, Tcl_DStringValue(&reply),
+ Tcl_DStringLength(&reply) + 1,
+ (PendingCommand *) NULL);
+ XFlush(dispPtr->display);
+ Tcl_DStringFree(&reply);
+ }
+ } else if ((*p == 'r') && (p[1] == 0)) {
+ int serial, code, gotSerial;
+ char *errorInfo, *errorCode, *resultString;
+ PendingCommand *pcPtr;
+
+ /*
+ *----------------------------------------------------------
+ * This is a reply to some command that we sent out. Iterate
+ * over all of its options. Stop when we reach the end of the
+ * property or something that doesn't look like an option.
+ *----------------------------------------------------------
+ */
+
+ p += 2;
+ code = TCL_OK;
+ gotSerial = 0;
+ errorInfo = NULL;
+ errorCode = NULL;
+ resultString = "";
+ while (((p-propInfo) < (int) numItems) && (*p == '-')) {
+ switch (p[1]) {
+ case 'c':
+ if (sscanf(p+2, " %d", &code) != 1) {
+ code = TCL_OK;
+ }
+ break;
+ case 'e':
+ if (p[2] == ' ') {
+ errorCode = p+3;
+ }
+ break;
+ case 'i':
+ if (p[2] == ' ') {
+ errorInfo = p+3;
+ }
+ break;
+ case 'r':
+ if (p[2] == ' ') {
+ resultString = p+3;
+ }
+ break;
+ case 's':
+ if (sscanf(p+2, " %d", &serial) == 1) {
+ gotSerial = 1;
+ }
+ break;
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+
+ if (!gotSerial) {
+ continue;
+ }
+
+ /*
+ * Give the result information to anyone who's
+ * waiting for it.
+ */
+
+ for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
+ pcPtr = pcPtr->nextPtr) {
+ if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
+ continue;
+ }
+ pcPtr->code = code;
+ if (resultString != NULL) {
+ pcPtr->result = (char *) ckalloc((unsigned)
+ (strlen(resultString) + 1));
+ strcpy(pcPtr->result, resultString);
+ }
+ if (code == TCL_ERROR) {
+ if (errorInfo != NULL) {
+ pcPtr->errorInfo = (char *) ckalloc((unsigned)
+ (strlen(errorInfo) + 1));
+ strcpy(pcPtr->errorInfo, errorInfo);
+ }
+ if (errorCode != NULL) {
+ pcPtr->errorCode = (char *) ckalloc((unsigned)
+ (strlen(errorCode) + 1));
+ strcpy(pcPtr->errorCode, errorCode);
+ }
+ }
+ pcPtr->gotResponse = 1;
+ break;
+ }
+ } else {
+ /*
+ * Didn't recognize this thing. Just skip through the next
+ * null character and try again.
+ */
+
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+ }
+ XFree(propInfo);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * AppendPropCarefully --
+ *
+ * Append a given property to a given window, but set up
+ * an X error handler so that if the append fails this
+ * procedure can return an error code rather than having
+ * Xlib panic.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given property on the given window is appended to.
+ * If this operation fails and if pendingPtr is non-NULL,
+ * then the pending operation is marked as complete with
+ * an error.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AppendPropCarefully(display, window, property, value, length, pendingPtr)
+ Display *display; /* Display on which to operate. */
+ Window window; /* Window whose property is to
+ * be modified. */
+ Atom property; /* Name of property. */
+ char *value; /* Characters to append to property. */
+ int length; /* Number of bytes to append. */
+ PendingCommand *pendingPtr; /* Pending command to mark complete
+ * if an error occurs during the
+ * property op. NULL means just
+ * ignore the error. */
+{
+ Tk_ErrorHandler handler;
+
+ handler = Tk_CreateErrorHandler(display, -1, -1, -1, AppendErrorProc,
+ (ClientData) pendingPtr);
+ XChangeProperty(display, window, property, XA_STRING, 8,
+ PropModeAppend, (unsigned char *) value, length);
+ Tk_DeleteErrorHandler(handler);
+}
+
+/*
+ * The procedure below is invoked if an error occurs during
+ * the XChangeProperty operation above.
+ */
+
+ /* ARGSUSED */
+static int
+AppendErrorProc(clientData, errorPtr)
+ ClientData clientData; /* Command to mark complete, or NULL. */
+ XErrorEvent *errorPtr; /* Information about error. */
+{
+ PendingCommand *pendingPtr = (PendingCommand *) clientData;
+ register PendingCommand *pcPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (pendingPtr == NULL) {
+ return 0;
+ }
+
+ /*
+ * Make sure this command is still pending.
+ */
+
+ for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
+ pcPtr = pcPtr->nextPtr) {
+ if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
+ pcPtr->result = (char *) ckalloc((unsigned)
+ (strlen(pcPtr->target) + 50));
+ sprintf(pcPtr->result, "no application named \"%s\"",
+ pcPtr->target);
+ pcPtr->code = TCL_ERROR;
+ pcPtr->gotResponse = 1;
+ break;
+ }
+ }
+ return 0;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteProc --
+ *
+ * This procedure is invoked by Tcl when the "send" command
+ * is deleted in an interpreter. It unregisters the interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The interpreter given by riPtr is unregistered.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteProc(clientData)
+ ClientData clientData; /* Info about registration, passed
+ * as ClientData. */
+{
+ RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
+ register RegisteredInterp *riPtr2;
+ NameRegistry *regPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1);
+ RegDeleteName(regPtr, riPtr->name);
+ RegClose(regPtr);
+
+ if (tsdPtr->interpListPtr == riPtr) {
+ tsdPtr->interpListPtr = riPtr->nextPtr;
+ } else {
+ for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL;
+ riPtr2 = riPtr2->nextPtr) {
+ if (riPtr2->nextPtr == riPtr) {
+ riPtr2->nextPtr = riPtr->nextPtr;
+ break;
+ }
+ }
+ }
+ ckfree((char *) riPtr->name);
+ riPtr->interp = NULL;
+ UpdateCommWindow(riPtr->dispPtr);
+ Tcl_EventuallyFree((ClientData) riPtr, TCL_DYNAMIC);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SendRestrictProc --
+ *
+ * This procedure filters incoming events when a "send" command
+ * is outstanding. It defers all events except those containing
+ * send commands and results.
+ *
+ * Results:
+ * False is returned except for property-change events on a
+ * commWindow.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static Tk_RestrictAction
+SendRestrictProc(clientData, eventPtr)
+ ClientData clientData; /* Not used. */
+ register XEvent *eventPtr; /* Event that just arrived. */
+{
+ TkDisplay *dispPtr;
+
+ if (eventPtr->type != PropertyNotify) {
+ return TK_DEFER_EVENT;
+ }
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if ((eventPtr->xany.display == dispPtr->display)
+ && (eventPtr->xproperty.window
+ == Tk_WindowId(dispPtr->commTkwin))) {
+ return TK_PROCESS_EVENT;
+ }
+ }
+ return TK_DEFER_EVENT;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateCommWindow --
+ *
+ * This procedure updates the list of application names stored
+ * on our commWindow. It is typically called when interpreters
+ * are registered and unregistered.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The TK_APPLICATION property on the comm window is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateCommWindow(dispPtr)
+ TkDisplay *dispPtr; /* Display whose commWindow is to be
+ * updated. */
+{
+ Tcl_DString names;
+ RegisteredInterp *riPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_DStringInit(&names);
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ Tcl_DStringAppendElement(&names, riPtr->name);
+ }
+ XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin),
+ dispPtr->appNameProperty, XA_STRING, 8, PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&names),
+ Tcl_DStringLength(&names));
+ Tcl_DStringFree(&names);
+}
--- /dev/null
+/*
+ * tkUnixWm.c --
+ *
+ * This module takes care of the interactions between a Tk-based
+ * application and the window manager. Among other things, it
+ * implements the "wm" command and passes geometry information
+ * to the window manager.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkUnixInt.h"
+#include <errno.h>
+
+/*
+ * A data structure of the following type holds information for
+ * each window manager protocol (such as WM_DELETE_WINDOW) for
+ * which a handler (i.e. a Tcl command) has been defined for a
+ * particular top-level window.
+ */
+
+typedef struct ProtocolHandler {
+ Atom protocol; /* Identifies the protocol. */
+ struct ProtocolHandler *nextPtr;
+ /* Next in list of protocol handlers for
+ * the same top-level window, or NULL for
+ * end of list. */
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ char command[4]; /* Tcl command to invoke when a client
+ * message for this protocol arrives.
+ * The actual size of the structure varies
+ * to accommodate the needs of the actual
+ * command. THIS MUST BE THE LAST FIELD OF
+ * THE STRUCTURE. */
+} ProtocolHandler;
+
+#define HANDLER_SIZE(cmdLength) \
+ ((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength))
+
+/*
+ * A data structure of the following type holds window-manager-related
+ * information for each top-level window in an application.
+ */
+
+typedef struct TkWmInfo {
+ TkWindow *winPtr; /* Pointer to main Tk information for
+ * this window. */
+ Window reparent; /* If the window has been reparented, this
+ * gives the ID of the ancestor of the window
+ * that is a child of the root window (may
+ * not be window's immediate parent). If
+ * the window isn't reparented, this has the
+ * value None. */
+ char *title; /* Title to display in window caption. If
+ * NULL, use name of widget. Malloced. */
+ char *iconName; /* Name to display in icon. Malloced. */
+ XWMHints hints; /* Various pieces of information for
+ * window manager. */
+ char *leaderName; /* Path name of leader of window group
+ * (corresponds to hints.window_group).
+ * Malloc-ed. Note: this field doesn't
+ * get updated if leader is destroyed. */
+ TkWindow *masterPtr; /* Master window for TRANSIENT_FOR property,
+ * or NULL. */
+ Tk_Window icon; /* Window to use as icon for this window,
+ * or NULL. */
+ Tk_Window iconFor; /* Window for which this window is icon, or
+ * NULL if this isn't an icon for anyone. */
+ int withdrawn; /* Non-zero means window has been withdrawn. */
+
+ /*
+ * In order to support menubars transparently under X, each toplevel
+ * window is encased in an additional window, called the wrapper,
+ * that holds the toplevel and the menubar, if any. The information
+ * below is used to keep track of the wrapper and the menubar.
+ */
+
+ TkWindow *wrapperPtr; /* Pointer to information about the wrapper.
+ * This is the "real" toplevel window as
+ * seen by the window manager. Although
+ * this is an official Tk window, it
+ * doesn't appear in the application's
+ * window hierarchy. NULL means that
+ * the wrapper hasn't been created yet. */
+ Tk_Window menubar; /* Pointer to information about the
+ * menubar, or NULL if there is no
+ * menubar for this toplevel. */
+ int menuHeight; /* Amount of vertical space needed for
+ * menubar, measured in pixels. If
+ * menubar is non-NULL, this is >= 1 (X
+ * servers don't like dimensions of 0). */
+
+ /*
+ * Information used to construct an XSizeHints structure for
+ * the window manager:
+ */
+
+ int sizeHintsFlags; /* Flags word for XSizeHints structure.
+ * If the PBaseSize flag is set then the
+ * window is gridded; otherwise it isn't
+ * gridded. */
+ int minWidth, minHeight; /* Minimum dimensions of window, in
+ * grid units, not pixels. */
+ int maxWidth, maxHeight; /* Maximum dimensions of window, in
+ * grid units, not pixels. */
+ Tk_Window gridWin; /* Identifies the window that controls
+ * gridding for this top-level, or NULL if
+ * the top-level isn't currently gridded. */
+ int widthInc, heightInc; /* Increments for size changes (# pixels
+ * per step). */
+ struct {
+ int x; /* numerator */
+ int y; /* denominator */
+ } minAspect, maxAspect; /* Min/max aspect ratios for window. */
+ int reqGridWidth, reqGridHeight;
+ /* The dimensions of the window (in
+ * grid units) requested through
+ * the geometry manager. */
+ int gravity; /* Desired window gravity. */
+
+ /*
+ * Information used to manage the size and location of a window.
+ */
+
+ int width, height; /* Desired dimensions of window, specified
+ * in grid units. These values are
+ * set by the "wm geometry" command and by
+ * ConfigureNotify events (for when wm
+ * resizes window). -1 means user hasn't
+ * requested dimensions. */
+ int x, y; /* Desired X and Y coordinates for window.
+ * These values are set by "wm geometry",
+ * plus by ConfigureNotify events (when wm
+ * moves window). These numbers are
+ * different than the numbers stored in
+ * winPtr->changes because (a) they could be
+ * measured from the right or bottom edge
+ * of the screen (see WM_NEGATIVE_X and
+ * WM_NEGATIVE_Y flags) and (b) if the window
+ * has been reparented then they refer to the
+ * parent rather than the window itself. */
+ int parentWidth, parentHeight;
+ /* Width and height of reparent, in pixels
+ * *including border*. If window hasn't been
+ * reparented then these will be the outer
+ * dimensions of the window, including
+ * border. */
+ int xInParent, yInParent; /* Offset of wrapperPtr within reparent,
+ * measured in pixels from upper-left outer
+ * corner of reparent's border to upper-left
+ * outer corner of wrapperPtr's border. If
+ * not reparented then these are zero. */
+ int configWidth, configHeight;
+ /* Dimensions passed to last request that we
+ * issued to change geometry of the wrapper.
+ * Used to eliminate redundant resize
+ * operations. */
+
+ /*
+ * Information about the virtual root window for this top-level,
+ * if there is one.
+ */
+
+ Window vRoot; /* Virtual root window for this top-level,
+ * or None if there is no virtual root
+ * window (i.e. just use the screen's root). */
+ int vRootX, vRootY; /* Position of the virtual root inside the
+ * root window. If the WM_VROOT_OFFSET_STALE
+ * flag is set then this information may be
+ * incorrect and needs to be refreshed from
+ * the X server. If vRoot is None then these
+ * values are both 0. */
+ int vRootWidth, vRootHeight;/* Dimensions of the virtual root window.
+ * If vRoot is None, gives the dimensions
+ * of the containing screen. This information
+ * is never stale, even though vRootX and
+ * vRootY can be. */
+
+ /*
+ * Miscellaneous information.
+ */
+
+ ProtocolHandler *protPtr; /* First in list of protocol handlers for
+ * this window (NULL means none). */
+ int cmdArgc; /* Number of elements in cmdArgv below. */
+ CONST char **cmdArgv; /* Array of strings to store in the
+ * WM_COMMAND property. NULL means nothing
+ * available. */
+ char *clientMachine; /* String to store in WM_CLIENT_MACHINE
+ * property, or NULL. */
+ int flags; /* Miscellaneous flags, defined below. */
+ int numTransients; /* number of transients on this window */
+ struct TkWmInfo *nextPtr; /* Next in list of all top-level windows. */
+} WmInfo;
+
+/*
+ * Flag values for WmInfo structures:
+ *
+ * WM_NEVER_MAPPED - non-zero means window has never been
+ * mapped; need to update all info when
+ * window is first mapped.
+ * WM_UPDATE_PENDING - non-zero means a call to UpdateGeometryInfo
+ * has already been scheduled for this
+ * window; no need to schedule another one.
+ * WM_NEGATIVE_X - non-zero means x-coordinate is measured in
+ * pixels from right edge of screen, rather
+ * than from left edge.
+ * WM_NEGATIVE_Y - non-zero means y-coordinate is measured in
+ * pixels up from bottom of screen, rather than
+ * down from top.
+ * WM_UPDATE_SIZE_HINTS - non-zero means that new size hints need to be
+ * propagated to window manager.
+ * WM_SYNC_PENDING - set to non-zero while waiting for the window
+ * manager to respond to some state change.
+ * WM_VROOT_OFFSET_STALE - non-zero means that (x,y) offset information
+ * about the virtual root window is stale and
+ * needs to be fetched fresh from the X server.
+ * WM_ABOUT_TO_MAP - non-zero means that the window is about to
+ * be mapped by TkWmMapWindow. This is used
+ * by UpdateGeometryInfo to modify its behavior.
+ * WM_MOVE_PENDING - non-zero means the application has requested
+ * a new position for the window, but it hasn't
+ * been reflected through the window manager
+ * yet.
+ * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were
+ * set explicitly via "wm colormapwindows".
+ * WM_ADDED_TOPLEVEL_COLORMAP - non-zero means that when "wm colormapwindows"
+ * was called the top-level itself wasn't
+ * specified, so we added it implicitly at
+ * the end of the list.
+ * WM_WIDTH_NOT_RESIZABLE - non-zero means that we're not supposed to
+ * allow the user to change the width of the
+ * window (controlled by "wm resizable"
+ * command).
+ * WM_HEIGHT_NOT_RESIZABLE - non-zero means that we're not supposed to
+ * allow the user to change the height of the
+ * window (controlled by "wm resizable"
+ * command).
+ * WM_TRANSIENT_WITHDRAWN - non-zero means that this is a transient window
+ * that has explicitly been withdrawn. It should
+ * not mirror state changes in the master.
+ */
+
+#define WM_NEVER_MAPPED 1
+#define WM_UPDATE_PENDING 2
+#define WM_NEGATIVE_X 4
+#define WM_NEGATIVE_Y 8
+#define WM_UPDATE_SIZE_HINTS 0x10
+#define WM_SYNC_PENDING 0x20
+#define WM_VROOT_OFFSET_STALE 0x40
+#define WM_ABOUT_TO_MAP 0x100
+#define WM_MOVE_PENDING 0x200
+#define WM_COLORMAPS_EXPLICIT 0x400
+#define WM_ADDED_TOPLEVEL_COLORMAP 0x800
+#define WM_WIDTH_NOT_RESIZABLE 0x1000
+#define WM_HEIGHT_NOT_RESIZABLE 0x2000
+#define WM_TRANSIENT_WITHDRAWN 0x4000
+
+/*
+ * This module keeps a list of all top-level windows, primarily to
+ * simplify the job of Tk_CoordsToWindow. The list is called
+ * firstWmPtr and is stored in the TkDisplay structure.
+ */
+
+/*
+ * The following structures are the official type records for geometry
+ * management of top-level and menubar windows.
+ */
+
+static void TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr wmMgrType = {
+ "wm", /* name */
+ TopLevelReqProc, /* requestProc */
+ (Tk_GeomLostSlaveProc *) NULL, /* lostSlaveProc */
+};
+
+static void MenubarReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr menubarMgrType = {
+ "menubar", /* name */
+ MenubarReqProc, /* requestProc */
+ (Tk_GeomLostSlaveProc *) NULL, /* lostSlaveProc */
+};
+
+/*
+ * Structures of the following type are used for communication between
+ * WaitForEvent, WaitRestrictProc, and WaitTimeoutProc.
+ */
+
+typedef struct WaitRestrictInfo {
+ Display *display; /* Window belongs to this display. */
+ WmInfo *wmInfoPtr;
+ int type; /* We only care about this type of event. */
+ XEvent *eventPtr; /* Where to store the event when it's found. */
+ int foundEvent; /* Non-zero means that an event of the
+ * desired type has been found. */
+} WaitRestrictInfo;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static int ComputeReparentGeometry _ANSI_ARGS_((WmInfo *wmPtr));
+static void ConfigureEvent _ANSI_ARGS_((WmInfo *wmPtr,
+ XConfigureEvent *eventPtr));
+static void CreateWrapper _ANSI_ARGS_((WmInfo *wmPtr));
+static void GetMaxSize _ANSI_ARGS_((WmInfo *wmPtr,
+ int *maxWidthPtr, int *maxHeightPtr));
+static void MenubarDestroyProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, TkWindow *winPtr));
+static void ReparentEvent _ANSI_ARGS_((WmInfo *wmPtr,
+ XReparentEvent *eventPtr));
+static void TkWmStackorderToplevelWrapperMap _ANSI_ARGS_((
+ TkWindow *winPtr,
+ Tcl_HashTable *reparentTable));
+static void TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
+ Tk_Window tkwin));
+static void UpdateCommand _ANSI_ARGS_((TkWindow *winPtr));
+static void UpdateGeometryInfo _ANSI_ARGS_((
+ ClientData clientData));
+static void UpdateHints _ANSI_ARGS_((TkWindow *winPtr));
+static void UpdateSizeHints _ANSI_ARGS_((TkWindow *winPtr));
+static void UpdateVRootGeometry _ANSI_ARGS_((WmInfo *wmPtr));
+static void UpdateWmProtocols _ANSI_ARGS_((WmInfo *wmPtr));
+static void WaitForConfigureNotify _ANSI_ARGS_((TkWindow *winPtr,
+ unsigned long serial));
+static int WaitForEvent _ANSI_ARGS_((Display *display,
+ WmInfo *wmInfoPtr, int type, XEvent *eventPtr));
+static void WaitForMapNotify _ANSI_ARGS_((TkWindow *winPtr,
+ int mapped));
+static Tk_RestrictAction
+ WaitRestrictProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void WrapperEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void WmWaitMapProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+
+static int WmAspectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmAttributesCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmClientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmColormapwindowsCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmCommandCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmDeiconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFocusmodelCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFrameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGeometryCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGridCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGroupCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconbitmapCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconwindowCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMaxsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMinsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmOverrideredirectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmPositionfromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmProtocolCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmResizableCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmSizefromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStackorderCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStateCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTitleCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTransientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmWithdrawCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void WmUpdateGeom _ANSI_ARGS_((WmInfo *wmPtr,
+ TkWindow *winPtr));
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmCleanup --
+ *
+ * This procedure is invoked to cleanup remaining wm resources
+ * associated with a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All WmInfo structure resources are freed and invalidated.
+ *
+ *--------------------------------------------------------------
+ */
+
+void TkWmCleanup(dispPtr)
+ TkDisplay *dispPtr;
+{
+ WmInfo *wmPtr, *nextPtr;
+ for (wmPtr = dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = nextPtr) {
+ /*
+ * We can't assume we have access to winPtr's anymore, so some
+ * cleanup requiring winPtr data is avoided.
+ */
+ nextPtr = wmPtr->nextPtr;
+ if (wmPtr->title != NULL) {
+ ckfree(wmPtr->title);
+ }
+ if (wmPtr->iconName != NULL) {
+ ckfree(wmPtr->iconName);
+ }
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ if (wmPtr->menubar != NULL) {
+ Tk_DestroyWindow(wmPtr->menubar);
+ }
+ if (wmPtr->wrapperPtr != NULL) {
+ Tk_DestroyWindow((Tk_Window) wmPtr->wrapperPtr);
+ }
+ while (wmPtr->protPtr != NULL) {
+ ProtocolHandler *protPtr;
+
+ protPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr->nextPtr;
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ if (wmPtr->clientMachine != NULL) {
+ ckfree((char *) wmPtr->clientMachine);
+ }
+ ckfree((char *) wmPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmNewWindow --
+ *
+ * This procedure is invoked whenever a new top-level
+ * window is created. Its job is to initialize the WmInfo
+ * structure for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A WmInfo structure gets allocated and initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmNewWindow(winPtr)
+ TkWindow *winPtr; /* Newly-created top-level window. */
+{
+ register WmInfo *wmPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo));
+ memset(wmPtr, 0, sizeof(WmInfo));
+ wmPtr->winPtr = winPtr;
+ wmPtr->reparent = None;
+ wmPtr->masterPtr = NULL;
+ wmPtr->numTransients = 0;
+ wmPtr->hints.flags = InputHint | StateHint;
+ wmPtr->hints.input = True;
+ wmPtr->hints.initial_state = NormalState;
+ wmPtr->hints.icon_pixmap = None;
+ wmPtr->hints.icon_window = None;
+ wmPtr->hints.icon_x = wmPtr->hints.icon_y = 0;
+ wmPtr->hints.icon_mask = None;
+ wmPtr->hints.window_group = None;
+ wmPtr->minWidth = wmPtr->minHeight = 1;
+
+ /*
+ * Default the maximum dimensions to the size of the display, minus
+ * a guess about how space is needed for window manager decorations.
+ */
+
+ wmPtr->widthInc = wmPtr->heightInc = 1;
+ wmPtr->minAspect.x = wmPtr->minAspect.y = 1;
+ wmPtr->maxAspect.x = wmPtr->maxAspect.y = 1;
+ wmPtr->reqGridWidth = wmPtr->reqGridHeight = -1;
+ wmPtr->gravity = NorthWestGravity;
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ wmPtr->x = winPtr->changes.x;
+ wmPtr->y = winPtr->changes.y;
+ wmPtr->parentWidth = winPtr->changes.width
+ + 2*winPtr->changes.border_width;
+ wmPtr->parentHeight = winPtr->changes.height
+ + 2*winPtr->changes.border_width;
+ wmPtr->configWidth = -1;
+ wmPtr->configHeight = -1;
+ wmPtr->vRoot = None;
+ wmPtr->flags = WM_NEVER_MAPPED;
+ wmPtr->nextPtr = (WmInfo *) dispPtr->firstWmPtr;
+ dispPtr->firstWmPtr = wmPtr;
+ winPtr->wmInfoPtr = wmPtr;
+
+ UpdateVRootGeometry(wmPtr);
+
+ /*
+ * Arrange for geometry requests to be reflected from the window
+ * to the window manager.
+ */
+
+ Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmMapWindow --
+ *
+ * This procedure is invoked to map a top-level window. This
+ * module gets a chance to update all window-manager-related
+ * information in properties before the window manager sees
+ * the map event and checks the properties. It also gets to
+ * decide whether or not to even map the window after all.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties of winPtr may get updated to provide up-to-date
+ * information to the window manager. The window may also get
+ * mapped, but it may not be if this procedure decides that
+ * isn't appropriate (e.g. because the window is withdrawn).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmMapWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's about to
+ * be mapped. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ XTextProperty textProp;
+ Tk_Uid string;
+
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ Tcl_DString ds;
+
+ wmPtr->flags &= ~WM_NEVER_MAPPED;
+
+ /*
+ * This is the first time this window has ever been mapped.
+ * First create the wrapper window that provides space for a
+ * menubar.
+ */
+
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+
+ /*
+ * Store all the window-manager-related information for the
+ * window.
+ */
+
+ string = (wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid;
+ Tcl_UtfToExternalDString(NULL, string, -1, &ds);
+ string = Tcl_DStringValue(&ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
+ XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, &textProp);
+ XFree((char *) textProp.value);
+ }
+ Tcl_DStringFree(&ds);
+
+ TkWmSetClass(winPtr);
+
+ if (wmPtr->iconName != NULL) {
+ Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds);
+ XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
+ Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ }
+
+ if (wmPtr->masterPtr != NULL) {
+ /*
+ * Don't map a transient if the master is not mapped.
+ */
+
+ if (!Tk_IsMapped(wmPtr->masterPtr)) {
+ wmPtr->withdrawn = 1;
+ wmPtr->hints.initial_state = WithdrawnState;
+ } else {
+ XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window,
+ wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window);
+ }
+ }
+
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ UpdateHints(winPtr);
+ UpdateWmProtocols(wmPtr);
+ if (wmPtr->cmdArgv != NULL) {
+ UpdateCommand(winPtr);
+ }
+ if (wmPtr->clientMachine != NULL) {
+ Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
+ XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
+ &textProp);
+ XFree((char *) textProp.value);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ }
+ if (wmPtr->hints.initial_state == WithdrawnState) {
+ return;
+ }
+ if (wmPtr->iconFor != NULL) {
+ /*
+ * This window is an icon for somebody else. Make sure that
+ * the geometry is up-to-date, then return without mapping
+ * the window.
+ */
+
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ return;
+ }
+ wmPtr->flags |= WM_ABOUT_TO_MAP;
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ wmPtr->flags &= ~WM_ABOUT_TO_MAP;
+
+ /*
+ * Map the window, then wait to be sure that the window manager has
+ * processed the map operation.
+ */
+
+ XMapWindow(winPtr->display, wmPtr->wrapperPtr->window);
+ if (wmPtr->hints.initial_state == NormalState) {
+ WaitForMapNotify(winPtr, 1);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmUnmapWindow --
+ *
+ * This procedure is invoked to unmap a top-level window. The
+ * only thing it does special is to wait for the window actually
+ * to be unmapped.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Unmaps the window.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmUnmapWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's about to
+ * be mapped. */
+{
+ /*
+ * It seems to be important to wait after unmapping a top-level
+ * window until the window really gets unmapped. I don't completely
+ * understand all the interactions with the window manager, but if
+ * we go on without waiting, and if the window is then mapped again
+ * quickly, events seem to get lost so that we think the window isn't
+ * mapped when in fact it is mapped. I suspect that this has something
+ * to do with the window manager filtering Map events (and possily not
+ * filtering Unmap events?).
+ */
+ XUnmapWindow(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window);
+ WaitForMapNotify(winPtr, 0);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmDeadWindow --
+ *
+ * This procedure is invoked when a top-level window is
+ * about to be deleted. It cleans up the wm-related data
+ * structures for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The WmInfo structure for winPtr gets freed up.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmDeadWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's being deleted. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ WmInfo *wmPtr2;
+
+ if (wmPtr == NULL) {
+ return;
+ }
+ if ((WmInfo *) winPtr->dispPtr->firstWmPtr == wmPtr) {
+ winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr;
+ } else {
+ register WmInfo *prevPtr;
+
+ for (prevPtr = (WmInfo *) winPtr->dispPtr->firstWmPtr; ;
+ prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ panic("couldn't unlink window in TkWmDeadWindow");
+ }
+ if (prevPtr->nextPtr == wmPtr) {
+ prevPtr->nextPtr = wmPtr->nextPtr;
+ break;
+ }
+ }
+ }
+ if (wmPtr->title != NULL) {
+ ckfree(wmPtr->title);
+ }
+ if (wmPtr->iconName != NULL) {
+ ckfree(wmPtr->iconName);
+ }
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
+ }
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
+ }
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ if (wmPtr->icon != NULL) {
+ wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr2->iconFor = NULL;
+ wmPtr2->withdrawn = 1;
+ }
+ if (wmPtr->iconFor != NULL) {
+ wmPtr2 = ((TkWindow *) wmPtr->iconFor)->wmInfoPtr;
+ wmPtr2->icon = NULL;
+ wmPtr2->hints.flags &= ~IconWindowHint;
+ UpdateHints((TkWindow *) wmPtr->iconFor);
+ }
+ if (wmPtr->menubar != NULL) {
+ Tk_DestroyWindow(wmPtr->menubar);
+ }
+ if (wmPtr->wrapperPtr != NULL) {
+ /*
+ * The rest of Tk doesn't know that we reparent the toplevel
+ * inside the wrapper, so reparent it back out again before
+ * deleting the wrapper; otherwise the toplevel will get deleted
+ * twice (once implicitly by the deletion of the wrapper).
+ */
+
+ XUnmapWindow(winPtr->display, winPtr->window);
+ XReparentWindow(winPtr->display, winPtr->window,
+ XRootWindow(winPtr->display, winPtr->screenNum), 0, 0);
+ Tk_DestroyWindow((Tk_Window) wmPtr->wrapperPtr);
+ }
+ while (wmPtr->protPtr != NULL) {
+ ProtocolHandler *protPtr;
+
+ protPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr->nextPtr;
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ if (wmPtr->clientMachine != NULL) {
+ ckfree((char *) wmPtr->clientMachine);
+ }
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ /*
+ * Reset all transient windows whose master is the dead window.
+ */
+
+ for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL;
+ wmPtr2 = wmPtr2->nextPtr) {
+ if (wmPtr2->masterPtr == winPtr) {
+ wmPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) wmPtr2->masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) wmPtr2->winPtr);
+ wmPtr2->masterPtr = NULL;
+ if (!(wmPtr2->flags & WM_NEVER_MAPPED)) {
+ XSetTransientForHint(wmPtr2->winPtr->display,
+ wmPtr2->wrapperPtr->window, None);
+ /* FIXME: Need a call like Win32's UpdateWrapper() so
+ we can recreate the wrapper and get rid of the
+ transient window decorations. */
+ }
+ }
+ }
+ if (wmPtr->numTransients != 0)
+ panic("numTransients should be 0");
+
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr2 = wmPtr->masterPtr->wmInfoPtr;
+ /*
+ * If we had a master, tell them that we aren't tied
+ * to them anymore
+ */
+ if (wmPtr2 != NULL) {
+ wmPtr2->numTransients--;
+ }
+ Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) winPtr);
+ wmPtr->masterPtr = NULL;
+ }
+ ckfree((char *) wmPtr);
+ winPtr->wmInfoPtr = NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmSetClass --
+ *
+ * This procedure is invoked whenever a top-level window's
+ * class is changed. If the window has been mapped then this
+ * procedure updates the window manager property for the
+ * class. If the window hasn't been mapped, the update is
+ * deferred until just before the first mapping.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A window property may get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmSetClass(winPtr)
+ TkWindow *winPtr; /* Newly-created top-level window. */
+{
+ if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ return;
+ }
+
+ if (winPtr->classUid != NULL) {
+ XClassHint *classPtr;
+ Tcl_DString name, class;
+
+ Tcl_UtfToExternalDString(NULL, winPtr->nameUid, -1, &name);
+ Tcl_UtfToExternalDString(NULL, winPtr->classUid, -1, &class);
+ classPtr = XAllocClassHint();
+ classPtr->res_name = Tcl_DStringValue(&name);
+ classPtr->res_class = Tcl_DStringValue(&class);
+ XSetClassHint(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window,
+ classPtr);
+ XFree((char *) classPtr);
+ Tcl_DStringFree(&name);
+ Tcl_DStringFree(&class);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WmObjCmd --
+ *
+ * This procedure is invoked to process the "wm" 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_WmObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ static CONST char *optionStrings[] = {
+ "aspect", "attributes", "client", "colormapwindows",
+ "command", "deiconify", "focusmodel", "frame",
+ "geometry", "grid", "group", "iconbitmap",
+ "iconify", "iconmask", "iconname", "iconposition",
+ "iconwindow", "maxsize", "minsize", "overrideredirect",
+ "positionfrom", "protocol", "resizable", "sizefrom",
+ "stackorder", "state", "title", "transient",
+ "withdraw", (char *) NULL };
+ enum options {
+ WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
+ WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME,
+ WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
+ WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPOSITION,
+ WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
+ WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
+ WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
+ WMOPT_WITHDRAW };
+ int index;
+ int length;
+ char *argv1;
+ TkWindow *winPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objc < 2) {
+ wrongNumArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ argv1 = Tcl_GetStringFromObj(objv[1], &length);
+ if ((argv1[0] == 't') && (strncmp(argv1, "tracing", (size_t) length) == 0)
+ && (length >= 3)) {
+ int wmTracing;
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetResult(interp,
+ ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmTracing) {
+ dispPtr->flags |= TK_DISPLAY_WM_TRACING;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
+ }
+ return TCL_OK;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc < 3) {
+ goto wrongNumArgs;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], (Tk_Window *) &winPtr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case WMOPT_ASPECT:
+ return WmAspectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ATTRIBUTES:
+ return WmAttributesCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_CLIENT:
+ return WmClientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COLORMAPWINDOWS:
+ return WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COMMAND:
+ return WmCommandCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_DEICONIFY:
+ return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FOCUSMODEL:
+ return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FRAME:
+ return WmFrameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GEOMETRY:
+ return WmGeometryCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GRID:
+ return WmGridCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GROUP:
+ return WmGroupCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONBITMAP:
+ return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONIFY:
+ return WmIconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONMASK:
+ return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONNAME:
+ return WmIconnameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONPOSITION:
+ return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONWINDOW:
+ return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MAXSIZE:
+ return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MINSIZE:
+ return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_OVERRIDEREDIRECT:
+ return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_POSITIONFROM:
+ return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_PROTOCOL:
+ return WmProtocolCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_RESIZABLE:
+ return WmResizableCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_SIZEFROM:
+ return WmSizefromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STACKORDER:
+ return WmStackorderCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STATE:
+ return WmStateCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TITLE:
+ return WmTitleCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TRANSIENT:
+ return WmTransientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_WITHDRAW:
+ return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv);
+ }
+
+ /* This should not happen */
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAspectCmd --
+ *
+ * This procedure is invoked to process the "wm aspect" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmAspectCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int numer1, denom1, numer2, denom2;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?minNumer minDenom maxNumer maxDenom?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PAspect) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
+ wmPtr->minAspect.y, wmPtr->maxAspect.x,
+ wmPtr->maxAspect.y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~PAspect;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &numer1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &denom1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
+ (denom2 <= 0)) {
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ wmPtr->minAspect.x = numer1;
+ wmPtr->minAspect.y = denom1;
+ wmPtr->maxAspect.x = numer2;
+ wmPtr->maxAspect.y = denom2;
+ wmPtr->sizeHintsFlags |= PAspect;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAttributesCmd --
+ *
+ * This procedure is invoked to process the "wm attributes" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmAttributesCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmClientCmd --
+ *
+ * This procedure is invoked to process the "wm client" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmClientCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->clientMachine != NULL) {
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (argv3[0] == 0) {
+ if (wmPtr->clientMachine != NULL) {
+ ckfree((char *) wmPtr->clientMachine);
+ wmPtr->clientMachine = NULL;
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) winPtr,
+ "WM_CLIENT_MACHINE"));
+ }
+ }
+ return TCL_OK;
+ }
+ if (wmPtr->clientMachine != NULL) {
+ ckfree((char *) wmPtr->clientMachine);
+ }
+ wmPtr->clientMachine = (char *)
+ ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->clientMachine, argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XTextProperty textProp;
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
+ XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
+ &textProp);
+ XFree((char *) textProp.value);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmColormapwindowsCmd --
+ *
+ * This procedure is invoked to process the "wm colormapwindows"
+ * Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Window *cmapList;
+ TkWindow *winPtr2;
+ int count, i, windowObjc, gotToplevel;
+ Tcl_Obj **windowObjv;
+ char buffer[20];
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?");
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+ if (objc == 3) {
+ if (XGetWMColormapWindows(winPtr->display,
+ wmPtr->wrapperPtr->window, &cmapList, &count) == 0) {
+ return TCL_OK;
+ }
+ for (i = 0; i < count; i++) {
+ if ((i == (count-1))
+ && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) {
+ break;
+ }
+ winPtr2 = (TkWindow *) Tk_IdToWindow(winPtr->display,
+ cmapList[i]);
+ if (winPtr2 == NULL) {
+ sprintf(buffer, "0x%lx", cmapList[i]);
+ Tcl_AppendElement(interp, buffer);
+ } else {
+ Tcl_AppendElement(interp, winPtr2->pathName);
+ }
+ }
+ XFree((char *) cmapList);
+ return TCL_OK;
+ }
+ if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmapList = (Window *) ckalloc((unsigned)
+ ((windowObjc+1)*sizeof(Window)));
+ gotToplevel = 0;
+ for (i = 0; i < windowObjc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, windowObjv[i],
+ (Tk_Window *) &winPtr2) != TCL_OK)
+ {
+ ckfree((char *) cmapList);
+ return TCL_ERROR;
+ }
+ if (winPtr2 == winPtr) {
+ gotToplevel = 1;
+ }
+ if (winPtr2->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr2);
+ }
+ cmapList[i] = winPtr2->window;
+ }
+ if (!gotToplevel) {
+ wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP;
+ cmapList[windowObjc] = wmPtr->wrapperPtr->window;
+ windowObjc++;
+ } else {
+ wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP;
+ }
+ wmPtr->flags |= WM_COLORMAPS_EXPLICIT;
+ XSetWMColormapWindows(winPtr->display, wmPtr->wrapperPtr->window,
+ cmapList, windowObjc);
+ ckfree((char *) cmapList);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmCommandCmd --
+ *
+ * This procedure is invoked to process the "wm command" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmCommandCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int cmdArgc;
+ CONST char **cmdArgv;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?value?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->cmdArgv != NULL) {
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (argv3[0] == 0) {
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ wmPtr->cmdArgv = NULL;
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) winPtr, "WM_COMMAND"));
+ }
+ }
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv3, &cmdArgc, &cmdArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ wmPtr->cmdArgc = cmdArgc;
+ wmPtr->cmdArgv = cmdArgv;
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ UpdateCommand(winPtr);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmDeiconifyCmd --
+ *
+ * This procedure is invoked to process the "wm deiconify" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]),
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName,
+ ": it is an embedded window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) {
+ wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN;
+ }
+ TkpWmSetState(winPtr, NormalState);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFocusmodelCmd --
+ *
+ * This procedure is invoked to process the "wm focusmodel" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "active", "passive", (char *) NULL };
+ enum options {
+ OPT_ACTIVE, OPT_PASSIVE };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ACTIVE) {
+ wmPtr->hints.input = False;
+ } else { /* OPT_PASSIVE */
+ wmPtr->hints.input = True;
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFrameCmd --
+ *
+ * This procedure is invoked to process the "wm frame" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmFrameCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Window window;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ window = wmPtr->reparent;
+ if (window == None) {
+ window = Tk_WindowId((Tk_Window) winPtr);
+ }
+ sprintf(buf, "0x%x", (unsigned int) window);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGeometryCmd --
+ *
+ * This procedure is invoked to process the "wm geometry" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmGeometryCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char xSign, ySign;
+ int width, height;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
+ xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
+ ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
+ if (wmPtr->gridWin != NULL) {
+ width = wmPtr->reqGridWidth + (winPtr->changes.width
+ - winPtr->reqWidth)/wmPtr->widthInc;
+ height = wmPtr->reqGridHeight + (winPtr->changes.height
+ - winPtr->reqHeight)/wmPtr->heightInc;
+ } else {
+ width = winPtr->changes.width;
+ height = winPtr->changes.height;
+ }
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\0') {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+ }
+ return ParseGeometry(interp, argv3, winPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGridCmd --
+ *
+ * This procedure is invoked to process the "wm grid" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmGridCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int reqWidth, reqHeight, widthInc, heightInc;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?baseWidth baseHeight widthInc heightInc?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PBaseSize) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
+ wmPtr->reqGridHeight, wmPtr->widthInc,
+ wmPtr->heightInc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ /*
+ * Turn off gridding and reset the width and height
+ * to make sense as ungridded numbers.
+ */
+
+ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc);
+ if (wmPtr->width != -1) {
+ wmPtr->width = winPtr->reqWidth + (wmPtr->width
+ - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ wmPtr->height = winPtr->reqHeight + (wmPtr->height
+ - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ }
+ wmPtr->widthInc = 1;
+ wmPtr->heightInc = 1;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &heightInc) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (reqWidth < 0) {
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (reqHeight < 0) {
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (widthInc < 0) {
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (heightInc < 0) {
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
+ heightInc);
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGroupCmd --
+ *
+ * This procedure is invoked to process the "wm group" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmGroupCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & WindowGroupHint) {
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (*argv3 == '\0') {
+ wmPtr->hints.flags &= ~WindowGroupHint;
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->leaderName = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ while (!Tk_TopWinHierarchy(tkwin2)) {
+ /*
+ * Ensure that the group leader is actually a Tk toplevel.
+ */
+
+ tkwin2 = Tk_Parent(tkwin2);
+ }
+ Tk_MakeWindowExist(tkwin2);
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr2);
+ }
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->hints.window_group = Tk_WindowId(wmPtr2->wrapperPtr);
+ wmPtr->hints.flags |= WindowGroupHint;
+ wmPtr->leaderName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->leaderName, argv3);
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconbitmapCmd --
+ *
+ * This procedure is invoked to process the "wm iconbitmap" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Pixmap pixmap;
+ char *argv3;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tcl_SetResult(interp, (char *)
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\0') {
+ if (wmPtr->hints.icon_pixmap != None) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
+ wmPtr->hints.icon_pixmap = None;
+ }
+ wmPtr->hints.flags &= ~IconPixmapHint;
+ } else {
+ pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, argv3);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_pixmap = pixmap;
+ wmPtr->hints.flags |= IconPixmapHint;
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconifyCmd --
+ *
+ * This procedure is invoked to process the "wm iconify" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconifyCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
+ Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
+ "\": override-redirect flag is set", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->masterPtr != NULL) {
+ Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
+ "\": it is a transient", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName,
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName,
+ ": it is an embedded window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkpWmSetState(winPtr, IconicState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send iconify message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconmaskCmd --
+ *
+ * This procedure is invoked to process the "wm iconmask" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconmaskCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Pixmap pixmap;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tcl_SetResult(interp, (char *)
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\0') {
+ if (wmPtr->hints.icon_mask != None) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
+ }
+ wmPtr->hints.flags &= ~IconMaskHint;
+ } else {
+ pixmap = Tk_GetBitmap(interp, tkwin, argv3);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_mask = pixmap;
+ wmPtr->hints.flags |= IconMaskHint;
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconnameCmd --
+ *
+ * This procedure is invoked to process the "wm iconname" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconnameCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp,
+ ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->iconName != NULL) {
+ ckfree((char *) wmPtr->iconName);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->iconName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->iconName, argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds);
+ XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
+ Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconpositionCmd --
+ *
+ * This procedure is invoked to process the "wm iconposition"
+ * Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconpositionCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPositionHint) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->hints.icon_x,
+ wmPtr->hints.icon_y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->hints.flags &= ~IconPositionHint;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_x = x;
+ wmPtr->hints.icon_y = y;
+ wmPtr->hints.flags |= IconPositionHint;
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconwindowCmd --
+ *
+ * This procedure is invoked to process the "wm iconwindow" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconwindowCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+ XSetWindowAttributes atts;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->icon != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->hints.flags &= ~IconWindowHint;
+ if (wmPtr->icon != NULL) {
+ /*
+ * Remove the icon window relationship. In principle we
+ * should also re-enable button events for the window, but
+ * this doesn't work in general because the window manager
+ * is probably selecting on them (we'll get an error if
+ * we try to re-enable the events). So, just leave the
+ * icon window event-challenged; the user will have to
+ * recreate it if they want button events.
+ */
+
+ wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr2->iconFor = NULL;
+ wmPtr2->withdrawn = 1;
+ wmPtr2->hints.initial_state = WithdrawnState;
+ }
+ wmPtr->icon = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(tkwin2)) {
+ Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]),
+ " as icon window: not at top level", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[3]),
+ " is already an icon for ",
+ Tk_PathName(wmPtr2->iconFor), (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->icon != NULL) {
+ WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr3->iconFor = NULL;
+ wmPtr3->withdrawn = 1;
+ wmPtr3->hints.initial_state = WithdrawnState;
+ }
+
+ /*
+ * Disable button events in the icon window: some window
+ * managers (like olvwm) want to get the events themselves,
+ * but X only allows one application at a time to receive
+ * button events for a window.
+ */
+
+ atts.event_mask = Tk_Attributes(tkwin2)->event_mask
+ & ~ButtonPressMask;
+ Tk_ChangeWindowAttributes(tkwin2, CWEventMask, &atts);
+ Tk_MakeWindowExist(tkwin2);
+ if (wmPtr2->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr2);
+ }
+ wmPtr->hints.icon_window = Tk_WindowId(wmPtr2->wrapperPtr);
+ wmPtr->hints.flags |= IconWindowHint;
+ wmPtr->icon = tkwin2;
+ wmPtr2->iconFor = (Tk_Window) winPtr;
+ if (!wmPtr2->withdrawn && !(wmPtr2->flags & WM_NEVER_MAPPED)) {
+ wmPtr2->withdrawn = 0;
+ if (XWithdrawWindow(Tk_Display(tkwin2),
+ Tk_WindowId(wmPtr2->wrapperPtr),
+ Tk_ScreenNumber(tkwin2)) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ WaitForMapNotify((TkWindow *) tkwin2, 0);
+ }
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMaxsizeCmd --
+ *
+ * This procedure is invoked to process the "wm maxsize" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ GetMaxSize(wmPtr, &width, &height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->maxWidth = width;
+ wmPtr->maxHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMinsizeCmd --
+ *
+ * This procedure is invoked to process the "wm minsize" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmMinsizeCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->minWidth = width;
+ wmPtr->minHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmOverrideredirectCmd --
+ *
+ * This procedure is invoked to process the "wm overrideredirect"
+ * Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int boolean, curValue;
+ XSetWindowAttributes atts;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+ curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
+ if (objc == 3) {
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue);
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (curValue != boolean) {
+ /*
+ * Only do this if we are really changing value, because it
+ * causes some funky stuff to occur
+ */
+ atts.override_redirect = (boolean) ? True : False;
+ Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect,
+ &atts);
+ if (winPtr->wmInfoPtr->wrapperPtr != NULL) {
+ Tk_ChangeWindowAttributes(
+ (Tk_Window) winPtr->wmInfoPtr->wrapperPtr,
+ CWOverrideRedirect, &atts);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmPositionfromCmd --
+ *
+ * This procedure is invoked to process the "wm positionfrom"
+ * Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmPositionfromCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USPosition) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PPosition) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PPosition;
+ wmPtr->sizeHintsFlags |= USPosition;
+ } else {
+ wmPtr->sizeHintsFlags &= ~USPosition;
+ wmPtr->sizeHintsFlags |= PPosition;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmProtocolCmd --
+ *
+ * This procedure is invoked to process the "wm protocol" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmProtocolCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ register ProtocolHandler *protPtr, *prevPtr;
+ Atom protocol;
+ char *cmd;
+ int cmdLength;
+
+ if ((objc < 3) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ /*
+ * Return a list of all defined protocols for the window.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ Tcl_AppendElement(interp,
+ Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol));
+ }
+ return TCL_OK;
+ }
+ protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3]));
+ if (objc == 4) {
+ /*
+ * Return the command to handle a given protocol.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Delete any current protocol handler, then create a new
+ * one with the specified command, unless the command is
+ * empty.
+ */
+
+ for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL;
+ prevPtr = protPtr, protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ if (prevPtr == NULL) {
+ wmPtr->protPtr = protPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = protPtr->nextPtr;
+ }
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ break;
+ }
+ }
+ cmd = Tcl_GetStringFromObj(objv[4], &cmdLength);
+ if (cmdLength > 0) {
+ protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength));
+ protPtr->protocol = protocol;
+ protPtr->nextPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr;
+ protPtr->interp = interp;
+ strcpy(protPtr->command, cmd);
+ }
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ UpdateWmProtocols(wmPtr);
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmResizableCmd --
+ *
+ * This procedure is invoked to process the "wm resizable" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmResizableCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
+ (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (width) {
+ wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE;
+ } else {
+ wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE;
+ }
+ if (height) {
+ wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE;
+ } else {
+ wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmSizefromCmd --
+ *
+ * This procedure is invoked to process the "wm sizefrom" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmSizefromCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USSize) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PSize) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USSize|PSize);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PSize;
+ wmPtr->sizeHintsFlags |= USSize;
+ } else { /* OPT_PROGRAM */
+ wmPtr->sizeHintsFlags &= ~USSize;
+ wmPtr->sizeHintsFlags |= PSize;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStackorderCmd --
+ *
+ * This procedure is invoked to process the "wm stackorder" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmStackorderCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ TkWindow **windows, **window_ptr;
+ static CONST char *optionStrings[] = {
+ "isabove", "isbelow", (char *) NULL };
+ enum options {
+ OPT_ISABOVE, OPT_ISBELOW };
+ int index;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?isabove|isbelow window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ windows = TkWmStackorderToplevel(winPtr);
+ if (windows == NULL) {
+ panic("TkWmStackorderToplevel failed");
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ Tcl_AppendElement(interp, (*window_ptr)->pathName);
+ }
+ ckfree((char *) windows);
+ return TCL_OK;
+ }
+ } else {
+ TkWindow *winPtr2;
+ int index1=-1, index2=-1, result;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsTopLevel(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Lookup stacking order of all toplevels that are children
+ * of "." and find the position of winPtr and winPtr2
+ * in the stacking order.
+ */
+
+ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
+
+ if (windows == NULL) {
+ Tcl_AppendResult(interp, "TkWmStackorderToplevel failed",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ if (*window_ptr == winPtr)
+ index1 = (window_ptr - windows);
+ if (*window_ptr == winPtr2)
+ index2 = (window_ptr - windows);
+ }
+ if (index1 == -1)
+ panic("winPtr window not found");
+ if (index2 == -1)
+ panic("winPtr2 window not found");
+
+ ckfree((char *) windows);
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ISABOVE) {
+ result = index1 > index2;
+ } else { /* OPT_ISBELOW */
+ result = index1 < index2;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+ return TCL_OK;
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStateCmd --
+ *
+ * This procedure is invoked to process the "wm state" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmStateCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "normal", "iconic", "withdrawn", (char *) NULL };
+ enum options {
+ OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN };
+ int index;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?state?");
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't change state of ",
+ Tcl_GetString(objv[2]),
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index == OPT_NORMAL) {
+ if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) {
+ wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN;
+ }
+ (void) TkpWmSetState(winPtr, NormalState);
+ } else if (index == OPT_ICONIC) {
+ if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
+ Tcl_AppendResult(interp, "can't iconify \"",
+ winPtr->pathName,
+ "\": override-redirect flag is set",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->masterPtr != NULL) {
+ Tcl_AppendResult(interp, "can't iconify \"",
+ winPtr->pathName,
+ "\": it is a transient", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkpWmSetState(winPtr, IconicState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send iconify message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ } else { /* OPT_WITHDRAWN */
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->flags |= WM_TRANSIENT_WITHDRAWN;
+ }
+ if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+ } else {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
+ } else if (wmPtr->withdrawn) {
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
+ } else if (Tk_IsMapped((Tk_Window) winPtr)
+ || ((wmPtr->flags & WM_NEVER_MAPPED)
+ && (wmPtr->hints.initial_state == NormalState))) {
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTitleCmd --
+ *
+ * This procedure is invoked to process the "wm title" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmTitleCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp, (char *)
+ ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->title != NULL) {
+ ckfree((char *) wmPtr->title);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->title = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->title, argv3);
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XTextProperty textProp;
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, wmPtr->title, -1, &ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
+ XSetWMName(winPtr->display, wmPtr->wrapperPtr->window,
+ &textProp);
+ XFree((char *) textProp.value);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTransientCmd --
+ *
+ * This procedure is invoked to process the "wm transient" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmTransientCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ TkWindow *masterPtr = wmPtr->masterPtr;
+ WmInfo *wmPtr2;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?master?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (masterPtr != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (Tcl_GetString(objv[3])[0] == '\0') {
+ if (masterPtr != NULL) {
+ /*
+ * If we had a master, tell them that we aren't tied
+ * to them anymore
+ */
+
+ masterPtr->wmInfoPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) winPtr);
+
+ /* FIXME: Need a call like Win32's UpdateWrapper() so
+ we can recreate the wrapper and get rid of the
+ transient window decorations. */
+ }
+
+ wmPtr->masterPtr = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3],
+ (Tk_Window *) &masterPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ while (!Tk_TopWinHierarchy(masterPtr)) {
+ /*
+ * Ensure that the master window is actually a Tk toplevel.
+ */
+
+ masterPtr = masterPtr->parentPtr;
+ }
+ Tk_MakeWindowExist((Tk_Window) masterPtr);
+
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[2]),
+ "\" a transient: it is an icon for ",
+ Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ wmPtr2 = masterPtr->wmInfoPtr;
+ if (wmPtr2->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr2);
+ }
+
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[3]),
+ "\" a master: it is an icon for ",
+ Tk_PathName(wmPtr2->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (masterPtr == winPtr) {
+ Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr),
+ "\" its own master",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (masterPtr != wmPtr->masterPtr) {
+ /*
+ * Remove old master map/unmap binding before setting
+ * the new master. The event handler will ensure that
+ * transient states reflect the state of the master.
+ */
+
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->masterPtr->wmInfoPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) winPtr);
+ }
+
+ masterPtr->wmInfoPtr->numTransients++;
+ Tk_CreateEventHandler((Tk_Window) masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) winPtr);
+
+ wmPtr->masterPtr = masterPtr;
+ }
+ }
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) {
+ if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ } else {
+ Window xwin = (wmPtr->masterPtr == NULL) ? None :
+ wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window;
+ XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window,
+ xwin);
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmWithdrawCmd --
+ *
+ * This procedure is invoked to process the "wm withdraw" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmWithdrawCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]),
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->flags |= WM_TRANSIENT_WITHDRAWN;
+ }
+ if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ * Invoked by those wm subcommands that affect geometry.
+ * Schedules a geometry update.
+ */
+static void
+WmUpdateGeom(wmPtr, winPtr)
+ WmInfo *wmPtr;
+ TkWindow *winPtr;
+{
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ * Invoked when a MapNotify or UnmapNotify event is delivered for a
+ * toplevel that is the master of a transient toplevel.
+ */
+static void
+WmWaitMapProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ TkWindow *masterPtr = winPtr->wmInfoPtr->masterPtr;
+
+ if (masterPtr == NULL)
+ return;
+
+ if (eventPtr->type == MapNotify) {
+ if (!(winPtr->wmInfoPtr->flags & WM_TRANSIENT_WITHDRAWN))
+ (void) TkpWmSetState(winPtr, NormalState);
+ } else if (eventPtr->type == UnmapNotify) {
+ (void) TkpWmSetState(winPtr, WithdrawnState);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetGrid --
+ *
+ * This procedure is invoked by a widget when it wishes to set a grid
+ * coordinate system that controls the size of a top-level window.
+ * It provides a C interface equivalent to the "wm grid" command and
+ * is usually asscoiated with the -setgrid option.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Grid-related information will be passed to the window manager, so
+ * that the top-level window associated with tkwin will resize on
+ * even grid units. If some other window already controls gridding
+ * for the top-level window then this procedure call has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetGrid(tkwin, reqWidth, reqHeight, widthInc, heightInc)
+ Tk_Window tkwin; /* Token for window. New window mgr info
+ * will be posted for the top-level window
+ * associated with this window. */
+ int reqWidth; /* Width (in grid units) corresponding to
+ * the requested geometry for tkwin. */
+ int reqHeight; /* Height (in grid units) corresponding to
+ * the requested geometry for tkwin. */
+ int widthInc, heightInc; /* Pixel increments corresponding to a
+ * change of one grid unit. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr;
+
+ /*
+ * Find the top-level window for tkwin, plus the window manager
+ * information.
+ */
+
+ while (!(winPtr->flags & TK_TOP_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ /*
+ * The window is being deleted... just skip this operation.
+ */
+
+ return;
+ }
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+
+ if ((wmPtr->gridWin != NULL) && (wmPtr->gridWin != tkwin)) {
+ return;
+ }
+
+ if ((wmPtr->reqGridWidth == reqWidth)
+ && (wmPtr->reqGridHeight == reqHeight)
+ && (wmPtr->widthInc == widthInc)
+ && (wmPtr->heightInc == heightInc)
+ && ((wmPtr->sizeHintsFlags & (PBaseSize|PResizeInc))
+ == (PBaseSize|PResizeInc))) {
+ return;
+ }
+
+ /*
+ * If gridding was previously off, then forget about any window
+ * size requests made by the user or via "wm geometry": these are
+ * in pixel units and there's no easy way to translate them to
+ * grid units since the new requested size of the top-level window in
+ * pixels may not yet have been registered yet (it may filter up
+ * the hierarchy in DoWhenIdle handlers). However, if the window
+ * has never been mapped yet then just leave the window size alone:
+ * assume that it is intended to be in grid units but just happened
+ * to have been specified before this procedure was called.
+ */
+
+ if ((wmPtr->gridWin == NULL) && !(wmPtr->flags & WM_NEVER_MAPPED)) {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ }
+
+ /*
+ * Set the new gridding information, and start the process of passing
+ * all of this information to the window manager.
+ */
+
+ wmPtr->gridWin = tkwin;
+ wmPtr->reqGridWidth = reqWidth;
+ wmPtr->reqGridHeight = reqHeight;
+ wmPtr->widthInc = widthInc;
+ wmPtr->heightInc = heightInc;
+ wmPtr->sizeHintsFlags |= PBaseSize|PResizeInc;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UnsetGrid --
+ *
+ * This procedure cancels the effect of a previous call
+ * to Tk_SetGrid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If tkwin currently controls gridding for its top-level window,
+ * gridding is cancelled for that top-level window; if some other
+ * window controls gridding then this procedure has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnsetGrid(tkwin)
+ Tk_Window tkwin; /* Token for window that is currently
+ * controlling gridding. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr;
+
+ /*
+ * Find the top-level window for tkwin, plus the window manager
+ * information.
+ */
+
+ while (!(winPtr->flags & TK_TOP_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ /*
+ * The window is being deleted... just skip this operation.
+ */
+
+ return;
+ }
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+
+ if (tkwin != wmPtr->gridWin) {
+ return;
+ }
+
+ wmPtr->gridWin = NULL;
+ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc);
+ if (wmPtr->width != -1) {
+ wmPtr->width = winPtr->reqWidth + (wmPtr->width
+ - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ wmPtr->height = winPtr->reqHeight + (wmPtr->height
+ - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ }
+ wmPtr->widthInc = 1;
+ wmPtr->heightInc = 1;
+
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureEvent --
+ *
+ * This procedure is called to handle ConfigureNotify events on
+ * wrapper windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets updated in the WmInfo structure for the window
+ * and the toplevel itself gets repositioned within the wrapper.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConfigureEvent(wmPtr, configEventPtr)
+ WmInfo *wmPtr; /* Information about toplevel window. */
+ XConfigureEvent *configEventPtr; /* Event that just occurred for
+ * wmPtr->wrapperPtr. */
+{
+ TkWindow *wrapperPtr = wmPtr->wrapperPtr;
+ TkWindow *winPtr = wmPtr->winPtr;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
+ Tk_ErrorHandler handler;
+
+ /*
+ * Update size information from the event. There are a couple of
+ * tricky points here:
+ *
+ * 1. If the user changed the size externally then set wmPtr->width
+ * and wmPtr->height just as if a "wm geometry" command had been
+ * invoked with the same information.
+ * 2. However, if the size is changing in response to a request
+ * coming from us (WM_SYNC_PENDING is set), then don't set wmPtr->width
+ * or wmPtr->height if they were previously -1 (otherwise the
+ * window will stop tracking geometry manager requests).
+ */
+
+ if (((wrapperPtr->changes.width != configEventPtr->width)
+ || (wrapperPtr->changes.height != configEventPtr->height))
+ && !(wmPtr->flags & WM_SYNC_PENDING)){
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("TopLevelEventProc: user changed %s size to %dx%d\n",
+ winPtr->pathName, configEventPtr->width,
+ configEventPtr->height);
+ }
+ if ((wmPtr->width == -1)
+ && (configEventPtr->width == winPtr->reqWidth)) {
+ /*
+ * Don't set external width, since the user didn't change it
+ * from what the widgets asked for.
+ */
+ } else {
+ /*
+ * Note: if this window is embedded then don't set the external
+ * size, since it came from the containing application, not the
+ * user. In this case we want to keep sending our size requests
+ * to the containing application; if the user fixes the size
+ * of that application then it will still percolate down to us
+ * in the right way.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (wmPtr->gridWin != NULL) {
+ wmPtr->width = wmPtr->reqGridWidth
+ + (configEventPtr->width
+ - winPtr->reqWidth)/wmPtr->widthInc;
+ if (wmPtr->width < 0) {
+ wmPtr->width = 0;
+ }
+ } else {
+ wmPtr->width = configEventPtr->width;
+ }
+ }
+ }
+ if ((wmPtr->height == -1)
+ && (configEventPtr->height ==
+ (winPtr->reqHeight + wmPtr->menuHeight))) {
+ /*
+ * Don't set external height, since the user didn't change it
+ * from what the widgets asked for.
+ */
+ } else {
+ /*
+ * See note for wmPtr->width about not setting external size
+ * for embedded windows.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (wmPtr->gridWin != NULL) {
+ wmPtr->height = wmPtr->reqGridHeight
+ + (configEventPtr->height - wmPtr->menuHeight
+ - winPtr->reqHeight)/wmPtr->heightInc;
+ if (wmPtr->height < 0) {
+ wmPtr->height = 0;
+ }
+ } else {
+ wmPtr->height = configEventPtr->height - wmPtr->menuHeight;
+ }
+ }
+ }
+ wmPtr->configWidth = configEventPtr->width;
+ wmPtr->configHeight = configEventPtr->height;
+ }
+
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("ConfigureEvent: %s x = %d y = %d, width = %d, height = %d\n",
+ winPtr->pathName, configEventPtr->x, configEventPtr->y,
+ configEventPtr->width, configEventPtr->height);
+ printf(" send_event = %d, serial = %ld (win %p, wrapper %p)\n",
+ configEventPtr->send_event, configEventPtr->serial,
+ winPtr, wrapperPtr);
+ }
+ wrapperPtr->changes.width = configEventPtr->width;
+ wrapperPtr->changes.height = configEventPtr->height;
+ wrapperPtr->changes.border_width = configEventPtr->border_width;
+ wrapperPtr->changes.sibling = configEventPtr->above;
+ wrapperPtr->changes.stack_mode = Above;
+
+ /*
+ * Reparenting window managers make life difficult. If the
+ * window manager reparents a top-level window then the x and y
+ * information that comes in events for the window is wrong:
+ * it gives the location of the window inside its decorative
+ * parent, rather than the location of the window in root
+ * coordinates, which is what we want. Window managers
+ * are supposed to send synthetic events with the correct
+ * information, but ICCCM doesn't require them to do this
+ * under all conditions, and the information provided doesn't
+ * include everything we need here. So, the code below
+ * maintains a bunch of information about the parent window.
+ * If the window hasn't been reparented, we pretend that
+ * there is a parent shrink-wrapped around the window.
+ */
+
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf(" %s parent == %p, above %p\n",
+ winPtr->pathName, (void *) wmPtr->reparent,
+ (void *) configEventPtr->above);
+ }
+
+ if ((wmPtr->reparent == None) || !ComputeReparentGeometry(wmPtr)) {
+ wmPtr->parentWidth = configEventPtr->width
+ + 2*configEventPtr->border_width;
+ wmPtr->parentHeight = configEventPtr->height
+ + 2*configEventPtr->border_width;
+ wrapperPtr->changes.x = wmPtr->x = configEventPtr->x;
+ wrapperPtr->changes.y = wmPtr->y = configEventPtr->y;
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ wmPtr->x = wmPtr->vRootWidth - (wmPtr->x + wmPtr->parentWidth);
+ }
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ wmPtr->y = wmPtr->vRootHeight - (wmPtr->y + wmPtr->parentHeight);
+ }
+ }
+
+ /*
+ * Make sure that the toplevel and menubar are properly positioned within
+ * the wrapper. If the menuHeight happens to be zero, we'll get a
+ * BadValue X error that we want to ignore [Bug: 3377]
+ */
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XMoveResizeWindow(winPtr->display, winPtr->window, 0,
+ wmPtr->menuHeight, (unsigned) wrapperPtr->changes.width,
+ (unsigned) (wrapperPtr->changes.height - wmPtr->menuHeight));
+ Tk_DeleteErrorHandler(handler);
+ if ((wmPtr->menubar != NULL)
+ && ((Tk_Width(wmPtr->menubar) != wrapperPtr->changes.width)
+ || (Tk_Height(wmPtr->menubar) != wmPtr->menuHeight))) {
+ Tk_MoveResizeWindow(wmPtr->menubar, 0, 0, wrapperPtr->changes.width,
+ wmPtr->menuHeight);
+ }
+
+ /*
+ * Update the coordinates in the toplevel (they should refer to the
+ * position in root window coordinates, not the coordinates of the
+ * wrapper window). Then synthesize a ConfigureNotify event to tell
+ * the application about the change.
+ */
+
+ winPtr->changes.x = wrapperPtr->changes.x;
+ winPtr->changes.y = wrapperPtr->changes.y + wmPtr->menuHeight;
+ winPtr->changes.width = wrapperPtr->changes.width;
+ winPtr->changes.height = wrapperPtr->changes.height - wmPtr->menuHeight;
+ TkDoConfigureNotify(winPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReparentEvent --
+ *
+ * This procedure is called to handle ReparentNotify events on
+ * wrapper windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets updated in the WmInfo structure for the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReparentEvent(wmPtr, reparentEventPtr)
+ WmInfo *wmPtr; /* Information about toplevel window. */
+ XReparentEvent *reparentEventPtr; /* Event that just occurred for
+ * wmPtr->wrapperPtr. */
+{
+ TkWindow *wrapperPtr = wmPtr->wrapperPtr;
+ Window vRoot, ancestor, *children, dummy2, *virtualRootPtr;
+ Atom actualType;
+ int actualFormat;
+ unsigned long numItems, bytesAfter;
+ unsigned int dummy;
+ Tk_ErrorHandler handler;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
+
+ /*
+ * Identify the root window for wrapperPtr. This is tricky because of
+ * virtual root window managers like tvtwm. If the window has a
+ * property named __SWM_ROOT or __WM_ROOT then this property gives
+ * the id for a virtual root window that should be used instead of
+ * the root window of the screen.
+ */
+
+ vRoot = RootWindow(wrapperPtr->display, wrapperPtr->screenNum);
+ wmPtr->vRoot = None;
+ handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ if (((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"), 0, (long) 1,
+ False, XA_WINDOW, &actualType, &actualFormat, &numItems,
+ &bytesAfter, (unsigned char **) &virtualRootPtr) == Success)
+ && (actualType == XA_WINDOW))
+ || ((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"), 0, (long) 1,
+ False, XA_WINDOW, &actualType, &actualFormat, &numItems,
+ &bytesAfter, (unsigned char **) &virtualRootPtr) == Success)
+ && (actualType == XA_WINDOW))) {
+ if ((actualFormat == 32) && (numItems == 1)) {
+ vRoot = wmPtr->vRoot = *virtualRootPtr;
+ } else if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("%s format %d numItems %ld\n",
+ "ReparentEvent got bogus VROOT property:", actualFormat,
+ numItems);
+ }
+ XFree((char *) virtualRootPtr);
+ }
+ Tk_DeleteErrorHandler(handler);
+
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("ReparentEvent: %s (%p) reparented to 0x%x, vRoot = 0x%x\n",
+ wmPtr->winPtr->pathName, wmPtr->winPtr,
+ (unsigned int) reparentEventPtr->parent, (unsigned int) vRoot);
+ }
+
+ /*
+ * Fetch correct geometry information for the new virtual root.
+ */
+
+ UpdateVRootGeometry(wmPtr);
+
+ /*
+ * If the window's new parent is the root window, then mark it as
+ * no longer reparented.
+ */
+
+ if (reparentEventPtr->parent == vRoot) {
+ noReparent:
+ wmPtr->reparent = None;
+ wmPtr->parentWidth = wrapperPtr->changes.width;
+ wmPtr->parentHeight = wrapperPtr->changes.height;
+ wmPtr->xInParent = wmPtr->yInParent = 0;
+ wrapperPtr->changes.x = reparentEventPtr->x;
+ wrapperPtr->changes.y = reparentEventPtr->y;
+ wmPtr->winPtr->changes.x = reparentEventPtr->x;
+ wmPtr->winPtr->changes.y = reparentEventPtr->y + wmPtr->menuHeight;
+ return;
+ }
+
+ /*
+ * Search up the window hierarchy to find the ancestor of this
+ * window that is just below the (virtual) root. This is tricky
+ * because it's possible that things have changed since the event
+ * was generated so that the ancestry indicated by the event no
+ * longer exists. If this happens then an error will occur and
+ * we just discard the event (there will be a more up-to-date
+ * ReparentNotify event coming later).
+ */
+
+ handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ wmPtr->reparent = reparentEventPtr->parent;
+ while (1) {
+ if (XQueryTree(wrapperPtr->display, wmPtr->reparent, &dummy2,
+ &ancestor, &children, &dummy) == 0) {
+ Tk_DeleteErrorHandler(handler);
+ goto noReparent;
+ }
+ XFree((char *) children);
+ if ((ancestor == vRoot) ||
+ (ancestor == RootWindow(wrapperPtr->display,
+ wrapperPtr->screenNum))) {
+ break;
+ }
+ wmPtr->reparent = ancestor;
+ }
+ Tk_DeleteErrorHandler(handler);
+
+ if (!ComputeReparentGeometry(wmPtr)) {
+ goto noReparent;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeReparentGeometry --
+ *
+ * This procedure is invoked to recompute geometry information
+ * related to a reparented top-level window, such as the position
+ * and total size of the parent and the position within it of
+ * the top-level window.
+ *
+ * Results:
+ * The return value is 1 if everything completed successfully
+ * and 0 if an error occurred while querying information about
+ * winPtr's parents. In this case winPtr is marked as no longer
+ * being reparented.
+ *
+ * Side effects:
+ * Geometry information in wmPtr, wmPtr->winPtr, and
+ * wmPtr->wrapperPtr gets updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ComputeReparentGeometry(wmPtr)
+ WmInfo *wmPtr; /* Information about toplevel window
+ * whose reparent info is to be recomputed. */
+{
+ TkWindow *wrapperPtr = wmPtr->wrapperPtr;
+ int width, height, bd;
+ unsigned int dummy;
+ int xOffset, yOffset, x, y;
+ Window dummy2;
+ Status status;
+ Tk_ErrorHandler handler;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
+
+ handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ (void) XTranslateCoordinates(wrapperPtr->display, wrapperPtr->window,
+ wmPtr->reparent, 0, 0, &xOffset, &yOffset, &dummy2);
+ status = XGetGeometry(wrapperPtr->display, wmPtr->reparent,
+ &dummy2, &x, &y, (unsigned int *) &width,
+ (unsigned int *) &height, (unsigned int *) &bd, &dummy);
+ Tk_DeleteErrorHandler(handler);
+ if (status == 0) {
+ /*
+ * It appears that the reparented parent went away and
+ * no-one told us. Reset the window to indicate that
+ * it's not reparented.
+ */
+ wmPtr->reparent = None;
+ wmPtr->xInParent = wmPtr->yInParent = 0;
+ return 0;
+ }
+ wmPtr->xInParent = xOffset + bd;
+ wmPtr->yInParent = yOffset + bd;
+ wmPtr->parentWidth = width + 2*bd;
+ wmPtr->parentHeight = height + 2*bd;
+
+ /*
+ * Some tricky issues in updating wmPtr->x and wmPtr->y:
+ *
+ * 1. Don't update them if the event occurred because of something
+ * we did (i.e. WM_SYNC_PENDING and WM_MOVE_PENDING are both set).
+ * This is because window managers treat coords differently than Tk,
+ * and no two window managers are alike. If the window manager moved
+ * the window because we told it to, remember the coordinates we told
+ * it, not the ones it actually moved it to. This allows us to move
+ * the window back to the same coordinates later and get the same
+ * result. Without this check, windows can "walk" across the screen
+ * under some conditions.
+ *
+ * 2. Don't update wmPtr->x and wmPtr->y unless wrapperPtr->changes.x
+ * or wrapperPtr->changes.y has changed (otherwise a size change can
+ * spoof us into thinking that the position changed too and defeat
+ * the intent of (1) above.
+ *
+ * (As of 9/96 the above 2 comments appear to be stale. They're
+ * being left in place as a reminder of what was once true (and
+ * perhaps should still be true?)).
+ *
+ * 3. Ignore size changes coming from the window system if we're
+ * about to change the size ourselves but haven't seen the event for
+ * it yet: our size change is supposed to take priority.
+ */
+
+ if (!(wmPtr->flags & WM_MOVE_PENDING)
+ && ((wrapperPtr->changes.x != (x + wmPtr->xInParent))
+ || (wrapperPtr->changes.y != (y + wmPtr->yInParent)))) {
+ wmPtr->x = x;
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ wmPtr->x = wmPtr->vRootWidth - (wmPtr->x + wmPtr->parentWidth);
+ }
+ wmPtr->y = y;
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ wmPtr->y = wmPtr->vRootHeight - (wmPtr->y + wmPtr->parentHeight);
+ }
+ }
+
+ wrapperPtr->changes.x = x + wmPtr->xInParent;
+ wrapperPtr->changes.y = y + wmPtr->yInParent;
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("wrapperPtr %p coords %d,%d\n",
+ wrapperPtr, wrapperPtr->changes.x, wrapperPtr->changes.y);
+ printf(" wmPtr %p coords %d,%d, offsets %d %d\n",
+ wmPtr, wmPtr->x, wmPtr->y, wmPtr->xInParent, wmPtr->yInParent);
+ }
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WrapperEventProc --
+ *
+ * This procedure is invoked by the event loop when a wrapper window
+ * is restructured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tk's internal data structures for the window get modified to
+ * reflect the structural change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WrapperEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about toplevel window. */
+ XEvent *eventPtr; /* Event that just happened. */
+{
+ WmInfo *wmPtr = (WmInfo *) clientData;
+ XEvent mapEvent;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
+
+ wmPtr->flags |= WM_VROOT_OFFSET_STALE;
+ if (eventPtr->type == DestroyNotify) {
+ Tk_ErrorHandler handler;
+
+ if (!(wmPtr->wrapperPtr->flags & TK_ALREADY_DEAD)) {
+ /*
+ * A top-level window was deleted externally (e.g., by the window
+ * manager). This is probably not a good thing, but cleanup as
+ * best we can. The error handler is needed because
+ * Tk_DestroyWindow will try to destroy the window, but of course
+ * it's already gone.
+ */
+
+ handler = Tk_CreateErrorHandler(wmPtr->winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ Tk_DestroyWindow((Tk_Window) wmPtr->winPtr);
+ Tk_DeleteErrorHandler(handler);
+ }
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("TopLevelEventProc: %s deleted\n", wmPtr->winPtr->pathName);
+ }
+ } else if (eventPtr->type == ConfigureNotify) {
+ /*
+ * Ignore the event if the window has never been mapped yet.
+ * Such an event occurs only in weird cases like changing the
+ * internal border width of a top-level window, which results
+ * in a synthetic Configure event. These events are not relevant
+ * to us, and if we process them confusion may result (e.g. we
+ * may conclude erroneously that the user repositioned or resized
+ * the window).
+ */
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ ConfigureEvent(wmPtr, &eventPtr->xconfigure);
+ }
+ } else if (eventPtr->type == MapNotify) {
+ wmPtr->wrapperPtr->flags |= TK_MAPPED;
+ wmPtr->winPtr->flags |= TK_MAPPED;
+ XMapWindow(wmPtr->winPtr->display, wmPtr->winPtr->window);
+ goto doMapEvent;
+ } else if (eventPtr->type == UnmapNotify) {
+ wmPtr->wrapperPtr->flags &= ~TK_MAPPED;
+ wmPtr->winPtr->flags &= ~TK_MAPPED;
+ XUnmapWindow(wmPtr->winPtr->display, wmPtr->winPtr->window);
+ goto doMapEvent;
+ } else if (eventPtr->type == ReparentNotify) {
+ ReparentEvent(wmPtr, &eventPtr->xreparent);
+ }
+ return;
+
+ doMapEvent:
+ mapEvent = *eventPtr;
+ mapEvent.xmap.event = wmPtr->winPtr->window;
+ mapEvent.xmap.window = wmPtr->winPtr->window;
+ Tk_HandleEvent(&mapEvent);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TopLevelReqProc --
+ *
+ * This procedure is invoked by the geometry manager whenever
+ * the requested size for a top-level window is changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arrange for the window to be resized to satisfy the request
+ * (this happens as a when-idle action).
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+TopLevelReqProc(dummy, tkwin)
+ ClientData dummy; /* Not used. */
+ Tk_Window tkwin; /* Information about window. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ WmInfo *wmPtr;
+
+ wmPtr = winPtr->wmInfoPtr;
+
+ if ((wmPtr->width >= 0) && (wmPtr->height >= 0)) {
+ /*
+ * Explicit dimensions have been set for this window, so we
+ * should ignore the geometry request. It's actually important
+ * to ignore the geometry request because, due to quirks in
+ * window managers, invoking UpdateGeometryInfo may cause the
+ * window to move. For example, if "wm geometry -10-20" was
+ * invoked, the window may be positioned incorrectly the first
+ * time it appears (because we didn't know the proper width of
+ * the window manager borders); if we invoke UpdateGeometryInfo
+ * again, the window will be positioned correctly, which may
+ * cause it to jump on the screen.
+ */
+
+ return;
+ }
+
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+
+ /*
+ * If the window isn't being positioned by its upper left corner
+ * then we have to move it as well.
+ */
+
+ if (wmPtr->flags & (WM_NEGATIVE_X | WM_NEGATIVE_Y)) {
+ wmPtr->flags |= WM_MOVE_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateGeometryInfo --
+ *
+ * This procedure is invoked when a top-level window is first
+ * mapped, and also as a when-idle procedure, to bring the
+ * geometry and/or position of a top-level window back into
+ * line with what has been requested by the user and/or widgets.
+ * This procedure doesn't return until the window manager has
+ * responded to the geometry change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location of both the toplevel window and its wrapper
+ * may change, unless the WM prevents that from happening.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateGeometryInfo(clientData)
+ ClientData clientData; /* Pointer to the window's record. */
+{
+ register TkWindow *winPtr = (TkWindow *) clientData;
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y, width, height;
+ unsigned long serial;
+
+ wmPtr->flags &= ~WM_UPDATE_PENDING;
+
+ /*
+ * Compute the new size for the top-level window. See the
+ * user documentation for details on this, but the size
+ * requested depends on (a) the size requested internally
+ * by the window's widgets, (b) the size requested by the
+ * user in a "wm geometry" command or via wm-based interactive
+ * resizing (if any), and (c) whether or not the window is
+ * gridded. Don't permit sizes <= 0 because this upsets
+ * the X server.
+ */
+
+ if (wmPtr->width == -1) {
+ width = winPtr->reqWidth;
+ } else if (wmPtr->gridWin != NULL) {
+ width = winPtr->reqWidth
+ + (wmPtr->width - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ } else {
+ width = wmPtr->width;
+ }
+ if (width <= 0) {
+ width = 1;
+ }
+ if (wmPtr->height == -1) {
+ height = winPtr->reqHeight;
+ } else if (wmPtr->gridWin != NULL) {
+ height = winPtr->reqHeight
+ + (wmPtr->height - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ } else {
+ height = wmPtr->height;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+
+ /*
+ * Compute the new position for the upper-left pixel of the window's
+ * decorative frame. This is tricky, because we need to include the
+ * border widths supplied by a reparented parent in this calculation,
+ * but can't use the parent's current overall size since that may
+ * change as a result of this code.
+ */
+
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ x = wmPtr->vRootWidth - wmPtr->x
+ - (width + (wmPtr->parentWidth - winPtr->changes.width));
+ } else {
+ x = wmPtr->x;
+ }
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ y = wmPtr->vRootHeight - wmPtr->y
+ - (height + (wmPtr->parentHeight - winPtr->changes.height));
+ } else {
+ y = wmPtr->y;
+ }
+
+ /*
+ * If the window's size is going to change and the window is
+ * supposed to not be resizable by the user, then we have to
+ * update the size hints. There may also be a size-hint-update
+ * request pending from somewhere else, too.
+ */
+
+ if (((width != winPtr->changes.width)
+ || (height != winPtr->changes.height))
+ && (wmPtr->gridWin == NULL)
+ && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) {
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ }
+ if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) {
+ UpdateSizeHints(winPtr);
+ }
+
+ /*
+ * Reconfigure the wrapper if it isn't already configured correctly.
+ * A few tricky points:
+ *
+ * 1. If the window is embeddedand the container is also in this
+ * process, don't actually reconfigure the window; just pass the
+ * desired size on to the container. Also, zero out any position
+ * information, since embedded windows are not allowed to move.
+ * 2. Sometimes the window manager will give us a different size
+ * than we asked for (e.g. mwm has a minimum size for windows), so
+ * base the size check on what we *asked for* last time, not what we
+ * got.
+ * 3. Can't just reconfigure always, because we may not get a
+ * ConfigureNotify event back if nothing changed, so
+ * WaitForConfigureNotify will hang a long time.
+ * 4. Don't move window unless a new position has been requested for
+ * it. This is because of "features" in some window managers (e.g.
+ * twm, as of 4/24/91) where they don't interpret coordinates
+ * according to ICCCM. Moving a window to its current location may
+ * cause it to shift position on the screen.
+ */
+
+ if ((winPtr->flags & (TK_EMBEDDED|TK_BOTH_HALVES))
+ == (TK_EMBEDDED|TK_BOTH_HALVES)) {
+ /*
+ * This window is embedded and the container is also in this
+ * process, so we don't need to do anything special about the
+ * geometry, except to make sure that the desired size is known
+ * by the container. Also, zero out any position information,
+ * since embedded windows are not allowed to move.
+ */
+
+ wmPtr->x = wmPtr->y = 0;
+ wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
+ height += wmPtr->menuHeight;
+ Tk_GeometryRequest((Tk_Window) TkpGetOtherWindow(winPtr),
+ width, height);
+ return;
+ }
+ serial = NextRequest(winPtr->display);
+ height += wmPtr->menuHeight;
+ if (wmPtr->flags & WM_MOVE_PENDING) {
+ if ((x + wmPtr->xInParent == winPtr->changes.x) &&
+ (y + wmPtr->yInParent + wmPtr->menuHeight == winPtr->changes.y)
+ && (width == wmPtr->wrapperPtr->changes.width)
+ && (height == wmPtr->wrapperPtr->changes.height)) {
+ /*
+ * The window already has the correct geometry, so don't bother
+ * to configure it; the X server appears to ignore these
+ * requests, so we won't get back a ConfigureNotify and the
+ * WaitForConfigureNotify call below will hang for a while.
+ */
+
+ wmPtr->flags &= ~WM_MOVE_PENDING;
+ return;
+ }
+ wmPtr->configWidth = width;
+ wmPtr->configHeight = height;
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("UpdateGeometryInfo moving to %d %d, resizing to %d x %d,\n",
+ x, y, width, height);
+ }
+ XMoveResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, x, y,
+ (unsigned) width, (unsigned) height);
+ } else if ((width != wmPtr->configWidth)
+ || (height != wmPtr->configHeight)) {
+ if ((width == wmPtr->wrapperPtr->changes.width)
+ && (height == wmPtr->wrapperPtr->changes.height)) {
+ /*
+ * The window is already just the size we want, so don't bother
+ * to configure it; the X server appears to ignore these
+ * requests, so we won't get back a ConfigureNotify and the
+ * WaitForConfigureNotify call below will hang for a while.
+ */
+
+ return;
+ }
+ wmPtr->configWidth = width;
+ wmPtr->configHeight = height;
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("UpdateGeometryInfo resizing %p to %d x %d\n",
+ (void *)wmPtr->wrapperPtr->window, width, height);
+ }
+ XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window,
+ (unsigned) width, (unsigned) height);
+ } else if ((wmPtr->menubar != NULL)
+ && ((Tk_Width(wmPtr->menubar) != wmPtr->wrapperPtr->changes.width)
+ || (Tk_Height(wmPtr->menubar) != wmPtr->menuHeight))) {
+ /*
+ * It is possible that the window's overall size has not changed
+ * but the menu size has.
+ */
+
+ Tk_MoveResizeWindow(wmPtr->menubar, 0, 0,
+ wmPtr->wrapperPtr->changes.width, wmPtr->menuHeight);
+ XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window,
+ (unsigned) width, (unsigned) height);
+ } else {
+ return;
+ }
+
+ /*
+ * Wait for the configure operation to complete. Don't need to do
+ * this, however, if the window is about to be mapped: it will be
+ * taken care of elsewhere.
+ */
+
+ if (!(wmPtr->flags & WM_ABOUT_TO_MAP)) {
+ WaitForConfigureNotify(winPtr, serial);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * UpdateSizeHints --
+ *
+ * This procedure is called to update the window manager's
+ * size hints information from the information in a WmInfo
+ * structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties get changed for winPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+UpdateSizeHints(winPtr)
+ TkWindow *winPtr;
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ XSizeHints *hintsPtr;
+ int maxWidth, maxHeight;
+
+ wmPtr->flags &= ~WM_UPDATE_SIZE_HINTS;
+
+ hintsPtr = XAllocSizeHints();
+ if (hintsPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Compute the pixel-based sizes for the various fields in the
+ * size hints structure, based on the grid-based sizes in
+ * our structure.
+ */
+
+ GetMaxSize(wmPtr, &maxWidth, &maxHeight);
+ if (wmPtr->gridWin != NULL) {
+ hintsPtr->base_width = winPtr->reqWidth
+ - (wmPtr->reqGridWidth * wmPtr->widthInc);
+ if (hintsPtr->base_width < 0) {
+ hintsPtr->base_width = 0;
+ }
+ hintsPtr->base_height = winPtr->reqHeight + wmPtr->menuHeight
+ - (wmPtr->reqGridHeight * wmPtr->heightInc);
+ if (hintsPtr->base_height < 0) {
+ hintsPtr->base_height = 0;
+ }
+ hintsPtr->min_width = hintsPtr->base_width
+ + (wmPtr->minWidth * wmPtr->widthInc);
+ hintsPtr->min_height = hintsPtr->base_height
+ + (wmPtr->minHeight * wmPtr->heightInc);
+ hintsPtr->max_width = hintsPtr->base_width
+ + (maxWidth * wmPtr->widthInc);
+ hintsPtr->max_height = hintsPtr->base_height
+ + (maxHeight * wmPtr->heightInc);
+ } else {
+ hintsPtr->min_width = wmPtr->minWidth;
+ hintsPtr->min_height = wmPtr->minHeight;
+ hintsPtr->max_width = maxWidth;
+ hintsPtr->max_height = maxHeight;
+ hintsPtr->base_width = 0;
+ hintsPtr->base_height = 0;
+ }
+ hintsPtr->width_inc = wmPtr->widthInc;
+ hintsPtr->height_inc = wmPtr->heightInc;
+ hintsPtr->min_aspect.x = wmPtr->minAspect.x;
+ hintsPtr->min_aspect.y = wmPtr->minAspect.y;
+ hintsPtr->max_aspect.x = wmPtr->maxAspect.x;
+ hintsPtr->max_aspect.y = wmPtr->maxAspect.y;
+ hintsPtr->win_gravity = wmPtr->gravity;
+ hintsPtr->flags = wmPtr->sizeHintsFlags | PMinSize | PMaxSize;
+
+ /*
+ * If the window isn't supposed to be resizable, then set the
+ * minimum and maximum dimensions to be the same.
+ */
+
+ if (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) {
+ if (wmPtr->width >= 0) {
+ hintsPtr->min_width = wmPtr->width;
+ } else {
+ hintsPtr->min_width = winPtr->reqWidth;
+ }
+ hintsPtr->max_width = hintsPtr->min_width;
+ }
+ if (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) {
+ if (wmPtr->height >= 0) {
+ hintsPtr->min_height = wmPtr->height;
+ } else {
+ hintsPtr->min_height = winPtr->reqHeight + wmPtr->menuHeight;
+ }
+ hintsPtr->max_height = hintsPtr->min_height;
+ }
+
+ XSetWMNormalHints(winPtr->display, wmPtr->wrapperPtr->window, hintsPtr);
+
+ XFree((char *) hintsPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForConfigureNotify --
+ *
+ * This procedure is invoked in order to synchronize with the
+ * window manager. It waits for a ConfigureNotify event to
+ * arrive, signalling that the window manager has seen an attempt
+ * on our part to move or resize a top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Delays the execution of the process until a ConfigureNotify event
+ * arrives with serial number at least as great as serial. This
+ * is useful for two reasons:
+ *
+ * 1. It's important to distinguish ConfigureNotify events that are
+ * coming in response to a request we've made from those generated
+ * spontaneously by the user. The reason for this is that if the
+ * user resizes the window we take that as an order to ignore
+ * geometry requests coming from inside the window hierarchy. If
+ * we accidentally interpret a response to our request as a
+ * user-initiated action, the window will stop responding to
+ * new geometry requests. To make this distinction, (a) this
+ * procedure sets a flag for TopLevelEventProc to indicate that
+ * we're waiting to sync with the wm, and (b) all changes to
+ * the size of a top-level window are followed by calls to this
+ * procedure.
+ * 2. Races and confusion can come about if there are multiple
+ * operations outstanding at a time (e.g. two different resizes
+ * of the top-level window: it's hard to tell which of the
+ * ConfigureNotify events coming back is for which request).
+ * While waiting, all events covered by StructureNotifyMask are
+ * processed and all others are deferred.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WaitForConfigureNotify(winPtr, serial)
+ TkWindow *winPtr; /* Top-level window for which we want
+ * to see a ConfigureNotify. */
+ unsigned long serial; /* Serial number of resize request. Want to
+ * be sure wm has seen this. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ XEvent event;
+ int diff, code;
+ int gotConfig = 0;
+
+ /*
+ * One more tricky detail about this procedure. In some cases the
+ * window manager will decide to ignore a configure request (e.g.
+ * because it thinks the window is already in the right place).
+ * To avoid hanging in this situation, only wait for a few seconds,
+ * then give up.
+ */
+
+ while (!gotConfig) {
+ wmPtr->flags |= WM_SYNC_PENDING;
+ code = WaitForEvent(winPtr->display, wmPtr, ConfigureNotify, &event);
+ wmPtr->flags &= ~WM_SYNC_PENDING;
+ if (code != TCL_OK) {
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("WaitForConfigureNotify giving up on %s\n",
+ winPtr->pathName);
+ }
+ break;
+ }
+ diff = event.xconfigure.serial - serial;
+ if (diff >= 0) {
+ gotConfig = 1;
+ }
+ }
+ wmPtr->flags &= ~WM_MOVE_PENDING;
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("WaitForConfigureNotify finished with %s, serial %ld\n",
+ winPtr->pathName, serial);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForEvent --
+ *
+ * This procedure is used by WaitForConfigureNotify and
+ * WaitForMapNotify to wait for an event of a certain type
+ * to arrive.
+ *
+ * Results:
+ * Under normal conditions, TCL_OK is returned and an event for
+ * display and window that matches "mask" is stored in *eventPtr.
+ * This event has already been processed by Tk before this procedure
+ * returns. If a long time goes by with no event of the right type
+ * arriving, or if an error occurs while waiting for the event to
+ * arrive, then TCL_ERROR is returned.
+ *
+ * Side effects:
+ * While waiting for the desired event to occur, Configurenotify
+ * events for window are processed, as are all ReparentNotify events,
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForEvent(display, wmInfoPtr, type, eventPtr)
+ Display *display; /* Display event is coming from. */
+ WmInfo *wmInfoPtr; /* Window for which event is desired. */
+ int type; /* Type of event that is wanted. */
+ XEvent *eventPtr; /* Place to store event. */
+{
+ WaitRestrictInfo info;
+ Tk_RestrictProc *oldRestrictProc;
+ ClientData oldRestrictData;
+ Tcl_Time timeout;
+
+ /*
+ * Set up an event filter to select just the events we want, and
+ * a timer handler, then wait for events until we get the event
+ * we want or a timeout happens.
+ */
+
+ info.display = display;
+ info.wmInfoPtr = wmInfoPtr;
+ info.type = type;
+ info.eventPtr = eventPtr;
+ info.foundEvent = 0;
+ oldRestrictProc = Tk_RestrictEvents(WaitRestrictProc, (ClientData) &info,
+ &oldRestrictData);
+
+ TclpGetTime(&timeout);
+ timeout.sec += 2;
+
+ while (!info.foundEvent) {
+ if (!TkUnixDoOneXEvent(&timeout)) {
+ break;
+ }
+ }
+ (void) Tk_RestrictEvents(oldRestrictProc, oldRestrictData,
+ &oldRestrictData);
+ if (info.foundEvent) {
+ return TCL_OK;
+ }
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitRestrictProc --
+ *
+ * This procedure is a Tk_RestrictProc that is used to filter
+ * events while WaitForEvent is active.
+ *
+ * Results:
+ * Returns TK_PROCESS_EVENT if the right event is found. Also
+ * returns TK_PROCESS_EVENT if any ReparentNotify event is found
+ * for window or if the event is a ConfigureNotify for window.
+ * Otherwise returns TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * An event may get stored in the area indicated by the caller
+ * of WaitForEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+WaitRestrictProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to WaitRestrictInfo structure. */
+ XEvent *eventPtr; /* Event that is about to be handled. */
+{
+ WaitRestrictInfo *infoPtr = (WaitRestrictInfo *) clientData;
+
+ if (eventPtr->type == ReparentNotify) {
+ return TK_PROCESS_EVENT;
+ }
+ if (((eventPtr->xany.window != infoPtr->wmInfoPtr->wrapperPtr->window)
+ && (eventPtr->xany.window != infoPtr->wmInfoPtr->reparent))
+ || (eventPtr->xany.display != infoPtr->display)) {
+ return TK_DEFER_EVENT;
+ }
+ if (eventPtr->type == infoPtr->type) {
+ *infoPtr->eventPtr = *eventPtr;
+ infoPtr->foundEvent = 1;
+ return TK_PROCESS_EVENT;
+ }
+ if (eventPtr->type == ConfigureNotify) {
+ return TK_PROCESS_EVENT;
+ }
+ return TK_DEFER_EVENT;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForMapNotify --
+ *
+ * This procedure is invoked in order to synchronize with the
+ * window manager. It waits for the window's mapped state to
+ * reach the value given by mapped.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Delays the execution of the process until winPtr becomes mapped
+ * or unmapped, depending on the "mapped" argument. This allows us
+ * to synchronize with the window manager, and allows us to
+ * identify changes in window size that come about when the window
+ * manager first starts managing the window (as opposed to those
+ * requested interactively by the user later). See the comments
+ * for WaitForConfigureNotify and WM_SYNC_PENDING. While waiting,
+ * all events covered by StructureNotifyMask are processed and all
+ * others are deferred.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WaitForMapNotify(winPtr, mapped)
+ TkWindow *winPtr; /* Top-level window for which we want
+ * to see a particular mapping state. */
+ int mapped; /* If non-zero, wait for window to become
+ * mapped, otherwise wait for it to become
+ * unmapped. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ XEvent event;
+ int code;
+
+ while (1) {
+ if (mapped) {
+ if (winPtr->flags & TK_MAPPED) {
+ break;
+ }
+ } else if (!(winPtr->flags & TK_MAPPED)) {
+ break;
+ }
+ wmPtr->flags |= WM_SYNC_PENDING;
+ code = WaitForEvent(winPtr->display, wmPtr,
+ mapped ? MapNotify : UnmapNotify, &event);
+ wmPtr->flags &= ~WM_SYNC_PENDING;
+ if (code != TCL_OK) {
+ /*
+ * There are some bizarre situations in which the window
+ * manager can't respond or chooses not to (e.g. if we've
+ * got a grab set it can't respond). If this happens then
+ * just quit.
+ */
+
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("WaitForMapNotify giving up on %s\n", winPtr->pathName);
+ }
+ break;
+ }
+ }
+ wmPtr->flags &= ~WM_MOVE_PENDING;
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("WaitForMapNotify finished with %s (winPtr %p, wmPtr %p)\n",
+ winPtr->pathName, winPtr, wmPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * UpdateHints --
+ *
+ * This procedure is called to update the window manager's
+ * hints information from the information in a WmInfo
+ * structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties get changed for winPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+UpdateHints(winPtr)
+ TkWindow *winPtr;
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return;
+ }
+ XSetWMHints(winPtr->display, wmPtr->wrapperPtr->window, &wmPtr->hints);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseGeometry --
+ *
+ * This procedure parses a geometry string and updates
+ * information used to control the geometry of a top-level
+ * window.
+ *
+ * Results:
+ * A standard Tcl return value, plus an error message in
+ * the interp's result if an error occurs.
+ *
+ * Side effects:
+ * The size and/or location of winPtr may change.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ParseGeometry(interp, string, winPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *string; /* String containing new geometry. Has the
+ * standard form "=wxh+x+y". */
+ TkWindow *winPtr; /* Pointer to top-level window whose
+ * geometry is to be changed. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y, width, height, flags;
+ char *end;
+ register char *p = string;
+
+ /*
+ * The leading "=" is optional.
+ */
+
+ if (*p == '=') {
+ p++;
+ }
+
+ /*
+ * Parse the width and height, if they are present. Don't
+ * actually update any of the fields of wmPtr until we've
+ * successfully parsed the entire geometry string.
+ */
+
+ width = wmPtr->width;
+ height = wmPtr->height;
+ x = wmPtr->x;
+ y = wmPtr->y;
+ flags = wmPtr->flags;
+ if (isdigit(UCHAR(*p))) {
+ width = strtoul(p, &end, 10);
+ p = end;
+ if (*p != 'x') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p))) {
+ goto error;
+ }
+ height = strtoul(p, &end, 10);
+ p = end;
+ }
+
+ /*
+ * Parse the X and Y coordinates, if they are present.
+ */
+
+ if (*p != '\0') {
+ flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y);
+ if (*p == '-') {
+ flags |= WM_NEGATIVE_X;
+ } else if (*p != '+') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p)) && (*p != '-')) {
+ goto error;
+ }
+ x = strtol(p, &end, 10);
+ p = end;
+ if (*p == '-') {
+ flags |= WM_NEGATIVE_Y;
+ } else if (*p != '+') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p)) && (*p != '-')) {
+ goto error;
+ }
+ y = strtol(p, &end, 10);
+ if (*end != '\0') {
+ goto error;
+ }
+
+ /*
+ * Assume that the geometry information came from the user,
+ * unless an explicit source has been specified. Otherwise
+ * most window managers assume that the size hints were
+ * program-specified and they ignore them.
+ */
+
+ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ wmPtr->sizeHintsFlags |= USPosition;
+ flags |= WM_UPDATE_SIZE_HINTS;
+ }
+ }
+
+ /*
+ * Everything was parsed OK. Update the fields of *wmPtr and
+ * arrange for the appropriate information to be percolated out
+ * to the window manager at the next idle moment.
+ */
+
+ wmPtr->width = width;
+ wmPtr->height = height;
+ wmPtr->x = x;
+ wmPtr->y = y;
+ flags |= WM_MOVE_PENDING;
+ wmPtr->flags = flags;
+
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_AppendResult(interp, "bad geometry specifier \"",
+ string, "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetRootCoords --
+ *
+ * Given a token for a window, this procedure traces through the
+ * window's lineage to find the (virtual) root-window coordinates
+ * corresponding to point (0,0) in the window.
+ *
+ * Results:
+ * The locations pointed to by xPtr and yPtr are filled in with
+ * the root coordinates of the (0,0) point in tkwin. If a virtual
+ * root window is in effect for the window, then the coordinates
+ * in the virtual root are returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_GetRootCoords(tkwin, xPtr, yPtr)
+ Tk_Window tkwin; /* Token for window. */
+ int *xPtr; /* Where to store x-displacement of (0,0). */
+ int *yPtr; /* Where to store y-displacement of (0,0). */
+{
+ int x, y;
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * Search back through this window's parents all the way to a
+ * top-level window, combining the offsets of each window within
+ * its parent.
+ */
+
+ x = y = 0;
+ while (1) {
+ x += winPtr->changes.x + winPtr->changes.border_width;
+ y += winPtr->changes.y + winPtr->changes.border_width;
+ if ((winPtr->wmInfoPtr != NULL)
+ && (winPtr->wmInfoPtr->menubar == (Tk_Window) winPtr)) {
+ /*
+ * This window is a special menubar; switch over to its
+ * associated toplevel, compensate for their differences in
+ * y coordinates, then continue with the toplevel (in case
+ * it's embedded).
+ */
+
+ y -= winPtr->wmInfoPtr->menuHeight;
+ winPtr = winPtr->wmInfoPtr->winPtr;
+ continue;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ TkWindow *otherPtr;
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ break;
+ }
+ otherPtr = TkpGetOtherWindow(winPtr);
+ if (otherPtr == NULL) {
+ /*
+ * The container window is not in the same application.
+ * Query the X server.
+ */
+
+ Window root, dummyChild;
+ int rootX, rootY;
+
+ root = winPtr->wmInfoPtr->vRoot;
+ if (root == None) {
+ root = RootWindowOfScreen(Tk_Screen((Tk_Window)winPtr));
+ }
+ XTranslateCoordinates(winPtr->display, winPtr->window,
+ root, 0, 0, &rootX, &rootY, &dummyChild);
+ x += rootX;
+ y += rootY;
+ break;
+ } else {
+ /*
+ * The container window is in the same application.
+ * Let's query its coordinates.
+ */
+
+ winPtr = otherPtr;
+ continue;
+ }
+ }
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ break;
+ }
+ }
+ *xPtr = x;
+ *yPtr = y;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CoordsToWindow --
+ *
+ * Given the (virtual) root coordinates of a point, this procedure
+ * returns the token for the top-most window covering that point,
+ * if there exists such a window in this application.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding
+ * to rootX and rootY, or else NULL to indicate that there is no such
+ * window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CoordsToWindow(rootX, rootY, tkwin)
+ int rootX, rootY; /* Coordinates of point in root window. If
+ * a virtual-root window manager is in use,
+ * these coordinates refer to the virtual
+ * root, not the real root. */
+ Tk_Window tkwin; /* Token for any window in application;
+ * used to identify the display. */
+{
+ Window window, parent, child;
+ int x, y, childX, childY, tmpx, tmpy, bd;
+ WmInfo *wmPtr;
+ TkWindow *winPtr, *childPtr, *nextPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ Tk_ErrorHandler handler = NULL;
+
+ /*
+ * Step 1: scan the list of toplevel windows to see if there is a
+ * virtual root for the screen we're interested in. If so, we have
+ * to translate the coordinates from virtual root to root
+ * coordinates.
+ */
+
+ parent = window = RootWindowOfScreen(Tk_Screen(tkwin));
+ x = rootX;
+ y = rootY;
+ for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
+ if (Tk_Screen(wmPtr->winPtr) != Tk_Screen(tkwin)) {
+ continue;
+ }
+ if (wmPtr->vRoot == None) {
+ continue;
+ }
+ UpdateVRootGeometry(wmPtr);
+ parent = wmPtr->vRoot;
+ break;
+ }
+
+ /*
+ * Step 2: work down through the window hierarchy starting at the
+ * root. For each window, find the child that contains the given
+ * point and then see if this child is either a wrapper for one of
+ * our toplevel windows or a window manager decoration window for
+ * one of our toplevels. This approach handles several tricky
+ * cases:
+ *
+ * 1. There may be a virtual root window between the root and one of
+ * our toplevels.
+ * 2. If a toplevel is embedded, we may have to search through the
+ * windows of the container application(s) before getting to
+ * the toplevel.
+ */
+
+ handler = Tk_CreateErrorHandler(Tk_Display(tkwin), -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ while (1) {
+ if (XTranslateCoordinates(Tk_Display(tkwin), parent, window,
+ x, y, &childX, &childY, &child) == False) {
+ /*
+ * We can end up here when the window is in the middle of
+ * being deleted
+ */
+ Tk_DeleteErrorHandler(handler);
+ return NULL;
+ }
+ if (child == None) {
+ Tk_DeleteErrorHandler(handler);
+ return NULL;
+ }
+ for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL;
+ wmPtr = wmPtr->nextPtr) {
+ if (wmPtr->reparent == child) {
+ goto gotToplevel;
+ }
+ if (wmPtr->wrapperPtr != NULL) {
+ if (child == wmPtr->wrapperPtr->window) {
+ goto gotToplevel;
+ }
+ } else if (child == wmPtr->winPtr->window) {
+ goto gotToplevel;
+ }
+ }
+ x = childX;
+ y = childY;
+ parent = window;
+ window = child;
+ }
+
+ gotToplevel:
+ if (handler) {
+ /*
+ * Check value of handler, because we can reach this label
+ * from above or below
+ */
+ Tk_DeleteErrorHandler(handler);
+ handler = NULL;
+ }
+ winPtr = wmPtr->winPtr;
+ if (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr) {
+ return NULL;
+ }
+
+ /*
+ * Step 3: at this point winPtr and wmPtr refer to the toplevel that
+ * contains the given coordinates, and childX and childY give the
+ * translated coordinates in the *parent* of the toplevel. Now
+ * decide whether the coordinates are in the menubar or the actual
+ * toplevel, and translate the coordinates into the coordinate
+ * system of that window.
+ */
+
+ x = childX - winPtr->changes.x;
+ y = childY - winPtr->changes.y;
+ if ((x < 0) || (x >= winPtr->changes.width)
+ || (y >= winPtr->changes.height)) {
+ return NULL;
+ }
+ if (y < 0) {
+ winPtr = (TkWindow *) wmPtr->menubar;
+ if (winPtr == NULL) {
+ return NULL;
+ }
+ y += wmPtr->menuHeight;
+ if (y < 0) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Step 4: work down through the hierarchy underneath the current
+ * window. At each level, scan through all the children to find the
+ * highest one in the stacking order that contains the point. Then
+ * repeat the whole process on that child.
+ */
+
+ while (1) {
+ nextPtr = NULL;
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (!Tk_IsMapped(childPtr) || (childPtr->flags & TK_TOP_HIERARCHY)) {
+ continue;
+ }
+ if (childPtr->flags & TK_REPARENTED) {
+ continue;
+ }
+ tmpx = x - childPtr->changes.x;
+ tmpy = y - childPtr->changes.y;
+ bd = childPtr->changes.border_width;
+ if ((tmpx >= -bd) && (tmpy >= -bd)
+ && (tmpx < (childPtr->changes.width + bd))
+ && (tmpy < (childPtr->changes.height + bd))) {
+ nextPtr = childPtr;
+ }
+ }
+ if (nextPtr == NULL) {
+ break;
+ }
+ winPtr = nextPtr;
+ x -= winPtr->changes.x;
+ y -= winPtr->changes.y;
+ if ((winPtr->flags & TK_CONTAINER)
+ && (winPtr->flags & TK_BOTH_HALVES)) {
+ /*
+ * The window containing the point is a container, and the
+ * embedded application is in this same process. Switch
+ * over to the toplevel for the embedded application and
+ * start processing that toplevel from scratch.
+ */
+
+ winPtr = TkpGetOtherWindow(winPtr);
+ wmPtr = winPtr->wmInfoPtr;
+ childX = x;
+ childY = y;
+ goto gotToplevel;
+ }
+ }
+ return (Tk_Window) winPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateVRootGeometry --
+ *
+ * This procedure is called to update all the virtual root
+ * geometry information in wmPtr.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The vRootX, vRootY, vRootWidth, and vRootHeight fields in
+ * wmPtr are filled with the most up-to-date information.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateVRootGeometry(wmPtr)
+ WmInfo *wmPtr; /* Window manager information to be
+ * updated. The wmPtr->vRoot field must
+ * be valid. */
+{
+ TkWindow *winPtr = wmPtr->winPtr;
+ int bd;
+ unsigned int dummy;
+ Window dummy2;
+ Status status;
+ Tk_ErrorHandler handler;
+
+ /*
+ * If this isn't a virtual-root window manager, just return information
+ * about the screen.
+ */
+
+ wmPtr->flags &= ~WM_VROOT_OFFSET_STALE;
+ if (wmPtr->vRoot == None) {
+ noVRoot:
+ wmPtr->vRootX = wmPtr->vRootY = 0;
+ wmPtr->vRootWidth = DisplayWidth(winPtr->display, winPtr->screenNum);
+ wmPtr->vRootHeight = DisplayHeight(winPtr->display, winPtr->screenNum);
+ return;
+ }
+
+ /*
+ * Refresh the virtual root information if it's out of date.
+ */
+
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ status = XGetGeometry(winPtr->display, wmPtr->vRoot,
+ &dummy2, &wmPtr->vRootX, &wmPtr->vRootY,
+ (unsigned int *) &wmPtr->vRootWidth,
+ (unsigned int *) &wmPtr->vRootHeight, (unsigned int *) &bd,
+ &dummy);
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("UpdateVRootGeometry: x = %d, y = %d, width = %d, ",
+ wmPtr->vRootX, wmPtr->vRootY, wmPtr->vRootWidth);
+ printf("height = %d, status = %d\n", wmPtr->vRootHeight, status);
+ }
+ Tk_DeleteErrorHandler(handler);
+ if (status == 0) {
+ /*
+ * The virtual root is gone! Pretend that it never existed.
+ */
+
+ wmPtr->vRoot = None;
+ goto noVRoot;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetVRootGeometry --
+ *
+ * This procedure returns information about the virtual root
+ * window corresponding to a particular Tk window.
+ *
+ * Results:
+ * The values at xPtr, yPtr, widthPtr, and heightPtr are set
+ * with the offset and dimensions of the root window corresponding
+ * to tkwin. If tkwin is being managed by a virtual root window
+ * manager these values correspond to the virtual root window being
+ * used for tkwin; otherwise the offsets will be 0 and the
+ * dimensions will be those of the screen.
+ *
+ * Side effects:
+ * Vroot window information is refreshed if it is out of date.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_GetVRootGeometry(tkwin, xPtr, yPtr, widthPtr, heightPtr)
+ Tk_Window tkwin; /* Window whose virtual root is to be
+ * queried. */
+ int *xPtr, *yPtr; /* Store x and y offsets of virtual root
+ * here. */
+ int *widthPtr, *heightPtr; /* Store dimensions of virtual root here. */
+{
+ WmInfo *wmPtr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * Find the top-level window for tkwin, and locate the window manager
+ * information for that window.
+ */
+
+ while (!(winPtr->flags & TK_TOP_HIERARCHY) && (winPtr->parentPtr != NULL)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ /* Punt. */
+ *xPtr = 0;
+ *yPtr = 0;
+ *widthPtr = 0;
+ *heightPtr = 0;
+ }
+
+
+ /*
+ * Make sure that the geometry information is up-to-date, then copy
+ * it out to the caller.
+ */
+
+ if (wmPtr->flags & WM_VROOT_OFFSET_STALE) {
+ UpdateVRootGeometry(wmPtr);
+ }
+ *xPtr = wmPtr->vRootX;
+ *yPtr = wmPtr->vRootY;
+ *widthPtr = wmPtr->vRootWidth;
+ *heightPtr = wmPtr->vRootHeight;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MoveToplevelWindow --
+ *
+ * This procedure is called instead of Tk_MoveWindow to adjust
+ * the x-y location of a top-level window. It delays the actual
+ * move to a later time and keeps window-manager information
+ * up-to-date with the move
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is eventually moved so that its upper-left corner
+ * (actually, the upper-left corner of the window's decorative
+ * frame, if there is one) is at (x,y).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MoveToplevelWindow(tkwin, x, y)
+ Tk_Window tkwin; /* Window to move. */
+ int x, y; /* New location for window (within
+ * parent). */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ panic("Tk_MoveToplevelWindow called with non-toplevel window");
+ }
+ wmPtr->x = x;
+ wmPtr->y = y;
+ wmPtr->flags |= WM_MOVE_PENDING;
+ wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
+ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ wmPtr->sizeHintsFlags |= USPosition;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ }
+
+ /*
+ * If the window has already been mapped, must bring its geometry
+ * up-to-date immediately, otherwise an event might arrive from the
+ * server that would overwrite wmPtr->x and wmPtr->y and lose the
+ * new position.
+ */
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateWmProtocols --
+ *
+ * This procedure transfers the most up-to-date information about
+ * window manager protocols from the WmInfo structure to the actual
+ * property on the top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The WM_PROTOCOLS property gets changed for wmPtr's window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateWmProtocols(wmPtr)
+ register WmInfo *wmPtr; /* Information about top-level window. */
+{
+ register ProtocolHandler *protPtr;
+ Atom deleteWindowAtom;
+ int count;
+ Atom *arrayPtr, *atomPtr;
+
+ /*
+ * There are only two tricky parts here. First, there could be any
+ * number of atoms for the window, so count them and malloc an array
+ * to hold all of their atoms. Second, we *always* want to respond
+ * to the WM_DELETE_WINDOW protocol, even if no-one's officially asked.
+ */
+
+ for (protPtr = wmPtr->protPtr, count = 1; protPtr != NULL;
+ protPtr = protPtr->nextPtr, count++) {
+ /* Empty loop body; we're just counting the handlers. */
+ }
+ arrayPtr = (Atom *) ckalloc((unsigned) (count * sizeof(Atom)));
+ deleteWindowAtom = Tk_InternAtom((Tk_Window) wmPtr->winPtr,
+ "WM_DELETE_WINDOW");
+ arrayPtr[0] = deleteWindowAtom;
+ for (protPtr = wmPtr->protPtr, atomPtr = &arrayPtr[1];
+ protPtr != NULL; protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol != deleteWindowAtom) {
+ *atomPtr = protPtr->protocol;
+ atomPtr++;
+ }
+ }
+ XChangeProperty(wmPtr->winPtr->display, wmPtr->wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) wmPtr->winPtr, "WM_PROTOCOLS"),
+ XA_ATOM, 32, PropModeReplace, (unsigned char *) arrayPtr,
+ atomPtr-arrayPtr);
+ ckfree((char *) arrayPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmProtocolEventProc --
+ *
+ * This procedure is called by the Tk_HandleEvent whenever a
+ * ClientMessage event arrives whose type is "WM_PROTOCOLS".
+ * This procedure handles the message from the window manager
+ * in an appropriate fashion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what sort of handler, if any, was set up for the
+ * protocol.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmProtocolEventProc(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window to which the event was sent. */
+ XEvent *eventPtr; /* X event. */
+{
+ WmInfo *wmPtr;
+ register ProtocolHandler *protPtr;
+ Atom protocol;
+ int result;
+ CONST char *protocolName;
+ Tcl_Interp *interp;
+
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+ protocol = (Atom) eventPtr->xclient.data.l[0];
+
+ /*
+ * Note: it's very important to retrieve the protocol name now,
+ * before invoking the command, even though the name won't be used
+ * until after the command returns. This is because the command
+ * could delete winPtr, making it impossible for us to use it
+ * later in the call to Tk_GetAtomName.
+ */
+
+ protocolName = Tk_GetAtomName((Tk_Window) winPtr, protocol);
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protocol == protPtr->protocol) {
+ Tcl_Preserve((ClientData) protPtr);
+ interp = protPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_GlobalEval(interp, protPtr->command);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (command for \"");
+ Tcl_AddErrorInfo(interp, protocolName);
+ Tcl_AddErrorInfo(interp,
+ "\" window manager protocol)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+ Tcl_Release((ClientData) protPtr);
+ return;
+ }
+ }
+
+ /*
+ * No handler was present for this protocol. If this is a
+ * WM_DELETE_WINDOW message then just destroy the window.
+ */
+
+ if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
+ Tk_DestroyWindow((Tk_Window) wmPtr->winPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevelWrapperMap --
+ *
+ * This procedure will create a table that maps the reparent wrapper
+ * X id for a toplevel to the TkWindow structure that is wraps.
+ * Tk keeps track of a mapping from the window X id to the TkWindow
+ * structure but that does us no good here since we only get the X
+ * id of the wrapper window. Only those toplevel windows that are
+ * mapped have a position in the stacking order.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds entries to the passed hashtable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TkWmStackorderToplevelWrapperMap(winPtr, table)
+ TkWindow *winPtr; /* TkWindow to recurse on */
+ Tcl_HashTable *table; /* Maps X id to TkWindow */
+{
+ TkWindow *childPtr;
+ Tcl_HashEntry *hPtr;
+ Window wrapper;
+ int newEntry;
+
+ if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr) &&
+ !Tk_IsEmbedded(winPtr)) {
+ wrapper = (winPtr->wmInfoPtr->reparent != None)
+ ? winPtr->wmInfoPtr->reparent
+ : winPtr->wmInfoPtr->wrapperPtr->window;
+
+ hPtr = Tcl_CreateHashEntry(table,
+ (char *) wrapper, &newEntry);
+ Tcl_SetHashValue(hPtr, winPtr);
+ }
+
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ TkWmStackorderToplevelWrapperMap(childPtr, table);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevel --
+ *
+ * This procedure returns the stack order of toplevel windows.
+ *
+ * Results:
+ * An array of pointers to tk window objects in stacking order
+ * or else NULL if there was an error.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow **
+TkWmStackorderToplevel(parentPtr)
+ TkWindow *parentPtr; /* Parent toplevel window. */
+{
+ Window dummy1, dummy2, vRoot;
+ Window *children;
+ unsigned int numChildren, i;
+ TkWindow *childWinPtr, **windows, **window_ptr;
+ Tcl_HashTable table;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ /*
+ * Map X Window ids to a TkWindow of the wrapped toplevel.
+ */
+
+ Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS);
+ TkWmStackorderToplevelWrapperMap(parentPtr, &table);
+
+ window_ptr = windows = (TkWindow **) ckalloc((table.numEntries+1)
+ * sizeof(TkWindow *));
+
+ /*
+ * Special cases: If zero or one toplevels were mapped
+ * there is no need to call XQueryTree.
+ */
+
+ switch (table.numEntries) {
+ case 0:
+ windows[0] = NULL;
+ goto done;
+ case 1:
+ hPtr = Tcl_FirstHashEntry(&table, &search);
+ windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr);
+ windows[1] = NULL;
+ goto done;
+ }
+
+ vRoot = parentPtr->wmInfoPtr->vRoot;
+ if (vRoot == None) {
+ vRoot = RootWindowOfScreen(Tk_Screen((Tk_Window) parentPtr));
+ }
+
+ if (XQueryTree(parentPtr->display, vRoot, &dummy1, &dummy2,
+ &children, &numChildren) == 0) {
+ ckfree((char *) windows);
+ windows = NULL;
+ } else {
+ for (i = 0; i < numChildren; i++) {
+ hPtr = Tcl_FindHashEntry(&table, (char *) children[i]);
+ if (hPtr != NULL) {
+ childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr);
+ *window_ptr++ = childWinPtr;
+ }
+ }
+ if ((window_ptr - windows) != table.numEntries)
+ panic("num matched toplevel windows does not equal num children");
+ *window_ptr = NULL;
+ if (numChildren) {
+ XFree((char *) children);
+ }
+ }
+
+ done:
+ Tcl_DeleteHashTable(&table);
+ return windows;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRestackToplevel --
+ *
+ * This procedure restacks a top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr gets restacked as specified by aboveBelow and otherPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmRestackToplevel(winPtr, aboveBelow, otherPtr)
+ TkWindow *winPtr; /* Window to restack. */
+ int aboveBelow; /* Gives relative position for restacking;
+ * must be Above or Below. */
+ TkWindow *otherPtr; /* Window relative to which to restack;
+ * if NULL, then winPtr gets restacked
+ * above or below *all* siblings. */
+{
+ XWindowChanges changes;
+ unsigned int mask;
+ TkWindow *wrapperPtr;
+
+ memset(&changes, 0, sizeof(XWindowChanges));
+ changes.stack_mode = aboveBelow;
+ mask = CWStackMode;
+
+ /*
+ * Make sure that winPtr and its wrapper window have been created.
+ */
+ if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ TkWmMapWindow(winPtr);
+ }
+ wrapperPtr = winPtr->wmInfoPtr->wrapperPtr;
+
+ if (otherPtr != NULL) {
+ /*
+ * The window is to be restacked with respect to another toplevel.
+ * Make sure it has been created as well.
+ */
+ if (otherPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ TkWmMapWindow(otherPtr);
+ }
+ changes.sibling = otherPtr->wmInfoPtr->wrapperPtr->window;
+ mask |= CWSibling;
+ }
+
+ /*
+ * Reconfigure the window. Note that we use XReconfigureWMWindow
+ * instead of XConfigureWindow, in order to handle the case
+ * where the window is to be restacked with respect to another toplevel.
+ * See [ICCCM] 4.1.5 "Configuring the Window" and XReconfigureWMWindow(3)
+ * for details.
+ */
+
+ XReconfigureWMWindow(winPtr->display, wrapperPtr->window,
+ Tk_ScreenNumber((Tk_Window) winPtr), mask, &changes);
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmAddToColormapWindows --
+ *
+ * This procedure is called to add a given window to the
+ * WM_COLORMAP_WINDOWS property for its top-level, if it
+ * isn't already there. It is invoked by the Tk code that
+ * creates a new colormap, in order to make sure that colormap
+ * information is propagated to the window manager by default.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr's window gets added to the WM_COLORMAP_WINDOWS
+ * property of its nearest top-level ancestor, unless the
+ * colormaps have been set explicitly with the
+ * "wm colormapwindows" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmAddToColormapWindows(winPtr)
+ TkWindow *winPtr; /* Window with a non-default colormap.
+ * Should not be a top-level window. */
+{
+ TkWindow *wrapperPtr;
+ TkWindow *topPtr;
+ Window *oldPtr, *newPtr;
+ int count, i;
+
+ if (winPtr->window == None) {
+ return;
+ }
+
+ for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) {
+ if (topPtr == NULL) {
+ /*
+ * Window is being deleted. Skip the whole operation.
+ */
+
+ return;
+ }
+ if (topPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+ if (topPtr->wmInfoPtr == NULL) {
+ return;
+ }
+
+ if (topPtr->wmInfoPtr->flags & WM_COLORMAPS_EXPLICIT) {
+ return;
+ }
+ if (topPtr->wmInfoPtr->wrapperPtr == NULL) {
+ CreateWrapper(topPtr->wmInfoPtr);
+ }
+ wrapperPtr = topPtr->wmInfoPtr->wrapperPtr;
+
+ /*
+ * Fetch the old value of the property.
+ */
+
+ if (XGetWMColormapWindows(topPtr->display, wrapperPtr->window,
+ &oldPtr, &count) == 0) {
+ oldPtr = NULL;
+ count = 0;
+ }
+
+ /*
+ * Make sure that the window isn't already in the list.
+ */
+
+ for (i = 0; i < count; i++) {
+ if (oldPtr[i] == winPtr->window) {
+ return;
+ }
+ }
+
+ /*
+ * Make a new bigger array and use it to reset the property.
+ * Automatically add the toplevel itself as the last element
+ * of the list.
+ */
+
+ newPtr = (Window *) ckalloc((unsigned) ((count+2)*sizeof(Window)));
+ for (i = 0; i < count; i++) {
+ newPtr[i] = oldPtr[i];
+ }
+ if (count == 0) {
+ count++;
+ }
+ newPtr[count-1] = winPtr->window;
+ newPtr[count] = topPtr->window;
+ XSetWMColormapWindows(topPtr->display, wrapperPtr->window, newPtr,
+ count+1);
+ ckfree((char *) newPtr);
+ if (oldPtr != NULL) {
+ XFree((char *) oldPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRemoveFromColormapWindows --
+ *
+ * This procedure is called to remove a given window from the
+ * WM_COLORMAP_WINDOWS property for its top-level. It is invoked
+ * when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr's window gets removed from the WM_COLORMAP_WINDOWS
+ * property of its nearest top-level ancestor, unless the
+ * top-level itself is being deleted too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmRemoveFromColormapWindows(winPtr)
+ TkWindow *winPtr; /* Window that may be present in
+ * WM_COLORMAP_WINDOWS property for its
+ * top-level. Should not be a top-level
+ * window. */
+{
+ TkWindow *wrapperPtr;
+ TkWindow *topPtr;
+ Window *oldPtr;
+ int count, i, j;
+
+ if (winPtr->window == None) {
+ return;
+ }
+
+ for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) {
+ if (topPtr == NULL) {
+ /*
+ * Ancestors have been deleted, so skip the whole operation.
+ * Seems like this can't ever happen?
+ */
+
+ return;
+ }
+ if (topPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+ if (topPtr->flags & TK_ALREADY_DEAD) {
+ /*
+ * Top-level is being deleted, so there's no need to cleanup
+ * the WM_COLORMAP_WINDOWS property.
+ */
+
+ return;
+ }
+ if (topPtr->wmInfoPtr == NULL) {
+ return;
+ }
+
+ if (topPtr->wmInfoPtr->wrapperPtr == NULL) {
+ CreateWrapper(topPtr->wmInfoPtr);
+ }
+ wrapperPtr = topPtr->wmInfoPtr->wrapperPtr;
+ if (wrapperPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Fetch the old value of the property.
+ */
+
+ if (XGetWMColormapWindows(topPtr->display, wrapperPtr->window,
+ &oldPtr, &count) == 0) {
+ return;
+ }
+
+ /*
+ * Find the window and slide the following ones down to cover
+ * it up.
+ */
+
+ for (i = 0; i < count; i++) {
+ if (oldPtr[i] == winPtr->window) {
+ for (j = i ; j < count-1; j++) {
+ oldPtr[j] = oldPtr[j+1];
+ }
+ XSetWMColormapWindows(topPtr->display, wrapperPtr->window,
+ oldPtr, count-1);
+ break;
+ }
+ }
+ XFree((char *) oldPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetPointerCoords --
+ *
+ * Fetch the position of the mouse pointer.
+ *
+ * Results:
+ * *xPtr and *yPtr are filled in with the (virtual) root coordinates
+ * of the mouse pointer for tkwin's display. If the pointer isn't
+ * on tkwin's screen, then -1 values are returned for both
+ * coordinates. The argument tkwin must be a toplevel window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGetPointerCoords(tkwin, xPtr, yPtr)
+ Tk_Window tkwin; /* Toplevel window that identifies screen
+ * on which lookup is to be done. */
+ int *xPtr, *yPtr; /* Store pointer coordinates here. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ WmInfo *wmPtr;
+ Window w, root, child;
+ int rootX, rootY;
+ unsigned int mask;
+
+ wmPtr = winPtr->wmInfoPtr;
+
+ w = wmPtr->vRoot;
+ if (w == None) {
+ w = RootWindow(winPtr->display, winPtr->screenNum);
+ }
+ if (XQueryPointer(winPtr->display, w, &root, &child, &rootX, &rootY,
+ xPtr, yPtr, &mask) != True) {
+ *xPtr = -1;
+ *yPtr = -1;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMaxSize --
+ *
+ * This procedure computes the current maxWidth and maxHeight
+ * values for a window, taking into account the possibility
+ * that they may be defaulted.
+ *
+ * Results:
+ * The values at *maxWidthPtr and *maxHeightPtr are filled
+ * in with the maximum allowable dimensions of wmPtr's window,
+ * in grid units. If no maximum has been specified for the
+ * window, then this procedure computes the largest sizes that
+ * will fit on the screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMaxSize(wmPtr, maxWidthPtr, maxHeightPtr)
+ WmInfo *wmPtr; /* Window manager information for the
+ * window. */
+ int *maxWidthPtr; /* Where to store the current maximum
+ * width of the window. */
+ int *maxHeightPtr; /* Where to store the current maximum
+ * height of the window. */
+{
+ int tmp;
+
+ if (wmPtr->maxWidth > 0) {
+ *maxWidthPtr = wmPtr->maxWidth;
+ } else {
+ /*
+ * Must compute a default width. Fill up the display, leaving a
+ * bit of extra space for the window manager's borders.
+ */
+
+ tmp = DisplayWidth(wmPtr->winPtr->display, wmPtr->winPtr->screenNum)
+ - 15;
+ if (wmPtr->gridWin != NULL) {
+ /*
+ * Gridding is turned on; convert from pixels to grid units.
+ */
+
+ tmp = wmPtr->reqGridWidth
+ + (tmp - wmPtr->winPtr->reqWidth)/wmPtr->widthInc;
+ }
+ *maxWidthPtr = tmp;
+ }
+ if (wmPtr->maxHeight > 0) {
+ *maxHeightPtr = wmPtr->maxHeight;
+ } else {
+ tmp = DisplayHeight(wmPtr->winPtr->display, wmPtr->winPtr->screenNum)
+ - 30;
+ if (wmPtr->gridWin != NULL) {
+ tmp = wmPtr->reqGridHeight
+ + (tmp - wmPtr->winPtr->reqHeight)/wmPtr->heightInc;
+ }
+ *maxHeightPtr = tmp;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeMenuWindow --
+ *
+ * Configure the window to be either a pull-down (or pop-up)
+ * menu, or as a toplevel (torn-off) menu or palette.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the style bit used to create a new Mac toplevel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMakeMenuWindow(tkwin, transient)
+ Tk_Window tkwin; /* New window. */
+ int transient; /* 1 means menu is only posted briefly as
+ * a popup or pulldown or cascade. 0 means
+ * menu is always visible, e.g. as a torn-off
+ * menu. Determines whether save_under and
+ * override_redirect should be set. */
+{
+ WmInfo *wmPtr;
+ XSetWindowAttributes atts;
+ TkWindow *wrapperPtr;
+
+ if (!Tk_HasWrapper(tkwin)) {
+ return;
+ }
+ wmPtr = ((TkWindow *) tkwin)->wmInfoPtr;
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+ wrapperPtr = wmPtr->wrapperPtr;
+ if (transient) {
+ atts.override_redirect = True;
+ atts.save_under = True;
+ } else {
+ atts.override_redirect = False;
+ atts.save_under = False;
+ }
+
+ /*
+ * The override-redirect and save-under bits must be set on the
+ * wrapper window in order to have the desired effect. However,
+ * also set the override-redirect bit on the window itself, so
+ * that the "wm overrideredirect" command will see it.
+ */
+
+ if ((atts.override_redirect != Tk_Attributes(wrapperPtr)->override_redirect)
+ || (atts.save_under != Tk_Attributes(wrapperPtr)->save_under)) {
+ Tk_ChangeWindowAttributes((Tk_Window) wrapperPtr,
+ CWOverrideRedirect|CWSaveUnder, &atts);
+ }
+ if (atts.override_redirect != Tk_Attributes(tkwin)->override_redirect) {
+ Tk_ChangeWindowAttributes(tkwin, CWOverrideRedirect, &atts);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateWrapper --
+ *
+ * This procedure is invoked to create the wrapper window for a
+ * toplevel window. It is called just before a toplevel is mapped
+ * for the first time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The wrapper is created and the toplevel is reparented inside it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CreateWrapper(wmPtr)
+ WmInfo *wmPtr; /* Window manager information for the
+ * window. */
+{
+ TkWindow *winPtr, *wrapperPtr;
+ Window parent;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ winPtr = wmPtr->winPtr;
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ }
+
+ /*
+ * The code below is copied from CreateTopLevelWindow,
+ * Tk_MakeWindowExist, and TkpMakeWindow; The idea is to create an
+ * "official" Tk window (so that we can get events on it), but to
+ * hide the window outside the official Tk hierarchy so that it
+ * isn't visible to the application. See the comments for the other
+ * procedures if you have questions about this code.
+ */
+
+ wmPtr->wrapperPtr = wrapperPtr = TkAllocWindow(winPtr->dispPtr,
+ Tk_ScreenNumber((Tk_Window) winPtr), winPtr);
+ wrapperPtr->dirtyAtts |= CWBorderPixel;
+
+ /*
+ * Tk doesn't normally select for StructureNotifyMask events because
+ * the events are synthesized internally. However, for wrapper
+ * windows we need to know when the window manager modifies the
+ * window configuration. We also need to select on focus change
+ * events; these are the only windows for which we care about focus
+ * changes.
+ */
+
+ wrapperPtr->flags |= TK_WRAPPER;
+ wrapperPtr->atts.event_mask |= StructureNotifyMask|FocusChangeMask;
+ wrapperPtr->atts.override_redirect = winPtr->atts.override_redirect;
+ if (winPtr->flags & TK_EMBEDDED) {
+ parent = TkUnixContainerId(winPtr);
+ } else {
+ parent = XRootWindow(wrapperPtr->display, wrapperPtr->screenNum);
+ }
+ wrapperPtr->window = XCreateWindow(wrapperPtr->display,
+ parent, wrapperPtr->changes.x, wrapperPtr->changes.y,
+ (unsigned) wrapperPtr->changes.width,
+ (unsigned) wrapperPtr->changes.height,
+ (unsigned) wrapperPtr->changes.border_width, wrapperPtr->depth,
+ InputOutput, wrapperPtr->visual,
+ wrapperPtr->dirtyAtts|CWOverrideRedirect, &wrapperPtr->atts);
+ hPtr = Tcl_CreateHashEntry(&wrapperPtr->dispPtr->winTable,
+ (char *) wrapperPtr->window, &new);
+ Tcl_SetHashValue(hPtr, wrapperPtr);
+ wrapperPtr->mainPtr = winPtr->mainPtr;
+ wrapperPtr->mainPtr->refCount++;
+ wrapperPtr->dirtyAtts = 0;
+ wrapperPtr->dirtyChanges = 0;
+ wrapperPtr->wmInfoPtr = wmPtr;
+
+ /*
+ * Reparent the toplevel window inside the wrapper.
+ */
+
+ XReparentWindow(wrapperPtr->display, winPtr->window, wrapperPtr->window,
+ 0, 0);
+
+ /*
+ * Tk must monitor structure events for wrapper windows in order
+ * to detect changes made by window managers such as resizing,
+ * mapping, unmapping, etc..
+ */
+
+ Tk_CreateEventHandler((Tk_Window) wmPtr->wrapperPtr, StructureNotifyMask,
+ WrapperEventProc, (ClientData) wmPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmFocusToplevel --
+ *
+ * This is a utility procedure invoked by focus-management code.
+ * The focus code responds to externally generated focus-related
+ * events on wrapper windows but ignores those events for any other
+ * windows. This procedure determines whether a given window is a
+ * wrapper window and, if so, returns the toplevel window
+ * corresponding to the wrapper.
+ *
+ * Results:
+ * If winPtr is a wrapper window, returns a pointer to the
+ * corresponding toplevel window; otherwise returns NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkWmFocusToplevel(winPtr)
+ TkWindow *winPtr; /* Window that received a focus-related
+ * event. */
+{
+ if (!(winPtr->flags & TK_WRAPPER)) {
+ return NULL;
+ }
+ return winPtr->wmInfoPtr->winPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnixSetMenubar --
+ *
+ * This procedure is invoked by menu management code to specify the
+ * window to use as a menubar for a given toplevel window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window given by menubar will be mapped and positioned inside
+ * the wrapper for tkwin and above tkwin. Menubar will
+ * automatically be resized to maintain the height specified by
+ * TkUnixSetMenuHeight the same width as tkwin. Any previous
+ * menubar specified for tkwin will be unmapped and ignored from
+ * now on.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUnixSetMenubar(tkwin, menubar)
+ Tk_Window tkwin; /* Token for toplevel window. */
+ Tk_Window menubar; /* Token for window that is to serve as
+ * menubar for tkwin. Must not be a
+ * toplevel window. If NULL, any
+ * existing menubar is canceled and the
+ * menu height is reset to 0. */
+{
+ WmInfo *wmPtr = ((TkWindow *) tkwin)->wmInfoPtr;
+ Tk_Window parent;
+ TkWindow *menubarPtr = (TkWindow *) menubar;
+
+ if (wmPtr->menubar != NULL) {
+ /*
+ * There's already a menubar for this toplevel. If it isn't the
+ * same as the new menubar, unmap it so that it is out of the
+ * way, and reparent it back to its original parent.
+ */
+
+ if (wmPtr->menubar == menubar) {
+ return;
+ }
+ ((TkWindow *) wmPtr->menubar)->wmInfoPtr = NULL;
+ ((TkWindow *) wmPtr->menubar)->flags &= ~TK_REPARENTED;
+ Tk_UnmapWindow(wmPtr->menubar);
+ parent = Tk_Parent(wmPtr->menubar);
+ if (parent != NULL) {
+ Tk_MakeWindowExist(parent);
+ XReparentWindow(Tk_Display(wmPtr->menubar),
+ Tk_WindowId(wmPtr->menubar), Tk_WindowId(parent), 0, 0);
+ }
+ Tk_DeleteEventHandler(wmPtr->menubar, StructureNotifyMask,
+ MenubarDestroyProc, (ClientData) wmPtr->menubar);
+ Tk_ManageGeometry(wmPtr->menubar, NULL, (ClientData) NULL);
+ }
+
+ wmPtr->menubar = menubar;
+ if (menubar == NULL) {
+ wmPtr->menuHeight = 0;
+ } else {
+ if ((menubarPtr->flags & TK_TOP_LEVEL)
+ || (Tk_Screen(menubar) != Tk_Screen(tkwin))) {
+ panic("TkUnixSetMenubar got bad menubar");
+ }
+ wmPtr->menuHeight = Tk_ReqHeight(menubar);
+ if (wmPtr->menuHeight == 0) {
+ wmPtr->menuHeight = 1;
+ }
+ Tk_MakeWindowExist(tkwin);
+ Tk_MakeWindowExist(menubar);
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+ XReparentWindow(Tk_Display(menubar), Tk_WindowId(menubar),
+ wmPtr->wrapperPtr->window, 0, 0);
+ menubarPtr->wmInfoPtr = wmPtr;
+ Tk_MoveResizeWindow(menubar, 0, 0, Tk_Width(tkwin), wmPtr->menuHeight);
+ Tk_MapWindow(menubar);
+ Tk_CreateEventHandler(menubar, StructureNotifyMask, MenubarDestroyProc,
+ (ClientData) menubar);
+ Tk_ManageGeometry(menubar, &menubarMgrType, (ClientData) wmPtr);
+ menubarPtr->flags |= TK_REPARENTED;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) tkwin);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenubarDestroyProc --
+ *
+ * This procedure is invoked by the event dispatcher whenever a
+ * menubar window is destroyed (it's also invoked for a few other
+ * kinds of events, but we ignore those).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The association between the window and its toplevel is broken,
+ * so that the window is no longer considered to be a menubar.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenubarDestroyProc(clientData, eventPtr)
+ ClientData clientData; /* TkWindow pointer for menubar. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ WmInfo *wmPtr;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+ wmPtr = ((TkWindow *) clientData)->wmInfoPtr;
+ wmPtr->menubar = NULL;
+ wmPtr->menuHeight = 0;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) wmPtr->winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenubarReqProc --
+ *
+ * This procedure is invoked by the Tk geometry management code
+ * whenever a menubar calls Tk_GeometryRequest to request a new
+ * size.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenubarReqProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to the window manager
+ * information for tkwin's toplevel. */
+ Tk_Window tkwin; /* Handle for menubar window. */
+{
+ WmInfo *wmPtr = (WmInfo *) clientData;
+
+ wmPtr->menuHeight = Tk_ReqHeight(tkwin);
+ if (wmPtr->menuHeight <= 0) {
+ wmPtr->menuHeight = 1;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) wmPtr->winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetWrapperWindow --
+ *
+ * Given a toplevel window return the hidden wrapper window for
+ * the toplevel window if available.
+ *
+ * Results:
+ * The wrapper window. NULL is we were not passed a toplevel
+ * window or the wrapper has yet to be created.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkpGetWrapperWindow(winPtr)
+ TkWindow *winPtr; /* A toplevel window pointer. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if ((winPtr == NULL) || (wmPtr == NULL)) {
+ return NULL;
+ }
+
+ return wmPtr->wrapperPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateCommand --
+ *
+ * Update the WM_COMMAND property, taking care to translate
+ * the command strings into the external encoding.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateCommand(winPtr)
+ TkWindow *winPtr;
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tcl_DString cmds, ds;
+ int i, *offsets;
+ char **cmdArgv;
+
+ /*
+ * Translate the argv strings into the external encoding. To avoid
+ * allocating lots of memory, the strings are appended to a buffer
+ * with nulls between each string.
+ *
+ * This code is tricky because we need to pass and array of pointers
+ * to XSetCommand. However, we can't compute the pointers as we go
+ * because the DString buffer space could get reallocated. So, store
+ * offsets for each element as we go, then compute pointers from the
+ * offsets once the entire DString is done.
+ */
+
+ cmdArgv = (char **) ckalloc(sizeof(char *) * wmPtr->cmdArgc);
+ offsets = (int *) ckalloc( sizeof(int) * wmPtr->cmdArgc);
+ Tcl_DStringInit(&cmds);
+ for (i = 0; i < wmPtr->cmdArgc; i++) {
+ Tcl_UtfToExternalDString(NULL, wmPtr->cmdArgv[i], -1, &ds);
+ offsets[i] = Tcl_DStringLength(&cmds);
+ Tcl_DStringAppend(&cmds, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds)+1);
+ Tcl_DStringFree(&ds);
+ }
+ cmdArgv[0] = Tcl_DStringValue(&cmds);
+ for (i = 1; i < wmPtr->cmdArgc; i++) {
+ cmdArgv[i] = cmdArgv[0] + offsets[i];
+ }
+
+ XSetCommand(winPtr->display, wmPtr->wrapperPtr->window,
+ cmdArgv, wmPtr->cmdArgc);
+ Tcl_DStringFree(&cmds);
+ ckfree((char *) cmdArgv);
+ ckfree((char *) offsets);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpWmSetState --
+ *
+ * Sets the window manager state for the wrapper window of a
+ * given toplevel window.
+ *
+ * Results:
+ * 0 on error, 1 otherwise
+ *
+ * Side effects:
+ * May minimize, restore, or withdraw a window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpWmSetState(winPtr, state)
+ TkWindow *winPtr; /* Toplevel window to operate on. */
+ int state; /* One of IconicState, NormalState,
+ * or WithdrawnState. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (state == WithdrawnState) {
+ wmPtr->hints.initial_state = WithdrawnState;
+ wmPtr->withdrawn = 1;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return 1;
+ }
+ if (XWithdrawWindow(winPtr->display, wmPtr->wrapperPtr->window,
+ winPtr->screenNum) == 0) {
+ return 0;
+ }
+ WaitForMapNotify(winPtr, 0);
+ } else if (state == NormalState) {
+ wmPtr->hints.initial_state = NormalState;
+ wmPtr->withdrawn = 0;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return 1;
+ }
+ UpdateHints(winPtr);
+ Tk_MapWindow((Tk_Window) winPtr);
+ } else if (state == IconicState) {
+ wmPtr->hints.initial_state = IconicState;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return 1;
+ }
+ if (wmPtr->withdrawn) {
+ UpdateHints(winPtr);
+ Tk_MapWindow((Tk_Window) winPtr);
+ wmPtr->withdrawn = 0;
+ } else {
+ if (XIconifyWindow(winPtr->display, wmPtr->wrapperPtr->window,
+ winPtr->screenNum) == 0) {
+ return 0;
+ }
+ WaitForMapNotify(winPtr, 0);
+ }
+ }
+
+ return 1;
+}
--- /dev/null
+/*
+ * tkUnixXId.c --
+ *
+ * This file provides a replacement function for the default X
+ * resource allocator (_XAllocID). The problem with the default
+ * allocator is that it never re-uses ids, which causes long-lived
+ * applications to crash when X resource identifiers wrap around.
+ * The replacement functions in this file re-use old identifiers
+ * to prevent this problem.
+ *
+ * The code in this file is based on similar implementations by
+ * George C. Kaplan and Michael Hoegeman.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * The definition below is needed on some systems so that we can access
+ * the resource_alloc field of Display structures in order to replace
+ * the resource allocator.
+ */
+
+#define XLIB_ILLEGAL_ACCESS 1
+
+#include "tkUnixInt.h"
+#include "tkPort.h"
+
+/*
+ * A structure of the following type is used to hold one or more
+ * available resource identifiers. There is a list of these structures
+ * for each display.
+ */
+
+#define IDS_PER_STACK 10
+typedef struct TkIdStack {
+ XID ids[IDS_PER_STACK]; /* Array of free identifiers. */
+ int numUsed; /* Indicates how many of the entries
+ * in ids are currently in use. */
+ TkDisplay *dispPtr; /* Display to which ids belong. */
+ struct TkIdStack *nextPtr; /* Next bunch of free identifiers
+ * for the same display. */
+} TkIdStack;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static XID AllocXId _ANSI_ARGS_((Display *display));
+static Tk_RestrictAction CheckRestrictProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void WindowIdCleanup _ANSI_ARGS_((ClientData clientData));
+static void WindowIdCleanup2 _ANSI_ARGS_((ClientData clientData));
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInitXId --
+ *
+ * This procedure is called to initialize the id allocator for
+ * a given display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The official allocator for the display is set up to be AllocXId.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInitXId(dispPtr)
+ TkDisplay *dispPtr; /* Tk's information about the
+ * display. */
+{
+ dispPtr->idStackPtr = NULL;
+ dispPtr->defaultAllocProc = (XID (*) _ANSI_ARGS_((Display *display)))
+ dispPtr->display->resource_alloc;
+ dispPtr->display->resource_alloc = AllocXId;
+ dispPtr->windowStackPtr = NULL;
+ dispPtr->idCleanupScheduled = (Tcl_TimerToken) 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeXId --
+ *
+ * This procedure is called to free resources for the id allocator
+ * for a given display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the id and window stack pools.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeXId(dispPtr)
+ TkDisplay *dispPtr; /* Tk's information about the
+ * display. */
+{
+ TkIdStack *stackPtr, *freePtr;
+
+ if (dispPtr->idCleanupScheduled) {
+ Tcl_DeleteTimerHandler(dispPtr->idCleanupScheduled);
+ }
+
+ for (stackPtr = dispPtr->idStackPtr; stackPtr != NULL; ) {
+ freePtr = stackPtr;
+ stackPtr = stackPtr->nextPtr;
+ ckfree((char *) freePtr);
+ }
+ dispPtr->idStackPtr = NULL;
+
+ for (stackPtr = dispPtr->windowStackPtr; stackPtr != NULL; ) {
+ freePtr = stackPtr;
+ stackPtr = stackPtr->nextPtr;
+ ckfree((char *) freePtr);
+ }
+ dispPtr->windowStackPtr = NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocXId --
+ *
+ * This procedure is invoked by Xlib as the resource allocator
+ * for a display.
+ *
+ * Results:
+ * The return value is an X resource identifier that isn't currently
+ * in use.
+ *
+ * Side effects:
+ * The identifier is removed from the stack of free identifiers,
+ * if it was previously on the stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static XID
+AllocXId(display)
+ Display *display; /* Display for which to allocate. */
+{
+ TkDisplay *dispPtr;
+ TkIdStack *stackPtr;
+
+ /*
+ * Find Tk's information about the display.
+ */
+
+ dispPtr = TkGetDisplay(display);
+
+ /*
+ * If the topmost chunk on the stack is empty then free it. Then
+ * check for a free id on the stack and return it if it exists.
+ */
+
+ stackPtr = dispPtr->idStackPtr;
+ if (stackPtr != NULL) {
+ while (stackPtr->numUsed == 0) {
+ dispPtr->idStackPtr = stackPtr->nextPtr;
+ ckfree((char *) stackPtr);
+ stackPtr = dispPtr->idStackPtr;
+ if (stackPtr == NULL) {
+ goto defAlloc;
+ }
+ }
+ stackPtr->numUsed--;
+ return stackPtr->ids[stackPtr->numUsed];
+ }
+
+ /*
+ * No free ids in the stack: just get one from the default
+ * allocator.
+ */
+
+ defAlloc:
+ return (*dispPtr->defaultAllocProc)(display);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeXId --
+ *
+ * This procedure is called to indicate that an X resource identifier
+ * is now free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The identifier is added to the stack of free identifiers for its
+ * display, so that it can be re-used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeXId(display, xid)
+ Display *display; /* Display for which xid was
+ * allocated. */
+ XID xid; /* Identifier that is no longer
+ * in use. */
+{
+ TkDisplay *dispPtr;
+ TkIdStack *stackPtr;
+
+ /*
+ * Find Tk's information about the display.
+ */
+
+ dispPtr = TkGetDisplay(display);
+
+ /*
+ * Add a new chunk to the stack if the current chunk is full.
+ */
+
+ stackPtr = dispPtr->idStackPtr;
+ if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) {
+ stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack));
+ stackPtr->numUsed = 0;
+ stackPtr->dispPtr = dispPtr;
+ stackPtr->nextPtr = dispPtr->idStackPtr;
+ dispPtr->idStackPtr = stackPtr;
+ }
+
+ /*
+ * Add the id to the current chunk.
+ */
+
+ stackPtr->ids[stackPtr->numUsed] = xid;
+ stackPtr->numUsed++;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeWindowId --
+ *
+ * This procedure is invoked instead of TkFreeXId for window ids.
+ * See below for the reason why.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The id given by w will eventually be freed, so that it can be
+ * reused for other resources.
+ *
+ * Design:
+ * Freeing window ids is very tricky because there could still be
+ * events pending for a window in the event queue (or even in the
+ * server) at the time the window is destroyed. If the window
+ * id were to get reused immediately for another window, old
+ * events could "drop in" on the new window, causing unexpected
+ * behavior.
+ *
+ * Thus we have to wait to re-use a window id until we know that
+ * there are no events left for it. Right now this is done in
+ * two steps. First, we wait until we know that the server
+ * has seen the XDestroyWindow request, so we can be sure that
+ * it won't generate more events for the window and that any
+ * existing events are in our queue. Second, we make sure that
+ * there are no events whatsoever in our queue (this is conservative
+ * but safe).
+ *
+ * The first step is done by remembering the request id of the
+ * XDestroyWindow request and using LastKnownRequestProcessed to
+ * see what events the server has processed. If multiple windows
+ * get destroyed at about the same time, we just remember the
+ * most recent request number for any of them (again, conservative
+ * but safe).
+ *
+ * There are a few other complications as well. When Tk destroys a
+ * sub-tree of windows, it only issues a single XDestroyWindow call,
+ * at the very end for the root of the subtree. We can't free any of
+ * the window ids until the final XDestroyWindow call. To make sure
+ * that this happens, we have to keep track of deletions in progress,
+ * hence the need for the "destroyCount" field of the display.
+ *
+ * One final problem. Some servers, like Sun X11/News servers still
+ * seem to have problems with ids getting reused too quickly. I'm
+ * not completely sure why this is a problem, but delaying the
+ * recycling of ids appears to eliminate it. Therefore, we wait
+ * an additional few seconds, even after "the coast is clear"
+ * before reusing the ids.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeWindowId(dispPtr, w)
+ TkDisplay *dispPtr; /* Display that w belongs to. */
+ Window w; /* X identifier for window on dispPtr. */
+{
+ TkIdStack *stackPtr;
+
+ /*
+ * Put the window id on a separate stack of window ids, rather
+ * than the main stack, so it won't get reused right away. Add
+ * a new chunk to the stack if the current chunk is full.
+ */
+
+ stackPtr = dispPtr->windowStackPtr;
+ if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) {
+ stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack));
+ stackPtr->numUsed = 0;
+ stackPtr->dispPtr = dispPtr;
+ stackPtr->nextPtr = dispPtr->windowStackPtr;
+ dispPtr->windowStackPtr = stackPtr;
+ }
+
+ /*
+ * Add the id to the current chunk.
+ */
+
+ stackPtr->ids[stackPtr->numUsed] = w;
+ stackPtr->numUsed++;
+
+ /*
+ * Schedule a call to WindowIdCleanup if one isn't already
+ * scheduled.
+ */
+
+ if (!dispPtr->idCleanupScheduled) {
+ dispPtr->idCleanupScheduled =
+ Tcl_CreateTimerHandler(100, WindowIdCleanup, (ClientData) dispPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowIdCleanup --
+ *
+ * See if we can now free up all the accumulated ids of
+ * deleted windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If it's safe to move the window ids back to the main free
+ * list, we schedule this to happen after a few mores seconds
+ * of delay. If it's not safe to move them yet, a timer handler
+ * gets invoked to try again later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WindowIdCleanup(clientData)
+ ClientData clientData; /* Pointer to TkDisplay for display */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ int anyEvents, delta;
+ Tk_RestrictProc *oldProc;
+ ClientData oldData;
+ static Tcl_Time timeout = {0, 0};
+
+ dispPtr->idCleanupScheduled = (Tcl_TimerToken) 0;
+
+ /*
+ * See if it's safe to recycle the window ids. It's safe if:
+ * (a) no deletions are in progress.
+ * (b) the server has seen all of the requests up to the last
+ * XDestroyWindow request.
+ * (c) there are no events in the event queue; the only way to
+ * test for this right now is to create a restrict proc that
+ * will filter the events, then call Tcl_DoOneEvent to see if
+ * the procedure gets invoked.
+ */
+
+ if (dispPtr->destroyCount > 0) {
+ goto tryAgain;
+ }
+ delta = LastKnownRequestProcessed(dispPtr->display)
+ - dispPtr->lastDestroyRequest;
+ if (delta < 0) {
+ XSync(dispPtr->display, False);
+ }
+ anyEvents = 0;
+ oldProc = Tk_RestrictEvents(CheckRestrictProc, (ClientData) &anyEvents,
+ &oldData);
+ TkUnixDoOneXEvent(&timeout);
+ Tk_RestrictEvents(oldProc, oldData, &oldData);
+ if (anyEvents) {
+ goto tryAgain;
+ }
+
+ /*
+ * These ids look safe to recycle, but we still need to delay a bit
+ * more (see comments for TkFreeWindowId). Schedule the final freeing.
+ */
+
+ if (dispPtr->windowStackPtr != NULL) {
+ Tcl_CreateTimerHandler(5000, WindowIdCleanup2,
+ (ClientData) dispPtr->windowStackPtr);
+ dispPtr->windowStackPtr = NULL;
+ }
+ return;
+
+ /*
+ * It's still not safe to free up the ids. Try again a bit later.
+ */
+
+ tryAgain:
+ dispPtr->idCleanupScheduled =
+ Tcl_CreateTimerHandler(500, WindowIdCleanup, (ClientData) dispPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowIdCleanup2 --
+ *
+ * This procedure is the last one in the chain that recycles
+ * window ids. It takes all of the ids indicated by its
+ * argument and adds them back to the main id free list.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Window ids get added to the main free list for their display.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WindowIdCleanup2(clientData)
+ ClientData clientData; /* Pointer to TkIdStack list. */
+{
+ TkIdStack *stackPtr = (TkIdStack *) clientData;
+ TkIdStack *lastPtr;
+
+ lastPtr = stackPtr;
+ while (lastPtr->nextPtr != NULL) {
+ lastPtr = lastPtr->nextPtr;
+ }
+ lastPtr->nextPtr = stackPtr->dispPtr->idStackPtr;
+ stackPtr->dispPtr->idStackPtr = stackPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckRestrictProc --
+ *
+ * This procedure is a restrict procedure, called by Tcl_DoOneEvent
+ * to filter X events. All it does is to set a flag to indicate
+ * that there are X events present.
+ *
+ * Results:
+ * Sets the integer pointed to by the argument, then returns
+ * TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+CheckRestrictProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to flag to set. */
+ XEvent *eventPtr; /* Event to filter; not used. */
+{
+ int *flag = (int *) clientData;
+ *flag = 1;
+ return TK_DEFER_EVENT;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetPixmap --
+ *
+ * Same as the XCreatePixmap procedure except that it manages
+ * resource identifiers better.
+ *
+ * Results:
+ * Returns a new pixmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetPixmap(display, d, width, height, depth)
+ Display *display; /* Display for new pixmap. */
+ Drawable d; /* Drawable where pixmap will be used. */
+ int width, height; /* Dimensions of pixmap. */
+ int depth; /* Bits per pixel for pixmap. */
+{
+ return XCreatePixmap(display, d, (unsigned) width, (unsigned) height,
+ (unsigned) depth);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreePixmap --
+ *
+ * Same as the XFreePixmap procedure except that it also marks
+ * the resource identifier as free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The pixmap is freed in the X server and its resource identifier
+ * is saved for re-use.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreePixmap(display, pixmap)
+ Display *display; /* Display for which pixmap was allocated. */
+ Pixmap pixmap; /* Identifier for pixmap. */
+{
+ XFreePixmap(display, pixmap);
+ Tk_FreeXId(display, (XID) pixmap);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpWindowWasRecentlyDeleted --
+ *
+ * Checks whether the window was recently deleted. This is called
+ * by the generic error handler to detect asynchronous notification
+ * of errors due to operations by Tk on a window that was already
+ * deleted by the server.
+ *
+ * Results:
+ * 1 if the window was deleted recently, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpWindowWasRecentlyDeleted(win, dispPtr)
+ Window win; /* The window to check for. */
+ TkDisplay *dispPtr; /* The window belongs to this display. */
+{
+ TkIdStack *stackPtr;
+ int i;
+
+ for (stackPtr = dispPtr->windowStackPtr;
+ stackPtr != NULL;
+ stackPtr = stackPtr->nextPtr) {
+ for (i = 0; i < stackPtr->numUsed; i++) {
+ if ((Window) stackPtr->ids[i] == win) {
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpScanWindowId --
+ *
+ * Given a string, produce the corresponding Window Id.
+ *
+ * Results:
+ * The return value is normally TCL_OK; in this case *idPtr
+ * will be set to the Window value equivalent to string. If
+ * string is improperly formed then TCL_ERROR is returned and
+ * an error message will be left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpScanWindowId(interp, string, idPtr)
+ Tcl_Interp *interp;
+ CONST char *string;
+ Window *idPtr;
+{
+ int value;
+ if (Tcl_GetInt(interp, string, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *idPtr = (Window) value;
+ return TCL_OK;
+}
+