Skip to content

Commit

Permalink
feat(developer): Open files in per-project instances
Browse files Browse the repository at this point in the history
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
mcdurdin committed Dec 4, 2023
1 parent 915510b commit ff5a366
Show file tree
Hide file tree
Showing 10 changed files with 420 additions and 217 deletions.
5 changes: 1 addition & 4 deletions developer/src/tike/actions/dmActionsMain.pas
Original file line number Diff line number Diff line change
Expand Up @@ -334,11 +334,8 @@ procedure TmodActionsMain.actFileNewUpdate(Sender: TObject);
end;

procedure TmodActionsMain.actFileOpenAccept(Sender: TObject);
var
i: Integer;
begin
for i := 0 to actFileOpen.Dialog.Files.Count - 1 do
frmKeymanDeveloper.OpenFileInProject(actFileOpen.Dialog.Files[i]);
frmKeymanDeveloper.OpenFilesInProject(actFileOpen.Dialog.Files.ToStringArray);
end;

procedure TmodActionsMain.actFileOpenUpdate(Sender: TObject);
Expand Down
4 changes: 2 additions & 2 deletions developer/src/tike/main/DropTarget.pas
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,8 @@ interface

type
IDragDrop = interface
function DropAllowed(const FileNames: array of string): Boolean;
procedure Drop(const FileNames: array of string);
function DropAllowed(const FileNames: TArray<string>): Boolean;
procedure Drop(const FileNames: TArray<string>);
end;

TDropTarget = class(TObject, IInterface, IDropTarget)
Expand Down
183 changes: 183 additions & 0 deletions developer/src/tike/main/Keyman.Developer.System.LaunchProjects.pas
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.
87 changes: 87 additions & 0 deletions developer/src/tike/main/Keyman.Developer.System.Main.pas
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.
Loading

0 comments on commit ff5a366

Please sign in to comment.