ProjectGroups: Add a choice "Compile clean from here". Issue #41521, patch by Dean Mustakinov.

components/ideintf/projectgroupintf.pp

@@ -32,6 +32,7 @@ Type
     taCompile,
     taCompileClean,
     taCompileFromHere,
+    taCompileCleanFromHere,
     taRun,
     taInstall,
     taUninstall);
@@ -249,11 +250,11 @@ var
 const
   PGTargetActions: array[TPGTargetType] of TPGTargetActions = (
     [], // ttUnknown
-    [taOpen,taSettings,taCompile,taCompileClean,taCompileFromHere,taRun], // ttProject
-    [taOpen,taSettings,taCompile,taCompileClean,taCompileFromHere,taInstall,taUninstall], // ttPackage
-    [taOpen,taCompile,taCompileClean,taCompileFromHere], // ttProjectGroup
+    [taOpen,taSettings,taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere,taRun], // ttProject
+    [taOpen,taSettings,taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere,taInstall,taUninstall], // ttPackage
+    [taOpen,taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere], // ttProjectGroup
     [taOpen,taSettings,taCompile,taCompileFromHere,taRun], // ttPascalFile
-    [taOpen,taCompile,taCompileClean,taCompileFromHere,taRun] // ttExternalTool
+    [taOpen,taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere,taRun] // ttExternalTool
   );
 
 function TargetTypeFromExtension(AExt: String): TPGTargetType;

components/projectgroups/languages/projectgroupstrconst.pot

@@ -409,6 +409,10 @@ msgctxt "projectgroupstrconst.listargetcompilecleancaption"
 msgid "Compile clean"
 msgstr ""
 
+#: projectgroupstrconst.listargetcompilecleanfromhere
+msgid "Compile clean from here"
+msgstr ""
+
 #: projectgroupstrconst.listargetcompilecleanhint
 msgid "Compile selected target clean"
 msgstr ""

components/projectgroups/projectgroup.pp

@@ -305,6 +305,7 @@ var
   MnuCmdTargetCompile,
   MnuCmdTargetCompileClean,
   MnuCmdTargetCompileFromHere,
+  MnuCmdTargetCompileCleanFromHere,
   MnuCmdTargetInstall,
   MnuCmdTargetOpen,
   MnuCmdTargetRun,
@@ -1532,7 +1533,7 @@ begin
   IDEMacros.SubstituteMacros(WorkingDir);
 
   Params:=TStringList.Create;
-  if AAction=taCompileClean then
+  if AAction in [taCompileClean,taCompileCleanFromHere] then
     Params.Add('-B');
   if aBuildMode<>'' then
     Params.Add('--build-mode='+aBuildMode);
@@ -1875,13 +1876,14 @@ begin
        end;
      taCompile,
      taCompileClean,
-     taCompileFromHere:
+     taCompileFromHere,
+     taCompileCleanFromHere:
        begin
          if not CheckIDEIsReadyForBuild then exit;
          // save project
          if LazarusIDE.DoSaveProject([])<>mrOk then exit;
          R:= crCompile;
-         if (AAction=taCompileClean) then
+         if (AAction in [taCompileClean,taCompileCleanFromHere]) then
            R:= crBuild;
          if BuildModeCount>1 then begin
            i:=0;
@@ -1892,7 +1894,7 @@ begin
            while i<BuildModeCount do begin
              aMode:=BuildModes[i];
              inc(i);
-             debugln(['TIDECompileTarget.ProjectAction ',(aMode.Identifier<>StartBuildMode),' ',aMode.Identifier,' StartBuildMode=',StartBuildMode,' ',AAction=taCompileFromHere]);
+             debugln(['TIDECompileTarget.ProjectAction ',(aMode.Identifier<>StartBuildMode),' ',aMode.Identifier,' StartBuildMode=',StartBuildMode,' ',AAction in [taCompileFromHere,taCompileCleanFromHere]]);
              if (aMode.Identifier<>StartBuildMode) and (not aMode.Compile) then continue;
              // switch build mode
              aProject.ActiveBuildModeID:=aMode.Identifier;
@@ -1904,7 +1906,7 @@ begin
              // compile project in active buildmode
              if LazarusIDE.DoBuildProject(R,[])<>mrOk then
                exit;
-             if (StartBuildMode<>'') and (AAction<>taCompileFromHere) then
+             if (StartBuildMode<>'') and not (AAction in [taCompileFromHere,taCompileCleanFromHere]) then
                exit(arOK);
              StartBuildMode:='';
            end;
@@ -1914,8 +1916,8 @@ begin
              exit;
          end;
          Result:=arOK;
-         if AAction=taCompileFromHere then
-           Result:=PerformNextTarget(taCompileFromHere);
+         if AAction in [taCompileFromHere,taCompileCleanFromHere] then
+           Result:=PerformNextTarget(AAction);
        end;
      taRun :
        begin
@@ -1938,7 +1940,8 @@ begin
       end;
     taCompile,
     taCompileClean,
-    taCompileFromHere:
+    taCompileFromHere,
+    taCompileCleanFromHere:
       begin
         if not CheckIDEIsReadyForBuild then exit;
         // save files
@@ -1960,7 +1963,7 @@ begin
               Result:=CompileUsingLazBuild(AAction,aMode.Identifier);
               if Result<>arOK then exit;
 
-              if (StartBuildMode<>'') and (AAction<>taCompileFromHere) then
+              if (StartBuildMode<>'') and not (AAction in [taCompileFromHere,taCompileCleanFromHere]) then
                 exit(arOK);
               StartBuildMode:='';
             end;
@@ -1974,8 +1977,8 @@ begin
           LazarusIDE.ToolStatus:=itNone;
         end;
         Result:=arOK;
-        if AAction=taCompileFromHere then
-          Result:=PerformNextTarget(taCompileFromHere);
+        if AAction in [taCompileFromHere,taCompileCleanFromHere] then
+          Result:=PerformNextTarget(AAction);
       end;
     taRun:
       begin
@@ -2004,14 +2007,15 @@ begin
     end;
   taCompile,
   taCompileClean,
-  taCompileFromHere:
+  taCompileFromHere,
+  taCompileCleanFromHere:
     begin
       if not CheckIDEIsReadyForBuild then exit;
       // compile independent of active project => use lazbuild
       Result:=CompileUsingLazBuild(AAction);
       if Result<>arOK then exit;
-      if AAction=taCompileFromHere then
-        Result:=PerformNextTarget(taCompileFromHere);
+      if AAction in [taCompileFromHere,taCompileCleanFromHere] then
+        Result:=PerformNextTarget(AAction);
     end;
   taInstall: ;  // ToDo install
   taUninstall: ; // ToDo uninstall
@@ -2045,15 +2049,21 @@ begin
     finally
       ActiveChanged(Nil);
     end;
-  taCompileFromHere:
+  taCompileFromHere,
+  taCompileCleanFromHere:
     begin
+      if AAction = taCompileCleanFromHere then begin
+        if ProjectGroupAction(taCompileClean)<>arOK then
+          exit;
+      end
+      else
       if ProjectGroupAction(taCompile)<>arOK then
         exit;
       Result:=arOK;
       aTarget:=TIDECompileTarget(GetNext(true));
       ActiveChanged(aTarget);
       if aTarget=nil then exit;
-      Result:=aTarget.PerformAction(taCompileFromHere);
+      Result:=aTarget.PerformAction(AAction);
     end;
   end;
 end;
@@ -2074,14 +2084,15 @@ begin
     end;
   taCompile,
   taCompileClean,
-  taCompileFromHere:
+  taCompileFromHere,
+  taCompileCleanFromHere:
     begin
       if not CheckIDEIsReadyForBuild then exit;
       if LazarusIDE.DoBuildFile(false,Filename)<>mrOK then
         exit;
       Result:=arOK;
-      if AAction=taCompileFromHere then
-        Result:=PerformNextTarget(taCompileFromHere);
+      if AAction in [taCompileFromHere,taCompileCleanFromHere] then
+        Result:=PerformNextTarget(AAction);
     end;
   taRun:
     begin
@@ -2103,10 +2114,11 @@ begin
   taSettings: ;
   taCompile,
   taCompileClean,
-  taCompileFromHere:
+  taCompileFromHere,
+  taCompileCleanFromHere:
     begin
-      if AAction=taCompileFromHere then
-        Result:=PerformNextTarget(taCompileFromHere);
+      if AAction in [taCompileFromHere,taCompileCleanFromHere] then
+        Result:=PerformNextTarget(AAction);
     end;
   taRun: ;
   end;

components/projectgroups/projectgroupeditor.lfm

@@ -228,6 +228,12 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
       OnExecute = ATargetCompileFromHereExecute
       OnUpdate = ATargetCompileFromHereUpdate
     end
+    object ATargetCompileCleanFromHere: TAction
+      Category = 'TargetAction'
+      Caption = 'Compile clean from here'
+      OnExecute = ATargetCompileCleanFromHereExecute
+      OnUpdate = ATargetCompileCleanFromHereUpdate
+    end
     object ATargetProperties: TAction
       Category = 'TargetAction'
       Caption = 'Properties'
@@ -486,6 +492,9 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
     object PMICompileFromHere: TMenuItem
       Action = ATargetCompileFromHere
     end
+    object PMICompileCleanFromHere: TMenuItem
+      Action = ATargetCompileCleanFromHere
+    end
     object PMIDelete: TMenuItem
       Action = AProjectGroupDelete
       Bitmap.Data = {

components/projectgroups/projectgroupeditor.pas

@@ -61,6 +61,7 @@ type
     AProjectGroupUndo: TAction;
     AProjectGroupReload: TAction;
     ATargetCompileFromHere: TAction;
+    ATargetCompileCleanFromHere: TAction;
     ATargetCopyFilename: TAction;
     AProjectGroupAddExisting: TAction;
     ATargetCompile: TAction;
@@ -87,6 +88,7 @@ type
     PMIRedo: TMenuItem;
     PMIUndo: TMenuItem;
     PMICompileFromHere: TMenuItem;
+    PMICompileCleanFromHere: TMenuItem;
     PMIRunMenuItem: TMenuItem;
     PMICopyFilenameMenuItem: TMenuItem;
     PMIOpen: TMenuItem;
@@ -146,6 +148,8 @@ type
     procedure ATargetCompileExecute(Sender: TObject);
     procedure ATargetCompileFromHereExecute(Sender: TObject);
     procedure ATargetCompileFromHereUpdate(Sender: TObject);
+    procedure ATargetCompileCleanFromHereExecute(Sender: TObject);
+    procedure ATargetCompileCleanFromHereUpdate(Sender: TObject);
     procedure ATargetCompileUpdate(Sender: TObject);
     procedure ATargetCopyFilenameExecute(Sender: TObject);
     procedure ATargetCopyFilenameUpdate(Sender: TObject);
@@ -447,6 +451,7 @@ begin
   ConfigAction(ATargetOpen,'',lisTargetOpenCaption,lisTargetOpenHint,Nil);
   ConfigAction(ATargetCopyFilename,'',lisTargetCopyFilename,'',Nil);
   ConfigAction(ATargetCompileFromHere,'',lisTargetCompileFromHere,'',Nil);
+  ConfigAction(ATargetCompileCleanFromHere,'',lisTargetCompileCleanFromHere,'',Nil);
   ConfigAction(AProjectGroupReload,'laz_refresh',lisProjectGroupReload,'',Nil);
   ConfigAction(AProjectGroupUndo, 'menu_undo', lisUndo, '', nil);
   ConfigAction(AProjectGroupRedo, 'menu_redo', lisRedo, '', nil);
@@ -616,6 +621,7 @@ begin
   SetItem(MnuCmdTargetCompile,@ATargetCompileExecute);
   SetItem(MnuCmdTargetCompileClean,@ATargetCompileCleanExecute);
   SetItem(MnuCmdTargetCompileFromHere,@ATargetCompileFromHereExecute);
+  SetItem(MnuCmdTargetCompileCleanFromHere,@ATargetCompileCleanFromHereExecute);
   SetItem(MnuCmdTargetInstall,@ATargetInstallExecute);
   SetItem(MnuCmdTargetUninstall,@ATargetUnInstallExecute);
   SetItem(MnuCmdTargetLater,@ATargetLaterExecute);
@@ -1031,7 +1037,7 @@ begin
       case ND.NodeType of
       ntBuildMode:
         Result:=(not aTarget.Missing)
-          and (ATargetAction in [taCompile,taCompileClean,taCompileFromHere,taRun]);
+          and (ATargetAction in [taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere,taRun]);
       end;
     end;
   end;
@@ -1128,6 +1134,17 @@ begin
   UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetCompile);
 end;
 
+procedure TProjectGroupEditorForm.ATargetCompileCleanFromHereExecute(Sender: TObject);
+begin
+  Perform(taCompileCleanFromHere);
+end;
+
+procedure TProjectGroupEditorForm.ATargetCompileCleanFromHereUpdate(Sender: TObject);
+begin
+  AllowPerform(taCompileCleanFromHere,Sender as TAction);
+  UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetCompile);
+end;
+
 procedure TProjectGroupEditorForm.ATargetCompileUpdate(Sender: TObject);
 begin
   AllowPerform(taCompile,Sender as TAction);

components/projectgroups/projectgroupstrconst.pas

@@ -34,6 +34,7 @@ Resourcestring
   lisProjectGroups = 'Project Groups';
   lisTargetCompileClean = 'Compile clean';
   lisTargetCompileFromHere = 'Compile from here';
+  lisTargetCompileCleanFromHere = 'Compile clean from here';
   lisTargetInstall      = 'Install';
   lisTargetUnInstall    = 'Uninstall';
   lisTargetActivate     = 'Activate target';

components/projectgroups/regprojectgroup.pp

@@ -47,6 +47,7 @@ begin
   RegisterMenuCmd(MnuCmdTargetCompile,MnuSection,'TargetCompile',lisTargetCompile);
   RegisterMenuCmd(MnuCmdTargetCompileClean,MnuSection,'TargetCompileClean',lisTargetCompileClean);
   RegisterMenuCmd(MnuCmdTargetCompileFromHere,MnuSection,'TargetCompileFromHere',lisTargetCompileFromHere);
+  RegisterMenuCmd(MnuCmdTargetCompileCleanFromHere,MnuSection,'TargetCompileCleanFromHere',lisTargetCompileCleanFromHere);
   // ToDo: clean ... -> clean up dialog
   // ToDo: set build mode of all projects