source: trunk/gui/src/RpListbox.c @ 4503

Last change on this file since 4503 was 4209, checked in by mmc, 7 years ago

Added some useful widgets: 1) Rappture::listbox, which is like the
usual Tk listbox, but adds icons for entries, indent levels for
entries, and a horizontal orientation that is useful when building
file browsers. 2) Rappture::Coverflow, which lets you select images
from an Apple-style coverflow display. 3) XAuth library, which can
be used to call OAuth-style web services.

Also fixed the build system to avoid Vtk stuff when --without-vtk and
--disable-vtkdicom are set.

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