paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-04 08:38:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

wiki test: load html

Browse Source 
git-svn-id: trunk@35745 -
This commit is contained in:
mattias 2012-03-05 18:57:27 +00:00
parent d03f8a8bfe
commit e8ec9a55e4
4 changed files with 189 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/wiki/lazwiki/wiki2xhtmlconvert.pas
View File

@ -275,7 +275,7 @@ begin
TitleNode.AppendChild(doc.CreateTextNode(Page.WikiPage.Title));
CurCSSFilename:=GetRelativeCSSFilename;
if CurCSSFilename<>'' then begin
// stylesheet <link href="fp.css" type="text/css" rel="stylesheet">
// stylesheet <link href="wiki.css" type="text/css" rel="stylesheet">
CSSNode:=doc.CreateElement('link');
HeadNode.AppendChild(CSSNode);
CSSNode.SetAttribute('href',CurCSSFilename);

33
components/wiki/test/wikihelpmanager.pas
View File

@ -191,6 +191,9 @@ type
FOnSearched: TNotifyEvent;
FQuery: TWikiHelpQuery;
FScoring: TWHScoring;
FResultsCSS: string;
FResultsCSSURL: string;
FResultsHTML: string;
FXMLDirectory: string;
FCritSec: TRTLCriticalSection;
FScanThread: TWikiHelpThread;
@ -216,6 +219,9 @@ type
function GetProgressCaption: string;
function Busy: boolean;
property ResultsCSS: string read FResultsCSS write FResultsCSS;
property ResultsCSSURL: string read FResultsCSSURL write FResultsCSSURL;
// load wiki files
procedure StartLoading; // returns immediately
function LoadingContent: boolean;
@ -229,6 +235,7 @@ type
property Query: TWikiHelpQuery read FQuery;
property Scoring: TWHScoring read FScoring;
property MaxResults: integer read FMaxResults write SetMaxResults;
property ResultsHTML: string read FResultsHTML;
public
property XMLDirectory: string read FXMLDirectory write SetXMLDirectory; // directory where the wiki xml files are
property ImagesDirectory: string read GetImagesDirectory write SetImagesDirectory; // directory where the wiki image files are
@ -1086,11 +1093,7 @@ begin
end;
procedure TWiki2HelpConverter.LoadPages;
var
s: TDateTime;
e: TDateTime;
begin
s:=Now;
Help.EnterCritSect;
try
Help.fProgressStep:=whpsWikiLoadPages;
@ -1100,8 +1103,6 @@ begin
Help.LeaveCritSect;
end;
ProcThreadPool.DoParallel(@ParallelLoadPage,0,(Count-1) div PagesPerThread);
e:=Now;
debugln(['TWiki2HelpConverter.LoadPages ',round((e-s)*86400000)]);
end;
constructor TWiki2HelpConverter.Create;
@ -1146,7 +1147,6 @@ begin
try
Help.Converter.OnLog:=@ConverterLog;
// get all wiki xml files
Log('TWikiHelpThread.Execute AAA1');
if FindFirstUTF8(Help.XMLDirectory+AllFilesMask,faAnyFile,FileInfo)=0 then begin
repeat
if CompareFileExt(FileInfo.Name,'.xml',false)<>0 then continue;
@ -1157,7 +1157,6 @@ begin
until FindNextUTF8(FileInfo)<>0;
end;
FindCloseUTF8(FileInfo);
Log('TWikiHelpThread.Execute AAA2');
// add file names to converter
for i:=0 to Files.Count-1 do begin
@ -1165,7 +1164,6 @@ begin
Help.Converter.AddWikiPage(Filename,false);
end;
if Help.Aborting then exit;
Log('TWikiHelpThread.Execute AAA3');
// load xml files
Help.Converter.LoadPages;
@ -1296,7 +1294,9 @@ var
Page: TW2HelpPage;
Node: TWHTextNode;
s: String;
HTML: String;
begin
FResultsHTML:='';
if Query.Phrases.Count=0 then begin
EnterCritSect;
try
@ -1310,12 +1310,23 @@ begin
//debugln(['TWikiHelp.DoSearch START Search=',Trim(Query.Phrases.Text)]);
FoundPages:=nil;
Converter.Search(Query,Scoring,FoundPages);
HTML:='<html>'+LineEnding
+'<head>'+LineEnding
+' <meta content="text/html; charset=utf-8" http-equiv="Content-Type">'+LineEnding;
if ResultsCSSURL<>'' then
HTML+=' <link href="'+ResultsCSSURL+'" type="text/css" rel="stylesheet">'+LineEnding;
HTML+='</head>'+LineEnding
+'<body>'+LineEnding;
for i:=0 to Min(FoundPages.Count-1,MaxResults) do begin
Page:=TW2HelpPage(FoundPages[i]);
Node:=Page.GetNodeHighestScore(Query,Scoring);
s:=FoundNodeToHTMLSnippet(Page,Node,Query);
s:='<div class="wikiSearchResultItem">'+FoundNodeToHTMLSnippet(Page,Node,Query)+'</div>'+LineEnding;
HTML+=s;
//debugln(['TWikiHelp.TestSearch Score=',Page.Score,' HTML="',s,'"']);
end;
HTML+='</body>'+LineEnding
+'</html>'+LineEnding;
FResultsHTML:=HTML;
FoundPages.Free;
EndTime:=Now;
fWikiSearchTimeMSec:=round(Abs(EndTime-StartTime)*86400000);
@ -1344,7 +1355,7 @@ begin
HeaderNode:=HeaderNode.Previous;
if HeaderNode<>nil then begin
// add a direct link to the sub topic
Result+='Topic: <a href="'+StrToXMLValue(aPage.WikiDocumentName+'#'+WikiHeaderToLink(HeaderNode.Txt))+'" class="wikiLinkTopic">'
Result+='Topic <a href="'+StrToXMLValue(aPage.WikiDocumentName+'#'+WikiHeaderToLink(HeaderNode.Txt))+'" class="wikiLinkTopic">'
+TextToHTMLSnipped(HeaderNode.Txt,aQuery.LoPhrases,200)+'</a>: ';
end;
if HeaderNode<>aNode then begin

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

@ -1,7 +1,7 @@
object WikiSearchDemoForm: TWikiSearchDemoForm
Left = 605
Left = 767
Height = 501
Top = 233
Top = 230
Width = 663
Caption = 'WikiSearchDemoForm'
ClientHeight = 501
@ -61,13 +61,16 @@ object WikiSearchDemoForm: TWikiSearchDemoForm
Align = alLeft
FixedTypeface = 'Courier New'
DefaultTypeFace = 'default'
DefaultFontSize = 12
DefaultFontSize = 8
FlagErrors = False
PrintSettings.MarginLeft = 0.5
PrintSettings.MarginTop = 0.5
PrintSettings.MarginRight = 0.5
PrintSettings.MarginBottom = 0.5
TabOrder = 0
WantTabs = False
OnDocumentOpen = ResultsIpHtmlPanelDocumentOpen
OnHotClick = ResultsIpHtmlPanelHotClick
end
object Splitter1: TSplitter
Left = 337
@ -90,6 +93,7 @@ object WikiSearchDemoForm: TWikiSearchDemoForm
PrintSettings.MarginRight = 0.5
PrintSettings.MarginBottom = 0.5
TabOrder = 2
WantTabs = False
end
end
object LanguagesLabel: TLabel

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

@ -5,11 +5,21 @@ unit WikiSearchMain;
interface
uses
Classes, SysUtils, FileUtil, LazLogger, LazUTF8, IpHtml, Forms, Controls,
Graphics, Dialogs, StdCtrls, ExtCtrls, WikiHelpManager;
Classes, SysUtils, FileUtil, LazLogger, LazUTF8, LazFileUtils, IpHtml,
Ipfilebroker, IpMsg, CodeToolManager, CodeCache, Forms, Controls, Graphics,
Dialogs, StdCtrls, ExtCtrls, WikiHelpManager;
type
{ TWikiIpHtmlDataProvider }
TWikiIpHtmlDataProvider = class(TIpHtmlDataProvider)
private
protected
function DoGetStream(const URL: string): TStream; override;
public
end;
{ TWikiSearchDemoForm }
TWikiSearchDemoForm = class(TForm)
@ -23,10 +33,21 @@ type
SearchLabel: TLabel;
Splitter1: TSplitter;
Timer1: TTimer;
function DataProviderCanHandle(Sender: TObject; const URL: string): Boolean;
procedure DataProviderCheckURL(Sender: TObject; const URL: string;
var Available: Boolean; var ContentType: string);
procedure DataProviderGetHtml(Sender: TObject; const URL: string;
const PostData: TIpFormDataEntity; var Stream: TStream);
procedure DataProviderGetImage(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture);
procedure DataProviderLeave(Sender: TIpHtml);
procedure DataProviderReportReference(Sender: TObject; const URL: string);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure LanguagesEditChange(Sender: TObject);
procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
procedure ResultsIpHtmlPanelDocumentOpen(Sender: TObject);
procedure ResultsIpHtmlPanelHotClick(Sender: TObject);
procedure SearchEditChange(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure WikiHelpScanned(Sender: TObject);
@ -35,9 +56,11 @@ type
fLastSearchText: string;
fLastLanguages: string;
FIdleConnected: boolean;
FURLDataProvider: TWikiIpHtmlDataProvider;
procedure SearchParamsChanged;
procedure SetIdleConnected(AValue: boolean);
procedure UpdateProgress;
procedure LoadHTML(Target: TIpHtmlPanel; HTML: string);
public
property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
end;
@ -47,11 +70,30 @@ var
implementation
{ TWikiIpHtmlDataProvider }
function TWikiIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
begin
Result:=nil;
if URL='' then exit;
if URL=WikiHelp.ResultsCSSURL then begin
debugln(['TWikiIpHtmlDataProvider.DoGetStream loading css ']);
Result:=TMemoryStream.Create;
if WikiHelp.ResultsCSS<>'' then
Result.Write(WikiHelp.ResultsCSS[1],length(WikiHelp.ResultsCSS));
Result.Position:=0;
exit;
end;
debugln(['TWikiIpHtmlDataProvider.DoGetStream ',URL]);
end;
{$R *.lfm}
{ TWikiSearchDemoForm }
procedure TWikiSearchDemoForm.FormCreate(Sender: TObject);
var
Code: TCodeBuffer;
begin
Caption:='Search Wiki (Proof of concept)';
SearchLabel.Caption:='Search:';
@ -62,6 +104,16 @@ begin
LanguagesEdit.Hint:='Empty for only original/untranslated pages, "de" to include german pages, "-,de" for german pages only';
MainGroupBox.Caption:='Result:';
FURLDataProvider:=TWikiIpHtmlDataProvider.Create(Self);
ResultsIpHtmlPanel.DataProvider:=FURLDataProvider;
PageIpHtmlPanel.DataProvider:=FURLDataProvider;
FURLDataProvider.OnCanHandle:=@DataProviderCanHandle;
FURLDataProvider.OnGetHtml:=@DataProviderGetHtml;
FURLDataProvider.OnGetImage:=@DataProviderGetImage;
FURLDataProvider.OnLeave:=@DataProviderLeave;
FURLDataProvider.OnCheckURL:=@DataProviderCheckURL;
FURLDataProvider.OnReportReference:=@DataProviderReportReference;
WikiHelp:=TWikiHelp.Create(nil);
WikiHelp.XMLDirectory:=SetDirSeparators('../wikixml');
WikiHelp.ImagesDirectory:=SetDirSeparators('../images');
@ -69,12 +121,59 @@ begin
WikiHelp.Converter.CSSFilename:='wiki.css';
WikiHelp.OnScanned:=@WikiHelpScanned;
WikiHelp.OnSearched:=@WikiHelpSearched;
WikiHelp.ResultsCSSURL:='wiki.css';
Code:=CodeToolBoss.LoadFile(TrimAndExpandFilename(SetDirSeparators('../html/wiki.css')),true,false);
if Code<>nil then
WikiHelp.ResultsCSS:=Code.Source;
LoadHTML(ResultsIpHtmlPanel,'');
LoadHTML(PageIpHtmlPanel,'');
WikiHelp.StartLoading;
UpdateProgress;
Timer1.Enabled:=true;
end;
function TWikiSearchDemoForm.DataProviderCanHandle(Sender: TObject;
const URL: string): Boolean;
begin
debugln(['TWikiSearchDemoForm.DataProviderCanHandle URL=',URL]);
Result:=false;
end;
procedure TWikiSearchDemoForm.DataProviderCheckURL(Sender: TObject;
const URL: string; var Available: Boolean; var ContentType: string);
begin
debugln(['TWikiSearchDemoForm.DataProviderCheckURL URL=',URL]);
Available:=false;
ContentType:='';
end;
procedure TWikiSearchDemoForm.DataProviderGetHtml(Sender: TObject;
const URL: string; const PostData: TIpFormDataEntity; var Stream: TStream);
begin
debugln(['TWikiSearchDemoForm.DataProviderGetHtml URL=',URL]);
Stream:=nil;
end;
procedure TWikiSearchDemoForm.DataProviderGetImage(Sender: TIpHtmlNode;
const URL: string; var Picture: TPicture);
begin
debugln(['TWikiSearchDemoForm.DataProviderGetImage URL=',URL]);
end;
procedure TWikiSearchDemoForm.DataProviderLeave(Sender: TIpHtml);
begin
//debugln(['TWikiSearchDemoForm.DataProviderLeave ']);
end;
procedure TWikiSearchDemoForm.DataProviderReportReference(Sender: TObject;
const URL: string);
begin
if URL='' then exit;
//debugln(['TWikiSearchDemoForm.DataProviderReportReference ',URL]);
end;
procedure TWikiSearchDemoForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(WikiHelp);
@ -91,6 +190,29 @@ begin
IdleConnected:=false;
end;
procedure TWikiSearchDemoForm.ResultsIpHtmlPanelDocumentOpen(Sender: TObject);
begin
end;
procedure TWikiSearchDemoForm.ResultsIpHtmlPanelHotClick(Sender: TObject);
var
HotNode: TIpHtmlNode;
HRef: String;
Panel: TIpHtmlPanel;
begin
Panel:=Sender as TIpHtmlPanel;
HotNode:=Panel.HotNode;
if HotNode is TIpHtmlNodeA then begin
HRef := TIpHtmlNodeA(HotNode).HRef;
//Target := TIpHtmlNodeA(HotNode).Target;
end else begin
HRef := TIpHtmlNodeAREA(HotNode).HRef;
//Target := TIpHtmlNodeAREA(HotNode).Target;
end;
debugln(['TWikiSearchDemoForm.ResultsIpHtmlPanelHotClick href=',href]);
end;
procedure TWikiSearchDemoForm.SearchEditChange(Sender: TObject);
begin
IdleConnected:=true;
@ -99,7 +221,7 @@ end;
procedure TWikiSearchDemoForm.Timer1Timer(Sender: TObject);
begin
ProgressLabel.Caption:=WikiHelp.GetProgressCaption;
debugln(['TWikiSearchDemoForm.Timer1Timer ',ProgressLabel.Caption]);
//debugln(['TWikiSearchDemoForm.Timer1Timer ',ProgressLabel.Caption]);
Timer1.Enabled:=WikiHelp.Busy;
end;
@ -109,8 +231,16 @@ begin
end;
procedure TWikiSearchDemoForm.WikiHelpSearched(Sender: TObject);
var
HTML: String;
begin
UpdateProgress;
HTML:=WikiHelp.ResultsHTML;
if HTML='' then begin
HTML:='<html><body><h1>Search Results</h1></body></html>';
end;
LoadHTML(ResultsIpHtmlPanel,HTML);
end;
procedure TWikiSearchDemoForm.SearchParamsChanged;
@ -142,5 +272,31 @@ begin
Timer1.Enabled:=WikiHelp.Busy;
end;
procedure TWikiSearchDemoForm.LoadHTML(Target: TIpHtmlPanel; HTML: string);
var
ms: TMemoryStream;
NewHTML: TIpHtml;
begin
if HTML='' then
HTML:='<html><body></body></html>';
ms:=TMemoryStream.Create;
try
try
ms.Write(HTML[1],length(HTML));
ms.Position:=0;
NewHTML:=TIpHtml.Create; // Beware: Will be freed automatically by IpHtmlPanel
//NewHTML.OnGetImageX:=@HTMLGetImageX;
Target.SetHtml(NewHTML);
NewHTML.LoadFromStream(ms);
except
on E: Exception do begin
debugln(['TWikiSearchDemoForm.LoadHTML ',E.Message]);
end;
end;
finally
ms.Free;
end;
end;
end.