paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-03 20:18:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

wiki test: options for scores

Browse Source 
git-svn-id: trunk@35854 -
This commit is contained in:
mattias 2012-03-09 21:19:05 +00:00
parent 24c2bcc08e
commit 0c27d96b3a
5 changed files with 210 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/wiki/lazwiki/wikistrconsts.pas
View File

@ -42,6 +42,15 @@ resourcestring
wrsWikiSearchOptions = 'Wiki Search Options';
wrsLanguages = 'Languages';
wrsPageTitleWholeWord = 'Page title, whole word';
wrsScores = 'Scores';
wrsPageTitlePart = 'Page title, part';
wrsHeaderWholeWord = 'Header, whole word';
wrsHeaderPart = 'Header, part';
wrsTextWholeWord = 'Text, whole word';
wrsTextPart = 'Text, part';
wrsLinkWholeWord = 'Link, whole word';
wrsLinkPart = 'Link, part';
wrsAll = 'All';
implementation

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

@ -75,8 +75,10 @@ type
LoPhrases: TStrings; // Phrases lowercase
Languages: string; // comma separated list, '-' means not in the original, 'de' = german
Scoring: TWHScoring;
FreeScoring: boolean;
constructor Create(const SearchText: string; const aLang: string = '';
aScoring: TWHScoring = nil);
aScoring: TWHScoring = nil; aFreeScoring: boolean = false);
constructor Clone(Query: TWikiHelpQuery);
destructor Destroy; override;
function Equals(Obj: TObject): boolean; override;
procedure Assign(Source: TPersistent); override;
@ -246,7 +248,7 @@ type
// search
procedure Search(const Term: string; const Languages: string = '';
Scoring: TWHScoring = nil);
Scoring: TWHScoring = nil; FreeScoring: boolean = false);
procedure Search(aQuery: TWikiHelpQuery);
property Query: TWikiHelpQuery read FQuery;
property DefaultScoring: TWHScoring read FDefaultScoring;
@ -579,7 +581,6 @@ var
begin
if Source is TWHScoring then begin
Src:=TWHScoring(Source);
debugln(['TWHScoring.Assign ',SizeOf(Phrases)]);
Move(Src.Phrases,Phrases,SizeOf(Phrases));
end else
inherited Assign(Source);
@ -588,7 +589,7 @@ end;
{ TWikiHelpQuery }
constructor TWikiHelpQuery.Create(const SearchText: string;
const aLang: string; aScoring: TWHScoring);
const aLang: string; aScoring: TWHScoring; aFreeScoring: boolean);
var
i: Integer;
begin
@ -598,13 +599,26 @@ begin
LoPhrases.Add(UTF8LowerCase(Phrases[i]));
Languages:=aLang;
Scoring:=aScoring;
FreeScoring:=aFreeScoring;
end;
constructor TWikiHelpQuery.Clone(Query: TWikiHelpQuery);
begin
Phrases:=TStringList.Create;
LoPhrases:=TStringList.Create;
Scoring:=TWHScoring.Create;
FreeScoring:=true;
Assign(Query);
end;
destructor TWikiHelpQuery.Destroy;
begin
FreeAndNil(Phrases);
FreeAndNil(LoPhrases);
FreeAndNil(Scoring);
if FreeScoring then
FreeAndNil(Scoring)
else
Scoring:=nil;
inherited Destroy;
end;
@ -1697,36 +1711,39 @@ begin
end;
procedure TWikiHelp.Search(const Term: string; const Languages: string;
Scoring: TWHScoring);
Scoring: TWHScoring; FreeScoring: boolean);
var
aQuery: TWikiHelpQuery;
begin
if Scoring=nil then Scoring:=DefaultScoring;
Search(TWikiHelpQuery.Create(Term,Languages,Scoring));
aQuery:=TWikiHelpQuery.Create(Term,Languages,
Scoring,FreeScoring and (Scoring<>DefaultScoring));
try
Search(aQuery);
finally
aQuery.Free;
end;
end;
procedure TWikiHelp.Search(aQuery: TWikiHelpQuery);
procedure FreeQuery(var aQuery: TWikiHelpQuery);
begin
if aQuery=nil then exit;
if aQuery.Scoring=DefaultScoring then
aQuery.Scoring:=nil;
FreeAndNil(aQuery);
end;
begin
EnterCritSect;
try
if (aQuery<>nil) and (FQuery<>nil) and (FQuery.Equals(aQuery)) then begin
if aQuery=nil then exit;
if FQuery=nil then
// first query
FQuery:=TWikiHelpQuery.Clone(aQuery)
else if FQuery.Equals(aQuery) then begin
// same query
FreeQuery(aQuery);
//debugln(['TWikiHelp.Search same query ',FQuery=aQuery,' ',FQuery.Scoring.Equals(aQuery.Scoring),' fquery.scoring=',FQuery.Scoring.Phrases[whfcPageTitle,whfsWholeWord],' aquery.scoring=',aQuery.Scoring.Phrases[whfcPageTitle,whfsWholeWord]]);
exit;
end;
FreeQuery(FQuery);
FQuery:=aQuery;
end else
FQuery.Assign(aQuery);
if LoadingContent then exit;
finally
LeaveCritSect;
end;
//debugln(['TWikiHelp.Search searching']);
DoSearch;
end;

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

@ -70,18 +70,19 @@ type
procedure SearchEditChange(Sender: TObject);
procedure ShowSearchToolButtonClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure WikiSearchOptsWndOptionsChanged(Sender: TObject);
private
fLastSearchText: string;
fLastLanguages: string;
fLastScoring: TWHScoring;
FIdleConnected: boolean;
FURLDataProvider: TWikiIpHtmlDataProvider;
procedure SearchParamsChanged;
procedure QueryChanged;
procedure SetIdleConnected(AValue: boolean);
procedure UpdateProgress;
procedure LoadHTML(Target: TIpHtmlPanel; HTML: string); overload;
procedure LoadHTML(Target: TIpHtmlPanel; aStream: TStream); overload;
procedure ShowOptions;
procedure WikiSearchOptsWndOptionsChanged(Sender: TObject);
procedure WikiHelpScanned(Sender: TObject);
procedure WikiHelpSearched(Sender: TObject);
procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
@ -139,6 +140,8 @@ begin
FURLDataProvider.OnGetImage:=@DataProviderGetImage;
WikiHelp:=TWikiHelp.Create(nil);
fLastScoring:=TWHScoring.Create;
fLastScoring.Assign(WikiHelp.DefaultScoring);
WikiHelp.XMLDirectory:=SetDirSeparators('../wikixml');
WikiHelp.ImagesDirectory:=SetDirSeparators('../images');
WikiHelp.Converter.OutputDir:='';
@ -193,11 +196,14 @@ end;
procedure TWikiSearchDemoForm.FormDestroy(Sender: TObject);
begin
IdleConnected:=false;
FreeAndNil(WikiSearchOptsWnd);
// free pages before dataprovider
FreeAndNil(ResultsIpHtmlPanel);
FreeAndNil(PageIpHtmlPanel);
FreeAndNil(FURLDataProvider);
FreeAndNil(WikiHelp);
FreeAndNil(fLastScoring);
end;
procedure TWikiSearchDemoForm.HideSearchButtonClick(Sender: TObject);
@ -219,7 +225,7 @@ end;
procedure TWikiSearchDemoForm.OnIdle(Sender: TObject; var Done: Boolean);
begin
SearchParamsChanged;
QueryChanged;
IdleConnected:=false;
end;
@ -309,7 +315,7 @@ end;
procedure TWikiSearchDemoForm.WikiSearchOptsWndOptionsChanged(Sender: TObject);
begin
SearchParamsChanged;
QueryChanged;
end;
procedure TWikiSearchDemoForm.WikiHelpScanned(Sender: TObject);
@ -329,18 +335,23 @@ begin
LoadHTML(ResultsIpHtmlPanel,HTML);
end;
procedure TWikiSearchDemoForm.SearchParamsChanged;
procedure TWikiSearchDemoForm.QueryChanged;
var
NewSearchText: String;
NewLanguages: String;
begin
if ComponentState*[csDestroying,csLoading]<>[] then exit;
NewSearchText:=UTF8Trim(SearchEdit.Text);
NewLanguages:=GetLanguages;
if (NewSearchText=fLastSearchText) and (NewLanguages=fLastLanguages) then
if (NewSearchText=fLastSearchText) and (NewLanguages=fLastLanguages)
and ((WikiSearchOptsWnd=nil) or fLastScoring.Equals(WikiSearchOptsWnd.Scoring))
then
exit;
fLastSearchText:=NewSearchText;
fLastLanguages:=NewLanguages;
WikiHelp.Search(NewSearchText,NewLanguages);
if WikiSearchOptsWnd<>nil then
fLastScoring.Assign(WikiSearchOptsWnd.Scoring);
WikiHelp.Search(NewSearchText,NewLanguages,fLastScoring);
Timer1.Enabled:=true;
end;

70
components/wiki/test/wikisearchoptions.lfm
View File

@ -1,30 +1,30 @@
object WikiSearchOptsWnd: TWikiSearchOptsWnd
Left = 364
Height = 308
Height = 300
Top = 392
Width = 364
Width = 449
Caption = 'WikiSearchOptsWnd'
ClientHeight = 308
ClientWidth = 364
ClientHeight = 300
ClientWidth = 449
OnClose = FormClose
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '0.9.31'
object LanguagesGroupBox: TGroupBox
Left = 0
Height = 308
Height = 300
Top = 0
Width = 194
Align = alLeft
Width = 218
Align = alClient
Caption = 'LanguagesGroupBox'
ClientHeight = 292
ClientWidth = 190
ClientHeight = 284
ClientWidth = 214
TabOrder = 0
object LanguagesTreeView: TTreeView
Left = 0
Height = 292
Height = 284
Top = 0
Width = 190
Width = 214
Align = alClient
DefaultItemHeight = 16
ReadOnly = True
@ -37,10 +37,54 @@ object WikiSearchOptsWnd: TWikiSearchOptsWnd
end
end
object LanguagesSplitter: TSplitter
Left = 194
Height = 308
Left = 218
Height = 300
Top = 0
Width = 5
Align = alRight
ResizeAnchor = akRight
end
object ScoresGroupBox: TGroupBox
Left = 223
Height = 300
Top = 0
Width = 226
Align = alRight
Caption = 'ScoresGroupBox'
ClientHeight = 284
ClientWidth = 222
TabOrder = 2
object ScoresStringGrid: TStringGrid
Left = 0
Height = 284
Top = 0
Width = 222
Align = alClient
AutoFillColumns = True
ColCount = 2
Columns = <
item
Color = clBtnFace
MinSize = 100
MaxSize = 300
ReadOnly = True
SizePriority = 2
Title.Caption = 'Item'
Width = 110
end
item
Title.Caption = 'Score'
Width = 110
end>
FixedCols = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goAlwaysShowEditor, goColSpanning, goDblClickAutoSize, goSmoothScroll]
TabOrder = 0
OnEditingDone = ScoresStringGridEditingDone
ColWidths = (
110
110
)
end
end
object ImageList1: TImageList
left = 70

91
components/wiki/test/wikisearchoptions.pas
View File

@ -27,7 +27,7 @@ interface
uses
Classes, SysUtils, FileUtil, LazLogger, BasicCodeTools,
CodeToolsStructs, WikiHelpManager, WikiFormat, WikiStrConsts, Forms, Controls,
Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls;
Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, Grids;
type
@ -38,19 +38,26 @@ type
LanguagesGroupBox: TGroupBox;
LanguagesSplitter: TSplitter;
LanguagesTreeView: TTreeView;
ScoresGroupBox: TGroupBox;
ScoresStringGrid: TStringGrid;
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure LanguagesTreeViewMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer);
procedure ScoresStringGridEditingDone(Sender: TObject);
private
FLanguages: TStringToStringTree;
FOnOptionsChanged: TNotifyEvent;
FScoring: TWHScoring;
function GetLangCodeEnabled(const ID: string): boolean;
function GetLanguages: string;
function LangNodeTextToCode(NodeText: string): string;
function LangToNodeText(LangID: string; Count: integer = -1): string;
procedure SetLangCodeEnabled(const ID: string; AValue: boolean);
procedure SetLanguages(AValue: string);
procedure FillScoresGrid;
function Score2String(s: single): string;
procedure DoOptionsChanged;
public
property Languages: string read GetLanguages write SetLanguages;
property LangCodeEnabled[const ID: string]: boolean read GetLangCodeEnabled
@ -58,6 +65,7 @@ type
procedure UpdateAvailableLanguages;
procedure UpdateEnabledLanguages;
property OnOptionsChanged: TNotifyEvent read FOnOptionsChanged write FOnOptionsChanged;
property Scoring: TWHScoring read FScoring;
end;
var
@ -71,16 +79,34 @@ implementation
procedure TWikiSearchOptsWnd.FormCreate(Sender: TObject);
begin
FScoring:=TWHScoring.Create;
FScoring.Assign(WikiHelp.DefaultScoring);
Caption:=wrsWikiSearchOptions;
LanguagesGroupBox.Caption:=wrsLanguages;
FLanguages:=TStringToStringTree.Create(false);
FLanguages['']:='1';
ScoresGroupBox.Caption:=wrsScores;
with ScoresStringGrid do begin
RowCount:=9;
Cells[0, 1]:=wrsPageTitleWholeWord;
Cells[0, 2]:=wrsPageTitlePart;
Cells[0, 3]:=wrsHeaderWholeWord;
Cells[0, 4]:=wrsHeaderPart;
Cells[0, 5]:=wrsTextWholeWord;
Cells[0, 6]:=wrsTextPart;
Cells[0, 7]:=wrsLinkWholeWord;
Cells[0, 8]:=wrsLinkPart;
end;
FillScoresGrid;
end;
procedure TWikiSearchOptsWnd.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
FreeAndNil(FLanguages);
FreeAndNil(FScoring);
end;
procedure TWikiSearchOptsWnd.LanguagesTreeViewMouseDown(Sender: TObject;
@ -97,6 +123,41 @@ begin
end;
end;
procedure TWikiSearchOptsWnd.ScoresStringGridEditingDone(Sender: TObject);
var
Category: TWHFitsCategory;
FitsString: TWHFitsStringFlag;
OldScore: Single;
NewScore: Extended;
Row: Integer;
Col: Integer;
begin
Row:=ScoresStringGrid.Row;
Col:=ScoresStringGrid.Col;
if Col=1 then begin
case Row of
1: begin Category:=whfcPageTitle; FitsString:=whfsWholeWord; end;
2: begin Category:=whfcPageTitle; FitsString:=whfsPart; end;
3: begin Category:=whfcHeader; FitsString:=whfsWholeWord; end;
4: begin Category:=whfcHeader; FitsString:=whfsPart; end;
5: begin Category:=whfcText; FitsString:=whfsWholeWord; end;
6: begin Category:=whfcText; FitsString:=whfsPart; end;
7: begin Category:=whfcLink; FitsString:=whfsWholeWord; end;
8: begin Category:=whfcLink; FitsString:=whfsPart; end;
else exit;
end;
OldScore:=Scoring.Phrases[Category,FitsString];
NewScore:=StrToFloatDef(ScoresStringGrid.Cells[Col,Row],OldScore);
if (NewScore<-10000) then NewScore:=-10000;
if (NewScore>10000) then NewScore:=10000;
ScoresStringGrid.Cells[Col,Row]:=Score2String(NewScore);
if OldScore<>NewScore then begin
Scoring.Phrases[Category,FitsString]:=NewScore;
DoOptionsChanged;
end;
end;
end;
procedure TWikiSearchOptsWnd.SetLanguages(AValue: string);
var
p: PChar;
@ -134,6 +195,31 @@ begin
UpdateEnabledLanguages;
end;
procedure TWikiSearchOptsWnd.FillScoresGrid;
begin
with ScoresStringGrid do begin
Cells[1,1]:=Score2String(Scoring.Phrases[whfcPageTitle,whfsWholeWord]);
Cells[1,2]:=Score2String(Scoring.Phrases[whfcPageTitle,whfsPart]);
Cells[1,3]:=Score2String(Scoring.Phrases[whfcHeader,whfsWholeWord]);
Cells[1,4]:=Score2String(Scoring.Phrases[whfcHeader,whfsPart]);
Cells[1,5]:=Score2String(Scoring.Phrases[whfcText,whfsWholeWord]);
Cells[1,6]:=Score2String(Scoring.Phrases[whfcText,whfsPart]);
Cells[1,7]:=Score2String(Scoring.Phrases[whfcLink,whfsWholeWord]);
Cells[1,8]:=Score2String(Scoring.Phrases[whfcLink,whfsPart]);
end;
end;
function TWikiSearchOptsWnd.Score2String(s: single): string;
begin
Result:=FloatToStrF(s,ffGeneral,5,2);
end;
procedure TWikiSearchOptsWnd.DoOptionsChanged;
begin
if Assigned(OnOptionsChanged) then
OnOptionsChanged(Self);
end;
procedure TWikiSearchOptsWnd.SetLangCodeEnabled(const ID: string;
AValue: boolean);
begin
@ -143,8 +229,7 @@ begin
else
FLanguages.Remove(ID);
UpdateEnabledLanguages;
if Assigned(OnOptionsChanged) then
OnOptionsChanged(Self);
DoOptionsChanged;
end;
function TWikiSearchOptsWnd.LangNodeTextToCode(NodeText: string): string;