wiki test: options for scores

git-svn-id: trunk@35854 -

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

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;
+    end else
-    FreeQuery(FQuery);
+      FQuery.Assign(aQuery);
-    FQuery:=aQuery;
     if LoadingContent then exit;
   finally
     LeaveCritSect;
   end;
+  //debugln(['TWikiHelp.Search searching']);
   DoSearch;
 end;
 

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;
 

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
+  ClientHeight = 300
-  ClientWidth = 364
+  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
+    Width = 218
-    Align = alLeft
+    Align = alClient
     Caption = 'LanguagesGroupBox'
-    ClientHeight = 292
+    ClientHeight = 284
-    ClientWidth = 190
+    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
+    Left = 218
-    Height = 308
+    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

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
+  DoOptionsChanged;
-    OnOptionsChanged(Self);
 end;
 
 function TWikiSearchOptsWnd.LangNodeTextToCode(NodeText: string): string;