From 0c27d96b3a4bd443b31eb97e2787a7757eaf01ea Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 9 Mar 2012 21:19:05 +0000 Subject: [PATCH] wiki test: options for scores git-svn-id: trunk@35854 - --- components/wiki/lazwiki/wikistrconsts.pas | 9 +++ components/wiki/test/wikihelpmanager.pas | 59 +++++++++----- components/wiki/test/wikisearchmain.pas | 25 ++++-- components/wiki/test/wikisearchoptions.lfm | 70 +++++++++++++---- components/wiki/test/wikisearchoptions.pas | 91 +++++++++++++++++++++- 5 files changed, 210 insertions(+), 44 deletions(-) diff --git a/components/wiki/lazwiki/wikistrconsts.pas b/components/wiki/lazwiki/wikistrconsts.pas index f3476d6f0d..5223e322d3 100644 --- a/components/wiki/lazwiki/wikistrconsts.pas +++ b/components/wiki/lazwiki/wikistrconsts.pas @@ -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 diff --git a/components/wiki/test/wikihelpmanager.pas b/components/wiki/test/wikihelpmanager.pas index 1862e67a7d..b32e53ae2e 100644 --- a/components/wiki/test/wikihelpmanager.pas +++ b/components/wiki/test/wikihelpmanager.pas @@ -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; diff --git a/components/wiki/test/wikisearchmain.pas b/components/wiki/test/wikisearchmain.pas index 953cdbb619..22e434c6d7 100644 --- a/components/wiki/test/wikisearchmain.pas +++ b/components/wiki/test/wikisearchmain.pas @@ -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; diff --git a/components/wiki/test/wikisearchoptions.lfm b/components/wiki/test/wikisearchoptions.lfm index b7deb40ffd..2e19bc7694 100644 --- a/components/wiki/test/wikisearchoptions.lfm +++ b/components/wiki/test/wikisearchoptions.lfm @@ -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 diff --git a/components/wiki/test/wikisearchoptions.pas b/components/wiki/test/wikisearchoptions.pas index af64548490..34feb6457d 100644 --- a/components/wiki/test/wikisearchoptions.pas +++ b/components/wiki/test/wikisearchoptions.pas @@ -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;