1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
unit BuilderThread;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
TOutputLineEvent = procedure(Sender: TObject; const ALine: string) of object;
TBuilderThread = class(TThread)
private
FBuildMode: integer;
FOnAvailableOutput: TOutputLineEvent;
OutputLine: string;
procedure DoOutputLine;
protected
procedure Execute; override;
public
procedure AfterConstruction; override;
property BuildMode: integer read FBuildMode write FBuildMode;
property OnAvailableOutput: TOutputLineEvent read FOnAvailableOutput write FOnAvailableOutput;
end;
implementation
uses
project
,process
,fpg_base
,fpg_iniutils
,fpg_utils
,ideconst
,idemacros
;
{ TBuilderThread }
procedure TBuilderThread.AfterConstruction;
begin
inherited AfterConstruction;
FBuildMode := -1; // signals use of project's default build mode
FreeOnTerminate := True;
end;
procedure TBuilderThread.Execute;
const
BufSize = 1024; //4096;
var
p: TProcess;
c: TfpgString;
unitdir: TfpgString;
Buf: string;
Count: integer;
i: integer;
LineStart: integer;
begin
unitdir := GProject.ProjectDir + GProject.UnitOutputDir;
unitdir := GMacroList.ExpandMacro(unitdir);
if not fpgDirectoryExists(unitdir) then
begin
{$IFDEF DEBUG}
writeln('DEBUG: TBuilderThread.Execute - Creating dir: ' + unitdir);
{$ENDIF}
fpgForceDirectories(unitDir);
end;
p := TProcess.Create(nil);
p.Options := [poUsePipes, poStdErrToOutPut];
p.ShowWindow := swoShowNormal;
p.CurrentDirectory := GProject.ProjectDir;
// build compilation string
c := gINI.ReadString(cEnvironment, 'Compiler', '');
c := c + GProject.GenerateCmdLine(False, BuildMode);
c := GMacroList.ExpandMacro(c);
// AddMessage('Compile command: ' + c);
p.CommandLine := c;
try
p.Execute;
{ Now process the output }
OutputLine:='';
SetLength(Buf,BufSize);
repeat
if (p.Output<>nil) then
begin
Count:=p.Output.Read(Buf[1],Length(Buf));
end
else
Count:=0;
LineStart:=1;
i:=1;
while i<=Count do
begin
if Buf[i] in [#10,#13] then
begin
OutputLine:=OutputLine+Copy(Buf,LineStart,i-LineStart);
Synchronize(@DoOutputLine);
OutputLine:='';
if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1]) then
inc(i);
LineStart:=i+1;
end;
inc(i);
end;
OutputLine:=Copy(Buf,LineStart,Count-LineStart+1);
until Count=0;
if OutputLine <> '' then
Synchronize(@DoOutputLine);
p.WaitOnExit;
finally
FreeAndNil(p);
end;
end;
procedure TBuilderThread.DoOutputLine;
begin
if Assigned(FOnAvailableOutput) then
FOnAvailableOutput(self, OutputLine);
end;
end.
|
