sl@0: /* 
sl@0:  * tclMacBGMain.c --
sl@0:  *
sl@0:  *	Main program for Macintosh Background Only Application shells.
sl@0:  *
sl@0:  * Copyright (c) 1997 Sun Microsystems, Inc.
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclMacBOAMain.c,v 1.4 2001/12/28 23:36:31 dgp Exp $
sl@0:  */
sl@0: 
sl@0: #include "tcl.h"
sl@0: #include "tclInt.h"
sl@0: #include "tclMacInt.h"
sl@0: #include <Resources.h>
sl@0: #include <Notification.h>
sl@0: #include <Strings.h>
sl@0: 
sl@0: /*
sl@0:  * This variable is used to get out of the modal loop of the
sl@0:  * notification manager.
sl@0:  */
sl@0: 
sl@0: int NotificationIsDone = 0;
sl@0: 
sl@0: /*
sl@0:  * The following code ensures that tclLink.c is linked whenever
sl@0:  * Tcl is linked.  Without this code there's no reference to the
sl@0:  * code in that file from anywhere in Tcl, so it may not be
sl@0:  * linked into the application.
sl@0:  */
sl@0: 
sl@0: EXTERN int Tcl_LinkVar();
sl@0: int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
sl@0: 
sl@0: /*
sl@0:  * Declarations for various library procedures and variables (don't want
sl@0:  * to include tclPort.h here, because people might copy this file out of
sl@0:  * the Tcl source directory to make their own modified versions).
sl@0:  * Note:  "exit" should really be declared here, but there's no way to
sl@0:  * declare it without causing conflicts with other definitions elsewher
sl@0:  * on some systems, so it's better just to leave it out.
sl@0:  */
sl@0: 
sl@0: extern int		isatty _ANSI_ARGS_((int fd));
sl@0: extern char *		strcpy _ANSI_ARGS_((char *dst, CONST char *src));
sl@0: 
sl@0: static Tcl_Interp *interp;	/* Interpreter for application. */
sl@0: 
sl@0: /*
sl@0:  * Forward references for procedures defined later in this file:
sl@0:  */
sl@0: 
sl@0: void TclMacDoNotification(char *mssg);
sl@0: void TclMacNotificationResponse(NMRecPtr nmRec); 
sl@0: int Tcl_MacBGNotifyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv);
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_Main --
sl@0:  *
sl@0:  *	Main program for tclsh and most other Tcl-based applications.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None. This procedure never returns (it exits the process when
sl@0:  *	it's done.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	This procedure initializes the Tk world and then starts
sl@0:  *	interpreting commands;  almost anything could happen, depending
sl@0:  *	on the script being interpreted.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_Main(argc, argv, appInitProc)
sl@0:     int argc;			/* Number of arguments. */
sl@0:     char **argv;		/* Array of argument strings. */
sl@0:     Tcl_AppInitProc *appInitProc;
sl@0: 				/* Application-specific initialization
sl@0: 				 * procedure to call after most
sl@0: 				 * initialization but before starting to
sl@0: 				 * execute commands. */
sl@0: {
sl@0:     Tcl_Obj *prompt1NamePtr = NULL;
sl@0:     Tcl_Obj *prompt2NamePtr = NULL;
sl@0:     Tcl_Obj *commandPtr = NULL;
sl@0:     char buffer[1000], *args, *fileName;
sl@0:     int code, tty;
sl@0:     int exitCode = 0;
sl@0: 
sl@0:     Tcl_FindExecutable(argv[0]);
sl@0:     interp = Tcl_CreateInterp();
sl@0:     Tcl_InitMemory(interp);
sl@0: 
sl@0:     /*
sl@0:      * Make command-line arguments available in the Tcl variables "argc"
sl@0:      * and "argv".  If the first argument doesn't start with a "-" then
sl@0:      * strip it off and use it as the name of a script file to process.
sl@0:      */
sl@0: 
sl@0:     fileName = NULL;
sl@0:     if ((argc > 1) && (argv[1][0] != '-')) {
sl@0: 	fileName = argv[1];
sl@0: 	argc--;
sl@0: 	argv++;
sl@0:     }
sl@0:     args = Tcl_Merge(argc-1, argv+1);
sl@0:     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
sl@0:     ckfree(args);
sl@0:     TclFormatInt(buffer, argc-1);
sl@0:     Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
sl@0:     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
sl@0: 	    TCL_GLOBAL_ONLY);
sl@0: 
sl@0:     /*
sl@0:      * Set the "tcl_interactive" variable.
sl@0:      */
sl@0: 
sl@0:     tty = isatty(0);
sl@0:     Tcl_SetVar(interp, "tcl_interactive",
sl@0: 	    ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
sl@0:     
sl@0:     /*
sl@0:      * Invoke application-specific initialization.
sl@0:      */
sl@0: 
sl@0:     if ((*appInitProc)(interp) != TCL_OK) {
sl@0: 	Tcl_DString errStr;
sl@0: 
sl@0: 	Tcl_DStringInit(&errStr);
sl@0: 	Tcl_DStringAppend(&errStr,
sl@0: 		"application-specific initialization failed: \n", -1);
sl@0: 	Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
sl@0: 	Tcl_DStringAppend(&errStr, "\n", 1);
sl@0: 	TclMacDoNotification(Tcl_DStringValue(&errStr));
sl@0: 	Tcl_DStringFree(&errStr);
sl@0: 	goto done;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Install the BGNotify command:
sl@0:      */
sl@0:     
sl@0:     if ( Tcl_CreateObjCommand(interp, "bgnotify", Tcl_MacBGNotifyObjCmd, NULL,
sl@0:              (Tcl_CmdDeleteProc *) NULL) == NULL) {
sl@0:         goto done;
sl@0:     }
sl@0:     
sl@0:     /*
sl@0:      * If a script file was specified then just source that file
sl@0:      * and quit.  In this Mac BG Application version, we will try the
sl@0:      * resource fork first, then the file system second...
sl@0:      */
sl@0: 
sl@0:     if (fileName != NULL) {
sl@0:         Str255 resName;
sl@0:         Handle resource;
sl@0:         
sl@0:         strcpy((char *) resName + 1, fileName);
sl@0:         resName[0] = strlen(fileName);
sl@0:         resource = GetNamedResource('TEXT',resName);
sl@0:         if (resource != NULL) {
sl@0:             code = Tcl_MacEvalResource(interp, fileName, -1, NULL);
sl@0:         } else {
sl@0:             code = Tcl_EvalFile(interp, fileName);
sl@0:         }
sl@0:         
sl@0: 	if (code != TCL_OK) {
sl@0:             Tcl_DString errStr;
sl@0:             
sl@0:             Tcl_DStringInit(&errStr);
sl@0:             Tcl_DStringAppend(&errStr, " Error sourcing resource or file: ", -1);
sl@0:             Tcl_DStringAppend(&errStr, fileName, -1);
sl@0:             Tcl_DStringAppend(&errStr, "\n\nError was: ", -1);
sl@0:             Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
sl@0:             TclMacDoNotification(Tcl_DStringValue(&errStr));
sl@0: 	    Tcl_DStringFree(&errStr);
sl@0:         }
sl@0: 	goto done;
sl@0:     }
sl@0: 
sl@0: 
sl@0:     /*
sl@0:      * Rather than calling exit, invoke the "exit" command so that
sl@0:      * users can replace "exit" with some other command to do additional
sl@0:      * cleanup on exit.  The Tcl_Eval call should never return.
sl@0:      */
sl@0: 
sl@0:     done:
sl@0:     if (commandPtr != NULL) {
sl@0: 	Tcl_DecrRefCount(commandPtr);
sl@0:     }
sl@0:     if (prompt1NamePtr != NULL) {
sl@0: 	Tcl_DecrRefCount(prompt1NamePtr);
sl@0:     }
sl@0:     if (prompt2NamePtr != NULL) {
sl@0: 	Tcl_DecrRefCount(prompt2NamePtr);
sl@0:     }
sl@0:     sprintf(buffer, "exit %d", exitCode);
sl@0:     Tcl_Eval(interp, buffer);
sl@0: }
sl@0: 
sl@0: /*----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclMacDoNotification --
sl@0:  *
sl@0:  *	This posts an error message using the Notification manager.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Post a Notification Manager dialog.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: void 
sl@0: TclMacDoNotification(mssg)
sl@0:     char *mssg;
sl@0: {
sl@0:     NMRec errorNot;
sl@0:     EventRecord *theEvent = NULL;
sl@0:     OSErr err;
sl@0:     char *ptr;
sl@0:     
sl@0:     errorNot.qType = nmType;
sl@0:     errorNot.nmMark = 0;
sl@0:     errorNot.nmIcon = 0;
sl@0:     errorNot.nmSound = (Handle) -1;
sl@0: 
sl@0:     for ( ptr = mssg; *ptr != '\0'; ptr++) {
sl@0:         if (*ptr == '\n') {
sl@0:             *ptr = '\r';
sl@0:         }
sl@0:     }
sl@0:         
sl@0:     c2pstr(mssg);
sl@0:     errorNot.nmStr = (StringPtr) mssg;
sl@0: 
sl@0:     errorNot.nmResp = NewNMProc(TclMacNotificationResponse);
sl@0:     errorNot.nmRefCon = SetCurrentA5();
sl@0:     
sl@0:     NotificationIsDone = 0;
sl@0:     
sl@0:     /*
sl@0:      * Cycle while waiting for the user to click on the
sl@0:      * notification box.  Don't take any events off the event queue,
sl@0:      * since we want Tcl to do this but we want to block till the notification
sl@0:      * has been handled...
sl@0:      */
sl@0:     
sl@0:     err = NMInstall(&errorNot);
sl@0:     if (err == noErr) { 
sl@0:         while (!NotificationIsDone) {
sl@0:             WaitNextEvent(0, theEvent, 20, NULL);
sl@0:         }
sl@0:         NMRemove(&errorNot);
sl@0:     }
sl@0:     	
sl@0:     p2cstr((unsigned char *) mssg);
sl@0: }
sl@0: 
sl@0: void 
sl@0: TclMacNotificationResponse(nmRec) 
sl@0:     NMRecPtr nmRec;
sl@0: {
sl@0:     int curA5;
sl@0:     
sl@0:     curA5 = SetCurrentA5();
sl@0:     SetA5(nmRec->nmRefCon);
sl@0:     
sl@0:     NotificationIsDone = 1;
sl@0:     
sl@0:     SetA5(curA5);
sl@0:     
sl@0: }
sl@0: 
sl@0: int 
sl@0: Tcl_MacBGNotifyObjCmd(clientData, interp, objc, objv)
sl@0:     ClientData clientData;
sl@0:     Tcl_Interp *interp;
sl@0:     int objc;
sl@0:     Tcl_Obj **objv;	
sl@0: {
sl@0:     Tcl_Obj *resultPtr;
sl@0:     
sl@0:     resultPtr = Tcl_GetObjResult(interp);
sl@0:     
sl@0:     if ( objc != 2 ) {
sl@0:         Tcl_WrongNumArgs(interp, 1, objv, "message");
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0:     
sl@0:     TclMacDoNotification(Tcl_GetString(objv[1]));
sl@0:     return TCL_OK;
sl@0:            
sl@0: }
sl@0: