/[dtapublic]/to_be_filed/sf_code/esrgpcpj/shared/tk_base/tkcmds.c
ViewVC logotype

Contents of /to_be_filed/sf_code/esrgpcpj/shared/tk_base/tkcmds.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25