Logo Search packages:      
Sourcecode: saods9 version File versions

tkListbox.c

/* 
 * 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 2004/04/02 22:35:07 joye Exp $
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"

#ifdef WIN32
#include "tkWinInt.h"
#endif

typedef struct {
    Tk_OptionTable listboxOptionTable;    /* Table defining configuration options
                               * available for the listbox */
    Tk_OptionTable itemAttrOptionTable;   /* Table definining configuration
                               * options available for listbox
                               * items */
} 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. */
    XColor *dfgColorPtr;      /* Text color in disabled 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. */
    int activeStyle;          /* style in which to draw the active element.
                         * One of: underline, none, dotbox */

    /*
     * Information for scanning:
     */

    int scanMarkX;            /* X-position at which scan started (e.g.
                         * button was pressed here). */
    int scanMarkY;            /* Y-position at which scan started (e.g.
                         * button was pressed here). */
    int scanMarkXOffset;      /* Value of "xOffset" field when scan
                         * started. */
    int scanMarkYIndex;       /* Index of line that was at top of window
                         * when scan started. */

    /*
     * Miscellaneous information:
     */

    Tk_Cursor cursor;         /* Current cursor for window, or None. */
    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 state;                /* Listbox state. */
    Pixmap gray;        /* Pixmap for displaying disabled text. */
    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 following enum is used to define a type for the -state option
 * of the Entry widget.  These values are used as indices into the 
 * string table below.
 */

enum state {
    STATE_DISABLED, STATE_NORMAL
};

static char *stateStrings[] = {
    "disabled", "normal", (char *) NULL
};

enum activeStyle {
    ACTIVE_STYLE_DOTBOX, ACTIVE_STYLE_NONE, ACTIVE_STYLE_UNDERLINE
};

static char *activeStyleStrings[] = {
    "dotbox", "none", "underline", (char *) NULL
};

/*
 * The optionSpecs table defines the valid configuration options for the
 * listbox widget
 */
static Tk_OptionSpec optionSpecs[] = {
    {TK_OPTION_STRING_TABLE, "-activestyle", "activeStyle", "ActiveStyle",
      DEF_LISTBOX_ACTIVE_STYLE, -1, Tk_Offset(Listbox, activeStyle),
        0, (ClientData) activeStyleStrings, 0},
    {TK_OPTION_BORDER, "-background", "background", "Background",
       DEF_LISTBOX_BG_COLOR, -1, Tk_Offset(Listbox, normalBorder),
       0, (ClientData) DEF_LISTBOX_BG_MONO, 0},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
       (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
       (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_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_COLOR, "-disabledforeground", "disabledForeground",
       "DisabledForeground", DEF_LISTBOX_DISABLED_FG, -1,
       Tk_Offset(Listbox, dfgColorPtr), 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_TABLE, "-state", "state", "State",
      DEF_LISTBOX_STATE, -1, Tk_Offset(Listbox, state), 
        0, (ClientData) stateStrings, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
       DEF_LISTBOX_TAKE_FOCUS, -1, Tk_Offset(Listbox, takeFocus),
       TK_OPTION_NULL_OK, 0, 0},
    {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 CONST 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 CONST char *selCommandNames[] = {
    "anchor", "clear", "includes", "set", (char *) NULL
};

enum selcommand {
    SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET
};

static CONST char *scanCommandNames[] = {
    "mark", "dragto", (char *) NULL
};

enum scancommand {
    SCAN_MARK, SCAN_DRAGTO
};

static CONST 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, CONST char *name1,
                      CONST 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 Tk_ClassProcs listboxClass = {
    sizeof(Tk_ClassProcs),    /* size */
    ListboxWorldChanged,      /* worldChangedProc */
};


/*
 *--------------------------------------------------------------
 *
 * 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;    /* NULL. */
    Tcl_Interp *interp;       /* Current interpreter. */
    int objc;                 /* Number of arguments. */
    Tcl_Obj *CONST objv[];    /* Argument objects. */
{
    register Listbox *listPtr;
    Tk_Window tkwin;
    ListboxOptionTables *optionTables;

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

    optionTables = (ListboxOptionTables *)
      Tcl_GetAssocData(interp, "ListboxOptionTables", NULL);
    if (optionTables == NULL) {
      /*
       * We haven't created the option tables for this widget class yet.
       * Do it now and save the a pointer to them as the 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);
    }

    /*
     * Initialize the fields of the structure that won't be initialized
     * by ConfigureListbox, or that ConfigureListbox requires to be
     * initialized already (e.g. resource pointers).
     */
    listPtr                         = (Listbox *) ckalloc(sizeof(Listbox));
    memset((void *) listPtr, 0, (sizeof(Listbox)));

    listPtr->tkwin                  = tkwin;
    listPtr->display                = Tk_Display(tkwin);
    listPtr->interp                 = interp;
    listPtr->widgetCmd              = Tcl_CreateObjCommand(interp,
          Tk_PathName(listPtr->tkwin), ListboxWidgetObjCmd,
          (ClientData) listPtr, ListboxCmdDeletedProc);
    listPtr->optionTable            = optionTables->listboxOptionTable;
    listPtr->itemAttrOptionTable    = optionTables->itemAttrOptionTable;
    listPtr->selection              =
      (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(listPtr->selection, TCL_ONE_WORD_KEYS);
    listPtr->itemAttrTable          =
      (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(listPtr->itemAttrTable, TCL_ONE_WORD_KEYS);
    listPtr->relief                 = TK_RELIEF_RAISED;
    listPtr->textGC                 = None;
    listPtr->selFgColorPtr          = None;
    listPtr->selTextGC              = None;
    listPtr->fullLines              = 1;
    listPtr->xScrollUnit            = 1;
    listPtr->exportSelection        = 1;
    listPtr->cursor                 = None;
    listPtr->state                  = STATE_NORMAL;
    listPtr->gray             = None;

    /*
     * Keep a hold of the associated tkwin until we destroy the listbox,
     * otherwise Tk might free it while we still need it.
     */

    Tcl_Preserve((ClientData) listPtr->tkwin);

    Tk_SetClass(listPtr->tkwin, "Listbox");
    Tk_SetClassProcs(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;
    }

    /*
     * Parse the command by looking up the second argument in the list
     * of valid subcommand names
     */
    result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
          "option", 0, &cmdIndex);
    if (result != TCL_OK) {
      return result;
    }

    Tcl_Preserve((ClientData)listPtr);
    /* The subcommand was valid, so continue processing */
    switch (cmdIndex) {
      case COMMAND_ACTIVATE: {
          if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "index");
            result = TCL_ERROR;
            break;
          }
          result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
          if (result != TCL_OK) {
            break;
          }

          if (!(listPtr->state & STATE_NORMAL)) {
            break;
          }

          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 (!(listPtr->state & STATE_NORMAL)) {
            break;
          }

          if (first < listPtr->nElements) {
            /*
             * if a "last index" was given, get it now; otherwise, use the
             * first index as the last index
             */
            if (objc == 4) {
                result = GetListboxIndex(interp, listPtr,
                      objv[3], 0, &last);
                if (result != TCL_OK) {
                  break;
                }
            } 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;
          }

          if (!(listPtr->state & STATE_NORMAL)) {
            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;
    }

    /*
     * Only allow 'selection includes' to respond if disabled. [Bug #632514]
     */

    if ((listPtr->state == STATE_DISABLED)
          && (selCmdIndex != SELECTION_INCLUDES)) {
      return TCL_OK;
    }

    switch (selCmdIndex) {
      case SELECTION_ANCHOR: {
          if (objc != 4) {
            Tcl_WrongNumArgs(interp, 3, objv, "index");
            return TCL_ERROR;
          }
          if (first >= listPtr->nElements) {
            first = listPtr->nElements - 1;
          }
          if (first < 0) {
            first = 0;
          }
          listPtr->selectAnchor = first;
          result = TCL_OK;
          break;
      }
      case SELECTION_CLEAR: {
          result = ListboxSelect(listPtr, first, last, 0);
          break;
      }
      case SELECTION_INCLUDES: {
          if (objc != 4) {
            Tcl_WrongNumArgs(interp, 3, objv, "index");
            return TCL_ERROR;
          }
          Tcl_SetObjResult(interp,
                Tcl_NewBooleanObj((Tcl_FindHashEntry(listPtr->selection,
                      (char *)first) != NULL)));
          result = TCL_OK;
          break;
      }
      case SELECTION_SET: {
          result = ListboxSelect(listPtr, first, last, 1);
          break;
      }
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxXviewSubCmd --
 *
 *    Process the listbox "xview" subcommand.
 *
 * Results:
 *    Standard Tcl result.
 *
 * Side effects:
 *    May change the listbox viewing area; may set the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxXviewSubCmd(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;

    /* 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);
    }
    if (listPtr->gray != None) {
      Tk_FreeBitmap(Tk_Display(listPtr->tkwin), listPtr->gray);
    }

    Tk_FreeConfigOptions((char *)listPtr, listPtr->optionTable,
          listPtr->tkwin);
    Tcl_Release((ClientData) 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;
    Tcl_Obj *errorResult = NULL;
    int oldExport, error;

    oldExport = listPtr->exportSelection;
    if (listPtr->listVarName != NULL) {
      Tcl_UntraceVar(interp, listPtr->listVarName,
            TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
            ListboxListVarProc, (ClientData) listPtr);
    }

    for (error = 0; error <= 1; error++) {
      if (!error) {
          /*
           * First pass: set options to new values.
           */

          if (Tk_SetOptions(interp, (char *) listPtr,
                listPtr->optionTable, objc, objv,
                listPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
            continue;
          }
      } else {
          /*
           * Second pass: restore options to old values.
           */

          errorResult = Tcl_GetObjResult(interp);
          Tcl_IncrRefCount(errorResult);
          Tk_RestoreSavedOptions(&savedOptions);
      }

      /*
       * A few options need special processing, such as setting the
       * background from a 3-D border.
       */

      Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder);

      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) {
            listVarObj = (oldListObj ? oldListObj : Tcl_NewObj());
            if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *) NULL,
                  listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
                  == NULL) {
                if (oldListObj == NULL) {
                  Tcl_DecrRefCount(listVarObj);
                }
                continue;
            }
          }
          /* Make sure the object is a good list object */
          if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy)
                != TCL_OK) {
            Tcl_AppendResult(listPtr->interp,
                  ": invalid -listvariable value", (char *) NULL);
            continue;
          }

          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);
      }
      break;
    }
    if (!error) {
      Tk_FreeSavedOptions(&savedOptions);
    }

    /* Make sure that the list length is correct */
    Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
    
    if (error) {
        Tcl_SetObjResult(interp, errorResult);
      Tcl_DecrRefCount(errorResult);
      return TCL_ERROR;
    } else {
      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;

    if (listPtr->state & STATE_NORMAL) {
      gcValues.foreground = listPtr->fgColorPtr->pixel;
      gcValues.graphics_exposures = False;
      mask = GCForeground | GCFont | GCGraphicsExposures;
    } else {
      if (listPtr->dfgColorPtr != NULL) {
          gcValues.foreground = listPtr->dfgColorPtr->pixel;
          gcValues.graphics_exposures = False;
          mask = GCForeground | GCFont | GCGraphicsExposures;
      } else {
          gcValues.foreground = listPtr->fgColorPtr->pixel;
          mask = GCForeground | GCFont;
          if (listPtr->gray == None) {
            listPtr->gray = Tk_GetBitmap(NULL, listPtr->tkwin, "gray50");
          }
          if (listPtr->gray != None) {
            gcValues.fill_style = FillStippled;
            gcValues.stipple = listPtr->gray;
            mask |= GCFillStyle | GCStipple;
          }
      }
    }

    gcValues.font = Tk_FontId(listPtr->tkfont);
    gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
    if (listPtr->textGC != 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, freeGC;
    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 & LISTBOX_DELETED) {
      return;
    }

    if (listPtr->flags & MAXWIDTH_IS_STALE) {
      ListboxComputeGeometry(listPtr, 0, 1, 0);
      listPtr->flags &= ~MAXWIDTH_IS_STALE;
      listPtr->flags |= UPDATE_H_SCROLLBAR;
    }

    Tcl_Preserve((ClientData) listPtr);
    if (listPtr->flags & UPDATE_V_SCROLLBAR) {
      ListboxUpdateVScrollbar(listPtr);
      if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) {
          Tcl_Release((ClientData) listPtr);
          return;
      }
    }
    if (listPtr->flags & UPDATE_H_SCROLLBAR) {
      ListboxUpdateHScrollbar(listPtr);
      if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) {
          Tcl_Release((ClientData) listPtr);
          return;
      }
    }
    listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR);
    Tcl_Release((ClientData) listPtr);

    /*
     * 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;
      freeGC = 0;
      /*
       * 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 listbox is enabled, items may be drawn differently;
       * they may be drawn selected, or they may have special foreground
       * or background colors.
       */
      if (listPtr->state & STATE_NORMAL) {
          if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) {
            /* Selected items are drawn differently. */
            gc = listPtr->selTextGC;
            width = Tk_Width(tkwin) - 2*listPtr->inset;
            selectedBg = listPtr->selBorder;
            
            /* If there is attribute information for this item,
             * adjust the drawing accordingly */
            if (entry != NULL) {
                attrs = (ItemAttr *)Tcl_GetHashValue(entry);
                /* Default GC has the values from the widget at large */
                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);
                  freeGC = 1;
                }
            }

            Tk_Fill3DRectangle(tkwin, pixmap, selectedBg, x, y,
                  width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);

            /*
             * Draw beveled edges around the selection, if there are
             * visible edges next to this element. Special considerations:
             *
             * 1. The left and right bevels may not be visible if
             *    horizontal scrolling is enabled (the "left" & "right"
             *    variables are zero to indicate that the corresponding
             *    bevel is visible).
             * 2. Top and bottom bevels are only drawn if this is the
             *    first or last seleted item.
             * 3. If the left or right bevel isn't visible, then the
             *    "left" & "right" vars, computed above, have non-zero
             *    values that extend the top and bottom bevels so that
             *    the mitered corners are off-screen.
             */

            /* Draw left bevel */
            if (left == 0) {
                Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
                      x, y, 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 the item has its own background color, draw it now.
                 */
                
                if (attrs->border != NULL) {
                  width = Tk_Width(tkwin) - 2*listPtr->inset;
                  Tk_Fill3DRectangle(tkwin, pixmap, attrs->border, x, y,
                        width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
                }
                
                /*
                 * If the item has its own foreground, use it to override
                 * the value in the gcValues structure.
                 */
                
                if ((listPtr->state & STATE_NORMAL)
                      && attrs->fgColor != NULL) {
                  gcValues.foreground = attrs->fgColor->pixel;
                  gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
                  freeGC = 1;
                }
            }
            prevSelected = 0;
          }
      }

      /* Draw the actual text of this item */
      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, apply the activestyle to it. */
      if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
          if (listPtr->activeStyle == ACTIVE_STYLE_UNDERLINE) {
            /* Underline the text. */
            Tk_UnderlineChars(listPtr->display, pixmap, gc,
                  listPtr->tkfont, stringRep, x, y, 0, stringLen);
          } else if (listPtr->activeStyle == ACTIVE_STYLE_DOTBOX) {
#ifdef WIN32
            /*
             * This provides for exact default look and feel on Windows.
             */
            TkWinDCState state;
            HDC dc;
            RECT rect;

            dc = TkWinGetDrawableDC(listPtr->display, pixmap, &state);
            rect.left   = listPtr->inset;
            rect.top    = ((i - listPtr->topIndex) * listPtr->lineHeight) 
                + listPtr->inset;
            rect.right  = rect.left + width;
            rect.bottom = rect.top + listPtr->lineHeight;
            DrawFocusRect(dc, &rect);
            TkWinReleaseDrawableDC(pixmap, dc, &state);
#else
            /*
             * Draw a dotted box around the text.
             */
            x = listPtr->inset;
            y = ((i - listPtr->topIndex) * listPtr->lineHeight)
                + listPtr->inset;
            width = Tk_Width(tkwin) - 2*listPtr->inset - 1;

            gcValues.line_style  = LineOnOffDash;
            gcValues.line_width  = listPtr->selBorderWidth;
            if (gcValues.line_width <= 0) {
                gcValues.line_width  = 1;
            }
            gcValues.dash_offset = 0;
            gcValues.dashes      = 1;
            /*
             * You would think the XSetDashes was necessary, but it
             * appears that the default dotting for just saying we
             * want dashes appears to work correctly.
             static char dashList[] = { 1 };
             static int  dashLen    = sizeof(dashList);
             XSetDashes(listPtr->display, gc, 0, dashList, dashLen);
             */
            mask = GCLineWidth | GCLineStyle | GCDashList | GCDashOffset;
            XChangeGC(listPtr->display, gc, mask, &gcValues);
            XDrawRectangle(listPtr->display, pixmap, gc, x, y,
                  (unsigned) width, (unsigned) listPtr->lineHeight - 1);
            if (!freeGC) {
                /* Don't bother changing if it is about to be freed. */
                gcValues.line_style = LineSolid;
                XChangeGC(listPtr->display, gc, GCLineStyle, &gcValues);
            }
#endif
          }
      }

      if (freeGC) {
          Tk_FreeGC(listPtr->display, gc);
      }
    }

    /*
     * Redraw the border for the listbox to make sure that it's on top
     * of any of the text of the listbox entries.
     */

    Tk_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) {
          ckfree((char *)Tcl_GetHashValue(entry));
          Tcl_DeleteHashEntry(entry);
      }
      
      /* Check width of the element.  We only have to check if widthChanged
       * has not already been set to 1, because we only need one maxWidth
       * element to disappear for us to have to recompute the width
       */
      if (widthChanged == 0) {
          Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &element);
          stringRep = Tcl_GetStringFromObj(element, &length);
          pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
          if (pixelWidth == listPtr->maxWidth) {
            widthChanged = 1;
          }
      }
    }

    /* Adjust selection and attribute info for indices after lastIndex */
    MigrateHashEntries(listPtr->selection, last+1,
          listPtr->nElements-1, count*-1);
    MigrateHashEntries(listPtr->itemAttrTable, last+1,
          listPtr->nElements-1, count*-1);

    /* Delete the requested elements */
    if (Tcl_IsShared(listPtr->listObj)) {
      newListObj = Tcl_DuplicateObj(listPtr->listObj);
    } else {
      newListObj = listPtr->listObj;
    }
    result = Tcl_ListObjReplace(listPtr->interp,
          newListObj, first, count, 0, NULL);
    if (result != TCL_OK) {
      return result;
    }

    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) {
      if (!(listPtr->flags & LISTBOX_DELETED)) {
          listPtr->flags |= LISTBOX_DELETED;
          Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
          if (listPtr->setGrid) {
            Tk_UnsetGrid(listPtr->tkwin);
          }
          if (listPtr->flags & REDRAW_PENDING) {
            Tcl_CancelIdleCall(DisplayListbox, clientData);
          }
          Tcl_EventuallyFree(clientData, DestroyListbox);
      }
    } else if (eventPtr->type == ConfigureNotify) {
      int vertSpace;

      vertSpace = Tk_Height(listPtr->tkwin) - 2*listPtr->inset;
      listPtr->fullLines = vertSpace / listPtr->lineHeight;
      if ((listPtr->fullLines*listPtr->lineHeight) < vertSpace) {
          listPtr->partialLine = 1;
      } else {
          listPtr->partialLine = 0;
      }
      listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
      ChangeListboxView(listPtr, listPtr->topIndex);
      ChangeListboxOffset(listPtr, listPtr->xOffset);

      /*
       * Redraw the whole listbox.  It's hard to tell what needs
       * to be redrawn (e.g. if the listbox has shrunk then we
       * may only need to redraw the borders), so just redraw
       * everything for safety.
       */

      EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
    } else if (eventPtr->type == FocusIn) {
      if (eventPtr->xfocus.detail != NotifyInferior) {
          listPtr->flags |= GOT_FOCUS;
          EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
      }
    } else if (eventPtr->type == FocusOut) {
      if (eventPtr->xfocus.detail != NotifyInferior) {
          listPtr->flags &= ~GOT_FOCUS;
          EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
      }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxCmdDeletedProc --
 *
 *    This procedure is invoked when a widget command is deleted.  If
 *    the widget isn't already in the process of being destroyed,
 *    this command destroys it.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The widget is destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
ListboxCmdDeletedProc(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.
     *
     * Add half a scroll unit to do entry/text-like synchronization.
     * [Bug #225025]
     */

    offset += listPtr->xScrollUnit / 2;
    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->flags & LISTBOX_DELETED)
          || !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. */
    CONST char *name1;          /* Not used. */
    CONST char *name2;          /* Not used. */
    int flags;                  /* Information about what happened. */
{
    Listbox *listPtr = (Listbox *)clientData;
    Tcl_Obj *oldListObj, *varListObj;
    int oldLength;
    int i;
    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) {
            ckfree((char *)Tcl_GetHashValue(entry));
            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;
}


Generated by  Doxygen 1.6.0   Back to index