From f3776676a32af9133ced6ce884369c452526d365 Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 19 Mar 2013 09:05:51 +0000 Subject: [PATCH] chmhelp: added menu item to open all chm files, patch #23411 git-svn-id: trunk@40589 - --- .gitattributes | 1 + .../chmhelp/packages/idehelp/chmhelppkg.lpk | 10 +- .../chmhelp/packages/idehelp/chmhelppkg.pas | 14 +- .../chmhelp/packages/idehelp/lazchmhelp.pas | 144 ++++++++++-------- .../packages/idehelp/lazchmhelpregister.pas | 86 +++++++++++ 5 files changed, 188 insertions(+), 67 deletions(-) create mode 100644 components/chmhelp/packages/idehelp/lazchmhelpregister.pas diff --git a/.gitattributes b/.gitattributes index 6736777e43..d760f0ca7b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -614,6 +614,7 @@ components/chmhelp/packages/idehelp/chmlangref.pas svneol=native#text/plain components/chmhelp/packages/idehelp/chmlcl.pas svneol=native#text/plain components/chmhelp/packages/idehelp/chmprog.pas svneol=native#text/plain components/chmhelp/packages/idehelp/lazchmhelp.pas svneol=native#text/plain +components/chmhelp/packages/idehelp/lazchmhelpregister.pas svneol=native#text/plain components/codetools/Makefile.compiled svneol=native#text/plain components/codetools/basiccodetools.pas svneol=native#text/pascal components/codetools/cachecodetools.pas svneol=native#text/plain diff --git a/components/chmhelp/packages/idehelp/chmhelppkg.lpk b/components/chmhelp/packages/idehelp/chmhelppkg.lpk index ab7ec0c242..a05f8dc9ec 100644 --- a/components/chmhelp/packages/idehelp/chmhelppkg.lpk +++ b/components/chmhelp/packages/idehelp/chmhelppkg.lpk @@ -23,7 +23,7 @@ - + @@ -41,6 +41,11 @@ + + + + + @@ -65,5 +70,8 @@ + + <_ExternHelp Items="Count"/> + diff --git a/components/chmhelp/packages/idehelp/chmhelppkg.pas b/components/chmhelp/packages/idehelp/chmhelppkg.pas index 2b6ad0b383..10dca738cd 100644 --- a/components/chmhelp/packages/idehelp/chmhelppkg.pas +++ b/components/chmhelp/packages/idehelp/chmhelppkg.pas @@ -2,20 +2,22 @@ This source is only used to compile and install the package. } -unit ChmHelpPkg; +unit ChmHelpPkg; interface uses - LazChmHelp, ChmLangRef, ChmLcl, ChmProg, LazarusPackageIntf; + LazChmHelp, ChmLangRef, ChmLcl, ChmProg, LazCHMHelpRegister, + LazarusPackageIntf; implementation -procedure Register; +procedure Register; begin - RegisterUnit('LazChmHelp', @LazChmHelp.Register); -end; + RegisterUnit('LazChmHelp', @LazChmHelp.Register); + RegisterUnit('LazCHMHelpRegister', @LazCHMHelpRegister.Register); +end; initialization - RegisterPackage('ChmHelpPkg', @Register); + RegisterPackage('ChmHelpPkg', @Register); end. diff --git a/components/chmhelp/packages/idehelp/lazchmhelp.pas b/components/chmhelp/packages/idehelp/lazchmhelp.pas index 7ab52668b2..5bc408660f 100644 --- a/components/chmhelp/packages/idehelp/lazchmhelp.pas +++ b/components/chmhelp/packages/idehelp/lazchmhelp.pas @@ -40,6 +40,8 @@ type function DBFindViewer({%H-}HelpDB: THelpDatabase; {%H-}const MimeType: string; var {%H-}ErrMsg: string; out Viewer: THelpViewer): TShowHelpResult; function GetHelpLabel: String; + // Shows all chm files in the given search path. Requires help viewer to be running already + procedure OpenAllCHMsInSearchPath(const SearchPath: String); procedure SetChmsFilePath(const AValue: String); procedure SetHelpEXE(AValue: String); protected @@ -54,6 +56,9 @@ type function SupportsTableOfContents: boolean; override; procedure ShowTableOfContents({%H-}Node: THelpNode); override; function SupportsMimeType(const AMimeType: string): boolean; override; + // Shows all chm help files. Opens lhelp if necessary. Used by menu commands. + procedure ShowAllHelp(Sender: TObject); + // Shows help for the indicated node or an error message if it cannot. Opens lhelp if necessary function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; override; //procedure Hide; virtual; procedure Assign(Source: TPersistent); override; @@ -68,13 +73,27 @@ type property HelpFilesPath: String read fCHMSearchPath write SetChmsFilePath; // directories separated with semicolon, with macros, see GetHelpFilesPath property HelpExeParams: String read fHelpExeParams write fHelpExeParams; end; - + procedure Register; implementation uses Process, MacroIntf, InterfaceBase, Forms, Dialogs, HelpFPDoc, IDEMsgIntf; +procedure Register; +var + ChmHelp: TChmHelpViewer; +begin + ChmHelp := TChmHelpViewer.Create(nil); + HelpViewers.RegisterViewer(ChmHelp); + RegisterLangRefHelpDatabase; + LangRefHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer; + RegisterLclHelpDatabase; + LCLHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer; + RegisterFPCDirectivesHelpDatabase; + FPCDirectivesHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer; +end; + { TChmHelpViewer } @@ -93,6 +112,57 @@ begin Result := fHelpLabel; end; +procedure TChmHelpViewer.OpenAllCHMsInSearchPath(const SearchPath: String); +var + SearchPathList: TStringlist; //SearchPath as a stringlist + CHMFiles: TStringList; + i: integer; + DirCounter: integer; +begin + { Alternative: + Open registered 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. + Also, this will not work for other .chm files in the relevant directories. + this still does not open all help files such as rtl.chm + + for i := 0 to HelpDatabases.Count-1 do begin + 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? + Application.ProcessMessages; + end; + end; + } + // Just open all CHM files in all directories+subdirs in ;-delimited searchpath: + SearchPathList:=TStringList.Create; + CHMFiles:=TStringList.Create; + try + CHMFiles.Sorted:=true; + CHMFiles.Duplicates:=dupIgnore; + SearchPathList.Delimiter:=';'; + SearchPathList.StrictDelimiter:=false; + SearchPathList.DelimitedText:=SearchPath; + for DirCounter := 0 to SearchPathList.Count-1 do begin + // Note: FindAllFiles has a SearchPath parameter that is a *single* directory, + CHMFiles.AddStrings(FindAllFiles(SearchPathList[DirCounter], '', true)); + end; + for i := 0 to CHMFiles.Count-1 do begin + if UpperCase(ExtractFileExt(CHMFiles[i]))='.CHM' then begin + fHelpConnection.OpenURL(CHMFiles[i], '/index.html'); + Sleep(200); //give viewer chance to open file. todo: better way of doing this? + Application.ProcessMessages; + end; + end; + finally + CHMFiles.Free; + SearchPathList.Free; + end; +end; + procedure TChmHelpViewer.SetChmsFilePath(const AValue: String); var p: String; @@ -338,17 +408,25 @@ begin Result := inherited; end; +procedure TChmHelpViewer.ShowAllHelp(Sender: TObject); +var + SearchPath: String; //; delimited list of directories +begin + SearchPath := GetHelpFilesPath; + // Start up server if needed + if not(fHelpConnection.ServerRunning) then + fHelpConnection.StartHelpServer(HelpLabel, GetHelpExe); + // Open all chm files after it has started + OpenAllCHMsInSearchPath(SearchPath); +end; + function TChmHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string ): TShowHelpResult; var - DirCounter: integer; - i: integer; FileName: String; - CHMFiles: TStringList; Url: String; Res: TLHelpResponse; SearchPath: String; //; delimited list of directories - SearchPathList: tstringlist; //SearchPath as a stringlist Proc: TProcessUTF8; FoundFileName: String; LHelpPath: String; @@ -393,47 +471,7 @@ begin // 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 - // Open registered 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. - // Also, this will not work for other .chm files in the relevant directories. - // this still does not open all help files such as rtl.chm - { - for i := 0 to HelpDatabases.Count-1 do begin - 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? - Application.ProcessMessages; - end; - end; - } - // Just open all CHM files in all directories+subdirs in ;-delimited searchpath: - SearchPathList:=TStringList.Create; - CHMFiles:=TStringList.Create; - try - CHMFiles.Sorted:=true; - CHMFiles.Duplicates:=dupIgnore; - SearchPathList.Delimiter:=';'; - SearchPathList.StrictDelimiter:=false; - SearchPathList.DelimitedText:=SearchPath; - for DirCounter := 0 to SearchPathList.Count-1 do begin - // Note: FindAllFiles has a SearchPath parameter that is a *single* directory, - CHMFiles.AddStrings(FindAllFiles(SearchPathList[DirCounter],'',true)); - end; - for i := 0 to CHMFiles.Count-1 do begin - if UpperCase(ExtractFileExt(CHMFiles[i]))='.CHM' then begin - fHelpConnection.OpenURL(CHMFiles[i], '/index.html'); - Sleep(200); //give viewer chance to open file. todo: better way of doing this? - Application.ProcessMessages; - end; - end; - finally - CHMFiles.Free; - SearchPathList.Free; - end; + OpenAllCHMsInSearchPath(SearchPath); end; Res := fHelpConnection.OpenURL(FileName, Url); end else begin @@ -525,20 +563,6 @@ begin Result := 'CHM Help Viewer'; end; -procedure Register; -var - ChmHelp: TChmHelpViewer; -begin - ChmHelp := TChmHelpViewer.Create(nil); - HelpViewers.RegisterViewer(ChmHelp); - RegisterLangRefHelpDatabase; - LangRefHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer; - RegisterLclHelpDatabase; - LCLHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer; - RegisterFPCDirectivesHelpDatabase; - FPCDirectivesHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer; -end; - initialization RegisterPropertyEditor(TypeInfo(AnsiString), TChmHelpViewer,'HelpEXE',TFileNamePropertyEditor); diff --git a/components/chmhelp/packages/idehelp/lazchmhelpregister.pas b/components/chmhelp/packages/idehelp/lazchmhelpregister.pas new file mode 100644 index 0000000000..4b57a5c6d7 --- /dev/null +++ b/components/chmhelp/packages/idehelp/lazchmhelpregister.pas @@ -0,0 +1,86 @@ +unit LazCHMHelpRegister; + +{$mode objfpc}{$H+} + +{ Registers Lazarus CHM Help menu shortcuts into the IDE } +{ 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 . You can also obtain it by writing + to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, USA. +} + +interface + +uses + { rtl } + SysUtils, Classes, + { lcl } + LCLType, FileUtil, LResources, + PropEdits, Controls; + +procedure Register; + +implementation + +uses + { lazarus } + LazIDEIntf, MenuIntf, IdeCommands, + { local } + LazCHMHelp, InterfaceBase, IDEMsgIntf; + +const + //HELP_MENU_NAME = 'chpOfflineHelp'; + HELP_CURRENT_NAME = 'chpHelp'; + HELP_CATEGORY_IDECMD_NAME = 'chpFormat'; + +resourcestring + //HELP_MENU = '&Help'; + HELP_CURRENT_MENU = '&Help'; + HELP_CURRENT_IDECMD = 'Show help'; + HELP_CATEGORY_IDECMD = 'CHM Help'; + + +var + IDECHMHelp: TChmHelpViewer; + + +procedure Register; +var + Cat: TIDECommandCategory; + { + Key: TIDEShortCut; + } + CmdHelpCommand: TIDECommand; +begin + // We can't put this in an initialization section because IDEChmHelp requires + // some IDE features, which are only available in "Register". + IDECHMHelp := TChmHelpViewer.Create(nil); + Cat := IDECommandList.CreateCategory(nil, HELP_CATEGORY_IDECMD_NAME, + HELP_CATEGORY_IDECMD, IDECmdScopeSrcEditOnly); + { + // Assign F1 key + Key := IDEShortCut(VK_F1, [], VK_UNKNOWN, []); + CmdHelpCommand := RegisterIDECommand(Cat, HELP_CURRENT_NAME, HELP_CURRENT_IDECMD, Key, + @IDECHMHelp.ShowAllHelp); + } + CmdHelpCommand := RegisterIDECommand(Cat, HELP_CURRENT_NAME, HELP_CURRENT_IDECMD, + @IDECHMHelp.ShowAllHelp); + + RegisterIDEMenuCommand(mnuHelp, HELP_CURRENT_NAME, HELP_CURRENT_MENU, + @IDECHMHelp.ShowAllHelp, nil, CmdHelpCommand); +end; + + +finalization + FreeAndNil(IDECHMHelp); +end. \ No newline at end of file