Context Navigation

RpListbox.c @ 4209

Last change on this file since 4209 was 4209, checked in by mmc, 10 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
43	typedef 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
56	typedef 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	*/
200	typedef 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
241	enum state {
242	STATE_DISABLED, STATE_NORMAL
243	};
244
245	static char *stateStrings[] = {
246	"disabled", "normal", (char *) NULL
247	};
248
249	enum activeStyle {
250	ACTIVE_STYLE_DOTBOX, ACTIVE_STYLE_NONE, ACTIVE_STYLE_UNDERLINE
251	};
252
253	static char *activeStyleStrings[] = {
254	"dotbox", "none", "underline", (char *) NULL
255	};
256
257	enum orientation {
258	ORIENT_VERTICAL, ORIENT_HORIZONTAL
259	};
260
261	static 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	*/
270	static 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	*/
350	static 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	*/
387	static 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
394	enum 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
402	static CONST char *selCommandNames[] = {
403	"anchor", "clear", "includes", "set", (char *) NULL
404	};
405
406	enum selcommand {
407	SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET
408	};
409
410	static CONST char *scanCommandNames[] = {
411	"mark", "dragto", (char *) NULL
412	};
413
414	enum scancommand {
415	SCAN_MARK, SCAN_DRAGTO
416	};
417
418	static CONST char *indexNames[] = {
419	"active", "anchor", "end", (char *)NULL
420	};
421
422	enum indices {
423	INDEX_ACTIVE, INDEX_ANCHOR, INDEX_END
424	};
425
426	static CONST char *bboxOptionNames[] = {
427	"-all", "-icon", "-text", (char *) NULL
428	};
429
430	enum bboxoption {
431	BBOX_ALL, BBOX_ICON, BBOX_TEXT
432	};
433
434
435	/* Declarations for procedures defined later in this file */
436	static void RpChangeListboxXOffset _ANSI_ARGS_((Listbox *listPtr,
437	int offset));
438	static void RpChangeListboxYOffset _ANSI_ARGS_((Listbox *listPtr,
439	int offset));
440	static void RpChangeListboxView _ANSI_ARGS_((Listbox *listPtr,
441	int index));
442	static int RpConfigureListbox _ANSI_ARGS_((Tcl_Interp *interp,
443	Listbox listPtr, int objc, Tcl_Obj CONST objv[],
444	int flags));
445	static int RpConfigureListboxItem _ANSI_ARGS_ ((Tcl_Interp *interp,
446	Listbox listPtr, ItemAttr attrs, int objc,
447	Tcl_Obj *CONST objv[], int index));
448	static int RpListboxDeleteSubCmd _ANSI_ARGS_((Listbox *listPtr,
449	int first, int last));
450	static void RpDestroyListbox _ANSI_ARGS_((char *memPtr));
451	static void RpDestroyListboxOptionTables _ANSI_ARGS_ (
452	(ClientData clientData, Tcl_Interp *interp));
453	static void RpDisplayListbox _ANSI_ARGS_((ClientData clientData));
454	static void RpDisplayImage _ANSI_ARGS_((Pixmap pixmap,
455	int w, int h, Tk_Image image, int x, int y));
456	static void RpListboxImageProc _ANSI_ARGS_((ClientData clientData,
457	int x, int y, int width, int height,
458	int imgWidth, int imgHeight));
459	static int RpGetListboxIndex _ANSI_ARGS_((Tcl_Interp *interp,
460	Listbox listPtr, Tcl_Obj index, int endIsSize,
461	int *indexPtr));
462	static void RpGetListboxPos _ANSI_ARGS_((Listbox *listPtr,
463	int index, int rowPtr, int colPtr));
464	static int RpListboxInsertSubCmd _ANSI_ARGS_((Listbox *listPtr,
465	int index, int objc, Tcl_Obj *CONST objv[]));
466	static void RpListboxCmdDeletedProc _ANSI_ARGS_((
467	ClientData clientData));
468	static void RpListboxComputeGeometry _ANSI_ARGS_((Listbox *listPtr,
469	int fontChanged, int maxIsStale, int updateGrid));
470	static void RpListboxEventProc _ANSI_ARGS_((ClientData clientData,
471	XEvent *eventPtr));
472	static int RpListboxFetchSelection _ANSI_ARGS_((
473	ClientData clientData, int offset, char *buffer,
474	int maxBytes));
475	static void RpListboxLostSelection _ANSI_ARGS_((
476	ClientData clientData));
477	static void RpEventuallyRedrawRange _ANSI_ARGS_((Listbox *listPtr,
478	int first, int last));
479	static void RpListboxScanTo _ANSI_ARGS_((Listbox *listPtr,
480	int x, int y));
481	static int RpListboxSelect _ANSI_ARGS_((Listbox *listPtr,
482	int first, int last, int select));
483	static void RpListboxUpdateHScrollbar _ANSI_ARGS_(
484	(Listbox *listPtr));
485	static void RpListboxUpdateVScrollbar _ANSI_ARGS_(
486	(Listbox *listPtr));
487	static int RpListboxWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
488	Tcl_Interp *interp, int objc,
489	Tcl_Obj *CONST objv[]));
490	static int RpListboxBboxSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
491	Listbox *listPtr, int index, int what));
492	static int RpListboxSelectionSubCmd _ANSI_ARGS_ (
493	(Tcl_Interp interp, Listbox listPtr, int objc,
494	Tcl_Obj *CONST objv[]));
495	static int RpListboxXviewSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
496	Listbox *listPtr, int objc,
497	Tcl_Obj *CONST objv[]));
498	static int RpListboxYviewSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
499	Listbox *listPtr, int objc,
500	Tcl_Obj *CONST objv[]));
501	static ItemAttr * RpListboxGetItemAttributes _ANSI_ARGS_ (
502	(Tcl_Interp interp, Listbox listPtr, int index));
503	static void RpListboxWorldChanged _ANSI_ARGS_((
504	ClientData instanceData));
505	static int RpNearestListboxElement _ANSI_ARGS_((Listbox *listPtr,
506	int x, int y));
507	static 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
514	static Tk_ClassProcs listboxClass = {
515	sizeof(Tk_ClassProcs), /* size */
516	RpListboxWorldChanged, /* worldChangedProc */
517	};
518
519	extern 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	*/
533	int
534	RpListbox_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
562	int
563	RpListboxObjCmd(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
686	static int
687	RpListboxWidgetObjCmd(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
1211	static int
1212	RpListboxBboxSubCmd(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
1298	static int
1299	RpListboxSelectionSubCmd(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
1392	static int
1393	RpListboxXviewSubCmd(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	+ countlistPtr->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
1468	static int
1469	RpListboxYviewSubCmd(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
1543	static ItemAttr *
1544	RpListboxGetItemAttributes(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
1591	static void
1592	RpDestroyListbox(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
1668	static void
1669	RpDestroyListboxOptionTables(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
1698	static int
1699	RpConfigureListbox(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
1801	static int
1802	RpConfigureListboxItem(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
1870	static void
1871	RpListboxWorldChanged(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
1948	static void
1949	RpDisplayListbox(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
2268	static void
2269	RpDisplayImage(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
2324	static void
2325	RpListboxImageProc(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
2364	static void
2365	RpListboxComputeGeometry(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->numColumnssizeof(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 = widthlistPtr->xScrollUnit + 2listPtr->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 = heightlistPtr->lineHeight + 2listPtr->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
2594	static int
2595	RpListboxInsertSubCmd(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
2693	static int
2694	RpListboxDeleteSubCmd(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
2832	static void
2833	RpListboxEventProc(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
2916	static void
2917	RpListboxCmdDeletedProc(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
2953	static int
2954	RpGetListboxIndex(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
3053	static void
3054	RpGetListboxPos(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
3093	static void
3094	RpChangeListboxView(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
3144	static void
3145	RpChangeListboxXOffset(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
3183	static void
3184	RpChangeListboxYOffset(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
3222	static void
3223	RpListboxScanTo(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
3285	static int
3286	RpNearestListboxElement(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
3353	static int
3354	RpListboxSelect(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
3446	static int
3447	RpListboxFetchSelection(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
3533	static void
3534	RpListboxLostSelection(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
3562	static void
3563	RpEventuallyRedrawRange(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
3603	static void
3604	RpListboxUpdateVScrollbar(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
3672	static void
3673	RpListboxUpdateHScrollbar(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
3735	static void
3736	RpMigrateHashEntries(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.

Context Navigation

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

Download in other formats: