diff --git a/.gitattributes b/.gitattributes index 475eecc995..17e1dc0f97 100644 --- a/.gitattributes +++ b/.gitattributes @@ -383,6 +383,10 @@ components/anchordocking/minide/simplefrm.pas svneol=native#text/plain components/anchordocking/minide/unit1.lfm svneol=native#text/plain components/anchordocking/minide/unit1.pas svneol=native#text/plain components/chmhelp/README.txt svneol=native#text/plain +components/chmhelp/democontrol/ContextHelpDemo.lpi svneol=native#text/plain +components/chmhelp/democontrol/ContextHelpDemo.lpr svneol=native#text/plain +components/chmhelp/democontrol/ctxchmhelpunit1.lfm svneol=native#text/plain +components/chmhelp/democontrol/ctxchmhelpunit1.pas svneol=native#text/plain components/chmhelp/democontrol/helpconnectionunit1.lfm svneol=native#text/plain components/chmhelp/democontrol/helpconnectionunit1.pas svneol=native#text/plain components/chmhelp/democontrol/lhelpconnectiondemo1.lpi svneol=native#text/plain @@ -413,6 +417,7 @@ components/chmhelp/lhelp/lnethttpdataprovider.pas svneol=native#text/plain components/chmhelp/packages/help/Makefile svneol=native#text/plain components/chmhelp/packages/help/Makefile.compiled svneol=native#text/plain components/chmhelp/packages/help/Makefile.fpc svneol=native#text/plain +components/chmhelp/packages/help/lazhelpchm.pas svneol=native#text/plain components/chmhelp/packages/help/lhelpcontrol.pas svneol=native#text/plain components/chmhelp/packages/help/lhelpcontrolpkg.lpk svneol=native#text/plain components/chmhelp/packages/help/lhelpcontrolpkg.pas svneol=native#text/plain diff --git a/components/chmhelp/democontrol/ContextHelpDemo.lpi b/components/chmhelp/democontrol/ContextHelpDemo.lpi new file mode 100644 index 0000000000..3416a73af9 --- /dev/null +++ b/components/chmhelp/democontrol/ContextHelpDemo.lpi @@ -0,0 +1,92 @@ + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="lhelpcontrolpkg"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="ContextHelpDemo.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="ContextHelpDemo"/> + </Unit0> + <Unit1> + <Filename Value="ctxchmhelpunit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="CtxCHMHelpUnit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="ContextHelpDemo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/chmhelp/democontrol/ContextHelpDemo.lpr b/components/chmhelp/democontrol/ContextHelpDemo.lpr new file mode 100644 index 0000000000..4841f802a8 --- /dev/null +++ b/components/chmhelp/democontrol/ContextHelpDemo.lpr @@ -0,0 +1,20 @@ +program ContextHelpDemo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, ctxchmhelpunit1, lhelpcontrolpkg; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/chmhelp/democontrol/ctxchmhelpunit1.lfm b/components/chmhelp/democontrol/ctxchmhelpunit1.lfm new file mode 100644 index 0000000000..0a499908b6 --- /dev/null +++ b/components/chmhelp/democontrol/ctxchmhelpunit1.lfm @@ -0,0 +1,54 @@ +object Form1: TForm1 + Left = 545 + Height = 239 + Top = 193 + Width = 359 + Caption = 'Form1' + ClientHeight = 239 + ClientWidth = 359 + OnCreate = FormCreate + LCLVersion = '1.1' + object Edit1: TEdit + Left = 71 + Height = 22 + Top = 72 + Width = 225 + HelpType = htKeyword + HelpKeyword = 'example/MainPage.html' + TabOrder = 0 + Text = 'Edit1' + end + object Edit2: TEdit + Left = 71 + Height = 22 + Top = 128 + Width = 224 + HelpType = htKeyword + HelpKeyword = 'example/SecondPage.html' + TabOrder = 1 + Text = 'Edit2' + end + object ShowHelpButton: TButton + Left = 70 + Height = 20 + Top = 20 + Width = 128 + AutoSize = True + Caption = 'ShowHelpButton' + OnClick = ShowHelpButtonClick + TabOrder = 2 + end + object CHMHelpDatabase1: TCHMHelpDatabase + AutoRegister = True + Filename = '../../../tools/chmmaker/example.chm' + KeywordPrefix = 'example/' + left = 80 + top = 168 + end + object LHelpConnector1: TLHelpConnector + LHelpPath = '../lhelp/lhelp' + AutoRegister = True + left = 256 + top = 168 + end +end diff --git a/components/chmhelp/democontrol/ctxchmhelpunit1.pas b/components/chmhelp/democontrol/ctxchmhelpunit1.pas new file mode 100644 index 0000000000..2a779d23ff --- /dev/null +++ b/components/chmhelp/democontrol/ctxchmhelpunit1.pas @@ -0,0 +1,87 @@ +{ +Abstract: + This example demonstrates the chm help components. + + TCHMLHelpDatabase handles help for a single chm file - it contains the + mapping from Keyword to page. + + TLHelpConnector starts "lhelp" a chm viewer written in pure pascal. + +How was the example created: + Put a TCHMHelpDatabase on a form. + Set AutoRegister to true. + Set KeywordPrefix to 'example/' + Set Filename to the path of the chm file '../../../tools/chmaker/example.chm' + You can create the example.chm with chmmaker (see the REDAME.txt + in the chmmaker directory). + + Put a TLHelpConnector on the form. + Set AutoRegister to true. + Set LHelpPath to '../lhelp/lhelp'. + + Put a TEdit on a form. + Set HelpType to htKeyword + Set HelpKeyword to 'example/MainPage.html' + + Run the program. + Focus the edit field and press F1. lhelp will be started. lhelp will load + example.chm and show the page MainPage.html. +} +unit CtxCHMHelpUnit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + HelpIntfs, LazHelpIntf, LazHelpCHM; + +const + {$IFDEF Darwin} + HelpShortcut = #$e2#$8c#$98'?'; + {$ELSE} + HelpShortcut = 'F1''; + {$ENDIF} + +type + + { TForm1 } + + TForm1 = class(TForm) + CHMHelpDatabase1: TCHMHelpDatabase; + Edit1: TEdit; + Edit2: TEdit; + LHelpConnector1: TLHelpConnector; + ShowHelpButton: TButton; + procedure FormCreate(Sender: TObject); + procedure ShowHelpButtonClick(Sender: TObject); + private + public + end; + +var + Form1: TForm1; + +implementation + +{ TForm1 } + +procedure TForm1.FormCreate(Sender: TObject); +begin + CreateLCLHelpSystem; + + Edit1.Text:='Edit1 - Press '+HelpShortcut+' for help'; + Edit2.Text:='Edit2 - Press '+HelpShortcut+' for help'; +end; + +procedure TForm1.ShowHelpButtonClick(Sender: TObject); +begin + // This demonstrates how to show a help item manually: + ShowHelpOrErrorForKeyword('','example/AboutLazarus.html'); +end; + +{$R *.lfm} + +end. + diff --git a/components/chmhelp/packages/help/lazhelpchm.pas b/components/chmhelp/packages/help/lazhelpchm.pas new file mode 100644 index 0000000000..d242775ea5 --- /dev/null +++ b/components/chmhelp/packages/help/lazhelpchm.pas @@ -0,0 +1,355 @@ +{ + ***************************************************************************** + * * + * See the file COPYING.modifiedLGPL.txt, included in this distribution, * + * for details about the copyright. * + * * + * This program 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. * + * * + ***************************************************************************** + + Author: Mattias Gaertner + + Abstract: + Methods and types for simple CHM help using chm viewer "lhelp". +} +unit LazHelpCHM; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LazHelpIntf, LazConfigStorage, HelpIntfs, + Dialogs, Forms, LazLogger, FileUtil, LHelpControl; + +const + CHMMimeType = 'application/chm'; + CHMPathParam = 'path'; +type + { TCHMHelpDatabase + + KeywordPrefix: if set, then the database will handle all Keywords + beginning with this value. And when the path is created by replacing + the prefix with the BaseURL. + For example: + Create a chm. For example build and run chmmaker in lazarus/tools/chmmaker + to create the example.chm (lazarus/tools/chmmaker/example.chm). + + Put a TCHMHelpDatabase on a form. + Set AutoRegister to true. + Set KeywordPrefix to 'example/' + Set CHM file to '../../../tools/chmmaker/example.chm' + + Put a TLHelpRemoteViewer on the form. + Set AutoRegister to true. + Set LHelpPath to the path of lhelp. E.g. '../../lhelp/lhelp' + + Put a TEdit on a form. + Set HelpType to htKeyword + Set HelpKeyword to 'example/MainPage.html' + + Run the program. + Focus the edit field and press F1. The page 'MainPage.html' will be shown. + } + TCHMHelpDatabase = class(THelpDatabase) + private + FFilename: string; + FHelpNode: THelpNode; + FKeywordPrefix: string; + procedure SetFilename(AValue: string); + procedure SetKeywordPrefix(AValue: string); + public + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + function ShowHelp({%H-}Query: THelpQuery; {%H-}BaseNode, NewNode: THelpNode; + {%H-}QueryItem: THelpQueryItem; + var ErrMsg: string): TShowHelpResult; override; + function ShowURL(const URL, Title: string; + var ErrMsg: string): TShowHelpResult; virtual; + function GetNodesForKeyword(const HelpKeyword: string; + var ListOfNodes: THelpNodeQueryList; + var ErrMsg: string): TShowHelpResult; override; + procedure Load(Storage: TConfigStorage); override; + procedure Save(Storage: TConfigStorage); override; + published + property AutoRegister; + property Filename: string read FFilename write SetFilename; + property KeywordPrefix: string read FKeywordPrefix write SetKeywordPrefix; + end; + +type + TOnFindLHelp = procedure(var Path: string) of object; + + { TLHelpConnector } + + TLHelpConnector = class(THelpViewer) + private + FConnection: TLHelpConnection; + FLHelpPath: string; + FOnFindLHelp: TOnFindLHelp; + procedure SetLHelpPath(AValue: string); + public + constructor Create(TheOwner: TComponent); override; + function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; override; + procedure Assign(Source: TPersistent); override; + procedure Load(Storage: TConfigStorage); override; + procedure Save(Storage: TConfigStorage); override; + function GetLocalizedName: string; override; + property OnFindLHelp: TOnFindLHelp read FOnFindLHelp write FOnFindLHelp; + property Connection: TLHelpConnection read FConnection; + published + property LHelpPath: string read FLHelpPath write SetLHelpPath; + property AutoRegister; + end; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponents('System',[TCHMHelpDatabase,TLHelpConnector]); +end; + +{ TLHelpConnector } + +procedure TLHelpConnector.SetLHelpPath(AValue: string); +begin + if FLHelpPath=AValue then Exit; + FLHelpPath:=AValue; +end; + +constructor TLHelpConnector.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + AddSupportedMimeType(CHMMimeType); +end; + +function TLHelpConnector.ShowNode(Node: THelpNode; var ErrMsg: string + ): TShowHelpResult; +var + Path: String; + IPCFile: String; + URLScheme: string; + URLPath: string; + URLParams: string; + CHMFilename: String; + SubPath: String; + Response: TLHelpResponse; + s: String; +begin + debugln(['TLHelpConnector.ShowNode START URL="',Node.URL,'"']); + + Result:=shrViewerError; + ErrMsg:=''; + if (not Node.URLValid) then begin + ErrMsg:='TLHelpConnector.ShowNode Node.URLValid=false'; + exit; + end; + if (Node.URL='') then begin + ErrMsg:='TLHelpConnector.ShowNode Node.URL empty'; + exit; + end; + + SplitURL(Node.URL,URLScheme,URLPath,URLParams); + CHMFilename:=SetDirSeparators(URLPath); + if not FileExistsUTF8(CHMFilename) then begin + ErrMsg:='chm file "'+CHMFilename+'" not found'; + exit; + end; + + SubPath:=''; + if LeftStr(URLParams,length(CHMPathParam)+1)=CHMPathParam+'=' then begin + SubPath:=URLParams; + Delete(SubPath,1,length(CHMPathParam)+1); + end; + + if Connection=nil then begin + // create a connection to lhelp: + FConnection := TLHelpConnection.Create; + Connection.ProcessWhileWaiting := @Application.ProcessMessages; + end; + + if Connection.ServerRunning = false then begin + IPCFile:=ExtractFileName(Application.ExeName); + IPCFile+='lhelpconnector'; + {$IFDEF Unix} + if FileExistsUTF8('/tmp/'+IPCFile) then + DeleteFileUTF8('/tmp/'+IPCFile); + {$ENDIF} + + // get lhelp path + Path:=LHelpPath; + if Assigned(OnFindLHelp) then + OnFindLHelp(Path); + + // append exe extension + if (ExtractFileExt(Path)='') and (GetExeExt<>'') then + Path:=Path+GetExeExt; + + // search in Path + if (Path<>'') and (ExtractFilePath(Path)='') then begin + s:=FindDefaultExecutablePath(Path); + if s<>'' then Path:=s; + end; + + {$IFDEF darwin} + // search exe in application bundle + if DirectoryExistsUTF8(Path+'.app') then + Path:=Path+'.app/Contents/MacOS/'+ExtractFileName(Path); + {$ENDIF} + + if not FileExistsUTF8(Path) then begin + ErrMsg:='The chm viewer program lhelp was not found at "'+Path+'"'; + exit; + end; + + Connection.StartHelpServer(IPCFile,Path); + end; + + Response:=Connection.OpenURL(CHMFilename,SubPath); + case Response of + srSuccess: exit(shrSuccess); + srNoAnswer: ErrMsg:='lhelp does not respond'; + srInvalidFile: ErrMsg:='lhelp can not open the file "'+CHMFilename+'"'; + srInvalidURL,srInvalidContext: ErrMsg:='lhelp can not find the help entry "'+SubPath+'"'; + else + ErrMsg:='Something is wrong with lhelp'; + end; +end; + +procedure TLHelpConnector.Assign(Source: TPersistent); +var + Src: TLHelpConnector; +begin + if Source is TLHelpConnector then begin + Src:=TLHelpConnector(Source); + LHelpPath:=Src.LHelpPath; + end; + inherited Assign(Source); +end; + +procedure TLHelpConnector.Load(Storage: TConfigStorage); +begin + inherited Load(Storage); + LHelpPath:=Storage.GetValue('LHelp/Path',''); +end; + +procedure TLHelpConnector.Save(Storage: TConfigStorage); +begin + inherited Save(Storage); + Storage.SetDeleteValue('LHelp/Path',LHelpPath,''); +end; + +function TLHelpConnector.GetLocalizedName: string; +begin + Result:='LHelp Connector'; +end; + +{ TCHMHelpDatabase } + +procedure TCHMHelpDatabase.SetFilename(AValue: string); +begin + if FFilename=AValue then Exit; + FFilename:=AValue; +end; + +procedure TCHMHelpDatabase.SetKeywordPrefix(AValue: string); +begin + if FKeywordPrefix=AValue then Exit; + FKeywordPrefix:=AValue; +end; + +constructor TCHMHelpDatabase.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + AddSupportedMimeType(CHMMimeType); +end; + +destructor TCHMHelpDatabase.Destroy; +begin + FreeAndNil(FHelpNode); + inherited Destroy; +end; + +function TCHMHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode, + NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string + ): TShowHelpResult; +begin + ErrMsg:=''; + Result:=shrContextNotFound; + if NewNode.URLValid then begin + Result:=ShowURL(NewNode.URL,NewNode.Title,ErrMsg); + end else begin + Result:=shrContextNotFound; + ErrMsg:='TCHMHelpDatabase.ShowHelp Node.URLValid=false Node.URL="'+NewNode.URL+'"'; + end; +end; + +function TCHMHelpDatabase.ShowURL(const URL, Title: string; var ErrMsg: string + ): TShowHelpResult; +var + Viewer: THelpViewer; + Node: THelpNode; +begin + //DebugLn('TCHMHelpDatabase.ShowURL A URL="',URL,'" Title="',Title,'"'); + + if not FileExistsUTF8(Filename) then begin + ErrMsg:='chm help file "'+Filename+'" not found'; + exit(shrDatabaseNotFound); + end; + + // find HTML viewer + Result:=FindViewer(CHMMimeType,ErrMsg,Viewer); + if Result<>shrSuccess then exit; + + // call viewer + Node:=nil; + try + Node:=THelpNode.CreateURL(Self,Title,URL); + Result:=Viewer.ShowNode(Node,ErrMsg); + finally + Node.Free; + end; +end; + +function TCHMHelpDatabase.GetNodesForKeyword(const HelpKeyword: string; + var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; +var + Path: String; +begin + Result:=inherited GetNodesForKeyword(HelpKeyword, ListOfNodes, ErrMsg); + if Result<>shrSuccess then exit; + + if not (csDesigning in ComponentState) + and (KeywordPrefix<>'') + and (LeftStr(HelpKeyword,length(KeywordPrefix))=KeywordPrefix) then begin + // HelpKeyword starts with KeywordPrefix -> add default node + if FHelpNode=nil then + FHelpNode:=THelpNode.CreateURL(Self,'',''); + Path:=copy(HelpKeyword,length(KeywordPrefix)+1,length(HelpKeyword)); + FHelpNode.Title:='Show page '+Path+' of '+ExtractFileName(Filename); + FHelpNode.URL:='chmfile://'+FilenameToURLPath(Filename)+'?'+CHMPathParam+'='+Path; + CreateNodeQueryListAndAdd(FHelpNode,nil,ListOfNodes,true); + end; +end; + +procedure TCHMHelpDatabase.Load(Storage: TConfigStorage); +begin + inherited Load(Storage); + KeywordPrefix:=Storage.GetValue('KeywordPrefix',''); + Filename:=Storage.GetValue('Filename',''); +end; + +procedure TCHMHelpDatabase.Save(Storage: TConfigStorage); +begin + inherited Save(Storage); + Storage.SetDeleteValue('KeywordPrefix',KeywordPrefix,''); + Storage.SetDeleteValue('Filename',Filename, ''); +end; + +end. + diff --git a/components/chmhelp/packages/help/lhelpcontrolpkg.lpk b/components/chmhelp/packages/help/lhelpcontrolpkg.lpk index 95771c5df1..b0cce0287a 100644 --- a/components/chmhelp/packages/help/lhelpcontrolpkg.lpk +++ b/components/chmhelp/packages/help/lhelpcontrolpkg.lpk @@ -21,12 +21,18 @@ <Description Value="This package contains unit that will allow you to "remote control" the program LHelp."/> <License Value="Modified LGPL-2, same as LCL"/> <Version Minor="2"/> - <Files Count="1"> + <Files Count="2"> <Item1> <Filename Value="lhelpcontrol.pas"/> <UnitName Value="LHelpControl"/> </Item1> + <Item2> + <Filename Value="lazhelpchm.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="LazHelpCHM"/> + </Item2> </Files> + <Type Value="RunAndDesignTime"/> <RequiredPkgs Count="2"> <Item1> <PackageName Value="LCL"/> diff --git a/components/chmhelp/packages/help/lhelpcontrolpkg.pas b/components/chmhelp/packages/help/lhelpcontrolpkg.pas index 2612eb5230..5f5fa50d37 100644 --- a/components/chmhelp/packages/help/lhelpcontrolpkg.pas +++ b/components/chmhelp/packages/help/lhelpcontrolpkg.pas @@ -1,14 +1,21 @@ { This file was automatically created by Lazarus. Do not edit! -This source is only used to compile and install the package. + This source is only used to compile and install the package. } -unit lhelpcontrolpkg; +unit lhelpcontrolpkg; interface uses - LHelpControl; + LHelpControl, LazHelpCHM, LazarusPackageIntf; implementation +procedure Register; +begin + RegisterUnit('LazHelpCHM', @LazHelpCHM.Register); +end; + +initialization + RegisterPackage('lhelpcontrolpkg', @Register); end.