/***********************************************************************/ /* */ /* Objective Caml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ /* $Id$ */ /* Macintosh-specific stuff */ #include #include #include #include #include #include #include #include /* The user interface defaults to MPW tool. The standalone application replaces these functions, as well as [main], [InitCursorCtl], [RotateCursor], [atexit] (see rotatecursor.c). */ void ui_exit (int return_code) { exit (return_code); } int ui_read (int file_desc, char *buf, unsigned int length) { return read (file_desc, buf, length); } int ui_write (int file_desc, char *buf, unsigned int length) { return write (file_desc, buf, length); } void ui_print_stderr (char *format, void *arg) { fprintf (stderr, format, arg); } /* Unix emulation stuff */ static short prevdir = 0; int chdir (char *dir) { WDPBRec pb; int result; 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; result = SetVol (NULL, pb.ioVRefNum); if (result != noErr) return -1; if (prevdir != 0){ prevdir = 0; pb.ioVRefNum = prevdir; PBCloseWDSync (&pb); } return 0; } static char *getfullpathid (short wd, long id); static void cat_cp_str (char **cstr, StringPtr pstr) { int l2 = (unsigned char) pstr [0]; int l1 = strlen (*cstr); int i; *cstr = realloc (*cstr, l1 + l2); if (*cstr == NULL) return; for (i = 0; i < l2; i++){ (*cstr)[l1 + i] = pstr [i + 1]; } (*cstr)[l1 + l2] = '\0'; } static char *getfullpathpb (CInfoPBPtr pb) { char *result; if (pb->hFileInfo.ioFlParID == fsRtParID){ result = malloc (1); if (result == NULL) return NULL; result [0] = '\0'; }else{ result = getfullpathid (pb->hFileInfo.ioVRefNum, pb->hFileInfo.ioFlParID); if (result == NULL) return NULL; } cat_cp_str (&result, pb->hFileInfo.ioNamePtr); if (pb->hFileInfo.ioFlAttrib & (1<<4)) cat_cp_str (&result, "\p:"); return result; } static char *getfullpathcwd (void) { CInfoPBRec pb; Str255 pname; pname [0] = 1; pname [1] = ':'; pb.hFileInfo.ioCompletion = NULL; pb.hFileInfo.ioVRefNum = 0; pb.hFileInfo.ioNamePtr = pname; pb.hFileInfo.ioFRefNum = 0; pb.hFileInfo.ioFVersNum = 0; pb.hFileInfo.ioFDirIndex = 0; pb.hFileInfo.ioDirID = 0; if (PBGetCatInfoSync (&pb) != noErr) return NULL; pb.hFileInfo.ioFDirIndex = -1; if (PBGetCatInfoSync (&pb) != noErr) return NULL; return getfullpathpb (&pb); } static char *getfullpathid (short wd, long id) { CInfoPBRec pb; Str255 name; pb.hFileInfo.ioCompletion = NULL; pb.hFileInfo.ioNamePtr = name; pb.hFileInfo.ioVRefNum = wd; pb.hFileInfo.ioFRefNum = 0; pb.hFileInfo.ioFVersNum = 0; pb.hFileInfo.ioFDirIndex = -1; pb.hFileInfo.ioDirID = id; if (PBGetCatInfoSync (&pb) != noErr) return NULL; return getfullpathpb (&pb); } char *getcwd (char *buf, long size) { char *path = getfullpathcwd (); if (path == NULL) return NULL; if (strlen (path) >= size){ free (path); return NULL; } if (buf == NULL){ return path; } strcpy (buf, path); free (path); return buf; } int system (char const *cmd) { char *filename; FILE *f; filename = getenv ("ocamlcommands"); if (filename == NULL) return 1; f = fopen (filename, "a"); if (f == NULL) return 1; fprintf (f, "%s\n", cmd); fclose (f); return 0; }