/[dtapublic]/projs/dtats/trunk/shared_source/c_tk_base_7_5_w_mods/tklistbox.c
ViewVC logotype

Contents of /projs/dtats/trunk/shared_source/c_tk_base_7_5_w_mods/tklistbox.c

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25