{  $Id: helpmanager.pas 16683 2008-09-23 12:42:33Z laurent $  }
{
 /***************************************************************************
                            helpmanager.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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************
}
unit HelpManager;

{$mode objfpc}{$H+}

interface

uses
  // FCL+LCL
  Classes, SysUtils, AVL_Tree, LCLProc, LCLIntf, LCLType, Forms, Controls, Buttons,
  StdCtrls, Dialogs, ExtCtrls, LResources, FileUtil,
  // CodeTools
  BasicCodeTools, CodeToolManager, CodeAtom, CodeCache, CustomCodeTool, CodeTree,
  PascalParserTool, FindDeclarationTool,
  // IDEIntf
  PropEdits, ObjectInspector, FormEditingIntf, ProjectIntf,
  LazHelpIntf, LazHelpHTML, HelpFPDoc, MacroIntf, IDEWindowIntf, IDEMsgIntf,
  LazIDEIntf, HelpIntfs, IDEHelpIntf,
  // IDE
  LazarusIDEStrConsts, TransferMacros, DialogProcs, IDEOptionDefs,
  ObjInspExt, EnvironmentOpts, AboutFrm, MsgView, Project, PackageDefs, MainBar,
  OutputFilter, HelpOptions, MainIntf, LazConf, HelpFPCMessages, CodeHelp,
  IDEContextHelpEdit;

type

  TLIHProviders = class;

  { TLazIDEHTMLProvider }

  TLazIDEHTMLProvider = class(TAbstractIDEHTMLProvider)
  private
    FProviders: TLIHProviders;
    procedure SetProviders(const AValue: TLIHProviders);
  public
    function GetStream(const URL: string): TStream; override;
    procedure ReleaseStream(const URL: string); override;
    property Providers: TLIHProviders read FProviders write SetProviders;
  end;

  { TLIHProviderStream }

  TLIHProviderStream = class
  private
    FRefCount: integer;
  public
    Stream: TStream;
    URL: string;
    destructor Destroy; override;
    procedure IncreaseRefCount;
    procedure DecreaseRefCount;
    property RefCount: integer read FRefCount;
  end;

  { TLIHProviders
    manages all TLazIDEHTMLProvider }

  TLIHProviders = class
  private
    FStreams: TAVLTree;// tree of TLIHProviderStream sorted for URL
  public
    constructor Create;
    destructor Destroy; override;
    function FindStream(const URL: string; CreateIfNotExists: Boolean): TLIHProviderStream;
    function GetStream(const URL: string): TStream;
    procedure ReleaseStream(const URL: string);
  end;

  { TSimpleHTMLControl }

  TSimpleHTMLControl = class(TLabel,TIDEHTMLControlIntf)
  private
    FProvider: TAbstractIDEHTMLProvider;
    FURL: string;
    procedure SetProvider(const AValue: TAbstractIDEHTMLProvider);
    function HTMLToCaption(const s: string): string;
  public
    function GetURL: string;
    procedure SetURL(const AValue: string);
    property Provider: TAbstractIDEHTMLProvider read FProvider write SetProvider;
    procedure SetHTMLContent(Stream: TStream);
    procedure GetPreferredControlSize(out AWidth, AHeight: integer);
  end;

  { TIDEHelpDatabases }

  TIDEHelpDatabases = class(THelpDatabases)
  public
    function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList;
                              var ErrMsg: string;
                              var Selection: THelpNodeQuery
                              ): TShowHelpResult; override;
    function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; override;
    function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition;
                                       var ErrMsg: string): TShowHelpResult; override;
    function SubstituteMacros(var s: string): boolean; override;
  end;
  
  
  { TIDEHelpManager }

  TIDEHelpManager = class(TBaseHelpManager)
    // help menu of the IDE menu bar
    procedure mnuHelpAboutLazarusClicked(Sender: TObject);
    procedure mnuHelpConfigureHelpClicked(Sender: TObject);
    procedure mnuHelpOnlineHelpClicked(Sender: TObject);
    procedure mnuHelpReportBugClicked(Sender: TObject);
  private
    FFCLHelpDBPath: THelpBaseURLObject;
    FLCLHelpDBPath: THelpBaseURLObject;
    FMainHelpDB: THelpDatabase;
    FMainHelpDBPath: THelpBasePathObject;
    FRTLHelpDB: THelpDatabase;
    FFCLHelpDB: THelpDatabase;
    FLCLHelpDB: THelpDatabase;
    FRTLHelpDBPath: THelpBaseURLObject;
    FHTMLProviders: TLIHProviders;
    procedure RegisterIDEHelpDatabases;
    procedure RegisterDefaultIDEHelpViewers;
    procedure FindDefaultBrowser(var DefaultBrowser, Params: string);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateFPCDocsHTMLDirectory;

    procedure ConnectMainBarEvents; override;
    procedure LoadHelpOptions; override;
    procedure SaveHelpOptions; override;

    procedure ShowLazarusHelpStartPage;
    procedure ShowIDEHelpForContext(HelpContext: THelpContext);
    procedure ShowIDEHelpForKeyword(const Keyword: string);

    function ShowHelpForSourcePosition(const Filename: string;
                                       const CodePos: TPoint;
                                       var ErrMsg: string): TShowHelpResult; override;
    procedure ShowHelpForMessage(Line: integer); override;
    procedure ShowHelpForObjectInspector(Sender: TObject); override;
    function GetHintForSourcePosition(const ExpandedFilename: string;
                                      const CodePos: TPoint;
                                      out BaseURL, HTMLHint: string): TShowHelpResult;

    function ConvertSourcePosToPascalHelpContext(const CaretPos: TPoint;
               const Filename: string): TPascalHelpContextList; override;
    function ConvertCodePosToPascalHelpContext(
               ACodePos: PCodeXYPosition): TPascalHelpContextList;
  public
    property FCLHelpDB: THelpDatabase read FFCLHelpDB;
    property FCLHelpDBPath: THelpBaseURLObject read FFCLHelpDBPath;
    property LCLHelpDB: THelpDatabase read FLCLHelpDB;
    property LCLHelpDBPath: THelpBaseURLObject read FLCLHelpDBPath;
    property MainHelpDB: THelpDatabase read FMainHelpDB;
    property MainHelpDBPath: THelpBasePathObject read FMainHelpDBPath;
    property RTLHelpDB: THelpDatabase read FRTLHelpDB;
    property RTLHelpDBPath: THelpBaseURLObject read FRTLHelpDBPath;
  end;

  { THelpSelectorDialog }
  
  THelpSelectorDialog = class(TForm)
    OKButton: TBitBtn;
    CancelButton: TBitBtn;
    NodesGroupBox: TGroupBox;
    NodesListBox: TListBox;
    BtnPanel: TPanel;
    procedure HelpSelectorDialogClose(Sender: TObject;
      var CloseAction: TCloseAction);
    procedure NodesListBoxDblClick(Sender: TObject);
  private
    FNodes: THelpNodeQueryList;
    procedure SetNodes(const AValue: THelpNodeQueryList);
    procedure FillNodesListBox;
  public
    constructor Create(TheOwner: TComponent); override;
    property Nodes: THelpNodeQueryList read FNodes write SetNodes;
  end;

  { Help Contexts for IDE help }
const
  lihcStartPage = 'StartPage';
  lihcRTLUnits = 'RTLUnits';
  lihcFCLUnits = 'FCLUnits';
  lihcLCLUnits = 'LCLUnits';
  
  lihBaseUrl = 'http://lazarus-ccr.sourceforge.net/docs/';

  lihRTLURL = lihBaseUrl+'rtl/';
  lihFCLURL = lihBaseUrl+'fcl/';
  lihLCLURL = lihBaseUrl+'lcl/';

var
  HelpBoss: TBaseHelpManager = nil;
  
implementation

function LazCreateIDEHTMLControl(Owner: TComponent;
  var Provider: TAbstractIDEHTMLProvider): TControl;
var
  HTMLControl: TSimpleHTMLControl;
begin
  HTMLControl:=TSimpleHTMLControl.Create(Owner);
  Result:=HTMLControl;
  if Provider=nil then
    Provider:=CreateIDEHTMLProvider(HTMLControl);
  Provider.ControlIntf:=HTMLControl;
  HTMLControl.Provider:=Provider;
end;

function LazCreateIDEHTMLProvider(Owner: TComponent): TAbstractIDEHTMLProvider;
begin
  Result:=TLazIDEHTMLProvider.Create(Owner);
  TLazIDEHTMLProvider(Result).Providers:=TIDEHelpManager(HelpBoss).FHTMLProviders;
end;

function CompareLIHProviderStream(Data1, Data2: Pointer): integer;
begin
  Result:=CompareStr(TLIHProviderStream(Data1).URL,TLIHProviderStream(Data2).URL);
end;

function CompareURLWithLIHProviderStream(URL, Stream: Pointer): integer;
begin
  Result:=CompareStr(AnsiString(URL),TLIHProviderStream(Stream).URL);
end;

{ TSimpleHTMLControl }

procedure TSimpleHTMLControl.SetProvider(const AValue: TAbstractIDEHTMLProvider
  );
begin
  if FProvider=AValue then exit;
  FProvider:=AValue;
end;

function TSimpleHTMLControl.HTMLToCaption(const s: string): string;
var
  p: Integer;
  EndPos: Integer;
  CurTag: String;
  NewTag: String;
begin
  Result:=s;
  p:=1;
  while p<=length(Result) do begin
    if Result[p]='<' then begin
      // skip html tag
      EndPos:=p+1;
      while (EndPos<=length(Result)) do begin
        if Result[EndPos]='"' then begin
          // skip " tag
          while (EndPos<=length(Result)) and (Result[EndPos]<>'"') do
            inc(EndPos);
          if EndPos>length(Result) then break;
        end;
        if (Result[EndPos]='>') then begin
          inc(EndPos);
          break;
        end;
        inc(EndPos);
      end;
      CurTag:=copy(Result,p,EndPos-p);
      if SysUtils.CompareText(CurTag,'<BR>')=0 then
        NewTag:=LineEnding
      else
        NewTag:='';
      if NewTag='' then
        System.Delete(Result,p,EndPos-p)
      else begin
        Result:=copy(Result,1,p-1)+NewTag+copy(Result,EndPos,length(Result));
        inc(p,length(NewTag));
      end;
    end else if Result[p] in [' ',#9,#10,#13] then begin
      // replace spaces and newline characters with single space
      EndPos:=p+1;
      while (EndPos<=length(Result)) and (Result[EndPos] in [' ',#9,#10,#13]) do
        inc(EndPos);
      Result:=copy(Result,1,p-1)+' '+copy(Result,EndPos,length(Result));
      inc(p);
    end else
      inc(p);
  end;
  DebugLn(['TSimpleHTMLControl.HTMLToCaption "',dbgstr(Result),'"']);
end;

function TSimpleHTMLControl.GetURL: string;
begin
  Result:=FURL;
end;

procedure TSimpleHTMLControl.SetURL(const AValue: string);
var
  Stream: TStream;
  s: string;
  NewURL: String;
begin
  if Provider=nil then raise Exception.Create('TSimpleHTMLControl.SetURL missing Provider');
  if FURL=AValue then exit;
  NewURL:=Provider.BuildURL(Provider.BaseURL,AValue);
  if FURL=NewURL then exit;
  FURL:=NewURL;
  try
    Stream:=Provider.GetStream(FURL);
    SetLength(s,Stream.Size);
    if s<>'' then
      Stream.Read(s[1],length(s));
    Caption:=HTMLToCaption(s);
    Provider.ReleaseStream(FURL);
  except
    on E: Exception do begin
      Caption:=E.Message;
    end;
  end;
end;

procedure TSimpleHTMLControl.SetHTMLContent(Stream: TStream);
var
  s: string;
begin
  SetLength(s,Stream.Size);
  if s<>'' then
    Stream.Read(s[1],length(s));
  Caption:=HTMLToCaption(s);
end;

procedure TSimpleHTMLControl.GetPreferredControlSize(out AWidth, AHeight: integer);
var
  DC: HDC;
  R: TRect;
  OldFont: HGDIOBJ;
  Flags: Cardinal;
  LabelText: String;
begin
  AWidth:=0;
  AHeight:=0;
  DC := GetDC(Parent.Handle);
  try
    R := Rect(0, 0, 600, 200);
    OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle));
    Flags := DT_CalcRect;
    inc(Flags, DT_WordBreak);
    LabelText := GetLabelText;
    DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags);
    SelectObject(DC, OldFont);
    AWidth := R.Right - R.Left;
    AHeight := R.Bottom - R.Top;
  finally
    ReleaseDC(Parent.Handle, DC);
  end;
  DebugLn(['TSimpleHTMLControl.GetPreferredControlSize Caption="',Caption,'" ',AWidth,'x',AHeight]);
end;

{ TLazIDEHTMLProvider }

procedure TLazIDEHTMLProvider.SetProviders(const AValue: TLIHProviders);
begin
  if FProviders=AValue then exit;
  FProviders:=AValue;
end;

function TLazIDEHTMLProvider.GetStream(const URL: string): TStream;
begin
  Result:=FProviders.GetStream(URL);
end;

procedure TLazIDEHTMLProvider.ReleaseStream(const URL: string);
begin
  FProviders.ReleaseStream(URL);
end;

{ TLIHProviders }

constructor TLIHProviders.Create;
begin
  FStreams:=TAVLTree.Create(@CompareLIHProviderStream);
end;

destructor TLIHProviders.Destroy;
begin
  FStreams.FreeAndClear;
  FreeAndNil(FStreams);
  inherited Destroy;
end;

function TLIHProviders.FindStream(const URL: string; CreateIfNotExists: Boolean
  ): TLIHProviderStream;
var
  Node: TAVLTreeNode;
begin
  if URL='' then
    exit(nil);
  Node:=FStreams.FindKey(Pointer(URL),@CompareURLWithLIHProviderStream);
  if Node<>nil then begin
    Result:=TLIHProviderStream(Node.Data);
  end else if CreateIfNotExists then begin
    Result:=TLIHProviderStream.Create;
    Result.URL:=URL;
    FStreams.Add(Result);
  end else
    Result:=nil;
end;

function TLIHProviders.GetStream(const URL: string): TStream;

  procedure OpenFile(out Stream: TStream; const Filename: string);
  var
    fs: TFileStream;
    ok: Boolean;
  begin
    fs:=nil;
    ok:=false;
    try
      fs:=TFileStream.Create(UTF8ToSys(Filename),fmOpenRead);
      //DebugLn(['OpenFile ',Filename,' ',fs.Size,' ',fs.Position]);
      Stream:=fs;
      ok:=true;
    finally
      if not ok then
        fs.Free;
    end;
  end;


{const
  HTML =
     '<HTML>'+#10
    +'<BODY>'+#10
    +'Test'+#10
    +'</BODY>'+#10
    +'</HTML>';}
var
  Stream: TLIHProviderStream;
  URLType: string;
  URLPath: string;
  URLParams: string;
begin
  if URL='' then raise Exception.Create('TLIHProviders.GetStream no URL');
  Stream:=FindStream(URL,true);
  Stream.IncreaseRefCount;
  Result:=Stream.Stream;
  try
    if Result=nil then begin
      SplitURL(URL,URLType,URLPath,URLParams);
      DebugLn(['TLIHProviders.GetStream URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams]);
      if URLType='lazdoc' then begin
        if copy(URLPath,1,8)='lazarus/' then begin
          URLPath:=copy(URLPath,9,length(URLPath));
          if (URLPath='index.html')
          or (URLPath='images/laztitle.jpg')
          or (URLPath='images/cheetah1.png') then begin
            OpenFile(Result,'/home/mattias/pascal/wichtig/lazarus/docs/'+URLPath);
          end;
        end;
      end else begin

      end;
      {Result:=TMemoryStream.Create;
      Stream.Stream:=Result;
      Result.Write(HTML[1],length(HTML));
      Result.Position:=0;}
      if Result=nil then
        raise Exception.Create('TLIHProviders.GetStream: URL not found "'+dbgstr(URL)+'"');
      Stream.Stream:=Result;
    end;
  finally
    if Result=nil then
      ReleaseStream(URL);
  end;
end;

procedure TLIHProviders.ReleaseStream(const URL: string);
var
  Stream: TLIHProviderStream;
begin
  Stream:=FindStream(URL,false);
  if Stream=nil then
    raise Exception.Create('TLIHProviders.ReleaseStream "'+URL+'"');
  Stream.DecreaseRefCount;
  if Stream.RefCount=0 then begin
    FStreams.Remove(Stream);
    Stream.Free;
  end;
end;

{ TLIHProviderStream }

destructor TLIHProviderStream.Destroy;
begin
  FreeAndNil(Stream);
  inherited Destroy;
end;

procedure TLIHProviderStream.IncreaseRefCount;
begin
  inc(FRefCount);
end;

procedure TLIHProviderStream.DecreaseRefCount;
begin
  if FRefCount<=0 then
    raise Exception.Create('TLIHProviderStream.DecreaseRefCount');
  dec(FRefCount);
end;

{ THelpSelectorDialog }

procedure THelpSelectorDialog.HelpSelectorDialogClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  IDEDialogLayoutList.SaveLayout(Self);
end;

procedure THelpSelectorDialog.NodesListBoxDblClick(Sender: TObject);
begin
  ModalResult := mrOK;
end;

procedure THelpSelectorDialog.SetNodes(const AValue: THelpNodeQueryList);
begin
  if FNodes=AValue then exit;
  FNodes:=AValue;
  FillNodesListBox;
end;

procedure THelpSelectorDialog.FillNodesListBox;
var
  List: TStringList;
  i: Integer;
  NodeQuery: THelpNodeQuery;
begin
  List:=TStringList.Create;
  if (Nodes<>nil) then begin
    for i:=0 to Nodes.Count-1 do begin
      NodeQuery:=Nodes[i];
      List.Add(NodeQuery.AsString);
    end;
  end;
  NodesListBox.Items.Assign(List);
  List.Free;
end;

constructor THelpSelectorDialog.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  IDEDialogLayoutList.ApplyLayout(Self,500,300);

  Caption := lisHelpSelectorDialog;
  NodesGroupBox.Caption:=lisSelectAHelpItem;
  OkButton.Caption:=lisLazBuildOk;
  CancelButton.Caption:=dlgCancel;
  OkButton.LoadGlyphFromLazarusResource('btn_ok');
  CancelButton.LoadGlyphFromLazarusResource('btn_cancel');
end;

{ TIDEHelpDatabases }

function TIDEHelpDatabases.ShowHelpSelector(Query: THelpQuery;
  Nodes: THelpNodeQueryList;
  var ErrMsg: string;
  var Selection: THelpNodeQuery
  ): TShowHelpResult;
var
  Dialog: THelpSelectorDialog;
  i: LongInt;
begin
  Selection:=nil;
  Result:=shrNone;
  Dialog:=THelpSelectorDialog.Create(nil);
  try
    Dialog.Nodes:=Nodes;
    if Dialog.ShowModal=mrOk then begin
      i:=Dialog.NodesListBox.ItemIndex;
      if i>=0 then begin
        Selection:=Nodes[i];
        Result:=shrSuccess;
      end;
    end else begin
      Result:=shrCancel;
    end;
  finally
    Dialog.Free;
  end;
end;

function TIDEHelpDatabases.GetBaseDirectoryForBasePathObject(
  BasePathObject: TObject): string;
begin
  Result:='';
  DebugLn('TIDEHelpDatabases.GetBaseDirectoryForBasePathObject BasePathObject=',dbgsName(BasePathObject));
  if (BasePathObject is THelpBasePathObject) then
    Result:=THelpBasePathObject(BasePathObject).BasePath
  else if (BasePathObject=HelpBoss) or (BasePathObject=MainIDEInterface) then
    Result:=EnvironmentOptions.LazarusDirectory
  else if BasePathObject is TProject then
    Result:=TProject(BasePathObject).ProjectDirectory
  else if BasePathObject is TLazPackage then
    Result:=TLazPackage(BasePathObject).Directory;
  if Result<>'' then
    IDEMacros.SubstituteMacros(Result);
  Result:=AppendPathDelim(Result);
end;

function TIDEHelpDatabases.ShowHelpForSourcePosition(
  Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult;
begin
  Result:=HelpBoss.ShowHelpForSourcePosition(Query.Filename,
                                             Query.SourcePosition,ErrMsg);
end;

function TIDEHelpDatabases.SubstituteMacros(var s: string): boolean;
begin
  Result:=IDEMacros.SubstituteMacros(s);
end;

{ TIDEHelpManager }

procedure TIDEHelpManager.mnuHelpAboutLazarusClicked(Sender: TObject);
begin
  ShowAboutForm;
end;

procedure TIDEHelpManager.mnuHelpConfigureHelpClicked(Sender: TObject);
begin
  if ShowHelpOptionsDialog=mrOk then
    SaveHelpOptions;
end;

procedure TIDEHelpManager.mnuHelpOnlineHelpClicked(Sender: TObject);
begin
  ShowLazarusHelpStartPage;
end;

procedure TIDEHelpManager.mnuHelpReportBugClicked(Sender: TObject);
begin
  ShowHelpOrError(lisReportingBugURL, lisMenuReportingBug, 'text/html');
end;

procedure TIDEHelpManager.RegisterIDEHelpDatabases;

  procedure CreateMainIDEHelpDB;
  var
    StartNode: THelpNode;
    HTMLHelp: THTMLHelpDatabase;
  begin
    FMainHelpDB:=HelpDatabases.CreateHelpDatabase(lihcStartPage,
                                                  THTMLHelpDatabase,true);
    HTMLHelp:=FMainHelpDB as THTMLHelpDatabase;
    FMainHelpDBPath:=THelpBasePathObject.Create('$(LazarusDir)');
    HTMLHelp.BasePathObject:=FMainHelpDBPath;

    // HTML nodes for the IDE
    StartNode:=THelpNode.CreateURLID(HTMLHelp,'Lazarus',
                                     'file://docs/index.html',lihcStartPage);
    HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,StartNode);// once as TOC
    HTMLHelp.RegisterItemWithNode(StartNode);// and once as normal page
  end;
  
  procedure CreateRTLHelpDB;
  var
    HTMLHelp: TFPDocHTMLHelpDatabase;
    FPDocNode: THelpNode;
    DirItem: THelpDBISourceDirectory;
  begin
    FRTLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcRTLUnits,
                                                 TFPDocHTMLHelpDatabase,true);
    HTMLHelp:=FRTLHelpDB as TFPDocHTMLHelpDatabase;
    HTMLHelp.DefaultBaseURL:=lihRTLURL;
    FRTLHelpDBPath:=THelpBaseURLObject.Create;
    HTMLHelp.BasePathObject:=FRTLHelpDBPath;

    // FPDoc nodes for units in the RTL
    FPDocNode:=THelpNode.CreateURL(HTMLHelp,
                   'RTL - Free Pascal Run Time Library Units',
                   'file://index.html');
    HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);// once as TOC
    DirItem:=THelpDBISourceDirectory.Create(FPDocNode,'$(FPCSrcDir)/rtl',
                                   '*.pp;*.pas',true);// and once as normal page
    HTMLHelp.RegisterItem(DirItem);
  end;

  procedure CreateFCLHelpDB;
  var
    HTMLHelp: TFPDocHTMLHelpDatabase;
    FPDocNode: THelpNode;
    DirItem: THelpDBISourceDirectory;
  begin
    FFCLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcFCLUnits,
                                                 TFPDocHTMLHelpDatabase,true);
    HTMLHelp:=FFCLHelpDB as TFPDocHTMLHelpDatabase;
    HTMLHelp.DefaultBaseURL:=lihFCLURL;
    FFCLHelpDBPath:=THelpBaseURLObject.Create;
    HTMLHelp.BasePathObject:=FFCLHelpDBPath;

    // FPDoc nodes for units in the FCL
    // create TOC
    HTMLHelp.TOCNode:=THelpNode.CreateURL(HTMLHelp,
                   'FCL - Free Pascal Component Library Units',
                   'file://index.html');
                   
    // fpc 2.0.x FCL source directory
    FPDocNode:=THelpNode.CreateURL(HTMLHelp,
                   'FCL - Free Pascal Component Library Units (2.0.x)',
                   'file://index.html');
    DirItem:=THelpDBISourceDirectory.Create(FPDocNode,
                                     '$(FPCSrcDir)/fcl/inc','*.pp;*.pas',false);
    HTMLHelp.RegisterItem(DirItem);
    
    // fpc 2.2.x FCL source directory
    FPDocNode:=THelpNode.CreateURL(HTMLHelp,
                   'FCL - Free Pascal Component Library Units',
                   'file://index.html');
    DirItem:=THelpDBISourceDirectory.Create(FPDocNode,
                   '$(FPCSrcDir)/packages/fcl-base/src/inc','*.pp;*.pas',false);
    HTMLHelp.RegisterItem(DirItem);
  end;

  procedure CreateLCLHelpDB;
  var
    HTMLHelp: TFPDocHTMLHelpDatabase;
    FPDocNode: THelpNode;
    DirItem: THelpDBISourceDirectory;
  begin
    FLCLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcLCLUnits,
                                                 TFPDocHTMLHelpDatabase,true);
    HTMLHelp:=FLCLHelpDB as TFPDocHTMLHelpDatabase;
    HTMLHelp.DefaultBaseURL:=lihLCLURL;
    FLCLHelpDBPath:=THelpBaseURLObject.Create;
    HTMLHelp.BasePathObject:=FLCLHelpDBPath;

    // FPDoc nodes for units in the LCL
    FPDocNode:=THelpNode.CreateURL(HTMLHelp,
                   'LCL - Lazarus Component Library Units',
                   'file://index.html');
    HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);// once as TOC
    DirItem:=THelpDBISourceDirectory.Create(FPDocNode,'$(LazarusDir)/lcl',
                                  '*.pp;*.pas',false);// and once as normal page
    HTMLHelp.RegisterItem(DirItem);
  end;

begin
  CreateMainIDEHelpDB;
  CreateRTLHelpDB;
  CreateFCLHelpDB;
  CreateLCLHelpDB;
  CreateFPCMessagesHelpDB;
end;

procedure TIDEHelpManager.RegisterDefaultIDEHelpViewers;
var
  HelpViewer: THTMLBrowserHelpViewer;
begin
  HelpViewer:= THTMLBrowserHelpViewer.Create(nil);
  HelpViewer.OnFindDefaultBrowser := @FindDefaultBrowser;
  HelpViewers.RegisterViewer(HelpViewer);
end;

procedure TIDEHelpManager.FindDefaultBrowser(var DefaultBrowser, Params: string);
begin
  GetDefaultBrowser(DefaultBrowser, Params);
end;

constructor TIDEHelpManager.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  HelpBoss:=Self;
  LazarusHelp:=Self;
  HelpOpts:=THelpOptions.Create;
  HelpOpts.SetDefaultFilename;
  HelpDatabases:=TIDEHelpDatabases.Create;
  HelpIntfs.HelpManager:=HelpDatabases;
  HelpViewers:=THelpViewers.Create;
  RegisterIDEHelpDatabases;
  RegisterDefaultIDEHelpViewers;
  
  CodeHelpBoss:=TCodeHelpManager.Create;

  // register property editors for URL handling
  RegisterPropertyEditor(TypeInfo(AnsiString),
                       THTMLHelpDatabase,'BaseURL',TURLDirectoryPropertyEditor);

  FHTMLProviders:=TLIHProviders.Create;

  if CreateIDEHTMLControl=nil then
    CreateIDEHTMLControl:=@LazCreateIDEHTMLControl;
  if CreateIDEHTMLProvider=nil then
    CreateIDEHTMLProvider:=@LazCreateIDEHTMLProvider;
end;

destructor TIDEHelpManager.Destroy;
begin
  FreeThenNil(FHTMLProviders);
  FreeThenNil(CodeHelpBoss);
  FPCMessagesHelpDB:=nil;
  FreeThenNil(HelpDatabases);
  FreeThenNil(HelpViewers);
  HelpIntfs.HelpManager:=nil;
  FreeThenNil(HelpOpts);
  FreeThenNil(FMainHelpDBPath);
  FreeThenNil(FRTLHelpDBPath);
  FreeThenNil(FFCLHelpDBPath);
  FreeThenNil(FLCLHelpDBPath);
  HelpBoss:=nil;
  LazarusHelp:=nil;
  inherited Destroy;
end;

procedure TIDEHelpManager.UpdateFPCDocsHTMLDirectory;

  function IsFPCDocsHTMDirectory(const Directory: string): boolean;
  var
    RefFilename: String;
  begin
    if Directory='' then exit(false);
    RefFilename:=AppendPathDelim(TrimFilename(Directory))
                                 +'ref'+PathDelim+'ref.kwd';
    Result:=FileExistsUTF8(RefFilename);
    //DebugLn(['IsFPCDocsHTMDirectory RefFilename="',RefFilename,'" Result=',Result]);
  end;
  
  function TryDirectory(const Directory: string): boolean;
  var
    NewDir: String;
  begin
    NewDir:=CleanAndExpandDirectory(Directory);
    if not IsFPCDocsHTMDirectory(NewDir) then exit(false);
    HelpOpts.FPCDocsHTMLDirectory:=NewDir;
    DebugLn(['TryDirectory Changing FPCDocsHTMLDirectory to "',HelpOpts.FPCDocsHTMLDirectory,'"']);
    SaveHelpOptions;
    Result:=true;
  end;
  
  function TryDirectoryMask(const Directory: string): boolean;
  var
    DirMask: String;
    CurDir: String;
    FileInfo: TSearchRec;
    NewDir: String;
  begin
    Result:=false;
    DirMask:=TrimFilename(Directory);
    CurDir:=ExtractFilePath(DirMask);
    if FindFirstUTF8(DirMask,faDirectory,FileInfo)=0 then begin
      repeat
        // skip special files
        if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
          continue;
        if ((FileInfo.Attr and faDirectory)>0) then begin
          NewDir:=CurDir+FileInfo.Name;
          if TryDirectory(NewDir) then
            exit(true);
        end;
      until FindNextUTF8(FileInfo)<>0;
    end;
    FindCloseUTF8(FileInfo);
  end;
  
  function SearchInCommonInstallDir: boolean;
  var
    SystemPPU: String;
    p: LongInt;
    FPCInstallDir: String;
    FPCVersion: String;
    UnitName: String;
  begin
    Result:=false;
    { Linux:
        normally fpc ppu are installed in
          /somewhere/lib/fpc/$fpcversion/units/$fpctarget/
        and the docs are installed in
          /somewhere/share/doc/fpcdocs-$fpcversion/
      }
    UnitName:='system.ppu';
    SystemPPU:=CodeToolBoss.DirectoryCachePool.FindCompiledUnitInCompletePath(
                                                    '',UnitName);
    DebugLn(['SearchInCommonInstallDir SystemPPU=',SystemPPU]);
    // SystemPPU is now e.g. /usr/lib/fpc/2.0.4/units/i386-linux/rtl/system.ppu
    if SystemPPU='' then exit;
    p:=System.Pos(PathDelim+'fpc'+PathDelim,SystemPPU);
    if p<1 then exit;
    FPCInstallDir:=copy(SystemPPU,1,p);// FPCInstallDir is now e.g. /usr/lib/
    FPCVersion:=copy(SystemPPU,p+5,length(SystemPPU));
    p:=System.Pos(PathDelim,FPCVersion);
    FPCVersion:=copy(FPCVersion,1,p-1);// FPCVersion is now e.g. 2.0.4
    DebugLn(['SearchInCommonInstallDir FPCInstallDir="',FPCInstallDir,'" FPCVersion="',FPCVersion,'"']);
    // try first with the current fpc version
    if (FPCVersion<>'') then begin
      if TryDirectory(FPCInstallDir
                      +SetDirSeparators('../share/doc/fpdocs-'+FPCVersion))
      then exit;
      if TryDirectory(FPCInstallDir+SetDirSeparators('doc/fpdocs-'+FPCVersion))
      then exit;
    end;
    // try any fpc version
    if TryDirectoryMask(FPCInstallDir
                        +SetDirSeparators('../share/doc/fpdocs-*'))
    then exit;
    if TryDirectoryMask(FPCInstallDir+SetDirSeparators('doc/fpdocs-*')) then
      exit;
  end;
  
begin
  if IsFPCDocsHTMDirectory(HelpOpts.FPCDocsHTMLDirectory) then exit;
  // search the docs at common places
  if SearchInCommonInstallDir then exit;
  if TryDirectoryMask('/usr/share/doc/fpdocs-*') then exit;
  if TryDirectoryMask('/usr/local/share/doc/fpdocs-*') then exit;
end;

procedure TIDEHelpManager.ConnectMainBarEvents;
begin
  with MainIDEBar do begin
  itmHelpAboutLazarus.OnClick := @mnuHelpAboutLazarusClicked;
  itmHelpOnlineHelp.OnClick := @mnuHelpOnlineHelpClicked;
  itmHelpReportingBug.OnClick := @mnuHelpReportBugClicked;
  itmHelpConfigureHelp.OnClick :=@mnuHelpConfigureHelpClicked;
  end;
end;

procedure TIDEHelpManager.LoadHelpOptions;
begin
  HelpOpts.Load;
end;

procedure TIDEHelpManager.SaveHelpOptions;
begin
  HelpOpts.Save;
end;

procedure TIDEHelpManager.ShowLazarusHelpStartPage;
begin
  ShowIDEHelpForKeyword(lihcStartPage);
end;

procedure TIDEHelpManager.ShowIDEHelpForContext(HelpContext: THelpContext);
begin
  ShowHelpOrErrorForContext(MainHelpDB.ID,HelpContext);
end;

procedure TIDEHelpManager.ShowIDEHelpForKeyword(const Keyword: string);
begin
  ShowHelpOrErrorForKeyword(MainHelpDB.ID,Keyword);
end;

function TIDEHelpManager.ShowHelpForSourcePosition(const Filename: string;
  const CodePos: TPoint; var ErrMsg: string): TShowHelpResult;
  
  function ShowHelpForFPCKeyWord(const KeyWord: string): TShowHelpResult;
  var
    RefFilename: String;
    i: Integer;
    List: TStrings;
    Line: string;
    FileStartPos: Integer;
    FileEndPos: LongInt;
    HTMLFilename: String;
  begin
    Result:=shrHelpNotFound;
    if Keyword='' then exit;
    UpdateFPCDocsHTMLDirectory;
    RefFilename:=HelpOpts.FPCDocsHTMLDirectory;
    if (RefFilename='') then exit;
    RefFilename:=AppendPathDelim(RefFilename)+'ref'+PathDelim+'ref.kwd';
    if not FileExistsUTF8(RefFilename) then begin
      DebugLn(['ShowHelpForFPCKeyWord file not found RefFilename="',RefFilename,'"']);
      exit;
    end;
    List:=nil;
    try
      if LoadStringListFromFile(RefFilename,'FPC keyword list',List)<>mrOk then
        exit;
      for i:=0 to List.Count-1 do begin
        // example: integer=refsu5.html#keyword:integer
        Line:=List[i];
        if (length(Line)>length(KeyWord))
        and (Line[length(KeyWord)+1]='=')
        and (SysUtils.CompareText(KeyWord,copy(Line,1,length(KeyWord)))=0) then
        begin
          FileStartPos:=length(KeyWord)+2;
          FileEndPos:=FileStartPos;
          while (FileEndPos<=length(Line)) and (Line[FileEndPos]<>'#') do
            inc(FileEndPos);
          HTMLFilename:=copy(Line,FileStartPos,FileEndPos-FileStartPos);
          HTMLFilename:=AppendPathDelim(HelpOpts.FPCDocsHTMLDirectory)+'ref'
                        +PathDelim+HTMLFilename;
          Result:=ShowHelpFileOrError(HTMLFilename,
                              'FPC help for keyword "'+KeyWord+'"',
                              'text/html');
          break;
        end;
      end;
    finally
      List.Free;
    end;
  end;
  
  function CollectKeyWords(CodeBuffer: TCodeBuffer): TShowHelpResult;
  // true: help found
  var
    p: Integer;
    IdentStart, IdentEnd: integer;
    KeyWord: String;
  begin
    Result:=shrHelpNotFound;
    p:=0;
    CodeBuffer.LineColToPosition(CodePos.Y,CodePos.X,p);
    if p<1 then exit;
    GetIdentStartEndAtPosition(CodeBuffer.Source,p,IdentStart,IdentEnd);
    if IdentEnd<=IdentStart then exit;
    KeyWord:=copy(CodeBuffer.Source,IdentStart,IdentEnd-IdentStart);
    Result:=ShowHelpForFPCKeyWord(KeyWord);
  end;

  procedure CollectDeclarations(CodeBuffer: TCodeBuffer);
  var
    NewList: TPascalHelpContextList;
    PascalHelpContextLists: TList;
    ListOfPCodeXYPosition: TFPList;
    CurCodePos: PCodeXYPosition;
    i: Integer;
  begin
    ListOfPCodeXYPosition:=nil;
    PascalHelpContextLists:=nil;
    try
      // get all possible declarations of this identifier
      if CodeToolBoss.FindDeclarationAndOverload(CodeBuffer,CodePos.X,CodePos.Y,
        ListOfPCodeXYPosition,[fdlfWithoutEmptyProperties,fdlfWithoutForwards])
      then begin
        if ListOfPCodeXYPosition=nil then exit;
        debugln('TIDEHelpManager.ShowHelpForSourcePosition B Success ',dbgs(ListOfPCodeXYPosition.Count));
        // convert the source positions in pascal help context list
        for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
          CurCodePos:=PCodeXYPosition(ListOfPCodeXYPosition[i]);
          debugln('TIDEHelpManager.ShowHelpForSourcePosition C ',CurCodePos^.Code.Filename,' X=',dbgs(CurCodePos^.X),' Y=',dbgs(CurCodePos^.Y));
          NewList:=ConvertCodePosToPascalHelpContext(CurCodePos);
          if NewList<>nil then begin
            if PascalHelpContextLists=nil then
              PascalHelpContextLists:=TList.Create;
            PascalHelpContextLists.Add(NewList);
          end;
        end;
        if PascalHelpContextLists=nil then exit;

        // invoke help system
        debugln('TIDEHelpManager.ShowHelpForSourcePosition D PascalHelpContextLists.Count=',dbgs(PascalHelpContextLists.Count));
        Result:=ShowHelpForPascalContexts(Filename,CodePos,PascalHelpContextLists,ErrMsg);
      end else begin
        MainIDEInterface.DoJumpToCodeToolBossError;
      end;
    finally
      FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
      if PascalHelpContextLists<>nil then begin
        for i:=0 to PascalHelpContextLists.Count-1 do
          TObject(PascalHelpContextLists[i]).Free;
        PascalHelpContextLists.Free;
      end;
    end;
  end;

var
  CodeBuffer: TCodeBuffer;
begin
  debugln('TIDEHelpManager.ShowHelpForSourcePosition A Filename=',Filename,' ',dbgs(CodePos));
  Result:=shrHelpNotFound;
  ErrMsg:='No help found for "'+Filename+'"'
         +' at ('+IntToStr(CodePos.Y)+','+IntToStr(CodePos.X)+')';
  // commit editor changes
  if not CodeToolBoss.GatherExternalChanges then exit;
  // get code buffer for Filename
  if mrOk<>LoadCodeBuffer(CodeBuffer,FileName,[lbfCheckIfText]) then
    exit;
    
  Result:=CollectKeyWords(CodeBuffer);
  if Result=shrSuccess then exit;
  CollectDeclarations(CodeBuffer);
end;

function TIDEHelpManager.ConvertCodePosToPascalHelpContext(
  ACodePos: PCodeXYPosition): TPascalHelpContextList;

  procedure AddContext(Descriptor: TPascalHelpContextType;
    const Context: string);
  var
    CurContext: TPascalHelpContext;
  begin
    CurContext.Descriptor:=Descriptor;
    CurContext.Context:=Context;
    Result.Add(CurContext);
    //debugln('  AddContext Descriptor=',dbgs(ord(Descriptor)),' Context="',Context,'"');
  end;

  procedure AddContextsBackwards(Tool: TCodeTool;
    Node: TCodeTreeNode);
  begin
    if Node=nil then exit;
    AddContextsBackwards(Tool,Node.Parent);
    case Node.Desc of
    ctnUnit, ctnPackage, ctnProgram, ctnLibrary:
      AddContext(pihcSourceName,Tool.GetSourceName);
    ctnVarDefinition:
      AddContext(pihcVariable,Tool.ExtractDefinitionName(Node));
    ctnTypeDefinition:
      AddContext(pihcType,Tool.ExtractDefinitionName(Node));
    ctnConstDefinition:
      AddContext(pihcConst,Tool.ExtractDefinitionName(Node));
    ctnProperty:
      AddContext(pihcProperty,Tool.ExtractPropName(Node,false));
    ctnProcedure:
      AddContext(pihcProcedure,Tool.ExtractProcName(Node,
                                                    [phpWithoutClassName]));
    ctnProcedureHead:
      AddContext(pihcParameterList,Tool.ExtractProcHead(Node,
                [phpWithoutClassKeyword,phpWithoutClassName,phpWithoutName,
                 phpWithoutSemicolon]));
    end;
  end;

var
  MainCodeBuffer: TCodeBuffer;
  Tool: TCustomCodeTool;
  CleanPos: integer;
  i: Integer;
  Node: TCodeTreeNode;
  IncludeChain: TFPList;
  ConversionResult: LongInt;
begin
  Result:=nil;
  // find code buffer
  if ACodePos^.Code=nil then begin
    debugln('WARNING: ConvertCodePosToPascalHelpContext ACodePos.Code=nil');
    exit;
  end;
  Result:=TPascalHelpContextList.Create;
  // add filename and all filenames of the include chain
  IncludeChain:=nil;
  try
    CodeToolBoss.GetIncludeCodeChain(ACodePos^.Code,true,IncludeChain);
    if IncludeChain=nil then begin
      debugln('WARNING: ConvertCodePosToPascalHelpContext IncludeChain=nil');
      exit;
    end;
    for i:=0 to IncludeChain.Count-1 do
      AddContext(pihcFilename,TCodeBuffer(IncludeChain[i]).Filename);
    MainCodeBuffer:=TCodeBuffer(IncludeChain[0]);
  finally
    IncludeChain.Free;
  end;
  // find code tool
  Tool:=CodeToolBoss.FindCodeToolForSource(MainCodeBuffer);
  if not (Tool is TCodeTool) then begin
    debugln('WARNING: ConvertCodePosToPascalHelpContext not (Tool is TCodeTool) MainCodeBuffer=',MainCodeBuffer.Filename);
    exit;
  end;
  // convert cursor position to clean position
  ConversionResult:=Tool.CaretToCleanPos(ACodePos^,CleanPos);
  if ConversionResult<>0 then begin
    // position not in clean code, maybe a comment, maybe behind last line
    // => ignore
    exit;
  end;
  // find node
  Node:=Tool.FindDeepestNodeAtPos(CleanPos,false);
  if Node=nil then begin
    // position not in a scanned pascal node, maybe in between
    // => ignore
    exit;
  end;
  AddContextsBackwards(TCodeTool(Tool),Node);
end;

procedure TIDEHelpManager.ShowHelpForMessage(Line: integer);

  function ParseMessage(MsgItem: TIDEMessageLine): TStringList;
  begin
    Result:=TStringList.Create;
    Result.Values['Message']:=MsgItem.Msg;
    if MsgItem.Parts<>nil then
      Result.Assign(MsgItem.Parts);
  end;

var
  MsgItem: TIDEMessageLine;
  MessageParts: TStringList;
begin
  //debugln('TIDEHelpManager.ShowHelpForMessage A Line=',dbgs(Line));
  if MessagesView=nil then exit;
  if Line<0 then
    Line:=MessagesView.SelectedMessageIndex;
  //DebugLn('TIDEHelpManager.ShowHelpForMessage B Line=',dbgs(Line),' ',dbgs(MessagesView.VisibleItemCount));
  if (Line<0) or (Line>=MessagesView.VisibleItemCount) then exit;
  MsgItem:=MessagesView.VisibleItems[Line];
  if MsgItem=nil then exit;
  if MsgItem.Msg<>'' then begin
    MessageParts:=ParseMessage(MsgItem);
    ShowHelpOrErrorForMessageLine(MsgItem.Msg,MessageParts);
  end;
end;

procedure TIDEHelpManager.ShowHelpForObjectInspector(Sender: TObject);
var
  AnInspector: TObjectInspectorDlg;
  Code: TCodeBuffer;
  Caret: TPoint;
  ErrMsg: string;
  NewTopLine: integer;
begin
  //DebugLn('TIDEHelpManager.ShowHelpForObjectInspector ',dbgsName(Sender));
  if Sender=nil then Sender:=ObjectInspector1;
  if Sender is TObjectInspectorDlg then begin
    AnInspector:=TObjectInspectorDlg(Sender);
    if AnInspector.GetActivePropertyRow<>nil then begin
      if FindDeclarationOfOIProperty(AnInspector,nil,Code,Caret,NewTopLine) then
      begin
        if NewTopLine=0 then ;
        ShowHelpForSourcePosition(Code.Filename,Caret,ErrMsg);
      end;
    end else begin
      DebugLn('TIDEHelpManager.ShowHelpForObjectInspector show default help for OI');
      ShowContextHelpForIDE(AnInspector);
    end;
  end;
end;

function TIDEHelpManager.GetHintForSourcePosition(const ExpandedFilename: string;
  const CodePos: TPoint; out BaseURL, HTMLHint: string): TShowHelpResult;
var
  Code: TCodeBuffer;
  CacheWasUsed: boolean;
begin
  BaseURL:='';
  HTMLHint:='';
  Code:=CodeToolBoss.LoadFile(ExpandedFilename,true,false);
  if Code=nil then exit(shrHelpNotFound);
  if CodeHelpBoss.GetHTMLHint(Code,CodePos.X,CodePos.Y,true,
    BaseURL,HTMLHint,CacheWasUsed)=chprSuccess
  then
    exit(shrSuccess);
  DebugLn(['TIDEHelpManager.GetHintForSourcePosition not found']);
  Result:=shrHelpNotFound;
end;

function TIDEHelpManager.ConvertSourcePosToPascalHelpContext(
  const CaretPos: TPoint; const Filename: string): TPascalHelpContextList;
var
  CodePos: TCodeXYPosition;
  Code: TCodeBuffer;
  ACodeTool: TCodeTool;
begin
  Result:=nil;
  Code:=CodeToolBoss.FindFile(Filename);
  if Code=nil then exit;
  CodePos.Code:=Code;
  CodePos.X:=CaretPos.X;
  CodePos.Y:=CaretPos.Y;
  if not CodeToolBoss.Explore(Code,ACodeTool,false) then exit;
  if ACodeTool=nil then ;
  Result:=ConvertCodePosToPascalHelpContext(@CodePos);
end;

initialization
  {$i helpmanager.lrs}

end.

