1 /*
2  * tkListbox.c --
3  *
4  *	This module implements listbox widgets for the Tk toolkit. A listbox
5  *	displays a collection of strings, one per line, and provides scrolling
6  *	and selection.
7  *
8  * Copyright © 1990-1994 The Regents of the University of California.
9  * Copyright © 1994-1997 Sun Microsystems, Inc.
10  *
11  * See the file "license.terms" for information on usage and redistribution of
12  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
13  */
14 
15 #include "tkInt.h"
16 #include "default.h"
17 
18 #ifdef _WIN32
19 #include "tkWinInt.h"
20 #endif
21 
22 typedef struct {
23     Tk_OptionTable listboxOptionTable;
24 				/* Table defining configuration options
25 				 * available for the listbox. */
26     Tk_OptionTable itemAttrOptionTable;
27 				/* Table defining configuration options
28 				 * available for listbox items. */
29 } ListboxOptionTables;
30 
31 /*
32  * A data structure of the following type is kept for each listbox widget
33  * managed by this file:
34  */
35 
36 typedef struct {
37     Tk_Window tkwin;		/* Window that embodies the listbox. NULL
38 				 * means that the window has been destroyed
39 				 * but the data structures haven't yet been
40 				 * cleaned up. */
41     Display *display;		/* Display containing widget. Used, among
42 				 * other things, so that resources can be
43 				 * freed even after tkwin has gone away. */
44     Tcl_Interp *interp;		/* Interpreter associated with listbox. */
45     Tcl_Command widgetCmd;	/* Token for listbox's widget command. */
46     Tk_OptionTable optionTable;	/* Table that defines configuration options
47 				 * available for this widget. */
48     Tk_OptionTable itemAttrOptionTable;
49 				/* Table that defines configuration options
50 				 * available for listbox items. */
51     char *listVarName;		/* List variable name */
52     Tcl_Obj *listObj;		/* Pointer to the list object being used */
53     int nElements;		/* Holds the current count of elements */
54     Tcl_HashTable *selection;	/* Tracks selection */
55     Tcl_HashTable *itemAttrTable;
56 				/* Tracks item attributes */
57 
58     /*
59      * Information used when displaying widget:
60      */
61 
62     Tk_3DBorder normalBorder;	/* Used for drawing border around whole
63 				 * window, plus used for background. */
64     int borderWidth;		/* Width of 3-D border around window. */
65     int relief;			/* 3-D effect: TK_RELIEF_RAISED, etc. */
66     int highlightWidth;		/* Width in pixels of highlight to draw around
67 				 * widget when it has the focus. <= 0 means
68 				 * don't draw a highlight. */
69     XColor *highlightBgColorPtr;
70 				/* Color for drawing traversal highlight area
71 				 * when highlight is off. */
72     XColor *highlightColorPtr;	/* Color for drawing traversal highlight. */
73     int inset;			/* Total width of all borders, including
74 				 * traversal highlight and 3-D border.
75 				 * Indicates how much interior stuff must be
76 				 * offset from outside edges to leave room for
77 				 * borders. */
78     Tk_Font tkfont;		/* Information about text font, or NULL. */
79     XColor *fgColorPtr;		/* Text color in normal mode. */
80     XColor *dfgColorPtr;	/* Text color in disabled mode. */
81     GC textGC;			/* For drawing normal text. */
82     Tk_3DBorder selBorder;	/* Borders and backgrounds for selected
83 				 * elements. */
84     int selBorderWidth;		/* Width of border around selection. */
85     XColor *selFgColorPtr;	/* Foreground color for selected elements. */
86     GC selTextGC;		/* For drawing selected text. */
87     int width;			/* Desired width of window, in characters. */
88     int height;			/* Desired height of window, in lines. */
89     int lineHeight;		/* Number of pixels allocated for each line in
90 				 * display. */
91     int topIndex;		/* Index of top-most element visible in
92 				 * window. */
93     int fullLines;		/* Number of lines that are completely
94 				 * visible in window. There may be one
95 				 * additional line at the bottom that is
96 				 * partially visible. */
97     int partialLine;		/* 0 means that the window holds exactly
98 				 * fullLines lines. 1 means that there is one
99 				 * additional line that is partially
100 				 * visible. */
101     int setGrid;		/* Non-zero means pass gridding information to
102 				 * window manager. */
103 
104     /*
105      * Information to support horizontal scrolling:
106      */
107 
108     int maxWidth;		/* Width (in pixels) of widest string in
109 				 * listbox. */
110     int xScrollUnit;		/* Number of pixels in one "unit" for
111 				 * horizontal scrolling (window scrolls
112 				 * horizontally in increments of this size).
113 				 * This is an average character size. */
114     int xOffset;		/* The left edge of each string in the listbox
115 				 * is offset to the left by this many pixels
116 				 * (0 means no offset, positive means there is
117 				 * an offset). This is x scrolling information
118                                  * is not linked to justification. */
119 
120     /*
121      * Information about what's selected or active, if any.
122      */
123 
124     Tk_Uid selectMode;		/* Selection style: single, browse, multiple,
125 				 * or extended. This value isn't used in C
126 				 * code, but the Tcl bindings use it. */
127     int numSelected;		/* Number of elements currently selected. */
128     int selectAnchor;		/* Fixed end of selection (i.e. element at
129 				 * which selection was started.) */
130     int exportSelection;	/* Non-zero means tie internal listbox to X
131 				 * selection. */
132     int active;			/* Index of "active" element (the one that has
133 				 * been selected by keyboard traversal). -1
134 				 * means none. */
135     int activeStyle;		/* Style in which to draw the active element.
136 				 * One of: underline, none, dotbox */
137 
138     /*
139      * Information for scanning:
140      */
141 
142     int scanMarkX;		/* X-position at which scan started (e.g.
143 				 * button was pressed here). */
144     int scanMarkY;		/* Y-position at which scan started (e.g.
145 				 * button was pressed here). */
146     int scanMarkXOffset;	/* Value of "xOffset" field when scan
147 				 * started. */
148     int scanMarkYIndex;		/* Index of line that was at top of window
149 				 * when scan started. */
150 
151     /*
152      * Miscellaneous information:
153      */
154 
155     Tk_Cursor cursor;		/* Current cursor for window, or None. */
156     char *takeFocus;		/* Value of -takefocus option; not used in the
157 				 * C code, but used by keyboard traversal
158 				 * scripts. Malloc'ed, but may be NULL. */
159     char *yScrollCmd;		/* Command prefix for communicating with
160 				 * vertical scrollbar. NULL means no command
161 				 * to issue. Malloc'ed. */
162     char *xScrollCmd;		/* Command prefix for communicating with
163 				 * horizontal scrollbar. NULL means no command
164 				 * to issue. Malloc'ed. */
165     int state;			/* Listbox state. */
166     Pixmap gray;		/* Pixmap for displaying disabled text. */
167     int flags;			/* Various flag bits: see below for
168 				 * definitions. */
169     Tk_Justify justify;         /* Justification. */
170 } Listbox;
171 
172 /*
173  * How to encode the keys for the hash tables used to store what items are
174  * selected and what the attributes are.
175  */
176 
177 #define KEY(i)		((char *) INT2PTR(i))
178 
179 /*
180  * ItemAttr structures are used to store item configuration information for
181  * the items in a listbox
182  */
183 
184 typedef struct {
185     Tk_3DBorder border;		/* Used for drawing background around text */
186     Tk_3DBorder selBorder;	/* Used for selected text */
187     XColor *fgColor;		/* Text color in normal mode. */
188     XColor *selFgColor;		/* Text color in selected mode. */
189 } ItemAttr;
190 
191 /*
192  * Flag bits for listboxes:
193  *
194  * REDRAW_PENDING:		Non-zero means a DoWhenIdle handler has
195  *				already been queued to redraw this window.
196  * UPDATE_V_SCROLLBAR:		Non-zero means vertical scrollbar needs to be
197  *				updated.
198  * UPDATE_H_SCROLLBAR:		Non-zero means horizontal scrollbar needs to
199  *				be updated.
200  * GOT_FOCUS:			Non-zero means this widget currently has the
201  *				input focus.
202  * MAXWIDTH_IS_STALE:		Stored maxWidth may be out-of-date.
203  * LISTBOX_DELETED:		This listbox has been effectively destroyed.
204  */
205 
206 #define REDRAW_PENDING		1
207 #define UPDATE_V_SCROLLBAR	2
208 #define UPDATE_H_SCROLLBAR	4
209 #define GOT_FOCUS		8
210 #define MAXWIDTH_IS_STALE	16
211 #define LISTBOX_DELETED		32
212 
213 /*
214  * The following enum is used to define a type for the -state option of the
215  * Listbox widget. These values are used as indices into the string table
216  * below.
217  */
218 
219 enum state {
220     STATE_DISABLED, STATE_NORMAL
221 };
222 
223 static const char *const stateStrings[] = {
224     "disabled", "normal", NULL
225 };
226 
227 enum activeStyle {
228     ACTIVE_STYLE_DOTBOX, ACTIVE_STYLE_NONE, ACTIVE_STYLE_UNDERLINE
229 };
230 
231 static const char *const activeStyleStrings[] = {
232     "dotbox", "none", "underline", NULL
233 };
234 
235 /*
236  * The optionSpecs table defines the valid configuration options for the
237  * listbox widget.
238  */
239 
240 static const Tk_OptionSpec optionSpecs[] = {
241     {TK_OPTION_STRING_TABLE, "-activestyle", "activeStyle", "ActiveStyle",
242 	DEF_LISTBOX_ACTIVE_STYLE, TCL_INDEX_NONE, offsetof(Listbox, activeStyle),
243 	0, activeStyleStrings, 0},
244     {TK_OPTION_BORDER, "-background", "background", "Background",
245 	 DEF_LISTBOX_BG_COLOR, TCL_INDEX_NONE, offsetof(Listbox, normalBorder),
246 	 0, DEF_LISTBOX_BG_MONO, 0},
247     {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
248 	 NULL, 0, TCL_INDEX_NONE, 0, "-borderwidth", 0},
249     {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
250 	 NULL, 0, TCL_INDEX_NONE, 0, "-background", 0},
251     {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
252 	 DEF_LISTBOX_BORDER_WIDTH, TCL_INDEX_NONE, offsetof(Listbox, borderWidth),
253 	 0, 0, 0},
254     {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
255 	 DEF_LISTBOX_CURSOR, TCL_INDEX_NONE, offsetof(Listbox, cursor),
256 	 TK_OPTION_NULL_OK, 0, 0},
257     {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
258 	 "DisabledForeground", DEF_LISTBOX_DISABLED_FG, TCL_INDEX_NONE,
259 	 offsetof(Listbox, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
260     {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
261 	 "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION, TCL_INDEX_NONE,
262 	 offsetof(Listbox, exportSelection), 0, 0, 0},
263     {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
264 	 NULL, 0, TCL_INDEX_NONE, 0, "-foreground", 0},
265     {TK_OPTION_FONT, "-font", "font", "Font",
266 	 DEF_LISTBOX_FONT, TCL_INDEX_NONE, offsetof(Listbox, tkfont), 0, 0, 0},
267     {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
268 	 DEF_LISTBOX_FG, TCL_INDEX_NONE, offsetof(Listbox, fgColorPtr), 0, 0, 0},
269     {TK_OPTION_INT, "-height", "height", "Height",
270 	 DEF_LISTBOX_HEIGHT, TCL_INDEX_NONE, offsetof(Listbox, height), 0, 0, 0},
271     {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
272 	 "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG, TCL_INDEX_NONE,
273 	 offsetof(Listbox, highlightBgColorPtr), 0, 0, 0},
274     {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
275 	 DEF_LISTBOX_HIGHLIGHT, TCL_INDEX_NONE, offsetof(Listbox, highlightColorPtr),
276 	 0, 0, 0},
277     {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
278 	 "HighlightThickness", DEF_LISTBOX_HIGHLIGHT_WIDTH, TCL_INDEX_NONE,
279 	 offsetof(Listbox, highlightWidth), 0, 0, 0},
280     {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
281 	DEF_LISTBOX_JUSTIFY, TCL_INDEX_NONE, offsetof(Listbox, justify), 0, 0, 0},
282     {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
283 	 DEF_LISTBOX_RELIEF, TCL_INDEX_NONE, offsetof(Listbox, relief), 0, 0, 0},
284     {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
285 	 DEF_LISTBOX_SELECT_COLOR, TCL_INDEX_NONE, offsetof(Listbox, selBorder),
286 	 0, DEF_LISTBOX_SELECT_MONO, 0},
287     {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
288 	 "BorderWidth", DEF_LISTBOX_SELECT_BD, TCL_INDEX_NONE,
289 	 offsetof(Listbox, selBorderWidth), 0, 0, 0},
290     {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
291 	 DEF_LISTBOX_SELECT_FG_COLOR, TCL_INDEX_NONE, offsetof(Listbox, selFgColorPtr),
292 	 TK_OPTION_NULL_OK, DEF_LISTBOX_SELECT_FG_MONO, 0},
293     {TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode",
294 	 DEF_LISTBOX_SELECT_MODE, TCL_INDEX_NONE, offsetof(Listbox, selectMode),
295 	 TK_OPTION_NULL_OK, 0, 0},
296     {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
297 	 DEF_LISTBOX_SET_GRID, TCL_INDEX_NONE, offsetof(Listbox, setGrid), 0, 0, 0},
298     {TK_OPTION_STRING_TABLE, "-state", "state", "State",
299 	DEF_LISTBOX_STATE, TCL_INDEX_NONE, offsetof(Listbox, state),
300 	0, stateStrings, 0},
301     {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
302 	 DEF_LISTBOX_TAKE_FOCUS, TCL_INDEX_NONE, offsetof(Listbox, takeFocus),
303 	 TK_OPTION_NULL_OK, 0, 0},
304     {TK_OPTION_INT, "-width", "width", "Width",
305 	 DEF_LISTBOX_WIDTH, TCL_INDEX_NONE, offsetof(Listbox, width), 0, 0, 0},
306     {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
307 	 DEF_LISTBOX_SCROLL_COMMAND, TCL_INDEX_NONE, offsetof(Listbox, xScrollCmd),
308 	 TK_OPTION_NULL_OK, 0, 0},
309     {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
310 	 DEF_LISTBOX_SCROLL_COMMAND, TCL_INDEX_NONE, offsetof(Listbox, yScrollCmd),
311 	 TK_OPTION_NULL_OK, 0, 0},
312     {TK_OPTION_STRING, "-listvariable", "listVariable", "Variable",
313 	 DEF_LISTBOX_LIST_VARIABLE, TCL_INDEX_NONE, offsetof(Listbox, listVarName),
314 	 TK_OPTION_NULL_OK, 0, 0},
315     {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, TCL_INDEX_NONE, 0, 0, 0}
316 };
317 
318 /*
319  * The itemAttrOptionSpecs table defines the valid configuration options for
320  * listbox items.
321  */
322 
323 static const Tk_OptionSpec itemAttrOptionSpecs[] = {
324     {TK_OPTION_BORDER, "-background", "background", "Background",
325      NULL, TCL_INDEX_NONE, offsetof(ItemAttr, border),
326      TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
327      DEF_LISTBOX_BG_MONO, 0},
328     {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
329      NULL, 0, TCL_INDEX_NONE, 0, "-background", 0},
330     {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
331      NULL, 0, TCL_INDEX_NONE, 0, "-foreground", 0},
332     {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
333      NULL, TCL_INDEX_NONE, offsetof(ItemAttr, fgColor),
334      TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0},
335     {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
336      NULL, TCL_INDEX_NONE, offsetof(ItemAttr, selBorder),
337      TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
338      DEF_LISTBOX_SELECT_MONO, 0},
339     {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
340      NULL, TCL_INDEX_NONE, offsetof(ItemAttr, selFgColor),
341      TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
342      DEF_LISTBOX_SELECT_FG_MONO, 0},
343     {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, TCL_INDEX_NONE, 0, 0, 0}
344 };
345 
346 /*
347  * The following tables define the listbox widget commands (and sub-commands)
348  * and map the indexes into the string tables into enumerated types used to
349  * dispatch the listbox widget command.
350  */
351 
352 static const char *const commandNames[] = {
353     "activate", "bbox", "cget", "configure", "curselection", "delete", "get",
354     "index", "insert", "itemcget", "itemconfigure", "nearest", "scan",
355     "see", "selection", "size", "xview", "yview", NULL
356 };
357 enum command {
358     COMMAND_ACTIVATE, COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE,
359     COMMAND_CURSELECTION, COMMAND_DELETE, COMMAND_GET, COMMAND_INDEX,
360     COMMAND_INSERT, COMMAND_ITEMCGET, COMMAND_ITEMCONFIGURE,
361     COMMAND_NEAREST, COMMAND_SCAN, COMMAND_SEE, COMMAND_SELECTION,
362     COMMAND_SIZE, COMMAND_XVIEW, COMMAND_YVIEW
363 };
364 
365 static const char *const selCommandNames[] = {
366     "anchor", "clear", "includes", "set", NULL
367 };
368 enum selcommand {
369     SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET
370 };
371 
372 static const char *const scanCommandNames[] = {
373     "mark", "dragto", NULL
374 };
375 enum scancommand {
376     SCAN_MARK, SCAN_DRAGTO
377 };
378 
379 static const char *const indexNames[] = {
380     "active", "anchor", NULL
381 };
382 enum indices {
383     INDEX_ACTIVE, INDEX_ANCHOR
384 };
385 
386 /*
387  * Declarations for procedures defined later in this file.
388  */
389 
390 static void		ChangeListboxOffset(Listbox *listPtr, int offset);
391 static void		ChangeListboxView(Listbox *listPtr, int index);
392 static int		ConfigureListbox(Tcl_Interp *interp, Listbox *listPtr,
393 			    int objc, Tcl_Obj *const objv[]);
394 static int		ConfigureListboxItem(Tcl_Interp *interp,
395 			    Listbox *listPtr, ItemAttr *attrs, int objc,
396 			    Tcl_Obj *const objv[], int index);
397 static int		ListboxDeleteSubCmd(Listbox *listPtr,
398 			    int first, int last);
399 static void		DestroyListbox(void *memPtr);
400 static void		DestroyListboxOptionTables(ClientData clientData,
401 			    Tcl_Interp *interp);
402 static void		DisplayListbox(ClientData clientData);
403 static int		GetListboxIndex(Tcl_Interp *interp, Listbox *listPtr,
404 			    Tcl_Obj *index, int endIsSize, int *indexPtr);
405 static int		ListboxInsertSubCmd(Listbox *listPtr,
406 			    int index, int objc, Tcl_Obj *const objv[]);
407 static void		ListboxCmdDeletedProc(ClientData clientData);
408 static void		ListboxComputeGeometry(Listbox *listPtr,
409 			    int fontChanged, int maxIsStale, int updateGrid);
410 static void		ListboxEventProc(ClientData clientData,
411 			    XEvent *eventPtr);
412 static TkSizeT	ListboxFetchSelection(ClientData clientData,
413 			    TkSizeT offset, char *buffer, TkSizeT maxBytes);
414 static void		ListboxLostSelection(ClientData clientData);
415 static void		GenerateListboxSelectEvent(Listbox *listPtr);
416 static void		EventuallyRedrawRange(Listbox *listPtr,
417 			    int first, int last);
418 static void		ListboxScanTo(Listbox *listPtr, int x, int y);
419 static int		ListboxSelect(Listbox *listPtr,
420 			    int first, int last, int select);
421 static void		ListboxUpdateHScrollbar(Listbox *listPtr);
422 static void		ListboxUpdateVScrollbar(Listbox *listPtr);
423 static int		ListboxWidgetObjCmd(ClientData clientData,
424 			    Tcl_Interp *interp, int objc,
425 			    Tcl_Obj *const objv[]);
426 static int		ListboxBboxSubCmd(Tcl_Interp *interp,
427 			    Listbox *listPtr, int index);
428 static int		ListboxSelectionSubCmd(Tcl_Interp *interp,
429 			    Listbox *listPtr, int objc, Tcl_Obj *const objv[]);
430 static int		ListboxXviewSubCmd(Tcl_Interp *interp,
431 			    Listbox *listPtr, int objc, Tcl_Obj *const objv[]);
432 static int		ListboxYviewSubCmd(Tcl_Interp *interp,
433 			    Listbox *listPtr, int objc, Tcl_Obj *const objv[]);
434 static ItemAttr *	ListboxGetItemAttributes(Tcl_Interp *interp,
435 			    Listbox *listPtr, int index);
436 static void		ListboxWorldChanged(ClientData instanceData);
437 static int		NearestListboxElement(Listbox *listPtr, int y);
438 static char *		ListboxListVarProc(ClientData clientData,
439 			    Tcl_Interp *interp, const char *name1,
440 			    const char *name2, int flags);
441 static void		MigrateHashEntries(Tcl_HashTable *table,
442 			    int first, int last, int offset);
443 static int		GetMaxOffset(Listbox *listPtr);
444 
445 /*
446  * The structure below defines button class behavior by means of procedures
447  * that can be invoked from generic window code.
448  */
449 
450 static const Tk_ClassProcs listboxClass = {
451     sizeof(Tk_ClassProcs),	/* size */
452     ListboxWorldChanged,	/* worldChangedProc */
453     NULL,			/* createProc */
454     NULL			/* modalProc */
455 };
456 
457 /*
458  *--------------------------------------------------------------
459  *
460  * Tk_ListboxObjCmd --
461  *
462  *	This procedure is invoked to process the "listbox" Tcl command. See
463  *	the user documentation for details on what it does.
464  *
465  * Results:
466  *	A standard Tcl result.
467  *
468  * Side effects:
469  *	See the user documentation.
470  *
471  *--------------------------------------------------------------
472  */
473 
474 int
Tk_ListboxObjCmd(ClientData dummy,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])475 Tk_ListboxObjCmd(
476     ClientData dummy,	/* NULL. */
477     Tcl_Interp *interp,		/* Current interpreter. */
478     int objc,			/* Number of arguments. */
479     Tcl_Obj *const objv[])	/* Argument objects. */
480 {
481     Listbox *listPtr;
482     Tk_Window tkwin;
483     ListboxOptionTables *optionTables;
484     (void)dummy;
485 
486     if (objc < 2) {
487 	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
488 	return TCL_ERROR;
489     }
490 
491     tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
492 	    Tcl_GetString(objv[1]), NULL);
493     if (tkwin == NULL) {
494 	return TCL_ERROR;
495     }
496 
497     optionTables = (ListboxOptionTables *)Tcl_GetAssocData(interp, "ListboxOptionTables", NULL);
498     if (optionTables == NULL) {
499 	/*
500 	 * We haven't created the option tables for this widget class yet. Do
501 	 * it now and save the a pointer to them as the ClientData for the
502 	 * command, so future invocations will have access to it.
503 	 */
504 
505 	optionTables = (ListboxOptionTables *)ckalloc(sizeof(ListboxOptionTables));
506 
507 	/*
508 	 * Set up an exit handler to free the optionTables struct.
509 	 */
510 
511 	Tcl_SetAssocData(interp, "ListboxOptionTables",
512 		DestroyListboxOptionTables, optionTables);
513 
514 	/*
515 	 * Create the listbox option table and the listbox item option table.
516 	 */
517 
518 	optionTables->listboxOptionTable =
519 		Tk_CreateOptionTable(interp, optionSpecs);
520 	optionTables->itemAttrOptionTable =
521 		Tk_CreateOptionTable(interp, itemAttrOptionSpecs);
522     }
523 
524     /*
525      * Initialize the fields of the structure that won't be initialized by
526      * ConfigureListbox, or that ConfigureListbox requires to be initialized
527      * already (e.g. resource pointers).
528      */
529 
530     listPtr			 = (Listbox *)ckalloc(sizeof(Listbox));
531     memset(listPtr, 0, sizeof(Listbox));
532 
533     listPtr->tkwin		 = tkwin;
534     listPtr->display		 = Tk_Display(tkwin);
535     listPtr->interp		 = interp;
536     listPtr->widgetCmd		 = Tcl_CreateObjCommand(interp,
537 	    Tk_PathName(listPtr->tkwin), ListboxWidgetObjCmd, listPtr,
538 	    ListboxCmdDeletedProc);
539     listPtr->optionTable	 = optionTables->listboxOptionTable;
540     listPtr->itemAttrOptionTable = optionTables->itemAttrOptionTable;
541     listPtr->selection		 = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
542     Tcl_InitHashTable(listPtr->selection, TCL_ONE_WORD_KEYS);
543     listPtr->itemAttrTable	 = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
544     Tcl_InitHashTable(listPtr->itemAttrTable, TCL_ONE_WORD_KEYS);
545     listPtr->relief		 = TK_RELIEF_RAISED;
546     listPtr->textGC		 = NULL;
547     listPtr->selFgColorPtr	 = NULL;
548     listPtr->selTextGC		 = NULL;
549     listPtr->fullLines		 = 1;
550     listPtr->xScrollUnit	 = 1;
551     listPtr->exportSelection	 = 1;
552     listPtr->cursor		 = NULL;
553     listPtr->state		 = STATE_NORMAL;
554     listPtr->gray		 = None;
555     listPtr->justify             = TK_JUSTIFY_LEFT;
556 
557     /*
558      * Keep a hold of the associated tkwin until we destroy the listbox,
559      * otherwise Tk might free it while we still need it.
560      */
561 
562     Tcl_Preserve(listPtr->tkwin);
563 
564     Tk_SetClass(listPtr->tkwin, "Listbox");
565     Tk_SetClassProcs(listPtr->tkwin, &listboxClass, listPtr);
566     Tk_CreateEventHandler(listPtr->tkwin,
567 	    ExposureMask|StructureNotifyMask|FocusChangeMask,
568 	    ListboxEventProc, listPtr);
569     Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,
570 	    ListboxFetchSelection, listPtr, XA_STRING);
571     if (Tk_InitOptions(interp, listPtr,
572 	    optionTables->listboxOptionTable, tkwin) != TCL_OK) {
573 	Tk_DestroyWindow(listPtr->tkwin);
574 	return TCL_ERROR;
575     }
576 
577     if (ConfigureListbox(interp, listPtr, objc-2, objv+2) != TCL_OK) {
578 	Tk_DestroyWindow(listPtr->tkwin);
579 	return TCL_ERROR;
580     }
581 
582     Tcl_SetObjResult(interp, Tk_NewWindowObj(listPtr->tkwin));
583     return TCL_OK;
584 }
585 
586 /*
587  *----------------------------------------------------------------------
588  *
589  * ListboxWidgetObjCmd --
590  *
591  *	This Tcl_Obj based procedure is invoked to process the Tcl command
592  *	that corresponds to a widget managed by this module. See the user
593  *	documentation for details on what it does.
594  *
595  * Results:
596  *	A standard Tcl result.
597  *
598  * Side effects:
599  *	See the user documentation.
600  *
601  *----------------------------------------------------------------------
602  */
603 
604 static int
ListboxWidgetObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])605 ListboxWidgetObjCmd(
606     ClientData clientData,	/* Information about listbox widget. */
607     Tcl_Interp *interp,		/* Current interpreter. */
608     int objc,			/* Number of arguments. */
609     Tcl_Obj *const objv[])	/* Arguments as Tcl_Obj's. */
610 {
611     Listbox *listPtr = (Listbox *)clientData;
612     int cmdIndex, index;
613     int result = TCL_OK;
614     Tcl_Obj *objPtr;
615 
616     if (objc < 2) {
617 	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
618 	return TCL_ERROR;
619     }
620 
621     /*
622      * Parse the command by looking up the second argument in the list of
623      * valid subcommand names.
624      */
625 
626     result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
627 	    "option", 0, &cmdIndex);
628     if (result != TCL_OK) {
629 	return result;
630     }
631 
632     Tcl_Preserve(listPtr);
633 
634     /*
635      * The subcommand was valid, so continue processing.
636      */
637 
638     switch (cmdIndex) {
639     case COMMAND_ACTIVATE:
640 	if (objc != 3) {
641 	    Tcl_WrongNumArgs(interp, 2, objv, "index");
642 	    result = TCL_ERROR;
643 	    break;
644 	}
645 	result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
646 	if (result != TCL_OK) {
647 	    break;
648 	}
649 
650 	if (!(listPtr->state & STATE_NORMAL)) {
651 	    break;
652 	}
653 
654 	if (index >= listPtr->nElements) {
655 	    index = listPtr->nElements-1;
656 	}
657 	if (index < 0) {
658 	    index = 0;
659 	}
660 	listPtr->active = index;
661 	EventuallyRedrawRange(listPtr, listPtr->active, listPtr->active);
662 	result = TCL_OK;
663 	break;
664 
665     case COMMAND_BBOX:
666 	if (objc != 3) {
667 	    Tcl_WrongNumArgs(interp, 2, objv, "index");
668 	    result = TCL_ERROR;
669 	    break;
670 	}
671 	result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
672 	if (result != TCL_OK) {
673 	    break;
674 	}
675 
676 	result = ListboxBboxSubCmd(interp, listPtr, index);
677 	break;
678 
679     case COMMAND_CGET:
680 	if (objc != 3) {
681 	    Tcl_WrongNumArgs(interp, 2, objv, "option");
682 	    result = TCL_ERROR;
683 	    break;
684 	}
685 
686 	objPtr = Tk_GetOptionValue(interp, listPtr,
687 		listPtr->optionTable, objv[2], listPtr->tkwin);
688 	if (objPtr == NULL) {
689 	    result = TCL_ERROR;
690 	    break;
691 	}
692 	Tcl_SetObjResult(interp, objPtr);
693 	result = TCL_OK;
694 	break;
695 
696     case COMMAND_CONFIGURE:
697 	if (objc <= 3) {
698 	    objPtr = Tk_GetOptionInfo(interp, listPtr,
699 		    listPtr->optionTable,
700 		    (objc == 3) ? objv[2] : NULL, listPtr->tkwin);
701 	    if (objPtr == NULL) {
702 		result = TCL_ERROR;
703 		break;
704 	    }
705 	    Tcl_SetObjResult(interp, objPtr);
706 	    result = TCL_OK;
707 	} else {
708 	    result = ConfigureListbox(interp, listPtr, objc-2, objv+2);
709 	}
710 	break;
711 
712     case COMMAND_CURSELECTION: {
713 	int i;
714 
715 	if (objc != 2) {
716 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
717 	    result = TCL_ERROR;
718 	    break;
719 	}
720 
721 	/*
722 	 * Of course, it would be more efficient to use the Tcl_HashTable
723 	 * search functions (Tcl_FirstHashEntry, Tcl_NextHashEntry), but then
724 	 * the result wouldn't be in sorted order. So instead we loop through
725 	 * the indices in order, adding them to the result if they are
726 	 * selected.
727 	 */
728 
729 	objPtr = Tcl_NewObj();
730 	for (i = 0; i < listPtr->nElements; i++) {
731 	    if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) {
732 		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(i));
733 	    }
734 	}
735 	Tcl_SetObjResult(interp, objPtr);
736 	result = TCL_OK;
737 	break;
738     }
739 
740     case COMMAND_DELETE: {
741 	int first, last;
742 
743 	if ((objc < 3) || (objc > 4)) {
744 	    Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
745 	    result = TCL_ERROR;
746 	    break;
747 	}
748 
749 	result = GetListboxIndex(interp, listPtr, objv[2], 0, &first);
750 	if (result != TCL_OK) {
751 	    break;
752 	}
753 
754 	if (!(listPtr->state & STATE_NORMAL)) {
755 	    break;
756 	}
757 
758 	if (first < listPtr->nElements) {
759 	    /*
760 	     * if a "last index" was given, get it now; otherwise, use the
761 	     * first index as the last index.
762 	     */
763 
764 	    if (objc == 4) {
765 		result = GetListboxIndex(interp, listPtr, objv[3], 0, &last);
766 		if (result != TCL_OK) {
767 		    break;
768 		}
769 	    } else {
770 		last = first;
771 	    }
772 	    if (last >= listPtr->nElements) {
773 		last = listPtr->nElements - 1;
774 	    }
775 	    result = ListboxDeleteSubCmd(listPtr, first, last);
776 	} else {
777 	    result = TCL_OK;
778 	}
779 	break;
780     }
781 
782     case COMMAND_GET: {
783 	int first, last, listLen;
784 	Tcl_Obj **elemPtrs;
785 
786 	if (objc != 3 && objc != 4) {
787 	    Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
788 	    result = TCL_ERROR;
789 	    break;
790 	}
791 	result = GetListboxIndex(interp, listPtr, objv[2], 0, &first);
792 	if (result != TCL_OK) {
793 	    break;
794 	}
795 	last = first;
796 	if (objc == 4) {
797 	    result = GetListboxIndex(interp, listPtr, objv[3], 0, &last);
798 	    if (result != TCL_OK) {
799 		break;
800 	    }
801 	}
802 	if (first >= listPtr->nElements) {
803 	    result = TCL_OK;
804 	    break;
805 	}
806 	if (last >= listPtr->nElements) {
807 	    last = listPtr->nElements - 1;
808 	}
809 	if (first < 0) {
810 	    first = 0;
811 	}
812 	if (first > last) {
813 	    result = TCL_OK;
814 	    break;
815 	}
816 	result = Tcl_ListObjGetElements(interp, listPtr->listObj, &listLen,
817 		&elemPtrs);
818 	if (result != TCL_OK) {
819 	    break;
820 	}
821 	if (objc == 3) {
822 	    /*
823 	     * One element request - we return a string
824 	     */
825 
826 	    Tcl_SetObjResult(interp, elemPtrs[first]);
827 	} else {
828 	    Tcl_SetObjResult(interp,
829 		    Tcl_NewListObj(last-first+1, elemPtrs+first));
830 	}
831 	result = TCL_OK;
832 	break;
833     }
834 
835     case COMMAND_INDEX:
836 	if (objc != 3) {
837 	    Tcl_WrongNumArgs(interp, 2, objv, "index");
838 	    result = TCL_ERROR;
839 	    break;
840 	}
841 	result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
842 	if (result != TCL_OK) {
843 	    break;
844 	}
845 	Tcl_SetObjResult(interp, TkNewIndexObj(index));
846 	result = TCL_OK;
847 	break;
848 
849     case COMMAND_INSERT:
850 	if (objc < 3) {
851 	    Tcl_WrongNumArgs(interp, 2, objv, "index ?element ...?");
852 	    result = TCL_ERROR;
853 	    break;
854 	}
855 
856 	result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
857 	if (result != TCL_OK) {
858 	    break;
859 	}
860 
861 	if (!(listPtr->state & STATE_NORMAL)) {
862 	    break;
863 	}
864 
865 	result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3);
866 	break;
867 
868     case COMMAND_ITEMCGET: {
869 	ItemAttr *attrPtr;
870 
871 	if (objc != 4) {
872 	    Tcl_WrongNumArgs(interp, 2, objv, "index option");
873 	    result = TCL_ERROR;
874 	    break;
875 	}
876 
877 	result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
878 	if (result != TCL_OK) {
879 	    break;
880 	}
881 
882 	if (index < 0 || index >= listPtr->nElements) {
883 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
884 		    "item number \"%s\" out of range",
885 		    Tcl_GetString(objv[2])));
886 	    Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", NULL);
887 	    result = TCL_ERROR;
888 	    break;
889 	}
890 
891 	attrPtr = ListboxGetItemAttributes(interp, listPtr, index);
892 
893 	objPtr = Tk_GetOptionValue(interp, (char *) attrPtr,
894 		listPtr->itemAttrOptionTable, objv[3], listPtr->tkwin);
895 	if (objPtr == NULL) {
896 	    result = TCL_ERROR;
897 	    break;
898 	}
899 	Tcl_SetObjResult(interp, objPtr);
900 	result = TCL_OK;
901 	break;
902     }
903 
904     case COMMAND_ITEMCONFIGURE: {
905 	ItemAttr *attrPtr;
906 
907 	if (objc < 3) {
908 	    Tcl_WrongNumArgs(interp, 2, objv,
909 		    "index ?-option value ...?");
910 	    result = TCL_ERROR;
911 	    break;
912 	}
913 
914 	result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
915 	if (result != TCL_OK) {
916 	    break;
917 	}
918 
919 	if (index < 0 || index >= listPtr->nElements) {
920 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
921 		    "item number \"%s\" out of range",
922 		    Tcl_GetString(objv[2])));
923 	    Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", NULL);
924 	    result = TCL_ERROR;
925 	    break;
926 	}
927 
928 	attrPtr = ListboxGetItemAttributes(interp, listPtr, index);
929 	if (objc <= 4) {
930 	    objPtr = Tk_GetOptionInfo(interp, attrPtr,
931 		    listPtr->itemAttrOptionTable,
932 		    (objc == 4) ? objv[3] : NULL, listPtr->tkwin);
933 	    if (objPtr == NULL) {
934 		result = TCL_ERROR;
935 		break;
936 	    }
937 	    Tcl_SetObjResult(interp, objPtr);
938 	    result = TCL_OK;
939 	} else {
940 	    result = ConfigureListboxItem(interp, listPtr, attrPtr,
941 		    objc-3, objv+3, index);
942 	}
943 	break;
944     }
945 
946     case COMMAND_NEAREST: {
947 	int y;
948 
949 	if (objc != 3) {
950 	    Tcl_WrongNumArgs(interp, 2, objv, "y");
951 	    result = TCL_ERROR;
952 	    break;
953 	}
954 
955 	result = Tcl_GetIntFromObj(interp, objv[2], &y);
956 	if (result != TCL_OK) {
957 	    break;
958 	}
959 	index = NearestListboxElement(listPtr, y);
960 	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
961 	result = TCL_OK;
962 	break;
963     }
964 
965     case COMMAND_SCAN: {
966 	int x, y, scanCmdIndex;
967 
968 	if (objc != 5) {
969 	    Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y");
970 	    result = TCL_ERROR;
971 	    break;
972 	}
973 
974 	if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK
975 		|| Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
976 	    result = TCL_ERROR;
977 	    break;
978 	}
979 
980 	result = Tcl_GetIndexFromObj(interp, objv[2], scanCommandNames,
981 		"option", 0, &scanCmdIndex);
982 	if (result != TCL_OK) {
983 	    break;
984 	}
985 	switch (scanCmdIndex) {
986 	case SCAN_MARK:
987 	    listPtr->scanMarkX = x;
988 	    listPtr->scanMarkY = y;
989 	    listPtr->scanMarkXOffset = listPtr->xOffset;
990 	    listPtr->scanMarkYIndex = listPtr->topIndex;
991 	    break;
992 	case SCAN_DRAGTO:
993 	    ListboxScanTo(listPtr, x, y);
994 	    break;
995 	}
996 	result = TCL_OK;
997 	break;
998     }
999 
1000     case COMMAND_SEE: {
1001 	int diff;
1002 
1003 	if (objc != 3) {
1004 	    Tcl_WrongNumArgs(interp, 2, objv, "index");
1005 	    result = TCL_ERROR;
1006 	    break;
1007 	}
1008 	result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
1009 	if (result != TCL_OK) {
1010 	    break;
1011 	}
1012 	if (index >= listPtr->nElements) {
1013 	    index = listPtr->nElements - 1;
1014 	}
1015 	if (index < 0) {
1016 	    index = 0;
1017 	}
1018 	diff = listPtr->topIndex - index;
1019 	if (diff > 0) {
1020 	    if (diff <= listPtr->fullLines / 3) {
1021 		ChangeListboxView(listPtr, index);
1022 	    } else {
1023 		ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2);
1024 	    }
1025 	} else {
1026 	    diff = index - (listPtr->topIndex + listPtr->fullLines - 1);
1027 	    if (diff > 0) {
1028 		if (diff <= listPtr->fullLines / 3) {
1029 		    ChangeListboxView(listPtr, listPtr->topIndex + diff);
1030 		} else {
1031 		    ChangeListboxView(listPtr, index-(listPtr->fullLines-1)/2);
1032 		}
1033 	    }
1034 	}
1035 	result = TCL_OK;
1036 	break;
1037     }
1038 
1039     case COMMAND_SELECTION:
1040 	result = ListboxSelectionSubCmd(interp, listPtr, objc, objv);
1041 	break;
1042     case COMMAND_SIZE:
1043 	if (objc != 2) {
1044 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
1045 	    result = TCL_ERROR;
1046 	    break;
1047 	}
1048 	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(listPtr->nElements));
1049 	result = TCL_OK;
1050 	break;
1051     case COMMAND_XVIEW:
1052 	result = ListboxXviewSubCmd(interp, listPtr, objc, objv);
1053 	break;
1054     case COMMAND_YVIEW:
1055 	result = ListboxYviewSubCmd(interp, listPtr, objc, objv);
1056 	break;
1057     }
1058     Tcl_Release(listPtr);
1059     return result;
1060 }
1061 
1062 /*
1063  *----------------------------------------------------------------------
1064  *
1065  * ListboxBboxSubCmd --
1066  *
1067  *	This procedure is invoked to process a listbox bbox request. See the
1068  *	user documentation for more information.
1069  *
1070  * Results:
1071  *	A standard Tcl result.
1072  *
1073  * Side effects:
1074  *	For valid indices, places the bbox of the requested element in the
1075  *	interpreter's result.
1076  *
1077  *----------------------------------------------------------------------
1078  */
1079 
1080 static int
ListboxBboxSubCmd(Tcl_Interp * interp,Listbox * listPtr,int index)1081 ListboxBboxSubCmd(
1082     Tcl_Interp *interp,		/* Pointer to the calling Tcl interpreter */
1083     Listbox *listPtr,		/* Information about the listbox */
1084     int index)			/* Index of the element to get bbox info on */
1085 {
1086     Tk_Window tkwin = listPtr->tkwin;
1087     int lastVisibleIndex;
1088 
1089     /*
1090      * Determine the index of the last visible item in the listbox.
1091      */
1092 
1093     lastVisibleIndex = listPtr->topIndex + listPtr->fullLines
1094 	    + listPtr->partialLine;
1095     if (listPtr->nElements < lastVisibleIndex) {
1096 	lastVisibleIndex = listPtr->nElements;
1097     }
1098 
1099     /*
1100      * Only allow bbox requests for indices that are visible.
1101      */
1102 
1103     if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) {
1104 	Tcl_Obj *el, *results[4];
1105 	const char *stringRep;
1106 	int pixelWidth, x, y, result;
1107 	TkSizeT stringLen;
1108 	Tk_FontMetrics fm;
1109 
1110 	/*
1111 	 * Compute the pixel width of the requested element.
1112 	 */
1113 
1114 	result = Tcl_ListObjIndex(interp, listPtr->listObj, index, &el);
1115 	if (result != TCL_OK) {
1116 	    return result;
1117 	}
1118 
1119 	stringRep = Tcl_GetStringFromObj(el, &stringLen);
1120 	Tk_GetFontMetrics(listPtr->tkfont, &fm);
1121 	pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen);
1122 
1123         if (listPtr->justify == TK_JUSTIFY_LEFT) {
1124             x = (listPtr->inset + listPtr->selBorderWidth) - listPtr->xOffset;
1125         } else if (listPtr->justify == TK_JUSTIFY_RIGHT) {
1126             x = Tk_Width(tkwin) - (listPtr->inset + listPtr->selBorderWidth)
1127                     - pixelWidth - listPtr->xOffset + GetMaxOffset(listPtr);
1128         } else {
1129             x = (Tk_Width(tkwin) - pixelWidth)/2
1130                     - listPtr->xOffset + GetMaxOffset(listPtr)/2;
1131         }
1132 	y = ((index - listPtr->topIndex)*listPtr->lineHeight)
1133 		+ listPtr->inset + listPtr->selBorderWidth;
1134 	results[0] = Tcl_NewWideIntObj(x);
1135 	results[1] = Tcl_NewWideIntObj(y);
1136 	results[2] = Tcl_NewWideIntObj(pixelWidth);
1137 	results[3] = Tcl_NewWideIntObj(fm.linespace);
1138 	Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
1139     }
1140     return TCL_OK;
1141 }
1142 
1143 /*
1144  *----------------------------------------------------------------------
1145  *
1146  * ListboxSelectionSubCmd --
1147  *
1148  *	This procedure is invoked to process the selection sub command for
1149  *	listbox widgets.
1150  *
1151  * Results:
1152  *	Standard Tcl result.
1153  *
1154  * Side effects:
1155  *	May set the interpreter's result field.
1156  *
1157  *----------------------------------------------------------------------
1158  */
1159 
1160 static int
ListboxSelectionSubCmd(Tcl_Interp * interp,Listbox * listPtr,int objc,Tcl_Obj * const objv[])1161 ListboxSelectionSubCmd(
1162     Tcl_Interp *interp,		/* Pointer to the calling Tcl interpreter */
1163     Listbox *listPtr,		/* Information about the listbox */
1164     int objc,			/* Number of arguments in the objv array */
1165     Tcl_Obj *const objv[])	/* Array of arguments to the procedure */
1166 {
1167     int selCmdIndex, first, last;
1168     int result = TCL_OK;
1169 
1170     if (objc != 4 && objc != 5) {
1171 	Tcl_WrongNumArgs(interp, 2, objv, "option index ?index?");
1172 	return TCL_ERROR;
1173     }
1174     result = GetListboxIndex(interp, listPtr, objv[3], 0, &first);
1175     if (result != TCL_OK) {
1176 	return result;
1177     }
1178     last = first;
1179     if (objc == 5) {
1180 	result = GetListboxIndex(interp, listPtr, objv[4], 0, &last);
1181 	if (result != TCL_OK) {
1182 	    return result;
1183 	}
1184     }
1185     result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames,
1186 	    "option", 0, &selCmdIndex);
1187     if (result != TCL_OK) {
1188 	return result;
1189     }
1190 
1191     /*
1192      * Only allow 'selection includes' to respond if disabled. [Bug #632514]
1193      */
1194 
1195     if ((listPtr->state == STATE_DISABLED)
1196 	    && (selCmdIndex != SELECTION_INCLUDES)) {
1197 	return TCL_OK;
1198     }
1199 
1200     switch (selCmdIndex) {
1201     case SELECTION_ANCHOR:
1202 	if (objc != 4) {
1203 	    Tcl_WrongNumArgs(interp, 3, objv, "index");
1204 	    return TCL_ERROR;
1205 	}
1206 	if (first >= listPtr->nElements) {
1207 	    first = listPtr->nElements - 1;
1208 	}
1209 	if (first < 0) {
1210 	    first = 0;
1211 	}
1212 	listPtr->selectAnchor = first;
1213 	result = TCL_OK;
1214 	break;
1215     case SELECTION_CLEAR:
1216 	result = ListboxSelect(listPtr, first, last, 0);
1217 	break;
1218     case SELECTION_INCLUDES:
1219 	if (objc != 4) {
1220 	    Tcl_WrongNumArgs(interp, 3, objv, "index");
1221 	    return TCL_ERROR;
1222 	}
1223 	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
1224 		Tcl_FindHashEntry(listPtr->selection, KEY(first)) != NULL));
1225 	result = TCL_OK;
1226 	break;
1227     case SELECTION_SET:
1228 	result = ListboxSelect(listPtr, first, last, 1);
1229 	break;
1230     }
1231     return result;
1232 }
1233 
1234 /*
1235  *----------------------------------------------------------------------
1236  *
1237  * ListboxXviewSubCmd --
1238  *
1239  *	Process the listbox "xview" subcommand.
1240  *
1241  * Results:
1242  *	Standard Tcl result.
1243  *
1244  * Side effects:
1245  *	May change the listbox viewing area; may set the interpreter's result.
1246  *
1247  *----------------------------------------------------------------------
1248  */
1249 
1250 static int
ListboxXviewSubCmd(Tcl_Interp * interp,Listbox * listPtr,int objc,Tcl_Obj * const objv[])1251 ListboxXviewSubCmd(
1252     Tcl_Interp *interp,		/* Pointer to the calling Tcl interpreter */
1253     Listbox *listPtr,		/* Information about the listbox */
1254     int objc,			/* Number of arguments in the objv array */
1255     Tcl_Obj *const objv[])	/* Array of arguments to the procedure */
1256 {
1257     int index, count, windowWidth, windowUnits;
1258     int offset = 0;		/* Initialized to stop gcc warnings. */
1259     double fraction;
1260 
1261     windowWidth = Tk_Width(listPtr->tkwin)
1262 	    - 2*(listPtr->inset + listPtr->selBorderWidth);
1263     if (objc == 2) {
1264 	Tcl_Obj *results[2];
1265 
1266 	if (listPtr->maxWidth == 0) {
1267 	    results[0] = Tcl_NewDoubleObj(0.0);
1268 	    results[1] = Tcl_NewDoubleObj(1.0);
1269 	} else {
1270 	    double fraction2;
1271 
1272 	    fraction = listPtr->xOffset / (double) listPtr->maxWidth;
1273 	    fraction2 = (listPtr->xOffset + windowWidth)
1274 		    / (double) listPtr->maxWidth;
1275 	    if (fraction2 > 1.0) {
1276 		fraction2 = 1.0;
1277 	    }
1278 	    results[0] = Tcl_NewDoubleObj(fraction);
1279 	    results[1] = Tcl_NewDoubleObj(fraction2);
1280 	}
1281 	Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
1282     } else if (objc == 3) {
1283 	if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) {
1284 	    return TCL_ERROR;
1285 	}
1286 	ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
1287     } else {
1288 	switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) {
1289 	case TK_SCROLL_ERROR:
1290 	    return TCL_ERROR;
1291 	case TK_SCROLL_MOVETO:
1292 	    offset = (int) (fraction*listPtr->maxWidth + 0.5);
1293 	    break;
1294 	case TK_SCROLL_PAGES:
1295 	    windowUnits = windowWidth / listPtr->xScrollUnit;
1296 	    if (windowUnits > 2) {
1297 		offset = listPtr->xOffset
1298 			+ count*listPtr->xScrollUnit*(windowUnits-2);
1299 	    } else {
1300 		offset = listPtr->xOffset + count*listPtr->xScrollUnit;
1301 	    }
1302 	    break;
1303 	case TK_SCROLL_UNITS:
1304 	    offset = listPtr->xOffset + count*listPtr->xScrollUnit;
1305 	    break;
1306 	}
1307 	ChangeListboxOffset(listPtr, offset);
1308     }
1309     return TCL_OK;
1310 }
1311 
1312 /*
1313  *----------------------------------------------------------------------
1314  *
1315  * ListboxYviewSubCmd --
1316  *
1317  *	Process the listbox "yview" subcommand.
1318  *
1319  * Results:
1320  *	Standard Tcl result.
1321  *
1322  * Side effects:
1323  *	May change the listbox viewing area; may set the interpreter's result.
1324  *
1325  *----------------------------------------------------------------------
1326  */
1327 
1328 static int
ListboxYviewSubCmd(Tcl_Interp * interp,Listbox * listPtr,int objc,Tcl_Obj * const objv[])1329 ListboxYviewSubCmd(
1330     Tcl_Interp *interp,		/* Pointer to the calling Tcl interpreter */
1331     Listbox *listPtr,		/* Information about the listbox */
1332     int objc,			/* Number of arguments in the objv array */
1333     Tcl_Obj *const objv[])	/* Array of arguments to the procedure */
1334 {
1335     int index, count;
1336     double fraction;
1337 
1338     if (objc == 2) {
1339 	Tcl_Obj *results[2];
1340 
1341 	if (listPtr->nElements == 0) {
1342 	    results[0] = Tcl_NewDoubleObj(0.0);
1343 	    results[1] = Tcl_NewDoubleObj(1.0);
1344 	} else {
1345 	    double fraction2, numEls = (double) listPtr->nElements;
1346 
1347 	    fraction = listPtr->topIndex / numEls;
1348 	    fraction2 = (listPtr->topIndex+listPtr->fullLines) / numEls;
1349 	    if (fraction2 > 1.0) {
1350 		fraction2 = 1.0;
1351 	    }
1352 	    results[0] = Tcl_NewDoubleObj(fraction);
1353 	    results[1] = Tcl_NewDoubleObj(fraction2);
1354 	}
1355 	Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
1356     } else if (objc == 3) {
1357 	if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) {
1358 	    return TCL_ERROR;
1359 	}
1360 	ChangeListboxView(listPtr, index);
1361     } else {
1362 	switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) {
1363 	case TK_SCROLL_MOVETO:
1364 	    index = (int) (listPtr->nElements*fraction + 0.5);
1365 	    break;
1366 	case TK_SCROLL_PAGES:
1367 	    if (listPtr->fullLines > 2) {
1368 		index = listPtr->topIndex + count*(listPtr->fullLines-2);
1369 	    } else {
1370 		index = listPtr->topIndex + count;
1371 	    }
1372 	    break;
1373 	case TK_SCROLL_UNITS:
1374 	    index = listPtr->topIndex + count;
1375 	    break;
1376 	case TK_SCROLL_ERROR:
1377 	default:
1378 	    return TCL_ERROR;
1379 	}
1380 	ChangeListboxView(listPtr, index);
1381     }
1382     return TCL_OK;
1383 }
1384 
1385 /*
1386  *----------------------------------------------------------------------
1387  *
1388  * ListboxGetItemAttributes --
1389  *
1390  *	Returns a pointer to the ItemAttr record for a given index, creating
1391  *	one if it does not already exist.
1392  *
1393  * Results:
1394  *	Pointer to an ItemAttr record.
1395  *
1396  * Side effects:
1397  *	Memory may be allocated for the ItemAttr record.
1398  *
1399  *----------------------------------------------------------------------
1400  */
1401 
1402 static ItemAttr *
ListboxGetItemAttributes(Tcl_Interp * interp,Listbox * listPtr,int index)1403 ListboxGetItemAttributes(
1404     Tcl_Interp *interp,		/* Pointer to the calling Tcl interpreter */
1405     Listbox *listPtr,		/* Information about the listbox */
1406     int index)			/* Index of the item to retrieve attributes
1407 				 * for. */
1408 {
1409     int isNew;
1410     Tcl_HashEntry *entry;
1411     ItemAttr *attrs;
1412 
1413     entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, KEY(index), &isNew);
1414     if (isNew) {
1415 	attrs = (ItemAttr *)ckalloc(sizeof(ItemAttr));
1416 	attrs->border = NULL;
1417 	attrs->selBorder = NULL;
1418 	attrs->fgColor = NULL;
1419 	attrs->selFgColor = NULL;
1420 	Tk_InitOptions(interp, attrs, listPtr->itemAttrOptionTable,
1421 		listPtr->tkwin);
1422 	Tcl_SetHashValue(entry, attrs);
1423     } else {
1424 	attrs = (ItemAttr *)Tcl_GetHashValue(entry);
1425     }
1426     return attrs;
1427 }
1428 
1429 /*
1430  *----------------------------------------------------------------------
1431  *
1432  * DestroyListbox --
1433  *
1434  *	This procedure is invoked by Tcl_EventuallyFree or Tcl_Release to
1435  *	clean up the internal structure of a listbox at a safe time (when
1436  *	no-one is using it anymore).
1437  *
1438  * Results:
1439  *	None.
1440  *
1441  * Side effects:
1442  *	Everything associated with the listbox is freed up.
1443  *
1444  *----------------------------------------------------------------------
1445  */
1446 
1447 static void
DestroyListbox(void * memPtr)1448 DestroyListbox(
1449     void *memPtr)		/* Info about listbox widget. */
1450 {
1451     Listbox *listPtr = (Listbox *)memPtr;
1452     Tcl_HashEntry *entry;
1453     Tcl_HashSearch search;
1454 
1455     /*
1456      * If we have an internal list object, free it.
1457      */
1458 
1459     if (listPtr->listObj != NULL) {
1460 	Tcl_DecrRefCount(listPtr->listObj);
1461 	listPtr->listObj = NULL;
1462     }
1463 
1464     if (listPtr->listVarName != NULL) {
1465 	Tcl_UntraceVar2(listPtr->interp, listPtr->listVarName, NULL,
1466 		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1467 		ListboxListVarProc, listPtr);
1468     }
1469 
1470     /*
1471      * Free the selection hash table.
1472      */
1473 
1474     Tcl_DeleteHashTable(listPtr->selection);
1475     ckfree(listPtr->selection);
1476 
1477     /*
1478      * Free the item attribute hash table.
1479      */
1480 
1481     for (entry = Tcl_FirstHashEntry(listPtr->itemAttrTable, &search);
1482 	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
1483 	ckfree(Tcl_GetHashValue(entry));
1484     }
1485     Tcl_DeleteHashTable(listPtr->itemAttrTable);
1486     ckfree(listPtr->itemAttrTable);
1487 
1488     /*
1489      * Free up all the stuff that requires special handling, then let
1490      * Tk_FreeOptions handle all the standard option-related stuff.
1491      */
1492 
1493     if (listPtr->textGC != NULL) {
1494 	Tk_FreeGC(listPtr->display, listPtr->textGC);
1495     }
1496     if (listPtr->selTextGC != NULL) {
1497 	Tk_FreeGC(listPtr->display, listPtr->selTextGC);
1498     }
1499     if (listPtr->gray != None) {
1500 	Tk_FreeBitmap(Tk_Display(listPtr->tkwin), listPtr->gray);
1501     }
1502 
1503     Tk_FreeConfigOptions((char *) listPtr, listPtr->optionTable,
1504 	    listPtr->tkwin);
1505     Tcl_Release(listPtr->tkwin);
1506     listPtr->tkwin = NULL;
1507     ckfree(listPtr);
1508 }
1509 
1510 /*
1511  *----------------------------------------------------------------------
1512  *
1513  * DestroyListboxOptionTables --
1514  *
1515  *	This procedure is registered as an exit callback when the listbox
1516  *	command is first called. It cleans up the OptionTables structure
1517  *	allocated by that command.
1518  *
1519  * Results:
1520  *	None.
1521  *
1522  * Side effects:
1523  *	Frees memory.
1524  *
1525  *----------------------------------------------------------------------
1526  */
1527 
1528 static void
DestroyListboxOptionTables(ClientData clientData,Tcl_Interp * dummy)1529 DestroyListboxOptionTables(
1530     ClientData clientData,	/* Pointer to the OptionTables struct */
1531     Tcl_Interp *dummy)		/* Pointer to the calling interp */
1532 {
1533     (void)dummy;
1534 
1535     ckfree(clientData);
1536     return;
1537 }
1538 
1539 /*
1540  *----------------------------------------------------------------------
1541  *
1542  * ConfigureListbox --
1543  *
1544  *	This procedure is called to process an objv/objc list, plus the Tk
1545  *	option database, in order to configure (or reconfigure) a listbox
1546  *	widget.
1547  *
1548  * Results:
1549  *	The return value is a standard Tcl result. If TCL_ERROR is returned,
1550  *	then the interp's result contains an error message.
1551  *
1552  * Side effects:
1553  *	Configuration information, such as colors, border width, etc. get set
1554  *	for listPtr; old resources get freed, if there were any.
1555  *
1556  *----------------------------------------------------------------------
1557  */
1558 
1559 static int
ConfigureListbox(Tcl_Interp * interp,Listbox * listPtr,int objc,Tcl_Obj * const objv[])1560 ConfigureListbox(
1561     Tcl_Interp *interp,		/* Used for error reporting. */
1562     Listbox *listPtr,	/* Information about widget; may or may not
1563 				 * already have values for some fields. */
1564     int objc,			/* Number of valid entries in argv. */
1565     Tcl_Obj *const objv[])	/* Arguments. */
1566 {
1567     Tk_SavedOptions savedOptions;
1568     Tcl_Obj *oldListObj = NULL;
1569     Tcl_Obj *errorResult = NULL;
1570     int oldExport, error;
1571 
1572     oldExport = (listPtr->exportSelection) && (!Tcl_IsSafe(listPtr->interp));
1573     if (listPtr->listVarName != NULL) {
1574 	Tcl_UntraceVar2(interp, listPtr->listVarName, NULL,
1575 		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1576 		ListboxListVarProc, listPtr);
1577     }
1578 
1579     for (error = 0; error <= 1; error++) {
1580 	if (!error) {
1581 	    /*
1582 	     * First pass: set options to new values.
1583 	     */
1584 
1585 	    if (Tk_SetOptions(interp, listPtr,
1586 		    listPtr->optionTable, objc, objv,
1587 		    listPtr->tkwin, &savedOptions, NULL) != TCL_OK) {
1588 		continue;
1589 	    }
1590 	} else {
1591 	    /*
1592 	     * Second pass: restore options to old values.
1593 	     */
1594 
1595 	    errorResult = Tcl_GetObjResult(interp);
1596 	    Tcl_IncrRefCount(errorResult);
1597 	    Tk_RestoreSavedOptions(&savedOptions);
1598 	}
1599 
1600 	/*
1601 	 * A few options need special processing, such as setting the
1602 	 * background from a 3-D border.
1603 	 */
1604 
1605 	Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder);
1606 
1607 	if (listPtr->highlightWidth < 0) {
1608 	    listPtr->highlightWidth = 0;
1609 	}
1610 	listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth;
1611 
1612 	/*
1613 	 * Claim the selection if we've suddenly started exporting it and
1614 	 * there is a selection to export and this interp is unsafe.
1615 	 */
1616 
1617 	if (listPtr->exportSelection && (!oldExport)
1618 		&& (!Tcl_IsSafe(listPtr->interp))
1619 		&& (listPtr->numSelected != 0)) {
1620 	    Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY,
1621 		    ListboxLostSelection, listPtr);
1622 	}
1623 
1624 	/*
1625 	 * Verify the current status of the list var.
1626 	 * PREVIOUS STATE | NEW STATE  | ACTION
1627 	 * ---------------+------------+----------------------------------
1628 	 * no listvar     | listvar    | If listvar does not exist, create it
1629 	 *				 and copy the internal list obj's
1630 	 *				 content to the new var. If it does
1631 	 *				 exist, toss the internal list obj.
1632 	 *
1633 	 * listvar	  | no listvar | Copy old listvar content to the
1634 	 *				 internal list obj
1635 	 *
1636 	 * listvar	  | listvar    | no special action
1637 	 *
1638 	 * no listvar     | no listvar | no special action
1639 	 */
1640 
1641 	oldListObj = listPtr->listObj;
1642 	if (listPtr->listVarName != NULL) {
1643 	    Tcl_Obj *listVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
1644 		    NULL, TCL_GLOBAL_ONLY);
1645 	    int dummy;
1646 
1647 	    if (listVarObj == NULL) {
1648 		listVarObj = (oldListObj ? oldListObj : Tcl_NewObj());
1649 		if (Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL,
1650 			listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
1651 			== NULL) {
1652 		    continue;
1653 		}
1654 	    }
1655 
1656 	    /*
1657 	     * Make sure the object is a good list object.
1658 	     */
1659 
1660 	    if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy)
1661 		    != TCL_OK) {
1662 		Tcl_AppendResult(listPtr->interp,
1663 			": invalid -listvariable value", NULL);
1664 		continue;
1665 	    }
1666 
1667 	    listPtr->listObj = listVarObj;
1668 	    Tcl_TraceVar2(listPtr->interp, listPtr->listVarName,
1669 		    NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1670 		    ListboxListVarProc, listPtr);
1671 	} else if (listPtr->listObj == NULL) {
1672 	    listPtr->listObj = Tcl_NewObj();
1673 	}
1674 	Tcl_IncrRefCount(listPtr->listObj);
1675 	if (oldListObj != NULL) {
1676 	    Tcl_DecrRefCount(oldListObj);
1677 	}
1678 	break;
1679     }
1680     if (!error) {
1681 	Tk_FreeSavedOptions(&savedOptions);
1682     }
1683 
1684     /*
1685      * Make sure that the list length is correct.
1686      */
1687 
1688     Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
1689 
1690     if (error) {
1691 	Tcl_SetObjResult(interp, errorResult);
1692 	Tcl_DecrRefCount(errorResult);
1693 	return TCL_ERROR;
1694     }
1695     ListboxWorldChanged(listPtr);
1696     return TCL_OK;
1697 }
1698 
1699 /*
1700  *----------------------------------------------------------------------
1701  *
1702  * ConfigureListboxItem --
1703  *
1704  *	This procedure is called to process an objv/objc list, plus the Tk
1705  *	option database, in order to configure (or reconfigure) a listbox
1706  *	item.
1707  *
1708  * Results:
1709  *	The return value is a standard Tcl result. If TCL_ERROR is returned,
1710  *	then the interp's result contains an error message.
1711  *
1712  * Side effects:
1713  *	Configuration information, such as colors, border width, etc. get set
1714  *	for a listbox item; old resources get freed, if there were any.
1715  *
1716  *----------------------------------------------------------------------
1717  */
1718 
1719 static int
ConfigureListboxItem(Tcl_Interp * interp,Listbox * listPtr,ItemAttr * attrs,int objc,Tcl_Obj * const objv[],int index)1720 ConfigureListboxItem(
1721     Tcl_Interp *interp,		/* Used for error reporting. */
1722     Listbox *listPtr,	/* Information about widget; may or may not
1723 				 * already have values for some fields. */
1724     ItemAttr *attrs,		/* Information about the item to configure */
1725     int objc,			/* Number of valid entries in argv. */
1726     Tcl_Obj *const objv[],	/* Arguments. */
1727     int index)			/* Index of the listbox item being configure */
1728 {
1729     Tk_SavedOptions savedOptions;
1730 
1731     if (Tk_SetOptions(interp, attrs,
1732 	    listPtr->itemAttrOptionTable, objc, objv, listPtr->tkwin,
1733 	    &savedOptions, NULL) != TCL_OK) {
1734 	Tk_RestoreSavedOptions(&savedOptions);
1735 	return TCL_ERROR;
1736     }
1737     Tk_FreeSavedOptions(&savedOptions);
1738 
1739     /*
1740      * Redraw this index - ListboxWorldChanged would need to be called if item
1741      * attributes were checked in the "world".
1742      */
1743 
1744     EventuallyRedrawRange(listPtr, index, index);
1745     return TCL_OK;
1746 }
1747 
1748 /*
1749  *---------------------------------------------------------------------------
1750  *
1751  * ListboxWorldChanged --
1752  *
1753  *	This procedure is called when the world has changed in some way and
1754  *	the widget needs to recompute all its graphics contexts and determine
1755  *	its new geometry.
1756  *
1757  * Results:
1758  *	None.
1759  *
1760  * Side effects:
1761  *	Listbox will be relayed out and redisplayed.
1762  *
1763  *---------------------------------------------------------------------------
1764  */
1765 
1766 static void
ListboxWorldChanged(ClientData instanceData)1767 ListboxWorldChanged(
1768     ClientData instanceData)	/* Information about widget. */
1769 {
1770     XGCValues gcValues;
1771     GC gc;
1772     unsigned long mask;
1773     Listbox *listPtr = (Listbox *)instanceData;
1774 
1775     if (listPtr->state & STATE_NORMAL) {
1776 	gcValues.foreground = listPtr->fgColorPtr->pixel;
1777 	gcValues.graphics_exposures = False;
1778 	mask = GCForeground | GCFont | GCGraphicsExposures;
1779     } else if (listPtr->dfgColorPtr != NULL) {
1780 	gcValues.foreground = listPtr->dfgColorPtr->pixel;
1781 	gcValues.graphics_exposures = False;
1782 	mask = GCForeground | GCFont | GCGraphicsExposures;
1783     } else {
1784 	gcValues.foreground = listPtr->fgColorPtr->pixel;
1785 	mask = GCForeground | GCFont;
1786 	if (listPtr->gray == None) {
1787 	    listPtr->gray = Tk_GetBitmap(NULL, listPtr->tkwin, "gray50");
1788 	}
1789 	if (listPtr->gray != None) {
1790 	    gcValues.fill_style = FillStippled;
1791 	    gcValues.stipple = listPtr->gray;
1792 	    mask |= GCFillStyle | GCStipple;
1793 	}
1794     }
1795 
1796     gcValues.font = Tk_FontId(listPtr->tkfont);
1797     gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
1798     if (listPtr->textGC != NULL) {
1799 	Tk_FreeGC(listPtr->display, listPtr->textGC);
1800     }
1801     listPtr->textGC = gc;
1802 
1803     if (listPtr->selFgColorPtr != NULL) {
1804 	gcValues.foreground = listPtr->selFgColorPtr->pixel;
1805     }
1806     gcValues.font = Tk_FontId(listPtr->tkfont);
1807     mask = GCForeground | GCFont;
1808     gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
1809     if (listPtr->selTextGC != NULL) {
1810 	Tk_FreeGC(listPtr->display, listPtr->selTextGC);
1811     }
1812     listPtr->selTextGC = gc;
1813 
1814     /*
1815      * Register the desired geometry for the window and arrange for the window
1816      * to be redisplayed.
1817      */
1818 
1819     ListboxComputeGeometry(listPtr, 1, 1, 1);
1820     listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
1821     EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
1822 }
1823 
1824 /*
1825  *--------------------------------------------------------------
1826  *
1827  * DisplayListbox --
1828  *
1829  *	This procedure redraws the contents of a listbox window.
1830  *
1831  * Results:
1832  *	None.
1833  *
1834  * Side effects:
1835  *	Information appears on the screen.
1836  *
1837  *--------------------------------------------------------------
1838  */
1839 
1840 static void
DisplayListbox(ClientData clientData)1841 DisplayListbox(
1842     ClientData clientData)	/* Information about window. */
1843 {
1844     Listbox *listPtr = (Listbox *)clientData;
1845     Tk_Window tkwin = listPtr->tkwin;
1846     GC gc;
1847     int i, limit, x, y, prevSelected, freeGC;
1848     TkSizeT stringLen;
1849     Tk_FontMetrics fm;
1850     Tcl_Obj *curElement;
1851     Tcl_HashEntry *entry;
1852     const char *stringRep;
1853     ItemAttr *attrs;
1854     Tk_3DBorder selectedBg;
1855     XGCValues gcValues;
1856     unsigned long mask;
1857     int left, right;		/* Non-zero values here indicate that the left
1858 				 * or right edge of the listbox is
1859 				 * off-screen. */
1860     Pixmap pixmap;
1861     int textWidth;
1862 
1863     listPtr->flags &= ~REDRAW_PENDING;
1864     if (listPtr->flags & LISTBOX_DELETED) {
1865 	return;
1866     }
1867 
1868     if (listPtr->flags & MAXWIDTH_IS_STALE) {
1869 	ListboxComputeGeometry(listPtr, 0, 1, 0);
1870 	listPtr->flags &= ~MAXWIDTH_IS_STALE;
1871 	listPtr->flags |= UPDATE_H_SCROLLBAR;
1872     }
1873 
1874     Tcl_Preserve(listPtr);
1875     if (listPtr->flags & UPDATE_V_SCROLLBAR) {
1876 	ListboxUpdateVScrollbar(listPtr);
1877 	if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) {
1878 	    Tcl_Release(listPtr);
1879 	    return;
1880 	}
1881     }
1882     if (listPtr->flags & UPDATE_H_SCROLLBAR) {
1883 	ListboxUpdateHScrollbar(listPtr);
1884 	if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) {
1885 	    Tcl_Release(listPtr);
1886 	    return;
1887 	}
1888     }
1889     listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR);
1890     Tcl_Release(listPtr);
1891 
1892 #ifndef TK_NO_DOUBLE_BUFFERING
1893     /*
1894      * Redrawing is done in a temporary pixmap that is allocated here and
1895      * freed at the end of the procedure. All drawing is done to the pixmap,
1896      * and the pixmap is copied to the screen at the end of the procedure.
1897      * This provides the smoothest possible visual effects (no flashing on the
1898      * screen).
1899      */
1900 
1901     pixmap = Tk_GetPixmap(listPtr->display, Tk_WindowId(tkwin),
1902 	    Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
1903 #else
1904     pixmap = Tk_WindowId(tkwin);
1905 #endif /* TK_NO_DOUBLE_BUFFERING */
1906     Tk_Fill3DRectangle(tkwin, pixmap, listPtr->normalBorder, 0, 0,
1907 	    Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
1908 
1909     /*
1910      * Display each item in the listbox.
1911      */
1912 
1913     limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1;
1914     if (limit >= listPtr->nElements) {
1915 	limit = listPtr->nElements-1;
1916     }
1917     left = right = 0;
1918     if (listPtr->xOffset > 0) {
1919 	left = listPtr->selBorderWidth+1;
1920     }
1921     if ((listPtr->maxWidth - listPtr->xOffset) > (Tk_Width(listPtr->tkwin)
1922 	    - 2*(listPtr->inset + listPtr->selBorderWidth))) {
1923 	right = listPtr->selBorderWidth+1;
1924     }
1925     prevSelected = 0;
1926 
1927     for (i = listPtr->topIndex; i <= limit; i++) {
1928 	int width = Tk_Width(tkwin);	/* zeroth approx to silence warning */
1929 
1930 	x = listPtr->inset;
1931 	y = ((i - listPtr->topIndex) * listPtr->lineHeight) + listPtr->inset;
1932 	gc = listPtr->textGC;
1933 	freeGC = 0;
1934 
1935 	/*
1936 	 * Lookup this item in the item attributes table, to see if it has
1937 	 * special foreground/background colors.
1938 	 */
1939 
1940 	entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i));
1941 
1942 	/*
1943 	 * If the listbox is enabled, items may be drawn differently; they may
1944 	 * be drawn selected, or they may have special foreground or
1945 	 * background colors.
1946 	 */
1947 
1948 	if (listPtr->state & STATE_NORMAL) {
1949 	    if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) {
1950 		/*
1951 		 * Selected items are drawn differently.
1952 		 */
1953 
1954 		gc = listPtr->selTextGC;
1955 		width = Tk_Width(tkwin) - 2*listPtr->inset;
1956 		selectedBg = listPtr->selBorder;
1957 
1958 		/*
1959 		 * If there is attribute information for this item, adjust the
1960 		 * drawing accordingly.
1961 		 */
1962 
1963 		if (entry != NULL) {
1964 		    attrs = (ItemAttr *)Tcl_GetHashValue(entry);
1965 
1966 		    /*
1967 		     * Default GC has the values from the widget at large.
1968 		     */
1969 
1970 		    if (listPtr->selFgColorPtr) {
1971 			gcValues.foreground = listPtr->selFgColorPtr->pixel;
1972 		    } else {
1973 			gcValues.foreground = listPtr->fgColorPtr->pixel;
1974 		    }
1975 		    gcValues.font = Tk_FontId(listPtr->tkfont);
1976 		    gcValues.graphics_exposures = False;
1977 		    mask = GCForeground | GCFont | GCGraphicsExposures;
1978 
1979 		    if (attrs->selBorder != NULL) {
1980 			selectedBg = attrs->selBorder;
1981 		    }
1982 
1983 		    if (attrs->selFgColor != NULL) {
1984 			gcValues.foreground = attrs->selFgColor->pixel;
1985 			gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
1986 			freeGC = 1;
1987 		    }
1988 		}
1989 
1990 		Tk_Fill3DRectangle(tkwin, pixmap, selectedBg, x, y,
1991 			width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
1992 
1993 		/*
1994 		 * Draw beveled edges around the selection, if there are
1995 		 * visible edges next to this element. Special considerations:
1996 		 *
1997 		 * 1. The left and right bevels may not be visible if
1998 		 *	horizontal scrolling is enabled (the "left" & "right"
1999 		 *	variables are zero to indicate that the corresponding
2000 		 *	bevel is visible).
2001 		 * 2. Top and bottom bevels are only drawn if this is the
2002 		 *	first or last seleted item.
2003 		 * 3. If the left or right bevel isn't visible, then the
2004 		 *	"left" & "right" vars, computed above, have non-zero
2005 		 *	values that extend the top and bottom bevels so that
2006 		 *	the mitered corners are off-screen.
2007 		 */
2008 
2009 		/* Draw left bevel */
2010 		if (left == 0) {
2011 		    Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
2012 			    x, y, listPtr->selBorderWidth, listPtr->lineHeight,
2013 			    1, TK_RELIEF_RAISED);
2014 		}
2015 		/* Draw right bevel */
2016 		if (right == 0) {
2017 		    Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
2018 			    x + width - listPtr->selBorderWidth, y,
2019 			    listPtr->selBorderWidth, listPtr->lineHeight,
2020 			    0, TK_RELIEF_RAISED);
2021 		}
2022 		/* Draw top bevel */
2023 		if (!prevSelected) {
2024 		    Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg,
2025 			    x-left, y, width+left+right,
2026 			    listPtr->selBorderWidth,
2027 			    1, 1, 1, TK_RELIEF_RAISED);
2028 		}
2029 		/* Draw bottom bevel */
2030 		if (i + 1 == listPtr->nElements ||
2031 			!Tcl_FindHashEntry(listPtr->selection, KEY(i + 1))) {
2032 		    Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left,
2033 			    y + listPtr->lineHeight - listPtr->selBorderWidth,
2034 			    width+left+right, listPtr->selBorderWidth, 0, 0, 0,
2035 			    TK_RELIEF_RAISED);
2036 		}
2037 		prevSelected = 1;
2038 	    } else {
2039 		/*
2040 		 * If there is an item attributes record for this item, draw
2041 		 * the background box and set the foreground color accordingly.
2042 		 */
2043 
2044 		if (entry != NULL) {
2045 		    attrs = (ItemAttr *)Tcl_GetHashValue(entry);
2046 		    gcValues.foreground = listPtr->fgColorPtr->pixel;
2047 		    gcValues.font = Tk_FontId(listPtr->tkfont);
2048 		    gcValues.graphics_exposures = False;
2049 		    mask = GCForeground | GCFont | GCGraphicsExposures;
2050 
2051 		    /*
2052 		     * If the item has its own background color, draw it now.
2053 		     */
2054 
2055 		    if (attrs->border != NULL) {
2056 			width = Tk_Width(tkwin) - 2*listPtr->inset;
2057 			Tk_Fill3DRectangle(tkwin, pixmap, attrs->border, x, y,
2058 				width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
2059 		    }
2060 
2061 		    /*
2062 		     * If the item has its own foreground, use it to override
2063 		     * the value in the gcValues structure.
2064 		     */
2065 
2066 		    if ((listPtr->state & STATE_NORMAL)
2067 			    && attrs->fgColor != NULL) {
2068 			gcValues.foreground = attrs->fgColor->pixel;
2069 			gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
2070 			freeGC = 1;
2071 		    }
2072 		}
2073 		prevSelected = 0;
2074 	    }
2075 	}
2076 
2077 	/*
2078 	 * Draw the actual text of this item.
2079 	 */
2080 
2081         Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement);
2082         stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
2083         textWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen);
2084 
2085 	Tk_GetFontMetrics(listPtr->tkfont, &fm);
2086 	y += fm.ascent + listPtr->selBorderWidth;
2087 
2088         if (listPtr->justify == TK_JUSTIFY_LEFT) {
2089             x = (listPtr->inset + listPtr->selBorderWidth) - listPtr->xOffset;
2090         } else if (listPtr->justify == TK_JUSTIFY_RIGHT) {
2091             x = Tk_Width(tkwin) - (listPtr->inset + listPtr->selBorderWidth)
2092                     - textWidth - listPtr->xOffset + GetMaxOffset(listPtr);
2093         } else {
2094             x = (Tk_Width(tkwin) - textWidth)/2
2095                     - listPtr->xOffset + GetMaxOffset(listPtr)/2;
2096         }
2097 
2098         Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont,
2099 		stringRep, stringLen, x, y);
2100 
2101 	/*
2102 	 * If this is the active element, apply the activestyle to it.
2103 	 */
2104 
2105 	if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
2106 	    if (listPtr->activeStyle == ACTIVE_STYLE_UNDERLINE) {
2107 		/*
2108 		 * Underline the text.
2109 		 */
2110 
2111 		Tk_UnderlineChars(listPtr->display, pixmap, gc,
2112 			listPtr->tkfont, stringRep, x, y, 0, stringLen);
2113 	    } else if (listPtr->activeStyle == ACTIVE_STYLE_DOTBOX) {
2114 #ifdef _WIN32
2115 		/*
2116 		 * This provides for exact default look and feel on Windows.
2117 		 */
2118 
2119 		TkWinDCState state;
2120 		HDC dc;
2121 		RECT rect;
2122 
2123 		dc = TkWinGetDrawableDC(listPtr->display, pixmap, &state);
2124 		rect.left = listPtr->inset;
2125 		rect.top = ((i - listPtr->topIndex) * listPtr->lineHeight)
2126 			+ listPtr->inset;
2127 		rect.right = rect.left + width;
2128 		rect.bottom = rect.top + listPtr->lineHeight;
2129 		DrawFocusRect(dc, &rect);
2130 		TkWinReleaseDrawableDC(pixmap, dc, &state);
2131 #else /* !_WIN32 */
2132 		/*
2133 		 * Draw a dotted box around the text.
2134 		 */
2135 
2136 		x = listPtr->inset;
2137 		y = ((i - listPtr->topIndex) * listPtr->lineHeight)
2138 			+ listPtr->inset;
2139 		width = Tk_Width(tkwin) - 2*listPtr->inset - 1;
2140 
2141 		gcValues.line_style = LineOnOffDash;
2142 		gcValues.line_width = listPtr->selBorderWidth;
2143 		if (gcValues.line_width <= 0) {
2144 		    gcValues.line_width  = 1;
2145 		}
2146 		gcValues.dash_offset = 0;
2147 		gcValues.dashes = 1;
2148 
2149 		/*
2150 		 * You would think the XSetDashes was necessary, but it
2151 		 * appears that the default dotting for just saying we want
2152 		 * dashes appears to work correctly.
2153 		 static char dashList[] = { 1 };
2154 		 static int dashLen = sizeof(dashList);
2155 		 XSetDashes(listPtr->display, gc, 0, dashList, dashLen);
2156 		 */
2157 
2158 		mask = GCLineWidth | GCLineStyle | GCDashList | GCDashOffset;
2159 		XChangeGC(listPtr->display, gc, mask, &gcValues);
2160 		XDrawRectangle(listPtr->display, pixmap, gc, x, y,
2161 			(unsigned) width, (unsigned) listPtr->lineHeight - 1);
2162 		if (!freeGC) {
2163 		    /*
2164 		     * Don't bother changing if it is about to be freed.
2165 		     */
2166 
2167 		    gcValues.line_style = LineSolid;
2168 		    XChangeGC(listPtr->display, gc, GCLineStyle, &gcValues);
2169 		}
2170 #endif /* _WIN32 */
2171 	    }
2172 	}
2173 
2174 	if (freeGC) {
2175 	    Tk_FreeGC(listPtr->display, gc);
2176 	}
2177     }
2178 
2179     /*
2180      * Redraw the border for the listbox to make sure that it's on top of any
2181      * of the text of the listbox entries.
2182      */
2183 
2184     Tk_Draw3DRectangle(tkwin, pixmap, listPtr->normalBorder,
2185 	    listPtr->highlightWidth, listPtr->highlightWidth,
2186 	    Tk_Width(tkwin) - 2*listPtr->highlightWidth,
2187 	    Tk_Height(tkwin) - 2*listPtr->highlightWidth,
2188 	    listPtr->borderWidth, listPtr->relief);
2189     if (listPtr->highlightWidth > 0) {
2190 	GC fgGC, bgGC;
2191 
2192 	bgGC = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap);
2193 	if (listPtr->flags & GOT_FOCUS) {
2194 	    fgGC = Tk_GCForColor(listPtr->highlightColorPtr, pixmap);
2195 	    TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
2196 		    listPtr->highlightWidth, pixmap);
2197 	} else {
2198 	    TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
2199 		    listPtr->highlightWidth, pixmap);
2200 	}
2201     }
2202 #ifndef TK_NO_DOUBLE_BUFFERING
2203     XCopyArea(listPtr->display, pixmap, Tk_WindowId(tkwin),
2204 	    listPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin),
2205 	    (unsigned) Tk_Height(tkwin), 0, 0);
2206     Tk_FreePixmap(listPtr->display, pixmap);
2207 #endif /* TK_NO_DOUBLE_BUFFERING */
2208 }
2209 
2210 /*
2211  *----------------------------------------------------------------------
2212  *
2213  * ListboxComputeGeometry --
2214  *
2215  *	This procedure is invoked to recompute geometry information such as
2216  *	the sizes of the elements and the overall dimensions desired for the
2217  *	listbox.
2218  *
2219  * Results:
2220  *	None.
2221  *
2222  * Side effects:
2223  *	Geometry information is updated and a new requested size is registered
2224  *	for the widget. Internal border and gridding information is also set.
2225  *
2226  *----------------------------------------------------------------------
2227  */
2228 
2229 static void
ListboxComputeGeometry(Listbox * listPtr,int fontChanged,int maxIsStale,int updateGrid)2230 ListboxComputeGeometry(
2231     Listbox *listPtr,		/* Listbox whose geometry is to be
2232 				 * recomputed. */
2233     int fontChanged,		/* Non-zero means the font may have changed so
2234 				 * per-element width information also has to
2235 				 * be computed. */
2236     int maxIsStale,		/* Non-zero means the "maxWidth" field may no
2237 				 * longer be up-to-date and must be
2238 				 * recomputed. If fontChanged is 1 then this
2239 				 * must be 1. */
2240     int updateGrid)		/* Non-zero means call Tk_SetGrid or
2241 				 * Tk_UnsetGrid to update gridding for the
2242 				 * window. */
2243 {
2244     int width, height, pixelWidth, pixelHeight, i, result;
2245     TkSizeT textLength;
2246     Tk_FontMetrics fm;
2247     Tcl_Obj *element;
2248     const char *text;
2249 
2250     if (fontChanged || maxIsStale) {
2251 	listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1);
2252 	if (listPtr->xScrollUnit == 0) {
2253 	    listPtr->xScrollUnit = 1;
2254 	}
2255 	listPtr->maxWidth = 0;
2256 	for (i = 0; i < listPtr->nElements; i++) {
2257 	    /*
2258 	     * Compute the pixel width of the current element.
2259 	     */
2260 
2261 	    result = Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
2262 		    &element);
2263 	    if (result != TCL_OK) {
2264 		continue;
2265 	    }
2266 	    text = Tcl_GetStringFromObj(element, &textLength);
2267 	    Tk_GetFontMetrics(listPtr->tkfont, &fm);
2268 	    pixelWidth = Tk_TextWidth(listPtr->tkfont, text, textLength);
2269 	    if (pixelWidth > listPtr->maxWidth) {
2270 		listPtr->maxWidth = pixelWidth;
2271 	    }
2272 	}
2273     }
2274 
2275     Tk_GetFontMetrics(listPtr->tkfont, &fm);
2276     listPtr->lineHeight = fm.linespace + 1 + 2*listPtr->selBorderWidth;
2277     width = listPtr->width;
2278     if (width <= 0) {
2279 	width = (listPtr->maxWidth + listPtr->xScrollUnit - 1)
2280 		/ listPtr->xScrollUnit;
2281 	if (width < 1) {
2282 	    width = 1;
2283 	}
2284     }
2285     pixelWidth = width*listPtr->xScrollUnit + 2*listPtr->inset
2286 	    + 2*listPtr->selBorderWidth;
2287     height = listPtr->height;
2288     if (listPtr->height <= 0) {
2289 	height = listPtr->nElements;
2290 	if (height < 1) {
2291 	    height = 1;
2292 	}
2293     }
2294     pixelHeight = height*listPtr->lineHeight + 2*listPtr->inset;
2295     Tk_GeometryRequest(listPtr->tkwin, pixelWidth, pixelHeight);
2296     Tk_SetInternalBorder(listPtr->tkwin, listPtr->inset);
2297     if (updateGrid) {
2298 	if (listPtr->setGrid) {
2299 	    Tk_SetGrid(listPtr->tkwin, width, height, listPtr->xScrollUnit,
2300 		    listPtr->lineHeight);
2301 	} else {
2302 	    Tk_UnsetGrid(listPtr->tkwin);
2303 	}
2304     }
2305 }
2306 
2307 /*
2308  *----------------------------------------------------------------------
2309  *
2310  * ListboxInsertSubCmd --
2311  *
2312  *	This procedure is invoked to handle the listbox "insert" subcommand.
2313  *
2314  * Results:
2315  *	Standard Tcl result.
2316  *
2317  * Side effects:
2318  *	New elements are added to the listbox pointed to by listPtr; a refresh
2319  *	callback is registered for the listbox.
2320  *
2321  *----------------------------------------------------------------------
2322  */
2323 
2324 static int
ListboxInsertSubCmd(Listbox * listPtr,int index,int objc,Tcl_Obj * const objv[])2325 ListboxInsertSubCmd(
2326     Listbox *listPtr,	/* Listbox that is to get the new elements. */
2327     int index,			/* Add the new elements before this
2328 				 * element. */
2329     int objc,			/* Number of new elements to add. */
2330     Tcl_Obj *const objv[])	/* New elements (one per entry). */
2331 {
2332     int i, oldMaxWidth, pixelWidth, result;
2333     TkSizeT length;
2334     Tcl_Obj *newListObj;
2335     const char *stringRep;
2336 
2337     oldMaxWidth = listPtr->maxWidth;
2338     for (i = 0; i < objc; i++) {
2339 	/*
2340 	 * Check if any of the new elements are wider than the current widest;
2341 	 * if so, update our notion of "widest."
2342 	 */
2343 
2344 	stringRep = Tcl_GetStringFromObj(objv[i], &length);
2345 	pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
2346 	if (pixelWidth > listPtr->maxWidth) {
2347 	    listPtr->maxWidth = pixelWidth;
2348 	}
2349     }
2350 
2351     /*
2352      * Adjust selection and attribute information for every index after the
2353      * first index.
2354      */
2355 
2356     MigrateHashEntries(listPtr->selection, index, listPtr->nElements-1, objc);
2357     MigrateHashEntries(listPtr->itemAttrTable, index, listPtr->nElements-1,
2358 	    objc);
2359 
2360     /*
2361      * If the object is shared, duplicate it before writing to it.
2362      */
2363 
2364     if (Tcl_IsShared(listPtr->listObj)) {
2365 	newListObj = Tcl_DuplicateObj(listPtr->listObj);
2366     } else {
2367 	newListObj = listPtr->listObj;
2368     }
2369     result = Tcl_ListObjReplace(listPtr->interp, newListObj, index, 0,
2370 	    objc, objv);
2371     if (result != TCL_OK) {
2372 	return result;
2373     }
2374 
2375     /*
2376      * Replace the current object and set attached listvar, if any. This may
2377      * error if listvar points to a var in a deleted namespace, but we ignore
2378      * those errors. If the namespace is recreated, it will auto-sync with the
2379      * current value. [Bug 1424513]
2380      */
2381 
2382     Tcl_IncrRefCount(newListObj);
2383     Tcl_DecrRefCount(listPtr->listObj);
2384     listPtr->listObj = newListObj;
2385     if (listPtr->listVarName != NULL) {
2386 	Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName, NULL,
2387 		listPtr->listObj, TCL_GLOBAL_ONLY);
2388     }
2389 
2390     /*
2391      * Get the new list length.
2392      */
2393 
2394     Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
2395 
2396     /*
2397      * Update the "special" indices (anchor, topIndex, active) to account for
2398      * the renumbering that just occurred. Then arrange for the new
2399      * information to be displayed.
2400      */
2401 
2402     if (index <= listPtr->selectAnchor) {
2403 	listPtr->selectAnchor += objc;
2404     }
2405     if (index < listPtr->topIndex) {
2406 	listPtr->topIndex += objc;
2407     }
2408     if (index <= listPtr->active) {
2409 	listPtr->active += objc;
2410 	if ((listPtr->active >= listPtr->nElements) &&
2411 		(listPtr->nElements > 0)) {
2412 	    listPtr->active = listPtr->nElements-1;
2413 	}
2414     }
2415     listPtr->flags |= UPDATE_V_SCROLLBAR;
2416     if (listPtr->maxWidth != oldMaxWidth) {
2417 	listPtr->flags |= UPDATE_H_SCROLLBAR;
2418     }
2419     ListboxComputeGeometry(listPtr, 0, 0, 0);
2420     EventuallyRedrawRange(listPtr, index, listPtr->nElements-1);
2421     return TCL_OK;
2422 }
2423 
2424 /*
2425  *----------------------------------------------------------------------
2426  *
2427  * ListboxDeleteSubCmd --
2428  *
2429  *	Process a listbox "delete" subcommand by removing one or more elements
2430  *	from a listbox widget.
2431  *
2432  * Results:
2433  *	Standard Tcl result.
2434  *
2435  * Side effects:
2436  *	The listbox will be modified and (eventually) redisplayed.
2437  *
2438  *----------------------------------------------------------------------
2439  */
2440 
2441 static int
ListboxDeleteSubCmd(Listbox * listPtr,int first,int last)2442 ListboxDeleteSubCmd(
2443     Listbox *listPtr,	/* Listbox widget to modify. */
2444     int first,			/* Index of first element to delete. */
2445     int last)			/* Index of last element to delete. */
2446 {
2447     int count, i, widthChanged, result, pixelWidth;
2448     TkSizeT length;
2449     Tcl_Obj *newListObj, *element;
2450     const char *stringRep;
2451     Tcl_HashEntry *entry;
2452 
2453     /*
2454      * Adjust the range to fit within the existing elements of the listbox,
2455      * and make sure there's something to delete.
2456      */
2457 
2458     if (first < 0) {
2459 	first = 0;
2460     }
2461     if (last >= listPtr->nElements) {
2462 	last = listPtr->nElements-1;
2463     }
2464     count = last + 1 - first;
2465     if (count <= 0) {
2466 	return TCL_OK;
2467     }
2468 
2469     /*
2470      * Foreach deleted index we must:
2471      * a) remove selection information,
2472      * b) check the width of the element; if it is equal to the max, set
2473      *    widthChanged to 1, because it may be the only element with that
2474      *    width.
2475      */
2476 
2477     widthChanged = 0;
2478     for (i = first; i <= last; i++) {
2479 	/*
2480 	 * Remove selection information.
2481 	 */
2482 
2483 	entry = Tcl_FindHashEntry(listPtr->selection, KEY(i));
2484 	if (entry != NULL) {
2485 	    listPtr->numSelected--;
2486 	    Tcl_DeleteHashEntry(entry);
2487 	}
2488 
2489 	entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i));
2490 	if (entry != NULL) {
2491 	    ckfree(Tcl_GetHashValue(entry));
2492 	    Tcl_DeleteHashEntry(entry);
2493 	}
2494 
2495 	/*
2496 	 * Check width of the element. We only have to check if widthChanged
2497 	 * has not already been set to 1, because we only need one maxWidth
2498 	 * element to disappear for us to have to recompute the width.
2499 	 */
2500 
2501 	if (widthChanged == 0) {
2502 	    Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &element);
2503 	    stringRep = Tcl_GetStringFromObj(element, &length);
2504 	    pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
2505 	    if (pixelWidth == listPtr->maxWidth) {
2506 		widthChanged = 1;
2507 	    }
2508 	}
2509     }
2510 
2511     /*
2512      * Adjust selection and attribute info for indices after lastIndex.
2513      */
2514 
2515     MigrateHashEntries(listPtr->selection, last+1,
2516 	    listPtr->nElements-1, count*-1);
2517     MigrateHashEntries(listPtr->itemAttrTable, last+1,
2518 	    listPtr->nElements-1, count*-1);
2519 
2520     /*
2521      * Delete the requested elements.
2522      */
2523 
2524     if (Tcl_IsShared(listPtr->listObj)) {
2525 	newListObj = Tcl_DuplicateObj(listPtr->listObj);
2526     } else {
2527 	newListObj = listPtr->listObj;
2528     }
2529     result = Tcl_ListObjReplace(listPtr->interp,
2530 	    newListObj, first, count, 0, NULL);
2531     if (result != TCL_OK) {
2532 	return result;
2533     }
2534 
2535     /*
2536      * Replace the current object and set attached listvar, if any. This may
2537      * error if listvar points to a var in a deleted namespace, but we ignore
2538      * those errors. If the namespace is recreated, it will auto-sync with the
2539      * current value. [Bug 1424513]
2540      */
2541 
2542     Tcl_IncrRefCount(newListObj);
2543     Tcl_DecrRefCount(listPtr->listObj);
2544     listPtr->listObj = newListObj;
2545     if (listPtr->listVarName != NULL) {
2546 	Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName, NULL,
2547 		listPtr->listObj, TCL_GLOBAL_ONLY);
2548     }
2549 
2550     /*
2551      * Get the new list length.
2552      */
2553 
2554     Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
2555 
2556     /*
2557      * Update the selection and viewing information to reflect the change in
2558      * the element numbering, and redisplay to slide information up over the
2559      * elements that were deleted.
2560      */
2561 
2562     if (first <= listPtr->selectAnchor) {
2563 	listPtr->selectAnchor -= count;
2564 	if (listPtr->selectAnchor < first) {
2565 	    listPtr->selectAnchor = first;
2566 	}
2567     }
2568     if (first <= listPtr->topIndex) {
2569 	listPtr->topIndex -= count;
2570 	if (listPtr->topIndex < first) {
2571 	    listPtr->topIndex = first;
2572 	}
2573     }
2574     if (listPtr->topIndex > (listPtr->nElements - listPtr->fullLines)) {
2575 	listPtr->topIndex = listPtr->nElements - listPtr->fullLines;
2576 	if (listPtr->topIndex < 0) {
2577 	    listPtr->topIndex = 0;
2578 	}
2579     }
2580     if (listPtr->active > last) {
2581 	listPtr->active -= count;
2582     } else if (listPtr->active >= first) {
2583 	listPtr->active = first;
2584 	if ((listPtr->active >= listPtr->nElements) &&
2585 		(listPtr->nElements > 0)) {
2586 	    listPtr->active = listPtr->nElements-1;
2587 	}
2588     }
2589     listPtr->flags |= UPDATE_V_SCROLLBAR;
2590     ListboxComputeGeometry(listPtr, 0, widthChanged, 0);
2591     if (widthChanged) {
2592 	listPtr->flags |= UPDATE_H_SCROLLBAR;
2593     }
2594     EventuallyRedrawRange(listPtr, first, listPtr->nElements-1);
2595     return TCL_OK;
2596 }
2597 
2598 /*
2599  *--------------------------------------------------------------
2600  *
2601  * ListboxEventProc --
2602  *
2603  *	This procedure is invoked by the Tk dispatcher for various events on
2604  *	listboxes.
2605  *
2606  * Results:
2607  *	None.
2608  *
2609  * Side effects:
2610  *	When the window gets deleted, internal structures get cleaned up. When
2611  *	it gets exposed, it is redisplayed.
2612  *
2613  *--------------------------------------------------------------
2614  */
2615 
2616 static void
ListboxEventProc(ClientData clientData,XEvent * eventPtr)2617 ListboxEventProc(
2618     ClientData clientData,	/* Information about window. */
2619     XEvent *eventPtr)		/* Information about event. */
2620 {
2621     Listbox *listPtr = (Listbox *)clientData;
2622 
2623     if (eventPtr->type == Expose) {
2624 	EventuallyRedrawRange(listPtr,
2625 		NearestListboxElement(listPtr, eventPtr->xexpose.y),
2626 		NearestListboxElement(listPtr, eventPtr->xexpose.y
2627 		+ eventPtr->xexpose.height));
2628     } else if (eventPtr->type == DestroyNotify) {
2629 	if (!(listPtr->flags & LISTBOX_DELETED)) {
2630 	    listPtr->flags |= LISTBOX_DELETED;
2631 	    Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
2632 	    if (listPtr->setGrid) {
2633 		Tk_UnsetGrid(listPtr->tkwin);
2634 	    }
2635 	    if (listPtr->flags & REDRAW_PENDING) {
2636 		Tcl_CancelIdleCall(DisplayListbox, clientData);
2637 	    }
2638 	    Tcl_EventuallyFree(clientData, (Tcl_FreeProc *) DestroyListbox);
2639 	}
2640     } else if (eventPtr->type == ConfigureNotify) {
2641 	int vertSpace;
2642 
2643 	vertSpace = Tk_Height(listPtr->tkwin) - 2*listPtr->inset;
2644 	listPtr->fullLines = vertSpace / listPtr->lineHeight;
2645 	if ((listPtr->fullLines*listPtr->lineHeight) < vertSpace) {
2646 	    listPtr->partialLine = 1;
2647 	} else {
2648 	    listPtr->partialLine = 0;
2649 	}
2650 	listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
2651 	ChangeListboxView(listPtr, listPtr->topIndex);
2652 	ChangeListboxOffset(listPtr, listPtr->xOffset);
2653 
2654 	/*
2655 	 * Redraw the whole listbox. It's hard to tell what needs to be
2656 	 * redrawn (e.g. if the listbox has shrunk then we may only need to
2657 	 * redraw the borders), so just redraw everything for safety.
2658 	 */
2659 
2660 	EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
2661     } else if (eventPtr->type == FocusIn) {
2662 	if (eventPtr->xfocus.detail != NotifyInferior) {
2663 	    listPtr->flags |= GOT_FOCUS;
2664 	    EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
2665 	}
2666     } else if (eventPtr->type == FocusOut) {
2667 	if (eventPtr->xfocus.detail != NotifyInferior) {
2668 	    listPtr->flags &= ~GOT_FOCUS;
2669 	    EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
2670 	}
2671     }
2672 }
2673 
2674 /*
2675  *----------------------------------------------------------------------
2676  *
2677  * ListboxCmdDeletedProc --
2678  *
2679  *	This procedure is invoked when a widget command is deleted. If the
2680  *	widget isn't already in the process of being destroyed, this command
2681  *	destroys it.
2682  *
2683  * Results:
2684  *	None.
2685  *
2686  * Side effects:
2687  *	The widget is destroyed.
2688  *
2689  *----------------------------------------------------------------------
2690  */
2691 
2692 static void
ListboxCmdDeletedProc(ClientData clientData)2693 ListboxCmdDeletedProc(
2694     ClientData clientData)	/* Pointer to widget record for widget. */
2695 {
2696     Listbox *listPtr = (Listbox *)clientData;
2697 
2698     /*
2699      * This procedure could be invoked either because the window was destroyed
2700      * and the command was then deleted (in which case tkwin is NULL) or
2701      * because the command was deleted, and then this procedure destroys the
2702      * widget.
2703      */
2704 
2705     if (!(listPtr->flags & LISTBOX_DELETED)) {
2706 	Tk_DestroyWindow(listPtr->tkwin);
2707     }
2708 }
2709 
2710 /*
2711  *--------------------------------------------------------------
2712  *
2713  * GetListboxIndex --
2714  *
2715  *	Parse an index into a listbox and return either its value or an error.
2716  *
2717  * Results:
2718  *	A standard Tcl result. If all went well, then *indexPtr is filled in
2719  *	with the index (into listPtr) corresponding to string. Otherwise an
2720  *	error message is left in the interp's result.
2721  *
2722  * Side effects:
2723  *	None.
2724  *
2725  *--------------------------------------------------------------
2726  */
2727 
2728 static int
GetListboxIndex(Tcl_Interp * interp,Listbox * listPtr,Tcl_Obj * indexObj,int lastOK,int * indexPtr)2729 GetListboxIndex(
2730     Tcl_Interp *interp,		/* For error messages. */
2731     Listbox *listPtr,		/* Listbox for which the index is being
2732 				 * specified. */
2733     Tcl_Obj *indexObj,		/* Specifies an element in the listbox. */
2734     int lastOK,		/* If 1, "end" refers to the number of entries
2735 				 * in the listbox. If 0, "end" refers to 1
2736 				 * less than the number of entries. */
2737     int *indexPtr)		/* Where to store converted index. */
2738 {
2739     int result, index;
2740     TkSizeT idx;
2741     const char *stringRep;
2742 
2743     result = TkGetIntForIndex(indexObj, listPtr->nElements - 1, lastOK, &idx);
2744     if (result == TCL_OK) {
2745     	if ((idx != TCL_INDEX_NONE) && (idx > (TkSizeT)listPtr->nElements)) {
2746     	    idx = listPtr->nElements;
2747     	}
2748     	*indexPtr = (int)idx;
2749     	return TCL_OK;
2750     }
2751 
2752     /*
2753      * First see if the index is one of the named indices.
2754      */
2755 
2756     result = Tcl_GetIndexFromObj(NULL, indexObj, indexNames, "", 0, &index);
2757     if (result == TCL_OK) {
2758 	switch (index) {
2759 	case INDEX_ACTIVE:
2760 	    /* "active" index */
2761 	    *indexPtr = listPtr->active;
2762 	    break;
2763 	case INDEX_ANCHOR:
2764 	    /* "anchor" index */
2765 	    *indexPtr = listPtr->selectAnchor;
2766 	    break;
2767 	}
2768 	return TCL_OK;
2769     }
2770 
2771     /*
2772      * The index didn't match any of the named indices; maybe it's an @x,y
2773      */
2774 
2775     stringRep = Tcl_GetString(indexObj);
2776     if (stringRep[0] == '@') {
2777 
2778         /*
2779          * @x,y index
2780          */
2781 
2782 	int y;
2783 	const char *start;
2784 	char *end;
2785 
2786 	start = stringRep + 1;
2787 	y = strtol(start, &end, 0);
2788 	if ((start == end) || (*end != ',')) {
2789 	    goto badIndex;
2790 	}
2791 	start = end+1;
2792 	y = strtol(start, &end, 0);
2793 	if ((start == end) || (*end != '\0')) {
2794 	    goto badIndex;
2795 	}
2796 	*indexPtr = NearestListboxElement(listPtr, y);
2797 	return TCL_OK;
2798     }
2799 
2800     /*
2801      * Everything failed, nothing matched. Throw up an error message.
2802      */
2803 
2804   badIndex:
2805     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2806 	    "bad listbox index \"%s\": must be active, anchor, end, @x,y,"
2807 	    " or a number", Tcl_GetString(indexObj)));
2808     Tcl_SetErrorCode(interp, "TK", "VALUE", "LISTBOX_INDEX", NULL);
2809     return TCL_ERROR;
2810 }
2811 
2812 /*
2813  *----------------------------------------------------------------------
2814  *
2815  * ChangeListboxView --
2816  *
2817  *	Change the view on a listbox widget so that a given element is
2818  *	displayed at the top.
2819  *
2820  * Results:
2821  *	None.
2822  *
2823  * Side effects:
2824  *	What's displayed on the screen is changed. If there is a scrollbar
2825  *	associated with this widget, then the scrollbar is instructed to
2826  *	change its display too.
2827  *
2828  *----------------------------------------------------------------------
2829  */
2830 
2831 static void
ChangeListboxView(Listbox * listPtr,int index)2832 ChangeListboxView(
2833     Listbox *listPtr,	/* Information about widget. */
2834     int index)			/* Index of element in listPtr that should now
2835 				 * appear at the top of the listbox. */
2836 {
2837     if (index >= (listPtr->nElements - listPtr->fullLines)) {
2838 	index = listPtr->nElements - listPtr->fullLines;
2839     }
2840     if (index < 0) {
2841 	index = 0;
2842     }
2843     if (listPtr->topIndex != index) {
2844 	listPtr->topIndex = index;
2845 	EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
2846 	listPtr->flags |= UPDATE_V_SCROLLBAR;
2847     }
2848 }
2849 
2850 /*
2851  *----------------------------------------------------------------------
2852  *
2853  * ChangListboxOffset --
2854  *
2855  *	Change the horizontal offset for a listbox.
2856  *
2857  * Results:
2858  *	None.
2859  *
2860  * Side effects:
2861  *	The listbox may be redrawn to reflect its new horizontal offset.
2862  *
2863  *----------------------------------------------------------------------
2864  */
2865 
2866 static void
ChangeListboxOffset(Listbox * listPtr,int offset)2867 ChangeListboxOffset(
2868     Listbox *listPtr,	/* Information about widget. */
2869     int offset)			/* Desired new "xOffset" for listbox. */
2870 {
2871     int maxOffset;
2872 
2873     /*
2874      * Make sure that the new offset is within the allowable range, and round
2875      * it off to an even multiple of xScrollUnit.
2876      *
2877      * Add half a scroll unit to do entry/text-like synchronization. [Bug
2878      * #225025]
2879      */
2880 
2881     offset += listPtr->xScrollUnit / 2;
2882     maxOffset = GetMaxOffset(listPtr);
2883     if (offset > maxOffset) {
2884 	offset = maxOffset;
2885     }
2886     if (offset < 0) {
2887 	offset = 0;
2888     }
2889     offset -= offset % listPtr->xScrollUnit;
2890     if (offset != listPtr->xOffset) {
2891 	listPtr->xOffset = offset;
2892 	listPtr->flags |= UPDATE_H_SCROLLBAR;
2893 	EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
2894     }
2895 }
2896 
2897 /*
2898  *----------------------------------------------------------------------
2899  *
2900  * ListboxScanTo --
2901  *
2902  *	Given a point (presumably of the curent mouse location) drag the view
2903  *	in the window to implement the scan operation.
2904  *
2905  * Results:
2906  *	None.
2907  *
2908  * Side effects:
2909  *	The view in the window may change.
2910  *
2911  *----------------------------------------------------------------------
2912  */
2913 
2914 static void
ListboxScanTo(Listbox * listPtr,int x,int y)2915 ListboxScanTo(
2916     Listbox *listPtr,	/* Information about widget. */
2917     int x,			/* X-coordinate to use for scan operation. */
2918     int y)			/* Y-coordinate to use for scan operation. */
2919 {
2920     int newTopIndex, newOffset, maxIndex, maxOffset;
2921 
2922     maxIndex = listPtr->nElements - listPtr->fullLines;
2923     maxOffset = GetMaxOffset(listPtr);
2924 
2925     /*
2926      * Compute new top line for screen by amplifying the difference between
2927      * the current position and the place where the scan started (the "mark"
2928      * position). If we run off the top or bottom of the list, then reset the
2929      * mark point so that the current position continues to correspond to the
2930      * edge of the window. This means that the picture will start dragging as
2931      * soon as the mouse reverses direction (without this reset, might have to
2932      * slide mouse a long ways back before the picture starts moving again).
2933      */
2934 
2935     newTopIndex = listPtr->scanMarkYIndex
2936 	    - (10*(y - listPtr->scanMarkY)) / listPtr->lineHeight;
2937     if (newTopIndex > maxIndex) {
2938 	newTopIndex = listPtr->scanMarkYIndex = maxIndex;
2939 	listPtr->scanMarkY = y;
2940     } else if (newTopIndex < 0) {
2941 	newTopIndex = listPtr->scanMarkYIndex = 0;
2942 	listPtr->scanMarkY = y;
2943     }
2944     ChangeListboxView(listPtr, newTopIndex);
2945 
2946     /*
2947      * Compute new left edge for display in a similar fashion by amplifying
2948      * the difference between the current position and the place where the
2949      * scan started.
2950      */
2951 
2952     newOffset = listPtr->scanMarkXOffset - 10*(x - listPtr->scanMarkX);
2953     if (newOffset > maxOffset) {
2954 	newOffset = listPtr->scanMarkXOffset = maxOffset;
2955 	listPtr->scanMarkX = x;
2956     } else if (newOffset < 0) {
2957 	newOffset = listPtr->scanMarkXOffset = 0;
2958 	listPtr->scanMarkX = x;
2959     }
2960     ChangeListboxOffset(listPtr, newOffset);
2961 }
2962 
2963 /*
2964  *----------------------------------------------------------------------
2965  *
2966  * NearestListboxElement --
2967  *
2968  *	Given a y-coordinate inside a listbox, compute the index of the
2969  *	element under that y-coordinate (or closest to that y-coordinate).
2970  *
2971  * Results:
2972  *	The return value is an index of an element of listPtr. If listPtr has
2973  *	no elements, then 0 is always returned.
2974  *
2975  * Side effects:
2976  *	None.
2977  *
2978  *----------------------------------------------------------------------
2979  */
2980 
2981 static int
NearestListboxElement(Listbox * listPtr,int y)2982 NearestListboxElement(
2983     Listbox *listPtr,	/* Information about widget. */
2984     int y)			/* Y-coordinate in listPtr's window. */
2985 {
2986     int index;
2987 
2988     index = (y - listPtr->inset) / listPtr->lineHeight;
2989     if (index >= (listPtr->fullLines + listPtr->partialLine)) {
2990 	index = listPtr->fullLines + listPtr->partialLine - 1;
2991     }
2992     if (index < 0) {
2993 	index = 0;
2994     }
2995     index += listPtr->topIndex;
2996     if (index >= listPtr->nElements) {
2997 	index = listPtr->nElements-1;
2998     }
2999     return index;
3000 }
3001 
3002 /*
3003  *----------------------------------------------------------------------
3004  *
3005  * ListboxSelect --
3006  *
3007  *	Select or deselect one or more elements in a listbox..
3008  *
3009  * Results:
3010  *	Standard Tcl result.
3011  *
3012  * Side effects:
3013  *	All of the elements in the range between first and last are marked as
3014  *	either selected or deselected, depending on the "select" argument. Any
3015  *	items whose state changes are redisplayed. The selection is claimed
3016  *	from X when the number of selected elements changes from zero to
3017  *	non-zero.
3018  *
3019  *----------------------------------------------------------------------
3020  */
3021 
3022 static int
ListboxSelect(Listbox * listPtr,int first,int last,int select)3023 ListboxSelect(
3024     Listbox *listPtr,	/* Information about widget. */
3025     int first,			/* Index of first element to select or
3026 				 * deselect. */
3027     int last,			/* Index of last element to select or
3028 				 * deselect. */
3029     int select)			/* 1 means select items, 0 means deselect
3030 				 * them. */
3031 {
3032     int i, firstRedisplay, oldCount, isNew;
3033     Tcl_HashEntry *entry;
3034 
3035     if (last < first) {
3036 	i = first;
3037 	first = last;
3038 	last = i;
3039     }
3040     if ((last < 0) || (first >= listPtr->nElements)) {
3041 	return TCL_OK;
3042     }
3043     if (first < 0) {
3044 	first = 0;
3045     }
3046     if (last >= listPtr->nElements) {
3047 	last = listPtr->nElements - 1;
3048     }
3049     oldCount = listPtr->numSelected;
3050     firstRedisplay = -1;
3051 
3052     /*
3053      * For each index in the range, find it in our selection hash table. If
3054      * it's not there but should be, add it. If it's there but shouldn't be,
3055      * remove it.
3056      */
3057 
3058     for (i = first; i <= last; i++) {
3059 	entry = Tcl_FindHashEntry(listPtr->selection, KEY(i));
3060 	if (entry != NULL) {
3061 	    if (!select) {
3062 		Tcl_DeleteHashEntry(entry);
3063 		listPtr->numSelected--;
3064 		if (firstRedisplay < 0) {
3065 		    firstRedisplay = i;
3066 		}
3067 	    }
3068 	} else {
3069 	    if (select) {
3070 		entry = Tcl_CreateHashEntry(listPtr->selection, KEY(i),
3071 			&isNew);
3072 		Tcl_SetHashValue(entry, NULL);
3073 		listPtr->numSelected++;
3074 		if (firstRedisplay < 0) {
3075 		    firstRedisplay = i;
3076 		}
3077 	    }
3078 	}
3079     }
3080 
3081     if (firstRedisplay >= 0) {
3082 	EventuallyRedrawRange(listPtr, first, last);
3083     }
3084     if ((oldCount == 0) && (listPtr->numSelected > 0)
3085 	    && (listPtr->exportSelection)
3086 	    && (!Tcl_IsSafe(listPtr->interp))) {
3087 	Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY,
3088 		ListboxLostSelection, listPtr);
3089     }
3090     return TCL_OK;
3091 }
3092 
3093 /*
3094  *----------------------------------------------------------------------
3095  *
3096  * ListboxFetchSelection --
3097  *
3098  *	This procedure is called back by Tk when the selection is requested by
3099  *	someone. It returns part or all of the selection in a buffer provided
3100  *	by the caller.
3101  *
3102  * Results:
3103  *	The return value is the number of non-NULL bytes stored at buffer.
3104  *	Buffer is filled (or partially filled) with a NULL-terminated string
3105  *	containing part or all of the selection, as given by offset and
3106  *	maxBytes. The selection is returned as a Tcl list with one list
3107  *	element for each element in the listbox.
3108  *
3109  * Side effects:
3110  *	None.
3111  *
3112  *----------------------------------------------------------------------
3113  */
3114 
3115 static TkSizeT
ListboxFetchSelection(ClientData clientData,TkSizeT offset,char * buffer,TkSizeT maxBytes)3116 ListboxFetchSelection(
3117     ClientData clientData,	/* Information about listbox widget. */
3118     TkSizeT offset,			/* Offset within selection of first byte to be
3119 				 * returned. */
3120     char *buffer,		/* Location in which to place selection. */
3121     TkSizeT maxBytes)		/* Maximum number of bytes to place at buffer,
3122 				 * not including terminating NULL
3123 				 * character. */
3124 {
3125     Listbox *listPtr = (Listbox *)clientData;
3126     Tcl_DString selection;
3127     int count, needNewline, i;
3128     TkSizeT length, stringLen;
3129     Tcl_Obj *curElement;
3130     const char *stringRep;
3131     Tcl_HashEntry *entry;
3132 
3133     if ((!listPtr->exportSelection) || Tcl_IsSafe(listPtr->interp)) {
3134 	return -1;
3135     }
3136 
3137     /*
3138      * Use a dynamic string to accumulate the contents of the selection.
3139      */
3140 
3141     needNewline = 0;
3142     Tcl_DStringInit(&selection);
3143     for (i = 0; i < listPtr->nElements; i++) {
3144 	entry = Tcl_FindHashEntry(listPtr->selection, KEY(i));
3145 	if (entry != NULL) {
3146 	    if (needNewline) {
3147 		Tcl_DStringAppend(&selection, "\n", 1);
3148 	    }
3149 	    Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
3150 		    &curElement);
3151 	    stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
3152 	    Tcl_DStringAppend(&selection, stringRep, stringLen);
3153 	    needNewline = 1;
3154 	}
3155     }
3156 
3157     length = Tcl_DStringLength(&selection);
3158     if (length == 0) {
3159 	return -1;
3160     }
3161 
3162     /*
3163      * Copy the requested portion of the selection to the buffer.
3164      */
3165 
3166     if (length <= offset) {
3167 	count = 0;
3168     } else {
3169 	count = length - offset;
3170 	if (count > (int)maxBytes) {
3171 	    count = (int)maxBytes;
3172 	}
3173 	memcpy(buffer, Tcl_DStringValue(&selection) + offset, count);
3174     }
3175     buffer[count] = '\0';
3176     Tcl_DStringFree(&selection);
3177     return count;
3178 }
3179 
3180 /*
3181  *----------------------------------------------------------------------
3182  *
3183  * ListboxLostSelection --
3184  *
3185  *	This procedure is called back by Tk when the selection is grabbed away
3186  *	from a listbox widget.
3187  *
3188  * Results:
3189  *	None.
3190  *
3191  * Side effects:
3192  *	The existing selection is unhighlighted, and the window is marked as
3193  *	not containing a selection.
3194  *
3195  *----------------------------------------------------------------------
3196  */
3197 
3198 static void
ListboxLostSelection(ClientData clientData)3199 ListboxLostSelection(
3200     ClientData clientData)	/* Information about listbox widget. */
3201 {
3202     Listbox *listPtr = (Listbox *)clientData;
3203 
3204     if ((listPtr->exportSelection) && (!Tcl_IsSafe(listPtr->interp))
3205 	    && (listPtr->nElements > 0)) {
3206 	ListboxSelect(listPtr, 0, listPtr->nElements-1, 0);
3207         GenerateListboxSelectEvent(listPtr);
3208     }
3209 }
3210 
3211 /*
3212  *----------------------------------------------------------------------
3213  *
3214  * GenerateListboxSelectEvent --
3215  *
3216  *	Send an event that the listbox selection was updated. This is
3217  *	equivalent to event generate $listboxWidget <<ListboxSelect>>
3218  *
3219  * Results:
3220  *	None
3221  *
3222  * Side effects:
3223  *	Any side effect possible, depending on bindings to this event.
3224  *
3225  *----------------------------------------------------------------------
3226  */
3227 
3228 static void
GenerateListboxSelectEvent(Listbox * listPtr)3229 GenerateListboxSelectEvent(
3230     Listbox *listPtr)		/* Information about widget. */
3231 {
3232     Tk_SendVirtualEvent(listPtr->tkwin, "ListboxSelect", NULL);
3233 }
3234 
3235 /*
3236  *----------------------------------------------------------------------
3237  *
3238  * EventuallyRedrawRange --
3239  *
3240  *	Ensure that a given range of elements is eventually redrawn on the
3241  *	display (if those elements in fact appear on the display).
3242  *
3243  * Results:
3244  *	None.
3245  *
3246  * Side effects:
3247  *	Information gets redisplayed.
3248  *
3249  *----------------------------------------------------------------------
3250  */
3251 
3252 static void
EventuallyRedrawRange(Listbox * listPtr,int first,int last)3253 EventuallyRedrawRange(
3254     Listbox *listPtr,	/* Information about widget. */
3255     int first,			/* Index of first element in list that needs
3256 				 * to be redrawn. */
3257     int last)			/* Index of last element in list that needs to
3258 				 * be redrawn. May be less than first; these
3259 				 * just bracket a range. */
3260 {
3261     (void)first;
3262     (void)last;
3263 
3264     /*
3265      * We don't have to register a redraw callback if one is already pending,
3266      * or if the window doesn't exist, or if the window isn't mapped.
3267      */
3268 
3269     if ((listPtr->flags & REDRAW_PENDING)
3270 	    || (listPtr->flags & LISTBOX_DELETED)
3271 	    || !Tk_IsMapped(listPtr->tkwin)) {
3272 	return;
3273     }
3274     listPtr->flags |= REDRAW_PENDING;
3275     Tcl_DoWhenIdle(DisplayListbox, listPtr);
3276 }
3277 
3278 /*
3279  *----------------------------------------------------------------------
3280  *
3281  * ListboxUpdateVScrollbar --
3282  *
3283  *	This procedure is invoked whenever information has changed in a
3284  *	listbox in a way that would invalidate a vertical scrollbar display.
3285  *	If there is an associated scrollbar, then this command updates it by
3286  *	invoking a Tcl command.
3287  *
3288  * Results:
3289  *	None.
3290  *
3291  * Side effects:
3292  *	A Tcl command is invoked, and an additional command may be invoked to
3293  *	process errors in the command.
3294  *
3295  *----------------------------------------------------------------------
3296  */
3297 
3298 static void
ListboxUpdateVScrollbar(Listbox * listPtr)3299 ListboxUpdateVScrollbar(
3300     Listbox *listPtr)	/* Information about widget. */
3301 {
3302     char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE];
3303     double first, last;
3304     int result;
3305     Tcl_Interp *interp;
3306     Tcl_DString buf;
3307 
3308     if (listPtr->yScrollCmd == NULL) {
3309 	return;
3310     }
3311     if (listPtr->nElements == 0) {
3312 	first = 0.0;
3313 	last = 1.0;
3314     } else {
3315 	first = listPtr->topIndex / (double) listPtr->nElements;
3316 	last = (listPtr->topIndex + listPtr->fullLines)
3317 		/ (double) listPtr->nElements;
3318 	if (last > 1.0) {
3319 	    last = 1.0;
3320 	}
3321     }
3322     Tcl_PrintDouble(NULL, first, firstStr);
3323     Tcl_PrintDouble(NULL, last, lastStr);
3324 
3325     /*
3326      * We must hold onto the interpreter from the listPtr because the data at
3327      * listPtr might be freed as a result of the Tcl_EvalEx.
3328      */
3329 
3330     interp = listPtr->interp;
3331     Tcl_Preserve(interp);
3332     Tcl_DStringInit(&buf);
3333     Tcl_DStringAppend(&buf, listPtr->yScrollCmd, -1);
3334     Tcl_DStringAppend(&buf, " ", -1);
3335     Tcl_DStringAppend(&buf, firstStr, -1);
3336     Tcl_DStringAppend(&buf, " ", -1);
3337     Tcl_DStringAppend(&buf, lastStr, -1);
3338     result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, TCL_EVAL_GLOBAL);
3339     Tcl_DStringFree(&buf);
3340     if (result != TCL_OK) {
3341 	Tcl_AddErrorInfo(interp,
3342 		"\n    (vertical scrolling command executed by listbox)");
3343 	Tcl_BackgroundException(interp, result);
3344     }
3345     Tcl_Release(interp);
3346 }
3347 
3348 /*
3349  *----------------------------------------------------------------------
3350  *
3351  * ListboxUpdateHScrollbar --
3352  *
3353  *	This procedure is invoked whenever information has changed in a
3354  *	listbox in a way that would invalidate a horizontal scrollbar display.
3355  *	If there is an associated horizontal scrollbar, then this command
3356  *	updates it by invoking a Tcl command.
3357  *
3358  * Results:
3359  *	None.
3360  *
3361  * Side effects:
3362  *	A Tcl command is invoked, and an additional command may be invoked to
3363  *	process errors in the command.
3364  *
3365  *----------------------------------------------------------------------
3366  */
3367 
3368 static void
ListboxUpdateHScrollbar(Listbox * listPtr)3369 ListboxUpdateHScrollbar(
3370     Listbox *listPtr)	/* Information about widget. */
3371 {
3372     char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE];
3373     int result, windowWidth;
3374     double first, last;
3375     Tcl_Interp *interp;
3376     Tcl_DString buf;
3377 
3378     if (listPtr->xScrollCmd == NULL) {
3379 	return;
3380     }
3381 
3382     windowWidth = Tk_Width(listPtr->tkwin)
3383 	    - 2*(listPtr->inset + listPtr->selBorderWidth);
3384     if (listPtr->maxWidth == 0) {
3385 	first = 0;
3386 	last = 1.0;
3387     } else {
3388 	first = listPtr->xOffset / (double) listPtr->maxWidth;
3389 	last = (listPtr->xOffset + windowWidth) / (double) listPtr->maxWidth;
3390 	if (last > 1.0) {
3391 	    last = 1.0;
3392 	}
3393     }
3394     Tcl_PrintDouble(NULL, first, firstStr);
3395     Tcl_PrintDouble(NULL, last, lastStr);
3396 
3397     /*
3398      * We must hold onto the interpreter because the data referred to at
3399      * listPtr might be freed as a result of the call to Tcl_EvalEx.
3400      */
3401 
3402     interp = listPtr->interp;
3403     Tcl_Preserve(interp);
3404     Tcl_DStringInit(&buf);
3405     Tcl_DStringAppend(&buf, listPtr->xScrollCmd, -1);
3406     Tcl_DStringAppend(&buf, " ", -1);
3407     Tcl_DStringAppend(&buf, firstStr, -1);
3408     Tcl_DStringAppend(&buf, " ", -1);
3409     Tcl_DStringAppend(&buf, lastStr, -1);
3410     result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, TCL_EVAL_GLOBAL);
3411     Tcl_DStringFree(&buf);
3412     if (result != TCL_OK) {
3413 	Tcl_AddErrorInfo(interp,
3414 		"\n    (horizontal scrolling command executed by listbox)");
3415 	Tcl_BackgroundException(interp, result);
3416     }
3417     Tcl_Release(interp);
3418 }
3419 
3420 /*
3421  *----------------------------------------------------------------------
3422  *
3423  * ListboxListVarProc --
3424  *
3425  *	Called whenever the trace on the listbox list var fires.
3426  *
3427  * Results:
3428  *	None.
3429  *
3430  * Side effects:
3431  *	None.
3432  *
3433  *----------------------------------------------------------------------
3434  */
3435 
3436 static char *
ListboxListVarProc(ClientData clientData,Tcl_Interp * interp,const char * name1,const char * name2,int flags)3437 ListboxListVarProc(
3438     ClientData clientData,	/* Information about button. */
3439     Tcl_Interp *interp,		/* Interpreter containing variable. */
3440     const char *name1,		/* Not used. */
3441     const char *name2,		/* Not used. */
3442     int flags)			/* Information about what happened. */
3443 {
3444     Listbox *listPtr = (Listbox *)clientData;
3445     Tcl_Obj *oldListObj, *varListObj;
3446     int oldLength, i;
3447     Tcl_HashEntry *entry;
3448     (void)name1;
3449     (void)name2;
3450 
3451     /*
3452      * Bwah hahahaha! Puny mortal, you can't unset a -listvar'd variable!
3453      */
3454 
3455     if (flags & TCL_TRACE_UNSETS) {
3456 
3457         if (!Tcl_InterpDeleted(interp) && listPtr->listVarName) {
3458             ClientData probe = NULL;
3459 
3460             do {
3461                 probe = Tcl_VarTraceInfo(interp,
3462                         listPtr->listVarName,
3463                         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
3464                         ListboxListVarProc, probe);
3465                 if (probe == (ClientData)listPtr) {
3466                     break;
3467                 }
3468             } while (probe);
3469             if (probe) {
3470                 /*
3471                  * We were able to fetch the unset trace for our
3472                  * listVarName, which means it is not unset and not
3473                  * the cause of this unset trace. Instead some outdated
3474                  * former variable must be, and we should ignore it.
3475                  */
3476                 return NULL;
3477             }
3478 	    Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL,
3479 		    listPtr->listObj, TCL_GLOBAL_ONLY);
3480 	    Tcl_TraceVar2(interp, listPtr->listVarName,
3481 		    NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
3482 		    ListboxListVarProc, clientData);
3483 	    return NULL;
3484 	}
3485     } else {
3486 	oldListObj = listPtr->listObj;
3487 	varListObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName,
3488 		NULL, TCL_GLOBAL_ONLY);
3489 
3490 	/*
3491 	 * Make sure the new value is a good list; if it's not, disallow the
3492 	 * change - the fact that it is a listvar means that it must always be
3493 	 * a valid list - and return an error message.
3494 	 */
3495 
3496 	if (Tcl_ListObjLength(listPtr->interp, varListObj, &i) != TCL_OK) {
3497 	    Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL, oldListObj,
3498 		    TCL_GLOBAL_ONLY);
3499 	    return (char *) "invalid listvar value";
3500 	}
3501 
3502 	listPtr->listObj = varListObj;
3503 
3504 	/*
3505 	 * Incr the obj ref count so it doesn't vanish if the var is unset.
3506 	 */
3507 
3508 	Tcl_IncrRefCount(listPtr->listObj);
3509 
3510 	/*
3511 	 * Clean up the ref to our old list obj.
3512 	 */
3513 
3514 	Tcl_DecrRefCount(oldListObj);
3515     }
3516 
3517     /*
3518      * If the list length has decreased, then we should clean up selection and
3519      * attributes information for elements past the end of the new list.
3520      */
3521 
3522     oldLength = listPtr->nElements;
3523     Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
3524     if (listPtr->nElements < oldLength) {
3525 	for (i = listPtr->nElements; i < oldLength; i++) {
3526 	    /*
3527 	     * Clean up selection.
3528 	     */
3529 
3530 	    entry = Tcl_FindHashEntry(listPtr->selection, KEY(i));
3531 	    if (entry != NULL) {
3532 		listPtr->numSelected--;
3533 		Tcl_DeleteHashEntry(entry);
3534 	    }
3535 
3536 	    /*
3537 	     * Clean up attributes.
3538 	     */
3539 
3540 	    entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i));
3541 	    if (entry != NULL) {
3542 		ckfree(Tcl_GetHashValue(entry));
3543 		Tcl_DeleteHashEntry(entry);
3544 	    }
3545 	}
3546     }
3547 
3548     if (oldLength != listPtr->nElements) {
3549 	listPtr->flags |= UPDATE_V_SCROLLBAR;
3550 	if (listPtr->topIndex > (listPtr->nElements - listPtr->fullLines)) {
3551 	    listPtr->topIndex = listPtr->nElements - listPtr->fullLines;
3552 	    if (listPtr->topIndex < 0) {
3553 		listPtr->topIndex = 0;
3554 	    }
3555 	}
3556     }
3557 
3558     /*
3559      * The computed maxWidth may have changed as a result of this operation.
3560      * However, we don't want to recompute it every time this trace fires
3561      * (imagine the user doing 1000 lappends to the listvar). Therefore, set
3562      * the MAXWIDTH_IS_STALE flag, which will cause the width to be recomputed
3563      * next time the list is redrawn.
3564      */
3565 
3566     listPtr->flags |= MAXWIDTH_IS_STALE;
3567 
3568     EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
3569     return NULL;
3570 }
3571 
3572 /*
3573  *----------------------------------------------------------------------
3574  *
3575  * MigrateHashEntries --
3576  *
3577  *	Given a hash table with entries keyed by a single integer value, move
3578  *	all entries in a given range by a fixed amount, so that if in the
3579  *	original table there was an entry with key n and the offset was i, in
3580  *	the new table that entry would have key n + i.
3581  *
3582  * Results:
3583  *	None.
3584  *
3585  * Side effects:
3586  *	Rekeys some hash table entries.
3587  *
3588  *----------------------------------------------------------------------
3589  */
3590 
3591 static void
MigrateHashEntries(Tcl_HashTable * table,int first,int last,int offset)3592 MigrateHashEntries(
3593     Tcl_HashTable *table,
3594     int first,
3595     int last,
3596     int offset)
3597 {
3598     int i, isNew;
3599     Tcl_HashEntry *entry;
3600     ClientData clientData;
3601 
3602     if (offset == 0) {
3603 	return;
3604     }
3605 
3606     /*
3607      * It's more efficient to do one if/else and nest the for loops inside,
3608      * although we could avoid some code duplication if we nested the if/else
3609      * inside the for loops.
3610      */
3611 
3612     if (offset > 0) {
3613 	for (i = last; i >= first; i--) {
3614 	    entry = Tcl_FindHashEntry(table, KEY(i));
3615 	    if (entry != NULL) {
3616 		clientData = Tcl_GetHashValue(entry);
3617 		Tcl_DeleteHashEntry(entry);
3618 		entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew);
3619 		Tcl_SetHashValue(entry, clientData);
3620 	    }
3621 	}
3622     } else {
3623 	for (i = first; i <= last; i++) {
3624 	    entry = Tcl_FindHashEntry(table, KEY(i));
3625 	    if (entry != NULL) {
3626 		clientData = Tcl_GetHashValue(entry);
3627 		Tcl_DeleteHashEntry(entry);
3628 		entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew);
3629 		Tcl_SetHashValue(entry, clientData);
3630 	    }
3631 	}
3632     }
3633     return;
3634 }
3635 
3636 /*
3637  *----------------------------------------------------------------------
3638  *
3639  * GetMaxOffset --
3640  *
3641  *	Passing in a listbox pointer, returns the maximum offset for the box,
3642  *	i.e. the maximum possible horizontal scrolling value (in pixels).
3643  *
3644  * Results:
3645  *	Listbox's maxOffset.
3646  *
3647  * Side effects:
3648  *	None.
3649  *
3650  *----------------------------------------------------------------------
3651 */
GetMaxOffset(Listbox * listPtr)3652 static int GetMaxOffset(
3653     Listbox *listPtr)
3654 {
3655     int maxOffset;
3656 
3657     maxOffset = listPtr->maxWidth -
3658             (Tk_Width(listPtr->tkwin) - 2*listPtr->inset -
3659             2*listPtr->selBorderWidth) + listPtr->xScrollUnit - 1;
3660     if (maxOffset < 0) {
3661 
3662         /*
3663          * Listbox is larger in width than its largest width item.
3664          */
3665 
3666         maxOffset = 0;
3667     }
3668     maxOffset -= maxOffset % listPtr->xScrollUnit;
3669 
3670     return maxOffset;
3671 }
3672 /*
3673  * Local Variables:
3674  * mode: c
3675  * c-basic-offset: 4
3676  * fill-column: 78
3677  * End:
3678  */
3679