1/* $Id$
2 * Copyright (c) 2003, Joe English
3 *
4 * Core widget utilities.
5 */
6
7#include <string.h>
8#include <tk.h>
9#include "ttkTheme.h"
10#include "ttkWidget.h"
11
12#ifdef MAC_OSX_TK
13#define TK_NO_DOUBLE_BUFFERING 1
14#endif
15
16/*------------------------------------------------------------------------
17 * +++ Internal helper routines.
18 */
19
20/* UpdateLayout --
21 * 	Call the widget's get-layout hook to recompute corePtr->layout.
22 * 	Returns TCL_OK if successful, returns TCL_ERROR and leaves
23 * 	the layout unchanged otherwise.
24 */
25static int UpdateLayout(Tcl_Interp *interp, WidgetCore *corePtr)
26{
27    Ttk_Theme themePtr = Ttk_GetCurrentTheme(interp);
28    Ttk_Layout newLayout =
29    	corePtr->widgetSpec->getLayoutProc(interp, themePtr,corePtr);
30
31    if (newLayout) {
32	if (corePtr->layout) {
33	    Ttk_FreeLayout(corePtr->layout);
34	}
35	corePtr->layout = newLayout;
36	return TCL_OK;
37    }
38    return TCL_ERROR;
39}
40
41/* SizeChanged --
42 * 	Call the widget's sizeProc to compute new requested size
43 * 	and pass it to the geometry manager.
44 */
45static void SizeChanged(WidgetCore *corePtr)
46{
47    int reqWidth = 1, reqHeight = 1;
48
49    if (corePtr->widgetSpec->sizeProc(corePtr,&reqWidth,&reqHeight)) {
50	Tk_GeometryRequest(corePtr->tkwin, reqWidth, reqHeight);
51    }
52}
53
54#ifndef TK_NO_DOUBLE_BUFFERING
55
56/* BeginDrawing --
57 * 	Returns a Drawable for drawing the widget contents.
58 *	This is normally an off-screen Pixmap, copied to
59 *	the window by EndDrawing().
60 */
61static Drawable BeginDrawing(Tk_Window tkwin)
62{
63    return Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
64	    Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
65}
66
67/* EndDrawing --
68 *	Copy the drawable contents to the screen and release resources.
69 */
70static void EndDrawing(Tk_Window tkwin, Drawable d)
71{
72    XGCValues gcValues;
73    GC gc;
74
75    gcValues.function = GXcopy;
76    gcValues.graphics_exposures = False;
77    gc = Tk_GetGC(tkwin, GCFunction|GCGraphicsExposures, &gcValues);
78
79    XCopyArea(Tk_Display(tkwin), d, Tk_WindowId(tkwin), gc,
80	    0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
81	    0, 0);
82
83    Tk_FreePixmap(Tk_Display(tkwin), d);
84    Tk_FreeGC(Tk_Display(tkwin), gc);
85}
86#else
87/* No double-buffering: draw directly into the window. */
88static Drawable BeginDrawing(Tk_Window tkwin) { return Tk_WindowId(tkwin); }
89static void EndDrawing(Tk_Window tkwin, Drawable d) { }
90#endif
91
92/* DrawWidget --
93 *	Redraw a widget.  Called as an idle handler.
94 */
95static void DrawWidget(ClientData recordPtr)
96{
97    WidgetCore *corePtr = recordPtr;
98
99    corePtr->flags &= ~REDISPLAY_PENDING;
100    if (Tk_IsMapped(corePtr->tkwin)) {
101	Drawable d = BeginDrawing(corePtr->tkwin);
102	corePtr->widgetSpec->layoutProc(recordPtr);
103	corePtr->widgetSpec->displayProc(recordPtr, d);
104	EndDrawing(corePtr->tkwin, d);
105    }
106}
107
108/* TtkRedisplayWidget --
109 * 	Schedule redisplay as an idle handler.
110 */
111void TtkRedisplayWidget(WidgetCore *corePtr)
112{
113    if (corePtr->flags & WIDGET_DESTROYED) {
114	return;
115    }
116
117    if (!(corePtr->flags & REDISPLAY_PENDING)) {
118	Tcl_DoWhenIdle(DrawWidget, corePtr);
119	corePtr->flags |= REDISPLAY_PENDING;
120    }
121}
122
123/* TtkResizeWidget --
124 * 	Recompute widget size, schedule geometry propagation and redisplay.
125 */
126void TtkResizeWidget(WidgetCore *corePtr)
127{
128    if (corePtr->flags & WIDGET_DESTROYED) {
129	return;
130    }
131
132    SizeChanged(corePtr);
133    TtkRedisplayWidget(corePtr);
134}
135
136/* TtkWidgetChangeState --
137 * 	Set / clear the specified bits in the 'state' flag,
138 */
139void TtkWidgetChangeState(WidgetCore *corePtr,
140    unsigned int setBits, unsigned int clearBits)
141{
142    Ttk_State oldState = corePtr->state;
143    corePtr->state = (oldState & ~clearBits) | setBits;
144    if (corePtr->state ^ oldState) {
145	TtkRedisplayWidget(corePtr);
146    }
147}
148
149/* WidgetInstanceObjCmd --
150 *	Widget instance command implementation.
151 */
152static int
153WidgetInstanceObjCmd(
154    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
155{
156    WidgetCore *corePtr = clientData;
157    const Ttk_Ensemble *commands = corePtr->widgetSpec->commands;
158    int status;
159
160    Tcl_Preserve(clientData);
161    status = Ttk_InvokeEnsemble(commands,1, clientData,interp,objc,objv);
162    Tcl_Release(clientData);
163
164    return status;
165}
166
167/*------------------------------------------------------------------------
168 * +++ Widget destruction.
169 *
170 * A widget can be destroyed when the application explicitly
171 * destroys the window or one of its ancestors via [destroy]
172 * or Tk_DestroyWindow(); when the application deletes the widget
173 * instance command; when there is an error in the widget constructor;
174 * or when another application calls XDestroyWindow on the window ID.
175 *
176 * The window receives a <DestroyNotify> event in all cases,
177 * so we do the bulk of the cleanup there.  See [#2207435] for
178 * further notes (esp. re: Tk_FreeConfigOptions).
179 *
180 * Widget code that reenters the interp should only do so
181 * when the widtget is Tcl_Preserve()d, and should check
182 * the WIDGET_DESTROYED flag bit upon return.
183 */
184
185/* WidgetInstanceObjCmdDeleted --
186 * 	Widget instance command	deletion callback.
187 */
188static void
189WidgetInstanceObjCmdDeleted(ClientData clientData)
190{
191    WidgetCore *corePtr = clientData;
192    corePtr->widgetCmd = NULL;
193    if (corePtr->tkwin != NULL)
194	Tk_DestroyWindow(corePtr->tkwin);
195}
196
197/* FreeWidget --
198 *	 Final cleanup for widget; called via Tcl_EventuallyFree().
199 */
200static void
201FreeWidget(char *memPtr)
202{
203    ckfree(memPtr);
204}
205
206/* DestroyWidget --
207 * 	Main widget destructor; called from <DestroyNotify> event handler.
208 */
209static void
210DestroyWidget(WidgetCore *corePtr)
211{
212    corePtr->flags |= WIDGET_DESTROYED;
213
214    corePtr->widgetSpec->cleanupProc(corePtr);
215
216    Tk_FreeConfigOptions(
217	(ClientData)corePtr, corePtr->optionTable, corePtr->tkwin);
218
219    if (corePtr->layout) {
220	Ttk_FreeLayout(corePtr->layout);
221    }
222
223    if (corePtr->flags & REDISPLAY_PENDING) {
224	Tcl_CancelIdleCall(DrawWidget, corePtr);
225    }
226
227    corePtr->tkwin = NULL;
228    if (corePtr->widgetCmd) {
229	Tcl_Command cmd = corePtr->widgetCmd;
230	corePtr->widgetCmd = 0;
231	/* NB: this can reenter the interpreter via a command traces */
232	Tcl_DeleteCommandFromToken(corePtr->interp, cmd);
233    }
234    Tcl_EventuallyFree(corePtr, FreeWidget);
235}
236
237/*
238 * CoreEventProc --
239 *	Event handler for basic events.
240 *	Processes Expose, Configure, FocusIn/Out, and Destroy events.
241 *	Also handles <<ThemeChanged>> virtual events.
242 *
243 *	For Expose and Configure, simply schedule the widget for redisplay.
244 *	For Destroy events, handle the cleanup process.
245 *
246 *	For Focus events, set/clear the focus bit in the state field.
247 *	It turns out this is impossible to do correctly in a binding script,
248 *	because Tk filters out focus events with detail == NotifyInferior.
249 *
250 *	For Deactivate/Activate pseudo-events, set/clear the background state
251 *	flag.
252 */
253
254static const unsigned CoreEventMask
255    = ExposureMask
256    | StructureNotifyMask
257    | FocusChangeMask
258    | VirtualEventMask
259    | ActivateMask
260    | EnterWindowMask
261    | LeaveWindowMask
262    ;
263
264static void CoreEventProc(ClientData clientData, XEvent *eventPtr)
265{
266    WidgetCore *corePtr = clientData;
267
268    switch (eventPtr->type)
269    {
270	case ConfigureNotify :
271	    TtkRedisplayWidget(corePtr);
272	    break;
273	case Expose :
274	    if (eventPtr->xexpose.count == 0) {
275		TtkRedisplayWidget(corePtr);
276	    }
277	    break;
278	case DestroyNotify :
279	    Tk_DeleteEventHandler(
280		corePtr->tkwin, CoreEventMask,CoreEventProc,clientData);
281	    DestroyWidget(corePtr);
282	    break;
283	case FocusIn:
284	case FocusOut:
285	    /* Don't process "virtual crossing" events */
286	    if (   eventPtr->xfocus.detail == NotifyInferior
287		|| eventPtr->xfocus.detail == NotifyAncestor
288		|| eventPtr->xfocus.detail == NotifyNonlinear)
289	    {
290		if (eventPtr->type == FocusIn)
291		    corePtr->state |= TTK_STATE_FOCUS;
292		else
293		    corePtr->state &= ~TTK_STATE_FOCUS;
294		TtkRedisplayWidget(corePtr);
295	    }
296	    break;
297	case ActivateNotify:
298	    corePtr->state &= ~TTK_STATE_BACKGROUND;
299	    TtkRedisplayWidget(corePtr);
300	    break;
301	case DeactivateNotify:
302	    corePtr->state |= TTK_STATE_BACKGROUND;
303	    TtkRedisplayWidget(corePtr);
304	    break;
305	case LeaveNotify:
306	    corePtr->state &= ~TTK_STATE_HOVER;
307	    TtkRedisplayWidget(corePtr);
308	    break;
309	case EnterNotify:
310	    corePtr->state |= TTK_STATE_HOVER;
311	    TtkRedisplayWidget(corePtr);
312	    break;
313	case VirtualEvent:
314	    if (!strcmp("ThemeChanged", ((XVirtualEvent *)(eventPtr))->name)) {
315		(void)UpdateLayout(corePtr->interp, corePtr);
316		SizeChanged(corePtr);
317		TtkRedisplayWidget(corePtr);
318	    }
319	default:
320	    /* can't happen... */
321	    break;
322    }
323}
324
325/*
326 * WidgetWorldChanged --
327 * 	Default Tk_ClassWorldChangedProc() for widgets.
328 * 	Invoked whenever fonts or other system resources are changed;
329 * 	recomputes geometry.
330 */
331static void WidgetWorldChanged(ClientData clientData)
332{
333    WidgetCore *corePtr = clientData;
334    SizeChanged(corePtr);
335    TtkRedisplayWidget(corePtr);
336}
337
338static Tk_ClassProcs widgetClassProcs = {
339    sizeof(Tk_ClassProcs),	/* size */
340    WidgetWorldChanged,	/* worldChangedProc */
341    NULL,					/* createProc */
342    NULL					/* modalProc */
343};
344
345/*
346 * TtkWidgetConstructorObjCmd --
347 *	General-purpose widget constructor command implementation.
348 *	ClientData is a WidgetSpec *.
349 */
350int TtkWidgetConstructorObjCmd(
351    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
352{
353    WidgetSpec *widgetSpec = clientData;
354    const char *className = widgetSpec->className;
355    Tk_OptionTable optionTable =
356	Tk_CreateOptionTable(interp, widgetSpec->optionSpecs);
357    Tk_Window tkwin;
358    void *recordPtr;
359    WidgetCore *corePtr;
360    Tk_SavedOptions savedOptions;
361    int i;
362
363    if (objc < 2 || objc % 2 == 1) {
364	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
365	return TCL_ERROR;
366    }
367
368    /* Check if a -class option has been specified.
369     * We have to do this before the InitOptions() call,
370     * since InitOptions() is affected by the widget class.
371     */
372    for (i = 2; i < objc; i += 2) {
373	if (!strcmp(Tcl_GetString(objv[i]), "-class")) {
374	    className = Tcl_GetString(objv[i+1]);
375	    break;
376	}
377    }
378
379    tkwin = Tk_CreateWindowFromPath(
380	interp, Tk_MainWindow(interp), Tcl_GetString(objv[1]), NULL);
381    if (tkwin == NULL)
382	return TCL_ERROR;
383
384    /*
385     * Allocate and initialize the widget record.
386     */
387    recordPtr = ckalloc(widgetSpec->recordSize);
388    memset(recordPtr, 0, widgetSpec->recordSize);
389    corePtr = recordPtr;
390
391    corePtr->tkwin	= tkwin;
392    corePtr->interp 	= interp;
393    corePtr->widgetSpec	= widgetSpec;
394    corePtr->widgetCmd	= Tcl_CreateObjCommand(interp, Tk_PathName(tkwin),
395	WidgetInstanceObjCmd, recordPtr, WidgetInstanceObjCmdDeleted);
396    corePtr->optionTable = optionTable;
397    corePtr->layout	= NULL;
398    corePtr->flags 	= 0;
399    corePtr->state 	= 0;
400
401    Tk_SetClass(tkwin, className);
402    Tk_SetClassProcs(tkwin, &widgetClassProcs, recordPtr);
403    Tk_SetWindowBackgroundPixmap(tkwin, ParentRelative);
404
405    widgetSpec->initializeProc(interp, recordPtr);
406
407    Tk_CreateEventHandler(tkwin, CoreEventMask, CoreEventProc, recordPtr);
408
409    /*
410     * Initial configuration.
411     */
412
413    Tcl_Preserve(corePtr);
414    if (Tk_InitOptions(interp, recordPtr, optionTable, tkwin) != TCL_OK) {
415	goto error;
416    }
417
418    if (Tk_SetOptions(interp, recordPtr, optionTable,
419	    objc - 2, objv + 2, tkwin, &savedOptions, NULL) != TCL_OK) {
420	Tk_RestoreSavedOptions(&savedOptions);
421	goto error;
422    } else {
423	Tk_FreeSavedOptions(&savedOptions);
424    }
425    if (widgetSpec->configureProc(interp, recordPtr, ~0) != TCL_OK)
426	goto error;
427    if (widgetSpec->postConfigureProc(interp, recordPtr, ~0) != TCL_OK)
428	goto error;
429
430    if (WidgetDestroyed(corePtr))
431	goto error;
432
433    Tcl_Release(corePtr);
434
435    SizeChanged(corePtr);
436    Tk_MakeWindowExist(tkwin);
437
438    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin), -1));
439    return TCL_OK;
440
441error:
442    if (WidgetDestroyed(corePtr)) {
443	Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC);
444    } else {
445	Tk_DestroyWindow(tkwin);
446    }
447    Tcl_Release(corePtr);
448    return TCL_ERROR;
449}
450
451/*------------------------------------------------------------------------
452 * +++ Default implementations for widget hook procedures.
453 */
454
455/* TtkWidgetGetLayout --
456 * 	Default getLayoutProc.
457 *	Looks up the layout based on the -style resource (if specified),
458 *	otherwise use the widget class.
459 */
460Ttk_Layout TtkWidgetGetLayout(
461    Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr)
462{
463    WidgetCore *corePtr = recordPtr;
464    const char *styleName = 0;
465
466    if (corePtr->styleObj)
467    	styleName = Tcl_GetString(corePtr->styleObj);
468
469    if (!styleName || *styleName == '\0')
470    	styleName = corePtr->widgetSpec->className;
471
472    return Ttk_CreateLayout(interp, themePtr, styleName,
473	recordPtr, corePtr->optionTable, corePtr->tkwin);
474}
475
476/*
477 * TtkWidgetGetOrientedLayout --
478 * 	Helper routine.  Same as TtkWidgetGetLayout, but prefixes
479 * 	"Horizontal." or "Vertical." to the style name, depending
480 * 	on the value of the 'orient' option.
481 */
482Ttk_Layout TtkWidgetGetOrientedLayout(
483    Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr, Tcl_Obj *orientObj)
484{
485    WidgetCore *corePtr = recordPtr;
486    const char *baseStyleName = 0;
487    Tcl_DString styleName;
488    int orient = TTK_ORIENT_HORIZONTAL;
489    Ttk_Layout layout;
490
491    Tcl_DStringInit(&styleName);
492
493    /* Prefix:
494     */
495    Ttk_GetOrientFromObj(NULL, orientObj, &orient);
496    if (orient == TTK_ORIENT_HORIZONTAL)
497	Tcl_DStringAppend(&styleName, "Horizontal.", -1);
498    else
499	Tcl_DStringAppend(&styleName, "Vertical.", -1);
500
501    /* Add base style name:
502     */
503    if (corePtr->styleObj)
504    	baseStyleName = Tcl_GetString(corePtr->styleObj);
505    if (!baseStyleName || *baseStyleName == '\0')
506    	baseStyleName = corePtr->widgetSpec->className;
507
508    Tcl_DStringAppend(&styleName, baseStyleName, -1);
509
510    /* Create layout:
511     */
512    layout= Ttk_CreateLayout(interp, themePtr, Tcl_DStringValue(&styleName),
513	recordPtr, corePtr->optionTable, corePtr->tkwin);
514
515    Tcl_DStringFree(&styleName);
516
517    return layout;
518}
519
520/* TtkNullInitialize --
521 * 	Default widget initializeProc (no-op)
522 */
523void TtkNullInitialize(Tcl_Interp *interp, void *recordPtr)
524{
525}
526
527/* TtkNullPostConfigure --
528 * 	Default widget postConfigureProc (no-op)
529 */
530int TtkNullPostConfigure(Tcl_Interp *interp, void *clientData, int mask)
531{
532    return TCL_OK;
533}
534
535/* TtkCoreConfigure --
536 * 	Default widget configureProc.
537 * 	Handles -style option.
538 */
539int TtkCoreConfigure(Tcl_Interp *interp, void *clientData, int mask)
540{
541    WidgetCore *corePtr = clientData;
542    int status = TCL_OK;
543
544    if (mask & STYLE_CHANGED) {
545	status = UpdateLayout(interp, corePtr);
546    }
547
548    return status;
549}
550
551/* TtkNullCleanup --
552 * 	Default widget cleanupProc (no-op)
553 */
554void TtkNullCleanup(void *recordPtr)
555{
556    return;
557}
558
559/* TtkWidgetDoLayout --
560 * 	Default widget layoutProc.
561 */
562void TtkWidgetDoLayout(void *clientData)
563{
564    WidgetCore *corePtr = clientData;
565    Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
566}
567
568/* TtkWidgetDisplay --
569 * 	Default widget displayProc.
570 */
571void TtkWidgetDisplay(void *recordPtr, Drawable d)
572{
573    WidgetCore *corePtr = recordPtr;
574    Ttk_DrawLayout(corePtr->layout, corePtr->state, d);
575}
576
577/* TtkWidgetSize --
578 * 	Default widget sizeProc()
579 */
580int TtkWidgetSize(void *recordPtr, int *widthPtr, int *heightPtr)
581{
582    WidgetCore *corePtr = recordPtr;
583    Ttk_LayoutSize(corePtr->layout, corePtr->state, widthPtr, heightPtr);
584    return 1;
585}
586
587/*------------------------------------------------------------------------
588 * +++ Default implementations for widget subcommands.
589 */
590
591/* $w cget -option
592 */
593int TtkWidgetCgetCommand(
594    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
595{
596    WidgetCore *corePtr = recordPtr;
597    Tcl_Obj *result;
598
599    if (objc != 3) {
600	Tcl_WrongNumArgs(interp, 2, objv, "option");
601	return TCL_ERROR;
602    }
603    result = Tk_GetOptionValue(interp, recordPtr,
604		corePtr->optionTable, objv[2], corePtr->tkwin);
605    if (result == NULL)
606	return TCL_ERROR;
607    Tcl_SetObjResult(interp, result);
608    return TCL_OK;
609}
610
611/* $w configure ?-option ?value ....??
612 */
613int TtkWidgetConfigureCommand(
614    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
615{
616    WidgetCore *corePtr = recordPtr;
617    Tcl_Obj *result;
618
619    if (objc == 2) {
620	result = Tk_GetOptionInfo(interp, recordPtr,
621		corePtr->optionTable, NULL, corePtr->tkwin);
622    } else if (objc == 3) {
623	result = Tk_GetOptionInfo(interp, recordPtr,
624		corePtr->optionTable, objv[2], corePtr->tkwin);
625    } else {
626	Tk_SavedOptions savedOptions;
627	int status;
628	int mask = 0;
629
630	status = Tk_SetOptions(interp, recordPtr,
631		corePtr->optionTable, objc - 2, objv + 2,
632		corePtr->tkwin, &savedOptions, &mask);
633	if (status != TCL_OK)
634	    return status;
635
636	if (mask & READONLY_OPTION) {
637	    Tcl_SetResult(interp,
638		    "Attempt to change read-only option", TCL_STATIC);
639	    Tk_RestoreSavedOptions(&savedOptions);
640	    return TCL_ERROR;
641	}
642
643	status = corePtr->widgetSpec->configureProc(interp, recordPtr, mask);
644	if (status != TCL_OK) {
645	    Tk_RestoreSavedOptions(&savedOptions);
646	    return status;
647	}
648	Tk_FreeSavedOptions(&savedOptions);
649
650	status = corePtr->widgetSpec->postConfigureProc(interp,recordPtr,mask);
651	if (WidgetDestroyed(corePtr)) {
652	    Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC);
653	    status = TCL_ERROR;
654	}
655	if (status != TCL_OK) {
656	    return status;
657	}
658
659	if (mask & (STYLE_CHANGED | GEOMETRY_CHANGED)) {
660	    SizeChanged(corePtr);
661	}
662
663	TtkRedisplayWidget(corePtr);
664	result = Tcl_NewObj();
665    }
666
667    if (result == 0) {
668	return TCL_ERROR;
669    }
670    Tcl_SetObjResult(interp, result);
671    return TCL_OK;
672}
673
674/* $w state ? $stateSpec ?
675 *
676 * 	If $stateSpec is specified, modify the widget state accordingly,
677 * 	return a new stateSpec representing the changed bits.
678 *
679 * 	Otherwise, return a statespec matching all the currently-set bits.
680 */
681
682int TtkWidgetStateCommand(
683    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
684{
685    WidgetCore *corePtr = recordPtr;
686    Ttk_StateSpec spec;
687    int status;
688    Ttk_State oldState, changed;
689
690    if (objc == 2) {
691	Tcl_SetObjResult(interp,
692	    Ttk_NewStateSpecObj(corePtr->state, 0ul));
693	return TCL_OK;
694    }
695
696    if (objc != 3) {
697	Tcl_WrongNumArgs(interp, 2, objv, "state-spec");
698	return TCL_ERROR;
699    }
700    status = Ttk_GetStateSpecFromObj(interp, objv[2], &spec);
701    if (status != TCL_OK)
702	return status;
703
704    oldState = corePtr->state;
705    corePtr->state = Ttk_ModifyState(corePtr->state, &spec);
706    changed = corePtr->state ^ oldState;
707
708    TtkRedisplayWidget(corePtr);
709
710    Tcl_SetObjResult(interp,
711	Ttk_NewStateSpecObj(oldState & changed, ~oldState & changed));
712    return status;
713}
714
715/* $w instate $stateSpec ?$script?
716 *
717 * 	Tests if widget state matches $stateSpec.
718 *	If $script is specified, execute script if state matches.
719 *	Otherwise, return true/false
720 */
721
722int TtkWidgetInstateCommand(
723    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
724{
725    WidgetCore *corePtr = recordPtr;
726    Ttk_State state = corePtr->state;
727    Ttk_StateSpec spec;
728    int status = TCL_OK;
729
730    if (objc < 3 || objc > 4) {
731	Tcl_WrongNumArgs(interp, 2, objv, "state-spec ?script?");
732	return TCL_ERROR;
733    }
734    status = Ttk_GetStateSpecFromObj(interp, objv[2], &spec);
735    if (status != TCL_OK)
736	return status;
737
738    if (objc == 3) {
739	Tcl_SetObjResult(interp,
740	    Tcl_NewBooleanObj(Ttk_StateMatches(state,&spec)));
741    } else if (objc == 4) {
742	if (Ttk_StateMatches(state,&spec)) {
743	    status = Tcl_EvalObjEx(interp, objv[3], 0);
744	}
745    }
746    return status;
747}
748
749/* $w identify $x $y
750 * $w identify element $x $y
751 * 	Returns: name of element at $x, $y
752 */
753int TtkWidgetIdentifyCommand(
754    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
755{
756    WidgetCore *corePtr = recordPtr;
757    Ttk_Element element;
758    static const char *whatTable[] = { "element", NULL };
759    int x, y, what;
760
761    if (objc < 4 || objc > 5) {
762	Tcl_WrongNumArgs(interp, 2, objv, "?what? x y");
763	return TCL_ERROR;
764    }
765    if (objc == 5) {
766	/* $w identify element $x $y */
767	if (Tcl_GetIndexFromObj(interp,objv[2],whatTable,"option",0,&what)
768		!= TCL_OK)
769	{
770	    return TCL_ERROR;
771	}
772    }
773
774    if (   Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
775	|| Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
776    ) {
777	return TCL_ERROR;
778    }
779
780    element = Ttk_IdentifyElement(corePtr->layout, x, y);
781    if (element) {
782	const char *elementName = Ttk_ElementName(element);
783	Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1));
784    }
785
786    return TCL_OK;
787}
788
789/*EOF*/
790