source: trunk/NewView/HelpTopic.pas@ 377

Unit HelpTopic;

// NewView - a new OS/2 Help Viewer
// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com)
// This software is released under the Gnu Public License - see readme.txt

Interface

// This is it - the monster which decodes IPF data.
// It's created with a reference to the contents data defining it.
// It gets relevant pointers out of that. When GetText is called
// it decodes the data and spits out formatted text to suit
// RichTextView.

uses
  BseDos,
  OS2Def,
  Classes,
  Graphics,
  ACLString,
  HelpWindowDimensions,
  IPFFileFormatUnit;

const
  DefaultGroupIndex = 0;

  RTF_NewLine = #10;

  // placeholder for font table entry, indiciating user fixed font should be substituted
  SubstituteFixedFont: pointer = 1;

Type
  THelpLink = class
    HelpFile: TObject;     // file this link is within

    // Even though it doesn't do anything,
    // we have to have a constructor to allow
    // virtual constructors to work
    constructor Create; virtual;
  end;

  THelpTopicSlot = class
    pData: pUInt8;
    Size: longint;
    pLocalDictionary: UInt16ArrayPointer;
    LocalDictSize: uint8;
    destructor Destroy; override;
  end;

  THelpLinkClass = class of THelpLink;

  TFootnoteHelpLink = class( THelpLink )
    TopicIndex: longint;
    Title: string; // from text within link
  end;

  TWindowedHelpLink = class( THelpLink )
    GroupIndex: longint;   // DefaultGroupIndex if not specified.
                           // Note: Overrides contents group index of topic
    Automatic: boolean;    // link should be automatically followed on topic display
    Split: boolean;        // link should open the window within the parent
    ViewPort: boolean;     // link should always open a new window
    Dependent: boolean;    // window opened by link should be closed
                           // when current topic is closed
    Rect: THelpWindowRect; // Display window with this rectangle.
                           // Note: overrides contents rect
    constructor Create; override;
    destructor Destroy; override;
  end;

  TInternalHelpLink = class( TWindowedHelpLink )
    TopicIndex: longint;
  end;

  THelpLinkByResourceID = class( TWindowedHelpLink )
    ResourceID: longint;
  end;

  SlotArray = array[ 0..0 ] of THelpTopicSlot;

  pSlotArray = ^SlotArray;

  TFontState = ( fsNormal, fsFixed, fsCustom );

  TIPFTextAlignment = ( itaLeft, itaRight, itaCenter, itaCenterOnePara );

  TParseState = record
    Alignment: TIPFTextAlignment;
    ForegroundColorTag: string;
    BackgroundColorTag: string;
    Spacing: boolean;
    FontState: TFontState;
    InCharGraphics: boolean;
    LinkIndex: longint;

    StartOfTextBlock: longint;
    TextBlock: TAString;
    FootnoteLink: TFootnoteHelpLink;

    StyleCode: longint;
  end;


  TTopic = class
  protected
    _FileHandle: HFILE;

    _pTOCEntry: pTTOCEntryStart;
    _pSlotOffsets: UInt32ArrayPointer;
    _Slots: TList;
    _pSlotNumbers: puint16;
    _NumSlots: longint;
    _Title: pstring;
    _GlobalDictionary: TList;

    _ShowInContents: boolean;
    _ContentsLevel: integer;
    _ContentsGroupIndex: longint;

    _FontTable: TList;

    _ReferencedFiles: TStrings;

    procedure SetTitle( const NewValue: string );
    function GetTitle: string;
    function GetTitlePtr: pstring;

    // Returns the tag texts for the given bitmap ref
    function GetImageText( CurrentAlignment: TIPFTextAlignment;
                           BitmapOffset: longint;
                           BitmapFlags: longint;
                           ImageOffsets: TList ): string;

    Procedure ProcessLinkedImage( Var State: TParseState;
                                  Var pData: pByte;
                                  Var OutputString: string;
                                  ImageOffsets: TList );
    procedure TranslateIPFEscapeCode( Var State: TParseState;
                                      Var pData: pUInt8;
                                      Text: TAString;
                                      Var WordsOnLine: longint;
                                      ImageOffsets: TList );

    function CreateLink( Var LinkIndex: longint;
                         Var Link: THelpLink;
                         LinkClass: THelpLinkClass ): boolean;

    procedure EnsureSlotsLoaded;

    // returns true if the escape code at pData results in whitespace.
    function IPFEscapeCodeSpace( Var State: TParseState;
                                    Var pData: pUInt8 ): boolean;

    function GetNextIPFTextItem( Var SlotIndex: longint;
                             Var pData: pUInt8;
                             Var State: TParseState ): longint;

    function CheckForSequence( WordSequences: TList;
                               SlotIndex: longint;
                               pData: pUint8;
                               State: TParseState;

                               GlobalDictIndex: longint;
                             ): longint;

  public
    constructor Create( FileHandle: HFILE;
                        pSlotOffsets: UInt32ArrayPointer;
                        Dictionary: TList;
                        pTOCEntry: pTTOCEntryStart;
                        FontTable: TList;
                        ReferencedFiles: TStrings );

    destructor destroy; override;

    property Title: string read GetTitle write SetTitle;
    property TitlePtr: pstring read GetTitlePtr;

    procedure SetTitleFromMem( const p: pointer; const Len: byte );
    // Main function for retrieving text for topic.
    // HighlightSequences: list of sequences to highlight
    // if nil then ignored.
    // ShowCodes: indicates debugging: hex output of escape
    //   codes will be included
    // ShowWordSeparators: | will be included after each dictionary
    //   word inserted
    // Text: The output is written to here. IS NOT CLEARED FIRST.
    // ImageOffsets: For each image that occurs in the text,
    //   the help file offset will be written to this list.
    // HighlightMatches: if not nil, and HighlightSequences is not nil,
    // will return offsets to each highlight match
    procedure GetText( HighlightSequences: TList;
                       ShowCodes: boolean;
                       ShowWordSeparators: boolean;
                       Text: TAString;
                       ImageOffsets: TList;
                       HighlightMatches: TList );

    // if StopAtFirstOccurrence true, returns 0 or 1
    // if false, returns count of occurrences of word
    function SearchForWord( DictIndex: integer;
                            StopAtFirstOccurrence: boolean ): longint;

    // searches for sequences out of those listed in WordSequence
    // Each element of WordSequence contains a pointer to an array
    // of flags for each dictionary word, indicating whether that word
    // is to be a possible match.
    function SearchForWordSequences( WordSequence: TList;
                                     StopAtFirstOccurrence: boolean ): longint;

    procedure GetContentsWindowRect( ContentsRect: THelpWindowRect );

    // search for binary data including codes
    function SearchForData( Data: pbyte;
                            DataLen: integer ): boolean;

    procedure SaveIPFEscapeCode( Var State: TParseState;
                                 Var pData: pUInt8;
                                 Var F: TextFile;
                                 ImageOffsets: TList );

    procedure SaveToIPF( Var f: TextFile;
                         ImageOffsets: TList );

    Links: TList; // only valid after GetText

    property ShowInContents: boolean read _ShowInContents;
    property ContentsLevel: integer read _ContentsLevel;
    property ContentsGroupIndex: longint read _ContentsGroupIndex;

    function CountWord( DictIndex: integer ): longint;
    function ContainsWord( DictIndex: integer ): boolean;

    // Used externally
    HelpFile: TObject;
    Index: longint;

    SearchRelevance: longint;
  end;

// Compares two topics for purposes of sorting by
// search match relevance
function TopicRelevanceCompare( Item1, Item2: pointer ): longint;

// Compares two topics for purposes of sorting by
// title
function TopicTitleCompare( Item1, Item2: pointer ): longint;

Implementation

uses
  SysUtils,
  NewViewConstantsUnit,
  ACLUtility,
  ACLFileIOUtility,
  AStringUtilityUnit,
  ACLLanguageUnit,
  StringUtilsUnit,
  CharUtilsUnit,
  SettingsUnit,
  DebugUnit;

const
  IPFColors: array[ 0..15 ] of string =
  (
    //rrggbb
    '', // default
    '#0000ff', // blue
    '#ff0000', // red
    '#ff00ff', // pink (purple)
    '#00ff00', // green
    '#00ffff', // cyan
    '#ffff00', // yellow
    '#808000', // neutral = brown
    '#404040', // dark gray
    '#000080', // dark blue
    '#800000', // dark red
    '#800080', // dark pink (purple)
    '#008000', // dark green
    '#008080', // dark cyan
    '#000000', // black
    '#c0c0c0'  // pale gray
  );

  // for ecHighlight1
  IPFHighlight1Tags : array [ 0..6 ] of string =
  (
    '</i></b></u></color>',  // normal
    '<i>',           // hp1 italitc
    '<b>',           // hp2 bold
    '<b><i>',        // hp3 bold italic
    '<u>',           // hp5 underline
    '<u><i>',        // hp6 underline italic
    '<u><b>'         // hp7 underline bold
  );

  // for ecHighlight2
  IPFHighlight2Tags : array [ 0..3 ] of string =
  (
    '</i></b></u></color>',  // normal
    '<color blue>',  // hp4 blue
    '<color red>',   // hp8 red
    '<color purple>' // hp9 purple
  );

  BlankString: string = '';

var
  DefaultTitle: string;

Procedure OnLanguageEvent( Language: TLanguageFile;
                           const Apply: boolean );
begin
  Language.Prefix := 'HelpTopic.';
  Language.LL( Apply, DefaultTitle, 'DefaultTitle', '(No title)' );
end;


function GetBeginLink( LinkIndex: longint ): string;
begin
  Result := '<link '
            + IntToStr( LinkIndex )
            + '>'
end;

function GetEndLinkTags( const State: TParseState ): string;
begin
  Result := '</link>'
            + State.ForegroundColorTag;
end;


// Even though it doesn't do anything,
// we have to have a constructor to allow
// virtual constructors to work
constructor THelpLink.Create;
begin
end;

constructor TWindowedHelpLink.Create;
begin
  GroupIndex := DefaultGroupIndex;
  Automatic := false;
  ViewPort := false;
  Dependent := false;

  Rect := THelpWindowRect.Create;
end;

destructor TWindowedHelpLink.Destroy;
begin
  Rect.Destroy;
end;

destructor THelpTopicSlot.Destroy;
begin
  DeallocateMemory( pData );
  DeallocateMemory( pLocalDictionary );
end;

constructor TTopic.Create( FileHandle: HFILE;
                           pSlotOffsets: UInt32ArrayPointer;
                           Dictionary: TList;
                           pTOCEntry: pTTOCEntryStart;
                           FontTable: TList;
                           ReferencedFiles: TStrings );
var
  pExtendedInfo: pExtendedTOCEntry;
  titleLen: integer;
  XY: THelpXYPair;
  p: pbyte;

  Flags: byte;

begin
  _FileHandle := FileHandle;
  _pSlotOffsets := pSlotOffsets;

  _Title := nil;
  _GlobalDictionary := Dictionary;
  _ContentsGroupIndex := 0;

  _pTOCEntry := pTOCEntry;
  _NumSlots := pTOCEntry ^. numslots;

  Flags := _pTOCEntry ^. flags;
  p := pUInt8( _pTOCEntry ) + sizeof( TTOCEntryStart );

  if ( Flags and TOCEntryExtended ) > 0 then
  begin
    pExtendedInfo := pExtendedTOCEntry( p );
    inc( p, sizeof( TExtendedTOCEntry ) );

    if ( pExtendedInfo^.w1 and 1 ) > 0 then
      // skip position
      inc( p, sizeof( XY ) );

    if ( pExtendedInfo^.w1 and 2 ) > 0 then
      // skip size
      inc( p, sizeof( XY ) );

    if ( pExtendedInfo^.w1 and 8 ) > 0 then
      // skip window controls
      inc( p, 2 );

    if ( pExtendedInfo^.w1 and $40 ) > 0 then
      // skip something else, unknown... style? 2 bytes
      inc( p, 2 );

    if ( pExtendedInfo^.w2 and 4 ) > 0 then
    begin
      _ContentsGroupIndex := pUInt16( p )^;
      // read group
      inc( p, sizeof( uint16 ) );
    end;
  end;

  // skip slot numbers for now.
  _pSlotNumbers := puint16( p );
  inc( p, _NumSlots * sizeof( uint16 ) );

  titleLen := _pTOCEntry ^.length
              - ( longword( p ) - longword( _pTOCEntry ) );

  // Read title
  if TitleLen > 0 then
    SetTitleFromMem( p, TitleLen )
  else
    Title := DefaultTitle;

  _ContentsLevel := ( Flags and $f );
  _ShowInContents := Flags and TOCEntryHidden = 0;
  if _ContentsLevel = 0 then
    _ShowInContents := false; // hmmm....

  _FontTable := FontTable;
  _ReferencedFiles := ReferencedFiles;
end;

destructor TTopic.Destroy;
begin
  DestroyListAndObjects( Links );
  FreePString( _Title );
  DestroyListAndObjects( _Slots );
end;

procedure TTopic.SetTitle( const NewValue: string );
begin
  FreePString( _Title );
  _Title := NewPString( NewValue );
end;

procedure TTopic.SetTitleFromMem( const p: pointer; const Len: byte );
begin
  FreePString( _Title );
  GetMem( _Title, Len + 1 );
  _Title^[ 0 ] := char( Len );
  MemCopy( p, _Title + 1, Len );
end;

function TTopic.GetTitle: string;
begin
  Result := _Title^;
end;

function TTopic.GetTitlePtr: pstring;
begin
  Result := _Title;
end;

// Replace < and > characters with doubles << and >>
// for compatibility with richtextview.
// This works in place, assuming that instances of > or < are
// actually rare. In practice, IPF normally would insert these
// two characters as distinct words, but I don't want to assume that.
procedure SubstituteAngleBrackets( Var s: string );
var
  i: integer;
begin
  i := 1;
  while i <= Length( S ) do
  begin
    case S[ i ] of
      '<':
      begin
        Insert( '<', s, i );
        inc( i );
      end;

      '>':
      begin
        Insert( '>', s, i );
        inc( i );
      end;
    end;
    inc( i );
  end;
end;

function TTopic.GetImageText( CurrentAlignment: TIPFTextAlignment;
                              BitmapOffset: longint;
                              BitmapFlags: longint;
                              ImageOffsets: TList ): string;
var
  BitmapIndex: longint;
  OriginalAlignTag: string;
  ImageTag: string;
  AlignTag: string;
begin
  BitmapIndex := ImageOffsets.IndexOf( pointer( BitmapOffset ) );
  if BitmapIndex = -1 then
    BitmapIndex := ImageOffsets.Add( pointer( BitmapOffset ) );

  ImageTag := '<image '
              + IntToStr( BitmapIndex )
              + '>';

  if ( BitmapFlags and $08 ) > 0 then
  begin
    // stretch to fit - not implemented
  end;

  // aligned
  case CurrentAlignment of
    itaLeft:
      OriginalAlignTag := '<align left>';
    itaRight:
      OriginalAlignTag := '<align right>';
    itaCenter,
    itaCenterOnePara:
      OriginalAlignTag := '<align center>';
  end;

  case BitmapFlags and 7 of
    0, // curious - should not occur? does in dbexpert.hlp
    1: // left
      AlignTag := '<align left>';
    2: // right
      AlignTag := '<align right>';
    4,5: // centre (4 is official, 5 seems to occur too)
      AlignTag := '<align center>';
  end;

  Result := AlignTag
            + ImageTag
            + OriginalAlignTag;

  if ( BitmapFlags and $10 ) = 0 then
  begin
    // NOT runin, new lines before and after
    Result := RTF_NewLine + Result + RTF_NewLine;
  end;

end;

Procedure SaveImageText( BitmapOffset: longint;
                         BitmapFlags: longint;
                         Var F: TextFile;
                         ImageOffsets: TList );
var
  ImageIndex: longint;
begin
  ImageIndex := ImageOffsets.IndexOf( pointer( BitmapOffset ) );
  if ImageIndex = -1 then
    ImageIndex := ImageOffsets.Add( pointer( BitmapOffset ) );

  Write( F, ':artwork name=' );
  Write( F, StrInSingleQuotes('img' + IntToStr(ImageIndex) + '.bmp') );

  case BitmapFlags and 7 of
    2: // right
      Write( F, ' align=right' );
    4,5: // centre (4 is official, 5 seems to occur too)
      Write( F, ' align=center' );
  end;

  if ( BitmapFlags and $10 ) > 0 then
  begin
    // runin
    Write( F, ' runin' );
  end;

  // fit ...
  Write( F, '.' );
end;

Procedure TTopic.ProcessLinkedImage( Var State: TParseState;
                                     Var pData: pByte;
                                     Var OutputString: string;
                                     ImageOffsets: TList );
var
  EscapeLen: uint8;
  EscapeCode: uint8;
  SubEscapeCode: uint8;
  BitmapOffset: longword;
  BitmapFlags: uint8;
  Link: TInternalHelpLink;
  LinkTopicIndex: uint16;
begin
  LinkTopicIndex := -1;
  while true do
  begin
    EscapeLen := pData^;
    SubEscapeCode := ( pData + 2 )^;
    case SubEscapeCode of
      HPART_DEFINE:
      begin
        BitmapFlags := ( pData + 3 )^;
        BitmapOffset := pUInt32( pData + 4 )^;
      end;

      HPART_HDREF: // define whole bitmap topic link?
      begin
        LinkTopicIndex := pUInt16( pData + 3 )^;
      end;
    end;
    inc( pData, EscapeLen );

    // Now pData points at next code or item
    if pData^ <> IPF_ESC then
      // not an escape code, done
      break;
    EscapeCode := (pData + 2) ^;
    if EscapeCode <> ecLinkedImage then
      // not a hyperlink code, done
      break;
    // another linked image code is coming up.
    SubEscapeCode := ( pData + 3 )^;
    if SubEscapeCode = HPART_DEFINE then
      // started another linked image.
      break;
    inc( pData ); // move pointer to escape code len.
  end;

  OutputString := GetImageText( State.Alignment,
                                BitmapOffset,
                                BitmapFlags,
                                ImageOffsets );

  // Don't make it a link if we didn't find a
  // overall link code, i.e. degrade gracefully.
  if LinkTopicIndex > -1 then
  begin
    if CreateLink( State.LinkIndex, Link, TInternalHelpLink ) then
    begin
      Link.TopicIndex := LinkTopicIndex;
    end;

    OutputString := GetBeginLink( State.LinkIndex )
                    + OutputString
                    + GetEndLinkTags( State );

    inc( State.LinkIndex );
  end;

end;

Procedure SaveLinkedImage( Var pData: pByte;
                           Var F: TextFile;
                           ImageOffsets: TList );
var
  EscapeLen: uint8;
  EscapeCode: uint8;
  SubEscapeCode: uint8;
  BitmapOffset: longword;
  BitmapFlags: uint8;
  LinkTopicIndex: uint16;
begin
  LinkTopicIndex := -1;
  while true do
  begin
    EscapeLen := pData^;
    SubEscapeCode := ( pData + 2 )^;
    case SubEscapeCode of
      HPART_DEFINE:
      begin
        BitmapFlags := ( pData + 3 )^;
        BitmapOffset := pUInt32( pData + 4 )^;
      end;

      HPART_HDREF: // define whole bitmap topic link?
      begin
        LinkTopicIndex := pUInt16( pData + 3 )^;
      end;
    end;
    inc( pData, EscapeLen );

    // Now pData points at next code or item
    if pData^ <> IPF_ESC then
      // not an escape code, done
      break;
    EscapeCode := (pData + 2) ^;
    if EscapeCode <> ecLinkedImage then
      // not a hyperlink code, done
      break;
    // another linked image code is coming up.
    SubEscapeCode := ( pData + 3 )^;
    if SubEscapeCode = HPART_DEFINE then
      // started another linked image.
      break;
    inc( pData ); // move pointer to escape code len.
  end;

  SaveImageText( BitmapOffset,
                 BitmapFlags,
                 F,
                 ImageOffsets );

  // Don't make it a link if we didn't find a
  // overall link code, i.e. degrade gracefully.
  if LinkTopicIndex > -1 then
  begin
    WriteLn( F, '' );
    WriteLn( F, ':artlink.' );
    Write( F, ':link reftype=hd' );
    Write( F, ' refid=' + IntToStr( LinkTopicIndex ) );
    WriteLn( F, '.' );
    WriteLn( F, ':eartlink.' );
  end;

end;

Procedure GetExtraLinkData( Link: TWindowedHelpLink;
                            pData: pUInt8 );
var
  LinkFlags1: uint8;
  LinkFlags2: uint8;
  LinkDataIndex: longint;
  pLinkXY: pHelpXYPair;
  pLinkData: pUInt8;
begin
  LinkFlags1 := ( pData + 0 ) ^;
  LinkFlags2 := ( pData + 1 ) ^;

  pLinkData := pData + 2;

  if ( LinkFlags1 and 1 ) > 0 then
  begin
    // position specified
    pLinkXY := pHelpXYPair( pLinkData );
    ReadHelpPosition( pLinkXY^, Link.Rect );
    inc( pLinkData, sizeof( THelpXYPair ) );
  end;

  if ( LinkFlags1 and 2 ) > 0 then
  begin
    // size specified
    pLinkXY := pHelpXYPair( pLinkData );
    ReadHelpSize( pLinkXY^, Link.Rect );
    inc( pLinkData, sizeof( THelpXYPair ) );
  end;

  if ( LinkFlags1 and 8 ) > 0 then
  begin
    // window controls specified - skip
    inc( pLinkData, 2 );
  end;

  if ( LinkFlags2 and 4 ) > 0 then
  begin
    // group specified
    Link.GroupIndex := pUInt16( pLinkData )^;
    inc( LinkDataIndex, sizeof( uint16 ) );
  end;

  if ( LinkFlags1 and 64 ) > 0 then
  begin
    Link.Automatic := true;
  end;

  if ( LinkFlags1 and 4 ) > 0 then
    Link.ViewPort := true;

  if ( LinkFlags2 and 2 ) > 0 then
    Link.Dependent := true;

  if ( LinkFlags1 and 128 ) > 0 then
    Link.Split := true;

  // cant be bothered with the others.
end;

// If the given link has already been decoded
// ie. the topic has been displayed before,
// then return the already decoded link & return false
// Otherwise, create a new link object & return true
function TTopic.CreateLink( Var LinkIndex: longint;
                            Var Link: THelpLink;
                            LinkClass: THelpLinkClass ): boolean;
begin
  if LinkIndex >= Links.Count then
  begin
    Link := LinkClass.Create;
    Link.HelpFile := HelpFile;
    Links.Add( Link );
    Result := true;
  end
  else
  begin
    Link := Links[ LinkIndex ];
    Result := false;
  end;
end;

const
  // size of the original View's default font
  AverageViewCharWidth = 8;

procedure GetMarginTag( const Margin: longint;
                        FontState: TFontState;
                        Var MarginString: string;
                        BreakIfPast: boolean );
begin
  MarginString := '<leftmargin ';
  if FontState <> fsCustom then
    // for standard fonts, scale margins to match font
    MarginString := MarginString + IntToStr( Margin )
  else
    // for custom fonts, since the IPF margins were always in
    // terms of the standard font size, set the margin to a width based on that.
    MarginString := MarginString + IntToStr( Margin * AverageViewCharWidth ) + ' pixels';

  if BreakIfPast then
    MarginString := MarginString + ' breakifpast';

  MarginString := MarginString + '>';
end;

// TODO
function FullDoubleQuote( const s: string ): string;
begin
  Result := StrDoubleQuote
            + StrEscapeAllCharsBy(s, [], CharDoubleQuote)
            + StrDoubleQuote;
end;

// End URL, if it has been started. Go back and insert the start tag,
// and add the end tag.
procedure CheckForAutoURL( Text: TAString;
                           var State: TParseState );
var
  T: TAstring;
begin
  if State.StartOfTextBlock = -1 then
    // haven't got any text yet
    exit;

  TrimPunctuation( State.TextBlock );

  if not IsURL( State.TextBlock ) then
  begin
    // not a URL we know
    State.TextBlock.Clear;
    exit;
  end;

  // It's a URL. Insert link at start of URL

  T := TAstring.Create;
  T.AddString( '<blue><link ' + PARAM_LINK_URL + ' "' );
  T.Add( State.TextBlock );
  T.AddString( '">' );

  Text.Insert( State.StartOfTextBlock, T );

  T.Destroy;

  Text.AddString( GetEndLinkTags( State ) );

  State.TextBlock.Clear;
  State.StartOfTextBlock := -1;
end;

procedure TTopic.TranslateIPFEscapeCode( Var State: TParseState;
                                         Var pData: pUInt8;
                                         Text: TAString;
                                         Var WordsOnLine: longint;
                                         ImageOffsets: TList );
var
  EscapeLen: uint8;
  EscapeCode: uint8;

  Link: TInternalHelpLink;
  FootnoteLink: TFootnoteHelpLink;
  LinkByResourceID: THelpLinkByResourceID;

  Margin: integer;

  BitmapOffset: longword;
  BitmapFlags: uint8;

  ColorCode: uint8;
  StyleCode: uint8;

  FontIndex: uint8;
  pFontSpec: pTHelpFontSpec;

  FaceName: string;
  PointSize: longint;
  QuotedFaceName: string;

  ExternalLinkFileIndex: uint8;
  ExternalLinkTopicID: string;

  ProgramLink: string;
  ProgramPath: string;
  ProgramFilename: string;
  ProgramInfo : TSerializableStringList;
  tmpProgramLinkParts : TStringList;

  OutputString: string;
begin
  EscapeLen := pData^;
  EscapeCode := (pData + 1) ^;
  OutputString := '';

  case EscapeCode of

    ecSetLeftMargin:
    begin
      CheckForAutoURL( Text, State );
      Margin := integer( ( pData + 2 )^ );
      GetMarginTag( Margin, State.FontState, OutputString, false );
    end;

    ecSetLeftMarginNewLine:
    begin
      CheckForAutoURL( Text, State );
      Margin := integer( ( pData + 2 )^ );
      GetMarginTag( Margin, State.FontState, OutputString, false );
      OutputString := OutputString
                      + RTF_NewLine;
    end;

    ecSetLeftMarginFit:
    begin
      CheckForAutoURL( Text, State );
      Margin := integer( ( pData + 2 )^ );
      GetMarginTag( Margin, State.FontState, OutputString, true );
      // note that this will cause following tex to be "tabbed" across to the
      // new margin position, if not yet there.
      // if we are already past this margin then a new line should be started.

    end;

    ecSetLeftMarginHere:
    begin
      OutputString := '<leftmargin here>';
    end;

    ecHighlight1:
    begin
      StyleCode := ( pData + 2 ) ^;
      if StyleCode <= High( IPFHighlight1Tags ) then
        OutputString := IPFHighlight1Tags[ StyleCode ];
      if StyleCode = 0 then
        State.ForegroundColorTag := '</color>';
    end;

    ecHighlight2:
    begin
      StyleCode := ( pData + 2 ) ^;
      if StyleCode <= High( IPFHighlight2Tags ) then
        OutputString := IPFHighlight2Tags[ StyleCode ];

      if StyleCode = 0 then
        State.ForegroundColorTag := '</color>'
      else
        State.ForegroundColorTag := OutputString; // only colours
    end;

    ecLinkStart:
    begin
      CheckForAutoURL( Text, State );
      if CreateLink( State.LinkIndex, Link, TInternalHelpLink ) then
      begin
        Link.TopicIndex := pUInt16( pData + 2 )^;

        if EscapeLen >= 6 then
        begin
          GetExtraLinkData( Link, pData + 4 );
        end;
      end;

      // If it's not an automatic link
      // then put code in to show it.
      if not Link.Automatic then
      begin
        OutputString := '<blue>' + GetBeginLink(State.LinkIndex);
      end;

      inc( State.LinkIndex );
    end;

    ecFootnoteLinkStart:
    begin
      CheckForAutoURL( Text, State );
      if CreateLink( State.LinkIndex, FootnoteLink, TFootnoteHelpLink ) then
      begin
        FootnoteLink.TopicIndex := pUInt16( pData + 2 )^;
        State.FootnoteLink := FootnoteLink;
      end;

      OutputString := '<blue>'
                      + GetBeginLink( State.LinkIndex );

      inc( State.LinkIndex );
    end;

    ecStartLinkByResourceID:
    begin
      CheckForAutoURL( Text, State );
      if CreateLink( State.LinkIndex, LinkByResourceID, THelpLinkByResourceID ) then
      begin
        LinkByResourceID.ResourceID := pUInt16( pData + 2 )^;

        if EscapeLen >= 6 then
        begin
          GetExtraLinkData( LinkByResourceID, pData + 4 );
        end;
      end;

      OutputString := '<blue>'
                      + GetBeginLink( State.LinkIndex );

      inc( State.LinkIndex );
    end;

    ecExternalLink:
    begin
      CheckForAutoURL( Text, State );
      // :link reftype=hd refid=... database=<filename>
      ExternalLinkFileIndex := ( pData + 2 )^;
      ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
      OutputString := '<blue><link ' + PARAM_LINK_EXTERNAL + ' '
                      + IntToStr( ExternalLinkFileIndex )
                      + ' '
                      + ExternalLinkTopicID
                      + '>'
    end;

    ecProgramLink:
    begin
      CheckForAutoURL( Text, State );
      ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );

      tmpProgramLinkParts := TStringList.Create;
      StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
      ProgramPath := tmpProgramLinkParts[0];
      tmpProgramLinkParts.Destroy;

      ProgramFilename := ExtractFilename( ProgramPath );

      if    StrStartsWithIgnoringCase(ProgramFilename, PRGM_EXPLORER) // web explorer?
         or StrStartsWithIgnoringCase(ProgramFilename, PRGM_NETSCAPE)
         or StrStartsWithIgnoringCase(ProgramFilename, PRGM_MOZILLA)
         or StrStartsWithIgnoringCase(ProgramFilename, PRGM_FIREFOX)
      then
      begin
        OutputString := '<blue><link ' + PARAM_LINK_URL + ' '
                        + FullDoubleQuote(StrSubstringFrom(ProgramLink, Length(ProgramPath) + 2))
                        + '>';
      end
      else
      begin
        ProgramInfo := TSerializableStringList.create;
        ProgramInfo.add(ProgramPath);
        ProgramInfo.add(StrSubstringFrom(ProgramLink, Length(ProgramPath) + 2));
        OutputString := '<blue><link ' + PARAM_LINK_PROGRAM + ' '
                        + ProgramInfo.getSerializedString
                        + '>';
        ProgramInfo.destroy;
      end;
    end;

    ecLinkEnd:
    begin
      OutputString := GetEndLinkTags( State );
      if State.FootnoteLink <> nil then
        State.FootnoteLink := nil;
    end;

    ecStartCharGraphics:
    begin
      State.FontState := fsFixed;
      State.InCharGraphics := true;
      OutputString := RTF_NewLine + RTF_NewLine + '<tt><wrap no>';
      State.Spacing := false;
      WordsOnLine := 0;
    end;

    ecEndCharGraphics:
    begin
      State.FontState := fsNormal;
      State.InCharGraphics := false;
      OutputString := '</tt><wrap yes>' + RTF_NewLine;
      State.Spacing := true;
    end;

    ecImage:
    begin
      CheckForAutoURL( Text, State );
      BitmapFlags := ( pData + 2 )^;
      BitmapOffset := pUInt32( pData + 3 )^;

      OutputString := GetImageText( State.Alignment,
                                    BitmapOffset,
                                    BitmapFlags,
                                    ImageOffsets );
      if State.Spacing
         AND (OutputString[Length(OutputString)] <> RTF_NewLine) // no space after a line break
      then
        OutputString := OutputString + ' ';
    end;

    ecLinkedImage:
    begin
      CheckForAutoURL( Text, State );
      ProcessLinkedImage( State,
                          pData,
                          OutputString,
                          ImageOffsets );
      if State.Spacing then
        OutputString := OutputString + ' ';

      // Note! Early exit, since the procedure
      // will update pData.
      Text.AddString( OutputString );
      exit;
    end;

    ecStartLines:
    begin
      CheckForAutoURL( Text, State );
      // aligned text
      case ( pData + 2 )^ of
        0, // just in case - to match image alignment oddities
        1:
        begin
          OutputString := RTF_NewLine + '<align left>';
          State.Alignment := itaLeft;
        end;

        2:
        begin
          OutputString := RTF_NewLine + '<align right>';
          State.Alignment := itaRight;
        end;

        4:
        begin
          OutputString := RTF_NewLine + '<align center>';
          State.Alignment := itaCenter;
        end;
      end;
      OutputString := OutputString + '<wrap no>';
      WordsOnLine := 0;
    end;

    ecEndLines:
    begin
      CheckForAutoURL( Text, State );
      // supposed to turn word wrap on, default font
      OutputString := '<align left><wrap yes>'; // I guess...
      State.Alignment := itaLeft;
    end;

    ecForegroundColor:
    begin
      ColorCode := ( pData + 2 )^;
      if ColorCode = 0 then
        State.ForegroundColorTag := '</color>'
      else if ColorCode <= High( IPFColors ) then
        State.ForegroundColorTag := '<color ' + IPFColors[ ColorCode ] + '>';
      OutputString := State.ForegroundColorTag;
    end;

    ecBackgroundColor:
    begin
      ColorCode := ( pData + 2 )^;
      if ColorCode = 0 then
        State.BackgroundColorTag := '</backcolor>'
      else if ColorCode <= High( IPFColors ) then
        State.BackgroundColorTag := '<backcolor ' + IPFColors[ ColorCode ] + '>';
      OutputString := State.BackgroundColorTag;
    end;

    ecFontChange:
    begin
      FontIndex := ( pData + 2 )^;
      if FontIndex = 0 then
      begin
        // back to default font
        OutputString := '</font>';
        State.FontState := fsNormal;
      end
      else if FontIndex < _FontTable.Count then
      begin
        // valid font index
        pFontSpec := _FontTable[ FontIndex ];

        if pFontSpec = SubstituteFixedFont then
        begin
          OutputString := '<tt>';
          State.FontState := fsFixed;
        end
        else
        begin
          pFontSpec := _FontTable[ FontIndex ];
          FaceName := StrPasWithLength( pFontSpec ^. FaceName,
                               sizeof( pFontSpec ^. FaceName ) );
          // arbitrarily and capriciously use specified height * 2/3
          // as the point size - seems to correspond to what original
          // view wanted...  note this doesn't necessarily scale
          // correctly, since default font could be different. whatever.
          PointSize := pFontSpec ^. Height * 2 div 3;

          if PointSize < 8 then
            PointSize := 8;
          // quote font name, escape double quotes with duplicates
          // e.g. Bob's "Big" Font would become
          //      "Bob's ""Big"" Font"
          QuotedFaceName := FullDoubleQuote( FaceName );
          OutputString := '<font '
                          + QuotedFaceName
                          + ' '
                          + IntToStr( PointSize )
                          + '>';
                          {
                           // for when (if ever) RTV allows setting font
                           // by precise dimensions
                          + '['
                          + IntToStr( pFontSpec ^. Width )
                          + 'x'
                          + IntToStr( pFontSpec ^. Height )
                          + ']';
                          }
          State.FontState := fsCustom;
        end;
      end;
    end
  end; // case escape code of...

  Text.AddString( OutputString );

  inc( pData, EscapeLen );
end;

// returns true if the escape code results in whitespace
// also updates the bits of State that relate to spacing
// ie. .Spacing, and .InCharGraphics (which affects whether
// spacing is reset at paragraph ends etc)
function TTopic.IPFEscapeCodeSpace( Var State: TParseState;
                                    Var pData: pUInt8 ): boolean;
var
  EscapeLen: uint8;
  EscapeCode: uint8;

begin
  EscapeLen := pData^;
  EscapeCode := (pData + 1) ^;

  result := false; // for most
  case EscapeCode of
    ecSetLeftMargin,
    ecSetLeftMarginNewLine,
    ecSetLeftMarginFit:
      result := true;

    ecStartCharGraphics:
    begin
      result := true;
      State.InCharGraphics := true;
      State.Spacing := false;
    end;

    ecEndCharGraphics:
    begin
      result := true;
      State.InCharGraphics := false;
      State.Spacing := true;
    end;

    ecImage:
      result := State.Spacing;

    ecLinkedImage:
      result := State.Spacing;

    ecStartLines:
    begin
      result := true;
      State.Spacing := false;
    end;

    ecEndLines:
    begin
      result := true;
      // supposed to turn word wrap on, default font
      State.Spacing := true;
    end;
  end; // case escape code of...

  inc( pData, EscapeLen );
end;

procedure TTopic.EnsureSlotsLoaded;
var
  i: longint;
  pSlotNumber: puint16;
  SlotNumber: uint16;
  SlotHeader: TSlotHeader;
  Slot: THelpTopicSlot;
begin
  if _Slots = nil then
  begin
    try
      _Slots := TList.Create;

      // Read slot data
      pSlotNumber := _pSlotNumbers;

      for i := 0 to _NumSlots - 1 do
      begin
        SlotNumber := pSlotNumber^;

        // Seek to start of slot
        try
          MySeek( _FileHandle,
                  _pSlotOffsets^[ SlotNumber ] );
        except
          // not a valid offset
          raise EHelpFileException.Create( ErrorCorruptHelpFile );
        end;

        // Read header
        if not MyRead( _FileHandle,
                       Addr( SlotHeader ),
                       sizeof( SlotHeader ) ) then
          // couldn't read slot header
          raise EHelpFileException.Create( ErrorCorruptHelpFile );

        // Create slot object
        Slot := THelpTopicSlot.Create;

        Slot.LocalDictSize := SlotHeader.nLocalDict;
        Slot.Size := SlotHeader.ntext;

        // Allocate and read slot dictionary
        ReadFileBlock( _FileHandle,
                       Slot.pLocalDictionary,
                       SlotHeader.localDictPos,
                       uint32( Slot.LocalDictSize ) * sizeof( uint16 ) );

        // Allocate and read slot data (text)
        ReadFileBlock( _FileHandle,
                       Slot.pData,
                       _pSlotOffsets^[ SlotNumber ] + sizeof( TSlotHeader ),
                       Slot.Size );

        _Slots.Add( Slot );

        inc( pSlotNumber, sizeof( UInt16 ) );
      end;
    except
      on E: EHelpFileException do
      begin
        DestroyListAndObjects( _Slots );
        raise;
      end;
    end;
  end;
end;

// returns a global dict index.
// or, -1 for a whitespace item.
// or, -2 for end of text.
function TTopic.GetNextIPFTextItem( Var SlotIndex: longint;
                                    Var pData: pUInt8;
                                    Var State: TParseState ): longint;
var
  Slot: THelpTopicSlot;
  pSlotEnd: pUInt8;

  LocalDictIndex: uint8;
begin
  while SlotIndex < _NumSlots do
  begin
    Slot := _Slots[ SlotIndex ];
    pSlotEnd := Slot.pData + Slot.Size;

    while pData < pSlotEnd do
    begin
      LocalDictIndex := pData^;
      inc( pData );

      if LocalDictIndex < Slot.LocalDictSize then
      begin
        // Normal word lookup
        result := Slot.pLocalDictionary^[ LocalDictIndex ];
        exit;
      end;

      // special code
      case LocalDictIndex of
        IPF_END_PARA:
        begin
          result := -1;
          if not State.InCharGraphics then
            State.Spacing := true;
          exit;
        end;

        IPF_CENTER:
        begin
          result := -1;
          exit;
        end;

        IPF_INVERT_SPACING:
        begin
          State.Spacing := not State.Spacing;
        end;

        IPF_LINEBREAK:
        begin
          result := -1;
          if not State.InCharGraphics then
            State.Spacing := true;
          exit;
        end;

        IPF_SPACE:
        begin
          result := -1;
          exit;
        end;

        IPF_ESC:
        begin
          // escape sequence
          if IPFEscapeCodeSpace( State, pData ) then
            result := -1;
        end;
      end;
    end; // while in slot...
    inc( SlotIndex );
  end;
  Result := -2;
end;

// Checks to see if the given word (at pData)
// starts one of the given sequences, by looking forward
// If found, returns the length of the sequence.
function TTopic.CheckForSequence( WordSequences: TList;
                                  SlotIndex: longint;
                                  pData: pUint8;
                                  State: TParseState;
                                  GlobalDictIndex: longint;
                                ): longint;
var
  tmpWordSequence: TList;
  tmpSequenceStepIndex: longint;
  pSequenceStepWords: Uint32ArrayPointer;

  SequenceIndex: longint;

  SlotIndexTemp: longint;
  pDataTemp: pUint8;
  StateTemp: TParseState;
//  s : string;
  DictIndex: longint;
begin
  result := 0; // if we don't find a match.

  for SequenceIndex := 0 to WordSequences.Count - 1 do
  begin
    tmpWordSequence := WordSequences[ SequenceIndex ];
    pSequenceStepWords := tmpWordSequence[ 0 ];

    if pSequenceStepWords^[ GlobalDictIndex ] > 0 then
    begin
      // matched first step in this sequence. Look ahead...
      tmpSequenceStepIndex := 1;

      pDataTemp := pData;
      SlotIndexTemp := SlotIndex;
      StateTemp := State;

      while true do
      begin
        if tmpSequenceStepIndex = tmpWordSequence.Count then
        begin
          // have a match for the sequence; time to leave
          Result := tmpWordSequence.Count;
          break;
        end;

        // get words for next step in sequence
        pSequenceStepWords := tmpWordSequence[ tmpSequenceStepIndex ];

        DictIndex := GetNextIPFTextItem( SlotIndexTemp, pDataTemp, StateTemp );
        if DictIndex = -2 then
        begin
          // end of text - abort
          break;
        end;

        if DictIndex = -1 then
        begin
          // whitespace - abort
           // for multi-word phrase searching - count this and subsequent whitespace...
          break;
        end;

        // s := pstring( _GlobalDictionary[ DictIndex ] )^; // for debug only


        // ignore whitespace
        if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ DictIndex ] )^ ) then
        begin
          if pSequenceStepWords^[ DictIndex ] = 0 then
          begin
            // word doesn't match - abort
            break;
          end;

          // match; next one
          inc(tmpSequenceStepIndex);
        end;

      end; // while

    end;
    // else - doesn't match first step, do nothing
  end; // for sequenceindex ...
end;


// Main translation function. Turns the IPF data into
// a text string. Translates formatting codes into tags
// as for Rich Text Viewer.
// Uses TAString for speed without length limits
// - string is too short
// - PChar is slow to concatenate (unless you keep track of the insert point)
// - AnsiString is slow
procedure TTopic.GetText( HighlightSequences: TList;
                            // each element is a TList
                            //   containing a sequence of possible words
                            //     each element of each sequence
                            //     is an array of flags for the dictionary
                            //       indicating if the word is a allowed match at that step
                            // a match is any sequence that matches one or more words at each step.
                          ShowCodes: boolean;
                          ShowWordSeparators: boolean;
                          Text: TAString;
                          ImageOffsets: TList;
                          HighlightMatches: TList );
var
  SlotIndex: integer;
  Slot: THelpTopicSlot;
  pData: pUInt8;
  pSlotEnd: pUInt8;

  GlobalDictIndex: uint32;

  WordsOnLine: longint;

  StringToAdd: string;
  LocalDictIndex: uint8;

  State: TParseState;

  EscapeLen: uint8;
  i: longint;

  SequenceStepIndex: longint;
begin
  if Links = nil then
    Links := TList.Create;

  if HighlightMatches <> nil then
    HighlightMatches.Clear;

  // Text.Clear;
  ImageOffsets.Clear;

  try
    EnsureSlotsLoaded;
  except
    on E: EHelpFileException do
    begin
      Text.AddString( e.Message );
      exit;
    end;
  end;

  WordsOnLine := 0;

  State.LinkIndex := 0;
  State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
  State.InCharGraphics := false;
  State.Spacing := true;
  State.ForegroundColorTag := '</color>';
  State.BackgroundColorTag := '</backcolor>';

  State.StartOfTextBlock := -1;
  State.TextBlock := TAString.Create;

  State.FootnoteLink := nil;

  Text.AddString( '<leftmargin 1>' );

  SequenceStepIndex := 0;

  for SlotIndex := 0 to _NumSlots - 1 do
  begin
    if not State.InCharGraphics then
      State.Spacing := true; // this is just a guess as to the exact view behaviour.
                             // inf.txt indicates that spacing is reset to true at
                             // slot (cell) start, but that doesn't seem to be the
                             // case when in character graphics... hey ho.

    Slot := _Slots[ SlotIndex ];

    pData := Slot.pData;

    pSlotEnd := pData + Slot.Size;

    State.Alignment := itaLeft;

    while pData < pSlotEnd do
    begin
      LocalDictIndex := pData^;
      inc( pData );

      if LocalDictIndex < Slot.LocalDictSize then
      begin
        // Normal word lookup
        GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];

        if ShowWordSeparators then
        begin
          Text.AddString( '{' + IntToStr( GlobalDictIndex )+ '}' );
        end;

        // normal lookup
        if GlobalDictIndex < _GlobalDictionary.Count then
          StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
        else
          StringToAdd := '';

        if StrIsEmptyOrSpaces( StringToAdd ) then
        begin
          // spaces only...
          CheckForAutoURL( Text, State );
        end
        else
        begin
          // really is a word, not a space.

          // store string into "word"
          if State.TextBlock.Length = 0 then
          begin
            // store start of block
            State.StartOfTextBlock := Text.Length;
          end;

          State.TextBlock.AddString( StringToAdd );

          SubstituteAngleBrackets( StringToAdd );

          if HighlightSequences <> nil then
          begin
            if SequenceStepIndex > 0 then
            begin
              // currently highlighting a sequence.
              dec( SequenceStepIndex );
              if SequenceStepIndex = 0 then
              begin
                // now finished, insert end highlight
                StringToAdd := StringToAdd + State.BackgroundColorTag;
              end;
            end
            else
            begin
              // not yet in a sequence, searching.
              SequenceStepIndex :=
                CheckForSequence( HighlightSequences,
                                  SlotIndex,
                                  pData,
                                  State,
                                  GlobalDictIndex );

              if SequenceStepIndex > 0 then
              begin
                // this word starts a sequence!
                if HighlightMatches <> nil then
                  HighlightMatches.Add( pointer( Text.Length ) );
                StringToAdd := '<backcolor #'
                         + IntToHex( Settings.Colors[ SearchHighlightTextColorIndex ], 6 )
                         + '>'
                         + StringToAdd;
                dec( SequenceStepIndex );
                if SequenceStepIndex = 0 then
                  // and ends it.
                  StringToAdd := StringToAdd + State.BackgroundColorTag;
              end;

            end;
          end; // if processing sequence
          inc( WordsOnLine );
        end;

        Text.AddString( StringToAdd );

        if State.FootnoteLink <> nil then
        begin
          State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
          if State.Spacing then
          begin
            State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
          end;
        end;

        if State.Spacing then
        begin
          CheckForAutoURL( Text, State );

          Text.AddString( ' ' );
        end;
      end
      else
      begin
        // special code

        if ShowCodes then
        begin
          Text.AddString( '[' + IntToHex( LocalDictIndex, 2 ) );
          if LocalDictIndex = IPF_ESC then
          begin
            EscapeLen := pData^;
            for i := 1 to EscapeLen - 1 do
            begin
              Text.AddString( ' '
                              + IntToHex( ( pData + i )^, 2 ) );
            end;

          end;
          Text.AddString( ']' );
        end;

        case LocalDictIndex of
          IPF_END_PARA:
          begin
            if SlotIndex = 0 then
              if pData - 1 = Slot.pData then
                // ignore first FA, not needed with RichTextView
                continue;

            CheckForAutoURL( Text, State );
            if State.Alignment = itaCenterOnePara then
            begin
              State.Alignment := itaLeft;
              Text.AddString( '<align left>' );
            end;
            Text.AddString(RTF_NewLine);

            if WordsOnLine > 0 then
              Text.AddString(RTF_NewLine);

            if not State.InCharGraphics then
              State.Spacing := true;

            WordsOnLine := 0;
          end;

          IPF_CENTER:
          begin
            CheckForAutoURL( Text, State );
            Text.addString( RTF_NewLine + '<align center>' );
            State.Alignment := itaCenterOnePara;
          end;

          IPF_INVERT_SPACING:
          begin
            State.Spacing := not State.Spacing;
          end;

          IPF_LINEBREAK:
          begin
            CheckForAutoURL( Text, State );

            if State.Alignment = itaCenterOnePara then
            begin
              State.Alignment := itaLeft;
              Text.AddString( '<align left>' );
            end;
            Text.AddString( RTF_NewLine );
            if not State.InCharGraphics then
              State.Spacing := true;
            WordsOnLine := 0;
          end;

          IPF_SPACE:
          begin
            CheckForAutoURL( Text, State );
            if State.Spacing then
              Text.AddString( '  ' );
          end;

          IPF_ESC:
          begin
            // escape sequence
            TranslateIPFEscapeCode( State,
                                    pData,
                                    Text,
                                    WordsOnLine,
                                    ImageOffsets );

          end;

        end; // case code of...
      end;
    end; // for slotindex = ...
  end;
  State.TextBlock.Destroy;
end;


function TTopic.SearchForWord( DictIndex: integer;
                               StopAtFirstOccurrence: boolean )
  : longint;
var
  SlotIndex: integer;
  Slot: THelpTopicSlot;
  pData: pUInt8;
  pSlotEnd: pUInt8;

  EscapeLen: longint;

  GlobalDictIndex: uint32;

  LocalDictIndex: uint8;
begin
  EnsureSlotsLoaded;

  Result := 0;
  for SlotIndex := 0 to _NumSlots - 1 do
  begin
    Slot := _Slots[ SlotIndex ];

    pData := Slot.pData;

    pSlotEnd := pData + Slot.Size;

    while pData < pSlotEnd do
    begin
      LocalDictIndex := pData^;

      if LocalDictIndex < Slot.LocalDictSize then
      begin
        // Normal word lookup
        GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];

        if GlobalDictIndex = DictIndex then
        begin
          inc( result );
          if StopAtFirstOccurrence then
            exit;
        end;
      end
      else
      begin
        // special code
        if LocalDictIndex = $ff then
        begin
          // escape string, skip it
          EscapeLen := ( pData + 1 ) ^;
          inc( pData, EscapeLen );
        end;
      end;

      inc( pData );
    end; // for slotindex = ...
  end;
end;

// Search for a sequence of bytes, including in escape codes
// this is for debugging to allow finding specific sequences
function TTopic.SearchForData( Data: pbyte;
                               DataLen: integer ): boolean;
var
  SlotIndex: integer;
  Slot: THelpTopicSlot;
  pData: pUInt8;
  pSlotEnd: pUInt8;

  pHold: pUint8;
  pSearch: pUint8;
begin
  EnsureSlotsLoaded;

  for SlotIndex := 0 to _NumSlots - 1 do
  begin
    Slot := _Slots[ SlotIndex ];

    pSearch := Data;
    pHold := Slot.pData;
    pData := Slot.pData;
    pSlotEnd := Slot.pData + Slot.Size;

    while pHold < pSlotEnd do
    begin
      if pData^ = pSearch^ then
      begin
        // byte matches
        inc( pData );
        inc( pSearch );
        if ( pSearch >= Data + DataLen ) then
        begin
          // matches
          result := true;
          exit;
        end
      end
      else
      begin
        // no match
        pSearch := Data;
        inc( pHold );
        pData := pHold;
      end;
    end; // for slotindex = ...
  end;

  result := false; // not found
end;

function TTopic.SearchForWordSequences( WordSequence: TList;
                                        StopAtFirstOccurrence: boolean )
  : longint;
var
  SlotIndex: integer;
  Slot: THelpTopicSlot;
  pData: pUInt8;
  pSlotEnd: pUInt8;

  EscapeLen: longint;

  GlobalDictIndex: uint32;
  IsWord: boolean;
  WordRelevance: uint32;

  CurrentMatchRelevance: uint32; // total relevances for words matched so far
                                 // in the current sequence

//  CurrentMatch: string;  // useful for debugging only
  LocalDictIndex: uint8;

  SequenceIndex: longint;
  SequenceStartSlotIndex: longint;
  pSequenceStartData: pUInt8;

  pStepWordRelevances: UInt32ArrayPointer; // word relevances for the current step in the sequence

  // get the current slot start and end pointers
  procedure GetSlot;
  begin
    Slot := self._Slots[ SlotIndex ];
    pData := Slot.pData;
    pSlotEnd := pData + Slot.Size;
  end;

  // get pointer to the current set of word relevances
  procedure GetStepFlags;
  begin
    pStepWordRelevances := WordSequence[ SequenceIndex ];
  end;

  // store the current point as start of a sequence
  procedure StoreStartOfSequence;
  begin
    SequenceIndex := 0;
    SequenceStartSlotIndex := SlotIndex;
    pSequenceStartData := pData;
    CurrentMatchRelevance := 0;
//    CurrentMatch := '';
    GetStepFlags;
  end;

begin
  Result := 0;

  EnsureSlotsLoaded;

  if _NumSlots = 0 then
    // thar's nowt in yon topic, cannae be a match laid
    exit;

  SlotIndex := 0;

  GetSlot;

  StoreStartOfSequence;

  while true do
  begin
    LocalDictIndex := pData^;
    IsWord := false;
    if LocalDictIndex < Slot.LocalDictSize then
    begin
      IsWord := true;
      // Normal word lookup, so get the global dict idnex before we
      // (potentially) move to next slot
      GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
    end;

    inc( pData );
    if pData >= pSlotEnd then
    begin
      // reached end of slot, next please
      inc( SlotIndex );
      if SlotIndex < _NumSlots then
        GetSlot;
      // else - there is nothing more to search
      // but we need to check this last item
    end;

    if IsWord then
    begin
      // Normal word lookup
      WordRelevance := 0;

      if GlobalDictIndex < _GlobalDictionary.Count then
        if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ GlobalDictIndex ] )^ ) then;
          WordRelevance := pStepWordRelevances[ GlobalDictIndex ];

      if WordRelevance > 0 then
      begin
        // Found a matching word
        inc( CurrentMatchRelevance, WordRelevance );
// debug:
//        CurrentMatch := CurrentMatch +
//          pstring( _GlobalDictionary[ GlobalDictIndex ] )^;

        if SequenceIndex = 0 then
        begin
          // remember next start point
          SequenceStartSlotIndex := SlotIndex;
          pSequenceStartData := pData;
        end;

        inc( SequenceIndex );

        if SequenceIndex < WordSequence.Count then
        begin
          // get next set of flags.
          GetStepFlags;
        end
        else
        begin
          // found a complete sequence. Cool!

          inc( result, CurrentMatchRelevance );

          if StopAtFirstOccurrence then
            exit;

          // start looking from the beginning of the sequence again.
          StoreStartOfSequence;
        end;
      end
      else
      begin
        // not a match at this point, restart search
        if SequenceIndex > 0 then
        begin
          // we had matched one or more steps already,
          // back to start of sequence AND back to
          // point we started matching from (+1)
          SequenceIndex := 0;
          CurrentMatchRelevance := 0;
//          CurrentMatch := '';
          SlotIndex := SequenceStartSlotIndex;
          GetSlot;
          pData := pSequenceStartData;
          GetStepFlags;
        end
        else
        begin
          // haven't matched anything yet.
          // update start of sequence
          SequenceStartSlotIndex := SlotIndex;
          pSequenceStartData := pData;
        end;
      end;
    end
    else
    begin
      // special code
      if LocalDictIndex = $ff then
      begin
        // escape string, skip it
        EscapeLen := pData ^;
        inc( pData, EscapeLen );
      end;
    end;

    if SlotIndex >= _NumSlots then
    begin
      // finished searching topic
      break;
    end;

    // next item
  end;
end;


function TTopic.CountWord( DictIndex: integer ): longint;
begin
  Result := SearchForWord( DictIndex, false );
end;

function TTopic.ContainsWord( DictIndex: integer ): boolean;
begin
  Result := SearchForWord( DictIndex, true ) > 0;
end;

// Gets the window dimensions specified by this topic's
// contents header
procedure TTopic.GetContentsWindowRect( ContentsRect: THelpWindowRect );
var
  extendedinfo: TExtendedTOCEntry;
  XY: THelpXYPair;
  p: pbyte;

  Flags: byte;
begin
  Flags := _pTOCEntry ^.flags;
  p := pByte( _pTOCEntry + sizeof( TTOCEntryStart ) );

  ContentsRect.Left := 0;
  ContentsRect.Bottom := 0;
  ContentsRect.Width := 100;
  ContentsRect.Height := 100;

  if ( Flags and TOCEntryExtended ) > 0 then
  begin
    // have more details available...
    ExtendedInfo.w1 := p^;
    ExtendedInfo.w2 := ( p+1) ^;
    inc( p, sizeof( ExtendedInfo ) );

    if (  ExtendedInfo.w1 and 1 ) > 0 then
    begin
      // read origin
      XY := pHelpXYPair( p )^;
      inc( p, sizeof( XY ) );
      ReadHelpPosition( XY, ContentsRect );
    end;
    if ( ExtendedInfo.w1 and 2 ) > 0 then
    begin
      // read size
      XY := pHelpXYPair( p )^;
      inc( p, sizeof( XY ) );
      ReadHelpSize( XY, ContentsRect );
    end;
  end;
end;

const
  IPFColorNames: array[ 0..15 ] of string =
  (
    'default',
    'blue',
    'red',
    'pink',
    'green',
    'cyan',
    'yellow',
    'neutral',
//    'brown',  ??
    'darkgray',
    'darkblue',
    'darkred',
    'darkpink',
    'darkgreen',
    'darkcyan',
    'black',
    'palegray'
  );

Procedure SaveExtraLinkData( Link: TWindowedHelpLink;
                            pData: pUInt8 );
var
  LinkFlags1: uint8;
  LinkFlags2: uint8;
  LinkDataIndex: longint;
  pLinkXY: pHelpXYPair;
  pLinkData: pUInt8;
begin
  LinkFlags1 := ( pData + 0 ) ^;
  LinkFlags2 := ( pData + 1 ) ^;

  pLinkData := pData + 2;

  if ( LinkFlags1 and 1 ) > 0 then
  begin
    // position specified
    pLinkXY := pHelpXYPair( pLinkData );
    inc( pLinkData, sizeof( THelpXYPair ) );
  end;

  if ( LinkFlags1 and 2 ) > 0 then
  begin
    // size specified
    pLinkXY := pHelpXYPair( pLinkData );
    inc( pLinkData, sizeof( THelpXYPair ) );
  end;

  if ( LinkFlags1 and 8 ) > 0 then
  begin
    // window controls specified - skip
    inc( pLinkData, 2 );
  end;

  if ( LinkFlags2 and 4 ) > 0 then
  begin
    // group specified
    Link.GroupIndex := pUInt16( pLinkData )^;
    inc( LinkDataIndex, sizeof( uint16 ) );
  end;

  if ( LinkFlags1 and 64 ) > 0 then
  begin
    Link.Automatic := true;
  end;

  if ( LinkFlags1 and 4 ) > 0 then
    Link.ViewPort := true;

  if ( LinkFlags2 and 2 ) > 0 then
    Link.Dependent := true;

  if ( LinkFlags1 and 128 ) > 0 then
    Link.Split := true;

  // cant be bothered with the others.
end;

procedure TTopic.SaveIPFEscapeCode( Var State: TParseState;
                                    Var pData: pUInt8;
                                    Var F: TextFile;
                                    ImageOffsets: TList );
var
  EscapeLen: uint8;
  EscapeCode: uint8;

  Margin: integer;

  BitmapOffset: longword;
  BitmapFlags: uint8;

  ColorCode: uint8;
  StyleCode: uint8;

  FontIndex: uint8;
  pFontSpec: pTHelpFontSpec;

  FaceName: string;

  ExternalLinkFileIndex: uint8;
  ExternalLinkTopicID: string;

  ProgramLink: string;
  ProgramPath: string;
  tmpProgramLinkParts : TStringList;

  OutputString: string;
begin
  EscapeLen := pData^;
  EscapeCode := (pData + 1) ^;
  OutputString := '';

  case EscapeCode of

    ecSetLeftMargin:
    begin
      Margin := integer( ( pData + 2 )^ );
      GetMarginTag( Margin, State.FontState, OutputString, false );
    end;

    ecSetLeftMarginNewLine:
    begin
      Margin := integer( ( pData + 2 )^ );
      GetMarginTag( Margin, State.FontState, OutputString, false );
      OutputString := OutputString
                      + RTF_NewLine;
    end;

    ecSetLeftMarginFit:
    begin
      Margin := integer( ( pData + 2 )^ );
      GetMarginTag( Margin, State.FontState, OutputString, true );
      // note that this will cause following tex to be "tabbed" across to the
      // new margin position, if not yet there.
      // if we are already past this margin then a new line should be started.

    end;

    ecSetLeftMarginHere:
    begin
      OutputString := '<leftmargin here>';
    end;

    ecHighlight1: // hp1,2,3, 5,6,7
    begin
      StyleCode := ( pData + 2 ) ^;
      if StyleCode > 3 then
        StyleCode := StyleCode + 1; // 4, 8 and 9 are expressed in highlight2 code

      if StyleCode > 0 then
        Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
      else
        Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
      State.StyleCode := StyleCode;
    end;

    ecHighlight2: // hp4, 8, 9
    begin
      StyleCode := ( pData + 2 ) ^;
      case StyleCode of
        1: StyleCode := 4;
        2: StyleCode := 8;
        3: StyleCode := 9;
      end;

      if StyleCode > 0 then
        Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
      else
        Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
      State.StyleCode := StyleCode;
    end;

    ecLinkStart:
    begin
      Write( F, ':link reftype=hd' ); // link to heading

      Write( F, ' refid=' + IntToStr( pUInt16( pData + 2 )^ ) );

      {
        if EscapeLen >= 6 then
        begin
          GetExtraLinkData( Link, pData + 4 );
        end;}

//      if Link.Automatic then
//        Write( F, ' auto' );

      Write( F, '.' );

      inc( State.LinkIndex );
    end;

    ecFootnoteLinkStart:
    begin
      Write( F, ':link reftype=fn refid=fn'
             + IntToStr( pUInt16( pData + 2 )^ )
             + '.' );
      inc( State.LinkIndex );
    end;

    ecStartLinkByResourceID:
    begin
      Write( F, ':link reftype=hd res='
             + IntToStr( pUInt16( pData + 2 )^ )
             + '.' );

      inc( State.LinkIndex );
    end;

    ecExternalLink:
    begin
      ExternalLinkFileIndex := ( pData + 2 )^;
      ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
      Write( F, ':link reftype=hd '
             + ' refid=' + StrInSingleQuotes( ExternalLinkTopicID )
             + ' database=' + StrInSingleQuotes( _ReferencedFiles[ ExternalLinkFileIndex ] )
             + '.' );

    end;

    ecProgramLink:
    begin
      ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );

      tmpProgramLinkParts := TStringList.Create;
      StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
      ProgramPath := tmpProgramLinkParts[0];
      tmpProgramLinkParts.Destroy;

      Write( F, ':link reftype=launch'
             + ' object=' + StrInSingleQuotes( ProgramPath )
             + ' data=' + StrInSingleQuotes( ProgramLink )
             + '.' );
    end;

    ecLinkEnd:
    begin
      Write( F, ':elink.' );
      if State.FootnoteLink <> nil then
        State.FootnoteLink := nil;
    end;

    ecStartCharGraphics:
    begin
      State.FontState := fsFixed;
      State.InCharGraphics := true;
      WriteLn( F, '' );
      WriteLn( F, ':cgraphic.' );
      State.Spacing := false;
    end;

    ecEndCharGraphics:
    begin
      State.FontState := fsNormal;
      State.InCharGraphics := false;
      WriteLn( F, '' );
      WriteLn( F, ':ecgraphic.' );
      State.Spacing := true;
    end;

    ecImage:
    begin
      BitmapFlags := ( pData + 2 )^;
      BitmapOffset := pUInt32( pData + 3 )^;

      SaveImageText( BitmapOffset, BitmapFlags, F, ImageOffsets );

      if State.Spacing then
        Write( F, ' ' );
    end;

    ecLinkedImage:
    begin
      SaveLinkedImage( pData, F, ImageOffsets );
      // Note! Early exit, since the procedure
      // will update pData.
      exit;
    end;

    ecStartLines:
    begin
      WriteLn( F, '' );
      // aligned text
      case ( pData + 2 )^ of
        0, // just in case - to match image alignment oddities
        1:
        begin
          WriteLn( F, ':lines.' );
          State.Alignment := itaLeft;
        end;

        2:
        begin
          WriteLn( F, ':lines align=right.' );
          State.Alignment := itaRight;
        end;

        4:
        begin
          WriteLn( F, ':lines align=center.' );
          State.Alignment := itaCenter;
        end;
      end;
    end;

    ecEndLines:
    begin
      // supposed to turn word wrap on, default font
      WriteLn( F, '' );
      WriteLn( F, ':elines.' );
      State.Alignment := itaLeft;
    end;

    ecForegroundColor:
    begin
      ColorCode := ( pData + 2 )^;

      if ColorCode < High( IPFColorNames ) then
        Write( F, ':color fc=' + IPFColorNames[ ColorCode ] + '.' );
    end;

    ecBackgroundColor:
    begin
      ColorCode := ( pData + 2 )^;
      if ColorCode < High( IPFColorNames ) then
        Write( F, ':color bc=' + IPFColorNames[ ColorCode ] + '.' );
    end;

    ecFontChange:
    begin
      FontIndex := ( pData + 2 )^;
      if FontIndex = 0 then
      begin
        // back to default font
        Write( F, ':font facename=default.' );
        State.FontState := fsNormal;
      end
      else if FontIndex < _FontTable.Count then
      begin
        // valid font index
        pFontSpec := _FontTable[ FontIndex ];

        if pFontSpec = SubstituteFixedFont then
        begin
         // oops.
          OutputString := '<tt>';
          State.FontState := fsFixed;
        end
        else
        begin
          pFontSpec := _FontTable[ FontIndex ];
          FaceName := StrPasWithLength( pFontSpec ^. FaceName,
                               sizeof( pFontSpec ^. FaceName ) );
          Write( F,
                 ':font facename=' + StrInSingleQuotes( FaceName )
                 + ' size=' + IntToStr( pFontSpec ^. Height )
                   + 'x' + IntToStr( pFontSpec ^. Width )
                 + '.' );
          State.FontState := fsCustom;
        end;
      end;
    end
  end; // case escape code of...

  // Write( F, OutputString );

  inc( pData, EscapeLen );
end;

procedure TTopic.SaveToIPF( Var f: TextFile;
                            ImageOffsets: TList );
var
  SlotIndex: integer;
  Slot: THelpTopicSlot;
  pData: pUInt8;
  pSlotEnd: pUInt8;

  GlobalDictIndex: uint32;

  StringToAdd: string;
  LocalDictIndex: uint8;

  State: TParseState;

  SequenceStepIndex: longint;

  LineLen: longint;
  c: char;
begin
  EnsureSlotsLoaded;

  State.LinkIndex := 0;
  State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
  State.InCharGraphics := false;
  State.Spacing := true;
  State.ForegroundColorTag := '</color>';
  State.BackgroundColorTag := '</backcolor>';

  State.StartOfTextBlock := -1;
  State.TextBlock := TAString.Create;

  State.FootnoteLink := nil;

  State.StyleCode := 0;

  SequenceStepIndex := 0;

  LineLen := 0;

  for SlotIndex := 0 to _NumSlots - 1 do
  begin
    if not State.InCharGraphics then
      State.Spacing := true; // this is just a guess as to the exact view behaviour.
                             // inf.txt indicates that spacing is reset to true at
                             // slot (cell) start, but that doesn't seem to be the
                             // case when in character graphics... hey ho.

    Slot := _Slots[ SlotIndex ];

    pData := Slot.pData;

    pSlotEnd := pData + Slot.Size;

    State.Alignment := itaLeft;

    while pData < pSlotEnd do
    begin
      LocalDictIndex := pData^;
      inc( pData );

      if LocalDictIndex < Slot.LocalDictSize then
      begin
        // Normal word lookup
        GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];

        // normal lookup
        if GlobalDictIndex < _GlobalDictionary.Count then
          StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
        else
          StringToAdd := '';

        if Length( StringToAdd ) = 1 then
        begin
          // could be symbol
          c := StringToAdd[ 1 ];
          case C of
            '&': StringToAdd := '&amp.';
            '''': StringToAdd := '&apos.';
//            '*': StringToAdd := '&asterisk.';
            '@': StringToAdd := '&atsign.';
            '\': StringToAdd := '&bsl.';
            '^': StringToAdd := '&caret.';
            '"': StringToAdd := '&osq.';
            ':': StringToAdd := '&colon.';
            '.': StringToAdd := '&per.';
          end;
        end;

        inc( LineLen, Length( StringToAdd ) );
        if ( LineLen > 80 ) and ( not State.InCharGraphics ) then
        begin
          WriteLn( F );
          LineLen := 0;
        end;

        Write( F, StringToAdd );
{
        if State.FootnoteLink <> nil then
        begin
          State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
          if State.Spacing then
          begin
            State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
          end;
        end;
 }
        if State.Spacing then
        begin
          Write( F, ' ' );
          inc( LineLen );
        end;
      end
      else
      begin
        // special code

        case LocalDictIndex of
          IPF_END_PARA:
          begin
            WriteLn( F, '' );
            Write( F, ':p.' );
            LineLen := 3;

            if not State.InCharGraphics then
              State.Spacing := true;
          end;

          IPF_CENTER:
          begin
            WriteLn( F, '' );
            Write( F, '.ce ' ); // remainder of this line is centered.
            LineLen := 4;
            State.Alignment := itaCenterOnePara;
          end;

          IPF_INVERT_SPACING:
          begin
            State.Spacing := not State.Spacing;
          end;

          IPF_LINEBREAK:
          begin
            WriteLn( F, '' );
            if not State.InCharGraphics then
              WriteLn( F, '.br ' ); // break must be the only thing on the line

            LineLen := 0;
            if not State.InCharGraphics then
              State.Spacing := true;
          end;

          IPF_SPACE:
          begin
            if State.Spacing then
              Write( F, '  ' )
            else
              Write( F, ' ' );
          end;

          IPF_ESC:
          begin
            // escape sequence
            SaveIPFEscapeCode( State,
                               pData,
                               F,
                               ImageOffsets );
          end;

        end; // case code of...
      end;
    end; // for slotindex = ...
  end;
  State.TextBlock.Destroy;

end;

// Compares two topics for purposes of sorting by
// search match relevance
function TopicRelevanceCompare( Item1, Item2: pointer ): longint;
var
  Topic1, Topic2: TTopic;
begin
  Topic1 := Item1;
  Topic2 := Item2;

  if Topic1.SearchRelevance > Topic2.SearchRelevance then
    Result := -1
  else if Topic1.SearchRelevance < Topic2.SearchRelevance then
    Result := 1
  else
    Result := 0;
end;

// Compares two topics for purposes of sorting by
// title
function TopicTitleCompare( Item1, Item2: pointer ): longint;
begin
  Result := CompareText( TTopic( Item1 )._Title^,
                         TTopic( Item2 )._Title^ );
end;

Initialization
   RegisterProcForLanguages( OnLanguageEvent );
End.