From decee4a2388dd329a619181983567df6eb2655bf Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 3 Jun 2011 00:29:11 +0000 Subject: [PATCH] IDE: remote control: Linux git-svn-id: trunk@31020 - --- ide/idecmdline.pas | 208 ++++++++++++++++++++++++++++++++++-- ide/lazarus.pp | 5 +- ide/lazarusidestrconsts.pas | 15 --- ide/lazbuild.lpr | 2 +- ide/main.pp | 87 ++++++++------- ide/mainintf.pas | 6 -- 6 files changed, 257 insertions(+), 66 deletions(-) diff --git a/ide/idecmdline.pas b/ide/idecmdline.pas index e889f5a323..67c97f7b7b 100644 --- a/ide/idecmdline.pas +++ b/ide/idecmdline.pas @@ -1,4 +1,3 @@ -{ $Id:$ } { /*************************************************************************** idecmdline.pas @@ -27,13 +26,11 @@ *************************************************************************** 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+} @@ -43,6 +40,21 @@ interface uses Classes, SysUtils, FileUtil, LazConf, LCLProc, LazarusIDEStrConsts; +const + ShowSetupDialogOptLong='--setup'; + PrimaryConfPathOptLong='--primary-config-path='; + PrimaryConfPathOptShort='--pcp='; + SecondaryConfPathOptLong='--secondary-config-path='; + SecondaryConfPathOptShort='--scp='; + NoSplashScreenOptLong='--no-splash-screen'; + NoSplashScreenOptShort='--nsc'; + StartedByStartLazarusOpt='--started-by-startlazarus'; + SkipLastProjectOpt='--skip-last-project'; + EnableRemoteControlOpt='--remote-control'; + DebugLogOpt='--debug-log='; + LanguageOpt='--language='; + LazarusDirOpt ='--lazarusdir='; + procedure ParseCommandLine(aCmdLineParams : TStrings; out IDEPid : Integer; out ShowSplashScreen: boolean); function GetCommandLineParameters(aCmdLineParams : TStrings; @@ -63,8 +75,18 @@ procedure SetParamOptions(var SkipAutoLoadingLastProject, function ExtractCmdLineFilenames : TStrings; function GetLazarusDirectory : String; - -implementation + +// remote control +var + EnableRemoteControl: boolean = false; + +function SetupMainIDEInstance: boolean; // false if this is a secondary instance +function GetPidFile: string; +function IsLazarusPIDRunning(aPID: int64): boolean; +function GetRemoteControlFilename: string; +procedure CleanUpPIDFile; + +implementation procedure ParseCommandLine(aCmdLineParams: TStrings; out IDEPid: Integer; out ShowSplashScreen: boolean); @@ -228,5 +250,179 @@ begin Result := ExtractFileDir(ParamStrUTF8(0)); end; +function GetPidFile: string; +begin + Result:=AppendPathDelim(GetPrimaryConfigPath)+'pid.txt'; +end; + +function IsLazarusPIDRunning(aPID: int64): boolean; + + function IsLinuxIDERunning: boolean; + var + sl: TStringList; + Filename: String; + begin + Result:=false; + Filename:='/proc/'+IntToStr(aPID)+'/cmdline'; + if not FileExists(Filename) then exit; + sl:=TStringList.Create; + try + try + sl.LoadFromFile(Filename); + if sl.Count=0 then exit; + if Pos('lazarus',lowercase(sl[0]))<1 then exit; + Result:=true; + except + end; + finally + sl.Free; + end; + end; + +begin + Result:=false; + {$IFDEF Linux} + Result:=IsLinuxIDERunning; + {$ENDIF} +end; + +function SetupMainIDEInstance: boolean; + + procedure WritePIDFile(const Filename: string; aPID: int64); + var + Dir: String; + sl: TStringList; + begin + debugln(['WritePIDFile File="',Filename,'" PID=',aPID]); + sl:=TStringList.Create; + try + sl.Add(IntToStr(aPID)); + try + Dir:=ChompPathDelim(ExtractFilePath(Filename)); + if not DirectoryExistsUTF8(Dir) then begin + if not CreateDirUTF8(Dir) then + debugln(['WritePIDFile failed to create directory ',Dir]); + exit; + end; + sl.SaveToFile(UTF8ToSys(Filename)); + except + on E: Exception do begin + debugln(['WritePIDFile "',Filename,'" failed:']); + debugln(E.Message); + end; + end; + finally + sl.Free; + end; + end; + + function ReadPIDFile(const Filename: string; out ConfigPID: int64): boolean; + var + sl: TStringList; + begin + Result:=false; + ConfigPID:=-1; + debugln(['ReadPIDFile ',Filename]); + if not FileExistsUTF8(Filename) then exit; + sl:=TStringList.Create; + try + try + sl.LoadFromFile(UTF8ToSys(Filename)); + ConfigPID:=StrToInt64(sl[0]); + Result:=true; + debugln(['ReadPIDFile ConfigPID=',ConfigPID]); + except + on E: Exception do begin + debugln(['ReadPIDFile "',Filename,'" failed:']); + debugln(E.Message); + end; + end; + finally + sl.Free; + end; + end; + + procedure SendCmdlineActionsToMainInstance; + var + sl: TStringList; + Param: String; + Filename: String; + i: Integer; + begin + sl:=TStringList.Create; + try + sl.Add('Show'); + for i:=1 to Paramcount do begin + Param:=ParamStrUTF8(i); + if (Param='') or (Param[1]='-') then continue; + sl.Add('Open '+Param); + end; + Filename:=GetRemoteControlFilename; + try + debugln(['SendCmdlineActionsToMainInstance Commands="',sl.Text,'"']); + sl.SaveToFile(UTF8ToSys(Filename)); + except + on E: Exception do begin + debugln(['SendCmdlineActionsToMainInstance failed to write ',Filename]); + debugln(E.Message); + end; + end; + finally + sl.Free; + end; + end; + +var + PIDFilename: String; + MyPID, ConfigPID: int64; + PIDRead: Boolean; +begin + Result:=true; + if not EnableRemoteControl then exit; + + // check if another IDE (of this user and same configuration) is already + // running. Request it to handle the show and handle the command line + // parameters (e.g. open files). And if successful return false. + // Otherwise become the main instance. + PIDFilename:=GetPidFile; + MyPID:=GetProcessID; + ConfigPID:=-1; + PIDRead:=ReadPIDFile(PIDFilename,ConfigPID); + if PIDRead and (ConfigPID<>MyPID) then begin + // there is a pid file from another instance + if not IsLazarusPIDRunning(ConfigPID) then begin + // clean up + DeleteFileUTF8(PIDFilename); + PIDRead:=false; + end; + end; + if not FileExistsUTF8(PIDFilename) then begin + // try to become the main instance + WritePIDFile(PIDFilename,MyPID); + PIDRead:=false; + end; + if not PIDRead then + PIDRead:=ReadPIDFile(PIDFilename,ConfigPID); + if ConfigPID=MyPID then begin + // this is the main instance + exit; + end; + // this is a second instance + Result:=false; + + SendCmdlineActionsToMainInstance; +end; + +function GetRemoteControlFilename: string; +begin + Result:=AppendPathDelim(GetPrimaryConfigPath)+'ideremotecontrol.txt'; +end; + +procedure CleanUpPIDFile; +begin + if EnableRemoteControl then + DeleteFileUTF8(GetRemoteControlFilename); +end; + end. diff --git a/ide/lazarus.pp b/ide/lazarus.pp index fff3d899e2..4412b2098f 100644 --- a/ide/lazarus.pp +++ b/ide/lazarus.pp @@ -51,7 +51,7 @@ uses SysUtils, Interfaces, Forms, LCLProc, - LazConf, + LazConf, IDECmdLine, Splash, Main, AboutFrm, @@ -95,6 +95,7 @@ begin OnGetApplicationName:=@GetLazarusApplicationName; Application.Initialize; TMainIDE.ParseCmdLineOptions; + if not SetupMainIDEInstance then exit; if Application.Terminated then exit; // Show splashform @@ -119,9 +120,11 @@ begin Application.Run; except debugln('lazarus.pp - unhandled exception'); + CleanUpPIDFile; Halt; end; end; + CleanUpPIDFile; if (SplashForm<>nil) then begin SplashForm.Free; SplashForm:=nil; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index b155170669..f13344942c 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -39,21 +39,6 @@ interface uses Classes, SysUtils; -const - ShowSetupDialogOptLong='--setup'; - PrimaryConfPathOptLong='--primary-config-path='; - PrimaryConfPathOptShort='--pcp='; - SecondaryConfPathOptLong='--secondary-config-path='; - SecondaryConfPathOptShort='--scp='; - NoSplashScreenOptLong='--no-splash-screen'; - NoSplashScreenOptShort='--nsc'; - StartedByStartLazarusOpt='--started-by-startlazarus'; - SkipLastProjectOpt='--skip-last-project'; - EnableRemoteControlOpt='--remote-control'; - DebugLogOpt='--debug-log='; - LanguageOpt='--language='; - LazarusDirOpt ='--lazarusdir='; - resourcestring lisErrInvalidOption = 'Invalid option at position %d: "%s"'; lisErrNoOptionAllowed = 'Option at position %d does not allow an argument: %s'; diff --git a/ide/lazbuild.lpr b/ide/lazbuild.lpr index 0e1c92e6a8..cced67ef2f 100644 --- a/ide/lazbuild.lpr +++ b/ide/lazbuild.lpr @@ -34,7 +34,7 @@ uses // IDE IDEProcs, InitialSetupDlgs, OutputFilter, CompilerOptions, ApplicationBundle, TransferMacros, EnvironmentOpts, IDETranslations, LazarusIDEStrConsts, - ExtToolDialog, + IDECmdLine, ExtToolDialog, MiscOptions, Project, LazConf, PackageDefs, PackageLinks, PackageSystem, BuildLazDialog, BuildProfileManager, BuildManager, BaseBuildManager; diff --git a/ide/main.pp b/ide/main.pp index cc0da41f5e..38faa7d3a9 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -631,7 +631,7 @@ type FCheckingFilesOnDisk: boolean; FCheckFilesOnDiskNeeded: boolean; FRemoteControlTimer: TTimer; - FRemoteControlFileValid: boolean; + FRemoteControlFileAge: integer; FIDECodeToolsDefines: TIDECodetoolsDefines; @@ -1105,7 +1105,6 @@ implementation var SkipAutoLoadingLastProject: boolean = false; StartedByStartLazarus: boolean = false; - EnableRemoteControl: boolean = false; ShowSetupDialog: boolean = false; function FindDesignComponent(const aName: string): TComponent; @@ -2273,7 +2272,8 @@ procedure TMainIDE.SetupRemoteControl; var Filename: String; begin - // delete old remote control file + debugln(['TMainIDE.SetupRemoteControl ']); + // delete old remote commands Filename:=GetRemoteControlFilename; if FileExistsUTF8(Filename) then DeleteFileUTF8(Filename); @@ -11925,17 +11925,27 @@ procedure TMainIDE.DoExecuteRemoteControl; ProjectLoaded:=Project1<>nil; DebugLn(['TMainIDE.DoExecuteRemoteControl.OpenFiles ProjectLoaded=',ProjectLoaded]); - // open project - if (Files<>nil) and (Files.Count>0) then begin + // open project (only the last in the list) + AProjectFilename:=''; + for i:=Files.Count-1 downto 0 do begin AProjectFilename:=Files[0]; if (CompareFileExt(AProjectFilename,'.lpr',false)=0) then AProjectFilename:=ChangeFileExt(AProjectFilename,'.lpi'); if (CompareFileExt(AProjectFilename,'.lpi',false)=0) then begin + // open a project + Files.Delete(i); // remove from the list AProjectFilename:=CleanAndExpandFilename(AProjectFilename); if FileExistsUTF8(AProjectFilename) then begin DebugLn(['TMainIDE.DoExecuteRemoteControl.OpenFiles AProjectFilename="',AProjectFilename,'"']); - Files.Delete(0); - ProjectLoaded:=(DoOpenProjectFile(AProjectFilename,[])=mrOk); + if (Project1<>nil) + and (CompareFilenames(AProjectFilename,Project1.ProjectInfoFile)=0) + then begin + // project is already open => do not reopen + ProjectLoaded:=true; + end else begin + // open another project + ProjectLoaded:=(DoOpenProjectFile(AProjectFilename,[])=mrOk); + end; end; end; end; @@ -11971,43 +11981,46 @@ var List: TStringList; Files: TStrings; i: Integer; + CmdShow: Boolean; begin Filename:=GetRemoteControlFilename; - if FileExistsUTF8(Filename) then begin - // the control file exists - if FRemoteControlFileValid then begin - List:=TStringList.Create; - Files:=nil; + if FileExistsUTF8(Filename) and (FRemoteControlFileAge<>FileAgeUTF8(Filename)) + then begin + // the control file exists and has changed + List:=TStringList.Create; + Files:=nil; + try + // load and delete the file try - // load and delete the file - try - List.LoadFromFile(UTF8ToSys(Filename)); - except - DebugLn(['TMainIDE.DoExecuteRemoteControl reading file failed: ',Filename]); - end; - DeleteFileUTF8(Filename); - FRemoteControlFileValid:=not FileExistsUTF8(Filename); - // execute - Files:=TStringList.Create; - for i:=0 to List.Count-1 do begin - if SysUtils.CompareText(copy(List[i],1,5),'open ')=0 then - Files.Add(copy(List[i],6,length(List[i]))); - end; - if Files.Count>0 then begin - OpenFiles(Files); - end; - finally - List.Free; - Files.Free; + List.LoadFromFile(UTF8ToSys(Filename)); + except + DebugLn(['TMainIDE.DoExecuteRemoteControl reading file failed: ',Filename]); end; - end else begin - // the last time there was an error (e.g. read/delete failed) - // do not waste time again + DeleteFileUTF8(Filename); + FRemoteControlFileAge:=-1; + // execute + Files:=TStringList.Create; + CmdShow:=false; + for i:=0 to List.Count-1 do begin + if SysUtils.CompareText(List[i],'show')=0 then + CmdShow:=true; + if SysUtils.CompareText(copy(List[i],1,5),'open ')=0 then + Files.Add(copy(List[i],6,length(List[i]))); + end; + if CmdShow then begin + // if minimized then restore, bring IDE to front + Application.MainForm.ShowOnTop; + end; + if Files.Count>0 then begin + OpenFiles(Files); + end; + finally + List.Free; + Files.Free; end; end else begin // the control file does not exist - // => remember the good state - FRemoteControlFileValid:=true; + FRemoteControlFileAge:=-1; end; end; diff --git a/ide/mainintf.pas b/ide/mainintf.pas index ed59a17d02..b19c871709 100644 --- a/ide/mainintf.pas +++ b/ide/mainintf.pas @@ -195,7 +195,6 @@ type class function GetPrimaryConfigPath: String; override; class function GetSecondaryConfigPath: String; override; procedure CopySecondaryConfigFile(const AFilename: String); override; - function GetRemoteControlFilename: string; function ShowProgress(const SomeText: string; Step, MaxStep: integer): boolean; override; @@ -400,11 +399,6 @@ begin LazConf.CopySecondaryConfigFile(AFilename); end; -function TMainIDEInterface.GetRemoteControlFilename: string; -begin - Result:=AppendPathDelim(GetPrimaryConfigPath)+'ideremotecontrol.txt'; -end; - function TMainIDEInterface.ShowProgress(const SomeText: string; Step, MaxStep: integer): boolean; begin