1/*
2 * tkTreeCtrl.c --
3 *
4 *	This module implements treectrl widgets for the Tk toolkit.
5 *
6 * Copyright (c) 2002-2009 Tim Baker
7 * Copyright (c) 2002-2003 Christian Krone
8 * Copyright (c) 2003-2005 ActiveState, a division of Sophos
9 *
10 * RCS: @(#) $Id: tkTreeCtrl.c,v 1.117 2010/03/08 17:02:58 treectrl Exp $
11 */
12
13#include "tkTreeCtrl.h"
14
15#ifdef WIN32
16#include <windows.h>
17#endif
18#if defined(MAC_TK_CARBON)
19#include <Carbon/Carbon.h>
20#endif
21#if defined(MAC_TK_COCOA)
22#import <Cocoa/Cocoa.h>
23#endif
24
25/*
26 * TIP #116 altered Tk_PhotoPutBlock API to add interp arg.
27 * We need to remove that for compiling with 8.4.
28 */
29#if (TK_MAJOR_VERSION == 8) && (TK_MINOR_VERSION < 5)
30#define TK_PHOTOPUTBLOCK(interp, hdl, blk, x, y, w, h, cr) \
31		Tk_PhotoPutBlock(hdl, blk, x, y, w, h, cr)
32#define TK_PHOTOPUTZOOMEDBLOCK(interp, hdl, blk, x, y, w, h, \
33				zx, zy, sx, sy, cr) \
34		Tk_PhotoPutZoomedBlock(hdl, blk, x, y, w, h, \
35				zx, zy, sx, sy, cr)
36#else
37#define TK_PHOTOPUTBLOCK	Tk_PhotoPutBlock
38#define TK_PHOTOPUTZOOMEDBLOCK	Tk_PhotoPutZoomedBlock
39#endif
40
41/* This structure is used for reference-counted images. */
42typedef struct TreeImageRef {
43    int count;			/* Reference count. */
44    Tk_Image image;		/* Image token. */
45    Tcl_HashEntry *hPtr;	/* Entry in tree->imageNameHash. */
46} TreeImageRef;
47
48static CONST char *bgModeST[] = {
49    "column", "order", "ordervisible", "row",
50#ifdef DEPRECATED
51    "index", "visindex",
52#endif
53    (char *) NULL
54};
55static CONST char *columnResizeModeST[] = {
56    "proxy", "realtime", (char *) NULL
57};
58static CONST char *doubleBufferST[] = {
59    "none", "item", "window", (char *) NULL
60};
61static CONST char *lineStyleST[] = {
62    "dot", "solid", (char *) NULL
63};
64static CONST char *orientStringTable[] = {
65    "horizontal", "vertical", (char *) NULL
66};
67
68static Tk_OptionSpec optionSpecs[] = {
69    {TK_OPTION_BORDER, "-background", "background", "Background",
70     "white", -1, Tk_Offset(TreeCtrl, border), 0,
71     (ClientData) "white", TREE_CONF_REDISPLAY},
72    {TK_OPTION_STRING, "-backgroundimage", "backgroundImage", "BackgroundImage",
73      (char *) NULL, -1, Tk_Offset(TreeCtrl, backgroundImageString),
74      TK_OPTION_NULL_OK, (ClientData) NULL,
75      TREE_CONF_BG_IMAGE | TREE_CONF_REDISPLAY},
76    {TK_OPTION_STRING_TABLE, "-backgroundmode",
77     "backgroundMode", "BackgroundMode",
78     "row", -1, Tk_Offset(TreeCtrl, backgroundMode),
79     0, (ClientData) bgModeST, TREE_CONF_REDISPLAY},
80    {TK_OPTION_STRING_TABLE, "-columnresizemode",
81     "columnResizeMode", "ColumnResizeMode",
82     "proxy", -1, Tk_Offset(TreeCtrl, columnResizeMode),
83     0, (ClientData) columnResizeModeST, 0},
84    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
85     (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
86    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
87     (char *) NULL, 0, -1, 0, (ClientData) "-background"},
88    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
89     DEF_LISTBOX_BORDER_WIDTH, Tk_Offset(TreeCtrl, borderWidthObj),
90     Tk_Offset(TreeCtrl, borderWidth),
91     0, (ClientData) NULL, TREE_CONF_BORDERS | TREE_CONF_RELAYOUT},
92    {TK_OPTION_COLOR, "-buttoncolor", "buttonColor", "ButtonColor",
93     "#808080", -1, Tk_Offset(TreeCtrl, buttonColor),
94     0, (ClientData) NULL, TREE_CONF_BUTTON | TREE_CONF_REDISPLAY},
95    {TK_OPTION_CUSTOM, "-buttonbitmap", "buttonBitmap", "ButtonBitmap",
96     (char *) NULL,
97     Tk_Offset(TreeCtrl, buttonBitmap.obj), Tk_Offset(TreeCtrl, buttonBitmap),
98     TK_OPTION_NULL_OK, (ClientData) NULL,
99     TREE_CONF_BUTTON | TREE_CONF_BUTBMP | TREE_CONF_RELAYOUT},
100    {TK_OPTION_CUSTOM, "-buttonimage", "buttonImage", "ButtonImage",
101     (char *) NULL,
102     Tk_Offset(TreeCtrl, buttonImage.obj), Tk_Offset(TreeCtrl, buttonImage),
103     TK_OPTION_NULL_OK, (ClientData) NULL,
104     TREE_CONF_BUTTON | TREE_CONF_BUTIMG | TREE_CONF_RELAYOUT},
105    {TK_OPTION_PIXELS, "-buttonsize", "buttonSize", "ButtonSize",
106     "9", Tk_Offset(TreeCtrl, buttonSizeObj),
107     Tk_Offset(TreeCtrl, buttonSize),
108     0, (ClientData) NULL, TREE_CONF_BUTTON | TREE_CONF_RELAYOUT},
109    {TK_OPTION_PIXELS, "-buttonthickness",
110     "buttonThickness", "ButtonThickness",
111     "1", Tk_Offset(TreeCtrl, buttonThicknessObj),
112     Tk_Offset(TreeCtrl, buttonThickness),
113     0, (ClientData) NULL, TREE_CONF_BUTTON | TREE_CONF_REDISPLAY},
114    {TK_OPTION_STRING, "-columnprefix", "columnPrefix", "ColumnPrefix",
115     "", -1, Tk_Offset(TreeCtrl, columnPrefix), 0, (ClientData) NULL, 0},
116    {TK_OPTION_PIXELS, "-columnproxy", "columnProxy", "ColumnProxy",
117     (char *) NULL, Tk_Offset(TreeCtrl, columnProxy.xObj),
118     Tk_Offset(TreeCtrl, columnProxy.x),
119     TK_OPTION_NULL_OK, (ClientData) NULL, TREE_CONF_PROXY},
120    {TK_OPTION_BOOLEAN, "-columntagexpr", "columnTagExpr", "ColumnTagExpr",
121     "1", -1, Tk_Offset(TreeCtrl, columnTagExpr),
122     0, (ClientData) NULL, 0},
123    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
124     (char *) NULL, -1, Tk_Offset(TreeCtrl, cursor),
125     TK_OPTION_NULL_OK, (ClientData) NULL, 0},
126#ifdef DEPRECATED
127    {TK_OPTION_STRING, "-defaultstyle", "defaultStyle", "DefaultStyle",
128     (char *) NULL, Tk_Offset(TreeCtrl, defaultStyle.stylesObj), -1,
129     TK_OPTION_NULL_OK, (ClientData) NULL, TREE_CONF_DEFSTYLE},
130    {TK_OPTION_STRING_TABLE, "-doublebuffer",
131     "doubleBuffer", "DoubleBuffer",
132     "item", -1, Tk_Offset(TreeCtrl, doubleBuffer),
133     0, (ClientData) doubleBufferST, TREE_CONF_REDISPLAY},
134#endif /* DEPRECATED */
135    {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
136     (char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
137    {TK_OPTION_FONT, "-font", "font", "Font",
138     DEF_LISTBOX_FONT, Tk_Offset(TreeCtrl, fontObj),
139     Tk_Offset(TreeCtrl, tkfont),
140     0, (ClientData) NULL, TREE_CONF_FONT | TREE_CONF_RELAYOUT},
141    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
142     DEF_LISTBOX_FG, Tk_Offset(TreeCtrl, fgObj), Tk_Offset(TreeCtrl, fgColorPtr),
143     0, (ClientData) NULL, TREE_CONF_FG | TREE_CONF_REDISPLAY},
144    {TK_OPTION_PIXELS, "-height", "height", "Height",
145     "200", Tk_Offset(TreeCtrl, heightObj), Tk_Offset(TreeCtrl, height),
146     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
147    {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
148     "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG, -1,
149     Tk_Offset(TreeCtrl, highlightBgColorPtr),
150     0, (ClientData) NULL, TREE_CONF_REDISPLAY},
151    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
152     DEF_LISTBOX_HIGHLIGHT, -1, Tk_Offset(TreeCtrl, highlightColorPtr),
153     0, (ClientData) NULL, TREE_CONF_REDISPLAY},
154    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
155     "HighlightThickness", DEF_LISTBOX_HIGHLIGHT_WIDTH,
156     Tk_Offset(TreeCtrl, highlightWidthObj),
157     Tk_Offset(TreeCtrl, highlightWidth),
158     0, (ClientData) NULL, TREE_CONF_BORDERS | TREE_CONF_RELAYOUT},
159    {TK_OPTION_PIXELS, "-indent", "indent", "Indent",
160     "19", Tk_Offset(TreeCtrl, indentObj),
161     Tk_Offset(TreeCtrl, indent),
162     0, (ClientData) NULL, TREE_CONF_INDENT | TREE_CONF_RELAYOUT},
163    {TK_OPTION_PIXELS, "-itemheight", "itemHeight", "ItemHeight",
164     "0", Tk_Offset(TreeCtrl, itemHeightObj),
165     Tk_Offset(TreeCtrl, itemHeight),
166     0, (ClientData) NULL, TREE_CONF_ITEMSIZE | TREE_CONF_RELAYOUT},
167#if 0
168    {TK_OPTION_CUSTOM, "-itempadx", (char *) NULL, (char *) NULL,
169     "0",
170     Tk_Offset(TreeCtrl, itemPadXObj),
171     Tk_Offset(TreeCtrl, itemPadX),
172     0, (ClientData) &TreeCtrlCO_pad, 0},
173    {TK_OPTION_CUSTOM, "-itempady", (char *) NULL, (char *) NULL,
174     "0",
175     Tk_Offset(TreeCtrl, itemPadYObj),
176     Tk_Offset(TreeCtrl, itemPadY),
177     0, (ClientData) &TreeCtrlCO_pad, 0},
178#endif
179    {TK_OPTION_STRING, "-itemprefix", "itemPrefix", "ItemPrefix",
180     "", -1, Tk_Offset(TreeCtrl, itemPrefix), 0, (ClientData) NULL, 0},
181    {TK_OPTION_BOOLEAN, "-itemtagexpr", "itemTagExpr", "ItemTagExpr",
182     "1", -1, Tk_Offset(TreeCtrl, itemTagExpr),
183     0, (ClientData) NULL, 0},
184    {TK_OPTION_PIXELS, "-itemwidth", "itemWidth", "ItemWidth",
185     "", Tk_Offset(TreeCtrl, itemWidthObj), Tk_Offset(TreeCtrl, itemWidth),
186     TK_OPTION_NULL_OK, (ClientData) NULL, TREE_CONF_ITEMSIZE | TREE_CONF_RELAYOUT},
187    {TK_OPTION_BOOLEAN, "-itemwidthequal", "itemWidthEqual", "ItemWidthEqual",
188     "0", -1, Tk_Offset(TreeCtrl, itemWidthEqual),
189     TK_OPTION_NULL_OK, (ClientData) NULL, TREE_CONF_ITEMSIZE | TREE_CONF_RELAYOUT},
190    {TK_OPTION_PIXELS, "-itemwidthmultiple", "itemWidthMultiple", "ItemWidthMultiple",
191     "", Tk_Offset(TreeCtrl, itemWidMultObj), Tk_Offset(TreeCtrl, itemWidMult),
192     TK_OPTION_NULL_OK, (ClientData) NULL, TREE_CONF_ITEMSIZE | TREE_CONF_RELAYOUT},
193    {TK_OPTION_COLOR, "-linecolor", "lineColor", "LineColor",
194     "#808080", -1, Tk_Offset(TreeCtrl, lineColor),
195     0, (ClientData) NULL, TREE_CONF_LINE | TREE_CONF_REDISPLAY},
196    {TK_OPTION_STRING_TABLE, "-linestyle", "lineStyle", "LineStyle",
197     "dot", -1, Tk_Offset(TreeCtrl, lineStyle),
198     0, (ClientData) lineStyleST, TREE_CONF_LINE | TREE_CONF_REDISPLAY},
199    {TK_OPTION_PIXELS, "-linethickness", "lineThickness", "LineThickness",
200     "1", Tk_Offset(TreeCtrl, lineThicknessObj),
201     Tk_Offset(TreeCtrl, lineThickness),
202     0, (ClientData) NULL, TREE_CONF_LINE | TREE_CONF_REDISPLAY},
203    {TK_OPTION_PIXELS, "-minitemheight", "minItemHeight", "MinItemHeight",
204     "0", Tk_Offset(TreeCtrl, minItemHeightObj),
205     Tk_Offset(TreeCtrl, minItemHeight),
206     0, (ClientData) NULL, TREE_CONF_ITEMSIZE | TREE_CONF_RELAYOUT},
207    {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient",
208     "vertical", -1, Tk_Offset(TreeCtrl, vertical),
209     0, (ClientData) orientStringTable, TREE_CONF_RELAYOUT},
210    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
211     "sunken", -1, Tk_Offset(TreeCtrl, relief),
212     0, (ClientData) NULL, TREE_CONF_REDISPLAY},
213    {TK_OPTION_PIXELS, "-rowproxy", "rowProxy", "RowProxy",
214     (char *) NULL, Tk_Offset(TreeCtrl, rowProxy.yObj),
215     Tk_Offset(TreeCtrl, rowProxy.y),
216     TK_OPTION_NULL_OK, (ClientData) NULL, TREE_CONF_PROXY},
217    {TK_OPTION_STRING, "-scrollmargin", "scrollMargin", "ScrollMargin",
218     "0", Tk_Offset(TreeCtrl, scrollMargin), -1,
219     0, (ClientData) NULL, 0},
220    {TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode",
221     DEF_LISTBOX_SELECT_MODE, -1, Tk_Offset(TreeCtrl, selectMode),
222     TK_OPTION_NULL_OK, (ClientData) NULL, 0},
223    {TK_OPTION_BOOLEAN, "-showbuttons", "showButtons",
224     "ShowButtons", "1", -1, Tk_Offset(TreeCtrl, showButtons),
225     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
226    {TK_OPTION_BOOLEAN, "-showheader", "showHeader", "ShowHeader",
227     "1", -1, Tk_Offset(TreeCtrl, showHeader),
228     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
229    {TK_OPTION_BOOLEAN, "-showlines", "showLines",
230     "ShowLines", "1", -1, Tk_Offset(TreeCtrl, showLines),
231     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
232    {TK_OPTION_BOOLEAN, "-showrootlines", "showRootLines",
233     "ShowRootLines", "1", -1, Tk_Offset(TreeCtrl, showRootLines),
234     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
235    {TK_OPTION_BOOLEAN, "-showroot", "showRoot",
236     "ShowRoot", "1", -1, Tk_Offset(TreeCtrl, showRoot),
237     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
238    {TK_OPTION_BOOLEAN, "-showrootbutton", "showRootButton",
239     "ShowRootButton", "0", -1, Tk_Offset(TreeCtrl, showRootButton),
240     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
241    {TK_OPTION_BOOLEAN, "-showrootchildbuttons", "showRootChildButtons",
242     "ShowRootChildButtons", "1", -1, Tk_Offset(TreeCtrl, showRootChildButtons),
243     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
244    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
245     DEF_LISTBOX_TAKE_FOCUS, -1, Tk_Offset(TreeCtrl, takeFocus),
246     TK_OPTION_NULL_OK, 0, 0},
247    {TK_OPTION_CUSTOM, "-treecolumn", "treeColumn", "TreeColumn",
248     (char *) NULL, -1, Tk_Offset(TreeCtrl, columnTree),
249     TK_OPTION_NULL_OK, (ClientData) &TreeCtrlCO_column_NOT_TAIL,
250     TREE_CONF_RELAYOUT},
251    {TK_OPTION_BOOLEAN, "-usetheme", "useTheme",
252     "UseTheme", "0", -1, Tk_Offset(TreeCtrl, useTheme),
253     0, (ClientData) NULL, TREE_CONF_THEME | TREE_CONF_RELAYOUT},
254    {TK_OPTION_PIXELS, "-width", "width", "Width",
255     "200", Tk_Offset(TreeCtrl, widthObj), Tk_Offset(TreeCtrl, width),
256     0, (ClientData) NULL, TREE_CONF_RELAYOUT},
257    {TK_OPTION_STRING, "-wrap", "wrap", "Wrap",
258     (char *) NULL, Tk_Offset(TreeCtrl, wrapObj), -1,
259     TK_OPTION_NULL_OK, (ClientData) NULL,
260     TREE_CONF_WRAP | TREE_CONF_RELAYOUT},
261    {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
262     (char *) NULL, -1, Tk_Offset(TreeCtrl, xScrollCmd),
263     TK_OPTION_NULL_OK, 0, 0},
264    {TK_OPTION_STRING, "-xscrolldelay", "xScrollDelay", "ScrollDelay",
265     "50", Tk_Offset(TreeCtrl, xScrollDelay), -1,
266     TK_OPTION_NULL_OK, 0, 0},
267    {TK_OPTION_PIXELS, "-xscrollincrement", "xScrollIncrement", "ScrollIncrement",
268     "0", -1, Tk_Offset(TreeCtrl, xScrollIncrement),
269     0, (ClientData) NULL, TREE_CONF_REDISPLAY},
270    {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
271     (char *) NULL, -1, Tk_Offset(TreeCtrl, yScrollCmd),
272     TK_OPTION_NULL_OK, 0, 0},
273    {TK_OPTION_STRING, "-yscrolldelay", "yScrollDelay", "ScrollDelay",
274     "50", Tk_Offset(TreeCtrl, yScrollDelay), -1,
275     TK_OPTION_NULL_OK, 0, 0},
276    {TK_OPTION_PIXELS, "-yscrollincrement", "yScrollIncrement", "ScrollIncrement",
277     "0", -1, Tk_Offset(TreeCtrl, yScrollIncrement),
278     0, (ClientData) NULL, TREE_CONF_REDISPLAY},
279
280    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
281     (char *) NULL, -1, -1, 0, (ClientData) NULL, 0}
282};
283
284static Tk_OptionSpec debugSpecs[] = {
285    {TK_OPTION_INT, "-displaydelay", (char *) NULL, (char *) NULL,
286     "0", -1, Tk_Offset(TreeCtrl, debug.displayDelay),
287     0, (ClientData) NULL, 0},
288    {TK_OPTION_BOOLEAN, "-data", (char *) NULL, (char *) NULL,
289     "1", -1, Tk_Offset(TreeCtrl, debug.data),
290     0, (ClientData) NULL, 0},
291    {TK_OPTION_BOOLEAN, "-display", (char *) NULL, (char *) NULL,
292     "1", -1, Tk_Offset(TreeCtrl, debug.display),
293     0, (ClientData) NULL, 0},
294    {TK_OPTION_COLOR, "-drawcolor", (char *) NULL, (char *) NULL,
295     (char *) NULL, -1, Tk_Offset(TreeCtrl, debug.drawColor),
296     TK_OPTION_NULL_OK, (ClientData) NULL, 0},
297    {TK_OPTION_BOOLEAN, "-enable", (char *) NULL, (char *) NULL,
298     "0", -1, Tk_Offset(TreeCtrl, debug.enable),
299     0, (ClientData) NULL, 0},
300    {TK_OPTION_COLOR, "-erasecolor", (char *) NULL, (char *) NULL,
301     (char *) NULL, -1, Tk_Offset(TreeCtrl, debug.eraseColor),
302     TK_OPTION_NULL_OK, (ClientData) NULL, 0},
303    {TK_OPTION_BOOLEAN, "-span", (char *) NULL, (char *) NULL,
304     "1", -1, Tk_Offset(TreeCtrl, debug.span),
305     0, (ClientData) NULL, 0},
306    {TK_OPTION_BOOLEAN, "-textlayout", (char *) NULL, (char *) NULL,
307     "1", -1, Tk_Offset(TreeCtrl, debug.textLayout),
308     0, (ClientData) NULL, 0},
309    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
310     (char *) NULL, -1, -1, 0, (ClientData) NULL, 0}
311};
312
313static int TreeWidgetCmd(ClientData clientData, Tcl_Interp *interp, int objc,
314    Tcl_Obj *CONST objv[]);
315static int TreeConfigure(Tcl_Interp *interp, TreeCtrl *tree, int objc,
316    Tcl_Obj *CONST objv[], int createFlag);
317static void TreeEventProc(ClientData clientData, XEvent * eventPtr);
318static void TreeDestroy(char *memPtr);
319static void TreeCmdDeletedProc(ClientData clientData);
320static void TreeWorldChanged(ClientData instanceData);
321static void TreeComputeGeometry(TreeCtrl *tree);
322static int TreeSeeCmd(TreeCtrl *tree, int objc, Tcl_Obj *CONST objv[]);
323static int TreeStateCmd(TreeCtrl *tree, int objc, Tcl_Obj *CONST objv[]);
324static int TreeSelectionCmd(Tcl_Interp *interp, TreeCtrl *tree, int objc,
325    Tcl_Obj *CONST objv[]);
326static int TreeXviewCmd(Tcl_Interp *interp, TreeCtrl *tree, int objc,
327    Tcl_Obj *CONST objv[]);
328static int TreeYviewCmd(Tcl_Interp *interp, TreeCtrl *tree, int objc,
329    Tcl_Obj *CONST objv[]);
330static int TreeDebugCmd(ClientData clientData, Tcl_Interp *interp, int objc,
331    Tcl_Obj *CONST objv[]);
332
333static Tk_ClassProcs treectrlClass = {
334    sizeof(Tk_ClassProcs),	/* size */
335    TreeWorldChanged,		/* worldChangedProc. */
336    NULL,			/* createProc. */
337    NULL			/* modalProc. */
338};
339
340/*
341 *--------------------------------------------------------------
342 *
343 * TreeObjCmd --
344 *
345 *	This procedure is invoked to process the [treectrl] Tcl
346 *	command.  See the user documentation for details on what
347 *	it does.
348 *
349 * Results:
350 *	A standard Tcl result.
351 *
352 * Side effects:
353 *	See the user documentation.
354 *
355 *--------------------------------------------------------------
356 */
357
358static int
359TreeObjCmd(
360    ClientData clientData,	/* Not used. */
361    Tcl_Interp *interp,		/* Current interpreter. */
362    int objc,			/* Number of arguments. */
363    Tcl_Obj *CONST objv[]	/* Argument values. */
364    )
365{
366    TreeCtrl *tree;
367    Tk_Window tkwin;
368    Tk_OptionTable optionTable;
369
370    if (objc < 2) {
371	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
372	return TCL_ERROR;
373    }
374
375    tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
376	    Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL);
377    if (tkwin == NULL) {
378	return TCL_ERROR;
379    }
380
381    optionTable = Tk_CreateOptionTable(interp, optionSpecs);
382
383    tree = (TreeCtrl *) ckalloc(sizeof(TreeCtrl));
384    memset(tree, '\0', sizeof(TreeCtrl));
385    tree->tkwin		= tkwin;
386    tree->display	= Tk_Display(tkwin);
387    tree->interp	= interp;
388    tree->widgetCmd	= Tcl_CreateObjCommand(interp,
389				Tk_PathName(tree->tkwin), TreeWidgetCmd,
390				(ClientData) tree, TreeCmdDeletedProc);
391    tree->optionTable	= optionTable;
392    tree->relief	= TK_RELIEF_SUNKEN;
393    tree->prevWidth	= Tk_Width(tkwin);
394    tree->prevHeight	= Tk_Height(tkwin);
395    tree->updateIndex	= 1;
396
397    tree->stateNames[0]	= "open";
398    tree->stateNames[1]	= "selected";
399    tree->stateNames[2]	= "enabled";
400    tree->stateNames[3]	= "active";
401    tree->stateNames[4]	= "focus";
402
403    Tcl_InitHashTable(&tree->selection, TCL_ONE_WORD_KEYS);
404
405    /* Do this before Tree_InitColumns() which does Tk_InitOptions(), which
406     * calls Tk_GetOption() which relies on the window class */
407    Tk_SetClass(tkwin, "TreeCtrl");
408    Tk_SetClassProcs(tkwin, &treectrlClass, (ClientData) tree);
409
410    tree->debug.optionTable = Tk_CreateOptionTable(interp, debugSpecs);
411    (void) Tk_InitOptions(interp, (char *) tree, tree->debug.optionTable,
412	    tkwin);
413
414    Tcl_InitHashTable(&tree->itemHash, TCL_ONE_WORD_KEYS);
415    Tcl_InitHashTable(&tree->itemSpansHash, TCL_ONE_WORD_KEYS);
416    Tcl_InitHashTable(&tree->elementHash, TCL_STRING_KEYS);
417    Tcl_InitHashTable(&tree->styleHash, TCL_STRING_KEYS);
418    Tcl_InitHashTable(&tree->imageNameHash, TCL_STRING_KEYS);
419    Tcl_InitHashTable(&tree->imageTokenHash, TCL_ONE_WORD_KEYS);
420
421    TreeItemList_Init(tree, &tree->preserveItemList, 0);
422
423#ifdef ALLOC_HAX
424    tree->allocData = TreeAlloc_Init();
425#endif
426
427    Tree_InitColumns(tree);
428    TreeItem_Init(tree);
429    TreeNotify_Init(tree);
430    (void) TreeStyle_Init(tree);
431    TreeMarquee_Init(tree);
432    TreeDragImage_Init(tree);
433    TreeDInfo_Init(tree);
434
435    Tk_CreateEventHandler(tree->tkwin,
436#ifdef USE_TTK
437	    ExposureMask|StructureNotifyMask|FocusChangeMask|ActivateMask|VirtualEventMask,
438#else
439	    ExposureMask|StructureNotifyMask|FocusChangeMask|ActivateMask,
440#endif
441	    TreeEventProc, (ClientData) tree);
442
443    /* Must do this on Unix because Tk_GCForColor() uses
444     * Tk_WindowId(tree->tkwin) */
445    Tk_MakeWindowExist(tree->tkwin);
446
447    /* Window must exist on Win32. */
448    TreeTheme_Init(tree);
449
450    /*
451     * Keep a hold of the associated tkwin until we destroy the listbox,
452     * otherwise Tk might free it while we still need it.
453     */
454    Tcl_Preserve((ClientData) tkwin);
455
456    if (Tk_InitOptions(interp, (char *) tree, optionTable, tkwin) != TCL_OK) {
457	Tk_DestroyWindow(tree->tkwin);
458	return TCL_ERROR;
459    }
460
461    if (TreeConfigure(interp, tree, objc - 2, objv + 2, TRUE) != TCL_OK) {
462	Tk_DestroyWindow(tree->tkwin);
463	return TCL_ERROR;
464    }
465
466    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tree->tkwin), -1));
467    return TCL_OK;
468}
469
470#define W2Cx(x) ((x) + tree->xOrigin)
471#define C2Wx(x) ((x) - tree->xOrigin)
472#define C2Ox(x) ((x) - Tree_ContentLeft(tree))
473
474#define W2Cy(y) ((y) + tree->yOrigin)
475#define C2Wy(y) ((y) - tree->yOrigin)
476#define C2Oy(y) ((y) - Tree_ContentTop(tree))
477
478/*
479 *--------------------------------------------------------------
480 *
481 * TreeWidgetCmd --
482 *
483 *	This procedure is invoked to process the Tcl command
484 *	that corresponds to a widget managed by this module.
485 *	See the user documentation for details on what it does.
486 *
487 * Results:
488 *	A standard Tcl result.
489 *
490 * Side effects:
491 *	See the user documentation.
492 *
493 *--------------------------------------------------------------
494 */
495
496static int TreeWidgetCmd(
497    ClientData clientData,	/* Widget info. */
498    Tcl_Interp *interp,		/* Current interpreter. */
499    int objc,			/* Number of arguments. */
500    Tcl_Obj *CONST objv[]	/* Argument values. */
501    )
502{
503    TreeCtrl *tree = clientData;
504    int result = TCL_OK;
505    static CONST char *commandName[] = {
506	"activate", "bbox", "canvasx", "canvasy", "cget",
507#ifdef DEPRECATED
508	"collapse",
509#endif
510	"column",
511#ifdef DEPRECATED
512	"compare",
513#endif
514	"configure", "contentbox", "debug", "depth", "dragimage", "element",
515#ifdef DEPRECATED
516	"expand",
517#endif
518	"identify", "index", "item", "marquee", "notify",
519#ifdef DEPRECATED
520	"numcolumns", "numitems",
521#endif
522	"orphans",
523#ifdef DEPRECATED
524	"range",
525#endif
526	"scan", "see", "selection", "state", "style",
527#ifdef DEPRECATED
528	"toggle",
529#endif
530	"xview", "yview", (char *) NULL
531    };
532    enum {
533	COMMAND_ACTIVATE, COMMAND_BBOX, COMMAND_CANVASX, COMMAND_CANVASY,
534	COMMAND_CGET,
535#ifdef DEPRECATED
536	COMMAND_COLLAPSE,
537#endif
538	COMMAND_COLUMN,
539#ifdef DEPRECATED
540	COMMAND_COMPARE,
541#endif
542	COMMAND_CONFIGURE, COMMAND_CONTENTBOX, COMMAND_DEBUG, COMMAND_DEPTH,
543	COMMAND_DRAGIMAGE, COMMAND_ELEMENT,
544#ifdef DEPRECATED
545	COMMAND_EXPAND,
546#endif
547	COMMAND_IDENTIFY, COMMAND_INDEX, COMMAND_ITEM, COMMAND_MARQUEE,
548	COMMAND_NOTIFY,
549#ifdef DEPRECATED
550	COMMAND_NUMCOLUMNS, COMMAND_NUMITEMS,
551#endif
552	COMMAND_ORPHANS,
553#ifdef DEPRECATED
554	COMMAND_RANGE,
555#endif
556	COMMAND_SCAN, COMMAND_SEE, COMMAND_SELECTION, COMMAND_STATE,
557	COMMAND_STYLE,
558#ifdef DEPRECATED
559	COMMAND_TOGGLE,
560#endif
561	COMMAND_XVIEW, COMMAND_YVIEW
562    };
563    Tcl_Obj *resultObjPtr;
564    int index;
565
566    if (objc < 2) {
567	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg arg ...?");
568	return TCL_ERROR;
569    }
570
571    if (Tcl_GetIndexFromObj(interp, objv[1], commandName, "command", 0,
572	    &index) != TCL_OK) {
573	return TCL_ERROR;
574    }
575
576    Tcl_Preserve((ClientData) tree);
577    Tree_PreserveItems(tree);
578
579    switch (index) {
580	case COMMAND_ACTIVATE: {
581	    TreeItem active, item;
582
583	    if (objc != 3) {
584		Tcl_WrongNumArgs(interp, 2, objv, "item");
585		goto error;
586	    }
587	    if (TreeItem_FromObj(tree, objv[2], &item, IFO_NOT_NULL) != TCL_OK) {
588		goto error;
589	    }
590	    if (item != tree->activeItem) {
591		int x, y, w, h;
592
593		active = tree->activeItem;
594		TreeItem_ChangeState(tree, active, STATE_ACTIVE, 0);
595		tree->activeItem = item;
596		TreeItem_ChangeState(tree, tree->activeItem, 0, STATE_ACTIVE);
597
598		/* FIXME: is it onscreen? */
599		/* FIXME: what if only lock columns displayed? */
600		if (Tree_ItemBbox(tree, item, COLUMN_LOCK_NONE, &x, &y, &w, &h) >= 0) {
601		    Tk_SetCaretPos(tree->tkwin, x - tree->xOrigin,
602			    y - tree->yOrigin, h);
603		}
604		TreeNotify_ActiveItem(tree, active, item);
605	    }
606	    break;
607	}
608
609	/* .t bbox ?area? */
610	case COMMAND_BBOX: {
611	    static CONST char *areaName[] = { "content", "header", "left",
612		    "right", (char *) NULL };
613	    int x1, y1, x2, y2;
614
615	    if (objc > 3) {
616		Tcl_WrongNumArgs(interp, 2, objv, "?area?");
617		goto error;
618	    }
619	    if (objc == 3) {
620		int area[4] = { TREE_AREA_CONTENT, TREE_AREA_HEADER,
621			TREE_AREA_LEFT, TREE_AREA_RIGHT };
622		if (Tcl_GetIndexFromObj(interp, objv[2], areaName, "area", 0,
623			&index) != TCL_OK) {
624		    goto error;
625		}
626		if (!Tree_AreaBbox(tree, area[index], &x1, &y1, &x2, &y2))
627		    break;
628	    } else {
629		x1 = 0;
630		y1 = 0;
631		x2 = Tk_Width(tree->tkwin);
632		y2 = Tk_Height(tree->tkwin);
633	    }
634	    FormatResult(interp, "%d %d %d %d", x1, y1, x2, y2);
635	    break;
636	}
637
638	case COMMAND_CANVASX: {
639	    int x;
640
641	    if (objc != 3) {
642		Tcl_WrongNumArgs(interp, 2, objv, "x");
643		goto error;
644	    }
645	    if (Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
646		goto error;
647	    Tcl_SetObjResult(interp, Tcl_NewIntObj(x + tree->xOrigin));
648	    break;
649	}
650
651	case COMMAND_CANVASY: {
652	    int y;
653
654	    if (objc != 3) {
655		Tcl_WrongNumArgs(interp, 2, objv, "y");
656		goto error;
657	    }
658	    if (Tcl_GetIntFromObj(interp, objv[2], &y) != TCL_OK)
659		goto error;
660	    Tcl_SetObjResult(interp, Tcl_NewIntObj(y + tree->yOrigin));
661	    break;
662	}
663
664	case COMMAND_CGET: {
665	    if (objc != 3) {
666		Tcl_WrongNumArgs(interp, 2, objv, "option");
667		goto error;
668	    }
669	    resultObjPtr = Tk_GetOptionValue(interp, (char *) tree,
670		    tree->optionTable, objv[2], tree->tkwin);
671	    if (resultObjPtr == NULL) {
672		result = TCL_ERROR;
673	    } else {
674		Tcl_SetObjResult(interp, resultObjPtr);
675	    }
676	    break;
677	}
678
679	case COMMAND_CONFIGURE: {
680	    resultObjPtr = NULL;
681	    if (objc <= 3) {
682		resultObjPtr = Tk_GetOptionInfo(interp, (char *) tree,
683			tree->optionTable,
684			(objc == 2) ? (Tcl_Obj *) NULL : objv[2],
685			tree->tkwin);
686		if (resultObjPtr == NULL) {
687		    result = TCL_ERROR;
688		} else {
689		    Tcl_SetObjResult(interp, resultObjPtr);
690		}
691	    } else {
692		result = TreeConfigure(interp, tree, objc - 2, objv + 2, FALSE);
693	    }
694	    break;
695	}
696
697	case COMMAND_CONTENTBOX: {
698	    int x1, y1, x2, y2;
699
700	    if (objc != 2) {
701		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
702		goto error;
703	    }
704	    if (Tree_AreaBbox(tree, TREE_AREA_CONTENT, &x1, &y1, &x2, &y2)) {
705		FormatResult(interp, "%d %d %d %d", x1, y1, x2, y2);
706	    }
707	    break;
708	}
709
710#ifdef DEPRECATED
711	/* T expand ?-recurse? I ... */
712	case COMMAND_COLLAPSE:
713	case COMMAND_EXPAND:
714	case COMMAND_TOGGLE: {
715	    char *s;
716	    int recurse = 0;
717	    int mode = 0; /* lint */
718	    int i, j, count, len;
719	    TreeItemList items, item2s;
720	    TreeItem _item;
721	    ItemForEach iter;
722
723	    if (objc == 2)
724		break;
725	    s = Tcl_GetStringFromObj(objv[2], &len);
726	    if (s[0] == '-') {
727		if (strncmp(s, "-recurse", len)) {
728		    FormatResult(interp, "bad option \"%s\": must be -recurse",
729			    s);
730		    goto error;
731		}
732		if (objc == 3)
733		    break;
734		recurse = 1;
735	    }
736	    switch (index) {
737		case COMMAND_COLLAPSE:
738		    mode = 0;
739		    break;
740		case COMMAND_EXPAND:
741		    mode = 1;
742		    break;
743		case COMMAND_TOGGLE:
744		    mode = -1;
745		    break;
746	    }
747	    for (i = 2 + recurse; i < objc; i++) {
748		if (TreeItemList_FromObj(tree, objv[i], &items,
749			IFO_NOT_NULL) != TCL_OK) {
750		    goto error;
751		}
752		TreeItemList_Init(tree, &item2s, 0);
753		ITEM_FOR_EACH(_item, &items, NULL, &iter) {
754		    TreeItemList_Append(&item2s, _item);
755		    if (!iter.all && recurse) {
756			TreeItem_ListDescendants(tree, _item, &item2s);
757		    }
758		}
759		count = TreeItemList_Count(&item2s);
760		for (j = 0; j < count; j++) {
761		    _item = TreeItemList_Nth(&item2s, j);
762		    TreeItem_OpenClose(tree, _item, mode);
763		}
764		TreeItemList_Free(&items);
765		TreeItemList_Free(&item2s);
766	    }
767#ifdef SELECTION_VISIBLE
768	    Tree_DeselectHidden(tree);
769#endif
770	    break;
771	}
772#endif /* DEPRECATED */
773
774	case COMMAND_COLUMN: {
775	    result = TreeColumnCmd(clientData, interp, objc, objv);
776	    break;
777	}
778
779#ifdef DEPRECATED
780	case COMMAND_COMPARE: {
781	    TreeItem item1, item2;
782	    static CONST char *opName[] = { "<", "<=", "==", ">=", ">", "!=", NULL };
783	    int op, compare = 0, index1, index2;
784
785	    if (objc != 5) {
786		Tcl_WrongNumArgs(interp, 2, objv, "item1 op item2");
787		goto error;
788	    }
789	    if (TreeItem_FromObj(tree, objv[2], &item1, IFO_NOT_NULL) != TCL_OK)
790		goto error;
791	    if (Tcl_GetIndexFromObj(interp, objv[3], opName, "comparison operator", 0,
792		    &op) != TCL_OK)
793		goto error;
794	    if (TreeItem_FromObj(tree, objv[4], &item2, IFO_NOT_NULL) != TCL_OK)
795		goto error;
796	    if (TreeItem_RootAncestor(tree, item1) !=
797		    TreeItem_RootAncestor(tree, item2)) {
798		FormatResult(interp,
799			"item %s%d and item %s%d don't share a common ancestor",
800			tree->itemPrefix, TreeItem_GetID(tree, item1),
801			tree->itemPrefix, TreeItem_GetID(tree, item2));
802		goto error;
803	    }
804	    TreeItem_ToIndex(tree, item1, &index1, NULL);
805	    TreeItem_ToIndex(tree, item2, &index2, NULL);
806	    switch (op) {
807		case 0: compare = index1 < index2; break;
808		case 1: compare = index1 <= index2; break;
809		case 2: compare = index1 == index2; break;
810		case 3: compare = index1 >= index2; break;
811		case 4: compare = index1 > index2; break;
812		case 5: compare = index1 != index2; break;
813	    }
814	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(compare));
815	    break;
816	}
817#endif /* DEPRECATED */
818
819	case COMMAND_DEBUG: {
820	    result = TreeDebugCmd(clientData, interp, objc, objv);
821	    break;
822	}
823
824	case COMMAND_DEPTH: {
825	    TreeItem item;
826	    int depth;
827
828	    if (objc < 2 || objc > 3) {
829		Tcl_WrongNumArgs(interp, 2, objv, "?item?");
830		goto error;
831	    }
832	    if (objc == 3) {
833		if (TreeItem_FromObj(tree, objv[2], &item, IFO_NOT_NULL) != TCL_OK)
834		    goto error;
835		depth = TreeItem_GetDepth(tree, item);
836		if (TreeItem_RootAncestor(tree, item) == tree->root)
837		    depth++;
838		Tcl_SetObjResult(interp, Tcl_NewIntObj(depth));
839		break;
840	    }
841	    Tree_UpdateItemIndex(tree);
842	    Tcl_SetObjResult(interp, Tcl_NewIntObj(tree->depth + 1));
843	    break;
844	}
845
846	case COMMAND_DRAGIMAGE: {
847	    result = TreeDragImageCmd(clientData, interp, objc, objv);
848	    break;
849	}
850
851	case COMMAND_ELEMENT: {
852	    result = TreeElementCmd(clientData, interp, objc, objv);
853	    break;
854	}
855
856	case COMMAND_IDENTIFY: {
857	    int x, y, width, height, depth;
858	    TreeColumn treeColumn;
859	    TreeItem item;
860	    char buf[64];
861	    int hit;
862	    int lock;
863/*
864  set id [$tree identify $x $y]
865  "item I column C" : mouse is in column C of item I
866  "item I column C elem E" : mouse is in element E in column C of item I
867  "item I button" : mouse is in button-area of item I
868  "item I line J" : mouse is near line coming from item J
869  "header C ?left|right?" : mouse is in header column C
870  "" : mouse is not in any item
871*/
872	    if (objc != 4) {
873		Tcl_WrongNumArgs(interp, 2, objv, "x y");
874		goto error;
875	    }
876	    if (Tk_GetPixelsFromObj(interp, tree->tkwin, objv[2], &x) != TCL_OK)
877		goto error;
878	    if (Tk_GetPixelsFromObj(interp, tree->tkwin, objv[3], &y) != TCL_OK)
879		goto error;
880
881	    hit = Tree_HitTest(tree, x, y);
882
883	    /* Require point inside borders */
884	    if (hit == TREE_AREA_NONE)
885		break;
886
887	    if (hit == TREE_AREA_HEADER) {
888		treeColumn = Tree_HeaderUnderPoint(tree, &x, &y, &width, &height,
889			FALSE);
890		if (treeColumn == tree->columnTail) {
891		    strcpy(buf, "header tail");
892		    if (x < 4)
893			sprintf(buf + strlen(buf), " left");
894		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
895		    break;
896		} else if (treeColumn != NULL) {
897		    sprintf(buf, "header %s%d", tree->columnPrefix,
898			TreeColumn_GetID(treeColumn));
899		    if (x < 4)
900			sprintf(buf + strlen(buf), " left");
901		    else if (x >= width - 4)
902			sprintf(buf + strlen(buf), " right");
903		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
904		    break;
905		}
906	    }
907
908	    item = Tree_ItemUnderPoint(tree, &x, &y, FALSE);
909	    if (item == NULL)
910		break;
911
912	    sprintf(buf, "item %s%d", tree->itemPrefix, TreeItem_GetID(tree, item)); /* TreeItem_ToObj() */
913	    depth = TreeItem_GetDepth(tree, item);
914	    if (item == tree->root)
915		depth = (tree->showButtons && tree->showRootButton) ? 1 : 0;
916	    else if (tree->showRoot)
917	    {
918		depth++;
919		if (tree->showButtons && tree->showRootButton)
920		    depth++;
921	    }
922	    else if (tree->showButtons && tree->showRootChildButtons)
923		depth += 1;
924	    else if (tree->showLines && tree->showRootLines)
925		depth += 1;
926
927	    lock = (hit == TREE_AREA_LEFT) ? COLUMN_LOCK_LEFT :
928		(hit == TREE_AREA_RIGHT) ? COLUMN_LOCK_RIGHT :
929		COLUMN_LOCK_NONE;
930
931	    /* Point is in a line or button */
932	    if (tree->columnTreeVis &&
933		    (TreeColumn_Lock(tree->columnTree) == lock) &&
934		    (x >= tree->columnTreeLeft) &&
935		    (x < tree->columnTreeLeft + TreeColumn_UseWidth(tree->columnTree)) &&
936		    (x < tree->columnTreeLeft + depth * tree->useIndent)) {
937		int column = (x - tree->columnTreeLeft) / tree->useIndent + 1;
938		if (column == depth) {
939		    if (TreeItem_HasButton(tree, item))
940			sprintf(buf + strlen(buf), " button");
941		} else if (tree->showLines) {
942		    TreeItem sibling;
943		    do {
944			item = TreeItem_GetParent(tree, item);
945		    } while (++column < depth);
946		    sibling = TreeItem_NextSiblingVisible(tree, item);
947		    if ((sibling != NULL) &&
948			((TreeItem_GetParent(tree, sibling) != tree->root) ||
949			tree->showRootLines))
950			sprintf(buf + strlen(buf), " line %s%d", tree->itemPrefix,
951				TreeItem_GetID(tree, item)); /* TreeItem_ToObj() */
952		}
953	    } else {
954		TreeItem_Identify(tree, item, lock, x, y, buf);
955	    }
956	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
957	    break;
958	}
959
960#ifdef DEPRECATED
961	case COMMAND_INDEX: {
962	    TreeItem item;
963
964	    if (objc != 3) {
965		Tcl_WrongNumArgs(interp, 2, objv, "item");
966		goto error;
967	    }
968	    if (TreeItem_FromObj(tree, objv[2], &item, 0) != TCL_OK) {
969		goto error;
970	    }
971	    if (item != NULL)
972		Tcl_SetObjResult(interp, TreeItem_ToObj(tree, item));
973	    break;
974	}
975#endif /* DEPRECATED */
976
977	case COMMAND_ITEM: {
978	    result = TreeItemCmd(clientData, interp, objc, objv);
979	    break;
980	}
981
982	case COMMAND_MARQUEE: {
983	    result = TreeMarqueeCmd(clientData, interp, objc, objv);
984	    break;
985	}
986
987	case COMMAND_NOTIFY: {
988	    result = TreeNotifyCmd(clientData, interp, objc, objv);
989	    break;
990	}
991
992#ifdef DEPRECATED
993	case COMMAND_NUMCOLUMNS: {
994	    if (objc != 2) {
995		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
996		goto error;
997	    }
998	    Tcl_SetObjResult(interp, Tcl_NewIntObj(tree->columnCount));
999	    break;
1000	}
1001
1002	case COMMAND_NUMITEMS: {
1003	    if (objc != 2) {
1004		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
1005		goto error;
1006	    }
1007	    Tcl_SetObjResult(interp, Tcl_NewIntObj(tree->itemCount));
1008	    break;
1009	}
1010#endif /* DEPRECATED */
1011
1012	case COMMAND_ORPHANS: {
1013	    Tcl_HashEntry *hPtr;
1014	    Tcl_HashSearch search;
1015	    Tcl_Obj *listObj;
1016	    TreeItem item;
1017
1018	    if (objc != 2) {
1019		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
1020		goto error;
1021	    }
1022
1023	    /* Pretty slow. Could keep a hash table of orphans */
1024	    listObj = Tcl_NewListObj(0, NULL);
1025	    hPtr = Tcl_FirstHashEntry(&tree->itemHash, &search);
1026	    while (hPtr != NULL) {
1027		item = (TreeItem) Tcl_GetHashValue(hPtr);
1028		if ((item != tree->root) &&
1029			(TreeItem_GetParent(tree, item) == NULL)) {
1030		    Tcl_ListObjAppendElement(interp, listObj,
1031			    TreeItem_ToObj(tree, item));
1032		}
1033		hPtr = Tcl_NextHashEntry(&search);
1034	    }
1035	    Tcl_SetObjResult(interp, listObj);
1036	    break;
1037	}
1038
1039#ifdef DEPRECATED
1040	case COMMAND_RANGE: {
1041	    TreeItem item, itemFirst, itemLast;
1042	    Tcl_Obj *listObj;
1043
1044	    if (objc != 4) {
1045		Tcl_WrongNumArgs(interp, 2, objv, "first last");
1046		goto error;
1047	    }
1048	    if (TreeItem_FromObj(tree, objv[2], &itemFirst, IFO_NOT_NULL) != TCL_OK)
1049		goto error;
1050	    if (TreeItem_FromObj(tree, objv[3], &itemLast, IFO_NOT_NULL) != TCL_OK)
1051		goto error;
1052	    if (TreeItem_FirstAndLast(tree, &itemFirst, &itemLast) == 0)
1053		goto error;
1054	    listObj = Tcl_NewListObj(0, NULL);
1055	    item = itemFirst;
1056	    while (item != NULL) {
1057		Tcl_ListObjAppendElement(interp, listObj,
1058			TreeItem_ToObj(tree, item));
1059		if (item == itemLast)
1060		    break;
1061		item = TreeItem_Next(tree, item);
1062	    }
1063	    Tcl_SetObjResult(interp, listObj);
1064	    break;
1065	}
1066#endif /* DEPRECATED */
1067
1068	case COMMAND_SCAN: {
1069	    static CONST char *optionName[] = { "dragto", "mark",
1070						(char *) NULL };
1071	    int x, y, gain = 10, xOrigin, yOrigin;
1072
1073	    if (objc < 3) {
1074		Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
1075		goto error;
1076	    }
1077	    if (Tcl_GetIndexFromObj(interp, objv[2], optionName, "option",
1078		    2, &index) != TCL_OK)
1079		goto error;
1080	    switch (index) {
1081		/* T scan dragto x y ?gain? */
1082		case 0:
1083		    if ((objc < 5) || (objc > 6)) {
1084			Tcl_WrongNumArgs(interp, 3, objv, "x y ?gain?");
1085			goto error;
1086		    }
1087		    if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) ||
1088			    (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK))
1089			goto error;
1090		    if (objc == 6) {
1091			if (Tcl_GetIntFromObj(interp, objv[5], &gain) != TCL_OK)
1092			    goto error;
1093		    }
1094		    xOrigin = tree->scanXOrigin - gain * (x - tree->scanX);
1095		    yOrigin = tree->scanYOrigin - gain * (y - tree->scanY);
1096		    Tree_SetOriginX(tree, xOrigin);
1097		    Tree_SetOriginY(tree, yOrigin);
1098		    break;
1099
1100		/* T scan mark x y ?gain? */
1101		case 1:
1102		    if (objc != 5) {
1103			Tcl_WrongNumArgs(interp, 3, objv, "x y");
1104			goto error;
1105		    }
1106		    if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) ||
1107			    (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK))
1108			goto error;
1109		    tree->scanX = x;
1110		    tree->scanY = y;
1111		    tree->scanXOrigin = tree->xOrigin;
1112		    tree->scanYOrigin = tree->yOrigin;
1113		    break;
1114	    }
1115	    break;
1116	}
1117
1118	case COMMAND_SEE: {
1119	    result = TreeSeeCmd(tree, objc, objv);
1120	    break;
1121	}
1122
1123	case COMMAND_SELECTION: {
1124	    result = TreeSelectionCmd(interp, tree, objc, objv);
1125	    break;
1126	}
1127
1128	case COMMAND_STATE: {
1129	    result = TreeStateCmd(tree, objc, objv);
1130	    break;
1131	}
1132
1133	case COMMAND_STYLE: {
1134	    result = TreeStyleCmd(clientData, interp, objc, objv);
1135	    break;
1136	}
1137
1138	case COMMAND_XVIEW: {
1139	    result = TreeXviewCmd(interp, tree, objc, objv);
1140	    break;
1141	}
1142
1143	case COMMAND_YVIEW: {
1144	    result = TreeYviewCmd(interp, tree, objc, objv);
1145	    break;
1146	}
1147    }
1148    Tree_ReleaseItems(tree);
1149    Tcl_Release((ClientData) tree);
1150    return result;
1151
1152error:
1153    Tree_ReleaseItems(tree);
1154    Tcl_Release((ClientData) tree);
1155    return TCL_ERROR;
1156}
1157
1158/*
1159 *--------------------------------------------------------------
1160 *
1161 * TreeConfigure --
1162 *
1163 *	This procedure is called to process an argv/argc list, plus
1164 *	the Tk option database, in order to configure (or reconfigure)
1165 *	a treectrl widget.
1166 *
1167 * Results:
1168 *	The return value is a standard Tcl result.  If TCL_ERROR is
1169 *	returned, then the interp's result contains an error message.
1170 *
1171 * Side effects:
1172 *	Configuration information, such as colors, border width,
1173 *	etc. get set for tree;  old resources get freed,
1174 *	if there were any.
1175 *
1176 *--------------------------------------------------------------
1177 */
1178
1179static int
1180TreeConfigure(
1181    Tcl_Interp *interp,		/* Current interpreter. */
1182    TreeCtrl *tree,		/* Widget info. */
1183    int objc,			/* Number of arguments. */
1184    Tcl_Obj *CONST objv[],	/* Argument values. */
1185    int createFlag		/* TRUE if the widget is being created. */
1186    )
1187{
1188    int error;
1189    Tcl_Obj *errorResult = NULL;
1190    TreeCtrl saved;
1191    Tk_SavedOptions savedOptions;
1192    int oldShowRoot = tree->showRoot;
1193    int mask, maskFree = 0;
1194    XGCValues gcValues;
1195    unsigned long gcMask;
1196
1197    /* Init these to prevent compiler warnings */
1198    saved.backgroundImage = NULL;
1199#ifdef DEPRECATED
1200    saved.defaultStyle.styles = NULL;
1201    saved.defaultStyle.numStyles = 0;
1202#endif
1203    saved.wrapMode = TREE_WRAP_NONE;
1204    saved.wrapArg = 0;
1205
1206    for (error = 0; error <= 1; error++) {
1207	if (error == 0) {
1208	    if (Tk_SetOptions(interp, (char *) tree, tree->optionTable, objc,
1209		    objv, tree->tkwin, &savedOptions, &mask) != TCL_OK) {
1210		mask = 0;
1211		continue;
1212	    }
1213
1214	    /* Wouldn't have to do this if Tk_InitOptions() would return
1215	    * a mask of configured options like Tk_SetOptions() does. */
1216	    if (createFlag) {
1217		if (tree->backgroundImageString != NULL)
1218		    mask |= TREE_CONF_BG_IMAGE;
1219		if (tree->buttonBitmap.obj != NULL)
1220		    mask |= TREE_CONF_BUTBMP;
1221		if (tree->buttonImage.obj != NULL)
1222		    mask |= TREE_CONF_BUTIMG;
1223#ifdef DEPRECATED
1224		if (tree->defaultStyle.stylesObj != NULL)
1225		    mask |= TREE_CONF_DEFSTYLE;
1226#endif
1227		if (tree->wrapObj != NULL)
1228		    mask |= TREE_CONF_WRAP;
1229		if (!ObjectIsEmpty(tree->itemWidthObj))
1230		    mask |= TREE_CONF_ITEMSIZE;
1231		if (!ObjectIsEmpty(tree->itemWidMultObj))
1232		    mask |= TREE_CONF_ITEMSIZE;
1233	    }
1234
1235	    /*
1236	     * Step 1: Save old values
1237	     */
1238
1239	    if (mask & TREE_CONF_BG_IMAGE)
1240		saved.backgroundImage = tree->backgroundImage;
1241#ifdef DEPRECATED
1242	    if (mask & TREE_CONF_DEFSTYLE) {
1243		saved.defaultStyle.styles = tree->defaultStyle.styles;
1244		saved.defaultStyle.numStyles = tree->defaultStyle.numStyles;
1245	    }
1246#endif
1247	    if (mask & TREE_CONF_WRAP) {
1248		saved.wrapMode = tree->wrapMode;
1249		saved.wrapArg = tree->wrapArg;
1250	    }
1251
1252	    /*
1253	     * Step 2: Process new values
1254	     */
1255
1256	    if (mask & TREE_CONF_BG_IMAGE) {
1257		if (tree->backgroundImageString == NULL) {
1258		    tree->backgroundImage = NULL;
1259		} else {
1260		    Tk_Image image = Tree_GetImage(tree, tree->backgroundImageString);
1261		    if (image == NULL)
1262			continue;
1263		    tree->backgroundImage = image;
1264		    maskFree |= TREE_CONF_BG_IMAGE;
1265		}
1266	    }
1267
1268#ifdef DEPRECATED
1269	    if (mask & TREE_CONF_DEFSTYLE) {
1270		if (tree->defaultStyle.stylesObj == NULL) {
1271		    tree->defaultStyle.styles = NULL;
1272		    tree->defaultStyle.numStyles = 0;
1273		} else {
1274		    int i, listObjc;
1275		    Tcl_Obj **listObjv;
1276		    TreeStyle style;
1277
1278		    if ((Tcl_ListObjGetElements(interp,
1279			tree->defaultStyle.stylesObj, &listObjc, &listObjv)
1280			!= TCL_OK)) continue;
1281		    tree->defaultStyle.styles =
1282			(TreeStyle *) ckalloc(sizeof(TreeStyle) * listObjc);
1283		    tree->defaultStyle.numStyles = listObjc;
1284		    for (i = 0; i < listObjc; i++) {
1285			if (ObjectIsEmpty(listObjv[i])) {
1286			    style = NULL;
1287			} else {
1288			    if (TreeStyle_FromObj(tree, listObjv[i], &style) != TCL_OK) {
1289				ckfree((char *) tree->defaultStyle.styles);
1290				break;
1291			    }
1292			}
1293			tree->defaultStyle.styles[i] = style;
1294		    }
1295		    if (i < listObjc)
1296			continue;
1297		    maskFree |= TREE_CONF_DEFSTYLE;
1298		}
1299	    }
1300#endif /* DEPRECATED */
1301
1302	    /* Parse -wrap string into wrapMode and wrapArg */
1303	    if (mask & TREE_CONF_WRAP) {
1304		int listObjc;
1305		Tcl_Obj **listObjv;
1306
1307		if (tree->wrapObj == NULL) {
1308		    tree->wrapMode = TREE_WRAP_NONE;
1309		    tree->wrapArg = 0;
1310		} else {
1311		    int len0, len1;
1312		    char *s0, *s1, ch0, ch1;
1313
1314		    if ((Tcl_ListObjGetElements(interp, tree->wrapObj, &listObjc,
1315			    &listObjv) != TCL_OK) || (listObjc > 2)) {
1316badWrap:
1317			FormatResult(interp, "bad wrap \"%s\"",
1318				Tcl_GetString(tree->wrapObj));
1319			continue;
1320		    }
1321		    if (listObjc == 1) {
1322			s0 = Tcl_GetStringFromObj(listObjv[0], &len0);
1323			ch0 = s0[0];
1324			if ((ch0 == 'w') && !strncmp(s0, "window", len0)) {
1325			    tree->wrapMode = TREE_WRAP_WINDOW;
1326			    tree->wrapArg = 0;
1327			} else
1328			    goto badWrap;
1329		    } else {
1330			s1 = Tcl_GetStringFromObj(listObjv[1], &len1);
1331			ch1 = s1[0];
1332			if ((ch1 == 'i') && !strncmp(s1, "items", len1)) {
1333			    int n;
1334			    if ((Tcl_GetIntFromObj(interp, listObjv[0], &n) != TCL_OK) ||
1335				    (n < 0)) {
1336				goto badWrap;
1337			    }
1338			    tree->wrapMode = TREE_WRAP_ITEMS;
1339			    tree->wrapArg = n;
1340			}
1341			else if ((ch1 == 'p') && !strncmp(s1, "pixels", len1)) {
1342			    int n;
1343			    if (Tk_GetPixelsFromObj(interp, tree->tkwin, listObjv[0], &n)
1344				    != TCL_OK) {
1345				goto badWrap;
1346			    }
1347			    tree->wrapMode = TREE_WRAP_PIXELS;
1348			    tree->wrapArg = n;
1349			} else
1350			    goto badWrap;
1351		    }
1352		}
1353	    }
1354
1355	    /*
1356	     * Step 3: Free saved values
1357	     */
1358
1359	    if (mask & TREE_CONF_BG_IMAGE) {
1360		if (saved.backgroundImage != NULL)
1361		    Tree_FreeImage(tree, saved.backgroundImage);
1362	    }
1363#ifdef DEPRECATED
1364	    if (mask & TREE_CONF_DEFSTYLE) {
1365		if (saved.defaultStyle.styles != NULL)
1366		    ckfree((char *) saved.defaultStyle.styles);
1367	    }
1368#endif
1369	    Tk_FreeSavedOptions(&savedOptions);
1370	    break;
1371	} else {
1372	    errorResult = Tcl_GetObjResult(interp);
1373	    Tcl_IncrRefCount(errorResult);
1374	    Tk_RestoreSavedOptions(&savedOptions);
1375
1376	    /*
1377	     * Free new values.
1378	     */
1379	    if (maskFree & TREE_CONF_BG_IMAGE)
1380		Tree_FreeImage(tree, tree->backgroundImage);
1381#ifdef DEPRECATED
1382	    if (maskFree & TREE_CONF_DEFSTYLE)
1383		ckfree((char *) tree->defaultStyle.styles);
1384#endif
1385	    /*
1386	     * Restore old values.
1387	     */
1388	    if (mask & TREE_CONF_BG_IMAGE) {
1389		tree->backgroundImage = saved.backgroundImage;
1390	    }
1391#ifdef DEPRECATED
1392	    if (mask & TREE_CONF_DEFSTYLE) {
1393		tree->defaultStyle.styles = saved.defaultStyle.styles;
1394		tree->defaultStyle.numStyles = saved.defaultStyle.numStyles;
1395	    }
1396#endif
1397	    if (mask & TREE_CONF_WRAP) {
1398		tree->wrapMode = saved.wrapMode;
1399		tree->wrapArg = saved.wrapArg;
1400	    }
1401
1402	    Tcl_SetObjResult(interp, errorResult);
1403	    Tcl_DecrRefCount(errorResult);
1404	    return TCL_ERROR;
1405	}
1406    }
1407
1408    tree->itemPrefixLen = strlen(tree->itemPrefix);
1409    tree->columnPrefixLen = strlen(tree->columnPrefix);
1410
1411    Tk_SetWindowBackground(tree->tkwin,
1412	    Tk_3DBorderColor(tree->border)->pixel);
1413
1414    if (createFlag)
1415	mask |= TREE_CONF_FONT | TREE_CONF_RELAYOUT;
1416
1417    if (mask & (TREE_CONF_FONT | TREE_CONF_FG)) {
1418	/*
1419	 * Should be blended into TreeWorldChanged.
1420	 */
1421	gcValues.font = Tk_FontId(tree->tkfont);
1422	gcValues.foreground = tree->fgColorPtr->pixel;
1423	gcValues.graphics_exposures = False;
1424	gcMask = GCForeground | GCFont | GCGraphicsExposures;
1425	if (tree->textGC != None)
1426	    Tk_FreeGC(tree->display, tree->textGC);
1427	tree->textGC = Tk_GetGC(tree->tkwin, gcMask, &gcValues);
1428    }
1429
1430    if (tree->copyGC == None) {
1431	gcValues.function = GXcopy;
1432	gcValues.graphics_exposures = False;
1433	gcMask = GCFunction | GCGraphicsExposures;
1434	tree->copyGC = Tk_GetGC(tree->tkwin, gcMask, &gcValues);
1435    }
1436
1437    if (createFlag)
1438	mask |= TREE_CONF_BUTTON;
1439
1440    if (mask & TREE_CONF_BUTTON) {
1441	if (tree->buttonGC != None)
1442	    Tk_FreeGC(tree->display, tree->buttonGC);
1443	gcValues.foreground = tree->buttonColor->pixel;
1444	gcValues.line_width = tree->buttonThickness;
1445	gcMask = GCForeground | GCLineWidth;
1446	tree->buttonGC = Tk_GetGC(tree->tkwin, gcMask, &gcValues);
1447    }
1448
1449    if (createFlag)
1450	mask |= TREE_CONF_LINE;
1451
1452    if (mask & TREE_CONF_LINE) {
1453	if (tree->lineGC != None)
1454	    Tk_FreeGC(tree->display, tree->lineGC);
1455	gcValues.foreground = tree->lineColor->pixel;
1456	gcValues.line_width = tree->lineThickness;
1457	gcMask = GCForeground | GCLineWidth;
1458	tree->lineGC = Tk_GetGC(tree->tkwin, gcMask, &gcValues);
1459    }
1460
1461    if (mask & TREE_CONF_PROXY) {
1462	TreeColumnProxy_Undisplay(tree);
1463	TreeColumnProxy_Display(tree);
1464	TreeRowProxy_Undisplay(tree);
1465	TreeRowProxy_Display(tree);
1466    }
1467
1468    tree->useIndent = MAX(tree->indent, Tree_ButtonMaxWidth(tree));
1469
1470    if (createFlag)
1471	mask |= TREE_CONF_BORDERS;
1472
1473    if (mask & TREE_CONF_BORDERS) {
1474	if (tree->highlightWidth < 0)
1475	    tree->highlightWidth = 0;
1476	if (tree->useTheme && TreeTheme_SetBorders(tree) == TCL_OK) {
1477	    /* nothing */
1478	} else {
1479	    tree->inset.left = tree->inset.top =
1480	    tree->inset.right = tree->inset.bottom =
1481		    tree->highlightWidth + tree->borderWidth;
1482	}
1483    }
1484
1485    if (oldShowRoot != tree->showRoot) {
1486	TreeItem_InvalidateHeight(tree, tree->root);
1487	tree->updateIndex = 1;
1488    }
1489
1490    TreeStyle_TreeChanged(tree, mask);
1491    TreeColumn_TreeChanged(tree, mask);
1492
1493    if (mask & TREE_CONF_RELAYOUT) {
1494	TreeComputeGeometry(tree);
1495	Tree_InvalidateColumnWidth(tree, NULL);
1496	Tree_InvalidateColumnHeight(tree, NULL); /* In case -usetheme changes */
1497	Tree_RelayoutWindow(tree);
1498    } else if (mask & TREE_CONF_REDISPLAY) {
1499	Tree_RelayoutWindow(tree);
1500    }
1501
1502    return TCL_OK;
1503}
1504
1505/*
1506 *---------------------------------------------------------------------------
1507 *
1508 * TreeWorldChanged --
1509 *
1510 *	This procedure is called when the world has changed in some
1511 *	way and the widget needs to recompute all its graphics contexts
1512 *	and determine its new geometry.
1513 *
1514 * Results:
1515 *	None.
1516 *
1517 * Side effects:
1518 *	Widget will be relayed out and redisplayed.
1519 *
1520 *---------------------------------------------------------------------------
1521 */
1522
1523static void
1524TreeWorldChanged(
1525    ClientData instanceData	/* Widget info. */
1526    )
1527{
1528    TreeCtrl *tree = (TreeCtrl *) instanceData;
1529    XGCValues gcValues;
1530    unsigned long gcMask;
1531
1532    gcValues.font = Tk_FontId(tree->tkfont);
1533    gcValues.foreground = tree->fgColorPtr->pixel;
1534    gcValues.graphics_exposures = False;
1535    gcMask = GCForeground | GCFont | GCGraphicsExposures;
1536    if (tree->textGC != None)
1537	Tk_FreeGC(tree->display, tree->textGC);
1538    tree->textGC = Tk_GetGC(tree->tkwin, gcMask, &gcValues);
1539
1540    TreeStyle_TreeChanged(tree, TREE_CONF_FONT | TREE_CONF_RELAYOUT);
1541    TreeColumn_TreeChanged(tree, TREE_CONF_FONT | TREE_CONF_RELAYOUT);
1542
1543    TreeComputeGeometry(tree);
1544    Tree_InvalidateColumnWidth(tree, NULL);
1545    Tree_RelayoutWindow(tree);
1546}
1547
1548/*
1549 *--------------------------------------------------------------
1550 *
1551 * TreeEventProc --
1552 *
1553 *	This procedure is invoked by the Tk dispatcher for various
1554 *	events on the widget.
1555 *
1556 * Results:
1557 *	None.
1558 *
1559 * Side effects:
1560 *	When the window gets deleted, internal structures get
1561 *	cleaned up.  When it gets exposed, it is redisplayed.
1562 *
1563 *--------------------------------------------------------------
1564 */
1565
1566static void
1567TreeEventProc(
1568    ClientData clientData,	/* Widget info. */
1569    XEvent *eventPtr		/* Event info. */
1570    )
1571{
1572    TreeCtrl *tree = clientData;
1573
1574    switch (eventPtr->type) {
1575	case Expose: {
1576	    int x = eventPtr->xexpose.x;
1577	    int y = eventPtr->xexpose.y;
1578	    Tree_ExposeArea(tree, x, y,
1579		    x + eventPtr->xexpose.width,
1580		    y + eventPtr->xexpose.height);
1581	    break;
1582	}
1583	case ConfigureNotify: {
1584	    if ((tree->prevWidth != Tk_Width(tree->tkwin)) ||
1585		    (tree->prevHeight != Tk_Height(tree->tkwin))) {
1586		tree->widthOfColumns = -1;
1587		tree->widthOfColumnsLeft = tree->widthOfColumnsRight = -1;
1588		Tree_RelayoutWindow(tree);
1589		tree->prevWidth = Tk_Width(tree->tkwin);
1590		tree->prevHeight = Tk_Height(tree->tkwin);
1591	    }
1592	    break;
1593	}
1594	case FocusIn:
1595	    /* Handle focus as Tile does */
1596	    if (   eventPtr->xfocus.detail == NotifyInferior
1597		|| eventPtr->xfocus.detail == NotifyAncestor
1598		|| eventPtr->xfocus.detail == NotifyNonlinear) {
1599		Tree_FocusChanged(tree, 1);
1600	    }
1601	    break;
1602	case FocusOut:
1603	    /* Handle focus as Tile does */
1604	    if (   eventPtr->xfocus.detail == NotifyInferior
1605		|| eventPtr->xfocus.detail == NotifyAncestor
1606		|| eventPtr->xfocus.detail == NotifyNonlinear) {
1607		Tree_FocusChanged(tree, 0);
1608	    }
1609	    break;
1610	case ActivateNotify:
1611	    Tree_Activate(tree, 1);
1612	    break;
1613	case DeactivateNotify:
1614	    Tree_Activate(tree, 0);
1615	    break;
1616	case DestroyNotify:
1617	    if (!tree->deleted) {
1618		tree->deleted = 1;
1619		Tcl_DeleteCommandFromToken(tree->interp, tree->widgetCmd);
1620		Tcl_EventuallyFree((ClientData) tree, TreeDestroy);
1621	    }
1622	    break;
1623#ifdef USE_TTK
1624	case VirtualEvent:
1625	    if (!strcmp("ThemeChanged", ((XVirtualEvent *)(eventPtr))->name)) {
1626		TreeTheme_ThemeChanged(tree);
1627		tree->widthOfColumns = -1;
1628		tree->widthOfColumnsLeft = tree->widthOfColumnsRight = -1;
1629		Tree_RelayoutWindow(tree);
1630	    }
1631	    break;
1632#endif
1633    }
1634}
1635
1636/*
1637 *----------------------------------------------------------------------
1638 *
1639 * TreeCmdDeletedProc --
1640 *
1641 *	This procedure is invoked when a widget command is deleted.  If
1642 *	the widget isn't already in the process of being destroyed,
1643 *	this command destroys it.
1644 *
1645 * Results:
1646 *	None.
1647 *
1648 * Side effects:
1649 *	The widget is destroyed.
1650 *
1651 *----------------------------------------------------------------------
1652 */
1653
1654static void
1655TreeCmdDeletedProc(
1656    ClientData clientData	/* Widget info. */
1657    )
1658{
1659    TreeCtrl *tree = clientData;
1660
1661    if (!tree->deleted) {
1662	Tk_DestroyWindow(tree->tkwin);
1663    }
1664}
1665
1666/*
1667 *----------------------------------------------------------------------
1668 *
1669 * TreeDestroy --
1670 *
1671 *	This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
1672 *	to clean up the internal structure of a widget at a safe time
1673 *	(when no-one is using it anymore).
1674 *
1675 * Results:
1676 *	None.
1677 *
1678 * Side effects:
1679 *	Everything associated with the widget is freed up.
1680 *
1681 *----------------------------------------------------------------------
1682 */
1683
1684static void
1685TreeDestroy(
1686    char *memPtr		/* Widget info. */
1687    )
1688{
1689    TreeCtrl *tree = (TreeCtrl *) memPtr;
1690    TreeItem item;
1691    Tcl_HashEntry *hPtr;
1692    Tcl_HashSearch search;
1693    int i, count;
1694
1695    hPtr = Tcl_FirstHashEntry(&tree->itemHash, &search);
1696    while (hPtr != NULL) {
1697	item = (TreeItem) Tcl_GetHashValue(hPtr);
1698	TreeItem_FreeResources(tree, item);
1699	hPtr = Tcl_NextHashEntry(&search);
1700    }
1701    Tcl_DeleteHashTable(&tree->itemHash);
1702
1703    Tcl_DeleteHashTable(&tree->itemSpansHash);
1704
1705    count = TreeItemList_Count(&tree->preserveItemList);
1706    for (i = 0; i < count; i++) {
1707	item = TreeItemList_Nth(&tree->preserveItemList, i);
1708	TreeItem_Release(tree, item);
1709    }
1710    TreeItemList_Free(&tree->preserveItemList);
1711
1712    TreeStyle_Free(tree);
1713
1714    TreeDragImage_Free(tree->dragImage);
1715    TreeMarquee_Free(tree->marquee);
1716    TreeDInfo_Free(tree);
1717    TreeTheme_Free(tree);
1718
1719    if (tree->copyGC != None)
1720	Tk_FreeGC(tree->display, tree->copyGC);
1721    if (tree->textGC != None)
1722	Tk_FreeGC(tree->display, tree->textGC);
1723    if (tree->buttonGC != None)
1724	Tk_FreeGC(tree->display, tree->buttonGC);
1725    if (tree->lineGC != None)
1726	Tk_FreeGC(tree->display, tree->lineGC);
1727    Tree_FreeAllGC(tree);
1728
1729    Tree_FreeColumns(tree);
1730
1731    while (tree->regionStackLen > 0)
1732	TkDestroyRegion(tree->regionStack[--tree->regionStackLen]);
1733
1734    QE_DeleteBindingTable(tree->bindingTable);
1735
1736    for (i = STATE_USER - 1; i < 32; i++)
1737	if (tree->stateNames[i] != NULL)
1738	    ckfree(tree->stateNames[i]);
1739
1740    Tk_FreeConfigOptions((char *) tree, tree->debug.optionTable,
1741	    tree->tkwin);
1742
1743    Tk_FreeConfigOptions((char *) tree, tree->optionTable, tree->tkwin);
1744
1745    hPtr = Tcl_FirstHashEntry(&tree->imageNameHash, &search);
1746    while (hPtr != NULL) {
1747	TreeImageRef *ref = (TreeImageRef *) Tcl_GetHashValue(hPtr);
1748	Tk_FreeImage(ref->image);
1749	ckfree((char *) ref);
1750	hPtr = Tcl_NextHashEntry(&search);
1751    }
1752    Tcl_DeleteHashTable(&tree->imageNameHash);
1753    Tcl_DeleteHashTable(&tree->imageTokenHash);
1754
1755    Tcl_DeleteHashTable(&tree->selection);
1756
1757#ifdef DEPRECATED
1758    if (tree->defaultStyle.styles != NULL)
1759	ckfree((char *) tree->defaultStyle.styles);
1760#endif
1761#ifdef ALLOC_HAX
1762    TreeAlloc_Finalize(tree->allocData);
1763#endif
1764
1765    Tcl_Release(tree->tkwin);
1766    WFREE(tree, TreeCtrl);
1767}
1768
1769/*
1770 *----------------------------------------------------------------------
1771 *
1772 * Tree_UpdateScrollbarX --
1773 *
1774 *	This procedure is invoked whenever information has changed in
1775 *	a widget in a way that would invalidate a scrollbar display.
1776 *
1777 *	A <Scroll-x> event is generated.
1778 *
1779 *	If there is an associated scrollbar, then this procedure updates
1780 *	it by invoking a Tcl command.
1781 *
1782 * Results:
1783 *	None.
1784 *
1785 * Side effects:
1786 *	A Tcl command is invoked, and an additional command may be
1787 *	invoked to process errors in the command.
1788 *
1789 *----------------------------------------------------------------------
1790 */
1791
1792void
1793Tree_UpdateScrollbarX(
1794    TreeCtrl *tree		/* Widget info. */
1795    )
1796{
1797    Tcl_Interp *interp = tree->interp;
1798    int result;
1799    double fractions[2];
1800    char buffer[TCL_DOUBLE_SPACE * 2];
1801    char *xScrollCmd;
1802
1803    Tree_GetScrollFractionsX(tree, fractions);
1804    TreeNotify_Scroll(tree, fractions, FALSE);
1805
1806    if (tree->xScrollCmd == NULL)
1807	return;
1808
1809    Tcl_Preserve((ClientData) interp);
1810    Tcl_Preserve((ClientData) tree);
1811
1812    xScrollCmd = tree->xScrollCmd;
1813    Tcl_Preserve((ClientData) xScrollCmd);
1814    sprintf(buffer, "%g %g", fractions[0], fractions[1]);
1815    result = Tcl_VarEval(interp, xScrollCmd, " ", buffer, (char *) NULL);
1816    if (result != TCL_OK)
1817	Tcl_BackgroundError(interp);
1818    Tcl_ResetResult(interp);
1819    Tcl_Release((ClientData) xScrollCmd);
1820
1821    Tcl_Release((ClientData) tree);
1822    Tcl_Release((ClientData) interp);
1823}
1824
1825/*
1826 *----------------------------------------------------------------------
1827 *
1828 * Tree_UpdateScrollbarY --
1829 *
1830 *	This procedure is invoked whenever information has changed in
1831 *	a widget in a way that would invalidate a scrollbar display.
1832 *
1833 *	A <Scroll-y> event is generated.
1834 *
1835 *	If there is an associated scrollbar, then this procedure updates
1836 *	it by invoking a Tcl command.
1837 *
1838 * Results:
1839 *	None.
1840 *
1841 * Side effects:
1842 *	A Tcl command is invoked, and an additional command may be
1843 *	invoked to process errors in the command.
1844 *
1845 *----------------------------------------------------------------------
1846 */
1847
1848void
1849Tree_UpdateScrollbarY(
1850    TreeCtrl *tree		/* Widget info. */
1851    )
1852{
1853    Tcl_Interp *interp = tree->interp;
1854    int result;
1855    double fractions[2];
1856    char buffer[TCL_DOUBLE_SPACE * 2];
1857    char *yScrollCmd;
1858
1859    Tree_GetScrollFractionsY(tree, fractions);
1860    TreeNotify_Scroll(tree, fractions, TRUE);
1861
1862    if (tree->yScrollCmd == NULL)
1863	return;
1864
1865    Tcl_Preserve((ClientData) interp);
1866    Tcl_Preserve((ClientData) tree);
1867
1868    yScrollCmd = tree->yScrollCmd;
1869    Tcl_Preserve((ClientData) yScrollCmd);
1870    sprintf(buffer, "%g %g", fractions[0], fractions[1]);
1871    result = Tcl_VarEval(interp, yScrollCmd, " ", buffer, (char *) NULL);
1872    if (result != TCL_OK)
1873	Tcl_BackgroundError(interp);
1874    Tcl_ResetResult(interp);
1875    Tcl_Release((ClientData) yScrollCmd);
1876
1877    Tcl_Release((ClientData) tree);
1878    Tcl_Release((ClientData) interp);
1879}
1880
1881/*
1882 *----------------------------------------------------------------------
1883 *
1884 * TreeComputeGeometry --
1885 *
1886 *	This procedure is invoked to compute the requested size for the
1887 *	window.
1888 *
1889 * Results:
1890 *	None.
1891 *
1892 * Side effects:
1893 *	Tk_GeometryRequest is called to register the desired dimensions
1894 *	for the window.
1895 *
1896 *----------------------------------------------------------------------
1897 */
1898
1899static void
1900TreeComputeGeometry(
1901    TreeCtrl *tree		/* Widget info. */
1902    )
1903{
1904    Tk_SetInternalBorderEx(tree->tkwin,
1905	    tree->inset.left, tree->inset.right,
1906	    tree->inset.top, tree->inset.bottom);
1907    Tk_GeometryRequest(tree->tkwin,
1908	    tree->width + tree->inset.left + tree->inset.right,
1909	    tree->height + tree->inset.top + tree->inset.bottom);
1910}
1911
1912/*
1913 *----------------------------------------------------------------------
1914 *
1915 * Tree_AddItem --
1916 *
1917 *	Add an item to the hash table of items. Also set the unique item
1918 *	id and increment the number of items.
1919 *
1920 * Results:
1921 *	None.
1922 *
1923 * Side effects:
1924 *	None.
1925 *
1926 *----------------------------------------------------------------------
1927 */
1928
1929void
1930Tree_AddItem(
1931    TreeCtrl *tree,		/* Widget info. */
1932    TreeItem item		/* Item that was created. */
1933    )
1934{
1935    Tcl_HashEntry *hPtr;
1936    int id, isNew;
1937
1938    id = TreeItem_SetID(tree, item, tree->nextItemId++);
1939    hPtr = Tcl_CreateHashEntry(&tree->itemHash, (char *) id, &isNew);
1940    Tcl_SetHashValue(hPtr, item);
1941    tree->itemCount++;
1942}
1943
1944/*
1945 *----------------------------------------------------------------------
1946 *
1947 * Tree_RemoveItem --
1948 *
1949 *	Remove an item from the selection, if selected.
1950 *	Remove an item from the hash table of items.
1951 *	Decrement the number of items.
1952 *	Reset the unique item id allocator if the last item is removed.
1953 *
1954 * Results:
1955 *	None.
1956 *
1957 * Side effects:
1958 *	None.
1959 *
1960 *----------------------------------------------------------------------
1961 */
1962
1963void
1964Tree_RemoveItem(
1965    TreeCtrl *tree,		/* Widget info. */
1966    TreeItem item		/* Item to remove. */
1967    )
1968{
1969    Tcl_HashEntry *hPtr;
1970
1971    if (TreeItem_GetSelected(tree, item))
1972	Tree_RemoveFromSelection(tree, item);
1973
1974    hPtr = Tcl_FindHashEntry(&tree->itemSpansHash, (char *) item);
1975    if (hPtr != NULL)
1976	Tcl_DeleteHashEntry(hPtr);
1977
1978    hPtr = Tcl_FindHashEntry(&tree->itemHash,
1979	    (char *) TreeItem_GetID(tree, item));
1980    Tcl_DeleteHashEntry(hPtr);
1981    tree->itemCount--;
1982    if (tree->itemCount == 1)
1983	tree->nextItemId = TreeItem_GetID(tree, tree->root) + 1;
1984}
1985
1986/*
1987 *----------------------------------------------------------------------
1988 *
1989 * ImageChangedProc --
1990 *
1991 *	This procedure is invoked by the image code whenever the manager
1992 *	for an image does something that affects the image's size or
1993 *	how it is displayed.
1994 *
1995 * Results:
1996 *	None.
1997 *
1998 * Side effects:
1999 *	Arranges for the widget to get redisplayed.
2000 *
2001 *----------------------------------------------------------------------
2002 */
2003
2004static void
2005ImageChangedProc(
2006    ClientData clientData,		/* Widget info. */
2007    int x, int y,			/* Upper left pixel (within image)
2008					 * that must be redisplayed. */
2009    int width, int height,		/* Dimensions of area to redisplay
2010					 * (may be <= 0). */
2011    int imageWidth, int imageHeight	/* New dimensions of image. */
2012    )
2013{
2014    /* I would like to know the image was deleted... */
2015    TreeCtrl *tree = clientData;
2016
2017    /* FIXME: any image elements need to have their size invalidated
2018     * and items relayout'd accordingly. */
2019
2020    /* FIXME: this is used for the background image, but whitespace
2021     * is not redrawn if the background image is modified. */
2022
2023    Tree_DInfoChanged(tree, DINFO_INVALIDATE | DINFO_OUT_OF_DATE);
2024}
2025
2026/*
2027 *----------------------------------------------------------------------
2028 *
2029 * Tree_GetImage --
2030 *
2031 *	Wrapper around Tk_GetImage(). If the requested image does not yet
2032 *	exist it is created. Otherwise an existing instance is returned.
2033 *
2034 *	The purpose of this procedure is to save memory. We may expect
2035 *	the same image to be used hundreds of times (a folder image for
2036 *	example) and want to avoid allocating an instance for every usage.
2037 *
2038 *	For each call to this function, there must be a matching call
2039 *	to Tree_FreeImage.
2040 *
2041 * Results:
2042 *	Token for the image instance. If an error occurs the result is
2043 *	NULL and a message is left in the interpreter's result.
2044 *
2045 * Side effects:
2046 *	A new image instance may be created.
2047 *
2048 *----------------------------------------------------------------------
2049 */
2050
2051Tk_Image
2052Tree_GetImage(
2053    TreeCtrl *tree,		/* Widget info. */
2054    char *imageName		/* Name of an existing image. */
2055    )
2056{
2057    Tcl_HashEntry *hPtr, *h2Ptr;
2058    TreeImageRef *ref;
2059    Tk_Image image;
2060    int isNew;
2061
2062    hPtr = Tcl_CreateHashEntry(&tree->imageNameHash, imageName, &isNew);
2063    if (isNew) {
2064	image = Tk_GetImage(tree->interp, tree->tkwin, imageName,
2065		ImageChangedProc, (ClientData) tree);
2066	if (image == NULL) {
2067	    Tcl_DeleteHashEntry(hPtr);
2068	    return NULL;
2069	}
2070	ref = (TreeImageRef *) ckalloc(sizeof(TreeImageRef));
2071	ref->count = 0;
2072	ref->image = image;
2073	ref->hPtr = hPtr;
2074	Tcl_SetHashValue(hPtr, ref);
2075
2076	h2Ptr = Tcl_CreateHashEntry(&tree->imageTokenHash, (char *) image,
2077		&isNew);
2078	Tcl_SetHashValue(h2Ptr, ref);
2079    }
2080    ref = (TreeImageRef *) Tcl_GetHashValue(hPtr);
2081    ref->count++;
2082    return ref->image;
2083}
2084
2085/*
2086 *----------------------------------------------------------------------
2087 *
2088 * Tree_FreeImage --
2089 *
2090 *	Decrement the reference count on an image.
2091 *
2092 * Results:
2093 *	If the reference count hits zero, frees the image instance and
2094 *	hash table entries.
2095 *
2096 * Side effects:
2097 *	Memory may be freed.
2098 *
2099 *----------------------------------------------------------------------
2100 */
2101
2102void
2103Tree_FreeImage(
2104    TreeCtrl *tree,		/* Widget info. */
2105    Tk_Image image		/* Image token. */
2106    )
2107{
2108    Tcl_HashEntry *hPtr;
2109    TreeImageRef *ref;
2110
2111    hPtr = Tcl_FindHashEntry(&tree->imageTokenHash, (char *) image);
2112    if (hPtr != NULL) {
2113	ref = (TreeImageRef *) Tcl_GetHashValue(hPtr);
2114	if (--ref->count == 0) {
2115	    Tcl_DeleteHashEntry(ref->hPtr); /* imageNameHash */
2116	    Tcl_DeleteHashEntry(hPtr);
2117	    Tk_FreeImage(ref->image);
2118	    ckfree((char *) ref);
2119	}
2120    }
2121}
2122
2123/*
2124 *--------------------------------------------------------------
2125 *
2126 * TreeSeeCmd --
2127 *
2128 *	This procedure is invoked to process the [see] widget
2129 *	command.  See the user documentation for details on what
2130 *	it does.
2131 *
2132 * Results:
2133 *	A standard Tcl result.
2134 *
2135 * Side effects:
2136 *	See the user documentation.
2137 *
2138 *--------------------------------------------------------------
2139 */
2140
2141static int
2142TreeSeeCmd(
2143    TreeCtrl *tree,		/* Widget info. */
2144    int objc,			/* Number of arguments. */
2145    Tcl_Obj *CONST objv[]	/* Argument values. */
2146    )
2147{
2148    Tcl_Interp *interp = tree->interp;
2149    TreeItem item;
2150    TreeColumn treeColumn = NULL;
2151    int x, y, w, h;
2152    int visWidth = Tree_ContentWidth(tree);
2153    int visHeight = Tree_ContentHeight(tree);
2154    int xOrigin = Tree_GetOriginX(tree);
2155    int yOrigin = Tree_GetOriginY(tree);
2156    int minX = Tree_ContentLeft(tree);
2157    int minY = Tree_ContentTop(tree);
2158    int maxX = Tree_ContentRight(tree);
2159    int maxY = Tree_ContentBottom(tree);
2160    int index, offset;
2161    int centerX = 0, centerY = 0;
2162
2163    if (objc < 3) {
2164	Tcl_WrongNumArgs(interp, 2, objv, "item ?column? ?option value ...?");
2165	return TCL_ERROR;
2166    }
2167    if (TreeItem_FromObj(tree, objv[2], &item, IFO_NOT_NULL) != TCL_OK)
2168	return TCL_ERROR;
2169
2170    if (objc > 3) {
2171	int i, k, len, firstOption = 3;
2172	char *s = Tcl_GetStringFromObj(objv[3], &len);
2173	if (s[0] != '-') {
2174	    if (TreeColumn_FromObj(tree, objv[3], &treeColumn,
2175		    CFO_NOT_NULL | CFO_NOT_TAIL) != TCL_OK)
2176		return TCL_ERROR;
2177	    firstOption = 4;
2178	}
2179
2180	for (i = firstOption; i < objc; i += 2)
2181	{
2182	    static CONST char *optionNames[] = {
2183		"-center", (char *) NULL
2184	    };
2185	    if (Tcl_GetIndexFromObj(interp, objv[i], optionNames,
2186		    "option", 0, &index) != TCL_OK) {
2187		return TCL_ERROR;
2188	    }
2189	    if (i + 1 == objc) {
2190		FormatResult(interp, "missing value for \"%s\" option",
2191			optionNames[index]);
2192		return TCL_ERROR;
2193	    }
2194	    switch (index)
2195	    {
2196		case 0: { /* -center */
2197		    char *s = Tcl_GetStringFromObj(objv[i+1], &len);
2198		    for (k = 0; k < len; k++) {
2199			switch (s[k]) {
2200			    case 'x': case 'X': centerX = 1; break;
2201			    case 'y': case 'Y': centerY = 1; break;
2202			    default: {
2203				Tcl_ResetResult(tree->interp);
2204				Tcl_AppendResult(tree->interp,
2205				    "bad -center value \"",
2206				    s, "\": must be a string ",
2207				    "containing zero or more of x and y",
2208				    (char *) NULL);
2209				return TCL_ERROR;
2210			    }
2211			}
2212		    }
2213		    break;
2214		}
2215	    }
2216	}
2217    }
2218
2219    /* Get the item bounds in canvas coords. */
2220    if (Tree_ItemBbox(tree, item, COLUMN_LOCK_NONE, &x, &y, &w, &h) < 0)
2221	return TCL_OK;
2222
2223    if (treeColumn != NULL) {
2224	x += TreeColumn_Offset(treeColumn);
2225	w = TreeColumn_UseWidth(treeColumn);
2226    }
2227
2228    /* No horizontal scrolling for locked columns. */
2229    if ((treeColumn != NULL) &&
2230	    (TreeColumn_Lock(treeColumn) != COLUMN_LOCK_NONE)) {
2231	/* nothing */
2232
2233    /* Center the item or column horizontally. */
2234    } else if (centerX) {
2235	index = Increment_FindX(tree, x + w/2 - visWidth/2);
2236	offset = Increment_ToOffsetX(tree, index);
2237	if (offset < x + w/2 - visWidth/2) {
2238	    index++;
2239	    offset = Increment_ToOffsetX(tree, index);
2240	}
2241	xOrigin = C2Ox(offset);
2242
2243    /* Scroll horizontally a minimal amount. */
2244    } else if ((C2Wx(x) > maxX) || (C2Wx(x + w) <= minX) || (w <= visWidth)) {
2245	if ((C2Wx(x) < minX) || (w > visWidth)) {
2246	    index = Increment_FindX(tree, x);
2247	    offset = Increment_ToOffsetX(tree, index);
2248	    xOrigin = C2Ox(offset);
2249	}
2250	else if (C2Wx(x + w) > maxX) {
2251	    index = Increment_FindX(tree, x + w - visWidth);
2252	    offset = Increment_ToOffsetX(tree, index);
2253	    if (offset < x + w - visWidth) {
2254		index++;
2255		offset = Increment_ToOffsetX(tree, index);
2256	    }
2257	    xOrigin = C2Ox(offset);
2258	}
2259    }
2260
2261    /* Center the item or column vertically. */
2262    if (centerY) {
2263	index = Increment_FindY(tree, y + h/2 - visHeight/2);
2264	offset = Increment_ToOffsetY(tree, index);
2265	if (offset < y + h/2 - visHeight/2) {
2266	    index++;
2267	    offset = Increment_ToOffsetY(tree, index);
2268	}
2269	yOrigin = C2Oy(offset);
2270
2271    /* Scroll vertically a minimal amount. */
2272    } else if ((C2Wy(y) > maxY) || (C2Wy(y + h) <= minY) || (h <= visHeight)) {
2273	if ((C2Wy(y) < minY) || (h > visHeight)) {
2274	    index = Increment_FindY(tree, y);
2275	    offset = Increment_ToOffsetY(tree, index);
2276	    yOrigin = C2Oy(offset);
2277	}
2278	else if (C2Wy(y + h) > maxY) {
2279	    index = Increment_FindY(tree, y + h - visHeight);
2280	    offset = Increment_ToOffsetY(tree, index);
2281	    if (offset < y + h - visHeight) {
2282		index++;
2283		offset = Increment_ToOffsetY(tree, index);
2284	    }
2285	    yOrigin = C2Oy(offset);
2286	}
2287    }
2288
2289    Tree_SetOriginX(tree, xOrigin);
2290    Tree_SetOriginY(tree, yOrigin);
2291
2292    return TCL_OK;
2293}
2294
2295/*
2296 *----------------------------------------------------------------------
2297 *
2298 * Tree_StateFromObj --
2299 *
2300 *	Parse a Tcl_Obj containing a state name (with optional modifers)
2301 *	into a STATE_xxx flag, and modify an existing array of state
2302 *	flags accordingly.
2303 *
2304 *	If the object contains "foo", then the state "foo" is set on.
2305 *	If the object contains "!foo", then the state "foo" is set off.
2306 *	If the object contains "^foo", then the state "foo" is toggled.
2307 *
2308 * Results:
2309 *	A standard Tcl result.
2310 *
2311 * Side effects:
2312 *	None.
2313 *
2314 *----------------------------------------------------------------------
2315 */
2316
2317int
2318Tree_StateFromObj(
2319    TreeCtrl *tree,		/* Widget info. */
2320    Tcl_Obj *obj,		/* String rep of the state. */
2321    int states[3],		/* Initialized state flags, indexed by the
2322				 * STATE_OP_xxx contants. A single flag
2323				 * may be turned on or off in each value. */
2324    int *indexPtr,		/* Returned index of the STATE_xxx flag.
2325				 * May be NULL. */
2326    int flags			/* SFO_xxx flags. */
2327    )
2328{
2329    Tcl_Interp *interp = tree->interp;
2330    int i, op = STATE_OP_ON, op2, op3, length, state = 0;
2331    char ch0, *string;
2332
2333    string = Tcl_GetStringFromObj(obj, &length);
2334    if (length == 0)
2335	goto unknown;
2336    ch0 = string[0];
2337    if (ch0 == '!') {
2338	if (flags & SFO_NOT_OFF) {
2339	    FormatResult(interp, "can't specify '!' for this command");
2340	    return TCL_ERROR;
2341	}
2342	op = STATE_OP_OFF;
2343	++string;
2344	ch0 = string[0];
2345    } else if (ch0 == '~') {
2346	if (flags & SFO_NOT_TOGGLE) {
2347	    FormatResult(interp, "can't specify '~' for this command");
2348	    return TCL_ERROR;
2349	}
2350	op = STATE_OP_TOGGLE;
2351	++string;
2352	ch0 = string[0];
2353    }
2354    for (i = 0; i < 32; i++) {
2355	if (tree->stateNames[i] == NULL)
2356	    continue;
2357	if ((ch0 == tree->stateNames[i][0]) &&
2358		(strcmp(string, tree->stateNames[i]) == 0)) {
2359	    if ((i < STATE_USER - 1) && (flags & SFO_NOT_STATIC)) {
2360		FormatResult(interp,
2361			"can't specify state \"%s\" for this command",
2362			tree->stateNames[i]);
2363		return TCL_ERROR;
2364	    }
2365	    state = 1L << i;
2366	    break;
2367	}
2368    }
2369    if (state == 0)
2370	goto unknown;
2371
2372    if (states != NULL) {
2373	if (op == STATE_OP_ON) {
2374	    op2 = STATE_OP_OFF;
2375	    op3 = STATE_OP_TOGGLE;
2376	}
2377	else if (op == STATE_OP_OFF) {
2378	    op2 = STATE_OP_ON;
2379	    op3 = STATE_OP_TOGGLE;
2380	} else {
2381	    op2 = STATE_OP_ON;
2382	    op3 = STATE_OP_OFF;
2383	}
2384	states[op2] &= ~state;
2385	states[op3] &= ~state;
2386	states[op] |= state;
2387    }
2388    if (indexPtr != NULL) (*indexPtr) = i;
2389    return TCL_OK;
2390
2391unknown:
2392    FormatResult(interp, "unknown state \"%s\"", string);
2393    return TCL_ERROR;
2394}
2395
2396/*
2397 *----------------------------------------------------------------------
2398 *
2399 * Tree_StateFromListObj --
2400 *
2401 *	Call Tree_StateFromObj for a Tcl_Obj list object.
2402 *
2403 * Results:
2404 *	A standard Tcl result.
2405 *
2406 * Side effects:
2407 *	None.
2408 *
2409 *----------------------------------------------------------------------
2410 */
2411
2412int
2413Tree_StateFromListObj(
2414    TreeCtrl *tree,		/* Widget info. */
2415    Tcl_Obj *obj,		/* List of states. */
2416    int states[3],		/* Uninitialized state flags, indexed by the
2417				 * STATE_OP_xxx contants. A single flag
2418				 * may be turned on or off in each value. */
2419    int flags			/* SFO_xxx flags. */
2420    )
2421{
2422    Tcl_Interp *interp = tree->interp;
2423    int i, listObjc;
2424    Tcl_Obj **listObjv;
2425
2426    states[0] = states[1] = states[2] = 0;
2427    if (Tcl_ListObjGetElements(interp, obj, &listObjc, &listObjv) != TCL_OK)
2428	return TCL_ERROR;
2429    for (i = 0; i < listObjc; i++) {
2430	if (Tree_StateFromObj(tree, listObjv[i], states, NULL, flags) != TCL_OK)
2431	    return TCL_ERROR;
2432    }
2433    return TCL_OK;
2434}
2435
2436/*
2437 *--------------------------------------------------------------
2438 *
2439 * TreeStateCmd --
2440 *
2441 *	This procedure is invoked to process the [state] widget
2442 *	command.  See the user documentation for details on what
2443 *	it does.
2444 *
2445 * Results:
2446 *	A standard Tcl result.
2447 *
2448 * Side effects:
2449 *	See the user documentation.
2450 *
2451 *--------------------------------------------------------------
2452 */
2453
2454static int
2455TreeStateCmd(
2456    TreeCtrl *tree,		/* Widget info. */
2457    int objc,			/* Number of arguments. */
2458    Tcl_Obj *CONST objv[]	/* Argument values. */
2459    )
2460{
2461    Tcl_Interp *interp = tree->interp;
2462    static CONST char *commandName[] = {
2463	"define", "linkage", "names",  "undefine", (char *) NULL
2464    };
2465    enum {
2466	COMMAND_DEFINE, COMMAND_LINKAGE, COMMAND_NAMES, COMMAND_UNDEFINE
2467    };
2468    int index;
2469
2470    if (objc < 3) {
2471	Tcl_WrongNumArgs(interp, 2, objv, "command ?arg arg ...?");
2472	return TCL_ERROR;
2473    }
2474
2475    if (Tcl_GetIndexFromObj(interp, objv[2], commandName, "command", 0,
2476	    &index) != TCL_OK) {
2477	return TCL_ERROR;
2478    }
2479
2480    switch (index) {
2481	case COMMAND_DEFINE: {
2482	    char *string;
2483	    int i, length, slot = -1;
2484
2485	    if (objc != 4) {
2486		Tcl_WrongNumArgs(interp, 3, objv, "stateName");
2487		return TCL_ERROR;
2488	    }
2489	    string = Tcl_GetStringFromObj(objv[3], &length);
2490	    if (!length || (*string == '~') || (*string == '!')) {
2491		FormatResult(interp, "invalid state name \"%s\"", string);
2492		return TCL_ERROR;
2493	    }
2494	    for (i = 0; i < 32; i++) {
2495		if (tree->stateNames[i] == NULL) {
2496		    if (slot == -1)
2497			slot = i;
2498		    continue;
2499		}
2500		if (strcmp(tree->stateNames[i], string) == 0) {
2501		    FormatResult(interp, "state \"%s\" already defined", string);
2502		    return TCL_ERROR;
2503		}
2504	    }
2505	    if (slot == -1) {
2506		FormatResult(interp, "cannot define any more states");
2507		return TCL_ERROR;
2508	    }
2509	    tree->stateNames[slot] = ckalloc(length + 1);
2510	    strcpy(tree->stateNames[slot], string);
2511	    break;
2512	}
2513
2514	case COMMAND_LINKAGE: {
2515	    int index;
2516
2517	    if (objc != 4) {
2518		Tcl_WrongNumArgs(interp, 3, objv, "state");
2519		return TCL_ERROR;
2520	    }
2521	    if (Tree_StateFromObj(tree, objv[3], NULL, &index,
2522		    SFO_NOT_OFF | SFO_NOT_TOGGLE) != TCL_OK)
2523		return TCL_ERROR;
2524	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
2525		(index < STATE_USER - 1) ? "static" : "dynamic", -1));
2526	    break;
2527	}
2528
2529	case COMMAND_NAMES: {
2530	    Tcl_Obj *listObj;
2531	    int i;
2532
2533	    if (objc != 3) {
2534		Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
2535		return TCL_ERROR;
2536	    }
2537	    listObj = Tcl_NewListObj(0, NULL);
2538	    for (i = STATE_USER - 1; i < 32; i++) {
2539		if (tree->stateNames[i] != NULL)
2540		    Tcl_ListObjAppendElement(interp, listObj,
2541			    Tcl_NewStringObj(tree->stateNames[i], -1));
2542	    }
2543	    Tcl_SetObjResult(interp, listObj);
2544	    break;
2545	}
2546
2547	case COMMAND_UNDEFINE: {
2548	    int i, index;
2549
2550	    for (i = 3; i < objc; i++) {
2551		if (Tree_StateFromObj(tree, objv[i], NULL, &index,
2552			SFO_NOT_STATIC | SFO_NOT_OFF | SFO_NOT_TOGGLE) != TCL_OK)
2553		    return TCL_ERROR;
2554		Tree_UndefineState(tree, 1L << index);
2555		PerStateInfo_Undefine(tree, &pstBitmap, &tree->buttonBitmap,
2556			1L << index);
2557		PerStateInfo_Undefine(tree, &pstImage, &tree->buttonImage,
2558			1L << index);
2559		ckfree(tree->stateNames[index]);
2560		tree->stateNames[index] = NULL;
2561	    }
2562	    break;
2563	}
2564    }
2565
2566    return TCL_OK;
2567}
2568
2569/*
2570 *--------------------------------------------------------------
2571 *
2572 * Tree_AddToSelection --
2573 *
2574 *	Add an item to the hash table of selected items. Turn on the
2575 *	STATE_SELECTED state for the item.
2576 *
2577 * Results:
2578 *	None.
2579 *
2580 * Side effects:
2581 *	The widget may be redisplayed at idle time.
2582 *
2583 *--------------------------------------------------------------
2584 */
2585
2586void
2587Tree_AddToSelection(
2588    TreeCtrl *tree,		/* Widget info */
2589    TreeItem item		/* Item to add to the selection. */
2590    )
2591{
2592    Tcl_HashEntry *hPtr;
2593    int isNew;
2594
2595#ifdef SELECTION_VISIBLE
2596    if (!TreeItem_ReallyVisible(tree, item))
2597	panic("Tree_AddToSelection: item %d not ReallyVisible",
2598		TreeItem_GetID(tree, item));
2599#endif
2600    if (TreeItem_GetSelected(tree, item))
2601	panic("Tree_AddToSelection: item %d already selected",
2602		TreeItem_GetID(tree, item));
2603    if (!TreeItem_GetEnabled(tree, item))
2604	panic("Tree_AddToSelection: item %d not enabled",
2605		TreeItem_GetID(tree, item));
2606    TreeItem_ChangeState(tree, item, 0, STATE_SELECTED);
2607    hPtr = Tcl_CreateHashEntry(&tree->selection, (char *) item, &isNew);
2608    if (!isNew)
2609	panic("Tree_AddToSelection: item %d already in selection hash table",
2610		TreeItem_GetID(tree, item));
2611    tree->selectCount++;
2612}
2613
2614/*
2615 *--------------------------------------------------------------
2616 *
2617 * Tree_RemoveFromSelection --
2618 *
2619 *	Remove an item from the hash table of selected items. Turn off the
2620 *	STATE_SELECTED state for the item.
2621 *
2622 * Results:
2623 *	None.
2624 *
2625 * Side effects:
2626 *	The widget may be redisplayed at idle time.
2627 *
2628 *--------------------------------------------------------------
2629 */
2630
2631void
2632Tree_RemoveFromSelection(
2633    TreeCtrl *tree,		/* Widget info */
2634    TreeItem item		/* Item to remove from the selection. */
2635    )
2636{
2637    Tcl_HashEntry *hPtr;
2638
2639    if (!TreeItem_GetSelected(tree, item))
2640	panic("Tree_RemoveFromSelection: item %d isn't selected",
2641		TreeItem_GetID(tree, item));
2642    TreeItem_ChangeState(tree, item, STATE_SELECTED, 0);
2643    hPtr = Tcl_FindHashEntry(&tree->selection, (char *) item);
2644    if (hPtr == NULL)
2645	panic("Tree_RemoveFromSelection: item %d not found in selection hash table",
2646		TreeItem_GetID(tree, item));
2647    Tcl_DeleteHashEntry(hPtr);
2648    tree->selectCount--;
2649}
2650
2651/*
2652 *--------------------------------------------------------------
2653 *
2654 * TreeSelectionCmd --
2655 *
2656 *	This procedure is invoked to process the [selection] widget
2657 *	command.  See the user documentation for details on what
2658 *	it does.
2659 *
2660 * Results:
2661 *	A standard Tcl result.
2662 *
2663 * Side effects:
2664 *	See the user documentation.
2665 *
2666 *--------------------------------------------------------------
2667 */
2668
2669static int
2670TreeSelectionCmd(
2671    Tcl_Interp *interp,		/* Current interpreter. */
2672    TreeCtrl *tree,		/* Widget info. */
2673    int objc,			/* Number of arguments. */
2674    Tcl_Obj *CONST objv[]	/* Argument values. */
2675    )
2676{
2677    static CONST char *commandName[] = {
2678	"add", "anchor", "clear", "count", "get", "includes", "modify", NULL
2679    };
2680    enum {
2681	COMMAND_ADD, COMMAND_ANCHOR, COMMAND_CLEAR, COMMAND_COUNT,
2682	COMMAND_GET, COMMAND_INCLUDES, COMMAND_MODIFY
2683    };
2684    int index;
2685    TreeItemList itemsFirst, itemsLast;
2686    TreeItem item, itemFirst, itemLast;
2687
2688    if (objc < 3) {
2689	Tcl_WrongNumArgs(interp, 2, objv, "command ?arg arg ...?");
2690	return TCL_ERROR;
2691    }
2692
2693    if (Tcl_GetIndexFromObj(interp, objv[2], commandName, "command", 0,
2694	    &index) != TCL_OK) {
2695	return TCL_ERROR;
2696    }
2697
2698    switch (index) {
2699	case COMMAND_ADD: {
2700	    int i, count;
2701	    TreeItemList items;
2702	    Tcl_HashEntry *hPtr;
2703	    Tcl_HashSearch search;
2704
2705	    if (objc < 4 || objc > 5) {
2706		Tcl_WrongNumArgs(interp, 3, objv, "first ?last?");
2707		return TCL_ERROR;
2708	    }
2709	    if (TreeItemList_FromObj(tree, objv[3], &itemsFirst, IFO_NOT_NULL) != TCL_OK)
2710		return TCL_ERROR;
2711	    itemFirst = TreeItemList_Nth(&itemsFirst, 0);
2712	    itemLast = NULL;
2713	    if (objc == 5) {
2714		if (TreeItemList_FromObj(tree, objv[4], &itemsLast, IFO_NOT_NULL) != TCL_OK) {
2715		    TreeItemList_Free(&itemsFirst);
2716		    return TCL_ERROR;
2717		}
2718		itemLast = TreeItemList_Nth(&itemsLast, 0);
2719	    }
2720	    if ((itemFirst == ITEM_ALL) || (itemLast == ITEM_ALL)) {
2721		if (objc == 5) TreeItemList_Free(&itemsLast);
2722		TreeItemList_Init(tree, &items,
2723			tree->itemCount - tree->selectCount);
2724
2725		/* Include orphans. */
2726		hPtr = Tcl_FirstHashEntry(&tree->itemHash, &search);
2727		while (hPtr != NULL) {
2728		    item = (TreeItem) Tcl_GetHashValue(hPtr);
2729#ifdef SELECTION_VISIBLE
2730		    if (!TreeItem_GetSelected(tree, item) &&
2731			    TreeItem_GetEnabled(tree, item) &&
2732			    TreeItem_ReallyVisible(tree, item)) {
2733#else
2734		    if (!TreeItem_GetSelected(tree, item) &&
2735			    TreeItem_GetEnabled(tree, item)) {
2736#endif
2737			Tree_AddToSelection(tree, item);
2738			TreeItemList_Append(&items, item);
2739		    }
2740		    hPtr = Tcl_NextHashEntry(&search);
2741		}
2742		goto doneADD;
2743	    }
2744	    if (objc == 5) {
2745		TreeItemList_Free(&itemsFirst);
2746		TreeItemList_Free(&itemsLast);
2747		count = TreeItem_FirstAndLast(tree, &itemFirst, &itemLast);
2748		if (count == 0)
2749		    return TCL_ERROR;
2750		TreeItemList_Init(tree, &items, count);
2751		while (1) {
2752#ifdef SELECTION_VISIBLE
2753		    if (!TreeItem_GetSelected(tree, itemFirst) &&
2754			    TreeItem_GetEnabled(tree, itemFirst) &&
2755			    TreeItem_ReallyVisible(tree, itemFirst)) {
2756#else
2757		    if (!TreeItem_GetSelected(tree, itemFirst) &&
2758			    TreeItem_GetEnabled(tree, itemFirst)) {
2759#endif
2760			Tree_AddToSelection(tree, itemFirst);
2761			TreeItemList_Append(&items, itemFirst);
2762		    }
2763		    if (itemFirst == itemLast)
2764			break;
2765		    itemFirst = TreeItem_Next(tree, itemFirst);
2766		}
2767		goto doneADD;
2768	    }
2769	    count = TreeItemList_Count(&itemsFirst);
2770	    TreeItemList_Init(tree, &items, count);
2771	    for (i = 0; i < count; i++) {
2772		item = TreeItemList_Nth(&itemsFirst, i);
2773#ifdef SELECTION_VISIBLE
2774		if (!TreeItem_GetSelected(tree, item) &&
2775			TreeItem_GetEnabled(tree, item) &&
2776			TreeItem_ReallyVisible(tree, item)) {
2777#else
2778		if (!TreeItem_GetSelected(tree, item) &&
2779			TreeItem_GetEnabled(tree, item)) {
2780#endif
2781		    Tree_AddToSelection(tree, item);
2782		    TreeItemList_Append(&items, item);
2783		}
2784	    }
2785doneADD:
2786	    if (TreeItemList_Count(&items)) {
2787		TreeNotify_Selection(tree, &items, NULL);
2788	    }
2789	    TreeItemList_Free(&items);
2790	    TreeItemList_Free(&itemsFirst);
2791	    break;
2792	}
2793
2794	case COMMAND_ANCHOR: {
2795	    if (objc != 3 && objc != 4) {
2796		Tcl_WrongNumArgs(interp, 3, objv, "?item?");
2797		return TCL_ERROR;
2798	    }
2799	    if (objc == 4) {
2800		if (TreeItem_FromObj(tree, objv[3], &item, IFO_NOT_NULL) != TCL_OK) {
2801		    return TCL_ERROR;
2802		}
2803		tree->anchorItem = item;
2804	    }
2805	    Tcl_SetObjResult(interp, TreeItem_ToObj(tree, tree->anchorItem));
2806	    break;
2807	}
2808
2809	case COMMAND_CLEAR: {
2810	    int i, count;
2811	    TreeItemList items;
2812	    Tcl_HashEntry *hPtr;
2813	    Tcl_HashSearch search;
2814
2815	    if (objc > 5) {
2816		Tcl_WrongNumArgs(interp, 3, objv, "?first? ?last?");
2817		return TCL_ERROR;
2818	    }
2819	    itemFirst = itemLast = NULL;
2820	    if (objc >= 4) {
2821		if (TreeItemList_FromObj(tree, objv[3], &itemsFirst, IFO_NOT_NULL) != TCL_OK)
2822		    return TCL_ERROR;
2823		itemFirst = TreeItemList_Nth(&itemsFirst, 0);
2824	    }
2825	    if (objc == 5) {
2826		if (TreeItemList_FromObj(tree, objv[4], &itemsLast, IFO_NOT_NULL) != TCL_OK) {
2827		    TreeItemList_Free(&itemsFirst);
2828		    return TCL_ERROR;
2829		}
2830		itemLast = TreeItemList_Nth(&itemsLast, 0);
2831	    }
2832	    if (tree->selectCount < 1) {
2833		if (objc >= 4) TreeItemList_Free(&itemsFirst);
2834		if (objc == 5) TreeItemList_Free(&itemsLast);
2835		break;
2836	    }
2837	    if ((objc == 3) || (itemFirst == ITEM_ALL) || (itemLast == ITEM_ALL)) {
2838		if (objc >= 4) TreeItemList_Free(&itemsFirst);
2839		if (objc == 5) TreeItemList_Free(&itemsLast);
2840		TreeItemList_Init(tree, &items, tree->selectCount);
2841		hPtr = Tcl_FirstHashEntry(&tree->selection, &search);
2842		while (hPtr != NULL) {
2843		    item = (TreeItem) Tcl_GetHashKey(&tree->selection, hPtr);
2844		    TreeItemList_Append(&items, item);
2845		    hPtr = Tcl_NextHashEntry(&search);
2846		}
2847		count = TreeItemList_Count(&items);
2848		for (i = 0; i < count; i++)
2849		    Tree_RemoveFromSelection(tree, TreeItemList_Nth(&items, i));
2850		goto doneCLEAR;
2851	    }
2852	    if (objc == 5) {
2853		TreeItemList_Free(&itemsFirst);
2854		TreeItemList_Free(&itemsLast);
2855		count = TreeItem_FirstAndLast(tree, &itemFirst, &itemLast);
2856		if (count == 0)
2857		    return TCL_ERROR;
2858		TreeItemList_Init(tree, &items, count);
2859		while (1) {
2860		    if (TreeItem_GetSelected(tree, itemFirst)) {
2861			Tree_RemoveFromSelection(tree, itemFirst);
2862			TreeItemList_Append(&items, itemFirst);
2863		    }
2864		    if (itemFirst == itemLast)
2865			break;
2866		    itemFirst = TreeItem_Next(tree, itemFirst);
2867		}
2868		goto doneCLEAR;
2869	    }
2870	    count = TreeItemList_Count(&itemsFirst);
2871	    TreeItemList_Init(tree, &items, count);
2872	    for (i = 0; i < count; i++) {
2873		item = TreeItemList_Nth(&itemsFirst, i);
2874		if (TreeItem_GetSelected(tree, item)) {
2875		    Tree_RemoveFromSelection(tree, item);
2876		    TreeItemList_Append(&items, item);
2877		}
2878	    }
2879	    TreeItemList_Free(&itemsFirst);
2880doneCLEAR:
2881	    if (TreeItemList_Count(&items)) {
2882		TreeNotify_Selection(tree, NULL, &items);
2883	    }
2884	    TreeItemList_Free(&items);
2885	    break;
2886	}
2887
2888	case COMMAND_COUNT: {
2889	    if (objc != 3) {
2890		Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
2891		return TCL_ERROR;
2892	    }
2893	    Tcl_SetObjResult(interp, Tcl_NewIntObj(tree->selectCount));
2894	    break;
2895	}
2896
2897	case COMMAND_GET: {
2898	    TreeItem item;
2899	    Tcl_Obj *listObj;
2900	    Tcl_HashEntry *hPtr;
2901	    Tcl_HashSearch search;
2902
2903#ifdef SELECTION_VISIBLE
2904	    if (objc < 3 || objc > 5) {
2905		Tcl_WrongNumArgs(interp, 3, objv, "?first? ?last?");
2906		return TCL_ERROR;
2907	    }
2908	    if (objc > 3) {
2909		int first, last;
2910		TreeItemList items;
2911
2912		if (TclGetIntForIndex(interp, objv[3], tree->selectCount - 1,
2913			&first) != TCL_OK) {
2914		    return TCL_ERROR;
2915		}
2916		if (first < 0)
2917		    first = 0;
2918		last = first;
2919		if (objc == 5) {
2920		    if (TclGetIntForIndex(interp, objv[4], tree->selectCount - 1,
2921			    &last) != TCL_OK) {
2922			return TCL_ERROR;
2923		    }
2924		}
2925		if (last >= tree->selectCount)
2926		    last = tree->selectCount - 1;
2927		if (first > last)
2928		    break;
2929
2930		/* Build a list of selected items. */
2931		TreeItemList_Init(tree, &items, tree->selectCount);
2932		hPtr = Tcl_FirstHashEntry(&tree->selection, &search);
2933		while (hPtr != NULL) {
2934		    item = (TreeItem) Tcl_GetHashKey(&tree->selection, hPtr);
2935		    TreeItemList_Append(&items, item);
2936		    hPtr = Tcl_NextHashEntry(&search);
2937		}
2938
2939		/* Sort it. */
2940		TreeItemList_Sort(&items);
2941
2942		if (first == last) {
2943		    item = TreeItemList_Nth(&items, first);
2944		    Tcl_SetObjResult(interp, TreeItem_ToObj(tree, item));
2945		} else {
2946		    listObj = Tcl_NewListObj(0, NULL);
2947		    for (index = first; index <= last; index++) {
2948			item = TreeItemList_Nth(&items, index);
2949			Tcl_ListObjAppendElement(interp, listObj,
2950				TreeItem_ToObj(tree, item));
2951		    }
2952		    Tcl_SetObjResult(interp, listObj);
2953		}
2954
2955		TreeItemList_Free(&items);
2956		break;
2957	    }
2958#else /* SELECTION_VISIBLE */
2959	    /* If any item may be selected, including orphans, then getting
2960	     * a sorted list of selected items is impossible. */
2961	    if (objc != 3) {
2962		Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
2963		return TCL_ERROR;
2964	    }
2965#endif /* SELECTION_VISIBLE */
2966
2967	    if (tree->selectCount < 1)
2968		break;
2969	    listObj = Tcl_NewListObj(0, NULL);
2970	    hPtr = Tcl_FirstHashEntry(&tree->selection, &search);
2971	    while (hPtr != NULL) {
2972		item = (TreeItem) Tcl_GetHashKey(&tree->selection, hPtr);
2973		Tcl_ListObjAppendElement(interp, listObj,
2974			TreeItem_ToObj(tree, item));
2975		hPtr = Tcl_NextHashEntry(&search);
2976	    }
2977	    Tcl_SetObjResult(interp, listObj);
2978	    break;
2979	}
2980
2981	case COMMAND_INCLUDES: {
2982	    if (objc != 4) {
2983		Tcl_WrongNumArgs(interp, 3, objv, "item");
2984		return TCL_ERROR;
2985	    }
2986	    if (TreeItem_FromObj(tree, objv[3], &item, IFO_NOT_NULL) != TCL_OK)
2987		return TCL_ERROR;
2988	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
2989		TreeItem_GetSelected(tree, item)));
2990	    break;
2991	}
2992
2993	case COMMAND_MODIFY: {
2994	    int i, j, k, objcS, objcD;
2995	    Tcl_Obj **objvS, **objvD;
2996	    Tcl_HashEntry *hPtr;
2997	    Tcl_HashSearch search;
2998	    TreeItem item;
2999	    TreeItemList items;
3000	    TreeItemList itemS, itemD, newS, newD;
3001	    int allS = FALSE, allD = FALSE;
3002
3003	    if (objc != 5) {
3004		Tcl_WrongNumArgs(interp, 3, objv, "select deselect");
3005		return TCL_ERROR;
3006	    }
3007	    if (Tcl_ListObjGetElements(interp, objv[3], &objcS, &objvS) != TCL_OK)
3008		return TCL_ERROR;
3009	    if (Tcl_ListObjGetElements(interp, objv[4], &objcD, &objvD) != TCL_OK)
3010		return TCL_ERROR;
3011
3012	    /* No change */
3013	    if (!objcS && !objcD)
3014		break;
3015
3016	    /* Some of these may get double-initialized. */
3017	    TreeItemList_Init(tree, &itemS, 0);
3018	    TreeItemList_Init(tree, &itemD, 0);
3019	    TreeItemList_Init(tree, &newS, 0);
3020	    TreeItemList_Init(tree, &newD, 0);
3021
3022	    /* List of items to select */
3023	    for (i = 0; i < objcS; i++) {
3024		if (TreeItemList_FromObj(tree, objvS[i], &items, IFO_NOT_NULL) != TCL_OK) {
3025		    TreeItemList_Free(&itemS);
3026		    return TCL_ERROR;
3027		}
3028
3029		/* Add unique items to itemS */
3030		for (k = 0; k < TreeItemList_Count(&items); k++) {
3031		    item = TreeItemList_Nth(&items, k);
3032		    if (item == ITEM_ALL) {
3033			allS = TRUE;
3034			break;
3035		    }
3036		    for (j = 0; j < TreeItemList_Count(&itemS); j++) {
3037			if (TreeItemList_Nth(&itemS, j) == item)
3038			    break;
3039		    }
3040		    if (j == TreeItemList_Count(&itemS)) {
3041			TreeItemList_Append(&itemS, item);
3042		    }
3043		}
3044		TreeItemList_Free(&items);
3045		if (allS) break;
3046	    }
3047
3048	    /* List of items to deselect */
3049	    for (i = 0; i < objcD; i++) {
3050		if (TreeItemList_FromObj(tree, objvD[i], &items, IFO_NOT_NULL) != TCL_OK) {
3051		    TreeItemList_Free(&itemS);
3052		    TreeItemList_Free(&itemD);
3053		    return TCL_ERROR;
3054		}
3055
3056		/* Add unique items to itemD */
3057		for (k = 0; k < TreeItemList_Count(&items); k++) {
3058		    item = TreeItemList_Nth(&items, k);
3059		    if (item == ITEM_ALL) {
3060			allD = TRUE;
3061			break;
3062		    }
3063		    for (j = 0; j < TreeItemList_Count(&itemD); j++) {
3064			if (TreeItemList_Nth(&itemD, j) == item)
3065			    break;
3066		    }
3067		    if (j == TreeItemList_Count(&itemD)) {
3068			TreeItemList_Append(&itemD, item);
3069		    }
3070		}
3071		TreeItemList_Free(&items);
3072		if (allD) break;
3073	    }
3074
3075	    /* Select all */
3076	    if (allS) {
3077		TreeItemList_Init(tree, &newS, tree->itemCount - tree->selectCount);
3078#ifdef SELECTION_VISIBLE
3079		item = tree->root;
3080		if (!TreeItem_ReallyVisible(tree, item))
3081		    item = TreeItem_NextVisible(tree, item);
3082		while (item != NULL) {
3083		    if (!TreeItem_GetSelected(tree, item) &&
3084			    TreeItem_GetEnabled(tree, item)) {
3085			TreeItemList_Append(&newS, item);
3086		    }
3087		    item = TreeItem_NextVisible(tree, item);
3088		}
3089#else
3090		/* Include detached items */
3091		hPtr = Tcl_FirstHashEntry(&tree->itemHash, &search);
3092		while (hPtr != NULL) {
3093		    item = (TreeItem) Tcl_GetHashValue(hPtr);
3094		    if (!TreeItem_GetSelected(tree, item) &&
3095			    TreeItem_GetEnabled(tree, item)) {
3096			TreeItemList_Append(&newS, item);
3097		    }
3098		    hPtr = Tcl_NextHashEntry(&search);
3099		}
3100#endif
3101		/* Ignore the deselect list. */
3102		goto modifyDONE;
3103	    }
3104
3105	    /* Select some */
3106	    if (objcS > 0) {
3107		TreeItemList_Init(tree, &newS, objcS);
3108		for (i = 0; i < TreeItemList_Count(&itemS); i++) {
3109		    item = TreeItemList_Nth(&itemS, i);
3110		    if (TreeItem_GetSelected(tree, item))
3111			continue;
3112		    if (!TreeItem_GetEnabled(tree, item))
3113			continue;
3114#ifdef SELECTION_VISIBLE
3115		    if (!TreeItem_ReallyVisible(tree, item))
3116			continue;
3117#endif
3118		    TreeItemList_Append(&newS, item);
3119		}
3120	    }
3121
3122	    /* Deselect all */
3123	    if (allD) {
3124		TreeItemList_Init(tree, &newD, tree->selectCount);
3125		hPtr = Tcl_FirstHashEntry(&tree->selection, &search);
3126		while (hPtr != NULL) {
3127		    item = (TreeItem) Tcl_GetHashKey(&tree->selection, hPtr);
3128		    /* Don't deselect an item in the select list */
3129		    for (j = 0; j < TreeItemList_Count(&itemS); j++) {
3130			if (item == TreeItemList_Nth(&itemS, j))
3131			    break;
3132		    }
3133		    if (j == TreeItemList_Count(&itemS)) {
3134			TreeItemList_Append(&newD, item);
3135		    }
3136		    hPtr = Tcl_NextHashEntry(&search);
3137		}
3138	    }
3139
3140	    /* Deselect some */
3141	    if ((objcD > 0) && !allD) {
3142		TreeItemList_Init(tree, &newD, objcD);
3143		for (i = 0; i < TreeItemList_Count(&itemD); i++) {
3144		    item = TreeItemList_Nth(&itemD, i);
3145		    if (!TreeItem_GetSelected(tree, item))
3146			continue;
3147		    /* Don't deselect an item in the select list */
3148		    for (j = 0; j < TreeItemList_Count(&itemS); j++) {
3149			if (item == TreeItemList_Nth(&itemS, j))
3150			    break;
3151		    }
3152		    if (j == TreeItemList_Count(&itemS)) {
3153			TreeItemList_Append(&newD, item);
3154		    }
3155		}
3156	    }
3157modifyDONE:
3158	    for (i = 0; i < TreeItemList_Count(&newS); i++)
3159		Tree_AddToSelection(tree, TreeItemList_Nth(&newS, i));
3160	    for (i = 0; i < TreeItemList_Count(&newD); i++)
3161		Tree_RemoveFromSelection(tree, TreeItemList_Nth(&newD, i));
3162	    if (TreeItemList_Count(&newS) || TreeItemList_Count(&newD)) {
3163		TreeNotify_Selection(tree, &newS, &newD);
3164	    }
3165	    TreeItemList_Free(&newS);
3166	    TreeItemList_Free(&itemS);
3167	    TreeItemList_Free(&newD);
3168	    TreeItemList_Free(&itemD);
3169	    break;
3170	}
3171    }
3172
3173    return TCL_OK;
3174}
3175
3176/*
3177 *--------------------------------------------------------------
3178 *
3179 * A_XviewCmd --
3180 *
3181 *	This procedure is invoked to process the "xview" option for
3182 *	the widget command for a TreeCtrl. See the user documentation
3183 *	for details on what it does.
3184 *
3185 *	NOTE: This procedure is called when the -xscrollincrement option
3186 *	is specified.
3187 *
3188 * Results:
3189 *	A standard Tcl result.
3190 *
3191 * Side effects:
3192 *	See the user documentation.
3193 *
3194 *--------------------------------------------------------------
3195 */
3196
3197static int
3198A_XviewCmd(
3199    TreeCtrl *tree,		/* Widget info. */
3200    int objc,			/* Number of arguments. */
3201    Tcl_Obj *CONST objv[]	/* Argument values. */
3202    )
3203{
3204    Tcl_Interp *interp = tree->interp;
3205
3206    if (objc == 2) {
3207	double fractions[2];
3208
3209	Tree_GetScrollFractionsX(tree, fractions);
3210	FormatResult(interp, "%g %g", fractions[0], fractions[1]);
3211    } else {
3212	int count, index = 0, indexMax, offset, type;
3213	double fraction;
3214	int visWidth = Tree_ContentWidth(tree);
3215	int totWidth = Tree_TotalWidth(tree);
3216	int xIncr = tree->xScrollIncrement;
3217
3218	if (visWidth < 0)
3219	    visWidth = 0;
3220	if (totWidth <= visWidth)
3221	    return TCL_OK;
3222
3223	if (visWidth > 1) {
3224	    /* Find incrementLeft when scrolled to extreme right */
3225	    indexMax = Increment_FindX(tree, totWidth - visWidth);
3226	    offset = Increment_ToOffsetX(tree, indexMax);
3227	    if (offset < totWidth - visWidth) {
3228		indexMax++;
3229		offset = Increment_ToOffsetX(tree, indexMax);
3230	    }
3231
3232	    /* Add some fake content to right */
3233	    if (offset + visWidth > totWidth)
3234		totWidth = offset + visWidth;
3235	} else {
3236	    indexMax = Increment_FindX(tree, totWidth);
3237	    visWidth = 1;
3238	}
3239
3240	type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count);
3241	switch (type) {
3242	    case TK_SCROLL_ERROR:
3243		return TCL_ERROR;
3244	    case TK_SCROLL_MOVETO:
3245		offset = (int) (fraction * totWidth + 0.5);
3246		index = Increment_FindX(tree, offset);
3247		break;
3248	    case TK_SCROLL_PAGES:
3249		offset = Tree_ContentLeft(tree) + tree->xOrigin;
3250		offset += (int) (count * visWidth * 0.9);
3251		index = Increment_FindX(tree, offset);
3252		if ((count > 0) && (index ==
3253			Increment_FindX(tree, Tree_ContentLeft(tree) + tree->xOrigin)))
3254		    index++;
3255		break;
3256	    case TK_SCROLL_UNITS:
3257		offset = Tree_ContentLeft(tree) + tree->xOrigin;
3258		index = offset / xIncr;
3259		index += count;
3260		break;
3261	}
3262
3263	/* Don't scroll too far left */
3264	if (index < 0)
3265	    index = 0;
3266
3267	/* Don't scroll too far right */
3268	if (index > indexMax)
3269	    index = indexMax;
3270
3271	offset = Increment_ToOffsetX(tree, index);
3272	if (offset - Tree_ContentLeft(tree) != tree->xOrigin) {
3273	    tree->xOrigin = offset - Tree_ContentLeft(tree);
3274	    Tree_EventuallyRedraw(tree);
3275	}
3276    }
3277    return TCL_OK;
3278}
3279
3280/*
3281 *--------------------------------------------------------------
3282 *
3283 * A_YviewCmd --
3284 *
3285 *	This procedure is invoked to process the "yview" option for
3286 *	the widget command for a TreeCtrl. See the user documentation
3287 *	for details on what it does.
3288 *
3289 *	NOTE: This procedure is called when the -yscrollincrement option
3290 *	is specified.
3291 *
3292 * Results:
3293 *	A standard Tcl result.
3294 *
3295 * Side effects:
3296 *	See the user documentation.
3297 *
3298 *--------------------------------------------------------------
3299 */
3300
3301static int
3302A_YviewCmd(
3303    TreeCtrl *tree,		/* Widget info. */
3304    int objc,			/* Number of arguments. */
3305    Tcl_Obj *CONST objv[]	/* Argument values. */
3306    )
3307{
3308    Tcl_Interp *interp = tree->interp;
3309
3310    if (objc == 2) {
3311	double fractions[2];
3312
3313	Tree_GetScrollFractionsY(tree, fractions);
3314	FormatResult(interp, "%g %g", fractions[0], fractions[1]);
3315    } else {
3316	int count, index = 0, indexMax, offset, type;
3317	double fraction;
3318	int visHeight = Tree_ContentHeight(tree);
3319	int totHeight = Tree_TotalHeight(tree);
3320	int yIncr = tree->yScrollIncrement;
3321
3322	if (visHeight < 0)
3323	    visHeight = 0;
3324	if (totHeight <= visHeight)
3325	    return TCL_OK;
3326
3327	if (visHeight > 1) {
3328	    /* Find incrementTop when scrolled to bottom */
3329	    indexMax = Increment_FindY(tree, totHeight - visHeight);
3330	    offset = Increment_ToOffsetY(tree, indexMax);
3331	    if (offset < totHeight - visHeight) {
3332		indexMax++;
3333		offset = Increment_ToOffsetY(tree, indexMax);
3334	    }
3335
3336	    /* Add some fake content to bottom */
3337	    if (offset + visHeight > totHeight)
3338		totHeight = offset + visHeight;
3339	} else {
3340	    indexMax = Increment_FindY(tree, totHeight);
3341	    visHeight = 1;
3342	}
3343
3344	type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count);
3345	switch (type) {
3346	    case TK_SCROLL_ERROR:
3347		return TCL_ERROR;
3348	    case TK_SCROLL_MOVETO:
3349		offset = (int) (fraction * totHeight + 0.5);
3350		index = Increment_FindY(tree, offset);
3351		break;
3352	    case TK_SCROLL_PAGES:
3353		offset = Tree_ContentTop(tree) + tree->yOrigin;
3354		offset += (int) (count * visHeight * 0.9);
3355		index = Increment_FindY(tree, offset);
3356		if ((count > 0) && (index ==
3357			Increment_FindY(tree, Tree_ContentTop(tree) + tree->yOrigin)))
3358		    index++;
3359		break;
3360	    case TK_SCROLL_UNITS:
3361		offset = Tree_ContentTop(tree) + tree->yOrigin;
3362		index = offset / yIncr;
3363		index += count;
3364		break;
3365	}
3366
3367	/* Don't scroll too far up */
3368	if (index < 0)
3369	    index = 0;
3370
3371	/* Don't scroll too far down */
3372	if (index > indexMax)
3373	    index = indexMax;
3374
3375	offset = Increment_ToOffsetY(tree, index);
3376	if (offset - Tree_ContentTop(tree) != tree->yOrigin) {
3377	    tree->yOrigin = offset - Tree_ContentTop(tree);
3378	    Tree_EventuallyRedraw(tree);
3379	}
3380    }
3381    return TCL_OK;
3382}
3383
3384/*
3385 *--------------------------------------------------------------
3386 *
3387 * TreeXviewCmd --
3388 *
3389 *	This procedure is invoked to process the "xview" option for
3390 *	the widget command for a TreeCtrl. See the user documentation
3391 *	for details on what it does.
3392 *
3393 * Results:
3394 *	A standard Tcl result.
3395 *
3396 * Side effects:
3397 *	See the user documentation.
3398 *
3399 *--------------------------------------------------------------
3400 */
3401
3402static int
3403TreeXviewCmd(
3404    Tcl_Interp *interp,		/* Current interpreter. */
3405    TreeCtrl *tree,		/* Widget info. */
3406    int objc,			/* Number of arguments. */
3407    Tcl_Obj *CONST objv[]	/* Argument values. */
3408    )
3409{
3410    if (tree->xScrollIncrement <= 0)
3411	return B_XviewCmd(tree, objc, objv);
3412    return A_XviewCmd(tree, objc, objv);
3413}
3414
3415/*
3416 *--------------------------------------------------------------
3417 *
3418 * TreeYviewCmd --
3419 *
3420 *	This procedure is invoked to process the "yview" option for
3421 *	the widget command for a TreeCtrl. See the user documentation
3422 *	for details on what it does.
3423 *
3424 * Results:
3425 *	A standard Tcl result.
3426 *
3427 * Side effects:
3428 *	See the user documentation.
3429 *
3430 *--------------------------------------------------------------
3431 */
3432
3433static int
3434TreeYviewCmd(
3435    Tcl_Interp *interp,		/* Current interpreter. */
3436    TreeCtrl *tree,		/* Widget info. */
3437    int objc,			/* Number of arguments. */
3438    Tcl_Obj *CONST objv[]	/* Argument values. */
3439    )
3440{
3441    if (tree->yScrollIncrement <= 0)
3442	return B_YviewCmd(tree, objc, objv);
3443    return A_YviewCmd(tree, objc, objv);
3444}
3445
3446void
3447Tree_Debug(
3448    TreeCtrl *tree		/* Widget info. */
3449    )
3450{
3451    if (TreeItem_Debug(tree, tree->root) != TCL_OK) {
3452	dbwin("Tree_Debug: %s\n", Tcl_GetStringResult(tree->interp));
3453	Tcl_BackgroundError(tree->interp);
3454    }
3455}
3456
3457/*
3458 *--------------------------------------------------------------
3459 *
3460 * TreeDebugCmd --
3461 *
3462 *	This procedure is invoked to process the [debug] widget
3463 *	command.  See the user documentation for details on what
3464 *	it does.
3465 *
3466 * Results:
3467 *	A standard Tcl result.
3468 *
3469 * Side effects:
3470 *	See the user documentation.
3471 *
3472 *--------------------------------------------------------------
3473 */
3474
3475static int
3476TreeDebugCmd(
3477    ClientData clientData,	/* Widget info. */
3478    Tcl_Interp *interp,		/* Current interpreter. */
3479    int objc,			/* Number of arguments. */
3480    Tcl_Obj *CONST objv[]	/* Argument values. */
3481    )
3482{
3483    TreeCtrl *tree = clientData;
3484    static CONST char *commandNames[] = {
3485	"alloc", "cget", "configure", "dinfo", "expose", "scroll", (char *) NULL
3486    };
3487    enum { COMMAND_ALLOC, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DINFO,
3488	COMMAND_EXPOSE, COMMAND_SCROLL };
3489    int index;
3490
3491    if (objc < 3) {
3492	Tcl_WrongNumArgs(interp, 2, objv, "command ?arg arg ...?");
3493	return TCL_ERROR;
3494    }
3495
3496    if (Tcl_GetIndexFromObj(interp, objv[2], commandNames, "command", 0,
3497	    &index) != TCL_OK) {
3498	return TCL_ERROR;
3499    }
3500
3501    switch (index) {
3502	/* T debug alloc */
3503	case COMMAND_ALLOC: {
3504#ifdef ALLOC_HAX
3505#ifdef TREECTRL_DEBUG
3506	    TreeAlloc_Stats(interp, tree->allocData);
3507#else
3508	    FormatResult(interp, "TREECTRL_DEBUG is not defined");
3509#endif
3510#else
3511	    FormatResult(interp, "ALLOC_HAX is not defined");
3512#endif
3513	    break;
3514	}
3515
3516	/* T debug cget option */
3517	case COMMAND_CGET: {
3518	    Tcl_Obj *resultObjPtr;
3519
3520	    if (objc != 4) {
3521		Tcl_WrongNumArgs(interp, 3, objv, "option");
3522		return TCL_ERROR;
3523	    }
3524	    resultObjPtr = Tk_GetOptionValue(interp, (char *) tree,
3525		    tree->debug.optionTable, objv[3], tree->tkwin);
3526	    if (resultObjPtr == NULL)
3527		return TCL_ERROR;
3528	    Tcl_SetObjResult(interp, resultObjPtr);
3529	    break;
3530	}
3531
3532	/* T debug configure ?option? ?value? ?option value ...? */
3533	case COMMAND_CONFIGURE: {
3534	    Tcl_Obj *resultObjPtr;
3535	    Tk_SavedOptions savedOptions;
3536	    int mask, result;
3537
3538	    if (objc < 3) {
3539		Tcl_WrongNumArgs(interp, 3, objv, "?option? ?value?");
3540		return TCL_ERROR;
3541	    }
3542	    if (objc <= 4) {
3543		resultObjPtr = Tk_GetOptionInfo(interp, (char *) tree,
3544			tree->debug.optionTable,
3545			(objc == 3) ? (Tcl_Obj *) NULL : objv[3],
3546			tree->tkwin);
3547		if (resultObjPtr == NULL)
3548		    return TCL_ERROR;
3549		Tcl_SetObjResult(interp, resultObjPtr);
3550		break;
3551	    }
3552	    result = Tk_SetOptions(interp, (char *) tree,
3553		    tree->debug.optionTable, objc - 3, objv + 3, tree->tkwin,
3554		    &savedOptions, &mask);
3555	    if (result != TCL_OK) {
3556		Tk_RestoreSavedOptions(&savedOptions);
3557		return TCL_ERROR;
3558	    }
3559	    Tk_FreeSavedOptions(&savedOptions);
3560	    if (tree->debug.eraseColor != NULL) {
3561		tree->debug.gcErase = Tk_GCForColor(tree->debug.eraseColor,
3562			Tk_WindowId(tree->tkwin));
3563	    }
3564	    if (tree->debug.drawColor != NULL) {
3565		tree->debug.gcDraw = Tk_GCForColor(tree->debug.drawColor,
3566			Tk_WindowId(tree->tkwin));
3567	    }
3568	    break;
3569	}
3570
3571	case COMMAND_DINFO: {
3572	    return Tree_DumpDInfo(tree, objc, objv);
3573	}
3574
3575	/* T debug expose x1 y1 x2 y2 */
3576	case COMMAND_EXPOSE: {
3577	    int x1, y1, x2, y2;
3578
3579	    if (objc != 7) {
3580		Tcl_WrongNumArgs(interp, 3, objv, "x1 y1 x2 y2");
3581		return TCL_ERROR;
3582	    }
3583	    if (Tcl_GetIntFromObj(interp, objv[3], &x1) != TCL_OK)
3584		return TCL_ERROR;
3585	    if (Tcl_GetIntFromObj(interp, objv[4], &y1) != TCL_OK)
3586		return TCL_ERROR;
3587	    if (Tcl_GetIntFromObj(interp, objv[5], &x2) != TCL_OK)
3588		return TCL_ERROR;
3589	    if (Tcl_GetIntFromObj(interp, objv[6], &y2) != TCL_OK)
3590		return TCL_ERROR;
3591	    Tree_RedrawArea(tree, MIN(x1, x2), MIN(y1, y2),
3592		    MAX(x1, x2), MAX(y1, y2));
3593	    break;
3594	}
3595
3596	case COMMAND_SCROLL: {
3597	    int visHeight = Tree_ContentHeight(tree);
3598	    int totHeight = Tree_TotalHeight(tree);
3599	    int yIncr = tree->yScrollIncrement;
3600	    if (yIncr <= 0)
3601		yIncr = tree->itemHeight;
3602	    if (yIncr <= 0)
3603		yIncr = 1;
3604	    FormatResult(interp, "visHeight %d totHeight %d visHeight %% yIncr %d totHeight %% yIncr %d",
3605		    visHeight,
3606		    totHeight,
3607		    visHeight % yIncr,
3608		    totHeight % yIncr
3609		);
3610	    break;
3611	}
3612    }
3613
3614    return TCL_OK;
3615}
3616
3617/*
3618 *--------------------------------------------------------------
3619 *
3620 * Tree_PreserveItems --
3621 *
3622 *	Increment tree->preserveItemRefCnt.
3623 *
3624 * Results:
3625 *	None.
3626 *
3627 * Side effects:
3628 *	None.
3629 *
3630 *--------------------------------------------------------------
3631 */
3632
3633void
3634Tree_PreserveItems(
3635    TreeCtrl *tree
3636    )
3637{
3638    tree->preserveItemRefCnt++;
3639}
3640
3641/*
3642 *--------------------------------------------------------------
3643 *
3644 * Tree_ReleaseItems --
3645 *
3646 *	Decrement tree->preserveItemRefCnt. If it reaches zero,
3647 *	release the storage of items marked as deleted.
3648 *
3649 * Results:
3650 *	None.
3651 *
3652 * Side effects:
3653 *	None.
3654 *
3655 *--------------------------------------------------------------
3656 */
3657
3658void
3659Tree_ReleaseItems(
3660    TreeCtrl *tree
3661    )
3662{
3663    int i, count;
3664    TreeItem item;
3665
3666    if (tree->preserveItemRefCnt == 0)
3667	panic("mismatched calls to Tree_PreserveItems/Tree_ReleaseItems");
3668
3669    if (--tree->preserveItemRefCnt > 0)
3670	return;
3671
3672    count = TreeItemList_Count(&tree->preserveItemList);
3673    for (i = 0; i < count; i++) {
3674	item = TreeItemList_Nth(&tree->preserveItemList, i);
3675	TreeItem_Release(tree, item);
3676    }
3677
3678    TreeItemList_Free(&tree->preserveItemList);
3679}
3680
3681/*
3682 *--------------------------------------------------------------
3683 *
3684 * TextLayoutCmd --
3685 *
3686 *	This procedure is invoked to process the [textlayout] Tcl
3687 *	command. The command is used by the library scripts to place
3688 *	the text-edit Entry or Text widget.
3689 *
3690 * Results:
3691 *	A standard Tcl result.
3692 *
3693 * Side effects:
3694 *	None.
3695 *
3696 *--------------------------------------------------------------
3697 */
3698
3699/*
3700textlayout $font $text
3701	-width pixels
3702	-wrap word|char
3703	-justify left|center|right
3704	-ignoretabs boolean
3705	-ignorenewlines boolean
3706*/
3707static int
3708TextLayoutCmd(
3709    ClientData clientData,	/* Not used. */
3710    Tcl_Interp *interp,		/* Current interpreter. */
3711    int objc,			/* Number of arguments. */
3712    Tcl_Obj *CONST objv[]	/* Argument values. */
3713    )
3714{
3715    Tk_Font tkfont;
3716    Tk_Window tkwin = Tk_MainWindow(interp);
3717    char *text;
3718    int flags = 0;
3719    Tk_Justify justify = TK_JUSTIFY_LEFT;
3720    Tk_TextLayout layout;
3721    int width = 0, height;
3722    int result = TCL_OK;
3723    int i;
3724
3725    if (objc < 3) {
3726	Tcl_WrongNumArgs(interp, 1, objv, "font text ?options ...?");
3727	return TCL_ERROR;
3728    }
3729
3730    tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[1]);
3731    if (tkfont == NULL)
3732	return TCL_ERROR;
3733    text = Tcl_GetString(objv[2]);
3734
3735    for (i = 3; i < objc; i += 2) {
3736	static CONST char *optionNames[] = {
3737	    "-ignoretabs", "-ignorenewlines",
3738	    "-justify", "-width", (char *) NULL
3739	};
3740	enum { OPT_IGNORETABS, OPT_IGNORENEWLINES, OPT_JUSTIFY, OPT_WIDTH };
3741	int index;
3742
3743	if (Tcl_GetIndexFromObj(interp, objv[i], optionNames, "option", 0,
3744		&index) != TCL_OK) {
3745	    result = TCL_ERROR;
3746	    goto done;
3747	}
3748
3749	if (i + 1 == objc) {
3750	    FormatResult(interp, "missing value for \"%s\" option",
3751		    optionNames[index]);
3752	    goto done;
3753	}
3754
3755	switch (index) {
3756	    case OPT_IGNORENEWLINES: {
3757		int v;
3758		if (Tcl_GetBooleanFromObj(interp, objv[i + 1], &v) != TCL_OK) {
3759		    result = TCL_ERROR;
3760		    goto done;
3761		}
3762		if (v)
3763		    flags |= TK_IGNORE_NEWLINES;
3764		else
3765		    flags &= ~TK_IGNORE_NEWLINES;
3766		break;
3767	    }
3768	    case OPT_IGNORETABS: {
3769		int v;
3770		if (Tcl_GetBooleanFromObj(interp, objv[i + 1], &v) != TCL_OK) {
3771		    result = TCL_ERROR;
3772		    goto done;
3773		}
3774		if (v)
3775		    flags |= TK_IGNORE_TABS;
3776		else
3777		    flags &= ~TK_IGNORE_TABS;
3778		break;
3779	    }
3780	    case OPT_JUSTIFY: {
3781		if (Tk_GetJustifyFromObj(interp, objv[i + 1], &justify) != TCL_OK) {
3782		    result = TCL_ERROR;
3783		    goto done;
3784		}
3785		break;
3786	    }
3787	    case OPT_WIDTH: {
3788		if (Tk_GetPixelsFromObj(interp, tkwin, objv[i + 1], &width) != TCL_OK) {
3789		    result = TCL_ERROR;
3790		    goto done;
3791		}
3792		break;
3793	    }
3794	}
3795    }
3796
3797    layout = Tk_ComputeTextLayout(tkfont, text, -1, width, justify, flags,
3798	    &width, &height);
3799    FormatResult(interp, "%d %d", width, height);
3800    Tk_FreeTextLayout(layout);
3801
3802done:
3803    Tk_FreeFont(tkfont);
3804    return result;
3805}
3806
3807/*
3808 *--------------------------------------------------------------
3809 *
3810 * ImageTintCmd --
3811 *
3812 *	This procedure is invoked to process the [imagetint] Tcl
3813 *	command. The command may be used to apply a highlight to an
3814 *	existing photo image. It is used by the demos to produce a
3815 *	selected version of an image.
3816 *
3817 * Results:
3818 *	A standard Tcl result.
3819 *
3820 * Side effects:
3821 *	A photo image is modified.
3822 *
3823 *--------------------------------------------------------------
3824 */
3825
3826static int
3827ImageTintCmd(
3828    ClientData clientData,	/* Not used. */
3829    Tcl_Interp *interp,		/* Current interpreter. */
3830    int objc,			/* Number of arguments. */
3831    Tcl_Obj *CONST objv[]	/* Argument values. */
3832    )
3833{
3834    char *imageName;
3835    Tk_PhotoHandle photoH;
3836    Tk_PhotoImageBlock photoBlock;
3837    XColor *xColor;
3838    unsigned char *pixelPtr, *photoPix;
3839    int x, y, alpha, imgW, imgH, pitch;
3840
3841    if (objc != 4) {
3842	Tcl_WrongNumArgs(interp, 1, objv, "imageName color alpha");
3843	return TCL_ERROR;
3844    }
3845
3846    imageName = Tcl_GetStringFromObj(objv[1], NULL);
3847    photoH = Tk_FindPhoto(interp, imageName);
3848    if (photoH == NULL) {
3849	Tcl_AppendResult(interp, "image \"", imageName,
3850		"\" doesn't exist or is not a photo image",
3851		(char *) NULL);
3852	return TCL_ERROR;
3853    }
3854
3855    xColor = Tk_AllocColorFromObj(interp, Tk_MainWindow(interp), objv[2]);
3856    if (xColor == NULL)
3857	return TCL_ERROR;
3858
3859    if (Tcl_GetIntFromObj(interp, objv[3], &alpha) != TCL_OK)
3860	return TCL_ERROR;
3861    if (alpha < 0)
3862	alpha = 0;
3863    if (alpha > 255)
3864	alpha = 255;
3865
3866    Tk_PhotoGetImage(photoH, &photoBlock);
3867    photoPix = photoBlock.pixelPtr;
3868    imgW = photoBlock.width;
3869    imgH = photoBlock.height;
3870    pitch = photoBlock.pitch;
3871
3872    pixelPtr = (unsigned char *) Tcl_Alloc(imgW * 4);
3873    photoBlock.pixelPtr = pixelPtr;
3874    photoBlock.width = imgW;
3875    photoBlock.height = 1;
3876    photoBlock.pitch = imgW * 4;
3877    photoBlock.pixelSize = 4;
3878    photoBlock.offset[0] = 0;
3879    photoBlock.offset[1] = 1;
3880    photoBlock.offset[2] = 2;
3881    photoBlock.offset[3] = 3;
3882
3883    for (x = 0; x < imgW; x++) {
3884	pixelPtr[x*4 + 0] = UCHAR(((double) xColor->red / USHRT_MAX) * 255);
3885	pixelPtr[x*4 + 1] = UCHAR(((double) xColor->green / USHRT_MAX) * 255);
3886	pixelPtr[x*4 + 2] = UCHAR(((double) xColor->blue / USHRT_MAX) * 255);
3887    }
3888    for (y = 0; y < imgH; y++) {
3889	for (x = 0; x < imgW; x++) {
3890	    if (photoPix[x * 4 + 3]) {
3891		pixelPtr[x * 4 + 3] = alpha;
3892	    } else {
3893		pixelPtr[x * 4 + 3] = 0;
3894	    }
3895	}
3896	TK_PHOTOPUTBLOCK(interp, photoH, &photoBlock, 0, y,
3897		imgW, 1, TK_PHOTO_COMPOSITE_OVERLAY);
3898	photoPix += pitch;
3899    }
3900    Tcl_Free((char *) photoBlock.pixelPtr);
3901
3902    return TCL_OK;
3903}
3904
3905/*
3906 *--------------------------------------------------------------
3907 *
3908 * LoupeCmd --
3909 *
3910 *	This procedure is invoked to process the [loupe] Tcl
3911 *	command. The command is used to perform a screen grab on the
3912 *	root window and place a magnified version of the screen grab
3913 *	into an existing photo image. The command is used to check those
3914 *	dotted lines and make sure they line up properly.
3915 *
3916 * Results:
3917 *	A standard Tcl result.
3918 *
3919 * Side effects:
3920 *	A photo image is modified.
3921 *
3922 *--------------------------------------------------------------
3923 */
3924
3925static int
3926LoupeCmd(
3927    ClientData clientData,	/* Not used. */
3928    Tcl_Interp *interp,		/* Current interpreter. */
3929    int objc,			/* Number of arguments. */
3930    Tcl_Obj *CONST objv[]	/* Argument values. */
3931    )
3932{
3933    Tk_Window tkwin = Tk_MainWindow(interp);
3934    Display *display = Tk_Display(tkwin);
3935    int screenNum = Tk_ScreenNumber(tkwin);
3936    int displayW = DisplayWidth(display, screenNum);
3937    int displayH = DisplayHeight(display, screenNum);
3938    char *imageName;
3939    Tk_PhotoHandle photoH;
3940    Tk_PhotoImageBlock photoBlock;
3941    unsigned char *pixelPtr;
3942    int x, y, w, h, zoom;
3943    int grabX, grabY, grabW, grabH;
3944    int minx = 0, miny = 0;
3945#ifdef WIN32
3946    int xx, yy;
3947    HWND hwnd;
3948    HDC hdc;
3949#define WIN7
3950#ifdef WIN7
3951    HDC hdcCopy;
3952    HBITMAP hBitmap, hBitmapSave;
3953#endif /* WIN7 */
3954#elif defined(MAC_OSX_TK)
3955#else
3956    Visual *visual = Tk_Visual(tkwin);
3957    Window rootWindow = RootWindow(display, screenNum);
3958    XImage *ximage;
3959    XColor *xcolors;
3960    unsigned long red_shift, green_shift, blue_shift;
3961    int i, ncolors;
3962    int separated = 0;
3963#endif
3964
3965    /*
3966     * x && y are points on screen to snap from
3967     * w && h are size of image to grab (default to image size)
3968     * zoom is the integer zoom factor to grab
3969     */
3970    if ((objc != 4) && (objc != 6) && (objc != 7)) {
3971	Tcl_WrongNumArgs(interp, 1, objv, "imageName x y ?w h? ?zoom?");
3972	return TCL_ERROR;
3973    }
3974
3975    imageName = Tcl_GetStringFromObj(objv[1], NULL);
3976    photoH = Tk_FindPhoto(interp, imageName);
3977    if (photoH == NULL) {
3978	Tcl_AppendResult(interp, "image \"", imageName,
3979		"\" doesn't exist or is not a photo image",
3980		(char *) NULL);
3981	return TCL_ERROR;
3982    }
3983
3984    if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
3985	    || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
3986	return TCL_ERROR;
3987    }
3988    if (objc >= 6) {
3989	if ((Tcl_GetIntFromObj(interp, objv[4], &w) != TCL_OK)
3990		|| (Tcl_GetIntFromObj(interp, objv[5], &h) != TCL_OK)) {
3991	    return TCL_ERROR;
3992	}
3993    } else {
3994	/*
3995	 * Get dimensions from image
3996	 */
3997	Tk_PhotoGetSize(photoH, &w, &h);
3998    }
3999    if (objc == 7) {
4000	if (Tcl_GetIntFromObj(interp, objv[6], &zoom) != TCL_OK) {
4001	    return TCL_ERROR;
4002	}
4003    } else {
4004	zoom = 1;
4005    }
4006
4007#ifdef WIN32
4008    /*
4009     * Windows multiple monitors can have negative coords
4010     */
4011    minx = GetSystemMetrics(SM_XVIRTUALSCREEN);
4012    miny = GetSystemMetrics(SM_YVIRTUALSCREEN);
4013    displayW = GetSystemMetrics(SM_CXVIRTUALSCREEN);
4014    displayH = GetSystemMetrics(SM_CYVIRTUALSCREEN);
4015#elif defined(MAC_OSX_TK)
4016    /*
4017     * OS X multiple monitors can have negative coords
4018     * FIX: must be implemented
4019     * Probably with CGDisplayPixelsWide & CGDisplayPixelsHigh,
4020     * may need to iterate existing displays
4021     */
4022#else
4023    /*
4024     * Does X11 allow for negative screen coords?
4025     */
4026#endif
4027    grabX = x - (w / zoom / 2);
4028    grabY = y - (h / zoom / 2);
4029    grabW = w / zoom;
4030    grabH = h / zoom;
4031    if (grabW > displayW)		grabW = displayW;
4032    if (grabH > displayH)		grabH = displayH;
4033    if (grabX < minx)			grabX = minx;
4034    if (grabY < miny)			grabY = miny;
4035    if (grabX + grabW > displayW)	grabX = displayW - grabW;
4036    if (grabY + grabH > displayH)	grabY = displayH - grabH;
4037
4038    if ((grabW <= 0) || (grabH <= 0)) {
4039	return TCL_OK;
4040    }
4041
4042#ifdef WIN32
4043    hwnd = GetDesktopWindow();
4044    hdc = GetWindowDC(hwnd);
4045
4046#ifdef WIN7
4047    /* Doing GetPixel() on the desktop DC under Windows 7 (Aero) is buggy
4048     * and *very* slow.  So BitBlt() from the desktop DC to an in-memory
4049     * bitmap and run GetPixel() on that. */
4050    hdcCopy = CreateCompatibleDC(hdc);
4051    hBitmap = CreateCompatibleBitmap(hdc, grabW, grabH);
4052    hBitmapSave = SelectObject(hdcCopy, hBitmap);
4053    BitBlt(hdcCopy, 0, 0, grabW, grabH, hdc, grabX, grabY,
4054	SRCCOPY | CAPTUREBLT);
4055#endif /* WIN7 */
4056
4057    /* XImage -> Tk_Image */
4058    pixelPtr = (unsigned char *) Tcl_Alloc(grabW * grabH * 4);
4059    memset(pixelPtr, 0, (grabW * grabH * 4));
4060    photoBlock.pixelPtr  = pixelPtr;
4061    photoBlock.width     = grabW;
4062    photoBlock.height    = grabH;
4063    photoBlock.pitch     = grabW * 4;
4064    photoBlock.pixelSize = 4;
4065    photoBlock.offset[0] = 0;
4066    photoBlock.offset[1] = 1;
4067    photoBlock.offset[2] = 2;
4068    photoBlock.offset[3] = 3;
4069
4070    /*
4071     * We could do a BitBlt for bulk copying, but then we'd have to
4072     * do screen size consistency checks and possibly pixel conversion.
4073     */
4074    for (yy = 0; yy < grabH; yy++) {
4075	COLORREF pixel;
4076	unsigned long stepDest = yy * photoBlock.pitch;
4077	for (xx = 0; xx < grabW; xx++) {
4078#ifdef WIN7
4079	    pixel = GetPixel(hdcCopy, xx, yy);
4080#else /* WIN7 */
4081	    pixel = GetPixel(hdc, grabX + xx, grabY + yy);
4082#endif /* WIN7 */
4083	    if (pixel == CLR_INVALID) {
4084		/*
4085		 * Skip just this pixel, as others will be valid depending on
4086		 * what corner we are in.
4087		 */
4088		continue;
4089	    }
4090	    pixelPtr[stepDest + xx * 4 + 0] = GetRValue(pixel);
4091	    pixelPtr[stepDest + xx * 4 + 1] = GetGValue(pixel);
4092	    pixelPtr[stepDest + xx * 4 + 2] = GetBValue(pixel);
4093	    pixelPtr[stepDest + xx * 4 + 3] = 255;
4094	}
4095    }
4096#ifdef WIN7
4097    SelectObject(hdcCopy, hBitmapSave);
4098    DeleteObject(hBitmap);
4099    DeleteDC(hdcCopy);
4100#endif /* WIN7 */
4101    ReleaseDC(hwnd, hdc);
4102#elif defined(MAC_OSX_TK)
4103    /*
4104     * Adapted from John Anon's ScreenController demo code.
4105     */
4106    {
4107    int xx, yy;
4108    unsigned char *screenBytes;
4109    int bPerPixel, byPerRow, byPerPixel;
4110
4111    /* Gets all the screen info: */
4112    CGDisplayHideCursor(kCGDirectMainDisplay);
4113    bPerPixel  = CGDisplayBitsPerPixel(kCGDirectMainDisplay);
4114    byPerRow   = CGDisplayBytesPerRow(kCGDirectMainDisplay);
4115    byPerPixel = bPerPixel / 8;
4116
4117    screenBytes = (unsigned char *)CGDisplayBaseAddress(kCGDirectMainDisplay);
4118
4119    pixelPtr = (unsigned char *) Tcl_Alloc(grabW * grabH * 4);
4120    memset(pixelPtr, 0, (grabW * grabH * 4));
4121
4122    photoBlock.pixelPtr  = pixelPtr;
4123    photoBlock.width     = grabW;
4124    photoBlock.height    = grabH;
4125    photoBlock.pitch     = grabW * 4;
4126    photoBlock.pixelSize = 4;
4127    photoBlock.offset[0] = 0;
4128    photoBlock.offset[1] = 1;
4129    photoBlock.offset[2] = 2;
4130    photoBlock.offset[3] = 3;
4131
4132    for (yy = 0; yy < grabH; yy++) {
4133	unsigned long newPixel = 0;
4134	unsigned long stepSrc = (grabY + yy) * byPerRow;
4135	unsigned long stepDest = yy * photoBlock.pitch;
4136
4137	for (xx = 0; xx < grabW; xx++) {
4138	    if (bPerPixel == 16) {
4139		unsigned short thisPixel;
4140
4141		thisPixel = *((unsigned short*)(screenBytes + stepSrc
4142				      + ((grabX + xx) * byPerPixel)));
4143#ifdef __BIG_ENDIAN__
4144		/* Transform from 0xARGB (1555) to 0xR0G0B0A0 (4444) */
4145		newPixel = (((thisPixel & 0x8000) >> 15) * 0xF8) | /* A */
4146		    ((thisPixel & 0x7C00) << 17) | /* R */
4147		    ((thisPixel & 0x03E0) << 14) | /* G */
4148		    ((thisPixel & 0x001F) << 11);  /* B */
4149#else
4150		/* Transform from 0xARGB (1555) to 0xB0G0R0A0 (4444) */
4151		newPixel = (((thisPixel & 0x8000) >> 15) * 0xF8) | /* A */
4152		    ((thisPixel & 0x7C00) << 11) | /* R */
4153		    ((thisPixel & 0x03E0) << 14) | /* G */
4154		    ((thisPixel & 0x001F) << 17);  /* B */
4155#endif
4156	    } else if (bPerPixel == 32) {
4157		unsigned long thisPixel;
4158
4159		thisPixel = *((unsigned long*)(screenBytes + stepSrc
4160				      + ((grabX + xx) * byPerPixel)));
4161
4162#ifdef __BIG_ENDIAN__
4163		/* Transformation is from 0xAARRGGBB to 0xRRGGBBAA */
4164		newPixel = ((thisPixel & 0xFF000000) >> 24) |
4165		    ((thisPixel & 0x00FFFFFF) << 8);
4166#else
4167		/* Transformation is from 0xAARRGGBB to 0xBBGGRRAA */
4168		newPixel = (thisPixel & 0xFF00FF00) |
4169		    ((thisPixel & 0x00FF0000) >> 16) |
4170		    ((thisPixel & 0x000000FF) << 16);
4171#endif
4172	    }
4173	    *((unsigned int *)(pixelPtr + stepDest + xx * 4)) = newPixel;
4174	}
4175    }
4176    CGDisplayShowCursor(kCGDirectMainDisplay);
4177    }
4178#else
4179    ximage = XGetImage(display, rootWindow,
4180	    grabX, grabY, grabW, grabH, AllPlanes, ZPixmap);
4181    if (ximage == NULL) {
4182	FormatResult(interp, "XGetImage() failed");
4183	return TCL_ERROR;
4184    }
4185
4186    /* See TkPostscriptImage */
4187
4188    ncolors = visual->map_entries;
4189    xcolors = (XColor *) ckalloc(sizeof(XColor) * ncolors);
4190
4191    if ((visual->class == DirectColor) || (visual->class == TrueColor)) {
4192	separated = 1;
4193	red_shift = green_shift = blue_shift = 0;
4194	while ((0x0001 & (ximage->red_mask >> red_shift)) == 0)
4195	    red_shift++;
4196	while ((0x0001 & (ximage->green_mask >> green_shift)) == 0)
4197	    green_shift++;
4198	while ((0x0001 & (ximage->blue_mask >> blue_shift)) == 0)
4199	    blue_shift++;
4200	for (i = 0; i < ncolors; i++) {
4201	    xcolors[i].pixel =
4202		((i << red_shift) & ximage->red_mask) |
4203		((i << green_shift) & ximage->green_mask) |
4204		((i << blue_shift) & ximage->blue_mask);
4205	}
4206    } else {
4207	for (i = 0; i < ncolors; i++)
4208	    xcolors[i].pixel = i;
4209    	red_shift = green_shift = blue_shift = 0; /* compiler warning */
4210    }
4211
4212    XQueryColors(display, Tk_Colormap(tkwin), xcolors, ncolors);
4213
4214    /* XImage -> Tk_Image */
4215    pixelPtr = (unsigned char *) Tcl_Alloc(ximage->width * ximage->height * 4);
4216    photoBlock.pixelPtr  = pixelPtr;
4217    photoBlock.width     = ximage->width;
4218    photoBlock.height    = ximage->height;
4219    photoBlock.pitch     = ximage->width * 4;
4220    photoBlock.pixelSize = 4;
4221    photoBlock.offset[0] = 0;
4222    photoBlock.offset[1] = 1;
4223    photoBlock.offset[2] = 2;
4224    photoBlock.offset[3] = 3;
4225
4226    for (y = 0; y < ximage->height; y++) {
4227	for (x = 0; x < ximage->width; x++) {
4228	    int r, g, b;
4229	    unsigned long pixel;
4230
4231	    pixel = XGetPixel(ximage, x, y);
4232	    if (separated) {
4233		r = (pixel & ximage->red_mask) >> red_shift;
4234		g = (pixel & ximage->green_mask) >> green_shift;
4235		b = (pixel & ximage->blue_mask) >> blue_shift;
4236		r = ((double) xcolors[r].red / USHRT_MAX) * 255;
4237		g = ((double) xcolors[g].green / USHRT_MAX) * 255;
4238		b = ((double) xcolors[b].blue / USHRT_MAX) * 255;
4239	    } else {
4240		r = ((double) xcolors[pixel].red / USHRT_MAX) * 255;
4241		g = ((double) xcolors[pixel].green / USHRT_MAX) * 255;
4242		b = ((double) xcolors[pixel].blue / USHRT_MAX) * 255;
4243	    }
4244	    pixelPtr[y * photoBlock.pitch + x * 4 + 0] = r;
4245	    pixelPtr[y * photoBlock.pitch + x * 4 + 1] = g;
4246	    pixelPtr[y * photoBlock.pitch + x * 4 + 2] = b;
4247	    pixelPtr[y * photoBlock.pitch + x * 4 + 3] = 255;
4248	}
4249    }
4250#endif
4251
4252    TK_PHOTOPUTZOOMEDBLOCK(interp, photoH, &photoBlock, 0, 0, w, h,
4253	    zoom, zoom, 1, 1, TK_PHOTO_COMPOSITE_SET);
4254
4255    Tcl_Free((char *) pixelPtr);
4256#if !defined(WIN32) && !defined(MAC_OSX_TK)
4257    ckfree((char *) xcolors);
4258    XDestroyImage(ximage);
4259#endif
4260
4261    return TCL_OK;
4262}
4263
4264#ifndef USE_TTK
4265
4266/*
4267 *--------------------------------------------------------------
4268 *
4269 * RecomputeWidgets --
4270 *
4271 *	This procedure is called when the system theme changes on platforms
4272 *	that support theming. The worldChangedProc of all treectrl widgets
4273 *	is called to relayout and redisplay the widgets.
4274 *
4275 *	Taken from tkFont.c.
4276 *
4277 * Results:
4278 *	None.
4279 *
4280 * Side effects:
4281 *	All treectrl widgets will be redisplayed at idle time.
4282 *
4283 *--------------------------------------------------------------
4284 */
4285
4286static void
4287RecomputeWidgets(
4288    TkWindow *winPtr		/* Window info. */
4289    )
4290{
4291    Tk_ClassWorldChangedProc *proc;
4292
4293    /* Clomp! Stomp! All over the internals */
4294    proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc);
4295    if (proc == TreeWorldChanged) {
4296	TreeTheme_ThemeChanged((TreeCtrl *) winPtr->instanceData);
4297	TreeWorldChanged(winPtr->instanceData);
4298    }
4299
4300    for (winPtr = winPtr->childList; winPtr != NULL; winPtr = winPtr->nextPtr) {
4301	RecomputeWidgets(winPtr);
4302    }
4303}
4304
4305/*
4306 *--------------------------------------------------------------
4307 *
4308 * Tree_TheWorldHasChanged --
4309 *
4310 *	This procedure is called when the system theme changes on platforms
4311 *	that support theming. The worldChangedProc of all treectrl widgets
4312 *	is called to relayout and redisplay the widgets.
4313 *
4314 * Results:
4315 *	None.
4316 *
4317 * Side effects:
4318 *	All treectrl widgets will be redisplayed at idle time.
4319 *
4320 *--------------------------------------------------------------
4321 */
4322
4323void
4324Tree_TheWorldHasChanged(
4325    Tcl_Interp *interp		/* Current interpreter. */
4326    )
4327{
4328    /* Could send a <<ThemeChanged>> event to every window like Tile does. */
4329    /* Could keep a list of treectrl widgets. */
4330    TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp);
4331    RecomputeWidgets(winPtr);
4332}
4333
4334#endif /* !USE_TTK */
4335
4336/*
4337 * In order to find treectrl.tcl during initialization, the following script
4338 * is invoked.
4339 */
4340static char initScript[] = "if {![llength [info proc ::TreeCtrl::Init]]} {\n\
4341  namespace eval ::TreeCtrl {}\n\
4342  proc ::TreeCtrl::Init {} {\n\
4343    global treectrl_library\n\
4344    tcl_findLibrary treectrl " PACKAGE_PATCHLEVEL " " PACKAGE_PATCHLEVEL " treectrl.tcl TREECTRL_LIBRARY treectrl_library\n\
4345  }\n\
4346}\n\
4347::TreeCtrl::Init";
4348
4349/*
4350 *--------------------------------------------------------------
4351 *
4352 * Treectrl_Init --
4353 *
4354 *	This procedure initializes the TreeCtrl package and related
4355 *	commands.
4356 *
4357 * Results:
4358 *	A standard Tcl result.
4359 *
4360 * Side effects:
4361 *	Memory is allocated. New Tcl commands are created.
4362 *
4363 *--------------------------------------------------------------
4364 */
4365
4366DLLEXPORT int
4367Treectrl_Init(
4368    Tcl_Interp *interp		/* Interpreter the package is loading into. */
4369    )
4370{
4371#ifdef USE_TTK
4372    static CONST char *tcl_version = "8.5";
4373#else
4374    static CONST char *tcl_version = "8.4";
4375#endif
4376
4377#ifdef USE_TCL_STUBS
4378    if (Tcl_InitStubs(interp, tcl_version, 0) == NULL) {
4379	return TCL_ERROR;
4380    }
4381#endif
4382#ifdef USE_TK_STUBS
4383#if (TK_MAJOR_VERSION == 8) && (TK_MINOR_VERSION < 5)
4384    if (Tk_InitStubs(interp, (char*)tcl_version, 0) == NULL) {
4385#else
4386    if (Tk_InitStubs(interp, tcl_version, 0) == NULL) {
4387#endif
4388	return TCL_ERROR;
4389    }
4390#endif
4391
4392    dbwin_add_interp(interp);
4393
4394    PerStateCO_Init(optionSpecs, "-buttonbitmap", &pstBitmap, TreeStateFromObj);
4395    PerStateCO_Init(optionSpecs, "-buttonimage", &pstImage, TreeStateFromObj);
4396
4397    if (TreeElement_Init(interp) != TCL_OK) {
4398	return TCL_ERROR;
4399    }
4400
4401    /* We don't care if this fails. */
4402    (void) TreeTheme_InitInterp(interp);
4403
4404    if (TreeColumn_InitInterp(interp) != TCL_OK)
4405	return TCL_ERROR;
4406
4407    /* Hack for editing a text Element. */
4408    Tcl_CreateObjCommand(interp, "textlayout", TextLayoutCmd, NULL, NULL);
4409
4410    /* Hack for colorizing an image (like Win98 explorer). */
4411    Tcl_CreateObjCommand(interp, "imagetint", ImageTintCmd, NULL, NULL);
4412
4413    /* Screen magnifier to check those dotted lines. */
4414    Tcl_CreateObjCommand(interp, "loupe", LoupeCmd, NULL, NULL);
4415
4416    Tcl_CreateObjCommand(interp, "treectrl", TreeObjCmd, NULL, NULL);
4417
4418    if (Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_PATCHLEVEL) != TCL_OK) {
4419	return TCL_ERROR;
4420    }
4421    return Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL);
4422}
4423
4424/*
4425 *--------------------------------------------------------------
4426 *
4427 * Treectrl_SafeInit --
4428 *
4429 *	This procedure initializes the TreeCtrl package and related
4430 *	commands.
4431 *
4432 * Results:
4433 *	A standard Tcl result.
4434 *
4435 * Side effects:
4436 *	Memory is allocated. New Tcl commands are created.
4437 *
4438 *--------------------------------------------------------------
4439 */
4440
4441DLLEXPORT int
4442Treectrl_SafeInit(
4443    Tcl_Interp *interp		/* Interpreter the package is loading into. */
4444    )
4445{
4446    return Treectrl_Init(interp);
4447}
4448
4449