(* 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; procedure RefreshOptions; override; 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.xmlLdmlProjectFile, Keyman.Developer.System.Project.Project, Keyman.Developer.UI.Project.ProjectUI, Keyman.Developer.UI.Project.ProjectFileUI, keyman.Developer.UI.Project.UpgradeProject, 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.RefreshOptions; begin inherited; ProjectRefresh(nil); 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 not FGlobalProject.Files[i].IsSourceFile then Continue; if FGlobalProject.Files[i].IsCompilable and not (FGlobalProject.Files[i] is TkpsProjectFile) 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 not FGlobalProject.Files[i].IsSourceFile then Continue; 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 } Assert(FGlobalProject.Options.Version = pv10); 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 } Assert(FGlobalProject.Options.Version = pv10); 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.OpenFilesInProject([SelectedMRUFileName]) else if Params.Values['name'] <> '' then frmKeymanDeveloper.OpenFilesInProject([Params.Values['name']]); 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 TxmlLdmlProjectFile) then OpenContainingFolder((pf as TxmlLdmlProjectFile).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 Assert(FGlobalProject.Options.Version = pv10); 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 if not FGlobalProject.Files[i].IsSourceFile then Continue; (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 not FGlobalProject.Files[i].IsSourceFile then Continue; if (FGlobalProject.Files[i] is TkmnProjectFile) or (FGlobalProject.Files[i] is TxmlLdmlProjectFile) 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 not FGlobalProject.Files[i].IsSourceFile then Continue; if (FGlobalProject.Files[i] is TkmnProjectFile) or (FGlobalProject.Files[i] is TxmlLdmlProjectFile) 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 not FGlobalProject.Files[i].IsSourceFile then Continue; 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 not FGlobalProject.Files[i].IsSourceFile then Continue; 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 not FGlobalProject.Files[i].IsSourceFile then Continue; if FGlobalProject.Files[i] is TkpsProjectFile then (FGlobalProject.Files[i].UI as TProjectFileUI).DoAction(pfaCompile, False); end; end else if Command = 'package_cleanall' then // I4692 begin ClearMessages; for i := 0 to FGlobalProject.Files.Count - 1 do begin if not FGlobalProject.Files[i].IsSourceFile then Continue; 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 = 'upgradeproject' then begin TryUpgradeProject(FGlobalProject); ProjectRefresh(nil); 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.