/* 
 * 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 144 2003-02-05 10:56:26Z mdejong $
 */

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

typedef struct {
    Tk_OptionTable listboxOptionTable;	/* Table defining configuration options
					 * available for the listbox */
    Tk_OptionTable itemAttrOptionTable;	/* Table definining configuration
					 * options available for listbox
					 * items */
} ListboxOptionTables;

/*
 * A data structure of the following type is kept for each listbox
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the listbox.  NULL
				 * means that the window has been destroyed
				 * but the data structures haven't yet been
				 * cleaned up.*/
    Display *display;		/* Display containing widget.  Used, among
				 * other things, so that resources can be
				 * freed even after tkwin has gone away. */
    Tcl_Interp *interp;		/* Interpreter associated with listbox. */
    Tcl_Command widgetCmd;	/* Token for listbox's widget command. */
    Tk_OptionTable optionTable;	/* Table that defines configuration options
				 * available for this widget. */
    Tk_OptionTable itemAttrOptionTable;	/* Table that defines configuration
					 * options available for listbox
					 * items */
    char *listVarName;          /* List variable name */
    Tcl_Obj *listObj;           /* Pointer to the list object being used */
    int nElements;              /* Holds the current count of elements */
    Tcl_HashTable *selection;   /* Tracks selection */
    Tcl_HashTable *itemAttrTable;	/* Tracks item attributes */

    /*
     * Information used when displaying widget:
     */

    Tk_3DBorder normalBorder;	/* Used for drawing border around whole
				 * window, plus used for background. */
    int borderWidth;		/* Width of 3-D border around window. */
    int relief;			/* 3-D effect: TK_RELIEF_RAISED, etc. */
    int highlightWidth;		/* Width in pixels of highlight to draw
				 * around widget when it has the focus.
				 * <= 0 means don't draw a highlight. */
    XColor *highlightBgColorPtr;
				/* Color for drawing traversal highlight
				 * area when highlight is off. */
    XColor *highlightColorPtr;	/* Color for drawing traversal highlight. */
    int inset;			/* Total width of all borders, including
				 * traversal highlight and 3-D border.
				 * Indicates how much interior stuff must
				 * be offset from outside edges to leave
				 * room for borders. */
    Tk_Font tkfont;		/* Information about text font, or NULL. */
    XColor *fgColorPtr;		/* Text color in normal mode. */
    GC textGC;			/* For drawing normal text. */
    Tk_3DBorder selBorder;	/* Borders and backgrounds for selected
				 * elements. */
    int selBorderWidth;		/* Width of border around selection. */
    XColor *selFgColorPtr;	/* Foreground color for selected elements. */
    GC selTextGC;		/* For drawing selected text. */
    int width;			/* Desired width of window, in characters. */
    int height;			/* Desired height of window, in lines. */
    int lineHeight;		/* Number of pixels allocated for each line
				 * in display. */
    int topIndex;		/* Index of top-most element visible in
				 * window. */
    int fullLines;		/* Number of lines that fit are completely
				 * visible in window.  There may be one
				 * additional line at the bottom that is
				 * partially visible. */
    int partialLine;		/* 0 means that the window holds exactly
				 * fullLines lines.  1 means that there is
				 * one additional line that is partially
				 * visble. */
    int setGrid;		/* Non-zero means pass gridding information
				 * to window manager. */

    /*
     * Information to support horizontal scrolling:
     */

    int maxWidth;		/* Width (in pixels) of widest string in
				 * listbox. */
    int xScrollUnit;		/* Number of pixels in one "unit" for
				 * horizontal scrolling (window scrolls
				 * horizontally in increments of this size).
				 * This is an average character size. */
    int xOffset;		/* The left edge of each string in the
				 * listbox is offset to the left by this
				 * many pixels (0 means no offset, positive
				 * means there is an offset). */

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

    Tk_Uid selectMode;		/* Selection style: single, browse, multiple,
				 * or extended.  This value isn't used in C
				 * code, but the Tcl bindings use it. */
    int numSelected;		/* Number of elements currently selected. */
    int selectAnchor;		/* Fixed end of selection (i.e. element
				 * at which selection was started.) */
    int exportSelection;	/* Non-zero means tie internal listbox
				 * to X selection. */
    int active;			/* Index of "active" element (the one that
				 * has been selected by keyboard traversal).
				 * -1 means none. */

    /*
     * Information for scanning:
     */

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

    /*
     * Miscellaneous information:
     */

    Tk_Cursor cursor;		/* Current cursor for window, or None. */
    char *takeFocus;		/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts.  Malloc'ed, but may be NULL. */
    char *yScrollCmd;		/* Command prefix for communicating with
				 * vertical scrollbar.  NULL means no command
				 * to issue.  Malloc'ed. */
    char *xScrollCmd;		/* Command prefix for communicating with
				 * horizontal scrollbar.  NULL means no command
				 * to issue.  Malloc'ed. */
    int flags;			/* Various flag bits:  see below for
				 * definitions. */
} Listbox;

/*
 * ItemAttr structures are used to store item configuration information for
 * the items in a listbox
 */
typedef struct {
    Tk_3DBorder border;		/* Used for drawing background around text */
    Tk_3DBorder selBorder;	/* Used for selected text */
    XColor *fgColor;		/* Text color in normal mode. */
    XColor *selFgColor;		/* Text color in selected mode. */
} ItemAttr;    

/*
 * Flag bits for listboxes:
 *
 * REDRAW_PENDING:		Non-zero means a DoWhenIdle handler
 *				has already been queued to redraw
 *				this window.
 * UPDATE_V_SCROLLBAR:		Non-zero means vertical scrollbar needs
 *				to be updated.
 * UPDATE_H_SCROLLBAR:		Non-zero means horizontal scrollbar needs
 *				to be updated.
 * GOT_FOCUS:			Non-zero means this widget currently
 *				has the input focus.
 * MAXWIDTH_IS_STALE:           Stored maxWidth may be out-of-date
 * LISTBOX_DELETED:		This listbox has been effectively destroyed.
 */

#define REDRAW_PENDING		1
#define UPDATE_V_SCROLLBAR	2
#define UPDATE_H_SCROLLBAR	4
#define GOT_FOCUS		8
#define MAXWIDTH_IS_STALE	16
#define LISTBOX_DELETED		32

/*
 * The optionSpecs table defines the valid configuration options for the
 * listbox widget
 */
static Tk_OptionSpec optionSpecs[] = {
    {TK_OPTION_BORDER, "-background", "background", "Background",
	 DEF_LISTBOX_BG_COLOR, -1, Tk_Offset(Listbox, normalBorder),
	 0, (ClientData) DEF_LISTBOX_BG_MONO, 0},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	 (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	 (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	 DEF_LISTBOX_BORDER_WIDTH, -1, Tk_Offset(Listbox, borderWidth),
	 0, 0, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	 DEF_LISTBOX_CURSOR, -1, Tk_Offset(Listbox, cursor),
	 TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
	 "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION, -1,
	 Tk_Offset(Listbox, exportSelection), 0, 0, 0},
    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	 (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	 DEF_LISTBOX_FONT, -1, Tk_Offset(Listbox, tkfont), 0, 0, 0},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	 DEF_LISTBOX_FG, -1, Tk_Offset(Listbox, fgColorPtr), 0, 0, 0},
    {TK_OPTION_INT, "-height", "height", "Height",
	 DEF_LISTBOX_HEIGHT, -1, Tk_Offset(Listbox, height), 0, 0, 0},
    {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
	 "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG, -1, 
	 Tk_Offset(Listbox, highlightBgColorPtr), 0, 0, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	 DEF_LISTBOX_HIGHLIGHT, -1, Tk_Offset(Listbox, highlightColorPtr),
	 0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	 "HighlightThickness", DEF_LISTBOX_HIGHLIGHT_WIDTH, -1,
	 Tk_Offset(Listbox, highlightWidth), 0, 0, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	 DEF_LISTBOX_RELIEF, -1, Tk_Offset(Listbox, relief), 0, 0, 0},
    {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
	 DEF_LISTBOX_SELECT_COLOR, -1, Tk_Offset(Listbox, selBorder),
	 0, (ClientData) DEF_LISTBOX_SELECT_MONO, 0},
    {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
	 "BorderWidth", DEF_LISTBOX_SELECT_BD, -1,
	 Tk_Offset(Listbox, selBorderWidth), 0, 0, 0},
    {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
	 DEF_LISTBOX_SELECT_FG_COLOR, -1, Tk_Offset(Listbox, selFgColorPtr),
	 0, (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0},
    {TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode",
	 DEF_LISTBOX_SELECT_MODE, -1, Tk_Offset(Listbox, selectMode),
	 TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
	 DEF_LISTBOX_SET_GRID, -1, Tk_Offset(Listbox, setGrid), 0, 0, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	 DEF_LISTBOX_TAKE_FOCUS, -1, Tk_Offset(Listbox, takeFocus),
	 TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_INT, "-width", "width", "Width",
	 DEF_LISTBOX_WIDTH, -1, Tk_Offset(Listbox, width), 0, 0, 0},
    {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
	 DEF_LISTBOX_SCROLL_COMMAND, -1, Tk_Offset(Listbox, xScrollCmd),
	 TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
	 DEF_LISTBOX_SCROLL_COMMAND, -1, Tk_Offset(Listbox, yScrollCmd),
	 TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-listvariable", "listVariable", "Variable",
	 DEF_LISTBOX_LIST_VARIABLE, -1, Tk_Offset(Listbox, listVarName),
	 TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	 (char *) NULL, 0, -1, 0, 0, 0}
};

/*
 * The itemAttrOptionSpecs table defines the valid configuration options for
 * listbox items
 */
static Tk_OptionSpec itemAttrOptionSpecs[] = {
    {TK_OPTION_BORDER, "-background", "background", "Background",
	 (char *)NULL, -1, Tk_Offset(ItemAttr, border),
	 TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
     (ClientData) DEF_LISTBOX_BG_MONO, 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	 (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	 (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	 (char *) NULL, -1, Tk_Offset(ItemAttr, fgColor),
	 TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0},
    {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
	 (char *) NULL, -1, Tk_Offset(ItemAttr, selBorder),
	 TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
     (ClientData) DEF_LISTBOX_SELECT_MONO, 0},
    {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
	 (char *) NULL, -1, Tk_Offset(ItemAttr, selFgColor),
	 TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
     (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	 (char *) NULL, 0, -1, 0, 0, 0}
};

/*
 * The following tables define the listbox widget commands (and sub-
 * commands) and map the indexes into the string tables into 
 * enumerated types used to dispatch the listbox widget command.
 */
static char *commandNames[] = {
    "activate", "bbox", "cget", "configure", "curselection", "delete", "get",
	"index", "insert", "itemcget", "itemconfigure", "nearest", "scan",
	"see", "selection", "size", "xview", "yview",
    (char *) NULL
};

enum command {
    COMMAND_ACTIVATE, COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE,
	COMMAND_CURSELECTION, COMMAND_DELETE, COMMAND_GET, COMMAND_INDEX,
	COMMAND_INSERT, COMMAND_ITEMCGET, COMMAND_ITEMCONFIGURE,
	COMMAND_NEAREST, COMMAND_SCAN, COMMAND_SEE, COMMAND_SELECTION,
	COMMAND_SIZE, COMMAND_XVIEW, COMMAND_YVIEW
};

static char *selCommandNames[] = {
    "anchor", "clear", "includes", "set", (char *) NULL
};

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

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

enum scancommand {
    SCAN_MARK, SCAN_DRAGTO
};

static char *indexNames[] = {
    "active", "anchor", "end", (char *)NULL
};

enum indices {
    INDEX_ACTIVE, INDEX_ANCHOR, INDEX_END
};


/* Declarations for procedures defined later in this file */
static void		ChangeListboxOffset _ANSI_ARGS_((Listbox *listPtr,
			    int offset));
static void		ChangeListboxView _ANSI_ARGS_((Listbox *listPtr,
			    int index));
static int		ConfigureListbox _ANSI_ARGS_((Tcl_Interp *interp,
			    Listbox *listPtr, int objc, Tcl_Obj *CONST objv[],
			    int flags));
static int		ConfigureListboxItem _ANSI_ARGS_ ((Tcl_Interp *interp,
			    Listbox *listPtr, ItemAttr *attrs, int objc,
			    Tcl_Obj *CONST objv[]));
static int		ListboxDeleteSubCmd _ANSI_ARGS_((Listbox *listPtr,
			    int first, int last));
static void		DestroyListbox _ANSI_ARGS_((char *memPtr));
static void		DestroyListboxOptionTables _ANSI_ARGS_ (
			    (ClientData clientData, Tcl_Interp *interp));
static void		DisplayListbox _ANSI_ARGS_((ClientData clientData));
static int		GetListboxIndex _ANSI_ARGS_((Tcl_Interp *interp,
			    Listbox *listPtr, Tcl_Obj *index, int endIsSize,
			    int *indexPtr));
static int		ListboxInsertSubCmd _ANSI_ARGS_((Listbox *listPtr,
			    int index, int objc, Tcl_Obj *CONST objv[]));
static void		ListboxCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static void		ListboxComputeGeometry _ANSI_ARGS_((Listbox *listPtr,
			    int fontChanged, int maxIsStale, int updateGrid));
static void		ListboxEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static int		ListboxFetchSelection _ANSI_ARGS_((
			    ClientData clientData, int offset, char *buffer,
			    int maxBytes));
static void		ListboxLostSelection _ANSI_ARGS_((
			    ClientData clientData));
static void		EventuallyRedrawRange _ANSI_ARGS_((Listbox *listPtr,
			    int first, int last));
static void		ListboxScanTo _ANSI_ARGS_((Listbox *listPtr,
			    int x, int y));
static int		ListboxSelect _ANSI_ARGS_((Listbox *listPtr,
			    int first, int last, int select));
static void		ListboxUpdateHScrollbar _ANSI_ARGS_(
    			    (Listbox *listPtr));
static void		ListboxUpdateVScrollbar _ANSI_ARGS_(
			    (Listbox *listPtr));
static int		ListboxWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
	                    Tcl_Interp *interp, int objc,
	                    Tcl_Obj *CONST objv[]));
static int		ListboxBboxSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
	                    Listbox *listPtr, int index));
static int		ListboxSelectionSubCmd _ANSI_ARGS_ (
			    (Tcl_Interp *interp, Listbox *listPtr, int objc,
			    Tcl_Obj *CONST objv[]));
static int		ListboxXviewSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
			    Listbox *listPtr, int objc,
			    Tcl_Obj *CONST objv[]));
static int		ListboxYviewSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
			    Listbox *listPtr, int objc,
			    Tcl_Obj *CONST objv[]));
static ItemAttr *	ListboxGetItemAttributes _ANSI_ARGS_ (
    			    (Tcl_Interp *interp, Listbox *listPtr, int index));
static void		ListboxWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));
static int		NearestListboxElement _ANSI_ARGS_((Listbox *listPtr,
			    int y));
static char *		ListboxListVarProc _ANSI_ARGS_ ((ClientData clientData,
	                    Tcl_Interp *interp, char *name1, char *name2,
 	                    int flags));
static void		MigrateHashEntries _ANSI_ARGS_ ((Tcl_HashTable *table,
			    int first, int last, int offset));
/*
 * The structure below defines button class behavior by means of procedures
 * that can be invoked from generic window code.
 */

static TkClassProcs listboxClass = {
    NULL,			/* createProc. */
    ListboxWorldChanged,	/* geometryProc. */
    NULL			/* modalProc. */
};


/*
 *--------------------------------------------------------------
 *
 * Tk_ListboxObjCmd --
 *
 *	This procedure is invoked to process the "listbox" Tcl
 *	command.  See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_ListboxObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Either NULL or pointer to option table */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    register Listbox *listPtr;
    Tk_Window tkwin;
    ListboxOptionTables *optionTables;

    optionTables = (ListboxOptionTables *)clientData;
    if (optionTables == NULL) {
	Tcl_CmdInfo info;
	char *name;

	/*
	 * We haven't created the option tables for this widget class yet.
	 * Do it now and save the a pointer to them as the ClientData for
	 * the command, so future invocations will have access to it.
	 */
	optionTables =
	    (ListboxOptionTables *) ckalloc(sizeof(ListboxOptionTables));
	/* Set up an exit handler to free the optionTables struct */
	Tcl_SetAssocData(interp, "ListboxOptionTables",
		DestroyListboxOptionTables, (ClientData) optionTables);

	/* Create the listbox option table and the listbox item option table */
	optionTables->listboxOptionTable =
	    Tk_CreateOptionTable(interp, optionSpecs);
	optionTables->itemAttrOptionTable =
	    Tk_CreateOptionTable(interp, itemAttrOptionSpecs);

	/* Store a pointer to the tables as the ClientData for the command */
	name = Tcl_GetString(objv[0]);
	Tcl_GetCommandInfo(interp, name, &info);
	info.objClientData = (ClientData) optionTables;
	Tcl_SetCommandInfo(interp, name, &info);
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
	return TCL_ERROR;
    }

    tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
            Tcl_GetString(objv[1]), (char *) NULL);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }

    /*
     * Initialize the fields of the structure that won't be initialized
     * by ConfigureListbox, or that ConfigureListbox requires to be
     * initialized already (e.g. resource pointers).
     */
    listPtr 				= (Listbox *) ckalloc(sizeof(Listbox));
    listPtr->tkwin 			= tkwin;
    listPtr->display 			= Tk_Display(tkwin);
    listPtr->interp 			= interp;
    listPtr->widgetCmd 			= Tcl_CreateObjCommand(interp,
	    Tk_PathName(listPtr->tkwin), ListboxWidgetObjCmd,
	    (ClientData) listPtr, ListboxCmdDeletedProc);
    listPtr->optionTable 		= optionTables->listboxOptionTable;
    listPtr->itemAttrOptionTable	= optionTables->itemAttrOptionTable;
    listPtr->listVarName 		= NULL;
    listPtr->listObj 			= NULL;
    listPtr->selection 			=
	(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(listPtr->selection, TCL_ONE_WORD_KEYS);
    listPtr->itemAttrTable 		=
	(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(listPtr->itemAttrTable, TCL_ONE_WORD_KEYS);
    listPtr->nElements 			= 0;
    listPtr->normalBorder 		= NULL;
    listPtr->borderWidth 		= 0;
    listPtr->relief 			= TK_RELIEF_RAISED;
    listPtr->highlightWidth 		= 0;
    listPtr->highlightBgColorPtr 	= NULL;
    listPtr->highlightColorPtr 		= NULL;
    listPtr->inset 			= 0;
    listPtr->tkfont 			= NULL;
    listPtr->fgColorPtr 		= NULL;
    listPtr->textGC 			= None;
    listPtr->selBorder 			= NULL;
    listPtr->selBorderWidth 		= 0;
    listPtr->selFgColorPtr 		= None;
    listPtr->selTextGC 			= None;
    listPtr->width 			= 0;
    listPtr->height 			= 0;
    listPtr->lineHeight 		= 0;
    listPtr->topIndex 			= 0;
    listPtr->fullLines 			= 1;
    listPtr->partialLine 		= 0;
    listPtr->setGrid 			= 0;
    listPtr->maxWidth 			= 0;
    listPtr->xScrollUnit 		= 1;
    listPtr->xOffset 			= 0;
    listPtr->selectMode 		= NULL;
    listPtr->numSelected 		= 0;
    listPtr->selectAnchor 		= 0;
    listPtr->exportSelection 		= 1;
    listPtr->active 			= 0;
    listPtr->scanMarkX 			= 0;
    listPtr->scanMarkY 			= 0;
    listPtr->scanMarkXOffset 		= 0;
    listPtr->scanMarkYIndex 		= 0;
    listPtr->cursor 			= None;
    listPtr->takeFocus 			= NULL;
    listPtr->xScrollCmd 		= NULL;
    listPtr->yScrollCmd 		= NULL;
    listPtr->flags 			= 0;

    Tk_SetClass(listPtr->tkwin, "Listbox");
    TkSetClassProcs(listPtr->tkwin, &listboxClass, (ClientData) listPtr);
    Tk_CreateEventHandler(listPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    ListboxEventProc, (ClientData) listPtr);
    Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,
	    ListboxFetchSelection, (ClientData) listPtr, XA_STRING);
    if (Tk_InitOptions(interp, (char *)listPtr,
	    optionTables->listboxOptionTable, tkwin) != TCL_OK) {
	Tk_DestroyWindow(listPtr->tkwin);
	return TCL_ERROR;
    }

    if (ConfigureListbox(interp, listPtr, objc-2, objv+2, 0) != TCL_OK) {
	Tk_DestroyWindow(listPtr->tkwin);
	return TCL_ERROR;
    }

    Tcl_SetResult(interp, Tk_PathName(listPtr->tkwin), TCL_STATIC);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxWidgetObjCmd --
 *
 *	This Tcl_Obj based procedure is invoked to process the Tcl command
 *      that corresponds to a widget managed by this module.  See the user
 *      documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxWidgetObjCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Information about listbox widget. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Arguments as Tcl_Obj's. */
{
    register Listbox *listPtr = (Listbox *) clientData;
    int cmdIndex, index;
    int result = TCL_OK;
    
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }
    Tcl_Preserve((ClientData)listPtr);

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

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

	case COMMAND_BBOX: {
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "index");
		result = TCL_ERROR;
		break;
	    }
	    result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
	    if (result != TCL_OK) {
		break;
	    }
	    
	    result = ListboxBboxSubCmd(interp, listPtr, index);
	    break;
	}

	case COMMAND_CGET: {
	    Tcl_Obj *objPtr;
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "option");
		result = TCL_ERROR;
		break;
	    }

	    objPtr = Tk_GetOptionValue(interp, (char *)listPtr,
		    listPtr->optionTable, objv[2], listPtr->tkwin);
	    if (objPtr == NULL) {
		result = TCL_ERROR;
		break;
	    }
	    Tcl_SetObjResult(interp, objPtr);
	    result = TCL_OK;
	    break;
	}
	
	case COMMAND_CONFIGURE: {
	    Tcl_Obj *objPtr;
	    if (objc <= 3) {
		objPtr = Tk_GetOptionInfo(interp, (char *) listPtr,
			listPtr->optionTable,
			(objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
			listPtr->tkwin);
		if (objPtr == NULL) {
		    result = TCL_ERROR;
		    break;
		} else {
		    Tcl_SetObjResult(interp, objPtr);
		    result = TCL_OK;
		}
	    } else {
		result = ConfigureListbox(interp, listPtr, objc-2, objv+2, 0);
	    }
	    break;
	}

	case COMMAND_CURSELECTION: {
	    char indexStringRep[TCL_INTEGER_SPACE];
	    int i;
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 2, objv, NULL);
		result = TCL_ERROR;
		break;
	    }
	    /*
	     * Of course, it would be more efficient to use the Tcl_HashTable
	     * search functions (Tcl_FirstHashEntry, Tcl_NextHashEntry), but
	     * then the result wouldn't be in sorted order.  So instead we
	     * loop through the indices in order, adding them to the result
	     * if they are selected
	     */
	    for (i = 0; i < listPtr->nElements; i++) {
		if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) {
		    sprintf(indexStringRep, "%d", i);
		    Tcl_AppendElement(interp, indexStringRep);
		}
	    }
	    result = TCL_OK;
	    break;
	}
	
	case COMMAND_DELETE: {
	    int first, last;
	    if ((objc < 3) || (objc > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"firstIndex ?lastIndex?");
		result = TCL_ERROR;
		break;
	    }

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

	case COMMAND_GET: {
	    int first, last;
	    Tcl_Obj **elemPtrs;
	    int listLen;
	    if (objc != 3 && objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
		result = TCL_ERROR;
		break;
	    }
	    result = GetListboxIndex(interp, listPtr, objv[2], 0, &first);
	    if (result != TCL_OK) {
		break;
	    }
	    last = first;
	    if (objc == 4) {
		result = GetListboxIndex(interp, listPtr, objv[3], 0, &last);
		if (result != TCL_OK) {
		    break;
		}
	    }
	    if (first >= listPtr->nElements) {
		result = TCL_OK;
		break;
	    }
	    if (last >= listPtr->nElements) {
		last = listPtr->nElements - 1;
	    }
	    if (first < 0) {
		first = 0;
	    }
	    if (first > last) {
		result = TCL_OK;
		break;
	    }
	    result = Tcl_ListObjGetElements(interp, listPtr->listObj, &listLen,
		    &elemPtrs);
	    if (result != TCL_OK) {
		break;
	    }
	    if (objc == 3) {
		/*
		 * One element request - we return a string
		 */
		Tcl_SetObjResult(interp, elemPtrs[first]);
	    } else {
		Tcl_SetListObj(Tcl_GetObjResult(interp), (last - first + 1),
			&(elemPtrs[first]));
	    }
	    result = TCL_OK;
	    break;
	}

	case COMMAND_INDEX:{
	    char buf[TCL_INTEGER_SPACE];
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "index");
		result = TCL_ERROR;
		break;
	    }
	    result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
	    if (result != TCL_OK) {
		break;
	    }
	    sprintf(buf, "%d", index);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    result = TCL_OK;
	    break;
	}

	case COMMAND_INSERT: {
	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"index ?element element ...?");
		result = TCL_ERROR;
		break;
	    }

	    result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
	    if (result != TCL_OK) {
		break;
	    }
	    result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3);
	    break;
	}

	case COMMAND_ITEMCGET: {
	    Tcl_Obj *objPtr;
	    ItemAttr *attrPtr;
	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "index option");
		result = TCL_ERROR;
		break;
	    }

	    result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
	    if (result != TCL_OK) {
		break;
	    }

	    if (index < 0 || index >= listPtr->nElements) {
		Tcl_AppendResult(interp, "item number \"",
			Tcl_GetString(objv[2]), "\" out of range",
			(char *)NULL);
		result = TCL_ERROR;
		break;
	    }
	    
	    attrPtr = ListboxGetItemAttributes(interp, listPtr, index);

	    objPtr = Tk_GetOptionValue(interp, (char *)attrPtr,
		    listPtr->itemAttrOptionTable, objv[3], listPtr->tkwin);
	    if (objPtr == NULL) {
		result = TCL_ERROR;
		break;
	    }
	    Tcl_SetObjResult(interp, objPtr);
	    result = TCL_OK;
	    break;
	}

	case COMMAND_ITEMCONFIGURE: {
	    Tcl_Obj *objPtr;
	    ItemAttr *attrPtr;
	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"index ?option? ?value? ?option value ...?");
		result = TCL_ERROR;
		break;
	    }

	    result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
	    if (result != TCL_OK) {
		break;
	    }
	    
	    if (index < 0 || index >= listPtr->nElements) {
		Tcl_AppendResult(interp, "item number \"",
			Tcl_GetString(objv[2]), "\" out of range",
			(char *)NULL);
		result = TCL_ERROR;
		break;
	    }
	    
	    attrPtr = ListboxGetItemAttributes(interp, listPtr, index);
	    if (objc <= 4) {
		objPtr = Tk_GetOptionInfo(interp, (char *)attrPtr,
			listPtr->itemAttrOptionTable,
			(objc == 4) ? objv[3] : (Tcl_Obj *) NULL,
			listPtr->tkwin);
		if (objPtr == NULL) {
		    result = TCL_ERROR;
		    break;
		} else {
		    Tcl_SetObjResult(interp, objPtr);
		    result = TCL_OK;
		}
	    } else {
		result = ConfigureListboxItem(interp, listPtr, attrPtr,
			objc-3, objv+3);
	    }
	    break;
	}
	
	case COMMAND_NEAREST: {
	    char buf[TCL_INTEGER_SPACE];
	    int y;
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "y");
		result = TCL_ERROR;
		break;
	    }
	    
	    result = Tcl_GetIntFromObj(interp, objv[2], &y);
	    if (result != TCL_OK) {
		break;
	    }
	    index = NearestListboxElement(listPtr, y);
	    sprintf(buf, "%d", index);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    result = TCL_OK;
	    break;
	}
	
	case COMMAND_SCAN: {
	    int x, y, scanCmdIndex;

	    if (objc != 5) {
		Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y");
		result = TCL_ERROR;
		break;
	    }

	    if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK
		    || Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
		result = TCL_ERROR;
		break;
	    }

	    result = Tcl_GetIndexFromObj(interp, objv[2], scanCommandNames,
		    "option", 0, &scanCmdIndex);
	    if (result != TCL_OK) {
		break;
	    }
	    switch (scanCmdIndex) {
		case SCAN_MARK: {
		    listPtr->scanMarkX = x;
		    listPtr->scanMarkY = y;
		    listPtr->scanMarkXOffset = listPtr->xOffset;
		    listPtr->scanMarkYIndex = listPtr->topIndex;
		    break;
		}
		case SCAN_DRAGTO: {
		    ListboxScanTo(listPtr, x, y);
		    break;
		}
	    }
	    result = TCL_OK;
	    break;
	}

	case COMMAND_SEE: {
	    int diff;
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "index");
		result = TCL_ERROR;
		break;
	    }
	    result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
	    if (result != TCL_OK) {
		break;
	    }
	    if (index >= listPtr->nElements) {
		index = listPtr->nElements - 1;
	    }
	    if (index < 0) {
		index = 0;
	    }
	    diff = listPtr->topIndex - index;
	    if (diff > 0) {
		if (diff <= (listPtr->fullLines/3)) {
		    ChangeListboxView(listPtr, index);
		} else {
		    ChangeListboxView(listPtr,
			    index - (listPtr->fullLines-1)/2);
		}
	    } else {
		diff = index - (listPtr->topIndex + listPtr->fullLines - 1);
		if (diff > 0) {
		    if (diff <= (listPtr->fullLines/3)) {
			ChangeListboxView(listPtr, listPtr->topIndex + diff);
		    } else {
			ChangeListboxView(listPtr,
				index - (listPtr->fullLines-1)/2);
		    }
		}
	    }
	    result = TCL_OK;
	    break;
	}

	case COMMAND_SELECTION: {
	    result = ListboxSelectionSubCmd(interp, listPtr, objc, objv);
	    break;
	}
	
	case COMMAND_SIZE: {
	    char buf[TCL_INTEGER_SPACE];
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 2, objv, NULL);
		result = TCL_ERROR;
		break;
	    }
	    sprintf(buf, "%d", listPtr->nElements);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    result = TCL_OK;
	    break;
	}

	case COMMAND_XVIEW: {
	    result = ListboxXviewSubCmd(interp, listPtr, objc, objv);
	    break;
	}
	
	case COMMAND_YVIEW: {
	    result = ListboxYviewSubCmd(interp, listPtr, objc, objv);
	    break;
	}
    }
    Tcl_Release((ClientData)listPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxBboxSubCmd --
 *
 *	This procedure is invoked to process a listbox bbox request.
 *      See the user documentation for more information.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	For valid indices, places the bbox of the requested element in
 *      the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxBboxSubCmd(interp, listPtr, index)
    Tcl_Interp *interp;          /* Pointer to the calling Tcl interpreter */
    Listbox *listPtr;            /* Information about the listbox */
    int index;                   /* Index of the element to get bbox info on */
{
    int lastVisibleIndex;
    /* Determine the index of the last visible item in the listbox */
    lastVisibleIndex = listPtr->topIndex + listPtr->fullLines
	+ listPtr->partialLine;
    if (listPtr->nElements < lastVisibleIndex) {
	lastVisibleIndex = listPtr->nElements;
    }

    /* Only allow bbox requests for indices that are visible */
    if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) {
	char buf[TCL_INTEGER_SPACE * 4];
	Tcl_Obj *el;
	char *stringRep;
	int pixelWidth, stringLen, x, y, result;
	Tk_FontMetrics fm;

	/* Compute the pixel width of the requested element */
	result = Tcl_ListObjIndex(interp, listPtr->listObj, index, &el);
	if (result != TCL_OK) {
	    return result;
	}

	stringRep = Tcl_GetStringFromObj(el, &stringLen);
	Tk_GetFontMetrics(listPtr->tkfont, &fm);
	pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen);

	x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
	y = ((index - listPtr->topIndex)*listPtr->lineHeight)
	    + listPtr->inset + listPtr->selBorderWidth;
	sprintf(buf, "%d %d %d %d", x, y, pixelWidth, fm.linespace);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxSelectionSubCmd --
 *
 *	This procedure is invoked to process the selection sub command
 *      for listbox widgets.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	May set the interpreter's result field.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxSelectionSubCmd(interp, listPtr, objc, objv)
    Tcl_Interp *interp;          /* Pointer to the calling Tcl interpreter */
    Listbox *listPtr;            /* Information about the listbox */
    int objc;                    /* Number of arguments in the objv array */
    Tcl_Obj *CONST objv[];       /* Array of arguments to the procedure */
{
    int selCmdIndex, first, last;
    int result = TCL_OK;
    if (objc != 4 && objc != 5) {
	Tcl_WrongNumArgs(interp, 2, objv, "option index ?index?");
	return TCL_ERROR;
    }
    result = GetListboxIndex(interp, listPtr, objv[3], 0, &first);
    if (result != TCL_OK) {
	return result;
    }
    last = first;
    if (objc == 5) {
	result = GetListboxIndex(interp, listPtr, objv[4], 0, &last);
	if (result != TCL_OK) {
	    return result;
	}
    }
    result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames,
	    "option", 0, &selCmdIndex);
    if (result != TCL_OK) {
	return result;
    }
    switch (selCmdIndex) {
	case SELECTION_ANCHOR: {
	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 3, objv, "index");
		return TCL_ERROR;
	    }
	    if (first >= listPtr->nElements) {
		first = listPtr->nElements - 1;
	    }
	    if (first < 0) {
		first = 0;
	    }
	    listPtr->selectAnchor = first;
	    result = TCL_OK;
	    break;
	}
	case SELECTION_CLEAR: {
	    result = ListboxSelect(listPtr, first, last, 0);
	    break;
	}
	case SELECTION_INCLUDES: {
	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 3, objv, "index");
		return TCL_ERROR;
	    }
	    if (Tcl_FindHashEntry(listPtr->selection, (char *)first)) {
		Tcl_SetResult(interp, "1", TCL_STATIC);
	    } else {
		Tcl_SetResult(interp, "0", TCL_STATIC);
	    }
	    result = TCL_OK;
	    break;
	}
	case SELECTION_SET: {
	    result = ListboxSelect(listPtr, first, last, 1);
	    break;
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxXviewSubCmd --
 *
 *	Process the listbox "xview" subcommand.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	May change the listbox viewing area; may set the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxXviewSubCmd(interp, listPtr, objc, objv)
    Tcl_Interp *interp;          /* Pointer to the calling Tcl interpreter */
    Listbox *listPtr;            /* Information about the listbox */
    int objc;                    /* Number of arguments in the objv array */
    Tcl_Obj *CONST objv[];       /* Array of arguments to the procedure */
{

    int index, count, type, windowWidth, windowUnits;
    int offset = 0;		/* Initialized to stop gcc warnings. */
    double fraction, fraction2;
    
    windowWidth = Tk_Width(listPtr->tkwin)
	- 2*(listPtr->inset + listPtr->selBorderWidth);
    if (objc == 2) {
	if (listPtr->maxWidth == 0) {
	    Tcl_SetResult(interp, "0 1", TCL_STATIC);
	} else {
	    char buf[TCL_DOUBLE_SPACE * 2];
	    
	    fraction = listPtr->xOffset/((double) listPtr->maxWidth);
	    fraction2 = (listPtr->xOffset + windowWidth)
		/((double) listPtr->maxWidth);
	    if (fraction2 > 1.0) {
		fraction2 = 1.0;
	    }
	    sprintf(buf, "%g %g", fraction, fraction2);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	}
    } else if (objc == 3) {
	if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
    } else {
	type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count);
	switch (type) {
	    case TK_SCROLL_ERROR:
		return TCL_ERROR;
	    case TK_SCROLL_MOVETO:
		offset = (int) (fraction*listPtr->maxWidth + 0.5);
		break;
	    case TK_SCROLL_PAGES:
		windowUnits = windowWidth/listPtr->xScrollUnit;
		if (windowUnits > 2) {
		    offset = listPtr->xOffset
			+ count*listPtr->xScrollUnit*(windowUnits-2);
		} else {
		    offset = listPtr->xOffset + count*listPtr->xScrollUnit;
		}
		break;
	    case TK_SCROLL_UNITS:
		offset = listPtr->xOffset + count*listPtr->xScrollUnit;
		break;
	}
	ChangeListboxOffset(listPtr, offset);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxYviewSubCmd --
 *
 *	Process the listbox "yview" subcommand.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	May change the listbox viewing area; may set the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxYviewSubCmd(interp, listPtr, objc, objv)
    Tcl_Interp *interp;          /* Pointer to the calling Tcl interpreter */
    Listbox *listPtr;            /* Information about the listbox */
    int objc;                    /* Number of arguments in the objv array */
    Tcl_Obj *CONST objv[];       /* Array of arguments to the procedure */
{
    int index, count, type;
    double fraction, fraction2;
    
    if (objc == 2) {
	if (listPtr->nElements == 0) {
	    Tcl_SetResult(interp, "0 1", TCL_STATIC);
	} else {
	    char buf[TCL_DOUBLE_SPACE * 2];
	    
	    fraction = listPtr->topIndex/((double) listPtr->nElements);
	    fraction2 = (listPtr->topIndex+listPtr->fullLines)
		/((double) listPtr->nElements);
	    if (fraction2 > 1.0) {
		fraction2 = 1.0;
	    }
	    sprintf(buf, "%g %g", fraction, fraction2);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	}
    } else if (objc == 3) {
	if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	ChangeListboxView(listPtr, index);
    } else {
	type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count);
	switch (type) {
	    case TK_SCROLL_ERROR:
		return TCL_ERROR;
	    case TK_SCROLL_MOVETO:
		index = (int) (listPtr->nElements*fraction + 0.5);
		break;
	    case TK_SCROLL_PAGES:
		if (listPtr->fullLines > 2) {
		    index = listPtr->topIndex
			+ count*(listPtr->fullLines-2);
		} else {
		    index = listPtr->topIndex + count;
		}
		break;
	    case TK_SCROLL_UNITS:
		index = listPtr->topIndex + count;
		break;
	}
	ChangeListboxView(listPtr, index);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxGetItemAttributes --
 *
 *	Returns a pointer to the ItemAttr record for a given index,
 *	creating one if it does not already exist.
 *
 * Results:
 *	Pointer to an ItemAttr record.
 *
 * Side effects:
 *	Memory may be allocated for the ItemAttr record.
 *
 *----------------------------------------------------------------------
 */

static ItemAttr *
ListboxGetItemAttributes(interp, listPtr, index)
    Tcl_Interp *interp;          /* Pointer to the calling Tcl interpreter */
    Listbox *listPtr;            /* Information about the listbox */
    int index;                   /* Index of the item to retrieve attributes
				  * for */
{
    int new;
    Tcl_HashEntry *entry;
    ItemAttr *attrs;

    entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, (char *)index,
	    &new);
    if (new) {
	attrs = (ItemAttr *) ckalloc(sizeof(ItemAttr));
	attrs->border = NULL;
	attrs->selBorder = NULL;
	attrs->fgColor = NULL;
	attrs->selFgColor = NULL;
	Tk_InitOptions(interp, (char *)attrs, listPtr->itemAttrOptionTable,
		listPtr->tkwin);
	Tcl_SetHashValue(entry, (ClientData) attrs);
    }
    attrs = (ItemAttr *)Tcl_GetHashValue(entry);
    return attrs;
}

/*
 *----------------------------------------------------------------------
 *
 * DestroyListbox --
 *
 *	This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
 *	to clean up the internal structure of a listbox at a safe time
 *	(when no-one is using it anymore).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Everything associated with the listbox is freed up.
 *
 *----------------------------------------------------------------------
 */

static void
DestroyListbox(memPtr)
    char *memPtr;	/* Info about listbox widget. */
{
    register Listbox *listPtr = (Listbox *) memPtr;
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;

    listPtr->flags |= LISTBOX_DELETED;

    Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
    if (listPtr->setGrid) {
	Tk_UnsetGrid(listPtr->tkwin);
    }
    if (listPtr->flags & REDRAW_PENDING) {
	Tcl_CancelIdleCall(DisplayListbox, (ClientData) listPtr);
    }

    /* If we have an internal list object, free it */
    if (listPtr->listObj != NULL) {
	Tcl_DecrRefCount(listPtr->listObj);
	listPtr->listObj = NULL;
    }

    if (listPtr->listVarName != NULL) {
	Tcl_UntraceVar(listPtr->interp, listPtr->listVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ListboxListVarProc, (ClientData) listPtr);
    }
    
    /* Free the selection hash table */
    Tcl_DeleteHashTable(listPtr->selection);
    ckfree((char *)listPtr->selection);

    /* Free the item attribute hash table */
    for (entry = Tcl_FirstHashEntry(listPtr->itemAttrTable, &search);
	 entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	ckfree((char *)Tcl_GetHashValue(entry));
    }
    Tcl_DeleteHashTable(listPtr->itemAttrTable);
    ckfree((char *)listPtr->itemAttrTable);

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    if (listPtr->textGC != None) {
	Tk_FreeGC(listPtr->display, listPtr->textGC);
    }
    if (listPtr->selTextGC != None) {
	Tk_FreeGC(listPtr->display, listPtr->selTextGC);
    }
    Tk_FreeConfigOptions((char *)listPtr, listPtr->optionTable,
	    listPtr->tkwin);
    listPtr->tkwin = NULL;
    ckfree((char *) listPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DestroyListboxOptionTables --
 *
 *	This procedure is registered as an exit callback when the listbox
 *	command is first called.  It cleans up the OptionTables structure
 *	allocated by that command.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees memory.
 *
 *----------------------------------------------------------------------
 */

static void
DestroyListboxOptionTables(clientData, interp)
    ClientData clientData;	/* Pointer to the OptionTables struct */
    Tcl_Interp *interp;		/* Pointer to the calling interp */
{
    ckfree((char *)clientData);
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureListbox --
 *
 *	This procedure is called to process an objv/objc list, plus
 *	the Tk option database, in order to configure (or reconfigure)
 *	a listbox widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for listPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureListbox(interp, listPtr, objc, objv, flags)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register Listbox *listPtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    int objc;			/* Number of valid entries in argv. */
    Tcl_Obj *CONST objv[];	/* Arguments. */
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{
    Tk_SavedOptions savedOptions;
    Tcl_Obj *oldListObj = NULL;
    int oldExport;

    oldExport = listPtr->exportSelection;
    if (listPtr->listVarName != NULL) {
	Tcl_UntraceVar(interp, listPtr->listVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ListboxListVarProc, (ClientData) listPtr);
    }
    
    if (Tk_SetOptions(interp, (char *)listPtr,
	    listPtr->optionTable, objc, objv, listPtr->tkwin,
	    &savedOptions, (int *)NULL) != TCL_OK) {
	Tk_RestoreSavedOptions(&savedOptions);
	return TCL_ERROR;
    }
    
    /*
     * A few options need special processing, such as setting the
     * background from a 3-D border.
     */

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

    if (listPtr->highlightWidth < 0) {
	listPtr->highlightWidth = 0;
    }
    listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth;

    /*
     * Claim the selection if we've suddenly started exporting it and
     * there is a selection to export.
     */

    if (listPtr->exportSelection && !oldExport
	    && (listPtr->numSelected != 0)) {
	Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
		(ClientData) listPtr);
    }

    
    /* Verify the current status of the list var.
     * PREVIOUS STATE    | NEW STATE     | ACTION
     * ------------------+---------------+----------------------------------
     * no listvar        | listvar       | If listvar does not exist, create
     *                                     it and copy the internal list obj's
     *                                     content to the new var.  If it does
     *                                     exist, toss the internal list obj.
     *
     * listvar           | no listvar    | Copy old listvar content to the
     *                                     internal list obj
     *
     * listvar           | listvar       | no special action
     *
     * no listvar        | no listvar    | no special action
     */
    oldListObj = listPtr->listObj;
    if (listPtr->listVarName != NULL) {
	Tcl_Obj *listVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
		(char *)NULL, TCL_GLOBAL_ONLY);
	int dummy;
	if (listVarObj == NULL) {
	    if (listPtr->listObj != NULL) {
		listVarObj = listPtr->listObj;
	    } else {
		listVarObj = Tcl_NewObj();
	    }
	    if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
		    listVarObj, TCL_GLOBAL_ONLY) == NULL) {
		Tcl_DecrRefCount(listVarObj);
		Tk_RestoreSavedOptions(&savedOptions);
		return TCL_ERROR;
	    }
	}
	/* Make sure the object is a good list object */
	if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy) != TCL_OK) {
	    Tk_RestoreSavedOptions(&savedOptions);
	    Tcl_AppendResult(listPtr->interp, ": invalid listvar value",
		    (char *)NULL);
	    return TCL_ERROR;
	}
    
	listPtr->listObj = listVarObj;
	Tcl_TraceVar(listPtr->interp, listPtr->listVarName,
                TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
                ListboxListVarProc, (ClientData) listPtr);
    } else {
	if (listPtr->listObj == NULL) {
	    listPtr->listObj = Tcl_NewObj();
	}
    }
    Tcl_IncrRefCount(listPtr->listObj);
    if (oldListObj != NULL) {
	Tcl_DecrRefCount(oldListObj);
    }

    /* Make sure that the list length is correct */
    Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
    
    Tk_FreeSavedOptions(&savedOptions);
    ListboxWorldChanged((ClientData) listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureListboxItem --
 *
 *	This procedure is called to process an objv/objc list, plus
 *	the Tk option database, in order to configure (or reconfigure)
 *	a listbox item.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for a listbox item;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureListboxItem(interp, listPtr, attrs, objc, objv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register Listbox *listPtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    ItemAttr *attrs;		/* Information about the item to configure */
    int objc;			/* Number of valid entries in argv. */
    Tcl_Obj *CONST objv[];	/* Arguments. */
{
    Tk_SavedOptions savedOptions;

    if (Tk_SetOptions(interp, (char *)attrs,
	    listPtr->itemAttrOptionTable, objc, objv, listPtr->tkwin,
	    &savedOptions, (int *)NULL) != TCL_OK) {
	Tk_RestoreSavedOptions(&savedOptions);
	return TCL_ERROR;
    }
    Tk_FreeSavedOptions(&savedOptions);
    ListboxWorldChanged((ClientData) listPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ListboxWorldChanged --
 *
 *      This procedure is called when the world has changed in some
 *      way and the widget needs to recompute all its graphics contexts
 *	and determine its new geometry.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Listbox will be relayed out and redisplayed.
 *
 *---------------------------------------------------------------------------
 */
 
static void
ListboxWorldChanged(instanceData)
    ClientData instanceData;	/* Information about widget. */
{
    XGCValues gcValues;
    GC gc;
    unsigned long mask;
    Listbox *listPtr;
    
    listPtr = (Listbox *) instanceData;

    gcValues.foreground = listPtr->fgColorPtr->pixel;
    gcValues.font = Tk_FontId(listPtr->tkfont);
    gcValues.graphics_exposures = False;
    mask = GCForeground | GCFont | GCGraphicsExposures;
    gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
    if (listPtr->textGC != None) {
	Tk_FreeGC(listPtr->display, listPtr->textGC);
    }
    listPtr->textGC = gc;

    gcValues.foreground = listPtr->selFgColorPtr->pixel;
    gcValues.font = Tk_FontId(listPtr->tkfont);
    mask = GCForeground | GCFont;
    gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
    if (listPtr->selTextGC != None) {
	Tk_FreeGC(listPtr->display, listPtr->selTextGC);
    }
    listPtr->selTextGC = gc;

    /*
     * Register the desired geometry for the window and arrange for
     * the window to be redisplayed.
     */

    ListboxComputeGeometry(listPtr, 1, 1, 1);
    listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
    EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}

/*
 *--------------------------------------------------------------
 *
 * DisplayListbox --
 *
 *	This procedure redraws the contents of a listbox window.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information appears on the screen.
 *
 *--------------------------------------------------------------
 */

static void
DisplayListbox(clientData)
    ClientData clientData;	/* Information about window. */
{
    register Listbox *listPtr = (Listbox *) clientData;
    register Tk_Window tkwin = listPtr->tkwin;
    GC gc;
    int i, limit, x, y, width, prevSelected;
    Tk_FontMetrics fm;
    Tcl_Obj *curElement;
    Tcl_HashEntry *entry;
    char *stringRep;
    int stringLen;
    ItemAttr *attrs;
    Tk_3DBorder selectedBg;
    XGCValues gcValues;
    unsigned long mask;
    int left, right;			/* Non-zero values here indicate
					 * that the left or right edge of
					 * the listbox is off-screen. */
    Pixmap pixmap;

    listPtr->flags &= ~REDRAW_PENDING;

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

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

    /*
     * Redrawing is done in a temporary pixmap that is allocated
     * here and freed at the end of the procedure.  All drawing is
     * done to the pixmap, and the pixmap is copied to the screen
     * at the end of the procedure.  This provides the smoothest
     * possible visual effects (no flashing on the screen).
     */

    pixmap = Tk_GetPixmap(listPtr->display, Tk_WindowId(tkwin),
	    Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
    Tk_Fill3DRectangle(tkwin, pixmap, listPtr->normalBorder, 0, 0,
	    Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);

    /* Display each item in the listbox */
    limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1;
    if (limit >= listPtr->nElements) {
	limit = listPtr->nElements-1;
    }
    left = right = 0;
    if (listPtr->xOffset > 0) {
	left = listPtr->selBorderWidth+1;
    }
    if ((listPtr->maxWidth - listPtr->xOffset) > (Tk_Width(listPtr->tkwin)
	    - 2*(listPtr->inset + listPtr->selBorderWidth)))  {
	right = listPtr->selBorderWidth+1;
    }
    prevSelected = 0;
    
    for (i = listPtr->topIndex; i <= limit; i++) {
	x = listPtr->inset;
	y = ((i - listPtr->topIndex) * listPtr->lineHeight) 
		+ listPtr->inset;
	gc = listPtr->textGC;
	/*
	 * Lookup this item in the item attributes table, to see if it has
	 * special foreground/background colors
	 */
	entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *)i);

	/* If the item is selected, it is drawn differently */
	if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) {
	    gc = listPtr->selTextGC;
	    width = Tk_Width(tkwin) - 2*listPtr->inset;
	    selectedBg = listPtr->selBorder;

	    /* If there is attribute information for this item,
	     * adjust the drawing accordingly */
	    if (entry != NULL) {
		attrs = (ItemAttr *)Tcl_GetHashValue(entry);
		/* The default GC has the settings from the widget at large */
		gcValues.foreground = listPtr->selFgColorPtr->pixel;
		gcValues.font = Tk_FontId(listPtr->tkfont);
		gcValues.graphics_exposures = False;
		mask = GCForeground | GCFont | GCGraphicsExposures;

		if (attrs->selBorder != NULL) {
		    selectedBg = attrs->selBorder;
		}

		if (attrs->selFgColor != NULL) {
		    gcValues.foreground = attrs->selFgColor->pixel;
		    gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
		}
	    }

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

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

	    /* Draw left bevel */
	    if (left == 0) {
		Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
			x, y, listPtr->selBorderWidth, listPtr->lineHeight,
			1, TK_RELIEF_RAISED);
	    }
	    /* Draw right bevel */
	    if (right == 0) {
		Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
			x + width - listPtr->selBorderWidth, y,
			listPtr->selBorderWidth, listPtr->lineHeight,
			0, TK_RELIEF_RAISED);
	    }
	    /* Draw top bevel */
	    if (!prevSelected) {
		Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg,
			x-left, y, width+left+right, listPtr->selBorderWidth,
			1, 1, 1, TK_RELIEF_RAISED);
	    }
	    /* Draw bottom bevel */
	    if (i + 1 == listPtr->nElements ||
		    Tcl_FindHashEntry(listPtr->selection,
			    (char *)(i + 1)) == NULL ) {
		Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left,
			y + listPtr->lineHeight - listPtr->selBorderWidth,
			width+left+right, listPtr->selBorderWidth, 0, 0, 0,
			TK_RELIEF_RAISED);
	    }
	    prevSelected = 1;
	} else {
	    /* If there is an item attributes record for this item,
	     * draw the background box and set the foreground color
	     * accordingly */
	    if (entry != NULL) {
		attrs = (ItemAttr *)Tcl_GetHashValue(entry);
		gcValues.foreground = listPtr->fgColorPtr->pixel;
		gcValues.font = Tk_FontId(listPtr->tkfont);
		gcValues.graphics_exposures = False;
		mask = GCForeground | GCFont | GCGraphicsExposures;
		if (attrs->border != NULL) {
		    width = Tk_Width(tkwin) - 2*listPtr->inset;
		    Tk_Fill3DRectangle(tkwin, pixmap, attrs->border, x, y,
			    width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
		}
		if (attrs->fgColor != NULL) {
		    gcValues.foreground = attrs->fgColor->pixel;
		    gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
		}
	    }
	    prevSelected = 0;
	}

	/* Draw the actual text of this item */
	Tk_GetFontMetrics(listPtr->tkfont, &fm);
	y += fm.ascent + listPtr->selBorderWidth;
	x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
	Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement);
	stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
	Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont,
		stringRep, stringLen, x, y);

	/* If this is the active element, underline it. */
	if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
	    Tk_UnderlineChars(listPtr->display, pixmap, gc, listPtr->tkfont,
		    stringRep, x, y, 0, stringLen);
	}
    }

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

    Tk_Draw3DRectangle(tkwin, pixmap, listPtr->normalBorder,
	    listPtr->highlightWidth, listPtr->highlightWidth,
	    Tk_Width(tkwin) - 2*listPtr->highlightWidth,
	    Tk_Height(tkwin) - 2*listPtr->highlightWidth,
	    listPtr->borderWidth, listPtr->relief);
    if (listPtr->highlightWidth > 0) {
	GC fgGC, bgGC;

	bgGC = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap);
	if (listPtr->flags & GOT_FOCUS) {
	    fgGC = Tk_GCForColor(listPtr->highlightColorPtr, pixmap);
	    TkpDrawHighlightBorder(tkwin, fgGC, bgGC, 
	            listPtr->highlightWidth, pixmap);
	} else {
	    TkpDrawHighlightBorder(tkwin, bgGC, bgGC, 
	            listPtr->highlightWidth, pixmap);
	}
    }
    XCopyArea(listPtr->display, pixmap, Tk_WindowId(tkwin),
	    listPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin),
	    (unsigned) Tk_Height(tkwin), 0, 0);
    Tk_FreePixmap(listPtr->display, pixmap);
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxComputeGeometry --
 *
 *	This procedure is invoked to recompute geometry information
 *	such as the sizes of the elements and the overall dimensions
 *	desired for the listbox.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Geometry information is updated and a new requested size is
 *	registered for the widget.  Internal border and gridding
 *	information is also set.
 *
 *----------------------------------------------------------------------
 */

static void
ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
    Listbox *listPtr;		/* Listbox whose geometry is to be
				 * recomputed. */
    int fontChanged;		/* Non-zero means the font may have changed
				 * so per-element width information also
				 * has to be computed. */
    int maxIsStale;		/* Non-zero means the "maxWidth" field may
				 * no longer be up-to-date and must
				 * be recomputed.  If fontChanged is 1 then
				 * this must be 1. */
    int updateGrid;		/* Non-zero means call Tk_SetGrid or
				 * Tk_UnsetGrid to update gridding for
				 * the window. */
{
    int width, height, pixelWidth, pixelHeight;
    Tk_FontMetrics fm;
    Tcl_Obj *element;
    int textLength;
    char *text;
    int i, result;
    
    if (fontChanged  || maxIsStale) {
	listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1);
	if (listPtr->xScrollUnit == 0) {
	    listPtr->xScrollUnit = 1;
	}
	listPtr->maxWidth = 0;
	for (i = 0; i < listPtr->nElements; i++) {
	    /* Compute the pixel width of the current element */
	    result = Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
		    &element);
	    if (result != TCL_OK) {
		continue;
	    }
	    text = Tcl_GetStringFromObj(element, &textLength);
	    Tk_GetFontMetrics(listPtr->tkfont, &fm);
	    pixelWidth = Tk_TextWidth(listPtr->tkfont, text, textLength);
	    if (pixelWidth > listPtr->maxWidth) {
		listPtr->maxWidth = pixelWidth;
	    }
	}
    }

    Tk_GetFontMetrics(listPtr->tkfont, &fm);
    listPtr->lineHeight = fm.linespace + 1 + 2*listPtr->selBorderWidth;
    width = listPtr->width;
    if (width <= 0) {
	width = (listPtr->maxWidth + listPtr->xScrollUnit - 1)
		/listPtr->xScrollUnit;
	if (width < 1) {
	    width = 1;
	}
    }
    pixelWidth = width*listPtr->xScrollUnit + 2*listPtr->inset
	    + 2*listPtr->selBorderWidth;
    height = listPtr->height;
    if (listPtr->height <= 0) {
	height = listPtr->nElements;
	if (height < 1) {
	    height = 1;
	}
    }
    pixelHeight = height*listPtr->lineHeight + 2*listPtr->inset;
    Tk_GeometryRequest(listPtr->tkwin, pixelWidth, pixelHeight);
    Tk_SetInternalBorder(listPtr->tkwin, listPtr->inset);
    if (updateGrid) {
	if (listPtr->setGrid) {
	    Tk_SetGrid(listPtr->tkwin, width, height, listPtr->xScrollUnit,
		    listPtr->lineHeight);
	} else {
	    Tk_UnsetGrid(listPtr->tkwin);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxInsertSubCmd --
 *
 *	This procedure is invoked to handle the listbox "insert"
 *      subcommand.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	New elements are added to the listbox pointed to by listPtr;
 *      a refresh callback is registered for the listbox.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxInsertSubCmd(listPtr, index, objc, objv)
    register Listbox *listPtr;	/* Listbox that is to get the new
				 * elements. */
    int index;			/* Add the new elements before this
				 * element. */
    int objc;			/* Number of new elements to add. */
    Tcl_Obj *CONST objv[];	/* New elements (one per entry). */
{
    int i, oldMaxWidth;
    Tcl_Obj *newListObj;
    int pixelWidth;
    int result;
    char *stringRep;
    int length;
    
    oldMaxWidth = listPtr->maxWidth;
    for (i = 0; i < objc; i++) {
	/*
	 * Check if any of the new elements are wider than the current widest;
	 * if so, update our notion of "widest."
	 */
	stringRep = Tcl_GetStringFromObj(objv[i], &length);
	pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
	if (pixelWidth > listPtr->maxWidth) {
	    listPtr->maxWidth = pixelWidth;
	}
    }
    
    /* Adjust selection and attribute information for every index after
     * the first index */
    MigrateHashEntries(listPtr->selection, index, listPtr->nElements-1, objc);
    MigrateHashEntries(listPtr->itemAttrTable, index, listPtr->nElements-1,
	    objc);
    
    /* If the object is shared, duplicate it before writing to it */
    if (Tcl_IsShared(listPtr->listObj)) {
	newListObj = Tcl_DuplicateObj(listPtr->listObj);
    } else {
	newListObj = listPtr->listObj;
    }
    result =
	Tcl_ListObjReplace(listPtr->interp, newListObj, index, 0, objc, objv);
    if (result != TCL_OK) {
	return result;
    }

    Tcl_IncrRefCount(newListObj);
    /* Clean up the old reference */
    Tcl_DecrRefCount(listPtr->listObj);

    /* Set the internal pointer to the new obj */
    listPtr->listObj = newListObj;

    /* If there is a listvar, make sure it points at the new object */
    if (listPtr->listVarName != NULL) {
	if (Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName,
		(char *)NULL, newListObj, TCL_GLOBAL_ONLY) == NULL) {
	    Tcl_DecrRefCount(newListObj);
	    return TCL_ERROR;
	}
    }

    /* Get the new list length */
    Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
    
    /*
     * Update the "special" indices (anchor, topIndex, active) to account
     * for the renumbering that just occurred.  Then arrange for the new
     * information to be displayed.
     */

    if (index <= listPtr->selectAnchor) {
	listPtr->selectAnchor += objc;
    }
    if (index < listPtr->topIndex) {
	listPtr->topIndex += objc;
    }
    if (index <= listPtr->active) {
	listPtr->active += objc;
	if ((listPtr->active >= listPtr->nElements) &&
		(listPtr->nElements > 0)) {
	    listPtr->active = listPtr->nElements-1;
	}
    }
    listPtr->flags |= UPDATE_V_SCROLLBAR;
    if (listPtr->maxWidth != oldMaxWidth) {
	listPtr->flags |= UPDATE_H_SCROLLBAR;
    }
    ListboxComputeGeometry(listPtr, 0, 0, 0);
    EventuallyRedrawRange(listPtr, index, listPtr->nElements-1);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxDeleteSubCmd --
 *
 *	Process a listbox "delete" subcommand by removing one or more
 *      elements from a listbox widget.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	The listbox will be modified and (eventually) redisplayed.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxDeleteSubCmd(listPtr, first, last)
    register Listbox *listPtr;	/* Listbox widget to modify. */
    int first;			/* Index of first element to delete. */
    int last;			/* Index of last element to delete. */
{
    int count, i, widthChanged;
    Tcl_Obj *newListObj;
    Tcl_Obj *element;
    int length;
    char *stringRep;
    int result;
    int pixelWidth;
    Tcl_HashEntry *entry;
    
    /*
     * Adjust the range to fit within the existing elements of the
     * listbox, and make sure there's something to delete.
     */

    if (first < 0) {
	first = 0;
    }
    if (last >= listPtr->nElements) {
	last = listPtr->nElements-1;
    }
    count = last + 1 - first;
    if (count <= 0) {
	return TCL_OK;
    }

    /*
     * Foreach deleted index we must:
     * a) remove selection information
     * b) check the width of the element; if it is equal to the max, set
     *    widthChanged to 1, because it may be the only element with that
     *    width
     */
    widthChanged = 0;
    for (i = first; i <= last; i++) {
	/* Remove selection information */
	entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
	if (entry != NULL) {
	    listPtr->numSelected--;
	    Tcl_DeleteHashEntry(entry);
	}

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

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

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

    Tcl_IncrRefCount(newListObj);
    /* Clean up the old reference */
    Tcl_DecrRefCount(listPtr->listObj);

    /* Set the internal pointer to the new obj */
    listPtr->listObj = newListObj;

    /* Get the new list length */
    Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
    
    /* If there is a listvar, make sure it points at the new object */
    if (listPtr->listVarName != NULL) {
	if (Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName,
		(char *)NULL, newListObj, TCL_GLOBAL_ONLY) == NULL) {
	    Tcl_DecrRefCount(newListObj);
	    return TCL_ERROR;
	}
    }

    /*
     * Update the selection and viewing information to reflect the change
     * in the element numbering, and redisplay to slide information up over
     * the elements that were deleted.
     */

    if (first <= listPtr->selectAnchor) {
	listPtr->selectAnchor -= count;
	if (listPtr->selectAnchor < first) {
	    listPtr->selectAnchor = first;
	}
    }
    if (first <= listPtr->topIndex) {
	listPtr->topIndex -= count;
	if (listPtr->topIndex < first) {
	    listPtr->topIndex = first;
	}
    }
    if (listPtr->topIndex > (listPtr->nElements - listPtr->fullLines)) {
	listPtr->topIndex = listPtr->nElements - listPtr->fullLines;
	if (listPtr->topIndex < 0) {
	    listPtr->topIndex = 0;
	}
    }
    if (listPtr->active > last) {
	listPtr->active -= count;
    } else if (listPtr->active >= first) {
	listPtr->active = first;
	if ((listPtr->active >= listPtr->nElements) &&
		(listPtr->nElements > 0)) {
	    listPtr->active = listPtr->nElements-1;
	}
    }
    listPtr->flags |= UPDATE_V_SCROLLBAR;
    ListboxComputeGeometry(listPtr, 0, widthChanged, 0);
    if (widthChanged) {
	listPtr->flags |= UPDATE_H_SCROLLBAR;
    }
    EventuallyRedrawRange(listPtr, first, listPtr->nElements-1);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ListboxEventProc --
 *
 *	This procedure is invoked by the Tk dispatcher for various
 *	events on listboxes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	When the window gets deleted, internal structures get
 *	cleaned up.  When it gets exposed, it is redisplayed.
 *
 *--------------------------------------------------------------
 */

static void
ListboxEventProc(clientData, eventPtr)
    ClientData clientData;	/* Information about window. */
    XEvent *eventPtr;		/* Information about event. */
{
    Listbox *listPtr = (Listbox *) clientData;
    
    if (eventPtr->type == Expose) {
	EventuallyRedrawRange(listPtr,
		NearestListboxElement(listPtr, eventPtr->xexpose.y),
		NearestListboxElement(listPtr, eventPtr->xexpose.y
		+ eventPtr->xexpose.height));
    } else if (eventPtr->type == DestroyNotify) {
	DestroyListbox((char *) clientData);
    } else if (eventPtr->type == ConfigureNotify) {
	int vertSpace;

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

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

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

static void
ListboxCmdDeletedProc(clientData)
    ClientData clientData;	/* Pointer to widget record for widget. */
{
    Listbox *listPtr = (Listbox *) clientData;

    /*
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (!(listPtr->flags & LISTBOX_DELETED)) {
	Tk_DestroyWindow(listPtr->tkwin);
    }
}

/*
 *--------------------------------------------------------------
 *
 * GetListboxIndex --
 *
 *	Parse an index into a listbox and return either its value
 *	or an error.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the index (into listPtr) corresponding to
 *	string.  Otherwise an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
GetListboxIndex(interp, listPtr, indexObj, endIsSize, indexPtr)
    Tcl_Interp *interp;		/* For error messages. */
    Listbox *listPtr;		/* Listbox for which the index is being
				 * specified. */
    Tcl_Obj *indexObj;		/* Specifies an element in the listbox. */
    int endIsSize;		/* If 1, "end" refers to the number of
				 * entries in the listbox.  If 0, "end"
				 * refers to 1 less than the number of
				 * entries. */
    int *indexPtr;		/* Where to store converted index. */
{
    int result;
    int index;
    char *stringRep;
    
    /* First see if the index is one of the named indices */
    result = Tcl_GetIndexFromObj(NULL, indexObj, indexNames, "", 0, &index);
    if (result == TCL_OK) {
	switch (index) {
	    case INDEX_ACTIVE: {
		/* "active" index */
		*indexPtr = listPtr->active;
		break;
	    }

	    case INDEX_ANCHOR: {
		/* "anchor" index */
		*indexPtr = listPtr->selectAnchor;
		break;
	    }

	    case INDEX_END: {
		/* "end" index */
		if (endIsSize) {
		    *indexPtr = listPtr->nElements;
		} else {
		    *indexPtr = listPtr->nElements - 1;
		}
		break;
	    }
	}
	return TCL_OK;
    }

    /* The index didn't match any of the named indices; maybe it's an @x,y */
    stringRep = Tcl_GetString(indexObj);
    if (stringRep[0] == '@') {
	/* @x,y index */
	int y;
	char *start, *end;
	start = stringRep + 1;
	strtol(start, &end, 0);
	if ((start == end) || (*end != ',')) {
	    Tcl_AppendResult(interp, "bad listbox index \"", stringRep,
		    "\": must be active, anchor, end, @x,y, or a number",
		    (char *)NULL);
	    return TCL_ERROR;
	}
	start = end+1;
	y = strtol(start, &end, 0);
	if ((start == end) || (*end != '\0')) {
	    Tcl_AppendResult(interp, "bad listbox index \"", stringRep,
		    "\": must be active, anchor, end, @x,y, or a number",
		    (char *)NULL);
	    return TCL_ERROR;
	}
	*indexPtr = NearestListboxElement(listPtr, y);
	return TCL_OK;
    }
    
    /* Maybe the index is just an integer */
    if (Tcl_GetIntFromObj(interp, indexObj, indexPtr) == TCL_OK) {
	return TCL_OK;
    }

    /* Everything failed, nothing matched.  Throw up an error message */
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, "bad listbox index \"",
	    Tcl_GetString(indexObj), "\": must be active, anchor, ",
	    "end, @x,y, or a number", (char *) NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ChangeListboxView --
 *
 *	Change the view on a listbox widget so that a given element
 *	is displayed at the top.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	What's displayed on the screen is changed.  If there is a
 *	scrollbar associated with this widget, then the scrollbar
 *	is instructed to change its display too.
 *
 *----------------------------------------------------------------------
 */

static void
ChangeListboxView(listPtr, index)
    register Listbox *listPtr;		/* Information about widget. */
    int index;				/* Index of element in listPtr
					 * that should now appear at the
					 * top of the listbox. */
{
    if (index >= (listPtr->nElements - listPtr->fullLines)) {
	index = listPtr->nElements - listPtr->fullLines;
    }
    if (index < 0) {
	index = 0;
    }
    if (listPtr->topIndex != index) {
	listPtr->topIndex = index;
	EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
	listPtr->flags |= UPDATE_V_SCROLLBAR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ChangListboxOffset --
 *
 *	Change the horizontal offset for a listbox.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The listbox may be redrawn to reflect its new horizontal
 *	offset.
 *
 *----------------------------------------------------------------------
 */

static void
ChangeListboxOffset(listPtr, offset)
    register Listbox *listPtr;		/* Information about widget. */
    int offset;				/* Desired new "xOffset" for
					 * listbox. */
{
    int maxOffset;
    
    /*
     * Make sure that the new offset is within the allowable range, and
     * round it off to an even multiple of xScrollUnit.
     */

    maxOffset = listPtr->maxWidth - (Tk_Width(listPtr->tkwin) -
	    2*listPtr->inset - 2*listPtr->selBorderWidth)
	    + listPtr->xScrollUnit - 1;
    if (offset > maxOffset) {
	offset = maxOffset;
    }
    if (offset < 0) {
	offset = 0;
    }
    offset -= offset % listPtr->xScrollUnit;
    if (offset != listPtr->xOffset) {
	listPtr->xOffset = offset;
	listPtr->flags |= UPDATE_H_SCROLLBAR;
	EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxScanTo --
 *
 *	Given a point (presumably of the curent mouse location)
 *	drag the view in the window to implement the scan operation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The view in the window may change.
 *
 *----------------------------------------------------------------------
 */

static void
ListboxScanTo(listPtr, x, y)
    register Listbox *listPtr;		/* Information about widget. */
    int x;				/* X-coordinate to use for scan
					 * operation. */
    int y;				/* Y-coordinate to use for scan
					 * operation. */
{
    int newTopIndex, newOffset, maxIndex, maxOffset;
    
    maxIndex = listPtr->nElements - listPtr->fullLines;
    maxOffset = listPtr->maxWidth + (listPtr->xScrollUnit - 1)
	    - (Tk_Width(listPtr->tkwin) - 2*listPtr->inset
	    - 2*listPtr->selBorderWidth - listPtr->xScrollUnit);

    /*
     * Compute new top line for screen by amplifying the difference
     * between the current position and the place where the scan
     * started (the "mark" position).  If we run off the top or bottom
     * of the list, then reset the mark point so that the current
     * position continues to correspond to the edge of the window.
     * This means that the picture will start dragging as soon as the
     * mouse reverses direction (without this reset, might have to slide
     * mouse a long ways back before the picture starts moving again).
     */

    newTopIndex = listPtr->scanMarkYIndex
	    - (10*(y - listPtr->scanMarkY))/listPtr->lineHeight;
    if (newTopIndex > maxIndex) {
	newTopIndex = listPtr->scanMarkYIndex = maxIndex;
	listPtr->scanMarkY = y;
    } else if (newTopIndex < 0) {
	newTopIndex = listPtr->scanMarkYIndex = 0;
	listPtr->scanMarkY = y;
    }
    ChangeListboxView(listPtr, newTopIndex);

    /*
     * Compute new left edge for display in a similar fashion by amplifying
     * the difference between the current position and the place where the
     * scan started.
     */

    newOffset = listPtr->scanMarkXOffset - (10*(x - listPtr->scanMarkX));
    if (newOffset > maxOffset) {
	newOffset = listPtr->scanMarkXOffset = maxOffset;
	listPtr->scanMarkX = x;
    } else if (newOffset < 0) {
	newOffset = listPtr->scanMarkXOffset = 0;
	listPtr->scanMarkX = x;
    }
    ChangeListboxOffset(listPtr, newOffset);
}

/*
 *----------------------------------------------------------------------
 *
 * NearestListboxElement --
 *
 *	Given a y-coordinate inside a listbox, compute the index of
 *	the element under that y-coordinate (or closest to that
 *	y-coordinate).
 *
 * Results:
 *	The return value is an index of an element of listPtr.  If
 *	listPtr has no elements, then 0 is always returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NearestListboxElement(listPtr, y)
    register Listbox *listPtr;		/* Information about widget. */
    int y;				/* Y-coordinate in listPtr's window. */
{
    int index;

    index = (y - listPtr->inset)/listPtr->lineHeight;
    if (index >= (listPtr->fullLines + listPtr->partialLine)) {
	index = listPtr->fullLines + listPtr->partialLine - 1;
    }
    if (index < 0) {
	index = 0;
    }
    index += listPtr->topIndex;
    if (index >= listPtr->nElements) {
	index = listPtr->nElements-1;
    }
    return index;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxSelect --
 *
 *	Select or deselect one or more elements in a listbox..
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	All of the elements in the range between first and last are
 *	marked as either selected or deselected, depending on the
 *	"select" argument.  Any items whose state changes are redisplayed.
 *	The selection is claimed from X when the number of selected
 *	elements changes from zero to non-zero.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxSelect(listPtr, first, last, select)
    register Listbox *listPtr;		/* Information about widget. */
    int first;				/* Index of first element to
					 * select or deselect. */
    int last;				/* Index of last element to
					 * select or deselect. */
    int select;				/* 1 means select items, 0 means
					 * deselect them. */
{
    int i, firstRedisplay, increment, oldCount;
    Tcl_HashEntry *entry;
    int new;
    
    if (last < first) {
	i = first;
	first = last;
	last = i;
    }
    if ((last < 0) || (first >= listPtr->nElements)) {
	return TCL_OK;
    }
    if (first < 0) {
	first = 0;
    }
    if (last >= listPtr->nElements) {
	last = listPtr->nElements - 1;
    }
    oldCount = listPtr->numSelected;
    firstRedisplay = -1;
    increment = select ? 1 : -1;

    /*
     * For each index in the range, find it in our selection hash table.
     * If it's not there but should be, add it.  If it's there but shouldn't
     * be, remove it.
     */
    for (i = first; i <= last; i++) {
	entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
	if (entry != NULL) {
	    if (!select) {
		Tcl_DeleteHashEntry(entry);
		listPtr->numSelected--;
		if (firstRedisplay < 0) {
		    firstRedisplay = i;
		}
	    }
	} else {
	    if (select) {
		entry = Tcl_CreateHashEntry(listPtr->selection,
			(char *)i, &new);
		Tcl_SetHashValue(entry, (ClientData) NULL);
		listPtr->numSelected++;
		if (firstRedisplay < 0) {
		    firstRedisplay = i;
		}
	    }
	}
    }

    if (firstRedisplay >= 0) {
	EventuallyRedrawRange(listPtr, first, last);
    }
    if ((oldCount == 0) && (listPtr->numSelected > 0)
	    && (listPtr->exportSelection)) {
	Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
		(ClientData) listPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxFetchSelection --
 *
 *	This procedure is called back by Tk when the selection is
 *	requested by someone.  It returns part or all of the selection
 *	in a buffer provided by the caller.
 *
 * Results:
 *	The return value is the number of non-NULL bytes stored
 *	at buffer.  Buffer is filled (or partially filled) with a
 *	NULL-terminated string containing part or all of the selection,
 *	as given by offset and maxBytes.  The selection is returned
 *	as a Tcl list with one list element for each element in the
 *	listbox.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ListboxFetchSelection(clientData, offset, buffer, maxBytes)
    ClientData clientData;		/* Information about listbox widget. */
    int offset;				/* Offset within selection of first
					 * byte to be returned. */
    char *buffer;			/* Location in which to place
					 * selection. */
    int maxBytes;			/* Maximum number of bytes to place
					 * at buffer, not including terminating
					 * NULL character. */
{
    register Listbox *listPtr = (Listbox *) clientData;
    Tcl_DString selection;
    int length, count, needNewline;
    Tcl_Obj *curElement;
    char *stringRep;
    int stringLen;
    Tcl_HashEntry *entry;
    int i;
    
    if (!listPtr->exportSelection) {
	return -1;
    }

    /*
     * Use a dynamic string to accumulate the contents of the selection.
     */

    needNewline = 0;
    Tcl_DStringInit(&selection);
    for (i = 0; i < listPtr->nElements; i++) {
	entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
	if (entry != NULL) {
	    if (needNewline) {
		Tcl_DStringAppend(&selection, "\n", 1);
	    }
	    Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
		    &curElement);
	    stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
	    Tcl_DStringAppend(&selection, stringRep, stringLen);
	    needNewline = 1;
	}
    }

    length = Tcl_DStringLength(&selection);
    if (length == 0) {
	return -1;
    }

    /*
     * Copy the requested portion of the selection to the buffer.
     */

    count = length - offset;
    if (count <= 0) {
	count = 0;
    } else {
	if (count > maxBytes) {
	    count = maxBytes;
	}
	memcpy((VOID *) buffer,
		(VOID *) (Tcl_DStringValue(&selection) + offset),
		(size_t) count);
    }
    buffer[count] = '\0';
    Tcl_DStringFree(&selection);
    return count;
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxLostSelection --
 *
 *	This procedure is called back by Tk when the selection is
 *	grabbed away from a listbox widget.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The existing selection is unhighlighted, and the window is
 *	marked as not containing a selection.
 *
 *----------------------------------------------------------------------
 */

static void
ListboxLostSelection(clientData)
    ClientData clientData;		/* Information about listbox widget. */
{
    register Listbox *listPtr = (Listbox *) clientData;
    
    if ((listPtr->exportSelection) && (listPtr->nElements > 0)) {
	ListboxSelect(listPtr, 0, listPtr->nElements-1, 0);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * EventuallyRedrawRange --
 *
 *	Ensure that a given range of elements is eventually redrawn on
 *	the display (if those elements in fact appear on the display).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information gets redisplayed.
 *
 *----------------------------------------------------------------------
 */

static void
EventuallyRedrawRange(listPtr, first, last)
    register Listbox *listPtr;		/* Information about widget. */
    int first;				/* Index of first element in list
					 * that needs to be redrawn. */
    int last;				/* Index of last element in list
					 * that needs to be redrawn.  May
					 * be less than first;
					 * these just bracket a range. */
{
    /* We don't have to register a redraw callback if one is already pending,
     * or if the window doesn't exist, or if the window isn't mapped */
    if ((listPtr->flags & REDRAW_PENDING)
	    || (listPtr->tkwin == NULL)
	    || !Tk_IsMapped(listPtr->tkwin)) {
	return;
    }
    listPtr->flags |= REDRAW_PENDING;
    Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxUpdateVScrollbar --
 *
 *	This procedure is invoked whenever information has changed in
 *	a listbox in a way that would invalidate a vertical scrollbar
 *	display.  If there is an associated scrollbar, then this command
 *	updates it by invoking a Tcl command.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A Tcl command is invoked, and an additional command may be
 *	invoked to process errors in the command.
 *
 *----------------------------------------------------------------------
 */

static void
ListboxUpdateVScrollbar(listPtr)
    register Listbox *listPtr;		/* Information about widget. */
{
    char string[TCL_DOUBLE_SPACE * 2];
    double first, last;
    int result;
    Tcl_Interp *interp;
    
    if (listPtr->yScrollCmd == NULL) {
	return;
    }
    if (listPtr->nElements == 0) {
	first = 0.0;
	last = 1.0;
    } else {
	first = listPtr->topIndex/((double) listPtr->nElements);
	last = (listPtr->topIndex+listPtr->fullLines)
		/((double) listPtr->nElements);
	if (last > 1.0) {
	    last = 1.0;
	}
    }
    sprintf(string, " %g %g", first, last);

    /*
     * We must hold onto the interpreter from the listPtr because the data
     * at listPtr might be freed as a result of the Tcl_VarEval.
     */
    
    interp = listPtr->interp;
    Tcl_Preserve((ClientData) interp);
    result = Tcl_VarEval(interp, listPtr->yScrollCmd, string,
	    (char *) NULL);
    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"\n    (vertical scrolling command executed by listbox)");
	Tcl_BackgroundError(interp);
    }
    Tcl_Release((ClientData) interp);
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxUpdateHScrollbar --
 *
 *	This procedure is invoked whenever information has changed in
 *	a listbox in a way that would invalidate a horizontal scrollbar
 *	display.  If there is an associated horizontal scrollbar, then
 *	this command updates it by invoking a Tcl command.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A Tcl command is invoked, and an additional command may be
 *	invoked to process errors in the command.
 *
 *----------------------------------------------------------------------
 */

static void
ListboxUpdateHScrollbar(listPtr)
    register Listbox *listPtr;		/* Information about widget. */
{
    char string[TCL_DOUBLE_SPACE * 2];
    int result, windowWidth;
    double first, last;
    Tcl_Interp *interp;

    if (listPtr->xScrollCmd == NULL) {
	return;
    }
    windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset
	    + listPtr->selBorderWidth);
    if (listPtr->maxWidth == 0) {
	first = 0;
	last = 1.0;
    } else {
	first = listPtr->xOffset/((double) listPtr->maxWidth);
	last = (listPtr->xOffset + windowWidth)
		/((double) listPtr->maxWidth);
	if (last > 1.0) {
	    last = 1.0;
	}
    }
    sprintf(string, " %g %g", first, last);

    /*
     * We must hold onto the interpreter because the data referred to at
     * listPtr might be freed as a result of the call to Tcl_VarEval.
     */
    
    interp = listPtr->interp;
    Tcl_Preserve((ClientData) interp);
    result = Tcl_VarEval(interp, listPtr->xScrollCmd, string,
	    (char *) NULL);
    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"\n    (horizontal scrolling command executed by listbox)");
	Tcl_BackgroundError(interp);
    }
    Tcl_Release((ClientData) interp);
}

/*
 *----------------------------------------------------------------------
 *
 * ListboxListVarProc --
 *
 *      Called whenever the trace on the listbox list var fires.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static char *
ListboxListVarProc(clientData, interp, name1, name2, flags)
    ClientData clientData;      /* Information about button. */
    Tcl_Interp *interp;         /* Interpreter containing variable. */
    char *name1;                /* Not used. */
    char *name2;                /* Not used. */
    int flags;                  /* Information about what happened. */
{
    Listbox *listPtr = (Listbox *)clientData;
    Tcl_Obj *oldListObj, *varListObj;
    int oldLength;
    int i;
    Tcl_HashEntry *entry;
    
    /* Bwah hahahaha -- puny mortal, you can't unset a -listvar'd variable! */
    if (flags & TCL_TRACE_UNSETS) {
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_SetVar2Ex(interp, listPtr->listVarName,
		    (char *)NULL, listPtr->listObj, TCL_GLOBAL_ONLY);
	    Tcl_TraceVar(interp, listPtr->listVarName,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    ListboxListVarProc, clientData);
	    return (char *)NULL;
	}
    } else {
	oldListObj = listPtr->listObj;
	varListObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName,
		(char *)NULL, TCL_GLOBAL_ONLY);
	/*
	 * Make sure the new value is a good list; if it's not, disallow
	 * the change -- the fact that it is a listvar means that it must
	 * always be a valid list -- and return an error message.
	 */
	if (Tcl_ListObjLength(listPtr->interp, varListObj, &i) != TCL_OK) {
	    Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
		    oldListObj, TCL_GLOBAL_ONLY);
	    return("invalid listvar value");
	}
	
	listPtr->listObj = varListObj;
	/* Incr the obj ref count so it doesn't vanish if the var is unset */
	Tcl_IncrRefCount(listPtr->listObj);
	/* Clean up the ref to our old list obj */
	Tcl_DecrRefCount(oldListObj);
    }

    /*
     * If the list length has decreased, then we should clean up selection and
     * attributes information for elements past the end of the new list
     */
    oldLength = listPtr->nElements;
    Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
    if (listPtr->nElements < oldLength) {
	for (i = listPtr->nElements; i < oldLength; i++) {
	    /* Clean up selection */
	    entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
	    if (entry != NULL) {
		listPtr->numSelected--;
		Tcl_DeleteHashEntry(entry);
	    }

	    /* Clean up attributes */
	    entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *)i);
	    if (entry != NULL) {
		Tcl_DeleteHashEntry(entry);
	    }
	}
    }

    if (oldLength != listPtr->nElements) {
	listPtr->flags |= UPDATE_V_SCROLLBAR;
	if (listPtr->topIndex > (listPtr->nElements - listPtr->fullLines)) {
	    listPtr->topIndex = listPtr->nElements - listPtr->fullLines;
	    if (listPtr->topIndex < 0) {
		listPtr->topIndex = 0;
	    }
	}
    }

    /*
     * The computed maxWidth may have changed as a result of this operation.
     * However, we don't want to recompute it every time this trace fires
     * (imagine the user doing 1000 lappends to the listvar).  Therefore, set
     * the MAXWIDTH_IS_STALE flag, which will cause the width to be recomputed
     * next time the list is redrawn.
     */
    listPtr->flags |= MAXWIDTH_IS_STALE;
    
    EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
    return (char*)NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * MigrateHashEntries --
 *
 *	Given a hash table with entries keyed by a single integer value,
 *	move all entries in a given range by a fixed amount, so that
 *	if in the original table there was an entry with key n and
 *	the offset was i, in the new table that entry would have key n + i.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Rekeys some hash table entries.
 *
 *----------------------------------------------------------------------
 */

static void
MigrateHashEntries(table, first, last, offset)
    Tcl_HashTable *table;
    int first;
    int last;
    int offset;
{
    int i, new;
    Tcl_HashEntry *entry;
    ClientData clientData;

    if (offset == 0) {
	return;
    }
    /* It's more efficient to do one if/else and nest the for loops inside,
     * although we could avoid some code duplication if we nested the if/else
     * inside the for loops */
    if (offset > 0) {
	for (i = last; i >= first; i--) {
	    entry = Tcl_FindHashEntry(table, (char *)i);
	    if (entry != NULL) {
		clientData = Tcl_GetHashValue(entry);
		Tcl_DeleteHashEntry(entry);
		entry = Tcl_CreateHashEntry(table, (char *)(i + offset), &new);
		Tcl_SetHashValue(entry, clientData);
	    }
	}
    } else {
	for (i = first; i <= last; i++) {
	    entry = Tcl_FindHashEntry(table, (char *)i);
	    if (entry != NULL) {
		clientData = Tcl_GetHashValue(entry);
		Tcl_DeleteHashEntry(entry);
		entry = Tcl_CreateHashEntry(table, (char *)(i + offset), &new);
		Tcl_SetHashValue(entry, clientData);
	    }
	}
    }
    return;
}



