diff options
author | das <das> | 2004-03-17 18:14:11 (GMT) |
---|---|---|
committer | das <das> | 2004-03-17 18:14:11 (GMT) |
commit | 0205867a3dad7204c57477b6c38c52b981af36e1 (patch) | |
tree | b40c5ed765d71e7cb68ba178c3f3a098638c9987 /mac/tclMacBOAMain.c | |
parent | b07cf17d9c57bb355e84b17470235902854c7d40 (diff) | |
download | tcl-0205867a3dad7204c57477b6c38c52b981af36e1.zip tcl-0205867a3dad7204c57477b6c38c52b981af36e1.tar.gz tcl-0205867a3dad7204c57477b6c38c52b981af36e1.tar.bz2 |
Removed support for Mac OS Classic platform [Patch 918142]
Diffstat (limited to 'mac/tclMacBOAMain.c')
-rw-r--r-- | mac/tclMacBOAMain.c | 304 |
1 files changed, 0 insertions, 304 deletions
diff --git a/mac/tclMacBOAMain.c b/mac/tclMacBOAMain.c deleted file mode 100644 index ff1a943..0000000 --- a/mac/tclMacBOAMain.c +++ /dev/null @@ -1,304 +0,0 @@ -/* - * 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; - -} - |