From 2c7d83556970ed416e109afdc2ae6449c9d95735 Mon Sep 17 00:00:00 2001 From: vincents Date: Wed, 9 Jul 2008 14:49:12 +0000 Subject: [PATCH] IDE: centralized command line parsing from Ido Kanner (issue #11624) git-svn-id: trunk@15723 - --- .gitattributes | 1 + ide/idecmdline.pas | 218 +++++++++++++++++++++++++++++++++++++++++ ide/lazarusmanager.pas | 60 ++---------- ide/main.pp | 106 ++++++-------------- 4 files changed, 259 insertions(+), 126 deletions(-) create mode 100644 ide/idecmdline.pas diff --git a/.gitattributes b/.gitattributes index 063e2e2b6b..2f0226f61f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/ide/idecmdline.pas b/ide/idecmdline.pas new file mode 100644 index 0000000000..fefdc9e4f5 --- /dev/null +++ b/ide/idecmdline.pas @@ -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 . 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. + diff --git a/ide/lazarusmanager.pas b/ide/lazarusmanager.pas index 3336707ce5..215aac479f 100644 --- a/ide/lazarusmanager.pas +++ b/ide/lazarusmanager.pas @@ -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; diff --git a/ide/main.pp b/ide/main.pp index 5f9ff263df..1c51c174c8 100644 --- a/ide/main.pp +++ b/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;