![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tkcmds.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tk|
Return to tkcmds.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tk |
1.1 root 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
18: static 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:
29: typedef 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:
43: static void AfterProc _ANSI_ARGS_((ClientData clientData));
44: static char * WaitVariableProc _ANSI_ARGS_((ClientData clientData,
45: Tcl_Interp *interp, char *name1, char *name2,
46: int flags));
47: static void WaitWindowProc _ANSI_ARGS_((ClientData clientData,
48: XEvent *eventPtr));
49:
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 */
68: int
69: Tk_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:
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:
142: static void
143: AfterProc(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:
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:
179: int
180: Tk_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:
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:
258: void
259: TkBindEventProc(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:
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:
296: int
297: Tk_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:
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 */
339: int
340: Tk_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:
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 */
407: int
408: Tk_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 */
468: static char *
469: WaitVariableProc(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:
482: static void
483: WaitWindowProc(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:
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:
511: int
512: Tk_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:
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 */
808: int
809: TkDeadAppCmd(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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.