Commit 30b6d91a authored by John van Groningen's avatar John van Groningen
Browse files

add folder PowerMacintosh

parent 89d36a54
definition module EdCleanSystem;
/* OS dependent module for the macintosh */
/* Interface module for calling the CLEAN compiler, code generator and linker */
import EdTypes, EdProgramState;
/* Macros used to select platform specific code.
Make sure only one of these macros is True.
*/
IfMacintoshSystem m o :== m;
IfMsWindowsSystem w o :== o;
IfUnixSystem u o :== o;
IF_MACH_O mach_o pef :== pef;
from UtilNewlinesFile import
:: NewlineConvention(
NewlineConventionNone,
NewlineConventionMac, NewlineConventionUnix, NewlineConventionDos);
HostNativeNewlineConvention
:== IfMacintoshSystem
NewlineConventionMac
(IfUnixSystem
NewlineConventionUnix
(IfMsWindowsSystem
NewlineConventionDos
("unknown" "os")));
:: CompilerMsg
= CompilerOK
| SyntaxError
| Patherror Pathname;
:: VerboseFun
:== String -> ProgState -> * (IO -> ProgIO);
:: WindowFun
:== Text -> ProgState -> * (IO -> ProgIO);
/* Compiles the given file:
1st arg. function to show verbose messages of the compiler.
2nd arg. function to show error and warning messages of the compiler.
3rd arg. function to show type info listed by the compiler.
4th arg. check syntax only?
5th arg. file name of the module to be compiled (must be a full .icl file name).
6th arg. list of paths where the compiler can find imported .dcl files.
7th arg. memory profile option for current project
8th arg. profile option for current project
9th arg. compiler options.
10th arg. program state.
11th arg. io state.
1st result new program and io state.
2nd result path name of the generated .abc file.
Note: on the macintosh the .abc file is generated in the standard Clean System
Files Folder. On Unix, however, the location of the .abc depends on the user
settings.
3rd result indication whether compilation was successfull.
*/
Compile :: !VerboseFun !WindowFun !WindowFun !CompileOrCheckSyntax !CompileClearCache !Pathname !(List Pathname) !Bool !Bool !CompilerOptions !ProgState !IO
-> (!ProgIO, !Pathname, !CompilerMsg);
/* Generates code for the given file:
1st arg. function to show error and warning messages of the code generator.
2nd arg. generate assembly only?
3rd arg. file name of the module to be compiled (must be a full .abc file name).
4th arg. code generator options.
5th arg. application options.
6th arg. program state.
7th arg. io state.
1st result new program and io state.
2nd result path name of the generated .o file.
Note: on the macintosh the .o file is generated in the standard Clean System
Files Folder. On Unix, however, the location of the .o depends on the user
settings.
3rd result indication whether code generation was successfull.
*/
CodeGen :: !WindowFun !CodeGenerateAsmOrCode !Pathname !CodeGenOptions !ApplicationOptions !ProgState !IO
-> (!ProgIO, !Pathname, !Bool);
/* Links the given file:
1st arg. function to show error and warning messages of the code generator.
2nd arg. full path name of the executable.
3rd arg. full path name of the '_system' object file.
4th arg. full path names of all the object files.
5th arg. default paths.
6th arg. application settings.
7th arg. full pathnames of object files whose names are retrieved from ".importobj" statements
8th arg. full pathnames of libraries whose names are retrieved from ".library" statements
9th arg. program state.
10th arg. io state.
1st result new program and io state.
2nd result indication whether linking was successfull.
*/
Link :: !WindowFun !Pathname !Pathname !(List Pathname) !(List Pathname) !ApplicationOptions !Processor !LinkOptions !(List Pathname) !(List Pathname) !ProgState !IO
-> (!ProgIO,!Bool);
ApplicationOptionsToFlags :: !ApplicationOptions -> Int;
FlagsToApplicationOptions :: !Int !ApplicationOptions -> ApplicationOptions;
Execute :: !WindowFun !Pathname !ApplicationOptions !ProgState !IO
-> (!ProgIO, !Bool);
ClearCompilerCache :: !IO -> (!Int,!IO);
QuitCleanCompiler :: !IO -> IO;
SetClipboardText :: String (IOState s) -> (IOState s);
GetClipboardText :: (IOState s) -> (String, IOState s);
SystemDependentDevices :: [DeviceSystem ProgState IO];
SystemDependentInitialIO :: InitialIO *s;
EditorDefaultFontsToTry :: [(!FontName, ![FontStyle], !FontSize)];
ReadStartupInfo :: !{#Char} !*Files -> (!StartupInfo,!*Files);
/* for Mach-O */
send_command_to_application :: !Bool !String !String -> (!Int,!Int);
/* */
\ No newline at end of file
This diff is collapsed.
definition module EdMyIO;
import StdFile, StdString, deltaEventIO, deltaFileSelect;
NoDate :== {exists=False,yy=0,mm=0,dd=0,h=0,m=0,s=0};
:: DATE = { exists :: !Bool,
yy :: !Int,
mm :: !Int,
dd :: !Int,
h :: !Int,
m :: !Int,
s :: !Int };
FOpenDir :: !String !*Files -> (!Bool, !*Files);
FCloseDir :: !*Files -> (Bool, !*Files);
FGetPlainFileName :: !*Files -> (!Bool, !String, !*Files);
FExists :: !String !*Files -> (!Bool, !*Files);
FRemove :: !String !*Files -> (!Bool, !*Files);
FModified :: !String !*Files -> (!DATE, !*Files);
FStartUpDir :: !String !*Files -> (!String, !*Files);
Older_Date :: !DATE !DATE -> Bool;
FTempFileName :: !String !*Files -> (!String, !*Files);
SelectDir :: !*state !(IOState *state)
-> (!Bool, !String, !*state, !IOState *state);
Launch :: !String *state !(IOState *state)
-> (!Bool,!Int,!*state,!IOState *state);
GetFullApplicationPath :: !*Files -> ({#Char}, *Files);
from MacKeys import ShiftKeyIsDown;
implementation module EdMyIO;
/* OS dependent module for the powermacintosh */
import StdClass,StdFile, StdChar, StdInt, StdBool, StdString, StdMisc,StdArray;
import deltaFileSelect, deltaEventIO, deltaIOSystem, deltaSystem, deltaDialog;
import mac_types, OS_utilities;
from files import GetFInfo,GetCatInfo1,GetCatInfo2,HGetVol;
NoDate :== {exists=False,yy=0,mm=0,dd=0,h=0,m=0,s=0};
:: DATE = { exists :: !Bool,
yy :: !Int,
mm :: !Int,
dd :: !Int,
h :: !Int,
m :: !Int,
s :: !Int };
FOpenDir :: !String !*Files -> (!Bool, !*Files);
FOpenDir name disk = (False, disk);
FCloseDir :: !*Files -> (Bool, !*Files);
FCloseDir disk = (False, disk);
FGetPlainFileName :: !*Files -> (!Bool, !String, !*Files);
FGetPlainFileName disk = (False, "", disk);
FExists :: !String !*Files -> (!Bool, !*Files);
FExists name disk = (result == 0, disk);
where {
(result,_,_) = GetFInfo name NewToolbox;
};
FRemove :: !String !*Files -> (!Bool, !*Files);
FRemove path disk
= (True, disk);
FModified :: !String !*Files -> (!DATE, !*Files);
FModified path disk
| result <> 0 = (NoDate,disk);
= ({exists=True,yy=years,mm=months,dd=days,h=hours,m=minutes,s=seconds},disk);
where {
(result,modification,_) = GetFInfo path NewToolbox;
(years,months,days,_,_) = Secs2Date modification 0;
(hours,minutes,seconds,_) = Secs2Time modification 0;
};
FStartUpDir :: !String !*Files -> (!String, !*Files);
FStartUpDir applicationname files
| result==0
= (pathName % (0,size pathName-2), files);
where {
(result,wd_vref_num,directory_id,tb1) = HGetVol NewToolbox;
(pathName,_) = Get_directory_path wd_vref_num directory_id "" tb1;
};
Get_name_and_parent_id_of_directory :: !Int !Int !*Toolbox -> (!String,!Int,!*Toolbox);
Get_name_and_parent_id_of_directory volumeNumber directoryId tb
| 0 == osError = (folderName,parentId,tb1);
= abort ("Error code returned by BPGetCatInfo: " +++ toString osError);
where {
(osError,folderName,parentId,tb1) = GetCatInfo2 volumeNumber directoryId String64 tb;
};
Get_directory_path :: !Int !Int !String !*Toolbox -> (!String, !*Toolbox);
Get_directory_path volumeNumber directoryId path tb
| directoryId==2
= (folderName +++ ":" +++ path, tb1);
= Get_directory_path volumeNumber parentId (folderName +++ ":" +++ path) tb1;
where {
(folderName, parentId, tb1) = Get_name_and_parent_id_of_directory volumeNumber directoryId tb;
};
String64 :: String;
String64 = createArray 64 '@';
Older_Date :: !DATE !DATE -> Bool;
Older_Date {exists=b1,yy=yy1,mm=mm1,dd=dd1,h=h1,m=m1,s=s1}
{exists=b2,yy=yy2,mm=mm2,dd=dd2,h=h2,m=m2,s=s2}
| b1 && not b2 = True;
| not b1 || not b2 = False;
= Older_IntList [yy1,mm1,dd1,h1,m1,s1] [yy2,mm2,dd2,h2,m2,s2];
Older_IntList :: ![Int] ![Int] -> Bool;
Older_IntList [] [] = False;
Older_IntList [h1:t1] [h2:t2] | h1 < h2 = True;
| h1 > h2 = False;
= Older_IntList t1 t2;
FTempFileName :: !String !*Files -> (!String, !*Files);
FTempFileName dir disk
= (dir +++ ":temp", disk);
SelectDir :: !*state !(IOState *state) -> (!Bool, !String, !*state, !IOState *state);
SelectDir state io
= (open, RemoveFileName dirname`, state`, io`);
where {
(open, dirname`, state`, io`)= SelectInputFile state io;
};
RemoveFileName :: !String -> String;
RemoveFileName path
| found = path % (0, dec position);
= path;
where {
(found,position) = LastColon path last;
last = dec (size path);
};
LastColon :: !String !Int -> (!Bool, !Int);
LastColon s i
| i <= 0
= (False,0);
| DirSeparator==s.[i]
= (True, i);
= LastColon s (dec i);
Launch :: !String *state !(IOState *state)
-> (!Bool,!Int,!*state,!IOState *state);
Launch progname state io
= (True, 0, state`, io`);
where {
(_, state`,io`) = OpenNotice notice state io;
notice = Notice [("Execute \'" +++ progname) +++ "\'"] (NoticeButton 1 "OK") [];
};
GetFullApplicationPath :: !*Files -> ({#Char}, *Files);
GetFullApplicationPath files
= FStartUpDir "" files;
definition module EdPath;
/* OS dependent operations on filenames */
from deltaIOSystem import ::Measure ( MM, Inch, Pixel);
import EdTypes;
EmptyPathname :== "";
DirSeparatorString:==":";
RemovePath :: !Pathname -> String;
RemoveSuffix :: !Pathname -> String;
RemoveFilename :: !Pathname -> Pathname;
IsDefPathname :: !Pathname -> Bool;
IsImpPathname :: !Pathname -> Bool;
IsPrjPathname :: !Pathname -> Bool;
IsFullPathname :: !Pathname -> Bool;
MakeDefPathname :: !String -> Pathname;
MakeImpPathname :: !String -> Pathname;
MakeABCPathname :: !String -> Pathname;
MakeObjPathname :: !Processor !String -> Pathname;
MakeMiraPathname :: !String -> Pathname;
MakeTextPathname :: !String -> Pathname;
MakeProjectPathname :: !String -> Pathname;
MakeExecPathname :: !String -> Pathname;
MakeTempPathname :: !Pathname -> Pathname;
MakeABCSystemPathname :: !Pathname !*Files -> (!Pathname, !*Files);
MakeObjSystemPathname :: !Processor !Pathname !*Files -> (!Pathname, !*Files);
MakeFullPathname :: !Pathname !Modulename -> Pathname;
GetModuleName :: !Pathname -> Modulename;
MakeProjectDirName :: !Bool !String !String !String -> String;
MakeDefDirName :: !Bool !String !String -> String;
MatchProjectDirName :: !Bool !Pathname !String !String !(List Pathname) -> Pathname;
MatchDefDirName :: !Bool !Pathname !String !(List Pathname) -> Pathname;
ListBoxWidth :: Measure;
replace_prefix_path :: !Pathname !Pathname !Pathname -> Pathname;
implementation module EdPath;
/* OS dependent operations on filenames for the powermacintosh */
import StdClass,StdString, deltaSystem, StdChar, StdBool, StdChar,StdInt, StdMisc,StdArray;
import deltaFont, deltaIOSystem;
import EdTypes, EdConstants;
EmptyPathname :== "";
DirSeparatorString:==":";
ExampleChar :== 'W';
CharWidth :== 32;
ListBoxMargin :== 10.0;
RemovePath :: !Pathname -> String;
RemovePath path
| found = path % (inc position, last);
= path;
where {
(found,position)= FindLastChar DirSeparator path last;
last = dec (size path);
};
RemoveSuffix :: !Pathname -> String;
RemoveSuffix path
| not found = path;
| not suffix = path;
= path % (0, dec position);
where {
(found, position) = FindLastChar '.' path last;
suf = path % (position, last);
suffix = suf == ".dcl" || suf == ".icl" || suf == ".abc" || suf == ".o" || suf == ".prj";
last = dec (size path);
};
RemoveFilename :: !Pathname -> Pathname;
RemoveFilename path
| found
= path % (0, dec position);
= path;
where {
(found,position) = FindLastChar DirSeparator path (dec (size path));
};
IsDefPathname :: !Pathname -> Bool;
IsDefPathname name = equal_suffix ".dcl" name;
IsImpPathname :: !Pathname -> Bool;
IsImpPathname name = equal_suffix ".icl" name;
IsPrjPathname :: !Pathname -> Bool;
IsPrjPathname name = equal_suffix ".prj" name;
IsFullPathname :: !Pathname -> Bool;
IsFullPathname name = LastChar DirSeparator name (dec (size name)) >= 0;
MakeDefPathname :: !String -> Pathname;
MakeDefPathname name = RemoveSuffix name +++ ".dcl";
MakeImpPathname :: !String -> Pathname;
MakeImpPathname name = RemoveSuffix name +++ ".icl";
MakeABCPathname :: !String -> Pathname;
MakeABCPathname name = RemoveSuffix name +++ ".abc";
ObjectSuffix :: Processor -> String;
ObjectSuffix CurrentProcessor
= ".o";
ObjectSuffix MC68000
= ".obj0";
ObjectSuffix MC68020
= ".obj1";
ObjectSuffix MC68020_and_68881
= ".obj2";
MakeObjPathname :: !Processor !String -> Pathname;
MakeObjPathname processor name
= RemoveSuffix name +++ ObjectSuffix processor;
MakeMiraPathname :: !String -> Pathname;
MakeMiraPathname name = RemoveSuffix name +++ ".m";
MakeTextPathname :: !String -> Pathname;
MakeTextPathname name = name;
MakeProjectPathname :: !String -> Pathname;
MakeProjectPathname name = RemoveSuffix name +++ ".prj";
MakeExecPathname :: !String -> Pathname;
MakeExecPathname name = RemoveSuffix name;
MakeTempPathname :: !Pathname -> Pathname;
MakeTempPathname name = name;
MakeABCSystemPathname :: !Pathname !*Files -> (!Pathname, !*Files);
MakeABCSystemPathname abcname files
= (directory_name_plus_system_dir +++ sep +++ file +++ ".abc",files);
{
directory_name_plus_system_dir
| equal_suffix SystemDir dir
= dir;
= dir +++ sep +++ SystemDir;
dir = RemoveFilename abcname;
sep = toString DirSeparator;
file = RemovePath (RemoveSuffix abcname);
};
MakeObjSystemPathname :: !Processor !Pathname !*Files -> (!Pathname,!*Files);
MakeObjSystemPathname processor name files
= files_and_path (ObjectSuffix processor);
{
files_and_path extension = (directory_name_plus_system_dir +++ sep +++ file+++extension,files);
directory_name_plus_system_dir
| equal_suffix SystemDir dir
= dir;
= dir +++ sep +++ SystemDir;
dir = RemoveFilename name;
sep = toString DirSeparator;
file = RemovePath (RemoveSuffix name);
};
MakeFullPathname :: !Pathname !Modulename -> Pathname;
MakeFullPathname path modname = path +++ toString DirSeparator +++ modname;
GetModuleName :: !Pathname -> Modulename;
GetModuleName name = RemoveSuffix (RemovePath name);
MakeProjectDirName :: !Bool !String !String !String -> String;
MakeProjectDirName long home appl file
| long
= Truncate file;
| home==file
= Truncate "{Project}";
| equal_path_prefix home file
= Truncate "{Project}" +++ DirSeparatorString +++ file % (inc (size home), dec (size file));
= MakeDefDirName False appl file;
MakeDefDirName :: !Bool !String !String -> String;
MakeDefDirName long appl file
| long
= Truncate file;
| appl==file
= Truncate "{Application}";
| equal_path_prefix appl file
= Truncate "{Application}" +++ DirSeparatorString +++ file % (inc (size appl), dec (size file));
= Truncate file;
MatchProjectDirName :: !Bool !Pathname !String !String !(List Pathname) -> Pathname;
MatchProjectDirName long home appl select Nil
= EmptyPathname;
MatchProjectDirName long home appl select (path:!paths)
| select == MakeProjectDirName long home appl path
= path;
= MatchProjectDirName long home appl select paths;
MatchDefDirName :: !Bool !Pathname !String !(List Pathname) -> Pathname;
MatchDefDirName long appl select Nil
= EmptyPathname;
MatchDefDirName long appl select (path:!paths)
| select == path`
= path;
= MatchDefDirName long appl select paths;
where {
path` = MakeDefDirName long appl path;
};
ListBoxWidth :: Measure;
ListBoxWidth
= Pixel ( CharWidth * FontCharWidth ExampleChar font + MMToHorPixels ListBoxMargin );
where {
(_,font) = SelectFont fn [] fs;
(fn,_,fs) = DefaultFont;
};
replace_prefix_path :: !Pathname !Pathname !Pathname -> Pathname;
replace_prefix_path old_prefix_path new_prefix_path path
| old_prefix_path==path
= new_prefix_path;
| equal_path_prefix old_prefix_path path
= new_prefix_path +++ DirSeparatorString +++ path % (inc (size old_prefix_path), dec (size path));
= path;
/* Auxilary functions */
equal_suffix :: !String !String -> Bool;
equal_suffix suffix string
| lengths < lengthsuf
= False;
= string % (lengths - lengthsuf,lengths) == suffix;
where {
lengths = dec (size string);
lengthsuf = dec (size suffix);
};
equal_path_prefix :: !String !String -> Bool;
equal_path_prefix prefix string
| lengths<=lengthpre
= False;
= string.[inc lengthpre]==DirSeparator && string % (0,lengthpre)==prefix;
where {
lengths = dec (size string);
lengthpre = dec (size prefix);
};
LastChar :: !Char !String !Int -> Int;
LastChar c s i
| i <= 0 = -1;
| c == s.[i] = i;
= LastChar c s (dec i);
FindLastChar :: !Char !String !Int -> (!Bool, !Int);
FindLastChar c s i
| i <= 0 = (False,0);
| c == s.[i] = (True, i);
= FindLastChar c s (dec i);
Truncate :: !String -> String;
Truncate s = MaxWidth font pixelwidth len s;
where {
len = size s;
pixelwidth = CharWidth * FontCharWidth ExampleChar font ;
(_,font) = SelectFont fn [] fs;
(fn,_,fs) = DefaultFont;
};
MaxWidth :: !Font !Int !Int !String -> String;
MaxWidth font pixelwidth truncated s
| truncated <= 1 = s;
| ok = s;
= MaxWidth font pixelwidth (dec truncated) s;
where {
ok= FontStringWidth (s % (0, dec truncated)) font < pixelwidth;
};