diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacBOAMain.c
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacBOAMain.c Fri Jun 15 03:10:57 2012 +0200
@@ -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;
+
+}
+