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