#216: Tokenized search implemented

win32/development/src/frontend/diary/ACCombo.pas

@@ -151,6 +151,17 @@ procedure Register;
 
 implementation
 
+const
+  RUSSIAN = ['À', 'Á', 'Â', 'Ã', 'Ä', 'Å', '¨', 'Æ', 'Ç', 'È',
+             'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï', 'Ð', 'Ñ', 'Ò',
+             'Ó', 'Ô', 'Õ', 'Ö', '×', 'Ø', 'Ù', 'Ú', 'Û', 'Ü',
+             'Ý', 'Þ', 'ß',
+             'à', 'á', 'â', 'ã', 'ä', 'å', '¸', 'æ', 'ç', 'è',
+             'é', 'ê', 'ë', 'ì', 'í', 'î', 'ï', 'ð', 'ñ', 'ò',
+             'ó', 'ô', 'õ', 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü',
+             'ý', 'þ', 'ÿ'];
+  GOOD = RUSSIAN + ['a'..'z', 'A'..'Z', '0'..'9'];
+
 {$R *.dcr}
 
 procedure Register;
@@ -257,16 +268,6 @@ function CheckStringSubString(const EditText, S: String): boolean;
 end;
 
 function CheckStringWord({const} EditText, S: String): boolean;
-const
-  RUSSIAN = ['À', 'Á', 'Â', 'Ã', 'Ä', 'Å', '¨', 'Æ', 'Ç', 'È',
-             'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï', 'Ð', 'Ñ', 'Ò',
-             'Ó', 'Ô', 'Õ', 'Ö', '×', 'Ø', 'Ù', 'Ú', 'Û', 'Ü',
-             'Ý', 'Þ', 'ß',
-             'à', 'á', 'â', 'ã', 'ä', 'å', '¸', 'æ', 'ç', 'è',
-             'é', 'ê', 'ë', 'ì', 'í', 'î', 'ï', 'ð', 'ñ', 'ò',
-             'ó', 'ô', 'õ', 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü',
-             'ý', 'þ', 'ÿ'];
-  GOOD = RUSSIAN + ['a'..'z', 'A'..'Z', '0'..'9'];
 var
   i, j: integer;
   Ignore: boolean;
@@ -536,50 +537,79 @@ procedure TACComboBox.ParentFormWndProc(var Message: TMessage);
 // Â ïàðàìåòðå AText ïåðåäàåòñÿ ââåäåííûé â ïîëå ðåäàêòèðîâàíèÿ êîìáîáîêñà òåêñò.
 procedure TACComboBox.PrepareACStrings({const }AText: String);
 
-  function Search(q: String): TStrings;
+  function MatchesTerms(Query, S: String): boolean;
   var
-    FirstList: TStrings;
-    SecondList: TStrings;
     i: integer;
+    Start: integer;
   begin
-    FirstList := TStringList.Create();
-    SecondList := TStringList.Create();
-    try
-      for i := 0 to FACItems.Count - 1 do
+    Start := 0;
+    Query := AnsiUpperCase(Query);
+    S := AnsiUpperCase(S);
+
+    for i := 1 to Length(Query) do
+    begin
+      if (Query[i] in GOOD) then
       begin
-        if CheckStringWord(q, FACItems[i]) then
-          FirstList.AddObject(FACItems[i], TObject(i)) else
-        if CheckStringSubString(q, FACItems[i]) then
-          SecondList.AddObject(FACItems[i], TObject(i));
+        if (Start = 0) then
+        begin
+          Start := i;
+        end;
+      end else
+      begin
+        if (Start <> 0) then
+        begin
+          if (pos(Copy(Query, Start, i - Start), S) = 0) then
+          begin
+            Result := False;
+            Exit;
+          end;
+
+          Start := 0;
+        end;
       end;
+    end;
 
-      Result := TStringList.Create();
-      Result.AddStrings(FirstList);
-      Result.AddStrings(SecondList);
-    finally
-      FirstList.Free;
-      SecondList.Free;
+    if (Start <> 0) then
+    begin
+      i := Length(Query) + 1;
+      if (pos(Copy(Query, Start, i - Start), S) = 0) then
+      begin
+        Result := False;
+        Exit;
+      end;
+    end;
+
+    Result := True;
+  end;
+
+  function Search(Query: String): TStrings;
+  var
+    i: integer;
+  begin
+    Result := TStringList.Create();
+    for i := 0 to FACItems.Count - 1 do
+    begin
+      if (MatchesTerms(Query, FACItems[i])) then
+        Result.AddObject(FACItems[i], TObject(i));
     end;
   end;
 
 var
-  Buffer: TStrings;
+  FoundItems: TStrings;
 begin
   AText := Trim(AText);
 
+  FoundItems := Search(AText);
   try
-    Buffer := Search(AText);
-
-    if (Buffer.Count = 0) then
+    if (FoundItems.Count = 0) then
     begin
-      Buffer.Free();
-      Buffer := Search(SwitchLanguage(AText));
+      FoundItems.Free();
+      FoundItems := Search(SwitchLanguage(AText));
     end;
 
-    // copy items
-    FDropDown.Items.Assign(Buffer);
+    FDropDown.Items.Assign(FoundItems);
   finally
-    Buffer.Free();
+    FoundItems.Free();
   end;
 end;