mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-03 23:54:33 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			163 lines
		
	
	
		
			4.2 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
			
		
		
	
	
			163 lines
		
	
	
		
			4.2 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
{
 | 
						|
    This file is part of the Free Pascal run time library.
 | 
						|
    Copyright (c) 2001-2005 by Free Pascal development team
 | 
						|
 | 
						|
    Low level system functions for MacOS
 | 
						|
 | 
						|
    See the file COPYING.FPC, included in this distribution,
 | 
						|
    for details about the copyright.
 | 
						|
 | 
						|
    This program is distributed in the hope that it will be useful,
 | 
						|
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
						|
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 | 
						|
 | 
						|
 **********************************************************************}
 | 
						|
 | 
						|
{*********************** MacOS API *********************}
 | 
						|
 | 
						|
{This implementation uses StdCLib: }
 | 
						|
{$define MACOS_USE_STDCLIB}
 | 
						|
 | 
						|
{Some MacOS API routines and StdCLib included for internal use:}
 | 
						|
{$I macostp.inc}
 | 
						|
 | 
						|
{Note, because the System unit is the most low level, it should not
 | 
						|
depend on any other units, and thus the macos api must be accessed
 | 
						|
as an include file and not a unit.}
 | 
						|
 | 
						|
{The reason StdCLib is used is that it can easily be connected
 | 
						|
to either SIOW or, in case of MPWTOOL, to MPW }
 | 
						|
 | 
						|
{If the Apples Universal Interfaces are used, the qd variable is required
 | 
						|
to be allocated somewhere, so we do it here for the convenience to the user.}
 | 
						|
 | 
						|
var
 | 
						|
  qd: QDGlobals; cvar;
 | 
						|
 | 
						|
 | 
						|
{$ifdef MACOS_USE_STDCLIB}
 | 
						|
 | 
						|
{************** API to StdCLib in MacOS ***************}
 | 
						|
{The reason StdCLib is used is that it can easily be connected
 | 
						|
to either SIOW or, in case of MPWTOOL, to MPW }
 | 
						|
 | 
						|
{$endif}
 | 
						|
 | 
						|
 | 
						|
{*********************** Macutils *********************}
 | 
						|
 | 
						|
{And also include the same utilities as in the macutils.pp unit.}
 | 
						|
 | 
						|
var
 | 
						|
  {emulated working directory}
 | 
						|
  workingDirectorySpec: FSSpec; cvar;
 | 
						|
 | 
						|
  {The above variable is also declared in macutils.pp as external. Declared }
 | 
						|
  {here to be available to macutils.inc and below in this file.}
 | 
						|
 | 
						|
{$I macutils.inc}
 | 
						|
 | 
						|
{******************************************************}
 | 
						|
 | 
						|
function GetAppFileLocation (var spec: FSSpec): Boolean;
 | 
						|
{Requires >= System 7}
 | 
						|
 | 
						|
  var
 | 
						|
   PSN: ProcessSerialNumber;
 | 
						|
   info: ProcessInfoRec;
 | 
						|
   appFileRefNum: Integer;
 | 
						|
   appName: Str255;
 | 
						|
   dummy: Mac_Handle;
 | 
						|
 | 
						|
begin
 | 
						|
  begin
 | 
						|
    PSN.highLongOfPSN := 0;
 | 
						|
    PSN.lowLongOfPSN := kCurrentProcess;
 | 
						|
    info.processInfoLength := SizeOf(info);
 | 
						|
    info.processName := nil;
 | 
						|
    info.processAppSpec := @spec;
 | 
						|
    if GetProcessInformation(PSN, info) = noErr then
 | 
						|
      begin
 | 
						|
        spec.name := '';
 | 
						|
        GetAppFileLocation := true;
 | 
						|
      end
 | 
						|
    else
 | 
						|
      GetAppFileLocation := false;
 | 
						|
  end
 | 
						|
end;
 | 
						|
 | 
						|
Procedure Errno2InOutRes;
 | 
						|
{
 | 
						|
  Convert ErrNo error to the correct InOutRes value.
 | 
						|
  It seems that some of the errno is, in macos,
 | 
						|
  used for other purposes than its original definition.
 | 
						|
}
 | 
						|
 | 
						|
begin
 | 
						|
  if errno = 0 then { Else it will go through all the cases }
 | 
						|
    exit;
 | 
						|
  case Errno of
 | 
						|
   Sys_ENFILE,
 | 
						|
   Sys_EMFILE : Inoutres:=4;
 | 
						|
   Sys_ENOENT : Inoutres:=2;
 | 
						|
    Sys_EBADF : Inoutres:=6;
 | 
						|
   Sys_ENOMEM,
 | 
						|
   Sys_EFAULT : Inoutres:=217; //TODO Exchange to something better
 | 
						|
   Sys_EINVAL : Inoutres:=218; //TODO RTE 218 doesn't exist
 | 
						|
   Sys_EAGAIN,
 | 
						|
   Sys_ENOSPC : Inoutres:=101;
 | 
						|
  Sys_ENOTDIR : Inoutres:=3;
 | 
						|
    Sys_EPERM,
 | 
						|
    Sys_EROFS,
 | 
						|
   Sys_EEXIST,
 | 
						|
   Sys_EISDIR,
 | 
						|
    Sys_EINTR,  //Happens when attempt to rename a file fails
 | 
						|
    Sys_EBUSY,  //Happens when attempt to remove a locked file
 | 
						|
   Sys_EACCES,
 | 
						|
   Sys_EMLINK : Inoutres:=5; //Happens when attempt to remove open file
 | 
						|
    Sys_ENXIO : InOutRes:=152;
 | 
						|
   Sys_ESPIPE : InOutRes:=156; //Illegal seek
 | 
						|
  else
 | 
						|
    InOutRes := Integer(errno);//TODO Exchange to something better
 | 
						|
  end;
 | 
						|
  errno:=0;
 | 
						|
end;
 | 
						|
 | 
						|
Procedure OSErr2InOutRes(err: OSErr);
 | 
						|
begin
 | 
						|
  InOutRes:= MacOSErr2RTEerr(err);
 | 
						|
end;
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                              MacOS specific functions
 | 
						|
*****************************************************************************}
 | 
						|
var
 | 
						|
  defaultCreator: OSType =  $4D505320; {'MPS '   MPW Shell}
 | 
						|
  //defaultCreator: OSType =  $74747874; {'ttxt'   Simple Text}
 | 
						|
  defaultFileType: OSType = $54455854; {'TEXT'}
 | 
						|
 | 
						|
procedure Yield;
 | 
						|
 | 
						|
begin
 | 
						|
  if StandAlone = 0 then
 | 
						|
    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;
 | 
						|
 | 
						|
 | 
						|
 | 
						|
 |