<commit_before>unit HelpFile;

{$mode objfpc}{$H+}

interface

// Encapsulates the basic reading of a help file's structure.

uses
  Classes
  ,SysUtils
  ,fpg_imagelist
  ,IPFFileFormatUnit
  ,HelpTopic
  ,HelpBitmap
  ,SearchTable
  ;

type

  TFontEncoding = (encUTF8, encCP437, encCP850, encIBMGraph);


  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)
  private
    function GetFormatVersion: string;
    function GetStringResourceIDCount: integer;
    function GetNumericResourceIDCount: integer;
  protected
    _Filename : string;
    _FileSize : longint;
    _Handle: TFileStream;

    _pSlotData: pUInt16;
    _SlotDataSize: longint;

    _Title: string;

    _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 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 ReadReferencedFilesTable;
    procedure ReadFontTableData;
    procedure ParseFontTable;

    function GetTopic( AIndex: longint ): TTopic;
    function GetTopicCount: longint;

    function GetDictionaryCount: longint;
    function GetDictionaryWord( AIndex: 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
    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 StringResourceIDCount: integer read GetStringResourceIDCount;
    property NumericResourceIDCount: integer read GetNumericResourceIDCount;
    property Index: TIndex read GetIndex;
    property Filename: string read _FileName;
    property FormatVersion: string read GetFormatVersion;

    property ReferencedFiles: TStringList read _ReferencedFiles;

    procedure GetImages( ImageOffsets: TList; Images: TfpgImageList );

    function GetImage( ImageOffset: longint ): THelpBitmap;

    property DictionaryCount: longint read GetDictionaryCount;
    property DictionaryWords[ AIndex: longint ]: string read GetDictionaryWord;

    function IndexOfTopic( Topic: TTopic ): longint;

    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
    Encoding: TFontEncoding;
  end;

// Returns helpfile that the given topic is within
Function TopicFile( Topic: TTopic ): THelpFile;

function GetHelpFileTitle( const Filename: string ): string;

Implementation

uses
//  BseErr,
//  StringUtilsUnit,
//  CharUtilsUnit,
//  DebugUnit,
//  ACLFileIOUtility,
//  ACLLanguageUnit;
  fpg_main
  ,fpg_utils
  ,nvUtilities
  ,ACLStringUtility
  ;

// Load "missing" bitmap
{ 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(' + anIndexEntry.getLabel + ', ' + 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
  Result := Topic.HelpFile as THelpFile;
end;

function THelpFile.GetFormatVersion: string;
begin
  Result := Format('%d.%d', [_pHeader^.version_hi, _pHeader^.version_lo]);
end;

function THelpFile.GetStringResourceIDCount: integer;
begin
  Result := _pHeader^.nname;
end;

function THelpFile.GetNumericResourceIDCount: integer;
begin
  Result := _pHeader^.nres;
end;

procedure THelpFile.InitMembers;
begin
  _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;
  _ReferencedFiles := TStringList.Create;
  _FontTable := TList.Create;

  NotesLoaded := false;
end;


constructor THelpFile.Create(const aFileName: string);
begin
  LogEvent(LogObjConstDest, 'THelpFile.Create (file:' + aFileName + ')');
  LogEvent(LogParse, 'Helpfile Load: ' + aFileName);

  _FileName := aFileName;
  Encoding := encUTF8;

  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;


destructor THelpFile.Destroy;
begin
  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 );

  _Dictionary.Free;
  _SearchTable.Free;
  _ReferencedFiles.Free;
  _FontTable.Free;

  _Handle.Free;
end;

procedure THelpFile.Open;
begin
  LogEvent(LogDebug, 'Open File >>');
  if not FileExists( _Filename ) then
    raise EHelpFileException.Create( FileErrorNotFound );

  try
    _Handle := TFileStream.Create(_FileName, fmOpenRead or fmShareDenyWrite);
  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);
  LogEvent(LogDebug, 'Open File  <<');
end;

procedure THelpFile.Close;
begin
  _Handle.Free;
  _Handle := nil;
end;

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!

  _Handle.Seek(StartPosition, soBeginning);

  // we allocate early so this should never happen
  if Dest = nil then
    Dest := GetMem(Length);

  bytes := _Handle.Read(Dest^, Length);
  if bytes <> Length then
    raise EHelpFileException.Create(ErrorCorruptHelpFile);
end;

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 (Byte(_pHeader^.ID[0]) = $5f) and (Byte(_pHeader^.ID[1]) = $3f) then
      raise EWindowsHelpFormatException.Create( 'It seems we have a Win16 help file!' );

    raise EHelpFileException.Create( FileErrorInvalidHeader );
  end;

  _Title := _pHeader^.Title;

  if _pHeader^.extstart > 0 then
  begin
    New(_pExtendedHeader);
    // read extended header
    ReadFileBlock( _pExtendedHeader,
                   _pHeader^.extstart,
                   sizeof( _pExtendedHeader^ ) );
  end;
end;

procedure THelpFile.ReadContents;
var
  Topic: TTopic;
  EntryIndex: longint;
  pEntry: pTTOCEntryStart;
  pEnd: pbyte;
  tocarray: UInt32ArrayPointer;
  pData: Pointer;
  p: PByte;
begin
  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 := _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 );
    p := PByte(pEntry);
    inc(p, pEntry^.Length);
    pEntry := pTTOCentryStart(p);
  end;
end;

procedure THelpFile.ReadDictionary;
var
  i: longint;
  Len: uint8;
  p: pbyte;
  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( 'Error reading help file dictionary' );


    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
  if _Index = nil then
  begin
    ReadIndex;
  end;
  Result := _Index;
end;

type
  TIndexEntryHeader = packed record
    TextLength: uint8;
    Flags: uint8;
    NumberOfRoots: uint8;
    TOCIndex: uint16;
  end;
  pTIndexEntryHeader = ^TIndexEntryHeader;

procedure THelpFile.ReadIndex;
var
  IndexIndex: longint;
  pEntryHeader: pTIndexEntryHeader;
  EntryText: string;
  IndexTitleLen: longint;
  p: pByte;
  pEnd: pByte;
  pIndexData: pointer;
  tmpIndexEntry: TIndexEntry;
begin
  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( 'Error reading help file index' );

    pEntryHeader := pTIndexEntryHeader(p);
    IndexTitleLen := pEntryHeader^.TextLength;
    inc( p, sizeof( TIndexEntryHeader ) );

    EntryText := '';
    SetString(EntryText, PChar(p), IndexTitleLen);

    if pEntryHeader^.TOCIndex < _Topics.Count then
    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' );
      ; // pass! something special

    inc( p, IndexTitleLen
            + pEntryHeader^.NumberOfRoots
              * sizeof( uint32 ) ); // skip 'roots' for index search
  end;

  FreeMem( pIndexData );
end;

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;<commit_msg>Just to make sure us humans understand what must happen. ;-)<commit_after>unit HelpFile;

{$mode objfpc}{$H+}

interface

// Encapsulates the basic reading of a help file's structure.

uses
  Classes
  ,SysUtils
  ,fpg_imagelist
  ,IPFFileFormatUnit
  ,HelpTopic
  ,HelpBitmap
  ,SearchTable
  ;

type

  TFontEncoding = (encUTF8, encCP437, encCP850, encIBMGraph);


  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)
  private
    function GetFormatVersion: string;
    function GetStringResourceIDCount: integer;
    function GetNumericResourceIDCount: integer;
  protected
    _Filename : string;
    _FileSize : longint;
    _Handle: TFileStream;

    _pSlotData: pUInt16;
    _SlotDataSize: longint;

    _Title: string;

    _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 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 ReadReferencedFilesTable;
    procedure ReadFontTableData;
    procedure ParseFontTable;

    function GetTopic( AIndex: longint ): TTopic;
    function GetTopicCount: longint;

    function GetDictionaryCount: longint;
    function GetDictionaryWord( AIndex: 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
    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 StringResourceIDCount: integer read GetStringResourceIDCount;
    property NumericResourceIDCount: integer read GetNumericResourceIDCount;
    property Index: TIndex read GetIndex;
    property Filename: string read _FileName;
    property FormatVersion: string read GetFormatVersion;

    property ReferencedFiles: TStringList read _ReferencedFiles;

    procedure GetImages( ImageOffsets: TList; Images: TfpgImageList );

    function GetImage( ImageOffset: longint ): THelpBitmap;

    property DictionaryCount: longint read GetDictionaryCount;
    property DictionaryWords[ AIndex: longint ]: string read GetDictionaryWord;

    function IndexOfTopic( Topic: TTopic ): longint;

    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
    Encoding: TFontEncoding;
  end;

// Returns helpfile that the given topic is within
Function TopicFile( Topic: TTopic ): THelpFile;

function GetHelpFileTitle( const Filename: string ): string;

Implementation

uses
//  BseErr,
//  StringUtilsUnit,
//  CharUtilsUnit,
//  DebugUnit,
//  ACLFileIOUtility,
//  ACLLanguageUnit;
  fpg_main
  ,fpg_utils
  ,nvUtilities
  ,ACLStringUtility
  ;

// Load "missing" bitmap
{ 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(' + anIndexEntry.getLabel + ', ' + 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
  Result := Topic.HelpFile as THelpFile;
end;

function THelpFile.GetFormatVersion: string;
begin
  Result := Format('%d.%d', [_pHeader^.version_hi, _pHeader^.version_lo]);
end;

function THelpFile.GetStringResourceIDCount: integer;
begin
  Result := _pHeader^.nname;
end;

function THelpFile.GetNumericResourceIDCount: integer;
begin
  Result := _pHeader^.nres;
end;

procedure THelpFile.InitMembers;
begin
  _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;
  _ReferencedFiles := TStringList.Create;
  _FontTable := TList.Create;

  NotesLoaded := false;
end;


constructor THelpFile.Create(const aFileName: string);
begin
  LogEvent(LogObjConstDest, 'THelpFile.Create (file:' + aFileName + ')');
  LogEvent(LogParse, 'Helpfile Load: ' + aFileName);

  _FileName := aFileName;
  Encoding := encUTF8;

  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;


destructor THelpFile.Destroy;
begin
  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 );

  _Dictionary.Free;
  _SearchTable.Free;
  _ReferencedFiles.Free;
  _FontTable.Free;

  _Handle.Free;
end;

procedure THelpFile.Open;
begin
  LogEvent(LogDebug, 'Open File >>');
  if not FileExists( _Filename ) then
    raise EHelpFileException.Create( FileErrorNotFound );

  try
    _Handle := TFileStream.Create(_FileName, fmOpenRead or fmShareDenyWrite);
  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);
  LogEvent(LogDebug, 'Open File  <<');
end;

procedure THelpFile.Close;
begin
  _Handle.Free;
  _Handle := nil;
end;

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!

  _Handle.Seek(StartPosition, soBeginning);

  // we allocate early so this should never happen
  if Dest = nil then
    Dest := GetMem(Length);

  bytes := _Handle.Read(Dest^, Length);
  if bytes <> Length then
    raise EHelpFileException.Create(ErrorCorruptHelpFile);
end;

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 (Byte(_pHeader^.ID[0]) = $5f) and (Byte(_pHeader^.ID[1]) = $3f) then
      raise EWindowsHelpFormatException.Create( 'It seems we have a Win16 help file!' );

    raise EHelpFileException.Create( FileErrorInvalidHeader );
  end;

  _Title := _pHeader^.Title;

  if _pHeader^.extstart > 0 then
  begin
    New(_pExtendedHeader);
    // read extended header
    ReadFileBlock( _pExtendedHeader,
                   _pHeader^.extstart,
                   sizeof( _pExtendedHeader^ ) );
  end;
end;

procedure THelpFile.ReadContents;
var
  Topic: TTopic;
  EntryIndex: longint;
  pEntry: pTTOCEntryStart;
  pEnd: pbyte;
  tocarray: UInt32ArrayPointer;
  pData: Pointer;
  p: PByte;
begin
  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 := _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 );
    p := PByte(pEntry);
    inc(p, pEntry^.Length);
    pEntry := pTTOCentryStart(p);
  end;
end;

procedure THelpFile.ReadDictionary;
var
  i: longint;
  Len: uint8;
  p: pbyte;
  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( 'Error reading help file dictionary' );


    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
  if _Index = nil then
  begin
    ReadIndex;
  end;
  Result := _Index;
end;

type
  TIndexEntryHeader = packed record
    TextLength: uint8;
    Flags: uint8;
    NumberOfRoots: uint8;
    TOCIndex: uint16;
  end;
  pTIndexEntryHeader = ^TIndexEntryHeader;

procedure THelpFile.ReadIndex;
var
  IndexIndex: longint;
  pEntryHeader: pTIndexEntryHeader;
  EntryText: string;
  IndexTitleLen: longint;
  p: pByte;
  pEnd: pByte;
  pIndexData: pointer;
  tmpIndexEntry: TIndexEntry;
begin
  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( 'Error reading help file index' );

    pEntryHeader := pTIndexEntryHeader(p);
    IndexTitleLen := pEntryHeader^.TextLength;
    inc( p, sizeof( TIndexEntryHeader ) );

    EntryText := '';
    SetString(EntryText, PChar(p), IndexTitleLen);

    if pEntryHeader^.TOCIndex < _Topics.Count then
    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' );
      ; // pass! something special

    inc( p, IndexTitleLen
            + pEntryHeader^.NumberOfRoots
              * sizeof( uint32 ) ); // skip 'roots' for index search
  end;

  FreeMem( pIndexData );
end;

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;
{'fraction_non_alphanumeric': 0.09510592055303883, 'fraction_numerical': 0.00581319228049962, 'mean_word_length': 2.8838604698464354, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 29, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 4, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6403703', 'n_tokens_mistral': 12218, 'n_tokens_neox': 11540, 'n_words': 3143}