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