/[dtapublic]/projs/ets/trunk/src/c_tk_base_7_5_w_mods/tklistbox.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tk_base_7_5_w_mods/tklistbox.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.29  
changed lines
  Added in v.220

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25