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