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

Annotation of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tklistbox.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 25 - (hide annotations) (download)
Sat Oct 8 06:43:03 2016 UTC (7 years, 9 months ago) by dashley
Original Path: sf_code/esrgpcpj/shared/tk_base/tklistbox.c
File MIME type: text/plain
File size: 103612 byte(s)
Initial commit.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tklistbox.c,v 1.1.1.1 2001/06/13 05:05:02 dtashley Exp $ */
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     /* $History: tkListbox.c $
3288     *
3289     * ***************** Version 1 *****************
3290     * User: Dtashley Date: 1/02/01 Time: 3:01a
3291     * Created in $/IjuScripter, IjuConsole/Source/Tk Base
3292     * Initial check-in.
3293     */
3294    
3295     /* End of TKLISTBOX.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25