cvs.zerfleddert.de Git - micropolis/blob - src/tk/main.c

   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
  17 static 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
  27 extern int isatty(int);
  28
  29 /*
  30  * Command used to initialize wish:
  31  */
  32
  33 char initCmd[] = "source $tk_library/wish.tcl";
  34
  35 Tk_Window w;                    /* NULL means window has been deleted. */
  36 Tk_TimerToken timeToken = 0;
  37 int idleHandler = 0;
  38 Tcl_Interp *interp;
  39 int x, y;
  40 Tcl_CmdBuf buffer;
  41 int tty;
  42 extern 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
  49 int synchronize = 0;
  50 char *fileName = NULL;
  51 char *name = NULL;
  52 char *display = NULL;
  53 char *geometry = NULL;
  54
  55 Tk_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 */
  71 void
  72 StdinProc (
  73     ClientData clientData,              /* Not used. */
  74     int mask
  75 )
  76 {
  77     char line[200];
  78     static int gotPartial = 0;
  79     char *cmd;
  80     int result;
  81
  82     if (mask & TK_READABLE) {
  83         if (fgets(line, 200, stdin) == NULL) {
  84             if (!gotPartial) {
  85                 if (tty) {
  86                     Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
  87                     exit(0);
  88                 } else {
  89                     Tk_DeleteFileHandler(0);
  90                 }
  91                 return;
  92             } else {
  93                 line[0] = 0;
  94             }
  95         }
  96         cmd = Tcl_AssembleCmd(buffer, line);
  97         if (cmd == NULL) {
  98             gotPartial = 1;
  99             return;
 100         }
 101         gotPartial = 0;
 102         result = Tcl_RecordAndEval(interp, cmd, 0);
 103         if (*interp->result != 0) {
 104             if ((result != TCL_OK) || (tty)) {
 105                 printf("%s\n", interp->result);
 106             }
 107         }
 108         if (tty) {
 109             printf("wish: ");
 110             fflush(stdout);
 111         }
 112     }
 113 }
 114
 115         /* ARGSUSED */
 116 static void
 117 StructureProc (
 118     ClientData clientData,      /* Information about window. */
 119     XEvent *eventPtr            /* Information about event. */
 120 )
 121 {
 122     if (eventPtr->type == DestroyNotify) {
 123         w = NULL;
 124     }
 125 }
 126
 127 /*
 128  * Procedure to map initial window.  This is invoked as a do-when-idle
 129  * handler.  Wait for all other when-idle handlers to be processed
 130  * before mapping the window, so that the window's correct geometry
 131  * has been determined.
 132  */
 133
 134         /* ARGSUSED */
 135 static void
 136 DelayedMap (
 137     ClientData clientData       /* Not used. */
 138 )
 139 {
 140
 141     while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
 142         /* Empty loop body. */
 143     }
 144     if (w == NULL) {
 145         return;
 146     }
 147     Tk_MapWindow(w);
 148 }
 149
 150         /* ARGSUSED */
 151 int
 152 DotCmd (
 153     ClientData dummy,                   /* Not used. */
 154     Tcl_Interp *interp,                 /* Current interpreter. */
 155     int argc,                           /* Number of arguments. */
 156     char **argv                 /* Argument strings. */
 157 )
 158 {
 159     int x, y;
 160
 161     if (argc != 3) {
 162         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 163                 " x y\"", (char *) NULL);
 164         return TCL_ERROR;
 165     }
 166     x = strtol(argv[1], (char **) NULL, 0);
 167     y = strtol(argv[2], (char **) NULL, 0);
 168     Tk_MakeWindowExist(w);
 169     XDrawPoint(Tk_Display(w), Tk_WindowId(w),
 170             DefaultGCOfScreen(Tk_Screen(w)), x, y);
 171     return TCL_OK;
 172 }
 173
 174         /* ARGSUSED */
 175 int
 176 MovetoCmd (
 177     ClientData dummy,                   /* Not used. */
 178     Tcl_Interp *interp,                 /* Current interpreter. */
 179     int argc,                           /* Number of arguments. */
 180     char **argv                 /* Argument strings. */
 181 )
 182 {
 183     if (argc != 3) {
 184         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 185                 " x y\"", (char *) NULL);
 186         return TCL_ERROR;
 187     }
 188     x = strtol(argv[1], (char **) NULL, 0);
 189     y = strtol(argv[2], (char **) NULL, 0);
 190     return TCL_OK;
 191 }
 192         /* ARGSUSED */
 193 int
 194 LinetoCmd (
 195     ClientData dummy,                   /* Not used. */
 196     Tcl_Interp *interp,                 /* Current interpreter. */
 197     int argc,                           /* Number of arguments. */
 198     char **argv                 /* Argument strings. */
 199 )
 200 {
 201     int newX, newY;
 202
 203     if (argc != 3) {
 204         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 205                 " x y\"", (char *) NULL);
 206         return TCL_ERROR;
 207     }
 208     newX = strtol(argv[1], (char **) NULL, 0);
 209     newY = strtol(argv[2], (char **) NULL, 0);
 210     Tk_MakeWindowExist(w);
 211     XDrawLine(Tk_Display(w), Tk_WindowId(w),
 212             DefaultGCOfScreen(Tk_Screen(w)), x, y, newX, newY);
 213     x = newX;
 214     y = newY;
 215     return TCL_OK;
 216 }
 217
 218 int
 219 main (int argc, char **argv)
 220 {
 221     char *args, *p, *msg;
 222     char buf[20];
 223     int result;
 224     Tk_3DBorder border;
 225
 226     { extern char *TCL_Library, *TK_Library;
 227       extern int TK_CreateColormap;
 228       char *tcllib = getenv("TCL_LIBRARY");
 229       char *tklib = getenv("TK_LIBRARY");
 230       char *create = getenv("CREATE_COLORMAP");
 231       if (tklib != NULL)
 232         TK_Library = tklib;
 233       if (tcllib != NULL)
 234         TCL_Library = tcllib;
 235       if (create != NULL)
 236         TK_CreateColormap = 1;
 237     }
 238
 239     interp = Tcl_CreateInterp();
 240 #ifdef TCL_MEM_DEBUG
 241     Tcl_InitMemory(interp);
 242 #endif
 243     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
 244             != TCL_OK) {
 245         fprintf(stderr, "%s\n", interp->result);
 246         exit(1);
 247     }
 248     if (name == NULL) {
 249         if (fileName != NULL) {
 250             p = fileName;
 251         } else {
 252             p = argv[0];
 253         }
 254         name = strrchr(p, '/');
 255         if (name != NULL) {
 256             name++;
 257         } else {
 258             name = p;
 259         }
 260     }
 261     w = Tk_CreateMainWindow(interp, display, name);
 262     if (w == NULL) {
 263         fprintf(stderr, "%s\n", interp->result);
 264         exit(1);
 265     }
 266     Tk_SetClass(w, "Tk");
 267     Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
 268             (ClientData) NULL);
 269     Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
 270     tty = isatty(0);
 271
 272     args = Tcl_Merge(argc-1, argv+1);
 273     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
 274     ckfree(args);
 275     sprintf(buf, "%d", argc-1);
 276     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
 277
 278     if (synchronize) {
 279         XSynchronize(Tk_Display(w), True);
 280     }
 281     Tk_GeometryRequest(w, 200, 200);
 282     border = Tk_Get3DBorder(interp, w, None, "#4eee94");
 283     if (border == NULL) {
 284         Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
 285         Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
 286     } else {
 287         Tk_SetBackgroundFromBorder(w, border);
 288     }
 289     XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
 290             BlackPixelOfScreen(Tk_Screen(w)));
 291     Tcl_CreateCommand(interp, "dot", DotCmd, (ClientData) w,
 292             (void (*)(int *)) NULL);
 293     Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) w,
 294             (void (*)(int *)) NULL);
 295     Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) w,
 296             (void (*)(int *)) NULL);
 297 #ifdef SQUARE_DEMO
 298     Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData) w,
 299             (void (*)(int *)) NULL);
 300 #endif
 301     if (geometry != NULL) {
 302         Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
 303     }
 304     result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
 305     if (result != TCL_OK) {
 306         goto error;
 307     }
 308     if (fileName != NULL) {
 309         result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
 310         if (result != TCL_OK) {
 311             goto error;
 312         }
 313         tty = 0;
 314     } else {
 315         tty = isatty(0);
 316         Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
 317         if (tty) {
 318             printf("wish: ");
 319         }
 320     }
 321     fflush(stdout);
 322     buffer = Tcl_CreateCmdBuf();
 323     (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
 324
 325     Tk_MainLoop();
 326     Tcl_DeleteInterp(interp);
 327     Tcl_DeleteCmdBuf(buffer);
 328     exit(0);
 329
 330 error:
 331     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
 332     if (msg == NULL) {
 333         msg = interp->result;
 334     }
 335     fprintf(stderr, "%s\n", msg);
 336     Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
 337     exit(1);
 338 }