paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-07 19:09:25 +01:00
Code Issues Packages Projects Releases Wiki Activity

wiki test: view html

Browse Source 
git-svn-id: trunk@35859 -
This commit is contained in:
mattias 2012-03-10 08:35:20 +00:00
parent 2e86fb66b8
commit 211a956aee
3 changed files with 61 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
components/wiki/test/wikisearchdemo.lpi
View File

@ -30,19 +30,22 @@
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="4"> <RequiredPackages Count="5">
<Item1> <Item1>
<PackageName Value="turbopoweripro"/> <PackageName Value="SynEdit"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="MultiThreadProcsLaz"/> <PackageName Value="turbopoweripro"/>
</Item2> </Item2>
<Item3> <Item3>
<PackageName Value="LazWiki"/> <PackageName Value="MultiThreadProcsLaz"/>
</Item3> </Item3>
<Item4> <Item4>
<PackageName Value="LCL"/> <PackageName Value="LazWiki"/>
</Item4> </Item4>
<Item5>
<PackageName Value="LCL"/>
</Item5>
</RequiredPackages> </RequiredPackages>
<Units Count="4"> <Units Count="4">
<Unit0> <Unit0>

11
components/wiki/test/wikisearchmain.lfm
View File

@ -55,8 +55,19 @@ object WikiSearchDemoForm: TWikiSearchDemoForm
AutoSize = True AutoSize = True
Caption = 'Search' Caption = 'Search'
OnClick = ShowSearchToolButtonClick OnClick = ShowSearchToolButtonClick
ParentShowHint = False
ShowHint = True
Visible = False Visible = False
end end
object ShowHTMLToolButton: TToolButton
Left = 47
Top = 2
AutoSize = True
Caption = 'HTML'
OnClick = ShowHTMLToolButtonClick
ParentShowHint = False
ShowHint = True
end
end end
end end
object Splitter1: TSplitter object Splitter1: TSplitter

43
components/wiki/test/wikisearchmain.pas
View File

@ -28,7 +28,7 @@ uses
Classes, SysUtils, math, FileUtil, LazLogger, LazUTF8, LazFileUtils, laz2_DOM, Classes, SysUtils, math, FileUtil, LazLogger, LazUTF8, LazFileUtils, laz2_DOM,
Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, LCLIntf, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, LCLIntf,
IpHtml, Ipfilebroker, IpMsg, IpHtml, Ipfilebroker, IpMsg,
CodeToolManager, CodeCache, CodeToolManager, CodeCache, SynEdit, SynHighlighterHTML,
WikiHelpManager, WikiSearchOptions, WikiParser; WikiHelpManager, WikiSearchOptions, WikiParser;
type type
@ -58,6 +58,7 @@ type
Splitter1: TSplitter; Splitter1: TSplitter;
Timer1: TTimer; Timer1: TTimer;
ShowSearchToolButton: TToolButton; ShowSearchToolButton: TToolButton;
ShowHTMLToolButton: TToolButton;
function DataProviderCanHandle(Sender: TObject; const {%H-}URL: string): Boolean; function DataProviderCanHandle(Sender: TObject; const {%H-}URL: string): Boolean;
procedure DataProviderGetImage(Sender: TIpHtmlNode; const URL: string; procedure DataProviderGetImage(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture); var Picture: TPicture);
@ -68,6 +69,7 @@ type
procedure IpHtmlPanelHotClick(Sender: TObject); procedure IpHtmlPanelHotClick(Sender: TObject);
procedure OptionsButtonClick(Sender: TObject); procedure OptionsButtonClick(Sender: TObject);
procedure SearchEditChange(Sender: TObject); procedure SearchEditChange(Sender: TObject);
procedure ShowHTMLToolButtonClick(Sender: TObject);
procedure ShowSearchToolButtonClick(Sender: TObject); procedure ShowSearchToolButtonClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject); procedure Timer1Timer(Sender: TObject);
private private
@ -76,6 +78,8 @@ type
fLastScoring: TWHScoring; fLastScoring: TWHScoring;
FIdleConnected: boolean; FIdleConnected: boolean;
FURLDataProvider: TWikiIpHtmlDataProvider; FURLDataProvider: TWikiIpHtmlDataProvider;
FPageURL: string;
FPageSource: string;
procedure QueryChanged; procedure QueryChanged;
procedure SetIdleConnected(AValue: boolean); procedure SetIdleConnected(AValue: boolean);
procedure UpdateProgress; procedure UpdateProgress;
@ -132,6 +136,7 @@ begin
// page panel // page panel
ShowSearchToolButton.Caption:='Search'; ShowSearchToolButton.Caption:='Search';
ShowHTMLToolButton.Hint:='View HTML Source';
FURLDataProvider:=TWikiIpHtmlDataProvider.Create(nil); FURLDataProvider:=TWikiIpHtmlDataProvider.Create(nil);
ResultsIpHtmlPanel.DataProvider:=FURLDataProvider; ResultsIpHtmlPanel.DataProvider:=FURLDataProvider;
@ -276,7 +281,13 @@ begin
end; end;
WikiHelp.SavePageToStream(DocumentName,ms); WikiHelp.SavePageToStream(DocumentName,ms);
ms.Position:=0; ms.Position:=0;
SetLength(Src,ms.Size);
if Src<>'' then
ms.Read(Src[1],length(Src));
ms.Position:=0;
LoadHTML(PageIpHtmlPanel,ms); LoadHTML(PageIpHtmlPanel,ms);
FPageSource:=Src;
FPageURL:=HRef;
except except
on E: Exception do begin on E: Exception do begin
Src:='<html><body>Error: '+EncodeLesserAndGreaterThan(E.Message)+'</body></html>'; Src:='<html><body>Error: '+EncodeLesserAndGreaterThan(E.Message)+'</body></html>';
@ -298,6 +309,36 @@ begin
IdleConnected:=true; IdleConnected:=true;
end; end;
procedure TWikiSearchDemoForm.ShowHTMLToolButtonClick(Sender: TObject);
var
ViewSrcForm: TForm;
SrcEdit: TSynEdit;
Highlighter: TSynHTMLSyn;
begin
if (FPageURL='') then exit;
ViewSrcForm:=TForm.Create(Self);
ViewSrcForm.DisableAutoSizing;
try
ViewSrcForm.Caption:='HTML Source of '+FPageURL;
ViewSrcForm.Position:=poScreenCenter;
ViewSrcForm.Width:=500;
ViewSrcForm.Height:=500;
Highlighter:=TSynHTMLSyn.Create(ViewSrcForm);
SrcEdit:=TSynEdit.Create(ViewSrcForm);
SrcEdit.Align:=alClient;
SrcEdit.Text:=FPageSource;
SrcEdit.Highlighter:=Highlighter;
SrcEdit.Parent:=ViewSrcForm;
SrcEdit.ReadOnly:=true;
ViewSrcForm.Show;
finally
ViewSrcForm.EnableAutoSizing;
end;
end;
procedure TWikiSearchDemoForm.ShowSearchToolButtonClick(Sender: TObject); procedure TWikiSearchDemoForm.ShowSearchToolButtonClick(Sender: TObject);
begin begin
DisableAutoSizing; DisableAutoSizing;