]> git.zerfleddert.de Git - micropolis/blame - src/tk/main.c
Import Micropolis from http://www.donhopkins.com/home/micropolis/
[micropolis] / src / tk / main.c
CommitLineData
6a5fa4e0
MG
1/*
2 * main.c --
3 *
4 * A simple program to test the toolkit facilities.
5 *
6 * Copyright 1990-1992 Regents of the University of California.
7 * Permission to use, copy, modify, and distribute this
8 * software and its documentation for any purpose and without
9 * fee is hereby granted, provided that the above copyright
10 * notice appear in all copies. The University of California
11 * makes no representations about the suitability of this
12 * software for any purpose. It is provided "as is" without
13 * express or implied warranty.
14 */
15
16#ifndef lint
17static char rcsid[] = "$Header: /user6/ouster/wish/RCS/main.c,v 1.68 92/05/07 08:52:02 ouster Exp $ SPRITE (Berkeley)";
18#endif
19
20#include "tkconfig.h"
21#include "tkint.h"
22
23/*
24 * Declarations for library procedures:
25 */
26
27extern int isatty();
28
29/*
30 * Command used to initialize wish:
31 */
32
33char initCmd[] = "source $tk_library/wish.tcl";
34
35Tk_Window w; /* NULL means window has been deleted. */
36Tk_TimerToken timeToken = 0;
37int idleHandler = 0;
38Tcl_Interp *interp;
39int x, y;
40Tcl_CmdBuf buffer;
41int tty;
42extern int Tk_SquareCmd _ANSI_ARGS_((ClientData clientData,
43 Tcl_Interp *interp, int argc, char **argv));
44
45/*
46 * Information for testing out command-line options:
47 */
48
49int synchronize = 0;
50char *fileName = NULL;
51char *name = NULL;
52char *display = NULL;
53char *geometry = NULL;
54
55Tk_ArgvInfo argTable[] = {
56 {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
57 "File from which to read commands"},
58 {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
59 "Initial geometry for window"},
60 {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
61 "Display to use"},
62 {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
63 "Name to use for application"},
64 {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
65 "Use synchronous mode for display server"},
66 {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
67 (char *) NULL}
68};
69
70 /* ARGSUSED */
71void
72StdinProc(clientData, mask)
73 ClientData clientData; /* Not used. */
74 int mask;
75{
76 char line[200];
77 static int gotPartial = 0;
78 char *cmd;
79 int result;
80
81 if (mask & TK_READABLE) {
82 if (fgets(line, 200, stdin) == NULL) {
83 if (!gotPartial) {
84 if (tty) {
85 Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
86 exit(0);
87 } else {
88 Tk_DeleteFileHandler(0);
89 }
90 return;
91 } else {
92 line[0] = 0;
93 }
94 }
95 cmd = Tcl_AssembleCmd(buffer, line);
96 if (cmd == NULL) {
97 gotPartial = 1;
98 return;
99 }
100 gotPartial = 0;
101 result = Tcl_RecordAndEval(interp, cmd, 0);
102 if (*interp->result != 0) {
103 if ((result != TCL_OK) || (tty)) {
104 printf("%s\n", interp->result);
105 }
106 }
107 if (tty) {
108 printf("wish: ");
109 fflush(stdout);
110 }
111 }
112}
113
114 /* ARGSUSED */
115static void
116StructureProc(clientData, eventPtr)
117 ClientData clientData; /* Information about window. */
118 XEvent *eventPtr; /* Information about event. */
119{
120 if (eventPtr->type == DestroyNotify) {
121 w = NULL;
122 }
123}
124
125/*
126 * Procedure to map initial window. This is invoked as a do-when-idle
127 * handler. Wait for all other when-idle handlers to be processed
128 * before mapping the window, so that the window's correct geometry
129 * has been determined.
130 */
131
132 /* ARGSUSED */
133static void
134DelayedMap(clientData)
135 ClientData clientData; /* Not used. */
136{
137
138 while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
139 /* Empty loop body. */
140 }
141 if (w == NULL) {
142 return;
143 }
144 Tk_MapWindow(w);
145}
146
147 /* ARGSUSED */
148int
149DotCmd(dummy, interp, argc, argv)
150 ClientData dummy; /* Not used. */
151 Tcl_Interp *interp; /* Current interpreter. */
152 int argc; /* Number of arguments. */
153 char **argv; /* Argument strings. */
154{
155 int x, y;
156
157 if (argc != 3) {
158 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
159 " x y\"", (char *) NULL);
160 return TCL_ERROR;
161 }
162 x = strtol(argv[1], (char **) NULL, 0);
163 y = strtol(argv[2], (char **) NULL, 0);
164 Tk_MakeWindowExist(w);
165 XDrawPoint(Tk_Display(w), Tk_WindowId(w),
166 DefaultGCOfScreen(Tk_Screen(w)), x, y);
167 return TCL_OK;
168}
169
170 /* ARGSUSED */
171int
172MovetoCmd(dummy, interp, argc, argv)
173 ClientData dummy; /* Not used. */
174 Tcl_Interp *interp; /* Current interpreter. */
175 int argc; /* Number of arguments. */
176 char **argv; /* Argument strings. */
177{
178 if (argc != 3) {
179 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
180 " x y\"", (char *) NULL);
181 return TCL_ERROR;
182 }
183 x = strtol(argv[1], (char **) NULL, 0);
184 y = strtol(argv[2], (char **) NULL, 0);
185 return TCL_OK;
186}
187 /* ARGSUSED */
188int
189LinetoCmd(dummy, interp, argc, argv)
190 ClientData dummy; /* Not used. */
191 Tcl_Interp *interp; /* Current interpreter. */
192 int argc; /* Number of arguments. */
193 char **argv; /* Argument strings. */
194{
195 int newX, newY;
196
197 if (argc != 3) {
198 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
199 " x y\"", (char *) NULL);
200 return TCL_ERROR;
201 }
202 newX = strtol(argv[1], (char **) NULL, 0);
203 newY = strtol(argv[2], (char **) NULL, 0);
204 Tk_MakeWindowExist(w);
205 XDrawLine(Tk_Display(w), Tk_WindowId(w),
206 DefaultGCOfScreen(Tk_Screen(w)), x, y, newX, newY);
207 x = newX;
208 y = newY;
209 return TCL_OK;
210}
211
212int
213main(argc, argv)
214 int argc;
215 char **argv;
216{
217 char *args, *p, *msg;
218 char buf[20];
219 int result;
220 Tk_3DBorder border;
221
222 { extern char *TCL_Library, *TK_Library;
223 extern int TK_CreateColormap;
224 char *tcllib = getenv("TCL_LIBRARY");
225 char *tklib = getenv("TK_LIBRARY");
226 char *create = getenv("CREATE_COLORMAP");
227 if (tklib != NULL)
228 TK_Library = tklib;
229 if (tcllib != NULL)
230 TCL_Library = tcllib;
231 if (create != NULL)
232 TK_CreateColormap = 1;
233 }
234
235 interp = Tcl_CreateInterp();
236#ifdef TCL_MEM_DEBUG
237 Tcl_InitMemory(interp);
238#endif
239 if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
240 != TCL_OK) {
241 fprintf(stderr, "%s\n", interp->result);
242 exit(1);
243 }
244 if (name == NULL) {
245 if (fileName != NULL) {
246 p = fileName;
247 } else {
248 p = argv[0];
249 }
250 name = strrchr(p, '/');
251 if (name != NULL) {
252 name++;
253 } else {
254 name = p;
255 }
256 }
257 w = Tk_CreateMainWindow(interp, display, name);
258 if (w == NULL) {
259 fprintf(stderr, "%s\n", interp->result);
260 exit(1);
261 }
262 Tk_SetClass(w, "Tk");
263 Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
264 (ClientData) NULL);
265 Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
266 tty = isatty(0);
267
268 args = Tcl_Merge(argc-1, argv+1);
269 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
270 ckfree(args);
271 sprintf(buf, "%d", argc-1);
272 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
273
274 if (synchronize) {
275 XSynchronize(Tk_Display(w), True);
276 }
277 Tk_GeometryRequest(w, 200, 200);
278 border = Tk_Get3DBorder(interp, w, None, "#4eee94");
279 if (border == NULL) {
280 Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
281 Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
282 } else {
283 Tk_SetBackgroundFromBorder(w, border);
284 }
285 XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
286 BlackPixelOfScreen(Tk_Screen(w)));
287 Tcl_CreateCommand(interp, "dot", DotCmd, (ClientData) w,
288 (void (*)()) NULL);
289 Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) w,
290 (void (*)()) NULL);
291 Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) w,
292 (void (*)()) NULL);
293#ifdef SQUARE_DEMO
294 Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData) w,
295 (void (*)()) NULL);
296#endif
297 if (geometry != NULL) {
298 Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
299 }
300 result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
301 if (result != TCL_OK) {
302 goto error;
303 }
304 if (fileName != NULL) {
305 result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
306 if (result != TCL_OK) {
307 goto error;
308 }
309 tty = 0;
310 } else {
311 tty = isatty(0);
312 Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
313 if (tty) {
314 printf("wish: ");
315 }
316 }
317 fflush(stdout);
318 buffer = Tcl_CreateCmdBuf();
319 (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
320
321 Tk_MainLoop();
322 Tcl_DeleteInterp(interp);
323 Tcl_DeleteCmdBuf(buffer);
324 exit(0);
325
326error:
327 msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
328 if (msg == NULL) {
329 msg = interp->result;
330 }
331 fprintf(stderr, "%s\n", msg);
332 Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
333 exit(1);
334}
Impressum, Datenschutz