OSDN Git Service

*** empty log message ***
[pf3gnuchains/sourceware.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 CONST 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 Tcl_Obj *        ScrollFractions _ANSI_ARGS_((int screen1,
303                             int screen2, int object1, int object2));
304 #ifdef USE_OLD_TAG_SEARCH
305 static void             RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
306                             Tcl_Obj *tag, Tk_Item *prevPtr));
307 static Tk_Item *        StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
308                             Tcl_Obj *tag, TagSearch *searchPtr));
309 #else /* USE_OLD_TAG_SEARCH */
310 static int              RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
311                             Tcl_Obj *tag, Tk_Item *prevPtr,
312                             TagSearch **searchPtrPtr));
313 static void             TagSearchExprInit _ANSI_ARGS_ ((
314                             TagSearchExpr **exprPtrPtr));
315 static void             TagSearchExprDestroy _ANSI_ARGS_((TagSearchExpr *expr));
316 static void             TagSearchDestroy _ANSI_ARGS_((TagSearch *searchPtr));
317 static int              TagSearchScan _ANSI_ARGS_((TkCanvas *canvasPtr,
318                             Tcl_Obj *tag, TagSearch **searchPtrPtr));
319 static int              TagSearchScanExpr _ANSI_ARGS_((Tcl_Interp *interp,
320                             TagSearch *searchPtr, TagSearchExpr *expr));
321 static int              TagSearchEvalExpr _ANSI_ARGS_((TagSearchExpr *expr,
322                             Tk_Item *itemPtr));
323 static Tk_Item *        TagSearchFirst _ANSI_ARGS_((TagSearch *searchPtr));
324 static Tk_Item *        TagSearchNext _ANSI_ARGS_((TagSearch *searchPtr));
325 #endif /* USE_OLD_TAG_SEARCH */
326
327 /*
328  * The structure below defines canvas class behavior by means of procedures
329  * that can be invoked from generic window code.
330  */
331
332 static Tk_ClassProcs canvasClass = {
333     sizeof(Tk_ClassProcs),      /* size */
334     CanvasWorldChanged,         /* worldChangedProc */
335 };
336
337 \f
338 /*
339  *--------------------------------------------------------------
340  *
341  * Tk_CanvasObjCmd --
342  *
343  *      This procedure is invoked to process the "canvas" Tcl
344  *      command.  See the user documentation for details on what
345  *      it does.
346  *
347  * Results:
348  *      A standard Tcl result.
349  *
350  * Side effects:
351  *      See the user documentation.
352  *
353  *--------------------------------------------------------------
354  */
355
356 int
357 Tk_CanvasObjCmd(clientData, interp, argc, argv)
358     ClientData clientData;              /* Main window associated with
359                                  * interpreter. */
360     Tcl_Interp *interp;         /* Current interpreter. */
361     int argc;                   /* Number of arguments. */
362     Tcl_Obj *CONST argv[];      /* Argument objects. */
363 {
364     Tk_Window tkwin = (Tk_Window) clientData;
365     TkCanvas *canvasPtr;
366     Tk_Window new;
367
368     if (typeList == NULL) {
369         InitCanvas();
370     }
371
372     if (argc < 2) {
373         Tcl_WrongNumArgs(interp, 1, argv, "pathName ?options?");
374         return TCL_ERROR;
375     }
376
377     new = Tk_CreateWindowFromPath(interp, tkwin,
378             Tcl_GetString(argv[1]), (char *) NULL);
379     if (new == NULL) {
380         return TCL_ERROR;
381     }
382
383     /*
384      * Initialize fields that won't be initialized by ConfigureCanvas,
385      * or which ConfigureCanvas expects to have reasonable values
386      * (e.g. resource pointers).
387      */
388
389     canvasPtr = (TkCanvas *) ckalloc(sizeof(TkCanvas));
390     canvasPtr->tkwin = new;
391     canvasPtr->display = Tk_Display(new);
392     canvasPtr->interp = interp;
393     canvasPtr->widgetCmd = Tcl_CreateObjCommand(interp,
394             Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd,
395             (ClientData) canvasPtr, CanvasCmdDeletedProc);
396     canvasPtr->firstItemPtr = NULL;
397     canvasPtr->lastItemPtr = NULL;
398     canvasPtr->borderWidth = 0;
399     canvasPtr->bgBorder = NULL;
400     canvasPtr->relief = TK_RELIEF_FLAT;
401     canvasPtr->highlightWidth = 0;
402     canvasPtr->highlightBgColorPtr = NULL;
403     canvasPtr->highlightColorPtr = NULL;
404     canvasPtr->inset = 0;
405     canvasPtr->pixmapGC = None;
406     canvasPtr->width = None;
407     canvasPtr->height = None;
408     canvasPtr->confine = 0;
409     canvasPtr->textInfo.selBorder = NULL;
410     canvasPtr->textInfo.selBorderWidth = 0;
411     canvasPtr->textInfo.selFgColorPtr = NULL;
412     canvasPtr->textInfo.selItemPtr = NULL;
413     canvasPtr->textInfo.selectFirst = -1;
414     canvasPtr->textInfo.selectLast = -1;
415     canvasPtr->textInfo.anchorItemPtr = NULL;
416     canvasPtr->textInfo.selectAnchor = 0;
417     canvasPtr->textInfo.insertBorder = NULL;
418     canvasPtr->textInfo.insertWidth = 0;
419     canvasPtr->textInfo.insertBorderWidth = 0;
420     canvasPtr->textInfo.focusItemPtr = NULL;
421     canvasPtr->textInfo.gotFocus = 0;
422     canvasPtr->textInfo.cursorOn = 0;
423     canvasPtr->insertOnTime = 0;
424     canvasPtr->insertOffTime = 0;
425     canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
426     canvasPtr->xOrigin = canvasPtr->yOrigin = 0;
427     canvasPtr->drawableXOrigin = canvasPtr->drawableYOrigin = 0;
428     canvasPtr->bindingTable = NULL;
429     canvasPtr->currentItemPtr = NULL;
430     canvasPtr->newCurrentPtr = NULL;
431     canvasPtr->closeEnough = 0.0;
432     canvasPtr->pickEvent.type = LeaveNotify;
433     canvasPtr->pickEvent.xcrossing.x = 0;
434     canvasPtr->pickEvent.xcrossing.y = 0;
435     canvasPtr->state = 0;
436     canvasPtr->xScrollCmd = NULL;
437     canvasPtr->yScrollCmd = NULL;
438     canvasPtr->scrollX1 = 0;
439     canvasPtr->scrollY1 = 0;
440     canvasPtr->scrollX2 = 0;
441     canvasPtr->scrollY2 = 0;
442     canvasPtr->regionString = NULL;
443     canvasPtr->xScrollIncrement = 0;
444     canvasPtr->yScrollIncrement = 0;
445     canvasPtr->scanX = 0;
446     canvasPtr->scanXOrigin = 0;
447     canvasPtr->scanY = 0;
448     canvasPtr->scanYOrigin = 0;
449     canvasPtr->hotPtr = NULL;
450     canvasPtr->hotPrevPtr = NULL;
451     canvasPtr->cursor = None;
452     canvasPtr->takeFocus = NULL;
453     canvasPtr->pixelsPerMM = WidthOfScreen(Tk_Screen(new));
454     canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(new));
455     canvasPtr->flags = 0;
456     canvasPtr->nextId = 1;
457     canvasPtr->psInfo = NULL;
458     canvasPtr->canvas_state = TK_STATE_NORMAL;
459     canvasPtr->tsoffset.flags = 0;
460     canvasPtr->tsoffset.xoffset = 0;
461     canvasPtr->tsoffset.yoffset = 0;
462 #ifndef USE_OLD_TAG_SEARCH
463     canvasPtr->bindTagExprs = NULL;
464 #endif
465     Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS);
466
467     Tk_SetClass(canvasPtr->tkwin, "Canvas");
468     Tk_SetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr);
469     Tk_CreateEventHandler(canvasPtr->tkwin,
470             ExposureMask|StructureNotifyMask|FocusChangeMask,
471             CanvasEventProc, (ClientData) canvasPtr);
472     Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask
473             |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
474             |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
475             CanvasBindProc, (ClientData) canvasPtr);
476     Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING,
477             CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING);
478     if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) {
479         goto error;
480     }
481
482     Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC);
483     return TCL_OK;
484
485     error:
486     Tk_DestroyWindow(canvasPtr->tkwin);
487     return TCL_ERROR;
488 }
489 \f
490 /*
491  *--------------------------------------------------------------
492  *
493  * CanvasWidgetCmd --
494  *
495  *      This procedure is invoked to process the Tcl command
496  *      that corresponds to a widget managed by this module.
497  *      See the user documentation for details on what it does.
498  *
499  * Results:
500  *      A standard Tcl result.
501  *
502  * Side effects:
503  *      See the user documentation.
504  *
505  *--------------------------------------------------------------
506  */
507
508 static int
509 CanvasWidgetCmd(clientData, interp, argc, argv)
510     ClientData clientData;              /* Information about canvas
511                                          * widget. */
512     Tcl_Interp *interp;                 /* Current interpreter. */
513     int argc;                           /* Number of arguments. */
514     Tcl_Obj *CONST argv[];              /* Argument objects. */
515 {
516     TkCanvas *canvasPtr = (TkCanvas *) clientData;
517     unsigned int length;
518     int c, result;
519     Tk_Item *itemPtr = NULL;            /* Initialization needed only to
520                                          * prevent compiler warning. */
521 #ifdef USE_OLD_TAG_SEARCH
522     TagSearch search;
523 #else /* USE_OLD_TAG_SEARCH */
524     TagSearch *searchPtr = NULL;        /* Allocated by first TagSearchScan
525                                          * Freed by TagSearchDestroy */
526 #endif /* USE_OLD_TAG_SEARCH */
527
528     int index;
529     static CONST char *optionStrings[] = {
530         "addtag",       "bbox",         "bind",         "canvasx",
531         "canvasy",      "cget",         "configure",    "coords",
532         "create",       "dchars",       "delete",       "dtag",
533         "find",         "focus",        "gettags",      "icursor",
534         "index",        "insert",       "itemcget",     "itemconfigure",
535         "lower",        "move",         "postscript",   "raise",
536         "scale",        "scan",         "select",       "type",
537         "xview",        "yview",
538         NULL
539     };
540     enum options {
541         CANV_ADDTAG,    CANV_BBOX,      CANV_BIND,      CANV_CANVASX,
542         CANV_CANVASY,   CANV_CGET,      CANV_CONFIGURE, CANV_COORDS,
543         CANV_CREATE,    CANV_DCHARS,    CANV_DELETE,    CANV_DTAG,
544         CANV_FIND,      CANV_FOCUS,     CANV_GETTAGS,   CANV_ICURSOR,
545         CANV_INDEX,     CANV_INSERT,    CANV_ITEMCGET,  CANV_ITEMCONFIGURE,
546         CANV_LOWER,     CANV_MOVE,      CANV_POSTSCRIPT,CANV_RAISE,
547         CANV_SCALE,     CANV_SCAN,      CANV_SELECT,    CANV_TYPE,
548         CANV_XVIEW,     CANV_YVIEW
549     };
550
551     if (argc < 2) {
552         Tcl_WrongNumArgs(interp, 1, argv, "option ?arg arg ...?");
553         return TCL_ERROR;
554     }
555     if (Tcl_GetIndexFromObj(interp, argv[1], optionStrings, "option", 0,
556             &index) != TCL_OK) {
557         return TCL_ERROR;
558     }
559     Tcl_Preserve((ClientData) canvasPtr);
560
561     result = TCL_OK;
562     switch ((enum options) index) {
563       case CANV_ADDTAG: {
564         if (argc < 4) {
565             Tcl_WrongNumArgs(interp, 2, argv, "tag searchCommand ?arg arg ...?");
566             result = TCL_ERROR;
567             goto done;
568         }
569 #ifdef USE_OLD_TAG_SEARCH
570         result = FindItems(interp, canvasPtr, argc, argv, argv[2], 3);
571 #else /* USE_OLD_TAG_SEARCH */
572         result = FindItems(interp, canvasPtr, argc, argv, argv[2], 3, &searchPtr);
573 #endif /* USE_OLD_TAG_SEARCH */
574         break;
575       }
576
577       case CANV_BBOX: {
578         int i, gotAny;
579         int x1 = 0, y1 = 0, x2 = 0, y2 = 0;     /* Initializations needed
580                                                  * only to prevent compiler
581                                                  * warnings. */
582
583         if (argc < 3) {
584             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagOrId ...?");
585             result = TCL_ERROR;
586             goto done;
587         }
588         gotAny = 0;
589         for (i = 2; i < argc; i++) {
590 #ifdef USE_OLD_TAG_SEARCH
591             for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
592                     itemPtr != NULL; itemPtr = NextItem(&search)) {
593 #else /* USE_OLD_TAG_SEARCH */
594             if ((result = TagSearchScan(canvasPtr, argv[i], &searchPtr)) != TCL_OK) {
595                 goto done;
596             }
597             for (itemPtr = TagSearchFirst(searchPtr);
598                     itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
599 #endif /* USE_OLD_TAG_SEARCH */
600
601                 if ((itemPtr->x1 >= itemPtr->x2)
602                         || (itemPtr->y1 >= itemPtr->y2)) {
603                     continue;
604                 }
605                 if (!gotAny) {
606                     x1 = itemPtr->x1;
607                     y1 = itemPtr->y1;
608                     x2 = itemPtr->x2;
609                     y2 = itemPtr->y2;
610                     gotAny = 1;
611                 } else {
612                     if (itemPtr->x1 < x1) {
613                         x1 = itemPtr->x1;
614                     }
615                     if (itemPtr->y1 < y1) {
616                         y1 = itemPtr->y1;
617                     }
618                     if (itemPtr->x2 > x2) {
619                         x2 = itemPtr->x2;
620                     }
621                     if (itemPtr->y2 > y2) {
622                         y2 = itemPtr->y2;
623                     }
624                 }
625             }
626         }
627         if (gotAny) {
628             char buf[TCL_INTEGER_SPACE * 4];
629             
630             sprintf(buf, "%d %d %d %d", x1, y1, x2, y2);
631             Tcl_SetResult(interp, buf, TCL_VOLATILE);
632         }
633         break;
634       }
635       case CANV_BIND: {
636         ClientData object;
637
638         if ((argc < 3) || (argc > 5)) {
639             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?sequence? ?command?");
640             result = TCL_ERROR;
641             goto done;
642         }
643
644         /*
645          * Figure out what object to use for the binding (individual
646          * item vs. tag).
647          */
648
649         object = 0;
650 #ifdef USE_OLD_TAG_SEARCH
651         if (isdigit(UCHAR(Tcl_GetString(argv[2])[0]))) {
652             int id;
653             char *end;
654             Tcl_HashEntry *entryPtr;
655
656             id = strtoul(Tcl_GetString(argv[2]), &end, 0);
657             if (*end != 0) {
658                 goto bindByTag;
659             }
660             entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
661             if (entryPtr != NULL) {
662                 itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr);
663                 object = (ClientData) itemPtr;
664             }
665
666             if (object == 0) {
667                 Tcl_AppendResult(interp, "item \"", Tcl_GetString(argv[2]),
668                         "\" doesn't exist", (char *) NULL);
669                 result = TCL_ERROR;
670                 goto done;
671             }
672         } else {
673             bindByTag:
674             object = (ClientData) Tk_GetUid(Tcl_GetString(argv[2]));
675         }
676 #else /* USE_OLD_TAG_SEARCH */
677         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
678             goto done;
679         }
680         if (searchPtr->type == 1) {
681             Tcl_HashEntry *entryPtr;
682
683             entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) searchPtr->id);
684             if (entryPtr != NULL) {
685                 itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr);
686                 object = (ClientData) itemPtr;
687             }
688
689             if (object == 0) {
690                 Tcl_AppendResult(interp, "item \"", Tcl_GetString(argv[2]),
691                         "\" doesn't exist", (char *) NULL);
692                 result = TCL_ERROR;
693                 goto done;
694             }
695         } else {
696             object = (ClientData) searchPtr->expr->uid;
697         }
698 #endif /* USE_OLD_TAG_SEARCH */
699
700         /*
701          * Make a binding table if the canvas doesn't already have
702          * one.
703          */
704
705         if (canvasPtr->bindingTable == NULL) {
706             canvasPtr->bindingTable = Tk_CreateBindingTable(interp);
707         }
708
709         if (argc == 5) {
710             int append = 0;
711             unsigned long mask;
712             char* argv4 = Tcl_GetStringFromObj(argv[4],NULL);
713
714             if (argv4[0] == 0) {
715                 result = Tk_DeleteBinding(interp, canvasPtr->bindingTable,
716                         object, Tcl_GetStringFromObj(argv[3], NULL));
717                 goto done;
718             }
719 #ifndef USE_OLD_TAG_SEARCH
720             if (searchPtr->type == 4) {
721                 /*
722                  * if new tag expression, then insert in linked list
723                  */
724                 TagSearchExpr *expr, **lastPtr;
725
726                 lastPtr = &(canvasPtr->bindTagExprs);
727                 while ((expr = *lastPtr) != NULL) {
728                     if (expr->uid == searchPtr->expr->uid) {
729                         break;
730                     }
731                     lastPtr = &(expr->next);
732                 }
733                 if (!expr) {
734                     /*
735                      * transfer ownership of expr to bindTagExprs list
736                      */
737                     *lastPtr = searchPtr->expr;
738                     searchPtr->expr->next = NULL;
739
740                     /*
741                      * flag in TagSearch that expr has changed ownership
742                      * so that TagSearchDestroy doesn't try to free it
743                      */
744                     searchPtr->expr = NULL;
745                 }
746             }
747 #endif /* not USE_OLD_TAG_SEARCH */
748             if (argv4[0] == '+') {
749                 argv4++;
750                 append = 1;
751             }
752             mask = Tk_CreateBinding(interp, canvasPtr->bindingTable,
753                     object, Tcl_GetStringFromObj(argv[3],NULL), argv4, append);
754             if (mask == 0) {
755                 result = TCL_ERROR;
756                 goto done;
757             }
758             if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
759                     |Button2MotionMask|Button3MotionMask|Button4MotionMask
760                     |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
761                     |EnterWindowMask|LeaveWindowMask|KeyPressMask
762                     |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
763                 Tk_DeleteBinding(interp, canvasPtr->bindingTable,
764                         object, Tcl_GetStringFromObj(argv[3], NULL));
765                 Tcl_ResetResult(interp);
766                 Tcl_AppendResult(interp, "requested illegal events; ",
767                         "only key, button, motion, enter, leave, and virtual ",
768                         "events may be used", (char *) NULL);
769                 result = TCL_ERROR;
770                 goto done;
771             }
772         } else if (argc == 4) {
773             CONST char *command;
774     
775             command = Tk_GetBinding(interp, canvasPtr->bindingTable,
776                     object, Tcl_GetStringFromObj(argv[3], NULL));
777             if (command == NULL) {
778                 CONST char *string;
779
780                 string = Tcl_GetStringResult(interp); 
781                 /*
782                  * Ignore missing binding errors.  This is a special hack
783                  * that relies on the error message returned by FindSequence
784                  * in tkBind.c.
785                  */
786
787                 if (string[0] != '\0') {
788                     result = TCL_ERROR;
789                     goto done;
790                 } else {
791                     Tcl_ResetResult(interp);
792                 }
793             } else {
794                 Tcl_SetResult(interp, (char *) command, TCL_STATIC);
795             }
796         } else {
797             Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
798         }
799         break;
800       }
801       case CANV_CANVASX: {
802         int x;
803         double grid;
804         char buf[TCL_DOUBLE_SPACE];
805
806         if ((argc < 3) || (argc > 4)) {
807             Tcl_WrongNumArgs(interp, 2, argv, "screenx ?gridspacing?");
808             result = TCL_ERROR;
809             goto done;
810         }
811         if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
812             result = TCL_ERROR;
813             goto done;
814         }
815         if (argc == 4) {
816             if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
817                     &grid) != TCL_OK) {
818                 result = TCL_ERROR;
819                 goto done;
820             }
821         } else {
822             grid = 0.0;
823         }
824         x += canvasPtr->xOrigin;
825         Tcl_PrintDouble(interp, GridAlign((double) x, grid), buf);
826         Tcl_SetResult(interp, buf, TCL_VOLATILE);
827         break;
828       }
829       case CANV_CANVASY: {
830         int y;
831         double grid;
832         char buf[TCL_DOUBLE_SPACE];
833
834         if ((argc < 3) || (argc > 4)) {
835             Tcl_WrongNumArgs(interp, 2, argv, "screeny ?gridspacing?");
836             result = TCL_ERROR;
837             goto done;
838         }
839         if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
840             result = TCL_ERROR;
841             goto done;
842         }
843         if (argc == 4) {
844             if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
845                     argv[3], &grid) != TCL_OK) {
846                 result = TCL_ERROR;
847                 goto done;
848             }
849         } else {
850             grid = 0.0;
851         }
852         y += canvasPtr->yOrigin;
853         Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf);
854         Tcl_SetResult(interp, buf, TCL_VOLATILE);
855         break;
856       }
857       case CANV_CGET: {
858         if (argc != 3) {
859             Tcl_WrongNumArgs(interp, 2, argv, "option");
860             result = TCL_ERROR;
861             goto done;
862         }
863         result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs,
864                 (char *) canvasPtr, Tcl_GetString(argv[2]), 0);
865         break;
866       }
867       case CANV_CONFIGURE: {
868         if (argc == 2) {
869             result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
870                     (char *) canvasPtr, (char *) NULL, 0);
871         } else if (argc == 3) {
872             result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
873                     (char *) canvasPtr, Tcl_GetString(argv[2]), 0);
874         } else {
875             result = ConfigureCanvas(interp, canvasPtr, argc-2, argv+2,
876                     TK_CONFIG_ARGV_ONLY);
877         }
878         break;
879       }
880       case CANV_COORDS: {
881         if (argc < 3) {
882             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?x y x y ...?");
883             result = TCL_ERROR;
884             goto done;
885         }
886 #ifdef USE_OLD_TAG_SEARCH
887         itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
888 #else /* USE_OLD_TAG_SEARCH */
889         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
890             goto done;
891         }
892         itemPtr = TagSearchFirst(searchPtr);
893 #endif /* USE_OLD_TAG_SEARCH */
894         if (itemPtr != NULL) {
895             if (argc != 3) {
896                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
897             }
898             if (itemPtr->typePtr->coordProc != NULL) {
899               if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
900                 result = (*itemPtr->typePtr->coordProc)(interp,
901                         (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3);
902               } else {
903                 CONST char **args = GetStringsFromObjs(argc-3, argv+3);
904                 result = (*itemPtr->typePtr->coordProc)(interp,
905                         (Tk_Canvas) canvasPtr, itemPtr, argc-3, (Tcl_Obj **) args);
906                 if (args) ckfree((char *) args);
907               }
908             }
909             if (argc != 3) {
910                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
911             }
912         }
913         break;
914       }
915       case CANV_CREATE: {
916         Tk_ItemType *typePtr;
917         Tk_ItemType *matchPtr = NULL;
918         Tk_Item *itemPtr;
919         char buf[TCL_INTEGER_SPACE];
920         int isNew = 0;
921         Tcl_HashEntry *entryPtr;
922         char *arg;
923
924         if (argc < 3) {
925             Tcl_WrongNumArgs(interp, 2, argv, "type ?arg arg ...?");
926             result = TCL_ERROR;
927             goto done;
928         }
929         arg = Tcl_GetStringFromObj(argv[2], (int *) &length);
930         c = arg[0];
931         for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) {
932             if ((c == typePtr->name[0])
933                     && (strncmp(arg, typePtr->name, length) == 0)) {
934                 if (matchPtr != NULL) {
935                     badType:
936                     Tcl_AppendResult(interp,
937                             "unknown or ambiguous item type \"",
938                             arg, "\"", (char *) NULL);
939                     result = TCL_ERROR;
940                     goto done;
941                 }
942                 matchPtr = typePtr;
943             }
944         }
945         if (matchPtr == NULL) {
946             goto badType;
947         }
948         typePtr = matchPtr;
949         itemPtr = (Tk_Item *) ckalloc((unsigned) typePtr->itemSize);
950         itemPtr->id = canvasPtr->nextId;
951         canvasPtr->nextId++;
952         itemPtr->tagPtr = itemPtr->staticTagSpace;
953         itemPtr->tagSpace = TK_TAG_SPACE;
954         itemPtr->numTags = 0;
955         itemPtr->typePtr = typePtr;
956         itemPtr->state = TK_STATE_NULL;
957         itemPtr->redraw_flags = 0;
958         if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
959           result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
960                 itemPtr, argc-3, argv+3);
961         } else {
962           CONST char **args = GetStringsFromObjs(argc-3, argv+3);
963           result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
964                 itemPtr, argc-3, (Tcl_Obj **) args);
965           if (args) ckfree((char *) args);
966         }
967         if (result != TCL_OK) {
968             ckfree((char *) itemPtr);
969             result = TCL_ERROR;
970             goto done;
971         }
972         itemPtr->nextPtr = NULL;
973         entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable,
974                 (char *) itemPtr->id, &isNew);
975         Tcl_SetHashValue(entryPtr, itemPtr);
976         itemPtr->prevPtr = canvasPtr->lastItemPtr;
977         canvasPtr->hotPtr = itemPtr;
978         canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr;
979         if (canvasPtr->lastItemPtr == NULL) {
980             canvasPtr->firstItemPtr = itemPtr;
981         } else {
982             canvasPtr->lastItemPtr->nextPtr = itemPtr;
983         }
984         canvasPtr->lastItemPtr = itemPtr;
985         itemPtr->redraw_flags |= FORCE_REDRAW;
986         EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
987         canvasPtr->flags |= REPICK_NEEDED;
988         sprintf(buf, "%d", itemPtr->id);
989         Tcl_SetResult(interp, buf, TCL_VOLATILE);
990         break;
991       }
992       case CANV_DCHARS: {
993         int first, last;
994         int x1,x2,y1,y2;
995
996         if ((argc != 4) && (argc != 5)) {
997             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId first ?last?");
998             result = TCL_ERROR;
999             goto done;
1000         }
1001 #ifdef USE_OLD_TAG_SEARCH
1002         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1003                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1004 #else /* USE_OLD_TAG_SEARCH */
1005         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1006             goto done;
1007         }
1008         for (itemPtr = TagSearchFirst(searchPtr);
1009                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1010 #endif /* USE_OLD_TAG_SEARCH */
1011             if ((itemPtr->typePtr->indexProc == NULL)
1012                     || (itemPtr->typePtr->dCharsProc == NULL)) {
1013                 continue;
1014             }
1015             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1016                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1017                         itemPtr, (char *) argv[3], &first);
1018             } else {
1019                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1020                         itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &first);
1021             }
1022             if (result != TCL_OK) {
1023                 goto done;
1024             }
1025             if (argc == 5) {
1026                 if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1027                     result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1028                             itemPtr, (char *) argv[4], &last);
1029                 } else {
1030                     result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1031                             itemPtr, Tcl_GetStringFromObj(argv[4], NULL), &last);
1032                 }
1033                 if (result != TCL_OK) {
1034                     goto done;
1035                 }
1036             } else {
1037                 last = first;
1038             }
1039
1040             /*
1041              * Redraw both item's old and new areas:  it's possible
1042              * that a delete could result in a new area larger than
1043              * the old area. Except if the insertProc sets the
1044              * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done.
1045              */
1046
1047             x1 = itemPtr->x1; y1 = itemPtr->y1;
1048             x2 = itemPtr->x2; y2 = itemPtr->y2;
1049             itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
1050             (*itemPtr->typePtr->dCharsProc)((Tk_Canvas) canvasPtr,
1051                     itemPtr, first, last);
1052             if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
1053                 Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
1054                         x1, y1, x2, y2);
1055                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1056             }
1057             itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
1058         }
1059         break;
1060       }
1061       case CANV_DELETE: {
1062         int i;
1063         Tcl_HashEntry *entryPtr;
1064
1065         for (i = 2; i < argc; i++) {
1066 #ifdef USE_OLD_TAG_SEARCH
1067             for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
1068                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1069 #else /* USE_OLD_TAG_SEARCH */
1070             if ((result = TagSearchScan(canvasPtr, argv[i], &searchPtr)) != TCL_OK) {
1071                 goto done;
1072             }
1073             for (itemPtr = TagSearchFirst(searchPtr);
1074                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1075 #endif /* USE_OLD_TAG_SEARCH */
1076                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1077                 if (canvasPtr->bindingTable != NULL) {
1078                     Tk_DeleteAllBindings(canvasPtr->bindingTable,
1079                             (ClientData) itemPtr);
1080                 }
1081                 (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
1082                         canvasPtr->display);
1083                 if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
1084                     ckfree((char *) itemPtr->tagPtr);
1085                 }
1086                 entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable,
1087                         (char *) itemPtr->id);
1088                 Tcl_DeleteHashEntry(entryPtr);
1089                 if (itemPtr->nextPtr != NULL) {
1090                     itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
1091                 }
1092                 if (itemPtr->prevPtr != NULL) {
1093                     itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
1094                 }
1095                 if (canvasPtr->firstItemPtr == itemPtr) {
1096                     canvasPtr->firstItemPtr = itemPtr->nextPtr;
1097                     if (canvasPtr->firstItemPtr == NULL) {
1098                         canvasPtr->lastItemPtr = NULL;
1099                     }
1100                 }
1101                 if (canvasPtr->lastItemPtr == itemPtr) {
1102                     canvasPtr->lastItemPtr = itemPtr->prevPtr;
1103                 }
1104                 ckfree((char *) itemPtr);
1105                 if (itemPtr == canvasPtr->currentItemPtr) {
1106                     canvasPtr->currentItemPtr = NULL;
1107                     canvasPtr->flags |= REPICK_NEEDED;
1108                 }
1109                 if (itemPtr == canvasPtr->newCurrentPtr) {
1110                     canvasPtr->newCurrentPtr = NULL;
1111                     canvasPtr->flags |= REPICK_NEEDED;
1112                 }
1113                 if (itemPtr == canvasPtr->textInfo.focusItemPtr) {
1114                     canvasPtr->textInfo.focusItemPtr = NULL;
1115                 }
1116                 if (itemPtr == canvasPtr->textInfo.selItemPtr) {
1117                     canvasPtr->textInfo.selItemPtr = NULL;
1118                 }
1119                 if ((itemPtr == canvasPtr->hotPtr)
1120                         || (itemPtr == canvasPtr->hotPrevPtr)) {
1121                     canvasPtr->hotPtr = NULL;
1122                 }
1123             }
1124         }
1125         break;
1126       }
1127       case CANV_DTAG: {
1128         Tk_Uid tag;
1129         int i;
1130
1131         if ((argc != 3) && (argc != 4)) {
1132             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagToDelete?");
1133             result = TCL_ERROR;
1134             goto done;
1135         }
1136         if (argc == 4) {
1137             tag = Tk_GetUid(Tcl_GetStringFromObj(argv[3], NULL));
1138         } else {
1139             tag = Tk_GetUid(Tcl_GetStringFromObj(argv[2], NULL));
1140         }
1141 #ifdef USE_OLD_TAG_SEARCH
1142         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1143                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1144 #else /* USE_OLD_TAG_SEARCH */
1145         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1146             goto done;
1147         }
1148         for (itemPtr = TagSearchFirst(searchPtr);
1149                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1150 #endif /* USE_OLD_TAG_SEARCH */
1151             for (i = itemPtr->numTags-1; i >= 0; i--) {
1152                 if (itemPtr->tagPtr[i] == tag) {
1153                     itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
1154                     itemPtr->numTags--;
1155                 }
1156             }
1157         }
1158         break;
1159       }
1160       case CANV_FIND: {
1161         if (argc < 3) {
1162             Tcl_WrongNumArgs(interp, 2, argv, "searchCommand ?arg arg ...?");
1163             result = TCL_ERROR;
1164             goto done;
1165         }
1166 #ifdef USE_OLD_TAG_SEARCH
1167         result = FindItems(interp, canvasPtr, argc, argv, (Tcl_Obj *) NULL, 2);
1168 #else /* USE_OLD_TAG_SEARCH */
1169         result = FindItems(interp, canvasPtr, argc, argv,
1170             (Tcl_Obj *) NULL, 2, &searchPtr);
1171 #endif /* USE_OLD_TAG_SEARCH */
1172         break;
1173       }
1174       case CANV_FOCUS: {
1175         if (argc > 3) {
1176             Tcl_WrongNumArgs(interp, 2, argv, "?tagOrId?");
1177             result = TCL_ERROR;
1178             goto done;
1179         }
1180         itemPtr = canvasPtr->textInfo.focusItemPtr;
1181         if (argc == 2) {
1182             if (itemPtr != NULL) {
1183                 char buf[TCL_INTEGER_SPACE];
1184                 
1185                 sprintf(buf, "%d", itemPtr->id);
1186                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1187             }
1188             goto done;
1189         }
1190         if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) {
1191             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1192         }
1193         if (Tcl_GetStringFromObj(argv[2], NULL)[0] == 0) {
1194             canvasPtr->textInfo.focusItemPtr = NULL;
1195             goto done;
1196         }
1197 #ifdef USE_OLD_TAG_SEARCH
1198         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1199                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1200 #else /* USE_OLD_TAG_SEARCH */
1201         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1202             goto done;
1203         }
1204         for (itemPtr = TagSearchFirst(searchPtr);
1205                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1206 #endif /* USE_OLD_TAG_SEARCH */
1207             if (itemPtr->typePtr->icursorProc != NULL) {
1208                 break;
1209             }
1210         }
1211         if (itemPtr == NULL) {
1212             goto done;
1213         }
1214         canvasPtr->textInfo.focusItemPtr = itemPtr;
1215         if (canvasPtr->textInfo.gotFocus) {
1216             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1217         }
1218         break;
1219       }
1220       case CANV_GETTAGS: {
1221         if (argc != 3) {
1222             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId");
1223             result = TCL_ERROR;
1224             goto done;
1225         }
1226 #ifdef USE_OLD_TAG_SEARCH
1227         itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1228 #else /* USE_OLD_TAG_SEARCH */
1229         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1230             goto done;
1231         }
1232         itemPtr = TagSearchFirst(searchPtr);
1233 #endif /* USE_OLD_TAG_SEARCH */
1234         if (itemPtr != NULL) {
1235             int i;
1236             for (i = 0; i < itemPtr->numTags; i++) {
1237                 Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]);
1238             }
1239         }
1240         break;
1241       }
1242       case CANV_ICURSOR: {
1243         int index;
1244
1245         if (argc != 4) {
1246             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
1247             result = TCL_ERROR;
1248             goto done;
1249         }
1250 #ifdef USE_OLD_TAG_SEARCH
1251         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1252                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1253 #else /* USE_OLD_TAG_SEARCH */
1254         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1255             goto done;
1256         }
1257         for (itemPtr = TagSearchFirst(searchPtr);
1258                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1259 #endif /* USE_OLD_TAG_SEARCH */
1260             if ((itemPtr->typePtr->indexProc == NULL)
1261                     || (itemPtr->typePtr->icursorProc == NULL)) {
1262                 goto done;
1263             }
1264             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1265                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1266                         itemPtr, (char *) argv[3], &index);
1267             } else {
1268                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1269                         itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &index);
1270             }
1271             if (result != TCL_OK) {
1272                 goto done;
1273             }
1274             (*itemPtr->typePtr->icursorProc)((Tk_Canvas) canvasPtr, itemPtr,
1275                     index);
1276             if ((itemPtr == canvasPtr->textInfo.focusItemPtr)
1277                     && (canvasPtr->textInfo.cursorOn)) {
1278                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1279             }
1280         }
1281         break;
1282       }
1283       case CANV_INDEX: {
1284
1285         int index;
1286         char buf[TCL_INTEGER_SPACE];
1287
1288         if (argc != 4) {
1289             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId string");
1290             result = TCL_ERROR;
1291             goto done;
1292         }
1293 #ifdef USE_OLD_TAG_SEARCH
1294         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1295                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1296 #else /* USE_OLD_TAG_SEARCH */
1297         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1298             goto done;
1299         }
1300         for (itemPtr = TagSearchFirst(searchPtr);
1301                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1302 #endif /* USE_OLD_TAG_SEARCH */
1303             if (itemPtr->typePtr->indexProc != NULL) {
1304                 break;
1305             }
1306         }
1307         if (itemPtr == NULL) {
1308             Tcl_AppendResult(interp, "can't find an indexable item \"",
1309                     Tcl_GetStringFromObj(argv[2], NULL), "\"", (char *) NULL);
1310             result = TCL_ERROR;
1311             goto done;
1312         }
1313         if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1314             result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1315                     itemPtr, (char *) argv[3], &index);
1316         } else {
1317             result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1318                     itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &index);
1319         }
1320         if (result != TCL_OK) {
1321             goto done;
1322         }
1323         sprintf(buf, "%d", index);
1324         Tcl_SetResult(interp, buf, TCL_VOLATILE);
1325         break;
1326       }
1327       case CANV_INSERT: {
1328         int beforeThis;
1329         int x1,x2,y1,y2;
1330
1331         if (argc != 5) {
1332             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId beforeThis string");
1333             result = TCL_ERROR;
1334             goto done;
1335         }
1336 #ifdef USE_OLD_TAG_SEARCH
1337         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1338                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1339 #else /* USE_OLD_TAG_SEARCH */
1340         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1341             goto done;
1342         }
1343         for (itemPtr = TagSearchFirst(searchPtr);
1344                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1345 #endif /* USE_OLD_TAG_SEARCH */
1346             if ((itemPtr->typePtr->indexProc == NULL)
1347                     || (itemPtr->typePtr->insertProc == NULL)) {
1348                 continue;
1349             }
1350             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1351                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1352                         itemPtr, (char *) argv[3], &beforeThis);
1353             } else {
1354                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1355                         itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &beforeThis);
1356             }
1357             if (result != TCL_OK) {
1358                 goto done;
1359             }
1360
1361             /*
1362              * Redraw both item's old and new areas:  it's possible
1363              * that an insertion could result in a new area either
1364              * larger or smaller than the old area. Except if the
1365              * insertProc sets the TK_ITEM_DONT_REDRAW flag, nothing
1366              * more needs to be done.
1367              */
1368
1369             x1 = itemPtr->x1; y1 = itemPtr->y1;
1370             x2 = itemPtr->x2; y2 = itemPtr->y2;
1371             itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
1372             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1373                 (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
1374                         itemPtr, beforeThis, (char *) argv[4]);
1375             } else {
1376                 (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
1377                         itemPtr, beforeThis, Tcl_GetStringFromObj(argv[4], NULL));
1378             }
1379             if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
1380                 Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
1381                         x1, y1, x2, y2);
1382                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1383             }
1384             itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
1385         }
1386         break;
1387       }
1388       case CANV_ITEMCGET: {
1389         if (argc != 4) {
1390             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId option");
1391             result = TCL_ERROR;
1392             goto done;
1393         }
1394 #ifdef USE_OLD_TAG_SEARCH
1395         itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1396 #else /* USE_OLD_TAG_SEARCH */
1397         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1398             goto done;
1399         }
1400         itemPtr = TagSearchFirst(searchPtr);
1401 #endif /* USE_OLD_TAG_SEARCH */
1402         if (itemPtr != NULL) {
1403             result = Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin,
1404                     itemPtr->typePtr->configSpecs, (char *) itemPtr,
1405                     Tcl_GetStringFromObj(argv[3], NULL), 0);
1406         }
1407         break;
1408       }
1409       case CANV_ITEMCONFIGURE: {
1410         if (argc < 3) {
1411             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?option value ...?");
1412             result = TCL_ERROR;
1413             goto done;
1414         }
1415 #ifdef USE_OLD_TAG_SEARCH
1416         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1417                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1418 #else /* USE_OLD_TAG_SEARCH */
1419         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1420             goto done;
1421         }
1422         for (itemPtr = TagSearchFirst(searchPtr);
1423                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1424 #endif /* USE_OLD_TAG_SEARCH */
1425             if (argc == 3) {
1426                 result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
1427                         itemPtr->typePtr->configSpecs, (char *) itemPtr,
1428                         (char *) NULL, 0);
1429             } else if (argc == 4) {
1430                 result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
1431                         itemPtr->typePtr->configSpecs, (char *) itemPtr,
1432                         Tcl_GetString(argv[3]), 0);
1433             } else {
1434                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1435                 if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1436                 result = (*itemPtr->typePtr->configProc)(interp,
1437                         (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3,
1438                         TK_CONFIG_ARGV_ONLY);
1439                 } else {
1440                 CONST char **args = GetStringsFromObjs(argc-3, argv+3);
1441                 result = (*itemPtr->typePtr->configProc)(interp,
1442                         (Tk_Canvas) canvasPtr, itemPtr, argc-3, (Tcl_Obj **) args,
1443                         TK_CONFIG_ARGV_ONLY);
1444                 if (args) ckfree((char *) args);
1445                 }
1446                 EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1447                 canvasPtr->flags |= REPICK_NEEDED;
1448             }
1449             if ((result != TCL_OK) || (argc < 5)) {
1450                 break;
1451             }
1452         }
1453         break;
1454       }
1455       case CANV_LOWER: {
1456         Tk_Item *itemPtr;
1457
1458         if ((argc != 3) && (argc != 4)) {
1459             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?belowThis?");
1460             result = TCL_ERROR;
1461             goto done;
1462         }
1463
1464         /*
1465          * First find the item just after which we'll insert the
1466          * named items.
1467          */
1468
1469         if (argc == 3) {
1470             itemPtr = NULL;
1471         } else {
1472 #ifdef USE_OLD_TAG_SEARCH
1473             itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
1474 #else /* USE_OLD_TAG_SEARCH */
1475             if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
1476                 goto done;
1477             }
1478             itemPtr = TagSearchFirst(searchPtr);
1479 #endif /* USE_OLD_TAG_SEARCH */
1480             if (itemPtr == NULL) {
1481                 Tcl_AppendResult(interp, "tag \"", Tcl_GetString(argv[3]),
1482                         "\" doesn't match any items", (char *) NULL);
1483                 goto done;
1484             }
1485             itemPtr = itemPtr->prevPtr;
1486         }
1487 #ifdef USE_OLD_TAG_SEARCH
1488         RelinkItems(canvasPtr, argv[2], itemPtr);
1489 #else /* USE_OLD_TAG_SEARCH */
1490         if ((result = RelinkItems(canvasPtr, argv[2], itemPtr, &searchPtr)) != TCL_OK) {
1491             goto done;
1492         }
1493 #endif /* USE_OLD_TAG_SEARCH */
1494         break;
1495       }
1496       case CANV_MOVE: {
1497         double xAmount, yAmount;
1498
1499         if (argc != 5) {
1500             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xAmount yAmount");
1501             result = TCL_ERROR;
1502             goto done;
1503         }
1504         if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
1505                 &xAmount) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
1506                 (Tk_Canvas) canvasPtr, argv[4], &yAmount) != TCL_OK)) {
1507             result = TCL_ERROR;
1508             goto done;
1509         }
1510 #ifdef USE_OLD_TAG_SEARCH
1511         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1512                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1513 #else /* USE_OLD_TAG_SEARCH */
1514         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1515             goto done;
1516         }
1517         for (itemPtr = TagSearchFirst(searchPtr);
1518                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1519 #endif /* USE_OLD_TAG_SEARCH */
1520             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1521             (void) (*itemPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr,
1522                     itemPtr,  xAmount, yAmount);
1523             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1524             canvasPtr->flags |= REPICK_NEEDED;
1525         }
1526         break;
1527       }
1528       case CANV_POSTSCRIPT: {
1529         CONST char **args = GetStringsFromObjs(argc, argv);
1530         result = TkCanvPostscriptCmd(canvasPtr, interp, argc, args);
1531         if (args) ckfree((char *) args);
1532         break;
1533       }
1534       case CANV_RAISE: {
1535         Tk_Item *prevPtr;
1536
1537         if ((argc != 3) && (argc != 4)) {
1538             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?aboveThis?");
1539             result = TCL_ERROR;
1540             goto done;
1541         }
1542
1543         /*
1544          * First find the item just after which we'll insert the
1545          * named items.
1546          */
1547
1548         if (argc == 3) {
1549             prevPtr = canvasPtr->lastItemPtr;
1550         } else {
1551             prevPtr = NULL;
1552 #ifdef USE_OLD_TAG_SEARCH
1553             for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
1554                     itemPtr != NULL; itemPtr = NextItem(&search)) {
1555 #else /* USE_OLD_TAG_SEARCH */
1556             if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
1557                 goto done;
1558             }
1559             for (itemPtr = TagSearchFirst(searchPtr);
1560                     itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1561 #endif /* USE_OLD_TAG_SEARCH */
1562                 prevPtr = itemPtr;
1563             }
1564             if (prevPtr == NULL) {
1565                 Tcl_AppendResult(interp, "tagOrId \"", Tcl_GetStringFromObj(argv[3], NULL),
1566                         "\" doesn't match any items", (char *) NULL);
1567                 result = TCL_ERROR;
1568                 goto done;
1569             }
1570         }
1571 #ifdef USE_OLD_TAG_SEARCH
1572         RelinkItems(canvasPtr, argv[2], prevPtr);
1573 #else /* USE_OLD_TAG_SEARCH */
1574         result = RelinkItems(canvasPtr, argv[2], prevPtr, &searchPtr);
1575         if (result != TCL_OK) {
1576             goto done;
1577         }
1578 #endif /* USE_OLD_TAG_SEARCH */
1579         break;
1580       }
1581       case CANV_SCALE: {
1582         double xOrigin, yOrigin, xScale, yScale;
1583
1584         if (argc != 7) {
1585             Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xOrigin yOrigin xScale yScale");
1586             result = TCL_ERROR;
1587             goto done;
1588         }
1589         if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
1590                     argv[3], &xOrigin) != TCL_OK)
1591                 || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
1592                     argv[4], &yOrigin) != TCL_OK)
1593                 || (Tcl_GetDoubleFromObj(interp, argv[5], &xScale) != TCL_OK)
1594                 || (Tcl_GetDoubleFromObj(interp, argv[6], &yScale) != TCL_OK)) {
1595             result = TCL_ERROR;
1596             goto done;
1597         }
1598         if ((xScale == 0.0) || (yScale == 0.0)) {
1599             Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC);
1600             result = TCL_ERROR;
1601             goto done;
1602         }
1603 #ifdef USE_OLD_TAG_SEARCH
1604         for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1605                 itemPtr != NULL; itemPtr = NextItem(&search)) {
1606 #else /* USE_OLD_TAG_SEARCH */
1607         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1608             goto done;
1609         }
1610         for (itemPtr = TagSearchFirst(searchPtr);
1611                 itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1612 #endif /* USE_OLD_TAG_SEARCH */
1613             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1614             (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr,
1615                     itemPtr, xOrigin, yOrigin, xScale, yScale);
1616             EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
1617             canvasPtr->flags |= REPICK_NEEDED;
1618         }
1619         break;
1620       }
1621       case CANV_SCAN: {
1622         int x, y, gain=10;
1623         static CONST char *optionStrings[] = {
1624             "mark", "dragto", NULL
1625         };
1626
1627         if (argc < 5) {
1628             Tcl_WrongNumArgs(interp, 2, argv, "mark|dragto x y ?dragGain?");
1629             result = TCL_ERROR;
1630         } else if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings,
1631                 "scan option", 0, &index) != TCL_OK) {
1632             result = TCL_ERROR;
1633         } else if ((argc != 5) && (argc != 5+index)) {
1634             Tcl_WrongNumArgs(interp, 3, argv, index?"x y ?gain?":"x y");
1635             result = TCL_ERROR;
1636         } else if ((Tcl_GetIntFromObj(interp, argv[3], &x) != TCL_OK)
1637                 || (Tcl_GetIntFromObj(interp, argv[4], &y) != TCL_OK)){
1638             result = TCL_ERROR;
1639         } else if ((argc == 6) &&
1640                 (Tcl_GetIntFromObj(interp, argv[5], &gain) != TCL_OK)) {
1641             result = TCL_ERROR;
1642         } else if (!index) {
1643             canvasPtr->scanX = x;
1644             canvasPtr->scanXOrigin = canvasPtr->xOrigin;
1645             canvasPtr->scanY = y;
1646             canvasPtr->scanYOrigin = canvasPtr->yOrigin;
1647         } else {
1648             int newXOrigin, newYOrigin, tmp;
1649
1650             /*
1651              * Compute a new view origin for the canvas, amplifying the
1652              * mouse motion.
1653              */
1654
1655             tmp = canvasPtr->scanXOrigin - gain*(x - canvasPtr->scanX)
1656                     - canvasPtr->scrollX1;
1657             newXOrigin = canvasPtr->scrollX1 + tmp;
1658             tmp = canvasPtr->scanYOrigin - gain*(y - canvasPtr->scanY)
1659                     - canvasPtr->scrollY1;
1660             newYOrigin = canvasPtr->scrollY1 + tmp;
1661             CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin);
1662         }
1663         break;
1664       }
1665       case CANV_SELECT: {
1666         int index, optionindex;
1667         static CONST char *optionStrings[] = {
1668             "adjust", "clear", "from", "item", "to", NULL
1669         };
1670         enum options {
1671             CANV_ADJUST, CANV_CLEAR, CANV_FROM, CANV_ITEM, CANV_TO
1672         };
1673
1674         if (argc < 3) {
1675             Tcl_WrongNumArgs(interp, 2, argv, "option ?tagOrId? ?arg?");
1676             result = TCL_ERROR;
1677             goto done;
1678         }
1679         if (argc >= 4) {
1680 #ifdef USE_OLD_TAG_SEARCH
1681             for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
1682                     itemPtr != NULL; itemPtr = NextItem(&search)) {
1683 #else /* USE_OLD_TAG_SEARCH */
1684             if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
1685                 goto done;
1686             }
1687             for (itemPtr = TagSearchFirst(searchPtr);
1688                     itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
1689 #endif /* USE_OLD_TAG_SEARCH */
1690                 if ((itemPtr->typePtr->indexProc != NULL)
1691                         && (itemPtr->typePtr->selectionProc != NULL)){
1692                     break;
1693                 }
1694             }
1695             if (itemPtr == NULL) {
1696                 Tcl_AppendResult(interp,
1697                         "can't find an indexable and selectable item \"",
1698                         Tcl_GetStringFromObj(argv[3], NULL), "\"", (char *) NULL);
1699                 result = TCL_ERROR;
1700                 goto done;
1701             }
1702         }
1703         if (argc == 5) {
1704             if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
1705                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1706                         itemPtr, (char *) argv[4], &index);
1707             } else {
1708                 result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
1709                         itemPtr, Tcl_GetStringFromObj(argv[4], NULL), &index);
1710             }
1711             if (result != TCL_OK) {
1712                 goto done;
1713             }
1714         }
1715         if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings, "select option", 0,
1716                 &optionindex) != TCL_OK) {
1717             result = TCL_ERROR;
1718             goto done;
1719         }
1720         switch ((enum options) optionindex) {
1721           case CANV_ADJUST: {
1722             if (argc != 5) {
1723                 Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
1724                 result = TCL_ERROR;
1725                 goto done;
1726             }
1727             if (canvasPtr->textInfo.selItemPtr == itemPtr) {
1728                 if (index < (canvasPtr->textInfo.selectFirst
1729                         + canvasPtr->textInfo.selectLast)/2) {
1730                     canvasPtr->textInfo.selectAnchor =
1731                             canvasPtr->textInfo.selectLast + 1;
1732                 } else {
1733                     canvasPtr->textInfo.selectAnchor =
1734                             canvasPtr->textInfo.selectFirst;
1735                 }
1736             }
1737             CanvasSelectTo(canvasPtr, itemPtr, index);
1738             break;
1739           }
1740           case CANV_CLEAR: {
1741             if (argc != 3) {
1742                 Tcl_AppendResult(interp, 3, argv, (char *) NULL);
1743                 result = TCL_ERROR;
1744                 goto done;
1745             }
1746             if (canvasPtr->textInfo.selItemPtr != NULL) {
1747                 EventuallyRedrawItem((Tk_Canvas) canvasPtr,
1748                         canvasPtr->textInfo.selItemPtr);
1749                 canvasPtr->textInfo.selItemPtr = NULL;
1750             }
1751             goto done;
1752             break;
1753           }
1754           case CANV_FROM: {
1755             if (argc != 5) {
1756                 Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
1757                 result = TCL_ERROR;
1758                 goto done;
1759             }
1760             canvasPtr->textInfo.anchorItemPtr = itemPtr;
1761             canvasPtr->textInfo.selectAnchor = index;
1762             break;
1763           }
1764           case CANV_ITEM: {
1765             if (argc != 3) {
1766                 Tcl_WrongNumArgs(interp, 3, argv, (char *) NULL);
1767                 result = TCL_ERROR;
1768                 goto done;
1769             }
1770             if (canvasPtr->textInfo.selItemPtr != NULL) {
1771                 char buf[TCL_INTEGER_SPACE];
1772                 
1773                 sprintf(buf, "%d", canvasPtr->textInfo.selItemPtr->id);
1774                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1775             }
1776             break;
1777           }
1778           case CANV_TO: {
1779             if (argc != 5) {
1780                 Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
1781                 result = TCL_ERROR;
1782                 goto done;
1783             }
1784             CanvasSelectTo(canvasPtr, itemPtr, index);
1785             break;
1786           }
1787         }
1788         break;
1789       }
1790       case CANV_TYPE: {
1791         if (argc != 3) {
1792             Tcl_WrongNumArgs(interp, 2, argv, "tag");
1793             result = TCL_ERROR;
1794             goto done;
1795         }
1796 #ifdef USE_OLD_TAG_SEARCH
1797         itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
1798 #else /* USE_OLD_TAG_SEARCH */
1799         if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
1800             goto done;
1801         }
1802         itemPtr = TagSearchFirst(searchPtr);
1803 #endif /* USE_OLD_TAG_SEARCH */
1804         if (itemPtr != NULL) {
1805             Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC);
1806         }
1807         break;
1808       }
1809       case CANV_XVIEW: {
1810         int count, type;
1811         int newX = 0;           /* Initialization needed only to prevent
1812                                  * gcc warnings. */
1813         double fraction;
1814
1815         if (argc == 2) {
1816             Tcl_SetObjResult(interp, ScrollFractions(
1817                     canvasPtr->xOrigin + canvasPtr->inset,
1818                     canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
1819                     - canvasPtr->inset, canvasPtr->scrollX1,
1820                     canvasPtr->scrollX2));
1821         } else {
1822             CONST char **args = GetStringsFromObjs(argc, argv);
1823             type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
1824             if (args) ckfree((char *) args);
1825             switch (type) {
1826                 case TK_SCROLL_ERROR:
1827                     result = TCL_ERROR;
1828                     goto done;
1829                 case TK_SCROLL_MOVETO:
1830                     newX = canvasPtr->scrollX1 - canvasPtr->inset
1831                             + (int) (fraction * (canvasPtr->scrollX2
1832                             - canvasPtr->scrollX1) + 0.5);
1833                     break;
1834                 case TK_SCROLL_PAGES:
1835                     newX = (int) (canvasPtr->xOrigin + count * .9
1836                             * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset));
1837                     break;
1838                 case TK_SCROLL_UNITS:
1839                     if (canvasPtr->xScrollIncrement > 0) {
1840                         newX = canvasPtr->xOrigin
1841                                 + count*canvasPtr->xScrollIncrement;
1842                     } else {
1843                         newX = (int) (canvasPtr->xOrigin + count * .1
1844                                 * (Tk_Width(canvasPtr->tkwin)
1845                                 - 2*canvasPtr->inset));
1846                     }
1847                     break;
1848             }
1849             CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin);
1850         }
1851         break;
1852       }
1853       case CANV_YVIEW: {
1854         int count, type;
1855         int newY = 0;           /* Initialization needed only to prevent
1856                                  * gcc warnings. */
1857         double fraction;
1858
1859         if (argc == 2) {
1860             Tcl_SetObjResult(interp,ScrollFractions(\
1861                     canvasPtr->yOrigin + canvasPtr->inset,
1862                     canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
1863                     - canvasPtr->inset, canvasPtr->scrollY1,
1864                     canvasPtr->scrollY2));
1865         } else {
1866             CONST char **args = GetStringsFromObjs(argc, argv);
1867             type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
1868             if (args) ckfree((char *) args);
1869             switch (type) {
1870                 case TK_SCROLL_ERROR:
1871                     result = TCL_ERROR;
1872                     goto done;
1873                 case TK_SCROLL_MOVETO:
1874                     newY = canvasPtr->scrollY1 - canvasPtr->inset
1875                             + (int) (fraction*(canvasPtr->scrollY2
1876                             - canvasPtr->scrollY1) + 0.5);
1877                     break;
1878                 case TK_SCROLL_PAGES:
1879                     newY = (int) (canvasPtr->yOrigin + count * .9
1880                             * (Tk_Height(canvasPtr->tkwin)
1881                             - 2*canvasPtr->inset));
1882                     break;
1883                 case TK_SCROLL_UNITS:
1884                     if (canvasPtr->yScrollIncrement > 0) {
1885                         newY = canvasPtr->yOrigin
1886                                 + count*canvasPtr->yScrollIncrement;
1887                     } else {
1888                         newY = (int) (canvasPtr->yOrigin + count * .1
1889                                 * (Tk_Height(canvasPtr->tkwin)
1890                                 - 2*canvasPtr->inset));
1891                     }
1892                     break;
1893             }
1894             CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY);
1895         }
1896         break;
1897       }
1898     }
1899     done:
1900 #ifndef USE_OLD_TAG_SEARCH
1901     TagSearchDestroy(searchPtr);
1902 #endif /* not USE_OLD_TAG_SEARCH */
1903     Tcl_Release((ClientData) canvasPtr);
1904     return result;
1905 }
1906 \f
1907 /*
1908  *----------------------------------------------------------------------
1909  *
1910  * DestroyCanvas --
1911  *
1912  *      This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
1913  *      to clean up the internal structure of a canvas at a safe time
1914  *      (when no-one is using it anymore).
1915  *
1916  * Results:
1917  *      None.
1918  *
1919  * Side effects:
1920  *      Everything associated with the canvas is freed up.
1921  *
1922  *----------------------------------------------------------------------
1923  */
1924
1925 static void
1926 DestroyCanvas(memPtr)
1927     char *memPtr;               /* Info about canvas widget. */
1928 {
1929     TkCanvas *canvasPtr = (TkCanvas *) memPtr;
1930     Tk_Item *itemPtr;
1931 #ifndef USE_OLD_TAG_SEARCH
1932     TagSearchExpr *expr, *next;
1933 #endif
1934
1935     /*
1936      * Free up all of the items in the canvas.
1937      */
1938
1939     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
1940             itemPtr = canvasPtr->firstItemPtr) {
1941         canvasPtr->firstItemPtr = itemPtr->nextPtr;
1942         (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
1943                 canvasPtr->display);
1944         if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
1945             ckfree((char *) itemPtr->tagPtr);
1946         }
1947         ckfree((char *) itemPtr);
1948     }
1949
1950     /*
1951      * Free up all the stuff that requires special handling,
1952      * then let Tk_FreeOptions handle all the standard option-related
1953      * stuff.
1954      */
1955
1956     Tcl_DeleteHashTable(&canvasPtr->idTable);
1957     if (canvasPtr->pixmapGC != None) {
1958         Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
1959     }
1960 #ifndef USE_OLD_TAG_SEARCH
1961     expr = canvasPtr->bindTagExprs;
1962     while (expr) {
1963         next = expr->next;
1964         TagSearchExprDestroy(expr);
1965         expr = next;
1966     }
1967 #endif
1968     Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
1969     if (canvasPtr->bindingTable != NULL) {
1970         Tk_DeleteBindingTable(canvasPtr->bindingTable);
1971     }
1972     Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0);
1973     canvasPtr->tkwin = NULL;
1974     ckfree((char *) canvasPtr);
1975 }
1976 \f
1977 /*
1978  *----------------------------------------------------------------------
1979  *
1980  * ConfigureCanvas --
1981  *
1982  *      This procedure is called to process an argv/argc list, plus
1983  *      the Tk option database, in order to configure (or
1984  *      reconfigure) a canvas widget.
1985  *
1986  * Results:
1987  *      The return value is a standard Tcl result.  If TCL_ERROR is
1988  *      returned, then the interp's result contains an error message.
1989  *
1990  * Side effects:
1991  *      Configuration information, such as colors, border width,
1992  *      etc. get set for canvasPtr;  old resources get freed,
1993  *      if there were any.
1994  *
1995  *----------------------------------------------------------------------
1996  */
1997
1998 static int
1999 ConfigureCanvas(interp, canvasPtr, argc, argv, flags)
2000     Tcl_Interp *interp;         /* Used for error reporting. */
2001     TkCanvas *canvasPtr;        /* Information about widget;  may or may
2002                                  * not already have values for some fields. */
2003     int argc;                   /* Number of valid entries in argv. */
2004     Tcl_Obj *CONST argv[];      /* Argument objects. */
2005     int flags;                  /* Flags to pass to Tk_ConfigureWidget. */
2006 {
2007     XGCValues gcValues;
2008     GC new;
2009
2010     if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs,
2011             argc, (CONST char **) argv, (char *) canvasPtr,
2012             flags|TK_CONFIG_OBJS) != TCL_OK) {
2013         return TCL_ERROR;
2014     }
2015
2016     /*
2017      * A few options need special processing, such as setting the
2018      * background from a 3-D border and creating a GC for copying
2019      * bits to the screen.
2020      */
2021
2022     Tk_SetBackgroundFromBorder(canvasPtr->tkwin, canvasPtr->bgBorder);
2023
2024     if (canvasPtr->highlightWidth < 0) {
2025         canvasPtr->highlightWidth = 0;
2026     }
2027     canvasPtr->inset = canvasPtr->borderWidth + canvasPtr->highlightWidth;
2028
2029     gcValues.function = GXcopy;
2030     gcValues.graphics_exposures = False;
2031     gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel;
2032     new = Tk_GetGC(canvasPtr->tkwin,
2033             GCFunction|GCGraphicsExposures|GCForeground, &gcValues);
2034     if (canvasPtr->pixmapGC != None) {
2035         Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
2036     }
2037     canvasPtr->pixmapGC = new;
2038
2039     /*
2040      * Reset the desired dimensions for the window.
2041      */
2042
2043     Tk_GeometryRequest(canvasPtr->tkwin, canvasPtr->width + 2*canvasPtr->inset,
2044             canvasPtr->height + 2*canvasPtr->inset);
2045
2046     /*
2047      * Restart the cursor timing sequence in case the on-time or off-time
2048      * just changed.
2049      */
2050
2051     if (canvasPtr->textInfo.gotFocus) {
2052         CanvasFocusProc(canvasPtr, 1);
2053     }
2054
2055     /*
2056      * Recompute the scroll region.
2057      */
2058
2059     canvasPtr->scrollX1 = 0;
2060     canvasPtr->scrollY1 = 0;
2061     canvasPtr->scrollX2 = 0;
2062     canvasPtr->scrollY2 = 0;
2063     if (canvasPtr->regionString != NULL) {
2064         int argc2;
2065         CONST char **argv2;
2066
2067         if (Tcl_SplitList(canvasPtr->interp, canvasPtr->regionString,
2068                 &argc2, &argv2) != TCL_OK) {
2069             return TCL_ERROR;
2070         }
2071         if (argc2 != 4) {
2072             Tcl_AppendResult(interp, "bad scrollRegion \"",
2073                     canvasPtr->regionString, "\"", (char *) NULL);
2074             badRegion:
2075             ckfree(canvasPtr->regionString);
2076             ckfree((char *) argv2);
2077             canvasPtr->regionString = NULL;
2078             return TCL_ERROR;
2079         }
2080         if ((Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
2081                     argv2[0], &canvasPtr->scrollX1) != TCL_OK)
2082                 || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
2083                     argv2[1], &canvasPtr->scrollY1) != TCL_OK)
2084                 || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
2085                     argv2[2], &canvasPtr->scrollX2) != TCL_OK)
2086                 || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
2087                     argv2[3], &canvasPtr->scrollY2) != TCL_OK)) {
2088             goto badRegion;
2089         }
2090         ckfree((char *) argv2);
2091     }
2092
2093     flags = canvasPtr->tsoffset.flags;
2094     if (flags & TK_OFFSET_LEFT) {
2095         canvasPtr->tsoffset.xoffset = 0;
2096     } else if (flags & TK_OFFSET_CENTER) {
2097         canvasPtr->tsoffset.xoffset = canvasPtr->width/2;
2098     } else if (flags & TK_OFFSET_RIGHT) {
2099         canvasPtr->tsoffset.xoffset = canvasPtr->width;
2100     }
2101     if (flags & TK_OFFSET_TOP) {
2102         canvasPtr->tsoffset.yoffset = 0;
2103     } else if (flags & TK_OFFSET_MIDDLE) {
2104         canvasPtr->tsoffset.yoffset = canvasPtr->height/2;
2105     } else if (flags & TK_OFFSET_BOTTOM) {
2106         canvasPtr->tsoffset.yoffset = canvasPtr->height;
2107     }
2108
2109     /*
2110      * Reset the canvas's origin (this is a no-op unless confine
2111      * mode has just been turned on or the scroll region has changed).
2112      */
2113
2114     CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
2115     canvasPtr->flags |= UPDATE_SCROLLBARS|REDRAW_BORDERS;
2116     Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
2117             canvasPtr->xOrigin, canvasPtr->yOrigin,
2118             canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
2119             canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
2120     return TCL_OK;
2121 }
2122 \f
2123 /*
2124  *---------------------------------------------------------------------------
2125  *
2126  * CanvasWorldChanged --
2127  *
2128  *      This procedure is called when the world has changed in some
2129  *      way and the widget needs to recompute all its graphics contexts
2130  *      and determine its new geometry.
2131  *
2132  * Results:
2133  *      None.
2134  *
2135  * Side effects:
2136  *      Configures all items in the canvas with a empty argc/argv, for
2137  *      the side effect of causing all the items to recompute their
2138  *      geometry and to be redisplayed.
2139  *
2140  *---------------------------------------------------------------------------
2141  */
2142  
2143 static void
2144 CanvasWorldChanged(instanceData)
2145     ClientData instanceData;    /* Information about widget. */
2146 {
2147     TkCanvas *canvasPtr;
2148     Tk_Item *itemPtr;
2149     int result;
2150
2151     canvasPtr = (TkCanvas *) instanceData;
2152     itemPtr = canvasPtr->firstItemPtr;
2153     for ( ; itemPtr != NULL; itemPtr = itemPtr->nextPtr) {
2154         result = (*itemPtr->typePtr->configProc)(canvasPtr->interp,
2155                 (Tk_Canvas) canvasPtr, itemPtr, 0, NULL,
2156                 TK_CONFIG_ARGV_ONLY);
2157         if (result != TCL_OK) {
2158             Tcl_ResetResult(canvasPtr->interp);
2159         }
2160     }
2161     canvasPtr->flags |= REPICK_NEEDED;
2162     Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
2163             canvasPtr->xOrigin, canvasPtr->yOrigin,
2164             canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
2165             canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
2166 }
2167 \f
2168 /*
2169  *--------------------------------------------------------------
2170  *
2171  * DisplayCanvas --
2172  *
2173  *      This procedure redraws the contents of a canvas window.
2174  *      It is invoked as a do-when-idle handler, so it only runs
2175  *      when there's nothing else for the application to do.
2176  *
2177  * Results:
2178  *      None.
2179  *
2180  * Side effects:
2181  *      Information appears on the screen.
2182  *
2183  *--------------------------------------------------------------
2184  */
2185
2186 static void
2187 DisplayCanvas(clientData)
2188     ClientData clientData;      /* Information about widget. */
2189 {
2190     TkCanvas *canvasPtr = (TkCanvas *) clientData;
2191     Tk_Window tkwin = canvasPtr->tkwin;
2192     Tk_Item *itemPtr;
2193     Pixmap pixmap;
2194     int screenX1, screenX2, screenY1, screenY2, width, height;
2195
2196     if (canvasPtr->tkwin == NULL) {
2197         return;
2198     }
2199
2200     if (!Tk_IsMapped(tkwin)) {
2201         goto done;
2202     }
2203
2204     /*
2205      * Choose a new current item if that is needed (this could cause
2206      * event handlers to be invoked).
2207      */
2208
2209     while (canvasPtr->flags & REPICK_NEEDED) {
2210         Tcl_Preserve((ClientData) canvasPtr);
2211         canvasPtr->flags &= ~REPICK_NEEDED;
2212         PickCurrentItem(canvasPtr, &canvasPtr->pickEvent);
2213         tkwin = canvasPtr->tkwin;
2214         Tcl_Release((ClientData) canvasPtr);
2215         if (tkwin == NULL) {
2216             return;
2217         }
2218     }
2219
2220     /*
2221      * Scan through the item list, registering the bounding box
2222      * for all items that didn't do that for the final coordinates
2223      * yet. This can be determined by the FORCE_REDRAW flag.
2224      */
2225
2226     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
2227                 itemPtr = itemPtr->nextPtr) {
2228         if (itemPtr->redraw_flags & FORCE_REDRAW) {
2229             itemPtr->redraw_flags &= ~FORCE_REDRAW;
2230             EventuallyRedrawItem((Tk_Canvas)canvasPtr, itemPtr);
2231             itemPtr->redraw_flags &= ~FORCE_REDRAW;
2232         }
2233     }
2234     /*
2235      * Compute the intersection between the area that needs redrawing
2236      * and the area that's visible on the screen.
2237      */
2238
2239     if ((canvasPtr->redrawX1 < canvasPtr->redrawX2)
2240             && (canvasPtr->redrawY1 < canvasPtr->redrawY2)) {
2241         screenX1 = canvasPtr->xOrigin + canvasPtr->inset;
2242         screenY1 = canvasPtr->yOrigin + canvasPtr->inset;
2243         screenX2 = canvasPtr->xOrigin + Tk_Width(tkwin) - canvasPtr->inset;
2244         screenY2 = canvasPtr->yOrigin + Tk_Height(tkwin) - canvasPtr->inset;
2245         if (canvasPtr->redrawX1 > screenX1) {
2246             screenX1 = canvasPtr->redrawX1;
2247         }
2248         if (canvasPtr->redrawY1 > screenY1) {
2249             screenY1 = canvasPtr->redrawY1;
2250         }
2251         if (canvasPtr->redrawX2 < screenX2) {
2252             screenX2 = canvasPtr->redrawX2;
2253         }
2254         if (canvasPtr->redrawY2 < screenY2) {
2255             screenY2 = canvasPtr->redrawY2;
2256         }
2257         if ((screenX1 >= screenX2) || (screenY1 >= screenY2)) {
2258             goto borders;
2259         }
2260     
2261         /*
2262          * Redrawing is done in a temporary pixmap that is allocated
2263          * here and freed at the end of the procedure.  All drawing
2264          * is done to the pixmap, and the pixmap is copied to the
2265          * screen at the end of the procedure. The temporary pixmap
2266          * serves two purposes:
2267          *
2268          * 1. It provides a smoother visual effect (no clearing and
2269          *    gradual redraw will be visible to users).
2270          * 2. It allows us to redraw only the objects that overlap
2271          *    the redraw area.  Otherwise incorrect results could
2272          *        occur from redrawing things that stick outside of
2273          *        the redraw area (we'd have to redraw everything in
2274          *    order to make the overlaps look right).
2275          *
2276          * Some tricky points about the pixmap:
2277          *
2278          * 1. We only allocate a large enough pixmap to hold the
2279          *    area that has to be redisplayed.  This saves time in
2280          *    in the X server for large objects that cover much
2281          *    more than the area being redisplayed:  only the area
2282          *    of the pixmap will actually have to be redrawn.
2283          * 2. Some X servers (e.g. the one for DECstations) have troubles
2284          *    with characters that overlap an edge of the pixmap (on the
2285          *    DEC servers, as of 8/18/92, such characters are drawn one
2286          *    pixel too far to the right).  To handle this problem,
2287          *    make the pixmap a bit larger than is absolutely needed
2288          *    so that for normal-sized fonts the characters that overlap
2289          *    the edge of the pixmap will be outside the area we care
2290          *    about.
2291          */
2292     
2293         canvasPtr->drawableXOrigin = screenX1 - 30;
2294         canvasPtr->drawableYOrigin = screenY1 - 30;
2295         pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
2296             (screenX2 + 30 - canvasPtr->drawableXOrigin),
2297             (screenY2 + 30 - canvasPtr->drawableYOrigin),
2298             Tk_Depth(tkwin));
2299     
2300         /*
2301          * Clear the area to be redrawn.
2302          */
2303     
2304         width = screenX2 - screenX1;
2305         height = screenY2 - screenY1;
2306     
2307         XFillRectangle(Tk_Display(tkwin), pixmap, canvasPtr->pixmapGC,
2308                 screenX1 - canvasPtr->drawableXOrigin,
2309                 screenY1 - canvasPtr->drawableYOrigin, (unsigned int) width,
2310                 (unsigned int) height);
2311     
2312         /*
2313          * Scan through the item list, redrawing those items that need it.
2314          * An item must be redraw if either (a) it intersects the smaller
2315          * on-screen area or (b) it intersects the full canvas area and its
2316          * type requests that it be redrawn always (e.g. so subwindows can
2317          * be unmapped when they move off-screen).
2318          */
2319     
2320         for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
2321                 itemPtr = itemPtr->nextPtr) {
2322             if ((itemPtr->x1 >= screenX2)
2323                     || (itemPtr->y1 >= screenY2)
2324                     || (itemPtr->x2 < screenX1)
2325                     || (itemPtr->y2 < screenY1)) {
2326                 if (!(itemPtr->typePtr->alwaysRedraw & 1)
2327                         || (itemPtr->x1 >= canvasPtr->redrawX2)
2328                         || (itemPtr->y1 >= canvasPtr->redrawY2)
2329                         || (itemPtr->x2 < canvasPtr->redrawX1)
2330                         || (itemPtr->y2 < canvasPtr->redrawY1)) {
2331                     continue;
2332                 }
2333             }
2334             if (itemPtr->state == TK_STATE_HIDDEN ||
2335                 (itemPtr->state == TK_STATE_NULL &&
2336                  canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
2337                 continue;
2338             }
2339             (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, itemPtr,
2340                     canvasPtr->display, pixmap, screenX1, screenY1, width,
2341                     height);
2342         }
2343     
2344         /*
2345          * Copy from the temporary pixmap to the screen, then free up
2346          * the temporary pixmap.
2347          */
2348     
2349         XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin),
2350                 canvasPtr->pixmapGC,
2351                 screenX1 - canvasPtr->drawableXOrigin,
2352                 screenY1 - canvasPtr->drawableYOrigin,
2353                 (unsigned) (screenX2 - screenX1),
2354                 (unsigned) (screenY2 - screenY1),
2355                 screenX1 - canvasPtr->xOrigin, screenY1 - canvasPtr->yOrigin);
2356         Tk_FreePixmap(Tk_Display(tkwin), pixmap);
2357     }
2358
2359     /*
2360      * Draw the window borders, if needed.
2361      */
2362
2363     borders:
2364     if (canvasPtr->flags & REDRAW_BORDERS) {
2365         canvasPtr->flags &= ~REDRAW_BORDERS;
2366         if (canvasPtr->borderWidth > 0) {
2367             Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin),
2368                     canvasPtr->bgBorder, canvasPtr->highlightWidth,
2369                     canvasPtr->highlightWidth,
2370                     Tk_Width(tkwin) - 2*canvasPtr->highlightWidth,
2371                     Tk_Height(tkwin) - 2*canvasPtr->highlightWidth,
2372                     canvasPtr->borderWidth, canvasPtr->relief);
2373         }
2374         if (canvasPtr->highlightWidth != 0) {
2375             GC fgGC, bgGC;
2376
2377             bgGC = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
2378                     Tk_WindowId(tkwin));
2379             if (canvasPtr->textInfo.gotFocus) {
2380                 fgGC = Tk_GCForColor(canvasPtr->highlightColorPtr,
2381                         Tk_WindowId(tkwin));
2382                 TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
2383                         canvasPtr->highlightWidth, Tk_WindowId(tkwin));
2384             } else {
2385                 TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
2386                         canvasPtr->highlightWidth, Tk_WindowId(tkwin));
2387             }
2388         }
2389     }
2390
2391     done:
2392     canvasPtr->flags &= ~(REDRAW_PENDING|BBOX_NOT_EMPTY);
2393     canvasPtr->redrawX1 = canvasPtr->redrawX2 = 0;
2394     canvasPtr->redrawY1 = canvasPtr->redrawY2 = 0;
2395     if (canvasPtr->flags & UPDATE_SCROLLBARS) {
2396         CanvasUpdateScrollbars(canvasPtr);
2397     }
2398 }
2399 \f
2400 /*
2401  *--------------------------------------------------------------
2402  *
2403  * CanvasEventProc --
2404  *
2405  *      This procedure is invoked by the Tk dispatcher for various
2406  *      events on canvases.
2407  *
2408  * Results:
2409  *      None.
2410  *
2411  * Side effects:
2412  *      When the window gets deleted, internal structures get
2413  *      cleaned up.  When it gets exposed, it is redisplayed.
2414  *
2415  *--------------------------------------------------------------
2416  */
2417
2418 static void
2419 CanvasEventProc(clientData, eventPtr)
2420     ClientData clientData;      /* Information about window. */
2421     XEvent *eventPtr;           /* Information about event. */
2422 {
2423     TkCanvas *canvasPtr = (TkCanvas *) clientData;
2424
2425     if (eventPtr->type == Expose) {
2426         int x, y;
2427
2428         x = eventPtr->xexpose.x + canvasPtr->xOrigin;
2429         y = eventPtr->xexpose.y + canvasPtr->yOrigin;
2430         Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x, y,
2431                 x + eventPtr->xexpose.width,
2432                 y + eventPtr->xexpose.height);
2433         if ((eventPtr->xexpose.x < canvasPtr->inset)
2434                 || (eventPtr->xexpose.y < canvasPtr->inset)
2435                 || ((eventPtr->xexpose.x + eventPtr->xexpose.width)
2436                     > (Tk_Width(canvasPtr->tkwin) - canvasPtr->inset))
2437                 || ((eventPtr->xexpose.y + eventPtr->xexpose.height)
2438                     > (Tk_Height(canvasPtr->tkwin) - canvasPtr->inset))) {
2439             canvasPtr->flags |= REDRAW_BORDERS;
2440         }
2441     } else if (eventPtr->type == DestroyNotify) {
2442         if (canvasPtr->tkwin != NULL) {
2443             canvasPtr->tkwin = NULL;
2444             Tcl_DeleteCommandFromToken(canvasPtr->interp,
2445                     canvasPtr->widgetCmd);
2446         }
2447         if (canvasPtr->flags & REDRAW_PENDING) {
2448             Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr);
2449         }
2450         Tcl_EventuallyFree((ClientData) canvasPtr,
2451                 (Tcl_FreeProc *) DestroyCanvas);
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 CONST 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  * ScrollFractions --
5209  *
5210  *      Given the range that's visible in the window and the "100%
5211  *      range" for what's in the canvas, return a list of two
5212  *      doubles representing the scroll fractions.  This procedure
5213  *      is used for both x 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 Tcl_Obj *
5227 ScrollFractions(screen1, screen2, object1, object2)
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 {
5233     double range, f1, f2;
5234     char buffer[2*TCL_DOUBLE_SPACE+2];
5235
5236     range = object2 - object1;
5237     if (range <= 0) {
5238         f1 = 0;
5239         f2 = 1.0;
5240     } else {
5241         f1 = (screen1 - object1)/range;
5242         if (f1 < 0) {
5243             f1 = 0.0;
5244         }
5245         f2 = (screen2 - object1)/range;
5246         if (f2 > 1.0) {
5247             f2 = 1.0;
5248         }
5249         if (f2 < f1) {
5250             f2 = f1;
5251         }
5252     }
5253     sprintf(buffer, "%g %g", f1, f2);
5254     return Tcl_NewStringObj(buffer, -1);
5255 }
5256 \f
5257 /*
5258  *--------------------------------------------------------------
5259  *
5260  * CanvasUpdateScrollbars --
5261  *
5262  *      This procedure is invoked whenever a canvas has changed in
5263  *      a way that requires scrollbars to be redisplayed (e.g. the
5264  *      view in the canvas has changed).
5265  *
5266  * Results:
5267  *      None.
5268  *
5269  * Side effects:
5270  *      If there are scrollbars associated with the canvas, then
5271  *      their scrolling commands are invoked to cause them to
5272  *      redisplay.  If errors occur, additional Tcl commands may
5273  *      be invoked to process the errors.
5274  *
5275  *--------------------------------------------------------------
5276  */
5277
5278 static void
5279 CanvasUpdateScrollbars(canvasPtr)
5280     TkCanvas *canvasPtr;                /* Information about canvas. */
5281 {
5282     int result;
5283     Tcl_Interp *interp;
5284     int xOrigin, yOrigin, inset, width, height, scrollX1, scrollX2,
5285         scrollY1, scrollY2;
5286     char *xScrollCmd, *yScrollCmd;
5287
5288     /*
5289      * Save all the relevant values from the canvasPtr, because it might be
5290      * deleted as part of either of the two calls to Tcl_VarEval below.
5291      */
5292     
5293     interp = canvasPtr->interp;
5294     Tcl_Preserve((ClientData) interp);
5295     xScrollCmd = canvasPtr->xScrollCmd;
5296     if (xScrollCmd != (char *) NULL) {
5297         Tcl_Preserve((ClientData) xScrollCmd);
5298     }
5299     yScrollCmd = canvasPtr->yScrollCmd;
5300     if (yScrollCmd != (char *) NULL) {
5301         Tcl_Preserve((ClientData) yScrollCmd);
5302     }
5303     xOrigin = canvasPtr->xOrigin;
5304     yOrigin = canvasPtr->yOrigin;
5305     inset = canvasPtr->inset;
5306     width = Tk_Width(canvasPtr->tkwin);
5307     height = Tk_Height(canvasPtr->tkwin);
5308     scrollX1 = canvasPtr->scrollX1;
5309     scrollX2 = canvasPtr->scrollX2;
5310     scrollY1 = canvasPtr->scrollY1;
5311     scrollY2 = canvasPtr->scrollY2;
5312     canvasPtr->flags &= ~UPDATE_SCROLLBARS;
5313     if (canvasPtr->xScrollCmd != NULL) {
5314         Tcl_Obj *fractions = ScrollFractions(xOrigin + inset,
5315                 xOrigin + width - inset, scrollX1, scrollX2);
5316         result = Tcl_VarEval(interp, xScrollCmd, " ", 
5317                 Tcl_GetString(fractions), (char *) NULL);
5318         Tcl_DecrRefCount(fractions);
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         Tcl_Obj *fractions = ScrollFractions(yOrigin + inset,
5328                 yOrigin + height - inset, scrollY1, scrollY2);
5329         result = Tcl_VarEval(interp, yScrollCmd, " ", 
5330                 Tcl_GetString(fractions), (char *) NULL);
5331         Tcl_DecrRefCount(fractions);
5332         if (result != TCL_OK) {
5333             Tcl_BackgroundError(interp);
5334         }
5335         Tcl_ResetResult(interp);
5336         Tcl_Release((ClientData) yScrollCmd);
5337     }
5338     Tcl_Release((ClientData) interp);
5339 }
5340 \f
5341 /*
5342  *--------------------------------------------------------------
5343  *
5344  * CanvasSetOrigin --
5345  *
5346  *      This procedure is invoked to change the mapping between
5347  *      canvas coordinates and screen coordinates in the canvas
5348  *      window.
5349  *
5350  * Results:
5351  *      None.
5352  *
5353  * Side effects:
5354  *      The canvas will be redisplayed to reflect the change in
5355  *      view.  In addition, scrollbars will be updated if there
5356  *      are any.
5357  *
5358  *--------------------------------------------------------------
5359  */
5360
5361 static void
5362 CanvasSetOrigin(canvasPtr, xOrigin, yOrigin)
5363     TkCanvas *canvasPtr;        /* Information about canvas. */
5364     int xOrigin;                /* New X origin for canvas (canvas x-coord
5365                                  * corresponding to left edge of canvas
5366                                  * window). */
5367     int yOrigin;                /* New Y origin for canvas (canvas y-coord
5368                                  * corresponding to top edge of canvas
5369                                  * window). */
5370 {
5371     int left, right, top, bottom, delta;
5372
5373     /*
5374      * If scroll increments have been set, round the window origin
5375      * to the nearest multiple of the increments.  Remember, the
5376      * origin is the place just inside the borders,  not the upper
5377      * left corner.
5378      */
5379
5380     if (canvasPtr->xScrollIncrement > 0) {
5381         if (xOrigin >= 0) {
5382             xOrigin += canvasPtr->xScrollIncrement/2;
5383             xOrigin -= (xOrigin + canvasPtr->inset)
5384                     % canvasPtr->xScrollIncrement;
5385         } else {
5386             xOrigin = (-xOrigin) + canvasPtr->xScrollIncrement/2;
5387             xOrigin = -(xOrigin - (xOrigin - canvasPtr->inset)
5388                     % canvasPtr->xScrollIncrement);
5389         }
5390     }
5391     if (canvasPtr->yScrollIncrement > 0) {
5392         if (yOrigin >= 0) {
5393             yOrigin += canvasPtr->yScrollIncrement/2;
5394             yOrigin -= (yOrigin + canvasPtr->inset)
5395                     % canvasPtr->yScrollIncrement;
5396         } else {
5397             yOrigin = (-yOrigin) + canvasPtr->yScrollIncrement/2;
5398             yOrigin = -(yOrigin - (yOrigin - canvasPtr->inset)
5399                     % canvasPtr->yScrollIncrement);
5400         }
5401     }
5402
5403     /*
5404      * Adjust the origin if necessary to keep as much as possible of the
5405      * canvas in the view.  The variables left, right, etc. keep track of
5406      * how much extra space there is on each side of the view before it
5407      * will stick out past the scroll region.  If one side sticks out past
5408      * the edge of the scroll region, adjust the view to bring that side
5409      * back to the edge of the scrollregion (but don't move it so much that
5410      * the other side sticks out now).  If scroll increments are in effect,
5411      * be sure to adjust only by full increments.
5412      */
5413
5414     if ((canvasPtr->confine) && (canvasPtr->regionString != NULL)) {
5415         left = xOrigin + canvasPtr->inset - canvasPtr->scrollX1;
5416         right = canvasPtr->scrollX2
5417                 - (xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset);
5418         top = yOrigin + canvasPtr->inset - canvasPtr->scrollY1;
5419         bottom = canvasPtr->scrollY2
5420                 - (yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset);
5421         if ((left < 0) && (right > 0)) {
5422             delta = (right > -left) ? -left : right;
5423             if (canvasPtr->xScrollIncrement > 0) {
5424                 delta -= delta % canvasPtr->xScrollIncrement;
5425             }
5426             xOrigin += delta;
5427         } else if ((right < 0) && (left > 0)) {
5428             delta = (left > -right) ? -right : left;
5429             if (canvasPtr->xScrollIncrement > 0) {
5430                 delta -= delta % canvasPtr->xScrollIncrement;
5431             }
5432             xOrigin -= delta;
5433         }
5434         if ((top < 0) && (bottom > 0)) {
5435             delta = (bottom > -top) ? -top : bottom;
5436             if (canvasPtr->yScrollIncrement > 0) {
5437                 delta -= delta % canvasPtr->yScrollIncrement;
5438             }
5439             yOrigin += delta;
5440         } else if ((bottom < 0) && (top > 0)) {
5441             delta = (top > -bottom) ? -bottom : top;
5442             if (canvasPtr->yScrollIncrement > 0) {
5443                 delta -= delta % canvasPtr->yScrollIncrement;
5444             }
5445             yOrigin -= delta;
5446         }
5447     }
5448
5449     if ((xOrigin == canvasPtr->xOrigin) && (yOrigin == canvasPtr->yOrigin)) {
5450         return;
5451     }
5452
5453     /*
5454      * Tricky point: must redisplay not only everything that's visible
5455      * in the window's final configuration, but also everything that was
5456      * visible in the initial configuration.  This is needed because some
5457      * item types, like windows, need to know when they move off-screen
5458      * so they can explicitly undisplay themselves.
5459      */
5460
5461     Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
5462             canvasPtr->xOrigin, canvasPtr->yOrigin,
5463             canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
5464             canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
5465     canvasPtr->xOrigin = xOrigin;
5466     canvasPtr->yOrigin = yOrigin;
5467     canvasPtr->flags |= UPDATE_SCROLLBARS;
5468     Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
5469             canvasPtr->xOrigin, canvasPtr->yOrigin,
5470             canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
5471             canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
5472 }
5473
5474 /*
5475  *----------------------------------------------------------------------
5476  *
5477  * GetStringsFromObjs
5478  *
5479  * Results:
5480  *      Converts object list into string list.
5481  *
5482  * Side effects:
5483  *      Memory is allocated for the argv array, which must
5484  *      be freed using ckfree() when no longer needed.
5485  *
5486  *----------------------------------------------------------------------
5487  */
5488 /* ARGSUSED */
5489 static CONST char **
5490 GetStringsFromObjs(argc, objv)
5491     int argc;
5492     Tcl_Obj *CONST objv[];
5493 {
5494     register int i;
5495     CONST char **argv;
5496     if (argc <= 0) {
5497         return NULL;
5498     }
5499     argv = (CONST char **) ckalloc((argc+1) * sizeof(char *));
5500     for (i = 0; i < argc; i++) {
5501         argv[i]=Tcl_GetStringFromObj(objv[i], (int *) NULL);
5502     }
5503     argv[argc] = 0;
5504     return argv;
5505 }
5506 \f
5507 /*
5508  *--------------------------------------------------------------
5509  *
5510  * Tk_CanvasPsColor --
5511  *
5512  *      This procedure is called by individual canvas items when
5513  *      they want to set a color value for output.  Given information
5514  *      about an X color, this procedure will generate Postscript
5515  *      commands to set up an appropriate color in Postscript.
5516  *
5517  * Results:
5518  *      Returns a standard Tcl return value.  If an error occurs
5519  *      then an error message will be left in interp->result.
5520  *      If no error occurs, then additional Postscript will be
5521  *      appended to interp->result.
5522  *
5523  * Side effects:
5524  *      None.
5525  *
5526  *--------------------------------------------------------------
5527  */
5528
5529 int
5530 Tk_CanvasPsColor(interp, canvas, colorPtr)
5531     Tcl_Interp *interp;                 /* Interpreter for returning Postscript
5532                                          * or error message. */
5533     Tk_Canvas canvas;                   /* Information about canvas. */
5534     XColor *colorPtr;                   /* Information about color. */
5535 {
5536     return Tk_PostscriptColor(interp, ((TkCanvas *) canvas)->psInfo,
5537             colorPtr);
5538 }
5539 \f
5540 /*
5541  *--------------------------------------------------------------
5542  *
5543  * Tk_CanvasPsFont --
5544  *
5545  *      This procedure is called by individual canvas items when
5546  *      they want to output text.  Given information about an X
5547  *      font, this procedure will generate Postscript commands
5548  *      to set up an appropriate font in Postscript.
5549  *
5550  * Results:
5551  *      Returns a standard Tcl return value.  If an error occurs
5552  *      then an error message will be left in interp->result.
5553  *      If no error occurs, then additional Postscript will be
5554  *      appended to the interp->result.
5555  *
5556  * Side effects:
5557  *      The Postscript font name is entered into psInfoPtr->fontTable
5558  *      if it wasn't already there.
5559  *
5560  *--------------------------------------------------------------
5561  */
5562
5563 int
5564 Tk_CanvasPsFont(interp, canvas, tkfont)
5565     Tcl_Interp *interp;                 /* Interpreter for returning Postscript
5566                                          * or error message. */
5567     Tk_Canvas canvas;                   /* Information about canvas. */
5568     Tk_Font tkfont;                     /* Information about font in which text
5569                                          * is to be printed. */
5570 {
5571     return Tk_PostscriptFont(interp, ((TkCanvas *) canvas)->psInfo, tkfont);
5572 }
5573 \f
5574 /*
5575  *--------------------------------------------------------------
5576  *
5577  * Tk_CanvasPsBitmap --
5578  *
5579  *      This procedure is called to output the contents of a
5580  *      sub-region of a bitmap in proper image data format for
5581  *      Postscript (i.e. data between angle brackets, one bit
5582  *      per pixel).
5583  *
5584  * Results:
5585  *      Returns a standard Tcl return value.  If an error occurs
5586  *      then an error message will be left in interp->result.
5587  *      If no error occurs, then additional Postscript will be
5588  *      appended to interp->result.
5589  *
5590  * Side effects:
5591  *      None.
5592  *
5593  *--------------------------------------------------------------
5594  */
5595
5596 int
5597 Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
5598     Tcl_Interp *interp;                 /* Interpreter for returning Postscript
5599                                          * or error message. */
5600     Tk_Canvas canvas;                   /* Information about canvas. */
5601     Pixmap bitmap;                      /* Bitmap for which to generate
5602                                          * Postscript. */
5603     int startX, startY;                 /* Coordinates of upper-left corner
5604                                          * of rectangular region to output. */
5605     int width, height;                  /* Height of rectangular region. */
5606 {
5607     return Tk_PostscriptBitmap(interp, ((TkCanvas *) canvas)->tkwin,
5608             ((TkCanvas *) canvas)->psInfo, bitmap, startX, startY,
5609             width, height);
5610 }
5611 \f
5612 /*
5613  *--------------------------------------------------------------
5614  *
5615  * Tk_CanvasPsStipple --
5616  *
5617  *      This procedure is called by individual canvas items when
5618  *      they have created a path that they'd like to be filled with
5619  *      a stipple pattern.  Given information about an X bitmap,
5620  *      this procedure will generate Postscript commands to fill
5621  *      the current clip region using a stipple pattern defined by the
5622  *      bitmap.
5623  *
5624  * Results:
5625  *      Returns a standard Tcl return value.  If an error occurs
5626  *      then an error message will be left in interp->result.
5627  *      If no error occurs, then additional Postscript will be
5628  *      appended to interp->result.
5629  *
5630  * Side effects:
5631  *      None.
5632  *
5633  *--------------------------------------------------------------
5634  */
5635
5636 int
5637 Tk_CanvasPsStipple(interp, canvas, bitmap)
5638     Tcl_Interp *interp;                 /* Interpreter for returning Postscript
5639                                          * or error message. */
5640     Tk_Canvas canvas;                   /* Information about canvas. */
5641     Pixmap bitmap;                      /* Bitmap to use for stippling. */
5642 {
5643     return Tk_PostscriptStipple(interp, ((TkCanvas *) canvas)->tkwin,
5644             ((TkCanvas *) canvas)->psInfo, bitmap);
5645 }
5646 \f
5647 /*
5648  *--------------------------------------------------------------
5649  *
5650  * Tk_CanvasPsY --
5651  *
5652  *      Given a y-coordinate in canvas coordinates, this procedure
5653  *      returns a y-coordinate to use for Postscript output.
5654  *
5655  * Results:
5656  *      Returns the Postscript coordinate that corresponds to
5657  *      "y".
5658  *
5659  * Side effects:
5660  *      None.
5661  *
5662  *--------------------------------------------------------------
5663  */
5664
5665 double
5666 Tk_CanvasPsY(canvas, y)
5667     Tk_Canvas canvas;                   /* Token for canvas on whose behalf
5668                                          * Postscript is being generated. */
5669     double y;                           /* Y-coordinate in canvas coords. */
5670 {
5671     return Tk_PostscriptY(y, ((TkCanvas *) canvas)->psInfo);
5672 }
5673 \f
5674 /*
5675  *--------------------------------------------------------------
5676  *
5677  * Tk_CanvasPsPath --
5678  *
5679  *      Given an array of points for a path, generate Postscript
5680  *      commands to create the path.
5681  *
5682  * Results:
5683  *      Postscript commands get appended to what's in interp->result.
5684  *
5685  * Side effects:
5686  *      None.
5687  *
5688  *--------------------------------------------------------------
5689  */
5690
5691 void
5692 Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
5693     Tcl_Interp *interp;                 /* Put generated Postscript in this
5694                                          * interpreter's result field. */
5695     Tk_Canvas canvas;                   /* Canvas on whose behalf Postscript
5696                                          * is being generated. */
5697     double *coordPtr;                   /* Pointer to first in array of
5698                                          * 2*numPoints coordinates giving
5699                                          * points for path. */
5700     int numPoints;                      /* Number of points at *coordPtr. */
5701 {
5702     Tk_PostscriptPath(interp, ((TkCanvas *) canvas)->psInfo,
5703             coordPtr, numPoints);
5704 }