[Lazarus] ChmHelpPkg: better way to show all CHMs when starting lhelp?

Reinier Olislagers reinierolislagers at gmail.com
Sat Dec 15 12:43:17 CET 2012


> On 21-7-2012 13:56, Reinier Olislagers wrote:
>> Editing ChmHelpPkg to try and solve bug 22110 Help (at least CHM help)
>> should open all help files to enable content/index search
>>
>> I want to open all .chm files in the help database when starting up
>> lhelp, which allows browsing and searching through the entire
>> documentation set.
>>
>> See modified code below.
By explicitly adding an 'application/x-chm' mime type to some CHM help
database classes, I now got the LCL.CHM help to open in addition to
whatever lhelp will search for (and I'm avoiding opening online help).
However, I still don't get e.g. rtl.chm open... what code would I need
to edit there?

Wondering if this is the right way to go?
Isn't there some way to recurse through all *.chm files in the chmd
files dir and open the corresponding table of contents URL/node?

Thanks,
Reinier
-------------- next part --------------
Index: components/chmhelp/packages/idehelp/lazchmhelp.pas
===================================================================
--- components/chmhelp/packages/idehelp/lazchmhelp.pas	(revision 39547)
+++ components/chmhelp/packages/idehelp/lazchmhelp.pas	(working copy)
@@ -340,6 +340,7 @@
 function TChmHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
   ): TShowHelpResult;
 var
+  i: integer;
   FileName: String;
   Url: String;
   Res: TLHelpResponse;
@@ -347,6 +348,7 @@
   Proc: TProcessUTF8;
   FoundFileName: String;
   LHelpPath: String;
+  WasRunning: boolean;
 begin
   if Pos('file://', Node.URL) = 1 then
   begin
@@ -382,7 +384,25 @@
   FileName := CleanAndExpandFilename(FoundFileName);
 
   if ExtractFileNameOnly(GetHelpExe) = 'lhelp' then begin
+    WasRunning := fHelpConnection.ServerRunning;
     fHelpConnection.StartHelpServer(HelpLabel, GetHelpExe);
+    // If the server is not already running, open all chm files after it has started
+    // This will allow cross-chm (LCL, FCL etc) searching and browsing in lhelp.
+    if not(WasRunning) then begin
+      for i := 0 to HelpDatabases.Count-1 do begin
+        // Only open chm help files (no online html help etc)
+        // Using SupportsMimetype would seem to be the solution here.
+        // This does mean that all classes providing chm file support add
+        // AddSupportedMimeType('application/x-chm');
+        // in their constructors as they normally inherit
+        // text/html from their HTML help parents.
+        // this still does not open all help files such as rtl.chm
+        if HelpDatabases[i].SupportsMimeType('application/x-chm') then begin
+          HelpDatabases[i].ShowTableOfContents;
+          Sleep(200); //give viewer chance to open file. todo: better way of doing this?
+        end;
+      end;
+    end;
     Res := fHelpConnection.OpenURL(FileName, Url);
   end else begin
     if Trim(fHelpExeParams) = '' then
Index: components/chmhelp/packages/idehelp/chmprog.pas
===================================================================
--- components/chmhelp/packages/idehelp/chmprog.pas	(revision 39547)
+++ components/chmhelp/packages/idehelp/chmprog.pas	(working copy)
@@ -124,6 +124,8 @@
 constructor TFPCDirectivesHelpDatabase.Create(TheOwner: TComponent);
 begin
   inherited Create(TheOwner);
+  // Needed for getting lhelp to auto-open this db on start:
+  AddSupportedMimeType('application/x-chm');
   FDirectiveNodes := TFPList.Create;
 end;
 
Index: components/chmhelp/packages/idehelp/chmlcl.pas
===================================================================
--- components/chmhelp/packages/idehelp/chmlcl.pas	(revision 39547)
+++ components/chmhelp/packages/idehelp/chmlcl.pas	(working copy)
@@ -53,6 +53,8 @@
 constructor TLclChmHelpDatabase.Create(TheOwner: TComponent);
 begin
   inherited Create(TheOwner);
+  // Needed for getting lhelp to auto-open this db on start:
+  AddSupportedMimeType('application/x-chm');
   FBaseURL := THelpBaseURLObject.Create;
   FBaseURL.BaseURL := 'lcl.chm://';
   BasePathObject := FBaseURL;
Index: components/chmhelp/packages/idehelp/chmlangref.pas
===================================================================
--- components/chmhelp/packages/idehelp/chmlangref.pas	(revision 39547)
+++ components/chmhelp/packages/idehelp/chmlangref.pas	(working copy)
@@ -68,6 +68,8 @@
 constructor TLangRefHelpDatabase.Create(TheOwner: TComponent);
 begin
   inherited Create(TheOwner);
+  // Needed for getting lhelp to auto-open this db on start:
+  AddSupportedMimeType('application/x-chm');
   FKeywordNodes := TList.Create;
   FKeyWordsList := TStringList.Create;
   FKeyWordsList.CaseSensitive := False;


More information about the Lazarus mailing list