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();
  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(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 */
 115 static void
 116 StructureProc(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 */
 133 static void
 134 DelayedMap(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 */
 148 int
 149 DotCmd(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 */
 171 int
 172 MovetoCmd(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 */
 188 int
 189 LinetoCmd(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
 212 int
 213 main(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
 326 error:
 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 }