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