mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 12:18:03 +02:00
IDE: centralized command line parsing from Ido Kanner (issue #11624)
git-svn-id: trunk@15723 -
This commit is contained in:
vincents
parent
e53050f3a2
commit
2c7d835569
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2104,6 +2104,7 @@ ide/helpmanager.pas svneol=native#text/pascal
|
||||
ide/helpoptions.lfm svneol=native#text/plain
|
||||
ide/helpoptions.lrs svneol=native#text/pascal
|
||||
ide/helpoptions.pas svneol=native#text/pascal
|
||||
ide/idecmdline.pas svneol=native#text/plain
|
||||
ide/idecontexthelpedit.lfm svneol=native#text/plain
|
||||
ide/idecontexthelpedit.lrs svneol=native#text/plain
|
||||
ide/idecontexthelpedit.pas svneol=native#text/plain
|
||||
|
||||
218
ide/idecmdline.pas
Normal file
218
ide/idecmdline.pas
Normal file
@ -0,0 +1,218 @@
|
||||
{ $Id:$ }
|
||||
{
|
||||
/***************************************************************************
|
||||
idecmdline.pas
|
||||
--------------------
|
||||
A unit to manage command lines issue used inside the ide
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
***************************************************************************
|
||||
* *
|
||||
* This source is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU General Public License as published by *
|
||||
* the Free Software Foundation; either version 2 of the License, or *
|
||||
* (at your option) any later version. *
|
||||
* *
|
||||
* This code is distributed in the hope that it will be useful, but *
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
||||
* General Public License for more details. *
|
||||
* *
|
||||
* A copy of the GNU General Public License is available on the World *
|
||||
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
|
||||
Author: Ido Kanner
|
||||
}
|
||||
|
||||
(*
|
||||
This unit manages the commandline utils that are used across Lazarus.
|
||||
It was created for avoding duplicates and easier access for commandline utils
|
||||
that are required by the IDE.
|
||||
*)
|
||||
unit IDECmdLine;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
procedure ParseCommandLine(aCmdLineParams : TStrings; out IDEPid : Integer);
|
||||
function GetCommandLineParameters(aCmdLineParams : TStrings;
|
||||
isStartLazarus : Boolean = False) : String;
|
||||
|
||||
function IsHelpRequested (index : Integer = 1) : Boolean;
|
||||
function ParamIsOption(ParamIndex : integer; const Option : string) : boolean;
|
||||
function ParamIsOptionPlusValue(ParamIndex : integer;
|
||||
const Option : string; var AValue : string) : boolean;
|
||||
|
||||
procedure SetParamOptions(var SkipAutoLoadingLastProject,
|
||||
StartedByStartLazarus,
|
||||
EnableRemoteControl,
|
||||
ShowSplashScreen : Boolean);
|
||||
|
||||
function ExtractCmdLineFilenames : TStrings;
|
||||
|
||||
function GetLazarusDirectory : String;
|
||||
|
||||
implementation
|
||||
uses FileUtil, LazConf, LCLProc, LazarusIDEStrConsts;
|
||||
|
||||
procedure ParseCommandLine(aCmdLineParams : TStrings; out IDEPid : Integer);
|
||||
const
|
||||
LazarusPidOpt = '--lazarus-pid=';
|
||||
LazarusDebugOpt = '--debug';
|
||||
var
|
||||
i : Integer;
|
||||
Param : string;
|
||||
begin
|
||||
IDEPid := 0;
|
||||
for i := 1 to ParamCount do begin
|
||||
Param := ParamStr(i);
|
||||
if Param=LazarusDebugOpt then begin
|
||||
aCmdLineParams.Add('--debug-log=' +
|
||||
AppendPathDelim(GetPrimaryConfigPath) + 'debug.log');
|
||||
end;
|
||||
if LeftStr(Param,length(LazarusPidOpt))=LazarusPidOpt then begin
|
||||
try
|
||||
IDEPid :=
|
||||
StrToInt(RightStr(Param,Length(Param)-Length(LazarusPidOpt)));
|
||||
except
|
||||
DebugLn('Failed to parse %s',[Param]);
|
||||
IDEPid := 0;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Do not add file to the parameter list
|
||||
if not (Copy(Param,1,1) = '-') and (FileExists(ExpandFileName(Param))) then
|
||||
begin
|
||||
DebugLn('%s is a file', [Param]);
|
||||
continue;
|
||||
end;
|
||||
|
||||
DebugLn('Adding "%s" as a parameter', [Param]);
|
||||
aCmdLineParams.Add(Param);
|
||||
end;
|
||||
end;
|
||||
// make sure that command line parameters are still
|
||||
// double quoted, if they contain spaces
|
||||
for i := 0 to aCmdLineParams.Count -1 do
|
||||
begin
|
||||
if pos(' ',aCmdLineParams[i])>0 then
|
||||
aCmdLineParams[i] := '"' + aCmdLineParams[i] + '"';
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetCommandLineParameters(aCmdLineParams : TStrings; isStartLazarus : Boolean = False) : String;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if isStartLazarus then
|
||||
Result := ' --no-splash-screen --started-by-startlazarus'
|
||||
else
|
||||
Result := '';
|
||||
for i := 0 to aCmdLineParams.Count - 1 do
|
||||
Result := Result + ' ' + aCmdLineParams[i];
|
||||
end;
|
||||
|
||||
function IsHelpRequested (index : Integer = 1) : Boolean;
|
||||
begin
|
||||
Result := (ParamCount>0) and
|
||||
((CompareText (ParamStr(index), '--help') = 0) or
|
||||
(CompareText (ParamStr(index), '-help') = 0) or
|
||||
(CompareText (ParamStr(index), '-?') = 0) or
|
||||
(CompareText (ParamStr(index), '-h') = 0));
|
||||
end;
|
||||
|
||||
function ParamIsOption(ParamIndex : integer; const Option : string) : boolean;
|
||||
begin
|
||||
Result:=CompareText(ParamStr(ParamIndex),Option) = 0;
|
||||
end;
|
||||
|
||||
function ParamIsOptionPlusValue(ParamIndex : integer;
|
||||
const Option : string; var AValue : string) : boolean;
|
||||
var
|
||||
p : String;
|
||||
begin
|
||||
p := ParamStr(ParamIndex);
|
||||
Result := CompareText(LeftStr(p, length(Option)), Option) = 0;
|
||||
if Result then
|
||||
AValue := copy(p, length(Option) + 1, length(p))
|
||||
else
|
||||
AValue := '';
|
||||
end;
|
||||
|
||||
procedure SetParamOptions(var SkipAutoLoadingLastProject,
|
||||
StartedByStartLazarus,
|
||||
EnableRemoteControl,
|
||||
ShowSplashScreen : Boolean);
|
||||
var
|
||||
i : integer;
|
||||
AValue : String;
|
||||
begin
|
||||
for i:= 1 to ParamCount do
|
||||
begin
|
||||
//DebugLn(['TMainIDE.ParseCmdLineOptions ',i,' "',ParamStr(i),'"']);
|
||||
if ParamIsOptionPlusValue(i, PrimaryConfPathOptLong, AValue) then
|
||||
begin
|
||||
SetPrimaryConfigPath(AValue);
|
||||
end;
|
||||
if ParamIsOptionPlusValue(i, PrimaryConfPathOptShort, AValue) then
|
||||
begin
|
||||
SetPrimaryConfigPath(AValue);
|
||||
end;
|
||||
if ParamIsOptionPlusValue(i, SecondaryConfPathOptLong, AValue) then
|
||||
begin
|
||||
SetSecondaryConfigPath(AValue);
|
||||
end;
|
||||
if ParamIsOptionPlusValue(i, SecondaryConfPathOptShort, AValue) then
|
||||
begin
|
||||
SetSecondaryConfigPath(AValue);
|
||||
end;
|
||||
if ParamIsOption(i, NoSplashScreenOptLong) or
|
||||
ParamIsOption(i, NoSplashScreenOptShort) then
|
||||
begin
|
||||
ShowSplashScreen := false;
|
||||
end;
|
||||
|
||||
if ParamIsOption(i, SkipLastProjectOpt) then
|
||||
SkipAutoLoadingLastProject := true;
|
||||
if ParamIsOption(i, StartedByStartLazarusOpt) then
|
||||
StartedByStartLazarus := true;
|
||||
if ParamIsOption(i, EnableRemoteControlOpt) then
|
||||
EnableRemoteControl := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExtractCmdLineFilenames : TStrings;
|
||||
var
|
||||
i : LongInt;
|
||||
Filename : String;
|
||||
|
||||
begin
|
||||
Result := nil;
|
||||
for i := 1 to ParamCount do
|
||||
begin
|
||||
Filename := ParamStr(i);
|
||||
if (Filename = '') or (Filename[1] = '-') then
|
||||
break;
|
||||
if Result = nil then
|
||||
Result := TStringList.Create;
|
||||
Result.Insert(0,Filename);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetLazarusDirectory : String;
|
||||
begin
|
||||
Result := ExtractFileDir(ParamStr(0));
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -111,8 +111,6 @@ type
|
||||
FLazarusPID: Integer;
|
||||
FCmdLineParams: TStrings;
|
||||
FShowSplashOption: boolean;
|
||||
procedure ParseCommandLine;
|
||||
function GetCommandLineParameters: string;
|
||||
function GetLazarusPath(const FileName: string): string;
|
||||
function RenameLazarusExecutable(const Directory: string): TModalResult;
|
||||
procedure LazarusProcessStart(Sender: TObject);
|
||||
@ -126,6 +124,7 @@ type
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses IDECmdLine;
|
||||
|
||||
destructor TLazarusManager.Destroy;
|
||||
begin
|
||||
@ -133,52 +132,6 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TLazarusManager.ParseCommandLine;
|
||||
const
|
||||
LazarusPidOpt='--lazarus-pid=';
|
||||
LazarusDebugOpt ='--debug';
|
||||
var
|
||||
i: Integer;
|
||||
Param: string;
|
||||
begin
|
||||
FCmdLineParams := TStringList.Create;
|
||||
FLazarusPID := 0;
|
||||
for i := 1 to ParamCount do begin
|
||||
Param := ParamStr(i);
|
||||
if Param=LazarusDebugOpt then begin
|
||||
FCmdLineParams.Add('--debug-log=' +
|
||||
AppendPathDelim(GetPrimaryConfigPath) + 'debug.log');
|
||||
end;
|
||||
if LeftStr(Param,length(LazarusPidOpt))=LazarusPidOpt then begin
|
||||
try
|
||||
FLazarusPID :=
|
||||
StrToInt(RightStr(Param,Length(Param)-Length(LazarusPidOpt)));
|
||||
except
|
||||
DebugLn('Failed to parse %s',[Param]);
|
||||
FLazarusPid := 0;
|
||||
end;
|
||||
end
|
||||
else
|
||||
FCmdLineParams.Add(Param);
|
||||
end;
|
||||
// make sure that command line parameters are still
|
||||
// double quoted, if they contain spaces
|
||||
for i := 0 to FCmdLineParams.Count -1 do
|
||||
begin
|
||||
if pos(' ',FCmdLineParams[i])>0 then
|
||||
FCmdLineParams[i] := '"' + FCmdLineParams[i] + '"';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazarusManager.GetCommandLineParameters: string;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := ' --no-splash-screen --started-by-startlazarus';
|
||||
for i := 0 to FCmdLineParams.Count - 1 do
|
||||
Result := Result + ' ' + FCmdLineParams[i];
|
||||
end;
|
||||
|
||||
function TLazarusManager.GetLazarusPath(const FileName: string) : string;
|
||||
begin
|
||||
// first try in the bin dir of the primary config directory
|
||||
@ -274,7 +227,8 @@ procedure TLazarusManager.Initialize;
|
||||
begin
|
||||
FShowSplashOption:=true;
|
||||
SplashForm := nil;
|
||||
ParseCommandLine;
|
||||
FCmdLineParams := TStringList.Create;
|
||||
ParseCommandLine(FCmdLineParams, FLazarusPID);
|
||||
if FShowSplashOption then
|
||||
ShowSplash;
|
||||
end;
|
||||
@ -368,8 +322,14 @@ begin
|
||||
end;
|
||||
|
||||
DebugLn(['TLazarusManager.Run starting ',FLazarusPath,' ...']);
|
||||
if not Assigned(FCmdLineParams) then
|
||||
begin
|
||||
FCmdLineParams := TStringList.Create;
|
||||
ParseCommandLine(FCmdLineParams, FLazarusPID);
|
||||
end;
|
||||
FLazarusProcess :=
|
||||
TLazarusProcess.Create(FLazarusPath, GetCommandLineParameters);
|
||||
TLazarusProcess.Create(FLazarusPath,
|
||||
GetCommandLineParameters(FCmdLineParams, True));
|
||||
FLazarusProcess.OnStart := @LazarusProcessStart;
|
||||
FLazarusProcess.Execute;
|
||||
FLazarusProcess.WaitOnExit;
|
||||
|
||||
106
ide/main.pp
106
ide/main.pp
@ -128,7 +128,7 @@ uses
|
||||
DialogProcs, FindReplaceDialog, FindInFilesDlg, CodeExplorer, BuildFileDlg,
|
||||
ProcedureList, ExtractProcDlg, FindRenameIdentifier, AbstractsMethodsDlg,
|
||||
EmptyMethodsDlg, CleanDirDlg, CodeContextForm, AboutFrm, BuildManager,
|
||||
CompatibilityRestrictions, RestrictionBrowser, ProjectWizardDlg,
|
||||
CompatibilityRestrictions, RestrictionBrowser, ProjectWizardDlg, IDECmdLine,
|
||||
// main ide
|
||||
MainBar, MainIntf, MainBase;
|
||||
|
||||
@ -953,40 +953,13 @@ var
|
||||
Parses the command line for the IDE.
|
||||
-------------------------------------------------------------------------------}
|
||||
class procedure TMainIDE.ParseCmdLineOptions;
|
||||
|
||||
function ParamIsOption(ParamIndex: integer;
|
||||
const Option: string): boolean;
|
||||
begin
|
||||
Result:=CompareText(ParamStr(ParamIndex),Option)=0;
|
||||
end;
|
||||
|
||||
function ParamIsOptionPlusValue(ParamIndex: integer;
|
||||
const Option: string; var AValue: string): boolean;
|
||||
var
|
||||
p: String;
|
||||
begin
|
||||
p:=ParamStr(ParamIndex);
|
||||
Result:=CompareText(LeftStr(p,length(Option)),Option)=0;
|
||||
if Result then
|
||||
AValue:=copy(p,length(Option)+1,length(p))
|
||||
else
|
||||
AValue:='';
|
||||
end;
|
||||
|
||||
const
|
||||
space = ' ';
|
||||
var
|
||||
i: integer;
|
||||
AValue: string;
|
||||
begin
|
||||
StartedByStartLazarus:=false;
|
||||
SkipAutoLoadingLastProject:=false;
|
||||
EnableRemoteControl:=false;
|
||||
if (ParamCount>0)
|
||||
and ((CompareText(ParamStr(1),'--help')=0)
|
||||
or (CompareText(ParamStr(1),'-help')=0)
|
||||
or (CompareText(ParamStr(1),'-?')=0)
|
||||
or (CompareText(ParamStr(1),'-h')=0)) then
|
||||
if IsHelpRequested then
|
||||
begin
|
||||
TranslateResourceStrings(ProgramDirectory,'');
|
||||
|
||||
@ -1027,31 +1000,9 @@ begin
|
||||
Application.Terminate;
|
||||
exit;
|
||||
end;
|
||||
for i:=1 to ParamCount do begin
|
||||
//DebugLn(['TMainIDE.ParseCmdLineOptions ',i,' "',ParamStr(i),'"']);
|
||||
if ParamIsOptionPlusValue(i,PrimaryConfPathOptLong,AValue) then begin
|
||||
SetPrimaryConfigPath(AValue);
|
||||
end;
|
||||
if ParamIsOptionPlusValue(i,PrimaryConfPathOptShort,AValue) then begin
|
||||
SetPrimaryConfigPath(AValue);
|
||||
end;
|
||||
if ParamIsOptionPlusValue(i,SecondaryConfPathOptLong,AValue) then begin
|
||||
SetSecondaryConfigPath(AValue);
|
||||
end;
|
||||
if ParamIsOptionPlusValue(i,SecondaryConfPathOptShort,AValue) then begin
|
||||
SetSecondaryConfigPath(AValue);
|
||||
end;
|
||||
if ParamIsOption(i,NoSplashScreenOptLong)
|
||||
or ParamIsOption(i,NoSplashScreenOptShort) then begin
|
||||
ShowSplashScreen:=false;
|
||||
end;
|
||||
if ParamIsOption(i,SkipLastProjectOpt) then
|
||||
SkipAutoLoadingLastProject:=true;
|
||||
if ParamIsOption(i,StartedByStartLazarusOpt) then
|
||||
StartedByStartLazarus:=true;
|
||||
if ParamIsOption(i,EnableRemoteControlOpt) then
|
||||
EnableRemoteControl:=true;
|
||||
end;
|
||||
|
||||
SetParamOptions(SkipAutoLoadingLastProject, StartedByStartLazarus, EnableRemoteControl, ShowSplashScreen);
|
||||
|
||||
DebugLn('TMainIDE.ParseCmdLineOptions:');
|
||||
Debugln(' PrimaryConfigPath="',GetPrimaryConfigPath,'"');
|
||||
Debugln(' SecondaryConfigPath="',GetSecondaryConfigPath,'"');
|
||||
@ -1811,22 +1762,6 @@ end;
|
||||
|
||||
procedure TMainIDE.SetupStartProject;
|
||||
|
||||
function ExtractCmdLineFilenames: TStrings;
|
||||
var
|
||||
i: LongInt;
|
||||
Filename: String;
|
||||
begin
|
||||
Result:=nil;
|
||||
i:=ParamCount;
|
||||
while (i>0) do begin
|
||||
Filename:=ParamStr(i);
|
||||
if (Filename='') or (Filename[1]='-') then break;
|
||||
if Result=nil then Result:=TStringList.Create;
|
||||
Result.Insert(0,Filename);
|
||||
dec(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
function AskIfLoadLastFailingProject: boolean;
|
||||
begin
|
||||
Result:=QuestionDlg(lisOpenProject2,
|
||||
@ -9479,13 +9414,19 @@ procedure TMainIDE.DoRestart;
|
||||
|
||||
procedure StartStarter;
|
||||
var
|
||||
StartLazProcess: TProcess;
|
||||
ExeName: string;
|
||||
StartLazProcess : TProcess;
|
||||
ExeName : string;
|
||||
Params : TStrings;
|
||||
Dummy : Integer;
|
||||
begin
|
||||
StartLazProcess := TProcess.Create(nil);
|
||||
try
|
||||
// TODO: use the target directory, where the new startlazarus is
|
||||
StartLazProcess.CurrentDirectory := ExtractFileDir(ParamStr(0));
|
||||
StartLazProcess.CurrentDirectory := GetLazarusDirectory;
|
||||
//DebugLn('Parsing commandLine: ');
|
||||
Params := TStringList.Create;
|
||||
ParseCommandLine(Params, Dummy);
|
||||
//DebugLn('Done parsing CommandLine');
|
||||
ExeName := AppendPathDelim(StartLazProcess.CurrentDirectory) +
|
||||
'startlazarus' + GetExecutableExt;
|
||||
if not FileExists(ExeName) then begin
|
||||
@ -9493,11 +9434,24 @@ procedure TMainIDE.DoRestart;
|
||||
[LineEnding, ExeName]),mtError,[mbCancel]);
|
||||
exit;
|
||||
end;
|
||||
StartLazProcess.CommandLine := ExeName
|
||||
+' --lazarus-pid='+IntToStr(GetProcessID)
|
||||
+' "--primary-config-path='+GetPrimaryConfigPath+'"';
|
||||
//DebugLn('Setting CommandLine');
|
||||
StartLazProcess.CommandLine := ExeName +
|
||||
' --lazarus-pid='+IntToStr(GetProcessID) +
|
||||
' ' +
|
||||
GetCommandLineParameters(Params, False);
|
||||
|
||||
//DebugLn('CommandLine 1 : %s', [StartLazProcess.CommandLine]);
|
||||
|
||||
if (pos(PrimaryConfPathOptLong, StartLazProcess.CommandLine) = 0) and
|
||||
(pos(PrimaryConfPathOptShort, StartLazProcess.CommandLine) = 0) then
|
||||
StartLazProcess.CommandLine := StartLazProcess.CommandLine +
|
||||
' ' + PrimaryConfPathOptLong + '="'+GetPrimaryConfigPath+'"';
|
||||
|
||||
//DebugLn('CommandLine 2 : %s', [StartLazProcess.CommandLine]);
|
||||
|
||||
StartLazProcess.Execute;
|
||||
finally
|
||||
FreeAndNil(Params);
|
||||
StartLazProcess.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user