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