[developer] Refactor Project window to use UframeCEFHost

This commit is contained in:
Marc Durdin 2018-07-18 07:07:36 +10:00
parent c65076e53b
commit fdb86ecc78
10 changed files with 140 additions and 260 deletions

View file

@ -287,7 +287,7 @@ uses
begin
CoInitFlags := COINIT_APARTMENTTHREADED;
FInitializeCEF := TInitializeCEF.Create;
FInitializeCEF := TCEFManager.Create;
try
if FInitializeCEF.Start then
begin

View file

@ -3,6 +3,8 @@ unit Keyman.Developer.System.InitializeCEF;
interface
uses
System.Classes,
System.Generics.Collections,
uCEFApplication;
//
@ -11,19 +13,37 @@ uses
// cleaner
//
type
TInitializeCEF = class
IKeymanCEFHost = interface;
TShutdownCompletionHandlerEvent = procedure(Sender: IKeymanCEFHost) of object;
IKeymanCEFHost = interface
['{DFABC8BF-803E-45E6-B7DC-522C7FEB08EB}']
procedure StartShutdown(CompletionHandler: TShutdownCompletionHandlerEvent);
end;
TCEFManager = class
private
FWindows: TList<IKeymanCEFHost>;
FShutdownCompletionHandler: TNotifyEvent;
procedure CompletionHandler(Sender: IKeymanCEFHost);
public
constructor Create;
destructor Destroy; override;
function Start: Boolean;
procedure RegisterWindow(cef: IKeymanCEFHost);
procedure UnregisterWindow(cef: IKeymanCEFHost);
function StartShutdown(CompletionHandler: TNotifyEvent): Boolean;
end;
var
FInitializeCEF: TInitializeCEF = nil;
FInitializeCEF: TCEFManager = nil;
implementation
uses
System.SysUtils,
Winapi.ShlObj,
KeymanDeveloperUtils,
@ -33,8 +53,20 @@ uses
{ TInitializeCEF }
constructor TInitializeCEF.Create;
procedure TCEFManager.CompletionHandler(Sender: IKeymanCEFHost);
begin
FWindows.Remove(Sender);
if FWindows.Count = 0 then
begin
Assert(@FShutdownCompletionHandler <> nil);
FShutdownCompletionHandler(Self);
FShutdownCompletionHandler := nil;
end;
end;
constructor TCEFManager.Create;
begin
FWindows := TList<IKeymanCEFHost>.Create;
// You *MUST* call GlobalCEFApp.StartMainProcess in a if..then clause
// with the Application initialization inside the begin..end.
// Read this https://www.briskbard.com/index.php?lang=en&pageid=cef
@ -55,16 +87,40 @@ begin
GlobalCEFApp.UserDataPath := GetFolderPath(CSIDL_APPDATA) + SFolderKeymanDeveloper + '\browser\userdata';
end;
destructor TInitializeCEF.Destroy;
destructor TCEFManager.Destroy;
begin
Assert(FWindows.Count = 0);
FreeAndNil(FWindows);
GlobalCEFApp.Free;
GlobalCEFApp := nil;
inherited Destroy;
end;
function TInitializeCEF.Start: Boolean;
procedure TCEFManager.RegisterWindow(cef: IKeymanCEFHost);
begin
FWindows.Add(cef);
end;
function TCEFManager.Start: Boolean;
begin
Result := GlobalCEFApp.StartMainProcess;
end;
function TCEFManager.StartShutdown(CompletionHandler: TNotifyEvent): Boolean;
var
i: Integer;
begin
if FWindows.Count = 0 then
Exit(True); // Can shutdown immediately
FShutdownCompletionHandler := CompletionHandler;
for i := 0 to FWindows.Count - 1 do
FWindows[i].StartShutdown(Self.CompletionHandler);
Result := False; // wait for completion handler
end;
procedure TCEFManager.UnregisterWindow(cef: IKeymanCEFHost);
begin
FWindows.Remove(cef);
end;
end.

View file

@ -2,12 +2,14 @@ inherited frameCEFHost: TframeCEFHost
Left = 193
Top = 131
ActiveControl = cef
Align = alClient
BorderIcons = []
BorderStyle = bsNone
Caption = ''
ClientHeight = 645
ClientWidth = 878
OldCreateOrder = True
OnDestroy = FormDestroy
ExplicitWidth = 878
ExplicitHeight = 645
PixelsPerInch = 96
@ -20,10 +22,7 @@ inherited frameCEFHost: TframeCEFHost
Align = alClient
TabOrder = 0
OnClose = cefClose
OnBeforeClose = cefBeforeClose
OnAfterCreated = cefAfterCreated
ExplicitWidth = 862
ExplicitHeight = 606
end
object tmrRefresh: TTimer
Enabled = False

View file

@ -17,6 +17,7 @@ uses
Winapi.Messages,
Winapi.Windows,
Keyman.Developer.System.InitializeCEF,
KeymanDeveloperUtils,
UserMessages,
UfrmTIKE,
@ -28,19 +29,25 @@ uses
type
TCEFHostBeforeBrowseEvent = procedure(Sender: TObject; const Url: string; out Result: Boolean) of object;
TframeCEFHost = class(TTikeForm)
TframeCEFHost = class(TTikeForm, IKeymanCEFHost)
tmrRefresh: TTimer;
cef: TChromiumWindow;
tmrCreateBrowser: TTimer;
procedure FormCreate(Sender: TObject);
procedure tmrCreateBrowserTimer(Sender: TObject);
procedure cefClose(Sender: TObject);
procedure cefBeforeClose(Sender: TObject);
procedure cefAfterCreated(Sender: TObject); // I2986
procedure cefAfterCreated(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject); // I2986
private
FNextURL: string;
FOnLoadEnd: TNotifyEvent;
FOnBeforeBrowse: TCEFHostBeforeBrowseEvent;
FOnAfterCreated: TNotifyEvent;
FShutdownCompletionHandler: TShutdownCompletionHandlerEvent;
FIsClosing: Boolean;
// IKeymanCEFHost
procedure StartShutdown(CompletionHandler: TShutdownCompletionHandlerEvent);
// CEF: You have to handle this two messages to call NotifyMoveOrResizeStarted or some page elements will be misaligned.
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
@ -85,6 +92,7 @@ type
procedure SetFocus; override;
procedure StartClose;
procedure Navigate(const url: string); overload;
property OnAfterCreated: TNotifyEvent read FOnAfterCreated write FOnAfterCreated;
property OnBeforeBrowse: TCEFHostBeforeBrowseEvent read FOnBeforeBrowse write FOnBeforeBrowse;
property OnLoadEnd: TNotifyEvent read FOnLoadEnd write FOnLoadEnd;
end;
@ -115,6 +123,14 @@ uses
procedure TframeCEFHost.StartClose;
begin
Visible := False;
FIsClosing := True;
cef.CloseBrowser(True);
end;
procedure TframeCEFHost.StartShutdown(CompletionHandler: TShutdownCompletionHandlerEvent);
begin
FIsClosing := True;
FShutdownCompletionHandler := CompletionHandler;
cef.CloseBrowser(True);
end;
@ -127,6 +143,20 @@ begin
cef.ChromiumBrowser.OnConsoleMessage := cefConsoleMessage;
cef.ChromiumBrowser.OnRunContextMenu := cefRunContextMenu;
cef.ChromiumBrowser.OnBeforePopup := cefBeforePopup;
FInitializeCEF.RegisterWindow(Self);
// CreateBrowser;
end;
procedure TframeCEFHost.FormDestroy(Sender: TObject);
begin
inherited;
FInitializeCEF.UnregisterWindow(Self);
end;
procedure TframeCEFHost.FormShow(Sender: TObject);
begin
inherited;
CreateBrowser;
end;
@ -159,7 +189,8 @@ end;
procedure TframeCEFHost.SetFocus;
begin
inherited;
cef.SetFocus;
if not FIsClosing and cef.CanFocus then
cef.SetFocus;
end;
procedure TframeCEFHost.cefAfterCreated(Sender: TObject);
@ -174,20 +205,17 @@ procedure TframeCEFHost.cefBeforeBrowse(Sender: TObject;
begin
if Assigned(FOnBeforeBrowse) then
FOnBeforeBrowse(Self, request.Url, Result);
// Result := DoNavigate(request.Url);
end;
procedure TframeCEFHost.cefBeforeClose(Sender: TObject);
begin
Close;
end;
procedure TframeCEFHost.cefClose(Sender: TObject);
begin
// DestroyChildWindow will destroy the child window created by CEF at the top of the Z order.
if not cef.DestroyChildWindow then
cef.DestroyChildWindow;
if Assigned(FShutdownCompletionHandler) then
begin
Close;
FShutdownCompletionHandler(Self);
FShutdownCompletionHandler := nil;
end;
end;

View file

@ -15,10 +15,6 @@ inherited frmHelp: TfrmHelp
OnClose = cefClose
OnBeforeClose = cefBeforeClose
OnAfterCreated = cefAfterCreated
ExplicitLeft = 8
ExplicitTop = 8
ExplicitWidth = 100
ExplicitHeight = 41
end
object ActionList1: TActionList
Left = 244

View file

@ -287,7 +287,7 @@ end;
procedure TfrmHelp.FormShow(Sender: TObject);
begin
inherited;
CreateBrowser;
// CreateBrowser;
end;
procedure TfrmHelp.cefAfterCreated(Sender: TObject);

View file

@ -301,7 +301,7 @@ inherited frmKeymanDeveloper: TfrmKeymanDeveloper
Left = 304
Top = 236
Bitmap = {
494C01010A000E00F40010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
494C01010A000E00F80010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000003000000001002000000000000030
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@ -710,7 +710,7 @@ inherited frmKeymanDeveloper: TfrmKeymanDeveloper
Left = 236
Top = 236
Bitmap = {
494C01013B004000F40010001000C0C0C000FF10FFFFFFFFFFFFFFFF424D3600
494C01013B004000F80010001000C0C0C000FF10FFFFFFFFFFFFFFFF424D3600
000000000000360000002800000040000000F0000000010020000000000000F0
000000000000000000000000000000000000C0C0C000C0C0C000C0C0C000C0C0
C000C0C0C000C6C6C600F7730000CE5A0000CE5A0000F7730000C6C6C600C0C0

View file

@ -333,6 +333,7 @@ type
procedure InitDock;
procedure LoadDockLayout;
procedure SaveDockLayout;
procedure CEFShutdownComplete(Sender: TObject);
protected
procedure WndProc(var Message: TMessage); override;
@ -404,6 +405,8 @@ uses
System.Win.ComObj,
Vcl.Themes,
Keyman.Developer.System.InitializeCEF,
CharMapDropTool,
DebugManager,
HTMLHelpViewer,
@ -606,32 +609,29 @@ begin
if not FIsClosing then
begin
// I944 - Fix crash when FChildWindows is nil on closing Keyman Developer
if not Assigned(FChildWindows) then
if Assigned(FChildWindows) then
begin
CanClose := True;
Exit;
for i := 0 to FChildWindows.Count - 1 do
if not FChildWindows[i].CloseQuery then
begin
CanClose := False;
Exit;
end;
end;
for i := 0 to FChildWindows.Count - 1 do
if not FChildWindows[i].CloseQuery then
begin
CanClose := False;
Exit;
end;
FIsClosing := True;
for i := 0 to FChildWindows.Count - 1 do
FChildWindows[i].StartClose;
frmHelp.StartClose;
SaveDockLayout;
CanClose := FInitializeCEF.StartShutdown(CEFShutdownComplete);
// TODO: complete exit after StartClose is successful
end;
end
else
CanClose := True;
end;
CanClose := True;
procedure TfrmKeymanDeveloper.CEFShutdownComplete(Sender: TObject);
begin
Close;
end;
procedure TfrmKeymanDeveloper.FormDestroy(Sender: TObject);

View file

@ -1,7 +1,6 @@
inherited frmProject: TfrmProject
Left = 193
Top = 131
ActiveControl = cef
Caption = 'frmProject'
ClientHeight = 606
ClientWidth = 862
@ -10,17 +9,6 @@ inherited frmProject: TfrmProject
ExplicitHeight = 606
PixelsPerInch = 96
TextHeight = 13
object cef: TChromiumWindow
Left = 0
Top = 0
Width = 862
Height = 606
Align = alClient
TabOrder = 0
OnClose = cefClose
OnBeforeClose = cefBeforeClose
OnAfterCreated = cefAfterCreated
end
object dlgOpenFile: TOpenDialog
Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
Title = 'Add File to Project'
@ -33,11 +21,4 @@ inherited frmProject: TfrmProject
Left = 604
Top = 48
end
object tmrCreateBrowser: TTimer
Enabled = False
Interval = 300
OnTimer = tmrCreateBrowserTimer
Left = 620
Top = 208
end
end

View file

@ -58,63 +58,25 @@ uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, UfrmMDIEditor, UfrmMDIChild, ProjectFile,
KeymanDeveloperUtils, UserMessages,
Keyman.Developer.UI.UframeCEFHost,
uCEFInterfaces, uCEFWindowParent, uCEFChromiumWindow, uCEFTypes;
type
TfrmProject = class(TfrmTikeChild) // I2721
dlgOpenFile: TOpenDialog;
tmrRefresh: TTimer;
cef: TChromiumWindow;
tmrCreateBrowser: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure tmrRefreshTimer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure tmrCreateBrowserTimer(Sender: TObject);
procedure cefClose(Sender: TObject);
procedure cefBeforeClose(Sender: TObject);
procedure cefAfterCreated(Sender: TObject); // I2986
private
FShouldRefresh: Boolean;
FNextCommand: WideString;
FNextCommandParams: TStringList;
cef: TframeCEFHost;
// CEF: You have to handle this two messages to call NotifyMoveOrResizeStarted or some page elements will be misaligned.
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
// CEF: You also have to handle these two messages to set GlobalCEFApp.OsmodalLoop
procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP;
procedure cefLoadEnd(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; httpStatusCode: Integer);
procedure cefBeforeBrowse(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; const request: ICefRequest; user_gesture,
isRedirect: Boolean; out Result: Boolean);
procedure cefPreKeyEvent(Sender: TObject; const browser: ICefBrowser;
const event: PCefKeyEvent; osEvent: TCefEventHandle;
out isKeyboardShortcut: Boolean; out Result: Boolean);
procedure cefConsoleMessage(Sender: TObject; const browser: ICefBrowser;
level: TCefLogSeverity; const message, source: ustring;
line: Integer; out Result: Boolean);
procedure cefRunContextMenu(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; const params: ICefContextMenuParams;
const model: ICefMenuModel;
const callback: ICefRunContextMenuCallback;
var aResult : Boolean);
procedure cefBeforePopup(Sender: TObject;
const browser: ICefBrowser;
const frame: ICefFrame;
const targetUrl,
targetFrameName: ustring;
targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean;
const popupFeatures: TCefPopupFeatures;
var windowInfo: TCefWindowInfo;
var client: ICefClient;
var settings: TCefBrowserSettings;
var noJavascriptAccess: Boolean;
var Result: Boolean);
procedure cefLoadEnd(Sender: TObject);
procedure cefBeforeBrowse(Sender: TObject; const Url: string; out Result: Boolean);
procedure ProjectRefresh(Sender: TObject);
procedure ProjectRefreshCaption(Sender: TObject);
@ -125,7 +87,6 @@ type
procedure EditFileExternal(FileName: WideString);
function DoNavigate(URL: string): Boolean;
procedure ClearMessages;
procedure CreateBrowser;
protected
function GetHelpTopic: string; override;
public
@ -207,7 +168,7 @@ end;
procedure TfrmProject.StartClose;
begin
Visible := False;
cef.CloseBrowser(True);
cef.StartClose;
end;
procedure TfrmProject.FormCreate(Sender: TObject);
@ -218,35 +179,21 @@ begin
GetGlobalProjectUI.OnRefresh := ProjectRefresh; // I4687
GetGlobalProjectUI.OnRefreshCaption := ProjectRefreshCaption; // I4687
cef.ChromiumBrowser.OnLoadEnd := cefLoadEnd;
cef.ChromiumBrowser.OnBeforeBrowse := cefBeforeBrowse;
cef.ChromiumBrowser.OnPreKeyEvent := cefPreKeyEvent;
cef.ChromiumBrowser.OnConsoleMessage := cefConsoleMessage;
cef.ChromiumBrowser.OnRunContextMenu := cefRunContextMenu;
cef.ChromiumBrowser.OnBeforePopup := cefBeforePopup;
CreateBrowser;
end;
procedure TfrmProject.CreateBrowser;
begin
tmrCreateBrowser.Enabled := not cef.CreateBrowser;
cef := TframeCEFHost.Create(Self);
cef.Parent := Self;
cef.Visible := True;
cef.OnBeforeBrowse := cefBeforeBrowse;
cef.OnLoadEnd := cefLoadEnd;
RefreshHTML;
end;
procedure TfrmProject.RefreshHTML;
begin
if not cef.Initialized then
begin
// After initialization, refresh will happen
// See cefAfterCreated
Exit;
end;
if GetGlobalProjectUI.Refreshing then // I4687
tmrRefresh.Enabled := True
else
begin
// GetGlobalProjectUI.Refreshing := True; // I4687
cef.LoadURL(modWebHttpServer.GetAppURL('project/?path='+URLEncode(GetGlobalProjectUI.FileName)));
cef.Navigate(modWebHttpServer.GetAppURL('project/?path='+URLEncode(GetGlobalProjectUI.FileName)));
end;
RefreshCaption;
end;
@ -301,61 +248,10 @@ begin
FreeAndNil(FNextCommandParams);
end;
procedure TfrmProject.cefAfterCreated(Sender: TObject);
begin
RefreshHTML;
end;
procedure TfrmProject.cefBeforeBrowse(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const request: ICefRequest; user_gesture, isRedirect: Boolean;
out Result: Boolean);
const Url: string; out Result: Boolean);
begin
Result := DoNavigate(request.Url);
end;
procedure TfrmProject.cefBeforeClose(Sender: TObject);
begin
Close;
end;
procedure TfrmProject.cefClose(Sender: TObject);
begin
// DestroyChildWindow will destroy the child window created by CEF at the top of the Z order.
if not cef.DestroyChildWindow then
begin
Close;
end;
end;
procedure TfrmProject.cefConsoleMessage(Sender: TObject;
const browser: ICefBrowser; level: TCefLogSeverity; const message,
source: ustring; line: Integer; out Result: Boolean);
begin
try
with TStringList.Create do
try
LoadFromFile(GetGlobalProjectUI.RenderFileName); // prolog determines encoding // I4687
LogExceptionToExternalHandler(
'script_'+Self.ClassName+'_ScriptError',
'Error occurred at line '+IntToStr(line)+' of '+source,
message,
'CEF'#13#10#13#10'<pre>'+XMLEncode(Text)+'</pre>');
finally
Free;
end;
except
on E:Exception do
LogExceptionToExternalHandler(
'script_'+Self.ClassName+'_ScriptError',
'Error occurred at line '+IntToStr(line)+' of '+source,
message,
'Exception '+E.Message+' trying to load '+GetGlobalProjectUI.RenderFileName+' for review'); // I4687
end;
Result := True;
Result := DoNavigate(Url);
end;
procedure TfrmProject.ClearMessages;
@ -620,20 +516,13 @@ begin
ProjectRefresh(nil);
end;}
procedure TfrmProject.tmrCreateBrowserTimer(Sender: TObject);
begin
tmrCreateBrowser.Enabled := False;
CreateBrowser;
end;
procedure TfrmProject.tmrRefreshTimer(Sender: TObject);
begin
tmrRefresh.Enabled := False;
ProjectRefresh(nil);
end;
procedure TfrmProject.cefLoadEnd(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; httpStatusCode: Integer);
procedure TfrmProject.cefLoadEnd(Sender: TObject);
begin
if csDestroying in ComponentState then
Exit;
@ -644,83 +533,14 @@ begin
end;
end;
procedure TfrmProject.cefPreKeyEvent(Sender: TObject;
const browser: ICefBrowser; const event: PCefKeyEvent;
osEvent: TCefEventHandle; out isKeyboardShortcut, Result: Boolean);
begin
Result := False;
if (event.windows_key_code <> VK_CONTROL) and (event.kind in [TCefKeyEventType.KEYEVENT_KEYDOWN, TCefKeyEventType.KEYEVENT_RAWKEYDOWN]) then
begin
if event.windows_key_code = VK_F1 then
begin
isKeyboardShortcut := True;
Result := True;
frmKeymanDeveloper.HelpTopic(Self);
end
else if event.windows_key_code = VK_F12 then
begin
cef.ChromiumBrowser.ShowDevTools(Point(Low(Integer),Low(Integer)), nil);
end
else if SendMessage(Application.Handle, CM_APPKEYDOWN, event.windows_key_code, 0) = 1 then
begin
isKeyboardShortcut := True;
Result := True;
end;
end;
end;
//TODO: support dropping files
// DropTarget := frmKeymanDeveloper.DropTargetIntf;
procedure TfrmProject.cefBeforePopup(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl,
targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean; const popupFeatures: TCefPopupFeatures;
var windowInfo: TCefWindowInfo; var client: ICefClient;
var settings: TCefBrowserSettings; var noJavascriptAccess, Result: Boolean);
begin
Result := True;
if not DoNavigate(targetUrl) then
cef.LoadURL(targetUrl);
end;
function TfrmProject.GetHelpTopic: string;
begin
Result := SHelpTopic_Context_Project;
end;
procedure TfrmProject.cefRunContextMenu(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; const model: ICefMenuModel;
const callback: ICefRunContextMenuCallback; var aResult: Boolean);
begin
aResult := GetKeyState(VK_SHIFT) >= 0;
end;
procedure TfrmProject.WMEnterMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := True;
end;
procedure TfrmProject.WMExitMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := False;
end;
procedure TfrmProject.WMMove(var aMessage: TWMMove);
begin
inherited;
if cef <> nil then cef.NotifyMoveOrResizeStarted;
end;
procedure TfrmProject.WMMoving(var aMessage: TMessage);
begin
inherited;
if cef <> nil then cef.NotifyMoveOrResizeStarted;
end;
procedure TfrmProject.WMUserWebCommand(var Message: TMessage);
begin
case Message.wParam of