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,
34 // LCL
35 Forms, Controls, Graphics, Dialogs,
36 // BuildIntf
37 IDEExternToolIntf,
38 // IdeIntf
39 IDEMsgIntf, LazIDEIntf,
40 // SynEdit
41 SynEditMarks,
42 // IDE
43 IDEOptionDefs, etMessageFrame, etQuickFixes, LazarusIDEStrConsts;
44
45 type
46
47 { TMessagesView }
48
49 TMessagesView = class(TIDEMessagesWindowInterface)
50 MessagesFrame1: TMessagesFrame;
51 procedure FormCreate(Sender: TObject);
52 procedure FormDestroy(Sender: TObject);
53 procedure OnMsgCtrlOptsChanged(Sender: TObject);
OnOpenMessagenull54 function OnOpenMessage(Sender: TObject; Msg: TMessageLine): boolean;
55 private
GetDblClickJumpsnull56 function GetDblClickJumps: boolean;
GetShowMessagesIconsnull57 function GetShowMessagesIcons: boolean;
58 procedure SetDblClickJumps(AValue: boolean);
59 procedure SetShowMessagesIcons(AValue: boolean);
60 protected
GetViewsnull61 function GetViews(Index: integer): TExtToolView; override;
62 public
63 // views
64 procedure Clear; override;
65 procedure DeleteView(View: TExtToolView); override;
FindUnfinishedViewnull66 function FindUnfinishedView: TExtToolView; override;
GetSelectedLinenull67 function GetSelectedLine: TMessageLine; override;
GetViewnull68 function GetView(aCaption: string; CreateIfNotExist: boolean
69 ): TExtToolView; override;
ViewCountnull70 function ViewCount: integer; override;
CreateViewnull71 function CreateView(aCaptionPrefix: string): TExtToolView; override;
IndexOfViewnull72 function IndexOfView(View: TExtToolView): integer; override;
73
74 // lines
75 procedure SelectMsgLine(Msg: TMessageLine); override;
SelectFirstUrgentMessagenull76 function SelectFirstUrgentMessage(aMinUrgency: TMessageLineUrgency;
77 WithSrcPos: boolean): boolean; override;
SelectNextUrgentMessagenull78 function SelectNextUrgentMessage(aMinUrgency: TMessageLineUrgency;
79 WithSrcPos, Downwards: boolean): boolean; override;
80 procedure ClearCustomMessages(const ViewCaption: string='');
AddCustomMessagenull81 function AddCustomMessage(TheUrgency: TMessageLineUrgency; Msg: string;
82 aSrcFilename: string=''; LineNumber: integer=0; Column: integer=0;
83 const ViewCaption: string=''): TMessageLine; override;
84
85 // misc
86 procedure SourceEditorPopup(MarkLine: TSynEditMarkLine; const LogicalCaretXY: TPoint);
87 procedure SourceEditorHint(MarkLine: TSynEditMarkLine; var HintStr: string);
88
89 // options
90 procedure ApplyIDEOptions;
91 property DblClickJumps: boolean read GetDblClickJumps write SetDblClickJumps;
92 property ShowMessagesIcons: boolean read GetShowMessagesIcons write SetShowMessagesIcons;
93 end;
94
95 var
96 MessagesView: TMessagesView;
97
98 implementation
99
100 {$R *.lfm}
101
102 { TMessagesView }
103
104 procedure TMessagesView.FormCreate(Sender: TObject);
105 begin
106 Name := NonModalIDEWindowNames[nmiwMessagesView];
107 IDEMessagesWindow:=Self;
108 Caption:=lisMenuViewMessages;
109 {$IFNDEF LCLGtk2}
110 try
111 Icon.LoadFromResourceName(HInstance, 'WIN_MESSAGES');
112 except
113 end;
114 {$ENDIF}
115 MessagesFrame1.MessagesCtrl.OnOpenMessage:=@OnOpenMessage;
116 MessagesFrame1.MessagesCtrl.OnOptionsChanged:=@OnMsgCtrlOptsChanged;
117
118 ActiveControl:=MessagesFrame1.MessagesCtrl;
119 end;
120
121 procedure TMessagesView.FormDestroy(Sender: TObject);
122 begin
123 IDEMessagesWindow:=nil;
124 end;
125
126 procedure TMessagesView.OnMsgCtrlOptsChanged(Sender: TObject);
127 begin
128 if mcoWndStayOnTop in MessagesFrame1.MessagesCtrl.Options then
129 FormStyle:=fsStayOnTop
130 else
131 FormStyle:=fsNormal;
132 end;
133
OnOpenMessagenull134 function TMessagesView.OnOpenMessage(Sender: TObject; Msg: TMessageLine): boolean;
135 begin
136 Result:=false;
137 // ask quickfixes
138 if IDEQuickFixes.OpenMsg(Msg) then exit(true);
139 if Msg.GetFullFilename<>'' then begin
140 // open file in source editor and mark it as error
141 Result:=LazarusIDE.DoJumpToCompilerMessage(true,Msg);
142 end;
143 end;
144
145 procedure TMessagesView.SetDblClickJumps(AValue: boolean);
146 begin
147 if AValue then
148 MessagesFrame1.MessagesCtrl.Options:=
149 MessagesFrame1.MessagesCtrl.Options-[mcoSingleClickOpensFile]
150 else
151 MessagesFrame1.MessagesCtrl.Options:=
152 MessagesFrame1.MessagesCtrl.Options+[mcoSingleClickOpensFile]
153 end;
154
155 procedure TMessagesView.SetShowMessagesIcons(AValue: boolean);
156 begin
157 if AValue then
158 MessagesFrame1.MessagesCtrl.Options:=MessagesFrame1.MessagesCtrl.Options+[mcoShowMsgIcons]
159 else
160 MessagesFrame1.MessagesCtrl.Options:=MessagesFrame1.MessagesCtrl.Options-[mcoShowMsgIcons];
161 end;
162
GetViewsnull163 function TMessagesView.GetViews(Index: integer): TExtToolView;
164 begin
165 Result:=MessagesFrame1.Views[Index];
166 end;
167
168 procedure TMessagesView.ClearCustomMessages(const ViewCaption: string);
169 begin
170 MessagesFrame1.ClearCustomMessages(ViewCaption);
171 end;
172
AddCustomMessagenull173 function TMessagesView.AddCustomMessage(TheUrgency: TMessageLineUrgency;
174 Msg: string; aSrcFilename: string; LineNumber: integer; Column: integer;
175 const ViewCaption: string): TMessageLine;
176 begin
177 Result:=MessagesFrame1.AddCustomMessage(TheUrgency,Msg,aSrcFilename,
178 LineNumber,Column,ViewCaption);
179 end;
180
181 procedure TMessagesView.SourceEditorPopup(MarkLine: TSynEditMarkLine;
182 const LogicalCaretXY: TPoint);
183 begin
184 MessagesFrame1.SourceEditorPopup(MarkLine,LogicalCaretXY);
185 end;
186
187 procedure TMessagesView.SourceEditorHint(MarkLine: TSynEditMarkLine;
188 var HintStr: string);
189 begin
190 MessagesFrame1.SourceEditorHint(MarkLine,HintStr);
191 end;
192
193 procedure TMessagesView.Clear;
194 begin
195 MessagesFrame1.ClearViews(true);
196 end;
197
198 procedure TMessagesView.DeleteView(View: TExtToolView);
199 begin
200 if View is TLMsgWndView then
201 MessagesFrame1.DeleteView(TLMsgWndView(View));
202 end;
203
FindUnfinishedViewnull204 function TMessagesView.FindUnfinishedView: TExtToolView;
205 begin
206 Result:=MessagesFrame1.FindUnfinishedView;
207 end;
208
GetSelectedLinenull209 function TMessagesView.GetSelectedLine: TMessageLine;
210 begin
211 Result:=MessagesFrame1.MessagesCtrl.GetSelectedMsg;
212 end;
213
TMessagesView.GetViewnull214 function TMessagesView.GetView(aCaption: string; CreateIfNotExist: boolean
215 ): TExtToolView;
216 begin
217 Result:=MessagesFrame1.GetView(aCaption,CreateIfNotExist);
218 end;
219
TMessagesView.CreateViewnull220 function TMessagesView.CreateView(aCaptionPrefix: string): TExtToolView;
221
TryCaptionnull222 function TryCaption(aCaption: string; var View: TExtToolView): boolean;
223 begin
224 if GetView(aCaption,false)<>nil then exit(false);
225 View:=GetView(aCaption,true);
226 Result:=true;
227 end;
228
229 var
230 i: Integer;
231 begin
232 Result:=nil;
233 if TryCaption(aCaptionPrefix,Result) then exit;
234 if (aCaptionPrefix<>'') and (aCaptionPrefix[length(aCaptionPrefix)] in ['0'..'9'])
235 then
236 aCaptionPrefix+='_';
237 i:=2;
238 repeat
239 if TryCaption(aCaptionPrefix+IntToStr(i),Result) then exit;
240 inc(i);
241 until false;
242 end;
243
TMessagesView.IndexOfViewnull244 function TMessagesView.IndexOfView(View: TExtToolView): integer;
245 begin
246 if View is TLMsgWndView then
247 Result:=MessagesFrame1.IndexOfView(TLMsgWndView(View))
248 else
249 Result:=-1;
250 end;
251
252 procedure TMessagesView.SelectMsgLine(Msg: TMessageLine);
253 begin
254 MessagesFrame1.SelectMsgLine(Msg,true);
255 end;
256
SelectFirstUrgentMessagenull257 function TMessagesView.SelectFirstUrgentMessage(
258 aMinUrgency: TMessageLineUrgency; WithSrcPos: boolean): boolean;
259 begin
260 Result:=MessagesFrame1.SelectFirstUrgentMessage(aMinUrgency,WithSrcPos);
261 end;
262
TMessagesView.SelectNextUrgentMessagenull263 function TMessagesView.SelectNextUrgentMessage(
264 aMinUrgency: TMessageLineUrgency; WithSrcPos, Downwards: boolean): boolean;
265 begin
266 Result:=MessagesFrame1.SelectNextUrgentMessage(aMinUrgency,WithSrcPos,Downwards);
267 end;
268
ViewCountnull269 function TMessagesView.ViewCount: integer;
270 begin
271 Result:=MessagesFrame1.ViewCount;
272 end;
273
274 procedure TMessagesView.ApplyIDEOptions;
275 begin
276 MessagesFrame1.ApplyIDEOptions;
277 OnMsgCtrlOptsChanged(Self);
278 end;
279
GetDblClickJumpsnull280 function TMessagesView.GetDblClickJumps: boolean;
281 begin
282 Result:=not (mcoSingleClickOpensFile in MessagesFrame1.MessagesCtrl.Options);
283 end;
284
GetShowMessagesIconsnull285 function TMessagesView.GetShowMessagesIcons: boolean;
286 begin
287 Result:=mcoShowMsgIcons in MessagesFrame1.MessagesCtrl.Options;
288 end;
289
290 end.
291
292