/* * 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; } 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_NewWideIntObj(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(listPtr); return result; } /* *---------------------------------------------------------------------- * * ListboxBboxSubCmd -- * * This procedure is invoked to process a listbox bbox request. See the * user documentation for more information. * * Results: * A standard Tcl result. * * Side effects: * For valid indices, places the bbox of the requested element in the * interpreter's result. * *---------------------------------------------------------------------- */ static int ListboxBboxSubCmd( 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 */ { Tk_Window tkwin = listPtr->tkwin; int lastVisibleIndex; /* * Determine the index of the last visible item in the listbox. */ lastVisibleIndex = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine; if ((int)listPtr->nElements < lastVisibleIndex) { lastVisibleIndex = listPtr->nElements; } /* * Only allow bbox requests for indices that are visible. */ if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) { Tcl_Obj *el, *results[4]; const char *stringRep; int pixelWidth, x, y, result; Tcl_Size stringLen; Tk_FontMetrics fm; int selBorderWidth; /* * Compute the pixel width of the requested element. */ result = Tcl_ListObjIndex(interp, listPtr->listObj, index, &el); if (result != TCL_OK) { return result; } stringRep = Tcl_GetStringFromObj(el, &stringLen); Tk_GetFontMetrics(listPtr->tkfont, &fm); pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen); Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->selBorderWidthObj, &selBorderWidth); if (listPtr->justify == TK_JUSTIFY_LEFT) { x = (listPtr->inset + selBorderWidth) - listPtr->xOffset; } else if (listPtr->justify == TK_JUSTIFY_RIGHT) { x = Tk_Width(tkwin) - (listPtr->inset + selBorderWidth) - pixelWidth - listPtr->xOffset + GetMaxOffset(listPtr); } else { x = (Tk_Width(tkwin) - pixelWidth) / 2 - listPtr->xOffset + GetMaxOffset(listPtr) / 2; } y = ((index - listPtr->topIndex)*listPtr->lineHeight) + listPtr->inset + selBorderWidth; results[0] = Tcl_NewWideIntObj(x); results[1] = Tcl_NewWideIntObj(y); results[2] = Tcl_NewWideIntObj(pixelWidth); results[3] = Tcl_NewWideIntObj(fm.linespace); Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * ListboxSelectionSubCmd -- * * This procedure is invoked to process the selection sub command for * listbox widgets. * * Results: * Standard Tcl result. * * Side effects: * May set the interpreter's result field. * *---------------------------------------------------------------------- */ static int ListboxSelectionSubCmd( Tcl_Interp *interp, /* Pointer to the calling Tcl interpreter */ Listbox *listPtr, /* Information about the listbox */ Tcl_Size objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { int selCmdIndex; Tcl_Size first, last; int result = TCL_OK; if (objc != 4 && objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "option index ?index?"); return TCL_ERROR; } result = GetListboxIndex(interp, listPtr, objv[3], 0, &first); if (result != TCL_OK) { return result; } last = first; if (objc == 5) { result = GetListboxIndex(interp, listPtr, objv[4], 0, &last); if (result != TCL_OK) { return result; } } result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames, "option", 0, &selCmdIndex); if (result != TCL_OK) { return result; } /* * Only allow 'selection includes' to respond if disabled. [Bug #632514] */ if ((listPtr->state == STATE_DISABLED) && (selCmdIndex != SELECTION_INCLUDES)) { return TCL_OK; } switch (selCmdIndex) { case SELECTION_ANCHOR: if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "index"); return TCL_ERROR; } if (first >= (int)listPtr->nElements) { first = listPtr->nElements - 1; } if (first < 0) { first = 0; } 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, KEY(first)) != NULL)); result = TCL_OK; break; case SELECTION_SET: result = ListboxSelect(listPtr, first, last, 1); break; } return result; } /* *---------------------------------------------------------------------- * * ListboxXviewSubCmd -- * * Process the listbox "xview" subcommand. * * Results: * Standard Tcl result. * * Side effects: * May change the listbox viewing area; may set the interpreter's result. * *---------------------------------------------------------------------- */ static int ListboxXviewSubCmd( Tcl_Interp *interp, /* Pointer to the calling Tcl interpreter */ Listbox *listPtr, /* Information about the listbox */ Tcl_Size objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { int index, count, windowWidth, windowUnits; int offset = 0; /* Initialized to stop gcc warnings. */ double fraction; int selBorderWidth; Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->selBorderWidthObj, &selBorderWidth); windowWidth = Tk_Width(listPtr->tkwin) - 2 * (listPtr->inset + selBorderWidth); if (objc == 2) { Tcl_Obj *results[2]; if (listPtr->maxWidth == 0) { results[0] = Tcl_NewDoubleObj(0.0); results[1] = Tcl_NewDoubleObj(1.0); } else { double fraction2; fraction = listPtr->xOffset / (double) listPtr->maxWidth; fraction2 = (listPtr->xOffset + windowWidth) / (double) listPtr->maxWidth; if (fraction2 > 1.0) { fraction2 = 1.0; } results[0] = Tcl_NewDoubleObj(fraction); results[1] = Tcl_NewDoubleObj(fraction2); } Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } else if (objc == 3) { if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) { return TCL_ERROR; } ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit); } else { switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_MOVETO: offset = (int) (fraction*listPtr->maxWidth + 0.5); break; case TK_SCROLL_PAGES: windowUnits = windowWidth / listPtr->xScrollUnit; if (windowUnits > 2) { offset = listPtr->xOffset + count*listPtr->xScrollUnit*(windowUnits-2); } else { offset = listPtr->xOffset + count*listPtr->xScrollUnit; } break; case TK_SCROLL_UNITS: offset = listPtr->xOffset + count*listPtr->xScrollUnit; break; default: return TCL_ERROR; } ChangeListboxOffset(listPtr, offset); } return TCL_OK; } /* *---------------------------------------------------------------------- * * ListboxYviewSubCmd -- * * Process the listbox "yview" subcommand. * * Results: * Standard Tcl result. * * Side effects: * May change the listbox viewing area; may set the interpreter's result. * *---------------------------------------------------------------------- */ static int ListboxYviewSubCmd( Tcl_Interp *interp, /* Pointer to the calling Tcl interpreter */ Listbox *listPtr, /* Information about the listbox */ Tcl_Size objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { Tcl_Size index; int count; double fraction; if (objc == 2) { Tcl_Obj *results[2]; if (listPtr->nElements == 0) { results[0] = Tcl_NewDoubleObj(0.0); results[1] = Tcl_NewDoubleObj(1.0); } else { double fraction2, numEls = (double) listPtr->nElements; fraction = listPtr->topIndex / numEls; fraction2 = (listPtr->topIndex+listPtr->fullLines) / numEls; if (fraction2 > 1.0) { fraction2 = 1.0; } results[0] = Tcl_NewDoubleObj(fraction); results[1] = Tcl_NewDoubleObj(fraction2); } Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } else if (objc == 3) { if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { return TCL_ERROR; } ChangeListboxView(listPtr, index); } else { switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_MOVETO: index = (Tcl_Size)(listPtr->nElements*fraction + 0.5); break; case TK_SCROLL_PAGES: if (listPtr->fullLines > 2) { index = listPtr->topIndex + count*(listPtr->fullLines-2); } else { index = listPtr->topIndex + count; } break; case TK_SCROLL_UNITS: index = listPtr->topIndex + count; break; default: return TCL_ERROR; } ChangeListboxView(listPtr, index); } return TCL_OK; } /* *---------------------------------------------------------------------- * * ListboxGetItemAttributes -- * * 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. * * Side effects: * Memory may be allocated for the ItemAttr record. * *---------------------------------------------------------------------- */ static ItemAttr * 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 isNew; Tcl_HashEntry *entry; ItemAttr *attrs; entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, KEY(index), &isNew); if (isNew) { attrs = (ItemAttr *)ckalloc(sizeof(ItemAttr)); attrs->border = NULL; attrs->selBorder = NULL; attrs->fgColor = NULL; attrs->selFgColor = NULL; Tk_InitOptions(interp, attrs, listPtr->itemAttrOptionTable, listPtr->tkwin); Tcl_SetHashValue(entry, attrs); } else { attrs = (ItemAttr *)Tcl_GetHashValue(entry); } return attrs; } /* *---------------------------------------------------------------------- * * 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). * * Results: * None. * * Side effects: * Everything associated with the listbox is freed up. * *---------------------------------------------------------------------- */ static void DestroyListbox( #if TCL_MAJOR_VERSION > 8 void *memPtr) /* Info about listbox widget. */ #else char *memPtr) #endif { Listbox *listPtr = (Listbox *)memPtr; Tcl_HashEntry *entry; Tcl_HashSearch search; /* * If we have an internal list object, free it. */ if (listPtr->listObj != NULL) { Tcl_DecrRefCount(listPtr->listObj); listPtr->listObj = NULL; } if (listPtr->listVarNameObj != NULL) { Tcl_UntraceVar2(listPtr->interp, Tcl_GetString(listPtr->listVarNameObj), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, listPtr); } /* * Free the selection hash table. */ Tcl_DeleteHashTable(listPtr->selection); ckfree(listPtr->selection); /* * Free the item attribute hash table. */ for (entry = Tcl_FirstHashEntry(listPtr->itemAttrTable, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { ckfree(Tcl_GetHashValue(entry)); } Tcl_DeleteHashTable(listPtr->itemAttrTable); ckfree(listPtr->itemAttrTable); /* * Free up all the stuff that requires special handling, then let * Tk_FreeOptions handle all the standard option-related stuff. */ if (listPtr->textGC != NULL) { Tk_FreeGC(listPtr->display, listPtr->textGC); } if (listPtr->selTextGC != NULL) { Tk_FreeGC(listPtr->display, listPtr->selTextGC); } if (listPtr->gray != None) { Tk_FreeBitmap(Tk_Display(listPtr->tkwin), listPtr->gray); } Tk_FreeConfigOptions(listPtr, listPtr->optionTable, listPtr->tkwin); Tcl_Release(listPtr->tkwin); listPtr->tkwin = NULL; ckfree(listPtr); } /* *---------------------------------------------------------------------- * * DestroyListboxOptionTables -- * * This procedure is registered as an exit callback when the listbox * command is first called. It cleans up the OptionTables structure * allocated by that command. * * Results: * None. * * Side effects: * Frees memory. * *---------------------------------------------------------------------- */ static void DestroyListboxOptionTables( void *clientData, /* Pointer to the OptionTables struct */ TCL_UNUSED(Tcl_Interp *)) /* Pointer to the calling interp */ { ckfree(clientData); return; } /* *---------------------------------------------------------------------- * * 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. * * Results: * 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. * *---------------------------------------------------------------------- */ static int ConfigureListbox( Tcl_Interp *interp, /* Used for error reporting. */ Listbox *listPtr, /* Information about widget; may or may not * already have values for some fields. */ Tcl_Size objc, /* Number of valid entries in argv. */ Tcl_Obj *const objv[]) /* Arguments. */ { Tk_SavedOptions savedOptions; Tcl_Obj *oldListObj = NULL; Tcl_Obj *errorResult = NULL; int oldExport, error; int borderWidth, selBorderWidth, highlightWidth; oldExport = (listPtr->exportSelection) && (!Tcl_IsSafe(listPtr->interp)); if (listPtr->listVarNameObj != NULL) { Tcl_UntraceVar2(interp, Tcl_GetString(listPtr->listVarNameObj), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, listPtr); } for (error = 0; error <= 1; error++) { if (!error) { /* * First pass: set options to new values. */ if (Tk_SetOptions(interp, listPtr, listPtr->optionTable, objc, objv, listPtr->tkwin, &savedOptions, NULL) != TCL_OK) { continue; } } else { /* * Second pass: restore options to old values. */ errorResult = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errorResult); Tk_RestoreSavedOptions(&savedOptions); } /* * A few options need special processing, such as setting the * background from a 3-D border. */ Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder); Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->borderWidthObj, &borderWidth); if (borderWidth < 0) { borderWidth = 0; Tcl_DecrRefCount(listPtr->borderWidthObj); listPtr->borderWidthObj = Tcl_NewIntObj(0); Tcl_IncrRefCount(listPtr->borderWidthObj); } Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->highlightWidthObj, &highlightWidth); if (highlightWidth < 0) { highlightWidth = 0; Tcl_DecrRefCount(listPtr->highlightWidthObj); listPtr->highlightWidthObj = Tcl_NewIntObj(0); Tcl_IncrRefCount(listPtr->highlightWidthObj); } Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->selBorderWidthObj, &selBorderWidth); if (selBorderWidth < 0) { selBorderWidth = 0; Tcl_DecrRefCount(listPtr->selBorderWidthObj); listPtr->selBorderWidthObj = Tcl_NewIntObj(0); Tcl_IncrRefCount(listPtr->selBorderWidthObj); } listPtr->inset = highlightWidth + borderWidth; /* * Claim the selection if we've suddenly started exporting it and * there is a selection to export and this interp is unsafe. */ if (listPtr->exportSelection && (!oldExport) && (!Tcl_IsSafe(listPtr->interp)) && (listPtr->numSelected != 0)) { Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection, listPtr); } /* * Verify the current status of the list var. * PREVIOUS STATE | NEW STATE | ACTION * ---------------+------------+---------------------------------- * no listvar | listvar | If listvar does not exist, create it * and copy the internal list obj's * content to the new var. If it does * exist, toss the internal list obj. * * listvar | no listvar | Copy old listvar content to the * internal list obj * * listvar | listvar | no special action * * no listvar | no listvar | no special action */ oldListObj = listPtr->listObj; if (listPtr->listVarNameObj != NULL) { Tcl_Obj *listVarObj = Tcl_GetVar2Ex(interp, Tcl_GetString(listPtr->listVarNameObj), NULL, TCL_GLOBAL_ONLY); Tcl_Size dummy; if (listVarObj == NULL) { listVarObj = (oldListObj ? oldListObj : Tcl_NewObj()); if (Tcl_SetVar2Ex(interp, Tcl_GetString(listPtr->listVarNameObj), NULL, listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { continue; } } /* * 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", NULL); continue; } listPtr->listObj = listVarObj; Tcl_TraceVar2(listPtr->interp, Tcl_GetString(listPtr->listVarNameObj), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, listPtr); } else if (listPtr->listObj == NULL) { listPtr->listObj = Tcl_NewObj(); } Tcl_IncrRefCount(listPtr->listObj); if (oldListObj != NULL) { Tcl_DecrRefCount(oldListObj); } break; } if (!error) { Tk_FreeSavedOptions(&savedOptions); } /* * Make sure that the list length is correct. */ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements); if (error) { Tcl_SetObjResult(interp, errorResult); Tcl_DecrRefCount(errorResult); return TCL_ERROR; } ListboxWorldChanged(listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * 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. * * Results: * 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. * *---------------------------------------------------------------------- */ static int ConfigureListboxItem( Tcl_Interp *interp, /* Used for error reporting. */ Listbox *listPtr, /* Information about widget; may or may not * already have values for some fields. */ ItemAttr *attrs, /* Information about the item to configure */ Tcl_Size objc, /* Number of valid entries in argv. */ Tcl_Obj *const objv[], /* Arguments. */ Tcl_Size index) /* Index of the listbox item being configure */ { Tk_SavedOptions savedOptions; if (Tk_SetOptions(interp, attrs, listPtr->itemAttrOptionTable, objc, objv, listPtr->tkwin, &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". */ EventuallyRedrawRange(listPtr, index, index); return TCL_OK; } /* *--------------------------------------------------------------------------- * * 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. * * Results: * None. * * Side effects: * Listbox will be relayed out and redisplayed. * *--------------------------------------------------------------------------- */ static void ListboxWorldChanged( void *instanceData) /* Information about widget. */ { XGCValues gcValues; GC gc; unsigned long mask; 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 { 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.font = Tk_FontId(listPtr->tkfont); gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues); if (listPtr->textGC != NULL) { Tk_FreeGC(listPtr->display, listPtr->textGC); } listPtr->textGC = gc; if (listPtr->selFgColorPtr != NULL) { gcValues.foreground = listPtr->selFgColorPtr->pixel; } gcValues.font = Tk_FontId(listPtr->tkfont); mask = GCForeground | GCFont; gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues); if (listPtr->selTextGC != NULL) { Tk_FreeGC(listPtr->display, listPtr->selTextGC); } listPtr->selTextGC = gc; /* * Register the desired geometry for the window and arrange for the window * to be redisplayed. */ ListboxComputeGeometry(listPtr, 1, 1, 1); listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR; EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); } /* *-------------------------------------------------------------- * * DisplayListbox -- * * This procedure redraws the contents of a listbox window. * * Results: * None. * * Side effects: * Information appears on the screen. * *-------------------------------------------------------------- */ static void DisplayListbox( void *clientData) /* Information about window. */ { Listbox *listPtr = (Listbox *)clientData; Tk_Window tkwin = listPtr->tkwin; Display *disp = listPtr->display; GC gc; int i, limit, x, y, prevSelected, freeGC; Tcl_Size stringLen; Tk_FontMetrics fm; Tcl_Obj *curElement; Tcl_HashEntry *entry; const char *stringRep; 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. */ Pixmap pixmap; int textWidth; int borderWidth, selBorderWidth, highlightWidth; listPtr->flags &= ~REDRAW_PENDING; if (listPtr->flags & LISTBOX_DELETED) { return; } if (listPtr->flags & MAXWIDTH_IS_STALE) { ListboxComputeGeometry(listPtr, 0, 1, 0); listPtr->flags &= ~MAXWIDTH_IS_STALE; listPtr->flags |= UPDATE_H_SCROLLBAR; } Tcl_Preserve(listPtr); if (listPtr->flags & UPDATE_V_SCROLLBAR) { ListboxUpdateVScrollbar(listPtr); if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) { Tcl_Release(listPtr); return; } } if (listPtr->flags & UPDATE_H_SCROLLBAR) { ListboxUpdateHScrollbar(listPtr); if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) { Tcl_Release(listPtr); return; } } listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR); Tcl_Release(listPtr); #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). */ pixmap = Tk_GetPixmap(disp, Tk_WindowId(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin)); #else pixmap = Tk_WindowId(tkwin); #endif /* TK_NO_DOUBLE_BUFFERING */ Tk_Fill3DRectangle(tkwin, pixmap, listPtr->normalBorder, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); /* * Display each item in the listbox. */ Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->selBorderWidthObj, &selBorderWidth); limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1; if (limit >= (int)listPtr->nElements) { limit = listPtr->nElements-1; } left = right = 0; if (listPtr->xOffset > 0) { left = selBorderWidth + 1; } if ((listPtr->maxWidth - listPtr->xOffset) > (Tk_Width(listPtr->tkwin) - 2 * (listPtr->inset + selBorderWidth))) { right = 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; gc = listPtr->textGC; freeGC = 0; /* * Lookup this item in the item attributes table, to see if it has * special foreground/background colors. */ entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(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 (listPtr->state & STATE_NORMAL) { if (Tcl_FindHashEntry(listPtr->selection, KEY(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 (entry != NULL) { attrs = (ItemAttr *)Tcl_GetHashValue(entry); /* * Default GC has the values from the widget at large. */ if (listPtr->selFgColorPtr) { gcValues.foreground = listPtr->selFgColorPtr->pixel; } else { gcValues.foreground = listPtr->fgColorPtr->pixel; } 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); freeGC = 1; } } Tk_Fill3DRectangle(tkwin, pixmap, selectedBg, x, y, width, listPtr->lineHeight, 0, TK_RELIEF_FLAT); /* * Draw beveled edges around the selection, if there are * visible edges next to this element. Special considerations: * * 1. The left and right bevels may not be visible if * horizontal scrolling is enabled (the "left" & "right" * variables are zero to indicate that the corresponding * bevel is visible). * 2. Top and bottom bevels are only drawn if this is the * first or last seleted item. * 3. If the left or right bevel isn't visible, then the * "left" & "right" vars, computed above, have non-zero * values that extend the top and bottom bevels so that * the mitered corners are off-screen. */ /* Draw left bevel */ if (left == 0) { Tk_3DVerticalBevel(tkwin, pixmap, selectedBg, x, y, selBorderWidth, listPtr->lineHeight, 1, TK_RELIEF_RAISED); } /* Draw right bevel */ if (right == 0) { Tk_3DVerticalBevel(tkwin, pixmap, selectedBg, x + width - selBorderWidth, y, selBorderWidth, listPtr->lineHeight, 0, TK_RELIEF_RAISED); } /* Draw top bevel */ if (!prevSelected) { Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left, y, width+left+right, selBorderWidth, 1, 1, 1, TK_RELIEF_RAISED); } /* Draw bottom bevel */ if (i + 1 == (int)listPtr->nElements || !Tcl_FindHashEntry(listPtr->selection, KEY(i + 1))) { Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left, y + listPtr->lineHeight - selBorderWidth, width+left+right, selBorderWidth, 0, 0, 0, TK_RELIEF_RAISED); } prevSelected = 1; } else { /* * 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; gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues); freeGC = 1; } } prevSelected = 0; } } /* * Draw the actual text of this item. */ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement); stringRep = Tcl_GetStringFromObj(curElement, &stringLen); textWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen); Tk_GetFontMetrics(listPtr->tkfont, &fm); y += fm.ascent + selBorderWidth; if (listPtr->justify == TK_JUSTIFY_LEFT) { x = (listPtr->inset + selBorderWidth) - listPtr->xOffset; } else if (listPtr->justify == TK_JUSTIFY_RIGHT) { x = Tk_Width(tkwin) - (listPtr->inset + selBorderWidth) - textWidth - listPtr->xOffset + GetMaxOffset(listPtr); } else { x = (Tk_Width(tkwin) - textWidth)/2 - listPtr->xOffset + GetMaxOffset(listPtr)/2; } Tk_DrawChars(disp, pixmap, gc, listPtr->tkfont, stringRep, stringLen, x, y); /* * 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. */ Tk_UnderlineChars(disp, pixmap, gc, listPtr->tkfont, stringRep, x, y, 0, stringLen); } else if (listPtr->activeStyle == ACTIVE_STYLE_DOTBOX) { /* * Draw a dotted box around the text. */ x = listPtr->inset; y = (i - listPtr->topIndex) * listPtr->lineHeight + listPtr->inset; width = Tk_Width(tkwin) - 2 * listPtr->inset; TkDrawDottedRect(disp, pixmap, gc, x, y, width, listPtr->lineHeight); if (!freeGC) { /* * Don't bother changing if it is about to be freed. */ gcValues.line_style = LineSolid; XChangeGC(disp, gc, GCLineStyle, &gcValues); } } } if (freeGC) { Tk_FreeGC(disp, gc); } } /* * Redraw the border for the listbox to make sure that it's on top of any * of the text of the listbox entries. */ Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->borderWidthObj, &borderWidth); Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->highlightWidthObj, &highlightWidth); Tk_Draw3DRectangle(tkwin, pixmap, listPtr->normalBorder, highlightWidth, highlightWidth, Tk_Width(tkwin) - 2 * highlightWidth, Tk_Height(tkwin) - 2 * highlightWidth, borderWidth, listPtr->relief); if (highlightWidth > 0) { GC fgGC, bgGC; bgGC = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap); if (listPtr->flags & GOT_FOCUS) { fgGC = Tk_GCForColor(listPtr->highlightColorPtr, pixmap); Tk_DrawHighlightBorder(tkwin, fgGC, bgGC, highlightWidth, pixmap); } else { Tk_DrawHighlightBorder(tkwin, bgGC, bgGC, highlightWidth, pixmap); } } #ifndef TK_NO_DOUBLE_BUFFERING XCopyArea(disp, pixmap, Tk_WindowId(tkwin), listPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0); Tk_FreePixmap(disp, pixmap); #endif /* TK_NO_DOUBLE_BUFFERING */ } /* *---------------------------------------------------------------------- * * ListboxComputeGeometry -- * * 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. * *---------------------------------------------------------------------- */ static void 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 width, height, pixelWidth, pixelHeight, i, result; Tcl_Size textLength; Tk_FontMetrics fm; Tcl_Obj *element; const char *text; int selBorderWidth; 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 < (int)listPtr->nElements; i++) { /* * Compute the pixel width of the current element. */ result = Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &element); if (result != TCL_OK) { continue; } text = Tcl_GetStringFromObj(element, &textLength); Tk_GetFontMetrics(listPtr->tkfont, &fm); pixelWidth = Tk_TextWidth(listPtr->tkfont, text, textLength); if (pixelWidth > listPtr->maxWidth) { listPtr->maxWidth = pixelWidth; } } } Tk_GetFontMetrics(listPtr->tkfont, &fm); Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->selBorderWidthObj, &selBorderWidth); listPtr->lineHeight = fm.linespace + 1 + 2 * selBorderWidth; width = listPtr->width; if (width <= 0) { width = (listPtr->maxWidth + listPtr->xScrollUnit - 1) / listPtr->xScrollUnit; if (width < 1) { width = 1; } } pixelWidth = width*listPtr->xScrollUnit + 2 * listPtr->inset + 2 * selBorderWidth; height = listPtr->height; if (listPtr->height <= 0) { height = (int)listPtr->nElements; if (height < 1) { height = 1; } } pixelHeight = height*listPtr->lineHeight + 2 * listPtr->inset; Tk_GeometryRequest(listPtr->tkwin, pixelWidth, pixelHeight); Tk_SetInternalBorder(listPtr->tkwin, listPtr->inset); if (updateGrid) { if (listPtr->setGrid) { Tk_SetGrid(listPtr->tkwin, width, height, listPtr->xScrollUnit, listPtr->lineHeight); } else { Tk_UnsetGrid(listPtr->tkwin); } } } /* *---------------------------------------------------------------------- * * ListboxInsertSubCmd -- * * 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. * *---------------------------------------------------------------------- */ static int ListboxInsertSubCmd( Listbox *listPtr, /* Listbox that is to get the new elements. */ Tcl_Size index, /* Add the new elements before this * element. */ Tcl_Size objc, /* Number of new elements to add. */ Tcl_Obj *const objv[]) /* New elements (one per entry). */ { int oldMaxWidth, pixelWidth, result; Tcl_Size i, length; Tcl_Obj *newListObj; const char *stringRep; 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. */ 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 (Tcl_IsShared(listPtr->listObj)) { newListObj = Tcl_DuplicateObj(listPtr->listObj); } else { newListObj = listPtr->listObj; } 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] */ Tcl_IncrRefCount(newListObj); Tcl_DecrRefCount(listPtr->listObj); listPtr->listObj = newListObj; if (listPtr->listVarNameObj != NULL) { Tcl_SetVar2Ex(listPtr->interp, Tcl_GetString(listPtr->listVarNameObj), NULL, listPtr->listObj, TCL_GLOBAL_ONLY); } /* * 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 * information to be displayed. */ if (index <= listPtr->selectAnchor) { listPtr->selectAnchor += objc; } if (index < listPtr->topIndex) { listPtr->topIndex += objc; } if (index <= listPtr->active) { listPtr->active += objc; if ((listPtr->active >= (int)listPtr->nElements) && ((int)listPtr->nElements > 0)) { listPtr->active = listPtr->nElements-1; } } listPtr->flags |= UPDATE_V_SCROLLBAR; if (listPtr->maxWidth != oldMaxWidth) { listPtr->flags |= UPDATE_H_SCROLLBAR; } ListboxComputeGeometry(listPtr, 0, 0, 0); EventuallyRedrawRange(listPtr, index, listPtr->nElements-1); return TCL_OK; } /* *---------------------------------------------------------------------- * * ListboxDeleteSubCmd -- * * Process a listbox "delete" subcommand by removing one or more elements * from a listbox widget. * * Results: * Standard Tcl result. * * Side effects: * The listbox will be modified and (eventually) redisplayed. * *---------------------------------------------------------------------- */ static int ListboxDeleteSubCmd( 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, result, pixelWidth; Tcl_Size length; Tcl_Obj *newListObj, *element; const char *stringRep; Tcl_HashEntry *entry; /* * Adjust the range to fit within the existing elements of the listbox, * and make sure there's something to delete. */ if (first < 0) { first = 0; } if (last >= (int)listPtr->nElements) { last = listPtr->nElements-1; } count = last + 1 - first; if (count <= 0) { return TCL_OK; } /* * Foreach deleted index we must: * a) remove selection information, * b) check the width of the element; if it is equal to the max, set * widthChanged to 1, because it may be the only element with that * width. */ widthChanged = 0; for (i = first; i <= last; i++) { /* * Remove selection information. */ entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); } entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); if (entry != NULL) { ckfree(Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); } /* * Check width of the element. We only have to check if widthChanged * has not already been set to 1, because we only need one maxWidth * element to disappear for us to have to recompute the width. */ if (widthChanged == 0) { Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &element); stringRep = Tcl_GetStringFromObj(element, &length); pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length); if (pixelWidth == listPtr->maxWidth) { widthChanged = 1; } } } /* * 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. */ if (Tcl_IsShared(listPtr->listObj)) { newListObj = Tcl_DuplicateObj(listPtr->listObj); } else { newListObj = listPtr->listObj; } result = Tcl_ListObjReplace(listPtr->interp, newListObj, first, count, 0, NULL); if (result != TCL_OK) { return result; } /* * 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->listVarNameObj != NULL) { Tcl_SetVar2Ex(listPtr->interp, Tcl_GetString(listPtr->listVarNameObj), NULL, listPtr->listObj, TCL_GLOBAL_ONLY); } /* * 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. */ if (first <= listPtr->selectAnchor) { listPtr->selectAnchor -= count; if (listPtr->selectAnchor < first) { listPtr->selectAnchor = first; } } if (first <= listPtr->topIndex) { listPtr->topIndex -= count; if (listPtr->topIndex < first) { listPtr->topIndex = first; } } if (listPtr->topIndex > ((int)listPtr->nElements - listPtr->fullLines)) { listPtr->topIndex = listPtr->nElements - listPtr->fullLines; if (listPtr->topIndex < 0) { listPtr->topIndex = 0; } } if (listPtr->active > last) { listPtr->active -= count; } else if (listPtr->active >= first) { listPtr->active = first; if ((listPtr->active >= (int)listPtr->nElements) && ((int)listPtr->nElements > 0)) { listPtr->active = listPtr->nElements-1; } } listPtr->flags |= UPDATE_V_SCROLLBAR; ListboxComputeGeometry(listPtr, 0, widthChanged, 0); if (widthChanged) { listPtr->flags |= UPDATE_H_SCROLLBAR; } EventuallyRedrawRange(listPtr, first, listPtr->nElements-1); return TCL_OK; } /* *-------------------------------------------------------------- * * ListboxEventProc -- * * 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. * *-------------------------------------------------------------- */ static void ListboxEventProc( void *clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { Listbox *listPtr = (Listbox *)clientData; if (eventPtr->type == Expose) { EventuallyRedrawRange(listPtr, NearestListboxElement(listPtr, eventPtr->xexpose.y), NearestListboxElement(listPtr, eventPtr->xexpose.y + eventPtr->xexpose.height)); } else if (eventPtr->type == DestroyNotify) { if (!(listPtr->flags & LISTBOX_DELETED)) { listPtr->flags |= LISTBOX_DELETED; Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd); if (listPtr->setGrid) { Tk_UnsetGrid(listPtr->tkwin); } if (listPtr->flags & REDRAW_PENDING) { Tcl_CancelIdleCall(DisplayListbox, clientData); } Tcl_EventuallyFree(clientData, DestroyListbox); } } else if (eventPtr->type == ConfigureNotify) { int vertSpace; vertSpace = Tk_Height(listPtr->tkwin) - 2 * listPtr->inset; listPtr->fullLines = vertSpace / listPtr->lineHeight; if ((listPtr->fullLines*listPtr->lineHeight) < vertSpace) { listPtr->partialLine = 1; } else { listPtr->partialLine = 0; } listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR; ChangeListboxView(listPtr, listPtr->topIndex); 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. */ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); } else if (eventPtr->type == FocusIn) { if (eventPtr->xfocus.detail != NotifyInferior) { listPtr->flags |= GOT_FOCUS; EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); } } else if (eventPtr->type == FocusOut) { if (eventPtr->xfocus.detail != NotifyInferior) { listPtr->flags &= ~GOT_FOCUS; EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); } } } /* *---------------------------------------------------------------------- * * 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. * * Results: * None. * * Side effects: * The widget is destroyed. * *---------------------------------------------------------------------- */ static void ListboxCmdDeletedProc( void *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. */ if (!(listPtr->flags & LISTBOX_DELETED)) { Tk_DestroyWindow(listPtr->tkwin); } } /* *-------------------------------------------------------------- * * GetListboxIndex -- * * 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. * * Side effects: * None. * *-------------------------------------------------------------- */ static int 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 lastOK, /* If 1, "end" refers to the number of entries * in the listbox. If 0, "end" refers to 1 * less than the number of entries. */ Tcl_Size *indexPtr) /* Where to store converted index. */ { int result; Tcl_Size idx, index; char *stringRep; result = TkGetIntForIndex(indexObj, listPtr->nElements - 1, lastOK, &idx); if (result == TCL_OK) { if ((idx != TCL_INDEX_NONE) && (idx > listPtr->nElements)) { idx = listPtr->nElements; } *indexPtr = idx; return TCL_OK; } /* * 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; } return TCL_OK; } /* * The index didn't match any of the named indices; maybe it's an @x,y */ stringRep = Tcl_GetString(indexObj); if (stringRep[0] == '@') { /* * @x,y index */ int y; char *start; char *rest; start = stringRep + 1; rest = strchr(start, ','); if (!rest) { goto badIndex; } *rest = '\0'; if (Tcl_GetInt(NULL, start, &y) != TCL_OK) { *rest = ','; goto badIndex; } *rest = ','; start = rest+1; if (Tcl_GetInt(NULL, start, &y) != TCL_OK) { goto badIndex; } *indexPtr = NearestListboxElement(listPtr, y); return TCL_OK; } /* * Everything failed, nothing matched. Throw up an error message. */ badIndex: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad listbox index \"%s\": must be active, anchor, end, @x,y," " or an index", Tcl_GetString(indexObj))); Tcl_SetErrorCode(interp, "TK", "VALUE", "LISTBOX_INDEX", (char *)NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * ChangeListboxView -- * * 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. * *---------------------------------------------------------------------- */ static void ChangeListboxView( Listbox *listPtr, /* Information about widget. */ int index) /* Index of element in listPtr that should now * appear at the top of the listbox. */ { if (index >= ((int)listPtr->nElements - listPtr->fullLines)) { index = listPtr->nElements - listPtr->fullLines; } if (index < 0) { index = 0; } if (listPtr->topIndex != index) { listPtr->topIndex = index; EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); listPtr->flags |= UPDATE_V_SCROLLBAR; } } /* *---------------------------------------------------------------------- * * ChangListboxOffset -- * * Change the horizontal offset for a listbox. * * Results: * None. * * Side effects: * The listbox may be redrawn to reflect its new horizontal offset. * *---------------------------------------------------------------------- */ static void ChangeListboxOffset( 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. * * Add half a scroll unit to do entry/text-like synchronization. [Bug * #225025] */ offset += listPtr->xScrollUnit / 2; maxOffset = GetMaxOffset(listPtr); if (offset > maxOffset) { offset = maxOffset; } if (offset < 0) { offset = 0; } offset -= offset % listPtr->xScrollUnit; if (offset != listPtr->xOffset) { listPtr->xOffset = offset; listPtr->flags |= UPDATE_H_SCROLLBAR; EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); } } /* *---------------------------------------------------------------------- * * ListboxScanTo -- * * Given a point (presumably of the curent mouse location) drag the view * in the window to implement the scan operation. * * Results: * None. * * Side effects: * The view in the window may change. * *---------------------------------------------------------------------- */ static void ListboxScanTo( 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 = GetMaxOffset(listPtr); /* * 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 - (10*(y - listPtr->scanMarkY)) / listPtr->lineHeight; if (newTopIndex > maxIndex) { newTopIndex = listPtr->scanMarkYIndex = maxIndex; listPtr->scanMarkY = y; } else if (newTopIndex < 0) { newTopIndex = listPtr->scanMarkYIndex = 0; listPtr->scanMarkY = y; } ChangeListboxView(listPtr, newTopIndex); /* * Compute new left edge for display in a similar fashion by amplifying * the difference between the current position and the place where the * scan started. */ newOffset = listPtr->scanMarkXOffset - 10*(x - listPtr->scanMarkX); if (newOffset > maxOffset) { newOffset = listPtr->scanMarkXOffset = maxOffset; listPtr->scanMarkX = x; } else if (newOffset < 0) { newOffset = listPtr->scanMarkXOffset = 0; listPtr->scanMarkX = x; } ChangeListboxOffset(listPtr, newOffset); } /* *---------------------------------------------------------------------- * * NearestListboxElement -- * * 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. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int NearestListboxElement( Listbox *listPtr, /* Information about widget. */ int y) /* Y-coordinate in listPtr's window. */ { int index; index = (y - listPtr->inset) / listPtr->lineHeight; if (index >= (listPtr->fullLines + listPtr->partialLine)) { index = listPtr->fullLines + listPtr->partialLine - 1; } if (index < 0) { index = 0; } index += listPtr->topIndex; if (index >= (int)listPtr->nElements) { index = listPtr->nElements-1; } return index; } /* *---------------------------------------------------------------------- * * ListboxSelect -- * * Select or deselect one or more elements in a listbox.. * * Results: * 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. * *---------------------------------------------------------------------- */ static int ListboxSelect( 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, isNew; Tcl_HashEntry *entry; if (last < first) { i = first; first = last; last = i; } if ((last < 0) || (first >= (int)listPtr->nElements)) { return TCL_OK; } if (first < 0) { first = 0; } if (last >= (int)listPtr->nElements) { last = listPtr->nElements - 1; } oldCount = listPtr->numSelected; 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 (i = first; i <= last; i++) { entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { if (!select) { Tcl_DeleteHashEntry(entry); listPtr->numSelected--; if (firstRedisplay < 0) { firstRedisplay = i; } } } else { if (select) { entry = Tcl_CreateHashEntry(listPtr->selection, KEY(i), &isNew); Tcl_SetHashValue(entry, NULL); listPtr->numSelected++; if (firstRedisplay < 0) { firstRedisplay = i; } } } } if (firstRedisplay >= 0) { EventuallyRedrawRange(listPtr, first, last); } if ((oldCount == 0) && (listPtr->numSelected > 0) && (listPtr->exportSelection) && (!Tcl_IsSafe(listPtr->interp))) { Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection, listPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * 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. * * 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. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Size ListboxFetchSelection( void *clientData, /* Information about listbox widget. */ Tcl_Size offset, /* Offset within selection of first byte to be * returned. */ char *buffer, /* Location in which to place selection. */ Tcl_Size maxBytes) /* Maximum number of bytes to place at buffer, * not including terminating NULL * character. */ { Listbox *listPtr = (Listbox *)clientData; Tcl_DString selection; int count, needNewline, i; Tcl_Size length, stringLen; Tcl_Obj *curElement; const char *stringRep; Tcl_HashEntry *entry; if ((!listPtr->exportSelection) || Tcl_IsSafe(listPtr->interp)) { return -1; } /* * Use a dynamic string to accumulate the contents of the selection. */ needNewline = 0; Tcl_DStringInit(&selection); for (i = 0; i < (int)listPtr->nElements; i++) { entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { if (needNewline) { Tcl_DStringAppend(&selection, "\n", 1); } Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement); stringRep = Tcl_GetStringFromObj(curElement, &stringLen); Tcl_DStringAppend(&selection, stringRep, stringLen); needNewline = 1; } } length = Tcl_DStringLength(&selection); if (length == 0) { return -1; } /* * Copy the requested portion of the selection to the buffer. */ if (length <= offset) { count = 0; } else { count = length - offset; if (count > (int)maxBytes) { count = (int)maxBytes; } memcpy(buffer, Tcl_DStringValue(&selection) + offset, count); } buffer[count] = '\0'; Tcl_DStringFree(&selection); return count; } /* *---------------------------------------------------------------------- * * ListboxLostSelection -- * * 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. * *---------------------------------------------------------------------- */ static void ListboxLostSelection( void *clientData) /* Information about listbox widget. */ { Listbox *listPtr = (Listbox *)clientData; if ((listPtr->exportSelection) && (!Tcl_IsSafe(listPtr->interp)) && (listPtr->nElements > 0)) { ListboxSelect(listPtr, 0, listPtr->nElements-1, 0); GenerateListboxSelectEvent(listPtr); } } /* *---------------------------------------------------------------------- * * GenerateListboxSelectEvent -- * * Send an event that the listbox selection was updated. This is * equivalent to event generate $listboxWidget <> * * Results: * None * * Side effects: * Any side effect possible, depending on bindings to this event. * *---------------------------------------------------------------------- */ static void GenerateListboxSelectEvent( Listbox *listPtr) /* Information about widget. */ { Tk_SendVirtualEvent(listPtr->tkwin, "ListboxSelect", NULL); } /* *---------------------------------------------------------------------- * * EventuallyRedrawRange -- * * Ensure that a given range of elements is eventually redrawn on the * display (if those elements in fact appear on the display). * * Results: * None. * * Side effects: * Information gets redisplayed. * *---------------------------------------------------------------------- */ static void EventuallyRedrawRange( Listbox *listPtr, /* Information about widget. */ TCL_UNUSED(Tcl_Size), /* Index of first element in list that needs * to be redrawn. */ TCL_UNUSED(Tcl_Size)) /* 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. */ if ((listPtr->flags & REDRAW_PENDING) || (listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(listPtr->tkwin)) { return; } listPtr->flags |= REDRAW_PENDING; Tcl_DoWhenIdle(DisplayListbox, listPtr); } /* *---------------------------------------------------------------------- * * 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. * * Results: * None. * * Side effects: * A Tcl command is invoked, and an additional command may be invoked to * process errors in the command. * *---------------------------------------------------------------------- */ static void ListboxUpdateVScrollbar( Listbox *listPtr) /* Information about widget. */ { char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE]; double first, last; int result; Tcl_Interp *interp; Tcl_DString buf; if (listPtr->yScrollCmdObj == NULL) { return; } if (listPtr->nElements == 0) { first = 0.0; last = 1.0; } else { first = listPtr->topIndex / (double) listPtr->nElements; last = (listPtr->topIndex + listPtr->fullLines) / (double) listPtr->nElements; if (last > 1.0) { last = 1.0; } } Tcl_PrintDouble(NULL, first, firstStr); Tcl_PrintDouble(NULL, last, lastStr); /* * We must hold onto the interpreter from the listPtr because the data at * listPtr might be freed as a result of the Tcl_EvalEx. */ interp = listPtr->interp; Tcl_Preserve(interp); Tcl_DStringInit(&buf); Tcl_DStringAppend(&buf, Tcl_GetString(listPtr->yScrollCmdObj), TCL_INDEX_NONE); Tcl_DStringAppend(&buf, " ", TCL_INDEX_NONE); Tcl_DStringAppend(&buf, firstStr, TCL_INDEX_NONE); Tcl_DStringAppend(&buf, " ", TCL_INDEX_NONE); Tcl_DStringAppend(&buf, lastStr, TCL_INDEX_NONE); result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), TCL_INDEX_NONE, TCL_EVAL_GLOBAL); Tcl_DStringFree(&buf); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (vertical scrolling command executed by listbox)"); Tcl_BackgroundException(interp, result); } Tcl_Release(interp); } /* *---------------------------------------------------------------------- * * 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. * * Results: * None. * * Side effects: * A Tcl command is invoked, and an additional command may be invoked to * process errors in the command. * *---------------------------------------------------------------------- */ static void ListboxUpdateHScrollbar( Listbox *listPtr) /* Information about widget. */ { char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE]; int result, windowWidth; double first, last; Tcl_Interp *interp; Tcl_DString buf; int selBorderWidth; if (listPtr->xScrollCmdObj == NULL) { return; } Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->selBorderWidthObj, &selBorderWidth); windowWidth = Tk_Width(listPtr->tkwin) - 2 * (listPtr->inset + selBorderWidth); if (listPtr->maxWidth == 0) { first = 0; last = 1.0; } else { first = listPtr->xOffset / (double) listPtr->maxWidth; last = (listPtr->xOffset + windowWidth) / (double) listPtr->maxWidth; if (last > 1.0) { last = 1.0; } } Tcl_PrintDouble(NULL, first, firstStr); Tcl_PrintDouble(NULL, last, lastStr); /* * We must hold onto the interpreter because the data referred to at * listPtr might be freed as a result of the call to Tcl_EvalEx. */ interp = listPtr->interp; Tcl_Preserve(interp); Tcl_DStringInit(&buf); Tcl_DStringAppend(&buf, Tcl_GetString(listPtr->xScrollCmdObj), TCL_INDEX_NONE); Tcl_DStringAppend(&buf, " ", TCL_INDEX_NONE); Tcl_DStringAppend(&buf, firstStr, TCL_INDEX_NONE); Tcl_DStringAppend(&buf, " ", TCL_INDEX_NONE); Tcl_DStringAppend(&buf, lastStr, TCL_INDEX_NONE); result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), TCL_INDEX_NONE, TCL_EVAL_GLOBAL); Tcl_DStringFree(&buf); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (horizontal scrolling command executed by listbox)"); Tcl_BackgroundException(interp, result); } Tcl_Release(interp); } /* *---------------------------------------------------------------------- * * ListboxListVarProc -- * * Called whenever the trace on the listbox list var fires. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static char * ListboxListVarProc( void *clientData, /* Information about button. */ Tcl_Interp *interp, /* Interpreter containing variable. */ TCL_UNUSED(const char *), TCL_UNUSED(const char *), int flags) /* Information about what happened. */ { Listbox *listPtr = (Listbox *)clientData; Tcl_Obj *oldListObj, *varListObj; Tcl_Size oldLength, i; Tcl_HashEntry *entry; /* * Bwah hahahaha! Puny mortal, you can't unset a -listvar'd variable! */ if (flags & TCL_TRACE_UNSETS) { if (!Tcl_InterpDeleted(interp) && listPtr->listVarNameObj) { void *probe = NULL; do { probe = Tcl_VarTraceInfo(interp, Tcl_GetString(listPtr->listVarNameObj), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, probe); if (probe == (void *)listPtr) { break; } } while (probe); if (probe) { /* * We were able to fetch the unset trace for our * listVarName, which means it is not unset and not * the cause of this unset trace. Instead some outdated * former variable must be, and we should ignore it. */ return NULL; } Tcl_SetVar2Ex(interp, Tcl_GetString(listPtr->listVarNameObj), NULL, listPtr->listObj, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, Tcl_GetString(listPtr->listVarNameObj), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, clientData); return NULL; } } else { oldListObj = listPtr->listObj; varListObj = Tcl_GetVar2Ex(listPtr->interp, Tcl_GetString(listPtr->listVarNameObj), 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. */ if (Tcl_ListObjLength(listPtr->interp, varListObj, &i) != TCL_OK) { Tcl_SetVar2Ex(interp, Tcl_GetString(listPtr->listVarNameObj), 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. */ Tcl_IncrRefCount(listPtr->listObj); /* * Clean up the ref to our old list obj. */ Tcl_DecrRefCount(oldListObj); } /* * 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, KEY(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); } /* * Clean up attributes. */ entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); if (entry != NULL) { ckfree(Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); } } } if (oldLength != listPtr->nElements) { listPtr->flags |= UPDATE_V_SCROLLBAR; if (listPtr->topIndex > ((int)listPtr->nElements - listPtr->fullLines)) { listPtr->topIndex = listPtr->nElements - listPtr->fullLines; if (listPtr->topIndex < 0) { listPtr->topIndex = 0; } } } /* * The computed maxWidth may have changed as a result of this operation. * However, we don't want to recompute it every time this trace fires * (imagine the user doing 1000 lappends to the listvar). Therefore, set * the MAXWIDTH_IS_STALE flag, which will cause the width to be recomputed * next time the list is redrawn. */ listPtr->flags |= MAXWIDTH_IS_STALE; EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); return NULL; } /* *---------------------------------------------------------------------- * * 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. * * Results: * None. * * Side effects: * Rekeys some hash table entries. * *---------------------------------------------------------------------- */ static void MigrateHashEntries( Tcl_HashTable *table, Tcl_Size first, Tcl_Size last, Tcl_Size offset) { Tcl_Size i; int isNew; Tcl_HashEntry *entry; void *clientData; if (offset == 0) { return; } /* * 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. */ if (offset > 0) { for (i = last; i >= first; i--) { entry = Tcl_FindHashEntry(table, KEY(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } } else { for (i = first; i <= last; i++) { entry = Tcl_FindHashEntry(table, KEY(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } } return; } /* *---------------------------------------------------------------------- * * GetMaxOffset -- * * Passing in a listbox pointer, returns the maximum offset for the box, * i.e. the maximum possible horizontal scrolling value (in pixels). * * Results: * Listbox's maxOffset. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetMaxOffset( Listbox *listPtr) { int maxOffset, selBorderWidth; Tk_GetPixelsFromObj(NULL, listPtr->tkwin, listPtr->selBorderWidthObj, &selBorderWidth); maxOffset = listPtr->maxWidth - (Tk_Width(listPtr->tkwin) - 2 * listPtr->inset - 2 * selBorderWidth) + listPtr->xScrollUnit - 1; if (maxOffset < 0) { /* * Listbox is larger in width than its largest width item. */ maxOffset = 0; } maxOffset -= maxOffset % listPtr->xScrollUnit; return maxOffset; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */