From b49deecff882d43e73b72dfe9621c110a53623ae Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 15 Aug 2003 16:10:13 +0000 Subject: [PATCH] implemented message blocks git-svn-id: trunk@4485 - --- ide/buildlazdialog.pas | 2 + ide/lazarusidestrconsts.pas | 1 + ide/main.pp | 88 +++++++++++++++++++++---------------- ide/msgview.pp | 21 +++++++-- 4 files changed, 69 insertions(+), 43 deletions(-) diff --git a/ide/buildlazdialog.pas b/ide/buildlazdialog.pas index 667663a3c6..7c62f9a16d 100644 --- a/ide/buildlazdialog.pas +++ b/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 diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 53c74d36b2..907e5c3f32 100644 --- a/ide/lazarusidestrconsts.pas +++ b/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'; diff --git a/ide/main.pp b/ide/main.pp index 284a30095e..886665ac86 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -5563,49 +5563,54 @@ begin // show messages MessagesView.Clear; - DoArrangeSourceEditorAndMessageView(false); + MessagesView.BeginBlock; + try + DoArrangeSourceEditorAndMessageView(false); - // warn ambigious files - DoWarnAmbigiousFiles; + // warn ambigious files + DoWarnAmbigiousFiles; - // execute compilation tool 'Before' - 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, + // execute compilation tool 'Before' + Result:=DoExecuteCompilationTool(Project1.CompilerOptions.ExecuteBefore, Project1.ProjectDirectory, - 'Executing command after'); - end; - - // add success message - if Result=mrOk then begin - MessagesView.AddMsg( - Format(lisProjectSuccessfullyBuilt, ['"', Project1.Title, '"']),''); - end; + 'Executing command before'); - // check sources - DoCheckFilesOnDisk; + 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'); + 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 diff --git a/ide/msgview.pp b/ide/msgview.pp index 25fe3522f4..145a616caf 100644 --- a/ide/msgview.pp +++ b/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; - end; + FLastLineIsProgress:=false; 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 ------------------------------------------------------------------------------}