Merge branch 'master' of ssh://fpgui.git.sourceforge.net/gitroot/fpgui/fpgui

1 files changed, 107 insertions, 0 deletions

diff --git a/docview/src/CompareWordUnit.pas b/docview/src/CompareWordUnit.pas
new file mode 100644
index 00000000..49c2ea26
--- /dev/null
+++ b/docview/src/CompareWordUnit.pas
@@ -0,0 +1,107 @@
+Unit CompareWordUnit;
+
+{$mode objfpc}{$H+}
+
+// NewView - a new OS/2 Help Viewer
+// Copyright 2001 Aaron Lawrence (aaronl at consultant dot com)
+// This software is released under the Gnu Public License - see readme.txt
+
+Interface
+
+// Compares words and produces a match level (relevance) based
+// on the relative sizes etc. Used in searching help files
+// to sort by relevance.
+
+const
+  // word weightings
+  mwExactWord = 20;
+  mwWordStart = 10;
+  mwWordWithin = 5;
+
+// Compares the given search word against the given
+// reference word. Returns a value indicating how well the
+// search word matches, 0 = not at all.
+function CompareWord( const SearchWord: string;
+                      const ReferenceWord: string ): longint;
+
+Implementation
+
+uses
+  SysUtils;
+
+// LOoks for string a within string b, case insensitively
+function CaseInsensitivePos( const a, b: string ): longint;
+begin
+  // Budget implementation to begin with.
+  Result := Pos( UpperCase( a ), UpperCase( b ) );
+end;
+
+function CompareWord( const SearchWord: string;
+                      const ReferenceWord: string ): longint;
+var
+  OccurrencePos: longint;
+begin
+  Result := 0;
+  // First up, if the word we're searching for is longer than
+  // this word, then it can't match at all.
+  if Length( SearchWord ) > Length( ReferenceWord ) then
+    exit;
+
+  OccurrencePos := CaseInsensitivePos( SearchWord, ReferenceWord );
+  if OccurrencePos = 0 then
+    // no match.
+    exit;
+
+  if Length( SearchWord ) = Length( ReferenceWord ) then
+  begin
+    // exact word match (except case)
+    Result := mwExactWord;
+    exit;
+  end;
+
+  // partial word match
+  if OccurrencePos = 1 then
+  begin
+    // word starts with searchword
+    Result := mwWordStart
+              * Length( SearchWord )
+              div Length( ReferenceWord );
+    if Result = 0 then
+      Result := 1;
+    exit;
+  end;
+
+  // Matched searchword somewhere within word
+  Result := mwWordWithin
+            * Length( SearchWord )
+            div Length( ReferenceWord );
+  if Result = 0 then
+    Result := 1;
+
+end;
+
+{// Note: searchstring must be uppercase,
+function IsMatching( const SearchString: string;
+                     const SearchType: TSearchType;
+                     const Item: string ): boolean;
+var
+  temp: string;
+begin
+  case SearchType of
+    stStarts:
+       Result:= StrStarts( SearchString, Item );
+
+    stContains:
+    begin
+      temp:= UpperCase( Item );
+      Result:= Pos( SearchString, temp ) <> 0;
+    end;
+
+    stMatches:
+      Result:= CompareText( SearchString,
+                            Item )= 0;
+  end;
+end;
+}
+Initialization
+End.