1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     Frame for messages - output lines for (compiler) messages.
25 }
26 unit etMessageFrame;
27 
28 {$mode objfpc}{$H+}
29 
30 {$I ide.inc}
31 
32 interface
33 
34 uses
35   Math, StrUtils, Classes, SysUtils, Laz_AVL_Tree,
36   // LCL
37   Forms, Buttons, ExtCtrls, Controls, LMessages, LCLType, LCLIntf,
38   Graphics, Themes, ImgList, Menus, Clipbrd, Dialogs, StdCtrls,
39   // LazUtils
40   GraphType, UTF8Process, LazUTF8, LazFileCache, LazFileUtils, IntegerList, LazLoggerBase,
41   // SynEdit
42   SynEdit, SynEditMarks,
43   // BuildIntf
44   ProjectIntf, PackageIntf, CompOptsIntf, IDEExternToolIntf,
45   // IDEIntf
46   IDEImagesIntf, MenuIntf, IDECommands, IDEDialogs, LazIDEIntf,
47   // IDE
48   LazarusIDEStrConsts, EnvironmentOpts, HelpFPCMessages, etSrcEditMarks,
49   MsgWnd_Options, etQuickFixes, ExtTools, IDEOptionDefs, CompilerOptions;
50 
51 const
52   CustomViewCaption = '------------------------------';
53 
54 type
55   TMessagesCtrl = class;
56 
57   { TLMsgWndView }
58 
59   TLMsgWndView = class(TLazExtToolView)
60   private
61     FAsyncQueued: boolean;
62     FControl: TMessagesCtrl;
63     FFilter: TLMsgViewFilter;
64     fPaintBottom: integer; // only valid if FPaintStamp=Control.FPaintStamp
65     FPaintStamp: int64;
66     fPaintTop: integer; // only valid if FPaintStamp=Control.FPaintStamp
67     FPendingChanges: TETMultiSrcChanges;
68     procedure SetFilter(AValue: TLMsgViewFilter);
69     procedure OnMarksFixed(ListOfTMessageLine: TFPList); // (main thread) called after mlfFixed was added to these messages
70     procedure CallOnChangedInMainThread({%H-}Data: PtrInt); // (main thread)
71   protected
72     procedure SetToolState(AValue: TLMVToolState); override;
73     procedure FetchAllPending; override; // (main thread)
74     procedure ToolExited; override; // (main thread)
75     procedure QueueAsyncOnChanged; override; // (worker thread)
76     procedure RemoveAsyncOnChanged; override; // (worker thread)
77   public
78     constructor Create(AOwner: TComponent); override;
79     destructor Destroy; override;
LineFitsnull80     function LineFits(Line: TMessageLine): boolean; override; // (worker thread)
81     property Control: TMessagesCtrl read FControl;
HasContentnull82     function HasContent: boolean;
GetShownLineCountnull83     function GetShownLineCount(WithHeader, WithProgressLine: boolean): integer;
84     procedure RebuildLines; // (main thread)
ApplySrcChangesnull85     function ApplySrcChanges(Changes: TETSingleSrcChanges): boolean; // true if something changed
86   public
87     // requires Enter/LeaveCriticalSection, write only via main thread
88     property Filter: TLMsgViewFilter read FFilter write SetFilter;
89     property PendingChanges: TETMultiSrcChanges read FPendingChanges;// src changes for messages adding to view
90   end;
91 
92   { TMsgCtrlUrgencyStyle }
93 
94   TMsgCtrlUrgencyStyle = class
95   private
96     FColor: TColor;
97     FControl: TMessagesCtrl;
98     FImageIndex: integer;
99     FTranslated: string;
100     FUrgency: TMessageLineUrgency;
101     procedure SetColor(AValue: TColor);
102     procedure SetImageIndex(AValue: integer);
103     procedure SetTranslated(AValue: string);
104     procedure Changed;
105   public
106     constructor Create(AControl: TMessagesCtrl; TheUrgency: TMessageLineUrgency);
Equalsnull107     function Equals(Obj: TObject): boolean; override;
108     procedure Assign(Src: TMsgCtrlUrgencyStyle);
109     procedure SetValues(TheTranslated: string; TheImageIndex: integer = -1; TheColor: TColor = clDefault);
110     property Control: TMessagesCtrl read FControl;
111     property Urgency: TMessageLineUrgency read FUrgency;
112     property Translated: string read FTranslated write SetTranslated;
113     property ImageIndex: integer read FImageIndex write SetImageIndex default -1;
114     property Color: TColor read FColor write SetColor default clDefault;
115   end;
116 
117 type
endernull118   TOnOpenMessageLine = function(Sender: TObject; Msg: TMessageLine): boolean of object;
119 
120   TMsgCtrlState = (
121     mcsFocused
122     );
123   TMsgCtrlStates = set of TMsgCtrlState;
124 
125   TMsgCtrlOption = (
126     mcoSingleClickOpensFile, // otherwise double click
127     mcoShowStats, // show numbers of errors, warnings and hints in view header line
128     mcoShowTranslated, // show translation (e.g. messages from German message file)
129     mcoShowMessageID,  // show message ID
130     mcoShowMsgIcons,
131     mcoAutoOpenFirstError, // when all views stopped, open first error
132     mcoSrcEditPopupSelect, // when user right clicks on gutter mark,
133                            // scroll and select message of the quickfixes
134     mcoWndStayOnTop,       // use fsStayOnTop
135     mcoAlwaysDrawFocused   // draw selected item as focused, even if the window is not
136     );
137   TMsgCtrlOptions = set of TMsgCtrlOption;
138 const
139   MCDefaultOptions = [mcoShowStats,mcoShowTranslated,
140                       mcoAutoOpenFirstError,mcoShowMsgIcons,
141                       mcoSrcEditPopupSelect];
142 
143 type
144 
145   { TMessagesCtrl }
146 
147   TMessagesCtrl = class(TCustomControl)
148   private
149     FActiveFilter: TLMsgViewFilter;
150     FBackgroundColor: TColor;
151     FFilenameStyle: TMsgWndFileNameStyle;
152     FHeaderBackground: array[TLMVToolState] of TColor;
153     FIdleConnected: boolean;
154     FImageChangeLink: TChangeLink;
155     FImages: TCustomImageList;
156     FItemHeight: integer;
157     FOnAllViewsStopped: TNotifyEvent;
158     FOnOpenMessage: TOnOpenMessageLine;
159     FOnOptionsChanged: TNotifyEvent;
160     FOptions: TMsgCtrlOptions;
161     FScrollLeft: integer;
162     FScrollTop: integer;
163     fScrollTopMax: integer;
164     FSearchText: string;
165     FSelectedLines: TIntegerList;
166     FSelectedView: TLMsgWndView;
167     FSourceMarks: TETMarks;
168     FTextColor: TColor;
169     fUpdateLock: integer;
170     FUpdateTimer: TTimer;
171     fSomeViewsRunning: boolean;
172     fUrgencyStyles: array[TMessageLineUrgency] of TMsgCtrlUrgencyStyle;
173     FAutoHeaderBackground: TColor;
174     procedure CreateSourceMark(MsgLine: TMessageLine; aSynEdit: TSynEdit);
175     procedure CreateSourceMarks(View: TLMsgWndView; StartLineNumber: Integer);
GetActiveFilternull176     function GetActiveFilter: TLMsgViewFilter; inline;
GetHeaderBackgroundnull177     function GetHeaderBackground(aToolState: TLMVToolState): TColor;
GetSelectedLinenull178     function GetSelectedLine: integer;
GetUrgencyStylesnull179     function GetUrgencyStyles(Urgency: TMessageLineUrgency): TMsgCtrlUrgencyStyle;
GetViewsnull180     function GetViews(Index: integer): TLMsgWndView;
181     procedure OnViewChanged(Sender: TObject); // (main thread)
182     procedure MsgUpdateTimerTimer(Sender: TObject);
183     procedure SetActiveFilter(AValue: TLMsgViewFilter); inline;
184     procedure SetBackgroundColor(AValue: TColor);
185     procedure SetFilenameStyle(AValue: TMsgWndFileNameStyle);
186     procedure SetHeaderBackground(aToolState: TLMVToolState; AValue: TColor);
187     procedure SetIdleConnected(AValue: boolean);
188     procedure SetImages(AValue: TCustomImageList);
189     procedure SetItemHeight(AValue: integer);
190     procedure SetOptions(NewOptions: TMsgCtrlOptions);
191     procedure SetScrollLeft(AValue: integer);
192     procedure SetScrollTop(AValue: integer);
193     procedure SetSearchText(AValue: string);
194     procedure SetSelectedLine(AValue: integer);
195     procedure SetSelectedView(AValue: TLMsgWndView);
196     procedure SetSourceMarks(AValue: TETMarks);
197     procedure SetTextColor(AValue: TColor);
198     procedure SetUrgencyStyles(Urgency: TMessageLineUrgency;
199       AValue: TMsgCtrlUrgencyStyle);
200     procedure SetAutoHeaderBackground(AValue: TColor);
201     procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL;
202     procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL;
203     procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
204     procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
205     procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
206     procedure ImageListChange(Sender: TObject);
207     procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
208     procedure OnFilterChanged(Sender: TObject);
GetPageScrollnull209     function GetPageScroll: integer;
210   protected
211     FViews: TFPList;// list of TMessagesViewMap
212     FStates: TMsgCtrlStates;
213     FPaintStamp: int64;
214     fLastSearchStartView: TLMsgWndView;
215     fLastSearchStartLine: integer;
216     fLastLoSearchText: string; // lower case search text
217     procedure FetchNewMessages;
FetchNewMessagesnull218     function FetchNewMessages(View: TLMsgWndView): boolean; // true if new lines
219     procedure Notification(AComponent: TComponent; Operation: TOperation);
220       override;
221     procedure Paint; override;
222     procedure UpdateScrollBar(InvalidateScrollMax: boolean);
223     procedure CreateWnd; override;
224     procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
225     //procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
226     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
227     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
228     procedure DoOnShowHint(HintInfo: PHintInfo); override;
229     procedure DoAllViewsStopped;
230   public
231     constructor Create(AOwner: TComponent); override;
232     destructor Destroy; override;
233     procedure BeginUpdate;
234     procedure EndUpdate;
235     procedure EraseBackground({%H-}DC: HDC); override;
236     procedure ApplyEnvironmentOptions;
UrgencyToStrnull237     function UrgencyToStr(Urgency: TMessageLineUrgency): string;
238 
239     // views
ViewCountnull240     function ViewCount: integer; inline;
241     property Views[Index: integer]: TLMsgWndView read GetViews;
IndexOfViewnull242     function IndexOfView(View: TLMsgWndView): integer;
243     procedure ClearViews(OnlyFinished: boolean); // deletes/frees all views
244     procedure RemoveView(View: TLMsgWndView); // remove without free
GetViewnull245     function GetView(aCaption: string; CreateIfNotExist: boolean): TLMsgWndView;
GetLineAtnull246     function GetLineAt(Y: integer; out View: TLMsgWndView; out Line: integer): boolean;
GetLineTextnull247     function GetLineText(Line: TMessageLine): string;
GetHeaderTextnull248     function GetHeaderText(View: TLMsgWndView): string;
FindUnfinishedViewnull249     function FindUnfinishedView: TLMsgWndView; // running or waiting for run
GetLastViewWithContentnull250     function GetLastViewWithContent: TLMsgWndView;
251 
252     // filter
253     property ActiveFilter: TLMsgViewFilter read GetActiveFilter write SetActiveFilter;
Filtersnull254     function Filters: TLMsgViewFilters; inline;
255 
256     // select, search
257     procedure AddToSelection(View: TLMsgWndView; LineNumber: integer);
258     procedure ExtendSelection(View: TLMsgWndView; LineNumber: integer);
SearchNextnull259     function SearchNext(StartView: TLMsgWndView; StartLine: integer;
260       SkipStart, Downwards: boolean;
261       out View: TLMsgWndView; out LineNumber: integer): boolean;
262     procedure Select(View: TLMsgWndView; LineNumber: integer; DoScroll, FullyVisible: boolean);
263     procedure Select(Msg: TMessageLine; DoScroll: boolean);
SelectNextOccurrencenull264     function SelectNextOccurrence(Downwards: boolean): boolean;
SelectNextShownnull265     function SelectNextShown(Offset: integer): boolean;
SelectLastnull266     function SelectLast(DoScroll, FullyVisible: boolean): boolean;
SelectFirstnull267     function SelectFirst(DoScroll, FullyVisible: boolean): boolean;
GetSelectedMsgnull268     function GetSelectedMsg: TMessageLine;
SearchNextUrgentnull269     function SearchNextUrgent(StartView: TLMsgWndView; StartLine: integer;
270       SkipStart, Downwards: boolean;
271       aMinUrgency: TMessageLineUrgency; WithSrcPos: boolean;
272       out View: TLMsgWndView; out LineNumber: integer): boolean;
SelectFirstUrgentMessagenull273     function SelectFirstUrgentMessage(aMinUrgency: TMessageLineUrgency;
274       WithSrcPos: boolean): boolean;
SelectNextUrgentMessagenull275     function SelectNextUrgentMessage(aMinUrgency: TMessageLineUrgency;
276       WithSrcPos: boolean; Downwards: boolean): boolean;
277 
278     // scroll
IsLineVisiblenull279     function IsLineVisible(View: TLMsgWndView; LineNumber: integer): boolean;
IsLastLineVisiblenull280     function IsLastLineVisible(View: TLMsgWndView): boolean;
281     procedure ScrollToLine(View: TLMsgWndView; LineNumber: integer; FullyVisible: boolean);
GetLineTopnull282     function GetLineTop(View: TLMsgWndView; LineNumber: integer; Scrolled: boolean): integer;
283     property ScrollLeft: integer read FScrollLeft write SetScrollLeft;
284     property ScrollTop: integer read FScrollTop write SetScrollTop;
ScrollLeftMaxnull285     function ScrollLeftMax: integer;
ScrollTopMaxnull286     function ScrollTopMax: integer;
287     procedure StoreSelectedAsSearchStart;
288 
289     // file
OpenSelectionnull290     function OpenSelection: boolean;
291     procedure CreateMarksForFile(aSynEdit: TSynEdit; aFilename: string; DeleteOld: boolean);
ApplySrcChangesnull292     function ApplySrcChanges(Changes: TETSingleSrcChanges): boolean; // true if something changed
293   public
294     // properties
295     property AutoHeaderBackground: TColor read FAutoHeaderBackground write SetAutoHeaderBackground default MsgWndDefAutoHeaderBackground;
296     property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default MsgWndDefBackgroundColor;
297     property Color default clWindow;
298     property FilenameStyle: TMsgWndFileNameStyle read FFilenameStyle write SetFilenameStyle;
299     property HeaderBackground[aToolState: TLMVToolState]: TColor read GetHeaderBackground write SetHeaderBackground;
300     property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
301     property Images: TCustomImageList read FImages write SetImages;
302     property ItemHeight: integer read FItemHeight write SetItemHeight;
303     property OnAllViewsStopped: TNotifyEvent read FOnAllViewsStopped write FOnAllViewsStopped;
304     property OnOpenMessage: TOnOpenMessageLine read FOnOpenMessage write FOnOpenMessage;
305     Property OnOptionsChanged: TNotifyEvent read FOnOptionsChanged write FOnOptionsChanged;
306     property Options: TMsgCtrlOptions read FOptions write SetOptions default MCDefaultOptions;
307     property SearchText: string read FSearchText write SetSearchText;
308     // First initially selected line, -1=header line, can be on progress line (=View.Count)
309     property SelectedLine1: integer read GetSelectedLine write SetSelectedLine;
310     property SelectedView: TLMsgWndView read FSelectedView write SetSelectedView;
311     property ShowHint default true;
312     property SourceMarks: TETMarks read FSourceMarks write SetSourceMarks;
313     property TextColor: TColor read FTextColor write SetTextColor default MsgWndDefTextColor;
314     property UrgencyStyles[Urgency: TMessageLineUrgency]: TMsgCtrlUrgencyStyle read GetUrgencyStyles write SetUrgencyStyles;
315   end;
316 
317   { TMessagesFrame }
318 
319   TMessagesFrame = class(TFrame)
320     HideSearchSpeedButton: TSpeedButton;
321     MsgCtrlPopupMenu: TPopupMenu;
322     SearchEdit: TEdit;
323     SearchNextSpeedButton: TSpeedButton;
324     SearchPanel: TPanel;
325     SearchPrevSpeedButton: TSpeedButton;
326     procedure AboutToolMenuItemClick(Sender: TObject);
327     procedure AddFilterMenuItemClick(Sender: TObject);
328     procedure ClearFilterMsgTypesMenuItemClick(Sender: TObject);
329     procedure ClearMenuItemClick(Sender: TObject);
330     procedure CopyAllMenuItemClick(Sender: TObject);
331     procedure CopyFilenameMenuItemClick(Sender: TObject);
332     procedure CopyMsgMenuItemClick(Sender: TObject);
333     procedure CopyShownMenuItemClick(Sender: TObject);
334     procedure EditHelpMenuItemClick(Sender: TObject);
335     procedure FileStyleMenuItemClick(Sender: TObject);
336     procedure FindMenuItemClick(Sender: TObject);
337     procedure HelpMenuItemClick(Sender: TObject);
338     procedure FilterHintsWithoutPosMenuItemClick(Sender: TObject);
339     procedure FilterMsgOfTypeMenuItemClick(Sender: TObject);
340     procedure FilterUrgencyMenuItemClick(Sender: TObject);
341     procedure HideSearchSpeedButtonClick(Sender: TObject);
342     procedure MoreOptionsMenuItemClick(Sender: TObject);
343     procedure MsgCtrlPopupMenuPopup(Sender: TObject);
344     procedure OnSelectFilterClick(Sender: TObject);
345     procedure OpenToolsOptionsMenuItemClick(Sender: TObject);
346     procedure RemoveCompOptHideMsgClick(Sender: TObject);
347     procedure SaveAllToFileMenuItemClick(Sender: TObject);
348     procedure SaveShownToFileMenuItemClick(Sender: TObject);
349     procedure SearchEditChange(Sender: TObject);
350     procedure SearchEditKeyDown(Sender: TObject; var Key: Word;
351       {%H-}Shift: TShiftState);
352     procedure SearchNextSpeedButtonClick(Sender: TObject);
353     procedure SearchPrevSpeedButtonClick(Sender: TObject);
354     procedure ShowIDMenuItemClick(Sender: TObject);
355     procedure SrcEditLinesChanged(Sender: TObject);
356     procedure TranslateMenuItemClick(Sender: TObject);
357     procedure RemoveFilterMsgTypeClick(Sender: TObject);
358     procedure WndStayOnTopMenuItemClick(Sender: TObject);
359   private
360     FImages: TLCLGlyphs;
AllMessagesAsStringnull361     function AllMessagesAsString(const OnlyShown: boolean): String;
GetAboutViewnull362     function GetAboutView: TLMsgWndView;
GetViewsnull363     function GetViews(Index: integer): TLMsgWndView;
364     procedure HideSearch;
365     procedure ImagesGetWidthForPPI(Sender: TCustomImageList; {%H-}AImageWidth,
366       {%H-}APPI: Integer; var AResultWidth: Integer);
367     procedure SaveClicked(OnlyShown: boolean);
368     procedure CopyAllClicked(OnlyShown: boolean);
369     procedure CopyMsgToClipboard(OnlyFilename: boolean);
GetMsgPatternnull370     function GetMsgPattern(SubTool: string; MsgId: integer;
371       WithUrgency: boolean; MaxLen: integer): string;
372   protected
373     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
374   public
375     MessagesCtrl: TMessagesCtrl;
376     constructor Create(TheOwner: TComponent); override;
377     destructor Destroy; override;
378 
379     procedure ApplyIDEOptions;
380 
381     // Views
ViewCountnull382     function ViewCount: integer;
383     property Views[Index: integer]: TLMsgWndView read GetViews;
GetViewnull384     function GetView(aCaption: string; CreateIfNotExist: boolean): TLMsgWndView;
FindUnfinishedViewnull385     function FindUnfinishedView: TLMsgWndView;
386     procedure DeleteView(View: TLMsgWndView); // free view
IndexOfViewnull387     function IndexOfView(View: TLMsgWndView): integer;
388     procedure ClearViews(OnlyFinished: boolean); // deletes/frees all views
389 
390     // source marks
391     procedure CreateMarksForFile(aSynEdit: TSynEdit; aFilename: string;
392       DeleteOld: boolean);
393     procedure ApplySrcChanges(Changes: TETSingleSrcChanges);
394     procedure ApplyMultiSrcChanges(Changes: TETMultiSrcChanges);
395     procedure SourceEditorPopup(MarkLine: TSynEditMarkLine;
396       const LogicalCaretXY: TPoint);
397     procedure SourceEditorHint(MarkLine: TSynEditMarkLine;
398       var HintStr: string);
399 
400     // message lines
401     procedure SelectMsgLine(Msg: TMessageLine; DoScroll: boolean);
SelectFirstUrgentMessagenull402     function SelectFirstUrgentMessage(aMinUrgency: TMessageLineUrgency;
403       WithSrcPos: boolean): boolean;
SelectNextUrgentMessagenull404     function SelectNextUrgentMessage(aMinUrgency: TMessageLineUrgency;
405       WithSrcPos, Downwards: boolean): boolean;
406     procedure ClearCustomMessages(const ViewCaption: string='');
AddCustomMessagenull407     function AddCustomMessage(TheUrgency: TMessageLineUrgency; Msg: string;
408       aFilename: string = ''; LineNumber: integer = 0; Column: integer = 0;
409       const ViewCaption: string = CustomViewCaption): TMessageLine;
410   end;
411 
412 const
413   MessagesMenuRootName = 'Messages';
414 var
415   MsgFindMenuItem: TIDEMenuCommand;
416   MsgQuickFixMenuSection: TIDEMenuSection;
417   MsgAboutSection: TIDEMenuSection;
418     MsgAboutToolMenuItem: TIDEMenuCommand;
419     MsgOpenToolOptionsMenuItem: TIDEMenuCommand;
420   MsgFilterMsgOfTypeMenuItem: TIDEMenuCommand;
421   MsgRemoveCompOptHideMenuSection: TIDEMenuSection;
422   MsgRemoveMsgTypeFilterMenuSection: TIDEMenuSection;
423     MsgRemoveFilterMsgOneTypeMenuSection: TIDEMenuSection;
424     MsgRemoveFilterAllMsgTypesMenuItem: TIDEMenuCommand;
425   MsgFilterBelowMenuSection: TIDEMenuSection;
426     MsgFilterWarningsMenuItem: TIDEMenuCommand;
427     MsgFilterNotesMenuItem: TIDEMenuCommand;
428     MsgFilterHintsMenuItem: TIDEMenuCommand;
429     MsgFilterVerboseMenuItem: TIDEMenuCommand;
430     MsgFilterDebugMenuItem: TIDEMenuCommand;
431     MsgFilterNoneMenuItem: TIDEMenuCommand;
432   MsgFilterHintsWithoutPosMenuItem: TIDEMenuCommand;
433   MsgFiltersMenuSection: TIDEMenuSection;
434     MsgSelectFilterMenuSection: TIDEMenuSection;
435     MsgAddFilterMenuItem: TIDEMenuCommand;
436   MsgCopyMenuSection: TIDEMenuSection;
437     MsgCopyFilenameMenuItem: TIDEMenuCommand;
438     MsgCopyMsgMenuItem: TIDEMenuCommand;
439     MsgCopyShownMenuItem: TIDEMenuCommand;
440     MsgCopyAllMenuItem: TIDEMenuCommand;
441   MsgSaveToFileMenuSection: TIDEMenuSection;
442     MsgSaveAllToFileMenuItem: TIDEMenuCommand;
443     MsgSaveShownToFileMenuItem: TIDEMenuCommand;
444   MsgHelpMenuItem: TIDEMenuCommand;
445   MsgEditHelpMenuItem: TIDEMenuCommand;
446   MsgClearMenuItem: TIDEMenuCommand;
447   MsgOptionsMenuSection: TIDEMenuSection;
448     MsgWndStayOnTopMenuItem: TIDEMenuCommand;
449     MsgFilenameStyleMenuSection: TIDEMenuSection;
450       MsgFileStyleShortMenuItem: TIDEMenuCommand;
451       MsgFileStyleRelativeMenuItem: TIDEMenuCommand;
452       MsgFileStyleFullMenuItem: TIDEMenuCommand;
453     MsgTranslateMenuItem: TIDEMenuCommand;
454     MsgShowIDMenuItem: TIDEMenuCommand;
455     MsgMoreOptionsMenuItem: TIDEMenuCommand;
456 
457 procedure RegisterStandardMessagesViewMenuItems;
458 
459 implementation
460 
461 procedure RegisterStandardMessagesViewMenuItems;
462 var
463   Parent: TIDEMenuSection;
464   Root: TIDEMenuSection;
465 begin
466   MessagesMenuRoot := RegisterIDEMenuRoot(MessagesMenuRootName);
467   Root:=MessagesMenuRoot;
468   MsgFindMenuItem := RegisterIDEMenuCommand(Root, 'Find', lisFind);
469   MsgQuickFixMenuSection := RegisterIDEMenuSection(Root, 'Quick Fix');
470   MsgAboutSection:=RegisterIDEMenuSection(Root,'About');
471     Parent:=MsgAboutSection;
472     Parent.ChildrenAsSubMenu:=true;
473     Parent.Caption:=lisAbout;
474     MsgAboutToolMenuItem:=RegisterIDEMenuCommand(Parent, 'About', lisAbout);
475     MsgOpenToolOptionsMenuItem:=RegisterIDEMenuCommand(Parent, 'Open Tool '
476       +'Options', lisOpenToolOptions);
477   MsgFilterMsgOfTypeMenuItem:=RegisterIDEMenuCommand(Root,'FilterMsgOfType',lisFilterAllMessagesOfCertainType);
478   MsgRemoveCompOptHideMenuSection:=RegisterIDEMenuSection(Root,'RemoveCompOptHideMsg');
479     Parent:=MsgRemoveCompOptHideMenuSection;
480     Parent.ChildrenAsSubMenu:=true;
481     Parent.Caption:=lisRemoveCompilerOptionHideMessage;
482   MsgRemoveMsgTypeFilterMenuSection:=RegisterIDEMenuSection(Root,'RemoveMsgTypeFilters');
483     Parent:=MsgRemoveMsgTypeFilterMenuSection;
484     Parent.ChildrenAsSubMenu:=true;
485     Parent.Caption:=lisRemoveMessageTypeFilter;
486     MsgRemoveFilterMsgOneTypeMenuSection:=RegisterIDEMenuSection(Parent,'RemoveOneMsgTypeFilterSection');
487     MsgRemoveFilterAllMsgTypesMenuItem:=RegisterIDEMenuCommand(Parent, 'Remove'
488       +' all message type filters', lisRemoveAllMessageTypeFilters);
489   MsgFilterBelowMenuSection:=RegisterIDEMenuSection(Root,'Filter Below Section');
490     Parent:=MsgFilterBelowMenuSection;
491     Parent.ChildrenAsSubMenu:=true;
492     Parent.Caption:=lisFilterNonUrgentMessages;
493     MsgFilterWarningsMenuItem:=RegisterIDEMenuCommand(Parent,
494       'Filter Warnings', lisFilterWarningsAndBelow);
495     MsgFilterWarningsMenuItem.RadioItem:=true;
496     MsgFilterWarningsMenuItem.GroupIndex:=2;
497     MsgFilterNotesMenuItem:=RegisterIDEMenuCommand(Parent, 'Filter Notes',
498       lisFilterNotesAndBelow);
499     MsgFilterNotesMenuItem.RadioItem:=true;
500     MsgFilterNotesMenuItem.GroupIndex:=2;
501     MsgFilterHintsMenuItem:=RegisterIDEMenuCommand(Parent, 'Filter Hints',
502       lisFilterHintsAndBelow);
503     MsgFilterHintsMenuItem.RadioItem:=true;
504     MsgFilterHintsMenuItem.GroupIndex:=2;
505     MsgFilterVerboseMenuItem:=RegisterIDEMenuCommand(Parent, 'Filter Verbose '
506       +'Messages', lisFilterVerboseMessagesAndBelow);
507     MsgFilterVerboseMenuItem.RadioItem:=true;
508     MsgFilterVerboseMenuItem.GroupIndex:=2;
509     MsgFilterDebugMenuItem:=RegisterIDEMenuCommand(Parent, 'Filter Debug '
510       +'Messages', lisFilterDebugMessagesAndBelow);
511     MsgFilterDebugMenuItem.RadioItem:=true;
512     MsgFilterDebugMenuItem.GroupIndex:=2;
513     MsgFilterNoneMenuItem:=RegisterIDEMenuCommand(Parent, 'Filter None, do not'
514       +' filter by urgency', lisFilterNoneDoNotFilterByUrgency);
515     MsgFilterNoneMenuItem.RadioItem:=true;
516     MsgFilterNoneMenuItem.GroupIndex:=2;
517   MsgFilterHintsWithoutPosMenuItem:=RegisterIDEMenuCommand(Root, 'Filter Hints'
518     +' without Source Position', lisFilterHintsWithoutSourcePosition);
519   MsgFiltersMenuSection:=RegisterIDEMenuSection(Root,'Switch Filter Section');
520     Parent:=MsgFiltersMenuSection;
521     Parent.ChildrenAsSubMenu:=true;
522     Parent.Caption:=lisSwitchFilterSettings;
523     MsgSelectFilterMenuSection:=RegisterIDEMenuSection(Parent,'Filters');
524     MsgAddFilterMenuItem:=RegisterIDEMenuCommand(Parent, 'Add Filter',
525       lisAddFilter);
526   MsgCopyMenuSection:=RegisterIDEMenuSection(Root,'Copy');
527     Parent:=MsgCopyMenuSection;
528     Parent.ChildrenAsSubMenu:=true;
529     Parent.Caption:=lisCopy;
530     MsgCopyFilenameMenuItem:=RegisterIDEMenuCommand(Parent, 'Filename',
531       lisCopyFileNameToClipboard);
532     MsgCopyMsgMenuItem := RegisterIDEMenuCommand(Parent, 'Selected',lisCopySelectedMessagesToClipboard);
533     MsgCopyShownMenuItem := RegisterIDEMenuCommand(Parent, 'Shown', lisCopyAllShownMessagesToClipboard);
534     MsgCopyAllMenuItem:=RegisterIDEMenuCommand(Parent, 'All',
535       lisCopyAllOriginalMessagesToClipboard);
536   MsgSaveToFileMenuSection:=RegisterIDEMenuSection(Root,'Save');
537     Parent:=MsgSaveToFileMenuSection;
538     Parent.ChildrenAsSubMenu:=true;
539     Parent.Caption:=lisSave;
540     MsgSaveShownToFileMenuItem:=RegisterIDEMenuCommand(Parent, 'Save Shown '
541       +'Messages to File', lisSaveShownMessagesToFile);
542     MsgSaveAllToFileMenuItem:=RegisterIDEMenuCommand(Parent, 'Save All '
543       +'Messages to File', lisSaveAllOriginalMessagesToFile);
544   MsgHelpMenuItem := RegisterIDEMenuCommand(Root, 'Help for this message',lisHelp);
545   MsgEditHelpMenuItem := RegisterIDEMenuCommand(Root, 'Edit help for messages',lisEditHelp);
546   MsgClearMenuItem := RegisterIDEMenuCommand(Root, 'Clear', lisClear);
547   MsgOptionsMenuSection:=RegisterIDEMenuSection(Root,'Option Section');
548     Parent:=MsgOptionsMenuSection;
549     Parent.ChildrenAsSubMenu:=true;
550     Parent.Caption:=lisOptions;
551     MsgWndStayOnTopMenuItem:=RegisterIDEMenuCommand(Parent,
552       'Window stay on top', lisWindowStaysOnTop);
553     MsgFilenameStyleMenuSection:=RegisterIDEMenuSection(Parent,'Filename Styles');
554       Parent:=MsgFilenameStyleMenuSection;
555       Parent.ChildrenAsSubMenu:=true;
556       Parent.Caption:=lisFilenameStyle;
557       MsgFileStyleShortMenuItem:=RegisterIDEMenuCommand(Parent, 'Short',
558         lisShortNoPath);
559       MsgFileStyleRelativeMenuItem:=RegisterIDEMenuCommand(Parent, 'Relative',
560         lisRelative);
561       MsgFileStyleFullMenuItem:=RegisterIDEMenuCommand(Parent, 'Full', lisFull);
562     Parent:=MsgOptionsMenuSection;
563     MsgTranslateMenuItem:=RegisterIDEMenuCommand(Parent, 'Translate',
564       lisTranslateTheEnglishMessages);
565     MsgShowIDMenuItem:=RegisterIDEMenuCommand(Parent, 'ShowID',
566       lisShowMessageTypeID);
567     MsgMoreOptionsMenuItem:=RegisterIDEMenuCommand(Parent, 'More Options',
568       lisDlgMore);
569 end;
570 
571 {$R *.lfm}
572 
573 { TLMsgWndView }
574 
575 procedure TLMsgWndView.OnMarksFixed(ListOfTMessageLine: TFPList);
576 var
577   i: Integer;
578   ViewLine: TMessageLine;
579   j: Integer;
580   WorkerMsg: TMessageLine;
581 begin
582   //debugln(['TLMsgWndView.OnMarksFixed START ',ListOfTMessageLine.Count]);
583   // apply marks to WorkerMessages
584   if Tool<>nil then begin
585     Tool.EnterCriticalSection;
586     try
587       for i:=0 to ListOfTMessageLine.Count-1 do begin
588         ViewLine:=TMessageLine(ListOfTMessageLine[i]);
589         j:=Tool.WorkerMessages.IndexOfOutputIndex(ViewLine.OutputIndex);
590         if j<0 then continue;
591         WorkerMsg:=Tool.WorkerMessages[j];
592         WorkerMsg.Flags:=ViewLine.Flags;
593         //debugln(['TLMsgWndView.OnMarksFixed j=',j,' ',dbgs(WorkerMsg.Flags),' ',dbgs(Pointer(WorkerMsg)),' WorkerMsg.OutputIndex=',WorkerMsg.OutputIndex,' ViewLine.OutputIndex=',ViewLine.OutputIndex]);
594       end;
595     finally
596       Tool.LeaveCriticalSection;
597     end;
598   end;
599 
600   // delete messages from view
601   for i:=ListOfTMessageLine.Count-1 downto 0 do begin
602     ViewLine:=TMessageLine(ListOfTMessageLine[i]);
603     Lines.Delete(ViewLine);
604   end;
605   ListOfTMessageLine.Clear;
606 
607   // update control
608   Control.UpdateScrollBar(true);
609   Control.Invalidate;
610 end;
611 
612 procedure TLMsgWndView.SetToolState(AValue: TLMVToolState);
613 begin
614   if ToolState=AValue then Exit;
615   inherited;
616   Control.Invalidate;
617 end;
618 
619 procedure TLMsgWndView.SetFilter(AValue: TLMsgViewFilter);
620 begin
621   FFilter.Assign(AValue);
622 end;
623 
624 procedure TLMsgWndView.FetchAllPending;
625 var
626   OldLineCount: Integer;
627   i: Integer;
628   OldUpdateSortedSrcPos: Boolean;
629   MsgLine: TMessageLine;
630   Line: Integer;
631   Col: Integer;
632 begin
633   OldLineCount:=Lines.Count;
634   inherited FetchAllPending;
635   if OldLineCount=Lines.Count then exit;
636 
637   // apply pending src changes
638   OldUpdateSortedSrcPos:=Lines.UpdateSortedSrcPos;
639   if FPendingChanges.Count>0 then begin
640     Lines.UpdateSortedSrcPos:=false;
641     try
642       for i:=OldLineCount to Lines.Count-1 do begin
643         MsgLine:=Lines[i];
644         //debugln(['TLMsgWndView.FetchAllPending ',i,' ',MsgLine.Msg]);
645         Line:=MsgLine.Line;
646         Col:=MsgLine.Column;
647         FPendingChanges.AdaptCaret(MsgLine.GetFullFilename,Line,Col,
648           mlfLeftToken in MsgLine.Flags);
649         MsgLine.SetSourcePosition(MsgLine.Filename,Line,Col);
650       end;
651     finally
652       Lines.UpdateSortedSrcPos:=OldUpdateSortedSrcPos;
653     end;
654   end;
655 end;
656 
657 procedure TLMsgWndView.ToolExited;
658 var
659   ErrCount: Integer;
660   u: TMessageLineUrgency;
661   MsgLine: TMessageLine;
662   i: Integer;
663   StartLine: Integer;
664   sl: TStringList;
665 begin
666   inherited ToolExited;
667   if Tool.Terminated then begin
668     ToolState:=lmvtsFailed;
669   end else if (ExitStatus<>0) or (ExitCode<>0) then begin
670     // tool stopped with errors
671     ErrCount:=0;
672     EnterCriticalSection;
673     try
674       for u:=mluError to high(TMessageLineUrgency) do
675         inc(ErrCount,Lines.UrgencyCounts[u]+PendingLines.UrgencyCounts[u]);
676     finally
677       LeaveCriticalSection;
678     end;
679     if ErrCount=0 then begin
680       // parser did not add an error message
681       // => add an error message
682       // add up the last 100 lines of output with panic urgency
683       Tool.EnterCriticalSection; // Note: always lock Tool *before* View
684       try
685         EnterCriticalSection;
686         try
687           StartLine:=Max(0,Tool.WorkerOutput.Count-100);
688           if PendingLines.Count>0 then
689             StartLine:=Max(StartLine,PendingLines[PendingLines.Count-1].OutputIndex+1);
690           if Lines.Count>0 then
691             StartLine:=Max(StartLine,Lines[Lines.Count-1].OutputIndex+1);
692           for i:=StartLine to Tool.WorkerOutput.Count-1 do
693           begin
694             MsgLine:=PendingLines.CreateLine(-1);
695             MsgLine.Msg:=Tool.WorkerOutput[i];
696             MsgLine.Urgency:=mluPanic;
697             PendingLines.Add(MsgLine);
698           end;
699           MsgLine:=PendingLines.CreateLine(-1);
700           MsgLine.Urgency:=mluPanic;
701           if ExitCode<>0 then
702             MsgLine.Msg:=Format(
703               lisToolStoppedWithExitCodeUseContextMenuToGetMoreInfo, [IntToStr(
704               ExitCode)])
705           else
706             MsgLine.Msg:=Format(
707               lisToolStoppedWithExitStatusUseContextMenuToGetMoreInfo, [
708               IntToStr(ExitStatus)]);
709           PendingLines.Add(MsgLine);
710         finally
711           LeaveCriticalSection;
712         end;
713       finally
714         Tool.LeaveCriticalSection;
715       end;
716     end;
717     ToolState:=lmvtsFailed;
718   end else if Tool.ErrorMessage<>'' then begin
719     // error executing the tool
720     EnterCriticalSection;
721     try
722       sl:=TStringList.Create;
723       try
724         sl.Text:=Tool.ErrorMessage;
725         for i:=0 to sl.Count-1 do begin
726           if sl[i]='' then continue;
727           MsgLine:=PendingLines.CreateLine(-1);
728           MsgLine.Urgency:=mluPanic;
729           MsgLine.Msg:=Format(lisInternalError, [sl[i]]);
730           PendingLines.Add(MsgLine);
731         end;
732       finally
733         sl.Free;
734       end;
735     finally
736       LeaveCriticalSection;
737     end;
738     ToolState:=lmvtsFailed;
739   end else
740     ToolState:=lmvtsSuccess;
741 end;
742 
743 procedure TLMsgWndView.CallOnChangedInMainThread(Data: PtrInt);
744 begin
745   FAsyncQueued:=false;
746   if csDestroying in ComponentState then exit;
747   if Assigned(OnChanged) then
748     OnChanged(Self);
749 end;
750 
751 procedure TLMsgWndView.QueueAsyncOnChanged;
752 begin
753   if FAsyncQueued then exit;
754   FAsyncQueued:=true;
755   if Application<>nil then
756     Application.QueueAsyncCall(@CallOnChangedInMainThread,0);
757 end;
758 
759 procedure TLMsgWndView.RemoveAsyncOnChanged;
760 begin
761   if not FAsyncQueued then exit;
762   FAsyncQueued:=false;
763   if Application<>nil then
764     Application.RemoveAsyncCalls(Self);
765 end;
766 
767 constructor TLMsgWndView.Create(AOwner: TComponent);
768 begin
769   fMessageLineClass:=TLMsgViewLine;
770   inherited Create(AOwner);
771   Lines.OnMarksFixed:=@OnMarksFixed;
772   FFilter:=TLMsgViewFilter.Create;
773   fPendingChanges:=TETMultiSrcChanges.Create(nil);
774 end;
775 
776 destructor TLMsgWndView.Destroy;
777 begin
778   inherited Destroy;
779   FreeAndNil(FPendingChanges);
780   FreeAndNil(FFilter);
781 end;
782 
TLMsgWndView.LineFitsnull783 function TLMsgWndView.LineFits(Line: TMessageLine): boolean;
784 begin
785   if FFilter<>nil then
786     Result:=FFilter.LineFits(Line)
787   else
788     Result:=inherited LineFits(Line);
789 end;
790 
HasContentnull791 function TLMsgWndView.HasContent: boolean;
792 begin
793   Result:=GetShownLineCount(true,true)>0;
794 end;
795 
GetShownLineCountnull796 function TLMsgWndView.GetShownLineCount(WithHeader, WithProgressLine: boolean
797   ): integer;
798 begin
799   Result:=Lines.Count;
800   // the header is only shown if there SummaryMsg<>'' or ProgressLine.Msg<>'' or Lines.Count>0
801   if ProgressLine.Msg<>'' then begin
802     if WithHeader then
803       inc(Result);
804     if WithProgressLine then
805       inc(Result);
806   end else if Caption<>'' then begin
807     if WithHeader then
808       inc(Result);
809   end else if (Result>0) and WithHeader then
810     inc(Result);
811 end;
812 
813 procedure TLMsgWndView.RebuildLines;
814 // called by main thread
815 var
816   i: Integer;
817   SrcMsg: TMessageLine;
818   NewProgressLine: TMessageLine;
819   NewMsg: TMessageLine;
820   Line: Integer;
821   Col: Integer;
822 begin
823   if Tool=nil then exit;
824   Tool.EnterCriticalSection; // lock Tool before View
825   try
826     EnterCriticalSection;
827     try
828       ClearLines;
829       NewProgressLine:=nil;
830       for i:=0 to Tool.WorkerMessages.Count-1 do begin
831         SrcMsg:=Tool.WorkerMessages[i];
832         //if Pos('"db"',SrcMsg.Msg)>0 then
833          // debugln(['TLMsgWndView.RebuildLines i=',i,' Msg="',SrcMsg.Msg,'" Fits=',LineFits(SrcMsg),' ',dbgs(SrcMsg.Flags),' ',SrcMsg.OutputIndex]);
834         if LineFits(SrcMsg) then begin
835           NewProgressLine:=nil;
836           NewMsg:=Lines.CreateLine(-1);
837           NewMsg.Assign(SrcMsg);
838           // adapt line,col due to src changes
839           Line:=NewMsg.Line;
840           Col:=NewMsg.Column;
841           FPendingChanges.AdaptCaret(NewMsg.GetFullFilename,Line,Col,
842                                      mlfLeftToken in NewMsg.Flags);
843           NewMsg.SetSourcePosition(NewMsg.Filename,Line,Col);
844           //debugln(['TLMsgWndView.RebuildLines NewMsg=',Lines.Count,'="',NewMsg.Msg,'"']);
845           Lines.Add(NewMsg);
846         end else begin
847           NewProgressLine:=SrcMsg;
848         end;
849       end;
850       FLastWorkerMessageCount:=Tool.WorkerMessages.Count-1;
851       if (NewProgressLine<>nil) and Running then begin
852         ProgressLine.Assign(NewProgressLine);
853       end
854       else if ProgressLine.Msg<>'' then begin
855         ProgressLine.Clear;
856       end;
857     finally
858       LeaveCriticalSection;
859     end;
860   finally
861     Tool.LeaveCriticalSection;
862   end;
863 end;
864 
ApplySrcChangesnull865 function TLMsgWndView.ApplySrcChanges(Changes: TETSingleSrcChanges): boolean;
866 
ApplyChangesnull867   function ApplyChanges(CurChanges: TETSingleSrcChanges;
868     CurLines: TMessageLines): boolean;
869   var
870     FromY: integer;
871     MaxY: integer;
872     LineDiffBehindMaxY: integer;
873     ToY: Integer;
874     MsgLine: TMessageLine;
875     Line: Integer;
876     Col: Integer;
877     OldUpdateSortedSrcPos: Boolean;
878   begin
879     Result:=false;
880     if CurChanges.First=nil then exit;
881     CurChanges.GetRange(FromY,MaxY,LineDiffBehindMaxY);
882     if LineDiffBehindMaxY=0 then
883       ToY:=MaxY
884     else
885       ToY:=High(Integer);
886     OldUpdateSortedSrcPos:=Lines.UpdateSortedSrcPos;
887     CurLines.UpdateSortedSrcPos:=false;
888     try
889       {if CurLines=Lines then begin
890         debugln(['ApplyChanges MinY=',FromY,' MaxY=',MaxY,' LineDiffBehindMaxY=',LineDiffBehindMaxY]);
891         CurChanges.WriteDebugReport('Changes:');
892       end;}
893       for MsgLine in CurLines.EnumerateFile(CurChanges.Filename,FromY,ToY)
894       do begin
895         Line:=MsgLine.Line;
896         Col:=MsgLine.Column;
897         if Line>MaxY then
898           inc(Line,LineDiffBehindMaxY)
899         else
900           CurChanges.AdaptCaret(Line,Col,mlfLeftToken in MsgLine.Flags);
901         //if CurLines=Lines then
902         //  debugln(['ApplyChanges ',MsgLine.Msg,' Old=',MsgLine.Line,',',MsgLine.Column,' New=',Line,',',Col]);
903 
904         if (Line=MsgLine.Line) and (MsgLine.Column=Col) then continue;
905         MsgLine.SetSourcePosition(MsgLine.Filename,Line,Col);
906         Result:=true;
907       end;
908     finally
909       CurLines.UpdateSortedSrcPos:=OldUpdateSortedSrcPos;
910     end;
911   end;
912 
913 var
914   Queue: TETSingleSrcChanges;
915   Change: TETSrcChange;
916   Node: TAvlTreeNode;
917   aFilename: String;
918 begin
919   Result:=false;
920   //debugln(['TLMsgWndView.ApplySrcChanges START ',Changes.Filename,' ',Changes.First<>nil]);
921   // check if there are changes
922   if Changes.First=nil then exit;
923   aFilename:=Changes.Filename;
924   if aFilename='' then exit;
925 
926   // update visible lines
927   Result:=ApplyChanges(Changes,Lines);
928 
929   // update pending lines
930   if Tool<>nil then begin
931     Tool.EnterCriticalSection; // lock Tool before View
932     try
933       EnterCriticalSection;
934       try
935         Queue:=PendingChanges.GetChanges(aFilename,true);
936         Change:=Changes.First;
937         while Change<>nil do begin
938           Queue.Add(Change.Action,Change.FromPos,Change.ToPos);
939           Change:=Change.Next;
940         end;
941         if not Running then begin
942           // apply all pending changes to Tool.WorkerMessages
943           Node:=PendingChanges.AllChanges.FindLowest;
944           while Node<>nil do begin
945             ApplyChanges(TETSingleSrcChanges(Node.Data),Tool.WorkerMessages);
946             Node:=Node.Successor;
947           end;
948           PendingChanges.Clear;
949         end;
950       finally
951         LeaveCriticalSection;
952       end;
953     finally
954       Tool.LeaveCriticalSection;
955     end;
956   end;
957 end;
958 
959 { TMsgCtrlUrgencyStyle }
960 
961 procedure TMsgCtrlUrgencyStyle.SetColor(AValue: TColor);
962 begin
963   if FColor=AValue then Exit;
964   FColor:=AValue;
965   Changed;
966 end;
967 
968 procedure TMsgCtrlUrgencyStyle.SetImageIndex(AValue: integer);
969 begin
970   if FImageIndex=AValue then Exit;
971   FImageIndex:=AValue;
972   Changed;
973 end;
974 
975 procedure TMsgCtrlUrgencyStyle.SetTranslated(AValue: string);
976 begin
977   if FTranslated=AValue then Exit;
978   FTranslated:=AValue;
979   Changed;
980 end;
981 
982 procedure TMsgCtrlUrgencyStyle.Changed;
983 begin
984   Control.Invalidate;
985 end;
986 
987 constructor TMsgCtrlUrgencyStyle.Create(AControl: TMessagesCtrl;
988   TheUrgency: TMessageLineUrgency);
989 begin
990   FControl:=AControl;
991   fUrgency:=TheUrgency;
992   FImageIndex:=-1;
993   FColor:=clDefault;
994 end;
995 
TMsgCtrlUrgencyStyle.Equalsnull996 function TMsgCtrlUrgencyStyle.Equals(Obj: TObject): boolean;
997 var
998   Src: TMsgCtrlUrgencyStyle;
999 begin
1000   if Obj is TMsgCtrlUrgencyStyle then begin
1001     Src:=TMsgCtrlUrgencyStyle(Obj);
1002     Result:=(ImageIndex=Src.ImageIndex)
1003         and (Color=Src.Color)
1004         and (Translated=Src.Translated);
1005   end else
1006     Result:=inherited Equals(Obj);
1007 end;
1008 
1009 procedure TMsgCtrlUrgencyStyle.Assign(Src: TMsgCtrlUrgencyStyle);
1010 begin
1011   if Equals(Src) then exit;
1012   fImageIndex:=Src.ImageIndex;
1013   fColor:=Src.Color;
1014   fTranslated:=Src.Translated;
1015   Changed;
1016 end;
1017 
1018 procedure TMsgCtrlUrgencyStyle.SetValues(TheTranslated: string;
1019   TheImageIndex: integer; TheColor: TColor);
1020 begin
1021   Translated:=TheTranslated;
1022   ImageIndex:=TheImageIndex;
1023   Color:=TheColor;
1024 end;
1025 
1026 { TMessagesCtrl }
1027 
1028 // inline
ViewCountnull1029 function TMessagesCtrl.ViewCount: integer;
1030 begin
1031   Result:=FViews.Count;
1032 end;
1033 
1034 // inline
TMessagesCtrl.Filtersnull1035 function TMessagesCtrl.Filters: TLMsgViewFilters;
1036 begin
1037   Result:=EnvironmentOptions.MsgViewFilters;
1038 end;
1039 
1040 // inline
GetActiveFilternull1041 function TMessagesCtrl.GetActiveFilter: TLMsgViewFilter;
1042 begin
1043   Result:=Filters.ActiveFilter;
1044 end;
1045 
1046 // inline
1047 procedure TMessagesCtrl.SetActiveFilter(AValue: TLMsgViewFilter);
1048 begin
1049   Filters.ActiveFilter:=AValue;
1050 end;
1051 
GetViewsnull1052 function TMessagesCtrl.GetViews(Index: integer): TLMsgWndView;
1053 
1054   procedure RaiseOutOfBounds;
1055   begin
1056     raise Exception.Create('TMessagesCtrl.GetViews '+IntToStr(Index)+' out of bounds '+IntToStr(ViewCount));
1057   end;
1058 
1059 begin
1060   if (Index<0) or (Index>=ViewCount) then
1061     RaiseOutOfBounds;
1062   Result:=TLMsgWndView(FViews[Index]);
1063 end;
1064 
1065 procedure TMessagesCtrl.OnViewChanged(Sender: TObject);
1066 var
1067   AllViewsStopped: Boolean;
1068   i: Integer;
1069 begin
1070   for i:=0 to ViewCount-1 do begin
1071     if Views[i].Running then begin
1072       // the views may change many times
1073       // reduce the update of the control to a few per second by using a timer
1074       fSomeViewsRunning:=true;
1075       FUpdateTimer.Enabled:=true;
1076       exit;
1077     end;
1078   end;
1079   // no views are running
1080   // The variable fSomeViewsRunning contains the last state
1081   // if fSomeViewsRunning was true, then all views have stopped
1082   AllViewsStopped:=fSomeViewsRunning;
1083   fSomeViewsRunning:=false;
1084   // no views running => update immediately
1085   FetchNewMessages;
1086 
1087   if AllViewsStopped then
1088     DoAllViewsStopped;
1089 end;
1090 
1091 procedure TMessagesCtrl.FetchNewMessages;
1092 // called when new messages are available from the worker threads
1093 // calls Views to fetch and filter new messages
1094 // scrolls to new message
1095 var
1096   i: Integer;
1097 begin
1098   if csDestroying in ComponentState then exit;
1099   BeginUpdate;
1100   try
1101     for i:=0 to ViewCount-1 do
1102       FetchNewMessages(Views[i]);
1103   finally
1104     EndUpdate;
1105   end;
1106   UpdateScrollBar(true);
1107 end;
1108 
FetchNewMessagesnull1109 function TMessagesCtrl.FetchNewMessages(View: TLMsgWndView): boolean;
1110 var
1111   OldLineCount: Integer;
1112   i: Integer;
1113   OtherView: TLMsgWndView;
1114   MaxY: Integer;
1115   y: Integer;
1116 begin
1117   Result:=false;
1118   if csDestroying in ComponentState then exit;
1119   if IndexOfView(View)<0 then exit;
1120 
1121   OldLineCount:=View.Lines.Count;
1122   if not View.ApplyPending then
1123     exit; // no new lines
1124   Result:=true;
1125   CreateSourceMarks(View,OldLineCount);
1126   UpdateScrollBar(true);
1127   Invalidate;
1128 
1129   // auto scroll
1130   if SelectedView<>nil then
1131     exit; // user has selected a non progress line -> do not auto scroll
1132 
1133   for i:=0 to ViewCount-1 do
1134   begin
1135     OtherView:=Views[i];
1136     if OtherView=View then break;
1137     if OtherView.Running then begin
1138       // there is still a prior View running
1139       // -> keep the last line of the other View visible
1140       MaxY:=GetLineTop(OtherView,OtherView.GetShownLineCount(true,true),false);
1141       y:=GetLineTop(View,View.GetShownLineCount(false,true),false);
1142       ScrollTop:=Min(MaxY,y);
1143       exit;
1144     end;
1145   end;
1146   // scroll to last line
1147   ScrollToLine(View,View.GetShownLineCount(false,true),true);
1148 end;
1149 
1150 procedure TMessagesCtrl.MsgUpdateTimerTimer(Sender: TObject);
1151 begin
1152   FUpdateTimer.Enabled:=false;
1153   FetchNewMessages;
1154 end;
1155 
1156 procedure TMessagesCtrl.SetBackgroundColor(AValue: TColor);
1157 begin
1158   if FBackgroundColor=AValue then Exit;
1159   FBackgroundColor:=AValue;
1160   Invalidate;
1161 end;
1162 
1163 procedure TMessagesCtrl.SetFilenameStyle(AValue: TMsgWndFileNameStyle);
1164 begin
1165   if FFilenameStyle=AValue then Exit;
1166   FFilenameStyle:=AValue;
1167   Invalidate;
1168 end;
1169 
1170 procedure TMessagesCtrl.SetHeaderBackground(aToolState: TLMVToolState;
1171   AValue: TColor);
1172 begin
1173   if FHeaderBackground[aToolState]=AValue then exit;
1174   FHeaderBackground[aToolState]:=AValue;
1175   Invalidate;
1176 end;
1177 
1178 procedure TMessagesCtrl.SetIdleConnected(AValue: boolean);
1179 begin
1180   if FIdleConnected=AValue then Exit;
1181   FIdleConnected:=AValue;
1182   if IdleConnected then
1183     Application.AddOnIdleHandler(@OnIdle)
1184   else
1185     Application.RemoveOnIdleHandler(@OnIdle);
1186 end;
1187 
1188 procedure TMessagesCtrl.SetImages(AValue: TCustomImageList);
1189 begin
1190   if FImages=AValue then Exit;
1191   if Images <> nil then
1192     Images.UnRegisterChanges(FImageChangeLink);
1193   FImages:=AValue;
1194   if Images <> nil then begin
1195     Images.RegisterChanges(FImageChangeLink);
1196     Images.FreeNotification(Self);
1197     if ItemHeight<Images.Height+2 then
1198       ItemHeight:=Images.Height+2;
1199   end;
1200   Invalidate;
1201 end;
1202 
1203 procedure TMessagesCtrl.SetItemHeight(AValue: integer);
1204 begin
1205   FItemHeight:=Max(0,FItemHeight);
1206   if FItemHeight=AValue then Exit;
1207   FItemHeight:=AValue;
1208   UpdateScrollBar(true);
1209   Invalidate;
1210 end;
1211 
1212 procedure TMessagesCtrl.SetOptions(NewOptions: TMsgCtrlOptions);
1213 var
1214   ChangedOptions: TMsgCtrlOptions;
1215 begin
1216   if FOptions=NewOptions then Exit;
1217   ChangedOptions:=(FOptions-NewOptions)+(NewOptions-FOptions);
1218   FOptions:=NewOptions;
1219   if [mcoShowStats,mcoShowTranslated,mcoShowMessageID,mcoShowMsgIcons,
1220     mcoAlwaysDrawFocused]*ChangedOptions<>[]
1221   then
1222     Invalidate;
1223   if Assigned(OnOptionsChanged) then
1224     OnOptionsChanged(Self);
1225 end;
1226 
1227 procedure TMessagesCtrl.SetScrollLeft(AValue: integer);
1228 begin
1229   AValue:=Max(0,Min(AValue,ScrollLeftMax));
1230   if FScrollLeft=AValue then Exit;
1231   FScrollLeft:=AValue;
1232   UpdateScrollBar(false);
1233   Invalidate;
1234 end;
1235 
1236 procedure TMessagesCtrl.SetScrollTop(AValue: integer);
1237 begin
1238   AValue:=Max(0,Min(AValue,ScrollTopMax));
1239   if FScrollTop=AValue then Exit;
1240   FScrollTop:=AValue;
1241   UpdateScrollBar(false);
1242   Invalidate;
1243 end;
1244 
1245 procedure TMessagesCtrl.SetSearchText(AValue: string);
1246 begin
1247   if FSearchText=AValue then Exit;
1248   FSearchText:=AValue;
1249   IdleConnected:=true;
1250 end;
1251 
1252 procedure TMessagesCtrl.SetSelectedLine(AValue: integer);
1253 // Select the given line, clear possibly existing selections.
1254 var
1255   LineCnt: Integer;
1256 begin
1257   Assert(AValue>=-1, 'TMessagesCtrl.SetSelectedLine: AValue < -1.');
1258   Assert(Assigned(SelectedView), 'TMessagesCtrl.SetSelectedLine: View = Nil.');
1259   LineCnt:=SelectedView.GetShownLineCount(false,true)-1;
1260   Assert(AValue<=LineCnt, 'TMessagesCtrl.SetSelectedLine: Value '+IntToStr(AValue)
1261                         + ' > line count ' + IntToStr(LineCnt));
1262   //AValue:=Min(AValue, SelectedView.GetShownLineCount(false,true)-1);
1263   if (FSelectedLines.Count>0) and (FSelectedLines[0]=AValue) then
1264     Exit;
1265   FSelectedLines.Count:=1;    // One line.
1266   FSelectedLines[0]:=AValue;
1267   Invalidate;
1268 end;
1269 
1270 procedure TMessagesCtrl.SetSelectedView(AValue: TLMsgWndView);
1271 begin
1272   if FSelectedView=AValue then Exit;
1273   FSelectedView:=AValue;
1274   Invalidate;
1275 end;
1276 
1277 procedure TMessagesCtrl.SetSourceMarks(AValue: TETMarks);
1278 begin
1279   if FSourceMarks=AValue then Exit;
1280   FSourceMarks:=AValue;
1281   if SourceMarks<>nil then
1282     FreeNotification(SourceMarks);
1283 end;
1284 
1285 procedure TMessagesCtrl.SetTextColor(AValue: TColor);
1286 begin
1287   if FTextColor=AValue then Exit;
1288   FTextColor:=AValue;
1289   Invalidate;
1290 end;
1291 
1292 procedure TMessagesCtrl.SetUrgencyStyles(Urgency: TMessageLineUrgency;
1293   AValue: TMsgCtrlUrgencyStyle);
1294 begin
1295   fUrgencyStyles[Urgency].Assign(AValue);
1296 end;
1297 
1298 procedure TMessagesCtrl.SetAutoHeaderBackground(AValue: TColor);
1299 begin
1300   if FAutoHeaderBackground=AValue then Exit;
1301   FAutoHeaderBackground:=AValue;
1302   Invalidate;
1303 end;
1304 
TMessagesCtrl.UrgencyToStrnull1305 function TMessagesCtrl.UrgencyToStr(Urgency: TMessageLineUrgency): string;
1306 begin
1307   if (mcoShowTranslated in Options)
1308   and (fUrgencyStyles[Urgency].Translated<>'') then
1309     Result:=fUrgencyStyles[Urgency].Translated
1310   else
1311     Result:=MessageLineUrgencyNames[Urgency];
1312 end;
1313 
1314 procedure TMessagesCtrl.WMHScroll(var Msg: TLMScroll);
1315 begin
1316   case Msg.ScrollCode of
1317       // Scrolls to start / end of the line
1318     SB_TOP: ScrollLeft := 1;
1319     SB_BOTTOM: ScrollLeft := ScrollLeftMax;
1320       // Scrolls one char left / right
1321     SB_LINEDOWN: ScrollLeft := ScrollLeft + 1;
1322     SB_LINEUP: ScrollLeft := ScrollLeft - 1;
1323       // Scrolls one page of chars left / right
1324     SB_PAGEDOWN: ScrollLeft := ScrollLeft + (ClientWidth div 2);
1325     SB_PAGEUP: ScrollLeft := ScrollLeft - (ClientHeight div 2);
1326       // Scrolls to the current scroll bar position
1327     SB_THUMBPOSITION,
1328     SB_THUMBTRACK: ScrollLeft := Msg.Pos;
1329   end;
1330 end;
1331 
1332 procedure TMessagesCtrl.WMVScroll(var Msg: TLMScroll);
1333 begin
1334   case Msg.ScrollCode of
1335     // Scrolls to start / end of the text
1336     SB_TOP:        ScrollTop := 0;
1337     SB_BOTTOM:     ScrollTop := ScrollTopMax;
1338     {$IFDEF EnableMsgWndLineWrap}
1339     // Scrolls one line up / down
1340     SB_LINEDOWN:   ScrollTop := ScrollTop + 1;
1341     SB_LINEUP:     ScrollTop := ScrollTop - 1;
1342     {$ELSE}
1343       // Scrolls one line up / down
1344     SB_LINEDOWN:   ScrollTop := ScrollTop + ItemHeight div 2;
1345     SB_LINEUP:     ScrollTop := ScrollTop - ItemHeight div 2;
1346     {$ENDIF}
1347     // Scrolls one page of lines up / down
1348     SB_PAGEDOWN:   ScrollTop := ScrollTop + GetPageScroll;
1349     SB_PAGEUP:     ScrollTop := ScrollTop - GetPageScroll;
1350     // Scrolls to the current scroll bar position
1351     SB_THUMBPOSITION,
1352     SB_THUMBTRACK: ScrollTop := Msg.Pos;
1353     // Ends scrolling
1354     SB_ENDSCROLL:  SetCaptureControl(nil); // release scrollbar capture
1355   end;
1356 end;
1357 
1358 procedure TMessagesCtrl.WMMouseWheel(var Message: TLMMouseEvent);
1359 begin
1360   if Mouse.WheelScrollLines=-1 then
1361   begin
1362     // -1 : scroll by page
1363     ScrollTop := ScrollTop - (Message.WheelDelta * GetPageScroll) div 120;
1364   end else begin
1365     {$IFDEF EnableMsgWndLineWrap}
1366     // scrolling one line -> see SB_LINEDOWN and SB_LINEUP handler in WMVScroll
1367     ScrollTop := ScrollTop -
1368         (Message.WheelDelta * Mouse.WheelScrollLines) div 240;
1369     {$ELSE}
1370     // scrolling one line -> scroll half an item, see SB_LINEDOWN and SB_LINEUP
1371     // handler in WMVScroll
1372     ScrollTop := ScrollTop -
1373         (Message.WheelDelta * Mouse.WheelScrollLines*ItemHeight) div 240;
1374     {$ENDIF}
1375   end;
1376   Message.Result := 1;
1377 end;
1378 
1379 procedure TMessagesCtrl.WMSetFocus(var Message: TLMSetFocus);
1380 begin
1381   Invalidate;
1382   inherited;
1383 end;
1384 
1385 procedure TMessagesCtrl.WMKillFocus(var Message: TLMKillFocus);
1386 begin
1387   Invalidate;
1388   inherited;
1389 end;
1390 
1391 procedure TMessagesCtrl.ImageListChange(Sender: TObject);
1392 begin
1393   Invalidate;
1394 end;
1395 
1396 procedure TMessagesCtrl.OnIdle(Sender: TObject; var Done: Boolean);
1397 var
1398   View: TLMsgWndView;
1399   LineNumber: integer;
1400   i: Integer;
1401 begin
1402   //debugln(['TMessagesCtrl.OnIdle fLastLoSearchText=',fLastLoSearchText,' ',UTF8LowerCase(fSearchText)]);
1403   for i:=0 to ViewCount-1 do begin
1404     View:=Views[i];
1405     if not View.Filter.IsEqual(ActiveFilter) then begin
1406       View.EnterCriticalSection;
1407       try
1408         View.Filter:=ActiveFilter;
1409       finally
1410         View.LeaveCriticalSection;
1411       end;
1412       View.RebuildLines;
1413       CreateSourceMarks(View,0);
1414       UpdateScrollBar(true);
1415       Invalidate;
1416     end;
1417   end;
1418 
1419   if fLastLoSearchText<>UTF8LowerCase(fSearchText) then begin
1420     fLastLoSearchText:=UTF8LowerCase(FSearchText);
1421     if SearchNext(fLastSearchStartView,fLastSearchStartLine,false,true,
1422       View,LineNumber)
1423     then begin
1424       //debugln(['TMessagesCtrl.OnIdle search text found ',LineNumber]);
1425       Select(View,LineNumber,true,true);
1426     end else begin
1427       //debugln(['TMessagesCtrl.OnIdle search text not found']);
1428     end;
1429     Invalidate;
1430   end;
1431   IdleConnected:=false;
1432 end;
1433 
1434 procedure TMessagesCtrl.OnFilterChanged(Sender: TObject);
1435 begin
1436   IdleConnected:=true;
1437 end;
1438 
TMessagesCtrl.GetPageScrollnull1439 function TMessagesCtrl.GetPageScroll: integer;
1440 begin
1441   {$IFDEF EnableMsgWndLineWrap}
1442   Result:=Max(1,((ClientHeight-BorderWidth) div ItemHeight));
1443   {$ELSE}
1444   Result:=ClientHeight - ItemHeight;
1445   {$ENDIF}
1446 end;
1447 
GetSelectedLinenull1448 function TMessagesCtrl.GetSelectedLine: integer;
1449 // Return the first selected line number.
1450 begin
1451   if FSelectedLines.Count>0 then
1452     Result:=FSelectedLines[0]
1453   else
1454     Result:=-1;   // No selection.
1455 end;
1456 
1457 procedure TMessagesCtrl.CreateSourceMarks(View: TLMsgWndView;
1458   StartLineNumber: Integer);
1459 var
1460   i: Integer;
1461 begin
1462   if SourceMarks=nil then exit;
1463   for i:=StartLineNumber to View.Lines.Count-1 do
1464     CreateSourceMark(View.Lines[i],nil);
1465 end;
1466 
TMessagesCtrl.GetHeaderBackgroundnull1467 function TMessagesCtrl.GetHeaderBackground(aToolState: TLMVToolState): TColor;
1468 begin
1469   Result:=FHeaderBackground[aToolState];
1470 end;
1471 
1472 procedure TMessagesCtrl.CreateSourceMark(MsgLine: TMessageLine;
1473   aSynEdit: TSynEdit);
1474 var
1475   SourceMark: TETMark;
1476 begin
1477   if TLMsgViewLine(MsgLine).Mark<>nil then exit;
1478   if ord(MsgLine.Urgency)<ord(mluHint) then exit;
1479   SourceMark:=SourceMarks.CreateMark(MsgLine,aSynEdit);
1480   if SourceMark=nil then exit;
1481   TLMsgViewLine(MsgLine).Mark:=SourceMark;
1482 end;
1483 
TMessagesCtrl.GetUrgencyStylesnull1484 function TMessagesCtrl.GetUrgencyStyles(Urgency: TMessageLineUrgency
1485   ): TMsgCtrlUrgencyStyle;
1486 begin
1487   Result:=fUrgencyStyles[Urgency];
1488 end;
1489 
1490 procedure TMessagesCtrl.Notification(AComponent: TComponent;
1491   Operation: TOperation);
1492 begin
1493   inherited Notification(AComponent, Operation);
1494   if Operation=opRemove then begin
1495     if (AComponent is TLMsgWndView) and (FViews.IndexOf(AComponent)>=0) then begin
1496       if fLastSearchStartView=AComponent then
1497         fLastSearchStartView:=nil;
1498       if SelectedView=AComponent then
1499         FSelectedView:=nil;
1500       RemoveView(TLMsgWndView(AComponent));
1501     end
1502     else if AComponent=Images then
1503       Images:=nil
1504     else if AComponent=SourceMarks then
1505       SourceMarks:=nil;
1506   end;
1507 end;
1508 
1509 procedure TMessagesCtrl.Paint;
1510 var
1511   LoSearchText: string;
1512 
1513   procedure DrawText(ARect: TRect; aTxt: string; IsSelected: boolean;
1514     TxtColor: TColor);
1515   var
1516     Details: TThemedElementDetails;
1517     TextRect: TRect;
1518     p: SizeInt;
1519     LoTxt: String;
1520     aLeft: Integer;
1521     aRight: Integer;
1522     LastP: Integer;
1523   begin
1524     Canvas.Font.Color:=Font.Color;
1525     TextRect:=ARect;
1526     TextRect.Right:=TextRect.Left+Canvas.TextWidth(aTxt)+2;
1527     if IsSelected then begin
1528       if (mcsFocused in FStates) or (mcoAlwaysDrawFocused in Options) then
1529         Details:=ThemeServices.GetElementDetails(ttItemSelected)
1530       else
1531         Details:=ThemeServices.GetElementDetails(ttItemSelectedNotFocus);
1532       ThemeServices.DrawElement(Canvas.Handle, Details, TextRect, nil);
1533       TxtColor:=clDefault;
1534     end else
1535       Details:=ThemeServices.GetElementDetails(ttItemNormal);
1536     if LoSearchText<>'' then begin
1537       LoTxt:=UTF8LowerCase(aTxt);
1538       p:=1;
1539       LastP:=1;
1540       while p<=length(LoTxt) do begin
1541         p:=PosEx(LoSearchText,LoTxt,LastP);
1542         if p<1 then break;
1543         Canvas.Brush.Color:=clHighlight;
1544         aLeft:=TextRect.Left+Canvas.TextWidth(copy(ATxt,1,p-1));
1545         aRight:=aLeft+Canvas.TextWidth(copy(ATxt,p,length(LoSearchText)));
1546         Canvas.FillRect(aLeft,TextRect.Top+1,aRight,TextRect.Bottom-1);
1547         LastP:=p+length(LoSearchText);
1548       end;
1549       Canvas.Brush.Color:=BackgroundColor;
1550     end;
1551     if TxtColor=clDefault then
1552       ThemeServices.DrawText(Canvas, Details, ATxt, TextRect,
1553         DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0)
1554     else begin
1555       p:=(TextRect.Top+TextRect.Bottom-Canvas.TextHeight('Mg')) div 2;
1556       Canvas.Font.Color:=TxtColor;
1557       Canvas.TextOut(TextRect.Left+2,p,ATxt);
1558     end;
1559   end;
1560 
1561 var
1562   i: Integer;
1563   View: TLMsgWndView;
1564   y: Integer;
1565   j: Integer;
1566   Line: TMessageLine;
1567   Indent: Integer;
1568   NodeRect: TRect;
1569   ImgIndex: LongInt;
1570   IsSelected: Boolean;
1571   FirstLineIsNotSelectedMessage: Boolean;
1572   SecondLineIsNotSelectedMessage: Boolean;
1573   col: TColor;
1574   ImgRes: TScaledImageListResolution;
1575 begin
1576   if Focused then
1577     Include(FStates,mcsFocused)
1578   else
1579     Exclude(FStates,mcsFocused);
1580   //debugln(['TMessagesCtrl.Paint ',Focused,' CanFocus=',CanFocus,' TabStop=',TabStop]);
1581   LUIncreaseChangeStamp64(FPaintStamp);
1582 
1583   // paint background
1584   Canvas.Brush.Color:=BackgroundColor;
1585   Canvas.FillRect(0,0,ClientWidth,ClientHeight);
1586 
1587   Indent:=BorderWidth+2;
1588   LoSearchText:=fLastLoSearchText;
1589 
1590   // paint from top to bottom
1591   {$IFDEF EnableMsgWndLineWrap}
1592   y:=-ScrollTop*ItemHeight;
1593   {$ELSE}
1594   y:=-ScrollTop;
1595   {$ENDIF}
1596   for i:=0 to ViewCount-1 do begin
1597     if y>ClientHeight then break;
1598     View:=Views[i];
1599     if not View.HasContent then continue;
1600 
1601     View.FPaintStamp:=FPaintStamp;
1602     View.fPaintTop:=y;
1603 
1604     // draw header
1605     if (y+ItemHeight>0) and (y<ClientHeight) then begin
1606       // header text
1607       NodeRect:=Rect(0,y,ClientWidth,y+ItemHeight);
1608       Canvas.Brush.Color:=HeaderBackground[View.ToolState];
1609       Canvas.FillRect(NodeRect);
1610       Canvas.Pen.Style:=psDash;
1611       Canvas.Line(NodeRect.Left,NodeRect.Top,NodeRect.Right,NodeRect.Top);
1612       Canvas.Pen.Style:=psSolid;
1613       DrawText(NodeRect,GetHeaderText(View),
1614         (fSelectedView=View) and (FSelectedLines.IndexOf(-1)>=0),TextColor);
1615       Canvas.Brush.Color:=BackgroundColor;
1616     end;
1617     inc(y,ItemHeight);
1618 
1619     // draw lines
1620     j:=0;
1621     if y<0 then begin
1622       j:=Min((-y) div ItemHeight,View.Lines.Count);
1623       inc(y,j*ItemHeight);
1624     end;
1625     FirstLineIsNotSelectedMessage:=false;
1626     SecondLineIsNotSelectedMessage:=false;
1627     while (j<View.Lines.Count) and (y<ClientHeight) do begin
1628       Line:=View.Lines[j];
1629       NodeRect:=Rect(Indent,y,ClientWidth,y+ItemHeight);
1630       IsSelected:=(fSelectedView=View) and (FSelectedLines.IndexOf(j)>=0);
1631       if not IsSelected then begin
1632         if (y>-ItemHeight) and (y<=0) then
1633           FirstLineIsNotSelectedMessage:=true
1634         else if (y>0) and (y<=ItemHeight) then
1635           SecondLineIsNotSelectedMessage:=true;
1636       end;
1637       ImgIndex:=fUrgencyStyles[Line.Urgency].ImageIndex;
1638       if (Images<>nil) and (mcoShowMsgIcons in Options)
1639       and (ImgIndex>=0) and (ImgIndex<Images.Count) then begin
1640         ImgRes := Images.ResolutionForControl[0, Self];
1641         ImgRes.Draw(Canvas,
1642           NodeRect.Left + 1, (NodeRect.Top + NodeRect.Bottom - Images.Height) div 2,
1643           ImgIndex, gdeNormal);
1644         inc(NodeRect.Left, ImgRes.Width+2);
1645       end;
1646       // message text
1647       col:=UrgencyStyles[Line.Urgency].Color;
1648       if col=clDefault then
1649         col:=TextColor;
1650       DrawText(NodeRect,GetLineText(Line),IsSelected,col);
1651       inc(y,ItemHeight);
1652       inc(j);
1653     end;
1654     if FirstLineIsNotSelectedMessage and SecondLineIsNotSelectedMessage then begin
1655       // the first two lines are normal messages, not selected
1656       // => paint view header hint
1657       NodeRect:=Rect(0,0,ClientWidth,ItemHeight div 2);
1658       Canvas.Brush.Color:=HeaderBackground[View.ToolState];
1659       Canvas.Brush.Style:=bsSolid;
1660       Canvas.FillRect(NodeRect);
1661       NodeRect:=Rect(0,NodeRect.Bottom,ClientWidth,ItemHeight);
1662       Canvas.GradientFill(NodeRect,HeaderBackground[View.ToolState],
1663         AutoHeaderBackground,gdVertical);
1664       Canvas.Pen.Style:=psDash;
1665       NodeRect:=Rect(0,0,ClientWidth,ItemHeight);
1666       Canvas.Line(NodeRect.Left,NodeRect.Bottom,NodeRect.Right,NodeRect.Bottom);
1667       Canvas.Pen.Style:=psSolid;
1668       DrawText(NodeRect,'...'+GetHeaderText(View),false,TextColor);
1669       Canvas.Brush.Color:=BackgroundColor;
1670     end;
1671     inc(y,ItemHeight*(View.Lines.Count-j));
1672 
1673     // draw progress line
1674     if View.ProgressLine.Msg<>'' then begin
1675       if (y+ItemHeight>0) and (y<ClientHeight) then begin
1676         // progress text
1677         NodeRect:=Rect(Indent,y,ClientWidth,y+ItemHeight);
1678         col:=UrgencyStyles[View.ProgressLine.Urgency].Color;
1679         if col=clDefault then
1680           col:=TextColor;
1681         DrawText(NodeRect,View.ProgressLine.Msg,
1682           (fSelectedView=View) and (FSelectedLines.IndexOf(View.Lines.Count)>=0),col);
1683       end;
1684       inc(y,ItemHeight);
1685     end;
1686 
1687     View.fPaintBottom:=y;
1688   end;
1689 
1690   // call OnPaint
1691   inherited Paint;
1692 end;
1693 
1694 procedure TMessagesCtrl.UpdateScrollBar(InvalidateScrollMax: boolean);
1695 var
1696   ScrollInfo: TScrollInfo;
1697 begin
1698   if InvalidateScrollMax then begin
1699     fScrollTopMax:=-1;
1700   end;
1701   if not HandleAllocated then exit;
1702 
1703   ScrollInfo.cbSize := SizeOf(ScrollInfo);
1704   ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
1705   ScrollInfo.nMin := 0;
1706   ScrollInfo.nTrackPos := 0;
1707   ScrollInfo.nMax := ScrollTopMax+ClientHeight-1;
1708   if ClientHeight < 2 then
1709     ScrollInfo.nPage := 1
1710   else
1711     ScrollInfo.nPage := ClientHeight-1;
1712   if ScrollTop > ScrollTopMax then
1713     ScrollTop := ScrollTopMax;
1714   ScrollInfo.nPos := ScrollTop;
1715   //debugln(['TMessagesCtrl.UpdateScrollBar ScrollTop=',ScrollTop,' ScrollTopMax=',ScrollTopMax]);
1716   ShowScrollBar(Handle, SB_VERT, True);
1717   SetScrollInfo(Handle, SB_VERT, ScrollInfo, false);
1718 end;
1719 
1720 procedure TMessagesCtrl.CreateWnd;
1721 begin
1722   inherited CreateWnd;
1723   ItemHeight:=Canvas.TextHeight('Mg')+2;
1724   UpdateScrollBar(false);
1725 end;
1726 
1727 procedure TMessagesCtrl.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);
1728 begin
1729   inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
1730   UpdateScrollBar(true);
1731 end;
1732 {
1733 procedure TMessagesCtrl.MouseMove(Shift: TShiftState; X, Y: Integer);
1734 begin
1735   inherited MouseMove(Shift, X, Y);
1736   //Application.HideHint;
1737 end;
1738 }
1739 procedure TMessagesCtrl.MouseDown(Button: TMouseButton; Shift: TShiftState;
1740   X, Y: Integer);
1741 var
1742   View: TLMsgWndView;
1743   LineNumber: integer;
1744 begin
1745   if not Focused and CanFocus then
1746     SetFocus;
1747   inherited MouseDown(Button, Shift, X, Y);
1748   if GetLineAt(Y,View,LineNumber) then begin
1749     if not (Button in [mbLeft,mbRight]) then Exit;
1750     if ssCtrl in Shift then
1751       AddToSelection(View,LineNumber)
1752     else if ssShift in Shift then
1753       ExtendSelection(View,LineNumber)
1754     else begin
1755       if (Button=mbLeft)
1756       or (View<>SelectedView) or (FSelectedLines.IndexOf(LineNumber)=-1) then
1757       begin
1758         Select(View,LineNumber,true,true);
1759         StoreSelectedAsSearchStart;
1760       end;
1761       if (Button=mbRight) then Exit;
1762       if ((ssDouble in Shift) and (not (mcoSingleClickOpensFile in FOptions)))
1763       or ((mcoSingleClickOpensFile in FOptions) and ([ssDouble,ssTriple,ssQuad]*Shift=[]))
1764       then
1765         OpenSelection;
1766     end;
1767   end;
1768 end;
1769 
1770 procedure TMessagesCtrl.KeyDown(var Key: Word; Shift: TShiftState);
1771 begin
1772   inherited KeyDown(Key, Shift);
1773 
1774   case Key of
1775 
1776   VK_DOWN:
1777     begin
1778       SelectNextShown(+1);
1779       Key:=VK_UNKNOWN;
1780     end;
1781 
1782   VK_UP:
1783     begin
1784       SelectNextShown(-1);
1785       Key:=VK_UNKNOWN;
1786     end;
1787 
1788   VK_HOME:
1789     begin
1790       SelectFirst(true,true);
1791       Key:=VK_UNKNOWN;
1792     end;
1793 
1794   VK_END:
1795     begin
1796       SelectLast(true,true);
1797       Key:=VK_UNKNOWN;
1798     end;
1799 
1800   VK_PRIOR: // Page Up
1801     begin
1802       SelectNextShown(-Max(1,ClientHeight div ItemHeight));
1803       Key:=VK_UNKNOWN;
1804     end;
1805 
1806   VK_NEXT: // Page Down
1807     begin
1808       SelectNextShown(Max(1,ClientHeight div ItemHeight));
1809       Key:=VK_UNKNOWN;
1810     end;
1811   end;
1812 end;
1813 
1814 procedure TMessagesCtrl.DoOnShowHint(HintInfo: PHintInfo);
1815 var
1816   View: TLMsgWndView;
1817   Line: integer;
1818   MsgLine: TMessageLine;
1819   s: String;
1820 begin
1821   if GetLineAt(HintInfo^.CursorPos.Y,View,Line) then begin
1822     MsgLine:=nil;
1823     s:='';
1824     if Line<0 then
1825       s:=GetHeaderText(View)
1826     else if Line<View.Lines.Count then begin
1827       MsgLine:=View.Lines[Line];
1828     end else begin
1829       MsgLine:=View.ProgressLine;
1830     end;
1831     if MsgLine<>nil then begin
1832       s:=GetLineText(MsgLine);
1833       s+=LineEnding+LineEnding;
1834       s+=ExternalToolList.GetMsgHint(MsgLine.SubTool,MsgLine.MsgID);
1835     end;
1836     HintInfo^.HintStr:=s;
1837     HintInfo^.ReshowTimeout:=0;
1838     HintInfo^.HideTimeout:=5000;
1839   end;
1840   inherited DoOnShowHint(HintInfo);
1841 end;
1842 
1843 procedure TMessagesCtrl.DoAllViewsStopped;
1844 {off $DEFINE VerboseMsgFrame}
1845 
1846   {$IFDEF VerboseMsgFrame}
1847   procedure DbgViews;
1848   var
1849     i, j: Integer;
1850     View: TLMsgWndView;
1851     Tool: TAbstractExternalTool;
1852     SrcMsg: TMessageLine;
1853   begin
1854     debugln(['TMessagesCtrl.DoAllViewsStopped ']);
1855     debugln(['DbgViews===START========================================']);
1856     for i:=0 to ViewCount-1 do
1857     begin
1858       View:=Views[i];
1859       View.RebuildLines;
1860       Tool:=View.Tool;
1861       if Tool=nil then continue;
1862       debugln(['DbgViews ',i,'/',ViewCount,' Tool.Title=',Tool.Title]);
1863       Tool.EnterCriticalSection; // lock Tool before View
1864       try
1865         View.EnterCriticalSection;
1866         try
1867           for j:=0 to Tool.WorkerMessages.Count-1 do begin
1868             SrcMsg:=Tool.WorkerMessages[j];
1869             debugln(['WorkerMsg ',SrcMsg.Filename,'(',SrcMsg.Line,',',SrcMsg.Column,') ',UrgencyToStr(SrcMsg.Urgency),'/',SrcMsg.SubTool,': ',SrcMsg.Msg]);
1870           end;
1871           for j:=0 to View.Lines.Count-1 do begin
1872             SrcMsg:=View.Lines[j];
1873             debugln(['ViewMsg ',SrcMsg.Filename,'(',SrcMsg.Line,',',SrcMsg.Column,') ',UrgencyToStr(SrcMsg.Urgency),'/',SrcMsg.SubTool,': ',SrcMsg.Msg]);
1874           end;
1875         finally
1876           View.LeaveCriticalSection;
1877         end;
1878       finally
1879         Tool.LeaveCriticalSection;
1880       end;
1881     end;
1882     debugln(['DbgViews===END==========================================']);
1883   end;
1884   {$ENDIF}
1885 
1886 var
1887   CurLine: TMessageLine;
1888 begin
1889   if Assigned(OnAllViewsStopped) then
1890     OnAllViewsStopped(Self);
1891   if mcoAutoOpenFirstError in Options then begin
1892     CurLine:=GetSelectedMsg;
1893     if (CurLine<>nil) and (CurLine.Urgency>=mluError)
1894     and CurLine.HasSourcePosition then
1895       exit;
1896     if SelectFirstUrgentMessage(mluError,true) then
1897       OpenSelection;
1898   end;
1899   {$IFDEF VerboseMsgFrame}
1900   DbgViews;
1901   {$ENDIF}
1902 end;
1903 
TMessagesCtrl.SearchNextnull1904 function TMessagesCtrl.SearchNext(StartView: TLMsgWndView; StartLine: integer;
1905   SkipStart, Downwards: boolean; out View: TLMsgWndView; out LineNumber: integer
1906   ): boolean;
1907 var
1908   CurView: TLMsgWndView;
1909   CurLine: Integer;
1910   CurViewLineCnt: integer;
1911   Txt: String;
1912 
Nextnull1913   function Next: boolean;
1914   var
1915     i: Integer;
1916   begin
1917     if Downwards then begin
1918       inc(CurLine);
1919       if CurLine>=CurViewLineCnt then begin
1920         i:=IndexOfView(CurView);
1921         repeat
1922           inc(i);
1923           if i>=ViewCount then exit(false);
1924           CurView:=Views[i];
1925         until CurView.HasContent;
1926         CurLine:=-1;
1927         CurViewLineCnt:=CurView.GetShownLineCount(true,true);
1928       end;
1929     end else begin
1930       dec(CurLine);
1931       if CurLine<-1 then begin
1932         i:=IndexOfView(CurView);
1933         repeat
1934           dec(i);
1935           if i<0 then exit(false);
1936           CurView:=Views[i];
1937         until CurView.HasContent;
1938         CurViewLineCnt:=CurView.GetShownLineCount(true,true);
1939         CurLine:=CurViewLineCnt-1;
1940       end;
1941     end;
1942     Result:=true;
1943   end;
1944 
1945 begin
1946   Result:=false;
1947   View:=nil;
1948   LineNumber:=-1;
1949   if ViewCount=0 then exit;
1950   if StartView=nil then begin
1951     // use default start
1952     if Downwards then begin
1953       StartView:=Views[0];
1954       StartLine:=-1;
1955     end else begin
1956       StartView:=Views[ViewCount-1];
1957       StartLine:=StartView.GetShownLineCount(true,true);
1958     end;
1959   end;
1960   CurView:=StartView;
1961   CurLine:=StartLine;
1962   CurViewLineCnt:=CurView.GetShownLineCount(true,true);
1963   // skip invalid line numbers
1964   if CurLine<-1 then begin
1965     SkipStart:=false;
1966     if Downwards then
1967       CurLine:=-1
1968     else if not Next then
1969       exit;
1970   end else if CurLine>=CurViewLineCnt then begin
1971     SkipStart:=false;
1972     if Downwards then begin
1973       if not Next then exit;
1974     end else
1975       CurLine:=CurViewLineCnt-1;
1976   end;
1977   // skip invalid views
1978   if not CurView.HasContent then begin
1979     SkipStart:=false;
1980     if not Next then exit;
1981   end;
1982   // skip start
1983   if SkipStart then
1984     if not Next then exit;
1985   // search
1986   repeat
1987     if CurLine<0 then
1988       Txt:=GetHeaderText(CurView)
1989     else if CurLine<CurView.Lines.Count then
1990       Txt:=GetLineText(CurView.Lines[CurLine])
1991     else
1992       Txt:=CurView.ProgressLine.Msg;
1993     Txt:=UTF8LowerCase(Txt);
1994     if Pos(fLastLoSearchText,Txt)>0 then begin
1995       View:=CurView;
1996       LineNumber:=CurLine;
1997       exit(true);
1998     end;
1999   until not Next;
2000 end;
2001 
2002 procedure TMessagesCtrl.AddToSelection(View: TLMsgWndView; LineNumber: integer);
2003 var
2004   i: Integer;
2005 begin
2006   BeginUpdate;
2007   SelectedView:=View;
2008   if FSelectedLines.Count=0 then        // No existing selection.
2009     i:=-1
2010   else
2011     i:=FSelectedLines.IndexOf(LineNumber);
2012   if i=-1 then
2013     FSelectedLines.Add(LineNumber)
2014   else
2015     FSelectedLines.Delete(i);          // Was already selected -> toggle.
2016   Invalidate;
2017   EndUpdate;
2018 end;
2019 
2020 procedure TMessagesCtrl.ExtendSelection(View: TLMsgWndView; LineNumber: integer);
2021 var
2022   i: Integer;
2023   Empty: Boolean;
2024 begin
2025   BeginUpdate;
2026   SelectedView:=View;
2027   Empty:=FSelectedLines.Count=0;
2028   FSelectedLines.Count:=1; // Delete possible earlier selections except first one.
2029   if Empty then
2030     FSelectedLines[0]:=LineNumber  // No earlier selection.
2031   else if LineNumber<FSelectedLines[0] then
2032     for i:=LineNumber to FSelectedLines[0]-1 do
2033       FSelectedLines.Add(i)
2034   else if LineNumber>FSelectedLines[0] then
2035     for i:=FSelectedLines[0]+1 to LineNumber do
2036       FSelectedLines.Add(i);
2037   // if LineNumber=FSelectedLines[0] then do nothing.
2038   Invalidate;
2039   EndUpdate;
2040 end;
2041 
2042 procedure TMessagesCtrl.Select(View: TLMsgWndView; LineNumber: integer;
2043   DoScroll, FullyVisible: boolean);
2044 begin
2045   BeginUpdate;
2046   SelectedView:=View;
2047   SelectedLine1:=LineNumber;
2048   if DoScroll then
2049     ScrollToLine(SelectedView,LineNumber,FullyVisible);
2050   EndUpdate;
2051 end;
2052 
2053 procedure TMessagesCtrl.Select(Msg: TMessageLine; DoScroll: boolean);
2054 begin
2055   BeginUpdate;
2056   if (Msg=nil) or (Msg.Lines=nil) or not (Msg.Lines.Owner is TLMsgWndView) then
2057   begin
2058     SelectedView:=nil;
2059     FSelectedLines.Clear;
2060     Invalidate;
2061   end else begin
2062     SelectedView:=TLMsgWndView(Msg.Lines.Owner);
2063     SelectedLine1:=Msg.Index;
2064     if DoScroll then
2065       ScrollToLine(SelectedView,Msg.Index,true);
2066   end;
2067   EndUpdate;
2068 end;
2069 
TMessagesCtrl.SelectNextOccurrencenull2070 function TMessagesCtrl.SelectNextOccurrence(Downwards: boolean): boolean;
2071 var
2072   View: TLMsgWndView;
2073   LineNumber: integer;
2074 begin
2075   StoreSelectedAsSearchStart;
2076   Result:=SearchNext(SelectedView,SelectedLine1,true,Downwards,View,LineNumber);
2077   if not Result then exit;
2078   Select(View,LineNumber,true,true);
2079 end;
2080 
TMessagesCtrl.SelectNextShownnull2081 function TMessagesCtrl.SelectNextShown(Offset: integer): boolean;
2082 // returns true if selection changed
2083 var
2084   View: TLMsgWndView;
2085   Line: Integer;
2086   i: Integer;
2087 begin
2088   Result:=false;
2089   {$IFDEF VerboseMsgCtrlSelectNextShown}
2090   debugln(['TMessagesCtrl.SelectNextShown START']);
2091   {$ENDIF}
2092   while Offset<>0 do begin
2093     {$IFDEF VerboseMsgCtrlSelectNextShown}
2094     debugln(['TMessagesCtrl.SelectNextShown LOOP Offset=',Offset,
2095              ' ViewIndex=',IndexOfView(SelectedView),' Line=',SelectedLine]);
2096     {$ENDIF}
2097     if SelectedView=nil then begin
2098       if Offset>0 then begin
2099         SelectFirst(true,true);
2100         dec(Offset);
2101       end else begin
2102         SelectLast(true,true);
2103         Inc(Offset);
2104       end;
2105       Result:=true;
2106     end else begin
2107       View:=SelectedView;
2108       Line:=SelectedLine1;
2109       if Offset>0 then begin
2110         {$IFDEF VerboseMsgCtrlSelectNextShown}
2111         debugln(['TMessagesCtrl.SelectNextShown NEXT View.GetShownLineCount(false,true)=',
2112                  View.GetShownLineCount(false,true),' ViewIndex=',IndexOfView(View),' Line=',Line]);
2113         {$ENDIF}
2114         inc(Line,Offset);
2115         if Line<View.GetShownLineCount(false,true) then
2116           Offset:=0
2117         else begin
2118           // next view
2119           Offset:=Line-View.GetShownLineCount(false,true);
2120           i:=IndexOfView(View);
2121           {$IFDEF VerboseMsgCtrlSelectNextShown}
2122           debugln(['TMessagesCtrl.SelectNextShown Line=',Line,' Offset=',Offset,' ViewIndex=',i]);
2123           {$ENDIF}
2124           repeat
2125             inc(i);
2126             if i>=ViewCount then begin
2127               {$IFDEF VerboseMsgCtrlSelectNextShown}
2128               debugln(['TMessagesCtrl.SelectNextShown can not go further down']);
2129               {$ENDIF}
2130               exit;
2131             end;
2132             View:=Views[i];
2133           until View.HasContent;
2134           Line:=-1;
2135         end;
2136       end else begin
2137         inc(Line,Offset);
2138         if Line>=-1 then
2139           Offset:=0
2140         else begin
2141           // previous view
2142           Offset:=Line+2;
2143           i:=IndexOfView(View);
2144           repeat
2145             dec(i);
2146             if i<0 then begin
2147               {$IFDEF VerboseMsgCtrlSelectNextShown}
2148               debugln(['TMessagesCtrl.SelectNextShown can not go further up']);
2149               {$ENDIF}
2150               exit;
2151             end;
2152             View:=Views[i];
2153           until View.HasContent;
2154           Line:=View.GetShownLineCount(true,true)-1;
2155         end;
2156       end;
2157       {$IFDEF VerboseMsgCtrlSelectNextShown}
2158       debugln(['TMessagesCtrl.SelectNextShown SELECT Offset=',Offset,' ViewIndex=',IndexOfView(View),' Line=',Line]);
2159       {$ENDIF}
2160       Select(View,Line,true,true);
2161       Result:=true;
2162     end;
2163   end;
2164   {$IFDEF VerboseMsgCtrlSelectNextShown}
2165   debugln(['TMessagesCtrl.SelectNextShown END ViewIndex=',IndexOfView(SelectedView),' Line=',SelectedLine]);
2166   {$ENDIF}
2167 end;
2168 
SelectLastnull2169 function TMessagesCtrl.SelectLast(DoScroll, FullyVisible: boolean): boolean;
2170 var
2171   i: Integer;
2172 begin
2173   i:=ViewCount-1;
2174   while (i>=0) do begin
2175     if Views[i].HasContent then begin
2176       Select(Views[i],Views[i].GetShownLineCount(true,true)-1,DoScroll,FullyVisible);
2177       exit(true);
2178     end;
2179     dec(i);
2180   end;
2181   Result:=false;
2182 end;
2183 
TMessagesCtrl.SelectFirstnull2184 function TMessagesCtrl.SelectFirst(DoScroll, FullyVisible: boolean): boolean;
2185 var
2186   i: Integer;
2187 begin
2188   i:=0;
2189   while (i<ViewCount) do begin
2190     if Views[i].HasContent then begin
2191       Select(Views[i],-1,DoScroll,FullyVisible);
2192       exit(true);
2193     end;
2194     inc(i);
2195   end;
2196   Result:=false;
2197 end;
2198 
GetSelectedMsgnull2199 function TMessagesCtrl.GetSelectedMsg: TMessageLine;
2200 // Return the first selected message.
2201 var
2202   View: TLMsgWndView;
2203   Line: Integer;
2204 begin
2205   Result:=nil;
2206   View:=SelectedView;
2207   if View=nil then exit;
2208   Line:=SelectedLine1;
2209   if (Line<0) then exit;
2210   if Line<View.Lines.Count then
2211     Result:=View.Lines[Line]
2212   else if View.ProgressLine.Msg<>'' then begin
2213     Assert((Line=View.Lines.Count), 'TMessagesCtrl.GetSelectedMsg: Line is too big.');
2214     Result:=View.ProgressLine;
2215   end;
2216 end;
2217 
SearchNextUrgentnull2218 function TMessagesCtrl.SearchNextUrgent(StartView: TLMsgWndView;
2219   StartLine: integer; SkipStart, Downwards: boolean;
2220   aMinUrgency: TMessageLineUrgency; WithSrcPos: boolean; out
2221   View: TLMsgWndView; out LineNumber: integer): boolean;
2222 var
2223   CurView: TLMsgWndView;
2224   CurLine: Integer;
2225   CurViewLineCnt: integer;
2226   MsgLine: TMessageLine;
2227 
Nextnull2228   function Next: boolean;
2229   var
2230     i: Integer;
2231   begin
2232     if Downwards then begin
2233       inc(CurLine);
2234       if CurLine>=CurViewLineCnt then begin
2235         i:=IndexOfView(CurView);
2236         repeat
2237           inc(i);
2238           if i>=ViewCount then exit(false);
2239           CurView:=Views[i];
2240         until CurView.HasContent;
2241         CurLine:=-1;
2242         CurViewLineCnt:=CurView.GetShownLineCount(true,true);
2243       end;
2244     end else begin
2245       dec(CurLine);
2246       if CurLine<-1 then begin
2247         i:=IndexOfView(CurView);
2248         repeat
2249           dec(i);
2250           if i<0 then exit(false);
2251           CurView:=Views[i];
2252         until CurView.HasContent;
2253         CurViewLineCnt:=CurView.GetShownLineCount(true,true);
2254         CurLine:=CurViewLineCnt-1;
2255       end;
2256     end;
2257     Result:=true;
2258   end;
2259 
2260 begin
2261   Result:=false;
2262   View:=nil;
2263   LineNumber:=-1;
2264   if ViewCount=0 then exit;
2265   if StartView=nil then begin
2266     // use default start
2267     if Downwards then begin
2268       StartView:=Views[0];
2269       StartLine:=-1;
2270     end else begin
2271       StartView:=Views[ViewCount-1];
2272       StartLine:=StartView.GetShownLineCount(true,true);
2273     end;
2274   end;
2275   CurView:=StartView;
2276   CurLine:=StartLine;
2277   CurViewLineCnt:=CurView.GetShownLineCount(true,true);
2278   // skip invalid line numbers
2279   if CurLine<-1 then begin
2280     SkipStart:=false;
2281     if Downwards then
2282       CurLine:=-1
2283     else if not Next then
2284       exit;
2285   end else if CurLine>=CurViewLineCnt then begin
2286     SkipStart:=false;
2287     if Downwards then begin
2288       if not Next then exit;
2289     end else
2290       CurLine:=CurViewLineCnt-1;
2291   end;
2292   // skip invalid views
2293   if not CurView.HasContent then begin
2294     SkipStart:=false;
2295     if not Next then exit;
2296   end;
2297   // skip start
2298   if SkipStart then
2299     if not Next then exit;
2300   // search
2301   repeat
2302     if (CurLine>=0) and (CurLine<CurView.Lines.Count) then begin
2303       MsgLine:=CurView.Lines[CurLine];
2304       if MsgLine.Urgency>=aMinUrgency then begin
2305         if (not WithSrcPos) or MsgLine.HasSourcePosition then begin
2306           View:=CurView;
2307           LineNumber:=CurLine;
2308           exit(true);
2309         end;
2310       end;
2311     end;
2312   until not Next;
2313 end;
2314 
SelectFirstUrgentMessagenull2315 function TMessagesCtrl.SelectFirstUrgentMessage(
2316   aMinUrgency: TMessageLineUrgency; WithSrcPos: boolean): boolean;
2317 var
2318   View: TLMsgWndView;
2319   LineNumber: integer;
2320 begin
2321   Result:=false;
2322   if ViewCount=0 then exit;
2323   if not SearchNextUrgent(nil,0,false,true,aMinUrgency,WithSrcPos,View,LineNumber)
2324   then exit;
2325   Select(View,LineNumber,true,true);
2326   Result:=true;
2327 end;
2328 
TMessagesCtrl.SelectNextUrgentMessagenull2329 function TMessagesCtrl.SelectNextUrgentMessage(aMinUrgency: TMessageLineUrgency;
2330   WithSrcPos: boolean; Downwards: boolean): boolean;
2331 var
2332   View: TLMsgWndView;
2333   LineNumber: integer;
2334 begin
2335   Result:=false;
2336   if not SearchNextUrgent(SelectedView,SelectedLine1,true,Downwards,
2337     aMinUrgency,WithSrcPos,View,LineNumber)
2338   then exit;
2339   Select(View,LineNumber,true,true);
2340   Result:=true;
2341 end;
2342 
IsLineVisiblenull2343 function TMessagesCtrl.IsLineVisible(View: TLMsgWndView; LineNumber: integer): boolean;
2344 var
2345   y: Integer;
2346 begin
2347   Result:=false;
2348   if View=nil then exit;
2349   y:=GetLineTop(View,LineNumber,true);
2350   if (y+ItemHeight>0) and (y<ClientHeight) then
2351     Result:=true;
2352 end;
2353 
IsLastLineVisiblenull2354 function TMessagesCtrl.IsLastLineVisible(View: TLMsgWndView): boolean;
2355 var
2356   LineNumber: Integer;
2357 begin
2358   LineNumber:=View.GetShownLineCount(false,true)-1;
2359   Result:=IsLineVisible(View,LineNumber);
2360 end;
2361 
TMessagesCtrl.GetLineTextnull2362 function TMessagesCtrl.GetLineText(Line: TMessageLine): string;
2363 begin
2364   // 'filename(line,column) '
2365   case FilenameStyle of
2366   mwfsShort: Result:=Line.GetShortFilename;
2367   mwfsRelative: Result:=Line.GetRelativeFilename
2368   else Result:=Line.GetFullFilename;
2369   end;
2370   if Line.Line>0 then begin
2371     Result+='('+IntToStr(Line.Line)+','+IntToStr(Line.Column)+')';
2372   end;
2373   if Result<>'' then
2374     Result+=' ';
2375 
2376   // 'error: '
2377   if Line.Urgency<>mluImportant then
2378     Result+=UrgencyToStr(Line.Urgency)+': ';
2379 
2380   // message id
2381   if (mcoShowMessageID in Options) and (Line.MsgID<>0) then
2382    Result+='('+IntToStr(Line.MsgID)+') ';
2383 
2384   // message
2385   if (mcoShowTranslated in Options) and (Line.TranslatedMsg<>'') then
2386     Result+=Line.TranslatedMsg
2387   else
2388     Result+=Line.Msg;
2389 end;
2390 
GetStatsnull2391 function GetStats(Lines: TMessageLines): string;
2392 var
2393   ErrCnt, WarnCnt, HintCnt: Integer;
2394   c: TMessageLineUrgency;
2395 begin
2396   Result:='';
2397   ErrCnt:=0;
2398   WarnCnt:=0;
2399   HintCnt:=0;
2400   for c:=Low(Lines.UrgencyCounts) to high(Lines.UrgencyCounts) do begin
2401     //debugln(['GetStats cat=',dbgs(c),' count=',Lines.UrgencyCounts[c]]);
2402     if c>=mluError then
2403       inc(ErrCnt,Lines.UrgencyCounts[c])
2404     else if c=mluWarning then
2405       inc(WarnCnt,Lines.UrgencyCounts[c])
2406     else if c in [mluHint,mluNote] then
2407       inc(HintCnt,Lines.UrgencyCounts[c]);
2408   end;
2409   if ErrCnt>0 then
2410     Result+=Format(lisErrors2, [IntToStr(ErrCnt)]);
2411   if WarnCnt>0 then
2412     Result+=Format(lisWarnings, [IntToStr(WarnCnt)]);
2413   if HintCnt>0 then
2414     Result+=Format(lisHints, [IntToStr(HintCnt)]);
2415 end;
2416 
TMessagesCtrl.GetHeaderTextnull2417 function TMessagesCtrl.GetHeaderText(View: TLMsgWndView): string;
2418 begin
2419   Result:=View.Caption;
2420   if Result='' then
2421     Result:=lisMenuViewMessages;
2422   if View.SummaryMsg<>'' then
2423     Result+=': '+View.SummaryMsg;
2424   if mcoShowStats in Options then begin
2425     Result+=GetStats(View.Lines);
2426   end;
2427 end;
2428 
TMessagesCtrl.FindUnfinishedViewnull2429 function TMessagesCtrl.FindUnfinishedView: TLMsgWndView;
2430 var
2431   i: Integer;
2432 begin
2433   for i:=0 to ViewCount-1 do begin
2434     Result:=Views[i];
2435     //debugln(['TMessagesCtrl.FindUnfinishedView ',i,' ',ViewCount,' caption="',Result.Caption,'" Result.Tool=',dbgsname(Result.Tool)]);
2436     if not Result.HasFinished then exit;
2437   end;
2438   Result:=nil;
2439 end;
2440 
GetLastViewWithContentnull2441 function TMessagesCtrl.GetLastViewWithContent: TLMsgWndView;
2442 var
2443   i: Integer;
2444 begin
2445   i:=ViewCount-1;
2446   while i>=0 do begin
2447     Result:=Views[i];
2448     if Result.HasContent then exit;
2449     dec(i);
2450   end;
2451   Result:=nil;
2452 end;
2453 
2454 procedure TMessagesCtrl.ScrollToLine(View: TLMsgWndView; LineNumber: integer;
2455   FullyVisible: boolean);
2456 var
2457   y: Integer;
2458   MinScrollTop: integer;
2459   MaxScrollTop: Integer;
2460 begin
2461   {$IFDEF EnableMsgWndLineWrap}
2462   {$ELSE}
2463   y:=GetLineTop(View,LineNumber,false);
2464   if FullyVisible then begin
2465     MinScrollTop:=Max(0,y+ItemHeight-ClientHeight);
2466     MaxScrollTop:=y;
2467   end else begin
2468     MinScrollTop:=Max(0,y-1-ClientHeight);
2469     MaxScrollTop:=y+ItemHeight-1;
2470   end;
2471   {$ENDIF}
2472   //debugln(['TMessagesCtrl.ScrollToLine ',LineNumber,' y=',y,' Min=',MinScrollTop,' Max=',MaxScrollTop]);
2473   y:=Max(Min(ScrollTop,MaxScrollTop),MinScrollTop);
2474   //debugln(['TMessagesCtrl.ScrollToLine y=',y,' ScrollTopMax=',ScrollTopMax]);
2475   ScrollTop:=y;
2476 end;
2477 
GetLineTopnull2478 function TMessagesCtrl.GetLineTop(View: TLMsgWndView; LineNumber: integer;
2479   Scrolled: boolean): integer;
2480 var
2481   i: Integer;
2482   CurView: TLMsgWndView;
2483 begin
2484   Result:=0;
2485   if View=nil then exit;
2486   for i:=0 to ViewCount-1 do begin
2487     CurView:=Views[i];
2488     if CurView=View then break;
2489     inc(Result,ItemHeight*CurView.GetShownLineCount(true,true));
2490   end;
2491   if LineNumber<0 then begin
2492     // header
2493   end else if LineNumber<View.Lines.Count then begin
2494     // normal messages
2495     inc(Result,(LineNumber+1)*ItemHeight);
2496   end else begin
2497     // last line
2498     inc(Result,(View.Lines.Count+1)*ItemHeight);
2499   end;
2500   if Scrolled then
2501     dec(Result,ScrollTop);
2502 end;
2503 
2504 constructor TMessagesCtrl.Create(AOwner: TComponent);
2505 var
2506   u: TMessageLineUrgency;
2507 begin
2508   inherited Create(AOwner);
2509   ControlStyle:=ControlStyle-[csCaptureMouse]+[csReflector];
2510   FOptions:=MCDefaultOptions;
2511   Filters.OnChanged:=@OnFilterChanged;
2512   FActiveFilter:=Filters[0];
2513   FViews:=TFPList.Create;
2514   FSelectedLines:=TIntegerList.Create;
2515   FUpdateTimer:=TTimer.Create(Self);
2516   FUpdateTimer.Name:='MsgUpdateTimer';
2517   FUpdateTimer.Interval:=200;
2518   FUpdateTimer.OnTimer:=@MsgUpdateTimerTimer;
2519   FItemHeight:=20;
2520   FSelectedView:=nil;
2521   BorderWidth:=0;
2522   fBackgroundColor:=MsgWndDefBackgroundColor;
2523   FHeaderBackground[lmvtsRunning]:=MsgWndDefHeaderBackgroundRunning;
2524   FHeaderBackground[lmvtsSuccess]:=MsgWndDefHeaderBackgroundSuccess;
2525   FHeaderBackground[lmvtsFailed]:=MsgWndDefHeaderBackgroundFailed;
2526   FAutoHeaderBackground:=MsgWndDefAutoHeaderBackground;
2527   FTextColor:=MsgWndDefTextColor;
2528   TabStop:=True;
2529   ParentColor:=False;
2530   FImageChangeLink:=TChangeLink.Create;
2531   FImageChangeLink.OnChange:=@ImageListChange;
2532   for u:=Low(TMessageLineUrgency) to high(TMessageLineUrgency) do
2533     fUrgencyStyles[u]:=TMsgCtrlUrgencyStyle.Create(Self,u);
2534   ShowHint:=true;
2535 end;
2536 
2537 destructor TMessagesCtrl.Destroy;
2538 var
2539   u: TMessageLineUrgency;
2540 begin
2541   IdleConnected:=false;
2542   Images:=nil;
2543   ClearViews(false);
2544 
2545   FreeAndNil(FSelectedLines);
2546   FreeAndNil(FViews);
2547   FreeAndNil(FUpdateTimer);
2548   FreeAndNil(FImageChangeLink);
2549   for u:=Low(TMessageLineUrgency) to high(TMessageLineUrgency) do
2550     FreeAndNil(fUrgencyStyles[u]);
2551   inherited Destroy;
2552 end;
2553 
2554 procedure TMessagesCtrl.BeginUpdate;
2555 begin
2556   inc(fUpdateLock);
2557 end;
2558 
2559 procedure TMessagesCtrl.EndUpdate;
2560 begin
2561   if fUpdateLock=0 then
2562     raise Exception.Create('');
2563   dec(fUpdateLock);
2564 end;
2565 
2566 procedure TMessagesCtrl.EraseBackground(DC: HDC);
2567 begin
2568   // everything is painted, so erasing the background is not needed
2569 end;
2570 
2571 procedure TMessagesCtrl.ApplyEnvironmentOptions;
2572 var
2573   NewOptions: TMsgCtrlOptions;
2574   u: TMessageLineUrgency;
2575 
2576   procedure SetOption(Option: TMsgCtrlOption; State: boolean);
2577   begin
2578     if State then
2579       NewOptions:=NewOptions+[Option]
2580     else
2581       NewOptions:=NewOptions-[Option];
2582   end;
2583 
2584 begin
2585   for u in TMessageLineUrgency do
2586     UrgencyStyles[u].Color:=EnvironmentOptions.MsgColors[u];
2587   BackgroundColor:=EnvironmentOptions.MsgViewColors[mwBackground];
2588   AutoHeaderBackground:=EnvironmentOptions.MsgViewColors[mwAutoHeader];
2589   HeaderBackground[lmvtsRunning]:=EnvironmentOptions.MsgViewColors[mwRunning];
2590   HeaderBackground[lmvtsSuccess]:=EnvironmentOptions.MsgViewColors[mwSuccess];
2591   HeaderBackground[lmvtsFailed]:=EnvironmentOptions.MsgViewColors[mwFailed];
2592   TextColor:=EnvironmentOptions.MsgViewColors[mwTextColor];
2593   NewOptions:=Options;
2594   SetOption(mcoSingleClickOpensFile,not EnvironmentOptions.MsgViewDblClickJumps);
2595   SetOption(mcoShowMsgIcons,EnvironmentOptions.ShowMessagesIcons);
2596   SetOption(mcoShowTranslated,EnvironmentOptions.MsgViewShowTranslations);
2597   SetOption(mcoAlwaysDrawFocused,EnvironmentOptions.MsgViewAlwaysDrawFocused);
2598   Options:=NewOptions;
2599   FilenameStyle:=EnvironmentOptions.MsgViewFilenameStyle;
2600 end;
2601 
IndexOfViewnull2602 function TMessagesCtrl.IndexOfView(View: TLMsgWndView): integer;
2603 begin
2604   Result:=FViews.IndexOf(View);
2605 end;
2606 
2607 procedure TMessagesCtrl.ClearViews(OnlyFinished: boolean);
2608 var
2609   i: Integer;
2610   View: TLMsgWndView;
2611 begin
2612   if OnlyFinished then begin
2613     for i:=ViewCount-1 downto 0 do begin
2614       if i>=ViewCount then continue;
2615       View:=Views[i];
2616       if View.HasFinished then
2617         View.Free;
2618     end;
2619   end else begin
2620     while ViewCount>0 do
2621       Views[0].Free;
2622   end;
2623 end;
2624 
2625 procedure TMessagesCtrl.RemoveView(View: TLMsgWndView);
2626 begin
2627   if FViews.IndexOf(View)<0 then exit;
2628   FViews.Remove(View);
2629   View.FControl:=nil;
2630   View.OnChanged:=nil;
2631   if fLastSearchStartView=View then
2632     fLastSearchStartView:=nil;
2633   if SelectedView=View then
2634     SelectedView:=nil;
2635   UpdateScrollBar(true);
2636   Invalidate;
2637 end;
2638 
GetViewnull2639 function TMessagesCtrl.GetView(aCaption: string; CreateIfNotExist: boolean
2640   ): TLMsgWndView;
2641 var
2642   i: Integer;
2643 begin
2644   for i:=0 to ViewCount-1 do begin
2645     Result:=Views[i];
2646     if UTF8CompareStr(aCaption,Result.Caption)=0 then exit;
2647   end;
2648   if not CreateIfNotExist then
2649     exit(nil);
2650   Result:=TLMsgWndView.Create(Self);
2651   Result.FControl:=Self;
2652   Result.Caption:=aCaption;
2653   Result.Filter.Assign(ActiveFilter);
2654   FViews.Add(Result);
2655   FreeNotification(Result);
2656   Result.OnChanged:=@OnViewChanged;
2657   fSomeViewsRunning:=true;
2658 end;
2659 
GetLineAtnull2660 function TMessagesCtrl.GetLineAt(Y: integer; out View: TLMsgWndView;
2661   out Line: integer): boolean;
2662 var
2663   i: Integer;
2664 begin
2665   for i:=0 to ViewCount-1 do begin
2666     View:=Views[i];
2667     if View.FPaintStamp<>FPaintStamp then continue;
2668     if (View.fPaintTop>Y) or (View.fPaintBottom<Y) then continue;
2669     Line:=((Y-View.fPaintTop) div ItemHeight)-1;
2670     Result:=true;
2671     exit;
2672   end;
2673   View:=nil;
2674   Line:=-1;
2675   Result:=false;
2676 end;
2677 
ScrollLeftMaxnull2678 function TMessagesCtrl.ScrollLeftMax: integer;
2679 begin
2680   Result:=0;
2681 end;
2682 
ScrollTopMaxnull2683 function TMessagesCtrl.ScrollTopMax: integer;
2684 var
2685   i: Integer;
2686   View: TLMsgWndView;
2687 begin
2688   if fScrollTopMax<0 then begin
2689     fScrollTopMax:=0;
2690     for i:=0 to ViewCount-1 do begin
2691       View:=Views[i];
2692       inc(fScrollTopMax,View.GetShownLineCount(true,true)*ItemHeight);
2693     end;
2694     fScrollTopMax:=Max(0,fScrollTopMax-ClientHeight);
2695   end;
2696   Result:=fScrollTopMax;
2697 end;
2698 
2699 procedure TMessagesCtrl.StoreSelectedAsSearchStart;
2700 begin
2701   fLastLoSearchText:=UTF8LowerCase(FSearchText);
2702   fLastSearchStartView:=FSelectedView;
2703   fLastSearchStartLine:=SelectedLine1;
2704 end;
2705 
TMessagesCtrl.OpenSelectionnull2706 function TMessagesCtrl.OpenSelection: boolean;
2707 var
2708   Msg: TMessageLine;
2709 begin
2710   Result:=false;
2711   if not Assigned(OnOpenMessage) then exit;
2712   Msg:=GetSelectedMsg;
2713   if Msg=nil then exit;
2714   Result:=OnOpenMessage(Self,Msg);
2715 end;
2716 
2717 procedure TMessagesCtrl.CreateMarksForFile(aSynEdit: TSynEdit;
2718   aFilename: string; DeleteOld: boolean);
2719 var
2720   i: Integer;
2721   Lines: TMessageLines;
2722   Line: TMessageLine;
2723 begin
2724   if DeleteOld then
2725     SourceMarks.RemoveMarks(aSynEdit);
2726   for i:=0 to ViewCount-1 do begin
2727     Lines:=Views[i].Lines;
2728     for Line in Lines.EnumerateFile(aFilename,0,High(Integer)) do begin
2729       //debugln(['TMessagesCtrl.CreateMarksForFile ',GetLineText(Line)]);
2730       CreateSourceMark(Line,aSynEdit);
2731     end;
2732   end;
2733 end;
2734 
ApplySrcChangesnull2735 function TMessagesCtrl.ApplySrcChanges(Changes: TETSingleSrcChanges): boolean;
2736 var
2737   i: Integer;
2738 begin
2739   Result:=false;
2740   //debugln(['TMessagesCtrl.ApplySrcChanges ViewCount=',ViewCount]);
2741   for i:=0 to ViewCount-1 do
2742     if Views[i].ApplySrcChanges(Changes) then
2743       Result:=true;
2744   if Result then
2745     Invalidate;
2746 end;
2747 
2748 { TMessagesFrame }
2749 
2750 procedure TMessagesFrame.MsgCtrlPopupMenuPopup(Sender: TObject);
2751 
2752   procedure UpdateRemoveCompOptHideMsgItems;
2753   var
2754     i: Integer;
2755     View: TLMsgWndView;
2756     ToolData: TIDEExternalToolData;
2757     IDETool: TObject;
2758     CompOpts: TBaseCompilerOptions;
2759     Flag: PCompilerMsgIdFlag;
2760     Pattern: String;
2761     Pkg: TIDEPackage;
2762     Cnt: Integer;
2763     Item: TIDEMenuCommand;
2764     ModuleName: String;
2765   begin
2766     // create one menuitem per compiler option
2767     Cnt:=0;
2768     for i:=0 to ViewCount-1 do begin
2769       View:=Views[i];
2770       if View.Tool=nil then continue;
2771       ToolData:=TIDEExternalToolData(View.Tool.Data);
2772       if not (ToolData is TIDEExternalToolData) then continue;
2773       IDETool:=ExternalToolList.GetIDEObject(ToolData);
2774       if IDETool=nil then continue;
2775       if IDETool is TLazProject then begin
2776         CompOpts:=TLazProject(IDETool).LazCompilerOptions as TBaseCompilerOptions;
2777         ModuleName:=lisProjectOption;
2778       end else if IDETool is TIDEPackage then begin
2779         Pkg:=TIDEPackage(IDETool);
2780         CompOpts:=Pkg.LazCompilerOptions as TBaseCompilerOptions;
2781         ModuleName:=Format(lisPackageOption, [Pkg.Name]);
2782       end else
2783         continue;
2784       for Flag in CompOpts.IDEMessageFlags do begin
2785         if Flag^.Flag<>cfvHide then continue;
2786         if Cnt>=MsgRemoveCompOptHideMenuSection.Count then begin
2787           Item:=RegisterIDEMenuCommand(MsgRemoveCompOptHideMenuSection,'RemoveCompOptHideMsg'+IntToStr(Cnt),'');
2788           Item.OnClick:=@RemoveCompOptHideMsgClick;
2789         end else begin
2790           Item:=MsgRemoveCompOptHideMenuSection.Items[Cnt] as TIDEMenuCommand;
2791         end;
2792         Item.Tag:=Flag^.MsgId;
2793         Item.UserTag:=PtrUInt(ToolData);
2794         Pattern:=GetMsgPattern(SubToolFPC,Flag^.MsgID,true,40);
2795         Item.Caption:=ModuleName+': '+Pattern;
2796         inc(Cnt);
2797       end;
2798     end;
2799     MsgRemoveCompOptHideMenuSection.Visible:=Cnt>0;
2800     // delete old menu items
2801     while MsgRemoveCompOptHideMenuSection.Count>Cnt do
2802       MsgRemoveCompOptHideMenuSection[Cnt].Free;
2803   end;
2804 
2805   procedure UpdateRemoveMsgTypeFilterItems;
2806   var
2807     FilterItem: TLMVFilterMsgType;
2808     i: Integer;
2809     Item: TIDEMenuCommand;
2810     Cnt: Integer;
2811   begin
2812     // create one menuitem per filter item
2813     Cnt:=MessagesCtrl.ActiveFilter.FilterMsgTypeCount;
2814     MsgRemoveMsgTypeFilterMenuSection.Visible:=Cnt>0;
2815     for i:=0 to Cnt-1 do begin
2816       if i>=MsgRemoveFilterMsgOneTypeMenuSection.Count then begin
2817         Item:=RegisterIDEMenuCommand(MsgRemoveFilterMsgOneTypeMenuSection,'MsgRemoveMsgOfTypeFilter'+IntToStr(i),'');
2818         Item.Tag:=i;
2819         Item.OnClick:=@RemoveFilterMsgTypeClick;
2820       end else
2821         Item:=MsgRemoveFilterMsgOneTypeMenuSection.Items[i] as TIDEMenuCommand;
2822       FilterItem:=MessagesCtrl.ActiveFilter.FilterMsgTypes[i];
2823       Item.Caption:=GetMsgPattern(FilterItem.SubTool,FilterItem.MsgID,true,40);
2824     end;
2825     // delete old menu items
2826     while MsgRemoveFilterMsgOneTypeMenuSection.Count>Cnt do
2827       MsgRemoveFilterMsgOneTypeMenuSection[Cnt].Free;
2828     MsgRemoveFilterAllMsgTypesMenuItem.OnClick:=@ClearFilterMsgTypesMenuItemClick;
2829   end;
2830 
2831   procedure UpdateFilterItems;
2832   var
2833     i: Integer;
2834     Filter: TLMsgViewFilter;
2835     Item: TIDEMenuCommand;
2836     Cnt: Integer;
2837   begin
2838     Cnt:=MessagesCtrl.Filters.Count;
2839     for i:=0 to Cnt-1 do begin
2840       Filter:=MessagesCtrl.Filters[i];
2841       if i>=MsgSelectFilterMenuSection.Count then begin
2842         Item:=RegisterIDEMenuCommand(MsgSelectFilterMenuSection,'MsgSelectFilter'+IntToStr(i),'');
2843         Item.Tag:=i;
2844         Item.OnClick:=@OnSelectFilterClick;
2845       end else
2846         Item:=MsgSelectFilterMenuSection[i] as TIDEMenuCommand;
2847       Item.Caption:=Filter.Caption;
2848       Item.Checked:=Filter=MessagesCtrl.ActiveFilter;
2849     end;
2850     // delete old menu items
2851     while MsgSelectFilterMenuSection.Count>Cnt do
2852       MsgSelectFilterMenuSection[Cnt].Free;
2853 
2854     MsgAddFilterMenuItem.OnClick:=@AddFilterMenuItemClick;
2855   end;
2856 
2857   procedure UpdateQuickFixes(CurLine: TMessageLine);
2858   begin
2859     // delete old
2860     MsgQuickFixMenuSection.Clear;
2861     // create items
2862     if CurLine<>nil then begin
2863       IDEQuickFixes.SetMsgLines(CurLine);
2864       IDEQuickFixes.OnPopupMenu(MsgQuickFixMenuSection);
2865     end;
2866     MsgQuickFixMenuSection.Visible:=MsgQuickFixMenuSection.Count>0;
2867   end;
2868 
2869 var
2870   View: TLMsgWndView;
2871   MinUrgency: TMessageLineUrgency;
2872   ToolData: TIDEExternalToolData;
2873   Line: TMessageLine;
2874   i, LineNumber, VisibleCnt: Integer;
2875   HasText, HasFilename, HasViewContent, Running, CanFilterMsgType: Boolean;
2876   MsgType, ToolOptionsCaption: String;
2877 begin
2878   MessagesMenuRoot.MenuItem:=MsgCtrlPopupMenu.Items;
2879   //MessagesMenuRoot.BeginUpdate;
2880   try
2881     HasText:=false;
2882     HasFilename:=false;
2883     MsgType:='';
2884     CanFilterMsgType:=false;
2885     Line:=nil;
2886     HasViewContent:=false;
2887     Running:=false;
2888 
2889     // check all
2890     for i:=0 to MessagesCtrl.ViewCount-1 do begin
2891       View:=MessagesCtrl.Views[i];
2892       if View.HasContent then
2893         HasViewContent:=true;
2894       if View.Running then
2895         Running:=true;
2896     end;
2897 
2898     MsgFindMenuItem.OnClick:=@FindMenuItemClick;
2899 
2900     // check selection
2901     View:=MessagesCtrl.SelectedView;
2902     if View<>nil then begin
2903       for i:=0 to MessagesCtrl.FSelectedLines.Count-1 do begin
2904         LineNumber:=MessagesCtrl.FSelectedLines[i];
2905         if LineNumber=-1 then Continue;            // header
2906         if LineNumber=View.Lines.Count then
2907           Line:=View.ProgressLine                  // progress line
2908         else
2909           Line:=View.Lines[LineNumber];            // normal messages
2910         if Line.Filename<>'' then
2911           HasFilename:=True;
2912         if Line.Msg<>'' then
2913           HasText:=True;
2914         if (Line.SubTool<>'') and (Line.MsgID<>0) then begin
2915           MsgType:=GetMsgPattern(Line.SubTool,Line.MsgID,true,40);
2916           CanFilterMsgType:=ord(Line.Urgency)<ord(mluError);
2917         end;
2918       end;
2919     end else begin
2920       // no line selected => use last visible View
2921       View:=MessagesCtrl.GetLastViewWithContent;
2922     end;
2923     ToolOptionsCaption:='';
2924 
2925     // About
2926     if View<>nil then
2927     begin
2928       MsgAboutToolMenuItem.Caption:=Format(lisAbout2, [View.Caption]);
2929       MsgAboutSection.Visible:=true;
2930       if (View.Tool<>nil) and (View.Tool.Data is TIDEExternalToolData) then begin
2931         ToolData:=TIDEExternalToolData(View.Tool.Data);
2932         if ToolData.Kind=IDEToolCompilePackage then
2933           ToolOptionsCaption:=Format(lisCPOpenPackage, [ToolData.ModuleName]);
2934       end;
2935     end else
2936       MsgAboutSection.Visible:=false;
2937     MsgAboutToolMenuItem.OnClick:=@AboutToolMenuItemClick;
2938     VisibleCnt:=1;
2939     MsgOpenToolOptionsMenuItem.Visible:=ToolOptionsCaption<>'';
2940     if MsgOpenToolOptionsMenuItem.Visible then
2941     begin
2942       inc(VisibleCnt);
2943       //only assign caption if it is not empty to avoid its "unlocalizing",
2944       //this is visible e.g. in EditorToolBar menu tree
2945       MsgOpenToolOptionsMenuItem.Caption:=ToolOptionsCaption;
2946     end
2947     else
2948       //assign default caption if item is not visible (needed for EditorToolBar)
2949       MsgOpenToolOptionsMenuItem.Caption:=lisOpenToolOptions;
2950     MsgOpenToolOptionsMenuItem.OnClick:=@OpenToolsOptionsMenuItemClick;
2951     MsgAboutSection.ChildrenAsSubMenu:=VisibleCnt>1;
2952 
2953     // Filtering
2954     if CanFilterMsgType then begin
2955       MsgFilterMsgOfTypeMenuItem.Caption:=Format(lisFilterAllMessagesOfType, [MsgType]);
2956       MsgFilterMsgOfTypeMenuItem.Visible:=true;
2957     end else begin
2958       //assign default caption if item is not visible (needed for EditorToolBar)
2959       MsgFilterMsgOfTypeMenuItem.Caption:=lisFilterAllMessagesOfCertainType;
2960       MsgFilterMsgOfTypeMenuItem.Visible:=false;
2961     end;
2962     MsgFilterMsgOfTypeMenuItem.OnClick:=@FilterMsgOfTypeMenuItemClick;
2963     MsgFilterHintsWithoutPosMenuItem.Checked:=MessagesCtrl.ActiveFilter.FilterNotesWithoutPos;
2964     MsgFilterHintsWithoutPosMenuItem.OnClick:=@FilterHintsWithoutPosMenuItemClick;
2965 
2966     MinUrgency:=MessagesCtrl.ActiveFilter.MinUrgency;
2967     MsgFilterNoneMenuItem.Checked:=MinUrgency in [mluNone..mluDebug];
2968     MsgFilterNoneMenuItem.OnClick:=@FilterUrgencyMenuItemClick;
2969     MsgFilterDebugMenuItem.Checked:=MinUrgency in [mluVerbose3..mluVerbose];
2970     MsgFilterDebugMenuItem.OnClick:=@FilterUrgencyMenuItemClick;
2971     MsgFilterVerboseMenuItem.Checked:=MinUrgency=mluHint;
2972     MsgFilterVerboseMenuItem.OnClick:=@FilterUrgencyMenuItemClick;
2973     MsgFilterHintsMenuItem.Checked:=MinUrgency=mluNote;
2974     MsgFilterHintsMenuItem.OnClick:=@FilterUrgencyMenuItemClick;
2975     MsgFilterNotesMenuItem.Checked:=MinUrgency in [mluWarning..mluImportant];
2976     MsgFilterNotesMenuItem.OnClick:=@FilterUrgencyMenuItemClick;
2977     MsgFilterWarningsMenuItem.Checked:=MinUrgency>=mluError;
2978     MsgFilterWarningsMenuItem.OnClick:=@FilterUrgencyMenuItemClick;
2979 
2980     // Copying
2981     MsgCopyMsgMenuItem.Enabled:=HasText;
2982     MsgCopyMsgMenuItem.OnClick:=@CopyMsgMenuItemClick;
2983     MsgCopyFilenameMenuItem.Enabled:=HasFilename;
2984     MsgCopyFilenameMenuItem.OnClick:=@CopyFilenameMenuItemClick;
2985     MsgCopyAllMenuItem.Enabled:=not Running;
2986     MsgCopyAllMenuItem.OnClick:=@CopyAllMenuItemClick;
2987     MsgCopyShownMenuItem.Enabled:=HasViewContent;
2988     MsgCopyShownMenuItem.OnClick:=@CopyShownMenuItemClick;
2989 
2990     // Saving
2991     MsgSaveAllToFileMenuItem.Enabled:=not Running;
2992     MsgSaveAllToFileMenuItem.OnClick:=@SaveAllToFileMenuItemClick;
2993     MsgSaveShownToFileMenuItem.Enabled:=HasViewContent;
2994     MsgSaveShownToFileMenuItem.OnClick:=@SaveShownToFileMenuItemClick;
2995     MsgHelpMenuItem.Enabled:=HasText;
2996     MsgHelpMenuItem.OnClick:=@HelpMenuItemClick;
2997     MsgEditHelpMenuItem.OnClick:=@EditHelpMenuItemClick;
2998     MsgClearMenuItem.OnClick:=@ClearMenuItemClick;
2999     MsgClearMenuItem.Enabled:=View<>nil;
3000 
3001     // Options
3002     MsgWndStayOnTopMenuItem.Checked:=mcoWndStayOnTop in MessagesCtrl.Options;
3003     MsgWndStayOnTopMenuItem.OnClick:=@WndStayOnTopMenuItemClick;
3004     MsgFileStyleShortMenuItem.Checked:=MessagesCtrl.FilenameStyle=mwfsShort;
3005     MsgFileStyleShortMenuItem.OnClick:=@FileStyleMenuItemClick;
3006     MsgFileStyleRelativeMenuItem.Checked:=MessagesCtrl.FilenameStyle=mwfsRelative;
3007     MsgFileStyleRelativeMenuItem.OnClick:=@FileStyleMenuItemClick;
3008     MsgFileStyleFullMenuItem.Checked:=MessagesCtrl.FilenameStyle=mwfsFull;
3009     MsgFileStyleFullMenuItem.OnClick:=@FileStyleMenuItemClick;
3010 
3011     MsgTranslateMenuItem.Checked:=mcoShowTranslated in MessagesCtrl.Options;
3012     MsgTranslateMenuItem.OnClick:=@TranslateMenuItemClick;
3013     MsgShowIDMenuItem.Checked:=mcoShowMessageID in MessagesCtrl.Options;
3014     MsgShowIDMenuItem.OnClick:=@ShowIDMenuItemClick;
3015     MsgMoreOptionsMenuItem.OnClick:=@MoreOptionsMenuItemClick;
3016 
3017     UpdateRemoveCompOptHideMsgItems;
3018     UpdateRemoveMsgTypeFilterItems;
3019     UpdateFilterItems;
3020 
3021     UpdateQuickFixes(Line);
3022   finally
3023     //MessagesMenuRoot.EndUpdate;
3024   end;
3025 end;
3026 
3027 procedure TMessagesFrame.OnSelectFilterClick(Sender: TObject);
3028 var
3029   Filter: TLMsgViewFilter;
3030   Item: TIDEMenuCommand;
3031 begin
3032   Item:=Sender as TIDEMenuCommand;
3033   Filter:=MessagesCtrl.Filters.GetFilter(Item.Caption,false);
3034   if Filter=nil then exit;
3035   MessagesCtrl.ActiveFilter:=Filter;
3036 end;
3037 
3038 procedure TMessagesFrame.OpenToolsOptionsMenuItemClick(Sender: TObject);
3039 var
3040   View: TLMsgWndView;
3041   ToolData: TIDEExternalToolData;
3042 begin
3043   View:=GetAboutView;
3044   if (View=nil) or (View.Tool=nil) then exit;
3045   ToolData:=TIDEExternalToolData(View.Tool.Data);
3046   if not (ToolData is TIDEExternalToolData) then exit;
3047   if ToolData.Kind=IDEToolCompilePackage then begin
3048     PackageEditingInterface.DoOpenPackageFile(ToolData.Filename,
3049                                               [pofAddToRecent],false);
3050   end;
3051 end;
3052 
3053 procedure TMessagesFrame.RemoveCompOptHideMsgClick(Sender: TObject);
3054 var
3055   Item: TIDEMenuCommand;
3056   MsgId: Integer;
3057   ToolData: TIDEExternalToolData;
3058   IDETool: TObject;
3059   CompOpts: TLazCompilerOptions;
3060   Pkg: TIDEPackage;
3061 begin
3062   if not (Sender is TIDEMenuCommand) then exit;
3063   Item:=TIDEMenuCommand(Sender);
3064   MsgId:=Item.Tag;
3065   ToolData:=TIDEExternalToolData(Item.UserTag);
3066   IDETool:=ExternalToolList.GetIDEObject(ToolData);
3067   if IDETool=nil then exit;
3068   if IDETool is TLazProject then begin
3069     CompOpts:=TLazProject(IDETool).LazCompilerOptions;
3070     CompOpts.MessageFlags[MsgID]:=cfvNone;
3071   end else if IDETool is TIDEPackage then begin
3072     if PackageEditingInterface.DoOpenPackageFile(ToolData.Filename,
3073                                         [pofAddToRecent],false)<>mrOk then exit;
3074     Pkg:=PackageEditingInterface.FindPackageWithName(ToolData.ModuleName);
3075     if Pkg=nil then exit;
3076     CompOpts:=Pkg.LazCompilerOptions;
3077     CompOpts.MessageFlags[MsgID]:=cfvNone;
3078   end;
3079 end;
3080 
3081 procedure TMessagesFrame.SaveAllToFileMenuItemClick(Sender: TObject);
3082 begin
3083   SaveClicked(false);
3084 end;
3085 
3086 procedure TMessagesFrame.SaveShownToFileMenuItemClick(Sender: TObject);
3087 begin
3088   SaveClicked(true);
3089 end;
3090 
3091 procedure TMessagesFrame.SearchEditChange(Sender: TObject);
3092 var
3093   s: TCaption;
3094 begin
3095   s:=SearchEdit.Text;
3096   MessagesCtrl.SearchText:=s;
3097 end;
3098 
3099 procedure TMessagesFrame.SearchEditKeyDown(Sender: TObject; var Key: Word;
3100   Shift: TShiftState);
3101 begin
3102   if (Key=VK_ESCAPE) then
3103     HideSearch;
3104 end;
3105 
3106 procedure TMessagesFrame.SearchNextSpeedButtonClick(Sender: TObject);
3107 begin
3108   MessagesCtrl.SelectNextOccurrence(true);
3109 end;
3110 
3111 procedure TMessagesFrame.SearchPrevSpeedButtonClick(Sender: TObject);
3112 begin
3113   MessagesCtrl.SelectNextOccurrence(false);
3114 end;
3115 
3116 procedure TMessagesFrame.ShowIDMenuItemClick(Sender: TObject);
3117 begin
3118   if mcoShowMessageID in MessagesCtrl.Options then
3119     MessagesCtrl.Options:=MessagesCtrl.Options-[mcoShowMessageID]
3120   else
3121     MessagesCtrl.Options:=MessagesCtrl.Options+[mcoShowMessageID];
3122 end;
3123 
3124 procedure TMessagesFrame.SrcEditLinesChanged(Sender: TObject);
3125 begin
3126   //debugln(['TMessagesFrame.SrcEditLinesChanged ',DbgSName(Sender)]);
3127   if Sender is TETSynPlugin then
3128     ApplySrcChanges(TETSynPlugin(Sender).Changes);
3129 end;
3130 
3131 procedure TMessagesFrame.TranslateMenuItemClick(Sender: TObject);
3132 begin
3133   if mcoShowTranslated in MessagesCtrl.Options then
3134     MessagesCtrl.Options:=MessagesCtrl.Options-[mcoShowTranslated]
3135   else
3136     MessagesCtrl.Options:=MessagesCtrl.Options+[mcoShowTranslated];
3137   EnvironmentOptions.MsgViewShowTranslations:=mcoShowTranslated in MessagesCtrl.Options;
3138 end;
3139 
3140 procedure TMessagesFrame.RemoveFilterMsgTypeClick(Sender: TObject);
3141 var
3142   i: PtrInt;
3143 begin
3144   i:=TIDEMenuCommand(Sender).Tag;
3145   if i<MessagesCtrl.ActiveFilter.FilterMsgTypeCount then
3146     MessagesCtrl.ActiveFilter.DeleteFilterMsgType(i);
3147 end;
3148 
3149 procedure TMessagesFrame.WndStayOnTopMenuItemClick(Sender: TObject);
3150 begin
3151   if mcoWndStayOnTop in MessagesCtrl.Options then
3152     MessagesCtrl.Options:=MessagesCtrl.Options-[mcoWndStayOnTop]
3153   else
3154     MessagesCtrl.Options:=MessagesCtrl.Options+[mcoWndStayOnTop];
3155   EnvironmentOptions.MsgViewStayOnTop:=mcoWndStayOnTop in MessagesCtrl.Options;
3156 end;
3157 
AllMessagesAsStringnull3158 function TMessagesFrame.AllMessagesAsString(const OnlyShown: boolean): String;
3159 var
3160   Tool: TAbstractExternalTool;
3161   View: TLMsgWndView;
3162   s: String;
3163   i, j: Integer;
3164 begin
3165   s:='';
3166   for i:=0 to MessagesCtrl.ViewCount-1 do begin
3167     View:=MessagesCtrl.Views[i];
3168     if OnlyShown or (View.Tool=nil) then begin
3169       // save shown messages
3170       if not View.HasContent then continue;
3171       s+=MessagesCtrl.GetHeaderText(View)+LineEnding;
3172       for j:=0 to View.Lines.Count-1 do
3173         s+=MessagesCtrl.GetLineText(View.Lines[j])+LineEnding;
3174     end else begin
3175       // save raw data
3176       if View.Running then continue;
3177       Tool:=View.Tool;
3178       Tool.EnterCriticalSection;
3179       try
3180         for j:=0 to Tool.WorkerOutput.Count-1 do
3181           s+=Tool.WorkerOutput[j]+LineEnding;
3182       finally
3183         Tool.LeaveCriticalSection;
3184       end;
3185     end;
3186   end;
3187   Result:=s;
3188 end;
3189 
GetAboutViewnull3190 function TMessagesFrame.GetAboutView: TLMsgWndView;
3191 begin
3192   Result:=MessagesCtrl.SelectedView;
3193   if Result=nil then
3194     Result:=MessagesCtrl.GetLastViewWithContent;
3195 end;
3196 
3197 procedure TMessagesFrame.CopyFilenameMenuItemClick(Sender: TObject);
3198 begin
3199   CopyMsgToClipboard(true);
3200 end;
3201 
3202 procedure TMessagesFrame.CopyMsgMenuItemClick(Sender: TObject);
3203 begin
3204   CopyMsgToClipboard(false);
3205 end;
3206 
3207 procedure TMessagesFrame.CopyAllMenuItemClick(Sender: TObject);
3208 begin
3209   CopyAllClicked(false);
3210 end;
3211 
3212 procedure TMessagesFrame.CopyShownMenuItemClick(Sender: TObject);
3213 begin
3214   CopyAllClicked(true);
3215 end;
3216 
3217 procedure TMessagesFrame.EditHelpMenuItemClick(Sender: TObject);
3218 begin
3219   ShowMessageHelpEditor;
3220 end;
3221 
3222 procedure TMessagesFrame.FileStyleMenuItemClick(Sender: TObject);
3223 begin
3224   if Sender=MsgFileStyleShortMenuItem then
3225     MessagesCtrl.FilenameStyle:=mwfsShort
3226   else if Sender=MsgFileStyleRelativeMenuItem then
3227     MessagesCtrl.FilenameStyle:=mwfsRelative
3228   else if Sender=MsgFileStyleFullMenuItem then
3229     MessagesCtrl.FilenameStyle:=mwfsFull;
3230   EnvironmentOptions.MsgViewFilenameStyle:=MessagesCtrl.FilenameStyle;
3231 end;
3232 
3233 procedure TMessagesFrame.FindMenuItemClick(Sender: TObject);
3234 begin
3235   MessagesCtrl.StoreSelectedAsSearchStart;
3236   SearchPanel.Visible:=true;
3237   SearchEdit.SetFocus;
3238 end;
3239 
3240 procedure TMessagesFrame.HelpMenuItemClick(Sender: TObject);
3241 begin
3242   ExecuteIDECommand(Self, ecContextHelp);
3243 end;
3244 
3245 procedure TMessagesFrame.FilterHintsWithoutPosMenuItemClick(Sender: TObject);
3246 begin
3247   MessagesCtrl.ActiveFilter.FilterNotesWithoutPos:=not MessagesCtrl.ActiveFilter.FilterNotesWithoutPos;
3248 end;
3249 
3250 procedure TMessagesFrame.FilterMsgOfTypeMenuItemClick(Sender: TObject);
3251 var
3252   Line: TMessageLine;
3253 begin
3254   Line:=MessagesCtrl.GetSelectedMsg;
3255   if (Line=nil) or (ord(Line.Urgency)>=ord(mluError)) then exit;
3256   MessagesCtrl.ActiveFilter.AddFilterMsgType(Line.SubTool,Line.MsgID);
3257 end;
3258 
3259 procedure TMessagesFrame.FilterUrgencyMenuItemClick(Sender: TObject);
3260 var
3261   MinUrgency: TMessageLineUrgency;
3262 begin
3263   //debugln(['TMessagesFrame.FilterUrgencyMenuItemClick ',DbgSName(Sender),' ',(Sender as TIDEMenuCommand).Caption,' ',(Sender as TIDEMenuCommand).Checked]);
3264   if Sender=MsgFilterWarningsMenuItem then
3265     MinUrgency:=mluError
3266   else if Sender=MsgFilterNotesMenuItem then
3267     MinUrgency:=mluWarning
3268   else if Sender=MsgFilterHintsMenuItem then
3269     MinUrgency:=mluNote
3270   else if Sender=MsgFilterVerboseMenuItem then
3271     MinUrgency:=mluHint
3272   else if Sender=MsgFilterDebugMenuItem then
3273     MinUrgency:=mluVerbose3
3274   else {if Sender=MsgFilterNoneMenuItem then}
3275     MinUrgency:=mluNone;
3276   MessagesCtrl.ActiveFilter.MinUrgency:=MinUrgency;
3277   //debugln(['TMessagesFrame.FilterUrgencyMenuItemClick ',MessageLineUrgencyNames[MinUrgency]]);
3278 end;
3279 
3280 procedure TMessagesFrame.HideSearchSpeedButtonClick(Sender: TObject);
3281 begin
3282   HideSearch;
3283 end;
3284 
3285 procedure TMessagesFrame.ImagesGetWidthForPPI(Sender: TCustomImageList;
3286   AImageWidth, APPI: Integer; var AResultWidth: Integer);
3287 begin
3288   if (16<=AResultWidth) and (AResultWidth<=20) then
3289     AResultWidth := 16;
3290 end;
3291 
3292 procedure TMessagesFrame.MoreOptionsMenuItemClick(Sender: TObject);
3293 begin
3294   LazarusIDE.DoOpenIDEOptions(TMsgWndOptionsFrame);
3295 end;
3296 
3297 procedure TMessagesFrame.AboutToolMenuItemClick(Sender: TObject);
3298 var
3299   View: TLMsgWndView;
3300   Form: TForm;
3301   s: String;
3302   Tool: TAbstractExternalTool;
3303   Proc: TProcessUTF8;
3304   Memo: TMemo;
3305   i: Integer;
3306 begin
3307   View:=GetAboutView;
3308   if View=nil then exit;
3309   s:=View.Caption+LineEnding;
3310   s+=LineEnding;
3311   Tool:=View.Tool;
3312   if Tool<>nil then begin
3313     if Tool.Hint<>'' then
3314       s+=Tool.Hint+LineEnding+LineEnding;
3315     Proc:=Tool.Process;
3316     if Proc<>nil then begin
3317       if Proc.Executable<>'' then
3318         s+='Executable: '+LineEnding+Proc.Executable+LineEnding+LineEnding;
3319       if Proc.CurrentDirectory<>'' then begin
3320         if Tool.CurrentDirectoryIsTestDir then
3321           s+='CurrentDirectory is test build directory:'
3322         else
3323           s+='CurrentDirectory:';
3324         s+=LineEnding+Proc.CurrentDirectory+LineEnding+LineEnding;
3325       end;
3326       if Proc.Desktop<>'' then
3327         s+='Desktop: '+Proc.Desktop+LineEnding;
3328       if Tool.EnvironmentOverrides.Text<>'' then
3329         s+='Environment Overrides:'+LineEnding
3330           +Tool.EnvironmentOverrides.Text+LineEnding;
3331       s+='Parameters:'+LineEnding;
3332       s+=Proc.Parameters.Text+LineEnding;
3333       s+='Command Line:'+LineEnding;
3334       s+=StrToCmdLineParam(Tool.Process.Executable)+' '+MergeCmdLineParams(Tool.Process.Parameters)+LineEnding+LineEnding;
3335       s+='Parsers: ';
3336       if Tool.ParserCount=0 then
3337         s+='none'
3338       else begin
3339         for i:=0 to Tool.ParserCount-1 do begin
3340           if i>0 then s+=', ';
3341           s+=Tool.Parsers[i].GetLocalizedParserName;
3342         end;
3343       end;
3344       s+=LineEnding+LineEnding;
3345 
3346       s+='ProcessID:'+LineEnding+IntToStr(Proc.ProcessID)+LineEnding+LineEnding;
3347       if Tool.Terminated then
3348         s+='Terminated'+LineEnding+LineEnding
3349       else begin
3350         s+='ExitCode:'+LineEnding+IntToStr(Proc.ExitCode)+LineEnding;
3351         s+='ExitStatus:'+LineEnding+IntToStr(Proc.ExitStatus)+LineEnding+LineEnding;
3352       end;
3353     end;
3354     if Tool.ErrorMessage<>'' then
3355       s+=lisError+Tool.ErrorMessage+LineEnding+LineEnding;
3356   end;
3357 
3358   Form:=TForm.CreateNew(Self);
3359   try
3360     with Form do begin
3361       Name:='AboutExtToolDlg';
3362       Width:=500;
3363       Height:=300;
3364       Position:=poScreenCenter;
3365       Caption:=Format(lisAbout2, [View.Caption]);
3366     end;
3367 
3368     Memo:=TMemo.Create(Form);
3369     with Memo do begin
3370       Name:='Memo';
3371       Lines.Text:=s;
3372       Align:=alClient;
3373       WordWrap:=true; // carbon requires this and it is a good idea in general
3374       ScrollBars:=ssVertical;
3375       ReadOnly:=true;
3376       Parent:=Form;
3377     end;
3378     Form.ShowModal;
3379   finally
3380     Form.Free;
3381   end;
3382 end;
3383 
3384 procedure TMessagesFrame.AddFilterMenuItemClick(Sender: TObject);
3385 var
3386   aCaption: String;
3387   i: Integer;
3388   NewFilter: TLMsgViewFilter;
3389   Filters: TLMsgViewFilters;
3390 begin
3391   aCaption:=lisFilter;
3392   i:=1;
3393   Filters:=MessagesCtrl.Filters;
3394   while Filters.GetFilter(aCaption+IntToStr(i),false)<>nil do
3395     inc(i);
3396   if not InputQuery(lisCreateFilter, lisCodeToolsDefsName, aCaption) then exit;
3397   aCaption:=UTF8Trim(aCaption,[]);
3398   if aCaption='' then exit;
3399   if Filters.GetFilter(aCaption,false)<>nil then begin
3400     IDEMessageDialog(lisFilterAlreadyExists, Format(
3401       lisAFilterWithTheNameAlreadyExists, [aCaption]), mtError, [mbCancel], '');
3402     exit;
3403   end;
3404   NewFilter:=Filters.GetFilter(aCaption,true);
3405   NewFilter.Assign(MessagesCtrl.ActiveFilter);
3406   MessagesCtrl.ActiveFilter:=NewFilter;
3407 end;
3408 
3409 procedure TMessagesFrame.ClearFilterMsgTypesMenuItemClick(Sender: TObject);
3410 begin
3411   MessagesCtrl.ActiveFilter.ClearFilterMsgTypes;
3412 end;
3413 
3414 procedure TMessagesFrame.ClearMenuItemClick(Sender: TObject);
3415 begin
3416   MessagesCtrl.ClearViews(true);
3417 end;
3418 
GetViewsnull3419 function TMessagesFrame.GetViews(Index: integer): TLMsgWndView;
3420 begin
3421   Result:=MessagesCtrl.Views[Index];
3422 end;
3423 
3424 procedure TMessagesFrame.HideSearch;
3425 begin
3426   SearchPanel.Visible:=false;
3427   MessagesCtrl.SearchText:='';
3428 end;
3429 
3430 procedure TMessagesFrame.SaveClicked(OnlyShown: boolean);
3431 var
3432   Dlg: TSaveDialog;
3433   s: String;
3434   Filename: String;
3435   fs: TFileStream;
3436 begin
3437   Dlg:=IDESaveDialogClass.Create(nil);
3438   try
3439     Dlg.Title:=lisSaveMessages;
3440     Dlg.FileName:='messages.txt';
3441     Dlg.Options:=Dlg.Options+[ofPathMustExist,ofCreatePrompt];
3442     InitIDEFileDialog(Dlg);
3443     if not Dlg.Execute then exit;
3444     Filename:=TrimAndExpandFilename(Dlg.FileName);
3445     if DirPathExistsCached(Filename) then exit;
3446 
3447     s:=AllMessagesAsString(OnlyShown);
3448 
3449     try
3450       fs:=TFileStream.Create(Filename,fmCreate);
3451       try
3452         if s<>'' then
3453           fs.Write(s[1],length(s));
3454       finally
3455         fs.Free;
3456       end;
3457     except
3458       on E: Exception do begin
3459         IDEMessageDialog(lisWriteError, Format(lisUnableToWriteFile2, [Filename]
3460           ),
3461           mtError, [mbCancel]);
3462       end;
3463     end;
3464 
3465   finally
3466     StoreIDEFileDialog(Dlg);
3467     Dlg.Free;
3468   end;
3469 end;
3470 
3471 procedure TMessagesFrame.CopyAllClicked(OnlyShown: boolean);
3472 var
3473   s: String;
3474   Msg: String;
3475 begin
3476   s:=AllMessagesAsString(OnlyShown);
3477   if length(s)>1000000 then begin
3478     if length(s)<10000 then
3479       Msg:=Format(lisByte, [IntToStr(length(s))])
3480     else if Length(s)<10000000 then
3481       Msg:=Format(lisKB, [IntToStr(length(s) div 1000)])
3482     else
3483       Msg:=Format(lisMB, [IntToStr(length(s) div 1000)]);
3484     if IDEMessageDialog(lisCCOWarningCaption, Format(
3485       lisThisWillPutALotOfTextOnTheClipboardProceed, [Msg, #13]),
3486       mtConfirmation,[mbYes,mbNo])<>mrYes then exit;
3487   end;
3488   Clipboard.AsText:=s;
3489 end;
3490 
3491 procedure TMessagesFrame.CopyMsgToClipboard(OnlyFilename: boolean);
3492 var
3493   View: TLMsgWndView;
3494   Line: TMessageLine;
3495   OrderedSelection: TIntegerList;
3496   i, LineNumber: Integer;
3497   Txt: String;
3498 begin
3499   Txt:='';
3500   View:=MessagesCtrl.SelectedView;
3501   if View=nil then exit;
3502   OrderedSelection:=TIntegerList.Create;
3503   try
3504     // The initially selected line is first in the list. The list is not sorted.
3505     // Here we need the line numbers sorted.
3506     OrderedSelection.Assign(MessagesCtrl.FSelectedLines);
3507     OrderedSelection.Sort;
3508     for i:=0 to OrderedSelection.Count-1 do begin
3509       LineNumber:=OrderedSelection[i];
3510       Assert(LineNumber<=View.Lines.Count, 'TMessagesFrame.CopyMsgToClipboard: LineNumber is too big.');
3511       if LineNumber=-1 then begin
3512         if OnlyFilename then
3513           Txt:=rsResourceFileName
3514         else
3515           Txt:=MessagesCtrl.GetHeaderText(View); // header
3516       end
3517       else begin
3518         if LineNumber=View.Lines.Count then
3519           Line:=View.ProgressLine                // progress line
3520         else
3521           Line:=View.Lines[LineNumber];          // normal messages
3522         if OnlyFilename then
3523           Txt+=Line.Filename
3524         else
3525           Txt+=MessagesCtrl.GetLineText(Line);
3526       end;
3527       if i<OrderedSelection.Count-1 then
3528         Txt+=LineEnding;
3529     end;
3530   finally
3531     OrderedSelection.Free;
3532   end;
3533   Clipboard.AsText:=Txt;
3534 end;
3535 
TMessagesFrame.GetMsgPatternnull3536 function TMessagesFrame.GetMsgPattern(SubTool: string; MsgId: integer;
3537   WithUrgency: boolean; MaxLen: integer): string;
3538 var
3539   Pattern: String;
3540   Urgency: TMessageLineUrgency;
3541 begin
3542   Result:=SubTool;
3543   if Result=SubToolFPC then
3544     Result:='';
3545   if (MsgID<>0) then
3546     Result+='('+IntToStr(MsgID)+')';
3547   Pattern:=ExternalToolList.GetMsgPattern(SubTool,MsgID,Urgency);
3548   if Pattern<>'' then
3549     Result+=' '+Pattern;
3550   if WithUrgency and (not (Urgency in [mluNone,mluImportant])) then
3551     Result:=MessagesCtrl.UrgencyToStr(Urgency)+': '+Result;
3552   if UTF8Length(Result)>MaxLen then
3553     Result:=UTF8Copy(Result,1,MaxLen)+'...';
3554 end;
3555 
3556 procedure TMessagesFrame.Notification(AComponent: TComponent;
3557   Operation: TOperation);
3558 begin
3559   inherited Notification(AComponent, Operation);
3560   if Operation=opRemove then begin
3561     if AComponent=MessagesCtrl then
3562       MessagesCtrl:=nil;
3563   end;
3564 end;
3565 
3566 constructor TMessagesFrame.Create(TheOwner: TComponent);
3567 var
3568   ImgIDInfo: Integer;
3569   ImgIDHint: Integer;
3570   ImgIDNote: Integer;
3571   ImgIDWarning: Integer;
3572   ImgIDError: Integer;
3573   ImgIDFatal: Integer;
3574 begin
3575   inherited Create(TheOwner);
3576 
3577   MessagesCtrl:=TMessagesCtrl.Create(Self);
3578   FImages := TLCLGlyphs.Create(Self);
3579   FImages.Width := 12;
3580   FImages.Height := 12;
3581   FImages.RegisterResolutions([12, 16, 24]);
3582   FImages.SetWidth100Suffix(16);
3583   FImages.OnGetWidthForPPI := @ImagesGetWidthForPPI;
3584   ImgIDInfo:=FImages.GetImageIndex('state_information');
3585   ImgIDHint:=FImages.GetImageIndex('state_hint');
3586   ImgIDNote:=FImages.GetImageIndex('state_note');
3587   ImgIDWarning:=FImages.GetImageIndex('state_warning');
3588   ImgIDError:=FImages.GetImageIndex('state_error');
3589   ImgIDFatal:=FImages.GetImageIndex('state_fatal');
3590   with MessagesCtrl do begin
3591     Name:='MessagesCtrl';
3592     Align:=alClient;
3593     Parent:=Self;
3594 
3595     UrgencyStyles[mluNone].SetValues('?',ImgIDInfo,EnvironmentOptions.MsgColors[mluNone]);
3596     UrgencyStyles[mluProgress].SetValues(lisPDProgress, ImgIDInfo,
3597       EnvironmentOptions.MsgColors[mluProgress]);
3598     UrgencyStyles[mluDebug].SetValues(lisDebug, ImgIDInfo,
3599       EnvironmentOptions.MsgColors[mluDebug]);
3600     UrgencyStyles[mluVerbose3].SetValues(lisExtremelyVerbose, ImgIDInfo,
3601       EnvironmentOptions.MsgColors[mluVerbose3]);
3602     UrgencyStyles[mluVerbose2].SetValues(lisVeryVerbose, ImgIDInfo,
3603       EnvironmentOptions.MsgColors[mluVerbose2]);
3604     UrgencyStyles[mluVerbose].SetValues(lisVerbose, ImgIDInfo,
3605       EnvironmentOptions.MsgColors[mluVerbose]);
3606     UrgencyStyles[mluHint].SetValues(lisHint, ImgIDHint,
3607       EnvironmentOptions.MsgColors[mluHint]);
3608     UrgencyStyles[mluNote].SetValues(lisNote, ImgIDNote,
3609       EnvironmentOptions.MsgColors[mluNote]);
3610     UrgencyStyles[mluWarning].SetValues(lisCCOWarningCaption, ImgIDWarning,
3611       EnvironmentOptions.MsgColors[mluWarning]);
3612     UrgencyStyles[mluImportant].SetValues(lisImportant, ImgIDInfo,
3613       EnvironmentOptions.MsgColors[mluImportant]);
3614     UrgencyStyles[mluError].SetValues(lisCCOErrorCaption, ImgIDError,
3615       EnvironmentOptions.MsgColors[mluError]);
3616     UrgencyStyles[mluFatal].SetValues(lisFatal, ImgIDFatal,
3617       EnvironmentOptions.MsgColors[mluFatal]);
3618     UrgencyStyles[mluPanic].SetValues(lisPanic, ImgIDFatal,
3619       EnvironmentOptions.MsgColors[mluPanic]);
3620     Images:=Self.FImages;
3621     PopupMenu:=MsgCtrlPopupMenu;
3622   end;
3623   MessagesCtrl.SourceMarks:=ExtToolsMarks;
3624 
3625   // search
3626   SearchPanel.Visible:=false; // by default the search is hidden
3627   HideSearchSpeedButton.Hint:=lisHideSearch;
3628   IDEImages.AssignImage(HideSearchSpeedButton, 'debugger_power');
3629   SearchNextSpeedButton.Hint:=lisUDSearchNextOccurrenceOfThisPhrase;
3630   IDEImages.AssignImage(SearchNextSpeedButton, 'callstack_bottom');
3631   SearchPrevSpeedButton.Hint:=lisUDSearchPreviousOccurrenceOfThisPhrase;
3632   IDEImages.AssignImage(SearchPrevSpeedButton, 'callstack_top');
3633   SearchEdit.TextHint:=lisUDSearch;
3634 end;
3635 
3636 destructor TMessagesFrame.Destroy;
3637 begin
3638   MessagesCtrl.BeginUpdate;
3639   ClearViews(false);
3640   inherited Destroy;
3641 end;
3642 
3643 procedure TMessagesFrame.ApplyIDEOptions;
3644 begin
3645   MessagesCtrl.ApplyEnvironmentOptions;
3646 end;
3647 
ViewCountnull3648 function TMessagesFrame.ViewCount: integer;
3649 begin
3650   Result:=MessagesCtrl.ViewCount;
3651 end;
3652 
GetViewnull3653 function TMessagesFrame.GetView(aCaption: string; CreateIfNotExist: boolean
3654   ): TLMsgWndView;
3655 begin
3656   Result:=MessagesCtrl.GetView(aCaption,CreateIfNotExist);
3657 end;
3658 
FindUnfinishedViewnull3659 function TMessagesFrame.FindUnfinishedView: TLMsgWndView;
3660 begin
3661   Result:=MessagesCtrl.FindUnfinishedView;
3662 end;
3663 
3664 procedure TMessagesFrame.DeleteView(View: TLMsgWndView);
3665 begin
3666   View.Free;
3667 end;
3668 
IndexOfViewnull3669 function TMessagesFrame.IndexOfView(View: TLMsgWndView): integer;
3670 begin
3671   Result:=MessagesCtrl.IndexOfView(View);
3672 end;
3673 
3674 procedure TMessagesFrame.ClearViews(OnlyFinished: boolean);
3675 begin
3676   MessagesCtrl.ClearViews(OnlyFinished);
3677 end;
3678 
3679 procedure TMessagesFrame.CreateMarksForFile(aSynEdit: TSynEdit;
3680   aFilename: string; DeleteOld: boolean);
3681 begin
3682   MessagesCtrl.CreateMarksForFile(aSynEdit,aFilename,DeleteOld);
3683 end;
3684 
3685 procedure TMessagesFrame.ApplySrcChanges(Changes: TETSingleSrcChanges);
3686 begin
3687   MessagesCtrl.ApplySrcChanges(Changes);
3688 end;
3689 
3690 procedure TMessagesFrame.ApplyMultiSrcChanges(Changes: TETMultiSrcChanges);
3691 var
3692   Node: TAvlTreeNode;
3693 begin
3694   for Node in Changes.PendingChanges do
3695     ApplySrcChanges(TETSingleSrcChanges(Node.Data));
3696 end;
3697 
3698 procedure TMessagesFrame.SourceEditorPopup(MarkLine: TSynEditMarkLine;
3699   const LogicalCaretXY: TPoint);
3700 var
3701   i: Integer;
3702   CurMark: TETMark;
3703   BestMark: TETMark;
3704 begin
3705   //debugln(['TMessagesFrame.SourceEditorPopup ']);
3706   // show quickfixes for the first TETMark in editor line
3707   if MarkLine=nil then exit;
3708   IDEQuickFixes.ClearLines;
3709   BestMark:=nil;
3710   for i:=0 to MarkLine.Count-1 do begin
3711     CurMark:=TETMark(MarkLine[i]);
3712     if not (CurMark is TETMark) then continue;
3713     //debugln(['TMessagesFrame.SourceEditorPopup ',CurMark.Line,',',CurMark.Column,' ID=',CurMark.MsgLine.MsgID,' Msg=',CurMark.MsgLine.Msg,' EditorXY=',dbgs(LogicalCaretXY)]);
3714     if (BestMark=nil) then
3715       BestMark:=CurMark
3716     else begin
3717       // there are multiple marks in the line
3718       if (LogicalCaretXY.Y=MarkLine.LineNum)
3719       and (LogicalCaretXY.X=CurMark.Column) then begin
3720         // mark at cursor position
3721         BestMark:=CurMark;
3722         break;
3723       end else begin
3724         // default: use first in line
3725         if CurMark.Column<BestMark.Column then
3726           BestMark:=CurMark;
3727       end;
3728     end;
3729   end;
3730   if BestMark=nil then
3731     exit;
3732   IDEQuickFixes.AddMsgLine(BestMark.MsgLine);
3733   // create items
3734   if IDEQuickFixes.Count>0 then begin
3735     IDEQuickFixes.OnPopupMenu(SrcEditMenuSectionFirstDynamic);
3736     if mcoSrcEditPopupSelect in MessagesCtrl.Options then
3737       MessagesCtrl.Select(BestMark.MsgLine,true);
3738   end;
3739 end;
3740 
3741 procedure TMessagesFrame.SourceEditorHint(MarkLine: TSynEditMarkLine;
3742   var HintStr: string);
3743 var
3744   i: Integer;
3745   CurMark: TETMark;
3746   Msg: TMessageLine;
3747   CurHint: String;
3748 begin
3749   if MarkLine=nil then exit;
3750   for i:=0 to MarkLine.Count-1 do begin
3751     CurMark:=TETMark(MarkLine[i]);
3752     if not (CurMark is TETMark) then continue;
3753     Msg:=CurMark.MsgLine;
3754     CurHint:=MessagesCtrl.UrgencyToStr(Msg.Urgency)+': '+Msg.Msg;
3755     if HintStr<>'' then
3756       HintStr:=HintStr+LineEnding;
3757     HintStr:=HintStr+CurHint;
3758   end;
3759 end;
3760 
3761 procedure TMessagesFrame.SelectMsgLine(Msg: TMessageLine; DoScroll: boolean);
3762 begin
3763   MessagesCtrl.Select(Msg,DoScroll);
3764 end;
3765 
SelectFirstUrgentMessagenull3766 function TMessagesFrame.SelectFirstUrgentMessage(
3767   aMinUrgency: TMessageLineUrgency; WithSrcPos: boolean): boolean;
3768 begin
3769   Result:=MessagesCtrl.SelectFirstUrgentMessage(aMinUrgency,WithSrcPos);
3770 end;
3771 
SelectNextUrgentMessagenull3772 function TMessagesFrame.SelectNextUrgentMessage(
3773   aMinUrgency: TMessageLineUrgency; WithSrcPos, Downwards: boolean): boolean;
3774 begin
3775   Result:=MessagesCtrl.SelectNextUrgentMessage(aMinUrgency,WithSrcPos,Downwards);
3776 end;
3777 
3778 procedure TMessagesFrame.ClearCustomMessages(const ViewCaption: string);
3779 var
3780   View: TLMsgWndView;
3781 begin
3782   View:=GetView(ViewCaption,false);
3783   if (View=nil) or (View.Lines.Count=0) then exit;
3784   View.Lines.Clear;
3785   MessagesCtrl.UpdateScrollBar(true);
3786   MessagesCtrl.Invalidate;
3787 end;
3788 
TMessagesFrame.AddCustomMessagenull3789 function TMessagesFrame.AddCustomMessage(TheUrgency: TMessageLineUrgency;
3790   Msg: string; aFilename: string; LineNumber: integer; Column: integer;
3791   const ViewCaption: string): TMessageLine;
3792 var
3793   View: TLMsgWndView;
3794 begin
3795   Result:=nil;
3796   View:=GetView(ViewCaption,true);
3797   View.Running:=false;
3798   Result:=View.Lines.CreateLine(-1);
3799   Result.Msg:=Msg;
3800   Result.Urgency:=TheUrgency;
3801   Result.SetSourcePosition(aFilename,LineNumber,Column);
3802   View.Lines.Add(Result);
3803   MessagesCtrl.UpdateScrollBar(true);
3804   MessagesCtrl.Invalidate;
3805 end;
3806 
3807 end.
3808 
3809