Added the ability to setup the Profile Directory and Cache Directory via OnDirectoryService.

Small changes in initialization sequence.
Added a designtime logo to the Gecko window.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1389 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/geckoport/Components/CallbackInterfaces.pas

@@ -34,10 +34,22 @@
  * ***** END LICENSE BLOCK ***** *)
 unit CallbackInterfaces;
 
+{$MACRO on}
+
+{$IFDEF Windows}
+  {$DEFINE extdecl:=stdcall}
+{$ELSE Windows}
+  {$DEFINE extdecl:=cdecl}
+{$ENDIF}
+
+{$IFNDEF FPC_HAS_CONSTREF}
+  {$DEFINE constref:=const}
+{$ENDIF}
+
 interface
 
 uses
-  nsXPCOM, nsTypes;
+  nsXPCOM, nsTypes,nsInit, nsGeckoStrings;
 
 type
   IGeckoCreateWindowTarget = interface
@@ -51,6 +63,26 @@ type
     function GetCreateWindowTarget: IGeckoCreateWindowTarget;
   end;
 
+  { nsMyDirectoryServiceProvider }
+
+  { IDirectoryServiceProvider }
+
+  IDirectoryServiceProvider = class(TInterfacedObject,
+                                  nsIDirectoryServiceProvider)
+  private
+    FCacheParentDir: UTF8String;
+    FProfileDir: UTF8String;
+    procedure SetCacheDir(const AValue: UTF8String);
+    procedure SetProfileDir(const AValue: UTF8String);
+  public
+    function GetFile(const prop: PAnsiChar; out persistent: PRBool): nsIFile; safecall;
+    property CacheParentDir: UTF8String read FCacheParentDir write SetCacheDir;
+    property ProfileDir: UTF8String read FProfileDir write SetProfileDir;
+  end;
+
+var
+  GeckoEngineDirectoryService: IDirectoryServiceProvider;
+
 function InitWindowCreator: Boolean;
 
 implementation
@@ -149,4 +181,43 @@ begin
   Result := HRESULT(NS_ERROR_FAILURE);
 end;
 
+{ IDirectoryServiceProvider }
+
+procedure IDirectoryServiceProvider.SetCacheDir(const AValue: UTF8String);
+begin
+  if FCacheParentDir=AValue then exit;
+  FCacheParentDir:=AValue;
+end;
+
+procedure IDirectoryServiceProvider.SetProfileDir(const AValue: UTF8String);
+begin
+  if FProfileDir=AValue then exit;
+  FProfileDir:=AValue;
+end;
+
+function IDirectoryServiceProvider.GetFile(const prop: PAnsiChar; out
+  persistent: PRBool): nsIFile; safecall;
+var
+  Local: nsILocalFile;
+begin
+  persistent:=true; //Only ask one time for each directory, it will be remembered
+                    //by the Gecko engine while running.
+  if prop = 'ProfD' then //Profile directory
+  begin
+    if FProfileDir<>'' then
+    begin
+      NS_NewLocalFile(NewString(FProfileDir).AString,false,Local);
+      Local.QueryInterface(nsILocalFile,Result);
+    end;
+  end else
+  if prop = 'cachePDir' then //Cache directory
+  begin
+    if FCacheParentDir<>'' then
+    begin
+      NS_NewLocalFile(NewString(FCacheParentDir).AString,false,Local);
+      Local.QueryInterface(nsILocalFile,Result);
+    end;
+  end;
+end;
+
 end.

components/geckoport/Components/GeckoBrowser.pas

@@ -53,7 +53,7 @@ unit GeckoBrowser;
 interface
 
 uses
-  {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
+  LclIntf, LMessages, LclType, LResources, Graphics,
   SysUtils, Classes, Controls, nsXPCOM,
   nsGeckoStrings, CallbackInterfaces, nsTypes, nsXPCOMGlue, BrowserSupports,
   nsXPCOM_std19
@@ -140,6 +140,7 @@ type
   TGeckoBrowserDOMEventHandler = procedure (Sender: TObject; aEvent:TGeckoDOMEvent) of object;
   TGeckoBrowserHistoryMove = procedure (Sender: TObject; aURI: nsIURI; out aContinue: LongBool; var Handled: Boolean) of object;
   TGeckoBrowserHistoryGoTo = procedure (Sender: TObject; aIndex: Longint; aURI: nsIURI; out aContinue: LongBool; var Handled: Boolean) of object;
+  TGeckoBrowserDirectoryService = procedure (Sender: TObject; const aDirectoryService: IDirectoryServiceProvider) of object;
 
   TGeckoBrowserHisoty = record
     URI: AnsiString;
@@ -147,7 +148,6 @@ type
     IsSubFrame: Boolean;
   end;
 
-
     //TODO 2 -cTCustomGeckoBrowser: DocShell ƒvƒƒpƒeƒB‚ð’ljÁ
 
   { TCustomGeckoBrowser }
@@ -178,6 +178,7 @@ type
     FOnNewWindow: TGeckoBrowserNewWindow;
 
     FOnSetupProperties: TNotifyEvent;
+    FOnDirectoryService: TGeckoBrowserDirectoryService;
 
     FGeckoComponentsStartupSucceeded: boolean;
 
@@ -186,6 +187,9 @@ type
     FInitializationStarted: Boolean;
     FInitialized: Boolean;
 
+    //Designtime graphic
+    FDesignTimeLogo: TPortableNetworkGraphic;
+
     function GetDisableJavaScript: Boolean;
     procedure SetDisableJavascript(const AValue: Boolean);
     procedure ShutdownWebBrowser;
@@ -301,9 +305,13 @@ type
     property OnNewWindow: TGeckoBrowserNewWindow
       read FOnNewWindow write FOnNewWindow;
 
-    property OnSetupProperties: TNotifyEvent read FOnSetupProperties write FOnSetupProperties;
+    property OnSetupProperties: TNotifyEvent
+      read FOnSetupProperties write FOnSetupProperties;
+    property OnDirectoryService: TGeckoBrowserDirectoryService
+      read FOnDirectoryService write FOnDirectoryService;
     // misc base settings
-    property DisableJavaScript: Boolean read GetDisableJavaScript write SetDisableJavascript;
+    property DisableJavaScript: Boolean
+      read GetDisableJavaScript write SetDisableJavascript;
     property Initialized: Boolean read FInitialized;
   end;
 
@@ -373,6 +381,8 @@ type
     function SafeCallException(Obj: TObject; Addr: Pointer): HRESULT; override;
   end;
 
+  { TGeckoBrowser }
+
   TGeckoBrowser = class(TCustomGeckoBrowser)
   protected
     FBrowser: nsIWebBrowser;
@@ -406,7 +416,7 @@ type
     function DoCreateChromeWindow(
       chromeFlags: Longword): nsIWebBrowserChrome; override;
 
-    function GetURIString(): UTF8String;
+    function GetURIString: UTF8String;
   public
     constructor Create(AOwner: TComponent); override;
 
@@ -480,6 +490,7 @@ type
     property OnGoToIndex;
 
     property OnSetupProperties;
+    property OnDirectoryService;
 
     property DisableJavaScript;
 
@@ -680,6 +691,8 @@ procedure Register;
 
 {$IFNDEF LCL}
 {$R *.dcr}
+{$ELSE}
+{$R geckoresources.rc}
 {$ENDIF}
 
 implementation
@@ -1011,6 +1024,8 @@ begin
 end;
 
 constructor TCustomGeckoBrowser.Create(AOwner: TComponent);
+var
+  Logo: TResourceStream;
 begin
   inherited;
 
@@ -1019,8 +1034,11 @@ begin
   {$ENDIF}
   if not (csDesigning in ComponentState) then
   begin
-    GeckoComponentsStartup;
+  end else begin
-    FGeckoComponentsStartupSucceeded := true;
+    Logo:=TResourceStream.Create(HINSTANCE,'ID_GECKO_LOGO',pchar(RT_RCDATA));
+    FDesignTimeLogo:=TPortableNetworkGraphic.Create;
+    FDesignTimeLogo.LoadFromStream(Logo);
+    Logo.Free;
   end;
 end;
 
@@ -1031,6 +1049,7 @@ begin
   {$ENDIF}
   if not (csDesigning in ComponentState) then
   begin
+    FreeAndNil(FDesignTimeLogo);
     ShutdownWebBrowser;
 
     Chrome := nil;
@@ -1059,6 +1078,22 @@ end;
 
 procedure TCustomGeckoBrowser.Loaded;
 begin
+  if not (csDesigning in ComponentState) then
+  begin
+    if not Assigned(GeckoEngineDirectoryService) then begin
+      //This interface must be created as soon as possible because it
+      //will be callbacked when starting the XRE which happend just
+      //after the GeckoBrowser is created but before it is ready to be
+      //used. The setup of this component is a one time operation, called
+      //by the FIRST instance of GeckoBrowser and not called by the next
+      //ones; and its data persists while the program is running.
+      GeckoEngineDirectoryService:=IDirectoryServiceProvider.Create;
+    end;
+    if Assigned(FOnDirectoryService) then
+      FOnDirectoryService(Self,GeckoEngineDirectoryService);
+    GeckoComponentsStartup;
+    FGeckoComponentsStartupSucceeded := true;
+  end;
   inherited Loaded;
   DoInitializationIfNeeded;
 end;
@@ -1823,7 +1858,10 @@ begin
   if csDesigning in ComponentState then
   begin
     rc := ClientRect;
-    Canvas.FillRect(rc);
+    if Assigned(FDesignTimeLogo) then
+      Canvas.StretchDraw(rc,FDesignTimeLogo)
+    else
+      Canvas.FillRect(rc);
   end else
   begin
     baseWin := FWebBrowser as nsIBaseWindow;

components/geckoport/Components/geckoresources.rc

@@ -0,0 +1 @@
+ID_GECKO_LOGO   RCDATA gecko-logo.png

components/geckoport/nsXRE.pas

@@ -3,7 +3,7 @@ unit nsXRE;
 interface
 
 uses
-  nsTypes, nsXPCOM, nsInit;
+  nsTypes, nsXPCOM, nsInit, CallbackInterfaces;
 
 type
   PXREAppData = ^nsXREAppData;
@@ -406,8 +406,10 @@ begin
     XRE_UnloadGRE();
     Exit;
   end;
+  if not Assigned(GeckoEngineDirectoryService) then
+    GeckoEngineDirectoryService:=IDirectoryServiceProvider.Create;
 //  NS_LogInit();
-  Result := XRE_InitEmbedding(xulDir, appDir, nil, nil, 0);
+  Result := XRE_InitEmbedding(xulDir, appDir, GeckoEngineDirectoryService, nil, 0);
 //  NS_LogTerm();
 end;