1 /*
2  * tkCmds.c --
3  *
4  *	This file contains a collection of Tk-related Tcl commands that didn't
5  *	fit in any particular file of the toolkit.
6  *
7  * Copyright (c) 1990-1994 The Regents of the University of California.
8  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
9  * Copyright (c) 2000 Scriptics Corporation.
10  *
11  * See the file "license.terms" for information on usage and redistribution of
12  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
13  */
14 
15 #include "tkInt.h"
16 
17 #if defined(WIN32)
18 #include "tkWinInt.h"
19 #elif defined(MAC_OSX_TK)
20 #include "tkMacOSXInt.h"
21 #else
22 #include "tkUnixInt.h"
23 #endif
24 
25 /*
26  * Forward declarations for functions defined later in this file:
27  */
28 
29 static TkWindow *	GetTopHierarchy(Tk_Window tkwin);
30 static char *		WaitVariableProc(ClientData clientData,
31 			    Tcl_Interp *interp, const char *name1,
32 			    const char *name2, int flags);
33 static void		WaitVisibilityProc(ClientData clientData,
34 			    XEvent *eventPtr);
35 static void		WaitWindowProc(ClientData clientData,
36 			    XEvent *eventPtr);
37 
38 /*
39  *----------------------------------------------------------------------
40  *
41  * Tk_BellObjCmd --
42  *
43  *	This function is invoked to process the "bell" Tcl command. See the
44  *	user documentation for details on what it does.
45  *
46  * Results:
47  *	A standard Tcl result.
48  *
49  * Side effects:
50  *	See the user documentation.
51  *
52  *----------------------------------------------------------------------
53  */
54 
55 int
Tk_BellObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])56 Tk_BellObjCmd(
57     ClientData clientData,	/* Main window associated with interpreter. */
58     Tcl_Interp *interp,		/* Current interpreter. */
59     int objc,			/* Number of arguments. */
60     Tcl_Obj *const objv[])	/* Argument objects. */
61 {
62     static const char *bellOptions[] = {
63 	"-displayof", "-nice", NULL
64     };
65     enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE };
66     Tk_Window tkwin = (Tk_Window) clientData;
67     int i, index, nice = 0;
68 
69     if (objc > 4) {
70     wrongArgs:
71 	Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?-nice?");
72 	return TCL_ERROR;
73     }
74 
75     for (i = 1; i < objc; i++) {
76 	if (Tcl_GetIndexFromObj(interp, objv[i], bellOptions, "option", 0,
77 		&index) != TCL_OK) {
78 	    return TCL_ERROR;
79 	}
80 	switch ((enum options) index) {
81 	case TK_BELL_DISPLAYOF:
82 	    if (++i >= objc) {
83 		goto wrongArgs;
84 	    }
85 	    tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
86 	    if (tkwin == NULL) {
87 		return TCL_ERROR;
88 	    }
89 	    break;
90 	case TK_BELL_NICE:
91 	    nice = 1;
92 	    break;
93 	}
94     }
95     XBell(Tk_Display(tkwin), 0);
96     if (!nice) {
97 	XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
98     }
99     XFlush(Tk_Display(tkwin));
100     return TCL_OK;
101 }
102 
103 /*
104  *----------------------------------------------------------------------
105  *
106  * Tk_BindObjCmd --
107  *
108  *	This function is invoked to process the "bind" Tcl command. See the
109  *	user documentation for details on what it does.
110  *
111  * Results:
112  *	A standard Tcl result.
113  *
114  * Side effects:
115  *	See the user documentation.
116  *
117  *----------------------------------------------------------------------
118  */
119 
120 int
Tk_BindObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])121 Tk_BindObjCmd(
122     ClientData clientData,	/* Main window associated with interpreter. */
123     Tcl_Interp *interp,		/* Current interpreter. */
124     int objc,			/* Number of arguments. */
125     Tcl_Obj *const objv[])	/* Argument objects. */
126 {
127     Tk_Window tkwin = (Tk_Window) clientData;
128     TkWindow *winPtr;
129     ClientData object;
130     char *string;
131 
132     if ((objc < 2) || (objc > 4)) {
133 	Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?");
134 	return TCL_ERROR;
135     }
136     string = Tcl_GetString(objv[1]);
137 
138     /*
139      * Bind tags either a window name or a tag name for the first argument.
140      * If the argument starts with ".", assume it is a window; otherwise, it
141      * is a tag.
142      */
143 
144     if (string[0] == '.') {
145 	winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
146 	if (winPtr == NULL) {
147 	    return TCL_ERROR;
148 	}
149 	object = (ClientData) winPtr->pathName;
150     } else {
151 	winPtr = (TkWindow *) clientData;
152 	object = (ClientData) Tk_GetUid(string);
153     }
154 
155     /*
156      * If there are four arguments, the command is modifying a binding. If
157      * there are three arguments, the command is querying a binding. If there
158      * are only two arguments, the command is querying all the bindings for
159      * the given tag/window.
160      */
161 
162     if (objc == 4) {
163 	int append = 0;
164 	unsigned long mask;
165 	char *sequence, *script;
166 	sequence	= Tcl_GetString(objv[2]);
167 	script		= Tcl_GetString(objv[3]);
168 
169 	/*
170 	 * If the script is null, just delete the binding.
171 	 */
172 
173 	if (script[0] == 0) {
174 	    return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
175 		    object, sequence);
176 	}
177 
178 	/*
179 	 * If the script begins with "+", append this script to the existing
180 	 * binding.
181 	 */
182 
183 	if (script[0] == '+') {
184 	    script++;
185 	    append = 1;
186 	}
187 	mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
188 		object, sequence, script, append);
189 	if (mask == 0) {
190 	    return TCL_ERROR;
191 	}
192     } else if (objc == 3) {
193 	const char *command;
194 
195 	command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
196 		object, Tcl_GetString(objv[2]));
197 	if (command == NULL) {
198 	    Tcl_ResetResult(interp);
199 	    return TCL_OK;
200 	}
201 	Tcl_SetResult(interp, (char *) command, TCL_STATIC);
202     } else {
203 	Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
204     }
205     return TCL_OK;
206 }
207 
208 /*
209  *----------------------------------------------------------------------
210  *
211  * TkBindEventProc --
212  *
213  *	This function is invoked by Tk_HandleEvent for each event; it causes
214  *	any appropriate bindings for that event to be invoked.
215  *
216  * Results:
217  *	None.
218  *
219  * Side effects:
220  *	Depends on what bindings have been established with the "bind"
221  *	command.
222  *
223  *----------------------------------------------------------------------
224  */
225 
226 void
TkBindEventProc(TkWindow * winPtr,XEvent * eventPtr)227 TkBindEventProc(
228     TkWindow *winPtr,		/* Pointer to info about window. */
229     XEvent *eventPtr)		/* Information about event. */
230 {
231 #define MAX_OBJS 20
232     ClientData objects[MAX_OBJS], *objPtr;
233     TkWindow *topLevPtr;
234     int i, count;
235     const char *p;
236     Tcl_HashEntry *hPtr;
237 
238     if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
239 	return;
240     }
241 
242     objPtr = objects;
243     if (winPtr->numTags != 0) {
244 	/*
245 	 * Make a copy of the tags for the window, replacing window names with
246 	 * pointers to the pathName from the appropriate window.
247 	 */
248 
249 	if (winPtr->numTags > MAX_OBJS) {
250 	    objPtr = (ClientData *) ckalloc((unsigned)
251 		    (winPtr->numTags * sizeof(ClientData)));
252 	}
253 	for (i = 0; i < winPtr->numTags; i++) {
254 	    p = winPtr->tagPtr[i];
255 	    if (*p == '.') {
256 		hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
257 		if (hPtr != NULL) {
258 		    p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;
259 		} else {
260 		    p = NULL;
261 		}
262 	    }
263 	    objPtr[i] = (ClientData) p;
264 	}
265 	count = winPtr->numTags;
266     } else {
267 	objPtr[0] = (ClientData) winPtr->pathName;
268 	objPtr[1] = (ClientData) winPtr->classUid;
269 	for (topLevPtr = winPtr;
270 		(topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_HIERARCHY);
271 		topLevPtr = topLevPtr->parentPtr) {
272 	    /* Empty loop body. */
273 	}
274 	if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
275 	    count = 4;
276 	    objPtr[2] = (ClientData) topLevPtr->pathName;
277 	} else {
278 	    count = 3;
279 	}
280 	objPtr[count-1] = (ClientData) Tk_GetUid("all");
281     }
282     Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
283 	    count, objPtr);
284     if (objPtr != objects) {
285 	ckfree((char *) objPtr);
286     }
287 }
288 
289 /*
290  *----------------------------------------------------------------------
291  *
292  * Tk_BindtagsObjCmd --
293  *
294  *	This function is invoked to process the "bindtags" Tcl command. See
295  *	the user documentation for details on what it does.
296  *
297  * Results:
298  *	A standard Tcl result.
299  *
300  * Side effects:
301  *	See the user documentation.
302  *
303  *----------------------------------------------------------------------
304  */
305 
306 int
Tk_BindtagsObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])307 Tk_BindtagsObjCmd(
308     ClientData clientData,	/* Main window associated with interpreter. */
309     Tcl_Interp *interp,		/* Current interpreter. */
310     int objc,			/* Number of arguments. */
311     Tcl_Obj *const objv[])	/* Argument objects. */
312 {
313     Tk_Window tkwin = (Tk_Window) clientData;
314     TkWindow *winPtr, *winPtr2;
315     int i, length;
316     char *p;
317     Tcl_Obj *listPtr, **tags;
318 
319     if ((objc < 2) || (objc > 3)) {
320 	Tcl_WrongNumArgs(interp, 1, objv, "window ?taglist?");
321 	return TCL_ERROR;
322     }
323     winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]),
324 	    tkwin);
325     if (winPtr == NULL) {
326 	return TCL_ERROR;
327     }
328     if (objc == 2) {
329 	listPtr = Tcl_NewObj();
330 	if (winPtr->numTags == 0) {
331 	    Tcl_ListObjAppendElement(interp, listPtr,
332 		    Tcl_NewStringObj(winPtr->pathName, -1));
333 	    Tcl_ListObjAppendElement(interp, listPtr,
334 		    Tcl_NewStringObj(winPtr->classUid, -1));
335 	    winPtr2 = winPtr;
336 	    while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) {
337 		winPtr2 = winPtr2->parentPtr;
338 	    }
339 	    if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
340 		Tcl_ListObjAppendElement(interp, listPtr,
341 			Tcl_NewStringObj(winPtr2->pathName, -1));
342 	    }
343 	    Tcl_ListObjAppendElement(interp, listPtr,
344 		    Tcl_NewStringObj("all", -1));
345 	} else {
346 	    for (i = 0; i < winPtr->numTags; i++) {
347 		Tcl_ListObjAppendElement(interp, listPtr,
348 			Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1));
349 	    }
350 	}
351 	Tcl_SetObjResult(interp, listPtr);
352 	return TCL_OK;
353     }
354     if (winPtr->tagPtr != NULL) {
355 	TkFreeBindingTags(winPtr);
356     }
357     if (Tcl_ListObjGetElements(interp, objv[2], &length, &tags) != TCL_OK) {
358 	return TCL_ERROR;
359     }
360     if (length == 0) {
361 	return TCL_OK;
362     }
363 
364     winPtr->numTags = length;
365     winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
366 	    (length * sizeof(ClientData)));
367     for (i = 0; i < length; i++) {
368 	p = Tcl_GetString(tags[i]);
369 	if (p[0] == '.') {
370 	    char *copy;
371 
372 	    /*
373 	     * Handle names starting with "." specially: store a malloc'ed
374 	     * string, rather than a Uid; at event time we'll look up the name
375 	     * in the window table and use the corresponding window, if there
376 	     * is one.
377 	     */
378 
379 	    copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
380 	    strcpy(copy, p);
381 	    winPtr->tagPtr[i] = (ClientData) copy;
382 	} else {
383 	    winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);
384 	}
385     }
386     return TCL_OK;
387 }
388 
389 /*
390  *----------------------------------------------------------------------
391  *
392  * TkFreeBindingTags --
393  *
394  *	This function is called to free all of the binding tags associated
395  *	with a window; typically it is only invoked where there are
396  *	window-specific tags.
397  *
398  * Results:
399  *	None.
400  *
401  * Side effects:
402  *	Any binding tags for winPtr are freed.
403  *
404  *----------------------------------------------------------------------
405  */
406 
407 void
TkFreeBindingTags(TkWindow * winPtr)408 TkFreeBindingTags(
409     TkWindow *winPtr)		/* Window whose tags are to be released. */
410 {
411     int i;
412     const char *p;
413 
414     for (i = 0; i < winPtr->numTags; i++) {
415 	p = winPtr->tagPtr[i];
416 	if (*p == '.') {
417 	    /*
418 	     * Names starting with "." are malloced rather than Uids, so they
419 	     * have to be freed.
420 	     */
421 
422 	    ckfree((char *)p);
423 	}
424     }
425     ckfree((char *) winPtr->tagPtr);
426     winPtr->numTags = 0;
427     winPtr->tagPtr = NULL;
428 }
429 
430 /*
431  *----------------------------------------------------------------------
432  *
433  * Tk_DestroyObjCmd --
434  *
435  *	This function is invoked to process the "destroy" Tcl command. See the
436  *	user documentation for details on what it does.
437  *
438  * Results:
439  *	A standard Tcl result.
440  *
441  * Side effects:
442  *	See the user documentation.
443  *
444  *----------------------------------------------------------------------
445  */
446 
447 int
Tk_DestroyObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])448 Tk_DestroyObjCmd(
449     ClientData clientData,	/* Main window associated with interpreter. */
450     Tcl_Interp *interp,		/* Current interpreter. */
451     int objc,			/* Number of arguments. */
452     Tcl_Obj *const objv[])	/* Argument objects. */
453 {
454     Tk_Window window;
455     Tk_Window tkwin = (Tk_Window) clientData;
456     int i;
457 
458     for (i = 1; i < objc; i++) {
459 	window = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
460 	if (window == NULL) {
461 	    Tcl_ResetResult(interp);
462 	    continue;
463 	}
464 	Tk_DestroyWindow(window);
465 	if (window == tkwin) {
466 	    /*
467 	     * We just deleted the main window for the application! This makes
468 	     * it impossible to do anything more (tkwin isn't valid anymore).
469 	     */
470 
471 	    break;
472 	}
473     }
474     return TCL_OK;
475 }
476 
477 /*
478  *----------------------------------------------------------------------
479  *
480  * Tk_LowerObjCmd --
481  *
482  *	This function is invoked to process the "lower" Tcl command. See the
483  *	user documentation for details on what it does.
484  *
485  * Results:
486  *	A standard Tcl result.
487  *
488  * Side effects:
489  *	See the user documentation.
490  *
491  *----------------------------------------------------------------------
492  */
493 
494 	/* ARGSUSED */
495 int
Tk_LowerObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])496 Tk_LowerObjCmd(
497     ClientData clientData,	/* Main window associated with interpreter. */
498     Tcl_Interp *interp,		/* Current interpreter. */
499     int objc,			/* Number of arguments. */
500     Tcl_Obj *const objv[])	/* Argument objects. */
501 {
502     Tk_Window mainwin = (Tk_Window) clientData;
503     Tk_Window tkwin, other;
504 
505     if ((objc != 2) && (objc != 3)) {
506 	Tcl_WrongNumArgs(interp, 1, objv, "window ?belowThis?");
507 	return TCL_ERROR;
508     }
509 
510     tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
511     if (tkwin == NULL) {
512 	return TCL_ERROR;
513     }
514     if (objc == 2) {
515 	other = NULL;
516     } else {
517 	other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
518 	if (other == NULL) {
519 	    return TCL_ERROR;
520 	}
521     }
522     if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
523 	Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]),
524 		"\" below \"", (other ? Tcl_GetString(objv[2]) : ""),
525 		"\"", NULL);
526 	return TCL_ERROR;
527     }
528     return TCL_OK;
529 }
530 
531 /*
532  *----------------------------------------------------------------------
533  *
534  * Tk_RaiseObjCmd --
535  *
536  *	This function is invoked to process the "raise" Tcl command. See the
537  *	user documentation for details on what it does.
538  *
539  * Results:
540  *	A standard Tcl result.
541  *
542  * Side effects:
543  *	See the user documentation.
544  *
545  *----------------------------------------------------------------------
546  */
547 
548 	/* ARGSUSED */
549 int
Tk_RaiseObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])550 Tk_RaiseObjCmd(
551     ClientData clientData,	/* Main window associated with interpreter. */
552     Tcl_Interp *interp,		/* Current interpreter. */
553     int objc,			/* Number of arguments. */
554     Tcl_Obj *const objv[])	/* Argument objects. */
555 {
556     Tk_Window mainwin = (Tk_Window) clientData;
557     Tk_Window tkwin, other;
558 
559     if ((objc != 2) && (objc != 3)) {
560 	Tcl_WrongNumArgs(interp, 1, objv, "window ?aboveThis?");
561 	return TCL_ERROR;
562     }
563 
564     tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
565     if (tkwin == NULL) {
566 	return TCL_ERROR;
567     }
568     if (objc == 2) {
569 	other = NULL;
570     } else {
571 	other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
572 	if (other == NULL) {
573 	    return TCL_ERROR;
574 	}
575     }
576     if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
577 	Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]),
578 		"\" above \"", (other ? Tcl_GetString(objv[2]) : ""),
579 		"\"", NULL);
580 	return TCL_ERROR;
581     }
582     return TCL_OK;
583 }
584 
585 /*
586  *----------------------------------------------------------------------
587  *
588  * Tk_TkObjCmd --
589  *
590  *	This function is invoked to process the "tk" Tcl command. See the user
591  *	documentation for details on what it does.
592  *
593  * Results:
594  *	A standard Tcl result.
595  *
596  * Side effects:
597  *	See the user documentation.
598  *
599  *----------------------------------------------------------------------
600  */
601 
602 int
Tk_TkObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])603 Tk_TkObjCmd(
604     ClientData clientData,	/* Main window associated with interpreter. */
605     Tcl_Interp *interp,		/* Current interpreter. */
606     int objc,			/* Number of arguments. */
607     Tcl_Obj *const objv[])	/* Argument objects. */
608 {
609     int index;
610     Tk_Window tkwin;
611     static const char *optionStrings[] = {
612 	"appname",	"caret",	"scaling",	"useinputmethods",
613 	"windowingsystem",		"inactive",	NULL
614     };
615     enum options {
616 	TK_APPNAME,	TK_CARET,	TK_SCALING,	TK_USE_IM,
617 	TK_WINDOWINGSYSTEM,		TK_INACTIVE
618     };
619 
620     tkwin = (Tk_Window) clientData;
621 
622     if (objc < 2) {
623 	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
624 	return TCL_ERROR;
625     }
626     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
627 	    &index) != TCL_OK) {
628 	return TCL_ERROR;
629     }
630 
631     switch ((enum options) index) {
632     case TK_APPNAME: {
633 	TkWindow *winPtr;
634 	char *string;
635 
636 	if (Tcl_IsSafe(interp)) {
637 	    Tcl_SetResult(interp,
638 		    "appname not accessible in a safe interpreter",
639 		    TCL_STATIC);
640 	    return TCL_ERROR;
641 	}
642 
643 	winPtr = (TkWindow *) tkwin;
644 
645 	if (objc > 3) {
646 	    Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
647 	    return TCL_ERROR;
648 	}
649 	if (objc == 3) {
650 	    string = Tcl_GetString(objv[2]);
651 	    winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
652 	}
653 	Tcl_AppendResult(interp, winPtr->nameUid, NULL);
654 	break;
655     }
656     case TK_CARET: {
657 	Tcl_Obj *objPtr;
658 	TkCaret *caretPtr;
659 	Tk_Window window;
660 	static const char *caretStrings[] = {
661 	    "-x",	"-y", "-height", NULL
662 	};
663 	enum caretOptions {
664 	    TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT
665 	};
666 
667 	if ((objc < 3) || ((objc > 4) && !(objc & 1))) {
668 	    Tcl_WrongNumArgs(interp, 2, objv,
669 		    "window ?-x x? ?-y y? ?-height height?");
670 	    return TCL_ERROR;
671 	}
672 	window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
673 	if (window == NULL) {
674 	    return TCL_ERROR;
675 	}
676 	caretPtr = &(((TkWindow *) window)->dispPtr->caret);
677 	if (objc == 3) {
678 	    /*
679 	     * Return all the current values
680 	     */
681 
682 	    objPtr = Tcl_NewObj();
683 	    Tcl_ListObjAppendElement(interp, objPtr,
684 		    Tcl_NewStringObj("-height", 7));
685 	    Tcl_ListObjAppendElement(interp, objPtr,
686 		    Tcl_NewIntObj(caretPtr->height));
687 	    Tcl_ListObjAppendElement(interp, objPtr,
688 		    Tcl_NewStringObj("-x", 2));
689 	    Tcl_ListObjAppendElement(interp, objPtr,
690 		    Tcl_NewIntObj(caretPtr->x));
691 	    Tcl_ListObjAppendElement(interp, objPtr,
692 		    Tcl_NewStringObj("-y", 2));
693 	    Tcl_ListObjAppendElement(interp, objPtr,
694 		    Tcl_NewIntObj(caretPtr->y));
695 	    Tcl_SetObjResult(interp, objPtr);
696 	} else if (objc == 4) {
697 	    int value;
698 
699 	    /*
700 	     * Return the current value of the selected option
701 	     */
702 
703 	    if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings,
704 		    "caret option", 0, &index) != TCL_OK) {
705 		return TCL_ERROR;
706 	    }
707 	    if (index == TK_CARET_X) {
708 		value = caretPtr->x;
709 	    } else if (index == TK_CARET_Y) {
710 		value = caretPtr->y;
711 	    } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
712 		value = caretPtr->height;
713 	    }
714 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), value);
715 	} else {
716 	    int i, value, x = 0, y = 0, height = -1;
717 
718 	    for (i = 3; i < objc; i += 2) {
719 		if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings,
720 			"caret option", 0, &index) != TCL_OK) ||
721 			Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) {
722 		    return TCL_ERROR;
723 		}
724 		if (index == TK_CARET_X) {
725 		    x = value;
726 		} else if (index == TK_CARET_Y) {
727 		    y = value;
728 		} else /* if (index == TK_CARET_HEIGHT) -- last case */ {
729 		    height = value;
730 		}
731 	    }
732 	    if (height < 0) {
733 		height = Tk_Height(window);
734 	    }
735 	    Tk_SetCaretPos(window, x, y, height);
736 	}
737 	break;
738     }
739     case TK_SCALING: {
740 	Screen *screenPtr;
741 	int skip, width, height;
742 	double d;
743 
744 	if (Tcl_IsSafe(interp)) {
745 	    Tcl_SetResult(interp,
746 		    "scaling not accessible in a safe interpreter",
747 		    TCL_STATIC);
748 	    return TCL_ERROR;
749 	}
750 
751 	skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
752 	if (skip < 0) {
753 	    return TCL_ERROR;
754 	}
755 	screenPtr = Tk_Screen(tkwin);
756 	if (objc - skip == 2) {
757 	    d = 25.4 / 72;
758 	    d *= WidthOfScreen(screenPtr);
759 	    d /= WidthMMOfScreen(screenPtr);
760 	    Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
761 	} else if (objc - skip == 3) {
762 	    if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) {
763 		return TCL_ERROR;
764 	    }
765 	    d = (25.4 / 72) / d;
766 	    width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
767 	    if (width <= 0) {
768 		width = 1;
769 	    }
770 	    height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
771 	    if (height <= 0) {
772 		height = 1;
773 	    }
774 	    WidthMMOfScreen(screenPtr) = width;
775 	    HeightMMOfScreen(screenPtr) = height;
776 	} else {
777 	    Tcl_WrongNumArgs(interp, 2, objv,
778 		    "?-displayof window? ?factor?");
779 	    return TCL_ERROR;
780 	}
781 	break;
782     }
783     case TK_USE_IM: {
784 	TkDisplay *dispPtr;
785 	int skip;
786 
787 	if (Tcl_IsSafe(interp)) {
788 	    Tcl_SetResult(interp,
789 		    "useinputmethods not accessible in a safe interpreter",
790 		    TCL_STATIC);
791 	    return TCL_ERROR;
792 	}
793 
794 	skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin);
795 	if (skip < 0) {
796 	    return TCL_ERROR;
797 	}
798 	dispPtr = ((TkWindow *) tkwin)->dispPtr;
799 	if ((objc - skip) == 3) {
800 	    /*
801 	     * In the case where TK_USE_INPUT_METHODS is not defined, this
802 	     * will be ignored and we will always return 0. That will indicate
803 	     * to the user that input methods are just not available.
804 	     */
805 
806 	    int boolVal;
807 
808 	    if (Tcl_GetBooleanFromObj(interp, objv[2+skip],
809 		    &boolVal) != TCL_OK) {
810 		return TCL_ERROR;
811 	    }
812 #ifdef TK_USE_INPUT_METHODS
813 	    if (boolVal) {
814 		dispPtr->flags |= TK_DISPLAY_USE_IM;
815 	    } else {
816 		dispPtr->flags &= ~TK_DISPLAY_USE_IM;
817 	    }
818 #endif /* TK_USE_INPUT_METHODS */
819 	} else if ((objc - skip) != 2) {
820 	    Tcl_WrongNumArgs(interp, 2, objv,
821 		    "?-displayof window? ?boolean?");
822 	    return TCL_ERROR;
823 	}
824 	Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
825 		(int) (dispPtr->flags & TK_DISPLAY_USE_IM));
826 	break;
827     }
828     case TK_WINDOWINGSYSTEM: {
829 	const char *windowingsystem;
830 
831 	if (objc != 2) {
832 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
833 	    return TCL_ERROR;
834 	}
835 #if defined(WIN32)
836 	windowingsystem = "win32";
837 #elif defined(MAC_OSX_TK)
838 	windowingsystem = "aqua";
839 #else
840 	windowingsystem = "x11";
841 #endif
842 	Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1);
843 	break;
844     }
845     case TK_INACTIVE: {
846 	int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
847 
848 	if (skip < 0) {
849 	    return TCL_ERROR;
850 	}
851 	if (objc - skip == 2) {
852 	    long inactive;
853 
854 	    inactive = (Tcl_IsSafe(interp) ? -1 :
855 		    Tk_GetUserInactiveTime(Tk_Display(tkwin)));
856 	    Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive));
857 
858 	} else if (objc - skip == 3) {
859 	    char *string;
860 
861 	    string = Tcl_GetString(objv[objc-1]);
862 	    if (strcmp(string, "reset") != 0) {
863 		Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1);
864 
865 		Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL);
866 		Tcl_SetObjResult(interp, msg);
867 		return TCL_ERROR;
868 	    }
869 	    if (Tcl_IsSafe(interp)) {
870 		Tcl_SetResult(interp,
871 			"resetting the user inactivity timer "
872 			"is not allowed in a safe interpreter", TCL_STATIC);
873 		return TCL_ERROR;
874 	    }
875 	    Tk_ResetUserInactiveTime(Tk_Display(tkwin));
876 	    Tcl_ResetResult(interp);
877 	} else {
878 	    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? ?reset?");
879 	    return TCL_ERROR;
880 	}
881 	break;
882     }
883     }
884     return TCL_OK;
885 }
886 
887 /*
888  *----------------------------------------------------------------------
889  *
890  * Tk_TkwaitObjCmd --
891  *
892  *	This function is invoked to process the "tkwait" Tcl command. See the
893  *	user documentation for details on what it does.
894  *
895  * Results:
896  *	A standard Tcl result.
897  *
898  * Side effects:
899  *	See the user documentation.
900  *
901  *----------------------------------------------------------------------
902  */
903 
904 	/* ARGSUSED */
905 int
Tk_TkwaitObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])906 Tk_TkwaitObjCmd(
907     ClientData clientData,	/* Main window associated with interpreter. */
908     Tcl_Interp *interp,		/* Current interpreter. */
909     int objc,			/* Number of arguments. */
910     Tcl_Obj *const objv[])	/* Argument objects. */
911 {
912     Tk_Window tkwin = (Tk_Window) clientData;
913     int done, index;
914     static const char *optionStrings[] = {
915 	"variable", "visibility", "window", NULL
916     };
917     enum options {
918 	TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW
919     };
920 
921     if (objc != 3) {
922 	Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
923 	return TCL_ERROR;
924     }
925 
926     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
927 	    &index) != TCL_OK) {
928 	return TCL_ERROR;
929     }
930 
931     switch ((enum options) index) {
932     case TKWAIT_VARIABLE:
933 	if (Tcl_TraceVar(interp, Tcl_GetString(objv[2]),
934 		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
935 		WaitVariableProc, (ClientData) &done) != TCL_OK) {
936 	    return TCL_ERROR;
937 	}
938 	done = 0;
939 	while (!done) {
940 	    Tcl_DoOneEvent(0);
941 	}
942 	Tcl_UntraceVar(interp, Tcl_GetString(objv[2]),
943 		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
944 		WaitVariableProc, (ClientData) &done);
945 	break;
946 
947     case TKWAIT_VISIBILITY: {
948 	Tk_Window window;
949 
950 	window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
951 	if (window == NULL) {
952 	    return TCL_ERROR;
953 	}
954 	Tk_CreateEventHandler(window,
955 		VisibilityChangeMask|StructureNotifyMask,
956 		WaitVisibilityProc, (ClientData) &done);
957 	done = 0;
958 	while (!done) {
959 	    Tcl_DoOneEvent(0);
960 	}
961 	if (done != 1) {
962 	    /*
963 	     * Note that we do not delete the event handler because it was
964 	     * deleted automatically when the window was destroyed.
965 	     */
966 
967 	    Tcl_ResetResult(interp);
968 	    Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]),
969 		    "\" was deleted before its visibility changed", NULL);
970 	    return TCL_ERROR;
971 	}
972 	Tk_DeleteEventHandler(window,
973 		VisibilityChangeMask|StructureNotifyMask,
974 		WaitVisibilityProc, (ClientData) &done);
975 	break;
976     }
977 
978     case TKWAIT_WINDOW: {
979 	Tk_Window window;
980 
981 	window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
982 	if (window == NULL) {
983 	    return TCL_ERROR;
984 	}
985 	Tk_CreateEventHandler(window, StructureNotifyMask,
986 		WaitWindowProc, (ClientData) &done);
987 	done = 0;
988 	while (!done) {
989 	    Tcl_DoOneEvent(0);
990 	}
991 
992 	/*
993 	 * Note: there's no need to delete the event handler. It was deleted
994 	 * automatically when the window was destroyed.
995 	 */
996 
997 	break;
998     }
999     }
1000 
1001     /*
1002      * Clear out the interpreter's result, since it may have been set by event
1003      * handlers.
1004      */
1005 
1006     Tcl_ResetResult(interp);
1007     return TCL_OK;
1008 }
1009 
1010 	/* ARGSUSED */
1011 static char *
WaitVariableProc(ClientData clientData,Tcl_Interp * interp,const char * name1,const char * name2,int flags)1012 WaitVariableProc(
1013     ClientData clientData,	/* Pointer to integer to set to 1. */
1014     Tcl_Interp *interp,		/* Interpreter containing variable. */
1015     const char *name1,		/* Name of variable. */
1016     const char *name2,		/* Second part of variable name. */
1017     int flags)			/* Information about what happened. */
1018 {
1019     int *donePtr = (int *) clientData;
1020 
1021     *donePtr = 1;
1022     return NULL;
1023 }
1024 
1025 	/*ARGSUSED*/
1026 static void
WaitVisibilityProc(ClientData clientData,XEvent * eventPtr)1027 WaitVisibilityProc(
1028     ClientData clientData,	/* Pointer to integer to set to 1. */
1029     XEvent *eventPtr)		/* Information about event (not used). */
1030 {
1031     int *donePtr = (int *) clientData;
1032 
1033     if (eventPtr->type == VisibilityNotify) {
1034 	*donePtr = 1;
1035     }
1036     if (eventPtr->type == DestroyNotify) {
1037 	*donePtr = 2;
1038     }
1039 }
1040 
1041 static void
WaitWindowProc(ClientData clientData,XEvent * eventPtr)1042 WaitWindowProc(
1043     ClientData clientData,	/* Pointer to integer to set to 1. */
1044     XEvent *eventPtr)		/* Information about event. */
1045 {
1046     int *donePtr = (int *) clientData;
1047 
1048     if (eventPtr->type == DestroyNotify) {
1049 	*donePtr = 1;
1050     }
1051 }
1052 
1053 /*
1054  *----------------------------------------------------------------------
1055  *
1056  * Tk_UpdateObjCmd --
1057  *
1058  *	This function is invoked to process the "update" Tcl command. See the
1059  *	user documentation for details on what it does.
1060  *
1061  * Results:
1062  *	A standard Tcl result.
1063  *
1064  * Side effects:
1065  *	See the user documentation.
1066  *
1067  *----------------------------------------------------------------------
1068  */
1069 
1070 	/* ARGSUSED */
1071 int
Tk_UpdateObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1072 Tk_UpdateObjCmd(
1073     ClientData clientData,	/* Main window associated with interpreter. */
1074     Tcl_Interp *interp,		/* Current interpreter. */
1075     int objc,			/* Number of arguments. */
1076     Tcl_Obj *const objv[])	/* Argument objects. */
1077 {
1078     static const char *updateOptions[] = {"idletasks", NULL};
1079     int flags, index;
1080     TkDisplay *dispPtr;
1081 
1082     if (objc == 1) {
1083 	flags = TCL_DONT_WAIT;
1084     } else if (objc == 2) {
1085 	if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0,
1086 		&index) != TCL_OK) {
1087 	    return TCL_ERROR;
1088 	}
1089 	flags = TCL_IDLE_EVENTS;
1090     } else {
1091 	Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
1092 	return TCL_ERROR;
1093     }
1094 
1095     /*
1096      * Handle all pending events, sync all displays, and repeat over and over
1097      * again until all pending events have been handled. Special note: it's
1098      * possible that the entire application could be destroyed by an event
1099      * handler that occurs during the update. Thus, don't use any information
1100      * from tkwin after calling Tcl_DoOneEvent.
1101      */
1102 
1103     while (1) {
1104 	while (Tcl_DoOneEvent(flags) != 0) {
1105 	    /* Empty loop body */
1106 	}
1107 	for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
1108 		dispPtr = dispPtr->nextPtr) {
1109 	    XSync(dispPtr->display, False);
1110 	}
1111 	if (Tcl_DoOneEvent(flags) == 0) {
1112 	    break;
1113 	}
1114     }
1115 
1116     /*
1117      * Must clear the interpreter's result because event handlers could have
1118      * executed commands.
1119      */
1120 
1121     Tcl_ResetResult(interp);
1122     return TCL_OK;
1123 }
1124 
1125 /*
1126  *----------------------------------------------------------------------
1127  *
1128  * Tk_WinfoObjCmd --
1129  *
1130  *	This function is invoked to process the "winfo" Tcl command. See the
1131  *	user documentation for details on what it does.
1132  *
1133  * Results:
1134  *	A standard Tcl result.
1135  *
1136  * Side effects:
1137  *	See the user documentation.
1138  *
1139  *----------------------------------------------------------------------
1140  */
1141 
1142 int
Tk_WinfoObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1143 Tk_WinfoObjCmd(
1144     ClientData clientData,	/* Main window associated with interpreter. */
1145     Tcl_Interp *interp,		/* Current interpreter. */
1146     int objc,			/* Number of arguments. */
1147     Tcl_Obj *const objv[])	/* Argument objects. */
1148 {
1149     int index, x, y, width, height, useX, useY, class, skip;
1150     char *string;
1151     TkWindow *winPtr;
1152     Tk_Window tkwin;
1153     Tcl_Obj *resultPtr;
1154 
1155     static const TkStateMap visualMap[] = {
1156 	{PseudoColor,	"pseudocolor"},
1157 	{GrayScale,	"grayscale"},
1158 	{DirectColor,	"directcolor"},
1159 	{TrueColor,	"truecolor"},
1160 	{StaticColor,	"staticcolor"},
1161 	{StaticGray,	"staticgray"},
1162 	{-1,		NULL}
1163     };
1164     static const char *optionStrings[] = {
1165 	"cells",	"children",	"class",	"colormapfull",
1166 	"depth",	"geometry",	"height",	"id",
1167 	"ismapped",	"manager",	"name",		"parent",
1168 	"pointerx",	"pointery",	"pointerxy",	"reqheight",
1169 	"reqwidth",	"rootx",	"rooty",	"screen",
1170 	"screencells",	"screendepth",	"screenheight",	"screenwidth",
1171 	"screenmmheight","screenmmwidth","screenvisual","server",
1172 	"toplevel",	"viewable",	"visual",	"visualid",
1173 	"vrootheight",	"vrootwidth",	"vrootx",	"vrooty",
1174 	"width",	"x",		"y",
1175 
1176 	"atom",		"atomname",	"containing",	"interps",
1177 	"pathname",
1178 
1179 	"exists",	"fpixels",	"pixels",	"rgb",
1180 	"visualsavailable",
1181 
1182 	NULL
1183     };
1184     enum options {
1185 	WIN_CELLS,	WIN_CHILDREN,	WIN_CLASS,	WIN_COLORMAPFULL,
1186 	WIN_DEPTH,	WIN_GEOMETRY,	WIN_HEIGHT,	WIN_ID,
1187 	WIN_ISMAPPED,	WIN_MANAGER,	WIN_NAME,	WIN_PARENT,
1188 	WIN_POINTERX,	WIN_POINTERY,	WIN_POINTERXY,	WIN_REQHEIGHT,
1189 	WIN_REQWIDTH,	WIN_ROOTX,	WIN_ROOTY,	WIN_SCREEN,
1190 	WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,
1191 	WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,
1192 	WIN_TOPLEVEL,	WIN_VIEWABLE,	WIN_VISUAL,	WIN_VISUALID,
1193 	WIN_VROOTHEIGHT,WIN_VROOTWIDTH,	WIN_VROOTX,	WIN_VROOTY,
1194 	WIN_WIDTH,	WIN_X,		WIN_Y,
1195 
1196 	WIN_ATOM,	WIN_ATOMNAME,	WIN_CONTAINING,	WIN_INTERPS,
1197 	WIN_PATHNAME,
1198 
1199 	WIN_EXISTS,	WIN_FPIXELS,	WIN_PIXELS,	WIN_RGB,
1200 	WIN_VISUALSAVAILABLE
1201     };
1202 
1203     tkwin = (Tk_Window) clientData;
1204 
1205     if (objc < 2) {
1206 	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
1207 	return TCL_ERROR;
1208     }
1209     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
1210 	    &index) != TCL_OK) {
1211 	return TCL_ERROR;
1212     }
1213 
1214     if (index < WIN_ATOM) {
1215 	if (objc != 3) {
1216 	    Tcl_WrongNumArgs(interp, 2, objv, "window");
1217 	    return TCL_ERROR;
1218 	}
1219 	string = Tcl_GetString(objv[2]);
1220 	tkwin = Tk_NameToWindow(interp, string, tkwin);
1221 	if (tkwin == NULL) {
1222 	    return TCL_ERROR;
1223 	}
1224     }
1225     winPtr = (TkWindow *) tkwin;
1226     resultPtr = Tcl_GetObjResult(interp);
1227 
1228     switch ((enum options) index) {
1229     case WIN_CELLS:
1230 	Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
1231 	break;
1232     case WIN_CHILDREN: {
1233 	Tcl_Obj *strPtr;
1234 
1235 	winPtr = winPtr->childList;
1236 	for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
1237 	    if (!(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
1238 		strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
1239 		Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
1240 	    }
1241 	}
1242 	break;
1243     }
1244     case WIN_CLASS:
1245 	Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
1246 	break;
1247     case WIN_COLORMAPFULL:
1248 	Tcl_SetBooleanObj(resultPtr,
1249 		TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
1250 	break;
1251     case WIN_DEPTH:
1252 	Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
1253 	break;
1254     case WIN_GEOMETRY: {
1255 	char buf[16 + TCL_INTEGER_SPACE * 4];
1256 
1257 	sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
1258 		Tk_X(tkwin), Tk_Y(tkwin));
1259 	Tcl_SetStringObj(resultPtr, buf, -1);
1260 	break;
1261     }
1262     case WIN_HEIGHT:
1263 	Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
1264 	break;
1265     case WIN_ID: {
1266 	char buf[TCL_INTEGER_SPACE];
1267 
1268 	Tk_MakeWindowExist(tkwin);
1269 	TkpPrintWindowId(buf, Tk_WindowId(tkwin));
1270 
1271 	/*
1272 	 * interp result may have changed, refetch it
1273 	 */
1274 
1275 	resultPtr = Tcl_GetObjResult(interp);
1276 	Tcl_SetStringObj(resultPtr, buf, -1);
1277 	break;
1278     }
1279     case WIN_ISMAPPED:
1280 	Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
1281 	break;
1282     case WIN_MANAGER:
1283 	if (winPtr->geomMgrPtr != NULL) {
1284 	    Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
1285 	}
1286 	break;
1287     case WIN_NAME:
1288 	Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
1289 	break;
1290     case WIN_PARENT:
1291 	if (winPtr->parentPtr != NULL) {
1292 	    Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
1293 	}
1294 	break;
1295     case WIN_POINTERX:
1296 	useX = 1;
1297 	useY = 0;
1298 	goto pointerxy;
1299     case WIN_POINTERY:
1300 	useX = 0;
1301 	useY = 1;
1302 	goto pointerxy;
1303     case WIN_POINTERXY:
1304 	useX = 1;
1305 	useY = 1;
1306 
1307     pointerxy:
1308 	winPtr = GetTopHierarchy(tkwin);
1309 	if (winPtr == NULL) {
1310 	    x = -1;
1311 	    y = -1;
1312 	} else {
1313 	    TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
1314 	}
1315 	if (useX & useY) {
1316 	    char buf[TCL_INTEGER_SPACE * 2];
1317 
1318 	    sprintf(buf, "%d %d", x, y);
1319 	    Tcl_SetStringObj(resultPtr, buf, -1);
1320 	} else if (useX) {
1321 	    Tcl_SetIntObj(resultPtr, x);
1322 	} else {
1323 	    Tcl_SetIntObj(resultPtr, y);
1324 	}
1325 	break;
1326     case WIN_REQHEIGHT:
1327 	Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
1328 	break;
1329     case WIN_REQWIDTH:
1330 	Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
1331 	break;
1332     case WIN_ROOTX:
1333 	Tk_GetRootCoords(tkwin, &x, &y);
1334 	Tcl_SetIntObj(resultPtr, x);
1335 	break;
1336     case WIN_ROOTY:
1337 	Tk_GetRootCoords(tkwin, &x, &y);
1338 	Tcl_SetIntObj(resultPtr, y);
1339 	break;
1340     case WIN_SCREEN: {
1341 	char buf[TCL_INTEGER_SPACE];
1342 
1343 	sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
1344 	Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin),".",buf, NULL);
1345 	break;
1346     }
1347     case WIN_SCREENCELLS:
1348 	Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
1349 	break;
1350     case WIN_SCREENDEPTH:
1351 	Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
1352 	break;
1353     case WIN_SCREENHEIGHT:
1354 	Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
1355 	break;
1356     case WIN_SCREENWIDTH:
1357 	Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
1358 	break;
1359     case WIN_SCREENMMHEIGHT:
1360 	Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
1361 	break;
1362     case WIN_SCREENMMWIDTH:
1363 	Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
1364 	break;
1365     case WIN_SCREENVISUAL:
1366 	class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
1367 	goto visual;
1368     case WIN_SERVER:
1369 	TkGetServerInfo(interp, tkwin);
1370 	break;
1371     case WIN_TOPLEVEL:
1372 	winPtr = GetTopHierarchy(tkwin);
1373 	if (winPtr != NULL) {
1374 	    Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
1375 	}
1376 	break;
1377     case WIN_VIEWABLE: {
1378 	int viewable = 0;
1379 
1380 	for ( ; ; winPtr = winPtr->parentPtr) {
1381 	    if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
1382 		break;
1383 	    }
1384 	    if (winPtr->flags & TK_TOP_HIERARCHY) {
1385 		viewable = 1;
1386 		break;
1387 	    }
1388 	}
1389 
1390 	Tcl_SetBooleanObj(resultPtr, viewable);
1391 	break;
1392     }
1393     case WIN_VISUAL:
1394 	class = Tk_Visual(tkwin)->class;
1395 
1396     visual:
1397 	string = TkFindStateString(visualMap, class);
1398 	if (string == NULL) {
1399 	    string = "unknown";
1400 	}
1401 	Tcl_SetStringObj(resultPtr, string, -1);
1402 	break;
1403     case WIN_VISUALID: {
1404 	char buf[TCL_INTEGER_SPACE];
1405 
1406 	sprintf(buf, "0x%x",
1407 		(unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
1408 	Tcl_SetStringObj(resultPtr, buf, -1);
1409 	break;
1410     }
1411     case WIN_VROOTHEIGHT:
1412 	Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1413 	Tcl_SetIntObj(resultPtr, height);
1414 	break;
1415     case WIN_VROOTWIDTH:
1416 	Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1417 	Tcl_SetIntObj(resultPtr, width);
1418 	break;
1419     case WIN_VROOTX:
1420 	Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1421 	Tcl_SetIntObj(resultPtr, x);
1422 	break;
1423     case WIN_VROOTY:
1424 	Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1425 	Tcl_SetIntObj(resultPtr, y);
1426 	break;
1427     case WIN_WIDTH:
1428 	Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
1429 	break;
1430     case WIN_X:
1431 	Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
1432 	break;
1433     case WIN_Y:
1434 	Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
1435 	break;
1436 
1437 	/*
1438 	 * Uses -displayof.
1439 	 */
1440 
1441     case WIN_ATOM:
1442 	skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1443 	if (skip < 0) {
1444 	    return TCL_ERROR;
1445 	}
1446 	if (objc - skip != 3) {
1447 	    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
1448 	    return TCL_ERROR;
1449 	}
1450 	objv += skip;
1451 	string = Tcl_GetString(objv[2]);
1452 	Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
1453 	break;
1454     case WIN_ATOMNAME: {
1455 	const char *name;
1456 	long id;
1457 
1458 	skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1459 	if (skip < 0) {
1460 	    return TCL_ERROR;
1461 	}
1462 	if (objc - skip != 3) {
1463 	    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
1464 	    return TCL_ERROR;
1465 	}
1466 	objv += skip;
1467 	if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
1468 	    return TCL_ERROR;
1469 	}
1470 	name = Tk_GetAtomName(tkwin, (Atom) id);
1471 	if (strcmp(name, "?bad atom?") == 0) {
1472 	    string = Tcl_GetString(objv[2]);
1473 	    Tcl_AppendStringsToObj(resultPtr,
1474 		    "no atom exists with id \"", string, "\"", NULL);
1475 	    return TCL_ERROR;
1476 	}
1477 	Tcl_SetStringObj(resultPtr, name, -1);
1478 	break;
1479     }
1480     case WIN_CONTAINING:
1481 	skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1482 	if (skip < 0) {
1483 	    return TCL_ERROR;
1484 	}
1485 	if (objc - skip != 4) {
1486 	    Tcl_WrongNumArgs(interp, 2, objv,
1487 		    "?-displayof window? rootX rootY");
1488 	    return TCL_ERROR;
1489 	}
1490 	objv += skip;
1491 	string = Tcl_GetString(objv[2]);
1492 	if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {
1493 	    return TCL_ERROR;
1494 	}
1495 	string = Tcl_GetString(objv[3]);
1496 	if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
1497 	    return TCL_ERROR;
1498 	}
1499 	tkwin = Tk_CoordsToWindow(x, y, tkwin);
1500 	if (tkwin != NULL) {
1501 	    Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
1502 	}
1503 	break;
1504     case WIN_INTERPS:
1505 	skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1506 	if (skip < 0) {
1507 	    return TCL_ERROR;
1508 	}
1509 	if (objc - skip != 2) {
1510 	    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
1511 	    return TCL_ERROR;
1512 	}
1513 	return TkGetInterpNames(interp, tkwin);
1514     case WIN_PATHNAME: {
1515 	Window id;
1516 
1517 	skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1518 	if (skip < 0) {
1519 	    return TCL_ERROR;
1520 	}
1521 	if (objc - skip != 3) {
1522 	    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
1523 	    return TCL_ERROR;
1524 	}
1525 	string = Tcl_GetString(objv[2 + skip]);
1526 	if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
1527 	    return TCL_ERROR;
1528 	}
1529 	winPtr = (TkWindow *)Tk_IdToWindow(Tk_Display(tkwin), id);
1530 	if ((winPtr == NULL) ||
1531 		(winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
1532 	    Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
1533 		    "\" doesn't exist in this application", NULL);
1534 	    return TCL_ERROR;
1535 	}
1536 
1537 	/*
1538 	 * If the window is a utility window with no associated path (such as
1539 	 * a wrapper window or send communication window), just return an
1540 	 * empty string.
1541 	 */
1542 
1543 	tkwin = (Tk_Window) winPtr;
1544 	if (Tk_PathName(tkwin) != NULL) {
1545 	    Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
1546 	}
1547 	break;
1548     }
1549 
1550 	/*
1551 	 * objv[3] is window.
1552 	 */
1553 
1554     case WIN_EXISTS: {
1555 	int alive;
1556 
1557 	if (objc != 3) {
1558 	    Tcl_WrongNumArgs(interp, 2, objv, "window");
1559 	    return TCL_ERROR;
1560 	}
1561 	string = Tcl_GetString(objv[2]);
1562 	winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
1563 	Tcl_ResetResult(interp);
1564 	resultPtr = Tcl_GetObjResult(interp);
1565 
1566 	alive = 1;
1567 	if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
1568 	    alive = 0;
1569 	}
1570 	Tcl_SetBooleanObj(resultPtr, alive);
1571 	break;
1572     }
1573     case WIN_FPIXELS: {
1574 	double mm, pixels;
1575 
1576 	if (objc != 4) {
1577 	    Tcl_WrongNumArgs(interp, 2, objv, "window number");
1578 	    return TCL_ERROR;
1579 	}
1580 	string = Tcl_GetString(objv[2]);
1581 	tkwin = Tk_NameToWindow(interp, string, tkwin);
1582 	if (tkwin == NULL) {
1583 	    return TCL_ERROR;
1584 	}
1585 	string = Tcl_GetString(objv[3]);
1586 	if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
1587 	    return TCL_ERROR;
1588 	}
1589 	pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
1590 		/ WidthMMOfScreen(Tk_Screen(tkwin));
1591 	Tcl_SetDoubleObj(resultPtr, pixels);
1592 	break;
1593     }
1594     case WIN_PIXELS: {
1595 	int pixels;
1596 
1597 	if (objc != 4) {
1598 	    Tcl_WrongNumArgs(interp, 2, objv, "window number");
1599 	    return TCL_ERROR;
1600 	}
1601 	string = Tcl_GetString(objv[2]);
1602 	tkwin = Tk_NameToWindow(interp, string, tkwin);
1603 	if (tkwin == NULL) {
1604 	    return TCL_ERROR;
1605 	}
1606 	string = Tcl_GetString(objv[3]);
1607 	if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
1608 	    return TCL_ERROR;
1609 	}
1610 	Tcl_SetIntObj(resultPtr, pixels);
1611 	break;
1612     }
1613     case WIN_RGB: {
1614 	XColor *colorPtr;
1615 	char buf[TCL_INTEGER_SPACE * 3];
1616 
1617 	if (objc != 4) {
1618 	    Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
1619 	    return TCL_ERROR;
1620 	}
1621 	string = Tcl_GetString(objv[2]);
1622 	tkwin = Tk_NameToWindow(interp, string, tkwin);
1623 	if (tkwin == NULL) {
1624 	    return TCL_ERROR;
1625 	}
1626 	string = Tcl_GetString(objv[3]);
1627 	colorPtr = Tk_GetColor(interp, tkwin, string);
1628 	if (colorPtr == NULL) {
1629 	    return TCL_ERROR;
1630 	}
1631 	sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
1632 		colorPtr->blue);
1633 	Tk_FreeColor(colorPtr);
1634 	Tcl_SetStringObj(resultPtr, buf, -1);
1635 	break;
1636     }
1637     case WIN_VISUALSAVAILABLE: {
1638 	XVisualInfo template, *visInfoPtr;
1639 	int count, i;
1640 	int includeVisualId;
1641 	Tcl_Obj *strPtr;
1642 	char buf[16 + TCL_INTEGER_SPACE];
1643 	char visualIdString[TCL_INTEGER_SPACE];
1644 
1645 	if (objc == 3) {
1646 	    includeVisualId = 0;
1647 	} else if ((objc == 4)
1648 		&& (strcmp(Tcl_GetString(objv[3]), "includeids") == 0)) {
1649 	    includeVisualId = 1;
1650 	} else {
1651 	    Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");
1652 	    return TCL_ERROR;
1653 	}
1654 
1655 	string = Tcl_GetString(objv[2]);
1656 	tkwin = Tk_NameToWindow(interp, string, tkwin);
1657 	if (tkwin == NULL) {
1658 	    return TCL_ERROR;
1659 	}
1660 
1661 	template.screen = Tk_ScreenNumber(tkwin);
1662 	visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
1663 		&template, &count);
1664 	if (visInfoPtr == NULL) {
1665 	    Tcl_SetStringObj(resultPtr,
1666 		    "can't find any visuals for screen", -1);
1667 	    return TCL_ERROR;
1668 	}
1669 	for (i = 0; i < count; i++) {
1670 	    string = TkFindStateString(visualMap, visInfoPtr[i].class);
1671 	    if (string == NULL) {
1672 		strcpy(buf, "unknown");
1673 	    } else {
1674 		sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
1675 	    }
1676 	    if (includeVisualId) {
1677 		sprintf(visualIdString, " 0x%x",
1678 			(unsigned int) visInfoPtr[i].visualid);
1679 		strcat(buf, visualIdString);
1680 	    }
1681 	    strPtr = Tcl_NewStringObj(buf, -1);
1682 	    Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
1683 	}
1684 	XFree((char *) visInfoPtr);
1685 	break;
1686     }
1687     }
1688     return TCL_OK;
1689 }
1690 
1691 #if 0
1692 /*
1693  *----------------------------------------------------------------------
1694  *
1695  * Tk_WmObjCmd --
1696  *
1697  *	This function is invoked to process the "wm" Tcl command. See the user
1698  *	documentation for details on what it does.
1699  *
1700  * Results:
1701  *	A standard Tcl result.
1702  *
1703  * Side effects:
1704  *	See the user documentation.
1705  *
1706  *----------------------------------------------------------------------
1707  */
1708 
1709 	/* ARGSUSED */
1710 int
1711 Tk_WmObjCmd(
1712     ClientData clientData,	/* Main window associated with interpreter. */
1713     Tcl_Interp *interp,		/* Current interpreter. */
1714     int objc,			/* Number of arguments. */
1715     Tcl_Obj *const objv[])	/* Argument objects. */
1716 {
1717     Tk_Window tkwin;
1718     TkWindow *winPtr;
1719 
1720     static const char *optionStrings[] = {
1721 	"aspect",	"client",	"command",	"deiconify",
1722 	"focusmodel",	"frame",	"geometry",	"grid",
1723 	"group",	"iconbitmap",	"iconify",	"iconmask",
1724 	"iconname",	"iconposition",	"iconwindow",	"maxsize",
1725 	"minsize",	"overrideredirect",	"positionfrom",	"protocol",
1726 	"resizable",	"sizefrom",	"state",	"title",
1727 	"tracing",	"transient",	"withdraw",	NULL
1728     };
1729     enum options {
1730 	TKWM_ASPECT,	TKWM_CLIENT,	TKWM_COMMAND,	TKWM_DEICONIFY,
1731 	TKWM_FOCUSMOD,	TKWM_FRAME,	TKWM_GEOMETRY,	TKWM_GRID,
1732 	TKWM_GROUP,	TKWM_ICONBMP,	TKWM_ICONIFY,	TKWM_ICONMASK,
1733 	TKWM_ICONNAME,	TKWM_ICONPOS,	TKWM_ICONWIN,	TKWM_MAXSIZE,
1734 	TKWM_MINSIZE,	TKWM_OVERRIDE,	TKWM_POSFROM,	TKWM_PROTOCOL,
1735 	TKWM_RESIZABLE,	TKWM_SIZEFROM,	TKWM_STATE,	TKWM_TITLE,
1736 	TKWM_TRACING,	TKWM_TRANSIENT,	TKWM_WITHDRAW
1737     };
1738 
1739     tkwin = (Tk_Window) clientData;
1740 
1741     if (objc < 2) {
1742 	Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg?");
1743 	return TCL_ERROR;
1744     }
1745     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
1746 	    &index) != TCL_OK) {
1747 	return TCL_ERROR;
1748     }
1749 
1750     if (index == TKWM_TRACING) {
1751 	int wmTracing;
1752 	TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
1753 
1754 	if ((objc != 2) && (objc != 3)) {
1755 	    Tcl_WrongNumArgs(interp, 1, objv, "tracing ?boolean?");
1756 	    return TCL_ERROR;
1757 	}
1758 	if (objc == 2) {
1759 	    Tcl_SetObjResult(interp,
1760 		    Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING));
1761 	    return TCL_OK;
1762 	}
1763 	if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
1764 	    return TCL_ERROR;
1765 	}
1766 	if (wmTracing) {
1767 	    dispPtr->flags |= TK_DISPLAY_WM_TRACING;
1768 	} else {
1769 	    dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
1770 	}
1771 	return TCL_OK;
1772     }
1773 
1774     if (objc < 3) {
1775 	Tcl_WrongNumArgs(interp, 2, objv, "window ?arg?");
1776 	return TCL_ERROR;
1777     }
1778 
1779     winPtr = (TkWindow *) Tk_NameToWindow(interp,
1780 	    Tcl_GetString(objv[2]), tkwin);
1781     if (winPtr == NULL) {
1782 	return TCL_ERROR;
1783     }
1784     if (!(winPtr->flags & TK_TOP_LEVEL)) {
1785 	Tcl_AppendResult(interp, "window \"", winPtr->pathName,
1786 		"\" isn't a top-level window", NULL);
1787 	return TCL_ERROR;
1788     }
1789 
1790     switch ((enum options) index) {
1791     case TKWM_ASPECT:
1792 	TkpWmAspectCmd(interp, tkwin, winPtr, objc, objv);
1793 	break;
1794     case TKWM_CLIENT:
1795 	TkpWmClientCmd(interp, tkwin, winPtr, objc, objv);
1796 	break;
1797     case TKWM_COMMAND:
1798 	TkpWmCommandCmd(interp, tkwin, winPtr, objc, objv);
1799 	break;
1800     case TKWM_DEICONIFY:
1801 	TkpWmDeiconifyCmd(interp, tkwin, winPtr, objc, objv);
1802 	break;
1803     case TKWM_FOCUSMOD:
1804 	TkpWmFocusmodCmd(interp, tkwin, winPtr, objc, objv);
1805 	break;
1806     case TKWM_FRAME:
1807 	TkpWmFrameCmd(interp, tkwin, winPtr, objc, objv);
1808 	break;
1809     case TKWM_GEOMETRY:
1810 	TkpWmGeometryCmd(interp, tkwin, winPtr, objc, objv);
1811 	break;
1812     case TKWM_GRID:
1813 	TkpWmGridCmd(interp, tkwin, winPtr, objc, objv);
1814 	break;
1815     case TKWM_GROUP:
1816 	TkpWmGroupCmd(interp, tkwin, winPtr, objc, objv);
1817 	break;
1818     case TKWM_ICONBMP:
1819 	TkpWmIconbitmapCmd(interp, tkwin, winPtr, objc, objv);
1820 	break;
1821     case TKWM_ICONIFY:
1822 	TkpWmIconifyCmd(interp, tkwin, winPtr, objc, objv);
1823 	break;
1824     case TKWM_ICONMASK:
1825 	TkpWmIconmaskCmd(interp, tkwin, winPtr, objc, objv);
1826 	break;
1827     case TKWM_ICONNAME:
1828 	/*
1829 	 * Slight Unix variation.
1830 	 */
1831 	TkpWmIconnameCmd(interp, tkwin, winPtr, objc, objv);
1832 	break;
1833     case TKWM_ICONPOS:
1834 	/*
1835 	 * nearly same - 1 line more on Unix.
1836 	 */
1837 	TkpWmIconpositionCmd(interp, tkwin, winPtr, objc, objv);
1838 	break;
1839     case TKWM_ICONWIN:
1840 	TkpWmIconwindowCmd(interp, tkwin, winPtr, objc, objv);
1841 	break;
1842     case TKWM_MAXSIZE:
1843 	/*
1844 	 * Nearly same, win diffs.
1845 	 */
1846 	TkpWmMaxsizeCmd(interp, tkwin, winPtr, objc, objv);
1847 	break;
1848     case TKWM_MINSIZE:
1849 	/*
1850 	 * Nearly same, win diffs
1851 	 */
1852 	TkpWmMinsizeCmd(interp, tkwin, winPtr, objc, objv);
1853 	break;
1854     case TKWM_OVERRIDE:
1855 	/*
1856 	 * Almost same.
1857 	 */
1858 	TkpWmOverrideCmd(interp, tkwin, winPtr, objc, objv);
1859 	break;
1860     case TKWM_POSFROM:
1861 	/*
1862 	 * Equal across platforms
1863 	 */
1864 	TkpWmPositionfromCmd(interp, tkwin, winPtr, objc, objv);
1865 	break;
1866     case TKWM_PROTOCOL:
1867 	/*
1868 	 * Equal across platforms
1869 	 */
1870 	TkpWmProtocolCmd(interp, tkwin, winPtr, objc, objv);
1871 	break;
1872     case TKWM_RESIZABLE:
1873 	/*
1874 	 * Almost same
1875 	 */
1876 	TkpWmResizableCmd(interp, tkwin, winPtr, objc, objv);
1877 	break;
1878     case TKWM_SIZEFROM:
1879 	/*
1880 	 * Equal across platforms
1881 	 */
1882 	TkpWmSizefromCmd(interp, tkwin, winPtr, objc, objv);
1883 	break;
1884     case TKWM_STATE:
1885 	TkpWmStateCmd(interp, tkwin, winPtr, objc, objv);
1886 	break;
1887     case TKWM_TITLE:
1888 	TkpWmTitleCmd(interp, tkwin, winPtr, objc, objv);
1889 	break;
1890     case TKWM_TRANSIENT:
1891 	TkpWmTransientCmd(interp, tkwin, winPtr, objc, objv);
1892 	break;
1893     case TKWM_WITHDRAW:
1894 	TkpWmWithdrawCmd(interp, tkwin, winPtr, objc, objv);
1895 	break;
1896     }
1897 
1898   updateGeom:
1899     if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
1900 	Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
1901 	wmPtr->flags |= WM_UPDATE_PENDING;
1902     }
1903     return TCL_OK;
1904 }
1905 #endif
1906 
1907 /*
1908  *----------------------------------------------------------------------
1909  *
1910  * TkGetDisplayOf --
1911  *
1912  *	Parses a "-displayof window" option for various commands. If present,
1913  *	the literal "-displayof" should be in objv[0] and the window name in
1914  *	objv[1].
1915  *
1916  * Results:
1917  *	The return value is 0 if the argument strings did not contain the
1918  *	"-displayof" option. The return value is 2 if the argument strings
1919  *	contained both the "-displayof" option and a valid window name.
1920  *	Otherwise, the return value is -1 if the window name was missing or
1921  *	did not specify a valid window.
1922  *
1923  *	If the return value was 2, *tkwinPtr is filled with the token for the
1924  *	window specified on the command line. If the return value was -1, an
1925  *	error message is left in interp's result object.
1926  *
1927  * Side effects:
1928  *	None.
1929  *
1930  *----------------------------------------------------------------------
1931  */
1932 
1933 int
TkGetDisplayOf(Tcl_Interp * interp,int objc,Tcl_Obj * const objv[],Tk_Window * tkwinPtr)1934 TkGetDisplayOf(
1935     Tcl_Interp *interp,		/* Interpreter for error reporting. */
1936     int objc,			/* Number of arguments. */
1937     Tcl_Obj *const objv[],	/* Argument objects. If it is present,
1938 				 * "-displayof" should be in objv[0] and
1939 				 * objv[1] the name of a window. */
1940     Tk_Window *tkwinPtr)	/* On input, contains main window of
1941 				 * application associated with interp. On
1942 				 * output, filled with window specified as
1943 				 * option to "-displayof" argument, or
1944 				 * unmodified if "-displayof" argument was not
1945 				 * present. */
1946 {
1947     char *string;
1948     int length;
1949 
1950     if (objc < 1) {
1951 	return 0;
1952     }
1953     string = Tcl_GetStringFromObj(objv[0], &length);
1954     if ((length >= 2) &&
1955 	    (strncmp(string, "-displayof", (unsigned) length) == 0)) {
1956         if (objc < 2) {
1957 	    Tcl_SetStringObj(Tcl_GetObjResult(interp),
1958 		    "value for \"-displayof\" missing", -1);
1959 	    return -1;
1960 	}
1961 	*tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr);
1962 	if (*tkwinPtr == NULL) {
1963 	    return -1;
1964 	}
1965 	return 2;
1966     }
1967     return 0;
1968 }
1969 
1970 /*
1971  *----------------------------------------------------------------------
1972  *
1973  * TkDeadAppCmd --
1974  *
1975  *	If an application has been deleted then all Tk commands will be
1976  *	re-bound to this function.
1977  *
1978  * Results:
1979  *	A standard Tcl error is reported to let the user know that the
1980  *	application is dead.
1981  *
1982  * Side effects:
1983  *	See the user documentation.
1984  *
1985  *----------------------------------------------------------------------
1986  */
1987 
1988 	/* ARGSUSED */
1989 int
TkDeadAppCmd(ClientData clientData,Tcl_Interp * interp,int argc,const char ** argv)1990 TkDeadAppCmd(
1991     ClientData clientData,	/* Dummy. */
1992     Tcl_Interp *interp,		/* Current interpreter. */
1993     int argc,			/* Number of arguments. */
1994     const char **argv)		/* Argument strings. */
1995 {
1996     Tcl_AppendResult(interp, "can't invoke \"", argv[0],
1997 	    "\" command:  application has been destroyed", NULL);
1998     return TCL_ERROR;
1999 }
2000 
2001 /*
2002  *----------------------------------------------------------------------
2003  *
2004  * GetTopHierarchy --
2005  *
2006  *	Retrieves the top-of-hierarchy window which is the nearest ancestor of
2007  *	the specified window.
2008  *
2009  * Results:
2010  *	Returns the top-of-hierarchy window, or NULL if the window has no
2011  *	ancestor which is at the top of a physical window hierarchy.
2012  *
2013  * Side effects:
2014  *	None.
2015  *
2016  *----------------------------------------------------------------------
2017  */
2018 
2019 static TkWindow *
GetTopHierarchy(Tk_Window tkwin)2020 GetTopHierarchy(
2021     Tk_Window tkwin)		/* Window for which the top-of-hierarchy
2022 				 * ancestor should be deterined. */
2023 {
2024     TkWindow *winPtr = (TkWindow *) tkwin;
2025 
2026     while ((winPtr != NULL) && !(winPtr->flags & TK_TOP_HIERARCHY)) {
2027 	winPtr = winPtr->parentPtr;
2028     }
2029     return winPtr;
2030 }
2031 
2032 /*
2033  * Local Variables:
2034  * mode: c
2035  * c-basic-offset: 4
2036  * fill-column: 78
2037  * End:
2038  */
2039