1 unit ExtToolsConsole;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils,
9 // LazUtils
10 LazLogger, LazUtilities,
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 TExternalToolConsole = class(TExternalTool)
50 protected
51 procedure CreateView; override;
52 procedure QueueAsyncAutoFree; override;
53 public
54 end;
55
56 { TExternalToolsConsole }
57
58 TExternalToolsConsole = class(TExternalTools)
59 public
60 constructor Create(aOwner: TComponent); override;
61 destructor Destroy; override;
GetIDEObjectnull62 function GetIDEObject({%H-}ToolData: TIDEExternalToolData): TObject; override;
63 procedure HandleMessages; override;
64 end;
65
66 var
67 ExtToolConsole: TLazExtToolConsole = nil; // set by lazbuild
68
69 implementation
70
71 { TLazExtToolConsoleView }
72
73 constructor TLazExtToolConsoleView.Create(AOwner: TComponent);
74 begin
75 inherited Create(AOwner);
76 end;
77
78 destructor TLazExtToolConsoleView.Destroy;
79 begin
80 Assert(Owner is TLazExtToolConsole, 'TLazExtToolConsoleView.Destroy: Owner is not TLazExtToolConsole.');
81 TLazExtToolConsole(Owner).fViews.Remove(Self);
82 inherited Destroy;
83 end;
84
85 procedure TLazExtToolConsoleView.ToolExited;
86 begin
87 inherited ToolExited;
88 if Tool.Terminated then begin
89 ToolState:=lmvtsFailed;
90 debugln('Error: (lazarus) ',Caption,': terminated');
91 end else if (ExitCode<>0) then begin
92 ToolState:=lmvtsFailed;
93 debugln('Error: (lazarus) ',Caption,': stopped with exit code '+IntToStr(ExitCode));
94 end else if (ExitStatus<>0) then begin
95 ToolState:=lmvtsFailed;
96 debugln('Error: (lazarus) ',Caption,': stopped with exit status '+IntToStr(ExitStatus));
97 end else if Tool.ErrorMessage<>'' then begin
98 ToolState:=lmvtsFailed;
99 debugln('Error: (lazarus) ',Caption,': ',Tool.ErrorMessage);
100 end else begin
101 ToolState:=lmvtsSuccess;
102 end;
103 end;
104
105 procedure TLazExtToolConsoleView.ProcessNewMessages(AThread: TThread);
106 begin
107
108 end;
109
110 procedure TLazExtToolConsoleView.OnNewOutput(Sender: TObject;
111 FirstNewMsgLine: integer);
112 begin
113 while fWrittenLineCount<Tool.WorkerOutput.Count do begin
114 debugln(Tool.WorkerOutput[fWrittenLineCount]);
115 inc(fWrittenLineCount);
116 end;
117 end;
118
119 procedure TLazExtToolConsoleView.InputClosed;
120 begin
121 inherited InputClosed;
122 Free;
123 end;
124
125 { TLazExtToolConsole }
126
127 constructor TLazExtToolConsole.Create(AOwner: TComponent);
128 begin
129 inherited Create(AOwner);
130 fViews:=TFPList.Create;
131 ExtToolConsole:=Self;
132 end;
133
134 destructor TLazExtToolConsole.Destroy;
135 begin
136 Clear;
137 FreeAndNil(fViews);
138 ExtToolConsole:=nil;
139 inherited Destroy;
140 end;
141
142 // inline
Countnull143 function TLazExtToolConsole.Count: integer;
144 begin
145 Result:=fViews.Count;
146 end;
147
GetViewsnull148 function TLazExtToolConsole.GetViews(Index: integer): TLazExtToolConsoleView;
149 begin
150 Result:=TLazExtToolConsoleView(fViews[Index]);
151 end;
152
153 procedure TLazExtToolConsole.Clear;
154 var
155 i: Integer;
156 begin
157 while FindUnfinishedView<>nil do begin
158 CheckSynchronize;
159 Sleep(10);
160 end;
161 for i:=Count-1 downto 0 do begin
162 if i>=Count then continue;
163 Views[i].Free;
164 end;
165 if Count>0 then
166 raise Exception.Create('TLazExtToolConsole.Clear: some views failed to free');
167 end;
168
FindUnfinishedViewnull169 function TLazExtToolConsole.FindUnfinishedView: TLazExtToolConsoleView;
170 var
171 i: Integer;
172 begin
173 for i:=0 to fViews.Count-1 do begin
174 Result:=Views[i];
175 if not Result.HasFinished then exit;
176 end;
177 Result:=nil;
178 end;
179
180 { TExternalToolConsole }
181
182 procedure TExternalToolConsole.CreateView;
183 // in console mode all output goes unparsed to console
184 var
185 View: TLazExtToolConsoleView;
186 begin
187 if ViewCount>0 then exit;
188 ClearParsers;
189 //View := ExtToolConsole.CreateView(Self);
190 View := TLazExtToolConsoleView.Create(ExtToolConsole);
191 View.Caption:=Self.Title;
192 AddHandlerOnNewOutput(@View.OnNewOutput);
193 ExtToolConsole.fViews.Add(View); // ToDo: Eliminate ExtToolConsole.
194 AddView(View);
195 end;
196
197 procedure TExternalToolConsole.QueueAsyncAutoFree;
198 begin
199 DebugLn(['WARNING: TExternalTool.SetThread can not call AutoFree from other thread']);
200 end;
201
202 { TExternalToolsConsole }
203
204 constructor TExternalToolsConsole.Create(aOwner: TComponent);
205 begin
206 inherited Create(aOwner);
207 FToolClass := TExternalToolConsole;
208 end;
209
210 destructor TExternalToolsConsole.Destroy;
211 begin
212 inherited Destroy;
213 end;
214
TExternalToolsConsole.GetIDEObjectnull215 function TExternalToolsConsole.GetIDEObject(ToolData: TIDEExternalToolData): TObject;
216 begin
217 raise Exception.Create('TExternalToolsConsole.GetIDEObject: Should not happen!');
218 Result:=nil;
219 end;
220
221 procedure TExternalToolsConsole.HandleMessages;
222 begin
223 if IsMultiThread then begin
224 if ConsoleVerbosity>0 then
225 DebugLn('TExternalToolsConsole.HandleMesages: Calling CheckSynchronize!');
226 CheckSynchronize;
227 end;
228 end;
229
230 end.
231
232