From f9a6a96333c06f7314d01aab9b8dc447f4c491a3 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 15 Oct 2009 17:01:44 +0200 Subject: Update HelpFile unit to latest NewView sources. * Update HelpFile unit. * Fixed code formatting * Code compatibility changes in SearchUnit.pas Signed-off-by: Graeme Geldenhuys --- src/HelpFile.pas | 1197 ++++++++++++++++++++++++++++++++++++++++++++-------- src/HelpTopic.pas | 24 +- src/SearchUnit.pas | 61 ++- 3 files changed, 1064 insertions(+), 218 deletions(-) diff --git a/src/HelpFile.pas b/src/HelpFile.pas index 9766f99b..4a643b95 100644 --- a/src/HelpFile.pas +++ b/src/HelpFile.pas @@ -3,7 +3,7 @@ Unit HelpFile; {$mode objfpc}{$H+} // NewView - a new OS/2 Help Viewer -// Copyright 2001 Aaron Lawrence (aaronl at consultant dot com) +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) // This software is released under the Gnu Public License - see readme.txt Interface @@ -11,41 +11,97 @@ Interface // Encapsulates the basic reading of a help file's structure. uses - Classes, SysUtils, - IPFFileFormatUnit, - HelpTopic, -// HelpBitmap, - TextSearchQuery, SearchTable, CompareWordUnit, - // this unit is used to fake image support untill fpGUI has this implemented. - nvNullObjects; - + Classes + ,SysUtils + ,IPFFileFormatUnit + ,HelpTopic +// ,HelpBitmap + ,SearchTable + ,nvNullObjects // Fake various classes like TImageList + ; type + + TIndexEntry = class(TObject) + private + name: String; + topic: TTopic; + flags: uint8; + public + CONSTRUCTOR Create(aName: String; aTopic: TTopic; aFlags: uint8); + DESTRUCTOR Destroy; override; + PROPERTY getTopic: TTopic read topic; + FUNCTION getLabel: String; + FUNCTION isGlobal: boolean; + FUNCTION getLevel: integer; + end; + + + TIndex = class(TObject) + private + entries: TStringList; + public + CONSTRUCTOR Create; + DESTRUCTOR Destroy; override; + FUNCTION Count: longint; + FUNCTION GetLabels: TStringList; + FUNCTION GetTopic(aPos: longint): TTopic; + PROCEDURE Add(anIndexEntry: TIndexEntry); + end; + + THelpFile = class(TObject) protected - _Data: pointer; - _DataLen: longint; + _Filename : string; + _FileSize : longint; + _Handle: TFileStream; + _pSlotData: pUInt16; _SlotDataSize: longint; - _FileName: string; + _Title: string; - _Header: THelpFileHeader; - _Topics: TList; // of TTopic - _Dictionary: TStringList; - _SlotOffsets: UInt32ArrayPointer; - _Index: TStringList; + + _Topics: TList; // of TTopics + + _Dictionary: TStringList; // pointers to strings. + + _Index: TIndex; + _SearchTable: TSearchTable; + _ReferencedFiles: TStringList; + + _FontTable: TList; + + _pHeader: TPHelpFileHeader; + _pExtendedHeader: TPExtendedHelpFileHeader; + _pContentsData: pointer; + _pResourceData: pointer; + _pSearchData: pointer; + _pHighlightWords: UInt32ArrayPointer; + _pSlotOffsets: Uint32ArrayPointer; + _pDictionaryData: pointer; + _pFontTableData: pointer; + _pTopicNameData: pointer; + _pTopicGlobalNamesData: pointer; + procedure InitMembers; - procedure ReadFile(const AFilename: string ); + procedure Open; + procedure Close; + procedure ReadFileBlock( Var Dest: pointer; + const StartPosition: LongWord; + const Length: LongWord); procedure ReadHeader; procedure ReadContents; procedure ReadDictionary; + procedure ReadSearchTable; procedure ReadIndex; - procedure ReadFontTable; + procedure ReadReferencedFilesTable; + procedure ReadFontTableData; + procedure ParseFontTable; function GetTopic( Index: longint ): TTopic; function GetTopicCount: longint; @@ -53,43 +109,235 @@ type function GetDictionaryCount: longint; function GetDictionaryWord( Index: longint ): string; + function GetHighlightWords: UInt32ArrayPointer; + + function GetSearchTable: TSearchTable; + + // Lookup global or local panel name list + function FindTopicByName( const Name: string; + Var pData: pointer; + Count: longint; + Offset: longint ): TTopic; + public - HighlightWords: UInt32ArrayPointer; - constructor Create( const FileName: string; - UpdateProgress: TProgressCallback ); + constructor Create( const aFileName: string ); destructor Destroy; override; + function GetIndex: TIndex; + property Title: string read _Title; property Topics[ Index: longint ]: TTopic read GetTopic; + property TopicList: TList read _Topics; property TopicCount: longint read GetTopicCount; - property Index: TStringList read _Index; + property Index: TIndex read GetIndex; property Filename: string read _FileName; + property ReferencedFiles: TStringList read _ReferencedFiles; + procedure GetImages( ImageOffsets: TList; Images: TImageList ); + function GetImage( ImageOffset: longint ): THelpBitmap; + property DictionaryCount: longint read GetDictionaryCount; property DictionaryWords[ Index: longint ]: string read GetDictionaryWord; function IndexOfTopic( Topic: TTopic ): longint; - property SearchTable: TSearchTable read _SearchTable; + property SearchTable: TSearchTable read GetSearchTable; + + function FindTopicByResourceID( ID: uint16 ): TTopic; + + function FindTopicByLocalName( const Name: string ): TTopic; + function FindTopicByGlobalName( const Name: string ): TTopic; + + function FindTopicByTitleStartsWith( const SearchText: string ): TTopic; + function FindTopicByTitleContains( const SearchText: string ): TTopic; + + function FindTopicByIndexStartsWith( const SearchText: string ): TTopic; + function FindTopicByIndexContains( const SearchText: string ): TTopic; + + procedure FindResourceIDsForTopic( Topic: TTopic; + ResourceIDs: TList ); + + property HighlightWords: UInt32ArrayPointer read GetHighlightWords; + + property FileSize: longint read _FileSize; + + procedure SetupFontSubstitutes( Substitutions: string ); + public + NotesLoaded: boolean; // used externally + end; // Returns helpfile that the given topic is within Function TopicFile( Topic: TTopic ): THelpFile; +function GetHelpFileTitle( const Filename: string ): string; Implementation uses - //ACLFileUtility, ACLStringUtility, ACLFileIOUtility, ACLProfile, - //ACLPCharUtility, ACLDialogs, - HelpWindowDimensions, nvUtilities; +// BseErr, +// StringUtilsUnit, +// CharUtilsUnit, +// DebugUnit, +// ACLFileIOUtility, +// ACLLanguageUnit; + nvUtilities + ,ACLStringUtility + ; // Load "missing" bitmap -//{.$R Images} +{ TODO -oGraeme -cbitmap : Create and load a "missing image" image } +{.$R Images} + +const + FileErrorNotFound = 'File not found '; + FileErrorAccessDenied = 'File access denied'; + FileErrorInUse = 'File in use'; + FileErrorInvalidHeader = 'Invalid file header'; + + + // ----------- + // TIndexEntry + // ----------- + + CONSTRUCTOR TIndexEntry.Create(aName: String; aTopic: TTopic; aFlags: uint8); + begin + LogEvent(LogObjConstDest, 'TIndexEntry.Create'); + name := aName; + topic := aTopic; + flags := aFlags; + end; + + + DESTRUCTOR TIndexEntry.Destroy; + begin + LogEvent(LogObjConstDest, 'TIndexEntry.Destroy'); + topic := nil; + // inherited Destroy; + end; + + + FUNCTION TIndexEntry.getLabel: String; + begin + result := name; + + // index level check (level 1 or 2) + if (getLevel) > 1 then + begin + result := '- ' + result; + end; + + if isGlobal then + begin + result := result + ' (g)'; + end; + end; + + + FUNCTION TIndexEntry.isGlobal: boolean; + begin + result := (flags and 64) > 0 + end; + + + FUNCTION TIndexEntry.getLevel: integer; + begin + result := 1; + + // index level check (level 1 or 2) + if (flags and 2 ) > 0 then + begin + result := 2; + end; + end; + + + + + // ----------- + // TIndex + // ----------- + CONSTRUCTOR TIndex.Create; + begin + inherited Create; + + entries := TStringList.Create; + // labels := nil; // lazy + end; + + + DESTRUCTOR TIndex.Destroy; + var + i : longint; + tmpEntry : TIndexEntry; + begin + LogEvent(LogObjConstDest, 'TIndex.Destroy (size:' + IntToStr(entries.Count) + ')'); + + for i := 0 to entries.Count - 1 do + begin + tmpEntry := TIndexEntry(entries.Objects[i]); + if tmpEntry <> nil then + begin + tmpEntry.Free; + entries.Objects[i] := nil; + end; + end; + entries.Free; + + inherited Destroy; + end; + + + FUNCTION TIndex.Count: longint; + begin + result := entries.Count; + end; + + + FUNCTION TIndex.GetLabels: TStringList; + begin + result := entries; + end; + + + FUNCTION TIndex.GetTopic(aPos: longint): TTopic; + begin + result := TIndexEntry(entries.Objects[aPos]).getTopic; + end; + + + PROCEDURE TIndex.add(anIndexEntry: TIndexEntry); + begin + // LogEvent(LogDebug, 'TIndex.add(' + aName + ', ' + anIndexEntry.ClassName); + entries.AddObject(anIndexEntry.getLabel, anIndexEntry); + end; + + + + +//Procedure OnLanguageEvent( Language: TLanguageFile; +// const Apply: boolean ); +//var +// tmpPrefix : String; +//begin +// tmpPrefix := 'HelpFile' + LANGUAGE_LABEL_DELIMITER; +// +// Language.LL( Apply, FileErrorNotFound, tmpPrefix + 'FileErrorNotFound', 'File not found' ); +// Language.LL( Apply, FileErrorAccessDenied, tmpPrefix + 'FileErrorAccessDenied', 'Access denied' ); +// Language.LL( Apply, FileErrorInUse, tmpPrefix + 'FileErrorInUse', 'File in use by another program' ); +// Language.LL( Apply, +// FileErrorInvalidHeader, +// tmpPrefix + 'FileErrorInvalidHeader', +// 'File doesn''t appear to be an OS/2 Help document (header ID not correct)' ); +// Language.LL( Apply, +// ErrorCorruptHelpFile, +// tmpPrefix + 'ErrorCorruptHelpFile', +// 'File is corrupt' ); +//end; Function TopicFile( Topic: TTopic ): THelpFile; Begin @@ -98,121 +346,169 @@ end; procedure THelpFile.InitMembers; begin - _pSlotData := nil; _SlotDataSize := 0; + _pHeader := nil; + _pExtendedHeader := nil; + _pContentsData := nil; + _pSlotOffsets := nil; + _pResourceData := nil; + _pSearchData := nil; + _pDictionaryData := nil; +// _pIndexData := nil; + _pFontTableData := nil; + + _pHighlightWords := nil; + _Dictionary:= TStringList.Create; - _Topics:= TList.Create; - _Index:= TStringList.Create; + _Topics := TList.Create; +// _Index := TStringList.Create; + _ReferencedFiles := TStringList.Create; + _FontTable := TList.Create; + + NotesLoaded := false; end; -procedure THelpFile.ReadFile(const AFilename: string ); -var - AFile: File of char; + +constructor THelpFile.Create(const aFileName: string); begin - _FileName:= AFilename; - if not FileExists( AFilename ) then - raise EHelpFileException.CreateFmt('File <%s> not found', [AFilename]); + LogEvent(LogObjConstDest, 'THelpFile.Create (file:' + aFileName + ')'); + LogEvent(LogParse, 'Helpfile Load: ' + aFileName); - AssignFile(AFile, Filename); - try - FileMode := fmOpenRead; // read-only - {$i-} - Reset(AFile); - {$i+} - if IOResult <> 0 then - begin - case IOResult of - 2: raise EHelpFileException.Create( 'File not found' ); - 5: raise EHelpFileException.Create( 'Access denied' ); - else - raise EHelpFileException.CreateFmt( 'File open error. IO Error is <%d>', [IOResult] ); - end; - end; + _FileName := aFileName; - _DataLen := FileSize(AFile); // in bytes - _Data := nil; - GetMem( _Data, _DataLen ); // allocate enough memory - BlockRead(AFile, _Data^, _DataLen); - finally - CloseFile(AFile); + InitMembers; + + Open; + + // we always need these basics: + try + ReadHeader; + ReadContents; + ReadDictionary; + ReadFontTableData; + ParseFontTable; + ReadReferencedFilesTable; + except + Close; + raise; end; + + // the rest is loaded on demand end; -procedure THelpFile.ReadHeader; + +destructor THelpFile.Destroy; begin -ProfileEvent('THelpFile.ReadHeader >>>>'); - Move(_Data^, _Header, SizeOf(_Header)); -ProfileEvent('title=' + _Header.title); + LogEvent(LogObjConstDest, 'THelpFile.Destroy'); + Dispose( _pHeader ); + Dispose( _pExtendedHeader ); + FreeMem( _pContentsData ); + FreeMem( _pSlotOffsets ); + FreeMem( _pResourceData ); + FreeMem( _pSearchData ); + FreeMem( _pDictionaryData ); +// DeallocateMemory( _pIndexData ); + FreeMem( _pFontTableData ); + + FreeMem( _pHighlightWords ); + + // index entries are pointing to topics + // so let us clean them first + if Assigned( _Index ) then + _Index.Free; + + if Assigned( _Topics ) then + DestroyListAndObjects( _Topics ); - if _Header.ID <> $5348 then // 'HS' - raise EHelpFileException.Create( 'File doesn''t appear to be an OS/2 Help document (header ID not correct)' ); + _Dictionary.Free; + _SearchTable.Free; + _ReferencedFiles.Free; + _FontTable.Free; - _Title := _Header.Title; -ProfileEvent('THelpFile.ReadHeader <<<<<'); + _Handle.Free; end; -constructor THelpFile.Create( const FileName: string; - UpdateProgress: TProgressCallback ); -var - SearchTableOffset: longint; - SearchTableRecordLengthIs16Bit: boolean; +procedure THelpFile.Open; begin - ProfileEvent( 'Helpfile Load: ' + FileName ); - - InitMembers; + if not FileExists( _Filename ) then + raise EHelpFileException.Create( FileErrorNotFound ); - UpdateProgress( 1, 100, 'Reading file' ); - - ReadFile( FileName ); + try + _Handle := TFileStream.Create(_FileName, fmOpenRead); - UpdateProgress( 20, 100, 'Interpreting file' ); + except + on E: Exception do + raise EHelpFileException.Create(E.Message); + end; + //case rc of + // ERROR_FILE_NOT_FOUND: // crap, this doesn't actually occur! + // raise EHelpFileException.Create( FileErrorNotFound ); + // + // ERROR_ACCESS_DENIED: + // raise EHelpFileException.Create( FileErrorAccessDenied ); + // + // ERROR_SHARING_VIOLATION: + // raise EHelpFileException.Create( FileErrorInUse ); + // + // else + // raise EHelpFileException.Create( SysErrorMessage( rc ) ); + //end; + + _FileSize := GetFileSize(_Filename); +end; - ProfileEvent( 'Read header' ); - ReadHeader; +procedure THelpFile.Close; +begin + _Handle.Free; + _Handle := nil; +end; - UpdateProgress( 40, 100, 'Reading contents' ); - ProfileEvent( 'Read contents' ); - ReadContents; +procedure THelpFile.ReadFileBlock(var Dest: pointer; + const StartPosition: LongWord; const Length: LongWord); +var + bytes: LongWord; +begin + if Length = 0 then + exit; // nothing to read - go home! - UpdateProgress( 60, 100, 'Reading dictionary' ); - ProfileEvent( 'Read dictionary' ); - ReadDictionary; + _Handle.Seek(StartPosition, soBeginning); - UpdateProgress( 80, 100, 'Reading index' ); - ProfileEvent( 'Read index' ); - ReadIndex; + // we allocate early so this should never happen + if Dest = nil then + Dest := GetMem(Length); - UpdateProgress( 90, 100, 'Reading search table' ); - ProfileEvent( 'Read search table' ); - SearchTableOffset := _Header.SearchStart and $7fffffff; - SearchTableRecordLengthIs16Bit := _Header.SearchStart and $80000000 > 0; - _SearchTable := TSearchTable.Create( _Data + SearchTableOffset, - SearchTableRecordLengthIs16Bit, - _Dictionary.Count, - _Topics.Count ); + bytes := _Handle.Read(Dest^, Length); + if bytes <> Length then + raise EHelpFileException.Create(ErrorCorruptHelpFile); +end; - UpdateProgress( 100, 100, 'Done' ); +procedure THelpFile.ReadHeader; +begin + LogEvent(LogParse, 'Read header'); + New(_pHeader); + ReadFileBlock( _pHeader, + 0, + sizeof( THelpFileHeader ) ); + if _pHeader^.ID <> INF_HEADER_ID then + begin + // not an OS/2 help file. + if _pHeader^.ID = $5f3f then + raise EWindowsHelpFormatException.Create( 'Win16' ); - GetMem( HighlightWords, - _Dictionary.Count * sizeof( longint ) ); + raise EHelpFileException.Create( FileErrorInvalidHeader ); + end; -end; + _Title := _pHeader^.Title; -destructor THelpFile.Destroy; -var - TopicIndex: longint; -begin -writeln('DEBUG: THelpFile.Destroy >>>>'); - FreeMem( HighlightWords, _Dictionary.Count * sizeof( longint ) ); - FreeMem( _Data, _DataLen ); - for TopicIndex:= 0 to _Topics.Count - 1 do - TTopic( _Topics[ TopicIndex ] ).Destroy; - _Topics.Free; - _Index.Free; - _Dictionary.Free; - _SearchTable.Free; -writeln('DEBUG: THelpFile.Destroy <<<<<'); + if _pHeader^.extstart > 0 then + begin + New(_pExtendedHeader); + // read extended header + ReadFileBlock( _pExtendedHeader, + _pHeader^.extstart, + sizeof( _pExtendedHeader^ ) ); + end; end; procedure THelpFile.ReadContents; @@ -220,98 +516,529 @@ var Topic: TTopic; EntryIndex: longint; pEntry: pTTOCEntryStart; - tocarray: ^UInt32; + pEnd: pbyte; + tocarray: UInt32ArrayPointer; + pData: Pointer; p: PByte; begin - _Topics.Capacity := _Header.ntoc; - p := _Data + _Header.tocoffsetsstart; - Move(p, tocarray, SizeOf(tocarray)); - for EntryIndex := 0 to _Header.ntoc-1 do + LogEvent(LogParse, 'Read contents'); + + if _pHeader^.ntoc = 0 then + exit; // explicit check required since ntoc is unsigned + + // Presize the topics list to save reallocation time + _Topics.Capacity := _pHeader^.ntoc; + + // read toc offsets array + //ReadFileBlock( tocarray, + // _pHeader^.tocoffsetsstart, + // _pHeader^.ntoc * SizeOf(uint32) ); + + // read slots first so that Topics can refer to it. + ReadFileBlock( _pSlotOffsets, + _pHeader^.slotsstart, + _pHeader^.nslots * sizeof( uint32 ) ); + + ReadFileBlock( _pContentsData, + _pHeader^.tocstart, + _pHeader^.toclen ); + + pEntry := _pContentsData; + pEnd := _pContentsData + _pHeader^.toclen; + p := PByte(pEntry); + + for EntryIndex := 0 to _pHeader^.ntoc - 1 do begin - pEntry := _Data + tocarray[EntryIndex]; - Topic := TTopic.Create(_Data, - _Header, - _Dictionary, - pEntry ); +// pEntry := _Handle.Seek(tocarray[EntryIndex], soBeginning); +// pEntry := tocarray[EntryIndex]; + if p >= pEnd then + // runs off end of data! + raise EHelpFileException.Create( ErrorCorruptHelpFile ); + + Topic := TTopic.Create( _Handle, + _pSlotOffsets, + _Dictionary, + pEntry, + _FontTable, + _ReferencedFiles ); + Topic.HelpFile := Self; Topic.Index := EntryIndex; - _Topics.Add(Topic); + + _Topics.Add( Topic ); + p := PByte(pEntry); + inc(p, pEntry^.Length); + pEntry := pTTOCentryStart(p); end; end; procedure THelpFile.ReadDictionary; var i: longint; + Len: uint8; p: pbyte; - c: array[0..255] of char; - b: byte; + pEnd: pbyte; s: string; + c: array[0..255] of char; +begin + LogEvent(LogParse, 'Read dictionary'); + + if _pHeader^.ndict = 0 then + exit; // explicit check required since ndict is unsigned + + ReadFileBlock( _pDictionaryData, + _pHeader^.dictstart, + _pHeader^.dictlen ); + + P := _pDictionaryData; + pEnd := _pDictionaryData + _pHeader^.dictlen; + + // Presize the dictionary to save reallocation + _Dictionary.Capacity := _pHeader^.ndict; + for i := 0 to _pHeader^.ndict - 1 do + begin + // adjust length so we can use as a Pascal string + // (file uses length including length byte, + // Pascal string have length excluding length byte) + if p >= pEnd then + // ran off end of data + raise EHelpFileException.Create( ErrorCorruptHelpFile ); + + + FillChar(c, sizeof(c), 0); // fill string with NUL chars + Len := p^ - 1; // read string length value (corrected length) + Inc(p, sizeof(byte)); // move pointer + Move(p^, c, Len); // read string of dictionary + s := c; // convert PChar to String type + + _Dictionary.Add( s ); + Inc(p, Len); // move pointer to next item + end; +end; + + +function THelpFile.GetIndex: TIndex; begin - p := _Data + _Header.dictstart; // set starting position - for i := 0 to _header.ndict-1 do + if _Index = nil then begin - FillChar(c, sizeof(c),0); // fill string with NUL chars - Move(p^, b, sizeof(b)); // read string length value - Inc(p, sizeof(b)); // move pointer - Move(p^, c, b-1); // read string of dictionary - Inc(p, b-1); // move pointer - s := c; - _Dictionary.Add(s); + ReadIndex; end; + Result := _Index; end; type - TIndexEntryHeader = packed record + TIndexEntryHeader = record TextLength: uint8; Flags: uint8; NumberOfRoots: uint8; TOCIndex: uint16; end; - procedure THelpFile.ReadIndex; var - IndexIndex: longint; + IndexIndex: longint; // I can't resist :-) pEntryHeader: ^TIndexEntryHeader; EntryText: string; - IndexTitleLen: byte; + IndexTitleLen: longint; p: pointer; - iword: array[0..255] of char; + pEnd: pointer; + pIndexData: pointer; + + tmpIndexEntry: TIndexEntry; begin - p := _Data + _Header.indexstart; - ProfileEvent('Number of indexes = ' + IntToStr(_Header.nindex)); - for IndexIndex:= 0 to longint( _Header.nindex ) - 1 do + LogEvent(LogParse, 'Read index'); + + _Index := TIndex.Create; + + if _pHeader^.nindex = 0 then + exit; // explicit check required since ndict is unsigned + + pIndexData := nil; + ReadFileBlock( pIndexData, + _pHeader^.indexstart, + _pHeader^.indexlen ); + + P := pIndexData; + pEnd := pIndexData + _pHeader^.indexlen; + + for IndexIndex := 0 to _pHeader^.nindex - 1 do begin + if p >= pEnd then + // ran off end of data + raise EHelpFileException.Create( ErrorCorruptHelpFile ); + pEntryHeader := p; - IndexTitleLen:= pEntryHeader^.TextLength; + IndexTitleLen := pEntryHeader^.TextLength; inc( p, sizeof( TIndexEntryHeader ) ); - FillChar(iword, Length(iword), 0); - Move(p^, iword, IndexTitleLen); - EntryText := iword; + EntryText := ''; - if ( pEntryHeader^.flags and 2 ) > 0 then - EntryText:= '- ' + EntryText; if pEntryHeader^.TOCIndex < _Topics.Count then - _Index.AddObject( EntryText, TTopic(_Topics[ pEntryHeader^.TOCIndex ]) ) + begin + tmpIndexEntry := TIndexEntry.Create(EntryText, TTopic(_Topics[pEntryHeader^.TOCIndex]), pEntryHeader^.flags); + _Index.Add(tmpIndexEntry); + end else - //raise EHelpFileException.Create( 'Error reading help file index - out of range topic reference' ); +// raise EHelpFileException.Create( 'Error reading help file index - out of range topic reference' ); ; // pass! something special - inc( p, IndexTitleLen + pEntryHeader^.NumberOfRoots ); // skip 'roots' for index search + + inc( p, IndexTitleLen + + pEntryHeader^.NumberOfRoots + * sizeof( uint32 ) ); // skip 'roots' for index search end; + + FreeMem( pIndexData ); end; -type - HelpFontSpec = class - FaceName: array[ 0..32 ] of char; - Height: uint16; - Width: uint16; - Codepage: uint16; +function THelpFile.GetSearchTable: TSearchTable; +begin + if _SearchTable = nil then + ReadSearchTable; + Result := _SearchTable; +end; + +procedure THelpFile.ReadSearchTable; +var + SearchTableOffset: longint; + SearchTableRecordLengthIs16Bit: boolean; +begin + LogEvent(LogParse, 'Read search table'); + + if _pHeader^.SearchLen = 0 then + begin + LogEvent(LogParse, 'Read search table (len = 0'); + exit; + end; + + SearchTableOffset := _pHeader^.SearchStart and $7fffffff; + SearchTableRecordLengthIs16Bit := _pHeader^.SearchStart and $80000000 > 0; + ReadFileBlock( _pSearchData, + SearchTableOffset, + _pHeader^.SearchLen ); + + _SearchTable := TSearchTable.Create( _pSearchData, + SearchTableRecordLengthIs16Bit, + _Dictionary.Count, + _Topics.Count ); +end; + +function THelpFile.GetHighlightWords: UInt32ArrayPointer; +begin + if _pHighlightWords = nil then + _pHighlightWords := GetMem( _Dictionary.Count * sizeof( UInt32 ) ); + Result := _pHighlightWords; +end; + +function THelpFile.FindTopicByResourceID( ID: uint16 ): TTopic; +var + i: longint; + pResourceIDs: UInt16ArrayPointer; + pTopicIndices: UInt16ArrayPointer; + FileResourceID: uint16; + TopicIndex: uint16; +begin + Result := nil; + + if _pHeader^.nres = 0 then + // since nres is unsigned + exit; + + if _pResourceData = nil then + ReadFileBlock( _pResourceData, + _pHeader^.resstart, + _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics + + pResourceIDs := _pResourceData; + pTopicIndices := _pResourceData + + _pHeader^.nres * sizeof( uint16 ); + + for i := 0 to _pHeader^.nres - 1 do + begin + FileResourceID := pResourceIDs^[ i ]; + if FileResourceID = ID then + begin + // found + TopicIndex := pTopicIndices^[ i ]; + Result := TTopic(_Topics[ TopicIndex ]); + exit; + end; + end; +end; + +// Look up a local "panel name" and return associated topic, if any. +function THelpFile.FindTopicByLocalName( const Name: string ): TTopic; +begin + Result := FindTopicByName( Name, + _pTopicNameData, + _pHeader^.nname, + _pHeader^.namestart ); +end; + +function THelpFile.FindTopicByGlobalName( const Name: string ): TTopic; +begin + Result := nil; + + if _pExtendedHeader = nil then + // no extended header - no global list to lookup + exit; + + Result := FindTopicByName( Name, + _pTopicGlobalNamesData, + _pExtendedHeader ^. EntryInGNameTable, + _pExtendedHeader ^. HelpPanelGNameTblOffset ); + +end; + +// The text of the names are stored in the (global) dictionary +// with a table referencing them. +// We could use a binary search here... but whatever... +function THelpFile.FindTopicByName( const Name: string; + Var pData: pointer; + Count: longint; + Offset: longint ): TTopic; +var + i: longint; + pNameTable: UInt16ArrayPointer; + pTopicIndices: UInt16ArrayPointer; + TopicIndex: uint16; + + TopicNameWordIndex: uint16; + TopicName: string; +begin + Result := nil; + + if Count = 0 then + // since it's unsigned + exit; + + if pData = nil then + ReadFileBlock( pData, + Offset, + Count * sizeof( uint16 ) * 2 ); // list of name words, list of topics + + // get pointers to the two parts of the table + pNameTable := pData; + pTopicIndices := pData + + Count * sizeof( uint16 ); + + for i := 0 to Count - 1 do + begin + TopicNameWordIndex := pNameTable^[ i ]; + TopicName := DictionaryWords[ TopicNameWordIndex ]; + + if CompareText( TopicName, Name ) = 0 then + begin + // found + TopicIndex := pTopicIndices^[ i ]; + Result := TTopic(_Topics[ TopicIndex ]); + exit; + end; + end; +end; + + +// TODO move to index class +function THelpFile.FindTopicByIndexStartsWith( const SearchText: string ): TTopic; +var + i: longint; + tmpLabel: String; +begin + result := nil; + GetIndex; // make sure it's read + + for i := 0 to _Index.Count - 1 do + begin + tmpLabel := _Index.GetLabels[i]; + if SameText(tmpLabel, SearchText) then + begin + // found + result := Index.getTopic(i); + exit; + end; + end; +end; + + +function THelpFile.FindTopicByIndexContains(const SearchText: string): TTopic; +var + i: longint; + tmpLabel: String; +begin + result := nil; + GetIndex; // make sure it's read + + for i := 0 to _Index.Count - 1 do + begin + tmpLabel := _Index.GetLabels[i]; + if Pos(UpperCase(SearchText), UpperCase(tmpLabel)) > 0 then + begin + // found + result := Index.getTopic(i); + exit; + end; + end; +end; + + +function THelpFile.FindTopicByTitleStartsWith( const SearchText: string ): TTopic; +var + i: longint; + tmpTopic: TTopic; + tmpLevel : integer; + tmpMore : boolean; +begin + result := nil; + + tmpLevel := 0; + repeat + tmpMore := false; + inc(tmpLevel); + for i := 0 to _Topics.Count - 1 do + begin + tmpTopic := TTopic(_Topics[i]); + if tmpLevel = tmpTopic.ContentsLevel then + begin + if StrStartsWithIgnoringCase(tmpTopic.Title, SearchText) then + begin + result := tmpTopic; + exit; + end; + end; + if tmpLevel < tmpTopic.ContentsLevel then + begin + tmpMore := True; + end; + end; + until NOT tmpMore; +end; + +function THelpFile.FindTopicByTitleContains( const SearchText: string ): TTopic; +var + i: longint; + tmpTopic: TTopic; + tmpLevel : integer; + tmpMore : boolean; +begin + result := nil; + + tmpLevel := 0; + repeat + tmpMore := false; + inc(tmpLevel); + for i := 0 to _Topics.Count - 1 do + begin + tmpTopic := TTopic(_Topics[i]); + if tmpLevel = tmpTopic.ContentsLevel then + begin + if CaseInsensitivePos( SearchText, tmpTopic.Title) > 0 then + begin + result := tmpTopic; + exit; + end; + end; + if tmpLevel < tmpTopic.ContentsLevel then + begin + tmpMore := True; + end; + end; + until NOT tmpMore; +end; + +procedure THelpFile.FindResourceIDsForTopic( Topic: TTopic; + ResourceIDs: TList ); +var + i: longint; + pResourceIDs: UInt16ArrayPointer; + pTopicIndices: UInt16ArrayPointer; +begin + ResourceIDs.Clear; + + if _pHeader^.nres = 0 then + // since nres is unsigned + exit; + + if _pResourceData = nil then + ReadFileBlock( _pResourceData, + _pHeader^.resstart, + _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics + + pResourceIDs := _pResourceData; + pTopicIndices := _pResourceData + + _pHeader^.nres * sizeof( uint16 ); + + for i := 0 to _pHeader^.nres - 1 do + begin + if pTopicIndices^[ i ] = Topic.Index then + begin + // found + ResourceIDs.Add( pointer( pResourceIDs^[ i ] ) ); + end; + end; +end; + +procedure THelpFile.ReadReferencedFilesTable; +var + i: longint; + p: pointer; + pData: pointer; + DatabaseName: string; + pLength: pByte; +begin + if _pExtendedHeader = nil then + // no extended header -> no referenced files table + exit; + + if _pExtendedHeader^.Numdatabase = 0 then + exit; + + pData := nil; // please allocate... + ReadFileBlock( pData, + _pExtendedHeader^.DatabaseOffset, + _pExtendedHeader^.DatabaseSize ); + + p := pData; + for i := 0 to _pExtendedHeader^.Numdatabase - 1 do + begin + pLength := p; // length byte, including itself + SetString(DatabaseName, p+1, pLength^-1); +// GetMemString( p + 1, DatabaseName, ( pLength ^ ) - 1 ); + _ReferencedFiles.Add( DatabaseName ); + inc( p, pLength^ ); // skip to next entry end; + FreeMem( pData ); +end; -procedure THelpFile.ReadFontTable; +procedure THelpFile.ReadFontTableData; +begin + if _pExtendedHeader = nil then + // no extended header -> no font table + exit; + + if _pExtendedHeader^.NumFontEntry = 0 then + exit; + + ReadFileBlock( _pFontTableData, + _pExtendedHeader^.FontTableOffset, + _pExtendedHeader^.NumFontEntry * sizeof( THelpFontSpec ) ); +end; + +procedure THelpFile.ParseFontTable; +var + i: longint; + p: pointer; + pFontSpec: pTHelpFontSpec; begin - { TODO : ReadFontTable } + _FontTable.Clear; + + p := _pFontTableData; + if p = nil then + exit; // no data + + for i := 0 to _pExtendedHeader^.NumFontEntry - 1 do + begin + pFontSpec := p + i * sizeof( THelpFontSpec ); + _FontTable.Add( pFontSpec ); + end; end; procedure THelpFile.GetImages( ImageOffsets: TList; @@ -322,13 +1049,13 @@ var Bitmap: THelpBitmap; begin Images.Clear; - for ListIndex:= 0 to ImageOffsets.Count - 1 do + + for ListIndex := 0 to ImageOffsets.Count - 1 do begin - { TODO -oGraeme : Double check pointer conversion } ImageOffset := longint( ImageOffsets[ ListIndex ] ); try - Bitmap:= THelpBitmap.CreateFromHelpFile( _Data - + _Header.imgstart + Bitmap := THelpBitmap.CreateFromHelpFile( _Handle, + _pHeader^.imgstart + ImageOffset ); except on e: EHelpBitmapException do @@ -337,29 +1064,52 @@ begin + ': ' + e.Message );} begin - Bitmap:= THelpBitmap.Create; + Bitmap := THelpBitmap.Create; Bitmap.LoadFromResourceName( 'MissingBitmap' ); end; end; Images.Add( Bitmap, nil ); Bitmap.Destroy; + + end; +end; + +function THelpFile.GetImage( ImageOffset: longint ): THelpBitmap; +begin + try + Result := THelpBitmap.CreateFromHelpFile( _Handle, + _pHeader^.imgstart + + ImageOffset ); + except + on e: EHelpBitmapException do +{ raise EHelpFileException.Create( 'Error loading help bitmap at' + + IntToStr( ImageOffset ) + + ': ' + + e.Message );} + begin + result := nil; + end; end; end; function THelpFile.GetTopic( Index: longint ): TTopic; begin - Result:= TTopic(_Topics[ Index ]); + if ( Index < 0 ) + or ( Index > _Topics.Count - 1 ) then + Result := nil + else + Result := TTopic(_Topics[ Index ]); end; function THelpFile.GetTopicCount: longint; begin - Result:= _Topics.Count; + Result := _Topics.Count; end; function THelpFile.IndexOfTopic( Topic: TTopic ): longint; begin - Result:= _Topics.IndexOf( Topic ); + Result := _Topics.IndexOf( Topic ); end; function THelpFile.GetDictionaryCount: longint; @@ -369,9 +1119,110 @@ end; function THelpFile.GetDictionaryWord( Index: longint ): string; begin - Result := _Dictionary[Index]; + Result := _Dictionary[ Index ]; end; -Initialization -End. + +// Looks for fonts that should be substitued to the +// users selected fixed font +// doesn't make a lot of sense for this to be here... +procedure THelpFile.SetupFontSubstitutes( Substitutions: string ); +var + Item: string; + FontName: string; + SpacePos: longint; + W: longint; + H: longint; + i: longint; + pFontSpec: pTHelpFontSpec; + tmpSubstitutionItems : TStringList; + tmpCounter : integer; + tmpDimensionParts : TStringList; +begin + ParseFontTable; // (re)load table from raw data + + tmpSubstitutionItems := TStringList.Create; + StrExtractStrings(tmpSubstitutionItems, Substitutions, [';'], #0); + + for tmpCounter := 0 to tmpSubstitutionItems.Count - 1 do + begin + Item := tmpSubstitutionItems[tmpCounter]; + try + if Item <> '' then + begin + // Look for space in xxxx WxH + SpacePos := LastDelimiter(' ', Item); + if SpacePos > 0 then + begin + // fontname comes before + FontName := StrLeft( Item, SpacePos - 1 ); + Delete( Item, 1, SpacePos ); + + // width and height after, with an X between + tmpDimensionParts := TStringList.Create; + StrExtractStrings(tmpDimensionParts, Item, ['x'], #0); + W := StrToInt(tmpDimensionParts[0]); + H := StrToInt(tmpDimensionParts[1]); + tmpDimensionParts.Destroy; + if ( W > 0 ) and ( H > 0 ) then + begin + // Now look through the font table for matches + for i := 0 to _FontTable.Count - 1 do + begin + pFontSpec := _FontTable[ i ]; + if StrNPas( pFontSpec^.FaceName, sizeof( pFontSpec^.FaceName ) ) = FontName then + begin + // same face name... + if ( W = pFontSpec^. Height ) and ( H = pFontSpec^. Width ) then + begin + // match + _FontTable[ i ] := SubstituteFixedFont; + end; + end; + end; + end; + end; + end; + except + end; + end; + + tmpSubstitutionItems.Destroy; +end; + + +// ------------------------------------------------------------- +// Get the title only from specific help file (if possible) + +function GetHelpFileTitle( const Filename: string ): string; +var + Header: THelpFileHeader; + fstream: TFileStream; + Ext: string; +begin + Ext := ExtractFileExt( Filename ); + Result := ''; + + if SameText( Ext, '.inf' ) + or SameText( Ext, '.hlp' ) then + begin + try + try + fstream := TFileStream.Create(Filename, fmOpenRead); + fstream.Position := 0; + FillChar( Header, sizeof( Header ), 0 ); + fstream.Read(Header, SizeOf(Header)); + if Header.ID = INF_HEADER_ID then + Result := StrPas(Header.title); + except + // silently ignore errors - it's not to critical at this point. + end; + finally + fstream.Free; + end; + end; +end; + + +end. diff --git a/src/HelpTopic.pas b/src/HelpTopic.pas index ac608f8e..fe832c10 100644 --- a/src/HelpTopic.pas +++ b/src/HelpTopic.pas @@ -113,7 +113,7 @@ type TTopic = class(TObject) protected - _FileHandle: TFileStream; // HFILE; + _FileHandle: TFileStream; _pTOCEntry: pTTOCEntryStart; _pSlotOffsets: UInt32ArrayPointer; _Slots: TList; @@ -173,7 +173,7 @@ type constructor Create( var FileHandle: TFileStream; pSlotOffsets: UInt32ArrayPointer; Dictionary: TStringList; - pTOCEntry: pTTOCEntryStart; + var pTOCEntry: pTTOCEntryStart; FontTable: TList; ReferencedFiles: TStrings ); destructor Destroy; override; @@ -332,7 +332,7 @@ end; constructor TTopic.Create( var FileHandle: TFileStream; pSlotOffsets: UInt32ArrayPointer; Dictionary: TStringList; - pTOCEntry: pTTOCEntryStart; + var pTOCEntry: pTTOCEntryStart; FontTable: TList; ReferencedFiles: TStrings ); var @@ -340,9 +340,7 @@ var titleLen: integer; XY: THelpXYPair; p: pbyte; - Flags: byte; - begin _FileHandle := FileHandle; _pSlotOffsets := pSlotOffsets; @@ -352,9 +350,9 @@ begin _ContentsGroupIndex := 0; _pTOCEntry := pTOCEntry; - _NumSlots := pTOCEntry^. numslots; + _NumSlots := pTOCEntry^.numslots; - Flags := _pTOCEntry^. flags; + Flags := _pTOCEntry^.flags; p := pUInt8( _pTOCEntry ) + sizeof( TTOCEntryStart ); if ( Flags and TOCEntryExtended ) > 0 then @@ -380,18 +378,18 @@ begin if ( pExtendedInfo^.w2 and 4 ) > 0 then begin - _ContentsGroupIndex := pUInt16( p )^; + _ContentsGroupIndex := pUInt16(p)^; // read group inc( p, sizeof( uint16 ) ); end; end; // skip slot numbers for now. - _pSlotNumbers := puint16( p ); + _pSlotNumbers := pUInt16(p); inc( p, _NumSlots * sizeof( uint16 ) ); - titleLen := _pTOCEntry^.length - - ( longword( p ) - longword( _pTOCEntry ) ); + // Calculate the remainder of the tocentry length - that is the bytes used for TOC topic (title) text + titleLen := _pTOCEntry^.length - ( longword( p ) - longword( _pTOCEntry ) ); // Read title if TitleLen > 0 then @@ -1310,7 +1308,7 @@ begin if Slot.pLocalDictionary = nil then // allocate memory Slot.pLocalDictionary := GetMem(expected); - bytes := _FileHandle.Read(Slot.pLocalDictionary, expected); + bytes := _FileHandle.Read(Slot.pLocalDictionary^, expected); if bytes <> expected then raise EHelpFileException.Create('Failed to read complete slot dictionary'); @@ -1320,7 +1318,7 @@ begin if Slot.pData = nil then // allocate memory Slot.pData := GetMem(expected); - bytes := _FileHandle.Read(Slot.pData, expected); + bytes := _FileHandle.Read(Slot.pData^, expected); if bytes <> expected then raise EHelpFileException.Create('Failed to read complete slot data (text)'); diff --git a/src/SearchUnit.pas b/src/SearchUnit.pas index 3b312d2a..d8f9c6d6 100644 --- a/src/SearchUnit.pas +++ b/src/SearchUnit.pas @@ -42,15 +42,17 @@ procedure SearchHelpFile( HelpFile: THelpFile; WordSequences: TList ); // clear a lsit of word sequences (as produced by above) -procedure ClearWordSequences( WordSequences: TList; - DictionaryCount: longint ); +procedure ClearWordSequences( WordSequences: TList; DictionaryCount: longint ); Implementation uses - SysUtils, -// ACLUtility, ACLStringUtility, - HelpTopic, CompareWordUnit, nvUtilities; + SysUtils + ,HelpTopic + ,CompareWordUnit + ,nvUtilities + ,ACLStringUtility + ; type TSearchType = ( stGeneral, stStarts, stExactMatch, stEnds ); @@ -69,17 +71,16 @@ begin WordSequence.Clear; end; -procedure ClearWordSequences( WordSequence: TList; - DictionaryCount: longint ); +procedure ClearWordSequences( WordSequences: TList; DictionaryCount: longint ); var SequenceIndex: longint; - WordSequence: TList; + lWordSequence: TList; begin for SequenceIndex := 0 to WordSequences.Count - 1 do begin - WordSequence := WordSequences[ SequenceIndex ]; - ClearWordSequence( WordSequence, DictionaryCount ); - WordSequence.Destroy; + lWordSequence := TList(WordSequences[ SequenceIndex ]); + ClearWordSequence( lWordSequence, DictionaryCount ); + lWordSequence.Destroy; end; WordSequences.Clear; end; @@ -123,13 +124,12 @@ procedure SearchDictionary( HelpFile: THelpFile; Results: UInt32ArrayPointer ); var DictIndex: integer; - pDictWord: pstring; + DictWord: string; begin for DictIndex := 0 to HelpFile.DictionaryCount - 1 do begin - pDictWord := HelpFile.DictionaryWordPtrs[ DictIndex ]; - Results[ DictIndex ] := CompareWord( SearchWord, - pDictWord^ ); + DictWord := HelpFile.DictionaryWords[ DictIndex ]; + Results^[ DictIndex ] := CompareWord( SearchWord, DictWord ); end; end; @@ -140,15 +140,15 @@ procedure SearchDictionaryExact( HelpFile: THelpFile; Results: UInt32ArrayPointer ); var DictIndex: integer; - pDictWord: pstring; + DictWord: string; begin FillUInt32Array( Results, HelpFile.DictionaryCount, 0 ); for DictIndex := 0 to HelpFile.DictionaryCount - 1 do begin - pDictWord := HelpFile.DictionaryWordPtrs[ DictIndex ]; - if StrEqualIgnoringCase( SearchWord, pDictWord^ ) then - Results[ DictIndex ] := mwExactWord; + DictWord := HelpFile.DictionaryWords[ DictIndex ]; + if SameText( SearchWord, DictWord ) then + Results^[ DictIndex ] := mwExactWord; end; end; @@ -167,7 +167,7 @@ begin begin DictWord := HelpFile.DictionaryWords[ DictIndex ]; if StrStartsWithIgnoringCase(DictWord, SearchWord) then - Results[ DictIndex ] := MatchedWordRelevance( SearchWord, DictWord ); + Results^[ DictIndex ] := MatchedWordRelevance( SearchWord, DictWord ); end; end; @@ -249,9 +249,7 @@ begin end; // Search index entries for given searchword -procedure SearchIndex( HelpFile: THelpFile; - SearchWord: string; - Results: UInt32ArrayPointer ); +procedure SearchIndex( HelpFile: THelpFile; SearchWord: string; Results: UInt32ArrayPointer ); var IndexIndex: longint; IndexEntry: string; @@ -267,7 +265,7 @@ begin for IndexIndex := 0 to HelpFile.Index.Count - 1 do begin - IndexEntry := HelpFile.Index.GetLabels.ValuePtrs[IndexIndex]; + IndexEntry := HelpFile.Index.GetLabels[IndexIndex]; IndexEntryWordIndex := 0; tmpIndexWords.Clear; @@ -364,7 +362,7 @@ begin TopicCount ); FillUInt32Array( TopicRelevances, TopicCount, 0); - FillUInt32Array( TopicsExcluded, TopicCountt, 0); + FillUInt32Array( TopicsExcluded, TopicCount, 0); for TermIndex := 0 to Query.TermCount - 1 do begin @@ -473,7 +471,7 @@ begin LogEvent(LogSearch, 'Checking for sequences' ); for TopicIndex := 0 to TopicCount - 1 do begin - if TopicsMatchingTerm[ TopicIndex ] > 0 then + if TopicsMatchingTerm^[ TopicIndex ] > 0 then begin Topic := HelpFile.Topics[ TopicIndex ]; // Topic text contained a match for the all the parts @@ -489,7 +487,7 @@ begin TopicRelevanceForTerm := TopicRelevanceForTerm div Term.Parts.Count; // divide to bring back into scale - TopicsMatchingTerm[ TopicIndex ] := TopicRelevanceForTerm; + TopicsMatchingTerm^[ TopicIndex ] := TopicRelevanceForTerm; end; end; @@ -497,9 +495,8 @@ begin if WordSequences = nil then begin // we don't need to keep the sequence - ClearWordSequence( TermWordSequence, - HelpFile.DictionaryCount ); - TermWordSequence.Destroy; + ClearWordSequence( TermWordSequence, HelpFile.DictionaryCount ); + TermWordSequence.Free; end; // Search titles and index @@ -546,10 +543,10 @@ begin for TopicIndex := 0 to TopicCount - 1 do begin - if TopicsExcluded[ TopicIndex ] = 0 then + if TopicsExcluded^[ TopicIndex ] = 0 then begin Topic := HelpFile.Topics[ TopicIndex ]; - Topic.SearchRelevance := TopicRelevances[ TopicIndex ]; + Topic.SearchRelevance := TopicRelevances^[ TopicIndex ]; if Topic.SearchRelevance > 0 then begin Results.Add( Topic ); -- cgit v1.2.3-70-g09d2