home *** CD-ROM | disk | FTP | other *** search
- #include <Files.h>
- #include <StdLib.h>
- #include <Resources.h>
- #include <StandardFile.h>
- #include "ui.h"
- #if defined( THINK_C ) || defined( __MWERKS__ )
- #include <stdio.h>
- #include <string.h>
- #include <strings.h>
- #endif
-
- void CenterRect (Rect *r);
-
- /* 09Jan95 e */
- static FileFilterUPP compile_filterUPP = NULL;
- static FileFilterUPP source_filterUPP = NULL;
- static FileFilterUPP object_filterUPP = NULL;
-
- static pascal Boolean compile_filter (ParmBlkPtr pb)
- {
- char len = pb->fileParam.ioNamePtr [0];
- if (len >= 4
- && pb->fileParam.ioNamePtr [len ] == 'l'
- && pb->fileParam.ioNamePtr [len - 1] == 'm'
- && pb->fileParam.ioNamePtr [len - 2] == 's'
- && pb->fileParam.ioNamePtr [len - 3] == '.'){
- return 0;
- }else if (len >= 4
- && pb->fileParam.ioNamePtr [len ] == 'g'
- && pb->fileParam.ioNamePtr [len - 1] == 'i'
- && pb->fileParam.ioNamePtr [len - 2] == 's'
- && pb->fileParam.ioNamePtr [len - 3] == '.'){
- return 0;
- }else{
- return 1;
- }
- }
-
- static pascal Boolean source_filter (ParmBlkPtr pb)
- {
- char len = pb->fileParam.ioNamePtr [0];
- if (len >= 4
- && pb->fileParam.ioNamePtr [len ] == 'l'
- && pb->fileParam.ioNamePtr [len - 1] == 'm'
- && pb->fileParam.ioNamePtr [len - 2] == 's'
- && pb->fileParam.ioNamePtr [len - 3] == '.'){
- return 0;
- }else{
- return 1;
- }
- }
-
- static pascal Boolean object_filter (ParmBlkPtr pb)
- {
- char len = pb->fileParam.ioNamePtr [0];
- if (len >= 3
- && pb->fileParam.ioNamePtr [len ] == 'o'
- && pb->fileParam.ioNamePtr [len - 1] == 'u'
- && pb->fileParam.ioNamePtr [len - 2] == '.'){
- return 0;
- }else{
- return 1;
- }
- }
-
- static char postfix [] = ":";
- #ifdef THINK_C
- static char nocd_template [] = "%s \"%#s\";";
- static char cd_template [] = "chDir \"%s\"; %s \"%#s\";";
- #else
- static char nocd_template [] = "%s \"%s\";";
- static char cd_template [] = "chDir \"%s\"; %s \"%s\";";
- #endif
-
- static void do_file (char *command, long type, FileFilterUPP filter)
- {
- SFTypeList type_list;
- StandardFileReply reply;
- short cur_vol;
- long cur_dir;
- char *buf, dir[512];
-
- type_list [0] = type;
- StandardGetFile ( filter, 1, type_list, &reply );
- if (!reply.sfGood) return;
- #ifndef THINK_C
- p2cstr (reply.sfFile.name);
- #endif
- HGetVol( NULL, &cur_vol, &cur_dir ); // 30Aug95 e
- if ( cur_vol == reply.sfFile.vRefNum && cur_dir == reply.sfFile.parID )
- { buf = malloc (sizeof (nocd_template) - 4
- + strlen (command)
- #ifdef THINK_C
- + reply.sfFile.name[0]);
- #else
- + strlen ((char *)reply.sfFile.name));
- #endif
- if (buf == NULL) return;
- sprintf (buf, nocd_template, command, reply.sfFile.name);
- }else{
- // dir = get_wd_name (reply.sfFile.vRefNum, postfix);
- getfullpath( reply.sfFile.vRefNum,
- reply.sfFile.parID,
- "\p", // postfix unnecessary
- dir, 511, 0 );
- buf = malloc (sizeof (cd_template) - 6
- + strlen (dir)
- + strlen (command)
- #ifdef THINK_C
- + reply.sfFile.name[0]);
- #else
- + strlen ((char *)reply.sfFile.name));
- #endif
- if (buf == NULL) return;
- sprintf (buf, cd_template, dir, command, reply.sfFile.name);
- // if (dir != postfix) free (dir - 1); /* cf.get_wd_name */
- }
- send_to_caml (buf);
- free (buf);
- }
-
- static ensure_ff_upp (void)
- { if ( compile_filterUPP == NULL )
- { compile_filterUPP = NewFileFilterProc(compile_filter);
- source_filterUPP = NewFileFilterProc(source_filter);
- object_filterUPP = NewFileFilterProc(object_filter);
- }
- }
-
- void do_include (void)
- {
- ensure_ff_upp();
- do_file ("use", 'TEXT', source_filterUPP);
- }
-
- void do_compile (void)
- {
- ensure_ff_upp();
- do_file ("compile", 'TEXT', compile_filterUPP);
- }
-
- void do_load (void)
- {
- ensure_ff_upp();
- do_file ("loadOne", 'BINA', object_filterUPP);
- }
-
- void do_load_object (void)
- {
- ensure_ff_upp();
- do_file ("load", 'BINA', object_filterUPP);
- }
-
- void do_gc (void)
- {
- #if 0
- send_to_caml ("gc_full_major();");
- #else
- send_to_caml("local prim_val gc : unit -> unit = 1 \"gc_full_major\" in val _ = gc() end;");
- #endif
- }
-
- void do_help (void)
- {
- send_to_caml ("help \"\";");
- }
-