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

started a posteriori message filtering

Browse Source 
git-svn-id: trunk@4960 -
This commit is contained in:
mattias 2003-12-26 12:36:31 +00:00
parent a3038d1607
commit b4695c1828
4 changed files with 216 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/codetools/pascalreadertool.pas
View File

@ -313,7 +313,8 @@ begin
ProcNode:=ProcNode.Parent;
if ProcNode=nil then exit;
end;
if not ProcNode.Desc in [ctnProcedure,ctnProcedureType] then exit;
if (ProcNode.Desc<>ctnProcedure) and (ProcNode.Desc<>ctnProcedureType) then
exit;
IsProcType:=(ProcNode.Desc=ctnProcedureType);
if (phpAddClassname in Attr) then begin
GrandPaNode:=ProcNode.Parent;

24
ide/main.pp
View File

@ -368,11 +368,9 @@ type
// MessagesView events
procedure MessagesViewSelectionChanged(sender : TObject);
procedure MessageViewDblClick(Sender : TObject);
//SearchResultsView events
procedure SearchResultsViewSelectionChanged(sender : TObject);
procedure SearchResultsViewDblClick(Sender : TObject);
// External Tools events
procedure OnExtToolNeedsOutputFilter(var OutputFilter: TOutputFilter;
@ -2874,19 +2872,6 @@ begin
ShowAboutForm;
end;
//------------------------------------------------------------------------------
Procedure TMainIDE.MessageViewDblClick(Sender : TObject);
Begin
end;
Procedure TMainIDE.SearchResultsViewDblClick(Sender : TObject);
Begin
end;
//==============================================================================
function TMainIDE.CreateNewCodeBuffer(NewUnitType:TNewUnitType;
@ -7445,14 +7430,14 @@ var MaxMessages: integer;
NewFilename: String;
begin
Result:=false;
MaxMessages:=MessagesView.MessageView.Items.Count;
MaxMessages:=MessagesView.VisibleItemCount;
if Index>=MaxMessages then exit;
if (Index<0) then begin
// search relevant message (first error, first fatal)
Index:=0;
while (Index<MaxMessages) do begin
if (TheOutputFilter.GetSourcePosition(
MessagesView.MessageView.Items[Index],
MessagesView.VisibleItems[Index].Msg,
Filename,CaretXY,MsgType)) then
begin
if MsgType in [etError,etFatal,etPanic] then break;
@ -7462,7 +7447,7 @@ begin
if Index>=MaxMessages then exit;
MessagesView.SelectedMessageIndex:=Index;
end;
MessagesView.GetMessageAt(Index,CurMsg,CurDir);
MessagesView.GetVisibleMessageAt(Index,CurMsg,CurDir);
if TheOutputFilter.GetSourcePosition(CurMsg,Filename,CaretXY,MsgType)
then begin
if not FilenameIsAbsolute(Filename) then begin
@ -10250,6 +10235,9 @@ end.
{ =============================================================================
$Log$
Revision 1.687 2003/12/26 12:36:31 mattias
started a posteriori message filtering
Revision 1.686 2003/12/25 14:17:06 mattias
fixed many range check warnings

256
ide/msgview.pp
View File

@ -41,36 +41,67 @@ uses
IDEOptionDefs, EnvironmentOpts, LazarusIDEStrConsts;
type
{ TMessageLine }
TMessageLine = class
private
FDirectory: string;
FMsg: string;
FPosition: integer;
FVisiblePosition: integer;
procedure SetDirectory(const AValue: string);
procedure SetMsg(const AValue: string);
public
constructor Create;
property Msg: string read FMsg write SetMsg;
property Directory: string read FDirectory write SetDirectory;
property Position: integer read FPosition;
property VisiblePosition: integer read FVisiblePosition;
end;
{ TMessagesView }
TOnFilterLine = procedure(MsgLine: TMessageLine; var Show: boolean) of object;
TMessagesView = class(TForm)
MessageView : TListBox;
MessageView: TListBox;
procedure MessageViewDblClicked(Sender: TObject);
Procedure MessageViewClicked(sender : TObject);
private
FDirectories: TStringList;
FItems: TList; // list of TMessageLine
FVisibleItems: TList; // list of TMessageLine (visible Items of FItems)
FLastLineIsProgress: boolean;
FOnSelectionChanged: TNotifyEvent;
function GetDirectory: string;
function GetItems(Index: integer): TMessageLine;
Function GetMessage: String;
function GetVisibleItems(Index: integer): TMessageLine;
procedure SetLastLineIsProgress(const AValue: boolean);
protected
fBlockCount: integer;
Function GetSelectedLineIndex: Integer;
procedure SetSelectedLineIndex(const AValue: Integer);
procedure SetMsgDirectory(Index: integer; const CurDir: string);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure Add(const Msg, CurDir: String; ProgressLine: boolean);
procedure DeleteLine(Index: integer);
procedure Add(const Msg, CurDir: String; ProgressLine,
VisibleLine: boolean);
procedure AddMsg(const Msg, CurDir: String);
procedure AddProgress(const Msg, CurDir: String);
procedure AddSeparator;
procedure ClearTillLastSeparator;
procedure ShowTopMessage;
function MsgCount: integer;
procedure Clear;
procedure GetMessageAt(Index: integer; var Msg, MsgDirectory: string);
procedure GetVisibleMessageAt(Index: integer; var Msg, MsgDirectory: string);
procedure BeginBlock;
procedure EndBlock;
procedure ClearItems;
function ItemCount: integer;
function VisibleItemCount: integer;
function MsgCount: integer;
procedure FilterLines(Filter: TOnFilterLine);
public
property LastLineIsProgress: boolean read FLastLineIsProgress
write SetLastLineIsProgress;
@ -80,6 +111,8 @@ type
write SetSelectedLineIndex;
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged
write FOnSelectionChanged;
property Items[Index: integer]: TMessageLine read GetItems;
property VisibleItems[Index: integer]: TMessageLine read GetVisibleItems;
end;
var
@ -100,6 +133,10 @@ constructor TMessagesView.Create(TheOwner : TComponent);
var ALayout: TIDEWindowLayout;
Begin
inherited Create(TheOwner);
Name := NonModalIDEWindowNames[nmiwMessagesViewName];
FItems:=TList.Create;
FVisibleItems:=TList.Create;
if LazarusResources.Find(ClassName)=nil then begin
Caption:=lisMenuViewMessages;
MessageView := TListBox.Create(Self);
@ -108,7 +145,6 @@ Begin
Align:= alClient;
end;
end;
Name := NonModalIDEWindowNames[nmiwMessagesViewName];
ALayout:=EnvironmentOptions.IDEWindowLayoutList.
ItemByEnum(nmiwMessagesViewName);
ALayout.Form:=TForm(Self);
@ -117,56 +153,97 @@ end;
destructor TMessagesView.Destroy;
begin
FreeAndNil(FDirectories);
ClearItems;
FreeThenNil(FItems);
FreeThenNil(FVisibleItems);
inherited Destroy;
end;
procedure TMessagesView.DeleteLine(Index: integer);
var
Line: TMessageLine;
VisibleIndex: Integer;
i: Integer;
begin
Line:=Items[Index];
FItems.Delete(Line.Position);
VisibleIndex:=Line.VisiblePosition;
if VisibleIndex>=0 then begin
MessageView.Items.Delete(VisibleIndex);
FVisibleItems.Delete(VisibleIndex);
end;
Line.Free;
// adjust Positions
for i:=Index to FItems.Count-1 do begin
Line:=Items[i];
dec(Line.FPosition);
if Line.VisiblePosition>VisibleIndex then
dec(Line.FVisiblePosition);
end;
end;
{------------------------------------------------------------------------------
TMessagesView.Add
------------------------------------------------------------------------------}
Procedure TMessagesView.Add(const Msg, CurDir: String; ProgressLine: boolean);
Procedure TMessagesView.Add(const Msg, CurDir: String; ProgressLine,
VisibleLine: boolean);
var
NewMsg: TMessageLine;
i: Integer;
Begin
if FLastLineIsProgress then begin
MessageView.Items[MessageView.Items.Count-1]:=Msg;
end else begin
MessageView.Items.Add(Msg);
NewMsg:=TMessageLine.Create;
NewMsg.Msg:=Msg;
NewMsg.Directory:=CurDir;
NewMsg.FPosition:=FItems.Count;
FItems.Add(NewMsg);
if VisibleLine then begin
if FLastLineIsProgress then begin
// replace old progress line
i:=FVisibleItems.Count-1;
VisibleItems[i].FVisiblePosition:=-1;
FVisibleItems.Delete(i);
MessageView.Items[i]:=Msg;
end else begin
// add line
MessageView.Items.Add(Msg);
end;
NewMsg.FVisiblePosition:=FVisibleItems.Count;
FVisibleItems.Add(NewMsg);
FLastLineIsProgress:=ProgressLine;
MessageView.TopIndex:=MessageView.Items.Count-1;
end;
FLastLineIsProgress:=ProgressLine;
i:=MessageView.Items.Count-1;
SetMsgDirectory(i,CurDir);
MessageView.TopIndex:=MessageView.Items.Count-1;
end;
procedure TMessagesView.AddMsg(const Msg, CurDir: String);
begin
Add(Msg,CurDir,false);
Add(Msg,CurDir,false,true);
end;
procedure TMessagesView.AddProgress(const Msg, CurDir: String);
begin
Add(Msg,CurDir,true);
Add(Msg,CurDir,true,true);
end;
Procedure TMessagesView.AddSeparator;
begin
Add(SeparatorLine,'',false);
Add(SeparatorLine,'',false,true);
end;
procedure TMessagesView.ClearTillLastSeparator;
var LastSeparator: integer;
begin
with MessageView do begin
LastSeparator:=Items.Count-1;
while (LastSeparator>=0) and (Items[LastSeparator]<>SeparatorLine) do
dec(LastSeparator);
if LastSeparator>=0 then begin
while (Items.Count>LastSeparator) do
Items.Delete(Items.Count-1);
FLastLineIsProgress:=false;
end;
BeginBlock;
LastSeparator:=VisibleItemCount-1;
while (LastSeparator>=0)
and (VisibleItems[LastSeparator].Msg<>SeparatorLine) do
dec(LastSeparator);
if LastSeparator>=0 then begin
while (VisibleItemCount>LastSeparator) do
DeleteLine(ItemCount-1);
FLastLineIsProgress:=false;
end;
EndBlock;
end;
procedure TMessagesView.ShowTopMessage;
@ -177,37 +254,73 @@ end;
function TMessagesView.MsgCount: integer;
begin
Result:=MessageView.Items.Count;
Result:=VisibleItemCount;
end;
procedure TMessagesView.FilterLines(Filter: TOnFilterLine);
// recalculate visible lines
var
i: Integer;
Line: TMessageLine;
ShowLine: Boolean;
begin
// remove temporary lines
ClearTillLastSeparator;
FLastLineIsProgress:=false;
// recalculate visible lines
FVisibleItems.Clear;
for i:=0 to FItems.Count-1 do begin
Line:=Items[i];
ShowLine:=true;
Filter(Line,ShowLine);
if ShowLine then begin
Line.FVisiblePosition:=FVisibleItems.Count;
FVisibleItems.Add(Line);
end else
Line.FVisiblePosition:=-1;
end;
// rebuild MessageView.Items
MessageView.Items.BeginUpdate;
for i:=0 to FVisibleItems.Count-1 do begin
Line:=VisibleItems[i];
if MessageView.Items.Count>i then
MessageView.Items[i]:=Line.Msg
else
MessageView.Items.Add(Line.Msg);
end;
while MessageView.Items.Count>FVisibleItems.Count do
MessageView.Items.Delete(MessageView.Items.Count-1);
MessageView.Items.EndUpdate;
end;
{------------------------------------------------------------------------------
TMessagesView.Clear
------------------------------------------------------------------------------}
Procedure TMessagesView.Clear;
Procedure TMessagesView.Clear;
Begin
if fBlockCount>0 then exit;
MessageView.Clear;
FLastLineIsProgress:=false;
if not Assigned(MessagesView.MessageView.OnClick) then
ClearItems;
if not Assigned(MessageView.OnClick) then
MessageView.OnClick := @MessageViewClicked;
if not Assigned(MessagesView.MessageView.OnDblClick) then
if not Assigned(MessageView.OnDblClick) then
MessageView.OnDblClick :=@MessageViewDblClicked;
end;
procedure TMessagesView.GetMessageAt(Index: integer;
procedure TMessagesView.GetVisibleMessageAt(Index: integer;
var Msg, MsgDirectory: string);
begin
// consistency checks
if (Index<0) then
RaiseException('TMessagesView.GetMessageAt');
RaiseException('TMessagesView.GetVisibleMessageAt');
if MessageView.Items.Count<=Index then
RaiseException('TMessagesView.GetMessageAt');
if (FDirectories=nil) then
RaiseException('TMessagesView.GetMessageAt');
if (FDirectories.Count<=Index) then
RaiseException('TMessagesView.GetMessageAt');
Msg:=MessageView.Items[Index];
MsgDirectory:=FDirectories[Index];
RaiseException('TMessagesView.GetVisibleMessageAt');
if (FItems=nil) then
RaiseException('TMessagesView.GetVisibleMessageAt');
if (FItems.Count<=Index) then
RaiseException('TMessagesView.GetVisibleMessageAt');
Msg:=Items[Index].Msg;
MsgDirectory:=Items[Index].Directory;
end;
procedure TMessagesView.BeginBlock;
@ -222,6 +335,26 @@ begin
dec(fBlockCount);
end;
procedure TMessagesView.ClearItems;
var
i: Integer;
begin
for i:=0 to FItems.Count-1 do TObject(FItems[i]).Free;
FItems.Clear;
FVisibleItems.Clear;
MessageView.Clear;
end;
function TMessagesView.ItemCount: integer;
begin
Result:=FItems.Count;
end;
function TMessagesView.VisibleItemCount: integer;
begin
Result:=FVisibleItems.Count;
end;
{------------------------------------------------------------------------------
TMessagesView.GetMessage
------------------------------------------------------------------------------}
@ -232,6 +365,11 @@ Begin
Result := MessageView.Items.Strings[GetSelectedLineIndex];
end;
function TMessagesView.GetVisibleItems(Index: integer): TMessageLine;
begin
Result:=TMessageLine(FVisibleItems[Index]);
end;
procedure TMessagesView.MessageViewDblClicked(Sender: TObject);
begin
if not EnvironmentOptions.MsgViewDblClickJumps then exit;
@ -256,8 +394,13 @@ var
begin
Result := '';
i:=GetSelectedLineIndex;
if (FDirectories<>nil) and (FDirectories.Count>i) then
Result := FDirectories[i];
if (FVisibleItems.Count>i) then
Result := VisibleItems[i].Msg;
end;
function TMessagesView.GetItems(Index: integer): TMessageLine;
begin
Result:=TMessageLine(FItems[Index]);
end;
Function TMessagesView.GetSelectedLineIndex : Integer;
@ -291,17 +434,28 @@ begin
MessageView.TopIndex:=MessageView.ItemIndex;
end;
procedure TMessagesView.SetMsgDirectory(Index: integer; const CurDir: string);
{ TMessageLine }
procedure TMessageLine.SetDirectory(const AValue: string);
begin
if FDirectories=nil then FDirectories:=TStringList.Create;
while FDirectories.Count<=Index do FDirectories.Add('');
FDirectories[Index]:=CurDir;
if FDirectory=AValue then exit;
FDirectory:=AValue;
end;
procedure TMessageLine.SetMsg(const AValue: string);
begin
if FMsg=AValue then exit;
FMsg:=AValue;
end;
constructor TMessageLine.Create;
begin
FPosition:=-1;
FVisiblePosition:=-1;
end;
initialization
MessagesView:=nil;
{ $I msgview.lrs}
end.

5
lcl/dynamicarray.pas
View File

@ -41,7 +41,7 @@ Type
TArray=Class
Private
FCols: TList;
Fondestroyitem: TOnNotifyItem;
FOnDestroyItem: TOnNotifyItem;
FOnNewItem: TonNotifyItem;
Function Getarr(Col, Row: Integer): Pointer;
Procedure Setarr(Col, Row: Integer; Const Avalue: Pointer);
@ -137,7 +137,7 @@ begin
If (P<>nil)And Assigned(OnDestroyItem) Then OnDestroyItem(Self, Col, Row, P);
end;
Procedure Tarray.Setlength(Cols, Rows: Integer);
Procedure Tarray.SetLength(Cols, Rows: Integer);
Var
i,j: integer;
L: TList;
@ -222,5 +222,6 @@ begin
TList(FCols[i]).Exchange(Index, WithIndex);
End;
end;
end.