mirror of https://gitlab.com/basile.b/dexed.git
possible workaround for linux OnTerminate TAsyncProcess bug
This commit is contained in:
parent
d0d230cc2d
commit
6ef73e5b0b
|
@ -5,7 +5,7 @@ unit ce_common;
|
|||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Classes, SysUtils, ExtCtrls,
|
||||
{$IFDEF WINDOWS}
|
||||
Windows,
|
||||
{$ENDIF}
|
||||
|
@ -23,6 +23,21 @@ var
|
|||
|
||||
type
|
||||
|
||||
(**
|
||||
* Workaround for a TAsyncProcess Linux issue: OnTerminate event not called.
|
||||
* An idle timer is started when executing and trigs the event if necessary.
|
||||
*)
|
||||
TCheckedAsyncProcess = class(TAsyncProcess)
|
||||
{$IFDEF LINUX}
|
||||
private
|
||||
fTimer: TIdleTimer;
|
||||
procedure checkTerminated(sender: TObject);
|
||||
public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
procedure Execute; override;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
(**
|
||||
* MRU list for strings
|
||||
*)
|
||||
|
@ -189,6 +204,8 @@ type
|
|||
*)
|
||||
procedure killProcess(var aProcess: TAsyncProcess);
|
||||
|
||||
procedure killProcess(var aProcess: TCheckedAsyncProcess);
|
||||
|
||||
(**
|
||||
* Ensures that the in/out process pipes are not redirected, that it has a console, if it waits on exit.
|
||||
*)
|
||||
|
@ -196,6 +213,32 @@ type
|
|||
|
||||
implementation
|
||||
|
||||
{$IFDEF LINUX}
|
||||
constructor TCheckedAsyncProcess.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fTimer := TIdleTimer.Create(self);
|
||||
fTimer.Interval:=50;
|
||||
fTimer.Enabled:=false;
|
||||
fTimer.OnTimer:=@checkTerminated;
|
||||
end;
|
||||
|
||||
procedure TCheckedAsyncProcess.Execute;
|
||||
begin
|
||||
inherited;
|
||||
if OnTerminate <> nil then
|
||||
fTimer.Enabled:=true;
|
||||
end;
|
||||
|
||||
procedure TCheckedAsyncProcess.checkTerminated(sender: TObject);
|
||||
begin
|
||||
if OnTerminate = nil then exit;
|
||||
fTimer.Enabled:=false;
|
||||
OnTerminate(Self);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
// https://stackoverflow.com/questions/25438091/objectbinarytotext-error-with-a-treader-twriter-helper-class
|
||||
// http://forum.lazarus.freepascal.org/index.php/topic,25557.0.html
|
||||
procedure TProcessEx.Assign(aValue: TPersistent);
|
||||
|
@ -739,6 +782,16 @@ begin
|
|||
aProcess := nil;
|
||||
end;
|
||||
|
||||
procedure killProcess(var aProcess: TCheckedAsyncProcess);
|
||||
begin
|
||||
if aProcess = nil then
|
||||
exit;
|
||||
if aProcess.Running then
|
||||
aProcess.Terminate(0);
|
||||
aProcess.Free;
|
||||
aProcess := nil;
|
||||
end;
|
||||
|
||||
procedure ensureNoPipeIfWait(aProcess: TProcess);
|
||||
begin
|
||||
if not (poWaitonExit in aProcess.Options) then
|
||||
|
|
|
@ -12,7 +12,7 @@ type
|
|||
|
||||
TCEToolItem = class(TCollectionItem)
|
||||
private
|
||||
fProcess: TAsyncProcess;
|
||||
fProcess: TCheckedAsyncProcess;
|
||||
fExecutable: string;
|
||||
fWorkingDir: string;
|
||||
fShowWin: TShowWindowOptions;
|
||||
|
@ -85,7 +85,7 @@ var
|
|||
begin
|
||||
killProcess(fProcess);
|
||||
//
|
||||
fProcess := TAsyncProcess.Create(nil);
|
||||
fProcess := TCheckedAsyncProcess.Create(nil);
|
||||
fProcess.OnReadData:= @processOutput;
|
||||
fProcess.OnTerminate:= @processOutput;
|
||||
fProcess.Options := fOpts;
|
||||
|
|
|
@ -5,7 +5,7 @@ unit ce_dmdwrap;
|
|||
interface
|
||||
|
||||
uses
|
||||
classes, sysutils, process, asyncprocess;
|
||||
classes, sysutils, process, asyncprocess, ce_common;
|
||||
|
||||
(*
|
||||
|
||||
|
@ -276,6 +276,7 @@ type
|
|||
without the overload aProcess does not get the Parameters if aProcess is TAsynProcess...}
|
||||
procedure setProcess(var aProcess: TProcess);
|
||||
procedure setProcess(var aProcess: TAsyncProcess);
|
||||
procedure setProcess(var aProcess: TCheckedAsyncProcess);
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
|
@ -354,7 +355,7 @@ type
|
|||
implementation
|
||||
|
||||
uses
|
||||
ce_common, ce_main;
|
||||
ce_main;
|
||||
|
||||
procedure TOptsGroup.doChanged;
|
||||
begin
|
||||
|
@ -1022,6 +1023,16 @@ begin
|
|||
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
|
||||
end;
|
||||
|
||||
procedure TCustomProcOptions.setProcess(var aProcess: TCheckedAsyncProcess);
|
||||
begin
|
||||
aProcess.Parameters.Assign(Parameters);
|
||||
aProcess.Executable := fExecutable;
|
||||
aProcess.ShowWindow := fShowWin;
|
||||
aProcess.Options := fOptions;
|
||||
aProcess.CurrentDirectory := fWorkDir;
|
||||
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
|
||||
end;
|
||||
|
||||
procedure TCustomProcOptions.setExecutable(const aValue: string);
|
||||
begin
|
||||
if fExecutable = aValue then exit;
|
||||
|
|
|
@ -196,7 +196,7 @@ type
|
|||
{$ENDIF}
|
||||
fTools: TCETools;
|
||||
|
||||
fRunProc: TAsyncProcess;
|
||||
fRunProc: TCheckedAsyncProcess;
|
||||
|
||||
fLogMessager: TCELogMessageSubject;
|
||||
|
||||
|
@ -1251,8 +1251,6 @@ begin
|
|||
begin
|
||||
for str in lst do
|
||||
subjLmFromString(fLogMessager, str, fDoc, amcEdit, amkBub);
|
||||
FreeRunnableProc;
|
||||
// runnable compiler
|
||||
end;
|
||||
finally
|
||||
lst.Free;
|
||||
|
@ -1269,7 +1267,7 @@ var
|
|||
begin
|
||||
|
||||
FreeRunnableProc;
|
||||
fRunProc := TAsyncProcess.Create(nil);
|
||||
fRunProc := TCheckedAsyncProcess.Create(nil);
|
||||
fRunProc.Options := [poStderrToOutPut, poUsePipes];
|
||||
fRunProc.ShowWindow := swoHIDE;
|
||||
fRunProc.OnReadData := @asyncprocOutput;
|
||||
|
|
|
@ -24,12 +24,11 @@ inherited CEMessagesWidget: TCEMessagesWidget
|
|||
Width = 735
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 2
|
||||
DefaultItemHeight = 16
|
||||
Font.CharSet = ANSI_CHARSET
|
||||
DefaultItemHeight = 18
|
||||
Font.Height = -12
|
||||
Font.Name = 'Lucida Console'
|
||||
Font.Pitch = fpFixed
|
||||
Font.Quality = fqDraft
|
||||
Font.Name = 'Courier New'
|
||||
Font.Quality = fqProof
|
||||
Font.Style = [fsBold]
|
||||
HideSelection = False
|
||||
Images = imgList
|
||||
MultiSelect = True
|
||||
|
|
|
@ -34,7 +34,7 @@ type
|
|||
fLibMan: TLibraryManager;
|
||||
fChangedCount: NativeInt;
|
||||
fProjectSubject: TCECustomSubject;
|
||||
fRunner: TAsyncProcess;
|
||||
fRunner: TCheckedAsyncProcess;
|
||||
fLogMessager: TCECustomSubject;
|
||||
procedure doChanged;
|
||||
procedure setLibAliases(const aValue: TStringList);
|
||||
|
@ -559,7 +559,7 @@ begin
|
|||
result := false;
|
||||
killProcess(fRunner);
|
||||
//
|
||||
fRunner := TAsyncProcess.Create(nil); // fRunner can use the input process widget.
|
||||
fRunner := TCheckedAsyncProcess.Create(nil); // fRunner can use the input process widget.
|
||||
currentConfiguration.runOptions.setProcess(fRunner);
|
||||
if runArgs <> '' then
|
||||
begin
|
||||
|
|
|
@ -434,7 +434,6 @@ var
|
|||
end;
|
||||
|
||||
begin
|
||||
killProcess(fDmdProc);
|
||||
if ndAlias = nil then exit;
|
||||
|
||||
// clear the tree
|
||||
|
|
Loading…
Reference in New Issue