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