From 3d54c41f98c85ab14a4e64ffe5e9cd32f0d36955 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Tue, 12 Oct 2010 09:54:03 +0000 Subject: [PATCH] Isolates the system environment apis in separate includes files. One for common code and one per operating system git-svn-id: trunk@27661 - --- .gitattributes | 4 + lcl/include/sysenvapis.inc | 43 +++++++++ lcl/include/sysenvapis_mac.inc | 25 ++++++ lcl/include/sysenvapis_unix.inc | 33 +++++++ lcl/include/sysenvapis_win.inc | 41 +++++++++ lcl/lclintf.pas | 150 ++++---------------------------- 6 files changed, 161 insertions(+), 135 deletions(-) create mode 100644 lcl/include/sysenvapis.inc create mode 100644 lcl/include/sysenvapis_mac.inc create mode 100644 lcl/include/sysenvapis_unix.inc create mode 100644 lcl/include/sysenvapis_win.inc diff --git a/.gitattributes b/.gitattributes index 73bfebfef7..1c518508fd 100644 --- a/.gitattributes +++ b/.gitattributes @@ -4659,6 +4659,10 @@ lcl/include/spinedit.inc svneol=native#text/pascal lcl/include/statusbar.inc svneol=native#text/pascal lcl/include/statuspanel.inc svneol=native#text/pascal lcl/include/statuspanels.inc svneol=native#text/pascal +lcl/include/sysenvapis.inc svneol=native#text/pascal +lcl/include/sysenvapis_mac.inc svneol=native#text/pascal +lcl/include/sysenvapis_unix.inc svneol=native#text/pascal +lcl/include/sysenvapis_win.inc svneol=native#text/pascal lcl/include/tabcontrol.inc svneol=native#text/pascal lcl/include/tabsheet.inc svneol=native#text/pascal lcl/include/tiffimage.inc svneol=native#text/pascal diff --git a/lcl/include/sysenvapis.inc b/lcl/include/sysenvapis.inc new file mode 100644 index 0000000000..a968ce5850 --- /dev/null +++ b/lcl/include/sysenvapis.inc @@ -0,0 +1,43 @@ +{%MainUnit ../lclintf.pp} + +// Locates the default browser associated in the system +function FindDefaultBrowser(out ABrowser, AParams: String): Boolean; + + function Find(const ShortFilename: String; out ABrowser: String): Boolean; inline; + begin + ABrowser := SearchFileInPath(ShortFilename + GetExeExt, '', + GetEnvironmentVariableUTF8('PATH'), PathSeparator, + [sffDontSearchInBasePath]); + Result := ABrowser <> ''; + end; + +begin + {$IFDEF MSWindows} + Find('rundll32', ABrowser); + AParams := 'url.dll,FileProtocolHandler %s'; + {$ELSE} + {$IFDEF DARWIN} + // open command launches url in the appropriate browser under Mac OS X + Find('open', ABrowser); + AParams := '"%s"'; + {$ELSE} + ABrowser := ''; + {$ENDIF} + {$ENDIF} + if ABrowser = '' then + begin + AParams := '"%s"'; + // Then search in path. Prefer open source ;) + if Find('xdg-open', ABrowser) // Portland OSDL/FreeDesktop standard on Linux + or Find('htmlview', ABrowser) // some redhat systems + or Find('firefox', ABrowser) + or Find('mozilla', ABrowser) + or Find('galeon', ABrowser) + or Find('konqueror', ABrowser) + or Find('safari', ABrowser) + or Find('netscape', ABrowser) + or Find('opera', ABrowser) + or Find('iexplore', ABrowser) then ;// some windows systems + end; + Result := ABrowser <> ''; +end; diff --git a/lcl/include/sysenvapis_mac.inc b/lcl/include/sysenvapis_mac.inc new file mode 100644 index 0000000000..f3a61fb407 --- /dev/null +++ b/lcl/include/sysenvapis_mac.inc @@ -0,0 +1,25 @@ +{%MainUnit ../lclintf.pp} + +// Open a given URL with the default browser +function OpenURL(AURL: String): Boolean; +var + cf: CFStringRef; + url: CFURLRef; +begin + if AURL = '' then + Exit(False); + cf := CFStringCreateWithCString(kCFAllocatorDefault, @AURL[1], kCFStringEncodingUTF8); + if not Assigned(cf) then + Exit(False); + url := CFURLCreateWithString(nil, cf, nil); + Result := LSOpenCFURLRef(url, nil) = 0; + CFRelease(url); + CFRelease(cf); +end; + +// Open a document with the default application associated with it in the system +function OpenDocument(APath: String): Boolean; +begin + Result := True; + RunCmdFromPath('open',APath); +end; diff --git a/lcl/include/sysenvapis_unix.inc b/lcl/include/sysenvapis_unix.inc new file mode 100644 index 0000000000..14f8f8f8f9 --- /dev/null +++ b/lcl/include/sysenvapis_unix.inc @@ -0,0 +1,33 @@ +{%MainUnit ../lclintf.pp} + +// Open a given URL with the default browser +function OpenURL(AURL: String): Boolean; +var + ABrowser, AParams: String; +begin + Result := FindDefaultBrowser(ABrowser, AParams) and FileExistsUTF8(ABrowser) and FileIsExecutable(ABrowser); + if not Result then + Exit; + RunCmdFromPath(ABrowser,Format(AParams, [AURL])); +end; + +// Open a document with the default application associated with it in the system +function OpenDocument(APath: String): Boolean; +var + lApp: string; +begin + Result := True; + if not FileExistsUTF8(APath) then exit(false); + + lApp:=FindFilenameOfCmd('xdg-open'); // Portland OSDL/FreeDesktop standard on Linux + if lApp='' then + lApp:=FindFilenameOfCmd('kfmclient'); // KDE command + if lApp='' then + lApp:=FindFilenameOfCmd('gnome-open'); // GNOME command + if lApp='' then + Exit(False); + + if (APath<>'') and (APath[1]<>'"') then + APath:=QuotedStr(APath); + RunCmdFromPath(lApp,APath); +end; diff --git a/lcl/include/sysenvapis_win.inc b/lcl/include/sysenvapis_win.inc new file mode 100644 index 0000000000..62d4d7784f --- /dev/null +++ b/lcl/include/sysenvapis_win.inc @@ -0,0 +1,41 @@ +{%MainUnit ../lclintf.pp} + +// Open a given URL with the default browser +function OpenURL(AURL: String): Boolean; +var +{$IFDEF WinCE} + Info: SHELLEXECUTEINFO; +{$ELSE} + ws: WideString; + ans: AnsiString; +{$ENDIF} +begin + Result := False; + if AURL = '' then Exit; + + {$IFDEF WinCE} + FillChar(Info, SizeOf(Info), 0); + Info.cbSize := SizeOf(Info); + Info.fMask := SEE_MASK_FLAG_NO_UI; + Info.lpVerb := 'open'; + Info.lpFile := PWideChar(UTF8Decode(AURL)); + Result := ShellExecuteEx(@Info); + {$ELSE} + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + ws := UTF8Decode(AURL); + Result := ShellExecuteW(0, 'open', PWideChar(ws), nil, nil, SW_SHOWNORMAL) > 32; + end + else + begin + ans := Utf8ToAnsi(AURL); // utf8 must be converted to Windows Ansi-codepage + Result := ShellExecute(0, 'open', PAnsiChar(ans), nil, nil, SW_SHOWNORMAL) > 32; + end; + {$ENDIF} +end; + +// Open a document with the default application associated with it in the system +function OpenDocument(APath: String): Boolean; +begin + Result := OpenURL(APath); +end; diff --git a/lcl/lclintf.pas b/lcl/lclintf.pas index f1ea3ad6bc..7fdcc28aaa 100644 --- a/lcl/lclintf.pas +++ b/lcl/lclintf.pas @@ -88,6 +88,7 @@ function GetTickCount: DWord; function GetTickStep: DWord; {$ENDIF} +// Functions in the include file sysenvapis.inc function FindDefaultBrowser(out ABrowser, AParams: String): Boolean; function OpenURL(AURL: String): Boolean; function OpenDocument(APath: String): Boolean; @@ -200,144 +201,23 @@ begin if KeyData and $20000000 <> 0 then Include(Result, ssAlt); end; -function FindDefaultBrowser(out ABrowser, AParams: String): Boolean; - - function Find(const ShortFilename: String; out ABrowser: String): Boolean; inline; - begin - ABrowser := SearchFileInPath(ShortFilename + GetExeExt, '', - GetEnvironmentVariableUTF8('PATH'), PathSeparator, - [sffDontSearchInBasePath]); - Result := ABrowser <> ''; - end; - -begin - {$IFDEF MSWindows} - Find('rundll32', ABrowser); - AParams := 'url.dll,FileProtocolHandler %s'; - {$ELSE} - {$IFDEF DARWIN} - // open command launches url in the appropriate browser under Mac OS X - Find('open', ABrowser); - AParams := '"%s"'; - {$ELSE} - ABrowser := ''; - {$ENDIF} - {$ENDIF} - if ABrowser = '' then - begin - AParams := '"%s"'; - // Then search in path. Prefer open source ;) - if Find('xdg-open', ABrowser) // Portland OSDL/FreeDesktop standard on Linux - or Find('htmlview', ABrowser) // some redhat systems - or Find('firefox', ABrowser) - or Find('mozilla', ABrowser) - or Find('galeon', ABrowser) - or Find('konqueror', ABrowser) - or Find('safari', ABrowser) - or Find('netscape', ABrowser) - or Find('opera', ABrowser) - or Find('iexplore', ABrowser) then ;// some windows systems - end; - Result := ABrowser <> ''; -end; - -function OpenURL(AURL: String): Boolean; -{$IFDEF Windows} -var -{$IFDEF WinCE} - Info: SHELLEXECUTEINFO; -{$ELSE} - ws: WideString; - ans: AnsiString; -{$ENDIF} -begin - Result := False; - if AURL = '' then Exit; - - {$IFDEF WinCE} - FillChar(Info, SizeOf(Info), 0); - Info.cbSize := SizeOf(Info); - Info.fMask := SEE_MASK_FLAG_NO_UI; - Info.lpVerb := 'open'; - Info.lpFile := PWideChar(UTF8Decode(AURL)); - Result := ShellExecuteEx(@Info); - {$ELSE} - if Win32Platform = VER_PLATFORM_WIN32_NT then - begin - ws := UTF8Decode(AURL); - Result := ShellExecuteW(0, 'open', PWideChar(ws), nil, nil, SW_SHOWNORMAL) > 32; - end - else - begin - ans := Utf8ToAnsi(AURL); // utf8 must be converted to Windows Ansi-codepage - Result := ShellExecute(0, 'open', PAnsiChar(ans), nil, nil, SW_SHOWNORMAL) > 32; - end; - {$ENDIF} -end; -{$ELSE} -{$IFDEF DARWIN} -var - cf: CFStringRef; - url: CFURLRef; -begin - if AURL = '' then - Exit(False); - cf := CFStringCreateWithCString(kCFAllocatorDefault, @AURL[1], kCFStringEncodingUTF8); - if not Assigned(cf) then - Exit(False); - url := CFURLCreateWithString(nil, cf, nil); - Result := LSOpenCFURLRef(url, nil) = 0; - CFRelease(url); - CFRelease(cf); -end; -{$ELSE} -var - ABrowser, AParams: String; -begin - Result := FindDefaultBrowser(ABrowser, AParams) and FileExistsUTF8(ABrowser) and FileIsExecutable(ABrowser); - if not Result then - Exit; - RunCmdFromPath(ABrowser,Format(AParams, [AURL])); -end; -{$ENDIF} -{$ENDIF} - -function OpenDocument(APath: String): Boolean; -{$IFDEF Windows} -begin - Result := OpenURL(APath); -end; -{$ELSE} -{$IFDEF DARWIN} -begin - Result := True; - RunCmdFromPath('open',APath); -end; -{$ELSE} -var - lApp: string; -begin - Result := True; - if not FileExistsUTF8(APath) then exit(false); - - lApp:=FindFilenameOfCmd('xdg-open'); // Portland OSDL/FreeDesktop standard on Linux - if lApp='' then - lApp:=FindFilenameOfCmd('kfmclient'); // KDE command - if lApp='' then - lApp:=FindFilenameOfCmd('gnome-open'); // GNOME command - if lApp='' then - Exit(False); - - if (APath<>'') and (APath[1]<>'"') then - APath:=QuotedStr(APath); - RunCmdFromPath(lApp,APath); -end; -{$ENDIF} -{$ENDIF} - {$I winapi.inc} {$I lclintf.inc} +// System APIs which have an operating-system specific implementation +// They should be moved to FPC eventually +{$I sysenvapis.inc} +{$ifdef Windows} + {$I sysenvapis_win.inc} +{$endif} +{$ifdef UNIX} + {$ifdef darwin} + {$I sysenvapis_mac.inc} + {$else} + {$I sysenvapis_unix.inc} + {$endif} +{$endif} + procedure InternalInit; var AClipboardFormat: TPredefinedClipboardFormat;