Annotation of micropolis/src/tk/main.c, revision 1.1

1.1     ! root        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: }

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.