1 {
2 /***************************************************************************
3 idecmdline.pas
4 --------------------
5 A unit to manage command lines issue used inside the ide
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27
28 Author: Ido Kanner
29
30 This unit manages the commandline utils that are used across Lazarus.
31 It was created for avoding duplicates and easier access for commandline utils
32 that are required by the IDE.
33 }
34 unit IDECmdLine;
35
36 {$mode objfpc}{$H+}
37
38 interface
39
40 uses
41 Classes, SysUtils,
42 // LazUtils
43 FileUtil, LazFileUtils, LazUTF8, LazUTF8Classes, LazLogger,
44 // IDE
45 LazConf;
46
47 const
48 // IDE cmd line options
49 ShowSetupDialogOptLong='--setup';
50 PrimaryConfPathOptLong='--primary-config-path=';
51 PrimaryConfPathOptShort='--pcp=';
52 SecondaryConfPathOptLong='--secondary-config-path=';
53 SecondaryConfPathOptShort='--scp=';
54 NoSplashScreenOptLong='--no-splash-screen';
55 NoSplashScreenOptShort='--nsc';
56 StartedByStartLazarusOpt='--started-by-startlazarus';
57 ForceNewInstanceOpt='--force-new-instance';
58 SkipLastProjectOpt='--skip-last-project';
59 DebugLogOpt='--debug-log=';
60 DebugLogOptEnable='--debug-enable=';
61 LanguageOpt='--language=';
62 LazarusDirOpt ='--lazarusdir=';
63 const
64 // startlazarus options
65 StartLazarusPidOpt = '--lazarus-pid=';
66 StartLazarusDebugOpt = '--debug';
67
68 procedure ParseCommandLine(aCmdLineParams: TStrings; out IDEPid : Integer;
69 out ShowSplashScreen: boolean);
GetCommandLineParametersnull70 function GetCommandLineParameters(aCmdLineParams: TStrings;
71 isStartLazarus: Boolean = False) : string;
ExtractPrimaryConfigPathnull72 function ExtractPrimaryConfigPath(aCmdLineParams: TStrings): string;
ExpandParamFilenull73 function ExpandParamFile(const s: string): string;
74
IsHelpRequestednull75 function IsHelpRequested : Boolean;
IsVersionRequestednull76 function IsVersionRequested : boolean;
GetLanguageSpecifiednull77 function GetLanguageSpecified : string;
ParamIsOptionnull78 function ParamIsOption(ParamIndex : integer; const Option : string) : boolean;
ParamIsOptionPlusValuenull79 function ParamIsOptionPlusValue(ParamIndex : integer;
80 const Option : string; out AValue : string) : boolean;
81
82 procedure ParseNoGuiCmdLineParams;
83
ExtractCmdLineFilenamesnull84 function ExtractCmdLineFilenames : TStrings;
85
86 // options from CFG file
GetCfgFileContentnull87 function GetCfgFileContent: TStrings;
GetParamsAndCfgFilenull88 function GetParamsAndCfgFile: TStrings;
ParamsAndCfgCountnull89 function ParamsAndCfgCount: Integer;
ParamsAndCfgStrnull90 function ParamsAndCfgStr(Idx: Integer): String;
91 procedure ResetParamsAndCfg;
92
93 implementation
94
95 var
96 CfgFileName: String = '';
97 CfgFileDone: Boolean = False;
98 CfgFileContent: TStrings = nil;
99 ParamsAndCfgFileContent: TStrings = nil;
100
GetCfgFileContentnull101 function GetCfgFileContent: TStrings;
102 begin
103 Result := CfgFileContent;
104 if CfgFileDone then
105 exit;
106 CfgFileDone := True;
107 CfgFileName := AppendPathDelim(ProgramDirectory) + 'lazarus.cfg';
108 if FileExistsUTF8(CfgFileName) then begin
109 DebugLn(['using config file ', CfgFileName]);
110 CfgFileContent := TStringListUTF8.Create;
111 CfgFileContent.LoadFromFile(CfgFileName);
112 end;
113 Result := CfgFileContent;
114 end;
115
GetParamsAndCfgFilenull116 function GetParamsAndCfgFile: TStrings;
117 procedure CleanDuplicates(ACurParam, AMatch, AClean: String);
118 var
119 i: Integer;
120 begin
121 if LowerCase(copy(ACurParam, 1, Length(AMatch))) = LowerCase(AMatch) then begin
122 i := ParamsAndCfgFileContent.Count - 1;
123 while i >= 0 do begin
124 if LowerCase(copy(ParamsAndCfgFileContent[i], 1, Length(AClean))) = LowerCase(AClean) then
125 ParamsAndCfgFileContent.Delete(i);
126 dec(i);
127 end;
128 end;
129 end;
130 var
131 Cfg: TStrings;
132 i: Integer;
133 s: String;
134 Warn: String;
135 begin
136 Result := ParamsAndCfgFileContent;
137 if Result <> nil then
138 exit;
139 ParamsAndCfgFileContent := TStringList.Create;
140 ParamsAndCfgFileContent.Add(ParamStrUTF8(0));
141
142 Cfg := GetCfgFileContent;
143 if Cfg <> nil then begin
144 Warn := '';
145 // insert Cfg at start. For duplicates the latest occurence takes precedence
146 for i := 0 to Cfg.Count - 1 do begin
147 s := Cfg[i];
148 if (s <> '') and (s[1] = '-') then
149 begin
150 s := Trim(s);
151 {$ifdef windows}
152 //cfg file is made by Windows installer and probably is Windows default codepage
153 if FindInvalidUTF8Codepoint(PChar(s), Length(s), True) > 0 then
154 s := WinCPToUtf8(s);
155 {$endif windows}
156 ParamsAndCfgFileContent.Add(s)
157 end
158 else
159 if (Trim(s) <> '') and (s[1] <> '#') then
160 Warn := Warn + IntToStr(i)+': ' + s + LineEnding;
161 end;
162 if Warn<>'' then begin
163 debugln('WARNING: invalid lines in lazarus.cfg:');
164 debugln(Warn);
165 end;
166 end;
167
168 for i := 1 to Paramcount do begin
169 s := ParamStrUTF8(i);
170 CleanDuplicates(s, PrimaryConfPathOptLong, PrimaryConfPathOptLong);
171 CleanDuplicates(s, PrimaryConfPathOptLong, PrimaryConfPathOptShort);
172 CleanDuplicates(s, PrimaryConfPathOptShort, PrimaryConfPathOptLong);
173 CleanDuplicates(s, PrimaryConfPathOptShort, PrimaryConfPathOptShort);
174 CleanDuplicates(s, SecondaryConfPathOptLong, SecondaryConfPathOptLong);
175 CleanDuplicates(s, SecondaryConfPathOptLong, SecondaryConfPathOptShort);
176 CleanDuplicates(s, SecondaryConfPathOptShort, SecondaryConfPathOptLong);
177 CleanDuplicates(s, SecondaryConfPathOptShort, SecondaryConfPathOptShort);
178 CleanDuplicates(s, LanguageOpt, LanguageOpt);
179 CleanDuplicates(s, LazarusDirOpt, LazarusDirOpt);
180 ParamsAndCfgFileContent.Add(s);
181 end;
182
183 Result := ParamsAndCfgFileContent;
184 end;
185
ParamsAndCfgCountnull186 function ParamsAndCfgCount: Integer;
187 begin
188 Result := GetParamsAndCfgFile.Count;
189 end;
190
ParamsAndCfgStrnull191 function ParamsAndCfgStr(Idx: Integer): String;
192 begin
193 if (Idx < 0) or (Idx >= GetParamsAndCfgFile.Count) then
194 Result := ''
195 else
196 Result := GetParamsAndCfgFile[Idx];
197 end;
198
199 procedure ResetParamsAndCfg;
200 begin
201 FreeAndNil(ParamsAndCfgFileContent);
202 end;
203
204 procedure ParseCommandLine(aCmdLineParams: TStrings; out IDEPid: Integer; out
205 ShowSplashScreen: boolean);
206 var
207 i : Integer;
208 Param : string;
209 HasDebugLog: Boolean;
210 begin
211 IDEPid := 0;
212 HasDebugLog := False;
213 for i := 1 to ParamsAndCfgCount do begin
214 Param := ParamsAndCfgStr(i);
215 if Param='' then continue;
216 if SysUtils.CompareText(LeftStr(Param, length(DebugLogOpt)), DebugLogOpt) = 0 then
217 HasDebugLog := HasDebugLog or (length(Param) > length(DebugLogOpt));
218 if (Param=StartLazarusDebugOpt) and (not HasDebugLog) then begin
219 aCmdLineParams.Add('--debug-log=' +
220 AppendPathDelim(UTF8ToSys(GetPrimaryConfigPath)) + 'debug.log');
221 end;
222 if LeftStr(Param,length(StartLazarusPidOpt))=StartLazarusPidOpt then begin
223 try
224 IDEPid :=
225 StrToInt(RightStr(Param,Length(Param)-Length(StartLazarusPidOpt)));
226 except
227 DebugLn('Failed to parse %s',[Param]);
228 IDEPid := 0;
229 end;
230 end
231 else if ParamIsOption(i, NoSplashScreenOptLong) or
232 ParamIsOption(i, NoSplashScreenOptShort) then
233 begin
234 ShowSplashScreen := false;
235 end
236 else begin
237 // Do not add file to the parameter list
238 if not (Copy(Param,1,1) = '-') and (FileExistsUTF8(ExpandFileNameUTF8(Param))) then
239 begin
240 DebugLn('%s is a file', [Param]);
241 continue;
242 end;
243
244 // pass these parameters to Lazarus
245 DebugLn('Adding "%s" as a parameter', [Param]);
246 aCmdLineParams.Add(Param);
247 end;
248 end;
249 end;
250
GetCommandLineParametersnull251 function GetCommandLineParameters(aCmdLineParams : TStrings; isStartLazarus : Boolean = False) : String;
252 var
253 i: Integer;
254 s: String;
255 begin
256 if isStartLazarus then
257 Result := ' --no-splash-screen --started-by-startlazarus'
258 else
259 Result := '';
260 for i := 0 to aCmdLineParams.Count - 1 do begin
261 s := aCmdLineParams[i];
262 // make sure that command line parameters are still
263 // double quoted, if they contain spaces
264 if pos(' ', s) > 0 then
265 s := '"' + s + '"';
266 Result := Result + ' ' + s;
267 end;
268 end;
269
ExtractPrimaryConfigPathnull270 function ExtractPrimaryConfigPath(aCmdLineParams: TStrings): string;
271
272 procedure GetParam(Param, Prefix: string; var Value: string);
273 begin
274 if LeftStr(Param,length(Prefix))=Prefix then
275 Value:=copy(Param,length(Prefix)+1,length(Param));
276 end;
277
278 var
279 i: Integer;
280 begin
281 Result:='';
282 for i:=0 to aCmdLineParams.Count-1 do
283 begin
284 GetParam(aCmdLineParams[i],PrimaryConfPathOptLong,Result);
285 GetParam(aCmdLineParams[i],PrimaryConfPathOptShort,Result);
286 end;
287 end;
288
ExpandParamFilenull289 function ExpandParamFile(const s: string): string;
290 const
291 a: array[1..5] of string = (
292 PrimaryConfPathOptLong,PrimaryConfPathOptShort,
293 SecondaryConfPathOptLong,SecondaryConfPathOptShort,
294 LazarusDirOpt
295 );
296 var
297 p: string;
298 begin
299 Result:=s;
300 for p in a do
301 if LeftStr(Result,length(p))=p then
302 begin
303 Result:=LeftStr(Result,length(p))+ExpandFileNameUTF8(copy(Result,length(p)+1,length(Result)));
304 exit;
305 end;
306 end;
307
IsHelpRequestednull308 function IsHelpRequested : Boolean;
309 var
310 i: integer;
311 begin
312 Result := false;
313 i:=1;
314 while (i <= ParamsAndCfgCount) and (Result = false) do
315 begin
316 Result := ParamIsOption(i, '--help') or
317 ParamIsOption(i, '-help') or
318 ParamIsOption(i, '-?') or
319 ParamIsOption(i, '-h');
320 inc(i);
321 end;
322 end;
323
IsVersionRequestednull324 function IsVersionRequested: boolean;
325 begin
326 //Don't use ParamsAndCfgCount here, because ATM (2019-03-24) GetParamsAndCfgFile adds
327 //ParamStrUtf8(0) to it and may add more in the future
328 Result := (ParamCount=1) and
329 ((ParamStr(1)='--version') or
330 (ParamStr(1)='-v'));
331 end;
332
333 function GetLanguageSpecified : string;
334 var
335 i: integer;
336 AValue: string;
337 begin
338 // return language specified in command line (empty string if no language specified)
339 Result := '';
340 AValue := '';
341 i := 1;
342 while i <= ParamsAndCfgCount do
343 begin
344 if ParamIsOptionPlusValue(i, LanguageOpt, AValue) = true then
345 begin
346 Result := AValue;
347 exit;
348 end;
349 inc(i);
350 end;
351 end;
352
353 function ParamIsOption(ParamIndex : integer; const Option : string) : boolean;
354 begin
355 Result:=SysUtils.CompareText(ParamsAndCfgStr(ParamIndex),Option) = 0;
356 end;
357
358 function ParamIsOptionPlusValue(ParamIndex : integer;
359 const Option : string; out AValue : string) : boolean;
360 var
361 p : String;
362 begin
363 p := ParamsAndCfgStr(ParamIndex);
364 Result := SysUtils.CompareText(LeftStr(p, length(Option)), Option) = 0;
365 if Result then
366 AValue := copy(p, length(Option) + 1, length(p))
367 else
368 AValue := '';
369 end;
370
371 procedure ParseNoGuiCmdLineParams;
372 var
373 i : integer;
374 AValue : String;
375 begin
376 for i:=1 to ParamsAndCfgCount do
377 begin
378 //DebugLn(['ParseNoGuiCmdLineParams ',i,' "',ParamsAndCfgStr(i),'"']);
379 if ParamIsOptionPlusValue(i, PrimaryConfPathOptLong, AValue) then
380 SetPrimaryConfigPath(AValue)
381 else if ParamIsOptionPlusValue(i, PrimaryConfPathOptShort, AValue) then
382 SetPrimaryConfigPath(AValue)
383 else if ParamIsOptionPlusValue(i, SecondaryConfPathOptLong, AValue) then
384 SetSecondaryConfigPath(AValue)
385 else if ParamIsOptionPlusValue(i, SecondaryConfPathOptShort, AValue) then
386 SetSecondaryConfigPath(AValue);
387 end;
388 end;
389
390 function ExtractCmdLineFilenames : TStrings;
391 var
392 i : LongInt;
393 Filename : String;
394
395 begin
396 Result := nil;
397 for i := 1 to ParamsAndCfgCount do
398 begin
399 Filename := ParamsAndCfgStr(i);
400 if (Filename = '') or (Filename[1] = '-') then
401 continue;
402 if Result = nil then
403 Result := TStringList.Create;
404 Result.Add(Filename);
405 end;
406 end;
407
408 procedure InitLogger;
409 var
410 i : integer;
411 AValue : String;
412 begin
413 for i:= 1 to ParamsAndCfgCount do
414 begin
415 if ParamIsOptionPlusValue(i, DebugLogOpt, AValue) then
416 LazLogger.DebugLogger.LogName := AValue;
417 end;
418 end;
419
420 initialization
421 InitLogger;
422 finalization
423 FreeAndNil(CfgFileContent);
424 FreeAndNil(ParamsAndCfgFileContent);
425 end.
426
427