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 Window for (compiler) messages.
25 }
26 unit etMessagesWnd;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, FileUtil, IDEMsgIntf, IDEImagesIntf, IDEOptionDefs,
34 IDEExternToolIntf, LazIDEIntf, SynEditMarks,
35 Forms, Controls, Graphics, Dialogs, LCLProc, etMessageFrame,
36 etQuickFixes, LazarusIDEStrConsts;
37
38 type
39
40 { TMessagesView }
41
42 TMessagesView = class(TIDEMessagesWindowInterface)
43 MessagesFrame1: TMessagesFrame;
44 procedure FormCreate(Sender: TObject);
45 procedure FormDestroy(Sender: TObject);
46 procedure OnMsgCtrlOptsChanged(Sender: TObject);
OnOpenMessagenull47 function OnOpenMessage(Sender: TObject; Msg: TMessageLine): boolean;
48 private
GetDblClickJumpsnull49 function GetDblClickJumps: boolean;
GetShowMessagesIconsnull50 function GetShowMessagesIcons: boolean;
51 procedure SetDblClickJumps(AValue: boolean);
52 procedure SetShowMessagesIcons(AValue: boolean);
53 protected
GetViewsnull54 function GetViews(Index: integer): TExtToolView; override;
55 public
56 // views
57 procedure Clear; override;
58 procedure DeleteView(View: TExtToolView); override;
FindUnfinishedViewnull59 function FindUnfinishedView: TExtToolView; override;
GetSelectedLinenull60 function GetSelectedLine: TMessageLine; override;
GetViewnull61 function GetView(aCaption: string; CreateIfNotExist: boolean
62 ): TExtToolView; override;
ViewCountnull63 function ViewCount: integer; override;
CreateViewnull64 function CreateView(aCaptionPrefix: string): TExtToolView; override;
IndexOfViewnull65 function IndexOfView(View: TExtToolView): integer; override;
66
67 // lines
68 procedure SelectMsgLine(Msg: TMessageLine); override;
SelectFirstUrgentMessagenull69 function SelectFirstUrgentMessage(aMinUrgency: TMessageLineUrgency;
70 WithSrcPos: boolean): boolean; override;
SelectNextUrgentMessagenull71 function SelectNextUrgentMessage(aMinUrgency: TMessageLineUrgency;
72 WithSrcPos, Downwards: boolean): boolean; override;
73 procedure ClearCustomMessages(const ViewCaption: string='');
AddCustomMessagenull74 function AddCustomMessage(TheUrgency: TMessageLineUrgency; Msg: string;
75 aSrcFilename: string=''; LineNumber: integer=0; Column: integer=0;
76 const ViewCaption: string=''): TMessageLine; override;
77
78 // misc
79 procedure SourceEditorPopup(MarkLine: TSynEditMarkLine; const LogicalCaretXY: TPoint);
80 procedure SourceEditorHint(MarkLine: TSynEditMarkLine; var HintStr: string);
81
82 // options
83 procedure ApplyIDEOptions;
84 property DblClickJumps: boolean read GetDblClickJumps write SetDblClickJumps;
85 property ShowMessagesIcons: boolean read GetShowMessagesIcons write SetShowMessagesIcons;
86 end;
87
88 var
89 MessagesView: TMessagesView;
90
91 implementation
92
93 {$R *.lfm}
94
95 { TMessagesView }
96
97 procedure TMessagesView.FormCreate(Sender: TObject);
98 begin
99 Name := NonModalIDEWindowNames[nmiwMessagesViewName];
100 IDEMessagesWindow:=Self;
101 Caption:=lisMenuViewMessages;
102 {$IFNDEF LCLGtk2}
103 try
104 Icon.LoadFromResourceName(HInstance, 'WIN_MESSAGES');
105 except
106 end;
107 {$ENDIF}
108 MessagesFrame1.MessagesCtrl.OnOpenMessage:=@OnOpenMessage;
109 MessagesFrame1.MessagesCtrl.OnOptionsChanged:=@OnMsgCtrlOptsChanged;
110
111 ActiveControl:=MessagesFrame1.MessagesCtrl;
112 end;
113
114 procedure TMessagesView.FormDestroy(Sender: TObject);
115 begin
116 IDEMessagesWindow:=nil;
117 end;
118
119 procedure TMessagesView.OnMsgCtrlOptsChanged(Sender: TObject);
120 begin
121 if mcoWndStayOnTop in MessagesFrame1.MessagesCtrl.Options then
122 FormStyle:=fsStayOnTop
123 else
124 FormStyle:=fsNormal;
125 end;
126
OnOpenMessagenull127 function TMessagesView.OnOpenMessage(Sender: TObject; Msg: TMessageLine): boolean;
128 begin
129 Result:=false;
130 // ask quickfixes
131 if IDEQuickFixes.OpenMsg(Msg) then exit(true);
132 if Msg.GetFullFilename<>'' then begin
133 // open file in source editor and mark it as error
134 Result:=LazarusIDE.DoJumpToCompilerMessage(true,Msg);
135 end;
136 end;
137
138 procedure TMessagesView.SetDblClickJumps(AValue: boolean);
139 begin
140 if AValue then
141 MessagesFrame1.MessagesCtrl.Options:=
142 MessagesFrame1.MessagesCtrl.Options-[mcoSingleClickOpensFile]
143 else
144 MessagesFrame1.MessagesCtrl.Options:=
145 MessagesFrame1.MessagesCtrl.Options+[mcoSingleClickOpensFile]
146 end;
147
148 procedure TMessagesView.SetShowMessagesIcons(AValue: boolean);
149 begin
150 if AValue then
151 MessagesFrame1.MessagesCtrl.Options:=MessagesFrame1.MessagesCtrl.Options+[mcoShowMsgIcons]
152 else
153 MessagesFrame1.MessagesCtrl.Options:=MessagesFrame1.MessagesCtrl.Options-[mcoShowMsgIcons];
154 end;
155
GetViewsnull156 function TMessagesView.GetViews(Index: integer): TExtToolView;
157 begin
158 Result:=MessagesFrame1.Views[Index];
159 end;
160
161 procedure TMessagesView.ClearCustomMessages(const ViewCaption: string);
162 begin
163 MessagesFrame1.ClearCustomMessages(ViewCaption);
164 end;
165
AddCustomMessagenull166 function TMessagesView.AddCustomMessage(TheUrgency: TMessageLineUrgency;
167 Msg: string; aSrcFilename: string; LineNumber: integer; Column: integer;
168 const ViewCaption: string): TMessageLine;
169 begin
170 Result:=MessagesFrame1.AddCustomMessage(TheUrgency,Msg,aSrcFilename,
171 LineNumber,Column,ViewCaption);
172 end;
173
174 procedure TMessagesView.SourceEditorPopup(MarkLine: TSynEditMarkLine;
175 const LogicalCaretXY: TPoint);
176 begin
177 MessagesFrame1.SourceEditorPopup(MarkLine,LogicalCaretXY);
178 end;
179
180 procedure TMessagesView.SourceEditorHint(MarkLine: TSynEditMarkLine;
181 var HintStr: string);
182 begin
183 MessagesFrame1.SourceEditorHint(MarkLine,HintStr);
184 end;
185
186 procedure TMessagesView.Clear;
187 begin
188 MessagesFrame1.ClearViews(true);
189 end;
190
191 procedure TMessagesView.DeleteView(View: TExtToolView);
192 begin
193 if View is TLMsgWndView then
194 MessagesFrame1.DeleteView(TLMsgWndView(View));
195 end;
196
FindUnfinishedViewnull197 function TMessagesView.FindUnfinishedView: TExtToolView;
198 begin
199 Result:=MessagesFrame1.FindUnfinishedView;
200 end;
201
GetSelectedLinenull202 function TMessagesView.GetSelectedLine: TMessageLine;
203 begin
204 Result:=MessagesFrame1.MessagesCtrl.GetSelectedMsg;
205 end;
206
TMessagesView.GetViewnull207 function TMessagesView.GetView(aCaption: string; CreateIfNotExist: boolean
208 ): TExtToolView;
209 begin
210 Result:=MessagesFrame1.GetView(aCaption,CreateIfNotExist);
211 end;
212
TMessagesView.CreateViewnull213 function TMessagesView.CreateView(aCaptionPrefix: string): TExtToolView;
214
TryCaptionnull215 function TryCaption(aCaption: string; var View: TExtToolView): boolean;
216 begin
217 if GetView(aCaption,false)<>nil then exit(false);
218 View:=GetView(aCaption,true);
219 Result:=true;
220 end;
221
222 var
223 i: Integer;
224 begin
225 Result:=nil;
226 if TryCaption(aCaptionPrefix,Result) then exit;
227 if (aCaptionPrefix<>'') and (aCaptionPrefix[length(aCaptionPrefix)] in ['0'..'9'])
228 then
229 aCaptionPrefix+='_';
230 i:=2;
231 repeat
232 if TryCaption(aCaptionPrefix+IntToStr(i),Result) then exit;
233 inc(i);
234 until false;
235 end;
236
TMessagesView.IndexOfViewnull237 function TMessagesView.IndexOfView(View: TExtToolView): integer;
238 begin
239 if View is TLMsgWndView then
240 Result:=MessagesFrame1.IndexOfView(TLMsgWndView(View))
241 else
242 Result:=-1;
243 end;
244
245 procedure TMessagesView.SelectMsgLine(Msg: TMessageLine);
246 begin
247 MessagesFrame1.SelectMsgLine(Msg,true);
248 end;
249
SelectFirstUrgentMessagenull250 function TMessagesView.SelectFirstUrgentMessage(
251 aMinUrgency: TMessageLineUrgency; WithSrcPos: boolean): boolean;
252 begin
253 Result:=MessagesFrame1.SelectFirstUrgentMessage(aMinUrgency,WithSrcPos);
254 end;
255
TMessagesView.SelectNextUrgentMessagenull256 function TMessagesView.SelectNextUrgentMessage(
257 aMinUrgency: TMessageLineUrgency; WithSrcPos, Downwards: boolean): boolean;
258 begin
259 Result:=MessagesFrame1.SelectNextUrgentMessage(aMinUrgency,WithSrcPos,Downwards);
260 end;
261
ViewCountnull262 function TMessagesView.ViewCount: integer;
263 begin
264 Result:=MessagesFrame1.ViewCount;
265 end;
266
267 procedure TMessagesView.ApplyIDEOptions;
268 begin
269 MessagesFrame1.ApplyIDEOptions;
270 OnMsgCtrlOptsChanged(Self);
271 end;
272
GetDblClickJumpsnull273 function TMessagesView.GetDblClickJumps: boolean;
274 begin
275 Result:=not (mcoSingleClickOpensFile in MessagesFrame1.MessagesCtrl.Options);
276 end;
277
GetShowMessagesIconsnull278 function TMessagesView.GetShowMessagesIcons: boolean;
279 begin
280 Result:=mcoShowMsgIcons in MessagesFrame1.MessagesCtrl.Options;
281 end;
282
283 end.
284
285