Hi,
I implemented a basic support for Amiga systems
with FPC 3.0+: Amiga 3.x m68k, MorphOS PowerPC, AROS i386
with FPC 3.1.1: additionally AROS ARM, AROS x86_64, AmigaOS 4 PowerPC
at the moment it only compiles NoGUI of course, but I would like to also
add the MUI LCL interface to the official repository, on the long run.
If it is possible and wanted.
Since 2010 I'm working on Lazarus/LCL MUI interface for Amiga Systems.
At the moment on github
https://github.com/alb42/lazarus/tree/lazarus-morphos some Results of
this available at my Blog: https://blog.alb42.de/category/fpc/lcl/
Is it possible to add this initial Amiga systems support? How about this
MUI LCL Interface?
Greetings,
Marcus "ALB42" Sackrow
Index: components/codetools/fileprocs.pas
===================================================================
--- components/codetools/fileprocs.pas (Revision 53782)
+++ components/codetools/fileprocs.pas (Arbeitskopie)
@@ -56,7 +56,7 @@
TFPCMemStreamSeekType = integer;
PCharZ = Pointer;
-{$if defined(Windows) or defined(darwin)}
+{$if defined(Windows) or defined(darwin) or defined(HASAMIGA)}
{$define CaseInsensitiveFilenames}
{$endif}
{$IF defined(CaseInsensitiveFilenames) or defined(darwin)}
@@ -365,8 +365,10 @@
// to get more detailed error messages consider the os
{$IFnDEF Windows}
+{$ifndef HASAMIGA}
uses
Unix;
+{$endif}
{$ENDIF}
{$IFDEF EnableWrapperFunctions}
@@ -1309,7 +1311,7 @@
Result:='';
if SearchCase=ctsfcAllCase then
Base:=FindDiskFilename(Base);
-
+
if SearchCase in [ctsfcDefault,ctsfcLoUpCase] then begin
LowerCaseFilename:=lowercase(ShortFilename);
UpperCaseFilename:=uppercase(ShortFilename);
@@ -1317,7 +1319,7 @@
LowerCaseFilename:='';
UpperCaseFilename:='';
end;
-
+
if LazFileUtils.FindFirstUTF8(Base+FileMask,faAnyFile,FileInfo)=0 then
begin
repeat
Index: components/codetools/ppugraph.pas
===================================================================
--- components/codetools/ppugraph.pas (Revision 53782)
+++ components/codetools/ppugraph.pas (Arbeitskopie)
@@ -30,12 +30,19 @@
interface
uses
- Classes, SysUtils, dynlibs, PPUParser, CodeTree, AVL_Tree, FileProcs,
+ Classes, SysUtils,
+ {$ifndef HASAMIGA}
+ dynlibs,
+ {$endif}
+ PPUParser, CodeTree, AVL_Tree, FileProcs,
LazFileUtils, BasicCodeTools, CodeGraph, CodeToolManager, CodeToolsStructs;
const
FPCPPUGroupPrefix = 'fpc_';
-
+ {$ifdef HASAMIGA}
+ SharedSuffix = 'library';
+ {$endif}
+
type
TPPUGroup = class;
@@ -44,7 +51,7 @@
pmfAutoDisabled
);
TPPUMemberFlags = set of TPPUMemberFlag;
-
+
{ TPPUMember }
TPPUMember = class
@@ -133,7 +140,7 @@
property UnitGraph: TCodeGraph read FUnitGraph;
property SortedGroups[Index: integer]: TPPUGroup read GetSortedGroups;
end;
-
+
function ComparePPUMembersByUnitName(Member1, Member2: Pointer): integer;
function CompareNameWithPPUMemberName(NamePChar, Member: Pointer): integer;
@@ -218,7 +225,7 @@
//debugln('Initialization proc: ',InitializationMangledName);
FinalizationMangledName:=PPU.GetFinalProcName;
//debugln('Finalization proc: ',FinalizationMangledName);
-
+
Result:=true;
end;
@@ -381,7 +388,7 @@
for i:=0 to UsesList.Count-1 do
AddUnitDependency(Member,UsesList[i]);
end;
-
+
procedure AddDependencies(Main: boolean);
var
AVLNode: TAVLTreeNode;
@@ -414,7 +421,7 @@
GraphNode.Data:=Member;
AVLNode:=FMembers.FindSuccessor(AVLNode);
end;
-
+
// add primary dependencies
AddDependencies(true);
// add secondary dependencies
@@ -480,8 +487,8 @@
// needed groups in topological order
if Groups.GroupGraph.GetGraphNode(KeyNode,false)=nil then
raise Exception.Create('inconsistency');
-
-
+
+
NeededLibs:='';
for i:=0 to Groups.FSortedGroups.Count-1 do begin
Group:=Groups.SortedGroups[i];
@@ -787,7 +794,7 @@
UpdateTopologicalSortedList;
// update loader units
if not UpdateLoaders then exit;
-
+
Result:=true;
end;
Index: components/lazutils/amigafileutil.inc
===================================================================
--- components/lazutils/amigafileutil.inc (nicht existent)
+++ components/lazutils/amigafileutil.inc (Arbeitskopie)
@@ -0,0 +1,8 @@
+{%MainUnit fileutil.pas}
+
+
+function ExtractShortPathNameUTF8(const FileName: String): String;
+begin
+ Result:=SysToUTF8(SysUtils.ExtractShortPathName(UTF8ToSys(FileName)));
+end;
+
Eigenschaftsänderungen: components/lazutils/amigafileutil.inc
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+text/plain
\ No newline at end of property
Index: components/lazutils/amigalazfileutils.inc
===================================================================
--- components/lazutils/amigalazfileutils.inc (nicht existent)
+++ components/lazutils/amigalazfileutils.inc (Arbeitskopie)
@@ -0,0 +1,330 @@
+{%MainUnit lazfileutils.pas}
+
+function FilenameIsAbsolute(const TheFilename: string):boolean;
+begin
+ Result := Pos(':', TheFilename) > 1;
+end;
+
+function FileOpenUTF8(const FileName: string; Mode: Integer): THandle;
+begin
+ Result := SysUtils.FileOpen(UTF8ToSys(FileName), Mode);
+end;
+
+function FileCreateUTF8(const FileName: string): THandle;
+begin
+ Result := SysUtils.FileCreate(UTF8ToSys(FileName));
+end;
+
+function FileCreateUTF8(const FileName: string; Rights: Cardinal): THandle;
+begin
+ Result := SysUtils.FileCreate(UTF8ToSys(FileName), Rights);
+end;
+
+function FileCreateUtf8(const FileName: String; ShareMode: Integer;
+ Rights: Cardinal): THandle;
+begin
+ Result := SysUtils.FileCreate(UTF8ToSys(FileName), ShareMode, Rights);
+end;
+
+function FileGetAttrUTF8(const FileName: String): Longint;
+begin
+ Result:=SysUtils.FileGetAttr(UTF8ToSys(Filename));
+end;
+
+function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint;
+begin
+ Result:=SysUtils.FileSetAttr(UTF8ToSys(Filename),Attr);
+ InvalidateFileStateCache(Filename);
+end;
+
+function FileExistsUTF8(const Filename: string): boolean;
+begin
+ Result:=SysUtils.FileExists(UTF8ToSys(Filename));
+end;
+
+function DirectoryExistsUTF8(const Directory: string): Boolean;
+begin
+ Result:=SysUtils.DirectoryExists(UTF8ToSys(Directory));
+end;
+
+function FileAgeUTF8(const FileName: string): Longint;
+begin
+ Result:=SysUtils.FileAge(UTF8ToSys(Filename));
+end;
+
+function FileSetDateUTF8(const FileName: String; Age: Longint): Longint;
+begin
+ Result := SysUtils.FileSetDate(UTF8ToSys(Filename), Age);
+ InvalidateFileStateCache(Filename);
+end;
+
+function FileSizeUtf8(const Filename: string): int64;
+var
+ Info: TSearchRec;
+ Str: AnsiString;
+begin
+ Result := 0;
+ Str := Utf8ToAnsi(Filename);
+ if SysUtils.FindFirst (str, faAnyFile and faDirectory, Info) = 0 then
+ begin
+ Result := Info.Size;
+ end;
+ SysUtils.FindClose(Info);
+end;
+
+{------------------------------------------------------------------------------
+ function ReadAllLinks(const Filename: string;
+ ExceptionOnError: boolean): string;
+ ------------------------------------------------------------------------------}
+function ReadAllLinks(const Filename: string;
+ ExceptionOnError: boolean): string;
+begin
+ Result:='';
+end;
+
+function GetPhysicalFilename(const Filename: string;
+ OnError: TPhysicalFilenameOnError): string;
+begin
+ Result:=Filename;
+end;
+
+function CreateDirUTF8(const NewDir: String): Boolean;
+begin
+ Result:=SysUtils.CreateDir(UTF8ToSys(NewDir));
+end;
+
+function RemoveDirUTF8(const Dir: String): Boolean;
+begin
+ Result:=SysUtils.RemoveDir(UTF8ToSys(Dir));
+end;
+
+function DeleteFileUTF8(const FileName: String): Boolean;
+begin
+ Result:=SysUtils.DeleteFile(UTF8ToSys(Filename));
+ if Result then
+ InvalidateFileStateCache;
+end;
+
+function RenameFileUTF8(const OldName, NewName: String): Boolean;
+begin
+ Result:=SysUtils.RenameFile(UTF8ToSys(OldName),UTF8ToSys(NewName));
+ if Result then
+ InvalidateFileStateCache;
+end;
+
+function SetCurrentDirUTF8(const NewDir: String): Boolean;
+begin
+ Result:=SysUtils.SetCurrentDir(UTF8ToSys(NewDir));
+end;
+
+function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec
+ ): Longint;
+begin
+ Result:=SysUtils.FindFirst(UTF8ToSys(Path),Attr,Rslt);
+ Rslt.Name:=SysToUTF8(Rslt.Name);
+end;
+
+function FindNextUTF8(var Rslt: TSearchRec): Longint;
+begin
+ Rslt.Name:=UTF8ToSys(Rslt.Name);
+ Result:=SysUtils.FindNext(Rslt);
+ Rslt.Name:=SysToUTF8(Rslt.Name);
+end;
+
+
+function ExpandFileNameUTF8(const FileName: string; BaseDir: string): string;
+var
+ IsAbs: Boolean;
+ CurDir, Fn: String;
+begin
+ Fn := FileName;
+ ForcePathDelims(Fn);
+ IsAbs := FileNameIsAbsolute(Fn);
+ if (not IsAbs) then
+ begin
+ CurDir := GetCurrentDirUtf8;
+ end;
+ if IsAbs then
+ begin
+ Result := ResolveDots(Fn);
+ end
+ else
+ begin
+ if (BaseDir = '') then
+ Fn := IncludeTrailingPathDelimiter(CurDir) + Fn
+ else
+ Fn := IncludeTrailingPathDelimiter(BaseDir) + Fn;
+ Fn := ResolveDots(Fn);
+ //if BaseDir is not absolute then this needs to be expanded as well
+ if not FileNameIsAbsolute(Fn) then
+ Fn := ExpandFileNameUtf8(Fn, '');
+ Result := Fn;
+ end;
+end;
+
+function GetCurrentDirUTF8: String;
+begin
+ Result:=SysToUTF8(SysUtils.GetCurrentDir);
+end;
+
+function FileIsExecutable(const AFilename: string): boolean;
+var
+ Fn: string;
+ MyLock: BPTR;
+ Info: TFileInfoBlock;
+begin
+ Result := False;
+ Fn := Utf8ToSys(AFilename);
+ MyLock := AmigaDos.Lock(PChar(Fn), SHARED_LOCK);
+ if PtrUInt(MyLock) <> 0 then
+ begin
+ Examine(MyLock, @Info);
+ Result := (Info.fib_Protection and FIBF_EXECUTE) <> 0;
+ AmigaDos.UnLock(MyLock);
+ end;
+end;
+
+procedure CheckIfFileIsExecutable(const AFilename: string);
+begin
+ // TProcess does not report, if a program can not be executed
+ // to get good error messages consider the OS
+ if not FileExistsUTF8(AFilename) then begin
+ raise Exception.Create(SysUtils.Format(lrsFileDoesNotExist, [AFilename]));
+ end;
+ if DirPathExists(AFilename) then begin
+ raise Exception.Create(SysUtils.Format(lrsFileIsADirectoryAndNotAnExecutable, [
+ AFilename]));
+ end;
+end;
+
+function FileIsSymlink(const AFilename: string): boolean;
+begin
+ Result := False;
+end;
+
+procedure CheckIfFileIsSymlink(const AFilename: string);
+begin
+ // to get good error messages consider the OS
+ if not FileExistsUTF8(AFilename) then begin
+ raise Exception.Create(SysUtils.Format(lrsFileDoesNotExist, [AFilename]));
+ end;
+ if not FileIsSymLink(AFilename) then
+ raise Exception.Create(SysUtils.Format(lrsIsNotASymbolicLink, [AFilename]));
+end;
+
+function FileIsHardLink(const AFilename: string): boolean;
+begin
+ Result := false;
+end;
+
+function FileIsReadable(const AFilename: string): boolean;
+var
+ Fn: string;
+ MyLock: BPTR;
+ Info: TFileInfoBlock;
+begin
+ Result := False;
+ Fn := Utf8ToSys(AFilename);
+ MyLock := AmigaDos.Lock(PChar(Fn), SHARED_LOCK);
+ if PtrUInt(MyLock) <> 0 then
+ begin
+ Examine(MyLock, @Info);
+ Result := (Info.fib_Protection and FIBF_READ) <> 0;
+ AmigaDos.UnLock(MyLock);
+ end;
+end;
+
+function FileIsWritable(const AFilename: string): boolean;
+var
+ Fn: string;
+ MyLock: BPTR;
+ Info: TFileInfoBlock;
+begin
+ Result := False;
+ Fn := Utf8ToSys(AFilename);
+ MyLock := AmigaDos.Lock(PChar(Fn), SHARED_LOCK);
+ if PtrUInt(MyLock) <> 0 then
+ begin
+ Examine(MyLock, @Info);
+ Result := (Info.fib_Protection and FIBF_WRITE) <> 0;
+ AmigaDos.UnLock(MyLock);
+ end;
+end;
+
+
+function IsUNCPath(const Path: String): Boolean;
+begin
+ Result := false;
+end;
+
+function ExtractUNCVolume(const Path: String): String;
+begin
+ Result := '';
+end;
+
+function GetFileDescription(const AFilename: string): string;
+var
+ Fn: string;
+ MyLock: BPTR;
+ Info: TFileInfoBlock;
+begin
+ Result := '';
+ Fn := Utf8ToSys(AFilename);
+ MyLock := AmigaDos.Lock(PChar(Fn), SHARED_LOCK);
+ if PtrUInt(MyLock) <> 0 then
+ begin
+ Examine(MyLock, @Info);
+ if (Info.fib_Protection and FIBF_ARCHIVE) <> 0 then
+ Result := Result + 'a';
+ if (Info.fib_Protection and FIBF_SCRIPT) <> 0 then
+ Result := Result + 's';
+ if (Info.fib_Protection and FIBF_PURE) <> 0 then
+ Result := Result + 'p';
+ if (Info.fib_Protection and FIBF_EXECUTE) <> 0 then
+ Result := Result + 'e';
+ if (Info.fib_Protection and FIBF_READ) <> 0 then
+ Result := Result + 'r';
+ if (Info.fib_Protection and FIBF_WRITE) <> 0 then
+ Result := Result + 'w';
+ if (Info.fib_Protection and FIBF_DELETE) <> 0 then
+ Result := Result + 'd';
+ AmigaDos.UnLock(MyLock);
+ end;
+end;
+
+
+function GetAppConfigDirUTF8(Global: Boolean; Create: boolean = false): string;
+begin
+ Result := SysToUTF8(SysUtils.GetAppConfigDir(Global));
+ if Result = '' then exit;
+ if Create and not ForceDirectoriesUTF8(Result) then
+ raise EInOutError.Create(SysUtils.Format(lrsUnableToCreateConfigDirectoryS,[Result]));
+end;
+
+function GetAppConfigFileUTF8(Global: Boolean; SubDir: boolean;
+ CreateDir: boolean): string;
+var
+ Dir: string;
+begin
+ Result := SysToUTF8(SysUtils.GetAppConfigFile(Global,SubDir));
+ if not CreateDir then exit;
+ Dir := ExtractFilePath(Result);
+ if Dir = '' then exit;
+ if not ForceDirectoriesUTF8(Dir) then
+ raise EInOutError.Create(SysUtils.Format(lrsUnableToCreateConfigDirectoryS,[Dir]));
+end;
+
+function GetShellLinkTarget(const FileName: string): string;
+begin
+ Result := Filename;
+end;
+
+procedure InitLazFileUtils;
+begin
+ //dummy
+end;
+
+procedure FinalizeLazFileUtils;
+begin
+ //dummy
+end;
Eigenschaftsänderungen: components/lazutils/amigalazfileutils.inc
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+text/plain
\ No newline at end of property
Index: components/lazutils/amigalazutf8.inc
===================================================================
--- components/lazutils/amigalazutf8.inc (nicht existent)
+++ components/lazutils/amigalazutf8.inc (Arbeitskopie)
@@ -0,0 +1,50 @@
+{%MainUnit lazutf8.pas}
+
+function ConsoleToUTF8(const s: string): string;// converts UTF8 string to console encoding (used by Write, WriteLn)
+begin
+ Result := SysToUTF8(S);
+end;
+
+function UTF8ToConsole(const s: string): string;
+begin
+ Result := UTF8ToSys(s);
+end;
+
+function WinCPToUTF8(const s: string): string;
+begin
+ if NeedRTLAnsi and (not IsASCII(s)) then
+ begin
+ Result:=AnsiToUTF8(s);
+ {$ifdef FPC_HAS_CPSTRING}
+ // prevent UTF8 codepage appear in the strings - we don't need codepage
+ // conversion magic in LCL code
+ SetCodePage(RawByteString(Result), StringCodePage(s), False);
+ {$endif}
+ end
+ else
+ Result:=s;
+end;
+
+function UTF8ToWinCP(const s: string): string;
+begin
+ if NeedRTLAnsi and (not IsASCII(s)) then
+ Result:=UTF8ToAnsi(s)
+ else
+ Result:=s;
+end;
+
+function ParamStrUTF8(Param: Integer): string;
+begin
+ Result:=SysToUTF8(ObjPas.ParamStr(Param));
+end;
+
+procedure InitLazUtf8;
+begin
+ //dummy procedure
+end;
+
+procedure FinalizeLazUTF8;
+begin
+ //dummy procedure
+end;
+
Eigenschaftsänderungen: components/lazutils/amigalazutf8.inc
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+text/plain
\ No newline at end of property
Index: components/lazutils/fileutil.pas
===================================================================
--- components/lazutils/fileutil.pas (Revision 53782)
+++ components/lazutils/fileutil.pas (Arbeitskopie)
@@ -29,8 +29,8 @@
uses
Classes, SysUtils,
Masks, LazUTF8, LazFileUtils, StrUtils;
-
-{$if defined(Windows) or defined(darwin)}
+
+{$if defined(Windows) or defined(darwin) or defined(HASAMIGA)}
{$define CaseInsensitiveFilenames}
{$endif}
{$IF defined(CaseInsensitiveFilenames) or defined(darwin)}
@@ -284,7 +284,11 @@
{$IFDEF windows}
Windows;
{$ELSE}
+ {$IFDEF HASAMIGA}
+ AmigaDOS;
+ {$ELSE}
Unix;
+ {$ENDIF}
{$ENDIF}
{$I fileutil.inc}
@@ -291,7 +295,11 @@
{$IFDEF windows}
{$i winfileutil.inc}
{$ELSE}
+ {$IFDEF HASAMIGA}
+ {$i amigafileutil.inc}
+ {$ELSE}
{$i unixfileutil.inc}
+ {$ENDIF}
{$ENDIF}
end.
Index: components/lazutils/lazfileutils.pas
===================================================================
--- components/lazutils/lazfileutils.pas (Revision 53782)
+++ components/lazutils/lazfileutils.pas (Arbeitskopie)
@@ -24,6 +24,9 @@
{$IFDEF darwin}
{$define CaseInsensitiveFilenames}
{$ENDIF}
+{$IFDEF HASAMIGA}
+ {$define CaseInsensitiveFilenames}
+{$ENDIF}
{$IF defined(CaseInsensitiveFilenames) or defined(darwin)}
{$DEFINE NotLiteralFilenames} // e.g. HFS+ normalizes file names
{$ENDIF}
@@ -168,10 +171,14 @@
{$IFDEF Windows}
Windows {$IFnDEF WinCE}, ShlObj, ActiveX, WinDirs{$ENDIF};
{$ELSE}
- {$IFDEF darwin}
- MacOSAll,
+ {$IFDEF HASAMIGA}
+ exec, amigados;
+ {$ELSE}
+ {$IFDEF darwin}
+ MacOSAll,
+ {$ENDIF}
+ Unix, BaseUnix;
{$ENDIF}
- Unix, BaseUnix;
{$ENDIF}
{$I lazfileutils.inc}
@@ -178,7 +185,11 @@
{$IFDEF windows}
{$I winlazfileutils.inc}
{$ELSE}
- {$I unixlazfileutils.inc}
+ {$ifdef HASAMIGA}
+ {$I amigalazfileutils.inc}
+ {$ELSE}
+ {$I unixlazfileutils.inc}
+ {$ENDIF}
{$ENDIF}
function CompareFilenames(const Filename1, Filename2: string): integer;
@@ -1026,7 +1037,7 @@
Start:=Start+Prefix;
I:=0;
repeat
- Result:=Format('%s%.5d.tmp',[Start,I]);
+ Result:=SysUtils.Format('%s%.5d.tmp',[Start,I]);
Inc(I);
until not FileExistsUTF8(Result);
end;
Index: components/lazutils/lazutf8.pas
===================================================================
--- components/lazutils/lazutf8.pas (Revision 53782)
+++ components/lazutils/lazutf8.pas (Arbeitskopie)
@@ -227,7 +227,11 @@
{$ifdef windows}
{$i winlazutf8.inc}
{$else}
+ {$ifdef HASAMIGA}
+ {$i amigalazutf8.inc}
+ {$else}
{$i unixlazutf8.inc}
+ {$endif}
{$endif}
var
@@ -2158,9 +2162,9 @@
2C60;LATIN CAPITAL LETTER L WITH DOUBLE BAR;Lu;0;L;;;;;N;;;;2C61; E2 B1 A0 => +1
2C61;LATIN SMALL LETTER L WITH DOUBLE BAR;Ll;0;L;;;;;N;;;2C60;;2C60
- 2C62;LATIN CAPITAL LETTER L WITH MIDDLE TILDE;Lu;0;L;;;;;N;;;;026B; => C9 AB
+ 2C62;LATIN CAPITAL LETTER L WITH MIDDLE TILDE;Lu;0;L;;;;;N;;;;026B; => C9 AB
2C63;LATIN CAPITAL LETTER P WITH STROKE;Lu;0;L;;;;;N;;;;1D7D; => E1 B5 BD
- 2C64;LATIN CAPITAL LETTER R WITH TAIL;Lu;0;L;;;;;N;;;;027D; => C9 BD
+ 2C64;LATIN CAPITAL LETTER R WITH TAIL;Lu;0;L;;;;;N;;;;027D; => C9 BD
2C65;LATIN SMALL LETTER A WITH STROKE;Ll;0;L;;;;;N;;;023A;;023A
2C66;LATIN SMALL LETTER T WITH DIAGONAL STROKE;Ll;0;L;;;;;N;;;023E;;023E
2C67;LATIN CAPITAL LETTER H WITH DESCENDER;Lu;0;L;;;;;N;;;;2C68; => E2 B1 A8
Index: components/lazutils/lazutf8sysutils.pas
===================================================================
--- components/lazutils/lazutf8sysutils.pas (Revision 53782)
+++ components/lazutils/lazutf8sysutils.pas (Arbeitskopie)
@@ -24,10 +24,13 @@
{$ifdef Windows}
Windows,
{$else}
- Unix, BaseUnix,
- {$If defined(Linux) and (FPC_FULLVERSION<30000)}
- Linux,
- {$EndIf}
+ {$ifdef HASAMIGA}
+ {$else}
+ Unix, BaseUnix,
+ {$If defined(Linux) and (FPC_FULLVERSION<30000)}
+ Linux,
+ {$EndIf}
+ {$endif}
{$endif}
Classes;
Index: lcl/include/sysenvapis_amiga.inc
===================================================================
--- lcl/include/sysenvapis_amiga.inc (nicht existent)
+++ lcl/include/sysenvapis_amiga.inc (Arbeitskopie)
@@ -0,0 +1,102 @@
+{%MainUnit ../lclintf.pas}
+
+{$I ../../components/lazutils/lazutils_defines.inc} //LCL depends on LazUtils, so this is OK
+
+
+function IsLaunchWinApp(ABrowser: WideString): Boolean;
+begin
+ Result := False;
+end;
+
+//not every AppUserModelID we retrieve using GetDefaultBrowserWideByAppID
+//accepts paramters (e.g. the URL)
+function LaunchWinAppBrowserCanHandleParams(ABrowser: WideString): Boolean;
+begin
+ Result := False;
+end;
+
+function GetDefaultBrowserWideByAppID: WideString;
+begin
+ Result := '';
+end;
+
+function GetDefaultBrowserWideByCmd: WideString;
+begin
+ Result := '';
+end;
+
+
+procedure ExtractBrowserAndParamsWide(const S: WideString; out ABrowser, AParams: WideString);
+begin
+ ABrowser := S;
+ AParams := '%s';
+end;
+
+
+function FindDefaultBrowserWide(out ABrowser, AParams: WideString): Boolean;
+begin
+ ABrowser := '';
+ AParams := '"%s"';
+end;
+
+function FindDefaultBrowserUtf8(out ABrowser, AParams: String): Boolean;
+var
+ QueryRes: String;
+ WideBrowser, WideParams: WideString;
+begin
+ Result := FindDefaultBrowserWide(WideBrowser, WideParams);
+ ABrowser := Utf16ToUtf8(WideBrowser);
+ AParams := Utf16ToUtf8(WideParams);
+end;
+
+function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;
+begin
+ Result := FindDefaultBrowserUtf8(ABrowser, AParams);
+ {$IFDEF ACP_RTL}
+ ABrowser := Utf8ToWinCp(ABrowser);
+ AParams := Utf8ToWinCp(AParams);
+ {$ENDIF ACP_RTL}
+end;
+
+function IsFileUriScheme(const AURL: String): Boolean;
+const
+ FileURIScheme = 'file://';
+begin
+ Result := (CompareText(Copy(AURL,1,Length(FileURIScheme)), FileURIScheme) = 0);
+end;
+
+function IsHtmlWithAnchor(AURL: String): Boolean;
+var
+ AnchorPos, HtmlPos: SizeInt;
+begin
+ Result := False;
+ //Anchor will be defined by last '#' in AURL;
+ AnchorPos := Length(AURL);
+ while (AnchorPos < 0) and (AURL[AnchorPos] <> '#') do Dec(AnchorPos);
+ if (AnchorPos > 0) then
+ begin
+ AURL := UpperCase(AURL); //don't care about UTF8
+ HtmlPos := Pos('.HTM', AURL);
+ if (HtmlPos = 0) then HtmlPos := Pos('.HTML', AURL);
+ Result := (HtmlPos > 0) and (AnchorPos > HtmlPos);
+ end;
+end;
+
+//Currently only used to open a local html file with a specified anchor
+//but in theory should be able to handle all URL's
+function FindDefaultBrowserAndOpenUrl(AURL: String; IsFileURI: Boolean=False{; IsLocalWithAnchor: Boolean=False}): Boolean;
+begin
+ Result := False;
+end;
+
+// Open a given URL with whatever Windows thinks is appropriate
+function OpenURL(AURL: String): Boolean;
+begin
+ Result := False;
+end;
+
+// Open a document with the default application associated with it in the system
+function OpenDocument(APath: String): Boolean;
+begin
+ Result := OpenURL(APath);
+end;
Eigenschaftsänderungen: lcl/include/sysenvapis_amiga.inc
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+text/plain
\ No newline at end of property
Index: lcl/lclintf.pas
===================================================================
--- lcl/lclintf.pas (Revision 53782)
+++ lcl/lclintf.pas (Arbeitskopie)
@@ -213,6 +213,9 @@
{$ifdef Windows}
{$I sysenvapis_win.inc}
{$endif}
+{$ifdef HASAMIGA}
+ {$I sysenvapis_amiga.inc}
+{$endif}
{$ifdef UNIX}
{$ifdef darwin}
{$I sysenvapis_mac.inc}
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus
