paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 21:59:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Message window now uses BeginUpdate/EndUpdate

Browse Source 
git-svn-id: trunk@15330 -
This commit is contained in:
mattias 2008-06-06 04:39:30 +00:00
parent 0a9c928d37
commit 9106150d26
3 changed files with 41 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ide/mainbase.pas
View File

@ -201,6 +201,8 @@ begin
TheOutputFilter.OnAddFilteredLine:=@MessagesView.AddMsg;
TheOutputFilter.OnReadLine:=@MessagesView.AddProgress;
TheOutputFilter.OnEndReading:=@MessagesView.CollectLineParts;
TheOutputFilter.OnBeginUpdate:=@MessagesView.BeginUpdateNotification;
TheOutputFilter.OnEndUpdate:=@MessagesView.EndUpdateNotification;
end;
procedure TMainIDEBase.SetToolStatus(const AValue: TIDEToolStatus);

12
ide/msgview.pp
View File

@ -114,6 +114,8 @@ type
ControlDocker: TLazControlDocker;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdateNotification(Sender: TObject);
procedure EndUpdateNotification(Sender: TObject);
procedure DeleteLine(Index: integer);
procedure Add(const Msg, CurDir: string;
ProgressLine, VisibleLine: boolean; OriginalIndex: integer);
@ -334,6 +336,16 @@ begin
MessagesView:=nil;
end;
procedure TMessagesView.BeginUpdateNotification(Sender: TObject);
begin
if MessageTreeView<>nil then MessageTreeView.BeginUpdate;
end;
procedure TMessagesView.EndUpdateNotification(Sender: TObject);
begin
if MessageTreeView<>nil then MessageTreeView.EndUpdate;
end;
procedure TMessagesView.DeleteLine(Index: integer);
var
Line: TLazMessageLine;

28
ide/outputfilter.pas
View File

@ -109,7 +109,9 @@ type
FBufferingOutputLock: integer;
fCurrentDirectory: string;
fFilteredOutput: TFilteredOutputLines;
FOnBeginUpdate: TNotifyEvent;
FOnEndReading: TOFOnEndReading;
FOnEndUpdate: TNotifyEvent;
fOnReadLine: TOnOutputString;
fOutput: TIDEMessageLineList;
fLastErrorType: TErrorType;
@ -163,6 +165,8 @@ type
procedure WriteOutput(Flush: boolean);
procedure BeginBufferingOutput;
procedure EndBufferingOutput;
procedure BeginUpdate;
procedure EndUpdate;
public
property CurrentDirectory: string read fCurrentDirectory
write fCurrentDirectory;
@ -182,6 +186,8 @@ type
property CurrentMessageParts: TStrings read GetCurrentMessageParts;
property AsyncProcessTerminated: boolean read FAsyncProcessTerminated;
property OnEndReading: TOFOnEndReading read FOnEndReading write FOnEndReading;
property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate write FOnBeginUpdate;
property OnEndUpdate: TNotifyEvent read FOnEndUpdate write FOnEndUpdate;
property Caller: TObject read FCaller;
property ScanLine: TOFScanLine read FScanLine;
property Tool: TIDEExternalToolOptions read FTool;
@ -252,6 +258,7 @@ var
OutputLine, Buf : String;
TheAsyncProcess: TAsyncProcess;
LastProcessMessages: TDateTime;
EndUpdateNeeded: Boolean;
begin
Result:=true;
Clear;
@ -270,6 +277,7 @@ begin
ErrorExists:=true;
Aborted:=false;
TheAsyncProcess:=nil;
EndUpdateNeeded:=false;
try
BeginBufferingOutput;
@ -292,7 +300,13 @@ begin
if (Application<>nil) and (abs(LastProcessMessages-Now)>((1/86400)/3))
then begin
LastProcessMessages:=Now;
if EndUpdateNeeded then begin
EndUpdateNeeded:=false;
EndUpdate;
end;
Application.ProcessMessages;
BeginUpdate;
EndUpdateNeeded:=true;
end;
if StopExecute then begin
fProcess.Terminate(0);
@ -358,6 +372,8 @@ begin
if ErrorExists and (ofoExceptionOnError in Options) then
raise EOutputFilterError.Create('there was an error');
finally
if EndUpdateNeeded then
EndUpdate;
EndBufferingOutput;
fProcess:=nil;
FreeAndNil(FAsyncOutput);
@ -1339,7 +1355,7 @@ var
LineEnd: string = LineEnding;
CurLine: String;
const
HalfASecond =0.5/(24*60*60); // 0.5 divided by the number of seconds per day
HalfASecond = 0.5/(24*60*60); // 0.5 divided by the number of seconds per day
begin
CurTime:=Now;
if ((CurTime-fLastOutputTime)>HalfASecond)
@ -1383,6 +1399,16 @@ begin
WriteOutput(true);
end;
procedure TOutputFilter.BeginUpdate;
begin
if Assigned(OnBeginUpdate) then OnBeginUpdate(Self);
end;
procedure TOutputFilter.EndUpdate;
begin
if Assigned(OnEndUpdate) then OnEndUpdate(Self);
end;
{ TFilteredOutputLines }
function TFilteredOutputLines.GetOriginalIndices(Index: integer): integer;