/* 

  * tclMacBGMain.c --

  *

  *	Main program for Macintosh Background Only Application shells.

  *

  * Copyright (c) 1997 Sun Microsystems, Inc.

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclMacBOAMain.c,v 1.4 2001/12/28 23:36:31 dgp Exp $

  */

 #include "tcl.h"

 #include "tclInt.h"

 #include "tclMacInt.h"

 #include <Resources.h>

 #include <Notification.h>

 #include <Strings.h>

 /*

  * This variable is used to get out of the modal loop of the

  * notification manager.

  */

 int NotificationIsDone = 0;

 /*

  * The following code ensures that tclLink.c is linked whenever

  * Tcl is linked.  Without this code there's no reference to the

  * code in that file from anywhere in Tcl, so it may not be

  * linked into the application.

  */

 EXTERN int Tcl_LinkVar();

 int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;

 /*

  * Declarations for various library procedures and variables (don't want

  * to include tclPort.h here, because people might copy this file out of

  * the Tcl source directory to make their own modified versions).

  * Note:  "exit" should really be declared here, but there's no way to

  * declare it without causing conflicts with other definitions elsewher

  * on some systems, so it's better just to leave it out.

  */

 extern int		isatty _ANSI_ARGS_((int fd));

 extern char *		strcpy _ANSI_ARGS_((char *dst, CONST char *src));

 static Tcl_Interp *interp;	/* Interpreter for application. */

 /*

  * Forward references for procedures defined later in this file:

  */

 void TclMacDoNotification(char *mssg);

 void TclMacNotificationResponse(NMRecPtr nmRec); 

 int Tcl_MacBGNotifyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv);

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_Main --

  *

  *	Main program for tclsh and most other Tcl-based applications.

  *

  * Results:

  *	None. This procedure never returns (it exits the process when

  *	it's done.

  *

  * Side effects:

  *	This procedure initializes the Tk world and then starts

  *	interpreting commands;  almost anything could happen, depending

  *	on the script being interpreted.

  *

  *----------------------------------------------------------------------

  */

 void

 Tcl_Main(argc, argv, appInitProc)

     int argc;			/* Number of arguments. */

     char **argv;		/* Array of argument strings. */

     Tcl_AppInitProc *appInitProc;

 				/* Application-specific initialization

 				 * procedure to call after most

 				 * initialization but before starting to

 				 * execute commands. */

 {

     Tcl_Obj *prompt1NamePtr = NULL;

     Tcl_Obj *prompt2NamePtr = NULL;

     Tcl_Obj *commandPtr = NULL;

     char buffer[1000], *args, *fileName;

     int code, tty;

     int exitCode = 0;

     Tcl_FindExecutable(argv[0]);

     interp = Tcl_CreateInterp();

     Tcl_InitMemory(interp);

     /*

      * Make command-line arguments available in the Tcl variables "argc"

      * and "argv".  If the first argument doesn't start with a "-" then

      * strip it off and use it as the name of a script file to process.

      */

     fileName = NULL;

     if ((argc > 1) && (argv[1][0] != '-')) {

 	fileName = argv[1];

 	argc--;

 	argv++;

     }

     args = Tcl_Merge(argc-1, argv+1);

     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);

     ckfree(args);

     TclFormatInt(buffer, argc-1);

     Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);

     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],

 	    TCL_GLOBAL_ONLY);

     /*

      * Set the "tcl_interactive" variable.

      */

     tty = isatty(0);

     Tcl_SetVar(interp, "tcl_interactive",

 	    ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);

     /*

      * Invoke application-specific initialization.

      */

     if ((*appInitProc)(interp) != TCL_OK) {

 	Tcl_DString errStr;

 	Tcl_DStringInit(&errStr);

 	Tcl_DStringAppend(&errStr,

 		"application-specific initialization failed: \n", -1);

 	Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);

 	Tcl_DStringAppend(&errStr, "\n", 1);

 	TclMacDoNotification(Tcl_DStringValue(&errStr));

 	Tcl_DStringFree(&errStr);

 	goto done;

     }

     /*

      * Install the BGNotify command:

      */

     if ( Tcl_CreateObjCommand(interp, "bgnotify", Tcl_MacBGNotifyObjCmd, NULL,

              (Tcl_CmdDeleteProc *) NULL) == NULL) {

         goto done;

     }

     /*

      * If a script file was specified then just source that file

      * and quit.  In this Mac BG Application version, we will try the

      * resource fork first, then the file system second...

      */

     if (fileName != NULL) {

         Str255 resName;

         Handle resource;

         strcpy((char *) resName + 1, fileName);

         resName[0] = strlen(fileName);

         resource = GetNamedResource('TEXT',resName);

         if (resource != NULL) {

             code = Tcl_MacEvalResource(interp, fileName, -1, NULL);

         } else {

             code = Tcl_EvalFile(interp, fileName);

         }

 	if (code != TCL_OK) {

             Tcl_DString errStr;

             Tcl_DStringInit(&errStr);

             Tcl_DStringAppend(&errStr, " Error sourcing resource or file: ", -1);

             Tcl_DStringAppend(&errStr, fileName, -1);

             Tcl_DStringAppend(&errStr, "\n\nError was: ", -1);

             Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);

             TclMacDoNotification(Tcl_DStringValue(&errStr));

 	    Tcl_DStringFree(&errStr);

         }

 	goto done;

     }

     /*

      * Rather than calling exit, invoke the "exit" command so that

      * users can replace "exit" with some other command to do additional

      * cleanup on exit.  The Tcl_Eval call should never return.

      */

     done:

     if (commandPtr != NULL) {

 	Tcl_DecrRefCount(commandPtr);

     }

     if (prompt1NamePtr != NULL) {

 	Tcl_DecrRefCount(prompt1NamePtr);

     }

     if (prompt2NamePtr != NULL) {

 	Tcl_DecrRefCount(prompt2NamePtr);

     }

     sprintf(buffer, "exit %d", exitCode);

     Tcl_Eval(interp, buffer);

 }

 /*----------------------------------------------------------------------

  *

  * TclMacDoNotification --

  *

  *	This posts an error message using the Notification manager.

  *

  * Results:

  *	Post a Notification Manager dialog.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 void 

 TclMacDoNotification(mssg)

     char *mssg;

 {

     NMRec errorNot;

     EventRecord *theEvent = NULL;

     OSErr err;

     char *ptr;

     errorNot.qType = nmType;

     errorNot.nmMark = 0;

     errorNot.nmIcon = 0;

     errorNot.nmSound = (Handle) -1;

     for ( ptr = mssg; *ptr != '\0'; ptr++) {

         if (*ptr == '\n') {

             *ptr = '\r';

         }

     }

     c2pstr(mssg);

     errorNot.nmStr = (StringPtr) mssg;

     errorNot.nmResp = NewNMProc(TclMacNotificationResponse);

     errorNot.nmRefCon = SetCurrentA5();

     NotificationIsDone = 0;

     /*

      * Cycle while waiting for the user to click on the

      * notification box.  Don't take any events off the event queue,

      * since we want Tcl to do this but we want to block till the notification

      * has been handled...

      */

     err = NMInstall(&errorNot);

     if (err == noErr) { 

         while (!NotificationIsDone) {

             WaitNextEvent(0, theEvent, 20, NULL);

         }

         NMRemove(&errorNot);

     }

     p2cstr((unsigned char *) mssg);

 }

 void 

 TclMacNotificationResponse(nmRec) 

     NMRecPtr nmRec;

 {

     int curA5;

     curA5 = SetCurrentA5();

     SetA5(nmRec->nmRefCon);

     NotificationIsDone = 1;

     SetA5(curA5);

 }

 int 

 Tcl_MacBGNotifyObjCmd(clientData, interp, objc, objv)

     ClientData clientData;

     Tcl_Interp *interp;

     int objc;

     Tcl_Obj **objv;	

 {

     Tcl_Obj *resultPtr;

     resultPtr = Tcl_GetObjResult(interp);

     if ( objc != 2 ) {

         Tcl_WrongNumArgs(interp, 1, objv, "message");

         return TCL_ERROR;

     }

     TclMacDoNotification(Tcl_GetString(objv[1]));

     return TCL_OK;

 }