paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 04:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* centralize some type definitions so that they are compatible between process and processunicode

Browse Source 
* add an extra parameter to the callback in preparation of readoutput callbacks. 
   This is needed to let the callback differentiate between stderr or stdout callbacks
 * rename processunicode class to TProcess on recommendation of MvC.

git-svn-id: trunk@39651 -
This commit is contained in:
marco 2018-08-20 11:46:11 +00:00
parent bffbff73e1
commit 8554332c1d
3 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
packages/fcl-process/src/process.pp
View File

@ -40,6 +40,13 @@ Type
TProcessOptions = set of TProcessOption;
TStartupOptions = set of TStartupOption;
TRunCommandEventCode = (RunCommandIdle,RunCommandReadOutput,RunCommandFinished,RunCommandException);
TOnRunCommandEvent = procedure(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:string) of object;
EProcess = Class(Exception);
{$ifdef UNIX}
TProcessForkEvent = procedure(Sender : TObject) of object;
{$endif UNIX}
{$macro on}
{define processunicodestring}

18
packages/fcl-process/src/processbody.inc
View File

@ -40,13 +40,6 @@ Type
TProcessStringList = TStringList;
{$endif}
{$ifdef UNIX}
TProcessForkEvent = procedure(Sender : TObject) of object;
{$endif UNIX}
TRunCommandEventCode = (RunCommandIdle,RunCommandFinished,RunCommandException);
TOnRunCommandEvent = procedure(Sender : TObject;Status:TRunCommandEventCode;const Message:string) of object;
{ TProcess }
TProcessnamemacro = Class (TComponent)
@ -103,7 +96,7 @@ Type
procedure SetEnvironment(const Value: TProcessStrings);
Procedure ConvertCommandLine;
function PeekExitStatus: Boolean;
Procedure IntOnIdleSleep(Sender : TObject;Status:TRunCommandEventCode;const Message:String);
Procedure IntOnIdleSleep(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:String);
Protected
FRunning : Boolean;
FExitCode : Cardinal;
@ -174,7 +167,6 @@ Type
end;
TProcessClass = Class of TProcessnamemacro;
EProcess = Class(Exception);
Procedure CommandToList(S : TProcessString; List : TProcessStrings);
@ -532,7 +524,7 @@ begin
end;
end;
procedure TProcessnamemacro.IntOnIdleSleep(Sender : TObject;status:TRunCommandEventCode;const message:string);
procedure TProcessnamemacro.IntOnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
begin
if status=RunCommandIdle then
sleep(FRunCommandSleepTime);
@ -571,7 +563,7 @@ begin
gotoutputstderr:=ReadInputStream(StdErr,StdErrBytesRead,StdErrLength,StdErrString,1);
if not gotoutput and not gotoutputstderr and Assigned(FOnRunCommandEvent) Then
FOnRunCommandEvent(self,RunCommandIdle,'');
FOnRunCommandEvent(self,Nil,RunCommandIdle,'');
end;
// Get left output after end of execution
ReadInputStream(output,BytesRead,OutputLength,OutputString,250);
@ -582,7 +574,7 @@ begin
anexitstatus:=exitstatus;
result:=0; // we came to here, document that.
if Assigned(FOnRunCommandEvent) then // allow external apps to react to that and finish GUI
FOnRunCommandEvent(self,RunCommandFinished,'');
FOnRunCommandEvent(self,Nil,RunCommandFinished,'');
except
on e : Exception do
@ -591,7 +583,7 @@ begin
setlength(outputstring,BytesRead);
setlength(stderrstring,StderrBytesRead);
if Assigned(FOnRunCommandEvent) then
FOnRunCommandEvent(self,RunCommandException,e.Message);
FOnRunCommandEvent(self,Nil,RunCommandException,e.Message);
end;
end;
end;

9
packages/fcl-process/src/processunicode.pp
View File

@ -29,10 +29,17 @@ Type
TProcessPriority = process.TProcessPriority;
TProcessOptions = process.TProcessOptions;
TStartupOptions = process.TStartupOptions;
{$ifdef UNIX}
TProcessForkEvent = Process.TProcessForkEvent;
{$endif UNIX}
TRunCommandEventCode = Process.TRunCommandEventCode;
TOnRunCommandEvent = Process.TOnRunCommandEvent;
EProcess = Process.EProcess;
{$macro on}
{$define processunicodestring}
{$define TProcessnamemacro:=TProcessUnicode}
{$define TProcessnamemacro:=TProcess}
{$i processbody.inc}
end.