From 6c9bd169bdcab488387518eb071532f1e62c564a Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 29 Sep 2009 16:38:12 +0200 Subject: Add more INF required units. Converted them all to be FPC compatible. Signed-off-by: Graeme Geldenhuys --- src/CompareWordUnit.pas | 107 +++++++++++++++++ src/DataTypes.pas | 4 + src/SearchTable.pas | 297 ++++++++++++++++++++++++++++++++++++++++++++++++ src/TextSearchQuery.pas | 118 +++++++++++++++++++ src/newview_fpgui.lpi | 27 ++++- src/newview_fpgui.lpr | 3 +- src/nvNullObjects.pas | 67 +++++++++++ src/nvUtilities.pas | 76 +++++++++++++ 8 files changed, 697 insertions(+), 2 deletions(-) create mode 100644 src/CompareWordUnit.pas create mode 100644 src/SearchTable.pas create mode 100644 src/TextSearchQuery.pas create mode 100644 src/nvNullObjects.pas create mode 100644 src/nvUtilities.pas (limited to 'src') 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 @@ - + @@ -68,6 +68,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + 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. + -- cgit v1.2.3-70-g09d2