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

Merged revision(s) 65311-65312 #6857527965-#6857527965, 65318 #769e991253 from trunk:

Browse Source 
IDE: Prepare to support multi-line selection in Messages window. Use IntegerList instead of one integer index.
........
IDE: Actually implement multi-line selection in Messages window. Copy to clipboard is supported.
........
IDE: Allow selecting the header line in Messages window's multi-line selection.
........

git-svn-id: branches/fixes_2_2@65321 -
This commit is contained in:
maxim 2021-06-28 23:18:26 +00:00
parent 9f42f210cb
commit f751d23e48
2 changed files with 237 additions and 202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

350
ide/etmessageframe.pas
View File

@ -32,17 +32,18 @@ unit etMessageFrame;
interface interface
uses uses
Math, strutils, Classes, SysUtils, Laz_AVL_Tree, Math, StrUtils, Classes, SysUtils, Laz_AVL_Tree,
// LCL // LCL
Forms, Buttons, ExtCtrls, Controls, LMessages, LCLType, LCLIntf, Forms, Buttons, ExtCtrls, Controls, LMessages, LCLType, LCLIntf,
Graphics, Themes, ImgList, Menus, Clipbrd, Dialogs, StdCtrls, Graphics, Themes, ImgList, Menus, Clipbrd, Dialogs, StdCtrls,
// LazUtils // LazUtils
GraphType, UTF8Process, FileProcs, LazFileCache, LazFileUtils, LazUTF8, GraphType, UTF8Process, LazUTF8, LazFileCache, LazFileUtils, IntegerList, LazLoggerBase,
// SynEdit // SynEdit
SynEdit, SynEditMarks, SynEdit, SynEditMarks,
// BuildIntf
ProjectIntf, PackageIntf, CompOptsIntf, IDEExternToolIntf,
// IDEIntf // IDEIntf
IDEExternToolIntf, IDEImagesIntf, MenuIntf, PackageIntf, IDEImagesIntf, MenuIntf, IDECommands, IDEDialogs, LazIDEIntf,
IDECommands, IDEDialogs, ProjectIntf, CompOptsIntf, LazIDEIntf,
// IDE // IDE
LazarusIDEStrConsts, EnvironmentOpts, HelpFPCMessages, etSrcEditMarks, LazarusIDEStrConsts, EnvironmentOpts, HelpFPCMessages, etSrcEditMarks,
MsgWnd_Options, etQuickFixes, ExtTools, IDEOptionDefs, CompilerOptions; MsgWnd_Options, etQuickFixes, ExtTools, IDEOptionDefs, CompilerOptions;
@ -161,7 +162,7 @@ type
FScrollTop: integer; FScrollTop: integer;
fScrollTopMax: integer; fScrollTopMax: integer;
FSearchText: string; FSearchText: string;
FSelectedLine: integer; FSelectedLines: TIntegerList;
FSelectedView: TLMsgWndView; FSelectedView: TLMsgWndView;
FSourceMarks: TETMarks; FSourceMarks: TETMarks;
FTextColor: TColor; FTextColor: TColor;
@ -202,7 +203,6 @@ type
procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL; procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
function GetMaxSelectedLine: integer;
procedure ImageListChange(Sender: TObject); procedure ImageListChange(Sender: TObject);
procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean); procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
procedure OnFilterChanged(Sender: TObject); procedure OnFilterChanged(Sender: TObject);
@ -222,9 +222,8 @@ type
procedure UpdateScrollBar(InvalidateScrollMax: boolean); procedure UpdateScrollBar(InvalidateScrollMax: boolean);
procedure CreateWnd; override; procedure CreateWnd; override;
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; //procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure DoOnShowHint(HintInfo: PHintInfo); override; procedure DoOnShowHint(HintInfo: PHintInfo); override;
procedure DoAllViewsStopped; procedure DoAllViewsStopped;
@ -255,13 +254,12 @@ type
function Filters: TLMsgViewFilters; inline; function Filters: TLMsgViewFilters; inline;
// select, search // select, search
// Note: At the moment only single single selected is implemented procedure AddToSelection(View: TLMsgWndView; LineNumber: integer);
function HasSelection: boolean; procedure ExtendSelection(View: TLMsgWndView; LineNumber: integer);
function IsLineSelected(View: TLMsgWndView; LineNumber: integer): boolean;
procedure Select(View: TLMsgWndView; LineNumber: integer; DoScroll, FullyVisible: boolean);
function SearchNext(StartView: TLMsgWndView; StartLine: integer; function SearchNext(StartView: TLMsgWndView; StartLine: integer;
SkipStart, Downwards: boolean; SkipStart, Downwards: boolean;
out View: TLMsgWndView; out LineNumber: integer): boolean; out View: TLMsgWndView; out LineNumber: integer): boolean;
procedure Select(View: TLMsgWndView; LineNumber: integer; DoScroll, FullyVisible: boolean);
procedure Select(Msg: TMessageLine; DoScroll: boolean); procedure Select(Msg: TMessageLine; DoScroll: boolean);
function SelectNextOccurrence(Downwards: boolean): boolean; function SelectNextOccurrence(Downwards: boolean): boolean;
function SelectNextShown(Offset: integer): boolean; function SelectNextShown(Offset: integer): boolean;
@ -307,7 +305,8 @@ type
Property OnOptionsChanged: TNotifyEvent read FOnOptionsChanged write FOnOptionsChanged; Property OnOptionsChanged: TNotifyEvent read FOnOptionsChanged write FOnOptionsChanged;
property Options: TMsgCtrlOptions read FOptions write SetOptions default MCDefaultOptions; property Options: TMsgCtrlOptions read FOptions write SetOptions default MCDefaultOptions;
property SearchText: string read FSearchText write SetSearchText; property SearchText: string read FSearchText write SetSearchText;
property SelectedLine: integer read GetSelectedLine write SetSelectedLine; // -1=header line, can be on progress line (=View.Count) // First initially selected line, -1=header line, can be on progress line (=View.Count)
property SelectedLine1: integer read GetSelectedLine write SetSelectedLine;
property SelectedView: TLMsgWndView read FSelectedView write SetSelectedView; property SelectedView: TLMsgWndView read FSelectedView write SetSelectedView;
property ShowHint default true; property ShowHint default true;
property SourceMarks: TETMarks read FSourceMarks write SetSourceMarks; property SourceMarks: TETMarks read FSourceMarks write SetSourceMarks;
@ -371,8 +370,7 @@ type
function GetMsgPattern(SubTool: string; MsgId: integer; function GetMsgPattern(SubTool: string; MsgId: integer;
WithUrgency: boolean; MaxLen: integer): string; WithUrgency: boolean; MaxLen: integer): string;
protected protected
procedure Notification(AComponent: TComponent; Operation: TOperation); procedure Notification(AComponent: TComponent; Operation: TOperation); override;
override;
public public
MessagesCtrl: TMessagesCtrl; MessagesCtrl: TMessagesCtrl;
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
@ -1129,8 +1127,7 @@ begin
Invalidate; Invalidate;
// auto scroll // auto scroll
if (SelectedView<>nil) if SelectedView<>nil then
and (SelectedLine<SelectedView.Lines.Count) then
exit; // user has selected a non progress line -> do not auto scroll exit; // user has selected a non progress line -> do not auto scroll
for i:=0 to ViewCount-1 do for i:=0 to ViewCount-1 do
@ -1253,12 +1250,20 @@ begin
end; end;
procedure TMessagesCtrl.SetSelectedLine(AValue: integer); procedure TMessagesCtrl.SetSelectedLine(AValue: integer);
// Select the given line, clear possibly existing selections.
var
LineCnt: Integer;
begin begin
if AValue<-1 then AValue:=-1; Assert(AValue>=-1, 'TMessagesCtrl.SetSelectedLine: AValue < -1.');
if FSelectedLine=AValue then Exit; Assert(Assigned(SelectedView), 'TMessagesCtrl.SetSelectedLine: View = Nil.');
AValue:=Min(AValue,GetMaxSelectedLine); LineCnt:=SelectedView.GetShownLineCount(false,true)-1;
if FSelectedLine=AValue then Exit; Assert(AValue<=LineCnt, 'TMessagesCtrl.SetSelectedLine: Value '+IntToStr(AValue)
FSelectedLine:=AValue; + ' > line count ' + IntToStr(LineCnt));
//AValue:=Min(AValue, SelectedView.GetShownLineCount(false,true)-1);
if (FSelectedLines.Count>0) and (FSelectedLines[0]=AValue) then
Exit;
FSelectedLines.Count:=1; // One line.
FSelectedLines[0]:=AValue;
Invalidate; Invalidate;
end; end;
@ -1383,17 +1388,6 @@ begin
inherited; inherited;
end; end;
function TMessagesCtrl.GetMaxSelectedLine: integer;
var
View: TLMsgWndView;
begin
View:=SelectedView;
if View<>nil then
Result:=View.GetShownLineCount(false,true)-1
else
Result:=-1;
end;
procedure TMessagesCtrl.ImageListChange(Sender: TObject); procedure TMessagesCtrl.ImageListChange(Sender: TObject);
begin begin
Invalidate; Invalidate;
@ -1452,18 +1446,12 @@ begin
end; end;
function TMessagesCtrl.GetSelectedLine: integer; function TMessagesCtrl.GetSelectedLine: integer;
var // Return the first selected line number.
View: TLMsgWndView;
begin begin
View:=SelectedView; if FSelectedLines.Count>0 then
if View<>nil then begin Result:=FSelectedLines[0]
Result:=FSelectedLine; else
if Result>=0 then Result:=-1; // No selection.
Result:=Min(FSelectedLine,GetMaxSelectedLine);
end else begin
Result:=-1;
end;
FSelectedLine:=Result;
end; end;
procedure TMessagesCtrl.CreateSourceMarks(View: TLMsgWndView; procedure TMessagesCtrl.CreateSourceMarks(View: TLMsgWndView;
@ -1623,7 +1611,7 @@ begin
Canvas.Line(NodeRect.Left,NodeRect.Top,NodeRect.Right,NodeRect.Top); Canvas.Line(NodeRect.Left,NodeRect.Top,NodeRect.Right,NodeRect.Top);
Canvas.Pen.Style:=psSolid; Canvas.Pen.Style:=psSolid;
DrawText(NodeRect,GetHeaderText(View), DrawText(NodeRect,GetHeaderText(View),
(fSelectedView=View) and (FSelectedLine=-1),TextColor); (fSelectedView=View) and (FSelectedLines.IndexOf(-1)>=0),TextColor);
Canvas.Brush.Color:=BackgroundColor; Canvas.Brush.Color:=BackgroundColor;
end; end;
inc(y,ItemHeight); inc(y,ItemHeight);
@ -1639,7 +1627,7 @@ begin
while (j<View.Lines.Count) and (y<ClientHeight) do begin while (j<View.Lines.Count) and (y<ClientHeight) do begin
Line:=View.Lines[j]; Line:=View.Lines[j];
NodeRect:=Rect(Indent,y,ClientWidth,y+ItemHeight); NodeRect:=Rect(Indent,y,ClientWidth,y+ItemHeight);
IsSelected:=(fSelectedView=View) and (FSelectedLine=j); IsSelected:=(fSelectedView=View) and (FSelectedLines.IndexOf(j)>=0);
if not IsSelected then begin if not IsSelected then begin
if (y>-ItemHeight) and (y<=0) then if (y>-ItemHeight) and (y<=0) then
FirstLineIsNotSelectedMessage:=true FirstLineIsNotSelectedMessage:=true
@ -1691,7 +1679,7 @@ begin
if col=clDefault then if col=clDefault then
col:=TextColor; col:=TextColor;
DrawText(NodeRect,View.ProgressLine.Msg, DrawText(NodeRect,View.ProgressLine.Msg,
(fSelectedView=View) and (FSelectedLine=View.Lines.Count),col); (fSelectedView=View) and (FSelectedLines.IndexOf(View.Lines.Count)>=0),col);
end; end;
inc(y,ItemHeight); inc(y,ItemHeight);
end; end;
@ -1741,15 +1729,15 @@ begin
inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
UpdateScrollBar(true); UpdateScrollBar(true);
end; end;
{
procedure TMessagesCtrl.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TMessagesCtrl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin begin
inherited MouseMove(Shift, X, Y); inherited MouseMove(Shift, X, Y);
//Application.HideHint; //Application.HideHint;
end; end;
}
procedure TMessagesCtrl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, procedure TMessagesCtrl.MouseDown(Button: TMouseButton; Shift: TShiftState;
Y: Integer); X, Y: Integer);
var var
View: TLMsgWndView; View: TLMsgWndView;
LineNumber: integer; LineNumber: integer;
@ -1758,19 +1746,23 @@ begin
SetFocus; SetFocus;
inherited MouseDown(Button, Shift, X, Y); inherited MouseDown(Button, Shift, X, Y);
if GetLineAt(Y,View,LineNumber) then begin if GetLineAt(Y,View,LineNumber) then begin
if Button=mbLeft then begin if not (Button in [mbLeft,mbRight]) then Exit;
if ssCtrl in Shift then
AddToSelection(View,LineNumber)
else if ssShift in Shift then
ExtendSelection(View,LineNumber)
else begin
if (Button=mbLeft)
or (View<>SelectedView) or (FSelectedLines.IndexOf(LineNumber)=-1) then
begin
Select(View,LineNumber,true,true); Select(View,LineNumber,true,true);
StoreSelectedAsSearchStart; StoreSelectedAsSearchStart;
end;
if (Button=mbRight) then Exit;
if ((ssDouble in Shift) and (not (mcoSingleClickOpensFile in FOptions))) if ((ssDouble in Shift) and (not (mcoSingleClickOpensFile in FOptions)))
or ((mcoSingleClickOpensFile in FOptions) and ([ssDouble,ssTriple,ssQuad]*Shift=[])) or ((mcoSingleClickOpensFile in FOptions) and ([ssDouble,ssTriple,ssQuad]*Shift=[]))
then then
OpenSelection; OpenSelection;
end else if Button=mbRight then begin
if not IsLineSelected(View,LineNumber) then begin
Select(View,LineNumber,true,true);
StoreSelectedAsSearchStart;
end;
end; end;
end; end;
end; end;
@ -2007,18 +1999,70 @@ begin
until not Next; until not Next;
end; end;
procedure TMessagesCtrl.AddToSelection(View: TLMsgWndView; LineNumber: integer);
var
i: Integer;
begin
BeginUpdate;
SelectedView:=View;
if FSelectedLines.Count=0 then // No existing selection.
i:=-1
else
i:=FSelectedLines.IndexOf(LineNumber);
if i=-1 then
FSelectedLines.Add(LineNumber)
else
FSelectedLines.Delete(i); // Was already selected -> toggle.
Invalidate;
EndUpdate;
end;
procedure TMessagesCtrl.ExtendSelection(View: TLMsgWndView; LineNumber: integer);
var
i: Integer;
Empty: Boolean;
begin
BeginUpdate;
SelectedView:=View;
Empty:=FSelectedLines.Count=0;
FSelectedLines.Count:=1; // Delete possible earlier selections except first one.
if Empty then
FSelectedLines[0]:=LineNumber // No earlier selection.
else if LineNumber<FSelectedLines[0] then
for i:=LineNumber to FSelectedLines[0]-1 do
FSelectedLines.Add(i)
else if LineNumber>FSelectedLines[0] then
for i:=FSelectedLines[0]+1 to LineNumber do
FSelectedLines.Add(i);
// if LineNumber=FSelectedLines[0] then do nothing.
Invalidate;
EndUpdate;
end;
procedure TMessagesCtrl.Select(View: TLMsgWndView; LineNumber: integer;
DoScroll, FullyVisible: boolean);
begin
BeginUpdate;
SelectedView:=View;
SelectedLine1:=LineNumber;
if DoScroll then
ScrollToLine(SelectedView,LineNumber,FullyVisible);
EndUpdate;
end;
procedure TMessagesCtrl.Select(Msg: TMessageLine; DoScroll: boolean); procedure TMessagesCtrl.Select(Msg: TMessageLine; DoScroll: boolean);
begin begin
BeginUpdate; BeginUpdate;
if (Msg=nil) or (Msg.Lines=nil) or (not (Msg.Lines.Owner is TLMsgWndView)) if (Msg=nil) or (Msg.Lines=nil) or not (Msg.Lines.Owner is TLMsgWndView) then
then begin begin
SelectedView:=nil; SelectedView:=nil;
SelectedLine:=-1; FSelectedLines.Clear;
Invalidate;
end else begin end else begin
SelectedView:=TLMsgWndView(Msg.Lines.Owner); SelectedView:=TLMsgWndView(Msg.Lines.Owner);
SelectedLine:=Msg.Index; SelectedLine1:=Msg.Index;
if DoScroll then if DoScroll then
ScrollToLine(SelectedView,SelectedLine,true); ScrollToLine(SelectedView,Msg.Index,true);
end; end;
EndUpdate; EndUpdate;
end; end;
@ -2029,7 +2073,7 @@ var
LineNumber: integer; LineNumber: integer;
begin begin
StoreSelectedAsSearchStart; StoreSelectedAsSearchStart;
Result:=SearchNext(SelectedView,SelectedLine,true,Downwards,View,LineNumber); Result:=SearchNext(SelectedView,SelectedLine1,true,Downwards,View,LineNumber);
if not Result then exit; if not Result then exit;
Select(View,LineNumber,true,true); Select(View,LineNumber,true,true);
end; end;
@ -2047,7 +2091,8 @@ begin
{$ENDIF} {$ENDIF}
while Offset<>0 do begin while Offset<>0 do begin
{$IFDEF VerboseMsgCtrlSelectNextShown} {$IFDEF VerboseMsgCtrlSelectNextShown}
debugln(['TMessagesCtrl.SelectNextShown LOOP Offset=',Offset,' ViewIndex=',IndexOfView(SelectedView),' Line=',SelectedLine]); debugln(['TMessagesCtrl.SelectNextShown LOOP Offset=',Offset,
' ViewIndex=',IndexOfView(SelectedView),' Line=',SelectedLine]);
{$ENDIF} {$ENDIF}
if SelectedView=nil then begin if SelectedView=nil then begin
if Offset>0 then begin if Offset>0 then begin
@ -2060,10 +2105,11 @@ begin
Result:=true; Result:=true;
end else begin end else begin
View:=SelectedView; View:=SelectedView;
Line:=SelectedLine; Line:=SelectedLine1;
if Offset>0 then begin if Offset>0 then begin
{$IFDEF VerboseMsgCtrlSelectNextShown} {$IFDEF VerboseMsgCtrlSelectNextShown}
debugln(['TMessagesCtrl.SelectNextShown NEXT View.GetShownLineCount(false,true)=',View.GetShownLineCount(false,true),' ',' ViewIndex=',IndexOfView(View),' Line=',Line]); debugln(['TMessagesCtrl.SelectNextShown NEXT View.GetShownLineCount(false,true)=',
View.GetShownLineCount(false,true),' ViewIndex=',IndexOfView(View),' Line=',Line]);
{$ENDIF} {$ENDIF}
inc(Line,Offset); inc(Line,Offset);
if Line<View.GetShownLineCount(false,true) then if Line<View.GetShownLineCount(false,true) then
@ -2151,6 +2197,7 @@ begin
end; end;
function TMessagesCtrl.GetSelectedMsg: TMessageLine; function TMessagesCtrl.GetSelectedMsg: TMessageLine;
// Return the first selected message.
var var
View: TLMsgWndView; View: TLMsgWndView;
Line: Integer; Line: Integer;
@ -2158,13 +2205,15 @@ begin
Result:=nil; Result:=nil;
View:=SelectedView; View:=SelectedView;
if View=nil then exit; if View=nil then exit;
Line:=SelectedLine; Line:=SelectedLine1;
if (Line<0) then exit; if (Line<0) then exit;
if Line<View.Lines.Count then if Line<View.Lines.Count then
Result:=View.Lines[Line] Result:=View.Lines[Line]
else if (Line=View.Lines.Count) and (View.ProgressLine.Msg<>'') then else if View.ProgressLine.Msg<>'' then begin
Assert((Line=View.Lines.Count), 'TMessagesCtrl.GetSelectedMsg: Line is too big.');
Result:=View.ProgressLine; Result:=View.ProgressLine;
end; end;
end;
function TMessagesCtrl.SearchNextUrgent(StartView: TLMsgWndView; function TMessagesCtrl.SearchNextUrgent(StartView: TLMsgWndView;
StartLine: integer; SkipStart, Downwards: boolean; StartLine: integer; SkipStart, Downwards: boolean;
@ -2277,23 +2326,21 @@ begin
Result:=true; Result:=true;
end; end;
function TMessagesCtrl.SelectNextUrgentMessage( function TMessagesCtrl.SelectNextUrgentMessage(aMinUrgency: TMessageLineUrgency;
aMinUrgency: TMessageLineUrgency; WithSrcPos: boolean; Downwards: boolean WithSrcPos: boolean; Downwards: boolean): boolean;
): boolean;
var var
View: TLMsgWndView; View: TLMsgWndView;
LineNumber: integer; LineNumber: integer;
begin begin
Result:=false; Result:=false;
if not SearchNextUrgent(SelectedView,SelectedLine,true,Downwards, if not SearchNextUrgent(SelectedView,SelectedLine1,true,Downwards,
aMinUrgency,WithSrcPos,View,LineNumber) aMinUrgency,WithSrcPos,View,LineNumber)
then exit; then exit;
Select(View,LineNumber,true,true); Select(View,LineNumber,true,true);
Result:=true; Result:=true;
end; end;
function TMessagesCtrl.IsLineVisible(View: TLMsgWndView; LineNumber: integer function TMessagesCtrl.IsLineVisible(View: TLMsgWndView; LineNumber: integer): boolean;
): boolean;
var var
y: Integer; y: Integer;
begin begin
@ -2341,13 +2388,9 @@ begin
Result+=Line.Msg; Result+=Line.Msg;
end; end;
function TMessagesCtrl.GetHeaderText(View: TLMsgWndView): string;
function GetStats(Lines: TMessageLines): string; function GetStats(Lines: TMessageLines): string;
var var
ErrCnt: Integer; ErrCnt, WarnCnt, HintCnt: Integer;
WarnCnt: Integer;
HintCnt: Integer;
c: TMessageLineUrgency; c: TMessageLineUrgency;
begin begin
Result:=''; Result:='';
@ -2371,6 +2414,7 @@ function TMessagesCtrl.GetHeaderText(View: TLMsgWndView): string;
Result+=Format(lisHints, [IntToStr(HintCnt)]); Result+=Format(lisHints, [IntToStr(HintCnt)]);
end; end;
function TMessagesCtrl.GetHeaderText(View: TLMsgWndView): string;
begin begin
Result:=View.Caption; Result:=View.Caption;
if Result='' then if Result='' then
@ -2407,17 +2451,6 @@ begin
Result:=nil; Result:=nil;
end; end;
procedure TMessagesCtrl.Select(View: TLMsgWndView; LineNumber: integer;
DoScroll, FullyVisible: boolean);
begin
BeginUpdate;
SelectedView:=View;
SelectedLine:=LineNumber;
if DoScroll then
ScrollToLine(SelectedView,SelectedLine,FullyVisible);
EndUpdate;
end;
procedure TMessagesCtrl.ScrollToLine(View: TLMsgWndView; LineNumber: integer; procedure TMessagesCtrl.ScrollToLine(View: TLMsgWndView; LineNumber: integer;
FullyVisible: boolean); FullyVisible: boolean);
var var
@ -2478,13 +2511,13 @@ begin
Filters.OnChanged:=@OnFilterChanged; Filters.OnChanged:=@OnFilterChanged;
FActiveFilter:=Filters[0]; FActiveFilter:=Filters[0];
FViews:=TFPList.Create; FViews:=TFPList.Create;
FSelectedLines:=TIntegerList.Create;
FUpdateTimer:=TTimer.Create(Self); FUpdateTimer:=TTimer.Create(Self);
FUpdateTimer.Name:='MsgUpdateTimer'; FUpdateTimer.Name:='MsgUpdateTimer';
FUpdateTimer.Interval:=200; FUpdateTimer.Interval:=200;
FUpdateTimer.OnTimer:=@MsgUpdateTimerTimer; FUpdateTimer.OnTimer:=@MsgUpdateTimerTimer;
FItemHeight:=20; FItemHeight:=20;
FSelectedView:=nil; FSelectedView:=nil;
FSelectedLine:=-1;
BorderWidth:=0; BorderWidth:=0;
fBackgroundColor:=MsgWndDefBackgroundColor; fBackgroundColor:=MsgWndDefBackgroundColor;
FHeaderBackground[lmvtsRunning]:=MsgWndDefHeaderBackgroundRunning; FHeaderBackground[lmvtsRunning]:=MsgWndDefHeaderBackgroundRunning;
@ -2509,6 +2542,7 @@ begin
Images:=nil; Images:=nil;
ClearViews(false); ClearViews(false);
FreeAndNil(FSelectedLines);
FreeAndNil(FViews); FreeAndNil(FViews);
FreeAndNil(FUpdateTimer); FreeAndNil(FUpdateTimer);
FreeAndNil(FImageChangeLink); FreeAndNil(FImageChangeLink);
@ -2623,8 +2657,8 @@ begin
fSomeViewsRunning:=true; fSomeViewsRunning:=true;
end; end;
function TMessagesCtrl.GetLineAt(Y: integer; out View: TLMsgWndView; out function TMessagesCtrl.GetLineAt(Y: integer; out View: TLMsgWndView;
Line: integer): boolean; out Line: integer): boolean;
var var
i: Integer; i: Integer;
begin begin
@ -2666,7 +2700,7 @@ procedure TMessagesCtrl.StoreSelectedAsSearchStart;
begin begin
fLastLoSearchText:=UTF8LowerCase(FSearchText); fLastLoSearchText:=UTF8LowerCase(FSearchText);
fLastSearchStartView:=FSelectedView; fLastSearchStartView:=FSelectedView;
fLastSearchStartLine:=FSelectedLine; fLastSearchStartLine:=SelectedLine1;
end; end;
function TMessagesCtrl.OpenSelection: boolean; function TMessagesCtrl.OpenSelection: boolean;
@ -2711,22 +2745,6 @@ begin
Invalidate; Invalidate;
end; end;
function TMessagesCtrl.HasSelection: boolean;
var
View: TLMsgWndView;
begin
Result:=false;
View:=SelectedView;
if View=nil then exit;
Result:=SelectedLine<View.GetShownLineCount(false,true);
end;
function TMessagesCtrl.IsLineSelected(View: TLMsgWndView; LineNumber: integer
): boolean;
begin
Result:=(View=SelectedView) and (LineNumber=SelectedLine);
end;
{ TMessagesFrame } { TMessagesFrame }
procedure TMessagesFrame.MsgCtrlPopupMenuPopup(Sender: TObject); procedure TMessagesFrame.MsgCtrlPopupMenuPopup(Sender: TObject);
@ -2849,20 +2867,13 @@ procedure TMessagesFrame.MsgCtrlPopupMenuPopup(Sender: TObject);
end; end;
var var
HasText: Boolean;
View: TLMsgWndView; View: TLMsgWndView;
HasFilename: Boolean;
LineNumber: Integer;
Line: TMessageLine;
i: Integer;
HasViewContent: Boolean;
Running: Boolean;
MsgType: String;
CanFilterMsgType: Boolean;
MinUrgency: TMessageLineUrgency; MinUrgency: TMessageLineUrgency;
ToolData: TIDEExternalToolData; ToolData: TIDEExternalToolData;
ToolOptionsCaption: String; Line: TMessageLine;
VisibleCnt: Integer; i, LineNumber, VisibleCnt: Integer;
HasText, HasFilename, HasViewContent, Running, CanFilterMsgType: Boolean;
MsgType, ToolOptionsCaption: String;
begin begin
MessagesMenuRoot.MenuItem:=MsgCtrlPopupMenu.Items; MessagesMenuRoot.MenuItem:=MsgCtrlPopupMenu.Items;
//MessagesMenuRoot.BeginUpdate; //MessagesMenuRoot.BeginUpdate;
@ -2889,11 +2900,17 @@ begin
// check selection // check selection
View:=MessagesCtrl.SelectedView; View:=MessagesCtrl.SelectedView;
if View<>nil then begin if View<>nil then begin
LineNumber:=MessagesCtrl.SelectedLine; for i:=0 to MessagesCtrl.FSelectedLines.Count-1 do begin
if (LineNumber>=0) and (LineNumber<View.Lines.Count) then begin LineNumber:=MessagesCtrl.FSelectedLines[i];
Line:=View.Lines[LineNumber]; if LineNumber=-1 then Continue; // header
HasFilename:=Line.Filename<>''; if LineNumber=View.Lines.Count then
HasText:=Line.Msg<>''; Line:=View.ProgressLine // progress line
else
Line:=View.Lines[LineNumber]; // normal messages
if Line.Filename<>'' then
HasFilename:=True;
if Line.Msg<>'' then
HasText:=True;
if (Line.SubTool<>'') and (Line.MsgID<>0) then begin if (Line.SubTool<>'') and (Line.MsgID<>0) then begin
MsgType:=GetMsgPattern(Line.SubTool,Line.MsgID,true,40); MsgType:=GetMsgPattern(Line.SubTool,Line.MsgID,true,40);
CanFilterMsgType:=ord(Line.Urgency)<ord(mluError); CanFilterMsgType:=ord(Line.Urgency)<ord(mluError);
@ -3140,11 +3157,10 @@ end;
function TMessagesFrame.AllMessagesAsString(const OnlyShown: boolean): String; function TMessagesFrame.AllMessagesAsString(const OnlyShown: boolean): String;
var var
s: String;
Tool: TAbstractExternalTool; Tool: TAbstractExternalTool;
View: TLMsgWndView; View: TLMsgWndView;
j: Integer; s: String;
i: Integer; i, j: Integer;
begin begin
s:=''; s:='';
for i:=0 to MessagesCtrl.ViewCount-1 do begin for i:=0 to MessagesCtrl.ViewCount-1 do begin
@ -3178,11 +3194,21 @@ begin
Result:=MessagesCtrl.GetLastViewWithContent; Result:=MessagesCtrl.GetLastViewWithContent;
end; end;
procedure TMessagesFrame.CopyFilenameMenuItemClick(Sender: TObject);
begin
CopyMsgToClipboard(true);
end;
procedure TMessagesFrame.CopyMsgMenuItemClick(Sender: TObject); procedure TMessagesFrame.CopyMsgMenuItemClick(Sender: TObject);
begin begin
CopyMsgToClipboard(false); CopyMsgToClipboard(false);
end; end;
procedure TMessagesFrame.CopyAllMenuItemClick(Sender: TObject);
begin
CopyAllClicked(false);
end;
procedure TMessagesFrame.CopyShownMenuItemClick(Sender: TObject); procedure TMessagesFrame.CopyShownMenuItemClick(Sender: TObject);
begin begin
CopyAllClicked(true); CopyAllClicked(true);
@ -3268,16 +3294,6 @@ begin
LazarusIDE.DoOpenIDEOptions(TMsgWndOptionsFrame); LazarusIDE.DoOpenIDEOptions(TMsgWndOptionsFrame);
end; end;
procedure TMessagesFrame.CopyFilenameMenuItemClick(Sender: TObject);
begin
CopyMsgToClipboard(true);
end;
procedure TMessagesFrame.CopyAllMenuItemClick(Sender: TObject);
begin
CopyAllClicked(false);
end;
procedure TMessagesFrame.AboutToolMenuItemClick(Sender: TObject); procedure TMessagesFrame.AboutToolMenuItemClick(Sender: TObject);
var var
View: TLMsgWndView; View: TLMsgWndView;
@ -3475,33 +3491,45 @@ end;
procedure TMessagesFrame.CopyMsgToClipboard(OnlyFilename: boolean); procedure TMessagesFrame.CopyMsgToClipboard(OnlyFilename: boolean);
var var
View: TLMsgWndView; View: TLMsgWndView;
LineNumber: Integer;
Txt: String;
Line: TMessageLine; Line: TMessageLine;
OrderedSelection: TIntegerList;
i, LineNumber: Integer;
Txt: String;
begin begin
Txt:='';
View:=MessagesCtrl.SelectedView; View:=MessagesCtrl.SelectedView;
if View=nil then exit; if View=nil then exit;
LineNumber:=MessagesCtrl.SelectedLine; OrderedSelection:=TIntegerList.Create;
if LineNumber<0 then begin try
// header // The initially selected line is first in the list. The list is not sorted.
if OnlyFilename then exit; // Here we need the line numbers sorted.
Txt:=MessagesCtrl.GetHeaderText(View); OrderedSelection.Assign(MessagesCtrl.FSelectedLines);
end else if LineNumber<View.Lines.Count then begin OrderedSelection.Sort;
// normal messages for i:=0 to OrderedSelection.Count-1 do begin
Line:=View.Lines[LineNumber]; LineNumber:=OrderedSelection[i];
Assert(LineNumber<=View.Lines.Count, 'TMessagesFrame.CopyMsgToClipboard: LineNumber is too big.');
if LineNumber=-1 then begin
if OnlyFilename then if OnlyFilename then
Txt:=Line.Filename Txt:=rsResourceFileName
else else
Txt:=MessagesCtrl.GetLineText(Line); Txt:=MessagesCtrl.GetHeaderText(View); // header
end else if LineNumber=View.Lines.Count then begin end
// progress line else begin
Line:=View.ProgressLine; if LineNumber=View.Lines.Count then
Line:=View.ProgressLine // progress line
else
Line:=View.Lines[LineNumber]; // normal messages
if OnlyFilename then if OnlyFilename then
Txt:=Line.Filename Txt+=Line.Filename
else else
Txt:=MessagesCtrl.GetLineText(Line); Txt+=MessagesCtrl.GetLineText(Line);
end else end;
exit; if i<OrderedSelection.Count-1 then
Txt+=LineEnding;
end;
finally
OrderedSelection.Free;
end;
Clipboard.AsText:=Txt; Clipboard.AsText:=Txt;
end; end;
@ -3597,7 +3625,7 @@ begin
// search // search
SearchPanel.Visible:=false; // by default the search is hidden SearchPanel.Visible:=false; // by default the search is hidden
HideSearchSpeedButton.Hint:=lisHideSearch; HideSearchSpeedButton.Hint:=lisHideSearch;
IDEImages.AssignImage(HideSearchSpeedButton, 'debugger_power_grey'); IDEImages.AssignImage(HideSearchSpeedButton, 'debugger_power');
SearchNextSpeedButton.Hint:=lisUDSearchNextOccurrenceOfThisPhrase; SearchNextSpeedButton.Hint:=lisUDSearchNextOccurrenceOfThisPhrase;
IDEImages.AssignImage(SearchNextSpeedButton, 'callstack_bottom'); IDEImages.AssignImage(SearchNextSpeedButton, 'callstack_bottom');
SearchPrevSpeedButton.Hint:=lisUDSearchPreviousOccurrenceOfThisPhrase; SearchPrevSpeedButton.Hint:=lisUDSearchPreviousOccurrenceOfThisPhrase;

15
ide/etmessageswnd.pas
View File

@ -30,10 +30,17 @@ unit etMessagesWnd;
interface interface
uses uses
Classes, SysUtils, FileUtil, IDEMsgIntf, IDEImagesIntf, IDEOptionDefs, Classes, SysUtils,
IDEExternToolIntf, LazIDEIntf, SynEditMarks, // LCL
Forms, Controls, Graphics, Dialogs, LCLProc, etMessageFrame, Forms, Controls, Graphics, Dialogs,
etQuickFixes, LazarusIDEStrConsts; // BuildIntf
IDEExternToolIntf,
// IdeIntf
IDEMsgIntf, LazIDEIntf,
// SynEdit
SynEditMarks,
// IDE
IDEOptionDefs, etMessageFrame, etQuickFixes, LazarusIDEStrConsts;
type type