1 unit ExtToolsConsole;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils,
9 // LazUtils
10 LazLogger,
11 // IDEIntf
12 IDEExternToolIntf,
13 // IDE
14 ExtTools;
15
16 type
17
18 { TLazExtToolConsoleView }
19
20 TLazExtToolConsoleView = class(TLazExtToolView)
21 protected
22 fWrittenLineCount: integer;
23 procedure ToolExited; override; // (main thread)
24 public
25 constructor Create(AOwner: TComponent); override;
26 destructor Destroy; override;
27 procedure InputClosed; override; // (main thread)
28 procedure ProcessNewMessages({%H-}AThread: TThread); override; // (worker thread, Tool is in Critical section)
29 procedure OnNewOutput(Sender: TObject; {%H-}FirstNewMsgLine: integer); // (main thread)
30 end;
31
32 { TLazExtToolConsole }
33
34 TLazExtToolConsole = class(TComponent)
35 private
36 fViews: TFPList; // list of TLazExtToolConsoleView
GetViewsnull37 function GetViews(Index: integer): TLazExtToolConsoleView;
38 public
39 constructor Create(AOwner: TComponent); override;
40 destructor Destroy; override;
41 procedure Clear;
FindUnfinishedViewnull42 function FindUnfinishedView: TLazExtToolConsoleView;
43 property Views[Index: integer]: TLazExtToolConsoleView read GetViews;
Countnull44 function Count: integer; inline;
45 end;
46
47 { TExternalToolConsole }
48
49 // ToDo: Replace TLazExtToolConsole with this TExternalToolConsole somehow.
50 TExternalToolConsole = class(TExternalTool)
51 private
52 protected
53 procedure CreateView; override;
54 procedure QueueAsyncAutoFree; override;
55 public
56 constructor Create(aOwner: TComponent); override;
57 destructor Destroy; override;
58 end;
59
60 { TExternalToolsConsole }
61
62 TExternalToolsConsole = class(TExternalTools)
63 public
64 constructor Create(aOwner: TComponent); override;
65 destructor Destroy; override;
GetIDEObjectnull66 function GetIDEObject(ToolData: TIDEExternalToolData): TObject; override;
67 procedure HandleMesages; override;
68 end;
69
70 var
71 ExtToolConsole: TLazExtToolConsole = nil; // set by lazbuild
72
73 implementation
74
75 { TLazExtToolConsoleView }
76
77 constructor TLazExtToolConsoleView.Create(AOwner: TComponent);
78 begin
79 inherited Create(AOwner);
80 end;
81
82 destructor TLazExtToolConsoleView.Destroy;
83 begin
84 Assert(Owner is TLazExtToolConsole, 'TLazExtToolConsoleView.Destroy: Owner is not TLazExtToolConsole.');
85 TLazExtToolConsole(Owner).fViews.Remove(Self);
86 inherited Destroy;
87 end;
88
89 procedure TLazExtToolConsoleView.ToolExited;
90 begin
91 inherited ToolExited;
92 if Tool.Terminated then begin
93 ToolState:=lmvtsFailed;
94 debugln('Error: (lazarus) ',Caption,': terminated');
95 end else if (ExitCode<>0) then begin
96 ToolState:=lmvtsFailed;
97 debugln('Error: (lazarus) ',Caption,': stopped with exit code '+IntToStr(ExitCode));
98 end else if (ExitStatus<>0) then begin
99 ToolState:=lmvtsFailed;
100 debugln('Error: (lazarus) ',Caption,': stopped with exit status '+IntToStr(ExitStatus));
101 end else if Tool.ErrorMessage<>'' then begin
102 ToolState:=lmvtsFailed;
103 debugln('Error: (lazarus) ',Caption,': ',Tool.ErrorMessage);
104 end else begin
105 ToolState:=lmvtsSuccess;
106 end;
107 end;
108
109 procedure TLazExtToolConsoleView.ProcessNewMessages(AThread: TThread);
110 begin
111
112 end;
113
114 procedure TLazExtToolConsoleView.OnNewOutput(Sender: TObject;
115 FirstNewMsgLine: integer);
116 begin
117 while fWrittenLineCount<Tool.WorkerOutput.Count do begin
118 debugln(Tool.WorkerOutput[fWrittenLineCount]);
119 inc(fWrittenLineCount);
120 end;
121 end;
122
123 procedure TLazExtToolConsoleView.InputClosed;
124 begin
125 inherited InputClosed;
126 Free;
127 end;
128
129 { TLazExtToolConsole }
130
131 constructor TLazExtToolConsole.Create(AOwner: TComponent);
132 begin
133 inherited Create(AOwner);
134 fViews:=TFPList.Create;
135 ExtToolConsole:=Self;
136 end;
137
138 destructor TLazExtToolConsole.Destroy;
139 begin
140 Clear;
141 FreeAndNil(fViews);
142 ExtToolConsole:=nil;
143 inherited Destroy;
144 end;
145
146 // inline
Countnull147 function TLazExtToolConsole.Count: integer;
148 begin
149 Result:=fViews.Count;
150 end;
151
GetViewsnull152 function TLazExtToolConsole.GetViews(Index: integer): TLazExtToolConsoleView;
153 begin
154 Result:=TLazExtToolConsoleView(fViews[Index]);
155 end;
156
157 procedure TLazExtToolConsole.Clear;
158 var
159 i: Integer;
160 begin
161 while FindUnfinishedView<>nil do begin
162 CheckSynchronize;
163 Sleep(10);
164 end;
165 for i:=Count-1 downto 0 do begin
166 if i>=Count then continue;
167 Views[i].Free;
168 end;
169 if Count>0 then
170 raise Exception.Create('TLazExtToolConsole.Clear: some views failed to free');
171 end;
172
FindUnfinishedViewnull173 function TLazExtToolConsole.FindUnfinishedView: TLazExtToolConsoleView;
174 var
175 i: Integer;
176 begin
177 for i:=0 to fViews.Count-1 do begin
178 Result:=Views[i];
179 if not Result.HasFinished then exit;
180 end;
181 Result:=nil;
182 end;
183
184 { TExternalToolConsole }
185
186 constructor TExternalToolConsole.Create(aOwner: TComponent);
187 begin
188 inherited Create(aOwner);
189 end;
190
191 destructor TExternalToolConsole.Destroy;
192 begin
193 inherited Destroy;
194 end;
195
196 procedure TExternalToolConsole.CreateView;
197 // in console mode all output goes unparsed to console
198 var
199 View: TLazExtToolConsoleView;
200 begin
201 if ViewCount>0 then exit;
202 ClearParsers;
203 //View := ExtToolConsole.CreateView(Self);
204 View := TLazExtToolConsoleView.Create(ExtToolConsole);
205 View.Caption:=Self.Title;
206 AddHandlerOnNewOutput(@View.OnNewOutput);
207 ExtToolConsole.fViews.Add(View); // ToDo: Eliminate ExtToolConsole.
208 AddView(View);
209 end;
210
211 procedure TExternalToolConsole.QueueAsyncAutoFree;
212 begin
213 debugln(['WARNING: TExternalTool.SetThread can not call AutoFree from other thread']);
214 end;
215
216 { TExternalToolsConsole }
217
218 constructor TExternalToolsConsole.Create(aOwner: TComponent);
219 begin
220 inherited Create(aOwner);
221 FToolClass := TExternalToolConsole;
222 end;
223
224 destructor TExternalToolsConsole.Destroy;
225 begin
226 inherited Destroy;
227 end;
228
TExternalToolsConsole.GetIDEObjectnull229 function TExternalToolsConsole.GetIDEObject(ToolData: TIDEExternalToolData): TObject;
230 begin
231 raise Exception.Create('TExternalToolsConsole.GetIDEObject: Should not happen!');
232 Result:=ToolData;
233 end;
234
235 procedure TExternalToolsConsole.HandleMesages;
236 begin
237 if IsMultiThread then
238 CheckSynchronize;
239 end;
240
241 end.
242
243