os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacBOAMain.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacBOAMain.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,304 @@
1.4 +/*
1.5 + * tclMacBGMain.c --
1.6 + *
1.7 + * Main program for Macintosh Background Only Application shells.
1.8 + *
1.9 + * Copyright (c) 1997 Sun Microsystems, Inc.
1.10 + *
1.11 + * See the file "license.terms" for information on usage and redistribution
1.12 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.13 + *
1.14 + * RCS: @(#) $Id: tclMacBOAMain.c,v 1.4 2001/12/28 23:36:31 dgp Exp $
1.15 + */
1.16 +
1.17 +#include "tcl.h"
1.18 +#include "tclInt.h"
1.19 +#include "tclMacInt.h"
1.20 +#include <Resources.h>
1.21 +#include <Notification.h>
1.22 +#include <Strings.h>
1.23 +
1.24 +/*
1.25 + * This variable is used to get out of the modal loop of the
1.26 + * notification manager.
1.27 + */
1.28 +
1.29 +int NotificationIsDone = 0;
1.30 +
1.31 +/*
1.32 + * The following code ensures that tclLink.c is linked whenever
1.33 + * Tcl is linked. Without this code there's no reference to the
1.34 + * code in that file from anywhere in Tcl, so it may not be
1.35 + * linked into the application.
1.36 + */
1.37 +
1.38 +EXTERN int Tcl_LinkVar();
1.39 +int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
1.40 +
1.41 +/*
1.42 + * Declarations for various library procedures and variables (don't want
1.43 + * to include tclPort.h here, because people might copy this file out of
1.44 + * the Tcl source directory to make their own modified versions).
1.45 + * Note: "exit" should really be declared here, but there's no way to
1.46 + * declare it without causing conflicts with other definitions elsewher
1.47 + * on some systems, so it's better just to leave it out.
1.48 + */
1.49 +
1.50 +extern int isatty _ANSI_ARGS_((int fd));
1.51 +extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
1.52 +
1.53 +static Tcl_Interp *interp; /* Interpreter for application. */
1.54 +
1.55 +/*
1.56 + * Forward references for procedures defined later in this file:
1.57 + */
1.58 +
1.59 +void TclMacDoNotification(char *mssg);
1.60 +void TclMacNotificationResponse(NMRecPtr nmRec);
1.61 +int Tcl_MacBGNotifyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv);
1.62 +
1.63 +
1.64 +/*
1.65 + *----------------------------------------------------------------------
1.66 + *
1.67 + * Tcl_Main --
1.68 + *
1.69 + * Main program for tclsh and most other Tcl-based applications.
1.70 + *
1.71 + * Results:
1.72 + * None. This procedure never returns (it exits the process when
1.73 + * it's done.
1.74 + *
1.75 + * Side effects:
1.76 + * This procedure initializes the Tk world and then starts
1.77 + * interpreting commands; almost anything could happen, depending
1.78 + * on the script being interpreted.
1.79 + *
1.80 + *----------------------------------------------------------------------
1.81 + */
1.82 +
1.83 +void
1.84 +Tcl_Main(argc, argv, appInitProc)
1.85 + int argc; /* Number of arguments. */
1.86 + char **argv; /* Array of argument strings. */
1.87 + Tcl_AppInitProc *appInitProc;
1.88 + /* Application-specific initialization
1.89 + * procedure to call after most
1.90 + * initialization but before starting to
1.91 + * execute commands. */
1.92 +{
1.93 + Tcl_Obj *prompt1NamePtr = NULL;
1.94 + Tcl_Obj *prompt2NamePtr = NULL;
1.95 + Tcl_Obj *commandPtr = NULL;
1.96 + char buffer[1000], *args, *fileName;
1.97 + int code, tty;
1.98 + int exitCode = 0;
1.99 +
1.100 + Tcl_FindExecutable(argv[0]);
1.101 + interp = Tcl_CreateInterp();
1.102 + Tcl_InitMemory(interp);
1.103 +
1.104 + /*
1.105 + * Make command-line arguments available in the Tcl variables "argc"
1.106 + * and "argv". If the first argument doesn't start with a "-" then
1.107 + * strip it off and use it as the name of a script file to process.
1.108 + */
1.109 +
1.110 + fileName = NULL;
1.111 + if ((argc > 1) && (argv[1][0] != '-')) {
1.112 + fileName = argv[1];
1.113 + argc--;
1.114 + argv++;
1.115 + }
1.116 + args = Tcl_Merge(argc-1, argv+1);
1.117 + Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
1.118 + ckfree(args);
1.119 + TclFormatInt(buffer, argc-1);
1.120 + Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
1.121 + Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
1.122 + TCL_GLOBAL_ONLY);
1.123 +
1.124 + /*
1.125 + * Set the "tcl_interactive" variable.
1.126 + */
1.127 +
1.128 + tty = isatty(0);
1.129 + Tcl_SetVar(interp, "tcl_interactive",
1.130 + ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
1.131 +
1.132 + /*
1.133 + * Invoke application-specific initialization.
1.134 + */
1.135 +
1.136 + if ((*appInitProc)(interp) != TCL_OK) {
1.137 + Tcl_DString errStr;
1.138 +
1.139 + Tcl_DStringInit(&errStr);
1.140 + Tcl_DStringAppend(&errStr,
1.141 + "application-specific initialization failed: \n", -1);
1.142 + Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
1.143 + Tcl_DStringAppend(&errStr, "\n", 1);
1.144 + TclMacDoNotification(Tcl_DStringValue(&errStr));
1.145 + Tcl_DStringFree(&errStr);
1.146 + goto done;
1.147 + }
1.148 +
1.149 + /*
1.150 + * Install the BGNotify command:
1.151 + */
1.152 +
1.153 + if ( Tcl_CreateObjCommand(interp, "bgnotify", Tcl_MacBGNotifyObjCmd, NULL,
1.154 + (Tcl_CmdDeleteProc *) NULL) == NULL) {
1.155 + goto done;
1.156 + }
1.157 +
1.158 + /*
1.159 + * If a script file was specified then just source that file
1.160 + * and quit. In this Mac BG Application version, we will try the
1.161 + * resource fork first, then the file system second...
1.162 + */
1.163 +
1.164 + if (fileName != NULL) {
1.165 + Str255 resName;
1.166 + Handle resource;
1.167 +
1.168 + strcpy((char *) resName + 1, fileName);
1.169 + resName[0] = strlen(fileName);
1.170 + resource = GetNamedResource('TEXT',resName);
1.171 + if (resource != NULL) {
1.172 + code = Tcl_MacEvalResource(interp, fileName, -1, NULL);
1.173 + } else {
1.174 + code = Tcl_EvalFile(interp, fileName);
1.175 + }
1.176 +
1.177 + if (code != TCL_OK) {
1.178 + Tcl_DString errStr;
1.179 +
1.180 + Tcl_DStringInit(&errStr);
1.181 + Tcl_DStringAppend(&errStr, " Error sourcing resource or file: ", -1);
1.182 + Tcl_DStringAppend(&errStr, fileName, -1);
1.183 + Tcl_DStringAppend(&errStr, "\n\nError was: ", -1);
1.184 + Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
1.185 + TclMacDoNotification(Tcl_DStringValue(&errStr));
1.186 + Tcl_DStringFree(&errStr);
1.187 + }
1.188 + goto done;
1.189 + }
1.190 +
1.191 +
1.192 + /*
1.193 + * Rather than calling exit, invoke the "exit" command so that
1.194 + * users can replace "exit" with some other command to do additional
1.195 + * cleanup on exit. The Tcl_Eval call should never return.
1.196 + */
1.197 +
1.198 + done:
1.199 + if (commandPtr != NULL) {
1.200 + Tcl_DecrRefCount(commandPtr);
1.201 + }
1.202 + if (prompt1NamePtr != NULL) {
1.203 + Tcl_DecrRefCount(prompt1NamePtr);
1.204 + }
1.205 + if (prompt2NamePtr != NULL) {
1.206 + Tcl_DecrRefCount(prompt2NamePtr);
1.207 + }
1.208 + sprintf(buffer, "exit %d", exitCode);
1.209 + Tcl_Eval(interp, buffer);
1.210 +}
1.211 +
1.212 +/*----------------------------------------------------------------------
1.213 + *
1.214 + * TclMacDoNotification --
1.215 + *
1.216 + * This posts an error message using the Notification manager.
1.217 + *
1.218 + * Results:
1.219 + * Post a Notification Manager dialog.
1.220 + *
1.221 + * Side effects:
1.222 + * None.
1.223 + *
1.224 + *----------------------------------------------------------------------
1.225 + */
1.226 +void
1.227 +TclMacDoNotification(mssg)
1.228 + char *mssg;
1.229 +{
1.230 + NMRec errorNot;
1.231 + EventRecord *theEvent = NULL;
1.232 + OSErr err;
1.233 + char *ptr;
1.234 +
1.235 + errorNot.qType = nmType;
1.236 + errorNot.nmMark = 0;
1.237 + errorNot.nmIcon = 0;
1.238 + errorNot.nmSound = (Handle) -1;
1.239 +
1.240 + for ( ptr = mssg; *ptr != '\0'; ptr++) {
1.241 + if (*ptr == '\n') {
1.242 + *ptr = '\r';
1.243 + }
1.244 + }
1.245 +
1.246 + c2pstr(mssg);
1.247 + errorNot.nmStr = (StringPtr) mssg;
1.248 +
1.249 + errorNot.nmResp = NewNMProc(TclMacNotificationResponse);
1.250 + errorNot.nmRefCon = SetCurrentA5();
1.251 +
1.252 + NotificationIsDone = 0;
1.253 +
1.254 + /*
1.255 + * Cycle while waiting for the user to click on the
1.256 + * notification box. Don't take any events off the event queue,
1.257 + * since we want Tcl to do this but we want to block till the notification
1.258 + * has been handled...
1.259 + */
1.260 +
1.261 + err = NMInstall(&errorNot);
1.262 + if (err == noErr) {
1.263 + while (!NotificationIsDone) {
1.264 + WaitNextEvent(0, theEvent, 20, NULL);
1.265 + }
1.266 + NMRemove(&errorNot);
1.267 + }
1.268 +
1.269 + p2cstr((unsigned char *) mssg);
1.270 +}
1.271 +
1.272 +void
1.273 +TclMacNotificationResponse(nmRec)
1.274 + NMRecPtr nmRec;
1.275 +{
1.276 + int curA5;
1.277 +
1.278 + curA5 = SetCurrentA5();
1.279 + SetA5(nmRec->nmRefCon);
1.280 +
1.281 + NotificationIsDone = 1;
1.282 +
1.283 + SetA5(curA5);
1.284 +
1.285 +}
1.286 +
1.287 +int
1.288 +Tcl_MacBGNotifyObjCmd(clientData, interp, objc, objv)
1.289 + ClientData clientData;
1.290 + Tcl_Interp *interp;
1.291 + int objc;
1.292 + Tcl_Obj **objv;
1.293 +{
1.294 + Tcl_Obj *resultPtr;
1.295 +
1.296 + resultPtr = Tcl_GetObjResult(interp);
1.297 +
1.298 + if ( objc != 2 ) {
1.299 + Tcl_WrongNumArgs(interp, 1, objv, "message");
1.300 + return TCL_ERROR;
1.301 + }
1.302 +
1.303 + TclMacDoNotification(Tcl_GetString(objv[1]));
1.304 + return TCL_OK;
1.305 +
1.306 +}
1.307 +