Add more INF required units. Converted them all to be FPC compatible.

Signed-off-by: Graeme Geldenhuys <graeme@mastermaths.co.za>

8 files changed, 697 insertions, 2 deletions

diff --git a/src/CompareWordUnit.pas b/src/CompareWordUnit.pas
new file mode 100644
index 00000000..49c2ea26
--- /dev/null
+++ b/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.
diff --git a/src/DataTypes.pas b/src/DataTypes.pas
index be4de565..9c029193 100644
--- a/src/DataTypes.pas
+++ b/src/DataTypes.pas
@@ -18,6 +18,7 @@ type
   pInt16 = ^int16;
   pInt32 = ^int32;
   pInt8 = ^byte;
+  ULong = Cardinal;
 
   PCharArray = array[ 0..0 ] of PCHar;
   Int32Array = array[ 0..0 ] of Int32;
@@ -32,6 +33,9 @@ type
   TBooleanArray = array[ 0..0 ] of boolean;
   BooleanArrayPointer = ^TBooleanArray;
 
+  TProgressCallback = procedure(n, outof: integer; AMessage: string) of object;
+
+
 procedure FillInt32Array( pArray: Int32ArrayPointer;
                           Size: longint;
                           Value: Int32 );
diff --git a/src/SearchTable.pas b/src/SearchTable.pas
new file mode 100644
index 00000000..ffbd3ee9
--- /dev/null
+++ b/src/SearchTable.pas
@@ -0,0 +1,297 @@
+Unit SearchTable;
+
+{$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
+
+uses
+  Classes, DataTypes;
+
+// Code to read and use IPF search tables
+// NB The RLE decompression was arrived at by trial and error
+// it seems to be correct but it's difficult to test.
+
+type
+  TSearchTable = class
+  protected
+    _Data: pointer;
+    _Entries: TList; // pointers to panel flag records
+    _RecordLengthIs16Bit: boolean;
+    _DictionaryCount: longint;
+    _TopicCount: longint;
+
+    procedure ReadEntries;
+
+    Procedure Check1ByteOfFlags( b: byte;
+                                 StartingIndex: longint;
+                                 Results: Int32ArrayPointer );
+
+    procedure DoRLESearch( p: pbyte;
+                           pDataEnd: pointer;
+                           Results: Int32ArrayPointer );
+
+  public
+    constructor Create( Data: pointer;
+                        RecordLengthIs16Bit: boolean;
+                        DictionaryCount: longint;
+                        TopicCount: longint );
+    destructor Destroy; override;
+
+    procedure Search( DictIndex: int16;
+                      Results: Int32ArrayPointer );
+
+  end;
+
+Implementation
+
+constructor TSearchTable.Create( Data: pointer;
+                                 RecordLengthIs16Bit: boolean;
+                                 DictionaryCount: longint;
+                                 TopicCount: longint );
+begin
+  _Data := Data;
+  _RecordLengthIs16Bit :=
+    RecordLengthIs16Bit;
+  _Entries := TList.Create;
+  _DictionaryCount := DictionaryCount;
+  _TopicCount := TopicCount;
+  ReadEntries;
+end;
+
+destructor TSearchTable.Destroy;
+begin
+  _Entries.Destroy;
+end;
+
+procedure TSearchTable.ReadEntries;
+var
+  pWordRecord: pointer;
+  RecordLen: int16;
+  WordIndex: int16;
+begin
+  pWordRecord:= _Data;
+
+  for WordIndex:= 0 to _DictionaryCount - 1 do
+  begin
+    _Entries.Add( pWordRecord );
+
+    if _RecordLengthIs16Bit then
+      RecordLen:= pint16( pWordRecord )^
+    else // 8 bit
+      RecordLen:= pint8( pWordRecord )^;
+    inc( pWordRecord, RecordLen );
+  end;
+end;
+
+
+// Search table decompression
+
+// Looks through a single byte of 8 flags, given by b,
+// and updates topic entries within results for any flags
+// that are set.
+Procedure TSearchTable.Check1ByteOfFlags( b: byte;
+                                          StartingIndex: longint;
+                                          Results: Int32ArrayPointer );
+var
+  TopicIndex: longint;
+begin
+  TopicIndex:= StartingIndex;
+  while b > 0 do
+  begin
+    if b and $80 > 0 then
+      Results^[ TopicIndex ] := 1;
+    inc( TopicIndex );
+    b:= b shl 1;
+  end;
+end;
+
+// Decompress RLE compressed data starting at p,
+// running til pDataEnd. Update topic entries in Results.
+procedure TSearchTable.DoRLESearch( p: pbyte;
+                                    pDataEnd: pointer;
+                                    Results: Int32ArrayPointer );
+var
+  TopicIndex: integer;
+
+  N: integer;
+  thebyte: byte;
+  byte1, byte2: byte;
+begin
+  assert( pbyte( p )^ = 1, 'Unexpected RLE type' );
+  inc( p ); // skip header, always 1?
+
+  TopicIndex:= 0;
+
+  while p < pDataEnd do
+  begin
+    thebyte:= p^;
+    inc( p );
+
+    if thebyte = $80 then
+    begin
+      // escape
+      thebyte := p^;
+      inc( p );
+
+      if thebyte = 0 then
+      begin
+        // 16 bit repeat of zeroes??
+        N := pint16( p )^ + 1;
+        inc( p, 2 );
+        inc( TopicIndex, N );
+      end
+      else
+      begin
+        // n+1 repeats of next 2 bytes???
+        N := thebyte + 1;
+        byte1 := p^;
+        inc( p );
+        byte2 := p^;
+        inc( p );
+        while N > 0 do
+        begin
+          Check1ByteOfFlags( byte1,
+                             TopicIndex,
+                             Results );
+          inc( TopicIndex, 8 );
+          Check1ByteOfFlags( byte2,
+                             TopicIndex,
+                             Results );
+          inc( TopicIndex, 8 );
+          dec( N );
+        end;
+      end;
+    end
+    else
+    begin
+      N:= thebyte and $7f + 1;
+
+      if thebyte and $80 > 0 then
+      begin
+        // literal data
+        while N > 0 do
+        begin
+          Check1ByteOfFlags( p^,
+                             TopicIndex,
+                             Results );
+          inc( TopicIndex, 8 );
+          inc( p );
+          dec( N );
+        end;
+      end
+      else
+      begin
+        // repeat of next byte
+        thebyte := p^;
+        inc( p );
+        while N > 0 do
+        begin
+          Check1ByteOfFlags( thebyte,
+                             TopicIndex,
+                             Results );
+          inc( TopicIndex, 8 );
+          dec( N );
+        end;
+      end;
+    end;
+  end;
+end;
+
+// This function finds uses of the given word (DictIndex)
+// using the search table. Results[ topic ] is set to
+// non-zero for topics which contain the word.
+procedure TSearchTable.Search( DictIndex: int16;
+                               Results: Int32ArrayPointer );
+var
+  TopicIndex: integer;
+  pWordRecord: pointer;
+  RecordLen: int16;
+  CompressionCode: int8;
+  pData: pointer;
+  pDataEnd: pointer;
+  Flags: int8;
+begin
+  FillInt32Array( Results, _TopicCount, 0 );
+
+  pWordRecord:= _Entries[ DictIndex ];
+
+  // Check search table format
+  if _RecordLengthIs16Bit then
+  begin
+    RecordLen:= pint16( pWordRecord )^;
+    CompressionCode:= pint8( pWordRecord + 2 )^;
+    pData:= pWordRecord + 3;
+  end
+  else // 8 bit
+  begin
+    RecordLen:= pint8( pWordRecord )^;
+    CompressionCode:= pint8( pWordRecord + 1 )^;
+    pData:= pWordRecord + 2;
+  end;
+
+  // Decompress the search table for this word
+  pDataEnd:= pWordRecord + RecordLen;
+  case CompressionCode of
+    0: // word not used anywhere.
+      ;
+
+    1: // used in all panels
+      FillInt32Array( Results, _TopicCount, 1 );
+
+    2: // RLE
+      begin
+        DoRLESearch( pData,
+                     pDataEnd,
+                     Results );
+      end;
+
+    3: // list of topics containing word
+      while pData < pDataEnd do
+      begin
+        TopicIndex:= pint16( pData )^;
+        Results^[ TopicIndex ] := 1;
+        inc( pData, 2 );
+      end;
+
+    4: // list of topics NOT containing word
+    begin
+      FillInt32Array( Results, _TopicCount, 1 );
+
+      while pData < pDataEnd do
+      begin
+        TopicIndex:= pint16( pData )^;
+        Results^[ TopicIndex ] := 0;
+        inc( pData, 2 );
+      end;
+    end;
+
+    5, // compressed by truncating bit stream at last byte containing a set bit.
+    6: // same as above but starting at non-zero byte
+    begin
+      if CompressionCode = 5 then
+        TopicIndex:= 0
+      else
+      begin
+        TopicIndex:= pInt16( pData )^ * 8;
+        inc( pData, 2  );
+      end;
+
+      while pData < pDataEnd do
+      begin
+        Flags:= pInt8( pData )^;
+        Check1ByteOfFlags( Flags,
+                           TopicIndex,
+                           Results );
+        inc( TopicIndex, 8 );
+        inc( pData );
+      end;
+    end;
+  end;
+end;
+
+Initialization
+End.
diff --git a/src/TextSearchQuery.pas b/src/TextSearchQuery.pas
new file mode 100644
index 00000000..2a5697b5
--- /dev/null
+++ b/src/TextSearchQuery.pas
@@ -0,0 +1,118 @@
+Unit TextSearchQuery;
+
+{$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
+
+// Encapsulates a parsed search query.
+
+uses
+  Classes, SysUtils;
+
+Type
+  ESearchSyntaxError = class( Exception )
+  end;
+
+  TSearchTermCombineMethod = ( cmOr, cmAnd, cmNot );
+
+  TSearchTerm = class
+    Text: string;
+    CombineMethod: TSearchTermCombineMethod;
+  end;
+
+  TTextSearchQuery = class
+  protected
+    Terms: TList;
+    function GetTerm( Index: longint ): TSearchTerm;
+    function GetTermCount: longint;
+  public
+    constructor Create( SearchString: string );
+    destructor Destroy; override;
+
+    property Term[ Index: longint ]: TSearchTerm read GetTerm;
+    property TermCount: longint read GetTermCount;
+  end;
+
+Implementation
+
+uses
+  nvUtilities;
+//  ACLStringUtility, ACLUtility, Dialogs;
+
+constructor TTextSearchQuery.Create( SearchString: string );
+var
+  SearchWord: string;
+  RemainingSearchString: string;
+  CombineMethod: TSearchTermCombineMethod;
+  lTerm: TSearchTerm;
+begin
+  Terms := TList.Create;
+  try
+    RemainingSearchString := Uppercase( SearchString );
+    while RemainingSearchString <> '' do
+    begin
+      SearchWord := ExtractNextValue( RemainingSearchString, ' ' );
+
+      // Check for modifiers + (word must be matched)
+      // and - (word must not be matched)
+      case SearchWord[ 1 ] of
+       '+':
+         CombineMethod := cmAnd;
+       '-':
+         CombineMethod := cmNot;
+       else
+         CombineMethod := cmOr;
+      end;
+      if CombineMethod <> cmOr then
+      begin
+        // delete + or -
+        if Length( SearchWord ) = 1 then
+          raise ESearchSyntaxError.Create( 'No search word given after "'
+                                           + SearchWord + '" before "'
+                                           + RemainingSearchString
+                                           + '"' );
+        Delete( SearchWord, 1, 1 );
+      end;
+
+      lTerm := TSearchTerm.Create;
+      lTerm.Text := SearchWord;
+      lTerm.CombineMethod := CombineMethod;
+      Terms.Add( lTerm );
+    end;
+  except
+    Destroy; // clean up
+    raise; // reraise exception
+  end;
+end;
+
+destructor TTextSearchQuery.Destroy;
+var
+  i: TSearchTerm;
+begin
+  while Terms.Count > 0 do
+  begin
+    i := TSearchTerm(Terms.Last);
+    Terms.Remove(i);
+    i.Free;
+  end;
+
+//  DestroyListObjects( Terms );
+  Terms.Destroy;
+end;
+
+function TTextSearchQuery.GetTerm( index: longint ): TSearchTerm;
+begin
+  Result := TSearchTerm(Terms[ Index ]);
+end;
+
+function TTextSearchQuery.GetTermCount: longint;
+begin
+  Result := Terms.Count;
+end;
+
+Initialization
+End.
diff --git a/src/newview_fpgui.lpi b/src/newview_fpgui.lpi
index 0ddc6b4a..ae36a414 100644
--- a/src/newview_fpgui.lpi
+++ b/src/newview_fpgui.lpi
@@ -32,7 +32,7 @@
         <PackageName Value="fpgui_toolkit"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="7">
+    <Units Count="12">
       <Unit0>
         <Filename Value="newview_fpgui.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -68,6 +68,31 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="HelpTopic"/>
       </Unit6>
+      <Unit7>
+        <Filename Value="CompareWordUnit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="CompareWordUnit"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="SearchTable.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="SearchTable"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="TextSearchQuery.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TextSearchQuery"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="nvUtilities.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="nvUtilities"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="nvNullObjects.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="nvNullObjects"/>
+      </Unit11>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
diff --git a/src/newview_fpgui.lpr b/src/newview_fpgui.lpr
index 09dcd8e3..a1d891ea 100644
--- a/src/newview_fpgui.lpr
+++ b/src/newview_fpgui.lpr
@@ -7,7 +7,8 @@ uses
   cthreads,
   {$ENDIF}{$ENDIF}
   Classes, fpg_main, frm_main, DataTypes, HelpFileHeader, HelpWindow, IPFEscapeCodes,
-  HelpTopic;
+  HelpTopic, CompareWordUnit, SearchTable, TextSearchQuery, nvUtilities,
+  nvNullObjects;
 
 
 procedure MainProc;
diff --git a/src/nvNullObjects.pas b/src/nvNullObjects.pas
new file mode 100644
index 00000000..dbd0cbed
--- /dev/null
+++ b/src/nvNullObjects.pas
@@ -0,0 +1,67 @@
+unit nvNullObjects;
+
+{$mode objfpc}{$H+}
+
+// disable to remove debugging output
+{$Define DEBUG}
+
+interface
+
+uses
+  contnrs, SysUtils;
+
+type
+  EHelpBitmapException = class(Exception);
+
+  // forward declaration
+  THelpBitmap = class;
+
+
+  TImageList = class(TObjectList)
+  public
+    procedure Add(ABitmap: THelpBitmap; AParam2: TObject);
+  end;
+
+
+  THelpBitmap = class(TObject)
+  public
+    class function CreateFromHelpFile(AData: pointer): THelpBitmap;
+    procedure LoadFromResourceName(const AName: string);
+  end;
+
+
+procedure ProfileEvent(const AString: string);
+
+
+implementation
+
+
+procedure ProfileEvent(const AString: string);
+begin
+  {$IFDEF DEBUG}
+  writeln('DEBUG:  ', AString);
+  {$ENDIF}
+end;
+
+{ TImageList }
+
+procedure TImageList.Add(ABitmap: THelpBitmap; AParam2: TObject);
+begin
+  //
+end;
+
+{ THelpBitmap }
+
+class function THelpBitmap.CreateFromHelpFile(AData: pointer): THelpBitmap;
+begin
+  Result := nil;
+end;
+
+procedure THelpBitmap.LoadFromResourceName(const AName: string);
+begin
+  //
+end;
+
+
+end.
+
diff --git a/src/nvUtilities.pas b/src/nvUtilities.pas
new file mode 100644
index 00000000..db6e8f6c
--- /dev/null
+++ b/src/nvUtilities.pas
@@ -0,0 +1,76 @@
+unit nvUtilities;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+const
+ { TODO -oGraeme : Should this change to LineEnding (platfrom dependant) }
+  EndLine= chr(13)+chr(10);
+  TwoEndLines= chr(13)+chr(10)+chr(13)+chr(10);
+  Quote = '''';
+  DoubleQuote = '"';
+
+
+// Removes and returns the first value in a separated
+// value list (removes quotes if found)
+Function ExtractNextValue(
+          var S: string;
+          const Separator: string ): string;
+
+Function ExtractNextValueNoTrim(
+           var S: string;
+           const Separator: string ): string;
+
+// Alias method which is the same as Move() but with less confusing name
+procedure MemCopy(const src; var dest; size: SizeInt);
+
+
+implementation
+
+
+Function ExtractNextValue( var S: string;
+                           const Separator: string ): string;
+begin
+  Result := ExtractNextValueNoTrim( S, Separator );
+  Result := trim( Result );
+
+  // Remove quotes if present
+  if Result <> '' then
+    if Result[ 1 ] = DoubleQuote then
+      Delete( Result, 1, 1 );
+
+  if Result <> '' then
+    if Result[ length( Result ) ] = DoubleQuote then
+      Delete( Result, length( Result ), 1 );
+end;
+
+Function ExtractNextValueNoTrim( var S: string;
+                                 const Separator: string ): string;
+Var
+  SeparatorPos: integer;
+Begin
+  SeparatorPos := Pos( Separator, S );
+  if SeparatorPos > 0 then
+  begin
+    Result := Copy( S, 1, SeparatorPos-1 );
+    Delete( S, 1, SeparatorPos + length( Separator ) - 1 );
+  end
+  else
+  begin
+    Result := S;
+    S := '';
+  end;
+end;
+
+procedure MemCopy(const src; var dest; size: SizeInt);
+begin
+  Move(src, dest, size);
+end;
+
+
+end.
+