IDE: remote control: Linux

git-svn-id: trunk@31020 -

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.
 

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;

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';

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;
   

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;
 

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