OSDN Git Service

touched all tk files to ease next import
[pf3gnuchains/pf3gnuchains4x.git] / tk / generic / tkCanvas.c
1 /* 
2  * tkCanvas.c --
3  *
4  *      This module implements canvas widgets for the Tk toolkit.
5  *      A canvas displays a background and a collection of graphical
6  *      objects such as rectangles, lines, and texts.
7  *
8  * Copyright (c) 1991-1994 The Regents of the University of California.
9  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
10  * Copyright (c) 1998-1999 by Scriptics Corporation.
11  *
12  * See the file "license.terms" for information on usage and redistribution
13  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14  *
15  * RCS: @(#) $Id$
16  */
17
18 /* #define USE_OLD_TAG_SEARCH 1 */
19
20 #include "default.h"
21 #include "tkInt.h"
22 #include "tkPort.h"
23 #include "tkCanvas.h"
24
25 /*
26  * See tkCanvas.h for key data structures used to implement canvases.
27  */
28
29 #ifdef USE_OLD_TAG_SEARCH
30 /*
31  * The structure defined below is used to keep track of a tag search
32  * in progress.  No field should be accessed by anyone other than
33  * StartTagSearch and NextItem.
34  */
35
36 typedef struct TagSearch {
37     TkCanvas *canvasPtr;        /* Canvas widget being searched. */
38     Tk_Uid tag;                 /* Tag to search for.   0 means return
39                                  * all items. */
40     Tk_Item *currentPtr;        /* Pointer to last item returned. */
41     Tk_Item *lastPtr;           /* The item right before the currentPtr
42                                  * is tracked so if the currentPtr is
43                                  * deleted we don't have to start from the
44                                  * beginning. */
45     int searchOver;             /* Non-zero means NextItem should always
46                                  * return NULL. */
47 } TagSearch;
48
49 #else /* USE_OLD_TAG_SEARCH */
50 /*
51  * The structure defined below is used to keep track of a tag search
52  * in progress.  No field should be accessed by anyone other than
53  * TagSearchScan, TagSearchFirst, TagSearchNext,
54  * TagSearchScanExpr, TagSearchEvalExpr, 
55  * TagSearchExprInit, TagSearchExprDestroy,
56  * TagSearchDestroy.
57  * (
58  *   Not quite accurate: the TagSearch structure is also accessed from:
59  *    CanvasWidgetCmd, FindItems, RelinkItems
60  *   The only instances of the structure are owned by:
61  *    CanvasWidgetCmd
62  *   CanvasWidgetCmd is the only function that calls:
63  *    FindItems, RelinkItems
64  *   CanvasWidgetCmd, FindItems, RelinkItems, are the only functions that call
65  *    TagSearch*
66  * )
67  */
68
69 typedef struct TagSearch {
70     TkCanvas *canvasPtr;        /* Canvas widget being searched. */
71     Tk_Item *currentPtr;        /* Pointer to last item returned. */
72     Tk_Item *lastPtr;           /* The item right before the currentPtr
73                                  * is tracked so if the currentPtr is
74                                  * deleted we don't have to start from the
75                                  * beginning. */
76     int searchOver;             /* Non-zero means NextItem should always
77                                  * return NULL. */
78     int type;                   /* search type */
79     int id;                     /* item id for searches by id */
80
81     char *string;               /* tag expression string */
82     int stringIndex;            /* current position in string scan */
83     int stringLength;           /* length of tag expression string */
84
85     char *rewritebuffer;        /* tag string (after removing escapes) */
86     unsigned int rewritebufferAllocated;        /* available space for rewrites */
87
88     TagSearchExpr *expr;        /* compiled tag expression */
89 } TagSearch;
90 #endif /* USE_OLD_TAG_SEARCH */
91
92 /*
93  * Custom option for handling "-state" and "-offset"
94  */
95
96 static Tk_CustomOption stateOption = {
97     (Tk_OptionParseProc *) TkStateParseProc,
98     TkStatePrintProc,
99     (ClientData) NULL   /* only "normal" and "disabled" */
100 };
101
102 static Tk_CustomOption offsetOption = {
103     (Tk_OptionParseProc *) TkOffsetParseProc,
104     TkOffsetPrintProc,
105     (ClientData) TK_OFFSET_RELATIVE
106 };
107
108 /*
109  * Information used for argv parsing.
110  */
111
112 static Tk_ConfigSpec configSpecs[] = {
113     {TK_CONFIG_BORDER, "-background", "background", "Background",
114         DEF_CANVAS_BG_COLOR, Tk_Offset(TkCanvas, bgBorder),
115         TK_CONFIG_COLOR_ONLY},
116     {TK_CONFIG_BORDER, "-background", "background", "Background",
117         DEF_CANVAS_BG_MONO, Tk_Offset(TkCanvas, bgBorder),
118         TK_CONFIG_MONO_ONLY},
119     {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
120         (char *) NULL, 0, 0},
121     {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
122         (char *) NULL, 0, 0},
123     {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
124         DEF_CANVAS_BORDER_WIDTH, Tk_Offset(TkCanvas, borderWidth), 0},
125     {TK_CONFIG_DOUBLE, "-closeenough", "closeEnough", "CloseEnough",
126         DEF_CANVAS_CLOSE_ENOUGH, Tk_Offset(TkCanvas, closeEnough), 0},
127     {TK_CONFIG_BOOLEAN, "-confine", "confine", "Confine",
128         DEF_CANVAS_CONFINE, Tk_Offset(TkCanvas, confine), 0},
129     {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
130         DEF_CANVAS_CURSOR, Tk_Offset(TkCanvas, cursor), TK_CONFIG_NULL_OK},
131     {TK_CONFIG_PIXELS, "-height", "height", "Height",
132         DEF_CANVAS_HEIGHT, Tk_Offset(TkCanvas, height), 0},
133     {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
134         "HighlightBackground", DEF_CANVAS_HIGHLIGHT_BG,
135         Tk_Offset(TkCanvas, highlightBgColorPtr), 0},
136     {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
137         DEF_CANVAS_HIGHLIGHT, Tk_Offset(TkCanvas, highlightColorPtr), 0},
138     {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
139         "HighlightThickness",
140         DEF_CANVAS_HIGHLIGHT_WIDTH, Tk_Offset(TkCanvas, highlightWidth), 0},
141     {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
142         DEF_CANVAS_INSERT_BG, Tk_Offset(TkCanvas, textInfo.insertBorder), 0},
143     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
144         DEF_CANVAS_INSERT_BD_COLOR,
145         Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_COLOR_ONLY},
146     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
147         DEF_CANVAS_INSERT_BD_MONO,
148         Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_MONO_ONLY},
149     {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
150         DEF_CANVAS_INSERT_OFF_TIME, Tk_Offset(TkCanvas, insertOffTime), 0},
151     {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
152         DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0},
153     {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
154         DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0},
155     {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0",
156         Tk_Offset(TkCanvas, tsoffset),TK_CONFIG_DONT_SET_DEFAULT,
157         &offsetOption},
158     {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
159         DEF_CANVAS_RELIEF, Tk_Offset(TkCanvas, relief), 0},
160     {TK_CONFIG_STRING, "-scrollregion", "scrollRegion", "ScrollRegion",
161         DEF_CANVAS_SCROLL_REGION, Tk_Offset(TkCanvas, regionString),
162         TK_CONFIG_NULL_OK},
163     {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
164         DEF_CANVAS_SELECT_COLOR, Tk_Offset(TkCanvas, textInfo.selBorder),
165         TK_CONFIG_COLOR_ONLY},
166     {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
167         DEF_CANVAS_SELECT_MONO, Tk_Offset(TkCanvas, textInfo.selBorder),
168         TK_CONFIG_MONO_ONLY},
169     {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
170         DEF_CANVAS_SELECT_BD_COLOR,
171         Tk_Offset(TkCanvas, textInfo.selBorderWidth), TK_CONFIG_COLOR_ONLY},
172     {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
173         DEF_CANVAS_SELECT_BD_MONO, Tk_Offset(TkCanvas, textInfo.selBorderWidth),
174         TK_CONFIG_MONO_ONLY},
175     {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
176         DEF_CANVAS_SELECT_FG_COLOR, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
177         TK_CONFIG_COLOR_ONLY},
178     {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
179         DEF_CANVAS_SELECT_FG_MONO, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
180         TK_CONFIG_MONO_ONLY},
181     {TK_CONFIG_CUSTOM, "-state", "state", "State",
182         "normal", Tk_Offset(TkCanvas, canvas_state), TK_CONFIG_DONT_SET_DEFAULT,
183         &stateOption},
184     {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
185         DEF_CANVAS_TAKE_FOCUS, Tk_Offset(TkCanvas, takeFocus),
186         TK_CONFIG_NULL_OK},
187     {TK_CONFIG_PIXELS, "-width", "width", "Width",
188         DEF_CANVAS_WIDTH, Tk_Offset(TkCanvas, width), 0},
189     {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
190         DEF_CANVAS_X_SCROLL_CMD, Tk_Offset(TkCanvas, xScrollCmd),
191         TK_CONFIG_NULL_OK},
192     {TK_CONFIG_PIXELS, "-xscrollincrement", "xScrollIncrement",
193         "ScrollIncrement",
194         DEF_CANVAS_X_SCROLL_INCREMENT, Tk_Offset(TkCanvas, xScrollIncrement),
195         0},
196     {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
197         DEF_CANVAS_Y_SCROLL_CMD, Tk_Offset(TkCanvas, yScrollCmd),
198         TK_CONFIG_NULL_OK},
199     {TK_CONFIG_PIXELS, "-yscrollincrement", "yScrollIncrement",
200         "ScrollIncrement",
201         DEF_CANVAS_Y_SCROLL_INCREMENT, Tk_Offset(TkCanvas, yScrollIncrement),
202         0},
203     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
204         (char *) NULL, 0, 0}
205 };
206
207 /*
208  * List of all the item types known at present:
209  */
210
211 static Tk_ItemType *typeList = NULL;    /* NULL means initialization hasn't
212                                          * been done yet. */
213
214 #ifndef USE_OLD_TAG_SEARCH
215 /*
216  * Uids for operands in compiled advanced tag search expressions
217  * Initialization is done by InitCanvas()
218  */
219 static Tk_Uid allUid = NULL;
220 static Tk_Uid currentUid = NULL;
221 static Tk_Uid andUid = NULL;
222 static Tk_Uid orUid = NULL;
223 static Tk_Uid xorUid = NULL;
224 static Tk_Uid parenUid = NULL;
225 static Tk_Uid negparenUid = NULL;
226 static Tk_Uid endparenUid = NULL;
227 static Tk_Uid tagvalUid = NULL;
228 static Tk_Uid negtagvalUid = NULL;
229 #endif /* USE_OLD_TAG_SEARCH */
230
231 /*
232  * Standard item types provided by Tk:
233  */
234
235 extern Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType;
236 extern Tk_ItemType tkOvalType, tkPolygonType;
237 extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType;
238
239 /*
240  * Prototypes for procedures defined later in this file:
241  */
242
243 static void             CanvasBindProc _ANSI_ARGS_((ClientData clientData,
244                             XEvent *eventPtr));
245 static void             CanvasBlinkProc _ANSI_ARGS_((ClientData clientData));
246 static void             CanvasCmdDeletedProc _ANSI_ARGS_((
247                             ClientData clientData));
248 static void             CanvasDoEvent _ANSI_ARGS_((TkCanvas *canvasPtr,
249                             XEvent *eventPtr));
250 static void             CanvasEventProc _ANSI_ARGS_((ClientData clientData,
251                             XEvent *eventPtr));
252 static int              CanvasFetchSelection _ANSI_ARGS_((
253                             ClientData clientData, int offset,
254                             char *buffer, int maxBytes));
255 static Tk_Item *        CanvasFindClosest _ANSI_ARGS_((TkCanvas *canvasPtr,
256                             double coords[2]));
257 static void             CanvasFocusProc _ANSI_ARGS_((TkCanvas *canvasPtr,
258                             int gotFocus));
259 static void             CanvasLostSelection _ANSI_ARGS_((
260                             ClientData clientData));
261 static void             CanvasSelectTo _ANSI_ARGS_((TkCanvas *canvasPtr,
262                             Tk_Item *itemPtr, int index));
263 static void             CanvasSetOrigin _ANSI_ARGS_((TkCanvas *canvasPtr,
264                             int xOrigin, int yOrigin));
265 static void             CanvasUpdateScrollbars _ANSI_ARGS_((
266                             TkCanvas *canvasPtr));
267 static int              CanvasWidgetCmd _ANSI_ARGS_((ClientData clientData,
268                             Tcl_Interp *interp, int argc, Tcl_Obj *CONST *argv));
269 static void             CanvasWorldChanged _ANSI_ARGS_((
270                             ClientData instanceData));
271 static int              ConfigureCanvas _ANSI_ARGS_((Tcl_Interp *interp,
272                             TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *argv,
273                             int flags));
274 static void             DestroyCanvas _ANSI_ARGS_((char *memPtr));
275 static void             DisplayCanvas _ANSI_ARGS_((ClientData clientData));
276 static void             DoItem _ANSI_ARGS_((Tcl_Interp *interp,
277                             Tk_Item *itemPtr, Tk_Uid tag));
278 static void             EventuallyRedrawItem _ANSI_ARGS_((Tk_Canvas canvas,
279                             Tk_Item *itemPtr));
280 #ifdef USE_OLD_TAG_SEARCH
281 static int              FindItems _ANSI_ARGS_((Tcl_Interp *interp,
282                             TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *argv,
283                             Tcl_Obj *newTagObj, int first));
284 #else /* USE_OLD_TAG_SEARCH */
285 static int              FindItems _ANSI_ARGS_((Tcl_Interp *interp,
286                             TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *argv,
287                             Tcl_Obj *newTagObj, int first,
288                             TagSearch **searchPtrPtr));
289 #endif /* USE_OLD_TAG_SEARCH */
290 static int              FindArea _ANSI_ARGS_((Tcl_Interp *interp,
291                             TkCanvas *canvasPtr, Tcl_Obj *CONST *argv, Tk_Uid uid,
292                             int enclosed));
293 static double           GridAlign _ANSI_ARGS_((double coord, double spacing));
294 static char**           GetStringsFromObjs _ANSI_ARGS_((int argc,
295                             Tcl_Obj *CONST *objv));
296 static void             InitCanvas _ANSI_ARGS_((void));
297 #ifdef USE_OLD_TAG_SEARCH
298 static Tk_Item *        NextItem _ANSI_ARGS_((TagSearch *searchPtr));
299 #endif /* USE_OLD_TAG_SEARCH */
300 static void             PickCurrentItem _ANSI_ARGS_((TkCanvas *canvasPtr,
301                             XEvent *eventPtr));
302 static void             PrintScrollFractions _ANSI_ARGS_((int screen1,
303                             int screen2, int object1, int object2,
304                             char *string));
305 #ifdef USE_OLD_TAG_SEARCH
306 static void             RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
307                             Tcl_Obj *tag, Tk_Item *prevPtr));
308 static Tk_Item *        StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
309                             Tcl_Obj *tag, TagSearch *searchPtr));
310 #else /* USE_OLD_TAG_SEARCH */
311 static int              RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
312                             Tcl_Obj *tag, Tk_Item *prevPtr,
313                             TagSearch **searchPtrPtr));
314 static void             TagSearchExprInit _ANSI_ARGS_ ((
315                             TagSearchExpr **exprPtrPtr));
316 static void             TagSearchExprDestroy _ANSI_ARGS_((TagSearchExpr *expr));
317 static void             TagSearchDestroy _ANSI_ARGS_((TagSearch *searchPtr));
318 static int              TagSearchScan _ANSI_ARGS_((TkCanvas *canvasPtr,
319                             Tcl_Obj *tag, TagSearch **searchPtrPtr));
320 static int              TagSearchScanExpr _ANSI_ARGS_((Tcl_Interp *interp,
321                             TagSearch *searchPtr, TagSearchExpr *expr));
322 static int              TagSearchEvalExpr _ANSI_ARGS_((TagSearchExpr *expr,
323                             Tk_Item *itemPtr));
324 static Tk_Item *        TagSearchFirst _ANSI_ARGS_((TagSearch *searchPtr));
325 static Tk_Item *        TagSearchNext _ANSI_ARGS_((TagSearch *searchPtr));
326 #endif /* USE_OLD_TAG_SEARCH */
327
328 /*
329  * The structure below defines canvas class behavior by means of procedures
330  * that can be invoked from generic window code.
331  */
332
333 static TkClassProcs canvasClass = {
334     NULL,                       /* createProc. */
335     CanvasWorldChanged,         /* geometryProc. */
336     NULL                        /* modalProc. */
337 };
338
339 \f
340 /*
341  *--------------------------------------------------------------
342  *
343  * Tk_CanvasObjCmd --
344  *
345  *      This procedure is invoked to process the "canvas" Tcl
346  *      command.  See the user documentation for details on what
347  *      it does.
348  *
349  * Results:
350  *      A standard Tcl result.
351  *
352  * Side effects:
353  *      See the user documentation.
354  *
355  *--------------------------------------------------------------
356  */
357
358 int
359 Tk_CanvasObjCmd(clientData, interp, argc, argv)
360     ClientData clientData;              /* Main window associated with
361                                  * interpreter. */
362     Tcl_Interp *interp;         /* Current interpreter. */
363     int argc;                   /* Number of arguments. */
364     Tcl_Obj *CONST argv[];      /* Argument objects. */
365 {
366     Tk_Window tkwin = (Tk_Window) clientData;
367     TkCanvas *canvasPtr;
368     Tk_Window new;
369
370     if (typeList == NULL) {
371         InitCanvas();
372     }
373
374     if (argc < 2) {
375         Tcl_WrongNumArgs(interp, 1, argv, "pathName ?options?");
376         return TCL_ERROR;
377     }
378
379     new = Tk_CreateWindowFromPath(interp, tkwin,
380             Tcl_GetString(argv[1]), (char *) NULL);
381     if (new == NULL) {
382         return TCL_ERROR;
383     }
384
385     /*
386      * Initialize fields that won't be initialized by ConfigureCanvas,
387      * or which ConfigureCanvas expects to have reasonable values
388      * (e.g. resource pointers).
389      */
390
391     canvasPtr = (TkCanvas *) ckalloc(sizeof(TkCanvas));
392     canvasPtr->tkwin = new;
393     canvasPtr->display = Tk_Display(new);
394     canvasPtr->interp = interp;
395     canvasPtr->widgetCmd = Tcl_CreateObjCommand(interp,
396             Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd,
397             (ClientData) canvasPtr, CanvasCmdDeletedProc);
398     canvasPtr->firstItemPtr = NULL;
399     canvasPtr->lastItemPtr = NULL;
400     canvasPtr->borderWidth = 0;
401     canvasPtr->bgBorder = NULL;
402     canvasPtr->relief = TK_RELIEF_FLAT;
403     canvasPtr->highlightWidth = 0;
404     canvasPtr->highlightBgColorPtr = NULL;
405     canvasPtr->highlightColorPtr = NULL;
406     canvasPtr->inset = 0;
407     canvasPtr->pixmapGC = None;
408     canvasPtr->width = None;
409     canvasPtr->height = None;
410     canvasPtr->confine = 0;
411     canvasPtr->textInfo.selBorder = NULL;
412     canvasPtr->textInfo.selBorderWidth = 0;
413     canvasPtr->textInfo.selFgColorPtr = NULL;
414     canvasPtr->textInfo.selItemPtr = NULL;
415     canvasPtr->textInfo.selectFirst = -1;
416     canvasPtr->textInfo.selectLast = -1;
417     canvasPtr->textInfo.anchorItemPtr = NULL;
418     canvasPtr->textInfo.selectAnchor = 0;
419     canvasPtr->textInfo.insertBorder = NULL;
420     canvasPtr->textInfo.insertWidth = 0;
421     canvasPtr->textInfo.insertBorderWidth = 0;
422     canvasPtr->textInfo.focusItemPtr = NULL;
423     canvasPtr->textInfo.gotFocus = 0;
424     canvasPtr->textInfo.cursorOn = 0;
425     canvasPtr->insertOnTime = 0;
426     canvasPtr->insertOffTime = 0;
427     canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
428     canvasPtr->xOrigin = canvasPtr->yOrigin = 0;
429     canvasPtr->drawableXOrigin = canvasPtr->drawableYOrigin = 0;
430     canvasPtr->bindingTable = NULL;
431     canvasPtr->currentItemPtr = NULL;
432     canvasPtr->newCurrentPtr = NULL;
433     canvasPtr->closeEnough = 0.0;
434     canvasPtr->pickEvent.type = LeaveNotify;
435     canvasPtr->pickEvent.xcrossing.x = 0;
436     canvasPtr->pickEvent.xcrossing.y = 0;
437     canvasPtr->state = 0;
438     canvasPtr->xScrollCmd = NULL;
439     canvasPtr->yScrollCmd = NULL;
440     canvasPtr->scrollX1 = 0;
441     canvasPtr->scrollY1 = 0;
442     canvasPtr->scrollX2 = 0;
443     canvasPtr->scrollY2 = 0;
444     canvasPtr->regionString = NULL;
445     canvasPtr->xScrollIncrement = 0;
446     canvasPtr->yScrollIncrement = 0;
447     canvasPtr->scanX = 0;
448     canvasPtr->scanXOrigin = 0;
449     canvasPtr->scanY = 0;
450     canvasPtr->scanYOrigin = 0;
451     canvasPtr->hotPtr = NULL;
452     canvasPtr->hotPrevPtr = NULL;
453     canvasPtr->cursor = None;
454     canvasPtr->takeFocus = NULL;
455     canvasPtr->pixelsPerMM = WidthOfScreen(Tk_Screen(new));
456     canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(new));
457     canvasPtr->flags = 0;
458     canvasPtr->nextId = 1;
459     canvasPtr->psInfo = NULL;
460     canvasPtr->canvas_state = TK_STATE_NORMAL;
461     canvasPtr->tsoffset.flags = 0;
462     canvasPtr->tsoffset.xoffset = 0;
463     canvasPtr->tsoffset.yoffset = 0;
464 #ifndef USE_OLD_TAG_SEARCH
465     canvasPtr->bindTagExprs = NULL;
466 #endif
467     Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS);
468
469     Tk_SetClass(canvasPtr->tkwin, "Canvas");
470     TkSetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr);
471     Tk_CreateEventHandler(canvasPtr->tkwin,
472             ExposureMask|StructureNotifyMask|FocusChangeMask,
473             CanvasEventProc, (ClientData) canvasPtr);
474     Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask
475             |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
476             |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
477             CanvasBindProc, (ClientData) canvasPtr);
478     Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING,
479             CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING);
480     if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) {
481         goto error;
482     }
483
484     Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC);
485     return TCL_OK;
486
487     error:
488     Tk_DestroyWindow(canvasPtr->tkwin);
489     return TCL_ERROR;
490 }
491 \f
492 /*
493  *--------------------------------------------------------------
494  *
495  * CanvasWidgetCmd --
496  *
497  *      This procedure is invoked to process the Tcl command
498  *      that corresponds to a widget managed by this module.
499  *      See the user documentation for details on what it does.
500  *
501  * Results:
502  *      A standard Tcl result.
503  *
504  * Side effects:
505  *      See the user documentation.
506  *
507  *--------------------------------------------------------------
508  */
509
510 static int
511 CanvasWidgetCmd(clientData, interp, argc, argv)
512     ClientData clientData;              /* Information about canvas
513                                          * widget. */
514     Tcl_Interp *interp;                 /* Current interpreter. */
515     int argc;                           /* Number of arguments. */
516     Tcl_Obj *CONST argv[];              /* Argument objects. */
517 {
518     TkCanvas *canvasPtr = (TkCanvas *) clientData;
519     unsigned int length;
520     int c, result;
521     Tk_Item *itemPtr = NULL;            /* Initialization needed only to
522                                          * prevent compiler warning. */
523 #ifdef USE_OLD_TAG_SEARCH
524     TagSearch search;
525 #else /* USE_OLD_TAG_SEARCH */
526     TagSearch *searchPtr = NULL;        /* Allocated by first TagSearchScan
527                                          * Freed by TagSearchDestroy */
528 #endif /* USE_OLD_TAG_SEARCH */
529
530     int index;
531     static char *optionStrings[] = {
532         "addtag",       "bbox",         "bind",         "canvasx",
533         "canvasy",      "cget",         "configure",    "coords",
534         "create",       "dchars",       "delete",       "dtag",
535         "find",         "focus",        "gettags",      "icursor",
536         "index",        "insert",       "itemcget",     "itemconfigure",
537         "lower",        "move",         "postscript",   "raise",
538         "scale",        "scan",         "select",       "type",
539         "xview",        "yview",
540         NULL
541     };
542     enum options {
543         CANV_ADDTAG,    CANV_BBOX,      CANV_BIND,      CANV_CANVASX,
544         CANV_CANVASY,   CANV_CGET,      CANV_CONFIGURE, CANV_COORDS,
545         CANV_CREATE,    CANV_DCHARS,    CANV_DELETE,    CANV_DTAG,
546         CANV_FIND,      CANV_FOCUS,     CANV_GETTAGS,   CANV_ICURSOR,
547         CANV_INDEX,     CANV_INSERT,    CANV_ITEMCGET,  CANV_ITEMCONFIGURE,
548         CANV_LOWER,     CANV_MOVE,      CANV_POSTSCRIPT,CANV_RAISE,
549         CANV_SCALE,     CANV_SCAN,      CANV_SELECT,    CANV_TYPE,
550         CANV_XVIEW,     CANV_YVIEW
551     };
552
553     if (argc < 2) {
554         Tcl_WrongNumArgs(interp, 1, argv, "option ?arg arg ...?");
555         return TCL_ERROR;
556     }
557     if (Tcl_GetIndexFromObj(interp, argv[1], optionStrings, "option", 0,
558             &index) != TCL_OK) {
559         return TCL_ERROR;
560     }
561     Tcl_Preserve((ClientData) canvasPtr);
562
563     result = TCL_OK;
564     switch ((enum options) index) {
565       case CANV_ADDTAG: {
566         if (argc < 4) {
567             Tcl_WrongNumArgs(interp, 2, argv, "tag searchCommand ?arg arg ...?");
568             result = TCL_ERROR;
569             goto done;
570         }
571 #ifdef USE_OLD_TAG_SEARCH
572         result = FindItems(interp, canvasPtr, argc, argv, argv[2], 3);
573 #else /* USE_OLD_TAG_SEARCH */
574         result = FindItems(interp, canvasPtr, argc, argv, argv[2], 3, &searchPtr);
575 #endif /* USE_OLD_TAG_SEARCH */
576         break;
577       }
578
579       case CANV_BBOX: {
580         int i, gotAny;
581         int x1 = 0, y1 = 0, x2 = 0, y2 = 0;     /* Initializations needed
582                                                  * only to prevent compiler
583                                                  * warnings. */
584
585         if (argc < 3) {
586             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagOrId ...?");
587             result = TCL_ERROR;
588             goto done;
589         }
590         gotAny = 0;
591         for (i = 2; i < argc; i++) {
592 #ifdef USE_OLD_TAG_SEARCH
593             for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
594                     itemPtr != NULL; itemPtr = NextItem(&search)) {
595 #else /* USE_OLD_TAG_SEARCH */
596             if ((result = TagSearchScan(canvasPtr, argv[i], &searchPtr)) != TCL_OK) {
597                 goto done;
598             }
599             for (itemPtr = TagSearchFirst(searchPtr);
600                     itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
601 #endif /* USE_OLD_TAG_SEARCH */
602
603                 if ((itemPtr->x1 >= itemPtr->x2)
604                         || (itemPtr->y1 >= itemPtr->y2)) {
605                     continue;
606                 }
607                 if (!gotAny) {
608                     x1 = itemPtr->x1;
609                     y1 = itemPtr->y1;
610                     x2 = itemPtr->x2;
611                     y2 = itemPtr->y2;
612                     gotAny = 1;
613                 } else {
614                     if (itemPtr->x1 < x1) {
615                         x1 = itemPtr->x1;
616                     }
617                     if (itemPtr->y1 < y1) {
618                         y1 = itemPtr->y1;
619                     }
620                     if (itemPtr->x2 > x2) {
621                         x2 = itemPtr->x2;
622                     }
623                     if (itemPtr->y2 > y2) {
624                         y2 = itemPtr->y2;
625                     }
626                 }
627             }
628         }
629         if (gotAny) {
630             char buf[TCL_INTEGER_SPACE * 4];
631             
632             sprintf(buf, "%d %d %d %d", x1, y1, x2, y2);
633             Tcl_SetResult(interp, buf, TCL_VOLATILE);
634         }
635         break;
636       }
637       case CANV_BIND: {
638         ClientData object;
639
640         if ((argc < 3) || (argc > 5)) {
641             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?sequence? ?command?");
642             result = TCL_ERROR;
643             goto done;
644         }
645
646         /*
647          * Figure out what object to use for the binding (individual
648          * item vs. tag).
649          */
650
651         object = 0;
652 #ifdef USE_OLD_TAG_SEARCH
653         if (isdigit(UCHAR(Tcl_GetString(argv[2])[0]))) {
654             int id;
655             char *end;
656             Tcl_HashEntry *entryPtr;
657
658             id = strtoul(Tcl_GetString(argv[2]), &end, 0);
659             if (*end != 0) {
660                 goto bindByTag;
661             }
662             entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
663             if (entryPtr != NULL) {
664                 itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr);
665                 object = (ClientData) itemPtr;
666             }
667
668             if (object == 0) {
669                 Tcl_AppendResult(interp, "item \"", Tcl_GetString(argv[2]),
670                         "\" doesn't exist", (char *) NULL);
671                 result = TCL_ERROR;
672                 goto done;
673             }
674         } else {
675             bindByTag:
676             object = (ClientData) Tk_GetUid(Tcl_GetString(argv[2]));
677         }
678 #else /* USE_OLD_TAG_SEARCH */
679         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
680             goto done;
681         }
682         if (searchPtr->type == 1) {
683             Tcl_HashEntry *entryPtr;
684
685             entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) searchPtr->id);
686             if (entryPtr != NULL) {
687                 itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr);
688                 object = (ClientData) itemPtr;
689             }
690
691             if (object == 0) {
692                 Tcl_AppendResult(interp, "item \"", Tcl_GetString(argv[2]),
693                         "\" doesn't exist", (char *) NULL);
694                 result = TCL_ERROR;
695                 goto done;
696             }
697         } else {
698             object = (ClientData) searchPtr->expr->uid;
699         }
700 #endif /* USE_OLD_TAG_SEARCH */
701
702         /*
703          * Make a binding table if the canvas doesn't already have
704          * one.
705          */
706
707         if (canvasPtr->bindingTable == NULL) {
708             canvasPtr->bindingTable = Tk_CreateBindingTable(interp);
709         }
710
711         if (argc == 5) {
712             int append = 0;
713             unsigned long mask;
714             char* argv4 = Tcl_GetStringFromObj(argv[4],NULL);
715
716             if (argv4[0] == 0) {
717                 result = Tk_DeleteBinding(interp, canvasPtr->bindingTable,
718                         object, Tcl_GetStringFromObj(argv[3], NULL));
719                 goto done;
720             }
721 #ifndef USE_OLD_TAG_SEARCH
722             if (searchPtr->type == 4) {
723                 /*
724                  * if new tag expression, then insert in linked list
725                  */
726                 TagSearchExpr *expr, **lastPtr;
727
728                 lastPtr = &(canvasPtr->bindTagExprs);
729                 while ((expr = *lastPtr) != NULL) {
730                     if (expr->uid == searchPtr->expr->uid) {
731                         break;
732                     }
733                     lastPtr = &(expr->next);
734                 }
735                 if (!expr) {
736                     /*
737                      * transfer ownership of expr to bindTagExprs list
738                      */
739                     *lastPtr = searchPtr->expr;
740                     searchPtr->expr->next = NULL;
741
742                     /*
743                      * flag in TagSearch that expr has changed ownership
744                      * so that TagSearchDestroy doesn't try to free it
745                      */
746                     searchPtr->expr = NULL;
747                 }
748             }
749 #endif /* not USE_OLD_TAG_SEARCH */
750             if (argv4[0] == '+') {
751                 argv4++;
752                 append = 1;
753             }
754             mask = Tk_CreateBinding(interp, canvasPtr->bindingTable,
755                     object, Tcl_GetStringFromObj(argv[3],NULL), argv4, append);
756             if (mask == 0) {
757                 result = TCL_ERROR;
758                 goto done;
759             }
760             if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
761                     |Button2MotionMask|Button3MotionMask|Button4MotionMask
762                     |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
763                     |EnterWindowMask|LeaveWindowMask|KeyPressMask
764                     |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
765                 Tk_DeleteBinding(interp, canvasPtr->bindingTable,
766                         object, Tcl_GetStringFromObj(argv[3], NULL));
767                 Tcl_ResetResult(interp);
768                 Tcl_AppendResult(interp, "requested illegal events; ",
769                         "only key, button, motion, enter, leave, and virtual ",
770                         "events may be used", (char *) NULL);
771                 result = TCL_ERROR;
772                 goto done;
773             }
774         } else if (argc == 4) {
775             char *command;
776     
777             command = Tk_GetBinding(interp, canvasPtr->bindingTable,
778                     object, Tcl_GetStringFromObj(argv[3], NULL));
779             if (command == NULL) {
780                 char *string;
781
782                 string = Tcl_GetStringResult(interp); 
783                 /*
784                  * Ignore missing binding errors.  This is a special hack
785                  * that relies on the error message returned by FindSequence
786                  * in tkBind.c.
787                  */
788
789                 if (string[0] != '\0') {
790                     result = TCL_ERROR;
791                     goto done;
792                 } else {
793                     Tcl_ResetResult(interp);
794                 }
795             } else {
796                 Tcl_SetResult(interp, command, TCL_STATIC);
797             }
798         } else {
799             Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
800         }
801         break;
802       }
803       case CANV_CANVASX: {
804         int x;
805         double grid;
806         char buf[TCL_DOUBLE_SPACE];
807
808         if ((argc < 3) || (argc > 4)) {
809             Tcl_WrongNumArgs(interp, 2, argv, "screenx ?gridspacing?");
810             result = TCL_ERROR;
811             goto done;
812         }
813         if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
814             result = TCL_ERROR;
815             goto done;
816         }
817         if (argc == 4) {
818             if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
819                     &grid) != TCL_OK) {
820                 result = TCL_ERROR;
821                 goto done;
822             }
823         } else {
824             grid = 0.0;
825         }
826         x += canvasPtr->xOrigin;
827         Tcl_PrintDouble(interp, GridAlign((double) x, grid), buf);
828         Tcl_SetResult(interp, buf, TCL_VOLATILE);
829         break;
830       }
831       case CANV_CANVASY: {
832         int y;
833         double grid;
834         char buf[TCL_DOUBLE_SPACE];
835
836         if ((argc < 3) || (argc > 4)) {
837             Tcl_WrongNumArgs(interp, 2, argv, "screeny ?gridspacing?");
838             result = TCL_ERROR;
839             goto done;
840         }
841         if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
842             result = TCL_ERROR;
843             goto done;
844         }
845         if (argc == 4) {
846             if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
847                     argv[3], &grid) != TCL_OK) {
848                 result = TCL_ERROR;
849                 goto done;
850             }
851         } else {
852             grid = 0.0;
853         }
854         y += canvasPtr->yOrigin;
855         Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf);
856         Tcl_SetResult(interp, buf, TCL_VOLATILE);
857         break;
858       }
859       case CANV_CGET: {
860         if (argc != 3) {
861             Tcl_WrongNumArgs(interp, 2, argv, "option");
862             result = TCL_ERROR;
863             goto done;
864         }
865         result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs,
866                 (char *) canvasPtr, Tcl_GetString(argv[2]), 0);
867         break;
868       }
869       case CANV_CONFIGURE: {
870         if (argc == 2) {
871             result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
872                     (char *) canvasPtr, (char *) NULL, 0);
873         } else if (argc == 3) {
874             result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
875                     (char *) canvasPtr, Tcl_GetString(argv[2]), 0);
876         } else {
877             result = ConfigureCanvas(interp, canvasPtr, argc-2, argv+2,
878                     TK_CONFIG_ARGV_ONLY);
879         }
880         break;
881       }
882       case CANV_COORDS: {
883         if (argc < 3) {
884             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?x y x y ...?");
885             result = TCL_ERROR;
886             goto done;
887         }
888 #ifdef USE_OLD_TAG_SEARCH
889         itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
890 #else /* USE_OLD_TAG_SEARCH */
891         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
892             goto done;
893         }
894         itemPtr = TagSearchFirst(searchPtr);
895 #endif /* USE_OLD_TAG_SEARCH */
896         if (itemPtr != NULL) {
897             if (argc != 3) {
898                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
899             }
900             if (itemPtr->typePtr->coordProc != NULL) {
901               if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
902                 result = (*itemPtr->typePtr->coordProc)(interp,
903                         (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3);
904               } else {
905                 char **args = GetStringsFromObjs(argc-3, argv+3);
906                 result = (*itemPtr->typePtr->coordProc)(interp,
907                         (Tk_Canvas) canvasPtr, itemPtr, argc-3, (Tcl_Obj **) args);
908                 if (args) ckfree((char *) args);
909               }
910             }
911             if (argc != 3) {
912                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
913             }
914         }
915         break;
916       }
917       case CANV_CREATE: {
918         Tk_ItemType *typePtr;
919         Tk_ItemType *matchPtr = NULL;
920         Tk_Item *itemPtr;
921         char buf[TCL_INTEGER_SPACE];
922         int isNew = 0;
923         Tcl_HashEntry *entryPtr;
924         char *arg;
925
926         if (argc < 3) {
927             Tcl_WrongNumArgs(interp, 2, argv, "type ?arg arg ...?");
928             result = TCL_ERROR;
929             goto done;
930         }
931         arg = Tcl_GetStringFromObj(argv[2], (int *) &length);
932         c = arg[0];
933         for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) {
934             if ((c == typePtr->name[0])
935                     && (strncmp(arg, typePtr->name, length) == 0)) {
936                 if (matchPtr != NULL) {
937                     badType:
938                     Tcl_AppendResult(interp,
939                             "unknown or ambiguous item type \"",
940                             arg, "\"", (char *) NULL);
941                     result = TCL_ERROR;
942                     goto done;
943                 }
944                 matchPtr = typePtr;
945             }
946         }
947         if (matchPtr == NULL) {
948             goto badType;
949         }
950         typePtr = matchPtr;
951         itemPtr = (Tk_Item *) ckalloc((unsigned) typePtr->itemSize);
952         itemPtr->id = canvasPtr->nextId;
953         canvasPtr->nextId++;
954         itemPtr->tagPtr = itemPtr->staticTagSpace;
955         itemPtr->tagSpace = TK_TAG_SPACE;
956         itemPtr->numTags = 0;
957         itemPtr->typePtr = typePtr;
958         itemPtr->state = TK_STATE_NULL;
959         itemPtr->redraw_flags = 0;
960         if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
961           result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
962                 itemPtr, argc-3, argv+3);
963         } else {
964           char **args = GetStringsFromObjs(argc-3, argv+3);
965           result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
966                 itemPtr, argc-3, (Tcl_Obj **) args);
967           if (args) ckfree((char *) args);
968         }
969         if (result != TCL_OK) {
970             ckfree((char *) itemPtr);
971             result = TCL_ERROR;
972             goto done;
973         }
974         itemPtr->nextPtr = NULL;
975         entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable,
976                 (char *) itemPtr->id, &isNew);
977         Tcl_SetHashValue(entryPtr, itemPtr);
978         itemPtr->prevPtr = canvasPtr->lastItemPtr;
979         canvasPtr->hotPtr = itemPtr;
980         canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr;
981         if (canvasPtr->lastItemPtr == NULL) {
982             canvasPtr->firstItemPtr = itemPtr;
983         } else {
984             canvasPtr->lastItemPtr->nextPtr = itemPtr;
985         }
986         canvasPtr->lastItemPtr = itemPtr;
987         itemPtr->redraw_flags |= FORCE_REDRAW;
988         EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
989         canvasPtr->flags |= REPICK_NEEDED;
990         sprintf(buf, "%d", itemPtr->id);
991         Tcl_SetResult(interp, buf, TCL_VOLATILE);
992         break;
993       }
994       case CANV_DCHARS: {
995         int first, last;
996         int x1,x2,y1,y2;
997
998         if ((argc != 4) && (argc != 5)) {
999             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId first ?last?");
1000             result = TCL_ERROR;
1001             goto done;
1002         }
1003 #ifdef USE_OLD_TAG_SEARCH
1004         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1005                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1006 #else /* USE_OLD_TAG_SEARCH */
1007         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1008             goto done;
1009         }
1010         for (itemPtr = TagSearchFirst(searchPtr);
1011                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1012 #endif /* USE_OLD_TAG_SEARCH */
1013             if ((itemPtr->typePtr->indexProc == NULL)
1014                     || (itemPtr->typePtr->dCharsProc == NULL)) {
1015                 continue;
1016             }
1017             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1018                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1019                         itemPtr, (char *) argv[3], &first);
1020             } else {
1021                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1022                         itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &first);
1023             }
1024             if (result != TCL_OK) {
1025                 goto done;
1026             }
1027             if (argc == 5) {
1028                 if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1029                     result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1030                             itemPtr, (char *) argv[4], &last);
1031                 } else {
1032                     result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1033                             itemPtr, Tcl_GetStringFromObj(argv[4], NULL), &last);
1034                 }
1035                 if (result != TCL_OK) {
1036                     goto done;
1037                 }
1038             } else {
1039                 last = first;
1040             }
1041
1042             /*
1043              * Redraw both item's old and new areas:  it's possible
1044              * that a delete could result in a new area larger than
1045              * the old area. Except if the insertProc sets the
1046              * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done.
1047              */
1048
1049             x1 = itemPtr->x1; y1 = itemPtr->y1;
1050             x2 = itemPtr->x2; y2 = itemPtr->y2;
1051             itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
1052             (*itemPtr->typePtr->dCharsProc)((Tk_Canvas) canvasPtr,
1053                     itemPtr, first, last);
1054             if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
1055                 Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
1056                         x1, y1, x2, y2);
1057                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1058             }
1059             itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
1060         }
1061         break;
1062       }
1063       case CANV_DELETE: {
1064         int i;
1065         Tcl_HashEntry *entryPtr;
1066
1067         for (i = 2; i < argc; i++) {
1068 #ifdef USE_OLD_TAG_SEARCH
1069             for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
1070                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1071 #else /* USE_OLD_TAG_SEARCH */
1072             if ((result = TagSearchScan(canvasPtr, argv[i], &searchPtr)) != TCL_OK) {
1073                 goto done;
1074             }
1075             for (itemPtr = TagSearchFirst(searchPtr);
1076                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1077 #endif /* USE_OLD_TAG_SEARCH */
1078                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1079                 if (canvasPtr->bindingTable != NULL) {
1080                     Tk_DeleteAllBindings(canvasPtr->bindingTable,
1081                             (ClientData) itemPtr);
1082                 }
1083                 (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
1084                         canvasPtr->display);
1085                 if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
1086                     ckfree((char *) itemPtr->tagPtr);
1087                 }
1088                 entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable,
1089                         (char *) itemPtr->id);
1090                 Tcl_DeleteHashEntry(entryPtr);
1091                 if (itemPtr->nextPtr != NULL) {
1092                     itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
1093                 }
1094                 if (itemPtr->prevPtr != NULL) {
1095                     itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
1096                 }
1097                 if (canvasPtr->firstItemPtr == itemPtr) {
1098                     canvasPtr->firstItemPtr = itemPtr->nextPtr;
1099                     if (canvasPtr->firstItemPtr == NULL) {
1100                         canvasPtr->lastItemPtr = NULL;
1101                     }
1102                 }
1103                 if (canvasPtr->lastItemPtr == itemPtr) {
1104                     canvasPtr->lastItemPtr = itemPtr->prevPtr;
1105                 }
1106                 ckfree((char *) itemPtr);
1107                 if (itemPtr == canvasPtr->currentItemPtr) {
1108                     canvasPtr->currentItemPtr = NULL;
1109                     canvasPtr->flags |= REPICK_NEEDED;
1110                 }
1111                 if (itemPtr == canvasPtr->newCurrentPtr) {
1112                     canvasPtr->newCurrentPtr = NULL;
1113                     canvasPtr->flags |= REPICK_NEEDED;
1114                 }
1115                 if (itemPtr == canvasPtr->textInfo.focusItemPtr) {
1116                     canvasPtr->textInfo.focusItemPtr = NULL;
1117                 }
1118                 if (itemPtr == canvasPtr->textInfo.selItemPtr) {
1119                     canvasPtr->textInfo.selItemPtr = NULL;
1120                 }
1121                 if ((itemPtr == canvasPtr->hotPtr)
1122                         || (itemPtr == canvasPtr->hotPrevPtr)) {
1123                     canvasPtr->hotPtr = NULL;
1124                 }
1125             }
1126         }
1127         break;
1128       }
1129       case CANV_DTAG: {
1130         Tk_Uid tag;
1131         int i;
1132
1133         if ((argc != 3) && (argc != 4)) {
1134             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagToDelete?");
1135             result = TCL_ERROR;
1136             goto done;
1137         }
1138         if (argc == 4) {
1139             tag = Tk_GetUid(Tcl_GetStringFromObj(argv[3], NULL));
1140         } else {
1141             tag = Tk_GetUid(Tcl_GetStringFromObj(argv[2], NULL));
1142         }
1143 #ifdef USE_OLD_TAG_SEARCH
1144         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1145                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1146 #else /* USE_OLD_TAG_SEARCH */
1147         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1148             goto done;
1149         }
1150         for (itemPtr = TagSearchFirst(searchPtr);
1151                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1152 #endif /* USE_OLD_TAG_SEARCH */
1153             for (i = itemPtr->numTags-1; i >= 0; i--) {
1154                 if (itemPtr->tagPtr[i] == tag) {
1155                     itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
1156                     itemPtr->numTags--;
1157                 }
1158             }
1159         }
1160         break;
1161       }
1162       case CANV_FIND: {
1163         if (argc < 3) {
1164             Tcl_WrongNumArgs(interp, 2, argv, "searchCommand ?arg arg ...?");
1165             result = TCL_ERROR;
1166             goto done;
1167         }
1168 #ifdef USE_OLD_TAG_SEARCH
1169         result = FindItems(interp, canvasPtr, argc, argv, (Tcl_Obj *) NULL, 2);
1170 #else /* USE_OLD_TAG_SEARCH */
1171         result = FindItems(interp, canvasPtr, argc, argv,
1172             (Tcl_Obj *) NULL, 2, &searchPtr);
1173 #endif /* USE_OLD_TAG_SEARCH */
1174         break;
1175       }
1176       case CANV_FOCUS: {
1177         if (argc > 3) {
1178             Tcl_WrongNumArgs(interp, 2, argv, "?tagOrId?");
1179             result = TCL_ERROR;
1180             goto done;
1181         }
1182         itemPtr = canvasPtr->textInfo.focusItemPtr;
1183         if (argc == 2) {
1184             if (itemPtr != NULL) {
1185                 char buf[TCL_INTEGER_SPACE];
1186                 
1187                 sprintf(buf, "%d", itemPtr->id);
1188                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1189             }
1190             goto done;
1191         }
1192         if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) {
1193             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1194         }
1195         if (Tcl_GetStringFromObj(argv[2], NULL)[0] == 0) {
1196             canvasPtr->textInfo.focusItemPtr = NULL;
1197             goto done;
1198         }
1199 #ifdef USE_OLD_TAG_SEARCH
1200         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1201                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1202 #else /* USE_OLD_TAG_SEARCH */
1203         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1204             goto done;
1205         }
1206         for (itemPtr = TagSearchFirst(searchPtr);
1207                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1208 #endif /* USE_OLD_TAG_SEARCH */
1209             if (itemPtr->typePtr->icursorProc != NULL) {
1210                 break;
1211             }
1212         }
1213         if (itemPtr == NULL) {
1214             goto done;
1215         }
1216         canvasPtr->textInfo.focusItemPtr = itemPtr;
1217         if (canvasPtr->textInfo.gotFocus) {
1218             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1219         }
1220         break;
1221       }
1222       case CANV_GETTAGS: {
1223         if (argc != 3) {
1224             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId");
1225             result = TCL_ERROR;
1226             goto done;
1227         }
1228 #ifdef USE_OLD_TAG_SEARCH
1229         itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1230 #else /* USE_OLD_TAG_SEARCH */
1231         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1232             goto done;
1233         }
1234         itemPtr = TagSearchFirst(searchPtr);
1235 #endif /* USE_OLD_TAG_SEARCH */
1236         if (itemPtr != NULL) {
1237             int i;
1238             for (i = 0; i < itemPtr->numTags; i++) {
1239                 Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]);
1240             }
1241         }
1242         break;
1243       }
1244       case CANV_ICURSOR: {
1245         int index;
1246
1247         if (argc != 4) {
1248             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
1249             result = TCL_ERROR;
1250             goto done;
1251         }
1252 #ifdef USE_OLD_TAG_SEARCH
1253         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1254                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1255 #else /* USE_OLD_TAG_SEARCH */
1256         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1257             goto done;
1258         }
1259         for (itemPtr = TagSearchFirst(searchPtr);
1260                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1261 #endif /* USE_OLD_TAG_SEARCH */
1262             if ((itemPtr->typePtr->indexProc == NULL)
1263                     || (itemPtr->typePtr->icursorProc == NULL)) {
1264                 goto done;
1265             }
1266             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1267                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1268                         itemPtr, (char *) argv[3], &index);
1269             } else {
1270                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1271                         itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &index);
1272             }
1273             if (result != TCL_OK) {
1274                 goto done;
1275             }
1276             (*itemPtr->typePtr->icursorProc)((Tk_Canvas) canvasPtr, itemPtr,
1277                     index);
1278             if ((itemPtr == canvasPtr->textInfo.focusItemPtr)
1279                     && (canvasPtr->textInfo.cursorOn)) {
1280                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1281             }
1282         }
1283         break;
1284       }
1285       case CANV_INDEX: {
1286
1287         int index;
1288         char buf[TCL_INTEGER_SPACE];
1289
1290         if (argc != 4) {
1291             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId string");
1292             result = TCL_ERROR;
1293             goto done;
1294         }
1295 #ifdef USE_OLD_TAG_SEARCH
1296         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1297                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1298 #else /* USE_OLD_TAG_SEARCH */
1299         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1300             goto done;
1301         }
1302         for (itemPtr = TagSearchFirst(searchPtr);
1303                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1304 #endif /* USE_OLD_TAG_SEARCH */
1305             if (itemPtr->typePtr->indexProc != NULL) {
1306                 break;
1307             }
1308         }
1309         if (itemPtr == NULL) {
1310             Tcl_AppendResult(interp, "can't find an indexable item \"",
1311                     Tcl_GetStringFromObj(argv[2], NULL), "\"", (char *) NULL);
1312             result = TCL_ERROR;
1313             goto done;
1314         }
1315         if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1316             result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1317                     itemPtr, (char *) argv[3], &index);
1318         } else {
1319             result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1320                     itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &index);
1321         }
1322         if (result != TCL_OK) {
1323             goto done;
1324         }
1325         sprintf(buf, "%d", index);
1326         Tcl_SetResult(interp, buf, TCL_VOLATILE);
1327         break;
1328       }
1329       case CANV_INSERT: {
1330         int beforeThis;
1331         int x1,x2,y1,y2;
1332
1333         if (argc != 5) {
1334             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId beforeThis string");
1335             result = TCL_ERROR;
1336             goto done;
1337         }
1338 #ifdef USE_OLD_TAG_SEARCH
1339         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1340                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1341 #else /* USE_OLD_TAG_SEARCH */
1342         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1343             goto done;
1344         }
1345         for (itemPtr = TagSearchFirst(searchPtr);
1346                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1347 #endif /* USE_OLD_TAG_SEARCH */
1348             if ((itemPtr->typePtr->indexProc == NULL)
1349                     || (itemPtr->typePtr->insertProc == NULL)) {
1350                 continue;
1351             }
1352             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1353                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1354                         itemPtr, (char *) argv[3], &beforeThis);
1355             } else {
1356                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1357                         itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &beforeThis);
1358             }
1359             if (result != TCL_OK) {
1360                 goto done;
1361             }
1362
1363             /*
1364              * Redraw both item's old and new areas:  it's possible
1365              * that an insertion could result in a new area either
1366              * larger or smaller than the old area. Except if the
1367              * insertProc sets the TK_ITEM_DONT_REDRAW flag, nothing
1368              * more needs to be done.
1369              */
1370
1371             x1 = itemPtr->x1; y1 = itemPtr->y1;
1372             x2 = itemPtr->x2; y2 = itemPtr->y2;
1373             itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
1374             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1375                 (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
1376                         itemPtr, beforeThis, (char *) argv[4]);
1377             } else {
1378                 (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
1379                         itemPtr, beforeThis, Tcl_GetStringFromObj(argv[4], NULL));
1380             }
1381             if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
1382                 Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
1383                         x1, y1, x2, y2);
1384                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1385             }
1386             itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
1387         }
1388         break;
1389       }
1390       case CANV_ITEMCGET: {
1391         if (argc != 4) {
1392             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId option");
1393             return TCL_ERROR;
1394         }
1395 #ifdef USE_OLD_TAG_SEARCH
1396         itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1397 #else /* USE_OLD_TAG_SEARCH */
1398         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1399             goto done;
1400         }
1401         itemPtr = TagSearchFirst(searchPtr);
1402 #endif /* USE_OLD_TAG_SEARCH */
1403         if (itemPtr != NULL) {
1404             result = Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin,
1405                     itemPtr->typePtr->configSpecs, (char *) itemPtr,
1406                     Tcl_GetStringFromObj(argv[3], NULL), 0);
1407         }
1408         break;
1409       }
1410       case CANV_ITEMCONFIGURE: {
1411         if (argc < 3) {
1412             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?option value ...?");
1413             result = TCL_ERROR;
1414             goto done;
1415         }
1416 #ifdef USE_OLD_TAG_SEARCH
1417         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1418                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1419 #else /* USE_OLD_TAG_SEARCH */
1420         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1421             goto done;
1422         }
1423         for (itemPtr = TagSearchFirst(searchPtr);
1424                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1425 #endif /* USE_OLD_TAG_SEARCH */
1426             if (argc == 3) {
1427                 result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
1428                         itemPtr->typePtr->configSpecs, (char *) itemPtr,
1429                         (char *) NULL, 0);
1430             } else if (argc == 4) {
1431                 result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
1432                         itemPtr->typePtr->configSpecs, (char *) itemPtr,
1433                         Tcl_GetString(argv[3]), 0);
1434             } else {
1435                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1436                 if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1437                 result = (*itemPtr->typePtr->configProc)(interp,
1438                         (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3,
1439                         TK_CONFIG_ARGV_ONLY);
1440                 } else {
1441                 char **args = GetStringsFromObjs(argc-3, argv+3);
1442                 result = (*itemPtr->typePtr->configProc)(interp,
1443                         (Tk_Canvas) canvasPtr, itemPtr, argc-3, (Tcl_Obj **) args,
1444                         TK_CONFIG_ARGV_ONLY);
1445                 if (args) ckfree((char *) args);
1446                 }
1447                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1448                 canvasPtr->flags |= REPICK_NEEDED;
1449             }
1450             if ((result != TCL_OK) || (argc < 5)) {
1451                 break;
1452             }
1453         }
1454         break;
1455       }
1456       case CANV_LOWER: {
1457         Tk_Item *itemPtr;
1458
1459         if ((argc != 3) && (argc != 4)) {
1460             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?belowThis?");
1461             result = TCL_ERROR;
1462             goto done;
1463         }
1464
1465         /*
1466          * First find the item just after which we'll insert the
1467          * named items.
1468          */
1469
1470         if (argc == 3) {
1471             itemPtr = NULL;
1472         } else {
1473 #ifdef USE_OLD_TAG_SEARCH
1474             itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
1475 #else /* USE_OLD_TAG_SEARCH */
1476             if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
1477                 goto done;
1478             }
1479             itemPtr = TagSearchFirst(searchPtr);
1480 #endif /* USE_OLD_TAG_SEARCH */
1481             if (itemPtr == NULL) {
1482                 Tcl_AppendResult(interp, "tag \"", Tcl_GetString(argv[3]),
1483                         "\" doesn't match any items", (char *) NULL);
1484                 goto done;
1485             }
1486             itemPtr = itemPtr->prevPtr;
1487         }
1488 #ifdef USE_OLD_TAG_SEARCH
1489         RelinkItems(canvasPtr, argv[2], itemPtr);
1490 #else /* USE_OLD_TAG_SEARCH */
1491         if ((result = RelinkItems(canvasPtr, argv[2], itemPtr, &searchPtr)) != TCL_OK) {
1492             goto done;
1493         }
1494 #endif /* USE_OLD_TAG_SEARCH */
1495         break;
1496       }
1497       case CANV_MOVE: {
1498         double xAmount, yAmount;
1499
1500         if (argc != 5) {
1501             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xAmount yAmount");
1502             result = TCL_ERROR;
1503             goto done;
1504         }
1505         if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
1506                 &xAmount) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
1507                 (Tk_Canvas) canvasPtr, argv[4], &yAmount) != TCL_OK)) {
1508             result = TCL_ERROR;
1509             goto done;
1510         }
1511 #ifdef USE_OLD_TAG_SEARCH
1512         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1513                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1514 #else /* USE_OLD_TAG_SEARCH */
1515         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1516             goto done;
1517         }
1518         for (itemPtr = TagSearchFirst(searchPtr);
1519                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1520 #endif /* USE_OLD_TAG_SEARCH */
1521             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1522             (void) (*itemPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr,
1523                     itemPtr,  xAmount, yAmount);
1524             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1525             canvasPtr->flags |= REPICK_NEEDED;
1526         }
1527         break;
1528       }
1529       case CANV_POSTSCRIPT: {
1530         char **args = GetStringsFromObjs(argc, argv);
1531         result = TkCanvPostscriptCmd(canvasPtr, interp, argc, args);
1532         if (args) ckfree((char *) args);
1533         break;
1534       }
1535       case CANV_RAISE: {
1536         Tk_Item *prevPtr;
1537
1538         if ((argc != 3) && (argc != 4)) {
1539             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?aboveThis?");
1540             result = TCL_ERROR;
1541             goto done;
1542         }
1543
1544         /*
1545          * First find the item just after which we'll insert the
1546          * named items.
1547          */
1548
1549         if (argc == 3) {
1550             prevPtr = canvasPtr->lastItemPtr;
1551         } else {
1552             prevPtr = NULL;
1553 #ifdef USE_OLD_TAG_SEARCH
1554             for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
1555                     itemPtr != NULL; itemPtr = NextItem(&search)) {
1556 #else /* USE_OLD_TAG_SEARCH */
1557             if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
1558                 goto done;
1559             }
1560             for (itemPtr = TagSearchFirst(searchPtr);
1561                     itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1562 #endif /* USE_OLD_TAG_SEARCH */
1563                 prevPtr = itemPtr;
1564             }
1565             if (prevPtr == NULL) {
1566                 Tcl_AppendResult(interp, "tagOrId \"", Tcl_GetStringFromObj(argv[3], NULL),
1567                         "\" doesn't match any items", (char *) NULL);
1568                 result = TCL_ERROR;
1569                 goto done;
1570             }
1571         }
1572 #ifdef USE_OLD_TAG_SEARCH
1573         RelinkItems(canvasPtr, argv[2], prevPtr);
1574 #else /* USE_OLD_TAG_SEARCH */
1575         result = RelinkItems(canvasPtr, argv[2], prevPtr, &searchPtr);
1576         if (result != TCL_OK) {
1577             goto done;
1578         }
1579 #endif /* USE_OLD_TAG_SEARCH */
1580         break;
1581       }
1582       case CANV_SCALE: {
1583         double xOrigin, yOrigin, xScale, yScale;
1584
1585         if (argc != 7) {
1586             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xOrigin yOrigin xScale yScale");
1587             result = TCL_ERROR;
1588             goto done;
1589         }
1590         if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
1591                     argv[3], &xOrigin) != TCL_OK)
1592                 || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
1593                     argv[4], &yOrigin) != TCL_OK)
1594                 || (Tcl_GetDoubleFromObj(interp, argv[5], &xScale) != TCL_OK)
1595                 || (Tcl_GetDoubleFromObj(interp, argv[6], &yScale) != TCL_OK)) {
1596             result = TCL_ERROR;
1597             goto done;
1598         }
1599         if ((xScale == 0.0) || (yScale == 0.0)) {
1600             Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC);
1601             result = TCL_ERROR;
1602             goto done;
1603         }
1604 #ifdef USE_OLD_TAG_SEARCH
1605         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1606                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1607 #else /* USE_OLD_TAG_SEARCH */
1608         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1609             goto done;
1610         }
1611         for (itemPtr = TagSearchFirst(searchPtr);
1612                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1613 #endif /* USE_OLD_TAG_SEARCH */
1614             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1615             (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr,
1616                     itemPtr, xOrigin, yOrigin, xScale, yScale);
1617             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1618             canvasPtr->flags |= REPICK_NEEDED;
1619         }
1620         break;
1621       }
1622       case CANV_SCAN: {
1623         int x, y, gain=10;
1624         static char *optionStrings[] = {
1625             "mark", "dragto", NULL
1626         };
1627
1628         if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings, "scan option", 0,
1629                 &index) != TCL_OK) {
1630             return TCL_ERROR;
1631         }
1632
1633         if ((argc != 5) && (argc != 5+index)) {
1634             Tcl_WrongNumArgs(interp, 3, argv, index?"x y ?gain?":"x y");
1635             result = TCL_ERROR;
1636             goto done;
1637         }
1638         if ((Tcl_GetIntFromObj(interp, argv[3], &x) != TCL_OK)
1639                 || (Tcl_GetIntFromObj(interp, argv[4], &y) != TCL_OK)){
1640             result = TCL_ERROR;
1641             goto done;
1642         }
1643         if ((argc == 6) && (Tcl_GetIntFromObj(interp, argv[5], &gain) != TCL_OK)) {
1644             result = TCL_ERROR;
1645             goto done;
1646         }
1647         if (!index) {
1648             canvasPtr->scanX = x;
1649             canvasPtr->scanXOrigin = canvasPtr->xOrigin;
1650             canvasPtr->scanY = y;
1651             canvasPtr->scanYOrigin = canvasPtr->yOrigin;
1652         } else {
1653             int newXOrigin, newYOrigin, tmp;
1654
1655             /*
1656              * Compute a new view origin for the canvas, amplifying the
1657              * mouse motion.
1658              */
1659
1660             tmp = canvasPtr->scanXOrigin - gain*(x - canvasPtr->scanX)
1661                     - canvasPtr->scrollX1;
1662             newXOrigin = canvasPtr->scrollX1 + tmp;
1663             tmp = canvasPtr->scanYOrigin - gain*(y - canvasPtr->scanY)
1664                     - canvasPtr->scrollY1;
1665             newYOrigin = canvasPtr->scrollY1 + tmp;
1666             CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin);
1667         }
1668         break;
1669       }
1670       case CANV_SELECT: {
1671         int index, optionindex;
1672         static char *optionStrings[] = {
1673             "adjust", "clear", "from", "item", "to", NULL
1674         };
1675         enum options {
1676             CANV_ADJUST, CANV_CLEAR, CANV_FROM, CANV_ITEM, CANV_TO
1677         };
1678
1679         if (argc < 3) {
1680             Tcl_WrongNumArgs(interp, 2, argv, "option ?tagOrId? ?arg?");
1681             result = TCL_ERROR;
1682             goto done;
1683         }
1684         if (argc >= 4) {
1685 #ifdef USE_OLD_TAG_SEARCH
1686             for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
1687                     itemPtr != NULL; itemPtr = NextItem(&search)) {
1688 #else /* USE_OLD_TAG_SEARCH */
1689             if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
1690                 goto done;
1691             }
1692             for (itemPtr = TagSearchFirst(searchPtr);
1693                     itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1694 #endif /* USE_OLD_TAG_SEARCH */
1695                 if ((itemPtr->typePtr->indexProc != NULL)
1696                         && (itemPtr->typePtr->selectionProc != NULL)){
1697                     break;
1698                 }
1699             }
1700             if (itemPtr == NULL) {
1701                 Tcl_AppendResult(interp,
1702                         "can't find an indexable and selectable item \"",
1703                         Tcl_GetStringFromObj(argv[3], NULL), "\"", (char *) NULL);
1704                 result = TCL_ERROR;
1705                 goto done;
1706             }
1707         }
1708         if (argc == 5) {
1709             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1710                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1711                         itemPtr, (char *) argv[4], &index);
1712             } else {
1713                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1714                         itemPtr, Tcl_GetStringFromObj(argv[4], NULL), &index);
1715             }
1716             if (result != TCL_OK) {
1717                 goto done;
1718             }
1719         }
1720         if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings, "select option", 0,
1721                 &optionindex) != TCL_OK) {
1722             return TCL_ERROR;
1723         }
1724         switch ((enum options) optionindex) {
1725           case CANV_ADJUST: {
1726             if (argc != 5) {
1727                 Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
1728                 result = TCL_ERROR;
1729                 goto done;
1730             }
1731             if (canvasPtr->textInfo.selItemPtr == itemPtr) {
1732                 if (index < (canvasPtr->textInfo.selectFirst
1733                         + canvasPtr->textInfo.selectLast)/2) {
1734                     canvasPtr->textInfo.selectAnchor =
1735                             canvasPtr->textInfo.selectLast + 1;
1736                 } else {
1737                     canvasPtr->textInfo.selectAnchor =
1738                             canvasPtr->textInfo.selectFirst;
1739                 }
1740             }
1741             CanvasSelectTo(canvasPtr, itemPtr, index);
1742             break;
1743           }
1744           case CANV_CLEAR: {
1745             if (argc != 3) {
1746                 Tcl_AppendResult(interp, 3, argv, (char *) NULL);
1747                 result = TCL_ERROR;
1748                 goto done;
1749             }
1750             if (canvasPtr->textInfo.selItemPtr != NULL) {
1751                 EventuallyRedrawItem((Tk_Canvas) canvasPtr,
1752                         canvasPtr->textInfo.selItemPtr);
1753                 canvasPtr->textInfo.selItemPtr = NULL;
1754             }
1755             goto done;
1756             break;
1757           }
1758           case CANV_FROM: {
1759             if (argc != 5) {
1760                 Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
1761                 result = TCL_ERROR;
1762                 goto done;
1763             }
1764             canvasPtr->textInfo.anchorItemPtr = itemPtr;
1765             canvasPtr->textInfo.selectAnchor = index;
1766             break;
1767           }
1768           case CANV_ITEM: {
1769             if (argc != 3) {
1770                 Tcl_WrongNumArgs(interp, 3, argv, (char *) NULL);
1771                 result = TCL_ERROR;
1772                 goto done;
1773             }
1774             if (canvasPtr->textInfo.selItemPtr != NULL) {
1775                 char buf[TCL_INTEGER_SPACE];
1776                 
1777                 sprintf(buf, "%d", canvasPtr->textInfo.selItemPtr->id);
1778                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1779             }
1780             break;
1781           }
1782           case CANV_TO: {
1783             if (argc != 5) {
1784                 Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
1785                 result = TCL_ERROR;
1786                 goto done;
1787             }
1788             CanvasSelectTo(canvasPtr, itemPtr, index);
1789             break;
1790           }
1791         }
1792         break;
1793       }
1794       case CANV_TYPE: {
1795         if (argc != 3) {
1796             Tcl_WrongNumArgs(interp, 2, argv, "tag");
1797             result = TCL_ERROR;
1798             goto done;
1799         }
1800 #ifdef USE_OLD_TAG_SEARCH
1801         itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1802 #else /* USE_OLD_TAG_SEARCH */
1803         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1804             goto done;
1805         }
1806         itemPtr = TagSearchFirst(searchPtr);
1807 #endif /* USE_OLD_TAG_SEARCH */
1808         if (itemPtr != NULL) {
1809             Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC);
1810         }
1811         break;
1812       }
1813       case CANV_XVIEW: {
1814         int count, type;
1815         int newX = 0;           /* Initialization needed only to prevent
1816                                  * gcc warnings. */
1817         double fraction;
1818
1819         if (argc == 2) {
1820             PrintScrollFractions(canvasPtr->xOrigin + canvasPtr->inset,
1821                     canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
1822                     - canvasPtr->inset, canvasPtr->scrollX1,
1823                     canvasPtr->scrollX2, Tcl_GetStringResult(interp));
1824         } else {
1825             char **args = GetStringsFromObjs(argc, argv);
1826             type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
1827             if (args) ckfree((char *) args);
1828             switch (type) {
1829                 case TK_SCROLL_ERROR:
1830                     result = TCL_ERROR;
1831                     goto done;
1832                 case TK_SCROLL_MOVETO:
1833                     newX = canvasPtr->scrollX1 - canvasPtr->inset
1834                             + (int) (fraction * (canvasPtr->scrollX2
1835                             - canvasPtr->scrollX1) + 0.5);
1836                     break;
1837                 case TK_SCROLL_PAGES:
1838                     newX = (int) (canvasPtr->xOrigin + count * .9
1839                             * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset));
1840                     break;
1841                 case TK_SCROLL_UNITS:
1842                     if (canvasPtr->xScrollIncrement > 0) {
1843                         newX = canvasPtr->xOrigin
1844                                 + count*canvasPtr->xScrollIncrement;
1845                     } else {
1846                         newX = (int) (canvasPtr->xOrigin + count * .1
1847                                 * (Tk_Width(canvasPtr->tkwin)
1848                                 - 2*canvasPtr->inset));
1849                     }
1850                     break;
1851             }
1852             CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin);
1853         }
1854         break;
1855       }
1856       case CANV_YVIEW: {
1857         int count, type;
1858         int newY = 0;           /* Initialization needed only to prevent
1859                                  * gcc warnings. */
1860         double fraction;
1861
1862         if (argc == 2) {
1863             PrintScrollFractions(canvasPtr->yOrigin + canvasPtr->inset,
1864                     canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
1865                     - canvasPtr->inset, canvasPtr->scrollY1,
1866                     canvasPtr->scrollY2, Tcl_GetStringResult(interp));
1867         } else {
1868             char **args = GetStringsFromObjs(argc, argv);
1869             type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
1870             if (args) ckfree((char *) args);
1871             switch (type) {
1872                 case TK_SCROLL_ERROR:
1873                     result = TCL_ERROR;
1874                     goto done;
1875                 case TK_SCROLL_MOVETO:
1876                     newY = canvasPtr->scrollY1 - canvasPtr->inset
1877                             + (int) (fraction*(canvasPtr->scrollY2
1878                             - canvasPtr->scrollY1) + 0.5);
1879                     break;
1880                 case TK_SCROLL_PAGES:
1881                     newY = (int) (canvasPtr->yOrigin + count * .9
1882                             * (Tk_Height(canvasPtr->tkwin)
1883                             - 2*canvasPtr->inset));
1884                     break;
1885                 case TK_SCROLL_UNITS:
1886                     if (canvasPtr->yScrollIncrement > 0) {
1887                         newY = canvasPtr->yOrigin
1888                                 + count*canvasPtr->yScrollIncrement;
1889                     } else {
1890                         newY = (int) (canvasPtr->yOrigin + count * .1
1891                                 * (Tk_Height(canvasPtr->tkwin)
1892                                 - 2*canvasPtr->inset));
1893                     }
1894                     break;
1895             }
1896             CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY);
1897         }
1898         break;
1899       }
1900     }
1901     done:
1902 #ifndef USE_OLD_TAG_SEARCH
1903     TagSearchDestroy(searchPtr);
1904 #endif /* not USE_OLD_TAG_SEARCH */
1905     Tcl_Release((ClientData) canvasPtr);
1906     return result;
1907 }
1908 \f
1909 /*
1910  *----------------------------------------------------------------------
1911  *
1912  * DestroyCanvas --
1913  *
1914  *      This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
1915  *      to clean up the internal structure of a canvas at a safe time
1916  *      (when no-one is using it anymore).
1917  *
1918  * Results:
1919  *      None.
1920  *
1921  * Side effects:
1922  *      Everything associated with the canvas is freed up.
1923  *
1924  *----------------------------------------------------------------------
1925  */
1926
1927 static void
1928 DestroyCanvas(memPtr)
1929     char *memPtr;               /* Info about canvas widget. */
1930 {
1931     TkCanvas *canvasPtr = (TkCanvas *) memPtr;
1932     Tk_Item *itemPtr;
1933
1934     if (canvasPtr->tkwin != NULL) {
1935         Tcl_DeleteCommandFromToken(canvasPtr->interp, canvasPtr->widgetCmd);
1936     }
1937     if (canvasPtr->flags & REDRAW_PENDING) {
1938         Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr);
1939     }
1940         
1941     /*
1942      * Free up all of the items in the canvas.
1943      */
1944
1945     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
1946             itemPtr = canvasPtr->firstItemPtr) {
1947         canvasPtr->firstItemPtr = itemPtr->nextPtr;
1948         (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
1949                 canvasPtr->display);
1950         if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
1951             ckfree((char *) itemPtr->tagPtr);
1952         }
1953         ckfree((char *) itemPtr);
1954     }
1955
1956     /*
1957      * Free up all the stuff that requires special handling,
1958      * then let Tk_FreeOptions handle all the standard option-related
1959      * stuff.
1960      */
1961
1962     Tcl_DeleteHashTable(&canvasPtr->idTable);
1963     if (canvasPtr->pixmapGC != None) {
1964         Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
1965     }
1966 #ifndef USE_OLD_TAG_SEARCH
1967     {
1968         TagSearchExpr *expr, *next;
1969
1970         expr = canvasPtr->bindTagExprs;
1971         while (expr) {
1972             next = expr->next;
1973             TagSearchExprDestroy(expr);
1974             expr = next;
1975         }
1976     }
1977 #endif
1978     Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
1979     if (canvasPtr->bindingTable != NULL) {
1980         Tk_DeleteBindingTable(canvasPtr->bindingTable);
1981     }
1982     Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0);
1983     canvasPtr->tkwin = NULL;
1984     ckfree((char *) canvasPtr);
1985 }
1986 \f
1987 /*
1988  *----------------------------------------------------------------------
1989  *
1990  * ConfigureCanvas --
1991  *
1992  *      This procedure is called to process an argv/argc list, plus
1993  *      the Tk option database, in order to configure (or
1994  *      reconfigure) a canvas widget.
1995  *
1996  * Results:
1997  *      The return value is a standard Tcl result.  If TCL_ERROR is
1998  *      returned, then the interp's result contains an error message.
1999  *
2000  * Side effects:
2001  *      Configuration information, such as colors, border width,
2002  *      etc. get set for canvasPtr;  old resources get freed,
2003  *      if there were any.
2004  *
2005  *----------------------------------------------------------------------
2006  */
2007
2008 static int
2009 ConfigureCanvas(interp, canvasPtr, argc, argv, flags)
2010     Tcl_Interp *interp;         /* Used for error reporting. */
2011     TkCanvas *canvasPtr;        /* Information about widget;  may or may
2012                                  * not already have values for some fields. */
2013     int argc;                   /* Number of valid entries in argv. */
2014     Tcl_Obj *CONST argv[];      /* Argument objects. */
2015     int flags;                  /* Flags to pass to Tk_ConfigureWidget. */
2016 {
2017     XGCValues gcValues;
2018     GC new;
2019
2020     if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs,
2021             argc, (char **) argv, (char *) canvasPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
2022         return TCL_ERROR;
2023     }
2024
2025     /*
2026      * A few options need special processing, such as setting the
2027      * background from a 3-D border and creating a GC for copying
2028      * bits to the screen.
2029      */
2030
2031     Tk_SetBackgroundFromBorder(canvasPtr->tkwin, canvasPtr->bgBorder);
2032
2033     if (canvasPtr->highlightWidth < 0) {
2034         canvasPtr->highlightWidth = 0;
2035     }
2036     canvasPtr->inset = canvasPtr->borderWidth + canvasPtr->highlightWidth;
2037
2038     gcValues.function = GXcopy;
2039     gcValues.graphics_exposures = False;
2040     gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel;
2041     new = Tk_GetGC(canvasPtr->tkwin,
2042             GCFunction|GCGraphicsExposures|GCForeground, &gcValues);
2043     if (canvasPtr->pixmapGC != None) {
2044         Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
2045     }
2046     canvasPtr->pixmapGC = new;
2047
2048     /*
2049      * Reset the desired dimensions for the window.
2050      */
2051
2052     Tk_GeometryRequest(canvasPtr->tkwin, canvasPtr->width + 2*canvasPtr->inset,
2053             canvasPtr->height + 2*canvasPtr->inset);
2054
2055     /*
2056      * Restart the cursor timing sequence in case the on-time or off-time
2057      * just changed.
2058      */
2059
2060     if (canvasPtr->textInfo.gotFocus) {
2061         CanvasFocusProc(canvasPtr, 1);
2062     }
2063
2064     /*
2065      * Recompute the scroll region.
2066      */
2067
2068     canvasPtr->scrollX1 = 0;
2069     canvasPtr->scrollY1 = 0;
2070     canvasPtr->scrollX2 = 0;
2071     canvasPtr->scrollY2 = 0;
2072     if (canvasPtr->regionString != NULL) {
2073         int argc2;
2074         char **argv2;
2075
2076         if (Tcl_SplitList(canvasPtr->interp, canvasPtr->regionString,
2077                 &argc2, &argv2) != TCL_OK) {
2078             return TCL_ERROR;
2079         }
2080         if (argc2 != 4) {
2081             Tcl_AppendResult(interp, "bad scrollRegion \"",
2082                     canvasPtr->regionString, "\"", (char *) NULL);
2083             badRegion:
2084             ckfree(canvasPtr->regionString);
2085             ckfree((char *) argv2);
2086             canvasPtr->regionString = NULL;
2087             return TCL_ERROR;
2088         }
2089         if ((Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
2090                     argv2[0], &canvasPtr->scrollX1) != TCL_OK)
2091                 || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
2092                     argv2[1], &canvasPtr->scrollY1) != TCL_OK)
2093                 || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
2094                     argv2[2], &canvasPtr->scrollX2) != TCL_OK)
2095                 || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
2096                     argv2[3], &canvasPtr->scrollY2) != TCL_OK)) {
2097             goto badRegion;
2098         }
2099         ckfree((char *) argv2);
2100     }
2101
2102     flags = canvasPtr->tsoffset.flags;
2103     if (flags & TK_OFFSET_LEFT) {
2104         canvasPtr->tsoffset.xoffset = 0;
2105     } else if (flags & TK_OFFSET_CENTER) {
2106         canvasPtr->tsoffset.xoffset = canvasPtr->width/2;
2107     } else if (flags & TK_OFFSET_RIGHT) {
2108         canvasPtr->tsoffset.xoffset = canvasPtr->width;
2109     }
2110     if (flags & TK_OFFSET_TOP) {
2111         canvasPtr->tsoffset.yoffset = 0;
2112     } else if (flags & TK_OFFSET_MIDDLE) {
2113         canvasPtr->tsoffset.yoffset = canvasPtr->height/2;
2114     } else if (flags & TK_OFFSET_BOTTOM) {
2115         canvasPtr->tsoffset.yoffset = canvasPtr->height;
2116     }
2117
2118     /*
2119      * Reset the canvas's origin (this is a no-op unless confine
2120      * mode has just been turned on or the scroll region has changed).
2121      */
2122
2123     CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
2124     canvasPtr->flags |= UPDATE_SCROLLBARS|REDRAW_BORDERS;
2125     Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
2126             canvasPtr->xOrigin, canvasPtr->yOrigin,
2127             canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
2128             canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
2129     return TCL_OK;
2130 }
2131 \f
2132 /*
2133  *---------------------------------------------------------------------------
2134  *
2135  * CanvasWorldChanged --
2136  *
2137  *      This procedure is called when the world has changed in some
2138  *      way and the widget needs to recompute all its graphics contexts
2139  *      and determine its new geometry.
2140  *
2141  * Results:
2142  *      None.
2143  *
2144  * Side effects:
2145  *      Configures all items in the canvas with a empty argc/argv, for
2146  *      the side effect of causing all the items to recompute their
2147  *      geometry and to be redisplayed.
2148  *
2149  *---------------------------------------------------------------------------
2150  */
2151  
2152 static void
2153 CanvasWorldChanged(instanceData)
2154     ClientData instanceData;    /* Information about widget. */
2155 {
2156     TkCanvas *canvasPtr;
2157     Tk_Item *itemPtr;
2158     int result;
2159
2160     canvasPtr = (TkCanvas *) instanceData;
2161     itemPtr = canvasPtr->firstItemPtr;
2162     for ( ; itemPtr != NULL; itemPtr = itemPtr->nextPtr) {
2163         result = (*itemPtr->typePtr->configProc)(canvasPtr->interp,
2164                 (Tk_Canvas) canvasPtr, itemPtr, 0, NULL,
2165                 TK_CONFIG_ARGV_ONLY);
2166         if (result != TCL_OK) {
2167             Tcl_ResetResult(canvasPtr->interp);
2168         }
2169     }
2170     canvasPtr->flags |= REPICK_NEEDED;
2171     Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
2172             canvasPtr->xOrigin, canvasPtr->yOrigin,
2173             canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
2174             canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
2175 }
2176 \f
2177 /*
2178  *--------------------------------------------------------------
2179  *
2180  * DisplayCanvas --
2181  *
2182  *      This procedure redraws the contents of a canvas window.
2183  *      It is invoked as a do-when-idle handler, so it only runs
2184  *      when there's nothing else for the application to do.
2185  *
2186  * Results:
2187  *      None.
2188  *
2189  * Side effects:
2190  *      Information appears on the screen.
2191  *
2192  *--------------------------------------------------------------
2193  */
2194
2195 static void
2196 DisplayCanvas(clientData)
2197     ClientData clientData;      /* Information about widget. */
2198 {
2199     TkCanvas *canvasPtr = (TkCanvas *) clientData;
2200     Tk_Window tkwin = canvasPtr->tkwin;
2201     Tk_Item *itemPtr;
2202     Pixmap pixmap;
2203     int screenX1, screenX2, screenY1, screenY2, width, height;
2204
2205     if (canvasPtr->tkwin == NULL) {
2206         return;
2207     }
2208
2209     if (!Tk_IsMapped(tkwin)) {
2210         goto done;
2211     }
2212
2213     /*
2214      * Choose a new current item if that is needed (this could cause
2215      * event handlers to be invoked).
2216      */
2217
2218     while (canvasPtr->flags & REPICK_NEEDED) {
2219         Tcl_Preserve((ClientData) canvasPtr);
2220         canvasPtr->flags &= ~REPICK_NEEDED;
2221         PickCurrentItem(canvasPtr, &canvasPtr->pickEvent);
2222         tkwin = canvasPtr->tkwin;
2223         Tcl_Release((ClientData) canvasPtr);
2224         if (tkwin == NULL) {
2225             return;
2226         }
2227     }
2228
2229     /*
2230      * Scan through the item list, registering the bounding box
2231      * for all items that didn't do that for the final coordinates
2232      * yet. This can be determined by the FORCE_REDRAW flag.
2233      */
2234
2235     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
2236                 itemPtr = itemPtr->nextPtr) {
2237         if (itemPtr->redraw_flags & FORCE_REDRAW) {
2238             itemPtr->redraw_flags &= ~FORCE_REDRAW;
2239             EventuallyRedrawItem((Tk_Canvas)canvasPtr, itemPtr);
2240             itemPtr->redraw_flags &= ~FORCE_REDRAW;
2241         }
2242     }
2243     /*
2244      * Compute the intersection between the area that needs redrawing
2245      * and the area that's visible on the screen.
2246      */
2247
2248     if ((canvasPtr->redrawX1 < canvasPtr->redrawX2)
2249             && (canvasPtr->redrawY1 < canvasPtr->redrawY2)) {
2250         screenX1 = canvasPtr->xOrigin + canvasPtr->inset;
2251         screenY1 = canvasPtr->yOrigin + canvasPtr->inset;
2252         screenX2 = canvasPtr->xOrigin + Tk_Width(tkwin) - canvasPtr->inset;
2253         screenY2 = canvasPtr->yOrigin + Tk_Height(tkwin) - canvasPtr->inset;
2254         if (canvasPtr->redrawX1 > screenX1) {
2255             screenX1 = canvasPtr->redrawX1;
2256         }
2257         if (canvasPtr->redrawY1 > screenY1) {
2258             screenY1 = canvasPtr->redrawY1;
2259         }
2260         if (canvasPtr->redrawX2 < screenX2) {
2261             screenX2 = canvasPtr->redrawX2;
2262         }
2263         if (canvasPtr->redrawY2 < screenY2) {
2264             screenY2 = canvasPtr->redrawY2;
2265         }
2266         if ((screenX1 >= screenX2) || (screenY1 >= screenY2)) {
2267             goto borders;
2268         }
2269     
2270         /*
2271          * Redrawing is done in a temporary pixmap that is allocated
2272          * here and freed at the end of the procedure.  All drawing
2273          * is done to the pixmap, and the pixmap is copied to the
2274          * screen at the end of the procedure. The temporary pixmap
2275          * serves two purposes:
2276          *
2277          * 1. It provides a smoother visual effect (no clearing and
2278          *    gradual redraw will be visible to users).
2279          * 2. It allows us to redraw only the objects that overlap
2280          *    the redraw area.  Otherwise incorrect results could
2281          *        occur from redrawing things that stick outside of
2282          *        the redraw area (we'd have to redraw everything in
2283          *    order to make the overlaps look right).
2284          *
2285          * Some tricky points about the pixmap:
2286          *
2287          * 1. We only allocate a large enough pixmap to hold the
2288          *    area that has to be redisplayed.  This saves time in
2289          *    in the X server for large objects that cover much
2290          *    more than the area being redisplayed:  only the area
2291          *    of the pixmap will actually have to be redrawn.
2292          * 2. Some X servers (e.g. the one for DECstations) have troubles
2293          *    with characters that overlap an edge of the pixmap (on the
2294          *    DEC servers, as of 8/18/92, such characters are drawn one
2295          *    pixel too far to the right).  To handle this problem,
2296          *    make the pixmap a bit larger than is absolutely needed
2297          *    so that for normal-sized fonts the characters that overlap
2298          *    the edge of the pixmap will be outside the area we care
2299          *    about.
2300          */
2301     
2302         canvasPtr->drawableXOrigin = screenX1 - 30;
2303         canvasPtr->drawableYOrigin = screenY1 - 30;
2304         pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
2305             (screenX2 + 30 - canvasPtr->drawableXOrigin),
2306             (screenY2 + 30 - canvasPtr->drawableYOrigin),
2307             Tk_Depth(tkwin));
2308     
2309         /*
2310          * Clear the area to be redrawn.
2311          */
2312     
2313         width = screenX2 - screenX1;
2314         height = screenY2 - screenY1;
2315     
2316         XFillRectangle(Tk_Display(tkwin), pixmap, canvasPtr->pixmapGC,
2317                 screenX1 - canvasPtr->drawableXOrigin,
2318                 screenY1 - canvasPtr->drawableYOrigin, (unsigned int) width,
2319                 (unsigned int) height);
2320     
2321         /*
2322          * Scan through the item list, redrawing those items that need it.
2323          * An item must be redraw if either (a) it intersects the smaller
2324          * on-screen area or (b) it intersects the full canvas area and its
2325          * type requests that it be redrawn always (e.g. so subwindows can
2326          * be unmapped when they move off-screen).
2327          */
2328     
2329         for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
2330                 itemPtr = itemPtr->nextPtr) {
2331             if ((itemPtr->x1 >= screenX2)
2332                     || (itemPtr->y1 >= screenY2)
2333                     || (itemPtr->x2 < screenX1)
2334                     || (itemPtr->y2 < screenY1)) {
2335                 if (!(itemPtr->typePtr->alwaysRedraw & 1)
2336                         || (itemPtr->x1 >= canvasPtr->redrawX2)
2337                         || (itemPtr->y1 >= canvasPtr->redrawY2)
2338                         || (itemPtr->x2 < canvasPtr->redrawX1)
2339                         || (itemPtr->y2 < canvasPtr->redrawY1)) {
2340                     continue;
2341                 }
2342             }
2343             if (itemPtr->state == TK_STATE_HIDDEN ||
2344                 (itemPtr->state == TK_STATE_NULL &&
2345                  canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
2346                 continue;
2347             }
2348             (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, itemPtr,
2349                     canvasPtr->display, pixmap, screenX1, screenY1, width,
2350                     height);
2351         }
2352     
2353         /*
2354          * Copy from the temporary pixmap to the screen, then free up
2355          * the temporary pixmap.
2356          */
2357     
2358         XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin),
2359                 canvasPtr->pixmapGC,
2360                 screenX1 - canvasPtr->drawableXOrigin,
2361                 screenY1 - canvasPtr->drawableYOrigin,
2362                 (unsigned) (screenX2 - screenX1),
2363                 (unsigned) (screenY2 - screenY1),
2364                 screenX1 - canvasPtr->xOrigin, screenY1 - canvasPtr->yOrigin);
2365         Tk_FreePixmap(Tk_Display(tkwin), pixmap);
2366     }
2367
2368     /*
2369      * Draw the window borders, if needed.
2370      */
2371
2372     borders:
2373     if (canvasPtr->flags & REDRAW_BORDERS) {
2374         canvasPtr->flags &= ~REDRAW_BORDERS;
2375         if (canvasPtr->borderWidth > 0) {
2376             Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin),
2377                     canvasPtr->bgBorder, canvasPtr->highlightWidth,
2378                     canvasPtr->highlightWidth,
2379                     Tk_Width(tkwin) - 2*canvasPtr->highlightWidth,
2380                     Tk_Height(tkwin) - 2*canvasPtr->highlightWidth,
2381                     canvasPtr->borderWidth, canvasPtr->relief);
2382         }
2383         if (canvasPtr->highlightWidth != 0) {
2384             GC fgGC, bgGC;
2385
2386             bgGC = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
2387                     Tk_WindowId(tkwin));
2388             if (canvasPtr->textInfo.gotFocus) {
2389                 fgGC = Tk_GCForColor(canvasPtr->highlightColorPtr,
2390                         Tk_WindowId(tkwin));
2391                 TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
2392                         canvasPtr->highlightWidth, Tk_WindowId(tkwin));
2393             } else {
2394                 TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
2395                         canvasPtr->highlightWidth, Tk_WindowId(tkwin));
2396             }
2397         }
2398     }
2399
2400     done:
2401     canvasPtr->flags &= ~(REDRAW_PENDING|BBOX_NOT_EMPTY);
2402     canvasPtr->redrawX1 = canvasPtr->redrawX2 = 0;
2403     canvasPtr->redrawY1 = canvasPtr->redrawY2 = 0;
2404     if (canvasPtr->flags & UPDATE_SCROLLBARS) {
2405         CanvasUpdateScrollbars(canvasPtr);
2406     }
2407 }
2408 \f
2409 /*
2410  *--------------------------------------------------------------
2411  *
2412  * CanvasEventProc --
2413  *
2414  *      This procedure is invoked by the Tk dispatcher for various
2415  *      events on canvases.
2416  *
2417  * Results:
2418  *      None.
2419  *
2420  * Side effects:
2421  *      When the window gets deleted, internal structures get
2422  *      cleaned up.  When it gets exposed, it is redisplayed.
2423  *
2424  *--------------------------------------------------------------
2425  */
2426
2427 static void
2428 CanvasEventProc(clientData, eventPtr)
2429     ClientData clientData;      /* Information about window. */
2430     XEvent *eventPtr;           /* Information about event. */
2431 {
2432     TkCanvas *canvasPtr = (TkCanvas *) clientData;
2433
2434     if (eventPtr->type == Expose) {
2435         int x, y;
2436
2437         x = eventPtr->xexpose.x + canvasPtr->xOrigin;
2438         y = eventPtr->xexpose.y + canvasPtr->yOrigin;
2439         Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x, y,
2440                 x + eventPtr->xexpose.width,
2441                 y + eventPtr->xexpose.height);
2442         if ((eventPtr->xexpose.x < canvasPtr->inset)
2443                 || (eventPtr->xexpose.y < canvasPtr->inset)
2444                 || ((eventPtr->xexpose.x + eventPtr->xexpose.width)
2445                     > (Tk_Width(canvasPtr->tkwin) - canvasPtr->inset))
2446                 || ((eventPtr->xexpose.y + eventPtr->xexpose.height)
2447                     > (Tk_Height(canvasPtr->tkwin) - canvasPtr->inset))) {
2448             canvasPtr->flags |= REDRAW_BORDERS;
2449         }
2450     } else if (eventPtr->type == DestroyNotify) {
2451         DestroyCanvas((char *) canvasPtr);
2452     } else if (eventPtr->type == ConfigureNotify) {
2453         canvasPtr->flags |= UPDATE_SCROLLBARS;
2454
2455         /*
2456          * The call below is needed in order to recenter the canvas if
2457          * it's confined and its scroll region is smaller than the window.
2458          */
2459
2460         CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
2461         Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, canvasPtr->xOrigin,
2462                 canvasPtr->yOrigin,
2463                 canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
2464                 canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
2465         canvasPtr->flags |= REDRAW_BORDERS;
2466     } else if (eventPtr->type == FocusIn) {
2467         if (eventPtr->xfocus.detail != NotifyInferior) {
2468             CanvasFocusProc(canvasPtr, 1);
2469         }
2470     } else if (eventPtr->type == FocusOut) {
2471         if (eventPtr->xfocus.detail != NotifyInferior) {
2472             CanvasFocusProc(canvasPtr, 0);
2473         }
2474     } else if (eventPtr->type == UnmapNotify) {
2475         Tk_Item *itemPtr;
2476
2477         /*
2478          * Special hack:  if the canvas is unmapped, then must notify
2479          * all items with "alwaysRedraw" set, so that they know that
2480          * they are no longer displayed.
2481          */
2482
2483         for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
2484                 itemPtr = itemPtr->nextPtr) {
2485             if (itemPtr->typePtr->alwaysRedraw & 1) {
2486                 (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr,
2487                         itemPtr, canvasPtr->display, None, 0, 0, 0, 0);
2488             }
2489         }
2490     }
2491 }
2492 \f
2493 /*
2494  *----------------------------------------------------------------------
2495  *
2496  * CanvasCmdDeletedProc --
2497  *
2498  *      This procedure is invoked when a widget command is deleted.  If
2499  *      the widget isn't already in the process of being destroyed,
2500  *      this command destroys it.
2501  *
2502  * Results:
2503  *      None.
2504  *
2505  * Side effects:
2506  *      The widget is destroyed.
2507  *
2508  *----------------------------------------------------------------------
2509  */
2510
2511 static void
2512 CanvasCmdDeletedProc(clientData)
2513     ClientData clientData;      /* Pointer to widget record for widget. */
2514 {
2515     TkCanvas *canvasPtr = (TkCanvas *) clientData;
2516     Tk_Window tkwin = canvasPtr->tkwin;
2517
2518     /*
2519      * This procedure could be invoked either because the window was
2520      * destroyed and the command was then deleted (in which case tkwin
2521      * is NULL) or because the command was deleted, and then this procedure
2522      * destroys the widget.
2523      */
2524
2525     if (tkwin != NULL) {
2526         canvasPtr->tkwin = NULL;
2527         Tk_DestroyWindow(tkwin);
2528     }
2529 }
2530 \f
2531 /*
2532  *--------------------------------------------------------------
2533  *
2534  * Tk_CanvasEventuallyRedraw --
2535  *
2536  *      Arrange for part or all of a canvas widget to redrawn at
2537  *      some convenient time in the future.
2538  *
2539  * Results:
2540  *      None.
2541  *
2542  * Side effects:
2543  *      The screen will eventually be refreshed.
2544  *
2545  *--------------------------------------------------------------
2546  */
2547
2548 void
2549 Tk_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2)
2550     Tk_Canvas canvas;           /* Information about widget. */
2551     int x1, y1;                 /* Upper left corner of area to redraw.
2552                                  * Pixels on edge are redrawn. */
2553     int x2, y2;                 /* Lower right corner of area to redraw.
2554                                  * Pixels on edge are not redrawn. */
2555 {
2556     TkCanvas *canvasPtr = (TkCanvas *) canvas;
2557     /*
2558      * If tkwin is NULL, the canvas has been destroyed, so we can't really
2559      * redraw it.
2560      */
2561     if (canvasPtr->tkwin == NULL) {
2562         return;
2563     }
2564
2565     if ((x1 >= x2) || (y1 >= y2) ||
2566             (x2 < canvasPtr->xOrigin) || (y2 < canvasPtr->yOrigin) ||
2567             (x1 >= canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)) ||
2568             (y1 >= canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin))) {
2569         return;
2570     }
2571     if (canvasPtr->flags & BBOX_NOT_EMPTY) {
2572         if (x1 <= canvasPtr->redrawX1) {
2573             canvasPtr->redrawX1 = x1;
2574         }
2575         if (y1 <= canvasPtr->redrawY1) {
2576             canvasPtr->redrawY1 = y1;
2577         }
2578         if (x2 >= canvasPtr->redrawX2) {
2579             canvasPtr->redrawX2 = x2;
2580         }
2581         if (y2 >= canvasPtr->redrawY2) {
2582             canvasPtr->redrawY2 = y2;
2583         }
2584     } else {
2585         canvasPtr->redrawX1 = x1;
2586         canvasPtr->redrawY1 = y1;
2587         canvasPtr->redrawX2 = x2;
2588         canvasPtr->redrawY2 = y2;
2589         canvasPtr->flags |= BBOX_NOT_EMPTY;
2590     }
2591     if (!(canvasPtr->flags & REDRAW_PENDING)) {
2592         Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
2593         canvasPtr->flags |= REDRAW_PENDING;
2594     }
2595 }
2596 \f
2597 /*
2598  *--------------------------------------------------------------
2599  *
2600  * EventuallyRedrawItem --
2601  *
2602  *      Arrange for part or all of a canvas widget to redrawn at
2603  *      some convenient time in the future.
2604  *
2605  * Results:
2606  *      None.
2607  *
2608  * Side effects:
2609  *      The screen will eventually be refreshed.
2610  *
2611  *--------------------------------------------------------------
2612  */
2613
2614 static void
2615 EventuallyRedrawItem(canvas, itemPtr)
2616     Tk_Canvas canvas;           /* Information about widget. */
2617     Tk_Item *itemPtr;           /* item to be redrawn. */
2618 {
2619     TkCanvas *canvasPtr = (TkCanvas *) canvas;
2620     if ((itemPtr->x1 >= itemPtr->x2) || (itemPtr->y1 >= itemPtr->y2) ||
2621             (itemPtr->x2 < canvasPtr->xOrigin) ||
2622             (itemPtr->y2 < canvasPtr->yOrigin) ||
2623             (itemPtr->x1 >= canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)) ||
2624             (itemPtr->y1 >= canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin))) {
2625         if (!(itemPtr->typePtr->alwaysRedraw & 1)) {
2626             return;
2627         }
2628     }
2629     if (!(itemPtr->redraw_flags & FORCE_REDRAW)) {
2630         if (canvasPtr->flags & BBOX_NOT_EMPTY) {
2631             if (itemPtr->x1 <= canvasPtr->redrawX1) {
2632                 canvasPtr->redrawX1 = itemPtr->x1;
2633             }
2634             if (itemPtr->y1 <= canvasPtr->redrawY1) {
2635                 canvasPtr->redrawY1 = itemPtr->y1;
2636             }
2637             if (itemPtr->x2 >= canvasPtr->redrawX2) {
2638                 canvasPtr->redrawX2 = itemPtr->x2;
2639             }
2640             if (itemPtr->y2 >= canvasPtr->redrawY2) {
2641                 canvasPtr->redrawY2 = itemPtr->y2;
2642             }
2643         } else {
2644             canvasPtr->redrawX1 = itemPtr->x1;
2645             canvasPtr->redrawY1 = itemPtr->y1;
2646             canvasPtr->redrawX2 = itemPtr->x2;
2647             canvasPtr->redrawY2 = itemPtr->y2;
2648             canvasPtr->flags |= BBOX_NOT_EMPTY;
2649         }
2650         itemPtr->redraw_flags |= FORCE_REDRAW;
2651     }
2652     if (!(canvasPtr->flags & REDRAW_PENDING)) {
2653         Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
2654         canvasPtr->flags |= REDRAW_PENDING;
2655     }
2656 }
2657 \f
2658 /*
2659  *--------------------------------------------------------------
2660  *
2661  * Tk_CreateItemType --
2662  *
2663  *      This procedure may be invoked to add a new kind of canvas
2664  *      element to the core item types supported by Tk.
2665  *
2666  * Results:
2667  *      None.
2668  *
2669  * Side effects:
2670  *      From now on, the new item type will be useable in canvas
2671  *      widgets (e.g. typePtr->name can be used as the item type
2672  *      in "create" widget commands).  If there was already a
2673  *      type with the same name as in typePtr, it is replaced with
2674  *      the new type.
2675  *
2676  *--------------------------------------------------------------
2677  */
2678
2679 void
2680 Tk_CreateItemType(typePtr)
2681     Tk_ItemType *typePtr;               /* Information about item type;
2682                                          * storage must be statically
2683                                          * allocated (must live forever). */
2684 {
2685     Tk_ItemType *typePtr2, *prevPtr;
2686
2687     if (typeList == NULL) {
2688         InitCanvas();
2689     }
2690
2691     /*
2692      * If there's already an item type with the given name, remove it.
2693      */
2694
2695     for (typePtr2 = typeList, prevPtr = NULL; typePtr2 != NULL;
2696             prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
2697         if (strcmp(typePtr2->name, typePtr->name) == 0) {
2698             if (prevPtr == NULL) {
2699                 typeList = typePtr2->nextPtr;
2700             } else {
2701                 prevPtr->nextPtr = typePtr2->nextPtr;
2702             }
2703             break;
2704         }
2705     }
2706     typePtr->nextPtr = typeList;
2707     typeList = typePtr;
2708 }
2709 \f
2710 /*
2711  *----------------------------------------------------------------------
2712  *
2713  * Tk_GetItemTypes --
2714  *
2715  *      This procedure returns a pointer to the list of all item
2716  *      types.
2717  *
2718  * Results:
2719  *      The return value is a pointer to the first in the list
2720  *      of item types currently supported by canvases.
2721  *
2722  * Side effects:
2723  *      None.
2724  *
2725  *----------------------------------------------------------------------
2726  */
2727
2728 Tk_ItemType *
2729 Tk_GetItemTypes()
2730 {
2731     if (typeList == NULL) {
2732         InitCanvas();
2733     }
2734     return typeList;
2735 }
2736 \f
2737 /*
2738  *--------------------------------------------------------------
2739  *
2740  * InitCanvas --
2741  *
2742  *      This procedure is invoked to perform once-only-ever
2743  *      initialization for the module, such as setting up
2744  *      the type table.
2745  *
2746  * Results:
2747  *      None.
2748  *
2749  * Side effects:
2750  *      None.
2751  *
2752  *--------------------------------------------------------------
2753  */
2754
2755 static void
2756 InitCanvas()
2757 {
2758     if (typeList != NULL) {
2759         return;
2760     }
2761     typeList = &tkRectangleType;
2762     tkRectangleType.nextPtr = &tkTextType;
2763     tkTextType.nextPtr = &tkLineType;
2764     tkLineType.nextPtr = &tkPolygonType;
2765     tkPolygonType.nextPtr = &tkImageType;
2766     tkImageType.nextPtr = &tkOvalType;
2767     tkOvalType.nextPtr = &tkBitmapType;
2768     tkBitmapType.nextPtr = &tkArcType;
2769     tkArcType.nextPtr = &tkWindowType;
2770     tkWindowType.nextPtr = NULL;
2771 #ifndef USE_OLD_TAG_SEARCH
2772     allUid = Tk_GetUid("all");
2773     currentUid = Tk_GetUid("current");
2774     andUid = Tk_GetUid("&&");
2775     orUid = Tk_GetUid("||");
2776     xorUid = Tk_GetUid("^");
2777     parenUid = Tk_GetUid("(");
2778     endparenUid = Tk_GetUid(")");
2779     negparenUid = Tk_GetUid("!(");
2780     tagvalUid = Tk_GetUid("!!");
2781     negtagvalUid = Tk_GetUid("!");
2782 #endif /* USE_OLD_TAG_SEARCH */
2783 }
2784 \f
2785 #ifdef USE_OLD_TAG_SEARCH
2786 /*
2787  *--------------------------------------------------------------
2788  *
2789  * StartTagSearch --
2790  *
2791  *      This procedure is called to initiate an enumeration of
2792  *      all items in a given canvas that contain a given tag.
2793  *
2794  * Results:
2795  *      The return value is a pointer to the first item in
2796  *      canvasPtr that matches tag, or NULL if there is no
2797  *      such item.  The information at *searchPtr is initialized
2798  *      such that successive calls to NextItem will return
2799  *      successive items that match tag.
2800  *
2801  * Side effects:
2802  *      SearchPtr is linked into a list of searches in progress
2803  *      on canvasPtr, so that elements can safely be deleted
2804  *      while the search is in progress.  EndTagSearch must be
2805  *      called at the end of the search to unlink searchPtr from
2806  *      this list.
2807  *
2808  *--------------------------------------------------------------
2809  */
2810
2811 static Tk_Item *
2812 StartTagSearch(canvasPtr, tagObj, searchPtr)
2813     TkCanvas *canvasPtr;                /* Canvas whose items are to be
2814                                          * searched. */
2815     Tcl_Obj *tagObj;                    /* Object giving tag value. */
2816     TagSearch *searchPtr;               /* Record describing tag search;
2817                                          * will be initialized here. */
2818 {
2819     int id;
2820     Tk_Item *itemPtr, *lastPtr;
2821     Tk_Uid *tagPtr;
2822     Tk_Uid uid;
2823     char *tag = Tcl_GetString(tagObj);
2824     int count;
2825     TkWindow *tkwin;
2826     TkDisplay *dispPtr;
2827
2828     tkwin = (TkWindow *) canvasPtr->tkwin;
2829     dispPtr = tkwin->dispPtr;
2830
2831     /*
2832      * Initialize the search.
2833      */
2834
2835     searchPtr->canvasPtr = canvasPtr;
2836     searchPtr->searchOver = 0;
2837
2838     /*
2839      * Find the first matching item in one of several ways. If the tag
2840      * is a number then it selects the single item with the matching
2841      * identifier.  In this case see if the item being requested is the
2842      * hot item, in which case the search can be skipped.
2843      */
2844
2845     if (isdigit(UCHAR(*tag))) {
2846         char *end;
2847         Tcl_HashEntry *entryPtr;
2848
2849         dispPtr->numIdSearches++;
2850         id = strtoul(tag, &end, 0);
2851         if (*end == 0) {
2852             itemPtr = canvasPtr->hotPtr;
2853             lastPtr = canvasPtr->hotPrevPtr;
2854             if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL)
2855                     || (lastPtr->nextPtr != itemPtr)) {
2856                 dispPtr->numSlowSearches++;
2857                 entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
2858                 if (entryPtr != NULL) {
2859                     itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
2860                     lastPtr = itemPtr->prevPtr;
2861                 } else {
2862                     lastPtr = itemPtr = NULL;
2863                 }
2864             }
2865             searchPtr->lastPtr = lastPtr;
2866             searchPtr->searchOver = 1;
2867             canvasPtr->hotPtr = itemPtr;
2868             canvasPtr->hotPrevPtr = lastPtr;
2869             return itemPtr;
2870         }
2871     }
2872
2873     searchPtr->tag = uid = Tk_GetUid(tag);
2874     if (uid == Tk_GetUid("all")) {
2875         /*
2876          * All items match.
2877          */
2878
2879         searchPtr->tag = NULL;
2880         searchPtr->lastPtr = NULL;
2881         searchPtr->currentPtr = canvasPtr->firstItemPtr;
2882         return canvasPtr->firstItemPtr;
2883     }
2884
2885     /*
2886      * None of the above.  Search for an item with a matching tag.
2887      */
2888
2889     for (lastPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
2890             lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
2891         for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
2892                 count > 0; tagPtr++, count--) {
2893             if (*tagPtr == uid) {
2894                 searchPtr->lastPtr = lastPtr;
2895                 searchPtr->currentPtr = itemPtr;
2896                 return itemPtr;
2897             }
2898         }
2899     }
2900     searchPtr->lastPtr = lastPtr;
2901     searchPtr->searchOver = 1;
2902     return NULL;
2903 }
2904 \f
2905 /*
2906  *--------------------------------------------------------------
2907  *
2908  * NextItem --
2909  *
2910  *      This procedure returns successive items that match a given
2911  *      tag;  it should be called only after StartTagSearch has been
2912  *      used to begin a search.
2913  *
2914  * Results:
2915  *      The return value is a pointer to the next item that matches
2916  *      the tag specified to StartTagSearch, or NULL if no such
2917  *      item exists.  *SearchPtr is updated so that the next call
2918  *      to this procedure will return the next item.
2919  *
2920  * Side effects:
2921  *      None.
2922  *
2923  *--------------------------------------------------------------
2924  */
2925
2926 static Tk_Item *
2927 NextItem(searchPtr)
2928     TagSearch *searchPtr;               /* Record describing search in
2929                                          * progress. */
2930 {
2931     Tk_Item *itemPtr, *lastPtr;
2932     int count;
2933     Tk_Uid uid;
2934     Tk_Uid *tagPtr;
2935
2936     /*
2937      * Find next item in list (this may not actually be a suitable
2938      * one to return), and return if there are no items left.
2939      */
2940
2941     lastPtr = searchPtr->lastPtr;
2942     if (lastPtr == NULL) {
2943         itemPtr = searchPtr->canvasPtr->firstItemPtr;
2944     } else {
2945         itemPtr = lastPtr->nextPtr;
2946     }
2947     if ((itemPtr == NULL) || (searchPtr->searchOver)) {
2948         searchPtr->searchOver = 1;
2949         return NULL;
2950     }
2951     if (itemPtr != searchPtr->currentPtr) {
2952         /*
2953          * The structure of the list has changed.  Probably the
2954          * previously-returned item was removed from the list.
2955          * In this case, don't advance lastPtr;  just return
2956          * its new successor (i.e. do nothing here).
2957          */
2958     } else {
2959         lastPtr = itemPtr;
2960         itemPtr = lastPtr->nextPtr;
2961     }
2962
2963     /*
2964      * Handle special case of "all" search by returning next item.
2965      */
2966
2967     uid = searchPtr->tag;
2968     if (uid == NULL) {
2969         searchPtr->lastPtr = lastPtr;
2970         searchPtr->currentPtr = itemPtr;
2971         return itemPtr;
2972     }
2973
2974     /*
2975      * Look for an item with a particular tag.
2976      */
2977
2978     for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
2979         for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
2980                 count > 0; tagPtr++, count--) {
2981             if (*tagPtr == uid) {
2982                 searchPtr->lastPtr = lastPtr;
2983                 searchPtr->currentPtr = itemPtr;
2984                 return itemPtr;
2985             }
2986         }
2987     }
2988     searchPtr->lastPtr = lastPtr;
2989     searchPtr->searchOver = 1;
2990     return NULL;
2991 }
2992 \f
2993 #else /* USE_OLD_TAG_SEARCH */
2994 /*
2995  *--------------------------------------------------------------
2996  *
2997  * TagSearchExprInit --
2998  *
2999  *      This procedure allocates and initializes one TagSearchExpr struct.
3000  *
3001  * Results:
3002  *
3003  * Side effects:
3004  *
3005  *--------------------------------------------------------------
3006  */
3007
3008 static void
3009 TagSearchExprInit(exprPtrPtr)
3010 TagSearchExpr **exprPtrPtr;
3011 {
3012     TagSearchExpr* expr = *exprPtrPtr;
3013
3014     if (! expr) {
3015         expr = (TagSearchExpr *) ckalloc(sizeof(TagSearchExpr));
3016         expr->allocated = 0;
3017         expr->uids = NULL;
3018         expr->next = NULL;
3019     }
3020     expr->uid = NULL;
3021     expr->index = 0;
3022     expr->length = 0;
3023     *exprPtrPtr = expr;
3024 }
3025  
3026 /*
3027  *--------------------------------------------------------------
3028  *
3029  * TagSearchExprDestroy --
3030  *
3031  *      This procedure destroys one TagSearchExpr structure.
3032  *
3033  * Results:
3034  *
3035  * Side effects:
3036  *
3037  *--------------------------------------------------------------
3038      */
3039
3040 static void
3041 TagSearchExprDestroy(expr)
3042     TagSearchExpr *expr;
3043 {
3044     if (expr) {
3045         if (expr->uids) {
3046                 ckfree((char *)expr->uids);
3047         }
3048         ckfree((char *)expr);
3049     }
3050 }
3051
3052 /*
3053  *--------------------------------------------------------------
3054  *
3055  * TagSearchScan --
3056  *
3057  *      This procedure is called to initiate an enumeration of
3058  *      all items in a given canvas that contain a tag that matches
3059  *      the tagOrId expression.
3060  *
3061  * Results:
3062  *      The return value indicates if the tagOrId expression
3063  *      was successfully scanned (syntax).
3064  *      The information at *searchPtr is initialized
3065  *      such that a call to TagSearchFirst, followed by
3066  *      successive calls to TagSearchNext will return items
3067  *      that match tag.
3068  *
3069  * Side effects:
3070  *      SearchPtr is linked into a list of searches in progress
3071  *      on canvasPtr, so that elements can safely be deleted
3072  *      while the search is in progress.
3073  *
3074  *--------------------------------------------------------------
3075  */
3076
3077 static int
3078 TagSearchScan(canvasPtr, tagObj, searchPtrPtr)
3079     TkCanvas *canvasPtr;                /* Canvas whose items are to be
3080                                          * searched. */
3081     Tcl_Obj *tagObj;                    /* Object giving tag value. */
3082     TagSearch **searchPtrPtr;           /* Record describing tag search;
3083                                          * will be initialized here. */
3084 {
3085     char *tag = Tcl_GetStringFromObj(tagObj,NULL);
3086     int i;
3087     TagSearch *searchPtr;
3088
3089     /*
3090      * Initialize the search.
3091      */
3092
3093     if (*searchPtrPtr) {
3094         searchPtr = *searchPtrPtr;
3095     } else {
3096         /* Allocate primary search struct on first call */
3097         *searchPtrPtr = searchPtr = (TagSearch *) ckalloc(sizeof(TagSearch));
3098         searchPtr->expr = NULL;
3099
3100         /* Allocate buffer for rewritten tags (after de-escaping) */
3101         searchPtr->rewritebufferAllocated = 100;
3102         searchPtr->rewritebuffer =
3103             ckalloc(searchPtr->rewritebufferAllocated);
3104     }
3105     TagSearchExprInit(&(searchPtr->expr));
3106
3107     /* How long is the tagOrId ? */
3108     searchPtr->stringLength = strlen(tag);
3109
3110     /* Make sure there is enough buffer to hold rewritten tags */
3111     if ((unsigned int)searchPtr->stringLength >=
3112             searchPtr->rewritebufferAllocated) {
3113         searchPtr->rewritebufferAllocated = searchPtr->stringLength + 100;
3114         searchPtr->rewritebuffer =
3115             ckrealloc(searchPtr->rewritebuffer,
3116                     searchPtr->rewritebufferAllocated);
3117     }
3118
3119     /* Initialize search */
3120     searchPtr->canvasPtr = canvasPtr;
3121     searchPtr->searchOver = 0;
3122     searchPtr->type = 0;
3123
3124     /*
3125      * Find the first matching item in one of several ways. If the tag
3126      * is a number then it selects the single item with the matching
3127      * identifier.  In this case see if the item being requested is the
3128      * hot item, in which case the search can be skipped.
3129      */
3130
3131     if (searchPtr->stringLength && isdigit(UCHAR(*tag))) {
3132         char *end;
3133
3134         searchPtr->id = strtoul(tag, &end, 0);
3135         if (*end == 0) {
3136             searchPtr->type = 1;
3137             return TCL_OK;
3138         }
3139     }
3140
3141     /*
3142      * For all other tags and tag expressions convert to a UID.
3143      * This UID is kept forever, but this should be thought of
3144      * as a cache rather than as a memory leak.
3145      */
3146     searchPtr->expr->uid = Tk_GetUid(tag);
3147
3148     /* short circuit impossible searches for null tags */
3149     if (searchPtr->stringLength == 0) {
3150         return TCL_OK;
3151     }
3152
3153     /*
3154      * Pre-scan tag for at least one unquoted "&&" "||" "^" "!"
3155      *   if not found then use string as simple tag
3156      */
3157     for (i = 0; i < searchPtr->stringLength ; i++) {
3158         if (tag[i] == '"') {
3159             i++;
3160             for ( ; i < searchPtr->stringLength; i++) {
3161                 if (tag[i] == '\\') {
3162                     i++;
3163                     continue;
3164                 }
3165                 if (tag[i] == '"') {
3166                     break;
3167                 }
3168             }
3169         } else {
3170             if ((tag[i] == '&' && tag[i+1] == '&')
3171              || (tag[i] == '|' && tag[i+1] == '|')
3172              || (tag[i] == '^')
3173              || (tag[i] == '!')) {
3174                 searchPtr->type = 4;
3175                 break;
3176             }
3177         }
3178     }
3179
3180     searchPtr->string = tag;
3181     searchPtr->stringIndex = 0;
3182     if (searchPtr->type == 4) {
3183         /*
3184          * an operator was found in the prescan, so
3185          * now compile the tag expression into array of Tk_Uid
3186          * flagging any syntax errors found
3187          */
3188         if (TagSearchScanExpr(canvasPtr->interp, searchPtr, searchPtr->expr) != TCL_OK) {
3189             /* Syntax error in tag expression */
3190             /* Result message set by TagSearchScanExpr */
3191             return TCL_ERROR;
3192         }
3193         searchPtr->expr->length = searchPtr->expr->index;
3194     } else {
3195         if (searchPtr->expr->uid == allUid) {
3196             /*
3197              * All items match.
3198              */
3199             searchPtr->type = 2;
3200         } else {
3201             /*
3202              * Optimized single-tag search
3203              */
3204             searchPtr->type = 3;
3205         }
3206     }
3207     return TCL_OK;
3208 }
3209 \f
3210 /*
3211  *--------------------------------------------------------------
3212  *
3213  * TagSearchDestroy --
3214  *
3215  *      This procedure destroys any dynamic structures that
3216  *      may have been allocated by TagSearchScan.
3217  *
3218  * Results:
3219  *
3220  * Side effects:
3221  *
3222  *--------------------------------------------------------------
3223  */
3224
3225 static void
3226 TagSearchDestroy(searchPtr)
3227     TagSearch *searchPtr;               /* Record describing tag search */
3228 {
3229     if (searchPtr) {
3230         TagSearchExprDestroy(searchPtr->expr);
3231         ckfree((char *)searchPtr->rewritebuffer);
3232         ckfree((char *)searchPtr);
3233     }
3234 }
3235 \f
3236 /*
3237  *--------------------------------------------------------------
3238  *
3239  * TagSearchScanExpr --
3240  *
3241  *      This recursive procedure is called to scan a tag expression
3242  *      and compile it into an array of Tk_Uids.
3243  *
3244  * Results:
3245  *      The return value indicates if the tagOrId expression
3246  *      was successfully scanned (syntax).
3247  *      The information at *searchPtr is initialized
3248  *      such that a call to TagSearchFirst, followed by
3249  *      successive calls to TagSearchNext will return items
3250  *      that match tag.
3251  *
3252  * Side effects:
3253  *
3254  *--------------------------------------------------------------
3255  */
3256
3257 static int
3258 TagSearchScanExpr(interp, searchPtr, expr)
3259     Tcl_Interp *interp;         /* Current interpreter. */
3260     TagSearch *searchPtr;       /* Search data */
3261     TagSearchExpr *expr;        /* compiled expression result */
3262 {
3263     int looking_for_tag;        /* When true, scanner expects
3264                                  * next char(s) to be a tag,
3265                                  * else operand expected */
3266     int found_tag;              /* One or more tags found */
3267     int found_endquote;         /* For quoted tag string parsing */
3268     int negate_result;          /* Pending negation of next tag value */
3269     char *tag;                  /* tag from tag expression string */
3270     char c;
3271
3272     negate_result = 0;
3273     found_tag = 0;
3274     looking_for_tag = 1;
3275     while (searchPtr->stringIndex < searchPtr->stringLength) {
3276         c = searchPtr->string[searchPtr->stringIndex++];
3277
3278         if (expr->allocated == expr->index) {
3279             expr->allocated += 15;
3280             if (expr->uids) {
3281                 expr->uids =
3282                     (Tk_Uid *) ckrealloc((char *)(expr->uids),
3283                     (expr->allocated)*sizeof(Tk_Uid));
3284             } else {
3285                 expr->uids =
3286                 (Tk_Uid *) ckalloc((expr->allocated)*sizeof(Tk_Uid));
3287             }
3288         }
3289
3290         if (looking_for_tag) {
3291
3292             switch (c) {
3293                 case ' '  :     /* ignore unquoted whitespace */
3294                 case '\t' :
3295                 case '\n' :
3296                 case '\r' :
3297                     break;
3298
3299                 case '!'  :     /* negate next tag or subexpr */
3300                     if (looking_for_tag > 1) {
3301                         Tcl_AppendResult(interp,
3302                             "Too many '!' in tag search expression",
3303                             (char *) NULL);
3304                         return TCL_ERROR;
3305                     }
3306                     looking_for_tag++;
3307                     negate_result = 1;
3308                     break;
3309
3310                 case '('  :     /* scan (negated) subexpr recursively */
3311                     if (negate_result) {
3312                         expr->uids[expr->index++] = negparenUid;
3313                         negate_result = 0;
3314                     } else {
3315                         expr->uids[expr->index++] = parenUid;
3316                     }
3317                     if (TagSearchScanExpr(interp, searchPtr, expr) != TCL_OK) {
3318                         /* Result string should be already set
3319                          * by nested call to tag_expr_scan() */
3320                         return TCL_ERROR;
3321                     }
3322                     looking_for_tag = 0;
3323                     found_tag = 1;
3324                     break;
3325
3326                 case '"'  :     /* quoted tag string */
3327                     if (negate_result) {
3328                         expr->uids[expr->index++] = negtagvalUid;
3329                         negate_result = 0;
3330                     } else {
3331                         expr->uids[expr->index++] = tagvalUid;
3332                     }
3333                     tag = searchPtr->rewritebuffer;
3334                     found_endquote = 0;
3335                     while (searchPtr->stringIndex < searchPtr->stringLength) {
3336                         c = searchPtr->string[searchPtr->stringIndex++];
3337                         if (c == '\\') {
3338                             c = searchPtr->string[searchPtr->stringIndex++];
3339                         }
3340                         if (c == '"') {
3341                             found_endquote = 1;
3342                             break;
3343                         }
3344                         *tag++ = c;
3345                     }
3346                     if (! found_endquote) {
3347                         Tcl_AppendResult(interp,
3348                                 "Missing endquote in tag search expression",
3349                                 (char *) NULL);
3350                         return TCL_ERROR;
3351                     }
3352                     if (! (tag - searchPtr->rewritebuffer)) {
3353                         Tcl_AppendResult(interp,
3354                             "Null quoted tag string in tag search expression",
3355                             (char *) NULL);
3356                         return TCL_ERROR;
3357                     }
3358                     *tag++ = '\0';
3359                     expr->uids[expr->index++] =
3360                         Tk_GetUid(searchPtr->rewritebuffer);
3361                     looking_for_tag = 0;
3362                     found_tag = 1;
3363                     break;
3364
3365                 case '&'  :     /* illegal chars when looking for tag */
3366                 case '|'  :
3367                 case '^'  :
3368                 case ')'  :
3369                     Tcl_AppendResult(interp,
3370                             "Unexpected operator in tag search expression",
3371                             (char *) NULL);
3372                     return TCL_ERROR;
3373
3374                 default :       /* unquoted tag string */
3375                     if (negate_result) {
3376                         expr->uids[expr->index++] = negtagvalUid;
3377                         negate_result = 0;
3378                     } else {
3379                         expr->uids[expr->index++] = tagvalUid;
3380                     }
3381                     tag = searchPtr->rewritebuffer;
3382                     *tag++ = c;
3383                     /* copy rest of tag, including any embedded whitespace */
3384                     while (searchPtr->stringIndex < searchPtr->stringLength) {
3385                         c = searchPtr->string[searchPtr->stringIndex];
3386                         if (c == '!' || c == '&' || c == '|' || c == '^'
3387                                 || c == '(' || c == ')' || c == '"') {
3388                             break;
3389                         }
3390                         *tag++ = c;
3391                         searchPtr->stringIndex++;
3392                     }
3393                     /* remove trailing whitespace */
3394                     while (1) {
3395                         c = *--tag;
3396                         /* there must have been one non-whitespace char,
3397                          *  so this will terminate */
3398                         if (c != ' ' && c != '\t' && c != '\n' && c != '\r') {
3399                             break;
3400                         }
3401                     }
3402                     *++tag = '\0';
3403                     expr->uids[expr->index++] =
3404                         Tk_GetUid(searchPtr->rewritebuffer);
3405                     looking_for_tag = 0;
3406                     found_tag = 1;
3407             }
3408
3409         } else {    /* ! looking_for_tag */
3410
3411             switch (c) {
3412                 case ' '  :     /* ignore whitespace */
3413                 case '\t' :
3414                 case '\n' :
3415                 case '\r' :
3416                     break;
3417
3418                 case '&'  :     /* AND operator */
3419                     c = searchPtr->string[searchPtr->stringIndex++];
3420                     if (c != '&') {
3421                         Tcl_AppendResult(interp,
3422                                 "Singleton '&' in tag search expression",
3423                                 (char *) NULL);
3424                         return TCL_ERROR;
3425                     }
3426                     expr->uids[expr->index++] = andUid;
3427                     looking_for_tag = 1;
3428                     break;
3429
3430                 case '|'  :     /* OR operator */
3431                     c = searchPtr->string[searchPtr->stringIndex++];
3432                     if (c != '|') {
3433                         Tcl_AppendResult(interp,
3434                                 "Singleton '|' in tag search expression",
3435                                 (char *) NULL);
3436                         return TCL_ERROR;
3437                     }
3438                     expr->uids[expr->index++] = orUid;
3439                     looking_for_tag = 1;
3440                     break;
3441
3442                 case '^'  :     /* XOR operator */
3443                     expr->uids[expr->index++] = xorUid;
3444                     looking_for_tag = 1;
3445                     break;
3446
3447                 case ')'  :     /* end subexpression */
3448                     expr->uids[expr->index++] = endparenUid;
3449                     goto breakwhile;
3450
3451                 default   :     /* syntax error */
3452                     Tcl_AppendResult(interp,
3453                             "Invalid boolean operator in tag search expression",
3454                             (char *) NULL);
3455                     return TCL_ERROR;
3456             }
3457         }
3458     }
3459     breakwhile:
3460     if (found_tag && ! looking_for_tag) {
3461         return TCL_OK;
3462     }
3463     Tcl_AppendResult(interp, "Missing tag in tag search expression",
3464             (char *) NULL);
3465     return TCL_ERROR;
3466 }
3467 \f
3468 /*
3469  *--------------------------------------------------------------
3470  *
3471  * TagSearchEvalExpr --
3472  *
3473  *      This recursive procedure is called to eval a tag expression.
3474  *
3475  * Results:
3476  *      The return value indicates if the tagOrId expression
3477  *      successfully matched the tags of the current item.
3478  *
3479  * Side effects:
3480  *
3481  *--------------------------------------------------------------
3482  */
3483
3484 static int
3485 TagSearchEvalExpr(expr, itemPtr)
3486     TagSearchExpr *expr;        /* Search expression */
3487     Tk_Item *itemPtr;           /* Item being test for match */
3488 {
3489     int looking_for_tag;        /* When true, scanner expects
3490                                  * next char(s) to be a tag,
3491                                  * else operand expected */
3492     int negate_result;          /* Pending negation of next tag value */
3493     Tk_Uid uid;
3494     Tk_Uid *tagPtr;
3495     int count;
3496     int result;                 /* Value of expr so far */
3497     int parendepth;
3498
3499     result = 0;  /* just to keep the compiler quiet */
3500
3501     negate_result = 0;
3502     looking_for_tag = 1;
3503     while (expr->index < expr->length) {
3504         uid = expr->uids[expr->index++];
3505         if (looking_for_tag) {
3506             if (uid == tagvalUid) {
3507 /*
3508  *              assert(expr->index < expr->length);
3509  */
3510                 uid = expr->uids[expr->index++];
3511                 result = 0;
3512                 /*
3513                  * set result 1 if tag is found in item's tags
3514                  */
3515                 for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
3516                     count > 0; tagPtr++, count--) {
3517                     if (*tagPtr == uid) {
3518                         result = 1;
3519                         break;
3520                     }
3521                 }
3522
3523             } else if (uid == negtagvalUid) {
3524                 negate_result = ! negate_result;
3525 /*
3526  *              assert(expr->index < expr->length);
3527  */
3528                 uid = expr->uids[expr->index++];
3529                 result = 0;
3530                 /*
3531                  * set result 1 if tag is found in item's tags
3532                  */
3533                 for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
3534                     count > 0; tagPtr++, count--) {
3535                     if (*tagPtr == uid) {
3536                         result = 1;
3537                         break;
3538                     }
3539                 }
3540
3541             } else if (uid == parenUid) {
3542                 /*
3543                  * evaluate subexpressions with recursion
3544                  */
3545                 result = TagSearchEvalExpr(expr, itemPtr);
3546
3547             } else if (uid == negparenUid) {
3548                 negate_result = ! negate_result;
3549                 /*
3550                  * evaluate subexpressions with recursion
3551                  */
3552                 result = TagSearchEvalExpr(expr, itemPtr);
3553 /*
3554  *          } else {
3555  *              assert(0);
3556  */
3557             }
3558             if (negate_result) {
3559                 result = ! result;
3560                 negate_result = 0;
3561             }
3562             looking_for_tag = 0;
3563         } else {    /* ! looking_for_tag */
3564             if (((uid == andUid) && (!result)) || ((uid == orUid) && result)) {
3565                 /*
3566                  * short circuit expression evaluation
3567                  *
3568                  * if result before && is 0, or result before || is 1,
3569                  *   then the expression is decided and no further
3570                  *   evaluation is needed.
3571                  */
3572
3573                     parendepth = 0;
3574                 while (expr->index < expr->length) {
3575                     uid = expr->uids[expr->index++];
3576                     if (uid == tagvalUid || uid == negtagvalUid) {
3577                         expr->index++;
3578                         continue;
3579                     }
3580                         if (uid == parenUid || uid == negparenUid) {
3581                             parendepth++;
3582                         continue;
3583                     } 
3584                     if (uid == endparenUid) {
3585                             parendepth--;
3586                             if (parendepth < 0) {
3587                                 break;
3588                             }
3589                         }
3590                     }
3591                 return result;
3592
3593             } else if (uid == xorUid) {
3594                 /*
3595                  * if the previous result was 1
3596                  *   then negate the next result
3597                  */
3598                 negate_result = result;
3599
3600             } else if (uid == endparenUid) {
3601                 return result;
3602 /*
3603  *          } else {
3604  *               assert(0);
3605  */
3606             }
3607             looking_for_tag = 1;
3608         }
3609     }
3610 /*
3611  *  assert(! looking_for_tag);
3612  */
3613     return result;
3614 }
3615 \f
3616 /*
3617  *--------------------------------------------------------------
3618  *
3619  * TagSearchFirst --
3620  *
3621  *      This procedure is called to get the first item
3622  *      item that matches a preestablished search predicate
3623  *      that was set by TagSearchScan.
3624  *
3625  * Results:
3626  *      The return value is a pointer to the first item, or NULL
3627  *      if there is no such item.  The information at *searchPtr
3628  *      is updated such that successive calls to TagSearchNext
3629  *      will return successive items.
3630  *
3631  * Side effects:
3632  *      SearchPtr is linked into a list of searches in progress
3633  *      on canvasPtr, so that elements can safely be deleted
3634  *      while the search is in progress.
3635  *
3636  *--------------------------------------------------------------
3637  */
3638
3639 static Tk_Item *
3640 TagSearchFirst(searchPtr)
3641     TagSearch *searchPtr;               /* Record describing tag search */
3642 {
3643     Tk_Item *itemPtr, *lastPtr;
3644     Tk_Uid uid, *tagPtr;
3645     int count;
3646
3647     /* short circuit impossible searches for null tags */
3648     if (searchPtr->stringLength == 0) {
3649         return NULL;
3650     }
3651
3652     /*
3653      * Find the first matching item in one of several ways. If the tag
3654      * is a number then it selects the single item with the matching
3655      * identifier.  In this case see if the item being requested is the
3656      * hot item, in which case the search can be skipped.
3657      */
3658
3659     if (searchPtr->type == 1) {
3660         Tcl_HashEntry *entryPtr;
3661
3662         itemPtr = searchPtr->canvasPtr->hotPtr;
3663         lastPtr = searchPtr->canvasPtr->hotPrevPtr;
3664         if ((itemPtr == NULL) || (itemPtr->id != searchPtr->id) || (lastPtr == NULL)
3665             || (lastPtr->nextPtr != itemPtr)) {
3666             entryPtr = Tcl_FindHashEntry(&searchPtr->canvasPtr->idTable,
3667                 (char *) searchPtr->id);
3668             if (entryPtr != NULL) {
3669                 itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
3670                 lastPtr = itemPtr->prevPtr;
3671             } else {
3672                 lastPtr = itemPtr = NULL;
3673             }
3674         }
3675         searchPtr->lastPtr = lastPtr;
3676         searchPtr->searchOver = 1;
3677         searchPtr->canvasPtr->hotPtr = itemPtr;
3678         searchPtr->canvasPtr->hotPrevPtr = lastPtr;
3679         return itemPtr;
3680     }
3681
3682     if (searchPtr->type == 2) {
3683
3684         /*
3685          * All items match.
3686          */
3687
3688         searchPtr->lastPtr = NULL;
3689         searchPtr->currentPtr = searchPtr->canvasPtr->firstItemPtr;
3690         return searchPtr->canvasPtr->firstItemPtr;
3691     }
3692
3693     if (searchPtr->type == 3) {
3694
3695         /*
3696          * Optimized single-tag search
3697          */
3698
3699         uid = searchPtr->expr->uid;
3700         for (lastPtr = NULL, itemPtr = searchPtr->canvasPtr->firstItemPtr;
3701                 itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
3702             for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
3703                     count > 0; tagPtr++, count--) {
3704                 if (*tagPtr == uid) {
3705                     searchPtr->lastPtr = lastPtr;
3706                     searchPtr->currentPtr = itemPtr;
3707                     return itemPtr;
3708                 }
3709             }
3710         }
3711     } else {
3712
3713     /*
3714          * None of the above.  Search for an item matching the tag expression.
3715      */
3716
3717     for (lastPtr = NULL, itemPtr = searchPtr->canvasPtr->firstItemPtr;
3718                 itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
3719             searchPtr->expr->index = 0;
3720             if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
3721             searchPtr->lastPtr = lastPtr;
3722             searchPtr->currentPtr = itemPtr;
3723             return itemPtr;
3724         }
3725         }
3726     }
3727     searchPtr->lastPtr = lastPtr;
3728     searchPtr->searchOver = 1;
3729     return NULL;
3730 }
3731 \f
3732 /*
3733  *--------------------------------------------------------------
3734  *
3735  * TagSearchNext --
3736  *
3737  *      This procedure returns successive items that match a given
3738  *      tag;  it should be called only after TagSearchFirst has been
3739  *      used to begin a search.
3740  *
3741  * Results:
3742  *      The return value is a pointer to the next item that matches
3743  *      the tag expr specified to TagSearchScan, or NULL if no such
3744  *      item exists.  *SearchPtr is updated so that the next call
3745  *      to this procedure will return the next item.
3746  *
3747  * Side effects:
3748  *      None.
3749  *
3750  *--------------------------------------------------------------
3751  */
3752
3753 static Tk_Item *
3754 TagSearchNext(searchPtr)
3755     TagSearch *searchPtr;               /* Record describing search in
3756                                          * progress. */
3757 {
3758     Tk_Item *itemPtr, *lastPtr;
3759     Tk_Uid uid, *tagPtr;
3760     int count;
3761
3762     /*
3763      * Find next item in list (this may not actually be a suitable
3764      * one to return), and return if there are no items left.
3765      */
3766
3767     lastPtr = searchPtr->lastPtr;
3768     if (lastPtr == NULL) {
3769         itemPtr = searchPtr->canvasPtr->firstItemPtr;
3770     } else {
3771         itemPtr = lastPtr->nextPtr;
3772     }
3773     if ((itemPtr == NULL) || (searchPtr->searchOver)) {
3774         searchPtr->searchOver = 1;
3775         return NULL;
3776     }
3777     if (itemPtr != searchPtr->currentPtr) {
3778         /*
3779          * The structure of the list has changed.  Probably the
3780          * previously-returned item was removed from the list.
3781          * In this case, don't advance lastPtr;  just return
3782          * its new successor (i.e. do nothing here).
3783          */
3784     } else {
3785         lastPtr = itemPtr;
3786         itemPtr = lastPtr->nextPtr;
3787     }
3788
3789     if (searchPtr->type == 2) {
3790
3791         /*
3792          * All items match.
3793          */
3794
3795         searchPtr->lastPtr = lastPtr;
3796         searchPtr->currentPtr = itemPtr;
3797         return itemPtr;
3798     }
3799
3800     if (searchPtr->type == 3) {
3801
3802         /*
3803          * Optimized single-tag search
3804          */
3805
3806         uid = searchPtr->expr->uid;
3807         for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
3808             for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
3809                     count > 0; tagPtr++, count--) {
3810                 if (*tagPtr == uid) {
3811                     searchPtr->lastPtr = lastPtr;
3812                     searchPtr->currentPtr = itemPtr;
3813                     return itemPtr;
3814                 }
3815             }
3816         }
3817         searchPtr->lastPtr = lastPtr;
3818         searchPtr->searchOver = 1;
3819         return NULL;
3820     }
3821
3822     /*
3823      * Else.... evaluate tag expression
3824      */
3825
3826     for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
3827         searchPtr->expr->index = 0;
3828         if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
3829             searchPtr->lastPtr = lastPtr;
3830             searchPtr->currentPtr = itemPtr;
3831             return itemPtr;
3832         }
3833     }
3834     searchPtr->lastPtr = lastPtr;
3835     searchPtr->searchOver = 1;
3836     return NULL;
3837 }
3838 #endif /* USE_OLD_TAG_SEARCH */
3839 \f
3840 /*
3841  *--------------------------------------------------------------
3842  *
3843  * DoItem --
3844  *
3845  *      This is a utility procedure called by FindItems.  It
3846  *      either adds itemPtr's id to the result forming in interp,
3847  *      or it adds a new tag to itemPtr, depending on the value
3848  *      of tag.
3849  *
3850  * Results:
3851  *      None.
3852  *
3853  * Side effects:
3854  *      If tag is NULL then itemPtr's id is added as a list element
3855  *      to the interp's result;  otherwise tag is added to itemPtr's
3856  *      list of tags.
3857  *
3858  *--------------------------------------------------------------
3859  */
3860
3861 static void
3862 DoItem(interp, itemPtr, tag)
3863     Tcl_Interp *interp;                 /* Interpreter in which to (possibly)
3864                                          * record item id. */
3865     Tk_Item *itemPtr;                   /* Item to (possibly) modify. */
3866     Tk_Uid tag;                         /* Tag to add to those already
3867                                          * present for item, or NULL. */
3868 {
3869     Tk_Uid *tagPtr;
3870     int count;
3871
3872     /*
3873      * Handle the "add-to-result" case and return, if appropriate.
3874      */
3875
3876     if (tag == NULL) {
3877         char msg[TCL_INTEGER_SPACE];
3878
3879         sprintf(msg, "%d", itemPtr->id);
3880         Tcl_AppendElement(interp, msg);
3881         return;
3882     }
3883
3884     for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
3885             count > 0; tagPtr++, count--) {
3886         if (tag == *tagPtr) {
3887             return;
3888         }
3889     }
3890
3891     /*
3892      * Grow the tag space if there's no more room left in the current
3893      * block.
3894      */
3895
3896     if (itemPtr->tagSpace == itemPtr->numTags) {
3897         Tk_Uid *newTagPtr;
3898
3899         itemPtr->tagSpace += 5;
3900         newTagPtr = (Tk_Uid *) ckalloc((unsigned)
3901                 (itemPtr->tagSpace * sizeof(Tk_Uid)));
3902         memcpy((VOID *) newTagPtr, (VOID *) itemPtr->tagPtr,
3903                 (itemPtr->numTags * sizeof(Tk_Uid)));
3904         if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
3905             ckfree((char *) itemPtr->tagPtr);
3906         }
3907         itemPtr->tagPtr = newTagPtr;
3908         tagPtr = &itemPtr->tagPtr[itemPtr->numTags];
3909     }
3910
3911     /*
3912      * Add in the new tag.
3913      */
3914
3915     *tagPtr = tag;
3916     itemPtr->numTags++;
3917 }
3918 \f
3919 /*
3920  *--------------------------------------------------------------
3921  *
3922  * FindItems --
3923  *
3924  *      This procedure does all the work of implementing the
3925  *      "find" and "addtag" options of the canvas widget command,
3926  *      which locate items that have certain features (location,
3927  *      tags, position in display list, etc.).
3928  *
3929  * Results:
3930  *      A standard Tcl return value.  If newTag is NULL, then a
3931  *      list of ids from all the items that match argc/argv is
3932  *      returned in the interp's result.  If newTag is NULL, then
3933  *      the normal the interp's result is an empty string.  If an error
3934  *      occurs, then the interp's result will hold an error message.
3935  *
3936  * Side effects:
3937  *      If newTag is non-NULL, then all the items that match the
3938  *      information in argc/argv have that tag added to their
3939  *      lists of tags.
3940  *
3941  *--------------------------------------------------------------
3942  */
3943
3944 static int
3945 #ifdef USE_OLD_TAG_SEARCH
3946 FindItems(interp, canvasPtr, argc, argv, newTag, first)
3947 #else /* USE_OLD_TAG_SEARCH */
3948 FindItems(interp, canvasPtr, argc, argv, newTag, first, searchPtrPtr)
3949 #endif /* USE_OLD_TAG_SEARCH */
3950     Tcl_Interp *interp;                 /* Interpreter for error reporting. */
3951     TkCanvas *canvasPtr;                /* Canvas whose items are to be
3952                                          * searched. */
3953     int argc;                           /* Number of entries in argv.  Must be
3954                                          * greater than zero. */
3955     Tcl_Obj *CONST *argv;               /* Arguments that describe what items
3956                                          * to search for (see user doc on
3957                                          * "find" and "addtag" options). */
3958     Tcl_Obj *newTag;                    /* If non-NULL, gives new tag to set
3959                                          * on all found items;  if NULL, then
3960                                          * ids of found items are returned
3961                                          * in the interp's result. */
3962     int first;                          /* For error messages:  gives number
3963                                          * of elements of argv which are already
3964                                          * handled. */
3965 #ifndef USE_OLD_TAG_SEARCH
3966     TagSearch **searchPtrPtr;           /* From CanvasWidgetCmd local vars*/
3967 #endif /* not USE_OLD_TAG_SEARCH */
3968 {
3969 #ifdef USE_OLD_TAG_SEARCH
3970     TagSearch search;
3971 #endif /* USE_OLD_TAG_SEARCH */
3972     Tk_Item *itemPtr;
3973     Tk_Uid uid;
3974     int index;
3975     static char *optionStrings[] = {
3976         "above", "all", "below", "closest",
3977         "enclosed", "overlapping", "withtag", NULL
3978     };
3979     enum options {
3980         CANV_ABOVE, CANV_ALL, CANV_BELOW, CANV_CLOSEST,
3981         CANV_ENCLOSED, CANV_OVERLAPPING, CANV_WITHTAG
3982     };
3983
3984     if (newTag != NULL) {
3985         uid = Tk_GetUid(Tcl_GetStringFromObj(newTag, NULL));
3986     } else {
3987         uid = NULL;
3988     }
3989     if (Tcl_GetIndexFromObj(interp, argv[first], optionStrings, "search command", 0,
3990             &index) != TCL_OK) {
3991         return TCL_ERROR;
3992     }
3993     switch ((enum options) index) {
3994       case CANV_ABOVE: {
3995         Tk_Item *lastPtr = NULL;
3996         if (argc != first+2) {
3997             Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
3998             return TCL_ERROR;
3999         }
4000 #ifdef USE_OLD_TAG_SEARCH
4001         for (itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
4002                 itemPtr != NULL; itemPtr = NextItem(&search)) {
4003 #else /* USE_OLD_TAG_SEARCH */
4004         if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
4005             return TCL_ERROR;
4006         }
4007         for (itemPtr = TagSearchFirst(*searchPtrPtr);
4008                 itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
4009 #endif /* USE_OLD_TAG_SEARCH */
4010             lastPtr = itemPtr;
4011         }
4012         if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) {
4013             DoItem(interp, lastPtr->nextPtr, uid);
4014         }
4015         break;
4016       }
4017       case CANV_ALL: {
4018         if (argc != first+1) {
4019             Tcl_WrongNumArgs(interp, first+1, argv, (char *) NULL);
4020             return TCL_ERROR;
4021         }
4022
4023         for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
4024                 itemPtr = itemPtr->nextPtr) {
4025             DoItem(interp, itemPtr, uid);
4026         }
4027         break;
4028       }
4029       case CANV_BELOW: {
4030         Tk_Item *itemPtr;
4031
4032         if (argc != first+2) {
4033             Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
4034             return TCL_ERROR;
4035         }
4036 #ifdef USE_OLD_TAG_SEARCH
4037         itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
4038 #else /* USE_OLD_TAG_SEARCH */
4039         if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
4040             return TCL_ERROR;
4041         }
4042         itemPtr = TagSearchFirst(*searchPtrPtr);
4043 #endif /* USE_OLD_TAG_SEARCH */
4044         if (itemPtr != NULL) {
4045             if (itemPtr->prevPtr != NULL) {
4046                 DoItem(interp, itemPtr->prevPtr, uid);
4047             }
4048         }
4049         break;
4050       }
4051       case CANV_CLOSEST: {
4052         double closestDist;
4053         Tk_Item *startPtr, *closestPtr;
4054         double coords[2], halo;
4055         int x1, y1, x2, y2;
4056
4057         if ((argc < first+3) || (argc > first+5)) {
4058             Tcl_WrongNumArgs(interp, first+1, argv, "x y ?halo? ?start?");
4059             return TCL_ERROR;
4060         }
4061         if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[first+1],
4062                 &coords[0]) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
4063                 (Tk_Canvas) canvasPtr, argv[first+2], &coords[1]) != TCL_OK)) {
4064             return TCL_ERROR;
4065         }
4066         if (argc > first+3) {
4067             if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[first+3],
4068                     &halo) != TCL_OK) {
4069                 return TCL_ERROR;
4070             }
4071             if (halo < 0.0) {
4072                 Tcl_AppendResult(interp, "can't have negative halo value \"",
4073                         Tcl_GetString(argv[3]), "\"", (char *) NULL);
4074                 return TCL_ERROR;
4075             }
4076         } else {
4077             halo = 0.0;
4078         }
4079
4080         /*
4081          * Find the item at which to start the search.
4082          */
4083
4084         startPtr = canvasPtr->firstItemPtr;
4085         if (argc == first+5) {
4086 #ifdef USE_OLD_TAG_SEARCH
4087             itemPtr = StartTagSearch(canvasPtr, argv[first+4], &search);
4088 #else /* USE_OLD_TAG_SEARCH */
4089             if (TagSearchScan(canvasPtr, argv[first+4], searchPtrPtr) != TCL_OK) {
4090                 return TCL_ERROR;
4091             }
4092             itemPtr = TagSearchFirst(*searchPtrPtr);
4093 #endif /* USE_OLD_TAG_SEARCH */
4094             if (itemPtr != NULL) {
4095                 startPtr = itemPtr;
4096             }
4097         }
4098
4099         /*
4100          * The code below is optimized so that it can eliminate most
4101          * items without having to call their item-specific procedures.
4102          * This is done by keeping a bounding box (x1, y1, x2, y2) that
4103          * an item's bbox must overlap if the item is to have any
4104          * chance of being closer than the closest so far.
4105          */
4106
4107         itemPtr = startPtr;
4108         while(itemPtr && (itemPtr->state == TK_STATE_HIDDEN ||
4109             (itemPtr->state == TK_STATE_NULL && canvasPtr->canvas_state == TK_STATE_HIDDEN))) {
4110             itemPtr = itemPtr->nextPtr;
4111         }
4112         if (itemPtr == NULL) {
4113             return TCL_OK;
4114         }
4115         closestDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
4116                 itemPtr, coords) - halo;
4117         if (closestDist < 0.0) {
4118             closestDist = 0.0;
4119         }
4120         while (1) {
4121             double newDist;
4122
4123             /*
4124              * Update the bounding box using itemPtr, which is the
4125              * new closest item.
4126              */
4127
4128             x1 = (int) (coords[0] - closestDist - halo - 1);
4129             y1 = (int) (coords[1] - closestDist - halo - 1);
4130             x2 = (int) (coords[0] + closestDist + halo + 1);
4131             y2 = (int) (coords[1] + closestDist + halo + 1);
4132             closestPtr = itemPtr;
4133
4134             /*
4135              * Search for an item that beats the current closest one.
4136              * Work circularly through the canvas's item list until
4137              * getting back to the starting item.
4138              */
4139
4140             while (1) {
4141                 itemPtr = itemPtr->nextPtr;
4142                 if (itemPtr == NULL) {
4143                     itemPtr = canvasPtr->firstItemPtr;
4144                 }
4145                 if (itemPtr == startPtr) {
4146                     DoItem(interp, closestPtr, uid);
4147                     return TCL_OK;
4148                 }
4149                 if (itemPtr->state == TK_STATE_HIDDEN || (itemPtr->state == TK_STATE_NULL &&
4150                         canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
4151                     continue;
4152                 }
4153                 if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
4154                         || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
4155                     continue;
4156                 }
4157                 newDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
4158                         itemPtr, coords) - halo;
4159                 if (newDist < 0.0) {
4160                     newDist = 0.0;
4161                 }
4162                 if (newDist <= closestDist) {
4163                     closestDist = newDist;
4164                     break;
4165                 }
4166             }
4167         }
4168         break;
4169       }
4170       case CANV_ENCLOSED: {
4171         if (argc != first+5) {
4172             Tcl_WrongNumArgs(interp, first+1, argv, "x1 y1 x2 y2");
4173             return TCL_ERROR;
4174         }
4175         return FindArea(interp, canvasPtr, argv+first+1, uid, 1);
4176       }
4177       case CANV_OVERLAPPING: {
4178         if (argc != first+5) {
4179             Tcl_WrongNumArgs(interp, first+1, argv, "x1 y1 x2 y2");
4180             return TCL_ERROR;
4181         }
4182         return FindArea(interp, canvasPtr, argv+first+1, uid, 0);
4183       }
4184       case CANV_WITHTAG: {
4185         if (argc != first+2) {
4186             Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
4187             return TCL_ERROR;
4188         }
4189 #ifdef USE_OLD_TAG_SEARCH
4190         for (itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
4191                 itemPtr != NULL; itemPtr = NextItem(&search)) {
4192 #else /* USE_OLD_TAG_SEARCH */
4193         if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
4194             return TCL_ERROR;
4195         }
4196         for (itemPtr = TagSearchFirst(*searchPtrPtr);
4197                 itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
4198 #endif /* USE_OLD_TAG_SEARCH */
4199             DoItem(interp, itemPtr, uid);
4200         }
4201       }
4202     }
4203     return TCL_OK;
4204 }
4205 \f
4206 /*
4207  *--------------------------------------------------------------
4208  *
4209  * FindArea --
4210  *
4211  *      This procedure implements area searches for the "find"
4212  *      and "addtag" options.
4213  *
4214  * Results:
4215  *      A standard Tcl return value.  If newTag is NULL, then a
4216  *      list of ids from all the items overlapping or enclosed
4217  *      by the rectangle given by argc is returned in the interp's result.
4218  *      If newTag is NULL, then the normal the interp's result is an
4219  *      empty string.  If an error occurs, then the interp's result will
4220  *      hold an error message.
4221  *
4222  * Side effects:
4223  *      If uid is non-NULL, then all the items overlapping
4224  *      or enclosed by the area in argv have that tag added to
4225  *      their lists of tags.
4226  *
4227  *--------------------------------------------------------------
4228  */
4229
4230 static int
4231 FindArea(interp, canvasPtr, argv, uid, enclosed)
4232     Tcl_Interp *interp;                 /* Interpreter for error reporting
4233                                          * and result storing. */
4234     TkCanvas *canvasPtr;                /* Canvas whose items are to be
4235                                          * searched. */
4236     Tcl_Obj *CONST *argv;               /* Array of four arguments that
4237                                          * give the coordinates of the
4238                                          * rectangular area to search. */
4239     Tk_Uid uid;                         /* If non-NULL, gives new tag to set
4240                                          * on all found items;  if NULL, then
4241                                          * ids of found items are returned
4242                                          * in the interp's result. */
4243     int enclosed;                       /* 0 means overlapping or enclosed
4244                                          * items are OK, 1 means only enclosed
4245                                          * items are OK. */
4246 {
4247     double rect[4], tmp;
4248     int x1, y1, x2, y2;
4249     Tk_Item *itemPtr;
4250
4251     if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[0],
4252                 &rect[0]) != TCL_OK)
4253             || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[1],
4254                 &rect[1]) != TCL_OK)
4255             || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[2],
4256                 &rect[2]) != TCL_OK)
4257             || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
4258                 &rect[3]) != TCL_OK)) {
4259         return TCL_ERROR;
4260     }
4261     if (rect[0] > rect[2]) {
4262         tmp = rect[0]; rect[0] = rect[2]; rect[2] = tmp;
4263     }
4264     if (rect[1] > rect[3]) {
4265         tmp = rect[1]; rect[1] = rect[3]; rect[3] = tmp;
4266     }
4267
4268     /*
4269      * Use an integer bounding box for a quick test, to avoid
4270      * calling item-specific code except for items that are close.
4271      */
4272
4273     x1 = (int) (rect[0]-1.0);
4274     y1 = (int) (rect[1]-1.0);
4275     x2 = (int) (rect[2]+1.0);
4276     y2 = (int) (rect[3]+1.0);
4277     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
4278             itemPtr = itemPtr->nextPtr) {
4279         if (itemPtr->state == TK_STATE_HIDDEN || (itemPtr->state == TK_STATE_NULL &&
4280                 canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
4281             continue;
4282         }
4283         if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
4284                 || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
4285             continue;
4286         }
4287         if ((*itemPtr->typePtr->areaProc)((Tk_Canvas) canvasPtr, itemPtr, rect)
4288                 >= enclosed) {
4289             DoItem(interp, itemPtr, uid);
4290         }
4291     }
4292     return TCL_OK;
4293 }
4294 \f
4295 /*
4296  *--------------------------------------------------------------
4297  *
4298  * RelinkItems --
4299  *
4300  *      Move one or more items to a different place in the
4301  *      display order for a canvas.
4302  *
4303  * Results:
4304  *      None.
4305  *
4306  * Side effects:
4307  *      The items identified by "tag" are moved so that they
4308  *      are all together in the display list and immediately
4309  *      after prevPtr.  The order of the moved items relative
4310  *      to each other is not changed.
4311  *
4312  *--------------------------------------------------------------
4313  */
4314
4315 #ifdef USE_OLD_TAG_SEARCH
4316 static void
4317 RelinkItems(canvasPtr, tag, prevPtr)
4318 #else /* USE_OLD_TAG_SEARCH */
4319 static int
4320 RelinkItems(canvasPtr, tag, prevPtr, searchPtrPtr)
4321 #endif /* USE_OLD_TAG_SEARCH */
4322     TkCanvas *canvasPtr;        /* Canvas to be modified. */
4323     Tcl_Obj *tag;               /* Tag identifying items to be moved
4324                                  * in the redisplay list. */
4325     Tk_Item *prevPtr;           /* Reposition the items so that they
4326                                  * go just after this item (NULL means
4327                                  * put at beginning of list). */
4328 #ifndef USE_OLD_TAG_SEARCH
4329     TagSearch **searchPtrPtr;   /* From CanvasWidgetCmd local vars */
4330 #endif /* not USE_OLD_TAG_SEARCH */
4331 {
4332     Tk_Item *itemPtr;
4333 #ifdef USE_OLD_TAG_SEARCH
4334     TagSearch search;
4335 #endif /* USE_OLD_TAG_SEARCH */
4336     Tk_Item *firstMovePtr, *lastMovePtr;
4337
4338     /*
4339      * Find all of the items to be moved and remove them from
4340      * the list, making an auxiliary list running from firstMovePtr
4341      * to lastMovePtr.  Record their areas for redisplay.
4342      */
4343
4344     firstMovePtr = lastMovePtr = NULL;
4345 #ifdef USE_OLD_TAG_SEARCH
4346     for (itemPtr = StartTagSearch(canvasPtr, tag, &search);
4347             itemPtr != NULL; itemPtr = NextItem(&search)) {
4348 #else /* USE_OLD_TAG_SEARCH */
4349     if (TagSearchScan(canvasPtr, tag, searchPtrPtr) != TCL_OK) {
4350         return TCL_ERROR;
4351     }
4352     for (itemPtr = TagSearchFirst(*searchPtrPtr);
4353             itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
4354 #endif /* USE_OLD_TAG_SEARCH */
4355         if (itemPtr == prevPtr) {
4356             /*
4357              * Item after which insertion is to occur is being
4358              * moved!  Switch to insert after its predecessor.
4359              */
4360
4361             prevPtr = prevPtr->prevPtr;
4362         }
4363         if (itemPtr->prevPtr == NULL) {
4364             if (itemPtr->nextPtr != NULL) {
4365                 itemPtr->nextPtr->prevPtr = NULL;
4366             }
4367             canvasPtr->firstItemPtr = itemPtr->nextPtr;
4368         } else {
4369             if (itemPtr->nextPtr != NULL) {
4370                 itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
4371             }
4372             itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
4373         }
4374         if (canvasPtr->lastItemPtr == itemPtr) {
4375             canvasPtr->lastItemPtr = itemPtr->prevPtr;
4376         }
4377         if (firstMovePtr == NULL) {
4378             itemPtr->prevPtr = NULL;
4379             firstMovePtr = itemPtr;
4380         } else {
4381             itemPtr->prevPtr = lastMovePtr;
4382             lastMovePtr->nextPtr = itemPtr;
4383         }
4384         lastMovePtr = itemPtr;
4385         EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
4386         canvasPtr->flags |= REPICK_NEEDED;
4387     }
4388
4389     /*
4390      * Insert the list of to-be-moved items back into the canvas's
4391      * at the desired position.
4392      */
4393
4394     if (firstMovePtr == NULL) {
4395 #ifdef USE_OLD_TAG_SEARCH
4396         return;
4397 #else /* USE_OLD_TAG_SEARCH */
4398         return TCL_OK;
4399 #endif /* USE_OLD_TAG_SEARCH */
4400     }
4401     if (prevPtr == NULL) {
4402         if (canvasPtr->firstItemPtr != NULL) {
4403             canvasPtr->firstItemPtr->prevPtr = lastMovePtr;
4404         }
4405         lastMovePtr->nextPtr = canvasPtr->firstItemPtr;
4406         canvasPtr->firstItemPtr = firstMovePtr;
4407     } else {
4408         if (prevPtr->nextPtr != NULL) {
4409             prevPtr->nextPtr->prevPtr = lastMovePtr;
4410         }
4411         lastMovePtr->nextPtr = prevPtr->nextPtr;
4412         if (firstMovePtr != NULL) {
4413             firstMovePtr->prevPtr = prevPtr;
4414         }
4415         prevPtr->nextPtr = firstMovePtr;
4416     }
4417     if (canvasPtr->lastItemPtr == prevPtr) {
4418         canvasPtr->lastItemPtr = lastMovePtr;
4419     }
4420 #ifndef USE_OLD_TAG_SEARCH
4421     return TCL_OK;
4422 #endif /* not USE_OLD_TAG_SEARCH */
4423 }
4424 \f
4425 /*
4426  *--------------------------------------------------------------
4427  *
4428  * CanvasBindProc --
4429  *
4430  *      This procedure is invoked by the Tk dispatcher to handle
4431  *      events associated with bindings on items.
4432  *
4433  * Results:
4434  *      None.
4435  *
4436  * Side effects:
4437  *      Depends on the command invoked as part of the binding
4438  *      (if there was any).
4439  *
4440  *--------------------------------------------------------------
4441  */
4442
4443 static void
4444 CanvasBindProc(clientData, eventPtr)
4445     ClientData clientData;              /* Pointer to canvas structure. */
4446     XEvent *eventPtr;                   /* Pointer to X event that just
4447                                          * happened. */
4448 {
4449     TkCanvas *canvasPtr = (TkCanvas *) clientData;
4450
4451     Tcl_Preserve((ClientData) canvasPtr);
4452
4453     /*
4454      * This code below keeps track of the current modifier state in
4455      * canvasPtr>state.  This information is used to defer repicks of
4456      * the current item while buttons are down.
4457      */
4458
4459     if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) {
4460         int mask;
4461
4462         switch (eventPtr->xbutton.button) {
4463             case Button1:
4464                 mask = Button1Mask;
4465                 break;
4466             case Button2:
4467                 mask = Button2Mask;
4468                 break;
4469             case Button3:
4470                 mask = Button3Mask;
4471                 break;
4472             case Button4:
4473                 mask = Button4Mask;
4474                 break;
4475             case Button5:
4476                 mask = Button5Mask;
4477                 break;
4478             default:
4479                 mask = 0;
4480                 break;
4481         }
4482
4483         /*
4484          * For button press events, repick the current item using the
4485          * button state before the event, then process the event.  For
4486          * button release events, first process the event, then repick
4487          * the current item using the button state *after* the event
4488          * (the button has logically gone up before we change the
4489          * current item).
4490          */
4491
4492         if (eventPtr->type == ButtonPress) {
4493             /*
4494              * On a button press, first repick the current item using
4495              * the button state before the event, the process the event.
4496              */
4497
4498             canvasPtr->state = eventPtr->xbutton.state;
4499             PickCurrentItem(canvasPtr, eventPtr);
4500             canvasPtr->state ^= mask;
4501             CanvasDoEvent(canvasPtr, eventPtr);
4502         } else {
4503             /*
4504              * Button release: first process the event, with the button
4505              * still considered to be down.  Then repick the current
4506              * item under the assumption that the button is no longer down.
4507              */
4508
4509             canvasPtr->state = eventPtr->xbutton.state;
4510             CanvasDoEvent(canvasPtr, eventPtr);
4511             eventPtr->xbutton.state ^= mask;
4512             canvasPtr->state = eventPtr->xbutton.state;
4513             PickCurrentItem(canvasPtr, eventPtr);
4514             eventPtr->xbutton.state ^= mask;
4515         }
4516         goto done;
4517     } else if ((eventPtr->type == EnterNotify)
4518             || (eventPtr->type == LeaveNotify)) {
4519         canvasPtr->state = eventPtr->xcrossing.state;
4520         PickCurrentItem(canvasPtr, eventPtr);
4521         goto done;
4522     } else if (eventPtr->type == MotionNotify) {
4523         canvasPtr->state = eventPtr->xmotion.state;
4524         PickCurrentItem(canvasPtr, eventPtr);
4525     }
4526     CanvasDoEvent(canvasPtr, eventPtr);
4527
4528     done:
4529     Tcl_Release((ClientData) canvasPtr);
4530 }
4531 \f
4532 /*
4533  *--------------------------------------------------------------
4534  *
4535  * PickCurrentItem --
4536  *
4537  *      Find the topmost item in a canvas that contains a given
4538  *      location and mark the the current item.  If the current
4539  *      item has changed, generate a fake exit event on the old
4540  *      current item, a fake enter event on the new current item
4541  *      item and force a redraw of the two items. Canvas items
4542  *      that are hidden or disabled are ignored.
4543  *
4544  * Results:
4545  *      None.
4546  *
4547  * Side effects:
4548  *      The current item for canvasPtr may change.  If it does,
4549  *      then the commands associated with item entry and exit
4550  *      could do just about anything.  A binding script could
4551  *      delete the canvas, so callers should protect themselves
4552  *      with Tcl_Preserve and Tcl_Release.
4553  *
4554  *--------------------------------------------------------------
4555  */
4556
4557 static void
4558 PickCurrentItem(canvasPtr, eventPtr)
4559     TkCanvas *canvasPtr;                /* Canvas widget in which to select
4560                                          * current item. */
4561     XEvent *eventPtr;                   /* Event describing location of
4562                                          * mouse cursor.  Must be EnterWindow,
4563                                          * LeaveWindow, ButtonRelease, or
4564                                          * MotionNotify. */
4565 {
4566     double coords[2];
4567     int buttonDown;
4568     Tk_Item *prevItemPtr;
4569
4570     /*
4571      * Check whether or not a button is down.  If so, we'll log entry
4572      * and exit into and out of the current item, but not entry into
4573      * any other item.  This implements a form of grabbing equivalent
4574      * to what the X server does for windows.
4575      */
4576
4577     buttonDown = canvasPtr->state
4578             & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask);
4579     if (!buttonDown) {
4580         canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
4581     }
4582
4583     /*
4584      * Save information about this event in the canvas.  The event in
4585      * the canvas is used for two purposes:
4586      *
4587      * 1. Event bindings: if the current item changes, fake events are
4588      *    generated to allow item-enter and item-leave bindings to trigger.
4589      * 2. Reselection: if the current item gets deleted, can use the
4590      *    saved event to find a new current item.
4591      * Translate MotionNotify events into EnterNotify events, since that's
4592      * what gets reported to item handlers.
4593      */
4594
4595     if (eventPtr != &canvasPtr->pickEvent) {
4596         if ((eventPtr->type == MotionNotify)
4597                 || (eventPtr->type == ButtonRelease)) {
4598             canvasPtr->pickEvent.xcrossing.type = EnterNotify;
4599             canvasPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial;
4600             canvasPtr->pickEvent.xcrossing.send_event
4601                     = eventPtr->xmotion.send_event;
4602             canvasPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display;
4603             canvasPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window;
4604             canvasPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root;
4605             canvasPtr->pickEvent.xcrossing.subwindow = None;
4606             canvasPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time;
4607             canvasPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x;
4608             canvasPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y;
4609             canvasPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root;
4610             canvasPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root;
4611             canvasPtr->pickEvent.xcrossing.mode = NotifyNormal;
4612             canvasPtr->pickEvent.xcrossing.detail = NotifyNonlinear;
4613             canvasPtr->pickEvent.xcrossing.same_screen
4614                     = eventPtr->xmotion.same_screen;
4615             canvasPtr->pickEvent.xcrossing.focus = False;
4616             canvasPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state;
4617         } else  {
4618             canvasPtr->pickEvent = *eventPtr;
4619         }
4620     }
4621
4622     /*
4623      * If this is a recursive call (there's already a partially completed
4624      * call pending on the stack;  it's in the middle of processing a
4625      * Leave event handler for the old current item) then just return;
4626      * the pending call will do everything that's needed.
4627      */
4628
4629     if (canvasPtr->flags & REPICK_IN_PROGRESS) {
4630         return;
4631     }
4632
4633     /*
4634      * A LeaveNotify event automatically means that there's no current
4635      * object, so the check for closest item can be skipped.
4636      */
4637
4638     coords[0] = canvasPtr->pickEvent.xcrossing.x + canvasPtr->xOrigin;
4639     coords[1] = canvasPtr->pickEvent.xcrossing.y + canvasPtr->yOrigin;
4640     if (canvasPtr->pickEvent.type != LeaveNotify) {
4641         canvasPtr->newCurrentPtr = CanvasFindClosest(canvasPtr, coords);
4642     } else {
4643         canvasPtr->newCurrentPtr = NULL;
4644     }
4645
4646     if ((canvasPtr->newCurrentPtr == canvasPtr->currentItemPtr)
4647             && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
4648         /*
4649          * Nothing to do:  the current item hasn't changed.
4650          */
4651
4652         return;
4653     }
4654
4655     /*
4656      * Simulate a LeaveNotify event on the previous current item and
4657      * an EnterNotify event on the new current item.  Remove the "current"
4658      * tag from the previous current item and place it on the new current
4659      * item.
4660      */
4661
4662     if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr)
4663             && (canvasPtr->currentItemPtr != NULL)
4664             && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
4665         XEvent event;
4666         Tk_Item *itemPtr = canvasPtr->currentItemPtr;
4667         int i;
4668
4669         event = canvasPtr->pickEvent;
4670         event.type = LeaveNotify;
4671
4672         /*
4673          * If the event's detail happens to be NotifyInferior the
4674          * binding mechanism will discard the event.  To be consistent,
4675          * always use NotifyAncestor.
4676          */
4677
4678         event.xcrossing.detail = NotifyAncestor;
4679         canvasPtr->flags |= REPICK_IN_PROGRESS;
4680         CanvasDoEvent(canvasPtr, &event);
4681         canvasPtr->flags &= ~REPICK_IN_PROGRESS;
4682
4683         /*
4684          * The check below is needed because there could be an event
4685          * handler for <LeaveNotify> that deletes the current item.
4686          */
4687
4688         if ((itemPtr == canvasPtr->currentItemPtr) && !buttonDown) {
4689             for (i = itemPtr->numTags-1; i >= 0; i--) {
4690 #ifdef USE_OLD_TAG_SEARCH
4691                 if (itemPtr->tagPtr[i] == Tk_GetUid("current")) {
4692 #else /* USE_OLD_TAG_SEARCH */
4693                 if (itemPtr->tagPtr[i] == currentUid) {
4694 #endif /* USE_OLD_TAG_SEARCH */
4695                     itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
4696                     itemPtr->numTags--;
4697                     break;
4698                 }
4699             }
4700         }
4701     
4702         /*
4703          * Note:  during CanvasDoEvent above, it's possible that
4704          * canvasPtr->newCurrentPtr got reset to NULL because the
4705          * item was deleted.
4706          */
4707     }
4708     if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr) && buttonDown) {
4709         canvasPtr->flags |= LEFT_GRABBED_ITEM;
4710         return;
4711     }
4712
4713     /*
4714      * Special note:  it's possible that canvasPtr->newCurrentPtr ==
4715      * canvasPtr->currentItemPtr here.  This can happen, for example,
4716      * if LEFT_GRABBED_ITEM was set.
4717      */
4718
4719     prevItemPtr = canvasPtr->currentItemPtr;
4720     canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
4721     canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr;
4722     if (prevItemPtr != NULL && prevItemPtr != canvasPtr->currentItemPtr &&
4723             (prevItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT)) {
4724         EventuallyRedrawItem((Tk_Canvas) canvasPtr, prevItemPtr);
4725         (*prevItemPtr->typePtr->configProc)(canvasPtr->interp,
4726                 (Tk_Canvas) canvasPtr, prevItemPtr, 0, (Tcl_Obj **) NULL,
4727                 TK_CONFIG_ARGV_ONLY);
4728     }
4729     if (canvasPtr->currentItemPtr != NULL) {
4730         XEvent event;
4731
4732 #ifdef USE_OLD_TAG_SEARCH
4733         DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, 
4734                 Tk_GetUid("current"));
4735 #else /* USE_OLD_TAG_SEARCH */
4736         DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, currentUid);
4737 #endif /* USE_OLD_TAG_SEA */
4738         if ((canvasPtr->currentItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT &&
4739                 prevItemPtr != canvasPtr->currentItemPtr)) {
4740             (*canvasPtr->currentItemPtr->typePtr->configProc)(canvasPtr->interp,
4741                     (Tk_Canvas) canvasPtr, canvasPtr->currentItemPtr, 0, (Tcl_Obj **) NULL,
4742                     TK_CONFIG_ARGV_ONLY);
4743             EventuallyRedrawItem((Tk_Canvas) canvasPtr,
4744                     canvasPtr->currentItemPtr);
4745         }
4746         event = canvasPtr->pickEvent;
4747         event.type = EnterNotify;
4748         event.xcrossing.detail = NotifyAncestor;
4749         CanvasDoEvent(canvasPtr, &event);
4750     }
4751 }
4752 \f
4753 /*
4754  *----------------------------------------------------------------------
4755  *
4756  * CanvasFindClosest --
4757  *
4758  *      Given x and y coordinates, find the topmost canvas item that
4759  *      is "close" to the coordinates. Canvas items that are hidden
4760  *      or disabled are ignored.
4761  *
4762  * Results:
4763  *      The return value is a pointer to the topmost item that is
4764  *      close to (x,y), or NULL if no item is close.
4765  *
4766  * Side effects:
4767  *      None.
4768  *
4769  *----------------------------------------------------------------------
4770  */
4771
4772 static Tk_Item *
4773 CanvasFindClosest(canvasPtr, coords)
4774     TkCanvas *canvasPtr;                /* Canvas widget to search. */
4775     double coords[2];                   /* Desired x,y position in canvas,
4776                                          * not screen, coordinates.) */
4777 {
4778     Tk_Item *itemPtr;
4779     Tk_Item *bestPtr;
4780     int x1, y1, x2, y2;
4781
4782     x1 = (int) (coords[0] - canvasPtr->closeEnough);
4783     y1 = (int) (coords[1] - canvasPtr->closeEnough);
4784     x2 = (int) (coords[0] + canvasPtr->closeEnough);
4785     y2 = (int) (coords[1] + canvasPtr->closeEnough);
4786
4787     bestPtr = NULL;
4788     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
4789             itemPtr = itemPtr->nextPtr) {
4790         if (itemPtr->state == TK_STATE_HIDDEN || itemPtr->state==TK_STATE_DISABLED ||
4791                 (itemPtr->state == TK_STATE_NULL && (canvasPtr->canvas_state == TK_STATE_HIDDEN ||
4792                 canvasPtr->canvas_state == TK_STATE_DISABLED))) {
4793             continue;
4794         }
4795         if ((itemPtr->x1 > x2) || (itemPtr->x2 < x1)
4796                 || (itemPtr->y1 > y2) || (itemPtr->y2 < y1)) {
4797             continue;
4798         }
4799         if ((*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
4800                 itemPtr, coords) <= canvasPtr->closeEnough) {
4801             bestPtr = itemPtr;
4802         }
4803     }
4804     return bestPtr;
4805 }
4806 \f
4807 /*
4808  *--------------------------------------------------------------
4809  *
4810  * CanvasDoEvent --
4811  *
4812  *      This procedure is called to invoke binding processing
4813  *      for a new event that is associated with the current item
4814  *      for a canvas.
4815  *
4816  * Results:
4817  *      None.
4818  *
4819  * Side effects:
4820  *      Depends on the bindings for the canvas.  A binding script
4821  *      could delete the canvas, so callers should protect themselves
4822  *      with Tcl_Preserve and Tcl_Release.
4823  *
4824  *--------------------------------------------------------------
4825  */
4826
4827 static void
4828 CanvasDoEvent(canvasPtr, eventPtr)
4829     TkCanvas *canvasPtr;                /* Canvas widget in which event
4830                                          * occurred. */
4831     XEvent *eventPtr;                   /* Real or simulated X event that
4832                                          * is to be processed. */
4833 {
4834 #define NUM_STATIC 3
4835     ClientData staticObjects[NUM_STATIC];
4836     ClientData *objectPtr;
4837     int numObjects, i;
4838     Tk_Item *itemPtr;
4839 #ifndef USE_OLD_TAG_SEARCH
4840     TagSearchExpr *expr;
4841     int numExprs;
4842 #endif /* not USE_OLD_TAG_SEARCH */
4843
4844     if (canvasPtr->bindingTable == NULL) {
4845         return;
4846     }
4847
4848     itemPtr = canvasPtr->currentItemPtr;
4849     if ((eventPtr->type == KeyPress) || (eventPtr->type == KeyRelease)) {
4850         itemPtr = canvasPtr->textInfo.focusItemPtr;
4851     }
4852     if (itemPtr == NULL) {
4853         return;
4854     }
4855
4856 #ifdef USE_OLD_TAG_SEARCH
4857     /*
4858      * Set up an array with all the relevant objects for processing
4859      * this event.  The relevant objects are (a) the event's item,
4860      * (b) the tags associated with the event's item, and (c) the
4861      * tag "all".  If there are a lot of tags then malloc an array
4862      * to hold all of the objects.
4863      */
4864
4865     numObjects = itemPtr->numTags + 2;
4866 #else /* USE_OLD_TAG_SEARCH */
4867     /*
4868      * Set up an array with all the relevant objects for processing
4869      * this event.  The relevant objects are:
4870      * (a) the event's item,
4871      * (b) the tags associated with the event's item, 
4872      * (c) the expressions that are true for the event's item's tags, and
4873      * (d) the tag "all". 
4874      *
4875      * If there are a lot of tags then malloc an array to hold all of
4876      * the objects.
4877      */
4878
4879     /*
4880      * flag and count all expressions that match item's tags
4881      */
4882     numExprs = 0;
4883     expr = canvasPtr->bindTagExprs;
4884     while (expr) {
4885         expr->index = 0;
4886         expr->match = TagSearchEvalExpr(expr, itemPtr);
4887         if (expr->match) {
4888             numExprs++;
4889         }
4890         expr = expr->next;
4891     }
4892
4893     numObjects = itemPtr->numTags + numExprs + 2;
4894 #endif /* not USE_OLD_TAG_SEARCH */
4895     if (numObjects <= NUM_STATIC) {
4896         objectPtr = staticObjects;
4897     } else {
4898         objectPtr = (ClientData *) ckalloc((unsigned)
4899                 (numObjects * sizeof(ClientData)));
4900     }
4901 #ifdef USE_OLD_TAG_SEARCH
4902     objectPtr[0] = (ClientData) Tk_GetUid("all");
4903 #else /* USE_OLD_TAG_SEARCH */
4904     objectPtr[0] = (ClientData) allUid;
4905 #endif /* USE_OLD_TAG_SEARCH */
4906     for (i = itemPtr->numTags-1; i >= 0; i--) {
4907         objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i];
4908     }
4909     objectPtr[itemPtr->numTags+1] = (ClientData) itemPtr;
4910 #ifndef USE_OLD_TAG_SEARCH
4911     /*
4912      * copy uids of matching expressions into object array
4913      */
4914     i = itemPtr->numTags+2;
4915     expr = canvasPtr->bindTagExprs;
4916     while (expr) {
4917         if (expr->match) {
4918             objectPtr[i++] = (int *) expr->uid;
4919         }
4920         expr = expr->next;
4921     }
4922 #endif /* not USE_OLD_TAG_SEARCH */
4923
4924     /*
4925      * Invoke the binding system, then free up the object array if
4926      * it was malloc-ed.
4927      */
4928
4929     if (canvasPtr->tkwin != NULL) {
4930         Tk_BindEvent(canvasPtr->bindingTable, eventPtr, canvasPtr->tkwin,
4931                 numObjects, objectPtr);
4932     }
4933     if (objectPtr != staticObjects) {
4934         ckfree((char *) objectPtr);
4935     }
4936 }
4937 \f
4938 /*
4939  *----------------------------------------------------------------------
4940  *
4941  * CanvasBlinkProc --
4942  *
4943  *      This procedure is called as a timer handler to blink the
4944  *      insertion cursor off and on.
4945  *
4946  * Results:
4947  *      None.
4948  *
4949  * Side effects:
4950  *      The cursor gets turned on or off, redisplay gets invoked,
4951  *      and this procedure reschedules itself.
4952  *
4953  *----------------------------------------------------------------------
4954  */
4955
4956 static void
4957 CanvasBlinkProc(clientData)
4958     ClientData clientData;      /* Pointer to record describing entry. */
4959 {
4960     TkCanvas *canvasPtr = (TkCanvas *) clientData;
4961
4962     if (!canvasPtr->textInfo.gotFocus || (canvasPtr->insertOffTime == 0)) {
4963         return;
4964     }
4965     if (canvasPtr->textInfo.cursorOn) {
4966         canvasPtr->textInfo.cursorOn = 0;
4967         canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
4968                 canvasPtr->insertOffTime, CanvasBlinkProc,
4969                 (ClientData) canvasPtr);
4970     } else {
4971         canvasPtr->textInfo.cursorOn = 1;
4972         canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
4973                 canvasPtr->insertOnTime, CanvasBlinkProc,
4974                 (ClientData) canvasPtr);
4975     }
4976     if (canvasPtr->textInfo.focusItemPtr != NULL) {
4977         EventuallyRedrawItem((Tk_Canvas) canvasPtr,
4978                 canvasPtr->textInfo.focusItemPtr);
4979     }
4980 }
4981 \f
4982 /*
4983  *----------------------------------------------------------------------
4984  *
4985  * CanvasFocusProc --
4986  *
4987  *      This procedure is called whenever a canvas gets or loses the
4988  *      input focus.  It's also called whenever the window is
4989  *      reconfigured while it has the focus.
4990  *
4991  * Results:
4992  *      None.
4993  *
4994  * Side effects:
4995  *      The cursor gets turned on or off.
4996  *
4997  *----------------------------------------------------------------------
4998  */
4999
5000 static void
5001 CanvasFocusProc(canvasPtr, gotFocus)
5002     TkCanvas *canvasPtr;        /* Canvas that just got or lost focus. */
5003     int gotFocus;               /* 1 means window is getting focus, 0 means
5004                                  * it's losing it. */
5005 {
5006     Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
5007     if (gotFocus) {
5008         canvasPtr->textInfo.gotFocus = 1;
5009         canvasPtr->textInfo.cursorOn = 1;
5010         if (canvasPtr->insertOffTime != 0) {
5011             canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
5012                     canvasPtr->insertOffTime, CanvasBlinkProc,
5013                     (ClientData) canvasPtr);
5014         }
5015     } else {
5016         canvasPtr->textInfo.gotFocus = 0;
5017         canvasPtr->textInfo.cursorOn = 0;
5018         canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
5019     }
5020     if (canvasPtr->textInfo.focusItemPtr != NULL) {
5021         EventuallyRedrawItem((Tk_Canvas) canvasPtr,
5022                 canvasPtr->textInfo.focusItemPtr);
5023     }
5024     if (canvasPtr->highlightWidth > 0) {
5025         canvasPtr->flags |= REDRAW_BORDERS;
5026         if (!(canvasPtr->flags & REDRAW_PENDING)) {
5027             Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
5028             canvasPtr->flags |= REDRAW_PENDING;
5029         }
5030     }
5031 }
5032 \f
5033 /*
5034  *----------------------------------------------------------------------
5035  *
5036  * CanvasSelectTo --
5037  *
5038  *      Modify the selection by moving its un-anchored end.  This could
5039  *      make the selection either larger or smaller.
5040  *
5041  * Results:
5042  *      None.
5043  *
5044  * Side effects:
5045  *      The selection changes.
5046  *
5047  *----------------------------------------------------------------------
5048  */
5049
5050 static void
5051 CanvasSelectTo(canvasPtr, itemPtr, index)
5052     TkCanvas *canvasPtr;        /* Information about widget. */
5053     Tk_Item *itemPtr;           /* Item that is to hold selection. */
5054     int index;                  /* Index of element that is to become the
5055                                  * "other" end of the selection. */
5056 {
5057     int oldFirst, oldLast;
5058     Tk_Item *oldSelPtr;
5059
5060     oldFirst = canvasPtr->textInfo.selectFirst;
5061     oldLast = canvasPtr->textInfo.selectLast;
5062     oldSelPtr = canvasPtr->textInfo.selItemPtr;
5063
5064     /*
5065      * Grab the selection if we don't own it already.
5066      */
5067
5068     if (canvasPtr->textInfo.selItemPtr == NULL) {
5069         Tk_OwnSelection(canvasPtr->tkwin, XA_PRIMARY, CanvasLostSelection,
5070                 (ClientData) canvasPtr);
5071     } else if (canvasPtr->textInfo.selItemPtr != itemPtr) {
5072         EventuallyRedrawItem((Tk_Canvas) canvasPtr,
5073                 canvasPtr->textInfo.selItemPtr);
5074     }
5075     canvasPtr->textInfo.selItemPtr = itemPtr;
5076
5077     if (canvasPtr->textInfo.anchorItemPtr != itemPtr) {
5078         canvasPtr->textInfo.anchorItemPtr = itemPtr;
5079         canvasPtr->textInfo.selectAnchor = index;
5080     }
5081     if (canvasPtr->textInfo.selectAnchor <= index) {
5082         canvasPtr->textInfo.selectFirst = canvasPtr->textInfo.selectAnchor;
5083         canvasPtr->textInfo.selectLast = index;
5084     } else {
5085         canvasPtr->textInfo.selectFirst = index;
5086         canvasPtr->textInfo.selectLast = canvasPtr->textInfo.selectAnchor - 1;
5087     }
5088     if ((canvasPtr->textInfo.selectFirst != oldFirst)
5089             || (canvasPtr->textInfo.selectLast != oldLast)
5090             || (itemPtr != oldSelPtr)) {
5091         EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
5092     }
5093 }
5094 \f
5095 /*
5096  *--------------------------------------------------------------
5097  *
5098  * CanvasFetchSelection --
5099  *
5100  *      This procedure is invoked by Tk to return part or all of
5101  *      the selection, when the selection is in a canvas widget.
5102  *      This procedure always returns the selection as a STRING.
5103  *
5104  * Results:
5105  *      The return value is the number of non-NULL bytes stored
5106  *      at buffer.  Buffer is filled (or partially filled) with a
5107  *      NULL-terminated string containing part or all of the selection,
5108  *      as given by offset and maxBytes.
5109  *
5110  * Side effects:
5111  *      None.
5112  *
5113  *--------------------------------------------------------------
5114  */
5115
5116 static int
5117 CanvasFetchSelection(clientData, offset, buffer, maxBytes)
5118     ClientData clientData;              /* Information about canvas widget. */
5119     int offset;                         /* Offset within selection of first
5120                                          * character to be returned. */
5121     char *buffer;                       /* Location in which to place
5122                                          * selection. */
5123     int maxBytes;                       /* Maximum number of bytes to place
5124                                          * at buffer, not including terminating
5125                                          * NULL character. */
5126 {
5127     TkCanvas *canvasPtr = (TkCanvas *) clientData;
5128
5129     if (canvasPtr->textInfo.selItemPtr == NULL) {
5130         return -1;
5131     }
5132     if (canvasPtr->textInfo.selItemPtr->typePtr->selectionProc == NULL) {
5133         return -1;
5134     }
5135     return (*canvasPtr->textInfo.selItemPtr->typePtr->selectionProc)(
5136             (Tk_Canvas) canvasPtr, canvasPtr->textInfo.selItemPtr, offset,
5137             buffer, maxBytes);
5138 }
5139 \f
5140 /*
5141  *----------------------------------------------------------------------
5142  *
5143  * CanvasLostSelection --
5144  *
5145  *      This procedure is called back by Tk when the selection is
5146  *      grabbed away from a canvas widget.
5147  *
5148  * Results:
5149  *      None.
5150  *
5151  * Side effects:
5152  *      The existing selection is unhighlighted, and the window is
5153  *      marked as not containing a selection.
5154  *
5155  *----------------------------------------------------------------------
5156  */
5157
5158 static void
5159 CanvasLostSelection(clientData)
5160     ClientData clientData;              /* Information about entry widget. */
5161 {
5162     TkCanvas *canvasPtr = (TkCanvas *) clientData;
5163
5164     if (canvasPtr->textInfo.selItemPtr != NULL) {
5165         EventuallyRedrawItem((Tk_Canvas) canvasPtr,
5166                 canvasPtr->textInfo.selItemPtr);
5167     }
5168     canvasPtr->textInfo.selItemPtr = NULL;
5169 }
5170 \f
5171 /*
5172  *--------------------------------------------------------------
5173  *
5174  * GridAlign --
5175  *
5176  *      Given a coordinate and a grid spacing, this procedure
5177  *      computes the location of the nearest grid line to the
5178  *      coordinate.
5179  *
5180  * Results:
5181  *      The return value is the location of the grid line nearest
5182  *      to coord.
5183  *
5184  * Side effects:
5185  *      None.
5186  *
5187  *--------------------------------------------------------------
5188  */
5189
5190 static double
5191 GridAlign(coord, spacing)
5192     double coord;               /* Coordinate to grid-align. */
5193     double spacing;             /* Spacing between grid lines.   If <= 0
5194                                  * then no alignment is done. */
5195 {
5196     if (spacing <= 0.0) {
5197         return coord;
5198     }
5199     if (coord < 0) {
5200         return -((int) ((-coord)/spacing + 0.5)) * spacing;
5201     }
5202     return ((int) (coord/spacing + 0.5)) * spacing;
5203 }
5204 \f
5205 /*
5206  *----------------------------------------------------------------------
5207  *
5208  * PrintScrollFractions --
5209  *
5210  *      Given the range that's visible in the window and the "100%
5211  *      range" for what's in the canvas, print a string containing
5212  *      the scroll fractions.  This procedure is used for both x
5213  *      and y scrolling.
5214  *
5215  * Results:
5216  *      The memory pointed to by string is modified to hold
5217  *      two real numbers containing the scroll fractions (between
5218  *      0 and 1) corresponding to the other arguments.
5219  *
5220  * Side effects:
5221  *      None.
5222  *
5223  *----------------------------------------------------------------------
5224  */
5225
5226 static void
5227 PrintScrollFractions(screen1, screen2, object1, object2, string)
5228     int screen1;                /* Lowest coordinate visible in the window. */
5229     int screen2;                /* Highest coordinate visible in the window. */
5230     int object1;                /* Lowest coordinate in the object. */
5231     int object2;                /* Highest coordinate in the object. */
5232     char *string;               /* Two real numbers get printed here.  Must
5233                                  * have enough storage for two %g
5234                                  * conversions. */
5235 {
5236     double range, f1, f2;
5237
5238     range = object2 - object1;
5239     if (range <= 0) {
5240         f1 = 0;
5241         f2 = 1.0;
5242     } else {
5243         f1 = (screen1 - object1)/range;
5244         if (f1 < 0) {
5245             f1 = 0.0;
5246         }
5247         f2 = (screen2 - object1)/range;
5248         if (f2 > 1.0) {
5249             f2 = 1.0;
5250         }
5251         if (f2 < f1) {
5252             f2 = f1;
5253         }
5254     }
5255     sprintf(string, "%g %g", f1, f2);
5256 }
5257 \f
5258 /*
5259  *--------------------------------------------------------------
5260  *
5261  * CanvasUpdateScrollbars --
5262  *
5263  *      This procedure is invoked whenever a canvas has changed in
5264  *      a way that requires scrollbars to be redisplayed (e.g. the
5265  *      view in the canvas has changed).
5266  *
5267  * Results:
5268  *      None.
5269  *
5270  * Side effects:
5271  *      If there are scrollbars associated with the canvas, then
5272  *      their scrolling commands are invoked to cause them to
5273  *      redisplay.  If errors occur, additional Tcl commands may
5274  *      be invoked to process the errors.
5275  *
5276  *--------------------------------------------------------------
5277  */
5278
5279 static void
5280 CanvasUpdateScrollbars(canvasPtr)
5281     TkCanvas *canvasPtr;                /* Information about canvas. */
5282 {
5283     int result;
5284     char buffer[200];
5285     Tcl_Interp *interp;
5286     int xOrigin, yOrigin, inset, width, height, scrollX1, scrollX2,
5287         scrollY1, scrollY2;
5288     char *xScrollCmd, *yScrollCmd;
5289
5290     /*
5291      * Save all the relevant values from the canvasPtr, because it might be
5292      * deleted as part of either of the two calls to Tcl_VarEval below.
5293      */
5294     
5295     interp = canvasPtr->interp;
5296     Tcl_Preserve((ClientData) interp);
5297     xScrollCmd = canvasPtr->xScrollCmd;
5298     if (xScrollCmd != (char *) NULL) {
5299         Tcl_Preserve((ClientData) xScrollCmd);
5300     }
5301     yScrollCmd = canvasPtr->yScrollCmd;
5302     if (yScrollCmd != (char *) NULL) {
5303         Tcl_Preserve((ClientData) yScrollCmd);
5304     }
5305     xOrigin = canvasPtr->xOrigin;
5306     yOrigin = canvasPtr->yOrigin;
5307     inset = canvasPtr->inset;
5308     width = Tk_Width(canvasPtr->tkwin);
5309     height = Tk_Height(canvasPtr->tkwin);
5310     scrollX1 = canvasPtr->scrollX1;
5311     scrollX2 = canvasPtr->scrollX2;
5312     scrollY1 = canvasPtr->scrollY1;
5313     scrollY2 = canvasPtr->scrollY2;
5314     canvasPtr->flags &= ~UPDATE_SCROLLBARS;
5315     if (canvasPtr->xScrollCmd != NULL) {
5316         PrintScrollFractions(xOrigin + inset, xOrigin + width - inset,
5317                 scrollX1, scrollX2, buffer);
5318         result = Tcl_VarEval(interp, xScrollCmd, " ", buffer, (char *) NULL);
5319         if (result != TCL_OK) {
5320             Tcl_BackgroundError(interp);
5321         }
5322         Tcl_ResetResult(interp);
5323         Tcl_Release((ClientData) xScrollCmd);
5324     }
5325
5326     if (yScrollCmd != NULL) {
5327         PrintScrollFractions(yOrigin + inset, yOrigin + height - inset,
5328                 scrollY1, scrollY2, buffer);
5329         result = Tcl_VarEval(interp, yScrollCmd, " ", buffer, (char *) NULL);
5330         if (result != TCL_OK) {
5331             Tcl_BackgroundError(interp);
5332         }
5333         Tcl_ResetResult(interp);
5334         Tcl_Release((ClientData) yScrollCmd);
5335     }
5336     Tcl_Release((ClientData) interp);
5337 }
5338 \f
5339 /*
5340  *--------------------------------------------------------------
5341  *
5342  * CanvasSetOrigin --
5343  *
5344  *      This procedure is invoked to change the mapping between
5345  *      canvas coordinates and screen coordinates in the canvas
5346  *      window.
5347  *
5348  * Results:
5349  *      None.
5350  *
5351  * Side effects:
5352  *      The canvas will be redisplayed to reflect the change in
5353  *      view.  In addition, scrollbars will be updated if there
5354  *      are any.
5355  *
5356  *--------------------------------------------------------------
5357  */
5358
5359 static void
5360 CanvasSetOrigin(canvasPtr, xOrigin, yOrigin)
5361     TkCanvas *canvasPtr;        /* Information about canvas. */
5362     int xOrigin;                /* New X origin for canvas (canvas x-coord
5363                                  * corresponding to left edge of canvas
5364                                  * window). */
5365     int yOrigin;                /* New Y origin for canvas (canvas y-coord
5366                                  * corresponding to top edge of canvas
5367                                  * window). */
5368 {
5369     int left, right, top, bottom, delta;
5370
5371     /*
5372      * If scroll increments have been set, round the window origin
5373      * to the nearest multiple of the increments.  Remember, the
5374      * origin is the place just inside the borders,  not the upper
5375      * left corner.
5376      */
5377
5378     if (canvasPtr->xScrollIncrement > 0) {
5379         if (xOrigin >= 0) {
5380             xOrigin += canvasPtr->xScrollIncrement/2;
5381             xOrigin -= (xOrigin + canvasPtr->inset)
5382                     % canvasPtr->xScrollIncrement;
5383         } else {
5384             xOrigin = (-xOrigin) + canvasPtr->xScrollIncrement/2;
5385             xOrigin = -(xOrigin - (xOrigin - canvasPtr->inset)
5386                     % canvasPtr->xScrollIncrement);
5387         }
5388     }
5389     if (canvasPtr->yScrollIncrement > 0) {
5390         if (yOrigin >= 0) {
5391             yOrigin += canvasPtr->yScrollIncrement/2;
5392             yOrigin -= (yOrigin + canvasPtr->inset)
5393                     % canvasPtr->yScrollIncrement;
5394         } else {
5395             yOrigin = (-yOrigin) + canvasPtr->yScrollIncrement/2;
5396             yOrigin = -(yOrigin - (yOrigin - canvasPtr->inset)
5397                     % canvasPtr->yScrollIncrement);
5398         }
5399     }
5400
5401     /*
5402      * Adjust the origin if necessary to keep as much as possible of the
5403      * canvas in the view.  The variables left, right, etc. keep track of
5404      * how much extra space there is on each side of the view before it
5405      * will stick out past the scroll region.  If one side sticks out past
5406      * the edge of the scroll region, adjust the view to bring that side
5407      * back to the edge of the scrollregion (but don't move it so much that
5408      * the other side sticks out now).  If scroll increments are in effect,
5409      * be sure to adjust only by full increments.
5410      */
5411
5412     if ((canvasPtr->confine) && (canvasPtr->regionString != NULL)) {
5413         left = xOrigin + canvasPtr->inset - canvasPtr->scrollX1;
5414         right = canvasPtr->scrollX2
5415                 - (xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset);
5416         top = yOrigin + canvasPtr->inset - canvasPtr->scrollY1;
5417         bottom = canvasPtr->scrollY2
5418                 - (yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset);
5419         if ((left < 0) && (right > 0)) {
5420             delta = (right > -left) ? -left : right;
5421             if (canvasPtr->xScrollIncrement > 0) {
5422                 delta -= delta % canvasPtr->xScrollIncrement;
5423             }
5424             xOrigin += delta;
5425         } else if ((right < 0) && (left > 0)) {
5426             delta = (left > -right) ? -right : left;
5427             if (canvasPtr->xScrollIncrement > 0) {
5428                 delta -= delta % canvasPtr->xScrollIncrement;
5429             }
5430             xOrigin -= delta;
5431         }
5432         if ((top < 0) && (bottom > 0)) {
5433             delta = (bottom > -top) ? -top : bottom;
5434             if (canvasPtr->yScrollIncrement > 0) {
5435                 delta -= delta % canvasPtr->yScrollIncrement;
5436             }
5437             yOrigin += delta;
5438         } else if ((bottom < 0) && (top > 0)) {
5439             delta = (top > -bottom) ? -bottom : top;
5440             if (canvasPtr->yScrollIncrement > 0) {
5441                 delta -= delta % canvasPtr->yScrollIncrement;
5442             }
5443             yOrigin -= delta;
5444         }
5445     }
5446
5447     if ((xOrigin == canvasPtr->xOrigin) && (yOrigin == canvasPtr->yOrigin)) {
5448         return;
5449     }
5450
5451     /*
5452      * Tricky point: must redisplay not only everything that's visible
5453      * in the window's final configuration, but also everything that was
5454      * visible in the initial configuration.  This is needed because some
5455      * item types, like windows, need to know when they move off-screen
5456      * so they can explicitly undisplay themselves.
5457      */
5458
5459     Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
5460             canvasPtr->xOrigin, canvasPtr->yOrigin,
5461             canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
5462             canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
5463     canvasPtr->xOrigin = xOrigin;
5464     canvasPtr->yOrigin = yOrigin;
5465     canvasPtr->flags |= UPDATE_SCROLLBARS;
5466     Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
5467             canvasPtr->xOrigin, canvasPtr->yOrigin,
5468             canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
5469             canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
5470 }
5471
5472 /*
5473  *----------------------------------------------------------------------
5474  *
5475  * GetStringsFromObjs
5476  *
5477  * Results:
5478  *      Converts object list into string list.
5479  *
5480  * Side effects:
5481  *      Memory is allocated for the argv array, which must
5482  *      be freed using ckfree() when no longer needed.
5483  *
5484  *----------------------------------------------------------------------
5485  */
5486 /* ARGSUSED */
5487 static char **
5488 GetStringsFromObjs(argc, objv)
5489     int argc;
5490     Tcl_Obj *CONST objv[];
5491 {
5492     register int i;
5493     char **argv;
5494     if (argc <= 0) {
5495         return NULL;
5496     }
5497     argv = (char **) ckalloc((argc+1) * sizeof(char *));
5498     for (i = 0; i < argc; i++) {
5499         argv[i]=Tcl_GetStringFromObj(objv[i], (int *) NULL);
5500     }
5501     argv[argc] = 0;
5502     return argv;
5503 }
5504 \f
5505 /*
5506  *--------------------------------------------------------------
5507  *
5508  * Tk_CanvasPsColor --
5509  *
5510  *      This procedure is called by individual canvas items when
5511  *      they want to set a color value for output.  Given information
5512  *      about an X color, this procedure will generate Postscript
5513  *      commands to set up an appropriate color in Postscript.
5514  *
5515  * Results:
5516  *      Returns a standard Tcl return value.  If an error occurs
5517  *      then an error message will be left in interp->result.
5518  *      If no error occurs, then additional Postscript will be
5519  *      appended to interp->result.
5520  *
5521  * Side effects:
5522  *      None.
5523  *
5524  *--------------------------------------------------------------
5525  */
5526
5527 int
5528 Tk_CanvasPsColor(interp, canvas, colorPtr)
5529     Tcl_Interp *interp;                 /* Interpreter for returning Postscript
5530                                          * or error message. */
5531     Tk_Canvas canvas;                   /* Information about canvas. */
5532     XColor *colorPtr;                   /* Information about color. */
5533 {
5534     return Tk_PostscriptColor(interp, ((TkCanvas *) canvas)->psInfo,
5535             colorPtr);
5536 }
5537 \f
5538 /*
5539  *--------------------------------------------------------------
5540  *
5541  * Tk_CanvasPsFont --
5542  *
5543  *      This procedure is called by individual canvas items when
5544  *      they want to output text.  Given information about an X
5545  *      font, this procedure will generate Postscript commands
5546  *      to set up an appropriate font in Postscript.
5547  *
5548  * Results:
5549  *      Returns a standard Tcl return value.  If an error occurs
5550  *      then an error message will be left in interp->result.
5551  *      If no error occurs, then additional Postscript will be
5552  *      appended to the interp->result.
5553  *
5554  * Side effects:
5555  *      The Postscript font name is entered into psInfoPtr->fontTable
5556  *      if it wasn't already there.
5557  *
5558  *--------------------------------------------------------------
5559  */
5560
5561 int
5562 Tk_CanvasPsFont(interp, canvas, tkfont)
5563     Tcl_Interp *interp;                 /* Interpreter for returning Postscript
5564                                          * or error message. */
5565     Tk_Canvas canvas;                   /* Information about canvas. */
5566     Tk_Font tkfont;                     /* Information about font in which text
5567                                          * is to be printed. */
5568 {
5569     return Tk_PostscriptFont(interp, ((TkCanvas *) canvas)->psInfo, tkfont);
5570 }
5571 \f
5572 /*
5573  *--------------------------------------------------------------
5574  *
5575  * Tk_CanvasPsBitmap --
5576  *
5577  *      This procedure is called to output the contents of a
5578  *      sub-region of a bitmap in proper image data format for
5579  *      Postscript (i.e. data between angle brackets, one bit
5580  *      per pixel).
5581  *
5582  * Results:
5583  *      Returns a standard Tcl return value.  If an error occurs
5584  *      then an error message will be left in interp->result.
5585  *      If no error occurs, then additional Postscript will be
5586  *      appended to interp->result.
5587  *
5588  * Side effects:
5589  *      None.
5590  *
5591  *--------------------------------------------------------------
5592  */
5593
5594 int
5595 Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
5596     Tcl_Interp *interp;                 /* Interpreter for returning Postscript
5597                                          * or error message. */
5598     Tk_Canvas canvas;                   /* Information about canvas. */
5599     Pixmap bitmap;                      /* Bitmap for which to generate
5600                                          * Postscript. */
5601     int startX, startY;                 /* Coordinates of upper-left corner
5602                                          * of rectangular region to output. */
5603     int width, height;                  /* Height of rectangular region. */
5604 {
5605     return Tk_PostscriptBitmap(interp, ((TkCanvas *) canvas)->tkwin,
5606             ((TkCanvas *) canvas)->psInfo, bitmap, startX, startY,
5607             width, height);
5608 }
5609 \f
5610 /*
5611  *--------------------------------------------------------------
5612  *
5613  * Tk_CanvasPsStipple --
5614  *
5615  *      This procedure is called by individual canvas items when
5616  *      they have created a path that they'd like to be filled with
5617  *      a stipple pattern.  Given information about an X bitmap,
5618  *      this procedure will generate Postscript commands to fill
5619  *      the current clip region using a stipple pattern defined by the
5620  *      bitmap.
5621  *
5622  * Results:
5623  *      Returns a standard Tcl return value.  If an error occurs
5624  *      then an error message will be left in interp->result.
5625  *      If no error occurs, then additional Postscript will be
5626  *      appended to interp->result.
5627  *
5628  * Side effects:
5629  *      None.
5630  *
5631  *--------------------------------------------------------------
5632  */
5633
5634 int
5635 Tk_CanvasPsStipple(interp, canvas, bitmap)
5636     Tcl_Interp *interp;                 /* Interpreter for returning Postscript
5637                                          * or error message. */
5638     Tk_Canvas canvas;                   /* Information about canvas. */
5639     Pixmap bitmap;                      /* Bitmap to use for stippling. */
5640 {
5641     return Tk_PostscriptStipple(interp, ((TkCanvas *) canvas)->tkwin,
5642             ((TkCanvas *) canvas)->psInfo, bitmap);
5643 }
5644 \f
5645 /*
5646  *--------------------------------------------------------------
5647  *
5648  * Tk_CanvasPsY --
5649  *
5650  *      Given a y-coordinate in canvas coordinates, this procedure
5651  *      returns a y-coordinate to use for Postscript output.
5652  *
5653  * Results:
5654  *      Returns the Postscript coordinate that corresponds to
5655  *      "y".
5656  *
5657  * Side effects:
5658  *      None.
5659  *
5660  *--------------------------------------------------------------
5661  */
5662
5663 double
5664 Tk_CanvasPsY(canvas, y)
5665     Tk_Canvas canvas;                   /* Token for canvas on whose behalf
5666                                          * Postscript is being generated. */
5667     double y;                           /* Y-coordinate in canvas coords. */
5668 {
5669     return Tk_PostscriptY(y, ((TkCanvas *) canvas)->psInfo);
5670 }
5671 \f
5672 /*
5673  *--------------------------------------------------------------
5674  *
5675  * Tk_CanvasPsPath --
5676  *
5677  *      Given an array of points for a path, generate Postscript
5678  *      commands to create the path.
5679  *
5680  * Results:
5681  *      Postscript commands get appended to what's in interp->result.
5682  *
5683  * Side effects:
5684  *      None.
5685  *
5686  *--------------------------------------------------------------
5687  */
5688
5689 void
5690 Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
5691     Tcl_Interp *interp;                 /* Put generated Postscript in this
5692                                          * interpreter's result field. */
5693     Tk_Canvas canvas;                   /* Canvas on whose behalf Postscript
5694                                          * is being generated. */
5695     double *coordPtr;                   /* Pointer to first in array of
5696                                          * 2*numPoints coordinates giving
5697                                          * points for path. */
5698     int numPoints;                      /* Number of points at *coordPtr. */
5699 {
5700     Tk_PostscriptPath(interp, ((TkCanvas *) canvas)->psInfo,
5701             coordPtr, numPoints);
5702 }
5703
5704