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