1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 Parser for GNU 'make' output.
25 }
26 unit etMakeMsgParser;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 // RTL
34 Classes, SysUtils,
35 // CodeTools
36 KeywordFuncLists,
37 // LazUtils
38 FileUtil, LazFileUtils, AvgLvlTree,
39 // IDEIntf
40 IDEExternToolIntf;
41
42 const
43 MakeMsgIDEnteringDirectory = 1;
44 MakeMsgIDLeavingDirectory = 2;
45
46 type
47
48 { TIDEMakeParser
49 Parse lines of 'make' tool. Finding the current directory is needed by other parsers. }
50
51 TIDEMakeParser = class(TMakeParser)
52 protected
53 fIsFileExecutable: TFilenameToPointerTree;
IsFileExecutablenull54 function IsFileExecutable(const Filename: string): boolean;
55 public
56 DirectoryStack: TStrings;
57 DefaultDirectory: string;
58 constructor Create(AOwner: TComponent); override;
59 destructor Destroy; override;
60 procedure InitReading; override;
61 procedure ReadLine(Line: string; OutputIndex: integer; IsStdErr: boolean;
62 var Handled: boolean); override;
DefaultSubToolnull63 class function DefaultSubTool: string; override;
Prioritynull64 class function Priority: integer; override;
65 end;
66
CompStrnull67 function CompStr(const SubStr: string; p: PChar): boolean;
CompStrInull68 function CompStrI(const SubStr: string; p: PChar): boolean;
FindSubStrInull69 function FindSubStrI(const SubStr: string; p: PChar): PChar;
GetStringnull70 function GetString(p: PChar; MaxLen: integer): string;
Str2Integernull71 function Str2Integer(p: PChar; const Default: integer): integer;
ReadDecimalnull72 function ReadDecimal(var p: PChar): boolean;
ReadNumberWithThousandSepnull73 function ReadNumberWithThousandSep(var p: PChar): boolean;
ReadCharnull74 function ReadChar(var p: PChar; c: char): boolean; inline;
ReadStringnull75 function ReadString(var p: PChar; const Find: string): boolean; inline;
76
77 procedure RegisterMakeParser;
78
79 implementation
80
CompStrnull81 function CompStr(const SubStr: string; p: PChar): boolean;
82 var
83 s: PChar;
84 begin
85 Result:=false;
86 if (SubStr='') or (p=nil) then exit;
87 s:=PChar(SubStr);
88 while (s^<>#0) and (p^=s^) do begin
89 inc(p);
90 inc(s);
91 end;
92 Result:=s^=#0;
93 end;
94
CompStrInull95 function CompStrI(const SubStr: string; p: PChar): boolean;
96 var
97 s: PChar;
98 begin
99 Result:=false;
100 if (SubStr='') or (p=nil) then exit;
101 s:=PChar(SubStr);
102 while (s^<>#0) and (UpChars[p^]=UpChars[s^]) do begin
103 inc(p);
104 inc(s);
105 end;
106 Result:=s^=#0;
107 end;
108
FindSubStrInull109 function FindSubStrI(const SubStr: string; p: PChar): PChar;
110 var
111 s: PChar;
112 begin
113 Result:=nil;
114 if (SubStr='') or (p=nil) then exit;
115 s:=PChar(SubStr);
116 while p^<>#0 do begin
117 if (UpChars[p^]=UpChars[s^]) and CompStrI(SubStr,p) then begin
118 Result:=p;
119 exit;
120 end;
121 inc(p);
122 end;
123 end;
124
GetStringnull125 function GetString(p: PChar; MaxLen: integer): string;
126 var
127 e: PChar;
128 len: Integer;
129 begin
130 e:=p;
131 len:=0;
132 while (e^<>#0) and (len<MaxLen) do begin
133 inc(e);
134 inc(len);
135 end;
136 SetLength(Result,len);
137 if len>0 then
138 System.Move(p^,Result[1],len);
139 end;
140
Str2Integernull141 function Str2Integer(p: PChar; const Default: integer): integer;
142 var
143 Negated: Boolean;
144 i: int64;
145 begin
146 i:=0;
147 if p^='-' then begin
148 Negated:=true;
149 inc(p);
150 end else
151 Negated:=false;
152 while p^ in ['0'..'9'] do begin
153 i:=i*10+ord(p^)-ord('0');
154 if (i>High(Result)) then begin
155 Result:=Default;
156 exit;
157 end;
158 inc(p);
159 end;
160 Result:=i;
161 if Negated then
162 Result:=-Result;
163 end;
164
ReadDecimalnull165 function ReadDecimal(var p: PChar): boolean;
166 var
167 OldP: PChar;
168 begin
169 OldP:=p;
170 while p^ in ['0'..'9'] do inc(p);
171 Result:=(OldP<p) and (p-OldP<10);
172 end;
173
ReadNumberWithThousandSepnull174 function ReadNumberWithThousandSep(var p: PChar): boolean;
175 var
176 OldP: PChar;
177 begin
178 OldP:=p;
179 repeat
180 case p^ of
181 '0'..'9': ;
182 '.':
183 if p=OldP then exit(false)
184 else if p[1]='.' then exit(false);
185 else break;
186 end;
187 inc(p);
188 until false;
189 Result:=(OldP<p) and (p-OldP<20);
190 end;
191
ReadCharnull192 function ReadChar(var p: PChar; c: char): boolean;
193 begin
194 Result:=p^=c;
195 if Result then inc(p);
196 end;
197
ReadStringnull198 function ReadString(var p: PChar; const Find: string): boolean;
199 begin
200 Result:=CompStr(Find,p);
201 if Result then inc(p,length(Find));
202 end;
203
204 procedure RegisterMakeParser;
205 begin
206 ExternalToolList.RegisterParser(TIDEMakeParser);
207 end;
208
209 { TIDEMakeParser }
210
TIDEMakeParser.IsFileExecutablenull211 function TIDEMakeParser.IsFileExecutable(const Filename: string): boolean;
212 var
213 p: Pointer;
214 begin
215 p:=fIsFileExecutable[Filename];
216 if p=Pointer(Self) then
217 Result:=true
218 else if p=Pointer(fIsFileExecutable) then
219 Result:=false
220 else begin
221 Result:=FileIsExecutable(Filename);
222 if Result then
223 fIsFileExecutable[Filename]:=Pointer(Self)
224 else
225 fIsFileExecutable[Filename]:=Pointer(fIsFileExecutable);
226 end;
227 end;
228
229 constructor TIDEMakeParser.Create(AOwner: TComponent);
230 begin
231 inherited Create(AOwner);
232 fIsFileExecutable:=TFilenameToPointerTree.Create(false);
233 end;
234
235 destructor TIDEMakeParser.Destroy;
236 begin
237 FreeAndNil(fIsFileExecutable);
238 FreeAndNil(DirectoryStack);
239 inherited Destroy;
240 end;
241
242 procedure TIDEMakeParser.InitReading;
243 begin
244 DefaultDirectory:=Tool.WorkerDirectory;
245 inherited InitReading;
246 end;
247
248 procedure TIDEMakeParser.ReadLine(Line: string; OutputIndex: integer;
249 IsStdErr: boolean; var Handled: boolean);
250 { returns true, if it is a make/gmake message
251 Examples for make messages:
252 make[1]: Entering directory `<filename>'
253 make[1]: Leaving directory `<filename>'
254 make[1]: *** [<filename>] Killed
255 make <command>
256 make[2]: *** [lazarus] Error 1
257 make[1]: *** [idepkg] Error 2
258 make: *** [idepkg] Error 2
259 /bin/cp <options>
260 }
261 const
262 EnterDirPattern = ': Entering directory `';
263 LeavingDirPattern = ': Leaving directory `';
264 MakeMsgPattern = ': *** [';
265 var
266 MsgLine: TMessageLine;
267 p: PChar;
268 Filename, Dir: string;
269 Run, OldP: PChar;
270 begin
271 if Line='' then exit;
272 p:=PChar(Line);
273 OldP:=p;
274 if ReadString(p,'make.exe') then
275 inc(p,8)
276 else if ReadString(p,'make') then
277 inc(p,4)
278 else if ReadString(p,'gmake') then
279 inc(p,5);
280
281 if (p>OldP) and (p^ in ['[',':']) then begin
282 // e.g. make[2]: *** [lazarus] Error 1
283 Handled:=true;
284
285 MsgLine:=CreateMsgLine(OutputIndex);
286 MsgLine.SubTool:=SubToolMake;
287 if IsStdErr then
288 begin
289 MsgLine.Urgency:=mluImportant;
290 MsgLine.Flags:=MsgLine.Flags+[mlfStdErr];
291 end else begin
292 MsgLine.Urgency:=mluVerbose;
293 end;
294 MsgLine.Msg:=Line;
295
296 if p^='[' then
297 begin
298 while not (p^ in [']',#0]) do inc(p);
299 if p^=']' then inc(p);
300 end;
301 if ReadString(p,EnterDirPattern) then begin
302 // entering directory
303 MsgLine.MsgID:=MakeMsgIDEnteringDirectory;
304 if DefaultDirectory='' then DefaultDirectory:=Tool.WorkerDirectory;
305 if (Tool.WorkerDirectory<>'') then begin
306 if (DirectoryStack=nil) then DirectoryStack:=TStringList.Create;
307 DirectoryStack.Add(Tool.WorkerDirectory);
308 end;
309 Dir:=p;
310 if (Dir<>'') and (Dir[length(Dir)]='''') then
311 Dir:=copy(Dir,1,length(Dir)-1);
312 Tool.WorkerDirectory:=Dir;
313 end else if ReadString(p,LeavingDirPattern) then begin
314 // leaving directory
315 MsgLine.MsgID:=MakeMsgIDLeavingDirectory;
316 if (DirectoryStack<>nil) and (DirectoryStack.Count>0) then begin
317 Tool.WorkerDirectory:=DirectoryStack[DirectoryStack.Count-1];
318 DirectoryStack.Delete(DirectoryStack.Count-1);
319 end else begin
320 // leaving what directory?
321 Tool.WorkerDirectory:=DefaultDirectory;
322 end;
323 end else if ReadString(p,MakeMsgPattern) then begin
324 MsgLine.Msg:=p-1;
325 end;
326 AddMsgLine(MsgLine);
327 exit;
328 end else if (p>OldP) and (p^=' ') then begin
329 // e.g. make --assume-new=lazbuild.lpr lazbuild
330 Handled:=true;
331
332 MsgLine:=CreateMsgLine(OutputIndex);
333 MsgLine.SubTool:=SubToolMake;
334 if IsStdErr then begin
335 MsgLine.Urgency:=mluImportant;
336 MsgLine.Flags:=MsgLine.Flags+[mlfStdErr];
337 end else begin
338 MsgLine.Urgency:=mluVerbose;
339 end;
340 MsgLine.Msg:=Line;
341 AddMsgLine(MsgLine);
342 exit;
343 end;
344
345 p:=OldP;
346 if not (p^ in [#0,' ',#9]) then begin
347 // check for command <option>
348 Run:=p;
349 while not (Run^ in [' ',#9,#0]) do inc(Run);
350 if Run^<>#0 then begin
351 SetLength(Filename,Run-p);
352 System.Move(p^,Filename[1],length(Filename));
353 Filename:=TrimFilename(Filename);
354 if FilenameIsAbsolute(Filename)
355 and ( (GetExeExt='') or FilenameExtIs(Filename,GetExeExt) )
356 and IsFileExecutable(Filename) then begin
357 Handled:=true;
358 MsgLine:=CreateMsgLine(OutputIndex);
359 MsgLine.SubTool:=SubToolMake;
360 if IsStdErr then begin
361 MsgLine.Urgency:=mluImportant;
362 MsgLine.Flags:=MsgLine.Flags+[mlfStdErr];
363 end else begin
364 MsgLine.Urgency:=mluVerbose;
365 end;
366 MsgLine.Msg:=Line;
367 AddMsgLine(MsgLine);
368 end;
369 end;
370 end;
371 end;
372
TIDEMakeParser.DefaultSubToolnull373 class function TIDEMakeParser.DefaultSubTool: string;
374 begin
375 Result:=SubToolMake;
376 end;
377
TIDEMakeParser.Prioritynull378 class function TIDEMakeParser.Priority: integer;
379 begin
380 Result:=SubToolMakePriority;
381 end;
382
383 end.
384
385