diff options
Diffstat (limited to 'generic/tkListbox.c')
| -rw-r--r-- | generic/tkListbox.c | 2531 |
1 files changed, 1310 insertions, 1221 deletions
diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 103cd9d..d803d7b 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -1,18 +1,17 @@ -/* +/* * tkListbox.c -- * - * This module implements listbox widgets for the Tk - * toolkit. A listbox displays a collection of strings, - * one per line, and provides scrolling and selection. + * This module implements listbox widgets for the Tk toolkit. A listbox + * displays a collection of strings, one per line, and provides scrolling + * and selection. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tkPort.h" #include "default.h" #include "tkInt.h" @@ -21,38 +20,40 @@ #endif typedef struct { - Tk_OptionTable listboxOptionTable; /* Table defining configuration options - * available for the listbox */ - Tk_OptionTable itemAttrOptionTable; /* Table definining configuration - * options available for listbox - * items */ + Tk_OptionTable listboxOptionTable; + /* Table defining configuration options + * available for the listbox. */ + Tk_OptionTable itemAttrOptionTable; + /* Table definining configuration options + * available for listbox items. */ } ListboxOptionTables; /* - * A data structure of the following type is kept for each listbox - * widget managed by this file: + * A data structure of the following type is kept for each listbox widget + * managed by this file: */ typedef struct { - Tk_Window tkwin; /* Window that embodies the listbox. NULL + Tk_Window tkwin; /* Window that embodies the listbox. NULL * means that the window has been destroyed * but the data structures haven't yet been - * cleaned up.*/ - Display *display; /* Display containing widget. Used, among + * cleaned up. */ + Display *display; /* Display containing widget. Used, among * other things, so that resources can be * freed even after tkwin has gone away. */ Tcl_Interp *interp; /* Interpreter associated with listbox. */ Tcl_Command widgetCmd; /* Token for listbox's widget command. */ Tk_OptionTable optionTable; /* Table that defines configuration options * available for this widget. */ - Tk_OptionTable itemAttrOptionTable; /* Table that defines configuration - * options available for listbox - * items */ - 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 */ - Tcl_HashTable *itemAttrTable; /* Tracks item attributes */ + Tk_OptionTable itemAttrOptionTable; + /* Table that defines configuration options + * available for listbox items. */ + 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 */ + Tcl_HashTable *itemAttrTable; + /* Tracks item attributes */ /* * Information used when displaying widget: @@ -62,18 +63,18 @@ typedef struct { * window, plus used for background. */ int borderWidth; /* Width of 3-D border around window. */ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */ - int highlightWidth; /* Width in pixels of highlight to draw - * around widget when it has the focus. - * <= 0 means don't draw a highlight. */ + int highlightWidth; /* Width in pixels of highlight to draw around + * widget when it has the focus. <= 0 means + * don't draw a highlight. */ XColor *highlightBgColorPtr; - /* Color for drawing traversal highlight - * area when highlight is off. */ + /* Color for drawing traversal highlight area + * when highlight is off. */ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */ int inset; /* Total width of all borders, including * traversal highlight and 3-D border. - * Indicates how much interior stuff must - * be offset from outside edges to leave - * room for borders. */ + * Indicates how much interior stuff must be + * offset from outside edges to leave room for + * borders. */ Tk_Font tkfont; /* Information about text font, or NULL. */ XColor *fgColorPtr; /* Text color in normal mode. */ XColor *dfgColorPtr; /* Text color in disabled mode. */ @@ -85,20 +86,20 @@ typedef struct { GC selTextGC; /* For drawing selected text. */ int width; /* Desired width of window, in characters. */ int height; /* Desired height of window, in lines. */ - int lineHeight; /* Number of pixels allocated for each line - * in display. */ + int lineHeight; /* Number of pixels allocated for each line in + * display. */ int topIndex; /* Index of top-most element visible in * window. */ int fullLines; /* Number of lines that fit are completely - * visible in window. There may be one + * visible in window. There may be one * additional line at the bottom that is * partially visible. */ int partialLine; /* 0 means that the window holds exactly - * fullLines lines. 1 means that there is - * one additional line that is partially + * fullLines lines. 1 means that there is one + * additional line that is partially * visble. */ - int setGrid; /* Non-zero means pass gridding information - * to window manager. */ + int setGrid; /* Non-zero means pass gridding information to + * window manager. */ /* * Information to support horizontal scrolling: @@ -110,26 +111,26 @@ typedef struct { * horizontal scrolling (window scrolls * horizontally in increments of this size). * This is an average character size. */ - int xOffset; /* The left edge of each string in the - * listbox is offset to the left by this - * many pixels (0 means no offset, positive - * means there is an offset). */ + int xOffset; /* The left edge of each string in the listbox + * is offset to the left by this many pixels + * (0 means no offset, positive means there is + * an offset). */ /* * Information about what's selected or active, if any. */ Tk_Uid selectMode; /* Selection style: single, browse, multiple, - * or extended. This value isn't used in C + * or extended. This value isn't used in C * code, but the Tcl bindings use it. */ int numSelected; /* Number of elements currently selected. */ - int selectAnchor; /* Fixed end of selection (i.e. element - * at which selection was started.) */ - int exportSelection; /* Non-zero means tie internal listbox - * to X selection. */ - int active; /* Index of "active" element (the one that - * has been selected by keyboard traversal). - * -1 means none. */ + int selectAnchor; /* Fixed end of selection (i.e. element at + * which selection was started.) */ + int exportSelection; /* Non-zero means tie internal listbox to X + * selection. */ + int active; /* Index of "active" element (the one that has + * been selected by keyboard traversal). -1 + * means none. */ int activeStyle; /* style in which to draw the active element. * One of: underline, none, dotbox */ @@ -151,18 +152,18 @@ typedef struct { */ Tk_Cursor cursor; /* Current cursor for window, or None. */ - char *takeFocus; /* Value of -takefocus option; not used in - * the C code, but used by keyboard traversal - * scripts. Malloc'ed, but may be NULL. */ + char *takeFocus; /* Value of -takefocus option; not used in the + * C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ char *yScrollCmd; /* Command prefix for communicating with - * vertical scrollbar. NULL means no command - * to issue. Malloc'ed. */ + * vertical scrollbar. NULL means no command + * to issue. Malloc'ed. */ char *xScrollCmd; /* Command prefix for communicating with - * horizontal scrollbar. NULL means no command - * to issue. Malloc'ed. */ + * horizontal scrollbar. NULL means no command + * to issue. Malloc'ed. */ int state; /* Listbox state. */ Pixmap gray; /* Pixmap for displaying disabled text. */ - int flags; /* Various flag bits: see below for + int flags; /* Various flag bits: see below for * definitions. */ } Listbox; @@ -170,26 +171,26 @@ typedef struct { * ItemAttr structures are used to store item configuration information for * the items in a listbox */ + typedef struct { Tk_3DBorder border; /* Used for drawing background around text */ Tk_3DBorder selBorder; /* Used for selected text */ XColor *fgColor; /* Text color in normal mode. */ XColor *selFgColor; /* Text color in selected mode. */ -} ItemAttr; +} ItemAttr; /* * Flag bits for listboxes: * - * REDRAW_PENDING: Non-zero means a DoWhenIdle handler - * has already been queued to redraw - * this window. - * UPDATE_V_SCROLLBAR: Non-zero means vertical scrollbar needs - * to be updated. - * UPDATE_H_SCROLLBAR: Non-zero means horizontal scrollbar needs - * 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 + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has + * already been queued to redraw this window. + * UPDATE_V_SCROLLBAR: Non-zero means vertical scrollbar needs to be + * updated. + * UPDATE_H_SCROLLBAR: Non-zero means horizontal scrollbar needs 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 * LISTBOX_DELETED: This listbox has been effectively destroyed. */ @@ -201,42 +202,43 @@ typedef struct { #define LISTBOX_DELETED 32 /* - * The following enum is used to define a type for the -state option - * of the Entry widget. These values are used as indices into the - * string table below. + * The following enum is used to define a type for the -state option of the + * Listbox widget. These values are used as indices into the string table + * below. */ enum state { STATE_DISABLED, STATE_NORMAL }; -static CONST char *CONST stateStrings[] = { - "disabled", "normal", (char *) NULL +static const char *const stateStrings[] = { + "disabled", "normal", NULL }; enum activeStyle { ACTIVE_STYLE_DOTBOX, ACTIVE_STYLE_NONE, ACTIVE_STYLE_UNDERLINE }; -static CONST char *CONST activeStyleStrings[] = { - "dotbox", "none", "underline", (char *) NULL +static const char *const activeStyleStrings[] = { + "dotbox", "none", "underline", NULL }; /* * The optionSpecs table defines the valid configuration options for the - * listbox widget + * listbox widget. */ -static CONST Tk_OptionSpec optionSpecs[] = { + +static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_STRING_TABLE, "-activestyle", "activeStyle", "ActiveStyle", DEF_LISTBOX_ACTIVE_STYLE, -1, Tk_Offset(Listbox, activeStyle), - 0, (ClientData) activeStyleStrings, 0}, + 0, (ClientData) activeStyleStrings, 0}, {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_SYNONYM, "-bd", NULL, NULL, + NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", NULL, NULL, + 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}, @@ -249,8 +251,8 @@ static CONST Tk_OptionSpec optionSpecs[] = { {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_SYNONYM, "-fg", "foreground", NULL, + 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", @@ -258,7 +260,7 @@ static CONST Tk_OptionSpec optionSpecs[] = { {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, + "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), @@ -283,8 +285,8 @@ static CONST Tk_OptionSpec optionSpecs[] = { {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid", DEF_LISTBOX_SET_GRID, -1, Tk_Offset(Listbox, setGrid), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", - DEF_LISTBOX_STATE, -1, Tk_Offset(Listbox, state), - 0, (ClientData) stateStrings, 0}, + DEF_LISTBOX_STATE, -1, Tk_Offset(Listbox, state), + 0, (ClientData) stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_LISTBOX_TAKE_FOCUS, -1, Tk_Offset(Listbox, takeFocus), TK_OPTION_NULL_OK, 0, 0}, @@ -299,50 +301,48 @@ static CONST Tk_OptionSpec optionSpecs[] = { {TK_OPTION_STRING, "-listvariable", "listVariable", "Variable", 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} + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0} }; /* * The itemAttrOptionSpecs table defines the valid configuration options for * listbox items */ -static CONST Tk_OptionSpec itemAttrOptionSpecs[] = { + +static const Tk_OptionSpec itemAttrOptionSpecs[] = { {TK_OPTION_BORDER, "-background", "background", "Background", - (char *)NULL, -1, Tk_Offset(ItemAttr, border), + NULL, -1, Tk_Offset(ItemAttr, border), TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, (ClientData) DEF_LISTBOX_BG_MONO, 0}, - {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, - (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, - {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + {TK_OPTION_SYNONYM, "-bg", NULL, NULL, + NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, + NULL, 0, -1, 0, (ClientData) "-foreground", 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", - (char *) NULL, -1, Tk_Offset(ItemAttr, fgColor), + NULL, -1, Tk_Offset(ItemAttr, fgColor), TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0}, {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground", - (char *) NULL, -1, Tk_Offset(ItemAttr, selBorder), + NULL, -1, Tk_Offset(ItemAttr, selBorder), TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, (ClientData) DEF_LISTBOX_SELECT_MONO, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", - (char *) NULL, -1, Tk_Offset(ItemAttr, selFgColor), + NULL, -1, Tk_Offset(ItemAttr, selFgColor), TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0}, - {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, -1, 0, 0, 0} + {TK_OPTION_END, NULL, NULL, NULL, 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. + * 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 CONST char *commandNames[] = { + +static const char *commandNames[] = { "activate", "bbox", "cget", "configure", "curselection", "delete", "get", "index", "insert", "itemcget", "itemconfigure", "nearest", "scan", - "see", "selection", "size", "xview", "yview", - (char *) NULL + "see", "selection", "size", "xview", "yview", NULL }; - enum command { COMMAND_ACTIVATE, COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_CURSELECTION, COMMAND_DELETE, COMMAND_GET, COMMAND_INDEX, @@ -351,99 +351,84 @@ enum command { COMMAND_SIZE, COMMAND_XVIEW, COMMAND_YVIEW }; -static CONST char *selCommandNames[] = { - "anchor", "clear", "includes", "set", (char *) NULL +static const char *selCommandNames[] = { + "anchor", "clear", "includes", "set", NULL }; - enum selcommand { SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET }; -static CONST char *scanCommandNames[] = { - "mark", "dragto", (char *) NULL +static const char *scanCommandNames[] = { + "mark", "dragto", NULL }; - enum scancommand { SCAN_MARK, SCAN_DRAGTO }; -static CONST char *indexNames[] = { - "active", "anchor", "end", (char *)NULL +static const char *indexNames[] = { + "active", "anchor", "end", NULL }; - enum indices { INDEX_ACTIVE, INDEX_ANCHOR, INDEX_END }; +/* + * Declarations for procedures defined later in this file. + */ -/* Declarations for procedures defined later in this file */ -static void ChangeListboxOffset _ANSI_ARGS_((Listbox *listPtr, - int offset)); -static void ChangeListboxView _ANSI_ARGS_((Listbox *listPtr, - int index)); -static int ConfigureListbox _ANSI_ARGS_((Tcl_Interp *interp, - Listbox *listPtr, int objc, Tcl_Obj *CONST objv[], - int flags)); -static int ConfigureListboxItem _ANSI_ARGS_ ((Tcl_Interp *interp, +static void ChangeListboxOffset(Listbox *listPtr, int offset); +static void ChangeListboxView(Listbox *listPtr, int index); +static int ConfigureListbox(Tcl_Interp *interp, Listbox *listPtr, + int objc, Tcl_Obj *const objv[], int flags); +static int ConfigureListboxItem(Tcl_Interp *interp, Listbox *listPtr, ItemAttr *attrs, int objc, - Tcl_Obj *CONST objv[], int index)); -static int ListboxDeleteSubCmd _ANSI_ARGS_((Listbox *listPtr, - int first, int last)); -static void DestroyListbox _ANSI_ARGS_((char *memPtr)); -static void DestroyListboxOptionTables _ANSI_ARGS_ ( - (ClientData clientData, Tcl_Interp *interp)); -static void DisplayListbox _ANSI_ARGS_((ClientData clientData)); -static int GetListboxIndex _ANSI_ARGS_((Tcl_Interp *interp, - Listbox *listPtr, Tcl_Obj *index, int endIsSize, - int *indexPtr)); -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, - int fontChanged, int maxIsStale, int updateGrid)); -static void ListboxEventProc _ANSI_ARGS_((ClientData clientData, - XEvent *eventPtr)); -static int ListboxFetchSelection _ANSI_ARGS_(( - ClientData clientData, int offset, char *buffer, - int maxBytes)); -static void ListboxLostSelection _ANSI_ARGS_(( - ClientData clientData)); -static void EventuallyRedrawRange _ANSI_ARGS_((Listbox *listPtr, - int first, int last)); -static void ListboxScanTo _ANSI_ARGS_((Listbox *listPtr, - int x, int y)); -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 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 ItemAttr * ListboxGetItemAttributes _ANSI_ARGS_ ( - (Tcl_Interp *interp, Listbox *listPtr, int index)); -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, CONST char *name1, - CONST char *name2, int flags)); -static void MigrateHashEntries _ANSI_ARGS_ ((Tcl_HashTable *table, - int first, int last, int offset)); + Tcl_Obj *const objv[], int index); +static int ListboxDeleteSubCmd(Listbox *listPtr, + int first, int last); +static void DestroyListbox(char *memPtr); +static void DestroyListboxOptionTables(ClientData clientData, + Tcl_Interp *interp); +static void DisplayListbox(ClientData clientData); +static int GetListboxIndex(Tcl_Interp *interp, Listbox *listPtr, + Tcl_Obj *index, int endIsSize, int *indexPtr); +static int ListboxInsertSubCmd(Listbox *listPtr, + int index, int objc, Tcl_Obj *const objv[]); +static void ListboxCmdDeletedProc(ClientData clientData); +static void ListboxComputeGeometry(Listbox *listPtr, + int fontChanged, int maxIsStale, int updateGrid); +static void ListboxEventProc(ClientData clientData, + XEvent *eventPtr); +static int ListboxFetchSelection(ClientData clientData, + int offset, char *buffer, int maxBytes); +static void ListboxLostSelection(ClientData clientData); +static void EventuallyRedrawRange(Listbox *listPtr, + int first, int last); +static void ListboxScanTo(Listbox *listPtr, int x, int y); +static int ListboxSelect(Listbox *listPtr, + int first, int last, int select); +static void ListboxUpdateHScrollbar(Listbox *listPtr); +static void ListboxUpdateVScrollbar(Listbox *listPtr); +static int ListboxWidgetObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ListboxBboxSubCmd(Tcl_Interp *interp, + Listbox *listPtr, int index); +static int ListboxSelectionSubCmd(Tcl_Interp *interp, + Listbox *listPtr, int objc, Tcl_Obj *const objv[]); +static int ListboxXviewSubCmd(Tcl_Interp *interp, + Listbox *listPtr, int objc, Tcl_Obj *const objv[]); +static int ListboxYviewSubCmd(Tcl_Interp *interp, + Listbox *listPtr, int objc, Tcl_Obj *const objv[]); +static ItemAttr * ListboxGetItemAttributes(Tcl_Interp *interp, + Listbox *listPtr, int index); +static void ListboxWorldChanged(ClientData instanceData); +static int NearestListboxElement(Listbox *listPtr, int y); +static char * ListboxListVarProc(ClientData clientData, + Tcl_Interp *interp, const char *name1, + const char *name2, int flags); +static void MigrateHashEntries(Tcl_HashTable *table, + int first, int last, int offset); + /* * The structure below defines button class behavior by means of procedures * that can be invoked from generic window code. @@ -452,17 +437,17 @@ static void MigrateHashEntries _ANSI_ARGS_ ((Tcl_HashTable *table, static Tk_ClassProcs listboxClass = { sizeof(Tk_ClassProcs), /* size */ ListboxWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; - /* *-------------------------------------------------------------- * * Tk_ListboxObjCmd -- * - * This procedure is invoked to process the "listbox" Tcl - * command. See the user documentation for details on what - * it does. + * This procedure is invoked to process the "listbox" Tcl command. See + * the user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -474,11 +459,11 @@ static Tk_ClassProcs listboxClass = { */ int -Tk_ListboxObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* NULL. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tk_ListboxObjCmd( + ClientData clientData, /* NULL. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register Listbox *listPtr; Tk_Window tkwin; @@ -490,7 +475,7 @@ Tk_ListboxObjCmd(clientData, interp, objc, objv) } tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), - Tcl_GetString(objv[1]), (char *) NULL); + Tcl_GetString(objv[1]), NULL); if (tkwin == NULL) { return TCL_ERROR; } @@ -499,56 +484,64 @@ Tk_ListboxObjCmd(clientData, interp, objc, objv) Tcl_GetAssocData(interp, "ListboxOptionTables", NULL); if (optionTables == NULL) { /* - * We haven't created the option tables for this widget class yet. - * Do it now and save the a pointer to them as the ClientData for - * the command, so future invocations will have access to it. + * We haven't created the option tables for this widget class yet. Do + * it now and save the a pointer to them as the ClientData for the + * command, so future invocations will have access to it. */ optionTables = (ListboxOptionTables *) - ckalloc(sizeof(ListboxOptionTables)); - /* Set up an exit handler to free the optionTables struct */ + ckalloc(sizeof(ListboxOptionTables)); + + /* + * Set up an exit handler to free the optionTables struct. + */ + Tcl_SetAssocData(interp, "ListboxOptionTables", DestroyListboxOptionTables, (ClientData) optionTables); - /* Create the listbox option table and the listbox item option table */ + /* + * Create the listbox option table and the listbox item option table. + */ + optionTables->listboxOptionTable = - Tk_CreateOptionTable(interp, optionSpecs); + Tk_CreateOptionTable(interp, optionSpecs); optionTables->itemAttrOptionTable = - Tk_CreateOptionTable(interp, itemAttrOptionSpecs); + Tk_CreateOptionTable(interp, itemAttrOptionSpecs); } /* - * Initialize the fields of the structure that won't be initialized - * by ConfigureListbox, or that ConfigureListbox requires to be - * initialized already (e.g. resource pointers). + * Initialize the fields of the structure that won't be initialized by + * ConfigureListbox, or that ConfigureListbox requires to be initialized + * already (e.g. resource pointers). */ - listPtr = (Listbox *) ckalloc(sizeof(Listbox)); - memset((void *) listPtr, 0, (sizeof(Listbox))); - listPtr->tkwin = tkwin; - listPtr->display = Tk_Display(tkwin); - listPtr->interp = interp; - listPtr->widgetCmd = Tcl_CreateObjCommand(interp, + listPtr = (Listbox *) ckalloc(sizeof(Listbox)); + memset(listPtr, 0, (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->optionTable = optionTables->listboxOptionTable; - listPtr->itemAttrOptionTable = optionTables->itemAttrOptionTable; - listPtr->selection = - (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + listPtr->optionTable = optionTables->listboxOptionTable; + listPtr->itemAttrOptionTable = optionTables->itemAttrOptionTable; + listPtr->selection = (Tcl_HashTable *) + ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(listPtr->selection, TCL_ONE_WORD_KEYS); - listPtr->itemAttrTable = - (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + listPtr->itemAttrTable = (Tcl_HashTable *) + ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(listPtr->itemAttrTable, TCL_ONE_WORD_KEYS); - listPtr->relief = TK_RELIEF_RAISED; - listPtr->textGC = None; - listPtr->selFgColorPtr = None; - listPtr->selTextGC = None; - listPtr->fullLines = 1; - listPtr->xScrollUnit = 1; - listPtr->exportSelection = 1; - listPtr->cursor = None; - listPtr->state = STATE_NORMAL; - listPtr->gray = None; + listPtr->relief = TK_RELIEF_RAISED; + listPtr->textGC = None; + listPtr->selFgColorPtr = None; + listPtr->selTextGC = None; + listPtr->fullLines = 1; + listPtr->xScrollUnit = 1; + listPtr->exportSelection = 1; + listPtr->cursor = None; + listPtr->state = STATE_NORMAL; + listPtr->gray = None; /* * Keep a hold of the associated tkwin until we destroy the listbox, @@ -585,8 +578,8 @@ Tk_ListboxObjCmd(clientData, interp, objc, objv) * ListboxWidgetObjCmd -- * * 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. + * that corresponds to a widget managed by this module. See the user + * documentation for details on what it does. * * Results: * A standard Tcl result. @@ -598,25 +591,26 @@ Tk_ListboxObjCmd(clientData, interp, objc, objv) */ static int -ListboxWidgetObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Information about listbox widget. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Arguments as Tcl_Obj's. */ +ListboxWidgetObjCmd( + ClientData clientData, /* Information about listbox widget. */ + Tcl_Interp *interp, /* Current interpreter. */ + 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; - + if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } /* - * Parse the command by looking up the second argument in the list - * of valid subcommand names + * 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) { @@ -624,448 +618,436 @@ ListboxWidgetObjCmd(clientData, interp, objc, objv) } Tcl_Preserve((ClientData)listPtr); - /* 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 (!(listPtr->state & STATE_NORMAL)) { - break; - } + /* + * The subcommand was valid, so continue processing. + */ - 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; + 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; } - 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); + if (!(listPtr->state & STATE_NORMAL)) { break; } - case COMMAND_CGET: { - Tcl_Obj *objPtr; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option"); - result = TCL_ERROR; - 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; - 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; + case COMMAND_BBOX: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); + result = TCL_ERROR; 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); - } + result = GetListboxIndex(interp, listPtr, objv[2], 0, &index); + if (result != TCL_OK) { break; } - 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; + 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; } - - case COMMAND_DELETE: { - int first, last; - 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; - } + 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; + } - if (!(listPtr->state & STATE_NORMAL)) { - break; - } + case COMMAND_CONFIGURE: { + Tcl_Obj *objPtr; - 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); + if (objc <= 3) { + objPtr = Tk_GetOptionInfo(interp, (char *) listPtr, + listPtr->optionTable, + (objc == 3) ? objv[2] : 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); + } + break; + } + + case COMMAND_CURSELECTION: { + char indexStringRep[TCL_INTEGER_SPACE]; + int i; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + result = TCL_ERROR; 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; + /* + * 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 *) INT2PTR(i))) { + sprintf(indexStringRep, "%d", i); + Tcl_AppendElement(interp, indexStringRep); } - last = first; + } + 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; + } + + result = GetListboxIndex(interp, listPtr, objv[2], 0, &first); + if (result != TCL_OK) { + break; + } + + if (!(listPtr->state & STATE_NORMAL)) { + 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; } - } - if (first >= listPtr->nElements) { - result = TCL_OK; - break; + } else { + last = first; } 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; - } - if (objc == 3) { - /* - * One element request - we return a string - */ - Tcl_SetObjResult(interp, elemPtrs[first]); - } else { - Tcl_SetListObj(Tcl_GetObjResult(interp), (last - first + 1), - &(elemPtrs[first])); - } + result = ListboxDeleteSubCmd(listPtr, first, last); + } else { result = TCL_OK; - break; } + 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); + case COMMAND_GET: { + int first, last, listLen; + Tcl_Obj **elemPtrs; + + 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; } - sprintf(buf, "%d", index); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + } + 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; + } + if (objc == 3) { + /* + * One element request - we return a string + */ - case COMMAND_INSERT: { - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, - "index ?element element ...?"); - result = TCL_ERROR; - break; - } + Tcl_SetObjResult(interp, elemPtrs[first]); + } else { + Tcl_SetListObj(Tcl_GetObjResult(interp), (last - first + 1), + &(elemPtrs[first])); + } + result = TCL_OK; + break; + } - result = GetListboxIndex(interp, listPtr, objv[2], 1, &index); - if (result != TCL_OK) { - break; - } + case COMMAND_INDEX: + 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; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); + result = TCL_OK; + break; - if (!(listPtr->state & STATE_NORMAL)) { - break; - } + case COMMAND_INSERT: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index ?element element ...?"); + result = TCL_ERROR; + break; + } - result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3); + result = GetListboxIndex(interp, listPtr, objv[2], 1, &index); + if (result != TCL_OK) { break; } - case COMMAND_ITEMCGET: { - Tcl_Obj *objPtr; - ItemAttr *attrPtr; - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "index option"); - result = TCL_ERROR; - break; - } + if (!(listPtr->state & STATE_NORMAL)) { + break; + } - result = GetListboxIndex(interp, listPtr, objv[2], 0, &index); - if (result != TCL_OK) { - break; - } + result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3); + break; - if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", - Tcl_GetString(objv[2]), "\" out of range", - (char *)NULL); - result = TCL_ERROR; - break; - } - - attrPtr = ListboxGetItemAttributes(interp, listPtr, index); + case COMMAND_ITEMCGET: { + Tcl_Obj *objPtr; + ItemAttr *attrPtr; - objPtr = Tk_GetOptionValue(interp, (char *)attrPtr, - listPtr->itemAttrOptionTable, objv[3], listPtr->tkwin); - if (objPtr == NULL) { - result = TCL_ERROR; - break; - } - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "index option"); + result = TCL_ERROR; break; } - case COMMAND_ITEMCONFIGURE: { - Tcl_Obj *objPtr; - ItemAttr *attrPtr; - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, - "index ?option? ?value? ?option value ...?"); - result = TCL_ERROR; - break; - } + result = GetListboxIndex(interp, listPtr, objv[2], 0, &index); + if (result != TCL_OK) { + break; + } - result = GetListboxIndex(interp, listPtr, objv[2], 0, &index); - if (result != TCL_OK) { - break; - } - - if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", - Tcl_GetString(objv[2]), "\" out of range", - (char *)NULL); - result = TCL_ERROR; - break; - } - - attrPtr = ListboxGetItemAttributes(interp, listPtr, index); - if (objc <= 4) { - objPtr = Tk_GetOptionInfo(interp, (char *)attrPtr, - listPtr->itemAttrOptionTable, - (objc == 4) ? objv[3] : (Tcl_Obj *) NULL, - listPtr->tkwin); - if (objPtr == NULL) { - result = TCL_ERROR; - break; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; - } - } else { - result = ConfigureListboxItem(interp, listPtr, attrPtr, - objc-3, objv+3, index); - } + if (index < 0 || index >= listPtr->nElements) { + Tcl_AppendResult(interp, "item number \"", + Tcl_GetString(objv[2]), "\" out of range", NULL); + result = TCL_ERROR; 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; + + attrPtr = ListboxGetItemAttributes(interp, listPtr, index); + + objPtr = Tk_GetOptionValue(interp, (char *) attrPtr, + listPtr->itemAttrOptionTable, objv[3], listPtr->tkwin); + if (objPtr == NULL) { + result = TCL_ERROR; break; } - - case COMMAND_SCAN: { - int x, y, scanCmdIndex; + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; + break; + } - if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y"); - result = TCL_ERROR; - break; - } + case COMMAND_ITEMCONFIGURE: { + Tcl_Obj *objPtr; + ItemAttr *attrPtr; - if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) { - result = TCL_ERROR; - break; - } + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, + "index ?option? ?value? ?option value ...?"); + 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; + result = GetListboxIndex(interp, listPtr, objv[2], 0, &index); + if (result != TCL_OK) { + break; + } + + if (index < 0 || index >= listPtr->nElements) { + Tcl_AppendResult(interp, "item number \"", Tcl_GetString(objv[2]), + "\" out of range", NULL); + result = TCL_ERROR; break; } - case COMMAND_SEE: { - int diff; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "index"); + attrPtr = ListboxGetItemAttributes(interp, listPtr, index); + if (objc <= 4) { + objPtr = Tk_GetOptionInfo(interp, (char *) attrPtr, + listPtr->itemAttrOptionTable, + (objc == 4) ? objv[3] : NULL, listPtr->tkwin); + if (objPtr == NULL) { 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, 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); - } - } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } - result = TCL_OK; + } else { + result = ConfigureListboxItem(interp, listPtr, attrPtr, + objc-3, objv+3, index); + } + break; + } + + case COMMAND_NEAREST: { + int y; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "y"); + result = TCL_ERROR; break; } - case COMMAND_SELECTION: { - result = ListboxSelectionSubCmd(interp, listPtr, objc, objv); + result = Tcl_GetIntFromObj(interp, objv[2], &y); + if (result != TCL_OK) { break; } + index = NearestListboxElement(listPtr, y); + Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); + result = TCL_OK; + 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; + case COMMAND_SCAN: { + int x, y, scanCmdIndex; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y"); + result = TCL_ERROR; + break; + } + + 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_XVIEW: { - result = ListboxXviewSubCmd(interp, listPtr, objc, objv); + 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; } - - case COMMAND_YVIEW: { - result = ListboxYviewSubCmd(interp, listPtr, objc, objv); + 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, 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: + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + result = TCL_ERROR; break; } + Tcl_SetObjResult(interp, Tcl_NewIntObj(listPtr->nElements)); + result = TCL_OK; + break; + case COMMAND_XVIEW: + result = ListboxXviewSubCmd(interp, listPtr, objc, objv); + break; + case COMMAND_YVIEW: + result = ListboxYviewSubCmd(interp, listPtr, objc, objv); + break; } Tcl_Release((ClientData)listPtr); return result; @@ -1076,34 +1058,41 @@ ListboxWidgetObjCmd(clientData, interp, objc, objv) * * ListboxBboxSubCmd -- * - * This procedure is invoked to process a listbox bbox request. - * See the user documentation for more information. + * 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. + * 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 */ +ListboxBboxSubCmd( + 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 */ + + /* + * Determine the index of the last visible item in the listbox. + */ + lastVisibleIndex = listPtr->topIndex + listPtr->fullLines - + listPtr->partialLine; + + listPtr->partialLine; if (listPtr->nElements < lastVisibleIndex) { lastVisibleIndex = listPtr->nElements; } - /* Only allow bbox requests for indices that are visible */ + /* + * Only allow bbox requests for indices that are visible. + */ + if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) { char buf[TCL_INTEGER_SPACE * 4]; Tcl_Obj *el; @@ -1111,7 +1100,10 @@ ListboxBboxSubCmd(interp, listPtr, index) int pixelWidth, stringLen, x, y, result; Tk_FontMetrics fm; - /* Compute the pixel width of the requested element */ + /* + * Compute the pixel width of the requested element. + */ + result = Tcl_ListObjIndex(interp, listPtr->listObj, index, &el); if (result != TCL_OK) { return result; @@ -1123,7 +1115,7 @@ ListboxBboxSubCmd(interp, listPtr, index) x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; y = ((index - listPtr->topIndex)*listPtr->lineHeight) - + listPtr->inset + listPtr->selBorderWidth; + + listPtr->inset + listPtr->selBorderWidth; sprintf(buf, "%d %d %d %d", x, y, pixelWidth, fm.linespace); Tcl_SetResult(interp, buf, TCL_VOLATILE); } @@ -1135,8 +1127,8 @@ ListboxBboxSubCmd(interp, listPtr, index) * * ListboxSelectionSubCmd -- * - * This procedure is invoked to process the selection sub command - * for listbox widgets. + * This procedure is invoked to process the selection sub command for + * listbox widgets. * * Results: * Standard Tcl result. @@ -1148,14 +1140,15 @@ ListboxBboxSubCmd(interp, listPtr, index) */ 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 */ +ListboxSelectionSubCmd( + 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; @@ -1187,40 +1180,36 @@ ListboxSelectionSubCmd(interp, listPtr, objc, objv) } switch (selCmdIndex) { - case SELECTION_ANCHOR: { - if (objc != 4) { - Tcl_WrongNumArgs(interp, 3, objv, "index"); - return TCL_ERROR; - } - if (first >= listPtr->nElements) { - first = listPtr->nElements - 1; - } - if (first < 0) { - first = 0; - } - listPtr->selectAnchor = first; - result = TCL_OK; - break; + case SELECTION_ANCHOR: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index"); + return TCL_ERROR; } - case SELECTION_CLEAR: { - result = ListboxSelect(listPtr, first, last, 0); - break; + if (first >= listPtr->nElements) { + first = listPtr->nElements - 1; } - case SELECTION_INCLUDES: { - if (objc != 4) { - Tcl_WrongNumArgs(interp, 3, objv, "index"); - return TCL_ERROR; - } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((Tcl_FindHashEntry(listPtr->selection, - (char *)first) != NULL))); - result = TCL_OK; - break; + if (first < 0) { + first = 0; } - case SELECTION_SET: { - result = ListboxSelect(listPtr, first, last, 1); - break; + listPtr->selectAnchor = first; + 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; } + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj((Tcl_FindHashEntry(listPtr->selection, + (char *) INT2PTR(first)) != NULL))); + result = TCL_OK; + break; + case SELECTION_SET: + result = ListboxSelect(listPtr, first, last, 1); + break; } return result; } @@ -1242,33 +1231,35 @@ ListboxSelectionSubCmd(interp, listPtr, objc, objv) */ 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 */ +ListboxXviewSubCmd( + 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); + - 2*(listPtr->inset + listPtr->selBorderWidth); if (objc == 2) { if (listPtr->maxWidth == 0) { - Tcl_SetResult(interp, "0 1", TCL_STATIC); + Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); } else { - char buf[TCL_DOUBLE_SPACE * 2]; - + char buf[TCL_DOUBLE_SPACE]; + fraction = listPtr->xOffset/((double) listPtr->maxWidth); fraction2 = (listPtr->xOffset + windowWidth) - /((double) listPtr->maxWidth); + / ((double) listPtr->maxWidth); if (fraction2 > 1.0) { fraction2 = 1.0; } - sprintf(buf, "%g %g", fraction, fraction2); + Tcl_PrintDouble(NULL, fraction, buf); Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_PrintDouble(NULL, fraction2, buf); + Tcl_AppendResult(interp, " ", buf, NULL); } } else if (objc == 3) { if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) { @@ -1278,23 +1269,23 @@ ListboxXviewSubCmd(interp, listPtr, objc, objv) } 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 + 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; - } - break; - case TK_SCROLL_UNITS: + } else { offset = listPtr->xOffset + count*listPtr->xScrollUnit; - break; + } + break; + case TK_SCROLL_UNITS: + offset = listPtr->xOffset + count*listPtr->xScrollUnit; + break; } ChangeListboxOffset(listPtr, offset); } @@ -1318,29 +1309,31 @@ ListboxXviewSubCmd(interp, listPtr, objc, objv) */ 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 */ +ListboxYviewSubCmd( + 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); + Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); } else { - char buf[TCL_DOUBLE_SPACE * 2]; - + char buf[TCL_DOUBLE_SPACE]; + fraction = listPtr->topIndex/((double) listPtr->nElements); fraction2 = (listPtr->topIndex+listPtr->fullLines) - /((double) listPtr->nElements); + /((double) listPtr->nElements); if (fraction2 > 1.0) { fraction2 = 1.0; } - sprintf(buf, "%g %g", fraction, fraction2); + Tcl_PrintDouble(NULL, fraction, buf); Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_PrintDouble(NULL, fraction2, buf); + Tcl_AppendResult(interp, " ", buf, NULL); } } else if (objc == 3) { if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { @@ -1350,22 +1343,22 @@ ListboxYviewSubCmd(interp, listPtr, objc, objv) } else { 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: + 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; + } + break; + case TK_SCROLL_UNITS: + index = listPtr->topIndex + count; + break; + case TK_SCROLL_ERROR: + default: + return TCL_ERROR; } ChangeListboxView(listPtr, index); } @@ -1377,8 +1370,8 @@ ListboxYviewSubCmd(interp, listPtr, objc, objv) * * ListboxGetItemAttributes -- * - * Returns a pointer to the ItemAttr record for a given index, - * creating one if it does not already exist. + * Returns a pointer to the ItemAttr record for a given index, creating + * one if it does not already exist. * * Results: * Pointer to an ItemAttr record. @@ -1390,18 +1383,19 @@ ListboxYviewSubCmd(interp, listPtr, objc, objv) */ static ItemAttr * -ListboxGetItemAttributes(interp, listPtr, index) - Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */ - Listbox *listPtr; /* Information about the listbox */ - int index; /* Index of the item to retrieve attributes - * for */ +ListboxGetItemAttributes( + Tcl_Interp *interp, /* Pointer to the calling Tcl interpreter */ + Listbox *listPtr, /* Information about the listbox */ + int index) /* Index of the item to retrieve attributes + * for. */ { - int new; + int isNew; Tcl_HashEntry *entry; ItemAttr *attrs; - entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, (char *)index, &new); - if (new) { + entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, + (char *) INT2PTR(index), &isNew); + if (isNew) { attrs = (ItemAttr *) ckalloc(sizeof(ItemAttr)); attrs->border = NULL; attrs->selBorder = NULL; @@ -1420,9 +1414,9 @@ ListboxGetItemAttributes(interp, listPtr, index) * * DestroyListbox -- * - * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release - * to clean up the internal structure of a listbox at a safe time - * (when no-one is using it anymore). + * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release to + * clean up the internal structure of a listbox at a safe time (when + * no-one is using it anymore). * * Results: * None. @@ -1434,14 +1428,17 @@ ListboxGetItemAttributes(interp, listPtr, index) */ static void -DestroyListbox(memPtr) - char *memPtr; /* Info about listbox widget. */ +DestroyListbox( + char *memPtr) /* Info about listbox widget. */ { register Listbox *listPtr = (Listbox *) memPtr; Tcl_HashEntry *entry; Tcl_HashSearch search; - /* If we have an internal list object, free it */ + /* + * If we have an internal list object, free it. + */ + if (listPtr->listObj != NULL) { Tcl_DecrRefCount(listPtr->listObj); listPtr->listObj = NULL; @@ -1452,23 +1449,28 @@ DestroyListbox(memPtr) TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, (ClientData) listPtr); } - - /* Free the selection hash table */ + + /* + * Free the selection hash table. + */ + Tcl_DeleteHashTable(listPtr->selection); ckfree((char *)listPtr->selection); - /* Free the item attribute hash table */ + /* + * Free the item attribute hash table. + */ + for (entry = Tcl_FirstHashEntry(listPtr->itemAttrTable, &search); - entry != NULL; entry = Tcl_NextHashEntry(&search)) { + entry != NULL; entry = Tcl_NextHashEntry(&search)) { ckfree((char *)Tcl_GetHashValue(entry)); } Tcl_DeleteHashTable(listPtr->itemAttrTable); ckfree((char *)listPtr->itemAttrTable); /* - * Free up all the stuff that requires special handling, then - * let Tk_FreeOptions handle all the standard option-related - * stuff. + * Free up all the stuff that requires special handling, then let + * Tk_FreeOptions handle all the standard option-related stuff. */ if (listPtr->textGC != None) { @@ -1494,7 +1496,7 @@ DestroyListbox(memPtr) * DestroyListboxOptionTables -- * * This procedure is registered as an exit callback when the listbox - * command is first called. It cleans up the OptionTables structure + * command is first called. It cleans up the OptionTables structure * allocated by that command. * * Results: @@ -1507,11 +1509,11 @@ DestroyListbox(memPtr) */ static void -DestroyListboxOptionTables(clientData, interp) - ClientData clientData; /* Pointer to the OptionTables struct */ - Tcl_Interp *interp; /* Pointer to the calling interp */ +DestroyListboxOptionTables( + ClientData clientData, /* Pointer to the OptionTables struct */ + Tcl_Interp *interp) /* Pointer to the calling interp */ { - ckfree((char *)clientData); + ckfree((char *) clientData); return; } @@ -1520,30 +1522,29 @@ DestroyListboxOptionTables(clientData, interp) * * ConfigureListbox -- * - * This procedure is called to process an objv/objc list, plus - * the Tk option database, in order to configure (or reconfigure) - * a listbox widget. + * This procedure is called to process an objv/objc list, plus the Tk + * option database, in order to configure (or reconfigure) a listbox + * widget. * * Results: - * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then the interp's result contains an error message. + * The return value is a standard Tcl result. If TCL_ERROR is returned, + * then the interp's result contains an error message. * * Side effects: - * Configuration information, such as colors, border width, - * etc. get set for listPtr; old resources get freed, - * if there were any. + * Configuration information, such as colors, border width, etc. get set + * for listPtr; old resources get freed, if there were any. * *---------------------------------------------------------------------- */ static int -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 objc; /* Number of valid entries in argv. */ - Tcl_Obj *CONST objv[]; /* Arguments. */ - int flags; /* Flags to pass to Tk_ConfigureWidget. */ +ConfigureListbox( + Tcl_Interp *interp, /* Used for error reporting. */ + register Listbox *listPtr, /* Information about widget; may or may not + * already have values for some fields. */ + 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 *oldListObj = NULL; @@ -1565,7 +1566,7 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) if (Tk_SetOptions(interp, (char *) listPtr, listPtr->optionTable, objc, objv, - listPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) { + listPtr->tkwin, &savedOptions, NULL) != TCL_OK) { continue; } } else { @@ -1601,29 +1602,32 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) (ClientData) listPtr); } - /* Verify the current status of the list var. + /* + * 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. + * 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 | no listvar | Copy old listvar content to the + * internal list obj * - * listvar | listvar | no special action + * listvar | listvar | no special action * * no listvar | no listvar | no special action */ + oldListObj = listPtr->listObj; if (listPtr->listVarName != NULL) { Tcl_Obj *listVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName, - (char *) NULL, TCL_GLOBAL_ONLY); + NULL, TCL_GLOBAL_ONLY); int dummy; + if (listVarObj == NULL) { listVarObj = (oldListObj ? oldListObj : Tcl_NewObj()); - if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *) NULL, + if (Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL, listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { if (oldListObj == NULL) { @@ -1632,11 +1636,15 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) continue; } } - /* Make sure the object is a good list object */ + + /* + * Make sure the object is a good list object. + */ + if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy) != TCL_OK) { Tcl_AppendResult(listPtr->interp, - ": invalid -listvariable value", (char *) NULL); + ": invalid -listvariable value", NULL); continue; } @@ -1657,11 +1665,14 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) Tk_FreeSavedOptions(&savedOptions); } - /* Make sure that the list length is correct */ + /* + * Make sure that the list length is correct. + */ + Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements); - + if (error) { - Tcl_SetObjResult(interp, errorResult); + Tcl_SetObjResult(interp, errorResult); Tcl_DecrRefCount(errorResult); return TCL_ERROR; } else { @@ -1675,45 +1686,46 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) * * ConfigureListboxItem -- * - * This procedure is called to process an objv/objc list, plus - * the Tk option database, in order to configure (or reconfigure) - * a listbox item. + * This procedure is called to process an objv/objc list, plus the Tk + * option database, in order to configure (or reconfigure) a listbox + * item. * * Results: - * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then the interp's result contains an error message. + * The return value is a standard Tcl result. If TCL_ERROR is returned, + * then the interp's result contains an error message. * * Side effects: - * Configuration information, such as colors, border width, - * etc. get set for a listbox item; old resources get freed, - * if there were any. + * Configuration information, such as colors, border width, etc. get set + * for a listbox item; old resources get freed, if there were any. * *---------------------------------------------------------------------- */ static int -ConfigureListboxItem(interp, listPtr, attrs, objc, objv, index) - Tcl_Interp *interp; /* Used for error reporting. */ - register Listbox *listPtr; /* Information about widget; may or may - * not already have values for some fields. */ - ItemAttr *attrs; /* Information about the item to configure */ - int objc; /* Number of valid entries in argv. */ - Tcl_Obj *CONST objv[]; /* Arguments. */ - int index; /* Index of the listbox item being configure */ +ConfigureListboxItem( + Tcl_Interp *interp, /* Used for error reporting. */ + register Listbox *listPtr, /* Information about widget; may or may not + * already have values for some fields. */ + ItemAttr *attrs, /* Information about the item to configure */ + int objc, /* Number of valid entries in argv. */ + Tcl_Obj *const objv[], /* Arguments. */ + int index) /* Index of the listbox item being configure */ { Tk_SavedOptions savedOptions; if (Tk_SetOptions(interp, (char *)attrs, listPtr->itemAttrOptionTable, objc, objv, listPtr->tkwin, - &savedOptions, (int *)NULL) != TCL_OK) { + &savedOptions, NULL) != TCL_OK) { Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } Tk_FreeSavedOptions(&savedOptions); + /* - * Redraw this index - ListboxWorldChanged would need to be called - * if item attributes were checked in the "world". + * Redraw this index - ListboxWorldChanged would need to be called if item + * attributes were checked in the "world". */ + EventuallyRedrawRange(listPtr, index, index); return TCL_OK; } @@ -1723,50 +1735,46 @@ ConfigureListboxItem(interp, listPtr, attrs, objc, objv, index) * * ListboxWorldChanged -- * - * This procedure is called when the world has changed in some - * way and the widget needs to recompute all its graphics contexts - * and determine its new geometry. + * This procedure is called when the world has changed in some way and + * the widget needs to recompute all its graphics contexts and determine + * its new geometry. * * Results: - * None. + * None. * * Side effects: - * Listbox will be relayed out and redisplayed. + * Listbox will be relayed out and redisplayed. * *--------------------------------------------------------------------------- */ - + static void -ListboxWorldChanged(instanceData) - ClientData instanceData; /* Information about widget. */ +ListboxWorldChanged( + ClientData instanceData) /* Information about widget. */ { XGCValues gcValues; GC gc; unsigned long mask; - Listbox *listPtr; - - listPtr = (Listbox *) instanceData; + Listbox *listPtr = (Listbox *) instanceData; if (listPtr->state & STATE_NORMAL) { gcValues.foreground = listPtr->fgColorPtr->pixel; gcValues.graphics_exposures = False; mask = GCForeground | GCFont | GCGraphicsExposures; + } else if (listPtr->dfgColorPtr != NULL) { + gcValues.foreground = listPtr->dfgColorPtr->pixel; + gcValues.graphics_exposures = False; + mask = GCForeground | GCFont | GCGraphicsExposures; } else { - if (listPtr->dfgColorPtr != NULL) { - gcValues.foreground = listPtr->dfgColorPtr->pixel; - gcValues.graphics_exposures = False; - mask = GCForeground | GCFont | GCGraphicsExposures; - } else { - gcValues.foreground = listPtr->fgColorPtr->pixel; - mask = GCForeground | GCFont; - if (listPtr->gray == None) { - listPtr->gray = Tk_GetBitmap(NULL, listPtr->tkwin, "gray50"); - } - if (listPtr->gray != None) { - gcValues.fill_style = FillStippled; - gcValues.stipple = listPtr->gray; - mask |= GCFillStyle | GCStipple; - } + gcValues.foreground = listPtr->fgColorPtr->pixel; + mask = GCForeground | GCFont; + if (listPtr->gray == None) { + listPtr->gray = Tk_GetBitmap(NULL, listPtr->tkwin, "gray50"); + } + if (listPtr->gray != None) { + gcValues.fill_style = FillStippled; + gcValues.stipple = listPtr->gray; + mask |= GCFillStyle | GCStipple; } } @@ -1789,8 +1797,8 @@ ListboxWorldChanged(instanceData) listPtr->selTextGC = gc; /* - * Register the desired geometry for the window and arrange for - * the window to be redisplayed. + * Register the desired geometry for the window and arrange for the window + * to be redisplayed. */ ListboxComputeGeometry(listPtr, 1, 1, 1); @@ -1815,25 +1823,24 @@ ListboxWorldChanged(instanceData) */ static void -DisplayListbox(clientData) - ClientData clientData; /* Information about window. */ +DisplayListbox( + ClientData clientData) /* Information about window. */ { register Listbox *listPtr = (Listbox *) clientData; register Tk_Window tkwin = listPtr->tkwin; GC gc; - int i, limit, x, y, width = 0, prevSelected, freeGC; + int i, limit, x, y, prevSelected, freeGC, stringLen; Tk_FontMetrics fm; Tcl_Obj *curElement; Tcl_HashEntry *entry; char *stringRep; - int stringLen; ItemAttr *attrs; Tk_3DBorder selectedBg; XGCValues gcValues; unsigned long mask; - int left, right; /* Non-zero values here indicate - * that the left or right edge of - * the listbox is off-screen. */ + 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; @@ -1867,11 +1874,11 @@ DisplayListbox(clientData) #ifndef TK_NO_DOUBLE_BUFFERING /* - * Redrawing is done in a temporary pixmap that is allocated - * here and freed at the end of the procedure. All drawing is - * done to the pixmap, and the pixmap is copied to the screen - * at the end of the procedure. This provides the smoothest - * possible visual effects (no flashing on the screen). + * Redrawing is done in a temporary pixmap that is allocated here and + * freed at the end of the procedure. All drawing is done to the pixmap, + * and the pixmap is copied to the screen at the end of the procedure. + * This provides the smoothest possible visual effects (no flashing on the + * screen). */ pixmap = Tk_GetPixmap(listPtr->display, Tk_WindowId(tkwin), @@ -1882,7 +1889,10 @@ DisplayListbox(clientData) Tk_Fill3DRectangle(tkwin, pixmap, listPtr->normalBorder, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); - /* Display each item in the listbox */ + /* + * Display each item in the listbox. + */ + limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1; if (limit >= listPtr->nElements) { limit = listPtr->nElements-1; @@ -1892,40 +1902,54 @@ DisplayListbox(clientData) left = listPtr->selBorderWidth+1; } if ((listPtr->maxWidth - listPtr->xOffset) > (Tk_Width(listPtr->tkwin) - - 2*(listPtr->inset + listPtr->selBorderWidth))) { + - 2*(listPtr->inset + listPtr->selBorderWidth))) { right = listPtr->selBorderWidth+1; } prevSelected = 0; - + for (i = listPtr->topIndex; i <= limit; i++) { + int width = Tk_Width(tkwin); /* zeroth approx to silence warning */ + x = listPtr->inset; - y = ((i - listPtr->topIndex) * listPtr->lineHeight) - + listPtr->inset; + y = ((i - listPtr->topIndex) * listPtr->lineHeight) + listPtr->inset; gc = listPtr->textGC; freeGC = 0; + /* * Lookup this item in the item attributes table, to see if it has - * special foreground/background colors + * special foreground/background colors. */ - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *)i); + + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *) INT2PTR(i)); /* - * If the listbox is enabled, items may be drawn differently; - * they may be drawn selected, or they may have special foreground - * or background colors. + * If the listbox is enabled, items may be drawn differently; they may + * be drawn selected, or they may have special foreground or + * background colors. */ + if (listPtr->state & STATE_NORMAL) { - if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) { - /* Selected items are drawn differently. */ + if (Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i))) { + /* + * Selected items are drawn differently. + */ + gc = listPtr->selTextGC; width = Tk_Width(tkwin) - 2*listPtr->inset; selectedBg = listPtr->selBorder; - - /* If there is attribute information for this item, - * adjust the drawing accordingly */ + + /* + * If there is attribute information for this item, adjust the + * drawing accordingly. + */ + if (entry != NULL) { attrs = (ItemAttr *)Tcl_GetHashValue(entry); - /* Default GC has the values from the widget at large */ + + /* + * Default GC has the values from the widget at large. + */ + if (listPtr->selFgColorPtr) { gcValues.foreground = listPtr->selFgColorPtr->pixel; } else { @@ -1934,11 +1958,11 @@ DisplayListbox(clientData) gcValues.font = Tk_FontId(listPtr->tkfont); gcValues.graphics_exposures = False; mask = GCForeground | GCFont | GCGraphicsExposures; - + if (attrs->selBorder != NULL) { selectedBg = attrs->selBorder; } - + if (attrs->selFgColor != NULL) { gcValues.foreground = attrs->selFgColor->pixel; gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues); @@ -1988,7 +2012,7 @@ DisplayListbox(clientData) /* Draw bottom bevel */ if (i + 1 == listPtr->nElements || Tcl_FindHashEntry(listPtr->selection, - (char *)(i + 1)) == NULL ) { + (char *) INT2PTR(i + 1)) == NULL ) { Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left, y + listPtr->lineHeight - listPtr->selBorderWidth, width+left+right, listPtr->selBorderWidth, 0, 0, 0, @@ -2000,28 +2024,29 @@ DisplayListbox(clientData) * If there is an item attributes record for this item, draw * the background box and set the foreground color accordingly */ + if (entry != NULL) { attrs = (ItemAttr *)Tcl_GetHashValue(entry); gcValues.foreground = listPtr->fgColorPtr->pixel; gcValues.font = Tk_FontId(listPtr->tkfont); gcValues.graphics_exposures = False; mask = GCForeground | GCFont | GCGraphicsExposures; - + /* * If the item has its own background color, draw it now. */ - + if (attrs->border != NULL) { width = Tk_Width(tkwin) - 2*listPtr->inset; Tk_Fill3DRectangle(tkwin, pixmap, attrs->border, x, y, width, listPtr->lineHeight, 0, TK_RELIEF_FLAT); } - + /* * If the item has its own foreground, use it to override * the value in the gcValues structure. */ - + if ((listPtr->state & STATE_NORMAL) && attrs->fgColor != NULL) { gcValues.foreground = attrs->fgColor->pixel; @@ -2033,7 +2058,10 @@ DisplayListbox(clientData) } } - /* Draw the actual text of this item */ + /* + * Draw the actual text of this item. + */ + Tk_GetFontMetrics(listPtr->tkfont, &fm); y += fm.ascent + listPtr->selBorderWidth; x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; @@ -2042,10 +2070,16 @@ DisplayListbox(clientData) Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont, stringRep, stringLen, x, y); - /* If this is the active element, apply the activestyle to it. */ + /* + * If this is the active element, apply the activestyle to it. + */ + if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) { if (listPtr->activeStyle == ACTIVE_STYLE_UNDERLINE) { - /* Underline the text. */ + /* + * Underline the text. + */ + Tk_UnderlineChars(listPtr->display, pixmap, gc, listPtr->tkfont, stringRep, x, y, 0, stringLen); } else if (listPtr->activeStyle == ACTIVE_STYLE_DOTBOX) { @@ -2053,52 +2087,59 @@ DisplayListbox(clientData) /* * This provides for exact default look and feel on Windows. */ + TkWinDCState state; HDC dc; RECT rect; dc = TkWinGetDrawableDC(listPtr->display, pixmap, &state); - rect.left = listPtr->inset; - rect.top = ((i - listPtr->topIndex) * listPtr->lineHeight) - + listPtr->inset; - rect.right = rect.left + width; + rect.left = listPtr->inset; + rect.top = ((i - listPtr->topIndex) * listPtr->lineHeight) + + listPtr->inset; + rect.right = rect.left + width; rect.bottom = rect.top + listPtr->lineHeight; DrawFocusRect(dc, &rect); TkWinReleaseDrawableDC(pixmap, dc, &state); -#else +#else /* !WIN32 */ /* * Draw a dotted box around the text. */ + x = listPtr->inset; y = ((i - listPtr->topIndex) * listPtr->lineHeight) - + listPtr->inset; + + listPtr->inset; width = Tk_Width(tkwin) - 2*listPtr->inset - 1; - gcValues.line_style = LineOnOffDash; - gcValues.line_width = listPtr->selBorderWidth; + gcValues.line_style = LineOnOffDash; + gcValues.line_width = listPtr->selBorderWidth; if (gcValues.line_width <= 0) { gcValues.line_width = 1; } gcValues.dash_offset = 0; - gcValues.dashes = 1; + gcValues.dashes = 1; + /* * You would think the XSetDashes was necessary, but it - * appears that the default dotting for just saying we - * want dashes appears to work correctly. + * appears that the default dotting for just saying we want + * dashes appears to work correctly. static char dashList[] = { 1 }; - static int dashLen = sizeof(dashList); + static int dashLen = sizeof(dashList); XSetDashes(listPtr->display, gc, 0, dashList, dashLen); */ + mask = GCLineWidth | GCLineStyle | GCDashList | GCDashOffset; XChangeGC(listPtr->display, gc, mask, &gcValues); XDrawRectangle(listPtr->display, pixmap, gc, x, y, (unsigned) width, (unsigned) listPtr->lineHeight - 1); if (!freeGC) { - /* Don't bother changing if it is about to be freed. */ + /* + * Don't bother changing if it is about to be freed. + */ + gcValues.line_style = LineSolid; XChangeGC(listPtr->display, gc, GCLineStyle, &gcValues); } -#endif +#endif /* WIN32 */ } } @@ -2108,8 +2149,8 @@ DisplayListbox(clientData) } /* - * Redraw the border for the listbox to make sure that it's on top - * of any of the text of the listbox entries. + * Redraw the border for the listbox to make sure that it's on top of any + * of the text of the listbox entries. */ Tk_Draw3DRectangle(tkwin, pixmap, listPtr->normalBorder, @@ -2123,11 +2164,11 @@ DisplayListbox(clientData) bgGC = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap); if (listPtr->flags & GOT_FOCUS) { fgGC = Tk_GCForColor(listPtr->highlightColorPtr, pixmap); - TkpDrawHighlightBorder(tkwin, fgGC, bgGC, - listPtr->highlightWidth, pixmap); + TkpDrawHighlightBorder(tkwin, fgGC, bgGC, + listPtr->highlightWidth, pixmap); } else { - TkpDrawHighlightBorder(tkwin, bgGC, bgGC, - listPtr->highlightWidth, pixmap); + TkpDrawHighlightBorder(tkwin, bgGC, bgGC, + listPtr->highlightWidth, pixmap); } } #ifndef TK_NO_DOUBLE_BUFFERING @@ -2143,51 +2184,51 @@ DisplayListbox(clientData) * * ListboxComputeGeometry -- * - * This procedure is invoked to recompute geometry information - * such as the sizes of the elements and the overall dimensions - * desired for the listbox. + * This procedure is invoked to recompute geometry information such as + * the sizes of the elements and the overall dimensions desired for the + * listbox. * * Results: * None. * * Side effects: - * Geometry information is updated and a new requested size is - * registered for the widget. Internal border and gridding - * information is also set. + * Geometry information is updated and a new requested size is registered + * for the widget. Internal border and gridding information is also set. * *---------------------------------------------------------------------- */ static void -ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid) - Listbox *listPtr; /* Listbox whose geometry is to be +ListboxComputeGeometry( + Listbox *listPtr, /* Listbox whose geometry is to be * recomputed. */ - int fontChanged; /* Non-zero means the font may have changed - * so per-element width information also - * has to be computed. */ - int maxIsStale; /* Non-zero means the "maxWidth" field may - * no longer be up-to-date and must - * be recomputed. If fontChanged is 1 then - * this must be 1. */ - int updateGrid; /* Non-zero means call Tk_SetGrid or - * Tk_UnsetGrid to update gridding for - * the window. */ + int fontChanged, /* Non-zero means the font may have changed so + * per-element width information also has to + * be computed. */ + int maxIsStale, /* Non-zero means the "maxWidth" field may no + * longer be up-to-date and must be + * recomputed. If fontChanged is 1 then this + * must be 1. */ + int updateGrid) /* Non-zero means call Tk_SetGrid or + * Tk_UnsetGrid to update gridding for the + * window. */ { - int width, height, pixelWidth, pixelHeight; + int width, height, pixelWidth, pixelHeight, textLength, i, result; Tk_FontMetrics fm; Tcl_Obj *element; - int textLength; char *text; - int i, result; - - if (fontChanged || maxIsStale) { + + if (fontChanged || maxIsStale) { listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1); if (listPtr->xScrollUnit == 0) { listPtr->xScrollUnit = 1; } listPtr->maxWidth = 0; for (i = 0; i < listPtr->nElements; i++) { - /* Compute the pixel width of the current element */ + /* + * Compute the pixel width of the current element. + */ + result = Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &element); if (result != TCL_OK) { @@ -2239,87 +2280,92 @@ ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid) * * ListboxInsertSubCmd -- * - * This procedure is invoked to handle the listbox "insert" - * subcommand. + * This procedure is invoked to handle the listbox "insert" subcommand. * * Results: * Standard Tcl result. * * Side effects: - * New elements are added to the listbox pointed to by listPtr; - * a refresh callback is registered for the listbox. + * New elements are added to the listbox pointed to by listPtr; a refresh + * callback is registered for the listbox. * *---------------------------------------------------------------------- */ 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 +ListboxInsertSubCmd( + register Listbox *listPtr, /* Listbox that is to get the new elements. */ + int index, /* Add the new elements before this * element. */ - int objc; /* Number of new elements to add. */ - Tcl_Obj *CONST objv[]; /* New elements (one per entry). */ + int objc, /* Number of new elements to add. */ + Tcl_Obj *const objv[]) /* New elements (one per entry). */ { - int i, oldMaxWidth; + int i, oldMaxWidth, pixelWidth, result, length; Tcl_Obj *newListObj; - int pixelWidth; - int result; 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; } } - - /* Adjust selection and attribute information for every index after - * the first index */ + + /* + * Adjust selection and attribute information for every index after the + * first index. + */ + MigrateHashEntries(listPtr->selection, index, listPtr->nElements-1, objc); MigrateHashEntries(listPtr->itemAttrTable, index, listPtr->nElements-1, objc); - - /* If the object is shared, duplicate it before writing to it */ + + /* + * If the object is shared, duplicate it before writing to it. + */ + if (Tcl_IsShared(listPtr->listObj)) { newListObj = Tcl_DuplicateObj(listPtr->listObj); } else { newListObj = listPtr->listObj; } - result = - Tcl_ListObjReplace(listPtr->interp, newListObj, index, 0, objc, objv); + result = Tcl_ListObjReplace(listPtr->interp, newListObj, index, 0, + objc, objv); if (result != TCL_OK) { return result; } /* - * Replace the current object and set attached listvar, if any. - * This may error if listvar points to a var in a deleted namespace, but - * we ignore those errors. If the namespace is recreated, it will - * auto-sync with the current value. [Bug 1424513] + * Replace the current object and set attached listvar, if any. This may + * error if listvar points to a var in a deleted namespace, but we ignore + * those errors. If the namespace is recreated, it will auto-sync with the + * current value. [Bug 1424513] */ Tcl_IncrRefCount(newListObj); Tcl_DecrRefCount(listPtr->listObj); listPtr->listObj = newListObj; if (listPtr->listVarName != NULL) { - Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName, - (char *) NULL, listPtr->listObj, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName, NULL, + listPtr->listObj, TCL_GLOBAL_ONLY); } - /* Get the new list length */ + /* + * Get the new list length. + */ + Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements); /* - * Update the "special" indices (anchor, topIndex, active) to account - * for the renumbering that 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. */ @@ -2350,8 +2396,8 @@ ListboxInsertSubCmd(listPtr, index, objc, objv) * * ListboxDeleteSubCmd -- * - * Process a listbox "delete" subcommand by removing one or more - * elements from a listbox widget. + * Process a listbox "delete" subcommand by removing one or more elements + * from a listbox widget. * * Results: * Standard Tcl result. @@ -2363,23 +2409,19 @@ ListboxInsertSubCmd(listPtr, index, objc, objv) */ 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. */ +ListboxDeleteSubCmd( + register Listbox *listPtr, /* Listbox widget to modify. */ + int first, /* Index of first element to delete. */ + int last) /* Index of last element to delete. */ { - int count, i, widthChanged; - Tcl_Obj *newListObj; - Tcl_Obj *element; - int length; + int count, i, widthChanged, length, result, pixelWidth; + Tcl_Obj *newListObj, *element; char *stringRep; - 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. + * Adjust the range to fit within the existing elements of the listbox, + * and make sure there's something to delete. */ if (first < 0) { @@ -2395,30 +2437,36 @@ ListboxDeleteSubCmd(listPtr, first, last) /* * Foreach deleted index we must: - * a) remove selection information + * 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 + * width. */ + widthChanged = 0; for (i = first; i <= last; i++) { - /* Remove selection information */ - entry = Tcl_FindHashEntry(listPtr->selection, (char *)i); + /* + * Remove selection information. + */ + + entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); } - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *)i); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *) INT2PTR(i)); if (entry != NULL) { ckfree((char *)Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); } - - /* Check width of the element. We only have to check if widthChanged + + /* + * 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); @@ -2429,13 +2477,19 @@ ListboxDeleteSubCmd(listPtr, first, last) } } - /* Adjust selection and attribute info for indices after lastIndex */ + /* + * Adjust selection and attribute info for indices after lastIndex. + */ + MigrateHashEntries(listPtr->selection, last+1, listPtr->nElements-1, count*-1); MigrateHashEntries(listPtr->itemAttrTable, last+1, listPtr->nElements-1, count*-1); - /* Delete the requested elements */ + /* + * Delete the requested elements. + */ + if (Tcl_IsShared(listPtr->listObj)) { newListObj = Tcl_DuplicateObj(listPtr->listObj); } else { @@ -2448,27 +2502,30 @@ ListboxDeleteSubCmd(listPtr, first, last) } /* - * Replace the current object and set attached listvar, if any. - * This may error if listvar points to a var in a deleted namespace, but - * we ignore those errors. If the namespace is recreated, it will - * auto-sync with the current value. [Bug 1424513] + * Replace the current object and set attached listvar, if any. This may + * error if listvar points to a var in a deleted namespace, but we ignore + * those errors. If the namespace is recreated, it will auto-sync with the + * current value. [Bug 1424513] */ Tcl_IncrRefCount(newListObj); Tcl_DecrRefCount(listPtr->listObj); listPtr->listObj = newListObj; if (listPtr->listVarName != NULL) { - Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName, - (char *) NULL, listPtr->listObj, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName, NULL, + listPtr->listObj, TCL_GLOBAL_ONLY); } - /* Get the new list length */ + /* + * Get the new list length. + */ + Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements); /* - * Update the selection and viewing information to reflect the change - * in the element numbering, and redisplay to slide information up over - * the elements that were deleted. + * Update the selection and viewing information to reflect the change in + * the element numbering, and redisplay to slide information up over the + * elements that were deleted. */ if (first <= listPtr->selectAnchor) { @@ -2512,26 +2569,26 @@ ListboxDeleteSubCmd(listPtr, first, last) * * ListboxEventProc -- * - * This procedure is invoked by the Tk dispatcher for various - * events on listboxes. + * This procedure is invoked by the Tk dispatcher for various events on + * listboxes. * * Results: * None. * * Side effects: - * When the window gets deleted, internal structures get - * cleaned up. When it gets exposed, it is redisplayed. + * When the window gets deleted, internal structures get cleaned up. When + * it gets exposed, it is redisplayed. * *-------------------------------------------------------------- */ static void -ListboxEventProc(clientData, eventPtr) - ClientData clientData; /* Information about window. */ - XEvent *eventPtr; /* Information about event. */ +ListboxEventProc( + ClientData clientData, /* Information about window. */ + XEvent *eventPtr) /* Information about event. */ { Listbox *listPtr = (Listbox *) clientData; - + if (eventPtr->type == Expose) { EventuallyRedrawRange(listPtr, NearestListboxElement(listPtr, eventPtr->xexpose.y), @@ -2564,10 +2621,9 @@ ListboxEventProc(clientData, eventPtr) ChangeListboxOffset(listPtr, listPtr->xOffset); /* - * Redraw the whole listbox. It's hard to tell what needs - * to be redrawn (e.g. if the listbox has shrunk then we - * may only need to redraw the borders), so just redraw - * everything for safety. + * Redraw the whole listbox. It's hard to tell what needs to be + * redrawn (e.g. if the listbox has shrunk then we may only need to + * redraw the borders), so just redraw everything for safety. */ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); @@ -2589,9 +2645,9 @@ ListboxEventProc(clientData, eventPtr) * * ListboxCmdDeletedProc -- * - * This procedure is invoked when a widget command is deleted. If - * the widget isn't already in the process of being destroyed, - * this command destroys it. + * This procedure is invoked when a widget command is deleted. If the + * widget isn't already in the process of being destroyed, this command + * destroys it. * * Results: * None. @@ -2603,16 +2659,16 @@ ListboxEventProc(clientData, eventPtr) */ static void -ListboxCmdDeletedProc(clientData) - ClientData clientData; /* Pointer to widget record for widget. */ +ListboxCmdDeletedProc( + ClientData clientData) /* Pointer to widget record for widget. */ { Listbox *listPtr = (Listbox *) clientData; /* - * This procedure could be invoked either because the window was - * destroyed and the command was then deleted (in which case tkwin - * is NULL) or because the command was deleted, and then this procedure - * destroys the widget. + * This procedure could be invoked either because the window was destroyed + * and the command was then deleted (in which case tkwin is NULL) or + * because the command was deleted, and then this procedure destroys the + * widget. */ if (!(listPtr->flags & LISTBOX_DELETED)) { @@ -2625,13 +2681,12 @@ ListboxCmdDeletedProc(clientData) * * GetListboxIndex -- * - * Parse an index into a listbox and return either its value - * or an error. + * Parse an index into a listbox and return either its value or an error. * * Results: - * A standard Tcl result. If all went well, then *indexPtr is - * filled in with the index (into listPtr) corresponding to - * string. Otherwise an error message is left in the interp's result. + * A standard Tcl result. If all went well, then *indexPtr is filled in + * with the index (into listPtr) corresponding to string. Otherwise an + * error message is left in the interp's result. * * Side effects: * None. @@ -2640,62 +2695,62 @@ ListboxCmdDeletedProc(clientData) */ static int -GetListboxIndex(interp, listPtr, indexObj, endIsSize, indexPtr) - Tcl_Interp *interp; /* For error messages. */ - Listbox *listPtr; /* Listbox for which the index is being +GetListboxIndex( + Tcl_Interp *interp, /* For error messages. */ + Listbox *listPtr, /* Listbox for which the index is being * specified. */ - 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. */ + 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 result; - int index; + int result, index; char *stringRep; - - /* First see if the index is one of the named indices */ + + /* + * 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; - } - - case INDEX_END: { - /* "end" index */ - if (endIsSize) { - *indexPtr = listPtr->nElements; - } else { - *indexPtr = listPtr->nElements - 1; - } - break; + case INDEX_ACTIVE: + /* "active" index */ + *indexPtr = listPtr->active; + break; + case INDEX_ANCHOR: + /* "anchor" index */ + *indexPtr = listPtr->selectAnchor; + break; + case INDEX_END: + /* "end" index */ + if (endIsSize) { + *indexPtr = listPtr->nElements; + } else { + *indexPtr = listPtr->nElements - 1; } + break; } return TCL_OK; } - /* The index didn't match any of the named indices; maybe it's an @x,y */ + /* + * 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); + y = 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); + NULL); return TCL_ERROR; } start = end+1; @@ -2703,23 +2758,29 @@ GetListboxIndex(interp, listPtr, indexObj, endIsSize, indexPtr) if ((start == end) || (*end != '\0')) { Tcl_AppendResult(interp, "bad listbox index \"", stringRep, "\": must be active, anchor, end, @x,y, or a number", - (char *)NULL); + NULL); return TCL_ERROR; } *indexPtr = NearestListboxElement(listPtr, y); return TCL_OK; } - - /* Maybe the index is just an integer */ + + /* + * Maybe the index is just an integer. + */ + if (Tcl_GetIntFromObj(interp, indexObj, indexPtr) == TCL_OK) { return TCL_OK; } - /* Everything failed, nothing matched. Throw up an error message */ + /* + * 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); + "end, @x,y, or a number", NULL); return TCL_ERROR; } @@ -2728,26 +2789,25 @@ GetListboxIndex(interp, listPtr, indexObj, endIsSize, indexPtr) * * ChangeListboxView -- * - * Change the view on a listbox widget so that a given element - * is displayed at the top. + * Change the view on a listbox widget so that a given element is + * displayed at the top. * * Results: * None. * * Side effects: - * What's displayed on the screen is changed. If there is a - * scrollbar associated with this widget, then the scrollbar - * is instructed to change its display too. + * What's displayed on the screen is changed. If there is a scrollbar + * associated with this widget, then the scrollbar is instructed to + * change its display too. * *---------------------------------------------------------------------- */ static void -ChangeListboxView(listPtr, index) - register Listbox *listPtr; /* Information about widget. */ - int index; /* Index of element in listPtr - * that should now appear at the - * top of the listbox. */ +ChangeListboxView( + register Listbox *listPtr, /* Information about widget. */ + int index) /* Index of element in listPtr that should now + * appear at the top of the listbox. */ { if (index >= (listPtr->nElements - listPtr->fullLines)) { index = listPtr->nElements - listPtr->fullLines; @@ -2773,26 +2833,24 @@ ChangeListboxView(listPtr, index) * None. * * Side effects: - * The listbox may be redrawn to reflect its new horizontal - * offset. + * The listbox may be redrawn to reflect its new horizontal offset. * *---------------------------------------------------------------------- */ static void -ChangeListboxOffset(listPtr, offset) - register Listbox *listPtr; /* Information about widget. */ - int offset; /* Desired new "xOffset" for - * listbox. */ +ChangeListboxOffset( + register Listbox *listPtr, /* Information about widget. */ + int offset) /* Desired new "xOffset" for listbox. */ { int maxOffset; - + /* - * Make sure that the new offset is within the allowable range, and - * round it off to an even multiple of xScrollUnit. + * Make sure that the new offset is within the allowable range, and round + * it off to an even multiple of xScrollUnit. * - * Add half a scroll unit to do entry/text-like synchronization. - * [Bug #225025] + * Add half a scroll unit to do entry/text-like synchronization. [Bug + * #225025] */ offset += listPtr->xScrollUnit / 2; @@ -2818,8 +2876,8 @@ ChangeListboxOffset(listPtr, offset) * * ListboxScanTo -- * - * Given a point (presumably of the curent mouse location) - * drag the view in the window to implement the scan operation. + * Given a point (presumably of the curent mouse location) drag the view + * in the window to implement the scan operation. * * Results: * None. @@ -2831,29 +2889,26 @@ ChangeListboxOffset(listPtr, offset) */ static void -ListboxScanTo(listPtr, x, y) - register Listbox *listPtr; /* Information about widget. */ - int x; /* X-coordinate to use for scan - * operation. */ - int y; /* Y-coordinate to use for scan - * operation. */ +ListboxScanTo( + register Listbox *listPtr, /* Information about widget. */ + int x, /* X-coordinate to use for scan operation. */ + int y) /* Y-coordinate to use for scan operation. */ { int newTopIndex, newOffset, maxIndex, maxOffset; - + maxIndex = listPtr->nElements - listPtr->fullLines; maxOffset = listPtr->maxWidth + (listPtr->xScrollUnit - 1) - (Tk_Width(listPtr->tkwin) - 2*listPtr->inset - 2*listPtr->selBorderWidth - listPtr->xScrollUnit); /* - * Compute new top line for screen by amplifying the difference - * between the current position and the place where the scan - * started (the "mark" position). If we run off the top or bottom - * of the list, then reset the mark point so that the current - * position continues to correspond to the edge of the window. - * This means that the picture will start dragging as soon as the - * mouse reverses direction (without this reset, might have to slide - * mouse a long ways back before the picture starts moving again). + * Compute new top line for screen by amplifying the difference between + * the current position and the place where the scan started (the "mark" + * position). If we run off the top or bottom of the list, then reset the + * mark point so that the current position continues to correspond to the + * edge of the window. This means that the picture will start dragging as + * soon as the mouse reverses direction (without this reset, might have to + * slide mouse a long ways back before the picture starts moving again). */ newTopIndex = listPtr->scanMarkYIndex @@ -2873,7 +2928,7 @@ ListboxScanTo(listPtr, x, y) * scan started. */ - newOffset = listPtr->scanMarkXOffset - (10*(x - listPtr->scanMarkX)); + newOffset = listPtr->scanMarkXOffset - 10*(x - listPtr->scanMarkX); if (newOffset > maxOffset) { newOffset = listPtr->scanMarkXOffset = maxOffset; listPtr->scanMarkX = x; @@ -2889,13 +2944,12 @@ ListboxScanTo(listPtr, x, y) * * NearestListboxElement -- * - * Given a y-coordinate inside a listbox, compute the index of - * the element under that y-coordinate (or closest to that - * y-coordinate). + * Given a y-coordinate inside a listbox, compute the index of the + * element under that y-coordinate (or closest to that y-coordinate). * * Results: - * The return value is an index of an element of listPtr. If - * listPtr has no elements, then 0 is always returned. + * The return value is an index of an element of listPtr. If listPtr has + * no elements, then 0 is always returned. * * Side effects: * None. @@ -2904,9 +2958,9 @@ ListboxScanTo(listPtr, x, y) */ static int -NearestListboxElement(listPtr, y) - register Listbox *listPtr; /* Information about widget. */ - int y; /* Y-coordinate in listPtr's window. */ +NearestListboxElement( + register Listbox *listPtr, /* Information about widget. */ + int y) /* Y-coordinate in listPtr's window. */ { int index; @@ -2935,29 +2989,28 @@ NearestListboxElement(listPtr, y) * Standard Tcl result. * * Side effects: - * All of the elements in the range between first and last are - * marked as either selected or deselected, depending on the - * "select" argument. Any items whose state changes are redisplayed. - * The selection is claimed from X when the number of selected - * elements changes from zero to non-zero. + * All of the elements in the range between first and last are marked as + * either selected or deselected, depending on the "select" argument. Any + * items whose state changes are redisplayed. The selection is claimed + * from X when the number of selected elements changes from zero to + * non-zero. * *---------------------------------------------------------------------- */ static int -ListboxSelect(listPtr, first, last, select) - register Listbox *listPtr; /* Information about widget. */ - int first; /* Index of first element to - * select or deselect. */ - int last; /* Index of last element to - * select or deselect. */ - int select; /* 1 means select items, 0 means - * deselect them. */ +ListboxSelect( + register Listbox *listPtr, /* Information about widget. */ + int first, /* Index of first element to select or + * deselect. */ + int last, /* Index of last element to select or + * deselect. */ + int select) /* 1 means select items, 0 means deselect + * them. */ { - int i, firstRedisplay, oldCount; + int i, firstRedisplay, oldCount, isNew; Tcl_HashEntry *entry; - int new; - + if (last < first) { i = first; first = last; @@ -2976,12 +3029,13 @@ ListboxSelect(listPtr, first, last, select) firstRedisplay = -1; /* - * 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 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); + entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); if (entry != NULL) { if (!select) { Tcl_DeleteHashEntry(entry); @@ -2993,7 +3047,7 @@ ListboxSelect(listPtr, first, last, select) } else { if (select) { entry = Tcl_CreateHashEntry(listPtr->selection, - (char *)i, &new); + (char *) INT2PTR(i), &isNew); Tcl_SetHashValue(entry, (ClientData) NULL); listPtr->numSelected++; if (firstRedisplay < 0) { @@ -3019,17 +3073,16 @@ ListboxSelect(listPtr, first, last, select) * * ListboxFetchSelection -- * - * This procedure is called back by Tk when the selection is - * requested by someone. It returns part or all of the selection - * in a buffer provided by the caller. + * This procedure is called back by Tk when the selection is requested by + * someone. It returns part or all of the selection in a buffer provided + * by the caller. * * Results: - * The return value is the number of non-NULL bytes stored - * at buffer. Buffer is filled (or partially filled) with a - * NULL-terminated string containing part or all of the selection, - * as given by offset and maxBytes. The selection is returned - * as a Tcl list with one list element for each element in the - * listbox. + * The return value is the number of non-NULL bytes stored at buffer. + * Buffer is filled (or partially filled) with a NULL-terminated string + * containing part or all of the selection, as given by offset and + * maxBytes. The selection is returned as a Tcl list with one list + * element for each element in the listbox. * * Side effects: * None. @@ -3038,25 +3091,22 @@ ListboxSelect(listPtr, first, last, select) */ static int -ListboxFetchSelection(clientData, offset, buffer, maxBytes) - ClientData clientData; /* Information about listbox widget. */ - int offset; /* Offset within selection of first - * byte to be returned. */ - char *buffer; /* Location in which to place - * selection. */ - int maxBytes; /* Maximum number of bytes to place - * at buffer, not including terminating - * NULL character. */ +ListboxFetchSelection( + ClientData clientData, /* Information about listbox widget. */ + int offset, /* Offset within selection of first byte to be + * returned. */ + char *buffer, /* Location in which to place selection. */ + int maxBytes) /* Maximum number of bytes to place at buffer, + * not including terminating NULL + * character. */ { register Listbox *listPtr = (Listbox *) clientData; Tcl_DString selection; - int length, count, needNewline; + int length, count, needNewline, stringLen, i; Tcl_Obj *curElement; char *stringRep; - int stringLen; Tcl_HashEntry *entry; - int i; - + if (!listPtr->exportSelection) { return -1; } @@ -3068,7 +3118,7 @@ ListboxFetchSelection(clientData, offset, buffer, maxBytes) needNewline = 0; Tcl_DStringInit(&selection); for (i = 0; i < listPtr->nElements; i++) { - entry = Tcl_FindHashEntry(listPtr->selection, (char *)i); + entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); if (entry != NULL) { if (needNewline) { Tcl_DStringAppend(&selection, "\n", 1); @@ -3097,9 +3147,7 @@ ListboxFetchSelection(clientData, offset, buffer, maxBytes) if (count > maxBytes) { count = maxBytes; } - memcpy((VOID *) buffer, - (VOID *) (Tcl_DStringValue(&selection) + offset), - (size_t) count); + memcpy(buffer, Tcl_DStringValue(&selection) + offset, (size_t) count); } buffer[count] = '\0'; Tcl_DStringFree(&selection); @@ -3111,25 +3159,25 @@ ListboxFetchSelection(clientData, offset, buffer, maxBytes) * * ListboxLostSelection -- * - * This procedure is called back by Tk when the selection is - * grabbed away from a listbox widget. + * This procedure is called back by Tk when the selection is grabbed away + * from a listbox widget. * * Results: * None. * * Side effects: - * The existing selection is unhighlighted, and the window is - * marked as not containing a selection. + * The existing selection is unhighlighted, and the window is marked as + * not containing a selection. * *---------------------------------------------------------------------- */ static void -ListboxLostSelection(clientData) - ClientData clientData; /* Information about listbox widget. */ +ListboxLostSelection( + ClientData clientData) /* Information about listbox widget. */ { register Listbox *listPtr = (Listbox *) clientData; - + if ((listPtr->exportSelection) && (listPtr->nElements > 0)) { ListboxSelect(listPtr, 0, listPtr->nElements-1, 0); } @@ -3140,8 +3188,8 @@ ListboxLostSelection(clientData) * * EventuallyRedrawRange -- * - * Ensure that a given range of elements is eventually redrawn on - * the display (if those elements in fact appear on the display). + * Ensure that a given range of elements is eventually redrawn on the + * display (if those elements in fact appear on the display). * * Results: * None. @@ -3153,17 +3201,19 @@ ListboxLostSelection(clientData) */ static void -EventuallyRedrawRange(listPtr, first, last) - register Listbox *listPtr; /* Information about widget. */ - int first; /* Index of first element in list - * that needs to be redrawn. */ - int last; /* Index of last element in list - * that needs to be redrawn. May - * be less than first; - * these just bracket a range. */ +EventuallyRedrawRange( + register Listbox *listPtr, /* Information about widget. */ + int first, /* Index of first element in list that needs + * to be redrawn. */ + int last) /* Index of last element in list that needs to + * be redrawn. May be less than first; these + * just bracket a range. */ { - /* 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 */ + /* + * 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->flags & LISTBOX_DELETED) || !Tk_IsMapped(listPtr->tkwin)) { @@ -3178,30 +3228,30 @@ EventuallyRedrawRange(listPtr, first, last) * * ListboxUpdateVScrollbar -- * - * This procedure is invoked whenever information has changed in - * a listbox in a way that would invalidate a vertical scrollbar - * display. If there is an associated scrollbar, then this command - * updates it by invoking a Tcl command. + * This procedure is invoked whenever information has changed in a + * listbox in a way that would invalidate a vertical scrollbar display. + * If there is an associated scrollbar, then this command updates it by + * invoking a Tcl command. * * Results: * None. * * Side effects: - * A Tcl command is invoked, and an additional command may be - * invoked to process errors in the command. + * A Tcl command is invoked, and an additional command may be invoked to + * process errors in the command. * *---------------------------------------------------------------------- */ static void -ListboxUpdateVScrollbar(listPtr) - register Listbox *listPtr; /* Information about widget. */ +ListboxUpdateVScrollbar( + register Listbox *listPtr) /* Information about widget. */ { - char string[TCL_DOUBLE_SPACE * 2]; + char firstStr[TCL_DOUBLE_SPACE+1], lastStr[TCL_DOUBLE_SPACE+1]; double first, last; int result; Tcl_Interp *interp; - + if (listPtr->yScrollCmd == NULL) { return; } @@ -3209,30 +3259,32 @@ ListboxUpdateVScrollbar(listPtr) first = 0.0; last = 1.0; } else { - first = listPtr->topIndex/((double) listPtr->nElements); - last = (listPtr->topIndex+listPtr->fullLines) - /((double) listPtr->nElements); + first = listPtr->topIndex / (double) listPtr->nElements; + last = (listPtr->topIndex + listPtr->fullLines) + / (double) listPtr->nElements; if (last > 1.0) { last = 1.0; } } - sprintf(string, " %g %g", first, last); + firstStr[0] = lastStr[0] = ' '; + Tcl_PrintDouble(NULL, first, firstStr+1); + Tcl_PrintDouble(NULL, last, lastStr+1); /* - * We must hold onto the interpreter from the listPtr because the data - * at listPtr might be freed as a result of the Tcl_VarEval. + * We must hold onto the interpreter from the listPtr because the data at + * listPtr might be freed as a result of the Tcl_VarEval. */ - + interp = listPtr->interp; - Tcl_Preserve((ClientData) interp); - result = Tcl_VarEval(interp, listPtr->yScrollCmd, string, - (char *) NULL); + Tcl_Preserve(interp); + result = Tcl_VarEval(interp, listPtr->yScrollCmd, firstStr, lastStr, + NULL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (vertical scrolling command executed by listbox)"); Tcl_BackgroundError(interp); } - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -3240,26 +3292,26 @@ ListboxUpdateVScrollbar(listPtr) * * ListboxUpdateHScrollbar -- * - * This procedure is invoked whenever information has changed in - * a listbox in a way that would invalidate a horizontal scrollbar - * display. If there is an associated horizontal scrollbar, then - * this command updates it by invoking a Tcl command. + * This procedure is invoked whenever information has changed in a + * listbox in a way that would invalidate a horizontal scrollbar display. + * If there is an associated horizontal scrollbar, then this command + * updates it by invoking a Tcl command. * * Results: * None. * * Side effects: - * A Tcl command is invoked, and an additional command may be - * invoked to process errors in the command. + * A Tcl command is invoked, and an additional command may be invoked to + * process errors in the command. * *---------------------------------------------------------------------- */ static void -ListboxUpdateHScrollbar(listPtr) - register Listbox *listPtr; /* Information about widget. */ +ListboxUpdateHScrollbar( + register Listbox *listPtr) /* Information about widget. */ { - char string[TCL_DOUBLE_SPACE * 2]; + char firstStr[TCL_DOUBLE_SPACE+1], lastStr[TCL_DOUBLE_SPACE+1]; int result, windowWidth; double first, last; Tcl_Interp *interp; @@ -3273,30 +3325,33 @@ ListboxUpdateHScrollbar(listPtr) first = 0; last = 1.0; } else { - first = listPtr->xOffset/((double) listPtr->maxWidth); - last = (listPtr->xOffset + windowWidth) - /((double) listPtr->maxWidth); + register double maxWide = (double) listPtr->maxWidth; + + first = listPtr->xOffset / maxWide; + last = (listPtr->xOffset + windowWidth) / maxWide; if (last > 1.0) { last = 1.0; } } - sprintf(string, " %g %g", first, last); + firstStr[0] = lastStr[0] = ' '; + Tcl_PrintDouble(NULL, first, firstStr+1); + Tcl_PrintDouble(NULL, last, lastStr+1); /* * We must hold onto the interpreter because the data referred to at * listPtr might be freed as a result of the call to Tcl_VarEval. */ - + interp = listPtr->interp; - Tcl_Preserve((ClientData) interp); - result = Tcl_VarEval(interp, listPtr->xScrollCmd, string, - (char *) NULL); + Tcl_Preserve(interp); + result = Tcl_VarEval(interp, listPtr->xScrollCmd, firstStr, lastStr, + NULL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (horizontal scrolling command executed by listbox)"); Tcl_BackgroundError(interp); } - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -3304,60 +3359,72 @@ ListboxUpdateHScrollbar(listPtr) * * ListboxListVarProc -- * - * Called whenever the trace on the listbox list var fires. + * Called whenever the trace on the listbox list var fires. * * Results: - * None. + * None. * * Side effects: - * None. + * None. * *---------------------------------------------------------------------- */ static char * -ListboxListVarProc(clientData, interp, name1, name2, flags) - ClientData clientData; /* Information about button. */ - Tcl_Interp *interp; /* Interpreter containing variable. */ - CONST char *name1; /* Not used. */ - CONST char *name2; /* Not used. */ - int flags; /* Information about what happened. */ +ListboxListVarProc( + ClientData clientData, /* Information about button. */ + Tcl_Interp *interp, /* Interpreter containing variable. */ + const char *name1, /* Not used. */ + const char *name2, /* Not used. */ + int flags) /* Information about what happened. */ { Listbox *listPtr = (Listbox *)clientData; Tcl_Obj *oldListObj, *varListObj; - int oldLength; - int i; + int oldLength, i; Tcl_HashEntry *entry; - - /* Bwah hahahaha -- puny mortal, you can't unset a -listvar'd variable! */ + + /* + * 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_SetVar2Ex(interp, listPtr->listVarName, 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; + return NULL; } } else { oldListObj = listPtr->listObj; varListObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName, - (char *)NULL, TCL_GLOBAL_ONLY); + NULL, TCL_GLOBAL_ONLY); + /* - * Make sure the new value is a good list; if it's not, disallow - * the change -- the fact that it is a listvar means that it must - * always be a valid list -- and return an error message. + * Make sure the new value is a good list; if it's not, disallow the + * change - the fact that it is a listvar means that it must always be + * a valid list - and return an error message. */ + if (Tcl_ListObjLength(listPtr->interp, varListObj, &i) != TCL_OK) { - Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL, - oldListObj, TCL_GLOBAL_ONLY); - return("invalid listvar value"); + Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL, oldListObj, + TCL_GLOBAL_ONLY); + return (char *) "invalid listvar value"; } - + listPtr->listObj = varListObj; - /* Incr the obj ref count so it doesn't vanish if the var is unset */ + + /* + * 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 */ + + /* + * Clean up the ref to our old list obj. + */ + Tcl_DecrRefCount(oldListObj); } @@ -3365,21 +3432,29 @@ ListboxListVarProc(clientData, interp, name1, name2, flags) * If the list length has decreased, then we should clean up selection and * attributes information for elements past the end of the new list */ + oldLength = listPtr->nElements; Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements); if (listPtr->nElements < oldLength) { for (i = listPtr->nElements; i < oldLength; i++) { - /* Clean up selection */ - entry = Tcl_FindHashEntry(listPtr->selection, (char *)i); + /* + * Clean up selection. + */ + + entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); } - /* Clean up attributes */ - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *)i); + /* + * Clean up attributes. + */ + + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, + (char *) INT2PTR(i)); if (entry != NULL) { - ckfree((char *)Tcl_GetHashValue(entry)); + ckfree((char *) Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); } } @@ -3398,14 +3473,15 @@ ListboxListVarProc(clientData, interp, name1, name2, flags) /* * 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 + * (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(listPtr, 0, listPtr->nElements-1); - return (char*)NULL; + return NULL; } /* @@ -3413,10 +3489,10 @@ ListboxListVarProc(clientData, interp, name1, name2, flags) * * MigrateHashEntries -- * - * Given a hash table with entries keyed by a single integer value, - * move all entries in a given range by a fixed amount, so that - * if in the original table there was an entry with key n and - * the offset was i, in the new table that entry would have key n + i. + * Given a hash table with entries keyed by a single integer value, move + * all entries in a given range by a fixed amount, so that if in the + * original table there was an entry with key n and the offset was i, in + * the new table that entry would have key n + i. * * Results: * None. @@ -3428,39 +3504,45 @@ ListboxListVarProc(clientData, interp, name1, name2, flags) */ static void -MigrateHashEntries(table, first, last, offset) - Tcl_HashTable *table; - int first; - int last; - int offset; +MigrateHashEntries( + Tcl_HashTable *table, + int first, + int last, + int offset) { - int i, new; + int i, isNew; Tcl_HashEntry *entry; ClientData clientData; if (offset == 0) { return; } - /* It's more efficient to do one if/else and nest the for loops inside, + + /* + * It's more efficient to do one if/else and nest the for loops inside, * although we could avoid some code duplication if we nested the if/else - * inside the for loops */ + * inside the for loops. + */ + if (offset > 0) { for (i = last; i >= first; i--) { - entry = Tcl_FindHashEntry(table, (char *)i); + entry = Tcl_FindHashEntry(table, (char *) INT2PTR(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); - entry = Tcl_CreateHashEntry(table, (char *)(i + offset), &new); + entry = Tcl_CreateHashEntry(table, + (char *) INT2PTR(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } } else { for (i = first; i <= last; i++) { - entry = Tcl_FindHashEntry(table, (char *)i); + entry = Tcl_FindHashEntry(table, (char *) INT2PTR(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); - entry = Tcl_CreateHashEntry(table, (char *)(i + offset), &new); + entry = Tcl_CreateHashEntry(table, + (char *) INT2PTR(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } @@ -3468,3 +3550,10 @@ MigrateHashEntries(table, first, last, offset) return; } +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |