* Added two way comunication to LHelpControl

* Made using lhelp easier so that it's only needed to install ChmHelpPkg and copy chms to docs/html
* lhelp will be built by ChmHelpPkg if it doesn't exist
* added helpful msg when F1 is pushed and no chms can be found

git-svn-id: trunk@21688 -

.gitattributes

@@ -57,9 +57,9 @@ components/chmhelp/lhelp/images/table_open.png -text
 components/chmhelp/lhelp/lhelp.ico -text svneol=unset#image/icon
 components/chmhelp/lhelp/lhelp.lpi svneol=native#text/plain
 components/chmhelp/lhelp/lhelp.lpr svneol=native#text/plain
-components/chmhelp/lhelp/lhelp.manifest -text svneol=native#text/plain
+components/chmhelp/lhelp/lhelp.manifest svneol=native#text/plain
-components/chmhelp/lhelp/lhelp.rc -text svneol=native#text/plain
+components/chmhelp/lhelp/lhelp.rc svneol=native#text/plain
-components/chmhelp/lhelp/lhelpcore.lfm -text svneol=native#text/plain
+components/chmhelp/lhelp/lhelpcore.lfm svneol=native#text/plain
 components/chmhelp/lhelp/lhelpcore.lrs svneol=native#text/pascal
 components/chmhelp/lhelp/lhelpcore.pas svneol=native#text/plain
 components/chmhelp/lhelp/lnethttpdataprovider.pas svneol=native#text/plain

components/chmhelp/democontrol/project1.lpi

@@ -2,15 +2,17 @@
 <CONFIG>
   <ProjectOptions>
     <PathDelim Value="\"/>
-    <Version Value="6"/>
+    <Version Value="7"/>
     <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
       <TargetFileExt Value=""/>
     </General>
     <PublishOptions>
       <Version Value="2"/>
-      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
       <IgnoreBinaries Value="False"/>
       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
       <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@@ -19,7 +21,7 @@
       <local>
         <FormatVersion Value="1"/>
         <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
-        <Display Use="True" Value="192.168.0.250:0"/>
+        <Display Value="192.168.0.250:0"/>
       </local>
     </RunParams>
     <RequiredPackages Count="2">
@@ -38,9 +40,9 @@
       </Unit0>
       <Unit1>
         <Filename Value="unit1.pas"/>
-        <ComponentName Value="Form1"/>
         <IsPartOfProject Value="True"/>
-        <ResourceFilename Value="unit1.lrs"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
         <UnitName Value="Unit1"/>
       </Unit1>
     </Units>

components/chmhelp/democontrol/unit1.lfm

@@ -1,30 +1,34 @@
 object Form1: TForm1
+  Left = 610
+  Height = 300
+  Top = 247
+  Width = 400
   ActiveControl = Button1
   Caption = 'Form1'
   ClientHeight = 300
   ClientWidth = 400
   OnCreate = FormCreate
-  PixelsPerInch = 90
+  OnDestroy = FormDestroy
-  HorzScrollBar.Page = 399
+  LCLVersion = '0.9.27'
-  VertScrollBar.Page = 299
+  object Label1: TLabel
-  Left = 610
+    Left = 93
-  Height = 300
+    Height = 18
-  Top = 247
+    Top = 73
-  Width = 400
+    Width = 110
+    Caption = 'Response is here'
+    ParentColor = False
+  end
   object Button1: TButton
-    
-    Caption = 'Click to load a chm'
-    OnClick = Button1Click
-    TabOrder = 0
     Left = 36
     Height = 25
     Top = 20
     Width = 284
+    Caption = 'Click to load a chm'
+    OnClick = Button1Click
+    TabOrder = 0
   end
   object OpenDialog1: TOpenDialog
-    Title = 'Open existing file'
     FilterIndex = 0
-    Title = 'Open existing file'
     left = 28
     top = 127
   end

components/chmhelp/democontrol/unit1.lrs

@@ -1,11 +1,13 @@
+{ This is an automatically generated lazarus resource file }
+
 LazarusResources.Add('TForm1','FORMDATA',[
-  'TPF0'#6'TForm1'#5'Form1'#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'b'#2#6'Height'#3','#1#3'Top'#3#247#0#5'Wi'
-  +#12'ClientHeight'#3','#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'
+  +'dth'#3#144#1#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'Client'
-  +#13'PixelsPerInch'#2'Z'#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'
+  +'Height'#3','#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#9'OnDes'
-  +#3'+'#1#4'Left'#3'b'#2#6'Height'#3','#1#3'Top'#3#247#0#5'Width'#3#144#1#0#7
+  +'troy'#7#11'FormDestroy'#10'LCLVersion'#6#6'0.9.27'#0#6'TLabel'#6'Label1'#4
-  +'TButton'#7'Button1'#7'Caption'#6#19'Click to load a chm'#7'OnClick'#7#12'Bu'
+  +'Left'#2']'#6'Height'#2#18#3'Top'#2'I'#5'Width'#2'n'#7'Caption'#6#16'Respons'
-  +'tton1Click'#8'TabOrder'#2#0#4'Left'#2'$'#6'Height'#2#25#3'Top'#2#20#5'Width'
+  +'e is here'#11'ParentColor'#8#0#0#7'TButton'#7'Button1'#4'Left'#2'$'#6'Heigh'
-  +#3#28#1#0#0#11'TOpenDialog'#11'OpenDialog1'#5'Title'#6#18'Open existing file'
+  +'t'#2#25#3'Top'#2#20#5'Width'#3#28#1#7'Caption'#6#19'Click to load a chm'#7
-  +#11'FilterIndex'#2#0#5'Title'#6#18'Open existing file'#4'left'#2#28#3'top'#2
+  +'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#11'TOpenDialog'#11'OpenDial'
-  +''#0#0#0
+  +'og1'#11'FilterIndex'#2#0#4'left'#2#28#3'top'#2''#0#0#0
 ]);

components/chmhelp/democontrol/unit1.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LHelpControl,
-  Buttons;
+  Buttons, StdCtrls;
 
 type
 
@@ -14,9 +14,11 @@ type
 
   TForm1 = class(TForm)
     Button1: TButton;
+    Label1: TLabel;
     OpenDialog1: TOpenDialog;
     procedure Button1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
   private
     { private declarations }
   public
@@ -31,16 +33,38 @@ implementation
 
 { TForm1 }
 
+function ResponseToString(Ares: TLHelpResponse): String;
+begin
+  case Ares of
+    srNoAnswer:  Result := 'NoAnswer';
+    srSuccess: Result := 'Success';
+    srInvalidFile:Result := 'InvalidFileName';
+    srInvalidURL:Result := 'InvalidURL';
+    srInvalidContext:Result := 'InvalidContext';
+
+  end;
+end;
+
 procedure TForm1.Button1Click(Sender: TObject);
+var
+  Res: TLHelpResponse;
 begin
   if not OpenDialog1.Execute then exit;
-  Help.StartHelpServer('letstestagain', '../lhelp/lhelp --display=192.168.0.250:0');
+  if Help.ServerRunning = false then
-  Help.OpenFile(OpenDialog1.FileName);
+    Help.StartHelpServer('letstestagain', '../lhelp/lhelp');
+  Res :=Help.OpenFile(OpenDialog1.FileName);
+  Label1.Caption := ResponseToString(Res);
 end;
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   Help := TLHelpConnection.Create;
+  Help.ProcessWhileWaiting := @Application.ProcessMessages;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Help.Free;
 end;
 
 initialization

components/chmhelp/lhelp/lhelp.lpi

@@ -55,15 +55,15 @@
       </Unit2>
       <Unit3>
         <Filename Value="chmpopup.pas"/>
-        <ComponentName Value="HelpPopupForm"/>
         <IsPartOfProject Value="True"/>
+        <ComponentName Value="HelpPopupForm"/>
         <UnitName Value="ChmPopup"/>
       </Unit3>
       <Unit4>
         <Filename Value="lhelpcore.pas"/>
+        <IsPartOfProject Value="True"/>
         <ComponentName Value="HelpForm"/>
         <HasResources Value="True"/>
-        <IsPartOfProject Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="lhelpcore"/>
       </Unit4>

components/chmhelp/lhelp/lhelpcore.pas

@@ -86,14 +86,16 @@ type
   private
     { private declarations }
     fServerName: String;
-    fServer: TSimpleIPCServer;
+    fInputIPC: TSimpleIPCServer;
+    fOutputIPC: TSimpleIPCClient;
     fServerTimer: TTimer;
     fContext: LongInt; // used once when we are started on the command line with --context
+    procedure SendResponse(Response: DWord);
     procedure ServerMessage(Sender: TObject);
     procedure ReadCommandLineOptions;
     procedure StartServer(ServerName: String);
     procedure StopServer;
-    procedure OpenURL(const AURL: String; AContext: THelpContext=-1);
+    function  OpenURL(const AURL: String; AContext: THelpContext=-1): DWord;
     procedure LateOpenURL(Url: PStringItem);
     function ActivePage: TContentTab;
     procedure RefreshState;
@@ -231,6 +233,23 @@ begin
     end;
 end;
 
+procedure THelpForm.SendResponse(Response: DWord);
+var
+  Stream: TMemoryStream;
+begin
+  fOutputIPC := TSimpleIPCClient.Create(nil);
+  fOutputIPC.ServerID := fServerName+'client';
+  fOutputIPC.Active := True;
+
+  Stream := TMemoryStream.Create;
+  Stream.WriteDWord(Response);
+  fOutputIPC.SendMessage(mtUnknown, Stream);
+
+  if fOutputIPC.Active then
+    fOutputIPC.Active := False;
+  FreeAndNil(fOutputIPC);
+end;
+
 
 
 procedure THelpForm.ServerMessage(Sender: TObject);
@@ -239,30 +258,32 @@ var
   FileReq:TFileRequest;
   ConReq: TContextRequest;
   Stream: TStream;
+  Res: LongWord;
 begin
-  if fServer.PeekMessage(5, True) then begin
+  if fInputIPC.PeekMessage(5, True) then begin
-    Stream := fServer.MsgData;
+    Stream := fInputIPC.MsgData;
     Stream.Position := 0;
     Stream.Read(FileReq, SizeOf(FileReq));
     case FileReq.RequestType of
       rtFile    : begin
-
+                    Res := OpenURL('file://'+FileReq.FileName);
-                    OpenURL('file://'+FileReq.FileName);
                   end;
       rtUrl     : begin
                     Stream.Position := 0;
                     Stream.Read(UrlReq, SizeOf(UrlReq));
                     if UrlReq.FileRequest.FileName <> '' then
-                      OpenUrl('file://'+UrlReq.FileRequest.FileName+'://'+UrlReq.Url)
+                      Res := OpenUrl('file://'+UrlReq.FileRequest.FileName+'://'+UrlReq.Url)
                     else
-                      OpenURL(UrlReq.Url);
+                      Res := OpenURL(UrlReq.Url);
                   end;
       rtContext : begin
                     Stream.Position := 0;
                     Stream.Read(ConReq, SizeOf(ConReq));
-                    OpenURL('file://'+FileReq.FileName, ConReq.HelpContext);
+                    Res := OpenURL('file://'+FileReq.FileName, ConReq.HelpContext);
                   end;
     end;
+    SendResponse(Res);
+    Self.SendToBack;
     Self.BringToFront;
   end;
 end;
@@ -314,27 +335,32 @@ end;
 
 procedure THelpForm.StartServer(ServerName: String);
 begin
-  fServer := TSimpleIPCServer.Create(nil);
+  fInputIPC := TSimpleIPCServer.Create(nil);
-  fServer.ServerID := ServerName;
+  fInputIPC.ServerID := ServerName;
-  fServer.Global := True;
+  fInputIPC.Global := True;
-  fServer.Active := True;
+  fInputIPC.Active := True;
   fServerTimer := TTimer.Create(nil);
   fServerTimer.OnTimer := @ServerMessage;
   fServerTimer.Interval := 200;
   fServerTimer.Enabled := True;
   ServerMessage(nil);
+
+
 end;
 
 procedure THelpForm.StopServer;
 begin
-   if fServer = nil then exit;
+   if fInputIPC = nil then
-   FreeAndNil(fServerTimer);
+     exit;
-   if fServer.Active then fServer.Active := False;
-   FreeAndNil(fServer);
 
+   if fInputIPC.Active then
+     fInputIPC.Active := False;
+
+   FreeAndNil(fInputIPC);
+   FreeAndNil(fServerTimer);
 end;
 
-procedure THelpForm.OpenURL(const AURL: String; AContext: THelpContext);
+function THelpForm.OpenURL(const AURL: String; AContext: THelpContext): DWord;
   function GetURLPrefix: String;
   var
     fPos: Integer;
@@ -349,18 +375,20 @@ var
  fNewPage: TContentTab;
  I: Integer;
 begin
-
+ Result := Ord(srUnknown);
  fURLPrefix := GetURLPrefix;
  fContentProvider := GetContentProvider(fURLPrefix);
  
  if fContentProvider = nil then begin
-   ShowError('Cannot handle this type of content. "' + fURLPrefix + '"');
+   ShowError('Cannot handle this type of content. "' + fURLPrefix + '" for url:'+LineEnding+AURL);
+   Result := Ord(srInvalidFile);
    Exit;
  end;
  fRealContentProvider := fContentProvider.GetProperContentProvider(AURL);
  
  if fRealContentProvider = nil then begin
-   ShowError('Cannot handle this type of subcontent. "' + fURLPrefix + '"');
+   ShowError('Cannot handle this type of subcontent. "' + fURLPrefix + '" for url:'+LineEnding+AURL);
+   Result := Ord(srInvalidFile);
    Exit;
  end;
 
@@ -368,7 +396,12 @@ begin
  for I := 0 to PageControl.PageCount-1 do begin
    if fRealContentProvider.ClassName = TContentTab(PageControl.Pages[I]).ContentProvider.ClassName then begin
      if TContentTab(PageControl.Pages[I]).ContentProvider.LoadURL(AURL, AContext) then
+     begin
        PageControl.ActivePage := PageControl.Pages[I];
+       Result := Ord(srSuccess);
+     end
+     else
+       Result := Ord(srInvalidFile);
      Exit;
    end;
  end;
@@ -381,7 +414,12 @@ begin
  ShowOnTop;
  
  if fNewPage.ContentProvider.LoadURL(AURL, AContext) then
+ begin
    PageControl.ActivePage := fNewPage;
+   Result := Ord(srSuccess);
+ end
+ else
+   Result := Ord(srInvalidFile);
 end;
 
 procedure THelpForm.LateOpenURL ( Url: PStringItem ) ;

components/chmhelp/packages/help/lhelpcontrol.pas

@@ -10,6 +10,8 @@ uses
 type
   TRequestType = (rtFile, rtUrl, rtContext);
 
+  TLHelpResponse = (srNoAnswer, srUnknown, srSuccess, srInvalidFile, srInvalidURL, srInvalidContext);
+
   TFileRequest = record
     RequestType: TRequestType;
     FileName: array[0..512] of char;
@@ -23,18 +25,28 @@ type
     HelpContext: THelpContext;
   end;
 
+  TProcedureOfObject = procedure of object;
+  
   { TLHelpConnection }
 
   TLHelpConnection = class(TObject)
   private
-    fClient: TSimpleIPCClient;
+    FProcessWhileWaiting: TProcedureOfObject;
+    fServerOut: TSimpleIPCClient; // sends messages to lhelp
+    fServerIn:  TSimpleIPCServer; // recieves messages from lhelp
+    function  WaitForMsgResponse: TLHelpResponse;
+    function  SendMessage(Stream: TStream): TLHelpResponse;
   public
     constructor Create;
     destructor Destroy; override;
+    function ServerRunning: Boolean;
     function StartHelpServer(NameForServer: String; ServerEXE: String = ''): Boolean;
-    procedure OpenURL(HelpFileName: String; Url: String);
+
-    procedure OpenContext(HelpFileName: String; Context: THelpContext);
+    function OpenURL(HelpFileName: String; Url: String): TLHelpResponse;
-    procedure OpenFile(HelpFileName: String);
+    function OpenContext(HelpFileName: String; Context: THelpContext): TLHelpResponse;
+    function OpenFile(HelpFileName: String): TLHelpResponse;
+
+    property ProcessWhileWaiting: TProcedureOfObject read FProcessWhileWaiting write FProcessWhileWaiting;
   end;
   
 
@@ -42,45 +54,87 @@ implementation
 
 { TLHelpConnection }
 
+function TLHelpConnection.WaitForMsgResponse: TLHelpResponse;
+var
+  I: Integer;
+  Stream: TStream;
+  WaitTime: Integer = 5000;
+begin
+  Result := srNoAnswer;
+  while WaitTime >= 0 do
+  begin
+    Dec(WaitTime, 50);
+    if fServerIn.PeekMessage(50, True) then
+    begin
+      Stream := fServerIn.MsgData;
+      Stream.Position:=0;
+      Result := TLHelpResponse(Stream.ReadDWord);
+      Exit;
+    end;
+    if Assigned(FProcessWhileWaiting) then FProcessWhileWaiting();
+  end;
+end;
+
+function TLHelpConnection.SendMessage(Stream: TStream): TLHelpResponse;
+begin
+  fServerOut.SendMessage(mtUnknown, Stream);
+  Result := WaitForMsgResponse;
+end;
 
 constructor TLHelpConnection.Create;
 begin
-  fClient := TSimpleIPCClient.Create(nil);
+  fServerOut := TSimpleIPCClient.Create(nil);
+  fServerIn  := TSimpleIPCServer.Create(nil);
 end;
 
 destructor TLHelpConnection.Destroy;
 begin
-  if fCLient.Active then fClient.Active:=False;
+  if fServerOut.Active then
-  fClient.Free;
+    fServerOut.Active:=False;
+  if fServerIn.Active then
+    fServerIn.Active:=False;
+  fServerOut.Free;
+  fServerIn.Free;
   inherited Destroy;
 
 end;
 
+function TLHelpConnection.ServerRunning: Boolean;
+begin
+  Result := (fServerOut<>nil) and (fServerOut.Active);
+end;
+
 function TLHelpConnection.StartHelpServer(NameForServer: String;
   ServerEXE: String): Boolean;
 var
   X: Integer;
 begin
   Result := False;
-  fClient.Active := False;
+
-  fClient.ServerID := NameForServer;
+  fServerIn.Active := False;
-  if not fClient.ServerRunning then begin
+  fServerIn.ServerID := NameForServer+'client';
+  fServerIn.Global := True;
+  fServerIn.Active := True;
+
+  fServerOut.Active := False;
+  fServerOut.ServerID := NameForServer;
+  if not fServerOut.ServerRunning then begin
     with TProcessUTF8.Create(nil) do begin
       CommandLine := ServerExe + ' --ipcname ' + NameForServer;
       Execute;
     end;
     // give the server some time to get started
     for X := 0 to 40 do begin
-      if not fClient.ServerRunning then Sleep(200);
+      if not fServerOut.ServerRunning then Sleep(200);
     end;
   end;
-  if fClient.ServerRunning then begin
+  if fServerOut.ServerRunning then begin
-    fClient.Active := True;
+    fServerOut.Active := True;
     Result := True;
   end;
 end;
 
-procedure TLHelpConnection.OpenURL(HelpFileName: String; Url: String);
+function TLHelpConnection.OpenURL(HelpFileName: String; Url: String): TLHelpResponse;
 var
 UrlRequest: TUrlRequest;
 Stream: TMemoryStream;
@@ -90,12 +144,15 @@ begin
   UrlRequest.FileRequest.RequestType := rtURL;
   UrlRequest.Url := Url+#0;
   Stream.Write(UrlRequest,SizeOf(UrlRequest));
-  fClient.SendMessage(mtUnknown, Stream);
+  Result := SendMessage(Stream);
+
   // Do I need to free the stream?? the example doesn't
+
+
 end;
 
-procedure TLHelpConnection.OpenContext(HelpFileName: String;
+function TLHelpConnection.OpenContext(HelpFileName: String;
-  Context: THelpContext);
+  Context: THelpContext) : TLHelpResponse;
 var
 ContextRequest: TContextRequest;
 Stream: TMemoryStream;
@@ -105,11 +162,11 @@ begin
   ContextRequest.FileRequest.RequestType := rtContext;
   ContextRequest.HelpContext := Context;
   Stream.Write(ContextRequest, SizeOf(ContextRequest));
-  fClient.SendMessage(mtUnknown, Stream);
+  Result := SendMessage(Stream);
   // Do I need to free the stream?? the example doesn't
 end;
 
-procedure TLHelpConnection.OpenFile(HelpFileName: String);
+function TLHelpConnection.OpenFile(HelpFileName: String): TLHelpResponse;
 var
 FileRequest : TFileRequest;
 Stream: TMemoryStream;
@@ -118,7 +175,7 @@ begin
   FileRequest.RequestType := rtFile;
   FileRequest.FileName := HelpFileName+#0;
   Stream.Write(FileRequest, SizeOf(FileRequest));
-  fClient.SendMessage(mtUnknown, Stream);
+  Result := SendMessage(Stream);
   // Do I need to free the stream?? the example doesn't
 end;
 

components/chmhelp/packages/idehelp/chmhelppkg.lpk

@@ -1,15 +1,12 @@
 <?xml version="1.0"?>
 <CONFIG>
-  <Package Version="2">
+  <Package Version="3">
     <Name Value="ChmHelpPkg"/>
     <CompilerOptions>
-      <Version Value="5"/>
+      <Version Value="8"/>
       <SearchPaths>
         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
-      <CodeGeneration>
-        <Generate Value="Faster"/>
-      </CodeGeneration>
       <Other>
         <CompilerPath Value="$(CompPath)"/>
       </Other>
@@ -23,20 +20,23 @@
       </Item1>
     </Files>
     <Type Value="DesignTime"/>
-    <RequiredPkgs Count="4">
+    <RequiredPkgs Count="5">
       <Item1>
-        <PackageName Value="CodeTools"/>
+        <PackageName Value="LCL"/>
       </Item1>
       <Item2>
-        <PackageName Value="lhelpcontrolpkg"/>
+        <PackageName Value="CodeTools"/>
       </Item2>
       <Item3>
-        <PackageName Value="IDEIntf"/>
+        <PackageName Value="lhelpcontrolpkg"/>
       </Item3>
       <Item4>
+        <PackageName Value="IDEIntf"/>
+      </Item4>
+      <Item5>
         <PackageName Value="FCL"/>
         <MinVersion Major="1" Valid="True"/>
-      </Item4>
+      </Item5>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)/"/>

components/chmhelp/packages/idehelp/lazchmhelp.pas

@@ -24,7 +24,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, LazHelpIntf, HelpIntfs, LazConfigStorage,
-  PropEdits, LHelpControl;
+  PropEdits, LHelpControl, Controls;
   
 type
   
@@ -36,10 +36,13 @@ type
     fHelpLabel: String;
     fHelpConnection: TLHelpConnection;
     fChmsFilePath: String;
+    function GetHelpEXE: String;
   protected
     function GetFileNameAndURL(RawUrl: String; out FileName: String; out URL: String): Boolean;
     procedure SetHelpEXE(AValue: String);
     procedure SetHelpLabel(AValue: String);
+    function CheckBuildLHelp: Integer; // modal result
+    function GetLazBuildEXE(out ALazBuild: String): Boolean;
   public
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
@@ -53,7 +56,7 @@ type
     procedure Save(Storage: TConfigStorage); override;
     function GetLocalizedName: string; override;
   published
-    property HelpEXE: String read fHelpEXE write SetHelpEXE;
+    property HelpEXE: String read GetHelpEXE write SetHelpEXE;
     property HelpLabel: String read fHelpLabel write SetHelpLabel;
     property HelpFilesPath: String read fChmsFilePath write fChmsFilePath;
 
@@ -62,9 +65,18 @@ type
   procedure Register;
 
 implementation
+uses Process, MacroIntf, InterfaceBase, Forms, Dialogs, HelpFPDoc;
 
 { TChmHelpViewer }
 
+function TChmHelpViewer.GetHelpEXE: String;
+begin
+  if fHelpExe <> '' then
+    Exit(fHelpExe);
+  Result := '$(LazarusDir)/components/chmhelp/lhelp/lhelp$(ExeExt)';
+  if not IDEMacros.SubstituteMacros(Result) then
+    Exit('');
+end;
 
 function TChmHelpViewer.GetFileNameAndURL(RawUrl:String; out FileName: String; out URL: String
   ): Boolean;
@@ -90,11 +102,82 @@ begin
  fHelpLabel := AValue;
 end;
 
+function TChmHelpViewer.CheckBuildLHelp: Integer;
+var
+  Proc: TProcess;
+  Lazbuild: String;
+  LHelpProject: String;
+  WS: String;
+begin
+  Result := mrCancel;
+
+  if FileExistsUTF8(HelpExe) = True then
+    Exit(mrOK);
+
+  if not GetLazBuildEXE(Lazbuild) then
+    Exit;
+
+  LHelpProject := '$(LazarusDir)/components/chmhelp/lhelp/lhelp.lpi';
+
+  if not (IDEMacros.SubstituteMacros(LHelpProject)
+          and FileExistsUTF8(LHelpProject))
+  then
+    Exit;
+
+  WS := ' --ws='+LCLPlatformDirNames[WidgetSet.LCLPlatform]+' ';
+
+  Result := MessageDlg('The help viewer is not compiled yet. Try to compile it now?', mtConfirmation, mbYesNo ,0);
+  if Result <> mrYes then
+    Exit;
+
+  Proc := TProcess.Create(nil);
+  Proc.CommandLine := Lazbuild + WS + LHelpProject;
+  Proc.Options := [];
+  Proc.Execute;
+
+  while Proc.Running do begin
+    Application.HandleMessage;
+  end;
+
+  if Proc.ExitStatus = 0 then
+    Result := mrOK;
+  Proc.Free;
+
+  if Result = mrOK then
+end;
+
+function TChmHelpViewer.GetLazBuildEXE(out ALazBuild: String): Boolean;
+var
+  LazBuildMacro: String;
+begin
+   Result := False;
+   LazBuildMacro:= '$(LazarusDir)/$MakeExe(lazbuild)';
+   Result := IDEMacros.SubstituteMacros(LazBuildMacro)
+             and FileExistsUTF8(LazBuildMacro);
+   if Result then
+     ALazBuild := LazBuildMacro;
+end;
+
 constructor TChmHelpViewer.Create(TheOwner: TComponent);
+var
+  i: Integer;
+  DB: TFPDocHTMLHelpDatabase;
+  BaseURL: THelpBaseURLObject;
 begin
   inherited Create(TheOwner);
   fHelpConnection := TLHelpConnection.Create;
+  fHelpConnection.ProcessWhileWaiting:=@Application.ProcessMessages;
   AddSupportedMimeType('text/html');
+  for i := 0 to HelpDatabases.Count-1 do begin
+    DB := TFPDocHTMLHelpDatabase(HelpDatabases.Items[i]);
+    BaseURL := THelpBaseURLObject(DB.BasePathObject);
+    if (DB.ID = 'RTLUnits') and (BaseURL.BaseURL = '') then
+      BaseURL.BaseURL := 'rtl.chm://'
+    else if (DB.ID = 'FCLUnits') and (BaseURL.BaseURL = '') then
+      BaseURL.BaseURL := 'fcl.chm://'
+    else if (DB.ID = 'LCLUnits') and (BaseURL.BaseURL = '') then
+      BaseURL.BaseURL := 'lcl.chm://';
+  end;
 end;
 
 destructor TChmHelpViewer.Destroy;
@@ -118,20 +201,52 @@ function TChmHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
 var
 FileName: String;
 Url: String;
+Res: TLHelpResponse;
+DocsDir: String;
 begin
   Result:=shrNone;
-  if not FileExistsUTF8(fHelpEXE) then begin
+  if CheckBuildLHelp <> mrOK then begin
-    ErrMsg := 'The program "' + fHelpEXE + '" doesn''t seem to exist!';
+    ErrMsg := 'The program "' + HelpEXE + '" doesn''t seem to exist'+LineEnding+
+              'or could not be built!';
     Exit(shrViewerNotFound);
   end;
   if not GetFileNameAndURL(Node.Url, FileName, Url) then begin
     ErrMsg := 'Couldn''t read the file/URL correctly';
     Exit(shrDatabaseNotFound);
   end;
-  FileName := fChmsFilePath+FileName;
+
-  fHelpConnection.StartHelpServer(fHelpLabel, fHelpExe);
+  if HelpFilesPath = '' then
-  fHelpConnection.OpenURL(FileName, Url);
+  begin
-  Result := shrSuccess;
+    DocsDir := '$(LazarusDir)/docs/html/';
+    IDEMacros.SubstituteMacros(DocsDir);
+    if not FileExistsUTF8(DocsDir+FileName) then
+    begin
+      Result := shrDatabaseNotFound;
+      ErrMsg := FileName +' not found. Please put the chm help files in '+ LineEnding
+                         +DocsDir+  LineEnding
+                         +' or set the path to lcl.chm rtl.chm fcl.chm with "HelpFilesPath" in '
+                         +' Environment Options -> Help -> Help Options ->'+LineEnding
+                         +' under HelpViewers - CHMHelpViewer';
+      Exit;
+    end;
+
+  end
+  else
+    DocsDir := fChmsFilePath;
+
+  FileName := DocsDir+FileName;
+
+  fHelpConnection.StartHelpServer(fHelpLabel, HelpExe);
+  Res := fHelpConnection.OpenURL(FileName, Url);
+
+  case Res of
+    srSuccess: Result := shrSuccess;
+    srNoAnswer: Result := shrSuccess;
+  else
+    Result := shrNone;
+    ErrMsg := 'Unknown error showing '+URL;
+  end;
+
   //WriteLn('LOADING URL = ', Node.URL);
 end;