-
-
Notifications
You must be signed in to change notification settings - Fork 112
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
feat(developer): Open files in per-project instances
Refactor the file-opening code so it can be used by Keyman Developer UI as well as command-line, and then add support for opening files in per-project instances from File|Open and friends. Also moves the initialization code out of tike.dpr into Keyman.Developer.System.Main.pas, which makes it easier to maintain and read.
- Loading branch information
Showing
10 changed files
with
420 additions
and
217 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
183 changes: 183 additions & 0 deletions
183
developer/src/tike/main/Keyman.Developer.System.LaunchProjects.pas
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,183 @@ | ||
unit Keyman.Developer.System.LaunchProjects; | ||
|
||
interface | ||
|
||
uses | ||
System.Classes, | ||
System.Generics.Collections, | ||
System.SysUtils, | ||
|
||
Keyman.Developer.System.TikeMultiProcess; | ||
|
||
type | ||
TLaunchProjectStatus = (lpsWaiting, lpsCurrentInstance, lpsOtherInstance, lpsNewInstance, lpsError); | ||
TLaunchProject = class | ||
private | ||
FProjectFilename: string; | ||
FFilenames: TStringList; | ||
FStatus: TLaunchProjectStatus; | ||
public | ||
constructor Create(const AProjectFilename: string); | ||
destructor Destroy; override; | ||
function LaunchAsNewInstance: Boolean; | ||
function PassToRunningProcess(AProcesses: TTikeProcessList): Boolean; | ||
property ProjectFilename: string read FProjectFilename; | ||
property Filenames: TStringList read FFilenames; | ||
property Status: TLaunchProjectStatus read FStatus; | ||
end; | ||
|
||
TLaunchProjects = class(TObjectList<TLaunchProject>) | ||
private | ||
FReserveStartupProject: Boolean; | ||
function GetStartupProject: TLaunchProject; | ||
public | ||
constructor Create(AReserveStartupProject: Boolean); | ||
procedure GroupFilenamesIntoProjects(const Filenames: TStringList); | ||
function LaunchAll(AProcesses: TTikeProcessList): Boolean; | ||
function Find(const ProjectFilename: string): TLaunchProject; | ||
property ReserveStartupProject: Boolean read FReserveStartupProject; | ||
property StartupProject: TLaunchProject read GetStartupProject; | ||
end; | ||
|
||
implementation | ||
|
||
uses | ||
Winapi.Windows, | ||
|
||
Keyman.Developer.System.ProjectOwningFile, | ||
utilexecute; | ||
|
||
{ TLaunchProject } | ||
|
||
constructor TLaunchProject.Create(const AProjectFilename: string); | ||
begin | ||
inherited Create; | ||
FProjectFilename := AProjectFilename; | ||
FFilenames := TStringList.Create; | ||
FStatus := lpsWaiting; | ||
end; | ||
|
||
destructor TLaunchProject.Destroy; | ||
begin | ||
FFilenames.Free; | ||
inherited Destroy; | ||
end; | ||
|
||
function TLaunchProject.LaunchAsNewInstance: Boolean; | ||
var | ||
filename, cmdline: string; | ||
begin | ||
cmdline := '"'+ParamStr(0)+'" --sub-process "'+Self.ProjectFilename+'"'; | ||
for filename in Self.Filenames do | ||
cmdline := cmdline + ' "'+filename+'"'; | ||
|
||
Result := TUtilExecute.Execute(cmdline, GetCurrentDir, SW_SHOWNORMAL); | ||
|
||
if Result | ||
then FStatus := lpsNewInstance | ||
else FStatus := lpsError; | ||
end; | ||
|
||
function TLaunchProject.PassToRunningProcess(AProcesses: TTikeProcessList): Boolean; | ||
var | ||
tp: TTikeProcess; | ||
filename: string; | ||
begin | ||
for tp in AProcesses do | ||
begin | ||
if tp.OwnsProject(Self.ProjectFilename) then | ||
begin | ||
FStatus := lpsOtherInstance; | ||
|
||
if Self.Filenames.Count = 0 then | ||
begin | ||
// Ensure that the project file tab is opened | ||
tp.OpenFile(Self.ProjectFilename); | ||
end; | ||
|
||
for filename in Self.Filenames do | ||
begin | ||
tp.OpenFile(filename); | ||
end; | ||
Exit(True); | ||
end; | ||
end; | ||
Result := False; | ||
end; | ||
|
||
{ TLaunchProjects } | ||
|
||
constructor TLaunchProjects.Create(AReserveStartupProject: Boolean); | ||
begin | ||
inherited Create(True); | ||
FReserveStartupProject := AReserveStartupProject; | ||
end; | ||
|
||
function TLaunchProjects.Find(const ProjectFilename: string): TLaunchProject; | ||
begin | ||
for Result in Self do | ||
begin | ||
if Result.ProjectFilename = ProjectFilename then | ||
begin | ||
Exit; | ||
end; | ||
end; | ||
Result := nil; | ||
end; | ||
|
||
function TLaunchProjects.GetStartupProject: TLaunchProject; | ||
begin | ||
for Result in Self do | ||
if Result.Status = lpsCurrentInstance then | ||
Exit; | ||
Result := nil; | ||
end; | ||
|
||
procedure TLaunchProjects.GroupFilenamesIntoProjects(const Filenames: TStringList); | ||
var | ||
projectFilename, filename: string; | ||
p: TLaunchProject; | ||
begin | ||
for filename in filenames do | ||
begin | ||
projectFilename := FindOwnerProjectForFile(filename); | ||
|
||
p := Self.Find(projectFilename); | ||
if p = nil then | ||
begin | ||
p := TLaunchProject.Create(projectFilename); | ||
Self.Add(p); | ||
end; | ||
p.Filenames.Add(filename); | ||
end; | ||
end; | ||
|
||
function TLaunchProjects.LaunchAll(AProcesses: TTikeProcessList): Boolean; | ||
var | ||
p: TLaunchProject; | ||
begin | ||
Result := False; | ||
|
||
// Hand off files to existing processes, based on project folder | ||
for p in Self do | ||
begin | ||
if not p.PassToRunningProcess(AProcesses) then | ||
begin | ||
// If there isn't an existing process, then we need to launch a new | ||
// process for the project | ||
if not Result and ReserveStartupProject then | ||
begin | ||
// For performance, we'll take the first project for the current process | ||
// if requested | ||
p.FStatus := lpsCurrentInstance; | ||
Result := True; | ||
end | ||
else | ||
begin | ||
p.LaunchAsNewInstance; | ||
end; | ||
end; | ||
end; | ||
end; | ||
|
||
end. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,87 @@ | ||
unit Keyman.Developer.System.Main; | ||
|
||
interface | ||
|
||
uses | ||
System.SysUtils, | ||
System.Win.ComObj, | ||
Vcl.Forms, | ||
Winapi.ActiveX, | ||
Winapi.UxTheme, | ||
|
||
uCEFApplication, | ||
uCEFTypes, | ||
|
||
Keyman.Developer.System.TikeCommandLine, | ||
Keyman.System.CEFManager, | ||
Keyman.System.KeymanSentryClient, | ||
Sentry.Client, | ||
Sentry.Client.Vcl, | ||
UfrmMain, | ||
UmodWebHttpServer; | ||
|
||
procedure RunKeymanDeveloper; | ||
|
||
implementation | ||
|
||
const | ||
LOGGER_DEVELOPER_IDE_TIKE = TKeymanSentryClient.LOGGER_DEVELOPER_IDE + '.tike'; | ||
|
||
procedure RunWithExceptionsHandled; forward; | ||
|
||
procedure RunKeymanDeveloper; | ||
begin | ||
CoInitFlags := COINIT_APARTMENTTHREADED; | ||
Application.MainFormOnTaskBar := True; | ||
Application.Initialize; | ||
Application.Title := 'Keyman Developer'; | ||
|
||
TKeymanSentryClient.Start(TSentryClientVcl, kscpDeveloper, LOGGER_DEVELOPER_IDE_TIKE); | ||
try | ||
try | ||
RunWithExceptionsHandled; | ||
except | ||
on E:Exception do | ||
SentryHandleException(E); | ||
end; | ||
finally | ||
TKeymanSentryClient.Stop; | ||
end; | ||
end; | ||
|
||
procedure RunWithExceptionsHandled; | ||
begin | ||
FInitializeCEF := TCEFManager.Create; | ||
try | ||
if GlobalCEFApp.ProcessType = ptBrowser then | ||
begin | ||
// We want to process the command line only if we are not a CEF | ||
// sub-process, because otherwise we lose the benefit of | ||
if TikeCommandLine.Process = pclExit then | ||
begin | ||
Exit; | ||
end; | ||
end; | ||
|
||
if FInitializeCEF.Start then | ||
begin | ||
InitThemeLibrary; | ||
SetThemeAppProperties(STAP_ALLOW_NONCLIENT or STAP_ALLOW_CONTROLS or STAP_ALLOW_WEBCONTENT); | ||
Application.CreateForm(TmodWebHttpServer, modWebHttpServer); | ||
try | ||
Application.CreateForm(TfrmKeymanDeveloper, frmKeymanDeveloper); | ||
try | ||
Application.Run; | ||
finally | ||
FreeAndNil(frmKeymanDeveloper); | ||
end; | ||
finally | ||
FreeAndNil(modWebHttpServer); | ||
end; | ||
end; | ||
finally | ||
FInitializeCEF.Free; | ||
end; | ||
end; | ||
|
||
end. |
Oops, something went wrong.