implemented message blocks

git-svn-id: trunk@4485 -

ide/buildlazdialog.pas

@@ -329,6 +329,8 @@ begin
         CurMakeMode:=mmBuild;
       if CurMakeMode=mmNone then continue;
       Tool.Title:=CurItem.Description;
+      if (CurItem=Options.ItemIDE) and (blfWithoutLinkingIDE in Flags) then
+        Tool.Title:=lisCompileIDEWithoutLinking;
       Tool.WorkingDirectory:='$(LazarusDir)/'+CurItem.Directory;
       Tool.CmdLineParams:=CurItem.Commands[CurItem.MakeMode];
       // append extra options

ide/lazarusidestrconsts.pas

@@ -1238,6 +1238,7 @@ resourcestring
    
   // Build lazarus dialog
   lisCleanLazarusSource = 'Clean Lazarus Source';
+  lisCompileIDEWithoutLinking = 'Compile IDE (without linking)';
   lisBuildLCL = 'Build LCL';
   lisBuildComponent = 'Build Component';
   lisBuildCodeTools = 'Build CodeTools';

ide/main.pp

@@ -5563,49 +5563,54 @@ begin
 
   // show messages
   MessagesView.Clear;
-  DoArrangeSourceEditorAndMessageView(false);
+  MessagesView.BeginBlock;
+  try
+    DoArrangeSourceEditorAndMessageView(false);
 
-  // warn ambigious files
+    // warn ambigious files
-  DoWarnAmbigiousFiles;
+    DoWarnAmbigiousFiles;
 
-  // execute compilation tool 'Before'
+    // execute compilation tool 'Before'
-  Result:=DoExecuteCompilationTool(Project1.CompilerOptions.ExecuteBefore,
+    Result:=DoExecuteCompilationTool(Project1.CompilerOptions.ExecuteBefore,
-                                   Project1.ProjectDirectory,
-                                   'Executing command before');
-
-  if (Result=mrOk)
-  and (not Project1.CompilerOptions.SkipCompiler) then begin
-    try
-      // change tool status
-      ToolStatus:=itBuilder;
-
-      TheOutputFilter.OnOutputString:=@MessagesView.AddMsg;
-      TheOutputFilter.OnReadLine:=@MessagesView.AddProgress;
-
-      // compile
-      Result:=TheCompiler.Compile(Project1,BuildAll,DefaultFilename);
-      if Result<>mrOk then
-        DoJumpToCompilerMessage(-1,true);
-    finally
-      ToolStatus:=itNone;
-    end;
-  end;
-  
-  // execute compilation tool 'After'
-  if Result=mrOk then begin
-    Result:=DoExecuteCompilationTool(Project1.CompilerOptions.ExecuteAfter,
                                      Project1.ProjectDirectory,
-                                     'Executing command after');
+                                     'Executing command before');
-  end;
 
-  // add success message
+    if (Result=mrOk)
-  if Result=mrOk then begin
+    and (not Project1.CompilerOptions.SkipCompiler) then begin
-    MessagesView.AddMsg(
+      try
-      Format(lisProjectSuccessfullyBuilt, ['"', Project1.Title, '"']),'');
+        // change tool status
-  end;
+        ToolStatus:=itBuilder;
 
-  // check sources
+        TheOutputFilter.OnOutputString:=@MessagesView.AddMsg;
-  DoCheckFilesOnDisk;
+        TheOutputFilter.OnReadLine:=@MessagesView.AddProgress;
+
+        // compile
+        Result:=TheCompiler.Compile(Project1,BuildAll,DefaultFilename);
+        if Result<>mrOk then
+          DoJumpToCompilerMessage(-1,true);
+      finally
+        ToolStatus:=itNone;
+      end;
+    end;
+
+    // execute compilation tool 'After'
+    if Result=mrOk then begin
+      Result:=DoExecuteCompilationTool(Project1.CompilerOptions.ExecuteAfter,
+                                       Project1.ProjectDirectory,
+                                       'Executing command after');
+    end;
+
+    // add success message
+    if Result=mrOk then begin
+      MessagesView.AddMsg(
+        Format(lisProjectSuccessfullyBuilt, ['"', Project1.Title, '"']),'');
+    end;
+
+    // check sources
+    DoCheckFilesOnDisk;
+  finally
+    MessagesView.EndBlock;
+  end;
 end;
 
 function TMainIDE.DoAbortBuild: TModalResult;
@@ -5763,6 +5768,7 @@ begin
     Result:=mrCancel;
     exit;
   end;
+  MessagesView.BeginBlock;
   try
     // first compile all lazarus components (LCL, SynEdit, CodeTools, ...)
     SourceNotebook.ClearErrorLines;
@@ -5805,6 +5811,7 @@ begin
     if Result<>mrOk then exit;
   finally
     DoCheckFilesOnDisk;
+    MessagesView.EndBlock;
   end;
 end;
 
@@ -9406,6 +9413,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.636  2003/08/15 16:10:12  mattias
+  implemented message blocks
+
   Revision 1.635  2003/08/14 12:25:21  mattias
   changed default visible of forms to false
 

ide/msgview.pp

@@ -41,7 +41,6 @@ uses
   IDEOptionDefs, EnvironmentOpts, LazarusIDEStrConsts;
 
 type
-
   TMessagesView = class(TForm)
     MessageView : TListBox;
     procedure MessageViewDblClicked(Sender: TObject);
@@ -54,6 +53,7 @@ type
     Function GetMessage: String;
     procedure SetLastLineIsProgress(const AValue: boolean);
   protected
+    fBlockCount: integer;
     Function GetSelectedLineIndex: Integer;
     procedure SetSelectedLineIndex(const AValue: Integer);
     procedure SetMsgDirectory(Index: integer; const CurDir: string);
@@ -69,6 +69,8 @@ type
     function MsgCount: integer;
     procedure Clear;
     procedure GetMessageAt(Index: integer; var Msg, MsgDirectory: string);
+    procedure BeginBlock;
+    procedure EndBlock;
   public
     property LastLineIsProgress: boolean read FLastLineIsProgress
                                          write SetLastLineIsProgress;
@@ -160,10 +162,9 @@ begin
     while (LastSeparator>=0) and (Items[LastSeparator]<>SeparatorLine) do
       dec(LastSeparator);
     if LastSeparator>=0 then begin
-      while (Items.Count>LastSeparator) do begin
+      while (Items.Count>LastSeparator) do
         Items.Delete(Items.Count-1);
-        FLastLineIsProgress:=false;
+      FLastLineIsProgress:=false;
-      end;
     end;
   end;
 end;
@@ -184,6 +185,7 @@ end;
 ------------------------------------------------------------------------------}
 Procedure  TMessagesView.Clear;
 Begin
+  if fBlockCount>0 then exit;
   MessageView.Clear;
   FLastLineIsProgress:=false;
   if not Assigned(MessagesView.MessageView.OnClick) then
@@ -208,6 +210,17 @@ begin
   MsgDirectory:=FDirectories[Index];
 end;
 
+procedure TMessagesView.BeginBlock;
+begin
+  inc(fBlockCount);
+end;
+
+procedure TMessagesView.EndBlock;
+begin
+  if fBlockCount<=0 then RaiseException('TMessagesView.EndBlock Internal Error');
+  dec(fBlockCount);
+end;
+
 {------------------------------------------------------------------------------
   TMessagesView.GetMessage
 ------------------------------------------------------------------------------}