(* Name: Keyman.Developer.UI.Project.UfrmProject Copyright: Copyright (C) SIL International. Documentation: Description: Create Date: 20 Jun 2006 Modified Date: 9 Aug 2015 Authors: mcdurdin Related Files: Dependencies: Bugs: Todo: Notes: History: 20 Jun 2006 - mcdurdin - Initial version 01 Aug 2006 - mcdurdin - Rework for Keyman 7 23 Aug 2006 - mcdurdin - Fix broken focus of web browser 23 Aug 2006 - mcdurdin - Disconnect click in web browser from actual command execution 23 Aug 2006 - mcdurdin - Fix hotkeys 14 Sep 2006 - mcdurdin - Add path information to New File dialog 28 Sep 2006 - mcdurdin - Add theming 04 Dec 2006 - mcdurdin - Support right-click options on MRU files 04 Jan 2007 - mcdurdin - Add help support, links to checkforupdates and upgrade 05 Jan 2007 - mcdurdin - Refresh after activating modules 30 Jan 2007 - mcdurdin - F1 - help 19 Mar 2007 - mcdurdin - I733 - Add Compile to Web button 30 May 2007 - mcdurdin - I762 - Fixed crash when refreshing project (rare) 30 May 2007 - mcdurdin - I727 - Stop dragging files into project,help panes 13 Jul 2007 - mcdurdin - I939 - Report script errors to website 23 Aug 2007 - mcdurdin - I927 - external editor support 19 Nov 2007 - mcdurdin - I1157 - const string parameters 14 Jun 2008 - mcdurdin - I1420 - Improve project performance 20 Jul 2008 - mcdurdin - I1553 - External exceptions 29 Mar 2010 - mcdurdin - I2199 - Shift+Click opens new window 26 Jul 2010 - mcdurdin - I2468 - Eliminate KeymanWeb Pack 17 Dec 2010 - mcdurdin - I2570 - Use new E-mbeddedWB (see also I2595) 18 Feb 2011 - mcdurdin - I2721 - Override Javascript-disabled security for web controls 03 May 2011 - mcdurdin - I2890 - Record diagnostic data when encountering registry errors 18 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support 18 May 2012 - mcdurdin - I3309 - V9.0 - Migrate to Delphi XE2, VS2010, svn 1.7 08 Jun 2012 - mcdurdin - I3349 - V9.0 - Consolidate all process creation into TUtilExecute 04 May 2015 - mcdurdin - I4687 - V9.0 - Split project UI actions into separate classes 04 May 2015 - mcdurdin - I4686 - V9.0 - Refactor compile into project file action 04 May 2015 - mcdurdin - I4692 - V9.0 - Add Clean as project action 06 Jun 2015 - mcdurdin - I4734 - Project files need to build package installers 06 Jun 2015 - mcdurdin - I4735 - Add clean and build single file commands to project 09 Aug 2015 - mcdurdin - I2986 - Ctrl+N, Ctrl+O not working in Developer Project view *) unit Keyman.Developer.UI.Project.UfrmProject; // I3306 // I3309 interface uses System.Contnrs, System.Types, System.UITypes, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, UfrmMDIEditor, UfrmMDIChild, Keyman.Developer.System.Project.ProjectFile, KeymanDeveloperUtils, UserMessages, Keyman.UI.UframeCEFHost; type TfrmProject = class(TfrmTikeChild) // I2721 dlgOpenFile: TOpenDialog; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormActivate(Sender: TObject); private FShouldRefresh: Boolean; FNextCommand: WideString; FNextCommandParams: TStringList; cef: TframeCEFHost; procedure cefLoadEnd(Sender: TObject); procedure cefBeforeBrowse(Sender: TObject; const Url: string; isPopup, wasHandled: Boolean); procedure cefBeforeBrowseSync(Sender: TObject; const Url: string; isPopup: Boolean; out Handled: Boolean); procedure cefCommand(Sender: TObject; const command: string; params: TStringList); procedure ProjectRefresh(Sender: TObject); procedure ProjectRefreshCaption(Sender: TObject); procedure RefreshCaption; procedure WebCommand(Command: WideString; Params: TStringList); procedure RefreshHTML; procedure EditFileExternal(FileName: WideString); procedure ClearMessages; function ShouldHandleNavigation(URL: string): Boolean; procedure WebCommandProject(Command: WideString; Params: TStringList); procedure WebCommandWelcome(Command: WideString; Params: TStringList); protected function GetHelpTopic: string; override; public procedure SetFocus; override; procedure SetGlobalProject; procedure StartClose; override; procedure CompileAll; end; implementation uses System.StrUtils, Winapi.ShellApi, Keyman.Developer.System.HelpTopics, dmActionsMain, KeymanDeveloperOptions, Keyman.Developer.System.Project.kmnProjectFile, Keyman.Developer.System.Project.kpsProjectFile, Keyman.Developer.System.Project.modelTsProjectFile, Keyman.Developer.System.Project.Project, Keyman.Developer.UI.Project.ProjectUI, Keyman.Developer.UI.Project.ProjectFileUI, Keyman.Developer.System.Project.ProjectFileType, typinfo, ErrorControlledRegistry, UfrmEditor, UfrmMain, UfrmMessages, UfrmNewFileDetails, utilfiletypes, utilhttp, utilsystem, utilexecute, utilxml, mrulist, UmodWebHttpServer; {$R *.DFM} { TfrmProject } // Destruction steps // ================= // 1. The FormCloseQuery event sets CanClose to False and calls TChromiumWindow.CloseBrowser, which triggers the TChromiumWindow.OnClose event. // 2. The TChromiumWindow.OnClose event calls TChromiumWindow.DestroyChildWindow which triggers the TChromiumWindow.OnBeforeClose event. // 3. TChromiumWindow.OnBeforeClose sets FCanClose to True and closes the form. procedure TfrmProject.EditFileExternal(FileName: WideString); begin if FKeymanDeveloperOptions.ExternalEditorPath = '' then begin if MessageDlg('You have not configured an external editor. Do you want to configure one now?', mtConfirmation, mbOkCancel, 0) = mrCancel then Exit; modActionsMain.actToolsOptions.Execute; if FKeymanDeveloperOptions.ExternalEditorPath = '' then begin ShowMessage('The external editor has not been configured.'); Exit; end; end; if not TUtilExecute.Shell(Handle, FKeymanDeveloperOptions.ExternalEditorPath, ExtractFileDir(FileName), '"'+FileName+'"') then // I3349 begin ShowMessage('Keyman Developer could not start the external editor '+IntToStr(GetLastError)+': '+SysErrorMessage(GetLastError)); end; end; procedure TfrmProject.FormActivate(Sender: TObject); begin inherited; if FShouldRefresh then RefreshHTML; FShouldRefresh := False; end; procedure TfrmProject.StartClose; begin Visible := False; cef.StartClose; end; procedure TfrmProject.FormCreate(Sender: TObject); begin inherited; FNextCommandParams := TStringList.Create; FGlobalProjectRefresh := ProjectRefresh; FGlobalProjectRefreshCaption := ProjectRefreshCaption; cef := TframeCEFHost.Create(Self); cef.Parent := Self; cef.Visible := True; cef.OnBeforeBrowse := cefBeforeBrowse; cef.OnBeforeBrowseSync := cefBeforeBrowseSync; cef.OnCommand := cefCommand; cef.OnLoadEnd := cefLoadEnd; RefreshHTML; end; procedure TfrmProject.RefreshHTML; begin if IsGlobalProjectUIReady then begin cef.Navigate(modWebHttpServer.GetAppURL('project/?path='+URLEncode(GetGlobalProjectUI.FileName))); end else cef.Navigate(modWebHttpServer.GetAppURL('project/welcome')); RefreshCaption; end; procedure TfrmProject.ProjectRefresh(Sender: TObject); begin if frmKeymanDeveloper.ActiveChild <> Self then FShouldRefresh := True else RefreshHTML; end; procedure TfrmProject.ProjectRefreshCaption(Sender: TObject); begin RefreshCaption; end; procedure TfrmProject.RefreshCaption; var s: string; begin if IsGlobalProjectUIReady then begin Hint := FGlobalProject.FileName; s := GetGlobalProjectUI.DisplayFileName; // I4687 end else begin Hint := 'Welcome'; s := 'Welcome'; end; Caption := s; end; procedure TfrmProject.SetFocus; begin inherited; cef.SetFocus; end; procedure TfrmProject.SetGlobalProject; begin ProjectRefresh(nil); end; procedure TfrmProject.FormDestroy(Sender: TObject); begin inherited; FGlobalProjectRefresh := nil; FGlobalProjectRefreshCaption := nil; FreeAndNil(FNextCommandParams); end; procedure TfrmProject.cefBeforeBrowse(Sender: TObject; const Url: string; isPopup, wasHandled: Boolean); var s: string; begin if Copy(URL, 1, 5) = 'help:' then begin s := URL; Delete(s,1,5); FNextCommand := LowerCase(s); frmKeymanDeveloper.HelpTopic(LowerCase(s)); end else if not URL.StartsWith(modWebHttpServer.GetLocalhostURL) and (Copy(URL, 1, 4) = 'http') then begin FNextCommand := URL; TUtilExecute.URL(URL); end; end; procedure TfrmProject.cefBeforeBrowseSync(Sender: TObject; const Url: string; isPopup: Boolean; out Handled: Boolean); begin Handled := ShouldHandleNavigation(Url); end; procedure TfrmProject.cefCommand(Sender: TObject; const command: string; params: TStringList); begin WebCommand(LowerCase(command), params); end; procedure TfrmProject.CompileAll; var i: Integer; begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if (FGlobalProject.Files[i] is TkmnProjectFile) or (FGlobalProject.Files[i] is TmodelTsProjectFile) then begin if not (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaCompile, False) then Exit; // I4687 end; end; for i := 0 to FGlobalProject.Files.Count - 1 do begin if FGlobalProject.Files[i] is TkpsProjectFile then if not (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaCompile, False) then Exit; // I4687 end; end; procedure TfrmProject.ClearMessages; begin frmMessages.Clear; end; function TfrmProject.ShouldHandleNavigation(URL: string): Boolean; begin Result := False; if Copy(URL, 1, 5) = 'help:' then begin Result := True; end else if not URL.StartsWith(modWebHttpServer.GetLocalhostURL) and (Copy(URL, 1, 4) = 'http') then begin Result := True; end end; procedure TfrmProject.WebCommand(Command: WideString; Params: TStringList); begin if not IsGlobalProjectUIReady then WebCommandWelcome(Command, Params) else WebCommandProject(Command, Params); end; procedure TfrmProject.WebCommandWelcome(Command: WideString; Params: TStringList); function SelectedMRUFileName: WideString; var n: Integer; begin Result := ''; if Params.Values['id'].StartsWith('id_MRU') then begin if TryStrToInt(Params.Values['id'].Substring(6), n) and (n >= 0) and (n < frmKeymanDeveloper.ProjectMRU.FileCount) then Result := frmKeymanDeveloper.ProjectMRU.Files[n]; end end; begin if Command = 'newproject' then modActionsMain.actProjectNew.Execute else if Command = 'openproject' then modActionsMain.actProjectOpen.Execute else if Command = 'editfile' then // MRU begin if SelectedMRUFileName <> '' then modActionsMain.OpenProject(SelectedMRUFileName); end else if Command = 'removefrommru' then begin if SelectedMRUFileName <> '' then begin frmKeymanDeveloper.ProjectMRU.Delete(SelectedMRUFileName); RefreshHTML; end; end end; procedure TfrmProject.WebCommandProject(Command: WideString; Params: TStringList); function FileTypeFromParamType: TKMFileType; begin if Params.Values['type'] = 'keyboard' then Result := ftKeymanSource else if Params.Values['type'] = 'package' then Result := ftPackageSource else if Params.Values['type'] = 'model' then Result := ftModelSource else Result := ftOther; end; function SelectedProjectFile: TProjectFile; var i: Integer; begin i := FGlobalProject.Files.IndexOfID(Params.Values['id']); if i < 0 then Result := nil else Result := FGlobalProject.Files[i]; end; function SelectedMRUFileName: WideString; var n: Integer; begin Result := ''; if Copy(Params.Values['id'], 1, 6) = 'id_MRU' then begin n := StrToIntDef(Copy(Params.Values['id'], 7, 10), -1); if (n >= 0) and (n < FGlobalProject.MRU.FileCount) then Result := FGlobalProject.MRU.Files[n]; end end; var pf: TProjectFile; FFileType: TKMFileType; FDefaultExtension: string; i: Integer; begin pf := nil; if Command = 'fileaddnew' then begin { create a new file, add it to the project } with TfrmNewFileDetails.Create(Self) do try BaseFileName := FGlobalProject.FileName; FileType := FileTypeFromParamType; if ShowModal = mrOk then begin pf := CreateProjectFile(FGlobalProject, FileName, nil); end; finally Free; end; if Assigned(pf) then (pf.UI as TProjectFileUI).NewFile; // I4687 end else if Command = 'fileaddexisting' then begin { locate an existing file, add it to the project } FFileType := FileTypeFromParamType; dlgOpenFile.Filter := GetFileTypeFilter(FFileType, FDefaultExtension); dlgOpenFile.DefaultExt := FDefaultExtension; if dlgOpenFile.Execute then begin CreateProjectFile(FGlobalProject, dlgOpenFile.FileName, nil); end; end else if (Command = 'editfile') or (Command = 'openfile') then begin pf := SelectedProjectFile; if Assigned(pf) then (pf.UI as TProjectFileUI).DefaultEvent(Self) // I4687 else if SelectedMRUFileName <> '' then frmKeymanDeveloper.OpenFile(SelectedMRUFileName, True) else if Params.Values['name'] <> '' then frmKeymanDeveloper.OpenFile(Params.Values['name'], True); end else if Command = 'viewfilesource' then begin pf := SelectedProjectFile; if Assigned(pf) then frmKeymanDeveloper.OpenEditor(pf.FileName, TfrmEditor) else if SelectedMRUFileName <> '' then frmKeymanDeveloper.OpenEditor(SelectedMRUFileName, TfrmEditor); end else if Command = 'editfileexternal' then begin pf := SelectedProjectFile; if Assigned(pf) then EditFileExternal(pf.FileName) else if SelectedMRUFileName <> '' then EditFileExternal(SelectedMRUFileName); end else if Command = 'opencontainingfolder' then begin pf := SelectedProjectFile; if Assigned(pf) then OpenContainingFolder(pf.FileName) else if SelectedMRUFileName <> '' then OpenContainingFolder(SelectedMRUFileName); end else if Command = 'openbuildfolder' then begin pf := SelectedProjectFile; if Assigned(pf) and (pf is TkmnProjectFile) then OpenContainingFolder((pf as TkmnProjectFile).TargetFileName) else if Assigned(pf) and (pf is TkpsProjectFile) then OpenContainingFolder((pf as TkpsProjectFile).TargetFileName) else if Assigned(pf) and (pf is TmodelTsProjectFile) then OpenContainingFolder((pf as TmodelTsProjectFile).TargetFileName); end else if Command = 'openprojectfolder' then begin OpenContainingFolder(FGlobalProject.FileName); end else if Command = 'removefile' then begin pf := SelectedProjectFile; if Assigned(pf) then begin if MessageDlg('Remove file '+pf.FileName+' from project? The file will not be deleted from the disk.', mtConfirmation, mbOkCancel, 0) = mrOk then begin FGlobalProject.Files.Remove(pf); end; end; end else if Command = 'removefrommru' then begin if SelectedMRUFileName <> '' then FGlobalProject.MRU.Delete(SelectedMRUFileName); end else if Command = 'compileall' then // I4686 begin CompileAll; end else if Command = 'cleanall' then // I4692 begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaClean, False); // I4687 end; end else if Command = 'keyboard_compileall' then begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if FGlobalProject.Files[i] is TkmnProjectFile then (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaCompile, False); // I4687 end; end else if Command = 'keyboard_cleanall' then // I4692 begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if FGlobalProject.Files[i] is TkmnProjectFile then (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaClean, False); end; end else if Command = 'model_compileall' then begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if FGlobalProject.Files[i] is TmodelTsProjectFile then (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaCompile, False); // I4687 end; end else if Command = 'model_cleanall' then // I4692 begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if FGlobalProject.Files[i] is TmodelTsProjectFile then (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaClean, False); end; end else if Command = 'package_compileall' then begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if FGlobalProject.Files[i] is TkpsProjectFile then (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaCompile, False); end; end else if Command = 'package_compileallinstallers' then // I4734 begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if FGlobalProject.Files[i] is TkpsProjectFile then (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaCompileInstaller, False); end; end else if Command = 'package_compileinstaller' then begin ClearMessages; pf := SelectedProjectFile; if Assigned(pf) then (pf.UI as TProjectFileUI).DoAction(pfaCompileInstaller, False); end else if Command = 'package_cleanall' then // I4692 begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if FGlobalProject.Files[i] is TkpsProjectFile then (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaClean, False); end; end else if Command = 'cleanfile' then // I4735 begin ClearMessages; pf := SelectedProjectFile; if Assigned(pf) then (pf.UI as TProjectFileUI).DoAction(pfaClean, False); end else if Command = 'compilefile' then begin ClearMessages; pf := SelectedProjectFile; if Assigned(pf) then (pf.UI as TProjectFileUI).DoAction(pfaCompile, False); end else if Command = 'checkforupdates' then begin modActionsMain.actHelpCheckForUpdates.Execute; end; end; {procedure TfrmProject.DoRefresh; begin ProjectRefresh(nil); end;} procedure TfrmProject.cefLoadEnd(Sender: TObject); begin if csDestroying in ComponentState then Exit; if (frmKeymanDeveloper.ActiveChild = Self) and (Screen.ActiveForm = frmKeymanDeveloper) and (GetWindowThreadProcessId(GetForegroundWindow, nil) = GetCurrentThreadId) then begin cef.SetFocus; end; end; //TODO: support dropping files // DropTarget := frmKeymanDeveloper.DropTargetIntf; function TfrmProject.GetHelpTopic: string; begin Result := SHelpTopic_Context_Project; end; end.