paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 01:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

lhelp: clean up

Browse Source 
git-svn-id: trunk@37712 -
This commit is contained in:
mattias 2012-06-21 11:22:32 +00:00
parent 987afc7816
commit c019b71631
6 changed files with 32 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/chmhelp/lhelp/basecontentprovider.pas
View File

@ -5,7 +5,7 @@ unit BaseContentProvider;
interface interface
uses uses
Classes, SysUtils, Controls, XMLCfg; Classes, SysUtils, Controls, Laz2_XMLCfg;
type type
@ -31,7 +31,7 @@ type
procedure GoBack; virtual; abstract; procedure GoBack; virtual; abstract;
procedure GoForward; virtual; abstract; procedure GoForward; virtual; abstract;
procedure LoadPreferences(ACfg: TXMLConfig); virtual; procedure LoadPreferences(ACfg: TXMLConfig); virtual;
procedure SavePreferences(ACfg: TXMLConfig); virtual; procedure SavePreferences({%H-}ACfg: TXMLConfig); virtual;
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; virtual; abstract; class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; virtual; abstract;
constructor Create(AParent: TWinControl; AImageList: TImageList); virtual; constructor Create(AParent: TWinControl; AImageList: TImageList); virtual;
destructor Destroy; override; destructor Destroy; override;

15
components/chmhelp/lhelp/chmcontentprovider.pas
View File

@ -20,7 +20,7 @@ unit chmcontentprovider;
interface interface
uses uses
Classes, SysUtils, XMLCfg, Classes, SysUtils, Laz2_XMLCfg,
FileUtil, Forms, StdCtrls, ExtCtrls, ComCtrls, Controls, Buttons, Menus, FileUtil, Forms, StdCtrls, ExtCtrls, ComCtrls, Controls, Buttons, Menus,
BaseContentProvider, FileContentProvider, IpHtml, ChmReader, ChmDataProvider; BaseContentProvider, FileContentProvider, IpHtml, ChmReader, ChmDataProvider;
@ -66,7 +66,7 @@ type
procedure DoCloseChm; procedure DoCloseChm;
procedure DoLoadContext(Context: THelpContext); procedure DoLoadContext(Context: THelpContext);
procedure DoLoadUri(Uri: String; AChm: TChmReader = nil); procedure DoLoadUri(Uri: String; AChm: TChmReader = nil);
procedure DoError(Error: Integer); procedure DoError({%H-}Error: Integer);
procedure NewChmOpened(ChmFileList: TChmFileList; Index: Integer); procedure NewChmOpened(ChmFileList: TChmFileList; Index: Integer);
procedure LoadingHTMLStream(var AStream: TStream); procedure LoadingHTMLStream(var AStream: TStream);
@ -77,7 +77,7 @@ type
procedure PopupCopyClick(Sender: TObject); procedure PopupCopyClick(Sender: TObject);
procedure ContentsTreeSelectionChanged(Sender: TObject); procedure ContentsTreeSelectionChanged(Sender: TObject);
procedure IndexViewDblClick(Sender: TObject); procedure IndexViewDblClick(Sender: TObject);
procedure TreeViewStopCollapse(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); procedure TreeViewStopCollapse(Sender: TObject; {%H-}Node: TTreeNode; var AllowCollapse: Boolean);
procedure ViewMenuContentsClick(Sender: TObject); procedure ViewMenuContentsClick(Sender: TObject);
procedure UpdateTitle; procedure UpdateTitle;
procedure SetTitle(const AValue: String); override; procedure SetTitle(const AValue: String); override;
@ -88,7 +88,7 @@ type
{$IFDEF CHM_SEARCH} {$IFDEF CHM_SEARCH}
procedure SearchButtonClick(Sender: TObject); procedure SearchButtonClick(Sender: TObject);
procedure SearchResultsDblClick(Sender: TObject); procedure SearchResultsDblClick(Sender: TObject);
procedure SearchComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SearchComboKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure GetTreeNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass); procedure GetTreeNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
{$ENDIF} {$ENDIF}
public public
@ -104,7 +104,7 @@ type
procedure GoForward; override; procedure GoForward; override;
property TabsControl: TPageControl read fTabsControl; property TabsControl: TPageControl read fTabsControl;
property Splitter: TSplitter read fSplitter; property Splitter: TSplitter read fSplitter;
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; override; class function GetProperContentProvider(const {%H-}AURL: String): TBaseContentProviderClass; override;
constructor Create(AParent: TWinControl; AImageList: TImageList); override; constructor Create(AParent: TWinControl; AImageList: TImageList); override;
destructor Destroy; override; destructor Destroy; override;
@ -112,7 +112,7 @@ type
implementation implementation
uses ChmSpecialParser{$IFDEF CHM_SEARCH}, chmFIftiMain{$ENDIF}, chmsitemap, LCLType, SAX_HTML, Dom, XMLWrite, DOM_HTML, HTMWrite; uses ChmSpecialParser{$IFDEF CHM_SEARCH}, chmFIftiMain{$ENDIF}, chmsitemap, LCLType, SAX_HTML, Dom, DOM_HTML, HTMWrite;
type type
@ -407,6 +407,7 @@ begin
Words.Delimiter:=' '; Words.Delimiter:=' ';
Words.DelimitedText:=fKeywordCombo.Text; Words.DelimitedText:=fKeywordCombo.Text;
Doc:=nil;
try try
UseOrigStream := True; UseOrigStream := True;
ReadHTMLFile(Doc, AStream); ReadHTMLFile(Doc, AStream);
@ -453,7 +454,9 @@ var
i: Integer; i: Integer;
SM: TChmSiteMap; SM: TChmSiteMap;
HasSearchIndex: Boolean = False; HasSearchIndex: Boolean = False;
{$IFNDEF CHM_BINARY_INDEX_TOC}
Stream: TMemoryStream; Stream: TMemoryStream;
{$ENDIF}
begin begin
if fFillingToc or fFillingIndex then begin if fFillingToc or fFillingIndex then begin
Application.QueueAsyncCall(@FillToc, Data); Application.QueueAsyncCall(@FillToc, Data);

8
components/chmhelp/lhelp/chmdataprovider.pas
View File

@ -55,11 +55,11 @@ type
function StripInPageLink(AURL: String): String; function StripInPageLink(AURL: String): String;
protected protected
function DoGetHtmlStream(const URL: string; function DoGetHtmlStream(const URL: string;
PostData: TIpFormDataEntity) : TStream; override; {%H-}PostData: TIpFormDataEntity) : TStream; override;
function DoCheckURL(const URL: string; function DoCheckURL(const URL: string;
var ContentType: string): Boolean; override; var ContentType: string): Boolean; override;
procedure DoLeave(Html: TIpHtml); override; procedure DoLeave({%H-}Html: TIpHtml); override;
procedure DoReference(const URL: string); override; procedure DoReference(const {%H-}URL: string); override;
procedure DoGetImage(Sender: TIpHtmlNode; const URL: string; procedure DoGetImage(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture); override; var Picture: TPicture); override;
function CanHandle(const URL: string): Boolean; override; function CanHandle(const URL: string): Boolean; override;
@ -67,7 +67,7 @@ type
function GetDirsParents(ADir: String): TStringList; function GetDirsParents(ADir: String): TStringList;
function DoGetStream(const URL: string): TStream; override; function DoGetStream(const URL: string): TStream; override;
public public
constructor Create(AOwner: TComponent; AChm: TChmFileList); constructor Create(AOwner: TComponent; AChm: TChmFileList); reintroduce;
destructor Destroy; override; destructor Destroy; override;
property Chm: TChmFileList read fChm write fChm; property Chm: TChmFileList read fChm write fChm;
property OnHelpPopup: THelpPopupEvent read fOnHelpPopup write fOnHelpPopup; property OnHelpPopup: THelpPopupEvent read fOnHelpPopup write fOnHelpPopup;

1
components/chmhelp/lhelp/chmspecialparser.pas
View File

@ -127,7 +127,6 @@ end;
procedure TContentsFiller.DoFill(ParentNode: TTreeNode); procedure TContentsFiller.DoFill(ParentNode: TTreeNode);
var var
OrigEvent: TTVCustomCreateNodeEvent;
X: Integer; X: Integer;
begin begin
fTreeView.BeginUpdate; fTreeView.BeginUpdate;

2
components/chmhelp/lhelp/filecontentprovider.pas
View File

@ -18,7 +18,7 @@ type
function CanGoBack: Boolean; override; function CanGoBack: Boolean; override;
function CanGoForward: Boolean; override; function CanGoForward: Boolean; override;
function GetHistory: TStrings; override; function GetHistory: TStrings; override;
function LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean; override; function LoadURL(const {%H-}AURL: String; const {%H-}AContext: THelpContext=-1): Boolean; override;
procedure GoHome; override; procedure GoHome; override;
procedure GoBack; override; procedure GoBack; override;
procedure GoForward; override; procedure GoForward; override;

29
components/chmhelp/lhelp/lhelpcore.pas
View File

@ -28,10 +28,12 @@ unit lhelpcore;
interface interface
uses uses
Classes, SysUtils, SimpleIPC, XMLCfg, Classes, SysUtils, SimpleIPC, Laz2_XMLCfg,
FileUtil, LResources, Forms, Controls, Graphics, Dialogs, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Buttons, LCLProc, StdCtrls, IpHtml, ComCtrls, ExtCtrls, Menus, LCLType, Buttons, LCLProc, IpHtml, ComCtrls, ExtCtrls, Menus, LCLType,
BaseContentProvider, FileContentProvider, ChmContentProvider{$IFDEF USE_LNET}, HTTPContentProvider{$ENDIF}; BaseContentProvider, FileContentProvider,
ChmContentProvider
{$IFDEF USE_LNET}, HTTPContentProvider{$ENDIF};
type type
@ -77,9 +79,9 @@ type
procedure FileMenuExitItemClick(Sender: TObject); procedure FileMenuExitItemClick(Sender: TObject);
procedure FileMenuOpenItemClick(Sender: TObject); procedure FileMenuOpenItemClick(Sender: TObject);
procedure FileMenuOpenURLItemClick(Sender: TObject); procedure FileMenuOpenURLItemClick(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure ForwardToolBtnClick(Sender: TObject); procedure ForwardToolBtnClick(Sender: TObject);
procedure HomeToolBtnClick(Sender: TObject); procedure HomeToolBtnClick(Sender: TObject);
@ -97,9 +99,9 @@ type
fConfig: TXMLConfig; fConfig: TXMLConfig;
FHasShowed: Boolean; FHasShowed: Boolean;
procedure LoadPreferences(AIPCName: String); procedure LoadPreferences(AIPCName: String);
procedure SavePreferences(AIPCName: String); procedure SavePreferences({%H-}AIPCName: String);
procedure AddRecentFile(AFileName: String); procedure AddRecentFile(AFileName: String);
procedure ContentTitleChange(sender: TObject); procedure ContentTitleChange({%H-}sender: TObject);
procedure OpenRecentItemClick(Sender: TObject); procedure OpenRecentItemClick(Sender: TObject);
procedure SendResponse(Response: DWord); procedure SendResponse(Response: DWord);
procedure ServerMessage(Sender: TObject); procedure ServerMessage(Sender: TObject);
@ -187,6 +189,7 @@ var
begin begin
Protocall := GetContentProviderList; Protocall := GetContentProviderList;
URLSAllowed:='';
for i := 0 to Protocall.Count-1 do for i := 0 to Protocall.Count-1 do
begin begin
if i < 1 then if i < 1 then
@ -198,7 +201,7 @@ begin
URLSAllowed := Trim(URLSALLowed); URLSAllowed := Trim(URLSALLowed);
fRes:='';
if InputQuery('Please Enter a URL', 'Supported URL type(s): (' +URLSAllowed+ ')', fRes) then if InputQuery('Please Enter a URL', 'Supported URL type(s): (' +URLSAllowed+ ')', fRes) then
begin begin
if OpenURL(fRes) = ord(srSuccess) then if OpenURL(fRes) = ord(srSuccess) then
@ -262,8 +265,6 @@ begin
end; end;
procedure THelpForm.ViewMenuContentsClick(Sender: TObject); procedure THelpForm.ViewMenuContentsClick(Sender: TObject);
var
AWidth: Integer;
begin begin
//TabsControl property in TChmContentProvider //TabsControl property in TChmContentProvider
if Assigned(ActivePage) then if Assigned(ActivePage) then
@ -273,7 +274,6 @@ begin
Splitter.Visible := TabsControl.Visible; Splitter.Visible := TabsControl.Visible;
Splitter.Left := TabsControl.Left + 4; //for splitter to move righter Splitter.Left := TabsControl.Left + 4; //for splitter to move righter
ViewMenuContents.Checked := TabsControl.Visible; ViewMenuContents.Checked := TabsControl.Visible;
AWidth := TabsControl.Width + Splitter.Width;
end; end;
end; end;
@ -402,6 +402,7 @@ begin
if fInputIPC.PeekMessage(5, True) then begin if fInputIPC.PeekMessage(5, True) then begin
Stream := fInputIPC.MsgData; Stream := fInputIPC.MsgData;
Stream.Position := 0; Stream.Position := 0;
FillByte(FileReq{%H-},SizeOf(FileReq),0);
Stream.Read(FileReq, SizeOf(FileReq)); Stream.Read(FileReq, SizeOf(FileReq));
case FileReq.RequestType of case FileReq.RequestType of
rtFile : begin rtFile : begin
@ -410,6 +411,7 @@ begin
end; end;
rtUrl : begin rtUrl : begin
Stream.Position := 0; Stream.Position := 0;
FillByte(UrlReq{%H-},SizeOf(UrlReq),0);
Stream.Read(UrlReq, SizeOf(UrlReq)); Stream.Read(UrlReq, SizeOf(UrlReq));
if UrlReq.FileRequest.FileName <> '' then if UrlReq.FileRequest.FileName <> '' then
begin begin
@ -424,6 +426,7 @@ begin
end; end;
rtContext : begin rtContext : begin
Stream.Position := 0; Stream.Position := 0;
FillByte(ConReq{%H-},SizeOf(ConReq),0);
Stream.Read(ConReq, SizeOf(ConReq)); Stream.Read(ConReq, SizeOf(ConReq));
Url := 'file://'+FileReq.FileName; Url := 'file://'+FileReq.FileName;
Res := OpenURL(Url, ConReq.HelpContext); Res := OpenURL(Url, ConReq.HelpContext);
@ -447,7 +450,7 @@ var
URL: String; URL: String;
StrItem: PStringItem; StrItem: PStringItem;
begin begin
FillChar(IsHandled, 51, 0); FillChar(IsHandled{%H-}, 51, 0);
for X := 1 to ParamCount do begin for X := 1 to ParamCount do begin
if LowerCase(ParamStrUTF8(X)) = '--ipcname' then begin if LowerCase(ParamStrUTF8(X)) = '--ipcname' then begin
IsHandled[X] := True; IsHandled[X] := True;
@ -473,7 +476,7 @@ begin
URL := ParamStrUTF8(X); URL := ParamStrUTF8(X);
StrItem := New(PStringItem); StrItem := New(PStringItem);
StrItem^.FString := URL; StrItem^.FString := URL;
Application.QueueAsyncCall(TDataEvent(@LateOpenURL), PtrUInt(StrItem)); Application.QueueAsyncCall(TDataEvent(@LateOpenURL), {%H-}PtrUInt(StrItem));
Break; Break;
end; end;
end; end;