/*

* 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.

*

* Copyright © 1990-1994 The Regents of the University of California.

* Copyright © 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.

*/

#include "tkInt.h"

#include "default.h"

typedef struct {

Tk_OptionTable listboxOptionTable;

/* Table defining configuration options

* available for the listbox. */

Tk_OptionTable itemAttrOptionTable;

/* Table defining configuration options

* available for listbox items. */

} ListboxOptionTables;

/*

* 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

* means that the window has been destroyed

* but the data structures haven't yet been

* 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. */

Tcl_Obj *listVarNameObj; /* List variable name */

Tcl_Obj *listObj; /* Pointer to the list object being used */

Tcl_Size nElements; /* Holds the current count of elements */

Tcl_HashTable *selection; /* Tracks selection */

Tcl_HashTable *itemAttrTable;

/* Tracks item attributes */

/*

* Information used when displaying widget:

*/

Tk_3DBorder normalBorder; /* Used for drawing border around whole

* window, plus used for background. */

Tcl_Obj *borderWidthObj; /* Width of 3-D border around window. */

int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */

Tcl_Obj *highlightWidthObj; /* 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. */

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. */

Tk_Font tkfont; /* Information about text font, or NULL. */

XColor *fgColorPtr; /* Text color in normal mode. */

XColor *dfgColorPtr; /* Text color in disabled mode. */

GC textGC; /* For drawing normal text. */

Tk_3DBorder selBorder; /* Borders and backgrounds for selected

* elements. */

Tcl_Obj *selBorderWidthObj; /* Width of border around selection. */

XColor *selFgColorPtr; /* Foreground color for selected elements. */

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 topIndex; /* Index of top-most element visible in

* window. */

int fullLines; /* Number of lines that are completely

* 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

* visible. */

int setGrid; /* Non-zero means pass gridding information to

* window manager. */

/*

* Information to support horizontal scrolling:

*/

int maxWidth; /* Width (in pixels) of widest string in

* listbox. */

int xScrollUnit; /* Number of pixels in one "unit" for

* 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). This is x scrolling information

* is not linked to justification. */

/*

* Information about what's selected or active, if any.

*/

Tcl_Obj *selectModeObj; /* Selection style: single, browse, multiple,

* 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 activeStyle; /* Style in which to draw the active element.

* One of: underline, none, dotbox */

/*

* Information for scanning:

*/

int scanMarkX; /* X-position at which scan started (e.g.

* button was pressed here). */

int scanMarkY; /* Y-position at which scan started (e.g.

* button was pressed here). */

int scanMarkXOffset; /* Value of "xOffset" field when scan

* started. */

int scanMarkYIndex; /* Index of line that was at top of window

* when scan started. */

/*

* Miscellaneous information:

*/

Tk_Cursor cursor; /* Current cursor for window, or None. */

Tcl_Obj *takeFocusObj; /* Value of -takefocus option; not used in the

* C code, but used by keyboard traversal

* scripts. May be NULL. */

Tcl_Obj *yScrollCmdObj; /* Command prefix for communicating with

* vertical scrollbar. NULL means no command

* to issue. May be NULL. */

Tcl_Obj *xScrollCmdObj; /* Command prefix for communicating with

* horizontal scrollbar. NULL means no command

* to issue. May be NULL. */

int state; /* Listbox state. */

Pixmap gray; /* Pixmap for displaying disabled text. */

int flags; /* Various flag bits: see below for

* definitions. */

Tk_Justify justify; /* Justification. */

} Listbox;

/*

* How to encode the keys for the hash tables used to store what items are

* selected and what the attributes are.

*/

#define KEY(i) ((char *) INT2PTR(i))

/*

* 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;

/*

* 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.

* LISTBOX_DELETED: This listbox has been effectively destroyed.

*/

#define REDRAW_PENDING 1

#define UPDATE_V_SCROLLBAR 2

#define UPDATE_H_SCROLLBAR 4

#define GOT_FOCUS 8

#define MAXWIDTH_IS_STALE 16

#define LISTBOX_DELETED 32

/*

* 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

};

enum activeStyle {

ACTIVE_STYLE_DOTBOX, ACTIVE_STYLE_NONE, ACTIVE_STYLE_UNDERLINE

};

static const char *const activeStyleStrings[] = {

"dotbox", "none", "underline", NULL

};

/*

* The optionSpecs table defines the valid configuration options for the

* listbox widget.

*/

static const Tk_OptionSpec optionSpecs[] = {

{TK_OPTION_STRING_TABLE, "-activestyle", "activeStyle", "ActiveStyle",

DEF_LISTBOX_ACTIVE_STYLE, TCL_INDEX_NONE, offsetof(Listbox, activeStyle),

0, activeStyleStrings, 0},

{TK_OPTION_BORDER, "-background", "background", "Background",

DEF_LISTBOX_BG_COLOR, TCL_INDEX_NONE, offsetof(Listbox, normalBorder),

0, DEF_LISTBOX_BG_MONO, 0},

{TK_OPTION_SYNONYM, "-bd", NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, "-borderwidth", 0},

{TK_OPTION_SYNONYM, "-bg", NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, "-background", 0},

{TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",

DEF_LISTBOX_BORDER_WIDTH, offsetof(Listbox, borderWidthObj), TCL_INDEX_NONE,

0, 0, 0},

{TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",

DEF_LISTBOX_CURSOR, TCL_INDEX_NONE, offsetof(Listbox, cursor),

TK_OPTION_NULL_OK, 0, 0},

{TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",

"DisabledForeground", DEF_LISTBOX_DISABLED_FG, TCL_INDEX_NONE,

offsetof(Listbox, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},

{TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",

"ExportSelection", DEF_LISTBOX_EXPORT_SELECTION, TCL_INDEX_NONE,

offsetof(Listbox, exportSelection), 0, 0, 0},

{TK_OPTION_SYNONYM, "-fg", "foreground", NULL,

NULL, 0, TCL_INDEX_NONE, 0, "-foreground", 0},

{TK_OPTION_FONT, "-font", "font", "Font",

DEF_LISTBOX_FONT, TCL_INDEX_NONE, offsetof(Listbox, tkfont), 0, 0, 0},

{TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",

DEF_LISTBOX_FG, TCL_INDEX_NONE, offsetof(Listbox, fgColorPtr), 0, 0, 0},

{TK_OPTION_INT, "-height", "height", "Height",

DEF_LISTBOX_HEIGHT, TCL_INDEX_NONE, offsetof(Listbox, height), 0, 0, 0},

{TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",

"HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG, TCL_INDEX_NONE,

offsetof(Listbox, highlightBgColorPtr), 0, 0, 0},

{TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",

DEF_LISTBOX_HIGHLIGHT, TCL_INDEX_NONE, offsetof(Listbox, highlightColorPtr),

0, 0, 0},

{TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",

"HighlightThickness", DEF_LISTBOX_HIGHLIGHT_WIDTH,

offsetof(Listbox, highlightWidthObj), TCL_INDEX_NONE, 0, 0, 0},

{TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",

DEF_LISTBOX_JUSTIFY, TCL_INDEX_NONE, offsetof(Listbox, justify), TK_OPTION_ENUM_VAR, 0, 0},

{TK_OPTION_RELIEF, "-relief", "relief", "Relief",

DEF_LISTBOX_RELIEF, TCL_INDEX_NONE, offsetof(Listbox, relief), 0, 0, 0},

{TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",

DEF_LISTBOX_SELECT_COLOR, TCL_INDEX_NONE, offsetof(Listbox, selBorder),

0, DEF_LISTBOX_SELECT_MONO, 0},

{TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",

"BorderWidth", DEF_LISTBOX_SELECT_BD, offsetof(Listbox, selBorderWidthObj),

TCL_INDEX_NONE, 0, 0, 0},

{TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",

DEF_LISTBOX_SELECT_FG_COLOR, TCL_INDEX_NONE, offsetof(Listbox, selFgColorPtr),

TK_OPTION_NULL_OK, DEF_LISTBOX_SELECT_FG_MONO, 0},

{TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode",

DEF_LISTBOX_SELECT_MODE, offsetof(Listbox, selectModeObj), TCL_INDEX_NONE,

TK_OPTION_NULL_OK, 0, 0},

{TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid",

DEF_LISTBOX_SET_GRID, TCL_INDEX_NONE, offsetof(Listbox, setGrid), 0, 0, 0},

{TK_OPTION_STRING_TABLE, "-state", "state", "State",

DEF_LISTBOX_STATE, TCL_INDEX_NONE, offsetof(Listbox, state),

0, &tkStateStrings[1], 0},

{TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",

DEF_LISTBOX_TAKE_FOCUS, offsetof(Listbox, takeFocusObj), TCL_INDEX_NONE,

TK_OPTION_NULL_OK, 0, 0},

{TK_OPTION_INT, "-width", "width", "Width",

DEF_LISTBOX_WIDTH, TCL_INDEX_NONE, offsetof(Listbox, width), 0, 0, 0},

{TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",

DEF_LISTBOX_SCROLL_COMMAND, offsetof(Listbox, xScrollCmdObj), TCL_INDEX_NONE,

TK_OPTION_NULL_OK, 0, 0},

{TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",

DEF_LISTBOX_SCROLL_COMMAND, offsetof(Listbox, yScrollCmdObj), TCL_INDEX_NONE,

TK_OPTION_NULL_OK, 0, 0},

{TK_OPTION_STRING, "-listvariable", "listVariable", "Variable",

DEF_LISTBOX_LIST_VARIABLE, offsetof(Listbox, listVarNameObj), TCL_INDEX_NONE,

TK_OPTION_NULL_OK, 0, 0},

{TK_OPTION_END, NULL, NULL, NULL, NULL, 0, TCL_INDEX_NONE, 0, 0, 0}

};

/*

* The itemAttrOptionSpecs table defines the valid configuration options for

* listbox items.

*/

static const Tk_OptionSpec itemAttrOptionSpecs[] = {

{TK_OPTION_BORDER, "-background", NULL, NULL,

NULL, TCL_INDEX_NONE, offsetof(ItemAttr, border),

TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_SYNONYM, "-bg", NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, "-background", 0},

{TK_OPTION_SYNONYM, "-fg", "foreground", NULL,

NULL, 0, TCL_INDEX_NONE, 0, "-foreground", 0},

{TK_OPTION_COLOR, "-foreground", NULL, NULL,

NULL, TCL_INDEX_NONE, offsetof(ItemAttr, fgColor),

TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_BORDER, "-selectbackground", NULL, NULL,

NULL, TCL_INDEX_NONE, offsetof(ItemAttr, selBorder),

TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_COLOR, "-selectforeground", NULL, NULL,

NULL, TCL_INDEX_NONE, offsetof(ItemAttr, selFgColor),

TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_END, NULL, NULL, NULL, NULL, 0, TCL_INDEX_NONE, 0, NULL, 0}

};

/*

* The following tables define the listbox widget commands (and sub-commands)

* and map the indexes into the string tables into enumerated types used to

* dispatch the listbox widget command.

*/

static const char *const commandNames[] = {

"activate", "bbox", "cget", "configure", "curselection", "delete", "get",

"index", "insert", "itemcget", "itemconfigure", "nearest", "scan",

"see", "selection", "size", "xview", "yview", NULL

};

enum command {

COMMAND_ACTIVATE, COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE,

COMMAND_CURSELECTION, COMMAND_DELETE, COMMAND_GET, COMMAND_INDEX,

COMMAND_INSERT, COMMAND_ITEMCGET, COMMAND_ITEMCONFIGURE,

COMMAND_NEAREST, COMMAND_SCAN, COMMAND_SEE, COMMAND_SELECTION,

COMMAND_SIZE, COMMAND_XVIEW, COMMAND_YVIEW

};

static const char *const selCommandNames[] = {

"anchor", "clear", "includes", "set", NULL

};

enum selcommand {

SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET

};

static const char *const scanCommandNames[] = {

"dragto", "mark", NULL

};

enum scancommand {

SCAN_DRAGTO, SCAN_MARK

};

static const char *const indexNames[] = {

"active", "anchor", NULL

};

enum indices {

INDEX_ACTIVE, INDEX_ANCHOR

};

/*

* Declarations for procedures defined later in this file.

*/

static void ChangeListboxOffset(Listbox *listPtr, int offset);

static void ChangeListboxView(Listbox *listPtr, int index);

static int ConfigureListbox(Tcl_Interp *interp, Listbox *listPtr,

Tcl_Size objc, Tcl_Obj *const objv[]);

static int ConfigureListboxItem(Tcl_Interp *interp,

Listbox *listPtr, ItemAttr *attrs, Tcl_Size objc,

Tcl_Obj *const objv[], Tcl_Size index);

static int ListboxDeleteSubCmd(Listbox *listPtr,

int first, int last);

static Tcl_FreeProc DestroyListbox;

static void DestroyListboxOptionTables(void *clientData,

Tcl_Interp *interp);

static void DisplayListbox(void *clientData);

static int GetListboxIndex(Tcl_Interp *interp, Listbox *listPtr,

Tcl_Obj *index, int endIsSize, Tcl_Size *indexPtr);

static int ListboxInsertSubCmd(Listbox *listPtr,

Tcl_Size index, Tcl_Size objc, Tcl_Obj *const objv[]);

static void ListboxCmdDeletedProc(void *clientData);

static void ListboxComputeGeometry(Listbox *listPtr,

int fontChanged, int maxIsStale, int updateGrid);

static void ListboxEventProc(void *clientData,

XEvent *eventPtr);

static Tcl_Size ListboxFetchSelection(void *clientData,

Tcl_Size offset, char *buffer, Tcl_Size maxBytes);

static void ListboxLostSelection(void *clientData);

static void GenerateListboxSelectEvent(Listbox *listPtr);

static void EventuallyRedrawRange(Listbox *listPtr,

Tcl_Size first, Tcl_Size 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 Tcl_ObjCmdProc ListboxWidgetObjCmd;

static int ListboxBboxSubCmd(Tcl_Interp *interp,

Listbox *listPtr, int index);

static int ListboxSelectionSubCmd(Tcl_Interp *interp,

Listbox *listPtr, Tcl_Size objc, Tcl_Obj *const objv[]);

static int ListboxXviewSubCmd(Tcl_Interp *interp,

Listbox *listPtr, Tcl_Size objc, Tcl_Obj *const objv[]);

static int ListboxYviewSubCmd(Tcl_Interp *interp,

Listbox *listPtr, Tcl_Size objc, Tcl_Obj *const objv[]);

static ItemAttr * ListboxGetItemAttributes(Tcl_Interp *interp,

Listbox *listPtr, int index);

static void ListboxWorldChanged(void *instanceData);

static int NearestListboxElement(Listbox *listPtr, int y);

static char * ListboxListVarProc(void *clientData,

Tcl_Interp *interp, const char *name1,

const char *name2, int flags);

static void MigrateHashEntries(Tcl_HashTable *table,

Tcl_Size first, Tcl_Size last, Tcl_Size offset);

static int GetMaxOffset(Listbox *listPtr);

/*

* The structure below defines button class behavior by means of procedures

* that can be invoked from generic window code.

*/

static const 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.

*

* Results:

* A standard Tcl result.

*

* Side effects:

* See the user documentation.

*

*--------------------------------------------------------------

*/

int

Tk_ListboxObjCmd(

TCL_UNUSED(void *),

Tcl_Interp *interp, /* Current interpreter. */

int objc, /* Number of arguments. */

Tcl_Obj *const objv[]) /* Argument objects. */

{

Listbox *listPtr;

Tk_Window tkwin;

ListboxOptionTables *optionTables;

if (objc < 2) {

Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");

return TCL_ERROR;

}

tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),

Tcl_GetString(objv[1]), NULL);

if (tkwin == NULL) {

return TCL_ERROR;

}

optionTables = (ListboxOptionTables *)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 void *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.

*/

Tcl_SetAssocData(interp, "ListboxOptionTables",

DestroyListboxOptionTables, optionTables);

/*

* Create the listbox option table and the listbox item option table.

*/

optionTables->listboxOptionTable =

Tk_CreateOptionTable(interp, optionSpecs);

optionTables->itemAttrOptionTable =

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).

*/

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, listPtr,

ListboxCmdDeletedProc);

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));

Tcl_InitHashTable(listPtr->itemAttrTable, TCL_ONE_WORD_KEYS);

listPtr->relief = TK_RELIEF_RAISED;

listPtr->textGC = NULL;

listPtr->selFgColorPtr = NULL;

listPtr->selTextGC = NULL;

listPtr->fullLines = 1;

listPtr->xScrollUnit = 1;

listPtr->exportSelection = 1;

listPtr->cursor = NULL;

listPtr->state = STATE_NORMAL;

listPtr->gray = None;

listPtr->justify = TK_JUSTIFY_LEFT;

/*

* Keep a hold of the associated tkwin until we destroy the listbox,

* otherwise Tk might free it while we still need it.

*/

Tcl_Preserve(listPtr->tkwin);

Tk_SetClass(listPtr->tkwin, "Listbox");

Tk_SetClassProcs(listPtr->tkwin, &listboxClass, listPtr);

Tk_CreateEventHandler(listPtr->tkwin,

ExposureMask|StructureNotifyMask|FocusChangeMask,

ListboxEventProc, listPtr);

Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,

ListboxFetchSelection, listPtr, XA_STRING);

if (Tk_InitOptions(interp, listPtr,

optionTables->listboxOptionTable, tkwin) != TCL_OK) {

Tk_DestroyWindow(listPtr->tkwin);

return TCL_ERROR;

}

if (ConfigureListbox(interp, listPtr, objc-2, objv+2) != TCL_OK) {

Tk_DestroyWindow(listPtr->tkwin);

return TCL_ERROR;

}

Tcl_SetObjResult(interp, Tk_NewWindowObj(listPtr->tkwin));

return TCL_OK;

}



/*

*----------------------------------------------------------------------

*

* 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.

*

* Results:

* A standard Tcl result.

*

* Side effects:

* See the user documentation.

*

*----------------------------------------------------------------------

*/

static int

ListboxWidgetObjCmd(

void *clientData, /* Information about listbox widget. */

Tcl_Interp *interp, /* Current interpreter. */

int objc, /* Number of arguments. */

Tcl_Obj *const objv[]) /* Arguments as Tcl_Obj's. */

{

Listbox *listPtr = (Listbox *)clientData;

int cmdIndex;

Tcl_Size index;

int result = TCL_OK;

Tcl_Obj *objPtr;

if (objc < 2) {

Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");

return TCL_ERROR;

}

/*

* 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) {

return result;

}

Tcl_Preserve(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;

}

if (index >= listPtr->nElements) {

index = listPtr->nElements-1;

}

if (index < 0) {

index = 0;

}

listPtr->active = index;

EventuallyRedrawRange(listPtr, listPtr->active, listPtr->active);

result = TCL_OK;

break;

case COMMAND_BBOX:

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

result = TCL_ERROR;

break;

}

result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);

if (result != TCL_OK) {

break;

}

result = ListboxBboxSubCmd(interp, listPtr, index);

break;

case COMMAND_CGET:

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "option");

result = TCL_ERROR;

break;

}

objPtr = Tk_GetOptionValue(interp, listPtr,

listPtr->optionTable, objv[2], listPtr->tkwin);

if (objPtr == NULL) {

result = TCL_ERROR;

break;

}

Tcl_SetObjResult(interp, objPtr);

result = TCL_OK;

break;

case COMMAND_CONFIGURE:

if (objc <= 3) {

objPtr = Tk_GetOptionInfo(interp, listPtr,

listPtr->optionTable,

(objc == 3) ? objv[2] : NULL, listPtr->tkwin);

if (objPtr == NULL) {

result = TCL_ERROR;

break;

}

Tcl_SetObjResult(interp, objPtr);

result = TCL_OK;

} else {

result = ConfigureListbox(interp, listPtr, objc-2, objv+2);

}

break;

case COMMAND_CURSELECTION: {

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.

*/

objPtr = Tcl_NewObj();

for (i = 0; i < (int)listPtr->nElements; i++) {

if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) {

Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(i));

}

}

Tcl_SetObjResult(interp, objPtr);

result = TCL_OK;

break;

}

case COMMAND_DELETE: {

Tcl_Size 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 < (int)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 >= (int)listPtr->nElements) {

last = listPtr->nElements - 1;

}

result = ListboxDeleteSubCmd(listPtr, first, last);

} else {

result = TCL_OK;

}

break;

}

case COMMAND_GET: {

Tcl_Size listLen, first, last;

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;

}

}

if (first >= (int)listPtr->nElements) {

result = TCL_OK;

break;

}

if (last >= (int)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_SetObjResult(interp,

Tcl_NewListObj(last-first+1, elemPtrs+first));

}

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, TkNewIndexObj(index));

result = TCL_OK;

break;

case COMMAND_INSERT:

if (objc < 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index ?element ...?");

result = TCL_ERROR;

break;

}

result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);

if (result != TCL_OK) {

break;

}

if (!(listPtr->state & STATE_NORMAL)) {

break;

}

result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3);

break;

case COMMAND_ITEMCGET: {

ItemAttr *attrPtr;

if (objc != 4) {

Tcl_WrongNumArgs(interp, 2, objv, "index option");

result = TCL_ERROR;

break;

}

result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);

if (result != TCL_OK) {

break;

}

if (index < 0 || index >= (int)listPtr->nElements) {

Tcl_SetObjResult(interp, Tcl_ObjPrintf(

"item number \"%s\" out of range",

Tcl_GetString(objv[2])));

Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", (char *)NULL);

result = TCL_ERROR;

break;

}

attrPtr = ListboxGetItemAttributes(interp, listPtr, index);

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;

break;

}

case COMMAND_ITEMCONFIGURE: {

ItemAttr *attrPtr;

if (objc < 3) {

Tcl_WrongNumArgs(interp, 2, objv,

"index ?-option value ...?");

result = TCL_ERROR;

break;

}

result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);

if (result != TCL_OK) {

break;

}

if (index < 0 || index >= (int)listPtr->nElements) {

Tcl_SetObjResult(interp, Tcl_ObjPrintf(

"item number \"%s\" out of range",

Tcl_GetString(objv[2])));

Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", (char *)NULL);

result = TCL_ERROR;

break;

}

attrPtr = ListboxGetItemAttributes(interp, listPtr, index);

if (objc <= 4) {

objPtr = Tk_GetOptionInfo(interp, attrPtr,

listPtr->itemAttrOptionTable,

(objc == 4) ? objv[3] : NULL, listPtr->tkwin);

if (objPtr == NULL) {

result = TCL_ERROR;

break;

}

Tcl_SetObjResult(interp, objPtr);

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;

}

result = Tcl_GetIntFromObj(interp, objv[2], &y);

if (result != TCL_OK) {

break;

}

index = NearestListboxElement(listPtr, y);

Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));

result = TCL_OK;

break;

}

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_SEE: {

int diff;

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

result = TCL_ERROR;

break;

}

result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);

if (result != TCL_OK) {

break;

}

if (index >= (int)listPtr->nElements) {

index = listPtr->nElements - 1;