lazarus/ide/helpfpcmessages.pas

{
 /***************************************************************************
                            helpfpcmessages.pas
                            -------------------


 ***************************************************************************/

 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************
 
  Author: Mattias Gaertner
   
  Abstract:
    Help items for FPC messages.
}
unit HelpFPCMessages;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fgl, LCLProc, Dialogs, TextTools, MacroIntf,
  LazarusIDEStrConsts, LazConfigStorage, HelpIntfs, IDEHelpIntf, BaseIDEIntf,
  IDEMsgIntf, IDEDialogs, IDEExternToolIntf, LazHelpIntf, LazHelpHTML, StdCtrls,
  ButtonPanel, ExtCtrls, Forms, Controls, Graphics, LCLIntf, CodeToolsFPCMsgs,
  FileProcs, LazFileUtils, LazFileCache, CodeToolManager, CodeCache,
  DefineTemplates, EnvironmentOpts;
  
const
  lihcFPCMessages = 'Free Pascal Compiler messages';
  lihFPCMessagesURL = 'http://wiki.lazarus.freepascal.org/';
  lihFPCMessagesInternalURL = 'file://Build_messages#FreePascal_Compiler_messages';

type

  { TMessageHelpAddition }

  TMessageHelpAddition = class
  public
    Name: string;
    URL: string;
    RegEx: string;
    IDs: string; // comma separated
    procedure Assign(Source: TMessageHelpAddition);
    function IsEqual(Source: TMessageHelpAddition): boolean;
    function Fits(ID: integer; Msg: string): boolean;
  end;
  TBaseMessageHelpAdditions = specialize TFPGObjectList<TMessageHelpAddition>;

  { TMessageHelpAdditions }

  TMessageHelpAdditions = class(TBaseMessageHelpAdditions)
  public
    function FindWithName(Name: string): TMessageHelpAddition;
    function IsEqual(Source: TMessageHelpAdditions): boolean;
    procedure Clone(Source: TMessageHelpAdditions);
    procedure LoadFromConfig(Cfg: TConfigStorage);
    procedure SaveToConfig(Cfg: TConfigStorage);
    procedure LoadFromFile(Filename: string);
    procedure SaveToFile(Filename: string);
  end;

  { TFPCMessagesHelpDatabase }

  TFPCMessagesHelpDatabase = class(THTMLHelpDatabase)
  private
    fAdditions: TMessageHelpAdditions;
    FAdditionsChangeStep: integer;
    FAdditionsFile: string;
    FDefaultAdditionsFile: string;
    FFoundAddition: TMessageHelpAddition;
    FDefaultNode: THelpNode;
    FFoundComment: string;
    FLastMessage: string;
    FLoadedAdditionsFilename: string;
    FMsgFile: TFPCMsgFile;
    FMsgFileChangeStep: integer;
    FMsgFilename: string;
    function GetAdditions(Index: integer): TMessageHelpAddition;
    procedure SetAdditionsFile(AValue: string);
    procedure SetFoundComment(const AValue: string);
    procedure SetLastMessage(const AValue: string);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    function GetNodesForMessage(const AMessage: string; MessageParts: TStrings;
                                var ListOfNodes: THelpNodeQueryList;
                                var ErrMsg: string): TShowHelpResult; override;
    function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
                      QueryItem: THelpQueryItem;
                      var ErrMsg: string): TShowHelpResult; override;
    procedure Load(Storage: TConfigStorage); override;
    procedure Save(Storage: TConfigStorage); override;
    property DefaultNode: THelpNode read FDefaultNode;
    property LastMessage: string read FLastMessage write SetLastMessage;
    property FoundComment: string read FFoundComment write SetFoundComment;
    property FoundAddition: TMessageHelpAddition read FFoundAddition;

    // the FPC message file
    function GetMsgFile: TFPCMsgFile;
    property MsgFile: TFPCMsgFile read FMsgFile;
    property MsgFilename: string read FMsgFilename;
    property MsgFileChangeStep: integer read FMsgFileChangeStep;

    // additional help for messages (they add an URL to the FPC comments)
    function AdditionsCount: integer;
    property Additions[Index: integer]: TMessageHelpAddition read GetAdditions;
    property AdditionsChangeStep: integer read FAdditionsChangeStep;
    property DefaultAdditionsFile: string read FDefaultAdditionsFile;
    property LoadedAdditionsFilename: string read FLoadedAdditionsFilename;
    procedure ClearAdditions;
    procedure LoadAdditions;
    procedure SaveAdditions;
    function GetAdditionsFilename: string;
  published
    property AdditionsFile: string read FAdditionsFile write SetAdditionsFile;
  end;

  { TEditIDEMsgHelpDialog }

  TEditIDEMsgHelpDialog = class(TForm)
    AddButton: TButton;
    AdditionFitsMsgLabel: TLabel;
    AdditionsFileEdit: TEdit;
    AdditionsFileLabel: TLabel;
    ButtonPanel1: TButtonPanel;
    CurGroupBox: TGroupBox;
    CurMsgGroupBox: TGroupBox;
    CurMsgMemo: TMemo;
    DeleteButton: TButton;
    FPCMsgFileValueLabel: TLabel;
    FPCMsgFileLabel: TLabel;
    GlobalOptionsGroupBox: TGroupBox;
    NameEdit: TEdit;
    NameLabel: TLabel;
    OnlyFPCMsgIDsLabel: TLabel;
    OnlyFPCMsgIDsEdit: TEdit;
    OnlyRegExEdit: TEdit;
    OnlyRegExLabel: TLabel;
    Splitter1: TSplitter;
    AllGroupBox: TGroupBox;
    TestURLButton: TButton;
    URLEdit: TEdit;
    URLLabel: TLabel;
    AllListBox: TListBox;
    procedure AddButtonClick(Sender: TObject);
    procedure AllListBoxSelectionChange(Sender: TObject; {%H-}User: boolean);
    procedure ButtonPanel1Click(Sender: TObject);
    procedure ButtonPanel1OKButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure NameEditChange(Sender: TObject);
    procedure OnlyFPCMsgIDsEditChange(Sender: TObject);
    procedure OnlyRegExEditChange(Sender: TObject);
    procedure TestURLButtonClick(Sender: TObject);
    procedure URLEditChange(Sender: TObject);
  private
    fDefaultValue: string;
    procedure FillAdditionsList;
    procedure UpdateCurAddition;
    procedure UpdateCurMessage;
    procedure UpdateAdditionsFitsMsg;
    function IsIDListValid(IDs: string): boolean;
    function IsRegexValid(re: string): boolean;
    function IsURLValid(URL: string): boolean;
  public
    Additions: TMessageHelpAdditions;
    CurAddition: TMessageHelpAddition;
    CurMsg: string;
    CurFPCId: integer;
  end;

var
  FPCMsgHelpDB: TFPCMessagesHelpDatabase = nil;

function ShowMessageHelpEditor: TModalResult;

procedure CreateFPCMessagesHelpDB;

implementation

{$R *.lfm}

function ShowMessageHelpEditor: TModalResult;
var
  Editor: TEditIDEMsgHelpDialog;
begin
  Editor:=TEditIDEMsgHelpDialog.Create(nil);
  try
    Result:=Editor.ShowModal;
  finally
    Editor.Free;
  end;
end;

procedure CreateFPCMessagesHelpDB;
var
  StartNode: THelpNode;
begin
  FPCMessagesHelpDB:=HelpDatabases.CreateHelpDatabase(lihcFPCMessages,
                                                 TFPCMessagesHelpDatabase,true);
  FPCMsgHelpDB:=FPCMessagesHelpDB as TFPCMessagesHelpDatabase;
  FPCMsgHelpDB.DefaultBaseURL:=lihFPCMessagesURL;

  // HTML nodes
  StartNode:=THelpNode.CreateURLID(FPCMsgHelpDB, lisFreePascalCompilerMessages,
          lihFPCMessagesInternalURL,lihcFPCMessages);
  FPCMsgHelpDB.TOCNode:=THelpNode.Create(FPCMsgHelpDB,StartNode);// once as TOC
  FPCMsgHelpDB.RegisterItemWithNode(StartNode);// and once as normal page
end;

{ TMessageHelpAdditions }

function TMessageHelpAdditions.FindWithName(Name: string): TMessageHelpAddition;
var
  i: Integer;
begin
  for i:=0 to Count-1 do begin
    Result:=Items[i];
    if SysUtils.CompareText(Result.Name,Name)=0 then exit;
  end;
  Result:=nil;
end;

function TMessageHelpAdditions.IsEqual(Source: TMessageHelpAdditions): boolean;
var
  i: Integer;
begin
  Result:=false;
  if Source=nil then exit;
  if Source=Self then exit(true);
  if Count<>Source.Count then exit;
  for i:=0 to Count-1 do
    if not Items[i].IsEqual(Source[i]) then exit;
  Result:=true;
end;

procedure TMessageHelpAdditions.Clone(Source: TMessageHelpAdditions);
var
  i: Integer;
  Item: TMessageHelpAddition;
begin
  Clear;
  for i:=0 to Source.Count-1 do begin
    Item:=TMessageHelpAddition.Create;
    Item.Assign(Source[i]);
    Add(Item);
  end;
end;

procedure TMessageHelpAdditions.LoadFromConfig(Cfg: TConfigStorage);
var
  Cnt: Integer;
  i: Integer;
  Item: TMessageHelpAddition;
  SubPath: String;
begin
  Clear;
  Cfg.AppendBasePath('Additions');
  try
    Cnt:=Cfg.GetValue('Count',0);
    for i:=1 to Cnt do begin
      Item:=TMessageHelpAddition.Create;
      SubPath:='Item'+IntToStr(i)+'/';
      Item.Name:=Cfg.GetValue(SubPath+'Name','');
      if Item.Name='' then begin
        Item.Free;
      end else begin
        Add(Item);
        Item.IDs:=cfg.GetValue(SubPath+'IDs','');
        Item.RegEx:=cfg.GetValue(SubPath+'RegEx','');
        Item.URL:=cfg.GetValue(SubPath+'URL','');
      end;
    end;
  finally
    Cfg.UndoAppendBasePath;
  end;
end;

procedure TMessageHelpAdditions.SaveToConfig(Cfg: TConfigStorage);
var
  Cnt: Integer;
  i: Integer;
  Item: TMessageHelpAddition;
  SubPath: String;
begin
  Cfg.AppendBasePath('Additions');
  try
    Cnt:=0;
    for i:=0 to Count-1 do begin
      Item:=Items[i];
      if Item.Name='' then continue;
      inc(Cnt);
      SubPath:='Item'+IntToStr(Cnt)+'/';
      Cfg.SetDeleteValue(SubPath+'Name',Item.Name,'');
      cfg.SetDeleteValue(SubPath+'IDs',Item.IDs,'');
      cfg.SetDeleteValue(SubPath+'RegEx',Item.RegEx,'');
      cfg.SetDeleteValue(SubPath+'URL',Item.URL,'');
    end;
    Cfg.SetDeleteValue('Count',Cnt,0);
  finally
    Cfg.UndoAppendBasePath;
  end;
end;

procedure TMessageHelpAdditions.LoadFromFile(Filename: string);
var
  Cfg: TConfigStorage;
begin
  try
    Cfg:=GetIDEConfigStorage(Filename,true);
    try
      LoadFromConfig(Cfg);
    finally
      Cfg.Free;
    end;
  except
    on E: Exception do begin
      debugln(['TMessageHelpAdditions.LoadFromFile unable to load file "'+Filename+'": '+E.Message]);
    end;
  end;
end;

procedure TMessageHelpAdditions.SaveToFile(Filename: string);
var
  Cfg: TConfigStorage;
begin
  try
    Cfg:=GetIDEConfigStorage(Filename,false);
    try
      SaveToConfig(Cfg);
      Cfg.WriteToDisk;
    finally
      Cfg.Free;
    end;
  except
    on E: Exception do begin
      debugln(['TMessageHelpAdditions.SaveToFile unable to save file "'+Filename+'": '+E.Message]);
    end;
  end;
end;

{ TMessageHelpAddition }

procedure TMessageHelpAddition.Assign(Source: TMessageHelpAddition);
begin
  Name:=Source.Name;
  IDs:=Source.IDs;
  RegEx:=Source.RegEx;
  URL:=Source.URL;
end;

function TMessageHelpAddition.IsEqual(Source: TMessageHelpAddition): boolean;
begin
  Result:=(Name=Source.Name)
      and (IDs=Source.IDs)
      and (RegEx=Source.RegEx)
      and (URL=Source.URL);
end;

function TMessageHelpAddition.Fits(ID: integer; Msg: string): boolean;
var
  CurID: Integer;
  p: PChar;
begin
  Result:=false;
  if Msg='' then exit;
  if RegEx<>'' then begin
    try
      Result:=REMatches(Msg,RegEx,'I');
    except
    end;
    if not Result then exit;
  end;
  if IDs<>'' then begin
    Result:=false;
    p:=PChar(IDs);
    CurID:=0;
    while p^<>#0 do begin
      case p^ of
      ',':
        if (CurID>0) and (CurID=ID) then begin
          Result:=true;
          break;
        end;
      '0'..'9':
        begin
          CurID:=CurID*10+ord(p^)-ord('0');
          if CurID>100000 then exit;
        end;
      else exit;
      end;
      inc(p);
    end;
    if (CurID>0) and (CurID=ID) then Result:=true;
    if not Result then exit;
  end;
end;

{ TEditIDEMsgHelpDialog }

procedure TEditIDEMsgHelpDialog.FormCreate(Sender: TObject);
var
  s: String;
begin
  fDefaultValue:=lisDefaultPlaceholder;
  Caption:=lisEditAdditionalHelpForMessages;

  GlobalOptionsGroupBox.Caption:=lisGlobalSettings;
  FPCMsgFileLabel.Caption:=lisFPCMessageFile2;
  AdditionsFileLabel.Caption:=lisConfigFileOfAdditions;

  CurMsgGroupBox.Caption:=lisSelectedMessageInMessagesWindow;

  AllGroupBox.Caption:=lisAdditions;
  AddButton.Caption:=lisCreateNewAddition;

  NameLabel.Caption:=lisCodeToolsDefsName;
  OnlyFPCMsgIDsLabel.Caption:=lisOnlyMessagesWithTheseFPCIDsCommaSeparated;
  OnlyRegExLabel.Caption:=lisOnlyMessagesFittingThisRegularExpression;
  s:=(FPCMessagesHelpDB as THTMLHelpDatabase).GetEffectiveBaseURL;
  URLLabel.Caption:=Format(lisURLOnWikiTheBaseUrlIs, [s]);
  TestURLButton.Caption:=lisTestURL;

  DeleteButton.Caption:=lisDeleteThisAddition;

  ButtonPanel1.OKButton.OnClick:=@ButtonPanel1OKButtonClick;

  // global options
  FPCMsgFileValueLabel.Caption:=EnvironmentOptions.GetParsedCompilerMessagesFilename;
  AdditionsFileEdit.Text:=FPCMsgHelpDB.AdditionsFile;

  // fetch selected message
  UpdateCurMessage;

  // list of additions
  FPCMsgHelpDB.LoadAdditions;
  Additions:=TMessageHelpAdditions.Create;
  Additions.Clone(FPCMsgHelpDB.fAdditions);
  FillAdditionsList;

  // current addition
  if AllListBox.Items.Count>0 then
    AllListBox.ItemIndex:=0;
  UpdateCurAddition;
end;

procedure TEditIDEMsgHelpDialog.ButtonPanel1Click(Sender: TObject);
begin

end;

procedure TEditIDEMsgHelpDialog.AllListBoxSelectionChange(Sender: TObject;
  User: boolean);
begin
  UpdateCurAddition;
end;

procedure TEditIDEMsgHelpDialog.AddButtonClick(Sender: TObject);
var
  i: Integer;
  Prefix: String;
  NewName: String;
  Item: TMessageHelpAddition;
begin
  if CurFPCId>=0 then
    Prefix:='Msg'+IntToStr(CurFPCId)+'_'
  else
    Prefix:='Msg';
  i:=1;
  repeat
    NewName:=Prefix+IntToStr(i);
    if Additions.FindWithName(NewName)=nil then break;
    inc(i);
  until false;
  Item:=TMessageHelpAddition.Create;
  Item.Name:=NewName;
  if CurFPCId>=0 then
    Item.IDs:=IntToStr(CurFPCId);
  Additions.Add(Item);
  FillAdditionsList;
  AllListBox.ItemIndex:=AllListBox.Items.IndexOf(Item.Name);
  UpdateCurAddition;
end;

procedure TEditIDEMsgHelpDialog.ButtonPanel1OKButtonClick(Sender: TObject);
var
  Filename: TCaption;
  HasChanged: Boolean;
begin
  HasChanged:=false;

  Filename:=EnvironmentOptions.GetParsedCompilerMessagesFilename;
  if (Filename=fDefaultValue) then
    Filename:='';

  Filename:=AdditionsFileEdit.Text;
  if (Filename=fDefaultValue)
  or (Filename=FPCMsgHelpDB.FDefaultAdditionsFile) then
    Filename:='';
  if FPCMsgHelpDB.AdditionsFile<>Filename then begin
    FPCMsgHelpDB.AdditionsFile:=Filename;
    HasChanged:=true;
  end;

  if HasChanged then begin
    // ToDo: save changes
    ShowMessage('Saving global options is not yet supported');
  end;

  if not Additions.IsEqual(FPCMsgHelpDB.fAdditions) then
  begin
    FPCMsgHelpDB.fAdditions.Clone(Additions);
    FPCMsgHelpDB.SaveAdditions;
  end;
end;

procedure TEditIDEMsgHelpDialog.DeleteButtonClick(Sender: TObject);
var
  i: LongInt;
  NewIndex: Integer;
begin
  if CurAddition=nil then exit;
  if IDEMessageDialog(lisDelete2,
    Format(lisDeleteAddition, [CurAddition.Name]), mtConfirmation, [mbYes, mbNo]
      )<>mrYes
  then exit;
  NewIndex:=AllListBox.ItemIndex;
  i:=Additions.IndexOf(CurAddition);
  CurAddition:=nil;
  if i>=0 then
    Additions.Delete(i);
  FillAdditionsList;
  if NewIndex<0 then NewIndex:=0;
  if NewIndex>=AllListBox.Items.Count then dec(NewIndex);
  AllListBox.ItemIndex:=NewIndex;
  UpdateCurAddition;
end;

procedure TEditIDEMsgHelpDialog.FormDestroy(Sender: TObject);
begin
  FreeAndNil(Additions);
end;

procedure TEditIDEMsgHelpDialog.NameEditChange(Sender: TObject);
var
  NewName: TCaption;
  ConflictAddition: TMessageHelpAddition;
begin
  NewName:=NameEdit.Text;
  ConflictAddition:=Additions.FindWithName(NewName);
  if (NewName='') or (CurAddition=nil)
  or ((ConflictAddition<>nil) and (Additions.FindWithName(NewName)<>CurAddition))
  then begin
    // invalid name
    NameLabel.Font.Color:=clRed;
  end else begin
    NameLabel.Font.Color:=clDefault;
    CurAddition.Name:=NewName;
    AllListBox.Items[AllListBox.ItemIndex]:=NewName;
  end;
end;

procedure TEditIDEMsgHelpDialog.OnlyFPCMsgIDsEditChange(Sender: TObject);
var
  NewIDs: TCaption;
begin
  NewIDs:=OnlyFPCMsgIDsEdit.Text;
  if (CurAddition=nil) or (not IsIDListValid(NewIDs)) then begin
    OnlyFPCMsgIDsLabel.Font.Color:=clRed;
  end else begin
    OnlyFPCMsgIDsLabel.Font.Color:=clDefault;
    CurAddition.IDs:=NewIDs;
    UpdateAdditionsFitsMsg;
  end;
end;

procedure TEditIDEMsgHelpDialog.OnlyRegExEditChange(Sender: TObject);
var
  NewRE: TCaption;
begin
  NewRE:=OnlyRegExEdit.Text;
  if (CurAddition=nil) or (not IsRegexValid(NewRE)) then begin
    OnlyRegExLabel.Font.Color:=clRed;
  end else begin
    OnlyRegExLabel.Font.Color:=clDefault;
    CurAddition.RegEx:=NewRE;
    UpdateAdditionsFitsMsg;
  end;
end;

procedure TEditIDEMsgHelpDialog.TestURLButtonClick(Sender: TObject);
var
  URL: String;
begin
  if (CurAddition=nil) or (CurAddition.URL='') then exit;
  URL:=FPCMsgHelpDB.GetEffectiveBaseURL+CurAddition.URL;
  OpenURL(URL);
end;

procedure TEditIDEMsgHelpDialog.URLEditChange(Sender: TObject);
var
  NewURL: TCaption;
begin
  NewURL:=URLEdit.Text;
  if (CurAddition=nil) or (not IsURLValid(NewURL)) then begin
    URLLabel.Font.Color:=clRed;
  end else begin
    URLLabel.Font.Color:=clDefault;
    CurAddition.URL:=NewURL;
  end;
end;

procedure TEditIDEMsgHelpDialog.FillAdditionsList;
var
  sl: TStringList;
  i: Integer;
begin
  sl:=TStringList.Create;
  try
    for i:=0 to Additions.Count-1 do
      sl.Add(Additions[i].Name);
    sl.Sort;
    AllListBox.Items.Assign(sl);
  finally
    sl.Free;
  end;
end;

procedure TEditIDEMsgHelpDialog.UpdateCurAddition;
var
  i: Integer;
begin
  i:=AllListBox.ItemIndex;
  if i>=0 then
    CurAddition:=Additions.FindWithName(AllListBox.Items[i])
  else
    CurAddition:=nil;
  if CurAddition=nil then begin
    CurGroupBox.Caption:=lisNoneSelected;
    CurGroupBox.Enabled:=false;
    NameEdit.Text:='';
    OnlyFPCMsgIDsEdit.Text:='';
    OnlyRegExEdit.Text:='';
    URLEdit.Text:='';
    for i:=0 to CurGroupBox.ControlCount-1 do
      CurGroupBox.Controls[i].Enabled:=false;
    NameLabel.Font.Color:=clDefault;
    OnlyFPCMsgIDsEdit.Font.Color:=clDefault;
    OnlyRegExEdit.Font.Color:=clDefault;
    URLEdit.Font.Color:=clDefault;
  end else begin
    CurGroupBox.Caption:=lisSelectedAddition;
    CurGroupBox.Enabled:=true;
    NameEdit.Text:=CurAddition.Name;
    NameLabel.Font.Color:=clDefault;
    OnlyFPCMsgIDsEdit.Text:=CurAddition.IDs;
    if not IsIDListValid(CurAddition.IDs) then
      OnlyFPCMsgIDsLabel.Font.Color:=clRed
    else
      OnlyFPCMsgIDsLabel.Font.Color:=clDefault;
    OnlyRegExEdit.Text:=CurAddition.RegEx;
    if not IsRegexValid(CurAddition.RegEx) then
      OnlyRegExLabel.Font.Color:=clRed
    else
      OnlyRegExLabel.Font.Color:=clDefault;
    URLEdit.Text:=CurAddition.URL;
    if not IsURLValid(CurAddition.URL) then
      URLLabel.Font.Color:=clRed
    else
      URLLabel.Font.Color:=clDefault;
    for i:=0 to CurGroupBox.ControlCount-1 do
      CurGroupBox.Controls[i].Enabled:=true;
  end;
  UpdateAdditionsFitsMsg;
end;

procedure TEditIDEMsgHelpDialog.UpdateCurMessage;
var
  Line: TMessageLine;
  sl: TStringList;
  MsgFile: TFPCMsgFile;
  FPCMsg: TFPCMsgItem;
begin
  CurMsg:='';
  CurFPCId:=-1;
  Line:=IDEMessagesWindow.GetSelectedLine;
  if Line=nil then begin
    CurMsgMemo.Text:=lisNoMessageSelected;
    CurMsgMemo.Enabled:=false;
  end else begin
    CurMsg:=Line.Msg;
    sl:=TStringList.Create;
    try
      sl.Add('Msg='+Line.Msg);
      sl.Add('MsgID='+IntToStr(Line.MsgID));
      MsgFile:=FPCMsgHelpDB.GetMsgFile;
      if MsgFile<>nil then begin
        FPCMsg:=nil;
        if Line.MsgID>0 then
          FPCMsg:=MsgFile.FindWithID(Line.MsgID);
        if FPCMsg=nil then
          FPCMsg:=MsgFile.FindWithMessage(Line.Msg);
        if FPCMsg<>nil then begin
          CurFPCId:=FPCMsg.ID;
          sl.Add('FPC Msg='+FPCMsg.GetName);
        end;
      end;
      CurMsgMemo.Text:=sl.Text;
    finally
      sl.Free;
    end;
    CurMsgMemo.Enabled:=true;
  end;
end;

procedure TEditIDEMsgHelpDialog.UpdateAdditionsFitsMsg;
begin
  if (CurAddition=nil) or (CurMsg='') then
    AdditionFitsMsgLabel.Visible:=false
  else begin
    AdditionFitsMsgLabel.Visible:=true;
    if CurAddition.Fits(CurFPCId,CurMsg) then begin
      AdditionFitsMsgLabel.Caption:=lisAdditionFitsTheCurrentMessage;
    end else begin
      AdditionFitsMsgLabel.Caption:=lisAdditionDoesNotFitTheCurrentMessage;
    end;
  end;
end;

function TEditIDEMsgHelpDialog.IsIDListValid(IDs: string): boolean;
// comma separated decimal numbers
var
  p: PChar;
  id: Integer;
begin
  if IDs='' then exit(true);
  Result:=false;
  p:=PChar(IDs);
  id:=0;
  while p^<>#0 do begin
    case p^ of
    ',': id:=0;
    '0'..'9':
      begin
        id:=id*10+ord(p^)-ord('0');
        if id>100000 then begin
          debugln(['TEditIDEMsgHelpDialog.IsIDListValid id too big ',id]);
          exit;
        end;
      end;
    else
      debugln(['TEditIDEMsgHelpDialog.IsIDListValid invalid character ',ord(p^),'=',dbgstr(p[0])]);
      exit;
    end;
    inc(p);
  end;
  Result:=true;
end;

function TEditIDEMsgHelpDialog.IsRegexValid(re: string): boolean;
begin
  if re='' then exit(true);
  Result:=false;
  try
    REMatches('',re,'I');
    Result:=true;
  except
    on E: Exception do begin
      debugln(['TEditIDEMsgHelpDialog.IsRegexValid inalid Re="',re,'": ',E.Message]);
    end;
  end;
end;

function TEditIDEMsgHelpDialog.IsURLValid(URL: string): boolean;
var
  i: Integer;
begin
  Result:=false;
  if URL='' then exit;
  for i:=1 to length(URL) do begin
    if URL[i] in [#0..#32] then exit;
  end;
  Result:=true;
end;

{ TFPCMessagesHelpDatabase }

procedure TFPCMessagesHelpDatabase.SetFoundComment(const AValue: string);
begin
  if FFoundComment=AValue then exit;
  FFoundComment:=AValue;
end;

function TFPCMessagesHelpDatabase.GetAdditions(Index: integer
  ): TMessageHelpAddition;
begin
  Result:=fAdditions[Index];
end;

procedure TFPCMessagesHelpDatabase.SetAdditionsFile(AValue: string);
begin
  if FAdditionsFile=AValue then Exit;
  FAdditionsFile:=AValue;
  FAdditionsChangeStep:=CTInvalidChangeStamp;
  FLoadedAdditionsFilename:='';
end;

procedure TFPCMessagesHelpDatabase.SetLastMessage(const AValue: string);
begin
  if FLastMessage=AValue then exit;
  FLastMessage:=AValue;
end;

constructor TFPCMessagesHelpDatabase.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  FDefaultAdditionsFile:='$(LazarusDir)/docs/additionalmsghelp.xml';
  fAdditions:=TMessageHelpAdditions.Create;
  FAdditionsChangeStep:=CTInvalidChangeStamp;
  FMsgFileChangeStep:=CTInvalidChangeStamp;
  FDefaultNode:=THelpNode.CreateURL(Self, lisFPCMessagesAppendix,
     'http://lazarus-ccr.sourceforge.net/fpcdoc/user/userap3.html#x81-168000C');
end;

destructor TFPCMessagesHelpDatabase.Destroy;
begin
  FreeAndNil(fAdditions);
  FreeAndNil(FDefaultNode);
  FreeAndNil(FMsgFile);
  inherited Destroy;
end;

function TFPCMessagesHelpDatabase.GetNodesForMessage(const AMessage: string;
  MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList;
  var ErrMsg: string): TShowHelpResult;
var
  MsgItem: TFPCMsgItem;
  i: Integer;
  FPCID: Integer;
  MsgId: Integer;
begin
  FFoundAddition:=nil;
  FFoundComment:='';
  FPCID:=-1;
  Result:=inherited GetNodesForMessage(AMessage, MessageParts, ListOfNodes,
                                       ErrMsg);
  if (ListOfNodes<>nil) and (ListOfNodes.Count>0) then exit;
  LastMessage:=AMessage;

  // search message in FPC message file
  GetMsgFile;
  MsgItem:=nil;
  if MsgFile<>nil then begin
    MsgId:=StrToIntDef(MessageParts.Values['MsgId'],0);
    if MsgId>0 then
      MsgItem:=MsgFile.FindWithID(MsgId);
    if MsgItem=nil then
      MsgItem:=MsgFile.FindWithMessage(AMessage);
    if MsgItem<>nil then begin
      FoundComment:=MsgItem.GetTrimmedComment(true,true);
      FPCID:=MsgItem.ID;
    end;
  end;

  // search message in additions
  LoadAdditions;
  FFoundAddition:=nil;
  for i:=0 to AdditionsCount-1 do begin
    if Additions[i].Fits(FPCID,AMessage) then begin
      FFoundAddition:=Additions[i];
      break;
    end;
  end;

  if (FoundComment<>'') or (FoundAddition<>nil) then begin
    Result:=shrSuccess;
    CreateNodeQueryListAndAdd(DefaultNode,nil,ListOfNodes,true);
    //DebugLn('TFPCMessagesHelpDatabase.GetNodesForMessage ',FoundComment);
  end;
end;

function TFPCMessagesHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
  NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string
  ): TShowHelpResult;
var
  URL: String;
begin
  Result:=shrHelpNotFound;
  if NewNode<>DefaultNode then begin
    Result:=inherited ShowHelp(Query, BaseNode, NewNode, QueryItem, ErrMsg);
  end else begin
    URL:='';
    if (FoundAddition<>nil) and (FoundAddition.URL<>'') then
      URL:=GetEffectiveBaseURL+FoundAddition.URL;
    if FoundComment<>'' then begin
      if URL='' then begin
        IDEMessageDialog(lisHFMHelpForFreePascalCompilerMessage, FoundComment,
                   mtInformation,[mbOk]);
      end else begin
        if IDEQuestionDialog(lisHFMHelpForFreePascalCompilerMessage, Format(
          lisThereAreAdditionalNotesForThisMessageOn, [FoundComment
                   +LineEnding+LineEnding, LineEnding+URL]),
                   mtInformation, [mrYes, lisOpenURL, mrClose, lisClose])=mrYes
                     then
        begin
          if not OpenURL(URL) then
            exit(shrViewerError);
        end;
      end;
    end else if URL<>'' then begin
      if not OpenURL(URL) then
        exit(shrViewerError);
    end;
    Result:=shrSuccess;
  end;
end;

procedure TFPCMessagesHelpDatabase.Load(Storage: TConfigStorage);
begin
  inherited Load(Storage);
  AdditionsFile:=Storage.GetValue('Additions/Filename','');
end;

procedure TFPCMessagesHelpDatabase.Save(Storage: TConfigStorage);
begin
  inherited Save(Storage);
  Storage.SetDeleteValue('Additions/Filename',AdditionsFile,'');
end;

function TFPCMessagesHelpDatabase.GetMsgFile: TFPCMsgFile;
var
  Filename: String;
  FPCSrcDir: String;
  Code: TCodeBuffer;
  AltFilename: String;
  UnitSet: TFPCUnitSetCache;
  CfgCache: TFPCTargetConfigCache;
begin
  Result:=nil;
  Filename:=EnvironmentOptions.GetParsedCompilerMessagesFilename;
  if Filename='' then
    FileName:='errore.msg';
  if not FilenameIsAbsolute(Filename) then
  begin
    // try in FPC sources and Compiler directory
    UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
    if UnitSet=nil then exit;

    // try in FPC sources
    FPCSrcDir:=UnitSet.FPCSourceDirectory;
    if (FPCSrcDir<>'') then begin
      AltFilename:=TrimFilename(AppendPathDelim(FPCSrcDir)
                +GetForcedPathDelims('compiler/msg/')+Filename);
      if FileExistsCached(AltFilename) then
        Filename:=AltFilename;
    end;

    if not FilenameIsAbsolute(Filename) then
    begin
      // try in compiler path
      CfgCache:=UnitSet.GetConfigCache(true);
      if CfgCache<>nil then begin
        // try in back end compiler path
        if FilenameIsAbsolute(CfgCache.RealCompiler) then
        begin
          AltFilename:=AppendPathDelim(ExtractFilePath(CfgCache.RealCompiler))
                      +'msg'+PathDelim+Filename;
          if FileExistsCached(AltFilename) then
            Filename:=AltFilename;
        end;
        // try in front end compiler path
        if (not FilenameIsAbsolute(Filename))
        and FilenameIsAbsolute(CfgCache.Compiler) then
        begin
          AltFilename:=AppendPathDelim(ExtractFilePath(CfgCache.Compiler))
                      +'msg'+PathDelim+Filename;
          if FileExistsCached(AltFilename) then
            Filename:=AltFilename;
        end;
      end;
    end;

    if not FilenameIsAbsolute(Filename) then exit;
  end;

  Code:=CodeToolBoss.LoadFile(Filename,true,false);
  if Code=nil then exit;

  // load MsgFile
  if (Filename<>MsgFilename) or (Code.ChangeStep<>MsgFileChangeStep) then begin
    fMsgFilename:=Filename;
    if FMsgFile=nil then
      FMsgFile:=TFPCMsgFile.Create;
    FMsgFileChangeStep:=Code.ChangeStep;
    try
      MsgFile.LoadFromText(Code.Source);
    except
      on E: Exception do begin
        debugln(['TFPCMessagesHelpDatabase failed to parse "'+MsgFilename+'": '+E.Message]);
        exit;
      end;
    end;
  end;
  Result:=MsgFile;
end;

function TFPCMessagesHelpDatabase.AdditionsCount: integer;
begin
  Result:=fAdditions.Count;
end;

procedure TFPCMessagesHelpDatabase.ClearAdditions;
begin
  fAdditions.Clear;
  FLoadedAdditionsFilename:='';
  FAdditionsChangeStep:=CTInvalidChangeStamp;
  FFoundAddition:=nil;
end;

procedure TFPCMessagesHelpDatabase.LoadAdditions;
var
  Filename: String;
  Code: TCodeBuffer;
begin
  Filename:=GetAdditionsFilename;
  if FLoadedAdditionsFilename<>Filename then
    FAdditionsChangeStep:=CTInvalidChangeStamp;
  Code:=CodeToolBoss.LoadFile(Filename,true,false);
  if Code<>nil then begin
    if Code.ChangeStep=AdditionsChangeStep then exit;
    fAdditionsChangeStep:=Code.ChangeStep;
  end else
    fAdditionsChangeStep:=CTInvalidChangeStamp;
  ClearAdditions;
  fAdditions.LoadFromFile(Filename);
  FLoadedAdditionsFilename:=Filename;
end;

procedure TFPCMessagesHelpDatabase.SaveAdditions;
var
  Code: TCodeBuffer;
  Filename: String;
begin
  Filename:=GetAdditionsFilename;
  fAdditions.SaveToFile(Filename);
  Code:=CodeToolBoss.LoadFile(Filename,true,false);
  if Code<>nil then
    fAdditionsChangeStep:=Code.ChangeStep;
  FLoadedAdditionsFilename:=Filename;
end;

function TFPCMessagesHelpDatabase.GetAdditionsFilename: string;
var
  LazDir: String;
begin
  Result:=AdditionsFile;
  IDEMacros.SubstituteMacros(Result);
  if Result='' then begin
    Result:=GetForcedPathDelims(FDefaultAdditionsFile);
    IDEMacros.SubstituteMacros(Result);
  end;
  Result:=TrimFilename(Result);
  if not FilenameIsAbsolute(Result) then begin
    LazDir:=EnvironmentOptions.GetParsedLazarusDirectory;
    Result:=TrimFilename(AppendPathDelim(LazDir)+Result);
  end;
end;

end.