paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 03:59:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: fixed clearing messages when appending codetools error

Browse Source 
git-svn-id: trunk@10756 -
This commit is contained in:
mattias 2007-03-16 11:14:24 +00:00
parent d50417ed40
commit b2a7c1c696
2 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
ide/msgview.pp
View File

@ -98,7 +98,7 @@ type
procedure SetLastLineIsProgress(const AValue: boolean);
procedure DoSelectionChange;
protected
fBlockCount: integer;
fBlockLevel: integer;
FLastSelectedIndex: integer;
function GetSelectedLineIndex: integer;
procedure SetSelectedLineIndex(const AValue: integer);
@ -120,7 +120,7 @@ type
procedure ShowTopMessage;
procedure Clear; override;
procedure GetVisibleMessageAt(Index: integer; var Msg, MsgDirectory: string);
procedure BeginBlock; override;
procedure BeginBlock(ClearOldBlocks: Boolean = true); override;
procedure EndBlock; override;
procedure ClearItems;
function LinesCount: integer; override;
@ -510,10 +510,11 @@ procedure TMessagesView.ClearTillLastSeparator;
var
LastSeparator: integer;
begin
BeginBlock;
BeginBlock(false);
try
LastSeparator := VisibleItemCount - 1;
while (LastSeparator >= 0) and (VisibleItems[LastSeparator].Msg <> SeparatorLine) do
while (LastSeparator >= 0)
and (VisibleItems[LastSeparator].Msg <> SeparatorLine) do
Dec(LastSeparator);
if LastSeparator >= 0 then
begin
@ -676,7 +677,7 @@ end;
procedure TMessagesView.Clear;
begin
if Self=nil then exit;
if fBlockCount>0 then begin
if fBlockLevel>0 then begin
// keep the old blocks
exit;
end;
@ -703,19 +704,20 @@ begin
MsgDirectory := VisibleItems[Index].Directory;
end;
procedure TMessagesView.BeginBlock;
procedure TMessagesView.BeginBlock(ClearOldBlocks: Boolean = true);
begin
Clear;
//if fBlockCount=0 then DumpStack;
Inc(fBlockCount);
if ClearOldBlocks then
Clear;
//if fBlockLevel=0 then DumpStack;
Inc(fBlockLevel);
end;
procedure TMessagesView.EndBlock;
begin
if fBlockCount <= 0 then
if fBlockLevel <= 0 then
RaiseException('TMessagesView.EndBlock Internal Error');
Dec(fBlockCount);
//if fBlockCount=0 then DumpStack;
Dec(fBlockLevel);
//if fBlockLevel=0 then DumpStack;
end;
procedure TMessagesView.ClearItems;

2
ideintf/idemsgintf.pas
View File

@ -183,7 +183,7 @@ type
procedure AddMsg(const Msg, CurDir: string; OriginalIndex: integer); virtual; abstract;
property Lines[Index: integer]: TIDEMessageLine read GetLines; default;
function LinesCount: integer; virtual; abstract;
procedure BeginBlock; virtual; abstract;
procedure BeginBlock(ClearOldBlocks: Boolean = true); virtual; abstract;
procedure EndBlock; virtual; abstract;
end;