sysos.inc 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2001-2005 by Free Pascal development team
  4. Low level system functions for MacOS
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {*********************** MacOS API *********************}
  12. {This implementation uses StdCLib: }
  13. {$define MACOS_USE_STDCLIB}
  14. {Some MacOS API routines and StdCLib included for internal use:}
  15. {$I macostp.inc}
  16. {Note, because the System unit is the most low level, it should not
  17. depend on any other units, and thus the macos api must be accessed
  18. as an include file and not a unit.}
  19. {The reason StdCLib is used is that it can easily be connected
  20. to either SIOW or, in case of MPWTOOL, to MPW }
  21. {If the Apples Universal Interfaces are used, the qd variable is required
  22. to be allocated somewhere, so we do it here for the convenience to the user.}
  23. var
  24. qd: QDGlobals; cvar;
  25. {$ifdef MACOS_USE_STDCLIB}
  26. {************** API to StdCLib in MacOS ***************}
  27. {The reason StdCLib is used is that it can easily be connected
  28. to either SIOW or, in case of MPWTOOL, to MPW }
  29. {$endif}
  30. {*********************** Macutils *********************}
  31. {And also include the same utilities as in the macutils.pp unit.}
  32. var
  33. {emulated working directory}
  34. workingDirectorySpec: FSSpec; cvar;
  35. {The above variable is also declared in macutils.pp as external. Declared }
  36. {here to be available to macutils.inc and below in this file.}
  37. {$I macutils.inc}
  38. {******************************************************}
  39. function GetAppFileLocation (var spec: FSSpec): Boolean;
  40. {Requires >= System 7}
  41. var
  42. PSN: ProcessSerialNumber;
  43. info: ProcessInfoRec;
  44. appFileRefNum: Integer;
  45. appName: Str255;
  46. dummy: Mac_Handle;
  47. begin
  48. begin
  49. PSN.highLongOfPSN := 0;
  50. PSN.lowLongOfPSN := kCurrentProcess;
  51. info.processInfoLength := SizeOf(info);
  52. info.processName := nil;
  53. info.processAppSpec := @spec;
  54. if GetProcessInformation(PSN, info) = noErr then
  55. begin
  56. spec.name := '';
  57. GetAppFileLocation := true;
  58. end
  59. else
  60. GetAppFileLocation := false;
  61. end
  62. end;
  63. Procedure Errno2InOutRes;
  64. {
  65. Convert ErrNo error to the correct InOutRes value.
  66. It seems that some of the errno is, in macos,
  67. used for other purposes than its original definition.
  68. }
  69. begin
  70. if errno = 0 then { Else it will go through all the cases }
  71. exit;
  72. case Errno of
  73. Sys_ENFILE,
  74. Sys_EMFILE : Inoutres:=4;
  75. Sys_ENOENT : Inoutres:=2;
  76. Sys_EBADF : Inoutres:=6;
  77. Sys_ENOMEM,
  78. Sys_EFAULT : Inoutres:=217; //TODO Exchange to something better
  79. Sys_EINVAL : Inoutres:=218; //TODO RTE 218 doesn't exist
  80. Sys_EAGAIN,
  81. Sys_ENOSPC : Inoutres:=101;
  82. Sys_ENOTDIR : Inoutres:=3;
  83. Sys_EPERM,
  84. Sys_EROFS,
  85. Sys_EEXIST,
  86. Sys_EISDIR,
  87. Sys_EINTR, //Happens when attempt to rename a file fails
  88. Sys_EBUSY, //Happens when attempt to remove a locked file
  89. Sys_EACCES,
  90. Sys_EMLINK : Inoutres:=5; //Happens when attempt to remove open file
  91. Sys_ENXIO : InOutRes:=152;
  92. Sys_ESPIPE : InOutRes:=156; //Illegal seek
  93. else
  94. InOutRes := Integer(errno);//TODO Exchange to something better
  95. end;
  96. errno:=0;
  97. end;
  98. Procedure OSErr2InOutRes(err: OSErr);
  99. begin
  100. InOutRes:= MacOSErr2RTEerr(err);
  101. end;
  102. {*****************************************************************************
  103. MacOS specific functions
  104. *****************************************************************************}
  105. var
  106. defaultCreator: OSType = $4D505320; {'MPS ' MPW Shell}
  107. //defaultCreator: OSType = $74747874; {'ttxt' Simple Text}
  108. defaultFileType: OSType = $54455854; {'TEXT'}
  109. procedure Yield;
  110. begin
  111. if StandAlone = 0 then
  112. SpinCursor(1);
  113. end;
  114. procedure SetDefaultMacOSFiletype(ftype: ShortString);
  115. begin
  116. if Length(ftype) = 4 then
  117. defaultFileType:= PLongWord(@ftype[1])^;
  118. end;
  119. procedure SetDefaultMacOSCreator(creator: ShortString);
  120. begin
  121. if Length(creator) = 4 then
  122. defaultCreator:= PLongWord(@creator[1])^;
  123. end;