]> git.zerfleddert.de Git - micropolis/blame - src/tk/tkcmds.c
XINCLUDE: use /usr/X11R6/include everywhere
[micropolis] / src / tk / tkcmds.c
CommitLineData
6a5fa4e0
MG
1/*
2 * tkCmds.c --
3 *
4 * This file contains a collection of Tk-related Tcl commands
5 * that didn't fit in any particular file of the toolkit.
6 *
7 * Copyright 1990-1992 Regents of the University of California
8 * Permission to use, copy, modify, and distribute this
9 * software and its documentation for any purpose and without
10 * fee is hereby granted, provided that the above copyright
11 * notice appear in all copies. The University of California
12 * makes no representations about the suitability of this
13 * software for any purpose. It is provided "as is" without
14 * express or implied warranty.
15 */
16
17#ifndef lint
18static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkCmds.c,v 1.32 92/06/03 14:21:14 ouster Exp $ SPRITE (Berkeley)";
19#endif /* not lint */
20
21#include "tkconfig.h"
22#include "tkint.h"
23
24/*
25 * The data structure below is used by the "after" command to remember
26 * the command to be executed later.
27 */
28
29typedef struct {
30 Tcl_Interp *interp; /* Interpreter in which to execute command. */
31 char *command; /* Command to execute. Malloc'ed, so must
32 * be freed when structure is deallocated.
33 * NULL means nothing to execute. */
34 int *donePtr; /* If non-NULL indicates address of word to
35 * set to 1 when command has finally been
36 * executed. */
37} AfterInfo;
38
39/*
40 * Forward declarations for procedures defined later in this file:
41 */
42
43static void AfterProc _ANSI_ARGS_((ClientData clientData));
44static char * WaitVariableProc _ANSI_ARGS_((ClientData clientData,
45 Tcl_Interp *interp, char *name1, char *name2,
46 int flags));
47static void WaitWindowProc _ANSI_ARGS_((ClientData clientData,
48 XEvent *eventPtr));
49\f
50/*
51 *----------------------------------------------------------------------
52 *
53 * Tk_AfterCmd --
54 *
55 * This procedure is invoked to process the "after" Tcl command.
56 * See the user documentation for details on what it does.
57 *
58 * Results:
59 * A standard Tcl result.
60 *
61 * Side effects:
62 * See the user documentation.
63 *
64 *----------------------------------------------------------------------
65 */
66
67 /* ARGSUSED */
68int
69Tk_AfterCmd(clientData, interp, argc, argv)
70 ClientData clientData; /* Main window associated with
71 * interpreter. Not used.*/
72 Tcl_Interp *interp; /* Current interpreter. */
73 int argc; /* Number of arguments. */
74 char **argv; /* Argument strings. */
75{
76 int ms;
77 AfterInfo *afterPtr;
78 int done;
79
80 if (argc < 2) {
81 Tcl_AppendResult(interp, "wrong # args: should be \"",
82 argv[0], " milliseconds ?command? ?arg arg ...?\"",
83 (char *) NULL);
84 return TCL_ERROR;
85 }
86
87 if ((Tcl_GetInt(interp, argv[1], &ms) != TCL_OK) || (ms <= 0)) {
88 Tcl_AppendResult(interp, "bad milliseconds value \"",
89 argv[1], "\"", (char *) NULL);
90 return TCL_ERROR;
91 }
92 afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
93 afterPtr->interp = interp;
94 if (argc == 2) {
95 afterPtr->command = (char *) NULL;
96 done = 0;
97 afterPtr->donePtr = &done;
98 } else if (argc == 3) {
99 afterPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
100 strcpy(afterPtr->command, argv[2]);
101 afterPtr->donePtr = (int *) NULL;
102 } else {
103 afterPtr->command = Tcl_Concat(argc-2, argv+2);
104 afterPtr->donePtr = (int *) NULL;
105 }
106 Tk_CreateTimerHandler(ms, AfterProc, (ClientData) afterPtr);
107 if (argc == 2) {
108 while (!done) {
109 Tk_DoOneEvent(0);
110 }
111 }
112
113 /*
114 * Must reset interpreter result because it could have changed as
115 * part of events processed by Tk_DoOneEvent.
116 */
117
118 Tcl_ResetResult(interp);
119 return TCL_OK;
120}
121\f
122/*
123 *----------------------------------------------------------------------
124 *
125 * AfterProc --
126 *
127 * Timer callback to execute commands registered with the
128 * "after" command.
129 *
130 * Results:
131 * None.
132 *
133 * Side effects:
134 * Executes whatever command was specified. If the command
135 * returns an error, then the command "tkerror" is invoked
136 * to process the error; if tkerror fails then information
137 * about the error is output on stderr.
138 *
139 *----------------------------------------------------------------------
140 */
141
142static void
143AfterProc(clientData)
144 ClientData clientData; /* Describes command to execute. */
145{
146 AfterInfo *afterPtr = (AfterInfo *) clientData;
147 int result;
148
149 if (afterPtr->command != NULL) {
150 result = Tcl_GlobalEval(afterPtr->interp, afterPtr->command);
151 if (result != TCL_OK) {
152 TkBindError(afterPtr->interp);
153 }
154 ckfree(afterPtr->command);
155 }
156 if (afterPtr->donePtr != NULL) {
157 *afterPtr->donePtr = 1;
158 }
159 ckfree((char *) afterPtr);
160}
161\f
162/*
163 *----------------------------------------------------------------------
164 *
165 * Tk_BindCmd --
166 *
167 * This procedure is invoked to process the "bind" Tcl command.
168 * See the user documentation for details on what it does.
169 *
170 * Results:
171 * A standard Tcl result.
172 *
173 * Side effects:
174 * See the user documentation.
175 *
176 *----------------------------------------------------------------------
177 */
178
179int
180Tk_BindCmd(clientData, interp, argc, argv)
181 ClientData clientData; /* Main window associated with
182 * interpreter. */
183 Tcl_Interp *interp; /* Current interpreter. */
184 int argc; /* Number of arguments. */
185 char **argv; /* Argument strings. */
186{
187 Tk_Window tkwin = (Tk_Window) clientData;
188 TkWindow *winPtr;
189 ClientData object;
190
191 if ((argc < 2) || (argc > 4)) {
192 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
193 " window ?pattern? ?command?\"", (char *) NULL);
194 return TCL_ERROR;
195 }
196 if (argv[1][0] == '.') {
197 winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
198 if (winPtr == NULL) {
199 return TCL_ERROR;
200 }
201 object = (ClientData) winPtr->pathName;
202 } else {
203 winPtr = (TkWindow *) clientData;
204 object = (ClientData) Tk_GetUid(argv[1]);
205 }
206
207 if (argc == 4) {
208 int append = 0;
209 unsigned long mask;
210
211 if (argv[3][0] == 0) {
212 return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
213 object, argv[2]);
214 }
215 if (argv[3][0] == '+') {
216 argv[3]++;
217 append = 1;
218 }
219 mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
220 object, argv[2], argv[3], append);
221 if (mask == 0) {
222 return TCL_ERROR;
223 }
224 } else if (argc == 3) {
225 char *command;
226
227 command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
228 object, argv[2]);
229 if (command == NULL) {
230 Tcl_ResetResult(interp);
231 return TCL_OK;
232 }
233 interp->result = command;
234 } else {
235 Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
236 }
237 return TCL_OK;
238}
239\f
240/*
241 *----------------------------------------------------------------------
242 *
243 * TkBindEventProc --
244 *
245 * This procedure is invoked by Tk_HandleEvent for each event; it
246 * causes any appropriate bindings for that event to be invoked.
247 *
248 * Results:
249 * None.
250 *
251 * Side effects:
252 * Depends on what bindings have been established with the "bind"
253 * command.
254 *
255 *----------------------------------------------------------------------
256 */
257
258void
259TkBindEventProc(winPtr, eventPtr)
260 TkWindow *winPtr; /* Pointer to info about window. */
261 XEvent *eventPtr; /* Information about event. */
262{
263 ClientData objects[3];
264 static Tk_Uid allUid = NULL;
265
266 if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
267 return;
268 }
269 objects[0] = (ClientData) winPtr->pathName;
270 objects[1] = (ClientData) winPtr->classUid;
271 if (allUid == NULL) {
272 allUid = Tk_GetUid("all");
273 }
274 objects[2] = (ClientData) allUid;
275 Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr,
276 (Tk_Window) winPtr, 3, objects);
277}
278\f
279/*
280 *----------------------------------------------------------------------
281 *
282 * Tk_DestroyCmd --
283 *
284 * This procedure is invoked to process the "destroy" Tcl command.
285 * See the user documentation for details on what it does.
286 *
287 * Results:
288 * A standard Tcl result.
289 *
290 * Side effects:
291 * See the user documentation.
292 *
293 *----------------------------------------------------------------------
294 */
295
296int
297Tk_DestroyCmd(clientData, interp, argc, argv)
298 ClientData clientData; /* Main window associated with
299 * interpreter. */
300 Tcl_Interp *interp; /* Current interpreter. */
301 int argc; /* Number of arguments. */
302 char **argv; /* Argument strings. */
303{
304 Tk_Window window;
305 Tk_Window tkwin = (Tk_Window) clientData;
306
307 if (argc != 2) {
308 Tcl_AppendResult(interp, "wrong # args: should be \"",
309 argv[0], " pathName\"", (char *) NULL);
310 return TCL_ERROR;
311 }
312
313 window = Tk_NameToWindow(interp, argv[1], tkwin);
314 if (window == NULL) {
315 return TCL_ERROR;
316 }
317 Tk_DestroyWindow(window);
318 return TCL_OK;
319}
320\f
321/*
322 *----------------------------------------------------------------------
323 *
324 * Tk_UpdateCmd --
325 *
326 * This procedure is invoked to process the "update" Tcl command.
327 * See the user documentation for details on what it does.
328 *
329 * Results:
330 * A standard Tcl result.
331 *
332 * Side effects:
333 * See the user documentation.
334 *
335 *----------------------------------------------------------------------
336 */
337
338 /* ARGSUSED */
339int
340Tk_UpdateCmd(clientData, interp, argc, argv)
341 ClientData clientData; /* Main window associated with
342 * interpreter. */
343 Tcl_Interp *interp; /* Current interpreter. */
344 int argc; /* Number of arguments. */
345 char **argv; /* Argument strings. */
346{
347 Tk_Window tkwin = (Tk_Window) clientData;
348 int flags;
349
350 if (argc == 1) {
351 flags = TK_DONT_WAIT;
352 } else if (argc == 2) {
353 if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
354 Tcl_AppendResult(interp, "bad argument \"", argv[1],
355 "\": must be idletasks", (char *) NULL);
356 return TCL_ERROR;
357 }
358 flags = TK_IDLE_EVENTS;
359 } else {
360 Tcl_AppendResult(interp, "wrong # args: should be \"",
361 argv[0], " ?idletasks?\"", (char *) NULL);
362 return TCL_ERROR;
363 }
364
365 /*
366 * Handle all pending events, sync the display, and repeat over
367 * and over again until all pending events have been handled.
368 */
369
370 while (1) {
371 while (Tk_DoOneEvent(flags) != 0) {
372 /* Empty loop body */
373 }
374 XSync(Tk_Display(tkwin), False);
375 if (Tk_DoOneEvent(flags) == 0) {
376 break;
377 }
378 }
379
380 /*
381 * Must clear the interpreter's result because event handlers could
382 * have executed commands.
383 */
384
385 Tcl_ResetResult(interp);
386 return TCL_OK;
387}
388\f
389/*
390 *----------------------------------------------------------------------
391 *
392 * Tk_TkwaitCmd --
393 *
394 * This procedure is invoked to process the "wait" Tcl command.
395 * See the user documentation for details on what it does.
396 *
397 * Results:
398 * A standard Tcl result.
399 *
400 * Side effects:
401 * See the user documentation.
402 *
403 *----------------------------------------------------------------------
404 */
405
406 /* ARGSUSED */
407int
408Tk_TkwaitCmd(clientData, interp, argc, argv)
409 ClientData clientData; /* Main window associated with
410 * interpreter. */
411 Tcl_Interp *interp; /* Current interpreter. */
412 int argc; /* Number of arguments. */
413 char **argv; /* Argument strings. */
414{
415 Tk_Window tkwin = (Tk_Window) clientData;
416 int c, length;
417 int done;
418
419 if (argc != 3) {
420 Tcl_AppendResult(interp, "wrong # args: should be \"",
421 argv[0], " variable|window name\"", (char *) NULL);
422 return TCL_ERROR;
423 }
424 c = argv[1][0];
425 length = strlen(argv[1]);
426 if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)) {
427 Tcl_TraceVar(interp, argv[2],
428 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
429 WaitVariableProc, (ClientData) &done);
430 done = 0;
431 while (!done) {
432 Tk_DoOneEvent(0);
433 }
434 Tcl_UntraceVar(interp, argv[2],
435 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
436 WaitVariableProc, (ClientData) &done);
437 } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
438 Tk_Window window;
439
440 window = Tk_NameToWindow(interp, argv[2], tkwin);
441 if (window == NULL) {
442 return TCL_ERROR;
443 }
444 Tk_CreateEventHandler(window, StructureNotifyMask,
445 WaitWindowProc, (ClientData) &done);
446 done = 0;
447 while (!done) {
448 Tk_DoOneEvent(0);
449 }
450 Tk_DeleteEventHandler(window, StructureNotifyMask,
451 WaitWindowProc, (ClientData) &done);
452 } else {
453 Tcl_AppendResult(interp, "bad option \"", argv[1],
454 "\": must be variable or window", (char *) NULL);
455 return TCL_ERROR;
456 }
457
458 /*
459 * Clear out the interpreter's result, since it may have been set
460 * by event handlers.
461 */
462
463 Tcl_ResetResult(interp);
464 return TCL_OK;
465}
466
467 /* ARGSUSED */
468static char *
469WaitVariableProc(clientData, interp, name1, name2, flags)
470 ClientData clientData; /* Pointer to integer to set to 1. */
471 Tcl_Interp *interp; /* Interpreter containing variable. */
472 char *name1; /* Name of variable. */
473 char *name2; /* Second part of variable name. */
474 int flags; /* Information about what happened. */
475{
476 int *donePtr = (int *) clientData;
477
478 *donePtr = 1;
479 return (char *) NULL;
480}
481
482static void
483WaitWindowProc(clientData, eventPtr)
484 ClientData clientData; /* Pointer to integer to set to 1. */
485 XEvent *eventPtr; /* Information about event. */
486{
487 int *donePtr = (int *) clientData;
488
489 if (eventPtr->type == DestroyNotify) {
490 *donePtr = 1;
491 }
492}
493\f
494/*
495 *----------------------------------------------------------------------
496 *
497 * Tk_WinfoCmd --
498 *
499 * This procedure is invoked to process the "winfo" Tcl command.
500 * See the user documentation for details on what it does.
501 *
502 * Results:
503 * A standard Tcl result.
504 *
505 * Side effects:
506 * See the user documentation.
507 *
508 *----------------------------------------------------------------------
509 */
510
511int
512Tk_WinfoCmd(clientData, interp, argc, argv)
513 ClientData clientData; /* Main window associated with
514 * interpreter. */
515 Tcl_Interp *interp; /* Current interpreter. */
516 int argc; /* Number of arguments. */
517 char **argv; /* Argument strings. */
518{
519 Tk_Window tkwin = (Tk_Window) clientData;
520 int length;
521 char c, *argName;
522 Tk_Window window;
523 register TkWindow *winPtr;
524
525#define SETUP(name) \
526 if (argc != 3) {\
527 argName = name; \
528 goto wrongArgs; \
529 } \
530 window = Tk_NameToWindow(interp, argv[2], tkwin); \
531 if (window == NULL) { \
532 return TCL_ERROR; \
533 }
534
535 if (argc < 2) {
536 Tcl_AppendResult(interp, "wrong # args: should be \"",
537 argv[0], " option ?arg?\"", (char *) NULL);
538 return TCL_ERROR;
539 }
540 c = argv[1][0];
541 length = strlen(argv[1]);
542 if ((c == 'a') && (strcmp(argv[1], "atom") == 0)) {
543 if (argc != 3) {
544 Tcl_AppendResult(interp, "wrong # args: should be \"",
545 argv[0], " atom name\"", (char *) NULL);
546 return TCL_ERROR;
547 }
548 sprintf(interp->result, "%d", Tk_InternAtom(tkwin, argv[2]));
549 } else if ((c == 'a') && (strncmp(argv[1], "atomname", length) == 0)
550 && (length >= 5)) {
551 Atom atom;
552 char *name;
553
554 if (argc != 3) {
555 Tcl_AppendResult(interp, "wrong # args: should be \"",
556 argv[0], " atomname id\"", (char *) NULL);
557 return TCL_ERROR;
558 }
559 if (Tcl_GetInt(interp, argv[2], (int *) &atom) != TCL_OK) {
560 return TCL_ERROR;
561 }
562 name = Tk_GetAtomName(tkwin, atom);
563 if (strcmp(name, "?bad atom?") == 0) {
564 Tcl_AppendResult(interp, "no atom exists with id \"",
565 argv[2], "\"", (char *) NULL);
566 return TCL_ERROR;
567 }
568 interp->result = name;
569 } else if ((c == 'c') && (strncmp(argv[1], "children", length) == 0)
570 && (length >= 2)) {
571 char *separator, *childName;
572
573 SETUP("children");
574 separator = "";
575 for (winPtr = ((TkWindow *) window)->childList; winPtr != NULL;
576 winPtr = winPtr->nextPtr) {
577 childName = Tcl_Merge(1, &winPtr->pathName);
578 Tcl_AppendResult(interp, separator, childName, (char *) NULL);
579 ckfree(childName);
580 separator = " ";
581 }
582 } else if ((c == 'c') && (strncmp(argv[1], "class", length) == 0)
583 && (length >= 2)) {
584 SETUP("class");
585 interp->result = Tk_Class(window);
586 } else if ((c == 'c') && (strncmp(argv[1], "containing", length) == 0)
587 && (length >= 2)) {
588 int rootX, rootY;
589
590 if (argc != 4) {
591 Tcl_AppendResult(interp, "wrong # args: should be \"",
592 argv[0], " containing rootX rootY\"", (char *) NULL);
593 return TCL_ERROR;
594 }
595 if ((Tk_GetPixels(interp, tkwin, argv[2], &rootX) != TCL_OK)
596 || (Tk_GetPixels(interp, tkwin, argv[3], &rootY) != TCL_OK)) {
597 return TCL_ERROR;
598 }
599 window = Tk_CoordsToWindow(rootX, rootY, tkwin);
600 if (window != NULL) {
601 interp->result = Tk_PathName(window);
602 }
603 } else if ((c == 'f') && (strncmp(argv[1], "fpixels", length) == 0)
604 && (length >= 2)) {
605 double mm, pixels;
606
607 if (argc != 4) {
608 Tcl_AppendResult(interp, "wrong # args: should be \"",
609 argv[0], " fpixels window number\"", (char *) NULL);
610 return TCL_ERROR;
611 }
612 window = Tk_NameToWindow(interp, argv[2], tkwin);
613 if (window == NULL) {
614 return TCL_ERROR;
615 }
616 if (Tk_GetScreenMM(interp, window, argv[3], &mm) != TCL_OK) {
617 return TCL_ERROR;
618 }
619 pixels = mm * WidthOfScreen(Tk_Screen(window))
620 / WidthMMOfScreen(Tk_Screen(window));
621 sprintf(interp->result, "%g", pixels);
622 } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)) {
623 SETUP("geometry");
624 sprintf(interp->result, "%dx%d+%d+%d", Tk_Width(window),
625 Tk_Height(window), Tk_X(window), Tk_Y(window));
626 } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {
627 SETUP("height");
628 sprintf(interp->result, "%d", Tk_Height(window));
629 } else if ((c == 'i') && (strcmp(argv[1], "id") == 0)) {
630 SETUP("id");
631 sprintf(interp->result, "0x%x", Tk_WindowId(window));
632 } else if ((c == 'i') && (strncmp(argv[1], "interps", length) == 0)
633 && (length >= 2)) {
634 if (argc != 2) {
635 Tcl_AppendResult(interp, "wrong # args: should be \"",
636 argv[1], " interps\"", (char *) NULL);
637 return TCL_ERROR;
638 }
639 return TkGetInterpNames(interp, tkwin);
640 } else if ((c == 'i') && (strncmp(argv[1], "ismapped", length) == 0)
641 && (length >= 2)) {
642 SETUP("ismapped");
643 interp->result = Tk_IsMapped(window) ? "1" : "0";
644 } else if ((c == 'n') && (strncmp(argv[1], "name", length) == 0)) {
645 SETUP("geometry");
646 interp->result = Tk_Name(window);
647 } else if ((c == 'p') && (strncmp(argv[1], "parent", length) == 0)) {
648 SETUP("geometry");
649 winPtr = (TkWindow *) window;
650 if (winPtr->parentPtr != NULL) {
651 interp->result = winPtr->parentPtr->pathName;
652 }
653 } else if ((c == 'p') && (strncmp(argv[1], "pathname", length) == 0)
654 && (length >= 2)) {
655 Window id;
656
657 if (argc != 3) {
658 argName = "pathname";
659 goto wrongArgs;
660 }
661 if (Tcl_GetInt(interp, argv[2], (int *) &id) != TCL_OK) {
662 return TCL_ERROR;
663 }
664 if ((XFindContext(Tk_Display(tkwin), id, tkWindowContext,
665 (void *) &window) != 0) || (((TkWindow *) window)->mainPtr
666 != ((TkWindow *) tkwin)->mainPtr)) {
667 Tcl_AppendResult(interp, "window id \"", argv[2],
668 "\" doesn't exist in this application", (char *) NULL);
669 return TCL_ERROR;
670 }
671 interp->result = Tk_PathName(window);
672 } else if ((c == 'p') && (strncmp(argv[1], "pixels", length) == 0)
673 && (length >= 2)) {
674 int pixels;
675
676 if (argc != 4) {
677 Tcl_AppendResult(interp, "wrong # args: should be \"",
678 argv[0], " pixels window number\"", (char *) NULL);
679 return TCL_ERROR;
680 }
681 window = Tk_NameToWindow(interp, argv[2], tkwin);
682 if (window == NULL) {
683 return TCL_ERROR;
684 }
685 if (Tk_GetPixels(interp, window, argv[3], &pixels) != TCL_OK) {
686 return TCL_ERROR;
687 }
688 sprintf(interp->result, "%d", pixels);
689 } else if ((c == 'r') && (strncmp(argv[1], "reqheight", length) == 0)
690 && (length >= 4)) {
691 SETUP("reqheight");
692 sprintf(interp->result, "%d", Tk_ReqHeight(window));
693 } else if ((c == 'r') && (strncmp(argv[1], "reqwidth", length) == 0)
694 && (length >= 4)) {
695 SETUP("reqwidth");
696 sprintf(interp->result, "%d", Tk_ReqWidth(window));
697 } else if ((c == 'r') && (strcmp(argv[1], "rootx") == 0)) {
698 int x, y;
699
700 SETUP("rootx");
701 Tk_GetRootCoords(window, &x, &y);
702 sprintf(interp->result, "%d", x);
703 } else if ((c == 'r') && (strcmp(argv[1], "rooty") == 0)) {
704 int x, y;
705
706 SETUP("rooty");
707 Tk_GetRootCoords(window, &x, &y);
708 sprintf(interp->result, "%d", y);
709 } else if ((c == 's') && (strcmp(argv[1], "screen") == 0)) {
710 char string[20];
711
712 SETUP("screen");
713 sprintf(string, "%d", Tk_ScreenNumber(window));
714 Tcl_AppendResult(interp, Tk_DisplayName(window), ".", string,
715 (char *) NULL);
716 } else if ((c == 's') && (strncmp(argv[1], "screencells", length) == 0)
717 && (length >= 7)) {
718 SETUP("screencells");
719 sprintf(interp->result, "%d", Tk_DefaultVisual(Tk_Screen(window))->map_entries);
720 } else if ((c == 's') && (strncmp(argv[1], "screendepth", length) == 0)
721 && (length >= 7)) {
722 SETUP("screendepth");
723 sprintf(interp->result, "%d", Tk_DefaultDepth(Tk_Screen(window)));
724 } else if ((c == 's') && (strncmp(argv[1], "screenheight", length) == 0)
725 && (length >= 7)) {
726 SETUP("screenheight");
727 sprintf(interp->result, "%d", HeightOfScreen(Tk_Screen(window)));
728 } else if ((c == 's') && (strncmp(argv[1], "screenmmheight", length) == 0)
729 && (length >= 9)) {
730 SETUP("screenmmheight");
731 sprintf(interp->result, "%d", HeightMMOfScreen(Tk_Screen(window)));
732 } else if ((c == 's') && (strncmp(argv[1], "screenmmwidth", length) == 0)
733 && (length >= 9)) {
734 SETUP("screenmmwidth");
735 sprintf(interp->result, "%d", WidthMMOfScreen(Tk_Screen(window)));
736 } else if ((c == 's') && (strncmp(argv[1], "screenvisual", length) == 0)
737 && (length >= 7)) {
738 SETUP("screenvisual");
739 switch (Tk_DefaultVisual(Tk_Screen(window))->class) {
740 case PseudoColor: interp->result = "pseudocolor"; break;
741 case GrayScale: interp->result = "grayscale"; break;
742 case DirectColor: interp->result = "directcolor"; break;
743 case TrueColor: interp->result = "truecolor"; break;
744 case StaticColor: interp->result = "staticcolor"; break;
745 case StaticGray: interp->result = "staticgray"; break;
746 default: interp->result = "unknown"; break;
747 }
748 } else if ((c == 's') && (strncmp(argv[1], "screenwidth", length) == 0)
749 && (length >= 7)) {
750 SETUP("screenwidth");
751 sprintf(interp->result, "%d", WidthOfScreen(Tk_Screen(window)));
752 } else if ((c == 's') && (strcmp(argv[1], "server") == 0)) {
753 SETUP("server");
754 Tcl_AppendResult(interp, Tk_DisplayName(window), (char *) NULL);
755 } else if ((c == 't') && (strncmp(argv[1], "toplevel", length) == 0)) {
756 SETUP("toplevel");
757 for (winPtr = (TkWindow *) window; !(winPtr->flags & TK_TOP_LEVEL);
758 winPtr = winPtr->parentPtr) {
759 /* Empty loop body. */
760 }
761 interp->result = winPtr->pathName;
762 } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {
763 SETUP("width");
764 sprintf(interp->result, "%d", Tk_Width(window));
765 } else if ((c == 'x') && (argv[1][1] == '\0')) {
766 SETUP("x");
767 sprintf(interp->result, "%d", Tk_X(window));
768 } else if ((c == 'y') && (argv[1][1] == '\0')) {
769 SETUP("y");
770 sprintf(interp->result, "%d", Tk_Y(window));
771 } else {
772 Tcl_AppendResult(interp, "bad option \"", argv[1],
773 "\": must be atom, atomname, children, class, fpixels, geometry, height, ",
774 "id, interps, ismapped, name, parent, pathname, ",
775 "pixels, reqheight, reqwidth, rootx, rooty, ",
776 "screen, screencells, screendepth, screenheight, ",
777 "screenmmheight, screenmmwidth, screenvisual, ",
778 "screenwidth, toplevel, width, x, or y", (char *) NULL);
779 return TCL_ERROR;
780 }
781 return TCL_OK;
782
783 wrongArgs:
784 Tcl_AppendResult(interp, "wrong # arguments: must be \"",
785 argv[0], " ", argName, " window\"", (char *) NULL);
786 return TCL_ERROR;
787}
788\f
789/*
790 *----------------------------------------------------------------------
791 *
792 * TkDeadAppCmd --
793 *
794 * If an application has been deleted then all Tk commands will be
795 * re-bound to this procedure.
796 *
797 * Results:
798 * A standard Tcl error is reported to let the user know that
799 * the application is dead.
800 *
801 * Side effects:
802 * See the user documentation.
803 *
804 *----------------------------------------------------------------------
805 */
806
807 /* ARGSUSED */
808int
809TkDeadAppCmd(clientData, interp, argc, argv)
810 ClientData clientData; /* Dummy. */
811 Tcl_Interp *interp; /* Current interpreter. */
812 int argc; /* Number of arguments. */
813 char **argv; /* Argument strings. */
814{
815 Tcl_AppendResult(interp, "can't invoke \"", argv[0],
816 "\" command: application has been destroyed", (char *) NULL);
817 return TCL_ERROR;
818}
Impressum, Datenschutz