tkListbox.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:103k
源码类别:

通讯编程

开发平台:

Visual C++

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