diff options
author | cvs2fossil <cvs2fossil> | 2011-01-25 19:02:56 (GMT) |
---|---|---|
committer | cvs2fossil <cvs2fossil> | 2011-01-25 19:02:56 (GMT) |
commit | 352fce86be9d102b2284de839b7f7ff94ed971f2 (patch) | |
tree | e454e0d4460f15029e4ed5ae3f3131a992445426 /mac/tclMacBOAMain.c | |
parent | 75f084f6970d2344bb5a82fdff6a73825bc6e64e (diff) | |
download | tcl-352fce86be9d102b2284de839b7f7ff94ed971f2.zip tcl-352fce86be9d102b2284de839b7f7ff94ed971f2.tar.gz tcl-352fce86be9d102b2284de839b7f7ff94ed971f2.tar.bz2 |
Created branch dgp-refactor-merge-syntheticdgp_refactor_mergedgp_refactor_merge_synthetic
Diffstat (limited to 'mac/tclMacBOAMain.c')
-rw-r--r-- | mac/tclMacBOAMain.c | 304 |
1 files changed, 304 insertions, 0 deletions
diff --git a/mac/tclMacBOAMain.c b/mac/tclMacBOAMain.c new file mode 100644 index 0000000..ff1a943 --- /dev/null +++ b/mac/tclMacBOAMain.c @@ -0,0 +1,304 @@ +/* + * 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; + +} + |