+ Added SetDefaultMacOS[Filetype|Creator]

* Files written to by fpc rtl now always will get decent filetype/creator
  * Adapted to use FSpGetFullPath
This commit is contained in:
olle 2004-09-30 19:58:42 +00:00
parent 4a9345c203
commit 0e5d980f63

View File

@ -65,8 +65,15 @@ var
{To be called at regular intervals, for lenghty tasks.
Yield might give time for other tasks to run under the cooperative
multitasked macos. For an MPW Tool, it also spinns the cursor.}
procedure Yield;
{To set mac file type and creator codes, to be used for files created
by the FPC runtime library. They must be exactly 4 chars long.}
procedure SetDefaultMacOSFiletype(ftype: ShortString);
procedure SetDefaultMacOSCreator(creator: ShortString);
{*********************************}
{** Available features on macos **}
{*********************************}
@ -440,6 +447,10 @@ end;
{*****************************************************************************
MacOS specific functions
*****************************************************************************}
var
defaultCreator: OSType = $4D505320; {'MPS ' MPW Shell}
//defaultCreator: OSType = $74747874; {'ttxt' Simple Text}
defaultFileType: OSType = $54455854; {'TEXT'}
procedure Yield;
@ -448,6 +459,21 @@ begin
SpinCursor(1);
end;
procedure SetDefaultMacOSFiletype(ftype: ShortString);
begin
if Length(ftype) = 4 then
defaultFileType:= PLongWord(@ftype[1])^;
end;
procedure SetDefaultMacOSCreator(creator: ShortString);
begin
if Length(creator) = 4 then
defaultCreator:= PLongWord(@creator[1])^;
end;
{*****************************************************************************
ParamStr/Randomize
*****************************************************************************}
@ -710,16 +736,20 @@ procedure do_open(var f;p:pchar;flags:longint);
}
var
creator, fileType: OSType;
scriptTag: ScriptCode;
refNum: Integer;
res: OSErr;
err: OSErr;
res: Integer;
spec: FSSpec;
fh: Longint;
oflags : longint;
s: AnsiString;
fullPath: AnsiString;
finderInfo: FInfo;
begin
// AllowSlash(p);
@ -783,10 +813,28 @@ begin
end
else
begin
InOutRes:= PathArgToFullPath(p, s);
InOutRes:= PathArgToFSSpec(p, spec);
if (InOutRes = 0) or (InOutRes = 2) then
begin
err:= FSpGetFullPath(spec, fullPath, false);
InOutRes:= MacOSErr2RTEerr(err);
end;
if InOutRes <> 0 then
exit;
p:= PChar(s);
p:= PChar(fullPath);
if FileRec(f).mode in [fmoutput, fminout, fmappend] then
begin
{Since opening of an existing file will not change filetype and creator,
it is set here. Otherwise overwritten darwin files will not get filetype
TEXT. This is not done when only opening file for reading.}
FSpGetFInfo(spec, finderInfo);
finderInfo.fdType:= defaultFileType;
finderInfo.fdCreator:= defaultCreator;
FSpSetFInfo(spec, finderInfo);
end;
end;
@ -805,10 +853,6 @@ begin
{$else}
InOutRes:=1;
//creator:= $522A6368; {'MPS ' -- MPW}
//creator:= $74747874; {'ttxt'}
creator:= $522A6368; {'R*ch' -- BBEdit}
fileType:= $54455854; {'TEXT'}
{ reset file handle }
filerec(f).handle:=UnusedHandle;
@ -816,7 +860,7 @@ begin
res:= FSpLocationFromFullPath(StrLen(p), p, spec);
if (res = noErr) or (res = fnfErr) then
begin
if FSpCreate(spec, creator, fileType, smSystemScript) = noErr then
if FSpCreate(spec, defaultCreator, defaultFileType, smSystemScript) = noErr then
;
if FSpOpenDF(spec, fsCurPerm, refNum) = noErr then
@ -941,21 +985,19 @@ end;
procedure getDir (DriveNr: byte; var Dir: ShortString);
var
pathHandle: Mac_Handle;
fullPath: AnsiString;
pathHandleSize: Longint;
begin
if FSpGetFullPath(workingDirectorySpec, pathHandle, false) <> noErr then
if FSpGetFullPath(workingDirectorySpec, fullPath, false) <> noErr then
Halt(3); {exit code 3 according to MPW}
pathHandleSize:= GetHandleSize(pathHandle);
SetString(dir, pathHandle^, pathHandleSize);
DisposeHandle(pathHandle);
if pathHandleSize <= 255 then {because dir is ShortString}
if Length(fullPath) <= 255 then {because dir is ShortString}
InOutRes := 0
else
InOutRes := 1; //TODO Exchange to something better
dir:= fullPath;
end;
{*****************************************************************************
@ -1305,7 +1347,12 @@ end.
{
$Log$
Revision 1.21 2004-09-12 19:51:02 olle
Revision 1.22 2004-09-30 19:58:42 olle
+ Added SetDefaultMacOS[Filetype|Creator]
* Files written to by fpc rtl now always will get decent filetype/creator
* Adapted to use FSpGetFullPath
Revision 1.21 2004/09/12 19:51:02 olle
+ InitGraf called for MPW tool, which make strange bug disappear.
* bugfix initial wd for MPW tool
+ Added SysInitExceptions