paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-23 21:08:42 +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)); TitleNode.AppendChild(doc.CreateTextNode(Page.WikiPage.Title));
CurCSSFilename:=GetRelativeCSSFilename; CurCSSFilename:=GetRelativeCSSFilename;
if CurCSSFilename<>'' then begin 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'); CSSNode:=doc.CreateElement('link');
HeadNode.AppendChild(CSSNode); HeadNode.AppendChild(CSSNode);
CSSNode.SetAttribute('href',CurCSSFilename); CSSNode.SetAttribute('href',CurCSSFilename);

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

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

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

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

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

@ -5,11 +5,21 @@ unit WikiSearchMain;
interface interface
uses uses
Classes, SysUtils, FileUtil, LazLogger, LazUTF8, IpHtml, Forms, Controls, Classes, SysUtils, FileUtil, LazLogger, LazUTF8, LazFileUtils, IpHtml,
Graphics, Dialogs, StdCtrls, ExtCtrls, WikiHelpManager; Ipfilebroker, IpMsg, CodeToolManager, CodeCache, Forms, Controls, Graphics,
Dialogs, StdCtrls, ExtCtrls, WikiHelpManager;
type type
{ TWikiIpHtmlDataProvider }
TWikiIpHtmlDataProvider = class(TIpHtmlDataProvider)
private
protected
function DoGetStream(const URL: string): TStream; override;
public
end;
{ TWikiSearchDemoForm } { TWikiSearchDemoForm }
TWikiSearchDemoForm = class(TForm) TWikiSearchDemoForm = class(TForm)
@ -23,10 +33,21 @@ type
SearchLabel: TLabel; SearchLabel: TLabel;
Splitter1: TSplitter; Splitter1: TSplitter;
Timer1: TTimer; 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 FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure LanguagesEditChange(Sender: TObject); procedure LanguagesEditChange(Sender: TObject);
procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean); procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
procedure ResultsIpHtmlPanelDocumentOpen(Sender: TObject);
procedure ResultsIpHtmlPanelHotClick(Sender: TObject);
procedure SearchEditChange(Sender: TObject); procedure SearchEditChange(Sender: TObject);
procedure Timer1Timer(Sender: TObject); procedure Timer1Timer(Sender: TObject);
procedure WikiHelpScanned(Sender: TObject); procedure WikiHelpScanned(Sender: TObject);
@ -35,9 +56,11 @@ type
fLastSearchText: string; fLastSearchText: string;
fLastLanguages: string; fLastLanguages: string;
FIdleConnected: boolean; FIdleConnected: boolean;
FURLDataProvider: TWikiIpHtmlDataProvider;
procedure SearchParamsChanged; procedure SearchParamsChanged;
procedure SetIdleConnected(AValue: boolean); procedure SetIdleConnected(AValue: boolean);
procedure UpdateProgress; procedure UpdateProgress;
procedure LoadHTML(Target: TIpHtmlPanel; HTML: string);
public public
property IdleConnected: boolean read FIdleConnected write SetIdleConnected; property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
end; end;
@ -47,11 +70,30 @@ var
implementation 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} {$R *.lfm}
{ TWikiSearchDemoForm } { TWikiSearchDemoForm }
procedure TWikiSearchDemoForm.FormCreate(Sender: TObject); procedure TWikiSearchDemoForm.FormCreate(Sender: TObject);
var
Code: TCodeBuffer;
begin begin
Caption:='Search Wiki (Proof of concept)'; Caption:='Search Wiki (Proof of concept)';
SearchLabel.Caption:='Search:'; 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'; LanguagesEdit.Hint:='Empty for only original/untranslated pages, "de" to include german pages, "-,de" for german pages only';
MainGroupBox.Caption:='Result:'; 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:=TWikiHelp.Create(nil);
WikiHelp.XMLDirectory:=SetDirSeparators('../wikixml'); WikiHelp.XMLDirectory:=SetDirSeparators('../wikixml');
WikiHelp.ImagesDirectory:=SetDirSeparators('../images'); WikiHelp.ImagesDirectory:=SetDirSeparators('../images');
@ -69,12 +121,59 @@ begin
WikiHelp.Converter.CSSFilename:='wiki.css'; WikiHelp.Converter.CSSFilename:='wiki.css';
WikiHelp.OnScanned:=@WikiHelpScanned; WikiHelp.OnScanned:=@WikiHelpScanned;
WikiHelp.OnSearched:=@WikiHelpSearched; 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; WikiHelp.StartLoading;
UpdateProgress; UpdateProgress;
Timer1.Enabled:=true; Timer1.Enabled:=true;
end; 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); procedure TWikiSearchDemoForm.FormDestroy(Sender: TObject);
begin begin
FreeAndNil(WikiHelp); FreeAndNil(WikiHelp);
@ -91,6 +190,29 @@ begin
IdleConnected:=false; IdleConnected:=false;
end; 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); procedure TWikiSearchDemoForm.SearchEditChange(Sender: TObject);
begin begin
IdleConnected:=true; IdleConnected:=true;
@ -99,7 +221,7 @@ end;
procedure TWikiSearchDemoForm.Timer1Timer(Sender: TObject); procedure TWikiSearchDemoForm.Timer1Timer(Sender: TObject);
begin begin
ProgressLabel.Caption:=WikiHelp.GetProgressCaption; ProgressLabel.Caption:=WikiHelp.GetProgressCaption;
debugln(['TWikiSearchDemoForm.Timer1Timer ',ProgressLabel.Caption]); //debugln(['TWikiSearchDemoForm.Timer1Timer ',ProgressLabel.Caption]);
Timer1.Enabled:=WikiHelp.Busy; Timer1.Enabled:=WikiHelp.Busy;
end; end;
@ -109,8 +231,16 @@ begin
end; end;
procedure TWikiSearchDemoForm.WikiHelpSearched(Sender: TObject); procedure TWikiSearchDemoForm.WikiHelpSearched(Sender: TObject);
var
HTML: String;
begin begin
UpdateProgress; UpdateProgress;
HTML:=WikiHelp.ResultsHTML;
if HTML='' then begin
HTML:='<html><body><h1>Search Results</h1></body></html>';
end;
LoadHTML(ResultsIpHtmlPanel,HTML);
end; end;
procedure TWikiSearchDemoForm.SearchParamsChanged; procedure TWikiSearchDemoForm.SearchParamsChanged;
@ -142,5 +272,31 @@ begin
Timer1.Enabled:=WikiHelp.Busy; Timer1.Enabled:=WikiHelp.Busy;
end; 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. end.