summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>1999-11-17 02:38:27 (GMT)
committerericm <ericm>1999-11-17 02:38:27 (GMT)
commit249bfa3b8b3e73d09d6e934b4a0cefbd0b05337f (patch)
tree2dfe007e1934d98763917d50b21ab9d420342513
parent64058b81a00dcb9a607570d29205f230a623b4ae (diff)
downloadtk-249bfa3b8b3e73d09d6e934b4a0cefbd0b05337f.zip
tk-249bfa3b8b3e73d09d6e934b4a0cefbd0b05337f.tar.gz
tk-249bfa3b8b3e73d09d6e934b4a0cefbd0b05337f.tar.bz2
* generic/tkWindow.c: Changed "listbox" mapping from old-school to
new-school objectified command. * generic/tkListbox.c: Objectified listbox; added support for -listvar option. Converted internal structure to use a Tcl list object to store the data. * generic/tkInt.h: Changed reference to Tk_ListboxCmd to Tk_ListboxObjCmd.
-rw-r--r--generic/tkInt.h7
-rw-r--r--generic/tkListbox.c2218
-rw-r--r--generic/tkWindow.c4
3 files changed, 1362 insertions, 867 deletions
diff --git a/generic/tkInt.h b/generic/tkInt.h
index e6a79e1..7e43724 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: $Id: tkInt.h,v 1.16 1999/10/29 03:57:57 hobbs Exp $
+ * RCS: $Id: tkInt.h,v 1.17 1999/11/17 02:38:27 ericm Exp $
*/
#ifndef _TKINT
@@ -933,8 +933,9 @@ EXTERN int Tk_ImageObjCmd _ANSI_ARGS_((ClientData clientData,
EXTERN int Tk_LabelObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
-EXTERN int Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ListboxObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
EXTERN int Tk_LowerCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tk_MenubuttonObjCmd _ANSI_ARGS_((ClientData clientData,
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index 487ba3b..04b540a 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkListbox.c,v 1.4 1999/08/10 05:06:47 jingham Exp $
+ * RCS: @(#) $Id: tkListbox.c,v 1.5 1999/11/17 02:38:28 ericm Exp $
*/
#include "tkPort.h"
@@ -19,31 +19,6 @@
#include "tkInt.h"
/*
- * One record of the following type is kept for each element
- * associated with a listbox widget:
- */
-
-typedef struct Element {
- int textLength; /* # non-NULL bytes in text string. */
- int lBearing; /* Distance from first character's
- * origin to left edge of character. */
- int pixelWidth; /* Total width of element in pixels (including
- * left bearing and right bearing). */
- int selected; /* 1 means this item is selected, 0 means
- * it isn't. */
- struct Element *nextPtr; /* Next in list of all elements of this
- * listbox, or NULL for last element. */
- char text[4]; /* Characters of this element, NULL-
- * terminated. The actual space allocated
- * here will be as large as needed (> 4,
- * most likely). Must be the last field
- * of the record. */
-} Element;
-
-#define ElementSize(stringLength) \
- ((unsigned) (sizeof(Element) - 3 + stringLength))
-
-/*
* A data structure of the following type is kept for each listbox
* widget managed by this file:
*/
@@ -58,12 +33,13 @@ typedef struct {
* freed even after tkwin has gone away. */
Tcl_Interp *interp; /* Interpreter associated with listbox. */
Tcl_Command widgetCmd; /* Token for listbox's widget command. */
- int numElements; /* Total number of elements in this listbox. */
- Element *firstPtr; /* First in list of elements (NULL if no
- * elements). */
- Element *lastPtr; /* Last in list of elements (NULL if no
- * elements). */
-
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ char *listVarName; /* List variable name */
+ Tcl_Obj *listObj; /* Pointer to the list object being used */
+ int nElements; /* Holds the current count of elements */
+ Tcl_HashTable *selection; /* Tracks selection */
+
/*
* Information used when displaying widget:
*/
@@ -183,87 +159,133 @@ typedef struct {
* to be updated.
* GOT_FOCUS: Non-zero means this widget currently
* has the input focus.
+ * MAXWIDTH_IS_STALE: Stored maxWidth may be out-of-date
*/
#define REDRAW_PENDING 1
#define UPDATE_V_SCROLLBAR 2
#define UPDATE_H_SCROLLBAR 4
#define GOT_FOCUS 8
+#define MAXWIDTH_IS_STALE 16
/*
* Information used for argv parsing:
*/
-static Tk_ConfigSpec configSpecs[] = {
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_LISTBOX_BG_COLOR, Tk_Offset(Listbox, normalBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_LISTBOX_BG_MONO, Tk_Offset(Listbox, normalBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- DEF_LISTBOX_BORDER_WIDTH, Tk_Offset(Listbox, borderWidth), 0},
- {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
- DEF_LISTBOX_CURSOR, Tk_Offset(Listbox, cursor), TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
- "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION,
- Tk_Offset(Listbox, exportSelection), 0},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_FONT, "-font", "font", "Font",
- DEF_LISTBOX_FONT, Tk_Offset(Listbox, tkfont), 0},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_LISTBOX_FG, Tk_Offset(Listbox, fgColorPtr), 0},
- {TK_CONFIG_INT, "-height", "height", "Height",
- DEF_LISTBOX_HEIGHT, Tk_Offset(Listbox, height), 0},
- {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
- "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG,
- Tk_Offset(Listbox, highlightBgColorPtr), 0},
- {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
- DEF_LISTBOX_HIGHLIGHT, Tk_Offset(Listbox, highlightColorPtr), 0},
- {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
- "HighlightThickness",
- DEF_LISTBOX_HIGHLIGHT_WIDTH, Tk_Offset(Listbox, highlightWidth), 0},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_LISTBOX_RELIEF, Tk_Offset(Listbox, relief), 0},
- {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
- DEF_LISTBOX_SELECT_COLOR, Tk_Offset(Listbox, selBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
- DEF_LISTBOX_SELECT_MONO, Tk_Offset(Listbox, selBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
- DEF_LISTBOX_SELECT_BD, Tk_Offset(Listbox, selBorderWidth), 0},
- {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
- DEF_LISTBOX_SELECT_FG_COLOR, Tk_Offset(Listbox, selFgColorPtr),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
- DEF_LISTBOX_SELECT_FG_MONO, Tk_Offset(Listbox, selFgColorPtr),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_UID, "-selectmode", "selectMode", "SelectMode",
- DEF_LISTBOX_SELECT_MODE, Tk_Offset(Listbox, selectMode), 0},
- {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
- DEF_LISTBOX_SET_GRID, Tk_Offset(Listbox, setGrid), 0},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_LISTBOX_TAKE_FOCUS, Tk_Offset(Listbox, takeFocus),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_INT, "-width", "width", "Width",
- DEF_LISTBOX_WIDTH, Tk_Offset(Listbox, width), 0},
- {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
- DEF_LISTBOX_SCROLL_COMMAND, Tk_Offset(Listbox, xScrollCmd),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
- DEF_LISTBOX_SCROLL_COMMAND, Tk_Offset(Listbox, yScrollCmd),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_LISTBOX_BG_COLOR, -1, Tk_Offset(Listbox, normalBorder),
+ 0, (ClientData) DEF_LISTBOX_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_LISTBOX_BORDER_WIDTH, -1, Tk_Offset(Listbox, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_LISTBOX_CURSOR, -1, Tk_Offset(Listbox, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION, -1,
+ Tk_Offset(Listbox, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_LISTBOX_FONT, -1, Tk_Offset(Listbox, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_LISTBOX_FG, -1, Tk_Offset(Listbox, fgColorPtr), 0, 0, 0},
+ {TK_OPTION_INT, "-height", "height", "Height",
+ DEF_LISTBOX_HEIGHT, -1, Tk_Offset(Listbox, height), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG, -1,
+ Tk_Offset(Listbox, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_LISTBOX_HIGHLIGHT, -1, Tk_Offset(Listbox, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_LISTBOX_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Listbox, highlightWidth), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LISTBOX_RELIEF, -1, Tk_Offset(Listbox, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_LISTBOX_SELECT_COLOR, -1, Tk_Offset(Listbox, selBorder),
+ 0, (ClientData) DEF_LISTBOX_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_LISTBOX_SELECT_BD, -1,
+ Tk_Offset(Listbox, selBorderWidth), 0, 0, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_LISTBOX_SELECT_FG_COLOR, -1, Tk_Offset(Listbox, selFgColorPtr),
+ 0, (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0},
+ {TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode",
+ DEF_LISTBOX_SELECT_MODE, -1, Tk_Offset(Listbox, selectMode),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_LISTBOX_SET_GRID, -1, Tk_Offset(Listbox, setGrid), 0, 0, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_LISTBOX_TAKE_FOCUS, -1, Tk_Offset(Listbox, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_LISTBOX_WIDTH, -1, Tk_Offset(Listbox, width), 0, 0, 0},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, -1, Tk_Offset(Listbox, xScrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, -1, Tk_Offset(Listbox, yScrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-listvariable", "listVariable", "ListVariable",
+ DEF_LISTBOX_LIST_VARIABLE, -1, Tk_Offset(Listbox, listVarName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
};
/*
+ * The following tables define the listbox widget commands (and sub-
+ * commands) and map the indexes into the string tables into
+ * enumerated types used to dispatch the listbox widget command.
+ */
+
+static char *commandNames[] = {
+ "activate", "bbox", "cget", "configure", "curselection", "delete", "get",
+ "index", "insert", "nearest", "scan", "see", "selection", "size", "xview",
+ "yview",
+ (char *) NULL
+};
+
+enum command {
+ COMMAND_ACTIVATE, COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE,
+ COMMAND_CURSELECTION, COMMAND_DELETE, COMMAND_GET, COMMAND_INDEX,
+ COMMAND_INSERT, COMMAND_NEAREST, COMMAND_SCAN, COMMAND_SEE,
+ COMMAND_SELECTION, COMMAND_SIZE, COMMAND_XVIEW, COMMAND_YVIEW
+};
+
+static char *selCommandNames[] = {
+ "anchor", "clear", "includes", "set", (char *) NULL
+};
+
+enum selcommand {
+ SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET
+};
+
+static char *scanCommandNames[] = {
+ "mark", "dragto", (char *) NULL
+};
+
+enum scancommand {
+ SCAN_MARK, SCAN_DRAGTO
+};
+
+static char *indexNames[] = {
+ "active", "anchor", "end", (char *)NULL
+};
+
+enum indices {
+ INDEX_ACTIVE, INDEX_ANCHOR, INDEX_END
+};
+
+
+/*
* Forward declarations for procedures defined later in this file:
*/
@@ -272,17 +294,17 @@ static void ChangeListboxOffset _ANSI_ARGS_((Listbox *listPtr,
static void ChangeListboxView _ANSI_ARGS_((Listbox *listPtr,
int index));
static int ConfigureListbox _ANSI_ARGS_((Tcl_Interp *interp,
- Listbox *listPtr, int argc, char **argv,
+ Listbox *listPtr, int objc, Tcl_Obj *CONST objv[],
int flags));
-static void DeleteEls _ANSI_ARGS_((Listbox *listPtr, int first,
- int last));
+static int ListboxDeleteSubCmd _ANSI_ARGS_((Listbox *listPtr,
+ int first, int last));
static void DestroyListbox _ANSI_ARGS_((char *memPtr));
static void DisplayListbox _ANSI_ARGS_((ClientData clientData));
static int GetListboxIndex _ANSI_ARGS_((Tcl_Interp *interp,
- Listbox *listPtr, char *string, int endIsSize,
+ Listbox *listPtr, Tcl_Obj *index, int endIsSize,
int *indexPtr));
-static void InsertEls _ANSI_ARGS_((Listbox *listPtr, int index,
- int argc, char **argv));
+static int ListboxInsertSubCmd _ANSI_ARGS_((Listbox *listPtr,
+ int index, int objc, Tcl_Obj *CONST objv[]));
static void ListboxCmdDeletedProc _ANSI_ARGS_((
ClientData clientData));
static void ListboxComputeGeometry _ANSI_ARGS_((Listbox *listPtr,
@@ -294,21 +316,35 @@ static int ListboxFetchSelection _ANSI_ARGS_((
int maxBytes));
static void ListboxLostSelection _ANSI_ARGS_((
ClientData clientData));
-static void ListboxRedrawRange _ANSI_ARGS_((Listbox *listPtr,
+static void EventuallyRedrawRange _ANSI_ARGS_((Listbox *listPtr,
int first, int last));
static void ListboxScanTo _ANSI_ARGS_((Listbox *listPtr,
int x, int y));
-static void ListboxSelect _ANSI_ARGS_((Listbox *listPtr,
+static int ListboxSelect _ANSI_ARGS_((Listbox *listPtr,
int first, int last, int select));
static void ListboxUpdateHScrollbar _ANSI_ARGS_((Listbox *listPtr));
static void ListboxUpdateVScrollbar _ANSI_ARGS_((Listbox *listPtr));
-static int ListboxWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int ListboxWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ListboxBboxSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
+ Listbox *listPtr, int index));
+static int ListboxSelectionSubCmd _ANSI_ARGS_ (
+ (Tcl_Interp *interp, Listbox *listPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ListboxXviewSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
+ Listbox *listPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ListboxYviewSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
+ Listbox *listPtr, int objc,
+ Tcl_Obj *CONST objv[]));
static void ListboxWorldChanged _ANSI_ARGS_((
ClientData instanceData));
static int NearestListboxElement _ANSI_ARGS_((Listbox *listPtr,
int y));
-
+static char * ListboxListVarProc _ANSI_ARGS_ ((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
/*
* The structure below defines button class behavior by means of procedures
* that can be invoked from generic window code.
@@ -324,7 +360,7 @@ static TkClassProcs listboxClass = {
/*
*--------------------------------------------------------------
*
- * Tk_ListboxCmd --
+ * Tk_ListboxObjCmd --
*
* This procedure is invoked to process the "listbox" Tcl
* command. See the user documentation for details on what
@@ -340,25 +376,43 @@ static TkClassProcs listboxClass = {
*/
int
-Tk_ListboxCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_ListboxObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
register Listbox *listPtr;
- Tk_Window new;
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+
+ optionTable = (Tk_OptionTable) clientData;
+ if (optionTable == NULL) {
+ Tcl_CmdInfo info;
+ char *name;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ /*
+ * We haven't created the option table for this widget class
+ * yet. Do it now and save the table as the clientData for
+ * the command, so we'll have access to it in future
+ * invocations of the command.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+ name = Tcl_GetString(objv[0]);
+ Tcl_GetCommandInfo(interp, name, &info);
+ info.objClientData = (ClientData) optionTable;
+ Tcl_SetCommandInfo(interp, name, &info);
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
- if (new == NULL) {
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
return TCL_ERROR;
}
@@ -368,54 +422,58 @@ Tk_ListboxCmd(clientData, interp, argc, argv)
* initialized already (e.g. resource pointers).
*/
- listPtr = (Listbox *) ckalloc(sizeof(Listbox));
- listPtr->tkwin = new;
- listPtr->display = Tk_Display(new);
- listPtr->interp = interp;
- listPtr->widgetCmd = Tcl_CreateCommand(interp,
- Tk_PathName(listPtr->tkwin), ListboxWidgetCmd,
+ listPtr = (Listbox *) ckalloc(sizeof(Listbox));
+ listPtr->tkwin = tkwin;
+ listPtr->display = Tk_Display(tkwin);
+ listPtr->interp = interp;
+ listPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(listPtr->tkwin), ListboxWidgetObjCmd,
(ClientData) listPtr, ListboxCmdDeletedProc);
- listPtr->numElements = 0;
- listPtr->firstPtr = NULL;
- listPtr->lastPtr = NULL;
- listPtr->normalBorder = NULL;
- listPtr->borderWidth = 0;
- listPtr->relief = TK_RELIEF_RAISED;
- listPtr->highlightWidth = 0;
- listPtr->highlightBgColorPtr = NULL;
- listPtr->highlightColorPtr = NULL;
- listPtr->inset = 0;
- listPtr->tkfont = NULL;
- listPtr->fgColorPtr = NULL;
- listPtr->textGC = None;
- listPtr->selBorder = NULL;
- listPtr->selBorderWidth = 0;
- listPtr->selFgColorPtr = None;
- listPtr->selTextGC = None;
- listPtr->width = 0;
- listPtr->height = 0;
- listPtr->lineHeight = 0;
- listPtr->topIndex = 0;
- listPtr->fullLines = 1;
- listPtr->partialLine = 0;
- listPtr->setGrid = 0;
- listPtr->maxWidth = 0;
- listPtr->xScrollUnit = 1;
- listPtr->xOffset = 0;
- listPtr->selectMode = NULL;
- listPtr->numSelected = 0;
- listPtr->selectAnchor = 0;
- listPtr->exportSelection = 1;
- listPtr->active = 0;
- listPtr->scanMarkX = 0;
- listPtr->scanMarkY = 0;
- listPtr->scanMarkXOffset = 0;
- listPtr->scanMarkYIndex = 0;
- listPtr->cursor = None;
- listPtr->takeFocus = NULL;
- listPtr->xScrollCmd = NULL;
- listPtr->yScrollCmd = NULL;
- listPtr->flags = 0;
+ listPtr->optionTable = optionTable;
+ listPtr->listVarName = NULL;
+ listPtr->listObj = NULL;
+ listPtr->selection =
+ (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(listPtr->selection, TCL_ONE_WORD_KEYS);
+ listPtr->nElements = 0;
+ listPtr->normalBorder = NULL;
+ listPtr->borderWidth = 0;
+ listPtr->relief = TK_RELIEF_RAISED;
+ listPtr->highlightWidth = 0;
+ listPtr->highlightBgColorPtr = NULL;
+ listPtr->highlightColorPtr = NULL;
+ listPtr->inset = 0;
+ listPtr->tkfont = NULL;
+ listPtr->fgColorPtr = NULL;
+ listPtr->textGC = None;
+ listPtr->selBorder = NULL;
+ listPtr->selBorderWidth = 0;
+ listPtr->selFgColorPtr = None;
+ listPtr->selTextGC = None;
+ listPtr->width = 0;
+ listPtr->height = 0;
+ listPtr->lineHeight = 0;
+ listPtr->topIndex = 0;
+ listPtr->fullLines = 1;
+ listPtr->partialLine = 0;
+ listPtr->setGrid = 0;
+ listPtr->maxWidth = 0;
+ listPtr->xScrollUnit = 1;
+ listPtr->xOffset = 0;
+ listPtr->selectMode = NULL;
+ listPtr->numSelected = 0;
+ listPtr->selectAnchor = 0;
+ listPtr->exportSelection = 1;
+ listPtr->active = 0;
+ listPtr->scanMarkX = 0;
+ listPtr->scanMarkY = 0;
+ listPtr->scanMarkXOffset = 0;
+ listPtr->scanMarkYIndex = 0;
+ listPtr->cursor = None;
+ listPtr->takeFocus = NULL;
+ listPtr->xScrollCmd = NULL;
+ listPtr->yScrollCmd = NULL;
+ listPtr->flags = 0;
Tk_SetClass(listPtr->tkwin, "Listbox");
TkSetClassProcs(listPtr->tkwin, &listboxClass, (ClientData) listPtr);
@@ -424,26 +482,29 @@ Tk_ListboxCmd(clientData, interp, argc, argv)
ListboxEventProc, (ClientData) listPtr);
Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,
ListboxFetchSelection, (ClientData) listPtr, XA_STRING);
- if (ConfigureListbox(interp, listPtr, argc-2, argv+2, 0) != TCL_OK) {
- goto error;
+ if (Tk_InitOptions(interp, (char *)listPtr, optionTable,
+ tkwin) != TCL_OK) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ if (ConfigureListbox(interp, listPtr, objc-2, objv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
}
Tcl_SetResult(interp, Tk_PathName(listPtr->tkwin), TCL_STATIC);
return TCL_OK;
-
- error:
- Tk_DestroyWindow(listPtr->tkwin);
- return TCL_ERROR;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * ListboxWidgetCmd --
+ * ListboxWidgetObjCmd --
*
- * This procedure is invoked to process the Tcl command
- * that corresponds to a widget managed by this module.
- * See the user documentation for details on what it does.
+ * This Tcl_Obj based procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module. See the user
+ * documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -451,495 +512,662 @@ Tk_ListboxCmd(clientData, interp, argc, argv)
* Side effects:
* See the user documentation.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static int
-ListboxWidgetCmd(clientData, interp, argc, argv)
+ListboxWidgetObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about listbox widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Arguments as Tcl_Obj's. */
{
register Listbox *listPtr = (Listbox *) clientData;
+ int cmdIndex, index;
int result = TCL_OK;
- size_t length;
- int c;
- Tk_FontMetrics fm;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- Tcl_Preserve((ClientData) listPtr);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) {
- int index;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " activate index\"",
- (char *) NULL);
- goto error;
- }
- ListboxRedrawRange(listPtr, listPtr->active, listPtr->active);
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index >= listPtr->numElements) {
- index = listPtr->numElements-1;
- }
- if (index < 0) {
- index = 0;
- }
- listPtr->active = index;
- ListboxRedrawRange(listPtr, listPtr->active, listPtr->active);
- } else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
- int index, x, y, i;
- Element *elPtr;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " bbox index\"", (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if ((index >= listPtr->numElements) || (index < 0)) {
- goto done;
- }
- for (i = 0, elPtr = listPtr->firstPtr; i < index;
- i++, elPtr = elPtr->nextPtr) {
- /* Empty loop body. */
- }
- if ((index >= listPtr->topIndex) && (index < listPtr->numElements)
- && (index < (listPtr->topIndex + listPtr->fullLines
- + listPtr->partialLine))) {
- char buf[TCL_INTEGER_SPACE * 4];
-
- x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
- y = ((index - listPtr->topIndex)*listPtr->lineHeight)
- + listPtr->inset + listPtr->selBorderWidth;
- Tk_GetFontMetrics(listPtr->tkfont, &fm);
- sprintf(buf, "%d %d %d %d", x, y, elPtr->pixelWidth, fm.linespace);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- }
- } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- goto error;
- }
- result = Tk_ConfigureValue(interp, listPtr->tkwin, configSpecs,
- (char *) listPtr, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, listPtr->tkwin, configSpecs,
- (char *) listPtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, listPtr->tkwin, configSpecs,
- (char *) listPtr, argv[2], 0);
- } else {
- result = ConfigureListbox(interp, listPtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
- }
- } else if ((c == 'c') && (strncmp(argv[1], "curselection", length) == 0)
- && (length >= 2)) {
- int i, count;
- Element *elPtr;
+ Tcl_Preserve((ClientData)listPtr);
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " curselection\"",
- (char *) NULL);
- goto error;
- }
- count = 0;
- for (i = 0, elPtr = listPtr->firstPtr; elPtr != NULL;
- i++, elPtr = elPtr->nextPtr) {
- if (elPtr->selected) {
- char index[TCL_INTEGER_SPACE];
-
- sprintf(index, "%d", i);
- Tcl_AppendElement(interp, index);
- count++;
+ /*
+ * Parse the command by looking up the second argument in the list
+ * of valid subcommand names
+ */
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ Tcl_Release((ClientData)listPtr);
+ return result;
+ }
+
+ /* The subcommand was valid, so continue processing */
+ switch (cmdIndex) {
+ case COMMAND_ACTIVATE: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements-1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ listPtr->active = index;
+ EventuallyRedrawRange(listPtr, listPtr->active, listPtr->active);
+ result = TCL_OK;
+ break;
+ }
+ case COMMAND_BBOX: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ result = ListboxBboxSubCmd(interp, listPtr, index);
+ break;
+ }
+ case COMMAND_CGET: {
+ Tcl_Obj *objPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ break;
}
- }
- if (count != listPtr->numSelected) {
- panic("ListboxWidgetCmd: selection count incorrect");
- }
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
- int first, last;
- if ((argc < 3) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " delete firstIndex ?lastIndex?\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
- goto error;
- }
- if (first < listPtr->numElements) {
- if (argc == 3) {
- last = first;
- } else {
- if (GetListboxIndex(interp, listPtr, argv[3], 0,
- &last) != TCL_OK) {
- goto error;
- }
- if (last >= listPtr->numElements) {
- last = listPtr->numElements-1;
+ objPtr = Tk_GetOptionValue(interp, (char *)listPtr,
+ listPtr->optionTable, objv[2], listPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ break;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_CONFIGURE: {
+ Tcl_Obj *objPtr;
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) listPtr,
+ listPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ listPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ break;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
}
+ } else {
+ result = ConfigureListbox(interp, listPtr, objc-2, objv+2, 0);
}
- DeleteEls(listPtr, first, last);
+ break;
}
- } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
- int first, last, i;
- Element *elPtr;
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " get first ?last?\"", (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
- goto error;
- }
- last = first;
- if ((argc == 4)
- && (GetListboxIndex(interp, listPtr, argv[3], 0,
- &last) != TCL_OK)) {
- goto error;
- }
- if (first >= listPtr->numElements) {
- goto done;
- }
- if (last >= listPtr->numElements) {
- last = listPtr->numElements-1;
- }
+ case COMMAND_CURSELECTION: {
+ char indexStringRep[TCL_INTEGER_SPACE];
+ int i;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ /*
+ * Of course, it would be more efficient to use the Tcl_HashTable
+ * search functions (Tcl_FirstHashEntry, Tcl_NextHashEntry), but
+ * then the result wouldn't be in sorted order. So instead we
+ * loop through the indices in order, adding them to the result
+ * if they are selected
+ */
+ for (i = 0; i < listPtr->nElements; i++) {
+ if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) {
+ sprintf(indexStringRep, "%d", i);
+ Tcl_AppendElement(interp, indexStringRep);
+ }
+ }
+ result = TCL_OK;
+ break;
+ }
+ case COMMAND_DELETE: {
+ int first, last;
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "firstIndex ?lastIndex?");
+ result = TCL_ERROR;
+ break;
+ }
- for (elPtr = listPtr->firstPtr, i = 0; i < first;
- i++, elPtr = elPtr->nextPtr) {
- /* Empty loop body. */
- }
- if (elPtr != NULL) {
- if (argc == 3) {
- if (first >= 0) {
- Tcl_SetResult(interp, elPtr->text, TCL_STATIC);
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &first);
+ if (result != TCL_OK) {
+ break;
+ }
+ if (first < listPtr->nElements) {
+ /*
+ * if a "last index" was given, get it now; otherwise, use the
+ * first index as the last index
+ */
+ if (objc == 4) {
+ result = GetListboxIndex(interp, listPtr,
+ objv[3], 0, &last);
+ if (result != TCL_OK) {
+ break;
+ }
+ } else {
+ last = first;
}
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
+ }
+ result = ListboxDeleteSubCmd(listPtr, first, last);
} else {
- for ( ; i <= last; i++, elPtr = elPtr->nextPtr) {
- Tcl_AppendElement(interp, elPtr->text);
+ result = TCL_OK;
+ }
+ break;
+ }
+ case COMMAND_GET: {
+ int first, last;
+ Tcl_Obj **elemPtrs;
+ int listLen;
+ if (objc != 3 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &first);
+ if (result != TCL_OK) {
+ break;
+ }
+ last = first;
+ if (objc == 4) {
+ result = GetListboxIndex(interp, listPtr, objv[3], 0, &last);
+ if (result != TCL_OK) {
+ break;
}
}
- }
- } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
- && (length >= 3)) {
- int index;
- char buf[TCL_INTEGER_SPACE];
+ if (first >= listPtr->nElements) {
+ result = TCL_OK;
+ break;
+ }
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ if (first > last) {
+ result = TCL_OK;
+ break;
+ }
+ result = Tcl_ListObjGetElements(interp, listPtr->listObj, &listLen,
+ &elemPtrs);
+ if (result != TCL_OK) {
+ break;
+ }
+ Tcl_SetListObj(Tcl_GetObjResult(interp), (last - first + 1),
+ &(elemPtrs[first]));
+ result = TCL_OK;
+ break;
+ }
+ case COMMAND_INDEX:{
+ char buf[TCL_INTEGER_SPACE];
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+ sprintf(buf, "%d", index);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ result = TCL_OK;
+ break;
+ }
+ case COMMAND_INSERT: {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "index ?element element ...?");
+ result = TCL_ERROR;
+ break;
+ }
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " index index\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
- != TCL_OK) {
- goto error;
+ result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+ result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3);
+ break;
+ }
+ case COMMAND_NEAREST: {
+ char buf[TCL_INTEGER_SPACE];
+ int y;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "y");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = Tcl_GetIntFromObj(interp, objv[2], &y);
+ if (result != TCL_OK) {
+ break;
+ }
+ index = NearestListboxElement(listPtr, y);
+ sprintf(buf, "%d", index);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ result = TCL_OK;
+ break;
}
- sprintf(buf, "%d", index);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
- && (length >= 3)) {
- int index;
-
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " insert index ?element element ...?\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
- != TCL_OK) {
- goto error;
- }
- InsertEls(listPtr, index, argc-3, argv+3);
- } else if ((c == 'n') && (strncmp(argv[1], "nearest", length) == 0)) {
- int index, y;
- char buf[TCL_INTEGER_SPACE];
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " nearest y\"", (char *) NULL);
- goto error;
- }
- if (Tcl_GetInt(interp, argv[2], &y) != TCL_OK) {
- goto error;
- }
- index = NearestListboxElement(listPtr, y);
- sprintf(buf, "%d", index);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- } else if ((c == 's') && (length >= 2)
- && (strncmp(argv[1], "scan", length) == 0)) {
- int x, y;
-
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " scan mark|dragto x y\"", (char *) NULL);
- goto error;
- }
- if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
- || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)) {
- goto error;
- }
- if ((argv[2][0] == 'm')
- && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
- listPtr->scanMarkX = x;
- listPtr->scanMarkY = y;
- listPtr->scanMarkXOffset = listPtr->xOffset;
- listPtr->scanMarkYIndex = listPtr->topIndex;
- } else if ((argv[2][0] == 'd')
- && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
- ListboxScanTo(listPtr, x, y);
- } else {
- Tcl_AppendResult(interp, "bad scan option \"", argv[2],
- "\": must be mark or dragto", (char *) NULL);
- goto error;
- }
- } else if ((c == 's') && (strncmp(argv[1], "see", length) == 0)
- && (length >= 3)) {
- int index, diff;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " see index\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index >= listPtr->numElements) {
- index = listPtr->numElements-1;
- }
- if (index < 0) {
- index = 0;
- }
- diff = listPtr->topIndex-index;
- if (diff > 0) {
- if (diff <= (listPtr->fullLines/3)) {
- ChangeListboxView(listPtr, index);
- } else {
- ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2);
+ case COMMAND_SCAN: {
+ int x, y, scanCmdIndex;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y");
+ result = TCL_ERROR;
+ break;
}
- } else {
- diff = index - (listPtr->topIndex + listPtr->fullLines - 1);
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], scanCommandNames,
+ "option", 0, &scanCmdIndex);
+ if (result != TCL_OK) {
+ break;
+ }
+ switch (scanCmdIndex) {
+ case SCAN_MARK: {
+ listPtr->scanMarkX = x;
+ listPtr->scanMarkY = y;
+ listPtr->scanMarkXOffset = listPtr->xOffset;
+ listPtr->scanMarkYIndex = listPtr->topIndex;
+ break;
+ }
+ case SCAN_DRAGTO: {
+ ListboxScanTo(listPtr, x, y);
+ break;
+ }
+ }
+ result = TCL_OK;
+ break;
+ }
+ case COMMAND_SEE: {
+ int diff;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ diff = listPtr->topIndex - index;
if (diff > 0) {
if (diff <= (listPtr->fullLines/3)) {
- ChangeListboxView(listPtr, listPtr->topIndex + diff);
+ ChangeListboxView(listPtr, index);
} else {
ChangeListboxView(listPtr,
index - (listPtr->fullLines-1)/2);
}
+ } else {
+ diff = index - (listPtr->topIndex + listPtr->fullLines - 1);
+ if (diff > 0) {
+ if (diff <= (listPtr->fullLines/3)) {
+ ChangeListboxView(listPtr, listPtr->topIndex + diff);
+ } else {
+ ChangeListboxView(listPtr,
+ index - (listPtr->fullLines-1)/2);
+ }
+ }
}
+ result = TCL_OK;
+ break;
+ }
+ case COMMAND_SELECTION: {
+ result = ListboxSelectionSubCmd(interp, listPtr, objc, objv);
+ break;
+ }
+ case COMMAND_SIZE: {
+ char buf[TCL_INTEGER_SPACE];
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ sprintf(buf, "%d", listPtr->nElements);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ result = TCL_OK;
+ break;
}
- } else if ((c == 's') && (length >= 3)
- && (strncmp(argv[1], "selection", length) == 0)) {
- int first, last;
-
- if ((argc != 4) && (argc != 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection option index ?index?\"",
- (char *) NULL);
- goto error;
+ case COMMAND_XVIEW: {
+ result = ListboxXviewSubCmd(interp, listPtr, objc, objv);
+ break;
}
- if (GetListboxIndex(interp, listPtr, argv[3], 0, &first) != TCL_OK) {
- goto error;
+ case COMMAND_YVIEW: {
+ result = ListboxYviewSubCmd(interp, listPtr, objc, objv);
+ break;
}
- if (argc == 5) {
- if (GetListboxIndex(interp, listPtr, argv[4], 0, &last) != TCL_OK) {
- goto error;
- }
- } else {
- last = first;
+ }
+ Tcl_Release((ClientData)listPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxBboxSubCmd --
+ *
+ * This procedure is invoked to process a listbox bbox request.
+ * See the user documentation for more information.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * For valid indices, places the bbox of the requested element in
+ * the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxBboxSubCmd(interp, listPtr, index)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int index; /* Index of the element to get bbox info on */
+{
+ int lastVisibleIndex;
+ /* Determine the index of the last visible item in the listbox */
+ lastVisibleIndex = listPtr->topIndex + listPtr->fullLines
+ + listPtr->partialLine;
+ if (listPtr->nElements < lastVisibleIndex) {
+ lastVisibleIndex = listPtr->nElements;
+ }
+
+ /* Only allow bbox requests for indices that are visible */
+ if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) {
+ char buf[TCL_INTEGER_SPACE * 4];
+ Tcl_Obj *el;
+ char *stringRep;
+ int pixelWidth, stringLen, x, y, result;
+ Tk_FontMetrics fm;
+
+ /* Compute the pixel width of the requested element */
+ result = Tcl_ListObjIndex(interp, listPtr->listObj, index, &el);
+ if (result != TCL_OK) {
+ return result;
}
- length = strlen(argv[2]);
- c = argv[2][0];
- if ((c == 'a') && (strncmp(argv[2], "anchor", length) == 0)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection anchor index\"", (char *) NULL);
- goto error;
+
+ stringRep = Tcl_GetStringFromObj(el, &stringLen);
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen);
+
+ x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
+ y = ((index - listPtr->topIndex)*listPtr->lineHeight)
+ + listPtr->inset + listPtr->selBorderWidth;
+ sprintf(buf, "%d %d %d %d", x, y, pixelWidth, fm.linespace);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxSelectionSubCmd --
+ *
+ * This procedure is invoked to process the selection sub command
+ * for listbox widgets.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May set the interpreter's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxSelectionSubCmd(interp, listPtr, objc, objv)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int objc; /* Number of arguments in the objv array */
+ Tcl_Obj *CONST objv[]; /* Array of arguments to the procedure */
+{
+ int selCmdIndex, first, last;
+ int result = TCL_OK;
+ if (objc != 4 && objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option index ?index?");
+ return TCL_ERROR;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[3], 0, &first);
+ if (result != TCL_OK) {
+ return result;
+ }
+ last = first;
+ if (objc == 5) {
+ result = GetListboxIndex(interp, listPtr, objv[4], 0, &last);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames,
+ "option", 0, &selCmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+ switch (selCmdIndex) {
+ case SELECTION_ANCHOR: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
}
- if (first >= listPtr->numElements) {
- first = listPtr->numElements-1;
+ if (first >= listPtr->nElements) {
+ first = listPtr->nElements - 1;
}
if (first < 0) {
first = 0;
}
listPtr->selectAnchor = first;
- } else if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) {
- ListboxSelect(listPtr, first, last, 0);
- } else if ((c == 'i') && (strncmp(argv[2], "includes", length) == 0)) {
- int i;
- Element *elPtr;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection includes index\"", (char *) NULL);
- goto error;
- }
- if ((first < 0) || (first >= listPtr->numElements)) {
- Tcl_SetResult(interp, "0", TCL_STATIC);
- goto done;
- }
- for (elPtr = listPtr->firstPtr, i = 0; i < first;
- i++, elPtr = elPtr->nextPtr) {
- /* Empty loop body. */
+ result = TCL_OK;
+ break;
+ }
+ case SELECTION_CLEAR: {
+ result = ListboxSelect(listPtr, first, last, 0);
+ break;
+ }
+ case SELECTION_INCLUDES: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
}
- if (elPtr->selected) {
+ if (Tcl_FindHashEntry(listPtr->selection, (char *)first)) {
Tcl_SetResult(interp, "1", TCL_STATIC);
} else {
Tcl_SetResult(interp, "0", TCL_STATIC);
}
- } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) {
- ListboxSelect(listPtr, first, last, 1);
- } else {
- Tcl_AppendResult(interp, "bad selection option \"", argv[2],
- "\": must be anchor, clear, includes, or set",
- (char *) NULL);
- goto error;
+ result = TCL_OK;
+ break;
}
- } else if ((c == 's') && (length >= 2)
- && (strncmp(argv[1], "size", length) == 0)) {
- char buf[TCL_INTEGER_SPACE];
-
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " size\"", (char *) NULL);
- goto error;
+ case SELECTION_SET: {
+ result = ListboxSelect(listPtr, first, last, 1);
+ break;
}
- sprintf(buf, "%d", listPtr->numElements);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
- int index, count, type, windowWidth, windowUnits;
- int offset = 0; /* Initialized to stop gcc warnings. */
- double fraction, fraction2;
-
- windowWidth = Tk_Width(listPtr->tkwin)
- - 2*(listPtr->inset + listPtr->selBorderWidth);
- if (argc == 2) {
- if (listPtr->maxWidth == 0) {
- Tcl_SetResult(interp, "0 1", TCL_STATIC);
- } else {
- char buf[TCL_DOUBLE_SPACE * 2];
-
- fraction = listPtr->xOffset/((double) listPtr->maxWidth);
- fraction2 = (listPtr->xOffset + windowWidth)
- /((double) listPtr->maxWidth);
- if (fraction2 > 1.0) {
- fraction2 = 1.0;
- }
- sprintf(buf, "%g %g", fraction, fraction2);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- }
- } else if (argc == 3) {
- if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
- goto error;
- }
- ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxXviewSubCmd --
+ *
+ * Process the listbox "xview" subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May change the listbox viewing area; may set the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxXviewSubCmd(interp, listPtr, objc, objv)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int objc; /* Number of arguments in the objv array */
+ Tcl_Obj *CONST objv[]; /* Array of arguments to the procedure */
+{
+
+ int index, count, type, windowWidth, windowUnits;
+ int offset = 0; /* Initialized to stop gcc warnings. */
+ double fraction, fraction2;
+
+ windowWidth = Tk_Width(listPtr->tkwin)
+ - 2*(listPtr->inset + listPtr->selBorderWidth);
+ if (objc == 2) {
+ if (listPtr->maxWidth == 0) {
+ Tcl_SetResult(interp, "0 1", TCL_STATIC);
} else {
- type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
- switch (type) {
- case TK_SCROLL_ERROR:
- goto error;
- case TK_SCROLL_MOVETO:
- offset = (int) (fraction*listPtr->maxWidth + 0.5);
- break;
- case TK_SCROLL_PAGES:
- windowUnits = windowWidth/listPtr->xScrollUnit;
- if (windowUnits > 2) {
- offset = listPtr->xOffset
- + count*listPtr->xScrollUnit*(windowUnits-2);
- } else {
- offset = listPtr->xOffset + count*listPtr->xScrollUnit;
- }
- break;
- case TK_SCROLL_UNITS:
- offset = listPtr->xOffset + count*listPtr->xScrollUnit;
- break;
+ char buf[TCL_DOUBLE_SPACE * 2];
+
+ fraction = listPtr->xOffset/((double) listPtr->maxWidth);
+ fraction2 = (listPtr->xOffset + windowWidth)
+ /((double) listPtr->maxWidth);
+ if (fraction2 > 1.0) {
+ fraction2 = 1.0;
}
- ChangeListboxOffset(listPtr, offset);
+ sprintf(buf, "%g %g", fraction, fraction2);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
- } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
- int index, count, type;
- double fraction, fraction2;
-
- if (argc == 2) {
- if (listPtr->numElements == 0) {
- Tcl_SetResult(interp, "0 1", TCL_STATIC);
- } else {
- char buf[TCL_DOUBLE_SPACE * 2];
-
- fraction = listPtr->topIndex/((double) listPtr->numElements);
- fraction2 = (listPtr->topIndex+listPtr->fullLines)
- /((double) listPtr->numElements);
- if (fraction2 > 1.0) {
- fraction2 = 1.0;
+ } else if (objc == 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
+ } else {
+ type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ offset = (int) (fraction*listPtr->maxWidth + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ windowUnits = windowWidth/listPtr->xScrollUnit;
+ if (windowUnits > 2) {
+ offset = listPtr->xOffset
+ + count*listPtr->xScrollUnit*(windowUnits-2);
+ } else {
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
}
- sprintf(buf, "%g %g", fraction, fraction2);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- }
- } else if (argc == 3) {
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &index)
- != TCL_OK) {
- goto error;
- }
- ChangeListboxView(listPtr, index);
+ break;
+ case TK_SCROLL_UNITS:
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
+ break;
+ }
+ ChangeListboxOffset(listPtr, offset);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxYviewSubCmd --
+ *
+ * Process the listbox "yview" subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May change the listbox viewing area; may set the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxYviewSubCmd(interp, listPtr, objc, objv)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int objc; /* Number of arguments in the objv array */
+ Tcl_Obj *CONST objv[]; /* Array of arguments to the procedure */
+{
+ int index, count, type;
+ double fraction, fraction2;
+
+ if (objc == 2) {
+ if (listPtr->nElements == 0) {
+ Tcl_SetResult(interp, "0 1", TCL_STATIC);
} else {
- type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
- switch (type) {
- case TK_SCROLL_ERROR:
- goto error;
- case TK_SCROLL_MOVETO:
- index = (int) (listPtr->numElements*fraction + 0.5);
- break;
- case TK_SCROLL_PAGES:
- if (listPtr->fullLines > 2) {
- index = listPtr->topIndex
- + count*(listPtr->fullLines-2);
- } else {
- index = listPtr->topIndex + count;
- }
- break;
- case TK_SCROLL_UNITS:
- index = listPtr->topIndex + count;
- break;
+ char buf[TCL_DOUBLE_SPACE * 2];
+
+ fraction = listPtr->topIndex/((double) listPtr->nElements);
+ fraction2 = (listPtr->topIndex+listPtr->fullLines)
+ /((double) listPtr->nElements);
+ if (fraction2 > 1.0) {
+ fraction2 = 1.0;
}
- ChangeListboxView(listPtr, index);
+ sprintf(buf, "%g %g", fraction, fraction2);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
+ } else if (objc == 3) {
+ if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ChangeListboxView(listPtr, index);
} else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be activate, bbox, cget, configure, ",
- "curselection, delete, get, index, insert, nearest, ",
- "scan, see, selection, size, ",
- "xview, or yview", (char *) NULL);
- goto error;
- }
- done:
- Tcl_Release((ClientData) listPtr);
- return result;
-
- error:
- Tcl_Release((ClientData) listPtr);
- return TCL_ERROR;
+ type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ index = (int) (listPtr->nElements*fraction + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ if (listPtr->fullLines > 2) {
+ index = listPtr->topIndex
+ + count*(listPtr->fullLines-2);
+ } else {
+ index = listPtr->topIndex + count;
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ index = listPtr->topIndex + count;
+ break;
+ }
+ ChangeListboxView(listPtr, index);
+ }
+ return TCL_OK;
}
/*
@@ -965,18 +1193,24 @@ DestroyListbox(memPtr)
char *memPtr; /* Info about listbox widget. */
{
register Listbox *listPtr = (Listbox *) memPtr;
- register Element *elPtr, *nextPtr;
- /*
- * Free up all of the list elements.
- */
-
- for (elPtr = listPtr->firstPtr; elPtr != NULL; ) {
- nextPtr = elPtr->nextPtr;
- ckfree((char *) elPtr);
- elPtr = nextPtr;
+ /* If we have an internal list object, free it */
+ if (listPtr->listObj != NULL) {
+ Tcl_DecrRefCount(listPtr->listObj);
+ listPtr->listObj = NULL;
}
+
+ if (listPtr->listVarName != NULL) {
+ Tcl_UntraceVar(listPtr->interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, (ClientData) listPtr);
+ }
+
+ /* Free the selection hash table */
+ Tcl_DeleteHashTable(listPtr->selection);
+ ckfree((char *)listPtr->selection);
+
/*
* Free up all the stuff that requires special handling, then
* let Tk_FreeOptions handle all the standard option-related
@@ -989,7 +1223,8 @@ DestroyListbox(memPtr)
if (listPtr->selTextGC != None) {
Tk_FreeGC(listPtr->display, listPtr->selTextGC);
}
- Tk_FreeOptions(configSpecs, (char *) listPtr, listPtr->display, 0);
+ Tk_FreeConfigOptions((char *)listPtr, listPtr->optionTable,
+ listPtr->tkwin);
ckfree((char *) listPtr);
}
@@ -998,7 +1233,7 @@ DestroyListbox(memPtr)
*
* ConfigureListbox --
*
- * This procedure is called to process an argv/argc list, plus
+ * This procedure is called to process an objv/objc list, plus
* the Tk option database, in order to configure (or reconfigure)
* a listbox widget.
*
@@ -1015,21 +1250,35 @@ DestroyListbox(memPtr)
*/
static int
-ConfigureListbox(interp, listPtr, argc, argv, flags)
+ConfigureListbox(interp, listPtr, objc, objv, flags)
Tcl_Interp *interp; /* Used for error reporting. */
register Listbox *listPtr; /* Information about widget; may or may
* not already have values for some fields. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *oldListVarObj = NULL;
int oldExport;
oldExport = listPtr->exportSelection;
- if (Tk_ConfigureWidget(interp, listPtr->tkwin, configSpecs,
- argc, argv, (char *) listPtr, flags) != TCL_OK) {
+ if (listPtr->listVarName != NULL) {
+ Tcl_UntraceVar(interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, (ClientData) listPtr);
+ oldListVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
+ (char *)NULL, TCL_GLOBAL_ONLY);
+ }
+
+ if (Tk_SetOptions(interp, (char *)listPtr,
+ listPtr->optionTable, objc, objv, listPtr->tkwin,
+ &savedOptions, (int *)NULL) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
return TCL_ERROR;
}
+
+ Tk_FreeSavedOptions(&savedOptions);
/*
* A few options need special processing, such as setting the
@@ -1054,6 +1303,69 @@ ConfigureListbox(interp, listPtr, argc, argv, flags)
(ClientData) listPtr);
}
+
+ /* Verify the current status of the list var.
+ * PREVIOUS STATE | NEW STATE | ACTION
+ * ------------------+---------------+----------------------------------
+ * no listvar | listvar | If listvar does not exist, create
+ * it and copy the internal list obj's
+ * content to the new var. If it does
+ * exist, toss the internal list obj.
+ *
+ * listvar | no listvar | Copy old listvar content to the
+ * internal list obj
+ *
+ * listvar | listvar | no special action
+ *
+ * no listvar | no listvar | no special action
+ */
+ if (listPtr->listVarName != NULL) {
+ /* We now have a listvar */
+ if (Tcl_GetVar2(interp, listPtr->listVarName, (char *)NULL,
+ TCL_GLOBAL_ONLY) == NULL) {
+ /* New listvar DOES NOT exist */
+ Tcl_Obj *listVarObj;
+ /* Use internal list obj if we have one; else, create an object */
+ if (listPtr->listObj != NULL) {
+ listVarObj = listPtr->listObj;
+ } else {
+ listVarObj = Tcl_NewObj();
+ Tcl_IncrRefCount(listVarObj);
+ }
+ if (Tcl_SetVar2Ex(interp, listPtr->listVarName,
+ (char *)NULL, listVarObj, TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_DecrRefCount(listVarObj);
+ return TCL_ERROR;
+ }
+ }
+ listPtr->listObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
+ (char *)NULL, TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(listPtr->interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, (ClientData) listPtr);
+ } else {
+ /* We do not now have a listvar */
+ if (oldListVarObj != NULL) {
+ /* We used to have a list var */
+ if (listPtr->listObj != NULL) {
+ Tcl_DecrRefCount(listPtr->listObj);
+ listPtr->listObj = NULL;
+ }
+ /* Copy the old listvar's content to the internal list obj */
+ listPtr->listObj = Tcl_DuplicateObj(oldListVarObj);
+ Tcl_IncrRefCount(listPtr->listObj);
+ } else {
+ /* We didn't have a listvar before */
+ if (listPtr->listObj == NULL) {
+ /* If we don't have an internal list obj, create one */
+ listPtr->listObj = Tcl_NewObj();
+ Tcl_IncrRefCount(listPtr->listObj);
+ }
+ }
+ }
+ /* Make sure that the list length is correct */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
ListboxWorldChanged((ClientData) listPtr);
return TCL_OK;
}
@@ -1084,7 +1396,7 @@ ListboxWorldChanged(instanceData)
GC gc;
unsigned long mask;
Listbox *listPtr;
-
+
listPtr = (Listbox *) instanceData;
gcValues.foreground = listPtr->fgColorPtr->pixel;
@@ -1113,7 +1425,7 @@ ListboxWorldChanged(instanceData)
ListboxComputeGeometry(listPtr, 1, 1, 1);
listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
- ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}
/*
@@ -1138,16 +1450,25 @@ DisplayListbox(clientData)
{
register Listbox *listPtr = (Listbox *) clientData;
register Tk_Window tkwin = listPtr->tkwin;
- register Element *elPtr;
GC gc;
int i, limit, x, y, width, prevSelected;
Tk_FontMetrics fm;
+ Tcl_Obj *curElement;
+ char *stringRep;
+ int stringLen;
int left, right; /* Non-zero values here indicate
* that the left or right edge of
* the listbox is off-screen. */
Pixmap pixmap;
listPtr->flags &= ~REDRAW_PENDING;
+
+ if (listPtr->flags & MAXWIDTH_IS_STALE) {
+ ListboxComputeGeometry(listPtr, 0, 1, 0);
+ listPtr->flags &= ~MAXWIDTH_IS_STALE;
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+
if (listPtr->flags & UPDATE_V_SCROLLBAR) {
ListboxUpdateVScrollbar(listPtr);
}
@@ -1179,8 +1500,8 @@ DisplayListbox(clientData)
*/
limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1;
- if (limit >= listPtr->numElements) {
- limit = listPtr->numElements-1;
+ if (limit >= listPtr->nElements) {
+ limit = listPtr->nElements-1;
}
left = right = 0;
if (listPtr->xOffset > 0) {
@@ -1191,16 +1512,13 @@ DisplayListbox(clientData)
right = listPtr->selBorderWidth+1;
}
prevSelected = 0;
- for (elPtr = listPtr->firstPtr, i = 0; (elPtr != NULL) && (i <= limit);
- prevSelected = elPtr->selected, elPtr = elPtr->nextPtr, i++) {
- if (i < listPtr->topIndex) {
- continue;
- }
+
+ for (i = listPtr->topIndex; i <= limit; i++) {
x = listPtr->inset;
y = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ listPtr->inset;
gc = listPtr->textGC;
- if (elPtr->selected) {
+ if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) {
gc = listPtr->selTextGC;
width = Tk_Width(tkwin) - 2*listPtr->inset;
Tk_Fill3DRectangle(tkwin, pixmap, listPtr->selBorder, x, y,
@@ -1237,19 +1555,25 @@ DisplayListbox(clientData)
x-left, y, width+left+right, listPtr->selBorderWidth,
1, 1, 1, TK_RELIEF_RAISED);
}
- if ((elPtr->nextPtr == NULL) || !elPtr->nextPtr->selected) {
+ if (i + 1 == listPtr->nElements ||
+ Tcl_FindHashEntry(listPtr->selection,
+ (char *)(i + 1)) == NULL ) {
Tk_3DHorizontalBevel(tkwin, pixmap, listPtr->selBorder, x-left,
y + listPtr->lineHeight - listPtr->selBorderWidth,
width+left+right, listPtr->selBorderWidth, 0, 0, 0,
TK_RELIEF_RAISED);
}
+ prevSelected = 1;
+ } else {
+ prevSelected = 0;
}
Tk_GetFontMetrics(listPtr->tkfont, &fm);
y += fm.ascent + listPtr->selBorderWidth;
- x = listPtr->inset + listPtr->selBorderWidth - elPtr->lBearing
- - listPtr->xOffset;
+ x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement);
+ stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont,
- elPtr->text, elPtr->textLength, x, y);
+ stringRep, stringLen, x, y);
/*
* If this is the active element, underline it.
@@ -1257,7 +1581,7 @@ DisplayListbox(clientData)
if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
Tk_UnderlineChars(listPtr->display, pixmap, gc, listPtr->tkfont,
- elPtr->text, x, y, 0, elPtr->textLength);
+ stringRep, x, y, 0, stringLen);
}
}
@@ -1325,24 +1649,31 @@ ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
* Tk_UnsetGrid to update gridding for
* the window. */
{
- register Element *elPtr;
int width, height, pixelWidth, pixelHeight;
Tk_FontMetrics fm;
-
+ Tcl_Obj *element;
+ int textLength;
+ char *text;
+ int i, result;
+
if (fontChanged || maxIsStale) {
listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1);
if (listPtr->xScrollUnit == 0) {
listPtr->xScrollUnit = 1;
}
listPtr->maxWidth = 0;
- for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) {
- if (fontChanged) {
- elPtr->pixelWidth = Tk_TextWidth(listPtr->tkfont,
- elPtr->text, elPtr->textLength);
- elPtr->lBearing = 0;
+ for (i = 0; i < listPtr->nElements; i++) {
+ /* Compute the pixel width of the requested element */
+ result = Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
+ &element);
+ if (result != TCL_OK) {
+ continue;
}
- if (elPtr->pixelWidth > listPtr->maxWidth) {
- listPtr->maxWidth = elPtr->pixelWidth;
+ text = Tcl_GetStringFromObj(element, &textLength);
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, text, textLength);
+ if (pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = pixelWidth;
}
}
}
@@ -1361,7 +1692,7 @@ ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
+ 2*listPtr->selBorderWidth;
height = listPtr->height;
if (listPtr->height <= 0) {
- height = listPtr->numElements;
+ height = listPtr->nElements;
if (height < 1) {
height = 1;
}
@@ -1382,100 +1713,111 @@ ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
/*
*----------------------------------------------------------------------
*
- * InsertEls --
+ * ListboxInsertSubCmd --
*
- * Add new elements to a listbox widget.
+ * This procedure is invoked to handle the listbox "insert"
+ * subcommand.
*
* Results:
- * None.
+ * Standard Tcl result.
*
* Side effects:
- * New information gets added to listPtr; it will be redisplayed
- * soon, but not immediately.
+ * New elements are added to the listbox pointed to by listPtr;
+ * a refresh callback is registered for the listbox.
*
*----------------------------------------------------------------------
*/
-static void
-InsertEls(listPtr, index, argc, argv)
+static int
+ListboxInsertSubCmd(listPtr, index, objc, objv)
register Listbox *listPtr; /* Listbox that is to get the new
* elements. */
int index; /* Add the new elements before this
* element. */
- int argc; /* Number of new elements to add. */
- char **argv; /* New elements (one per entry). */
+ int objc; /* Number of new elements to add. */
+ Tcl_Obj *CONST objv[]; /* New elements (one per entry). */
{
- register Element *prevPtr, *newPtr;
- int length, i, oldMaxWidth;
-
- /*
- * Find the element before which the new ones will be inserted.
- */
-
- if (index <= 0) {
- index = 0;
+ int i, oldMaxWidth;
+ Tcl_Obj *newListObj;
+ int pixelWidth;
+ int new, result;
+ Tcl_HashEntry *entry;
+ char *stringRep;
+ int length;
+
+ oldMaxWidth = listPtr->maxWidth;
+ for (i = 0; i < objc; i++) {
+ /*
+ * Check if any of the new elements are wider than the current widest;
+ * if so, update our notion of "widest."
+ */
+ stringRep = Tcl_GetStringFromObj(objv[i], &length);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
+ if (pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = pixelWidth;
+ }
}
- if (index > listPtr->numElements) {
- index = listPtr->numElements;
+
+ /* First, foreach selected item with index >= insertIndex, relocate the
+ * selection marker by objc counts. Start from the END of the list, so
+ * that we don't get accidental collisions en route
+ */
+ for (i = listPtr->nElements - 1; i >= index; i--) {
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ Tcl_DeleteHashEntry(entry);
+ Tcl_CreateHashEntry(listPtr->selection, (char *)(i + objc), &new);
+ }
}
- if (index == 0) {
- prevPtr = NULL;
- } else if (index == listPtr->numElements) {
- prevPtr = listPtr->lastPtr;
+
+ /* If the object is shared, duplicate it before writing to it */
+ if (Tcl_IsShared(listPtr->listObj)) {
+ newListObj = Tcl_DuplicateObj(listPtr->listObj);
} else {
- for (prevPtr = listPtr->firstPtr, i = index - 1; i > 0; i--) {
- prevPtr = prevPtr->nextPtr;
- }
+ newListObj = listPtr->listObj;
+ }
+ result =
+ Tcl_ListObjReplace(listPtr->interp, newListObj, index, 0, objc, objv);
+ if (result != TCL_OK) {
+ return result;
}
- /*
- * For each new element, create a record, initialize it, and link
- * it into the list of elements.
- */
+ Tcl_IncrRefCount(newListObj);
+ /* Clean up the old reference */
+ Tcl_DecrRefCount(listPtr->listObj);
- oldMaxWidth = listPtr->maxWidth;
- for (i = argc ; i > 0; i--, argv++, prevPtr = newPtr) {
- length = strlen(*argv);
- newPtr = (Element *) ckalloc(ElementSize(length));
- newPtr->textLength = length;
- strcpy(newPtr->text, *argv);
- newPtr->pixelWidth = Tk_TextWidth(listPtr->tkfont, newPtr->text,
- newPtr->textLength);
- newPtr->lBearing = 0;
- if (newPtr->pixelWidth > listPtr->maxWidth) {
- listPtr->maxWidth = newPtr->pixelWidth;
- }
- newPtr->selected = 0;
- if (prevPtr == NULL) {
- newPtr->nextPtr = listPtr->firstPtr;
- listPtr->firstPtr = newPtr;
- } else {
- newPtr->nextPtr = prevPtr->nextPtr;
- prevPtr->nextPtr = newPtr;
+ /* Set the internal pointer to the new obj */
+ listPtr->listObj = newListObj;
+
+ /* If there is a listvar, make sure it points at the new object */
+ if (listPtr->listVarName != NULL) {
+ if (Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName,
+ (char *)NULL, newListObj, TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_DecrRefCount(newListObj);
+ return TCL_ERROR;
}
}
- if ((prevPtr != NULL) && (prevPtr->nextPtr == NULL)) {
- listPtr->lastPtr = prevPtr;
- }
- listPtr->numElements += argc;
+ /* Get the new list length */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
/*
- * Update the selection and other indexes to account for the
- * renumbering that has just occurred. Then arrange for the new
+ * Update the "special" indices (anchor, topIndex, active) to account
+ * for the renumbering that just occurred. Then arrange for the new
* information to be displayed.
*/
if (index <= listPtr->selectAnchor) {
- listPtr->selectAnchor += argc;
+ listPtr->selectAnchor += objc;
}
if (index < listPtr->topIndex) {
- listPtr->topIndex += argc;
+ listPtr->topIndex += objc;
}
if (index <= listPtr->active) {
- listPtr->active += argc;
- if ((listPtr->active >= listPtr->numElements)
- && (listPtr->numElements > 0)) {
- listPtr->active = listPtr->numElements-1;
+ listPtr->active += objc;
+ if ((listPtr->active >= listPtr->nElements) &&
+ (listPtr->nElements > 0)) {
+ listPtr->active = listPtr->nElements-1;
}
}
listPtr->flags |= UPDATE_V_SCROLLBAR;
@@ -1483,35 +1825,43 @@ InsertEls(listPtr, index, argc, argv)
listPtr->flags |= UPDATE_H_SCROLLBAR;
}
ListboxComputeGeometry(listPtr, 0, 0, 0);
- ListboxRedrawRange(listPtr, index, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, index, listPtr->nElements-1);
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * DeleteEls --
+ * ListboxDeleteSubCmd --
*
- * Remove one or more elements from a listbox widget.
+ * Process a listbox "delete" subcommand by removing one or more
+ * elements from a listbox widget.
*
* Results:
- * None.
+ * Standard Tcl result.
*
* Side effects:
- * Memory gets freed, the listbox gets modified and (eventually)
- * redisplayed.
+ * The listbox will be modified and (eventually) redisplayed.
*
*----------------------------------------------------------------------
*/
-static void
-DeleteEls(listPtr, first, last)
+static int
+ListboxDeleteSubCmd(listPtr, first, last)
register Listbox *listPtr; /* Listbox widget to modify. */
int first; /* Index of first element to delete. */
int last; /* Index of last element to delete. */
{
- register Element *prevPtr, *elPtr;
int count, i, widthChanged;
-
+ Tcl_Obj *newListObj;
+ Tcl_Obj *element;
+ int length;
+ char *stringRep;
+ int new;
+ int result;
+ int pixelWidth;
+ Tcl_HashEntry *entry;
+
/*
* Adjust the range to fit within the existing elements of the
* listbox, and make sure there's something to delete.
@@ -1520,54 +1870,84 @@ DeleteEls(listPtr, first, last)
if (first < 0) {
first = 0;
}
- if (last >= listPtr->numElements) {
- last = listPtr->numElements-1;
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements-1;
}
count = last + 1 - first;
if (count <= 0) {
- return;
+ return TCL_OK;
}
/*
- * Find the element just before the ones to delete.
+ * Foreach deleted index we must:
+ * a) remove selection information
+ * b) check the width of the element; if it is equal to the max, set
+ * widthChanged to 1, because it may be the only element with that
+ * width
*/
-
- if (first == 0) {
- prevPtr = NULL;
- } else {
- for (i = first-1, prevPtr = listPtr->firstPtr; i > 0; i--) {
- prevPtr = prevPtr->nextPtr;
+ widthChanged = 0;
+ for (i = first; i <= last; i++) {
+ /* Remove selection information */
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ listPtr->numSelected--;
+ Tcl_DeleteHashEntry(entry);
}
- }
- /*
- * Delete the requested number of elements.
- */
-
- widthChanged = 0;
- for (i = count; i > 0; i--) {
- if (prevPtr == NULL) {
- elPtr = listPtr->firstPtr;
- listPtr->firstPtr = elPtr->nextPtr;
- if (listPtr->firstPtr == NULL) {
- listPtr->lastPtr = NULL;
- }
- } else {
- elPtr = prevPtr->nextPtr;
- prevPtr->nextPtr = elPtr->nextPtr;
- if (prevPtr->nextPtr == NULL) {
- listPtr->lastPtr = prevPtr;
+ /* Check width of the element. We only have to check if widthChanged
+ * has not already been set to 1, because we only need one maxWidth
+ * element to disappear for us to have to recompute the width
+ */
+ if (widthChanged == 0) {
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &element);
+ stringRep = Tcl_GetStringFromObj(element, &length);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
+ if (pixelWidth == listPtr->maxWidth) {
+ widthChanged = 1;
}
}
- if (elPtr->pixelWidth == listPtr->maxWidth) {
- widthChanged = 1;
+ }
+
+ /* Next, for every index greater than the lastIndex, if there is selection
+ * information for that index, relocate it down by count steps */
+ for (i = last + 1; i < listPtr->nElements; i++) {
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ Tcl_DeleteHashEntry(entry);
+ Tcl_CreateHashEntry(listPtr->selection, (char *)(i - count), &new);
}
- if (elPtr->selected) {
- listPtr->numSelected -= 1;
+ }
+
+ /* Delete the requested elements */
+ if (Tcl_IsShared(listPtr->listObj)) {
+ newListObj = Tcl_DuplicateObj(listPtr->listObj);
+ } else {
+ newListObj = listPtr->listObj;
+ }
+ result = Tcl_ListObjReplace(listPtr->interp,
+ newListObj, first, count, 0, NULL);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_IncrRefCount(newListObj);
+ /* Clean up the old reference */
+ Tcl_DecrRefCount(listPtr->listObj);
+
+ /* Set the internal pointer to the new obj */
+ listPtr->listObj = newListObj;
+
+ /* Get the new list length */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ /* If there is a listvar, make sure it points at the new object */
+ if (listPtr->listVarName != NULL) {
+ if (Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName,
+ (char *)NULL, newListObj, TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_DecrRefCount(newListObj);
+ return TCL_ERROR;
}
- ckfree((char *) elPtr);
}
- listPtr->numElements -= count;
/*
* Update the selection and viewing information to reflect the change
@@ -1587,8 +1967,8 @@ DeleteEls(listPtr, first, last)
listPtr->topIndex = first;
}
}
- if (listPtr->topIndex > (listPtr->numElements - listPtr->fullLines)) {
- listPtr->topIndex = listPtr->numElements - listPtr->fullLines;
+ if (listPtr->topIndex > (listPtr->nElements - listPtr->fullLines)) {
+ listPtr->topIndex = listPtr->nElements - listPtr->fullLines;
if (listPtr->topIndex < 0) {
listPtr->topIndex = 0;
}
@@ -1597,9 +1977,9 @@ DeleteEls(listPtr, first, last)
listPtr->active -= count;
} else if (listPtr->active >= first) {
listPtr->active = first;
- if ((listPtr->active >= listPtr->numElements)
- && (listPtr->numElements > 0)) {
- listPtr->active = listPtr->numElements-1;
+ if ((listPtr->active >= listPtr->nElements) &&
+ (listPtr->nElements > 0)) {
+ listPtr->active = listPtr->nElements-1;
}
}
listPtr->flags |= UPDATE_V_SCROLLBAR;
@@ -1607,7 +1987,8 @@ DeleteEls(listPtr, first, last)
if (widthChanged) {
listPtr->flags |= UPDATE_H_SCROLLBAR;
}
- ListboxRedrawRange(listPtr, first, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, first, listPtr->nElements-1);
+ return TCL_OK;
}
/*
@@ -1634,9 +2015,9 @@ ListboxEventProc(clientData, eventPtr)
XEvent *eventPtr; /* Information about event. */
{
Listbox *listPtr = (Listbox *) clientData;
-
+
if (eventPtr->type == Expose) {
- ListboxRedrawRange(listPtr,
+ EventuallyRedrawRange(listPtr,
NearestListboxElement(listPtr, eventPtr->xexpose.y),
NearestListboxElement(listPtr, eventPtr->xexpose.y
+ eventPtr->xexpose.height));
@@ -1673,16 +2054,16 @@ ListboxEventProc(clientData, eventPtr)
* everything for safety.
*/
- ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
} else if (eventPtr->type == FocusIn) {
if (eventPtr->xfocus.detail != NotifyInferior) {
listPtr->flags |= GOT_FOCUS;
- ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}
} else if (eventPtr->type == FocusOut) {
if (eventPtr->xfocus.detail != NotifyInferior) {
listPtr->flags &= ~GOT_FOCUS;
- ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}
}
}
@@ -1748,61 +2129,86 @@ ListboxCmdDeletedProc(clientData)
*/
static int
-GetListboxIndex(interp, listPtr, string, endIsSize, indexPtr)
+GetListboxIndex(interp, listPtr, indexObj, endIsSize, indexPtr)
Tcl_Interp *interp; /* For error messages. */
Listbox *listPtr; /* Listbox for which the index is being
* specified. */
- char *string; /* Specifies an element in the listbox. */
+ Tcl_Obj *indexObj; /* Specifies an element in the listbox. */
int endIsSize; /* If 1, "end" refers to the number of
* entries in the listbox. If 0, "end"
* refers to 1 less than the number of
* entries. */
int *indexPtr; /* Where to store converted index. */
{
- int c;
- size_t length;
-
- length = strlen(string);
- c = string[0];
- if ((c == 'a') && (strncmp(string, "active", length) == 0)
- && (length >= 2)) {
- *indexPtr = listPtr->active;
- } else if ((c == 'a') && (strncmp(string, "anchor", length) == 0)
- && (length >= 2)) {
- *indexPtr = listPtr->selectAnchor;
- } else if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
- if (endIsSize) {
- *indexPtr = listPtr->numElements;
- } else {
- *indexPtr = listPtr->numElements - 1;
- }
- } else if (c == '@') {
- int y;
- char *p, *end;
+ int result;
+ int index;
+ char *stringRep;
+
+ /* First see if the index is one of the named indices */
+ result = Tcl_GetIndexFromObj(NULL, indexObj, indexNames, "", 0, &index);
+ if (result == TCL_OK) {
+ switch (index) {
+ case INDEX_ACTIVE: {
+ /* "active" index */
+ *indexPtr = listPtr->active;
+ break;
+ }
+
+ case INDEX_ANCHOR: {
+ /* "anchor" index */
+ *indexPtr = listPtr->selectAnchor;
+ break;
+ }
- p = string+1;
- strtol(p, &end, 0);
- if ((end == p) || (*end != ',')) {
- goto badIndex;
+ case INDEX_END: {
+ /* "end" index */
+ if (endIsSize) {
+ *indexPtr = listPtr->nElements;
+ } else {
+ *indexPtr = listPtr->nElements - 1;
+ }
+ break;
+ }
}
- p = end+1;
- y = strtol(p, &end, 0);
- if ((end == p) || (*end != 0)) {
- goto badIndex;
+ return TCL_OK;
+ }
+
+ /* The index didn't match any of the named indices; maybe it's an @x,y */
+ stringRep = Tcl_GetString(indexObj);
+ if (stringRep[0] == '@') {
+ /* @x,y index */
+ int y;
+ char *start, *end;
+ start = stringRep + 1;
+ strtol(start, &end, 0);
+ if ((start == end) || (*end != ',')) {
+ Tcl_AppendResult(interp, "bad listbox index \"", stringRep,
+ "\": must be active, anchor, end, @x,y, or a "
+ "number", (char *)NULL);
+ return TCL_ERROR;
+ }
+ start = end+1;
+ y = strtol(start, &end, 0);
+ if ((start == end) || (*end != '\0')) {
+ Tcl_AppendResult(interp, "bad listbox index \"", stringRep,
+ "\": must be active, anchor, end, @x,y, or a "
+ "number", (char *)NULL);
+ return TCL_ERROR;
}
*indexPtr = NearestListboxElement(listPtr, y);
- } else {
- if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
- Tcl_ResetResult(interp);
- goto badIndex;
- }
+ return TCL_OK;
+ }
+
+ /* Maybe the index is just an integer */
+ if (Tcl_GetIntFromObj(interp, indexObj, indexPtr) == TCL_OK) {
+ return TCL_OK;
}
- return TCL_OK;
- badIndex:
- Tcl_AppendResult(interp, "bad listbox index \"", string,
- "\": must be active, anchor, end, @x,y, or a number",
- (char *) NULL);
+ /* Everything failed, nothing matched. Throw up an error message */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad listbox index \"",
+ Tcl_GetString(indexObj), "\": must be active, anchor, ",
+ "end, @x,y, or a number", (char *) NULL);
return TCL_ERROR;
}
@@ -1832,18 +2238,15 @@ ChangeListboxView(listPtr, index)
* that should now appear at the
* top of the listbox. */
{
- if (index >= (listPtr->numElements - listPtr->fullLines)) {
- index = listPtr->numElements - listPtr->fullLines;
+ if (index >= (listPtr->nElements - listPtr->fullLines)) {
+ index = listPtr->nElements - listPtr->fullLines;
}
if (index < 0) {
index = 0;
}
if (listPtr->topIndex != index) {
listPtr->topIndex = index;
- if (!(listPtr->flags & REDRAW_PENDING)) {
- Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
- listPtr->flags |= REDRAW_PENDING;
- }
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
listPtr->flags |= UPDATE_V_SCROLLBAR;
}
}
@@ -1872,7 +2275,7 @@ ChangeListboxOffset(listPtr, offset)
* listbox. */
{
int maxOffset;
-
+
/*
* Make sure that the new offset is within the allowable range, and
* round it off to an even multiple of xScrollUnit.
@@ -1891,7 +2294,7 @@ ChangeListboxOffset(listPtr, offset)
if (offset != listPtr->xOffset) {
listPtr->xOffset = offset;
listPtr->flags |= UPDATE_H_SCROLLBAR;
- ListboxRedrawRange(listPtr, 0, listPtr->numElements);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}
}
@@ -1921,8 +2324,8 @@ ListboxScanTo(listPtr, x, y)
* operation. */
{
int newTopIndex, newOffset, maxIndex, maxOffset;
-
- maxIndex = listPtr->numElements - listPtr->fullLines;
+
+ maxIndex = listPtr->nElements - listPtr->fullLines;
maxOffset = listPtr->maxWidth + (listPtr->xScrollUnit - 1)
- (Tk_Width(listPtr->tkwin) - 2*listPtr->inset
- 2*listPtr->selBorderWidth - listPtr->xScrollUnit);
@@ -2000,8 +2403,8 @@ NearestListboxElement(listPtr, y)
index = 0;
}
index += listPtr->topIndex;
- if (index >= listPtr->numElements) {
- index = listPtr->numElements-1;
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements-1;
}
return index;
}
@@ -2014,7 +2417,7 @@ NearestListboxElement(listPtr, y)
* Select or deselect one or more elements in a listbox..
*
* Results:
- * None.
+ * Standard Tcl result.
*
* Side effects:
* All of the elements in the range between first and last are
@@ -2026,7 +2429,7 @@ NearestListboxElement(listPtr, y)
*----------------------------------------------------------------------
*/
-static void
+static int
ListboxSelect(listPtr, first, last, select)
register Listbox *listPtr; /* Information about widget. */
int first; /* Index of first element to
@@ -2037,47 +2440,62 @@ ListboxSelect(listPtr, first, last, select)
* deselect them. */
{
int i, firstRedisplay, increment, oldCount;
- Element *elPtr;
-
+ Tcl_HashEntry *entry;
+ int new;
+
if (last < first) {
i = first;
first = last;
last = i;
}
- if ((last < 0) || (first >= listPtr->numElements)) {
- return;
+ if ((last < 0) || (first >= listPtr->nElements)) {
+ return TCL_OK;
}
if (first < 0) {
first = 0;
}
- if (last >= listPtr->numElements) {
- last = listPtr->numElements - 1;
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
}
oldCount = listPtr->numSelected;
firstRedisplay = -1;
increment = select ? 1 : -1;
- for (i = 0, elPtr = listPtr->firstPtr; i < first;
- i++, elPtr = elPtr->nextPtr) {
- /* Empty loop body. */
- }
- for ( ; i <= last; i++, elPtr = elPtr->nextPtr) {
- if (elPtr->selected == select) {
- continue;
- }
- listPtr->numSelected += increment;
- elPtr->selected = select;
- if (firstRedisplay < 0) {
- firstRedisplay = i;
+
+ /*
+ * For each index in the range, find it in our selection hash table.
+ * If it's not there but should be, add it. If it's there but shouldn't
+ * be, remove it.
+ */
+ for (i = first; i <= last; i++) {
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ if (!select) {
+ Tcl_DeleteHashEntry(entry);
+ listPtr->numSelected--;
+ if (firstRedisplay < 0) {
+ firstRedisplay = i;
+ }
+ }
+ } else {
+ if (select) {
+ Tcl_CreateHashEntry(listPtr->selection, (char *)i, &new);
+ listPtr->numSelected++;
+ if (firstRedisplay < 0) {
+ firstRedisplay = i;
+ }
+ }
}
}
+
if (firstRedisplay >= 0) {
- ListboxRedrawRange(listPtr, first, last);
+ EventuallyRedrawRange(listPtr, first, last);
}
if ((oldCount == 0) && (listPtr->numSelected > 0)
&& (listPtr->exportSelection)) {
Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
(ClientData) listPtr);
}
+ return TCL_OK;
}
/*
@@ -2115,10 +2533,14 @@ ListboxFetchSelection(clientData, offset, buffer, maxBytes)
* NULL character. */
{
register Listbox *listPtr = (Listbox *) clientData;
- register Element *elPtr;
Tcl_DString selection;
int length, count, needNewline;
-
+ Tcl_Obj *curElement;
+ char *stringRep;
+ int stringLen;
+ Tcl_HashEntry *entry;
+ int i;
+
if (!listPtr->exportSelection) {
return -1;
}
@@ -2129,12 +2551,16 @@ ListboxFetchSelection(clientData, offset, buffer, maxBytes)
needNewline = 0;
Tcl_DStringInit(&selection);
- for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) {
- if (elPtr->selected) {
+ for (i = 0; i < listPtr->nElements; i++) {
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
if (needNewline) {
Tcl_DStringAppend(&selection, "\n", 1);
}
- Tcl_DStringAppend(&selection, elPtr->text, elPtr->textLength);
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
+ &curElement);
+ stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
+ Tcl_DStringAppend(&selection, stringRep, stringLen);
needNewline = 1;
}
}
@@ -2187,16 +2613,16 @@ ListboxLostSelection(clientData)
ClientData clientData; /* Information about listbox widget. */
{
register Listbox *listPtr = (Listbox *) clientData;
-
- if ((listPtr->exportSelection) && (listPtr->numElements > 0)) {
- ListboxSelect(listPtr, 0, listPtr->numElements-1, 0);
+
+ if ((listPtr->exportSelection) && (listPtr->nElements > 0)) {
+ ListboxSelect(listPtr, 0, listPtr->nElements-1, 0);
}
}
/*
*----------------------------------------------------------------------
*
- * ListboxRedrawRange --
+ * EventuallyRedrawRange --
*
* Ensure that a given range of elements is eventually redrawn on
* the display (if those elements in fact appear on the display).
@@ -2212,7 +2638,7 @@ ListboxLostSelection(clientData)
/* ARGSUSED */
static void
-ListboxRedrawRange(listPtr, first, last)
+EventuallyRedrawRange(listPtr, first, last)
register Listbox *listPtr; /* Information about widget. */
int first; /* Index of first element in list
* that needs to be redrawn. */
@@ -2221,12 +2647,15 @@ ListboxRedrawRange(listPtr, first, last)
* be less than first;
* these just bracket a range. */
{
- if ((listPtr->tkwin == NULL) || !Tk_IsMapped(listPtr->tkwin)
- || (listPtr->flags & REDRAW_PENDING)) {
+ /* We don't have to register a redraw callback if one is already pending,
+ * or if the window doesn't exist, or if the window isn't mapped */
+ if ((listPtr->flags & REDRAW_PENDING)
+ || (listPtr->tkwin == NULL)
+ || !Tk_IsMapped(listPtr->tkwin)) {
return;
}
- Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
listPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
}
/*
@@ -2257,17 +2686,17 @@ ListboxUpdateVScrollbar(listPtr)
double first, last;
int result;
Tcl_Interp *interp;
-
+
if (listPtr->yScrollCmd == NULL) {
return;
}
- if (listPtr->numElements == 0) {
+ if (listPtr->nElements == 0) {
first = 0.0;
last = 1.0;
} else {
- first = listPtr->topIndex/((double) listPtr->numElements);
+ first = listPtr->topIndex/((double) listPtr->nElements);
last = (listPtr->topIndex+listPtr->fullLines)
- /((double) listPtr->numElements);
+ /((double) listPtr->nElements);
if (last > 1.0) {
last = 1.0;
}
@@ -2354,3 +2783,68 @@ ListboxUpdateHScrollbar(listPtr)
}
Tcl_Release((ClientData) interp);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxListVarProc --
+ *
+ * Called whenever the trace on the listbox list var fires.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ListboxListVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Not used. */
+ char *name2; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ Listbox *listPtr = (Listbox *)clientData;
+ Tcl_Obj *oldListObj;
+
+ /* Bwah hahahaha -- puny mortal, you can't unset a -listvar'd variable! */
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar2Ex(interp, listPtr->listVarName,
+ (char *)NULL, listPtr->listObj, TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, clientData);
+ return (char *)NULL;
+ }
+ } else {
+ oldListObj = listPtr->listObj;
+ /* Make sure the internal pointer points to the correct object */
+ listPtr->listObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName,
+ (char *)NULL, TCL_GLOBAL_ONLY);
+ /* Incr the obj ref count so it doesn't vanish if the var is unset */
+ Tcl_IncrRefCount(listPtr->listObj);
+ /* Clean up the ref to our old list obj */
+ Tcl_DecrRefCount(oldListObj);
+ }
+
+ /* Get the list length */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ /*
+ * The computed maxWidth may have changed as a result of this operation.
+ * However, we don't want to recompute it every time this trace fires
+ * (imagine the user doing 1000 lappends to the listvar). Therefore, set
+ * the MAXWIDTH_IS_STALE flag, which will cause the width to be recomputed
+ * next time the list is redrawn.
+ */
+ listPtr->flags |= MAXWIDTH_IS_STALE;
+
+ EventuallyRedrawRange(clientData, 0, listPtr->nElements-1);
+ return (char*)NULL;
+}
+
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 20674ba..1c61446 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkWindow.c,v 1.10 1999/10/29 03:57:57 hobbs Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.11 1999/11/17 02:38:28 ericm Exp $
*/
#include "tkPort.h"
@@ -139,7 +139,7 @@ static TkCmd commands[] = {
{"entry", NULL, Tk_EntryObjCmd, 1, 0},
{"frame", Tk_FrameCmd, NULL, 1, 1},
{"label", NULL, Tk_LabelObjCmd, 1, 0},
- {"listbox", Tk_ListboxCmd, NULL, 1, 1},
+ {"listbox", NULL, Tk_ListboxObjCmd, 1, 0},
{"menubutton", NULL, Tk_MenubuttonObjCmd, 1, 0},
{"message", Tk_MessageCmd, NULL, 1, 1},
{"radiobutton", NULL, Tk_RadiobuttonObjCmd, 1, 0},