1 {
2 /***************************************************************************
3 helpfpcmessages.pas
4 -------------------
5
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27
28 Author: Mattias Gaertner
29
30 Abstract:
31 Help items for FPC messages.
32 }
33 unit HelpFPCMessages;
34
35 {$mode objfpc}{$H+}
36
37 interface
38
39 uses
40 Classes, SysUtils, fgl,
41 // LCL
42 LCLProc, LCLIntf, Dialogs, Forms, Controls, StdCtrls, ExtCtrls, Graphics,
43 ButtonPanel, LazHelpHTML,
44 // LazUtils
45 LazConfigStorage, LazFileUtils, LazFileCache, LazUTF8,
46 // CodeTools
47 FileProcs, CodeToolsFPCMsgs, CodeToolManager, CodeCache, DefineTemplates,
48 // IdeIntf
49 BaseIDEIntf, MacroIntf, HelpIntfs, IDEHelpIntf, IDEMsgIntf,
50 IDEExternToolIntf, LazHelpIntf, IDEDialogs, TextTools,
51 // IDE
52 LazarusIDEStrConsts, EnvironmentOpts;
53
54 const
55 lihcFPCMessages = 'Free Pascal Compiler messages';
56 lihFPCMessagesURL = 'http://wiki.lazarus.freepascal.org/';
57 lihFPCMessagesInternalURL = 'file://Build_messages#FreePascal_Compiler_messages';
58
59 type
60
61 { TMessageHelpAddition }
62
63 TMessageHelpAddition = class
64 public
65 Name: string;
66 URL: string;
67 RegEx: string;
68 IDs: string; // comma separated
69 procedure Assign(Source: TMessageHelpAddition);
IsEqualnull70 function IsEqual(Source: TMessageHelpAddition): boolean;
Fitsnull71 function Fits(ID: integer; Msg: string): boolean;
72 end;
73 TBaseMessageHelpAdditions = specialize TFPGObjectList<TMessageHelpAddition>;
74
75 { TMessageHelpAdditions }
76
77 TMessageHelpAdditions = class(TBaseMessageHelpAdditions)
78 public
FindWithNamenull79 function FindWithName(Name: string): TMessageHelpAddition;
IsEqualnull80 function IsEqual(Source: TMessageHelpAdditions): boolean;
81 procedure Clone(Source: TMessageHelpAdditions);
82 procedure LoadFromConfig(Cfg: TConfigStorage);
83 procedure SaveToConfig(Cfg: TConfigStorage);
84 procedure LoadFromFile(Filename: string);
85 procedure SaveToFile(Filename: string);
86 end;
87
88 { TFPCMessagesHelpDatabase }
89
90 TFPCMessagesHelpDatabase = class(THTMLHelpDatabase)
91 private
92 fAdditions: TMessageHelpAdditions;
93 FAdditionsChangeStep: integer;
94 FAdditionsFile: string;
95 FDefaultAdditionsFile: string;
96 FFoundAddition: TMessageHelpAddition;
97 FDefaultNode: THelpNode;
98 FFoundComment: string;
99 FLastMessage: string;
100 FLoadedAdditionsFilename: string;
101 FMsgFile: TFPCMsgFile;
102 FMsgFileChangeStep: integer;
103 FMsgFilename: string;
GetAdditionsnull104 function GetAdditions(Index: integer): TMessageHelpAddition;
105 procedure SetAdditionsFile(AValue: string);
106 procedure SetFoundComment(const AValue: string);
107 procedure SetLastMessage(const AValue: string);
108 public
109 constructor Create(TheOwner: TComponent); override;
110 destructor Destroy; override;
GetNodesForMessagenull111 function GetNodesForMessage(const AMessage: string; MessageParts: TStrings;
112 var ListOfNodes: THelpNodeQueryList;
113 var ErrMsg: string): TShowHelpResult; override;
ShowHelpnull114 function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
115 QueryItem: THelpQueryItem;
116 var ErrMsg: string): TShowHelpResult; override;
117 procedure Load(Storage: TConfigStorage); override;
118 procedure Save(Storage: TConfigStorage); override;
119 property DefaultNode: THelpNode read FDefaultNode;
120 property LastMessage: string read FLastMessage write SetLastMessage;
121 property FoundComment: string read FFoundComment write SetFoundComment;
122 property FoundAddition: TMessageHelpAddition read FFoundAddition;
123
124 // the FPC message file
GetMsgFilenull125 function GetMsgFile: TFPCMsgFile;
126 property MsgFile: TFPCMsgFile read FMsgFile;
127 property MsgFilename: string read FMsgFilename;
128 property MsgFileChangeStep: integer read FMsgFileChangeStep;
129
130 // additional help for messages (they add an URL to the FPC comments)
AdditionsCountnull131 function AdditionsCount: integer;
132 property Additions[Index: integer]: TMessageHelpAddition read GetAdditions;
133 property AdditionsChangeStep: integer read FAdditionsChangeStep;
134 property DefaultAdditionsFile: string read FDefaultAdditionsFile;
135 property LoadedAdditionsFilename: string read FLoadedAdditionsFilename;
136 procedure ClearAdditions;
137 procedure LoadAdditions;
138 procedure SaveAdditions;
GetAdditionsFilenamenull139 function GetAdditionsFilename: string;
140 published
141 property AdditionsFile: string read FAdditionsFile write SetAdditionsFile;
142 end;
143
144 { TEditIDEMsgHelpDialog }
145
146 TEditIDEMsgHelpDialog = class(TForm)
147 AddButton: TButton;
148 AdditionFitsMsgLabel: TLabel;
149 AdditionsFileEdit: TEdit;
150 AdditionsFileLabel: TLabel;
151 ButtonPanel1: TButtonPanel;
152 CurGroupBox: TGroupBox;
153 CurMsgGroupBox: TGroupBox;
154 CurMsgMemo: TMemo;
155 DeleteButton: TButton;
156 FPCMsgFileValueLabel: TLabel;
157 FPCMsgFileLabel: TLabel;
158 GlobalOptionsGroupBox: TGroupBox;
159 NameEdit: TEdit;
160 NameLabel: TLabel;
161 OnlyFPCMsgIDsLabel: TLabel;
162 OnlyFPCMsgIDsEdit: TEdit;
163 OnlyRegExEdit: TEdit;
164 OnlyRegExLabel: TLabel;
165 Splitter1: TSplitter;
166 AllGroupBox: TGroupBox;
167 TestURLButton: TButton;
168 URLEdit: TEdit;
169 URLLabel: TLabel;
170 AllListBox: TListBox;
171 procedure AddButtonClick(Sender: TObject);
172 procedure AllListBoxSelectionChange(Sender: TObject; {%H-}User: boolean);
173 procedure ButtonPanel1Click(Sender: TObject);
174 procedure ButtonPanel1OKButtonClick(Sender: TObject);
175 procedure DeleteButtonClick(Sender: TObject);
176 procedure FormCreate(Sender: TObject);
177 procedure FormDestroy(Sender: TObject);
178 procedure NameEditChange(Sender: TObject);
179 procedure OnlyFPCMsgIDsEditChange(Sender: TObject);
180 procedure OnlyRegExEditChange(Sender: TObject);
181 procedure TestURLButtonClick(Sender: TObject);
182 procedure URLEditChange(Sender: TObject);
183 private
184 fDefaultValue: string;
185 procedure FillAdditionsList;
186 procedure UpdateCurAddition;
187 procedure UpdateCurMessage;
188 procedure UpdateAdditionsFitsMsg;
IsIDListValidnull189 function IsIDListValid(IDs: string): boolean;
IsRegexValidnull190 function IsRegexValid(re: string): boolean;
IsURLValidnull191 function IsURLValid(URL: string): boolean;
192 public
193 Additions: TMessageHelpAdditions;
194 CurAddition: TMessageHelpAddition;
195 CurMsg: string;
196 CurFPCId: integer;
197 end;
198
199 var
200 FPCMsgHelpDB: TFPCMessagesHelpDatabase = nil;
201
ShowMessageHelpEditornull202 function ShowMessageHelpEditor: TModalResult;
203
204 procedure CreateFPCMessagesHelpDB;
205
206 implementation
207
208 {$R *.lfm}
209
ShowMessageHelpEditornull210 function ShowMessageHelpEditor: TModalResult;
211 var
212 Editor: TEditIDEMsgHelpDialog;
213 begin
214 Editor:=TEditIDEMsgHelpDialog.Create(nil);
215 try
216 Result:=Editor.ShowModal;
217 finally
218 Editor.Free;
219 end;
220 end;
221
222 procedure CreateFPCMessagesHelpDB;
223 var
224 StartNode: THelpNode;
225 begin
226 FPCMessagesHelpDB:=HelpDatabases.CreateHelpDatabase(lihcFPCMessages,
227 TFPCMessagesHelpDatabase,true);
228 FPCMsgHelpDB:=FPCMessagesHelpDB as TFPCMessagesHelpDatabase;
229 FPCMsgHelpDB.DefaultBaseURL:=lihFPCMessagesURL;
230
231 // HTML nodes
232 StartNode:=THelpNode.CreateURLID(FPCMsgHelpDB, lisFreePascalCompilerMessages,
233 lihFPCMessagesInternalURL,lihcFPCMessages);
234 FPCMsgHelpDB.TOCNode:=THelpNode.Create(FPCMsgHelpDB,StartNode);// once as TOC
235 FPCMsgHelpDB.RegisterItemWithNode(StartNode);// and once as normal page
236 end;
237
238 { TMessageHelpAdditions }
239
FindWithNamenull240 function TMessageHelpAdditions.FindWithName(Name: string): TMessageHelpAddition;
241 var
242 i: Integer;
243 begin
244 for i:=0 to Count-1 do begin
245 Result:=Items[i];
246 if SysUtils.CompareText(Result.Name,Name)=0 then exit;
247 end;
248 Result:=nil;
249 end;
250
TMessageHelpAdditions.IsEqualnull251 function TMessageHelpAdditions.IsEqual(Source: TMessageHelpAdditions): boolean;
252 var
253 i: Integer;
254 begin
255 Result:=false;
256 if Source=nil then exit;
257 if Source=Self then exit(true);
258 if Count<>Source.Count then exit;
259 for i:=0 to Count-1 do
260 if not Items[i].IsEqual(Source[i]) then exit;
261 Result:=true;
262 end;
263
264 procedure TMessageHelpAdditions.Clone(Source: TMessageHelpAdditions);
265 var
266 i: Integer;
267 Item: TMessageHelpAddition;
268 begin
269 Clear;
270 for i:=0 to Source.Count-1 do begin
271 Item:=TMessageHelpAddition.Create;
272 Item.Assign(Source[i]);
273 Add(Item);
274 end;
275 end;
276
277 procedure TMessageHelpAdditions.LoadFromConfig(Cfg: TConfigStorage);
278 var
279 Cnt: Integer;
280 i: Integer;
281 Item: TMessageHelpAddition;
282 SubPath: String;
283 begin
284 Clear;
285 Cfg.AppendBasePath('Additions');
286 try
287 Cnt:=Cfg.GetValue('Count',0);
288 for i:=1 to Cnt do begin
289 Item:=TMessageHelpAddition.Create;
290 SubPath:='Item'+IntToStr(i)+'/';
291 Item.Name:=Cfg.GetValue(SubPath+'Name','');
292 if Item.Name='' then begin
293 Item.Free;
294 end else begin
295 Add(Item);
296 Item.IDs:=cfg.GetValue(SubPath+'IDs','');
297 Item.RegEx:=cfg.GetValue(SubPath+'RegEx','');
298 Item.URL:=cfg.GetValue(SubPath+'URL','');
299 end;
300 end;
301 finally
302 Cfg.UndoAppendBasePath;
303 end;
304 end;
305
306 procedure TMessageHelpAdditions.SaveToConfig(Cfg: TConfigStorage);
307 var
308 Cnt: Integer;
309 i: Integer;
310 Item: TMessageHelpAddition;
311 SubPath: String;
312 begin
313 Cfg.AppendBasePath('Additions');
314 try
315 Cnt:=0;
316 for i:=0 to Count-1 do begin
317 Item:=Items[i];
318 if Item.Name='' then continue;
319 inc(Cnt);
320 SubPath:='Item'+IntToStr(Cnt)+'/';
321 Cfg.SetDeleteValue(SubPath+'Name',Item.Name,'');
322 cfg.SetDeleteValue(SubPath+'IDs',Item.IDs,'');
323 cfg.SetDeleteValue(SubPath+'RegEx',Item.RegEx,'');
324 cfg.SetDeleteValue(SubPath+'URL',Item.URL,'');
325 end;
326 Cfg.SetDeleteValue('Count',Cnt,0);
327 finally
328 Cfg.UndoAppendBasePath;
329 end;
330 end;
331
332 procedure TMessageHelpAdditions.LoadFromFile(Filename: string);
333 var
334 Cfg: TConfigStorage;
335 begin
336 try
337 Cfg:=GetIDEConfigStorage(Filename,true);
338 try
339 LoadFromConfig(Cfg);
340 finally
341 Cfg.Free;
342 end;
343 except
344 on E: Exception do begin
345 debugln(['TMessageHelpAdditions.LoadFromFile unable to load file "'+Filename+'": '+E.Message]);
346 end;
347 end;
348 end;
349
350 procedure TMessageHelpAdditions.SaveToFile(Filename: string);
351 var
352 Cfg: TConfigStorage;
353 begin
354 try
355 Cfg:=GetIDEConfigStorage(Filename,false);
356 try
357 SaveToConfig(Cfg);
358 Cfg.WriteToDisk;
359 finally
360 Cfg.Free;
361 end;
362 except
363 on E: Exception do begin
364 debugln(['TMessageHelpAdditions.SaveToFile unable to save file "'+Filename+'": '+E.Message]);
365 end;
366 end;
367 end;
368
369 { TMessageHelpAddition }
370
371 procedure TMessageHelpAddition.Assign(Source: TMessageHelpAddition);
372 begin
373 Name:=Source.Name;
374 IDs:=Source.IDs;
375 RegEx:=Source.RegEx;
376 URL:=Source.URL;
377 end;
378
TMessageHelpAddition.IsEqualnull379 function TMessageHelpAddition.IsEqual(Source: TMessageHelpAddition): boolean;
380 begin
381 Result:=(Name=Source.Name)
382 and (IDs=Source.IDs)
383 and (RegEx=Source.RegEx)
384 and (URL=Source.URL);
385 end;
386
Fitsnull387 function TMessageHelpAddition.Fits(ID: integer; Msg: string): boolean;
388 var
389 CurID: Integer;
390 p: PChar;
391 begin
392 Result:=false;
393 if Msg='' then exit;
394 if RegEx<>'' then begin
395 try
396 Result:=REMatches(Msg,RegEx,'I');
397 except
398 end;
399 if not Result then exit;
400 end;
401 if IDs<>'' then begin
402 Result:=false;
403 p:=PChar(IDs);
404 CurID:=0;
405 while p^<>#0 do begin
406 case p^ of
407 ',':
408 if (CurID>0) and (CurID=ID) then begin
409 Result:=true;
410 break;
411 end;
412 '0'..'9':
413 begin
414 CurID:=CurID*10+ord(p^)-ord('0');
415 if CurID>100000 then exit;
416 end;
417 else exit;
418 end;
419 inc(p);
420 end;
421 if (CurID>0) and (CurID=ID) then Result:=true;
422 if not Result then exit;
423 end;
424 end;
425
426 { TEditIDEMsgHelpDialog }
427
428 procedure TEditIDEMsgHelpDialog.FormCreate(Sender: TObject);
429 var
430 s: String;
431 begin
432 fDefaultValue:=lisDefaultPlaceholder;
433 Caption:=lisEditAdditionalHelpForMessages;
434
435 GlobalOptionsGroupBox.Caption:=lisGlobalSettings;
436 FPCMsgFileLabel.Caption:=lisFPCMessageFile2;
437 AdditionsFileLabel.Caption:=lisConfigFileOfAdditions;
438
439 CurMsgGroupBox.Caption:=lisSelectedMessageInMessagesWindow;
440
441 AllGroupBox.Caption:=lisAdditions;
442 AddButton.Caption:=lisCreateNewAddition;
443
444 NameLabel.Caption:=lisCodeToolsDefsName;
445 OnlyFPCMsgIDsLabel.Caption:=lisOnlyMessagesWithTheseFPCIDsCommaSeparated;
446 OnlyRegExLabel.Caption:=lisOnlyMessagesFittingThisRegularExpression;
447 s:=(FPCMessagesHelpDB as THTMLHelpDatabase).GetEffectiveBaseURL;
448 URLLabel.Caption:=Format(lisURLOnWikiTheBaseUrlIs, [s]);
449 TestURLButton.Caption:=lisTestURL;
450
451 DeleteButton.Caption:=lisDeleteThisAddition;
452
453 ButtonPanel1.OKButton.OnClick:=@ButtonPanel1OKButtonClick;
454
455 // global options
456 FPCMsgFileValueLabel.Caption:=EnvironmentOptions.GetParsedCompilerMessagesFilename;
457 AdditionsFileEdit.Text:=FPCMsgHelpDB.AdditionsFile;
458
459 // fetch selected message
460 UpdateCurMessage;
461
462 // list of additions
463 FPCMsgHelpDB.LoadAdditions;
464 Additions:=TMessageHelpAdditions.Create;
465 Additions.Clone(FPCMsgHelpDB.fAdditions);
466 FillAdditionsList;
467
468 // current addition
469 if AllListBox.Items.Count>0 then
470 AllListBox.ItemIndex:=0;
471 UpdateCurAddition;
472 end;
473
474 procedure TEditIDEMsgHelpDialog.ButtonPanel1Click(Sender: TObject);
475 begin
476
477 end;
478
479 procedure TEditIDEMsgHelpDialog.AllListBoxSelectionChange(Sender: TObject;
480 User: boolean);
481 begin
482 UpdateCurAddition;
483 end;
484
485 procedure TEditIDEMsgHelpDialog.AddButtonClick(Sender: TObject);
486 var
487 i: Integer;
488 Prefix: String;
489 NewName: String;
490 Item: TMessageHelpAddition;
491 begin
492 if CurFPCId>=0 then
493 Prefix:='Msg'+IntToStr(CurFPCId)+'_'
494 else
495 Prefix:='Msg';
496 i:=1;
497 repeat
498 NewName:=Prefix+IntToStr(i);
499 if Additions.FindWithName(NewName)=nil then break;
500 inc(i);
501 until false;
502 Item:=TMessageHelpAddition.Create;
503 Item.Name:=NewName;
504 if CurFPCId>=0 then
505 Item.IDs:=IntToStr(CurFPCId);
506 Additions.Add(Item);
507 FillAdditionsList;
508 AllListBox.ItemIndex:=AllListBox.Items.IndexOf(Item.Name);
509 UpdateCurAddition;
510 end;
511
512 procedure TEditIDEMsgHelpDialog.ButtonPanel1OKButtonClick(Sender: TObject);
513 var
514 Filename: TCaption;
515 HasChanged: Boolean;
516 begin
517 HasChanged:=false;
518
519 Filename:=EnvironmentOptions.GetParsedCompilerMessagesFilename;
520 if (Filename=fDefaultValue) then
521 Filename:='';
522
523 Filename:=AdditionsFileEdit.Text;
524 if (Filename=fDefaultValue)
525 or (Filename=FPCMsgHelpDB.FDefaultAdditionsFile) then
526 Filename:='';
527 if FPCMsgHelpDB.AdditionsFile<>Filename then begin
528 FPCMsgHelpDB.AdditionsFile:=Filename;
529 HasChanged:=true;
530 end;
531
532 if HasChanged then begin
533 // ToDo: save changes
534 ShowMessage('Saving global options is not yet supported');
535 end;
536
537 if not Additions.IsEqual(FPCMsgHelpDB.fAdditions) then
538 begin
539 FPCMsgHelpDB.fAdditions.Clone(Additions);
540 FPCMsgHelpDB.SaveAdditions;
541 end;
542 end;
543
544 procedure TEditIDEMsgHelpDialog.DeleteButtonClick(Sender: TObject);
545 var
546 i: LongInt;
547 NewIndex: Integer;
548 begin
549 if CurAddition=nil then exit;
550 if IDEMessageDialog(lisDelete2,
551 Format(lisDeleteAddition, [CurAddition.Name]), mtConfirmation, [mbYes, mbNo]
552 )<>mrYes
553 then exit;
554 NewIndex:=AllListBox.ItemIndex;
555 i:=Additions.IndexOf(CurAddition);
556 CurAddition:=nil;
557 if i>=0 then
558 Additions.Delete(i);
559 FillAdditionsList;
560 if NewIndex<0 then NewIndex:=0;
561 if NewIndex>=AllListBox.Items.Count then dec(NewIndex);
562 AllListBox.ItemIndex:=NewIndex;
563 UpdateCurAddition;
564 end;
565
566 procedure TEditIDEMsgHelpDialog.FormDestroy(Sender: TObject);
567 begin
568 FreeAndNil(Additions);
569 end;
570
571 procedure TEditIDEMsgHelpDialog.NameEditChange(Sender: TObject);
572 var
573 NewName: TCaption;
574 ConflictAddition: TMessageHelpAddition;
575 begin
576 NewName:=NameEdit.Text;
577 ConflictAddition:=Additions.FindWithName(NewName);
578 if (NewName='') or (CurAddition=nil)
579 or ((ConflictAddition<>nil) and (Additions.FindWithName(NewName)<>CurAddition))
580 then begin
581 // invalid name
582 NameLabel.Font.Color:=clRed;
583 end else begin
584 NameLabel.Font.Color:=clDefault;
585 CurAddition.Name:=NewName;
586 AllListBox.Items[AllListBox.ItemIndex]:=NewName;
587 end;
588 end;
589
590 procedure TEditIDEMsgHelpDialog.OnlyFPCMsgIDsEditChange(Sender: TObject);
591 var
592 NewIDs: TCaption;
593 begin
594 NewIDs:=OnlyFPCMsgIDsEdit.Text;
595 if (CurAddition=nil) or (not IsIDListValid(NewIDs)) then begin
596 OnlyFPCMsgIDsLabel.Font.Color:=clRed;
597 end else begin
598 OnlyFPCMsgIDsLabel.Font.Color:=clDefault;
599 CurAddition.IDs:=NewIDs;
600 UpdateAdditionsFitsMsg;
601 end;
602 end;
603
604 procedure TEditIDEMsgHelpDialog.OnlyRegExEditChange(Sender: TObject);
605 var
606 NewRE: TCaption;
607 begin
608 NewRE:=OnlyRegExEdit.Text;
609 if (CurAddition=nil) or (not IsRegexValid(NewRE)) then begin
610 OnlyRegExLabel.Font.Color:=clRed;
611 end else begin
612 OnlyRegExLabel.Font.Color:=clDefault;
613 CurAddition.RegEx:=NewRE;
614 UpdateAdditionsFitsMsg;
615 end;
616 end;
617
618 procedure TEditIDEMsgHelpDialog.TestURLButtonClick(Sender: TObject);
619 var
620 URL: String;
621 begin
622 if (CurAddition=nil) or (CurAddition.URL='') then exit;
623 URL:=FPCMsgHelpDB.GetEffectiveBaseURL+CurAddition.URL;
624 OpenURL(URL);
625 end;
626
627 procedure TEditIDEMsgHelpDialog.URLEditChange(Sender: TObject);
628 var
629 NewURL: TCaption;
630 begin
631 NewURL:=URLEdit.Text;
632 if (CurAddition=nil) or (not IsURLValid(NewURL)) then begin
633 URLLabel.Font.Color:=clRed;
634 end else begin
635 URLLabel.Font.Color:=clDefault;
636 CurAddition.URL:=NewURL;
637 end;
638 end;
639
640 procedure TEditIDEMsgHelpDialog.FillAdditionsList;
641 var
642 sl: TStringListUTF8Fast;
643 i: Integer;
644 begin
645 sl:=TStringListUTF8Fast.Create;
646 try
647 for i:=0 to Additions.Count-1 do
648 sl.Add(Additions[i].Name);
649 sl.Sort;
650 AllListBox.Items.Assign(sl);
651 finally
652 sl.Free;
653 end;
654 end;
655
656 procedure TEditIDEMsgHelpDialog.UpdateCurAddition;
657 var
658 i: Integer;
659 begin
660 i:=AllListBox.ItemIndex;
661 if i>=0 then
662 CurAddition:=Additions.FindWithName(AllListBox.Items[i])
663 else
664 CurAddition:=nil;
665 if CurAddition=nil then begin
666 CurGroupBox.Caption:=lisNoneSelected;
667 CurGroupBox.Enabled:=false;
668 NameEdit.Text:='';
669 OnlyFPCMsgIDsEdit.Text:='';
670 OnlyRegExEdit.Text:='';
671 URLEdit.Text:='';
672 for i:=0 to CurGroupBox.ControlCount-1 do
673 CurGroupBox.Controls[i].Enabled:=false;
674 NameLabel.Font.Color:=clDefault;
675 OnlyFPCMsgIDsEdit.Font.Color:=clDefault;
676 OnlyRegExEdit.Font.Color:=clDefault;
677 URLEdit.Font.Color:=clDefault;
678 end else begin
679 CurGroupBox.Caption:=lisSelectedAddition;
680 CurGroupBox.Enabled:=true;
681 NameEdit.Text:=CurAddition.Name;
682 NameLabel.Font.Color:=clDefault;
683 OnlyFPCMsgIDsEdit.Text:=CurAddition.IDs;
684 if not IsIDListValid(CurAddition.IDs) then
685 OnlyFPCMsgIDsLabel.Font.Color:=clRed
686 else
687 OnlyFPCMsgIDsLabel.Font.Color:=clDefault;
688 OnlyRegExEdit.Text:=CurAddition.RegEx;
689 if not IsRegexValid(CurAddition.RegEx) then
690 OnlyRegExLabel.Font.Color:=clRed
691 else
692 OnlyRegExLabel.Font.Color:=clDefault;
693 URLEdit.Text:=CurAddition.URL;
694 if not IsURLValid(CurAddition.URL) then
695 URLLabel.Font.Color:=clRed
696 else
697 URLLabel.Font.Color:=clDefault;
698 for i:=0 to CurGroupBox.ControlCount-1 do
699 CurGroupBox.Controls[i].Enabled:=true;
700 end;
701 UpdateAdditionsFitsMsg;
702 end;
703
704 procedure TEditIDEMsgHelpDialog.UpdateCurMessage;
705 var
706 Line: TMessageLine;
707 sl: TStringList;
708 MsgFile: TFPCMsgFile;
709 FPCMsg: TFPCMsgItem;
710 begin
711 CurMsg:='';
712 CurFPCId:=-1;
713 Line:=IDEMessagesWindow.GetSelectedLine;
714 if Line=nil then begin
715 CurMsgMemo.Text:=lisNoMessageSelected;
716 CurMsgMemo.Enabled:=false;
717 end else begin
718 CurMsg:=Line.Msg;
719 sl:=TStringList.Create;
720 try
721 sl.Add('Msg='+Line.Msg);
722 sl.Add('MsgID='+IntToStr(Line.MsgID));
723 MsgFile:=FPCMsgHelpDB.GetMsgFile;
724 if MsgFile<>nil then begin
725 FPCMsg:=nil;
726 if Line.MsgID>0 then
727 FPCMsg:=MsgFile.FindWithID(Line.MsgID);
728 if FPCMsg=nil then
729 FPCMsg:=MsgFile.FindWithMessage(Line.Msg);
730 if FPCMsg<>nil then begin
731 CurFPCId:=FPCMsg.ID;
732 sl.Add('FPC Msg='+FPCMsg.GetName);
733 end;
734 end;
735 CurMsgMemo.Text:=sl.Text;
736 finally
737 sl.Free;
738 end;
739 CurMsgMemo.Enabled:=true;
740 end;
741 end;
742
743 procedure TEditIDEMsgHelpDialog.UpdateAdditionsFitsMsg;
744 begin
745 if (CurAddition=nil) or (CurMsg='') then
746 AdditionFitsMsgLabel.Visible:=false
747 else begin
748 AdditionFitsMsgLabel.Visible:=true;
749 if CurAddition.Fits(CurFPCId,CurMsg) then begin
750 AdditionFitsMsgLabel.Caption:=lisAdditionFitsTheCurrentMessage;
751 end else begin
752 AdditionFitsMsgLabel.Caption:=lisAdditionDoesNotFitTheCurrentMessage;
753 end;
754 end;
755 end;
756
IsIDListValidnull757 function TEditIDEMsgHelpDialog.IsIDListValid(IDs: string): boolean;
758 // comma separated decimal numbers
759 var
760 p: PChar;
761 id: Integer;
762 begin
763 if IDs='' then exit(true);
764 Result:=false;
765 p:=PChar(IDs);
766 id:=0;
767 while p^<>#0 do begin
768 case p^ of
769 ',': id:=0;
770 '0'..'9':
771 begin
772 id:=id*10+ord(p^)-ord('0');
773 if id>100000 then begin
774 debugln(['TEditIDEMsgHelpDialog.IsIDListValid id too big ',id]);
775 exit;
776 end;
777 end;
778 else
779 debugln(['TEditIDEMsgHelpDialog.IsIDListValid invalid character ',ord(p^),'=',dbgstr(p[0])]);
780 exit;
781 end;
782 inc(p);
783 end;
784 Result:=true;
785 end;
786
IsRegexValidnull787 function TEditIDEMsgHelpDialog.IsRegexValid(re: string): boolean;
788 begin
789 if re='' then exit(true);
790 Result:=false;
791 try
792 REMatches('',re,'I');
793 Result:=true;
794 except
795 on E: Exception do begin
796 debugln(['TEditIDEMsgHelpDialog.IsRegexValid inalid Re="',re,'": ',E.Message]);
797 end;
798 end;
799 end;
800
TEditIDEMsgHelpDialog.IsURLValidnull801 function TEditIDEMsgHelpDialog.IsURLValid(URL: string): boolean;
802 var
803 i: Integer;
804 begin
805 Result:=false;
806 if URL='' then exit;
807 for i:=1 to length(URL) do begin
808 if URL[i] in [#0..#32] then exit;
809 end;
810 Result:=true;
811 end;
812
813 { TFPCMessagesHelpDatabase }
814
815 procedure TFPCMessagesHelpDatabase.SetFoundComment(const AValue: string);
816 begin
817 if FFoundComment=AValue then exit;
818 FFoundComment:=AValue;
819 end;
820
TFPCMessagesHelpDatabase.GetAdditionsnull821 function TFPCMessagesHelpDatabase.GetAdditions(Index: integer
822 ): TMessageHelpAddition;
823 begin
824 Result:=fAdditions[Index];
825 end;
826
827 procedure TFPCMessagesHelpDatabase.SetAdditionsFile(AValue: string);
828 begin
829 if FAdditionsFile=AValue then Exit;
830 FAdditionsFile:=AValue;
831 FAdditionsChangeStep:=CTInvalidChangeStamp;
832 FLoadedAdditionsFilename:='';
833 end;
834
835 procedure TFPCMessagesHelpDatabase.SetLastMessage(const AValue: string);
836 begin
837 if FLastMessage=AValue then exit;
838 FLastMessage:=AValue;
839 end;
840
841 constructor TFPCMessagesHelpDatabase.Create(TheOwner: TComponent);
842 begin
843 inherited Create(TheOwner);
844 FDefaultAdditionsFile:='$(LazarusDir)/docs/additionalmsghelp.xml';
845 fAdditions:=TMessageHelpAdditions.Create;
846 FAdditionsChangeStep:=CTInvalidChangeStamp;
847 FMsgFileChangeStep:=CTInvalidChangeStamp;
848 FDefaultNode:=THelpNode.CreateURL(Self, lisFPCMessagesAppendix,
849 'http://lazarus-ccr.sourceforge.net/fpcdoc/user/userap3.html#x81-168000C');
850 end;
851
852 destructor TFPCMessagesHelpDatabase.Destroy;
853 begin
854 FreeAndNil(fAdditions);
855 FreeAndNil(FDefaultNode);
856 FreeAndNil(FMsgFile);
857 inherited Destroy;
858 end;
859
TFPCMessagesHelpDatabase.GetNodesForMessagenull860 function TFPCMessagesHelpDatabase.GetNodesForMessage(const AMessage: string;
861 MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList;
862 var ErrMsg: string): TShowHelpResult;
863 var
864 MsgItem: TFPCMsgItem;
865 i: Integer;
866 FPCID: Integer;
867 MsgId: Integer;
868 begin
869 FFoundAddition:=nil;
870 FFoundComment:='';
871 FPCID:=-1;
872 Result:=inherited GetNodesForMessage(AMessage, MessageParts, ListOfNodes,
873 ErrMsg);
874 if (ListOfNodes<>nil) and (ListOfNodes.Count>0) then exit;
875 LastMessage:=AMessage;
876
877 // search message in FPC message file
878 GetMsgFile;
879 MsgItem:=nil;
880 if MsgFile<>nil then begin
881 MsgId:=StrToIntDef(MessageParts.Values['MsgId'],0);
882 if MsgId>0 then
883 MsgItem:=MsgFile.FindWithID(MsgId);
884 if MsgItem=nil then
885 MsgItem:=MsgFile.FindWithMessage(AMessage);
886 if MsgItem<>nil then begin
887 FoundComment:=MsgItem.GetTrimmedComment(true,true);
888 FPCID:=MsgItem.ID;
889 end;
890 end;
891
892 // search message in additions
893 LoadAdditions;
894 FFoundAddition:=nil;
895 for i:=0 to AdditionsCount-1 do begin
896 if Additions[i].Fits(FPCID,AMessage) then begin
897 FFoundAddition:=Additions[i];
898 break;
899 end;
900 end;
901
902 if (FoundComment<>'') or (FoundAddition<>nil) then begin
903 Result:=shrSuccess;
904 CreateNodeQueryListAndAdd(DefaultNode,nil,ListOfNodes,true);
905 //DebugLn('TFPCMessagesHelpDatabase.GetNodesForMessage ',FoundComment);
906 end;
907 end;
908
ShowHelpnull909 function TFPCMessagesHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
910 NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string
911 ): TShowHelpResult;
912 var
913 URL: String;
914 begin
915 Result:=shrHelpNotFound;
916 if NewNode<>DefaultNode then begin
917 Result:=inherited ShowHelp(Query, BaseNode, NewNode, QueryItem, ErrMsg);
918 end else begin
919 URL:='';
920 if (FoundAddition<>nil) and (FoundAddition.URL<>'') then
921 URL:=GetEffectiveBaseURL+FoundAddition.URL;
922 if FoundComment<>'' then begin
923 if URL='' then begin
924 IDEMessageDialog(lisHFMHelpForFreePascalCompilerMessage, FoundComment,
925 mtInformation,[mbOk]);
926 end else begin
927 if IDEQuestionDialog(lisHFMHelpForFreePascalCompilerMessage,
928 Format(lisThereAreAdditionalNotesForThisMessageOn,
929 [FoundComment+LineEnding+LineEnding, LineEnding+URL]),
930 mtInformation, [mrYes, lisOpenURL,
931 mrClose, lisClose]) = mrYes
932 then begin
933 if not OpenURL(URL) then
934 exit(shrViewerError);
935 end;
936 end;
937 end else if URL<>'' then begin
938 if not OpenURL(URL) then
939 exit(shrViewerError);
940 end;
941 Result:=shrSuccess;
942 end;
943 end;
944
945 procedure TFPCMessagesHelpDatabase.Load(Storage: TConfigStorage);
946 begin
947 inherited Load(Storage);
948 AdditionsFile:=Storage.GetValue('Additions/Filename','');
949 end;
950
951 procedure TFPCMessagesHelpDatabase.Save(Storage: TConfigStorage);
952 begin
953 inherited Save(Storage);
954 Storage.SetDeleteValue('Additions/Filename',AdditionsFile,'');
955 end;
956
GetMsgFilenull957 function TFPCMessagesHelpDatabase.GetMsgFile: TFPCMsgFile;
958 var
959 Filename: String;
960 FPCSrcDir: String;
961 Code: TCodeBuffer;
962 AltFilename: String;
963 UnitSet: TFPCUnitSetCache;
964 CfgCache: TPCTargetConfigCache;
965 begin
966 Result:=nil;
967 Filename:=EnvironmentOptions.GetParsedCompilerMessagesFilename;
968 if Filename='' then
969 FileName:='errore.msg';
970 if not FilenameIsAbsolute(Filename) then
971 begin
972 // try in FPC sources and Compiler directory
973 UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
974 if UnitSet=nil then exit;
975
976 // try in FPC sources
977 FPCSrcDir:=UnitSet.FPCSourceDirectory;
978 if (FPCSrcDir<>'') then begin
979 AltFilename:=TrimFilename(AppendPathDelim(FPCSrcDir)
980 +GetForcedPathDelims('compiler/msg/')+Filename);
981 if FileExistsCached(AltFilename) then
982 Filename:=AltFilename;
983 end;
984
985 if not FilenameIsAbsolute(Filename) then
986 begin
987 // try in compiler path
988 CfgCache:=UnitSet.GetConfigCache(true);
989 if CfgCache<>nil then begin
990 // try in back end compiler path
991 if FilenameIsAbsolute(CfgCache.RealCompiler) then
992 begin
993 AltFilename:=AppendPathDelim(ExtractFilePath(CfgCache.RealCompiler))
994 +'msg'+PathDelim+Filename;
995 if FileExistsCached(AltFilename) then
996 Filename:=AltFilename;
997 end;
998 // try in front end compiler path
999 if (not FilenameIsAbsolute(Filename))
1000 and FilenameIsAbsolute(CfgCache.Compiler) then
1001 begin
1002 AltFilename:=AppendPathDelim(ExtractFilePath(CfgCache.Compiler))
1003 +'msg'+PathDelim+Filename;
1004 if FileExistsCached(AltFilename) then
1005 Filename:=AltFilename;
1006 end;
1007 end;
1008 end;
1009
1010 if not FilenameIsAbsolute(Filename) then exit;
1011 end;
1012
1013 Code:=CodeToolBoss.LoadFile(Filename,true,false);
1014 if Code=nil then exit;
1015
1016 // load MsgFile
1017 if (Filename<>MsgFilename) or (Code.ChangeStep<>MsgFileChangeStep) then begin
1018 fMsgFilename:=Filename;
1019 if FMsgFile=nil then
1020 FMsgFile:=TFPCMsgFile.Create;
1021 FMsgFileChangeStep:=Code.ChangeStep;
1022 try
1023 MsgFile.LoadFromText(Code.Source);
1024 except
1025 on E: Exception do begin
1026 debugln(['TFPCMessagesHelpDatabase failed to parse "'+MsgFilename+'": '+E.Message]);
1027 exit;
1028 end;
1029 end;
1030 end;
1031 Result:=MsgFile;
1032 end;
1033
AdditionsCountnull1034 function TFPCMessagesHelpDatabase.AdditionsCount: integer;
1035 begin
1036 Result:=fAdditions.Count;
1037 end;
1038
1039 procedure TFPCMessagesHelpDatabase.ClearAdditions;
1040 begin
1041 fAdditions.Clear;
1042 FLoadedAdditionsFilename:='';
1043 FAdditionsChangeStep:=CTInvalidChangeStamp;
1044 FFoundAddition:=nil;
1045 end;
1046
1047 procedure TFPCMessagesHelpDatabase.LoadAdditions;
1048 var
1049 Filename: String;
1050 Code: TCodeBuffer;
1051 begin
1052 Filename:=GetAdditionsFilename;
1053 if FLoadedAdditionsFilename<>Filename then
1054 FAdditionsChangeStep:=CTInvalidChangeStamp;
1055 Code:=CodeToolBoss.LoadFile(Filename,true,false);
1056 if Code<>nil then begin
1057 if Code.ChangeStep=AdditionsChangeStep then exit;
1058 fAdditionsChangeStep:=Code.ChangeStep;
1059 end else
1060 fAdditionsChangeStep:=CTInvalidChangeStamp;
1061 ClearAdditions;
1062 fAdditions.LoadFromFile(Filename);
1063 FLoadedAdditionsFilename:=Filename;
1064 end;
1065
1066 procedure TFPCMessagesHelpDatabase.SaveAdditions;
1067 var
1068 Code: TCodeBuffer;
1069 Filename: String;
1070 begin
1071 Filename:=GetAdditionsFilename;
1072 fAdditions.SaveToFile(Filename);
1073 Code:=CodeToolBoss.LoadFile(Filename,true,false);
1074 if Code<>nil then
1075 fAdditionsChangeStep:=Code.ChangeStep;
1076 FLoadedAdditionsFilename:=Filename;
1077 end;
1078
TFPCMessagesHelpDatabase.GetAdditionsFilenamenull1079 function TFPCMessagesHelpDatabase.GetAdditionsFilename: string;
1080 var
1081 LazDir: String;
1082 begin
1083 Result:=AdditionsFile;
1084 IDEMacros.SubstituteMacros(Result);
1085 if Result='' then begin
1086 Result:=GetForcedPathDelims(FDefaultAdditionsFile);
1087 IDEMacros.SubstituteMacros(Result);
1088 end;
1089 Result:=TrimFilename(Result);
1090 if not FilenameIsAbsolute(Result) then begin
1091 LazDir:=EnvironmentOptions.GetParsedLazarusDirectory;
1092 Result:=TrimFilename(AppendPathDelim(LazDir)+Result);
1093 end;
1094 end;
1095
1096 end.
1097
1098