/***********************************************************************/ /* */ /* Objective Caml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License. */ /* */ /***********************************************************************/ /* $Id$ */ /* MacOS-specific stuff */ #include #include #include #include #include #include #include #include #include #include #include "misc.h" #include "rotatecursor.h" /* The user interface defaults to MPW tool. The standalone application overrides the ui_* functions, as well as [main], [InitCursorCtl], [RotateCursor], [atexit], [getenv], and the terminfo functions. */ void ui_exit (int return_code) { exit (return_code); } int ui_read (int file_desc, char *buf, unsigned int length) { ROTATECURSOR_MAGIC (); return read (file_desc, buf, length); } int ui_write (int file_desc, char *buf, unsigned int length) { ROTATECURSOR_MAGIC (); return write (file_desc, buf, length); } void ui_print_stderr (char *format, void *arg) { ROTATECURSOR_MAGIC (); fprintf (stderr, format, arg); fflush (stderr); } /* Unix emulation stuff */ static short prevdir = 0; int chdir (char *dir) { WDPBRec pb; int result; short curdir; pb.ioCompletion = NULL; pb.ioNamePtr = c2pstr (dir); pb.ioVRefNum = 0; pb.ioWDProcID = 'Caml'; pb.ioWDDirID = 0; result = PBOpenWDSync (&pb); p2cstr ((unsigned char *) dir); if (result != noErr) return -1; curdir = pb.ioVRefNum; result = SetVol (NULL, curdir); if (result != noErr) return -1; if (prevdir != 0){ pb.ioVRefNum = prevdir; PBCloseWDSync (&pb); } prevdir = curdir; return 0; } Handle macos_getfullpathname (short vrefnum, long dirid) { Handle result = NewHandle (0); CInfoPBRec mypb; Str255 dirname; OSErr err; if (result == NULL) goto failed; mypb.dirInfo.ioNamePtr = dirname; mypb.dirInfo.ioVRefNum = vrefnum; mypb.dirInfo.ioDrParID = dirid; mypb.dirInfo.ioFDirIndex = -1; do{ mypb.dirInfo.ioDrDirID = mypb.dirInfo.ioDrParID; err = PBGetCatInfo (&mypb, false); if (err) goto failed; Munger (result, 0, NULL, 0, ":", 1); Munger (result, 0, NULL, 0, dirname+1, dirname[0]); /* XXX out of memory ?! */ }while (mypb.dirInfo.ioDrDirID != fsRtDirID); return result; failed: if (result != NULL) DisposeHandle (result); return NULL; } char *getcwd (char *buf, long size) { size_t len; Handle path = macos_getfullpathname (0, 0); if (path == NULL) return NULL; len = GetHandleSize (path); if (len+1 >= size){ DisposeHandle (path); return NULL; } if (buf == NULL){ buf = malloc (len+1); if (buf == NULL) return NULL; } memcpy (buf, *path, len); buf [len] = '\000'; DisposeHandle (path); return buf; } pascal Boolean system_idleproc (const EventRecord *event, long *sleepTime, RgnHandle *mouseRgn) { static RgnHandle myregion = NULL; EventRecord evt; if (myregion == NULL){ myregion = NewRgn (); SetRectRgn (myregion, -32000, -32000, 32000, 32000); } /* XXX standalone appli: process event */ *mouseRgn = myregion; *sleepTime = 3; if (EventAvail (keyDownMask, &evt) && (evt.modifiers & cmdKey) && ((evt.message & charCodeMask) == '.')){ return true; }else{ return false; } } void quote (char *buf, long buflen) { long i, j; j = 2; for (i = 0; buf[i] != '\0'; i++){ if (buf[i] == '\'') j += 3; ++ j; } if (j >= buflen) return; buf[j--] = '\0'; buf[j--] = '\''; while (i > 0){ -- i; buf[j--] = buf[i]; if (buf[i] == '\''){ buf[j--] = '\''; buf[j--] = '\266'; buf[j--] = '\''; } } buf[j] = '\''; Assert (j == 0); } int system (char const *cmd) { char *fmt = "directory %s; %s"; char *cmdline; char *buf; #define buf_size 66000 static AEIdleUPP myIdleProcUPP = NULL; AEAddressDesc serveraddr; AppleEvent myevent, reply; OSType toolserver_sig = 'MPSX'; DescType ret_type; OSErr err = noErr; long event_status = 0, ret_size; int result; /* once only */ if (myIdleProcUPP == NULL) myIdleProcUPP = NewAEIdleProc (system_idleproc); SetCursor (*GetCursor (watchCursor)); buf = malloc (buf_size); if (buf == NULL) goto failed_malloc_buf; /* Create the command line */ getcwd (buf, buf_size); quote (buf, buf_size); cmdline = malloc (strlen (fmt) + strlen (cmd) + strlen (buf) + 1); if (cmdline == NULL) goto failed_malloc_cmdline; sprintf (cmdline, fmt, buf, cmd); /* Send the event and get the reply */ err = AECreateDesc (typeApplSignature, &toolserver_sig, sizeof (toolserver_sig), &serveraddr); if (err != noErr) goto failed_AECreateDesc; err = AECreateAppleEvent ('misc', 'dosc', &serveraddr, kAutoGenerateReturnID, kAnyTransactionID, &myevent); if (err != noErr) goto failed_AECreateAppleEvent; err = AEPutParamPtr (&myevent, '----', 'TEXT', cmdline, strlen (cmdline)); if (err != noErr) goto failed_AEPutParamPtr; err = AESend (&myevent, &reply, kAEWaitReply + kAENeverInteract, kAENormalPriority, kNoTimeOut, myIdleProcUPP, NULL); if (err != noErr) goto failed_AESend; err = AEGetParamPtr (&reply, 'errn', typeLongInteger, &ret_type, &event_status, sizeof (event_status), &ret_size); if (err != noErr || event_status != noErr) goto failed_script; err = AEGetParamPtr (&reply, 'stat', typeLongInteger, &ret_type, &event_status, sizeof (event_status), &ret_size); if (err != noErr || event_status != noErr) goto failed_script; /* forward stdout and stderr */ err = AEGetParamPtr (&reply, 'diag', typeChar, &ret_type, buf, buf_size, &ret_size); if (err == noErr) ui_write (2, buf, ret_size); err = AEGetParamPtr (&reply, '----', typeChar, &ret_type, buf, buf_size, &ret_size); if (err == noErr) ui_write (1, buf, ret_size); AEDisposeDesc (&reply); AEDisposeDesc (&myevent); AEDisposeDesc (&serveraddr); free (cmdline); free (buf); RotateCursor (32); return 0; failed_script: AEDisposeDesc (&reply); failed_AESend: failed_AEPutParamPtr: AEDisposeDesc (&myevent); failed_AECreateAppleEvent: AEDisposeDesc (&serveraddr); failed_AECreateDesc: free (cmdline); failed_malloc_cmdline: free (buf); failed_malloc_buf: if (err != noErr) result = err; else if (event_status != 0) result = event_status; else result = 1; if (result == 0 || result == -1) result = 1; RotateCursor (32); return result; }