Merged separate DocView project as our subdirectory

10 files changed, 8810 insertions, 0 deletions

diff --git a/docview/components/richtext/ACLStringUtility.pas b/docview/components/richtext/ACLStringUtility.pas
new file mode 100644
index 00000000..f60aeed0
--- /dev/null
+++ b/docview/components/richtext/ACLStringUtility.pas
@@ -0,0 +1,1769 @@
+Unit ACLStringUtility;
+
+{$mode objfpc}{$H+}
+
+Interface
+
+Uses
+  Classes;
+
+const
+  CharTAB = chr(9);
+  CharCR = chr(13);
+  CharLF = chr(10);
+  CharSingleQuote = '''';
+  CharDoubleQuote = '"';
+
+  EndLine = CharCR + CharLF;
+
+  StrTAB = CharTAB;
+  StrCR = CharCR;
+  StrLF = CharLF;
+  StrCRLF = StrCR + StrLF;
+  StrSingleQuote = CharSingleQuote;
+  StrDoubleQuote = CharDoubleQuote;
+
+type
+  TSetOfChars = set of char;
+
+  TCharMatchFunction = function( const a: char ): boolean;
+
+
+  TSerializableStringList = class(TObject)
+  private
+    stringList: TStringList;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    function    getCount : LongInt;
+    function    get(const anIndex : LongInt) : String;
+    function    getSerializedString : String;
+    procedure   add(const aString : String);
+    procedure   readValuesFromSerializedString(const aSerializedString : String);
+  end;
+
+
+// Returns true if c is a digit 0..9
+Function IsDigit( const c: char ): boolean;
+
+// Returns true if c is not a digit
+Function IsNonDigit( const c: char ): boolean;
+
+// Returns true if c is an alphabetic character a..z A..Z
+Function IsAlpha( const c: char ): boolean;
+
+// Returns true if s is only spaces (or empty)
+Function IsSpaces( const s: string ): boolean;
+
+// ---------------------- Numeric conversions ---------------------------------------
+
+// Converts a hex string to a longint
+// May be upper or lower case
+// Does not allow a sign
+// Is not forgiving as StrToInt: all characters
+// must be valid hex chars.
+function HexToInt( s: string ): longint;
+
+// Given a string with a number on the end, increments that
+// number by one.
+// If there is no number it adds a one.
+// If the number is left zero padded then the result is similarly
+// padded
+Function IncrementNumberedString( StartString: string ): string;
+
+// ---------------------- Pascal String Utilities ---------------------------------------
+
+Function CaseInsensitivePos( const a: string;
+                             const b: string ): longint;
+
+// Looks for occurrences of QuoteChar and inserts a duplicate
+Function InsertDuplicateChars( const S: string;
+                               const QuoteChar: char ): string;
+
+// Returns index of SubString in S, case-insensitve
+Function FindSubstring( const SubString: string;
+                        const S: string ): integer;
+
+// Returns characters at the front of S that match according
+// to a given function... for example, IsDigit, IsNonDigit, IsAlpha
+Function MatchLeadingChars(
+           const S: string;
+           MatchFunction: TCharMatchFunction ): string;
+
+// Same as MatchLeadingChars, but removes the matching chars from S
+Function ExtractLeadingChars(
+           Var S: string;
+           MatchFunction: TCharMatchFunction ): string;
+
+// Case insensitive compare
+Function StringsSame( const a, b: string ): boolean;
+
+// Quoting
+
+// Note: these functions do not check for existing quotes within
+// the string, they only add or delete characters at the end.
+
+// Returns S in single quotes
+Function StrQuote( const s: string ): string;
+
+// Returns S without single quotes
+Function StrUnQuote( const s: string ): string;
+
+// Returns S in double quotes,
+// with any double quotes in S duplicated
+Function StrFullDoubleQuote( const s: string ): string;
+
+// Returns S without double quotes
+Function StrUnDoubleQuote( const s: string ): string;
+// Returns aString enclosed in single quotes
+Function StrInSingleQuotes(const aString : String) : String;
+// Returns aString enclosed in double quotes
+Function StrInDoubleQuotes(const aString : String) : String;
+
+
+//
+
+// Substitutes given character - placing all occurences of AFind char.
+Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string;
+
+// Returns the count rightmost chars of S
+Function StrRight( const S:string; const count:integer ):string;
+
+// Returns the remainder of S starting at start
+Function StrRightFrom( const S:string; const start:integer ):string;
+
+// Returns the count leftmost chars of S
+Function StrLeft( const S:string; const count:integer ):string;
+
+// Returns S minus count characters from the right
+Function StrLeftWithout( const S:string; const count:integer ):string;
+
+// Returns S with leftCount chars removed from the left and
+// rightCount chars removed from the right.
+Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string;
+
+// Produces a string from n padded on the left with 0's
+// to width chars
+Function StrLeft0Pad( const n: integer; const width: integer ): string;
+
+// Returns true if s starts with start (case insensitive)
+Function StrStarts( const start: string; const s: string ): boolean;
+
+// Returns true if s ends with endstr (case insensitive)
+Function StrEnds( const endStr: string; const s: string ): boolean;
+
+// Returns first word from S
+Function StrFirstWord( const S: String ): string;
+
+// prefixes all occurences of one of the chars in aReceiver with
+// anEscape char if the escapeChar itself is found, then it is doubled
+Function StrEscapeAllCharsBy(Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char): String;
+
+// Trims punctuation characters from start and end of s
+// such as braces, periods, commas.
+procedure TrimPunctuation( var s: string );
+
+// Returns true if S contains a URL.  MAY MODIFY CONTENTS OF S
+function CheckAndEncodeURL( var s: string ): boolean;
+
+// ------------ Seperated value utilities ---------------------
+
+// Returns the next item starting at Index. Spaces are the separator,
+// unless the item is quoted with QuoteChar, in which case it looks for
+// a closing quote. Occurrences of the QuoteChar in the item itself,
+// can be escaped with a duplicate, e.g. "He said ""bok"""
+Procedure GetNextQuotedValue(
+           const S: string;
+           var Index: longint;
+           var Value: string;
+           const QuoteChar: char );
+
+procedure GetNextValue(
+           const S: String;
+           var Index: longint;
+           var Value: string;
+           const Seperator: char );
+
+// Extract all fields in a String delimited by whitespace (blank or tab).
+// use double quotes if you need blanks in the strings
+Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String);
+
+// Extract all fields in a String given a set of delimiter characters and
+// an optional escape character usable to escape field delimits.
+// Example:
+//     StrExtractStrings('1x2x3\x4', 'x', '\') ->
+//     returns 4 strings: '1', '', '2' and '3x4'
+procedure StrExtractStrings(var aResult : TStrings; const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
+
+// Removes and returns the first value in a separated
+// value list (removes quotes if found)
+Function ExtractNextValue(
+          var S: string;
+          const Separator: string ): string;
+
+Function ExtractNextValueNoTrim(
+           var S: string;
+           const Separator: string ): string;
+
+
+// Parses a line of the form
+// key = value into it's components
+Procedure ParseConfigLine( const S: string;
+                           var KeyName: string;
+                           var KeyValue: string );
+
+// Removes spaces around the separator in the given string
+Procedure RemoveSeparatorSpaces( var S: string; const Separator:string );
+
+{$ifdef os2}
+// ------------ Ansi String utilities ------------------------
+
+// Right & left trim that works with AnsiStrings.
+Function AnsiTrim( const S: AnsiString ): AnsiString;
+
+Procedure AnsiParseConfigLine( const S: Ansistring;
+                               var keyName: Ansistring;
+                               var keyValue: Ansistring );
+
+Function AnsiExtractNextValue( var CSVString: AnsiString;
+                               const Separator: AnsiString ): AnsiString;
+
+{$endif}
+
+// ------------- Lists of strings, and strings as lists -----------
+
+// Adds NewValue to S as a separated list
+Procedure AddToListString( Var S: string;
+                           const NewValue: string;
+                           const Separator: string );
+
+Function ListToString( List: TStrings;
+                       const Separator: string ): string;
+
+procedure StringToList( S: String;
+                        List: TStrings;
+                        const Separator: string );
+
+// Reverse the given list. It must be set to not sorted
+Procedure ReverseList( TheList: TStrings );
+
+// Sort the given list into reverse alphabetical order
+//Procedure ReverseSortList( TheList: TStringList );
+
+// Find the given string in the given list, using
+// case insensitive searching (and trimming)
+// returns -1 if not found
+Function FindStringInList( const TheString: string;
+                           TheList:TStrings ):longint;
+
+Procedure MergeStringLists( Dest: TStringList;
+                            AdditionalList: TStringList );
+
+// ---------------------- PCHAR Utilities ---------------------------------------
+
+function StrNPas( const ps: PChar; const Length: integer ): String;
+
+// Returns a - b
+Function PCharDiff( const a: PChar; const b: Pchar ): longword;
+
+// trims spaces and carriage returns of the end of Text
+procedure TrimWhitespace( Text: PChar );
+
+
+function TrimChars( const s: string;
+                    chars: TSetOfChars ): string;
+
+// Concatenates a pascal string onto a PCHar string
+// Resizes if needed
+procedure StrPCat( Var Dest: PChar;
+                   const StringToAdd: string );
+
+// Trim endlines (#10 or #13) off the end of
+// the given string.
+Procedure TrimEndLines( const S: PChar );
+
+// Allocates enough memory for a copy of s as a PChar
+// and copies s to it.
+Function StrDupPas( const s: string ): PChar;
+
+// Returns a copy of the first n chars of s
+Function StrNDup( const s: PChar; const n: integer ): PChar;
+
+// Returns a copy of the first line starting at lineStart
+Function CopyFirstLine( const lineStart: PChar ): PChar;
+
+// Returns next line p points to
+Function NextLine( const p: PChar): PChar;
+
+// Concatentate AddText to Text. Reallocate and expand
+// Text if necessary. This is a size-safe StrCat
+Procedure AddAndResize( Var Text: PChar;
+                        const AddText: PChar );
+
+// Copy Source to Dest. Reallocate and expand
+// Dest if necessary. This is a size-safe StrCopy
+Procedure StrCopyAndResize( Var Dest: PChar;
+                            const Source: PChar );
+
+// Return "True" or "False"
+Function BoolToStr( const b: boolean ): string;
+
+// Return true if param matches the form
+// /Flag:value
+// dash (-) can be used instead of slash (/)
+// colon can be omitted
+function MatchValueParam( const Param: string;
+                          const Flag: string;
+                          var Value: string ): boolean;
+
+// Return true if param matches the form
+// /Flag
+// dash (-) can be used instead of slash (/)
+function MatchFlagParam( const Param: string; const Flag: string ): boolean;
+
+// returns true if the String starts with the provided one
+// this is case INsensitive
+function StrStartsWithIgnoringCase(const aReceiver: String; const aStartString: String): Boolean;
+
+// returns true if the String ends with the provided one
+// this is case INsensitive
+function StrEndsWithIgnoringCase(const aReceiver: String; const anEndString: String): Boolean;
+
+function StrIsEmptyOrSpaces(const AText: string): boolean;
+
+implementation
+
+Uses
+  SysUtils
+  ,nvUtilities
+  ;
+
+// ---------------------- Pascal String Utilities ---------------------------------------
+
+Procedure SkipChar( const S: string;
+                    Var index: longint;
+                    const C: Char );
+begin
+  while Index <= Length( S ) do
+  begin
+    if S[ Index ] <> C then
+     break;
+    inc( Index );
+  end;
+end;
+
+
+Procedure GetNextQuotedValue(
+           const S: string;
+           var Index: longint;
+           var Value: string;
+           const QuoteChar: char );
+begin
+  Value := '';
+  SkipChar( S, Index, ' ' );
+  if Index > Length( S ) then
+    exit;
+
+  if S[ Index ] <> QuoteChar then
+  begin
+    // not quoted, go to next space
+    while Index <= Length( S ) do
+    begin
+      if S[ Index ] = ' ' then
+        break;
+      Value := Value + S[ Index ];
+      inc( Index );
+    end;
+    // skip following spaces
+    SkipChar( S, Index, ' ' );
+    exit;
+  end;
+
+  // quoted string
+  inc( Index ); // skip opening quote
+
+  while Index <= Length( S ) do
+  begin
+    if S[ Index ] = QuoteChar then
+    begin
+      inc( index ); // skip closing quote
+      if Index > Length( S ) then
+        break; // done
+      if S[ Index ] <> QuoteChar then
+        break; // done
+
+      // escaped quote e.g "" so we do want it.
+    end;
+    Value := Value + S[ Index ];
+    inc( Index );
+  end;
+
+  SkipChar( S, Index, ' ' );
+
+end;
+
+Function InsertDuplicateChars( const S: string;
+                               const QuoteChar: char ): string;
+var
+  i: integer;
+begin
+  Result := '';
+  for i := 1 to Length( S ) do
+  begin
+    Result := Result + S[ i ];
+    if S[ i ] = QuoteChar then
+      Result := Result + QuoteChar; // insert duplicate
+  end;
+end;
+
+Function FindSubstring( const SubString: string;
+                        const S: string ): integer;
+begin
+  Result := Pos( Uppercase( SubString ),
+                 Uppercase( S ) );
+end;
+
+Function MatchLeadingChars(
+           const S: string;
+           MatchFunction: TCharMatchFunction ): string;
+var
+  i: integer;
+  TheChar: char;
+begin
+  Result:= '';
+  i := 1;
+  while i <= Length( S ) do
+  begin
+    TheChar:= S[ i ];
+    if not MatchFunction( TheChar ) then
+      // found a non matching char. Stop looking
+      break;
+    Result:= Result + TheChar;
+    inc( i );
+  end;
+end;
+
+Function ExtractLeadingChars(
+           Var S: string;
+           MatchFunction: TCharMatchFunction ): string;
+begin
+  Result := MatchLeadingChars( s, MatchFunction );
+  if Length( Result ) > 0 then
+    // remove matching section from string
+    Delete( S, 1, Length( Result ) );
+end;
+
+// Hex conversion: sheer extravagance. Conversion from
+// a hex digit char to int is done by creating a lookup table
+// in advance.
+var
+  MapHexDigitToInt: array[ Chr( 0 ) .. Chr( 255 ) ] of longint;
+
+procedure InitHexDigitMap;
+var
+  c: char;
+  IntValue: longint;
+begin
+  for c := Chr( 0 ) to Chr( 255 ) do
+  begin
+    IntValue := -1;
+    if ( c >= '0' )
+       and ( c <= '9' ) then
+      IntValue := Ord( c ) - Ord( '0' );
+
+    if ( Upcase( c ) >= 'A' )
+       and ( Upcase( c ) <= 'F' ) then
+      IntValue := 10 + Ord( Upcase( c ) ) - Ord( 'A' );
+
+    MapHexDigitToInt[ c ] := IntValue;
+  end;
+end;
+
+function HexDigitToInt( c: char ): longint;
+begin
+  Result := MapHexDigitToInt[ c ];
+  if Result = -1 then
+    raise EConvertError.Create( 'Invalid hex char: ' + c );
+end;
+
+function HexToInt( s: string ): longint;
+var
+  i: integer;
+begin
+  if Length( s ) = 0 then
+    raise EConvertError.Create( 'No chars in hex string' );
+  Result := 0;
+  for i:= 1 to Length( s ) do
+  begin
+    Result := Result shl 4;
+    inc( Result, HexDigitToInt( s[ i ] ) );
+  end;
+end;
+
+Function StringsSame( const a, b: string ): boolean;
+begin
+  Result:= CompareText( a, b ) = 0;
+end;
+
+// Returns S in single quotes
+Function StrQuote( const s: string ): string;
+begin
+  Result := StrSingleQuote + s + StrSingleQuote;
+end;
+
+// Returns S without double quotes
+Function StrUnQuote( const s: string ): string;
+begin
+  Result := S;
+  if S = '' then
+    exit;
+
+  if Result[ 1 ] = StrSingleQuote then
+    Delete( Result, 1, 1 );
+
+  if Result = '' then
+    exit;
+
+  if Result[ Length( Result ) ] = StrSingleQuote then
+    Delete( Result, Length( Result ), 1 );
+end;
+
+Function StrFullDoubleQuote( const s: string ): string;
+begin
+  Result := StrDoubleQuote
+            + InsertDuplicateChars( s, '"' )
+            + StrDoubleQuote;
+end;
+
+// Returns S without double quotes
+Function StrUnDoubleQuote( const s: string ): string;
+begin
+  Result := S;
+  if S = '' then
+    exit;
+
+  if Result[ 1 ] = StrDoubleQuote then
+    Delete( Result, 1, 1 );
+
+  if Result = '' then
+    exit;
+
+  if Result[ Length( Result ) ] = StrDoubleQuote then
+    Delete( Result, Length( Result ), 1 );
+end;
+
+Function StrInSingleQuotes(const aString : String) : String;
+begin
+  Result := StrSingleQuote + aString + StrSingleQuote;
+end;
+
+Function StrInDoubleQuotes(const aString : String) : String;
+begin
+  Result := StrDoubleQuote + aString + StrDoubleQuote;
+end;
+
+Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string;
+Var
+  i: longint;
+Begin
+  Result:= S;
+  for i:=1 to length( S ) do
+    if Result[ i ] = Find then
+      Result[ i ]:= Replace;
+End;
+
+Function StrRight( const S:string; const count:integer ):string;
+Begin
+  if count>=length(s) then
+  begin
+    Result:=S;
+  end
+  else
+  begin
+    Result:=copy( S, length( s )-count+1, count );
+  end;
+end;
+
+Function StrLeft( const S:string; const count:integer ):string;
+Begin
+  if count>=length(s) then
+    Result:=S
+  else
+    Result:=copy( S, 1, count );
+end;
+
+// Returns S minus count characters from the right
+Function StrLeftWithout( const S:string; const count:integer ):string;
+Begin
+  Result:= copy( S, 1, length( S )-count );
+End;
+
+Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string;
+Begin
+  Result:= S;
+  Delete( Result, 1, leftCount );
+  Delete( Result, length( S )-rightCount, rightCount );
+End;
+
+Function StrRightFrom( const S:string; const start:integer ):string;
+Begin
+  Result:= copy( S, start, length( S )-start+1 );
+end;
+
+Procedure ParseConfigLine( const S: string;
+                           var keyName: string;
+                           var keyValue: string );
+Var
+  line: String;
+  EqualsPos: longint;
+Begin
+  KeyName:= '';
+  KeyValue:= '';
+
+  line:= trim( S );
+  EqualsPos:= Pos( '=', line );
+
+  if ( EqualsPos>0 ) then
+  begin
+    KeyName:= line;
+    Delete( KeyName, EqualsPos, length( KeyName )-EqualsPos+1 );
+    KeyName:= Trim( KeyName );
+
+    KeyValue:= line;
+    Delete( KeyValue, 1, EqualsPos );
+    KeyValue:= Trim( KeyValue );
+  end;
+end;
+
+Function ExtractNextValueNoTrim( var S: string;
+                                 const Separator: string ): string;
+Var
+  SeparatorPos: integer;
+Begin
+  SeparatorPos := Pos( Separator, S );
+  if SeparatorPos > 0 then
+  begin
+    Result := Copy( S, 1, SeparatorPos-1 );
+    Delete( S, 1, SeparatorPos + length( Separator ) - 1 );
+  end
+  else
+  begin
+    Result := S;
+    S := '';
+  end;
+end;
+
+Function ExtractNextValue( var S: string;
+                           const Separator: string ): string;
+begin
+  Result := ExtractNextValueNoTrim( S, Separator );
+  Result := trim( Result );
+
+  // Remove quotes if present
+  if Result <> '' then
+    if Result[ 1 ] = StrDoubleQuote then
+      Delete( Result, 1, 1 );
+
+  if Result <> '' then
+    if Result[ length( Result ) ] = StrDoubleQuote then
+      Delete( Result, length( Result ), 1 );
+end;
+
+procedure GetNextValue( const S: String;
+                        Var Index: longint;
+                        Var Value: String;
+                        const Seperator: Char );
+var
+  NextSeperatorPosition: longint;
+  StringLen: longint;
+begin
+  Value := '';
+  StringLen := Length( S );
+  if Index > StringLen then
+    exit;
+  NextSeperatorPosition := Index;
+  while NextSeperatorPosition < StringLen do
+  begin
+    if S[ NextSeperatorPosition ] = Seperator then
+      break;
+    inc( NextSeperatorPosition );
+  end;
+
+  if NextSeperatorPosition < StringLen then
+  begin
+    Value := Copy( S,
+                   Index,
+                   NextSeperatorPosition - Index );
+    Index := NextSeperatorPosition + 1;
+  end
+  else
+  begin
+    Value := Copy( S,
+                   Index,
+                   StringLen - Index + 1 );
+    Index := StringLen + 1;
+  end;
+  TrimRight( Value );
+end;
+
+Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String);
+Var
+  tmpState : (WHITESPACE, INSIDE, START_QUOTE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE);
+  tmpCurrentParsePosition : Integer;
+  tmpCurrentChar : Char;
+  tmpPart : String;
+
+Begin
+  if (length(aReceiver) < 1) then exit;
+
+  tmpState := WHITESPACE;
+  tmpPart := '';
+
+  tmpCurrentParsePosition := 1;
+
+  for tmpCurrentParsePosition:=1 to length(aReceiver) do
+  begin
+    tmpCurrentChar := aReceiver[tmpCurrentParsePosition];
+
+    Case tmpCurrentChar of
+      ' ', StrTAB :
+      begin
+
+        Case tmpState of
+
+          WHITESPACE :
+          begin
+            // nothing
+          end;
+
+          INSIDE :
+          begin
+            aResult.add(tmpPart);
+            tmpPart := '';
+            tmpState := WHITESPACE;
+          end;
+
+          INSIDE_QUOTED :
+          begin
+            tmpPart := tmpPart + tmpCurrentChar;
+          end;
+
+          START_QUOTE :
+          begin
+            tmpPart := tmpPart + tmpCurrentChar;
+            tmpState := INSIDE_QUOTED;
+          end;
+
+          INSIDE_QUOTED_START_QUOTE :
+          begin
+            aResult.add(tmpPart);
+            tmpPart := '';
+            tmpState := WHITESPACE;
+          end;
+        end;
+      end;
+
+      StrDoubleQuote :
+      begin
+
+        Case tmpState of
+
+          WHITESPACE :
+          begin
+            tmpState := START_QUOTE;
+          end;
+
+          INSIDE :
+          begin
+            aResult.add(tmpPart);
+            tmpPart := '';
+            tmpState := START_QUOTE;
+          end;
+
+          INSIDE_QUOTED :
+          begin
+            tmpState := INSIDE_QUOTED_START_QUOTE;
+          end;
+
+          START_QUOTE :
+          begin
+            tmpState := INSIDE_QUOTED_START_QUOTE;
+          end;
+
+          INSIDE_QUOTED_START_QUOTE :
+          begin
+            tmpPart := tmpPart + tmpCurrentChar;
+            tmpState := INSIDE_QUOTED;
+          end;
+        end;
+      end;
+
+      else
+      begin
+        Case tmpState of
+
+          WHITESPACE :
+          begin
+            tmpPart := tmpPart + tmpCurrentChar;
+            tmpState := INSIDE;
+          end;
+
+          INSIDE, INSIDE_QUOTED :
+          begin
+            tmpPart := tmpPart + tmpCurrentChar;
+          end;
+
+          START_QUOTE :
+          begin
+            tmpPart := tmpPart + tmpCurrentChar;
+            tmpState := INSIDE_QUOTED;
+          end;
+
+          INSIDE_QUOTED_START_QUOTE :
+          begin
+            aResult.add(tmpPart);
+            tmpPart := tmpCurrentChar;
+            tmpState := INSIDE;
+          end;
+        end;
+      end;
+
+    end;
+  end;
+
+  Case tmpState of
+    WHITESPACE, START_QUOTE : {nothing to do};
+
+    INSIDE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE :
+    begin
+      aResult.add(tmpPart);
+    end;
+  end;
+end;
+
+Procedure PrivateStrExtractStrings(   Var aResult: TStrings;
+                                      const aReceiver: String;
+                                      const aSetOfChars: TSetOfChars;
+                                      const anEscapeChar: char;
+                                      const anIgnoreEmptyFlag : boolean);
+Var
+  i : Integer;
+  tmpChar,tmpNextChar : Char;
+  tmpPart: String;
+Begin
+  if (length(aReceiver) < 1) then exit;
+
+  tmpPart := '';
+
+  i := 1;
+  while i <= length(aReceiver) do
+  begin
+    tmpChar := aReceiver[i];
+    if i < length(aReceiver) then
+      tmpNextChar := aReceiver[i+1]
+    else
+      tmpNextChar := #0;
+
+    if (tmpChar = anEscapeChar) and (tmpNextChar = anEscapeChar) then
+    begin
+      tmpPart := tmpPart + anEscapeChar;
+      i := i + 2;
+    end
+    else
+      if (tmpChar = anEscapeChar) and (tmpNextChar in aSetOfChars) then
+      begin
+        tmpPart := tmpPart + tmpNextChar;
+        i := i + 2;
+      end
+      else
+      begin
+        if (tmpChar in aSetOfChars) then
+        begin
+          if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then
+            aResult.add(tmpPart);
+          tmpPart := '';
+          i := i + 1;
+        end
+        else
+        begin
+          tmpPart := tmpPart + tmpChar;
+          i := i + 1;
+        end;
+      end;  { if/else }
+  end;
+
+  if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then
+  begin
+    aResult.add(tmpPart);
+  end;
+end;
+
+procedure StrExtractStrings(Var aResult: TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
+begin
+  PrivateStrExtractStrings(aResult, aReceiver, aSetOfChars, anEscapeChar, false);
+end;
+
+
+Function IsDigit( const c: char ): boolean;
+Begin
+  Result:=( c>='0' ) and ( c<='9' );
+End;
+
+Function IsNonDigit( const c: char ): boolean;
+Begin
+  Result:=( c<'0' ) or ( c>'9' );
+End;
+
+Function IsAlpha( const c: char ): boolean;
+var
+  UppercaseC: char;
+Begin
+  UppercaseC := UpCase( c );
+  Result := ( UppercaseC >= 'A' ) and ( UppercaseC <= 'Z' );
+end;
+
+{$ifdef os2}
+// Returns true if s is only spaces (or empty)
+Function IsSpaces( const s: string ): boolean;
+Begin
+  Asm
+  MOV ESI,s   // get address of s into ESI
+  MOV CL,[ESI]     // get length of s
+  MOVZX ECX, CL      // widen CL
+  INC ECX
+
+!IsSpacesLoop:
+  INC ESI   // move to next char
+  DEC ECX
+  JE !IsSpacesTrue
+
+  MOV AL,[ESI] // load character
+  CMP AL,32  // is it a space?
+  JE !IsSpacesLoop // yes, go to next
+
+  // no, return false
+  MOV EAX, 0
+  JMP !IsSpacesDone
+
+!IsSpacesTrue:
+  MOV EAX, 1
+
+!IsSpacesDone:
+  LEAVE
+  RETN32 4
+  End;
+
+End;
+{$else}
+// Returns true if s is only spaces (or empty)
+Function IsSpaces( const s: string ): boolean;
+var
+  i: longint;
+Begin
+  for i := 1 to length( s ) do
+  begin
+    if s[ i ] <> ' ' then
+    begin
+      result := false;
+      exit;
+    end;
+  end;
+  result := true;
+end;
+{$endif}
+
+Function StrLeft0Pad( const n: integer; const width: integer ): string;
+Begin
+  Result:= IntToStr( n );
+  while length( Result )<width do
+    Result:= '0' +Result;
+End;
+
+// Returns true if s starts with start
+Function StrStarts( const start: string; const s: string ): boolean;
+Var
+  i: integer;
+Begin
+  Result:= false;
+  if length( start ) > length( s ) then
+    exit;
+  for i:= 1 to length( start ) do
+    if UpCase( s[ i ] ) <> UpCase( start[ i ] ) then
+      exit;
+  Result:= true;
+End;
+
+// Returns true if s ends with endstr (case insensitive)
+Function StrEnds( const endStr: string; const s: string ): boolean;
+Var
+  i, j: integer;
+Begin
+  Result:= false;
+  if Length( s ) < length( endStr ) then
+    exit;
+  j:= Length( s );
+  for i:= length( endstr ) downto 1 do
+  begin
+    if UpCase( s[ j ] ) <> UpCase( endStr[ i ] ) then
+      exit;
+    dec( j );
+  end;
+  Result:= true;
+End;
+
+Procedure RemoveSeparatorSpaces( var S: string;
+                                 const Separator:string );
+Var
+  SeparatorPos:integer;
+  NewString: string;
+Begin
+  NewString := '';
+  while S <> '' do
+  begin
+    SeparatorPos := pos( Separator, S );
+    if SeparatorPos > 0 then
+    begin
+      NewString := NewString
+                   + trim( copy( S, 1, SeparatorPos - 1 ) )
+                   + Separator;
+      Delete( S, 1, SeparatorPos );
+    end
+    else
+    begin
+      NewString := NewString + trim( S );
+      S := '';
+    end;
+  end;
+  S := NewString;
+End;
+
+Procedure AddToListString( Var S: string;
+                           const NewValue: string;
+                           const Separator: string );
+Begin
+  if trim( S )<>'' then
+    S:=S+Separator;
+  S:=S+NewValue;
+End;
+
+Function ListToString( List: TStrings;
+                       const Separator: string ): string;
+Var
+  i: longint;
+Begin
+  Result:= '';
+  for i:= 0 to List.Count - 1 do
+    AddToListString( Result, List[ i ], Separator );
+End;
+
+procedure StringToList( S: String;
+                        List: TStrings;
+                        const Separator: string );
+var
+  Item: string;
+begin
+  List.Clear;
+  while S <> '' do
+  begin
+    Item:= ExtractNextValue( S, Separator );
+    List.Add( Item );
+  end;
+end;
+
+Function StrFirstWord( const S: String ): string;
+Var
+  SpacePos: longint;
+  temp: string;
+Begin
+  temp:= trimleft( S );
+  SpacePos:= pos( ' ', temp );
+  if SpacePos>0 then
+    Result:= Copy( temp, 1, SpacePos-1 )
+  else
+    Result:= temp;
+End;
+
+Function StrEscapeAllCharsBy(Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char): String;
+Var
+  i : Integer;
+  tmpChar : Char;
+Begin
+  Result := '';
+
+  for i := 1 To length(aReceiver) do
+  begin
+    tmpChar := aReceiver[i];
+
+    if (tmpChar = anEscapeChar) or (tmpChar IN aSetOfChars) then
+      result := result + anEscapeChar + tmpChar
+    else
+      result := result + tmpChar;
+  end;
+end;
+
+const
+  StartPunctuationChars: set of char =
+    [ '(', '[', '{', '<', '''', '"' ];
+
+  EndPunctuationChars: set of char =
+    [ ')', ']', '}', '>', '''', '"', '.', ',', ':', ';', '!', '?' ];
+
+procedure TrimPunctuation( var s: string );
+var
+  ChangesMade: boolean;
+  c: Char;
+begin
+  while Length(s) > 0 do
+  begin
+    ChangesMade := false;
+    c := s[1];
+    if c in StartPunctuationChars then
+    begin
+      ChangesMade := true;
+      Delete(s, 1, 1);
+    end;
+
+    if Length(s) = 0 then
+      exit;
+
+    c := s[Length(s)];
+    if c in EndPunctuationChars then
+    begin
+      ChangesMade := true;
+      Delete(s, Length(s), 1);
+    end;
+
+    if not ChangesMade then
+      exit; // done
+  end;
+end;
+
+function IsDomainName( const s: string; StartingAt: longint ): boolean;
+var
+  DotPos: longint;
+  t: string;
+begin
+  Result := false;
+  t := Copy(s, StartingAt+1, Length(s));
+
+  // must be a dot in the domain...
+  DotPos := pos('.', t);
+  if DotPos = 0 then
+    // nope
+    exit;
+
+  // must be some text between start and dot,
+  // and between dot and end
+  // ie. a.b not .b or a.
+
+  if DotPos = Length(t) then
+    // no b;
+    exit;
+
+  Result := true;
+end;
+
+function IsEmailAddress( const s: string ): boolean;
+var
+  AtPos: longint;
+  SecondAtPos: longint;
+begin
+  result := false;
+  // must be a @...
+  AtPos := pos('@', s);
+  if AtPos = 0 then
+    // no @
+    exit;
+  if AtPos = 1 then
+    // can't be the first char though
+    exit;
+
+  // there is? There must be only one though...
+  SecondAtPos := LastDelimiter('@', s);
+  if (SecondAtPos <> AtPos) then
+    // there's a second @
+    exit;
+
+  Result := IsDomainName( s, AtPos + 1 );
+end;
+
+function CheckAndEncodeURL( var s: string ): boolean;
+  // simple userfriendly routine
+  function StartsWith(const s:string; const text: string): boolean;
+  begin
+    Result := pos(text, s) = 1;
+  end;
+
+begin
+
+  if StartsWith(s, 'www.') then
+  begin
+    if not IsDomainName( s, 4 ) then
+      exit;
+    Insert('http://', s, 1);
+    Result := true;
+    exit;
+  end;
+
+  if StartsWith(s, 'ftp.') then
+  begin
+    if not IsDomainName( s, 4 ) then
+      exit;
+    Insert('ftp://', s, 1);
+    Result := true;
+    exit;
+  end;
+
+  if    StartsWith(s, 'http://' )
+     or StartsWith(s, 'https://' )
+     or StartsWith(s, 'ftp://' )
+     or StartsWith(s, 'mailto:' )
+     or StartsWith(s, 'news:' ) then
+  begin
+    Result := true;
+    exit;
+  end;
+
+  if IsEmailAddress( s ) then
+  begin
+    Insert('mailto:', s, 1);
+    Result := true;
+    exit;
+  end;
+
+  Result := false;
+end;
+
+Function IncrementNumberedString( StartString: string ): string;
+Var
+  Number: string;
+  NewNumber: string;
+  i: integer;
+begin
+  // Extract any digits at the end of the string
+  i:= length( StartString );
+  Number:= '';
+  while i>0 do
+  begin
+    if isDigit( StartString[i] ) then
+    begin
+       Number:= StartString[i] + Number;
+       i:= i - 1;
+    end
+    else
+      break;
+  end;
+
+  if Number<>'' then
+  begin
+    // Found a numeric bit to play with
+    // Copy the first part
+    Result:= StrLeftWithout( StartString, length( Number ) );
+    NewNumber:= StrLeft0Pad( StrToInt( Number ) + 1,
+                               length( Number ) );
+    Result:= Result + NewNumber;
+  end
+  else
+    // No build number, add a 1
+    Result:= StartString + '1';
+end;
+
+{$ifdef OS2}
+
+Function AnsiTrim( const S: AnsiString ): AnsiString;
+Var
+  i: longint;
+Begin
+  i:= 1;
+  while i<length( S) do
+  begin
+    if S[ i ]<>' ' then
+      break;
+    inc( i );
+  end;
+  Result:= S;
+  if i>1 then
+    AnsiDelete( Result, 1, i-1 );
+  i:= length( Result );
+  while i>=1 do
+  begin
+    if S[ i ]<>' ' then
+      break;
+    dec( i );
+  end;
+  AnsiSetLength( Result, i );
+End;
+
+Procedure AnsiParseConfigLine( const S: Ansistring;
+                               var keyName: Ansistring;
+                               var keyValue: Ansistring );
+Var
+  line: AnsiString;
+  EqualsPos: longint;
+Begin
+  KeyName:= '';
+  KeyValue:= '';
+
+  line:= AnsiTrim( S );
+  EqualsPos:= AnsiPos( '=', line );
+
+  if ( EqualsPos>0 ) then
+  begin
+    KeyName:= AnsiCopy( line, 1, EqualsPos-1 );
+    KeyName:= AnsiTrim( KeyName );
+
+    KeyValue:= AnsiCopy( line, EqualsPos+1, length( line )-EqualsPos );
+    KeyValue:= AnsiTrim( KeyValue );
+  end;
+end;
+
+Function AnsiExtractNextValue( var CSVString: AnsiString;
+                               const Separator: AnsiString ): AnsiString;
+Var
+  SeparatorPos: integer;
+Begin
+  SeparatorPos:= AnsiPos( Separator, CSVString );
+  if SeparatorPos>0 then
+  begin
+    Result:= AnsiCopy( CSVString, 1, SeparatorPos-1 );
+    AnsiDelete( CSVString, 1, SeparatorPos + length( Separator ) - 1 );
+  end
+  else
+  begin
+    Result:= CSVString;
+    CSVString:= '';
+  end;
+  Result:= AnsiTrim( Result );
+  // Remove qyotes if present
+  if ( Result[1] = chr(34) )
+     and ( Result[ length(Result) ] = chr(34) ) then
+  begin
+    AnsiDelete( Result, 1, 1 );
+    AnsiDelete( Result, length( Result ), 1 );
+    Result:= AnsiTrim( Result );
+  end;
+end;
+{$Endif}
+
+Procedure ReverseList( TheList:TStrings );
+Var
+  TempList: TStringList;
+  i: integer;
+Begin
+  TempList:= TStringList.Create;
+  for i:=TheList.count-1 downto 0 do
+  begin
+    TempList.AddObject( TheList.Strings[i],
+                        TheList.Objects[i] );
+  end;
+  TheList.Assign( TempList );
+  TempList.Destroy;
+end;
+
+Function FindStringInList( const TheString: string;
+                           TheList:TStrings ): longint;
+Var
+  i: longint;
+Begin
+  for i:=0 to TheList.count-1 do
+  begin
+    if StringsSame( TheString, TheList[ i ] ) then
+    begin
+      // found
+      Result:=i;
+      exit;
+    end;
+  end;
+  Result:=-1;
+End;
+
+Procedure MergeStringLists( Dest: TStringList;
+                            AdditionalList: TStringList );
+var
+  i: integer;
+  s: string;
+begin
+  for i:= 0 to AdditionalList.Count - 1 do
+  begin
+    s:= AdditionalList[ i ];
+    if FindStringInList( s, Dest ) = -1 then
+      Dest.AddObject( s, AdditionalList.Objects[ i ] );
+  end;
+end;
+
+// ---------------------- PCHAR Utilities ---------------------------------------
+
+function StrNPas( const Ps: PChar; const Length: integer ): String;
+var
+  i: integer;
+begin
+  Result:= '';
+  i:= 0;
+  while ( Ps[ i ] <> #0 ) and ( i < Length ) do
+  begin
+    Result:= Result + Ps[ i ];
+    inc( i );
+  end;
+end;
+
+Function PCharDiff( const a: PChar; const b: Pchar ): longword;
+begin
+  Result:= longword( a ) - longword( b );
+end;
+
+Procedure CheckPCharSize( Var Text: PChar;
+                          const NeededSize: longword );
+var
+  temp: PChar;
+  NewBufferSize: longword;
+begin
+  if   ( NeededSize + 1 ) // + 1 to allow for null terminator
+     > StrBufSize( Text ) then
+  begin
+    // allocate new buffer, double the size...
+    NewBufferSize:= StrBufSize( Text ) * 2;
+    // or if that's not enough...
+    if NewBufferSize < ( NeededSize + 1 ) then
+      // double what we are going to need
+      NewBufferSize:= NeededSize * 2;
+    temp:= StrAlloc( NewBufferSize );
+
+    // copy string to new buffer
+    StrCopy( temp, Text );
+    StrDispose( Text );
+    Text:= temp;
+  end;
+end;
+
+Procedure AddAndResize( Var Text: PChar; const AddText: PChar );
+var
+ s: string;
+ s1, s2: string;
+begin
+  //CheckPCharSize( Text,
+  //                strlen( Text )
+  //                + strlen( AddText ) );
+  //StrCat( Text, AddText );
+  s1 := Text;
+  s2 := AddText;
+  s := s1 + s2;
+  StrDispose(Text);
+  Text := StrAlloc(length(s) + 1);
+  StrPCopy(Text, s);
+end;
+
+Procedure StrCopyAndResize( Var Dest: PChar;
+                            const Source: PChar );
+begin
+  CheckPCharSize( Dest, StrLen( Source ) );
+  StrCopy( Dest, Source );
+end;
+
+// trims spaces and carriage returns of the end of Text
+procedure TrimWhitespace( Text: PChar );
+var
+  P: PChar;
+  IsWhitespace: boolean;
+  TheChar: Char;
+begin
+  P:= Text + StrLen( Text );
+  while P > Text do
+  begin
+    dec( P );
+    TheChar:= P^;
+    IsWhitespace:= TheChar in [ ' ', #13, #10, #9 ];
+    if not IsWhiteSpace then
+      // done
+      break;
+    P[ 0 ]:= #0; // Do no use P^ :=
+  end;
+end;
+
+function TrimChars( const s: string;
+                    chars: TSetOfChars ): string;
+var
+  i: longint;
+  j: longint;
+begin
+  i := 1;
+  while i < Length( s ) do
+    if s[ i ] in chars then
+      inc( i )
+    else
+      break;
+
+  j := Length( s );
+  while j > i do
+    if s[ j ] in chars then
+      dec( j )
+    else
+      break;
+
+  result := Copy( s, i, j - i + 1 );
+end;
+
+procedure StrPCat( Var Dest: PChar;
+                   const StringToAdd: string );
+var
+  Index: longint;
+  DestP: PChar;
+begin
+  CheckPCharSize( Dest,
+                  StrLen( Dest )
+                  + longword( Length( StringToAdd ) ) );
+  DestP:= Dest + StrLen( Dest );
+  for Index:= 1 to Length( StringToAdd ) do
+  begin
+    DestP[ 0 ]:= StringToAdd[ Index ]; // do not use DestP^ :=
+    inc( DestP );
+  end;
+  DestP[ 0 ]:= #0; // Do not use DestP^ := #0; Under Sibyl at least, this writes *** 2 NULL BYTES!!! ***
+end;
+
+Procedure TrimEndLines( const S: PChar );
+var
+  StringIndex: integer;
+begin
+  StringIndex:= strlen( S );
+  while StringIndex > 0 do
+  begin
+    dec( StringIndex );
+    if S[ StringIndex ] in [ #10, #13 ] then
+    begin
+      S[ StringIndex ]:= #0
+    end
+    else
+      break;
+  end;
+end;
+
+Function StrDupPas( const s: string ): PChar;
+Begin
+  Result:=StrAlloc( length( s )+1 );
+  StrPCopy( Result, S );
+//  Result^:=s;
+End;
+
+// Returns a copy of the first n chars of s
+Function StrNDup( const s: PChar; const n: integer ): PChar;
+Begin
+  Result:= StrAlloc( n+1 );
+  Result[ n ]:= '6';
+  StrLCopy( Result, s, n );
+End;
+
+// Returns a copy of the first line starting at lineStart
+Function CopyFirstLine( const lineStart: PChar ): PChar;
+Var
+  lineEnd: PChar;
+  lineLength: integer;
+Begin
+  // look for an end of line
+  lineEnd:= strpos( lineStart, EndLine );
+  if lineEnd <> nil then
+  begin
+    // found, line length is difference between line end position and start of line
+    lineLength:= longword( lineEnd )-longword( lineStart ); // ugly but how else can it be done?
+    Result:= StrNDup( lineStart, lineLength );
+    exit;
+  end;
+
+  // no eol found, return copy of remainder of string
+  Result:= StrNew( lineStart );
+end;
+
+// Returns next line p points to
+Function NextLine( const p: PChar): PChar;
+Var
+  lineEnd: PChar;
+Begin
+  // look for an end of line
+  lineEnd:=strpos( p, EndLine );
+  if lineEnd<>nil then
+  begin
+    // Advance the linestart over the eol
+    Result:=lineEnd+length( EndLine );
+    exit;
+  end;
+
+  // no eol found, return pointer to null term
+  Result:=p+strlen( p );
+end;
+
+Function CaseInsensitivePos( const a: string; const b: string ): longint;
+begin
+  Result := Pos( UpperCase( a ), Uppercase( b ) );
+end;
+
+
+Function BoolToStr( const b: boolean ): string;
+begin
+  if b then
+    Result := 'True'
+  else
+    Result := 'False';
+end;
+
+// Return true if param matches the form
+// /Flag:value
+// dash (-) can be used instead of slash (/)
+// colon can be omitted
+function MatchValueParam( const Param: string;
+                          const Flag: string;
+                          var Value: string ): boolean;
+begin
+  Result := false;
+
+  if Param = '' then
+    exit;
+
+  if     ( Param[ 1 ] <> '/' )
+     and ( Param[ 1 ] <> '-' ) then
+    exit;
+
+  if not StringsSame( Copy( Param, 2, Length( Flag ) ),
+                      Flag ) then
+    exit;
+
+  Result := true;
+
+  Value := StrRightFrom( Param, 2 + Length( Flag ) );
+  if Value <> '' then
+    if Value[ 1 ] = ':' then
+      Delete( Value, 1, 1 );
+end;
+
+// Return true if param matches the form
+// /Flag
+// dash (-) can be used instead of slash (/)
+function MatchFlagParam( const Param: string;
+                         const Flag: string ): boolean;
+begin
+  Result := false;
+
+  if Param = '' then
+    exit;
+
+  if     ( Param[ 1 ] <> '/' )
+     and ( Param[ 1 ] <> '-' ) then
+    exit;
+
+  Result := StringsSame( StrRightFrom( Param, 2 ),
+                         Flag );
+end;
+
+function StrStartsWithIgnoringCase(const aReceiver: String; const aStartString: String): Boolean;
+var
+  tmpStringPos : integer;
+  tmpStartStringLength : integer;
+begin
+  tmpStartStringLength := Length(aStartString);
+
+  if Length(aReceiver) < tmpStartStringLength then
+  begin
+    result := false;
+    exit;
+  end;
+
+  for tmpStringPos := 1 to tmpStartStringLength do
+  begin
+    if UpCase(aReceiver[tmpStringPos]) <> UpCase(aStartString[tmpStringPos]) then
+    begin
+      result := false;
+      exit;
+    end;
+  end;
+
+  result := true;
+end;
+
+Function StrEndsWithIgnoringCase(const aReceiver: String; const anEndString: String): Boolean;
+Var
+  tmpStringPos : Longint;
+  tmpMatchPos : Longint;
+Begin
+  tmpStringPos := length(aReceiver);
+  tmpMatchPos := length(anEndString);
+
+  if tmpMatchPos > tmpStringPos then
+  begin
+    result := false;
+    exit;
+  end;
+
+  while tmpMatchPos > 0 do
+  begin
+    if upcase(aReceiver[tmpStringPos]) <> upcase(anEndString[tmpMatchPos]) then
+    begin
+      result := false;
+      exit;
+    end;
+    dec(tmpMatchPos);
+    dec(tmpStringPos);
+  end;
+
+  result := true;
+end;
+
+function StrIsEmptyOrSpaces(const AText: string): boolean;
+begin
+  Result := Trim(AText) = '';
+end;
+
+{ TSerializableStringList }
+
+constructor TSerializableStringList.Create;
+begin
+  LogEvent(LogObjConstDest, 'TSerializableStringList createdestroy');
+  inherited Create;
+  stringList := TStringList.Create;
+end;
+
+destructor TSerializableStringList.Destroy;
+begin
+  LogEvent(LogObjConstDest, 'TSerializableStringList destroy');
+  stringList.Free;
+  inherited Destroy;
+end;
+
+function TSerializableStringList.getCount: LongInt;
+begin
+  Result := stringlist.Count;
+end;
+
+function TSerializableStringList.get(const anIndex: LongInt): String;
+begin
+  Result := stringList[anIndex];
+end;
+
+function TSerializableStringList.getSerializedString: String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 0 to stringList.count-1 do
+  begin
+    if (i > 0) then result := result + '&';
+    Result := Result + StrEscapeAllCharsBy(stringList[i], ['&'], '\');
+  end;
+end;
+
+procedure TSerializableStringList.add(const aString: String);
+begin
+  stringList.add(aString);
+end;
+
+procedure TSerializableStringList.readValuesFromSerializedString(const aSerializedString: String);
+begin
+  if length(aSerializedString) < 1 then
+    exit;
+  LogEvent(LogObjConstDest, 'readValuesFromSerializedString');
+  stringList.Clear;
+  LogEvent(LogObjConstDest, 'readValuesFromSerializedString clear done');
+  StrExtractStrings(stringList, aSerializedString, ['&'], '\');
+end;
+
+initialization
+  InitHexDigitMap;
+
+End.
diff --git a/docview/components/richtext/CanvasFontManager.pas b/docview/components/richtext/CanvasFontManager.pas
new file mode 100644
index 00000000..86a52b9d
--- /dev/null
+++ b/docview/components/richtext/CanvasFontManager.pas
@@ -0,0 +1,1139 @@
+Unit CanvasFontManager;
+
+{$mode objfpc}{$H+}
+
+Interface
+
+Uses
+  Classes
+  ,fpg_base
+  ,fpg_main
+  ,fpg_widget
+  ;
+
+Const
+  // This defines the fraction of a pixel that
+  // font character widths will be given in
+  FontWidthPrecisionFactor = 1; // 256 seems to be specific to OS/2 API
+  DefaultTopicFont = 'Sans';
+  DefaultTopicFontSize = '10';
+  DefaultTopicFixedFont = 'Courier New';
+  DefaultTopicFixedFontSize = '10';
+
+
+Type
+  {Standard Font types}
+  TFontType=(ftBitmap,ftOutline);
+
+  {Standard Font Attributes}
+  TFontAttributes=Set Of(faItalic,faUnderScore,faOutline,faStrikeOut,faBold);
+
+  {Standard Font pitches}
+  TFontPitch=(fpFixed,fpProportional);
+
+  {Standard Font character Set}
+  TFontCharSet=(fcsSBCS,fcsDBCS,fcsMBCS);  {Single,Double,mixed Byte}
+
+
+  // a user-oriented specification of a font; not an actual structure in the INF file
+  TFontSpec = record
+    FaceName: string[ 64 ];
+    PointSize: integer; // if 0 then use x/y size
+    XSize: integer;
+    YSize: integer;
+    Attributes: TFontAttributes; // set of faBold, faItalic etc
+  end;
+
+  // NOTE: Char widths are in 1/FontWidthPrecisionFactor units
+  TCharWidthArray = array[ #0..#255 ] of longint;
+  TPCharWidthArray = ^TCharWidthArray;
+
+  // Used internally for storing full info on font
+  TLogicalFont = class(TObject)
+  public
+    FaceName: string; // user-selected name
+    UseFaceName: string; // after substitutions.
+
+    // Selected bits of FONTMETRICS
+    fsSelection: word; //USHORT;
+
+    FontType: TFontType;
+    FixedWidth: boolean;
+    PointSize: integer;
+    ID: integer;
+    Attributes: TFontAttributes;
+
+    // this can be nil if not already fetched
+    pCharWidthArray: TPCharWidthArray;
+    lMaxbaselineExt: longint; //LONG;
+    lAveCharWidth: longint; //LONG;
+    lMaxCharInc: longint; //LONG;
+    lMaxDescender: longint; //LONG;
+  public
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+
+  TFontFace = class(TObject)
+  public
+    Name: string;
+    FixedWidth: boolean;
+    FontType: TFontType;
+    Sizes: TList; // relevant for bitmap fonts only - contains TLogicalFont objects
+    constructor Create;
+    destructor  Destroy; override;
+  end;
+
+
+  TCanvasFontManager = class(TObject)
+  private
+    FWidget: TfpgWidget;
+  protected
+    FCanvas: TfpgCanvas;
+    FLogicalFonts: TList;
+    FCurrentFontSpec: TFontSpec;
+    FDefaultFontSpec: TFontSpec;
+    FCurrentFont: TLogicalFont;
+    FAllowBitmapFonts: boolean;
+    function    CreateFont( const FontSpec: TFontSpec ): TLogicalFont;
+    function    GetFont( const FontSpec: TFontSpec ): TLogicalFont;
+    procedure   RegisterFont( Font: TLogicalFont );
+    procedure   SelectFont( Font: TLogicalFont; Scale: longint );
+    // Retrieve character widths for current font
+    procedure   LoadMetrics;
+    // load metrics if needed
+    procedure   EnsureMetricsLoaded;
+  public
+    constructor Create(Canvas: TfpgCanvas; AllowBitmapFonts: boolean; AWidget: TfpgWidget); reintroduce;
+    destructor  Destroy; override;
+    // Set the font for the associated canvas.
+    procedure   SetFont( const FontSpec: TFontSpec );
+    // Retrieve the width of the given char, in the current font
+    function    CharWidth( const C: Char ): longint;
+    function    AverageCharWidth: longint;
+    function    MaximumCharWidth: longint;
+    function    IsFixed: boolean;
+    function    CharHeight: longint;
+    function    CharDescender: longint;
+    procedure   DrawString(var Point: TPoint; const Length: longint; const S: PChar);
+    property    Canvas: TfpgCanvas read FCanvas;
+    property    Widget: TfpgWidget read FWidget;
+    property    DefaultFontSpec: TFontSpec read FDefaultFontSpec write FDefaultFontSpec;
+  end;
+
+
+// Convert a Sibyl font to a FontSpec (Color is left the same)
+procedure FPGuiFontToFontSpec( Font: TfpgFont; Var FontSpec: TFontSpec );
+
+  // Thoughts on how it works....
+
+  // SelectFont looks for an existing logical font that
+  // matches the request. If found selects that logical font
+  // onto the canvas.
+
+  // If not found it creates a logical font and selects that onto
+  // the canvas.
+
+  // For bitmap fonts the logical font definition includes pointsize
+  // For outline fonts the defn is only face+attr; in this case
+  // selectfont also ses the 'CharBox' according to the point size.
+
+implementation
+
+uses
+  SysUtils
+  ,ACLStringUtility
+  ,nvUtilities
+  ,fpg_stringutils
+  ;
+
+
+var
+  FontFaces: TList = nil; // of TFontface
+  DefaultOutlineFixedFace: TFontFace;
+  DefaultOutlineProportionalFace: TFontFace;
+
+// TFontFace
+//------------------------------------------------------------------------
+
+constructor TFontface.Create;
+begin
+  Sizes := TList.Create;
+  FontType := ftOutline; // in fpGUI we treat all fonts as scalable (preference)
+end;
+
+destructor TFontface.Destroy;
+begin
+  Sizes.Free;
+end;
+
+// TLogicalFont
+//------------------------------------------------------------------------
+
+constructor TLogicalFont.Create;
+begin
+  FontType := ftOutline;
+  PointSize := 10;
+  Attributes := [];
+  FixedWidth := False;
+end;
+
+// frees allocated memory, if any.
+// Note - does not delete the Gpi Logical Font
+destructor TLogicalFont.Destroy;
+begin
+  if pCharWidthArray <> nil then
+    FreeMem( pCharWidthArray,
+             sizeof( TCharWidthArray ) );
+
+  inherited Destroy;
+end;
+
+
+// Convert a fpGUI Toolkit font to a FontSpec
+//------------------------------------------------------------------------
+procedure FPGuiFontToFontSpec( Font: TfpgFont; Var FontSpec: TFontSpec );
+var
+  s: string;
+  facename: string;
+  cp: integer;
+  c: char;
+  token: string;
+  prop, propval: string;
+  desc: string;
+
+  function NextC: char;
+  begin
+    Inc(cp);
+    if cp > length(desc) then
+      c := #0
+    else
+      c := desc[cp];
+    Result := c;
+  end;
+
+  procedure NextToken;
+  begin
+    token := '';
+    while (c <> #0) and (c in [' ', 'a'..'z', 'A'..'Z', '_', '0'..'9']) do
+    begin
+      token := token + c;
+      NextC;
+    end;
+  end;
+
+begin
+  cp := 0;
+  desc := Font.FontDesc;
+  // find fontface
+  NextC;
+  NextToken;
+  FontSpec.FaceName := token;
+  FontSpec.Attributes := [];
+  FontSpec.XSize := Font.TextWidth('v');
+  FontSpec.YSize := Font.Height;
+
+  // find font size
+  if c = '-' then
+  begin
+    NextC;
+    NextToken;
+    FontSpec.PointSize := StrToIntDef(token, 10);
+  end;
+
+  // find font attributes
+  while c = ':' do
+  begin
+    NextC;
+    NextToken;
+    prop    := UpperCase(token);
+    propval := '';
+
+    if c = '=' then
+    begin
+      NextC;
+      NextToken;
+      propval := UpperCase(token);
+    end;
+    // convert fontdesc attributes to fontspec attributes
+    if prop = 'BOLD' then
+      include(FontSpec.Attributes, faBold)
+    else if prop = 'ITALIC' then
+      include(FontSpec.Attributes, faItalic)
+    else if prop = 'UNDERLINE' then
+      include(FontSpec.Attributes, faUnderScore)
+  end;
+end;
+
+// Find a font face with the given name
+//------------------------------------------------------------------------
+function FindFaceName( const name: string ): TFontFace;
+Var
+  FaceIndex: LongInt;
+  Face: TFontFace;
+begin
+  for FaceIndex := 0 to FontFaces.Count - 1 do
+  begin
+    Face := TFontFace(FontFaces[ FaceIndex ]);
+
+    if pos(UpperCase(name), UpperCase(Face.Name)) > 0 then
+    begin
+      Result := Face;
+      exit;
+    end;
+  end;
+  Result := nil;
+end;
+
+// Return the first font face of type = Outline (scalable)
+//------------------------------------------------------------------------
+function GetFirstOutlineFace( FixedWidth: boolean ): TFontFace;
+Var
+  FaceIndex: LongInt;
+  Face: TFontFace;
+begin
+  for FaceIndex := 0 to FontFaces.Count - 1 do
+  begin
+    Face := TFontFace(FontFaces[ FaceIndex ]);
+
+    if     ( Face.FixedWidth = FixedWidth )
+       and ( Face.FontType = ftOutline ) then
+    begin
+      Result := Face;
+      exit;
+    end;
+  end;
+  Result := nil;
+end;
+
+// Find the bitmap font which best matches the given pointsize.
+//------------------------------------------------------------------------
+function GetClosestBitmapFixedFont( const PointSize: longint ): TLogicalFont;
+Var
+  FaceIndex: Longint;
+  FontIndex: longint;
+  Face: TFontFace;
+  Font: TLogicalFont;
+begin
+  Result := nil;
+  for FaceIndex := 0 to FontFaces.Count - 1 do
+  begin
+    Face := TFontFace(FontFaces[ FaceIndex ]);
+
+    if Face.FontType = ftBitmap then
+    begin
+      for FontIndex := 0 to Face.Sizes.Count - 1 do
+      begin
+        Font := TLogicalFont(Face.Sizes[ FontIndex ]);
+        if Font.FixedWidth then
+        begin
+          if    ( Result = nil )
+             or ( Abs( Font.PointSize - PointSize )
+                  < Abs( Result.PointSize - PointSize ) ) then
+            Result := Font;
+        end;
+      end;
+    end;
+  end;
+end;
+
+// Pick some nice default fonts.
+//------------------------------------------------------------------------
+procedure GetDefaultFonts;
+begin
+  // courier new is common and reasonably nice
+  DefaultOutlineFixedFace := FindFaceName( 'Courier New' );
+  if DefaultOutlineFixedFace = nil then
+  begin
+    DefaultOutlineFixedFace := GetFirstOutlineFace( true ); // first fixed outline face
+  end;
+
+  DefaultOutlineProportionalFace := FindFaceName( DefaultTopicFont );
+  if DefaultOutlineProportionalFace = nil then
+  begin
+    DefaultOutlineProportionalFace := GetFirstOutlineFace( false ); // first prop outline face
+  end;
+end;
+
+// Fetch the global list of font faces and sizes
+//------------------------------------------------------------------------
+procedure GetFontList;
+Var
+  Count: LongInt;
+  T: LongInt;
+  Font: TLogicalFont;
+  Face: TFontFace;
+  FamilyName: string;
+  fl: TStringList;
+  f: TfpgFont;
+begin
+  fl := nil;
+  FontFaces := TList.Create;
+  fl := fpgApplication.GetFontFaceList;
+
+  // Get font count
+  Count := fl.Count;
+  If Count > 0 Then
+  Begin
+    For T := 0 To Count - 1 Do
+    Begin
+      Font := TLogicalFont.Create;
+      Font.FaceName := fl[T];
+      f := fpgGetFont(Font.FaceName + '-10');
+      if (pos('COURIER', UpperCase(Font.FaceName)) > 0) or (pos('MONO', UpperCase(Font.FaceName)) > 0) then
+        Font.FixedWidth := True;
+      Font.lAveCharWidth := f.TextWidth('g');
+      Font.lMaxbaselineExt := f.Height;
+      //Font.fsSelection := pfm^[ T ].fsSelection;
+      //Font.lMaxbaselineExt := pfm^[ T ].lMaxbaselineExt;
+      //Font.lAveCharWidth := pfm^[ T ].lAveCharWidth;
+      //Font.lMaxCharInc := pfm^[ T ].lMaxCharInc;
+      Font.ID := -1; // and always shall be so...
+      f.Free;
+
+      Face := FindFaceName( Font.FaceName );
+      if Face = nil then
+      begin
+        // new face found
+        Face := TFontFace.Create;
+        Face.Name := Font.FaceName; // point to the actual face name string!
+        Face.FixedWidth := Font.FixedWidth;
+        Face.FontType := Font.FontType;
+        FontFaces.Add( Face );
+      end;
+      Face.Sizes.Add( Font );
+    End;
+  End;
+
+  // pick some for defaults
+  GetDefaultFonts;
+end;
+
+// Add .subscript to font name for attributes
+//------------------------------------------------------------------------
+Function ModifyFontName( const FontName: string;
+                         const Attrs: TFontAttributes ): String;
+Begin
+  Result := FontName;
+  If faItalic in Attrs Then
+    Result := Result + '.Italic';
+  If faBold in Attrs Then
+    Result := Result + '.Bold';
+  If faOutline in Attrs Then
+    Result := Result + '.Outline';
+  If faStrikeOut in Attrs Then
+    Result := Result + '.Strikeout';
+  If faUnderScore in Attrs Then
+    Result := Result + '.Underscore';
+End;
+
+// Create a font without attributes
+//------------------------------------------------------------------------
+function CreateFontBasic( const FaceName: string; const PointSize: integer ): TLogicalFont;
+var
+  PPString: string;
+begin
+  Result := TLogicalFont.Create;
+  if FindFaceName( FaceName ) = nil then
+    Exit;  //==>
+  Result.PointSize := PointSize; // will use later if the result was an outline font...
+  Result.FaceName := FaceName;
+
+  // OK now we have found the font face...
+  PPString := IntToStr( PointSize) + '.' + FaceName;
+
+  PPString := ModifyFontName( PPString, [] );
+end;
+
+// Provide outline substitutes for some common bitmap fonts
+// From Mozilla/2 source.
+//------------------------------------------------------------------------
+function SubstituteBitmapFontToOutline( const FaceName: string ): string;
+begin
+  if StringsSame( FaceName, 'Helv' ) then
+    result := DefaultTopicFont
+  else if StringsSame( FaceName, 'Helvetica' ) then
+    result := DefaultTopicFont
+  else if StringsSame( FaceName, 'Tms Rmn' ) then
+    result := 'Times New Roman'
+  else if StringsSame( FaceName, 'System Proportional' ) then
+    result := DefaultTopicFont
+  else if StringsSame( FaceName, 'System Monospaced' ) then
+    result := DefaultTopicFixedFont
+  else if StringsSame( FaceName, 'System VIO' ) then
+    result := DefaultTopicFixedFont
+  else
+    result := FaceName; // no substitution
+end;
+
+// Ask OS/2 dummy font window to convert a font spec
+// into a FONTMETRICS.
+//------------------------------------------------------------------------
+//procedure AskOS2FontDetails( const FaceName: string;
+//                             const PointSize: longint;
+//                             const Attributes: TFontAttributes;
+//                             var FontInfo: FONTMETRICS );
+//var
+//  PPString: string;
+//  PresSpace: HPS;
+//begin
+//  // Hack from Sibyl code - we don't know WTF the algorithm is
+//  // for selecting between outline/bitmap and doing substitutions
+//  // so send it to a dummy window and find out the resulting details
+//  PPString := IntToStr( PointSize )
+//              + '.'
+//              + FaceName;
+//
+//  PPString := ModifyFontName( PPString, Attributes );
+//
+//  FontWindow.SetPPFontNameSize( PPString );
+//
+//  PresSpace := WinGetPS( FontWindow.Handle );
+//  GpiQueryFontMetrics( PresSpace,
+//                             SizeOf( FontInfo ),
+//                             FontInfo );
+//  WinReleasePS( PresSpace );
+//end;
+
+// Look for the best match for the given face, size and attributes.
+// If FixedWidth is set then makes sure that the result is fixed
+// (if there is any fixed font on the system at all!)
+// This uses the OS/2 GPI and therefore makes some substitutions,
+// such as Helv 8 (bitmap) for Helvetica 8 (outline)
+//------------------------------------------------------------------------
+procedure FindBestFontMatch( const FaceName: string;
+                             const PointSize: longint;
+                             const Attributes: TFontAttributes;
+                             const FixedWidth: boolean;
+                             var FontInfo: string );
+var
+  BestBitmapFontMatch: TLogicalFont;
+  fl: TStringList;
+  i: integer;
+begin
+  { TODO -oGraeme -cfonts : This hack is very quick and dirty. Needs to be refined a lot }
+  fl := fpgApplication.GetFontFaceList;
+  for i := 0 to fl.Count-1 do
+  begin
+    if Pos(FaceName, fl[i]) > 0 then
+      FontInfo := fl[i] + '-' + IntToStr(PointSize);
+  end;
+
+  if Fontinfo = '' then
+    // nothing found se use default font of fpGUI
+    FontInfo := fpgApplication.DefaultFont.FontDesc;
+end;
+
+//------------------------------------------------------------------------
+// Font manager
+//------------------------------------------------------------------------
+
+// constructor
+//------------------------------------------------------------------------
+constructor TCanvasFontManager.Create(Canvas: TfpgCanvas; AllowBitmapFonts: boolean;
+  AWidget: TfpgWidget);
+begin
+  inherited Create;
+  if FontFaces = nil then
+    GetFontList;
+  FCanvas := Canvas;
+  FWidget := AWidget;
+  FLogicalFonts := TList.Create;
+  FCurrentFontSpec.FaceName := 'Arial';
+  FCurrentFont := nil;
+  FAllowBitmapFonts := AllowBitmapFonts;
+  // get system default font spec
+  // as default default ;)
+  FPGuiFontToFontSpec( fpgApplication.DefaultFont, FDefaultFontSpec );
+  if FDefaultFontSpec.FaceName = '' then
+    raise Exception.Create('For some reason we could not create a FDefaultFontSpec instance');
+end;
+
+// Destructor
+//------------------------------------------------------------------------
+destructor TCanvasFontManager.Destroy;
+var
+  i: integer;
+  Font: TLogicalFont;
+  face: TFontFace;
+begin
+  // select default font so none of our logical fonts are in use
+  FCanvas.Font := fpgApplication.DefaultFont;
+
+  // delete each logical font and our record of it
+  for i := 0 to FLogicalFonts.Count - 1 do
+  begin
+    Font := TLogicalFont(FLogicalFonts[ i ]);
+    Font.Free;
+  end;
+  FLogicalFonts.Clear;
+  FLogicalFonts.Free;
+
+  // TCanvasFontManager asked for FontFaces to be created, so lets take responsibility to destroy it.
+  for i := 0 to FontFaces.Count-1 do
+  begin
+    face := TFontFace(Fontfaces[i]);
+    face.Free;
+  end;
+  FontFaces.Clear;
+  FontFaces.Free;
+  inherited Destroy;
+end;
+
+// Create a logical font for the given spec
+//------------------------------------------------------------------------
+function TCanvasFontManager.CreateFont( const FontSpec: TFontSpec ): TLogicalFont;
+var
+  UseFaceName: string;
+  Face: TFontFace;
+  RemoveBoldFromSelection: boolean;
+  RemoveItalicFromSelection: boolean;
+  UseAttributes: TFontAttributes;
+  MatchAttributes: TFontAttributes;
+  BaseFont: TLogicalFont;
+  BaseFontIsBitmapFont: Boolean;
+  FontInfo: string;
+  FixedWidth: boolean;
+begin
+ProfileEvent('>>>>  TCanvasFontManager.CreateFont >>>>');
+  Face := nil;
+  RemoveBoldFromSelection := false;
+  RemoveItalicFromSelection := false;
+
+  UseAttributes := FontSpec.Attributes;
+
+  // see if the originally specified font is a fixed width one.
+  FixedWidth := false;
+  Face := FindFaceName( FontSpec.FaceName );
+  if Face <> nil then
+    FixedWidth := Face.FixedWidth;
+
+  Face := nil;
+
+  if not FAllowBitmapFonts then
+    UseFaceName := SubstituteBitmapFontToOutline( FontSpec.FaceName )
+  else
+    UseFaceName := FontSpec.FaceName;
+ProfileEvent('UseFaceName=' + UseFaceName);
+
+  if FontSpec.Attributes <> [] then
+  begin
+profileevent('FontSpec.Attributes are not blank');
+    BaseFontIsBitmapFont := false;
+    if FAllowBitmapFonts then
+    begin
+      // First see if the base font (without attributes)
+      // would be a bitmap font...
+      BaseFont := CreateFontBasic( UseFaceName, FontSpec.PointSize );
+      if BaseFont <> nil then
+      begin
+        BaseFontIsBitmapFont := BaseFont.FontType = ftBitmap;
+        BaseFont.Destroy;
+      end;
+    end;
+
+    If not BaseFontIsBitmapFont Then
+    begin
+profileevent('we seem to be looking for a outline font');
+      // Result is an outline font so look for specific bold/italic fonts
+      if     ( faBold in FontSpec.Attributes )
+         and ( faItalic in FontSpec.Attributes ) then
+      begin
+        Face := FindFaceName( UseFaceName + ' BOLD ITALIC' );
+        if Face <> nil then
+        begin
+          Exclude( UseAttributes, faBold );
+          Exclude( UseAttributes, faItalic );
+          RemoveBoldFromSelection := true;
+          RemoveItalicFromSelection := true;
+        end;
+      end;
+
+      if Face = nil then
+        if faBold in FontSpec.Attributes then
+        begin
+          Face := FindFaceName( UseFaceName + ' BOLD' );
+          if Face <> nil then
+          begin
+            Exclude( UseAttributes, faBold );
+            RemoveBoldFromSelection := true;
+          end;
+        end;
+
+      if Face = nil then
+        if faItalic in FontSpec.Attributes then
+        begin
+          Face := FindFaceName( UseFaceName + ' ITALIC' );
+          if Face <> nil then
+          begin
+            Exclude( UseAttributes, faItalic );
+            RemoveItalicFromSelection := true;
+          end;
+        end;
+    end;
+  end;
+
+  if Face <> nil then
+    // found a styled face, does it match fixed width?
+    if Face.FixedWidth <> FixedWidth then
+      // no so we don't want to use it.
+      Face := nil;
+
+  if Face = nil then
+    // didn't find a styled face (or no styles set)
+    // so find unmodified, we will use simulation bits
+    Face := FindFaceName( UseFaceName );
+
+  // Oh shit!
+  if Face = nil then
+    // didn't find a styled face (or no styles set)
+    // so find unmodified, we will use simulation bits
+    Face := FindFaceName( 'Sans' );   // something very generic
+
+  if not FAllowBitmapFonts then
+    if Assigned(Face) and (Face.FontType = ftBitmap) then
+      // we aren't allowed bitmaps, but that's what this
+      // face is. So use the default outline face of the
+      // appropriate width type
+      if FixedWidth then
+        Face := DefaultOutlineFixedFace
+      else
+        Face := DefaultOutlineProportionalFace;
+
+  if Face = nil then
+  begin
+profileevent('Could not find the specified font name. Bummer! + early exit');
+    // Could not find the specified font name. Bummer.
+    Result := nil;
+    exit;
+  end;
+
+profileevent('******* Now create the TLogicalFont instance');
+  // OK now we have found the font face...
+  Result := TLogicalFont.Create;
+  Result.PointSize    := FontSpec.PointSize; // will use later if the result was an outline font...
+  Result.FaceName     := FontSpec.FaceName;
+  Result.UseFaceName  := Face.Name;
+  Result.Attributes   := FontSpec.Attributes;
+  Result.fsSelection  := 0;
+  Result.FixedWidth   := Face.FixedWidth;
+
+  if FAllowBitmapFonts then
+  begin
+    if BaseFontIsBitmapFont then
+      MatchAttributes := []
+    else
+      MatchAttributes := UseAttributes;
+    FindBestFontMatch( Face.Name,
+                       FontSpec.PointSize,
+                       MatchAttributes,
+                       FixedWidth,
+                       FontInfo );
+
+    Result.UseFaceName := FontInfo;
+  end
+  else
+  begin
+    // no bitmap fonts please.
+    Result.FontType := ftOutline
+  end;
+
+  // store the baseline and average char width.
+  // For bitmap fonts, these tell GPI which font we really want
+  // For outline fonts, we are just storing them for later ref.
+  //Result.lMaxbaseLineExt := FontInfo.lMaxbaselineExt;
+  //Result.lAveCharWidth := FontInfo.lAveCharWidth;
+  //Result.lMaxCharInc := FontInfo.lMaxCharInc;
+  Result.lMaxBaseLineExt := FontSpec.YSize;
+  Result.lAveCharWidth := FontSpec.XSize;
+  Result.lMaxCharInc := FontSpec.XSize;
+
+  // Set style flags
+  with Result do
+  begin
+    //If faBold in UseAttributes Then
+    //  fsSelection := fsSelection or FM_SEL_BOLD;
+    //If faItalic in UseAttributes Then
+    //  fsSelection := fsSelection or FM_SEL_ITALIC;
+    //If faUnderScore in UseAttributes Then
+    //  fsSelection := fsSelection or FM_SEl_UNDERSCORE;
+    //If faStrikeOut in UseAttributes Then
+    //  fsSelection := fsSelection or FM_SEl_STRIKEOUT;
+    //If faOutline in UseAttributes Then
+    //  fsSelection := fsSelection or FM_SEl_OUTlINE;
+  end;
+
+profileevent('  Result.FaceName=' + Result.FaceName);
+profileevent('  Result.PointSize=' + IntToStr(Result.PointSize));
+profileevent('  Result.UseFaceName=' + Result.UseFaceName);
+
+  Result.pCharWidthArray := Nil;
+  ProfileEvent('<<<<  TCanvasFontManager.CreateFont');
+end;
+
+// Register the given logical font with GPI and store for later use
+//------------------------------------------------------------------------
+procedure TCanvasFontManager.RegisterFont( Font: TLogicalFont );
+var
+//  fa: FATTRS;
+  rc: longint;
+begin
+  FLogicalFonts.Add( Font );
+  Font.ID := FLogicalFonts.Count + 1; // add 1 to stay out of Sibyl's way
+
+  //// Initialise GPI font attributes
+  //FillChar( fa, SizeOf( FATTRS ), 0 );
+  //fa.usRecordLength := SizeOf( FATTRS );
+  //
+  //// Copy facename and 'simulation' attributes from what we obtained
+  //// earlier
+  //fa.szFaceName := Font.pUseFaceName^;
+  //fa.fsSelection := Font.fsSelection;
+  //
+  //fa.lMatch := 0; // please Mr GPI be helpful and do clever stuff for us, we are ignorant
+  //
+  //fa.idRegistry := 0; // IBM magic number
+  //fa.usCodePage := 0; // use current codepage
+  //
+  //If Font.FontType = ftOutline then
+  //  // Outline font wanted
+  //  fa.fsFontUse := FATTR_FONTUSE_OUTLINE Or FATTR_FONTUSE_TRANSFORMABLE
+  //else
+  //  // bitmap font
+  //  fa.fsFontUse := 0;
+  //
+  //// don't need mixing with graphics (for now)
+  //fa.fsFontUse := fa.fsFontUse or FATTR_FONTUSE_NOMIX;
+  //
+  //// copy char cell width/height from the (valid) one we
+  //// found earlier in GetFont (will be zero for outline)
+  //fa.lMaxbaseLineExt := Font.lMaxbaselineExt;
+  //fa.lAveCharWidth := Font.lAveCharWidth;
+  //
+  //fa.fsType := 0;
+  //
+  //// create logical font
+  //rc := GpiCreateLogFont( FCanvas.Handle,
+  //                        nil,
+  //                        Font.ID,
+  //                        fa );
+end;
+
+// Select the given (existing) logical font
+//------------------------------------------------------------------------
+procedure TCanvasFontManager.SelectFont( Font: TLogicalFont;
+                                         Scale: longint );
+var
+  f: TfpgFont;
+  s: string;
+begin
+  // Select the logical font
+  if Font.FontType = ftOutline then
+  begin
+    s := Font.FaceName + '-' + IntToStr(Font.PointSize);
+    if faBold in Font.Attributes then
+      s := s + ':bold';
+    if faItalic in Font.Attributes then
+      s := s + ':italic';
+    if faUnderScore in Font.Attributes then
+      s := s + ':underline';
+
+    f := fpgGetFont(s);
+    FCanvas.Font := f;
+  end;
+end;
+
+// Get a font to match the given spec, creating or re-using an
+// existing font as needed.
+//------------------------------------------------------------------------
+function TCanvasFontManager.GetFont( const FontSpec: TFontSpec ): TLogicalFont;
+var
+  AFont: TLogicalFont;
+  FontIndex: integer;
+  sub: string;
+begin
+ProfileEvent('DEBUG:  TCanvasFontManager.GetFont >>>');
+ProfileEvent('Received FontSpec: Facename=' + FontSpec.FaceName);
+ProfileEvent('                   PointSize=' + IntToStr(FontSpec.PointSize));
+ProfileEvent('FLogicalFonts.Count=' + intToStr(FLogicalFonts.Count));
+try
+  for FontIndex := 0 to FLogicalFonts.Count - 1 do
+  begin
+    AFont := TLogicalFont(FLogicalFonts[ FontIndex ]);
+    if AFont.PointSize = FontSpec.PointSize then
+    begin
+      if    ( AFont.PointSize > 0 )
+         or (     ( AFont.lAveCharWidth = FontSpec.XSize )
+              and ( AFont.lMaxbaselineExt = FontSpec.YSize ) ) then
+      begin
+        if AFont.Attributes = FontSpec.Attributes then
+        begin
+          // search name last since it's the slowest thing
+ProfileEvent('            AFont.UseFaceName=' + AFont.UseFaceName);
+ProfileEvent('         FontSpec.FaceName=' + FontSpec.FaceName);
+          if AFont.FaceName = FontSpec.FaceName then
+          begin
+            // Found a logical font already created
+            Result := AFont;
+            // done
+            exit;
+          end
+          else
+          begin
+            // Still nothing! Lets try known substitute font names
+            sub := SubstituteBitmapFontToOutline(FontSpec.FaceName);
+ProfileEvent('           substitute font=' + sub);
+            if AFont.FaceName = sub then
+            begin
+              // Found a logical font already created
+              Result := AFont;
+              // done
+              profileevent('TCanvasFontManager.GetFont <<<<<  exit early we found a font');
+              exit;
+            end;
+          end;
+        end;
+      end;
+    end;
+  end;
+except
+  { TODO -oGraeme -cknow bug : An Access Violation error occurs often here! No idea why? }
+  on E: Exception do
+    ProfileEvent('Unexpected error occured. Error: ' + E.Message);
+end;
+
+  ProfileEvent('Now we need to create a new logical font');
+  // Need to create new logical font
+  Result := CreateFont( FontSpec );
+  if Result <> nil then
+  begin
+    RegisterFont( Result );
+  end;
+ProfileEvent('DEBUG:  TCanvasFontManager.GetFont <<<');
+end;
+
+// Set the current font for the canvas to match the given
+// spec, creating or re-using fonts as needed.
+//------------------------------------------------------------------------
+procedure TCanvasFontManager.SetFont( const FontSpec: TFontSpec );
+var
+  Font: TLogicalFont;
+  lDefaultFontSpec: TFontSpec;
+begin
+ProfileEvent('DEBUG:  TCanvasFontManager.SetFont >>>>');
+  if (FCurrentFontSpec.FaceName = FontSpec.FaceName) and
+     (FCurrentFontSpec.PointSize = FontSpec.PointSize) and
+     (FCurrentFontSpec.Attributes = FontSpec.Attributes) then
+    // same font
+    exit;
+
+  Font := GetFont( FontSpec );
+
+  if Font = nil then
+  begin
+    // ack! Pfffbt! Couldn't find the font.
+
+    // Try to get the default font
+    writeln('---------- here goes nothing -------------');
+    Font := GetFont( FDefaultFontSpec );
+    if Font = nil then
+    begin
+      writeln('******* We should never get here!!!! Defaut font should always exist.');
+      writeln('FDefaultFontSpec:');
+      writeln('  FaceName=', FDefaultFontSpec.FaceName);
+      writeln('  Size=', FDefaultFontSpec.PointSize);
+      FPGuiFontToFontSpec( fpgApplication.DefaultFont, lDefaultFontSpec );
+      Font := GetFont( lDefaultFontSpec );
+      if Font = nil then
+        // Jimminy! We can't even get the default system font
+        raise Exception.Create( 'Could not access default font '
+                                + 'in place of '
+                                + FontSpec.FaceName
+                                + ' '
+                                + IntToStr( FontSpec.PointSize ) );
+    end;
+
+  end;
+
+  SelectFont( Font, 1 );
+  FCurrentFontSpec := FontSpec;
+  FCurrentFont.Free;
+  FCurrentFont := Font;
+ProfileEvent('DEBUG:  TCanvasFontManager.SetFont <<<<');
+end;
+
+// Get the widths of all characters for current font
+// and other dimensions
+//------------------------------------------------------------------------
+procedure TCanvasFontManager.LoadMetrics;
+var
+  TheChar: Char;
+begin
+  // Retrieve all character widths
+  if FCurrentFont.FontType = ftOutline then
+  begin
+    SelectFont( FCurrentFont, FontWidthPrecisionFactor );
+  end;
+
+  // allocate memory for storing the char widths
+  GetMem( FCurrentFont.pCharWidthArray, sizeof( TCharWidthArray ) );
+  //if not GpiQueryWidthTable( FCanvas.Handle,
+  //                           0, 256,
+  //                           FCurrentFont.pCharWidthArray^[ #0 ] ) then
+  //begin
+  //  raise Exception.Create( 'Error getting character width table: '
+  //                          + 'GpiQueryWidthTable error '
+  //                          + IntToStr( WinGetLastError( AppHandle ) ) );
+  //end;
+
+  // Convert all widths to positive!
+  // For unknown reason, sometimes GPI returns negative values...
+  for TheChar := #0 to #255 do
+  begin
+    FCurrentFont.pCharWidthArray^[ TheChar ] := Abs( FCurrentFont.pCharWidthArray^[ TheChar ] );
+  end;
+
+  if FCurrentFont.FontType = ftOutline then
+  begin
+    SelectFont( FCurrentFont, 1 );
+  end
+  else
+  begin
+    // For bitmap fonts, multiply by 256 manually
+    for TheChar := #0 to #255 do
+    begin
+      FCurrentFont.pCharWidthArray^[ TheChar ] :=
+        FCurrentFont.pCharWidthArray^[ TheChar ]
+        * FontWidthPrecisionFactor;
+    end;
+  end;
+
+  //GpiQueryFontMetrics( FCanvas.Handle,
+  //                     sizeof( fm ),
+  //                     fm );
+  //FCurrentFont.lMaxbaseLineExt := fm.lMaxbaselineExt;
+  //FCurrentFont.lAveCharWidth := fm.lAveCharWidth;
+  //FCurrentFont.lMaxCharInc := fm.lMaxCharInc;
+  //FCurrentFont.lMaxDescender := fm.lMaxDescender;
+end;
+
+procedure TCanvasFontManager.EnsureMetricsLoaded;
+begin
+  if FCurrentFont = nil then
+    raise( Exception.Create( 'No font selected before getting font metrics' ) );
+
+  if FCurrentFont.pCharWidthArray = Nil then
+    LoadMetrics;
+end;
+
+function TCanvasFontManager.CharWidth( const C: Char ): longint;
+begin
+  EnsureMetricsLoaded;
+  Result := FCurrentFont.pCharWidthArray^[ C ];
+  { TODO -ograemeg -chard-coded result : This is a temporary hard-code }
+//  result := fpgApplication.DefaultFont.TextWidth(C);
+  Result := FCurrentFont.lAveCharWidth;
+end;
+
+function TCanvasFontManager.AverageCharWidth: longint;
+begin
+  EnsureMetricsLoaded;
+  Result := FCurrentFont.lAveCharWidth;
+end;
+
+function TCanvasFontManager.MaximumCharWidth: longint;
+begin
+  EnsureMetricsLoaded;
+  Result := FCurrentFont.lMaxCharInc;
+end;
+
+function TCanvasFontManager.CharHeight: longint;
+begin
+  EnsureMetricsLoaded;
+  Result := FCurrentFont.lMaxBaseLineExt;
+end;
+
+function TCanvasFontManager.CharDescender: longint;
+begin
+  EnsureMetricsLoaded;
+  Result := FCurrentFont.lMaxDescender;
+end;
+
+function TCanvasFontManager.IsFixed: boolean;
+begin
+  Result := FCurrentFont.FixedWidth;
+end;
+
+procedure TCanvasFontManager.DrawString(var Point: TPoint; const Length: longint; const S: PChar);
+var
+  t: string;
+
+  // Seaches <AValue> and replaces <ADel> with <AIns>. Case sensitive.
+  function tiStrTran(AValue, ADel, AIns : string): string;
+  var
+    i : integer;
+    sToChange : string;
+  begin
+    result := '';
+    sToChange := AValue;
+    i := UTF8Pos(ADel, sToChange);
+    while i <> 0 do
+    begin
+      result := result + UTF8Copy(sToChange, 1, i-1) + AIns;
+      UTF8Delete(sToChange, 1, i+UTF8length(ADel)-1);
+      i := UTF8Pos(ADel, sToChange);
+    end;
+    result := result + sToChange;
+  end;
+
+begin
+  t := s;
+
+// Hack Alert #2: replace strange table chars with something we can actually see
+  //t := SubstituteChar(t, Chr(218), Char('+') );   // top-left corner
+  //t := SubstituteChar(t, Chr(196), Char('-') );   // horz row deviders
+  //t := SubstituteChar(t, Chr(194), Char('-') );   // centre top T connection
+  //t := SubstituteChar(t, Chr(191), Char('+') );   // top-right corner
+  //t := SubstituteChar(t, Chr(192), Char('+') );   // bot-left corner
+  //t := SubstituteChar(t, Chr(193), Char('-') );   // centre bottom inverted T
+  //t := SubstituteChar(t, Chr(197), Char('+') );
+  //t := SubstituteChar(t, Chr(179), Char('|') );  //
+  //t := SubstituteChar(t, Chr(195), Char('|') );
+  //t := SubstituteChar(t, Chr(180), Char('|') );
+  //t := SubstituteChar(t, Chr(217), Char('+') );   // bot-right corner
+
+  // it's cheaper to first check for the char than actually running full tiStrTran
+  // CodePage 437 (kind-of) to Unicode mapping
+    t := tiStrTran(t, Char(16), '>' );
+    t := tiStrTran(t, Char(17), '<' );
+    t := tiStrTran(t, Char($1f), '▼' );
+//  if pos(t, Char(179)) > 0 then
+    t := tiStrTran(t, Char(179), '│' );
+//  if pos(t, Char(180)) > 0 then
+    t := tiStrTran(t, Char(180), '┤' );
+//  if pos(t, Char(191)) > 0 then
+    t := tiStrTran(t, Char(191), '┐' );
+//  if pos(t, Char(192)) > 0 then
+    t := tiStrTran(t, Char(192), '└' );
+//  if pos(t, Char(193)) > 0 then
+    t := tiStrTran(t, Char(193), '┴' );
+//  if pos(t, Char(194)) > 0 then
+    t := tiStrTran(t, Char(194), '┬' );
+//  if pos(t, Char(195)) > 0 then
+    t := tiStrTran(t, Char(195), '├' );
+//  if pos(t, Char(196)) > 0 then
+    t := tiStrTran(t, Char(196), '─' );
+//  if pos(t, Char(197)) > 0 then
+    t := tiStrTran(t, Char(197), '┼' );
+//  if pos(t, Char(217)) > 0 then
+    t := tiStrTran(t, Char(217), '┘' );
+//  if pos(t, Char(218)) > 0 then
+    t := tiStrTran(t, Char(218), '┌' );
+
+  FCanvas.DrawString(Point.X, Point.Y, t);
+  Point.x := Point.X + Canvas.Font.TextWidth(t);
+end;
+
+
+end.
diff --git a/docview/components/richtext/RichTextDisplayUnit.pas b/docview/components/richtext/RichTextDisplayUnit.pas
new file mode 100644
index 00000000..5d16ab54
--- /dev/null
+++ b/docview/components/richtext/RichTextDisplayUnit.pas
@@ -0,0 +1,416 @@
+Unit RichTextDisplayUnit;
+
+{$mode objfpc}{$H+}
+
+Interface
+
+uses
+  Classes
+  ,CanvasFontManager
+  ,RichTextStyleUnit
+  ,RichTextLayoutUnit
+  ;
+
+// Selection start and end should both be nil if no selection is to be applied
+Procedure DrawRichTextLayout( var FontManager: TCanvasFontManager;
+                              Layout: TRichTextLayout;
+                              const SelectionStart: PChar;
+                              const SelectionEnd: PChar;
+                              const StartLine: longint;
+                              const EndLine: longint;
+                              const StartPoint: TPoint );
+
+// Print as much of the given layout as will fit on the page,
+// starting at StartY and StartLine
+// EndY is set to the final Y output position used + 1.
+// EndLine is set to the last line printed + 1
+Procedure PrintRichTextLayout( var FontManager: TCanvasFontManager;
+                               var Layout: TRichTextLayout;
+                               const StartLine: longint;
+                               var EndLine: longint;
+                               const StartY: longint;
+                               var EndY: longint );
+
+Implementation
+
+uses
+  SysUtils
+//  ACLString, ACLUtility,
+  ,RichTextDocumentUnit
+  ,fpg_base
+  ,fpg_main
+  ,nvUtilities
+  ;
+
+// For the given point in the text, update selected if the point
+// is at start or end of selection
+// Returns true if changed
+function SelectionChange( P: PChar;
+                          SelectionStart: PChar;
+                          SelectionEnd: PChar;
+                          var NextSelected: boolean ): boolean;
+begin
+  Result := false;
+  if P = SelectionStart then
+  begin
+    Result := true;
+    if SelectionStart < SelectionEnd then
+      // reached start of selection
+      NextSelected := true
+    else
+      // reached end
+      NextSelected := false;
+  end
+  else if P = SelectionEnd then
+  begin
+    Result := true;
+    if SelectionStart < SelectionEnd then
+      // reached end of selection
+      NextSelected := false
+    else
+      // reached start
+      NextSelected := true;
+  end;
+end;
+
+function InvertRGB( Arg: TfpgColor ): TfpgColor;
+begin
+  Result := fpgColorToRGB( Arg ); // in case it's a system color e.g. button face
+  Result := Result xor $ffffff; // now invert the RGB components
+end;
+
+// Draw a string at the given location with given color/selected state
+procedure DrawRichTextString( var FontManager: TCanvasFontManager; Layout: TRichTextLayout;
+    var X: longint; Y: longint; S: PChar; Len: longint; Selected: Boolean;
+    PenColor: TfpgColor; BackColor: TfpgColor );
+var
+  Point: TPoint;
+begin
+ProfileEvent('DEBUG:  DrawRichTextString >>>');
+  if Len = 0 then
+    exit;
+
+  Point.X := X;
+  Point.Y := Y;
+
+  if Selected then
+  begin
+    FontManager.Canvas.Color := InvertRGB( BackColor );
+    FontManager.Canvas.TextColor := InvertRGB(PenColor);
+  end
+  else
+  begin
+    FontManager.Canvas.Color := BackColor;
+    FontManager.Canvas.TextColor := PenColor;
+  end;
+  if FontManager.Canvas.Color <> Layout.FRichTextSettings.DefaultBackgroundColor then
+    FontManager.Canvas.FillRectangle(x, y,
+        FontManager.Canvas.Font.TextWidth(s),
+        FontManager.Canvas.Font.Height);
+  FontManager.DrawString( Point, Len, S );
+  X := Point.X;
+ProfileEvent('DEBUG:  DrawRichTextString <<<');
+end;
+
+var
+  // global, so that we don't reallocate every drawline
+  StringToDraw: String = '';
+
+// Draw the specified line at the specified
+// (physical) location
+Procedure DrawRichTextLine( var FontManager: TCanvasFontManager;
+    Layout: TRichTextLayout; SelectionStart: PChar; SelectionEnd: PChar;
+    Line: TLayoutLine; Start: TPoint );
+var
+  X, Y: longint;
+  Element: TTextElement;
+  StartedDrawing: boolean;
+  Style: TTextDrawStyle;
+  P: PChar;
+  NextP: PChar;
+  EndP: PChar;
+  BitmapIndex: longint;
+  Bitmap: TfpgImage;
+  BitmapRect: TRect;
+  TextBlockStart: PChar;
+  Selected: boolean;
+  NextSelected: boolean;
+  NewMarginX: longint;
+
+  procedure DrawTextBlock;
+  begin
+    DrawRichTextString( FontManager, Layout,
+                        X,         // value gets adjusted by the time it returns
+                        Y,         // value gets adjusted by the time it returns
+                        PChar(StringToDraw),
+                        Length(StringToDraw),
+                        Selected,
+                        Style.Color,
+                        Style.BackgroundColor);
+    StringToDraw := '';
+  end;
+
+
+begin
+ProfileEvent('DEBUG:  DrawRichTextLine >>>');
+  P := Line.Text;
+  EndP := Line.Text + Line.Length;
+
+  if P = EndP then
+  begin
+    // Empty line
+    exit;
+  end;
+
+  Selected := false;
+  if SelectionStart <= Line.Text then
+    // selection start is above.
+    Selected := true;
+  if SelectionEnd <= Line.Text then
+    // selection end is above.
+    Selected := not Selected;
+
+  StringToDraw := '';
+
+  Style := Line.Style;
+  FontManager.SetFont( Style.Font );
+  StartedDrawing := false;
+
+  TextBlockStart := P;
+
+  Y := Start.Y + Line.MaxDescender; // co-ordinates are from top/left, so do we need descender? [Graeme]
+
+  while P < EndP do
+  begin
+    Element := ExtractNextTextElement( P, NextP );
+
+    if SelectionChange( P,
+                        SelectionStart,
+                        SelectionEnd,
+                        NextSelected ) then
+    begin
+      DrawTextBlock;
+      TextBlockStart := P;
+      Selected := NextSelected;
+    end;
+
+    case Element.ElementType of
+      teWordBreak,
+      teText,
+      teImage:
+      begin
+        if not StartedDrawing then
+        begin
+          // we haven't yet started drawing:
+          // so work out alignment
+          X := Start.X{ * FontWidthPrecisionFactor}
+               + Layout.GetStartX( Style, Line );
+          StartedDrawing := true;
+        end;
+
+        // Now do the drawing
+        if Element.ElementType = teImage then
+        begin
+          ProfileEvent('DEBUG:  DrawRichTextLine - skipping image drawing (not implemented yet)');
+          DrawTextBlock;
+          TextBlockStart := NextP;
+
+          try
+            BitmapIndex := StrToInt( Element.Tag.Arguments );
+          except
+            BitmapIndex := -1;
+          end;
+          if Layout.IsValidBitmapIndex( BitmapIndex ) then
+          begin
+            Bitmap := Layout.Images.Item[BitmapIndex].Image;
+
+            BitmapRect.Left := X div FontWidthPrecisionFactor;
+            BitmapRect.Bottom := Start.Y;
+            BitmapRect.Right := Trunc(BitmapRect.Left
+                                + Bitmap.Width
+                                  * Layout.HorizontalImageScale);
+            BitmapRect.Top := Trunc(BitmapRect.Bottom
+                              + Bitmap.Height
+                                * Layout.VerticalImageScale);
+
+            FontManager.Canvas.StretchDraw(BitmapRect.Left, BitMapRect.Top,
+                BitmapRect.Right-BitMapRect.Left, BitMapRect.Bottom-BitMapRect.Top, Bitmap);
+
+            inc( X, trunc( Bitmap.Width
+                           * FontWidthPrecisionFactor
+                           * Layout.HorizontalImageScale ) );
+          end;
+        end
+        else
+        begin
+          // character (or word break)
+          // build up the successive characters...
+          StringToDraw := StringToDraw + Element.Character;
+        end;
+      end;
+
+      teStyle:
+      begin
+        DrawTextBlock;
+        TextBlockStart := NextP;
+
+        if     ( Element.Tag.TagType = ttItalicOff )
+           and ( faItalic in Style.Font.Attributes )
+           and ( not FontManager.IsFixed )
+           then
+          // end of italic; add a space
+          inc( X, FontManager.CharWidth( ' ' )  );
+
+        Layout.PerformStyleTag( Element.Tag, Style, X );
+        NewMarginX := ( Start.X + Style.LeftMargin ){ * FontWidthPrecisionFactor};
+        if NewMarginX > X then
+        begin
+          //skip across...
+          X := NewMarginX;
+        end;
+      end;
+    end;
+    P := NextP;
+  end;
+
+  DrawTextBlock;
+ProfileEvent('DEBUG:  DrawRichTextLine <<<');
+end;
+
+Procedure DrawRichTextLayout( var FontManager: TCanvasFontManager;
+                              Layout: TRichTextLayout;
+                              const SelectionStart: PChar;
+                              const SelectionEnd: PChar;
+                              const StartLine: longint;
+                              const EndLine: longint;
+                              const StartPoint: TPoint );
+Var
+  Line: TLayoutLine;
+  LineIndex: longint;
+  Y: longint;
+  BottomOfLine: longint;
+begin
+ProfileEvent('DEBUG:  DrawRichTextLayout >>>');
+  assert( StartLine >= 0 );
+  assert( StartLine <= Layout.FNumLines );
+  assert( EndLine >= 0 );
+  assert( EndLine <= Layout.FNumLines );
+  assert( StartLine <= EndLine );
+
+  if Layout.FNumLines = 0 then
+    // no text to draw
+    exit;
+
+  Y := StartPoint.Y + Layout.FRichTextSettings.Margins.Top;
+  LineIndex := 0;
+
+  repeat
+    Line := Layout.FLines^[ LineIndex ];
+    BottomOfLine := Y {+ Line.Height} + 1; // bottom pixel row is top + height + 1
+
+    if // the line is in the range to be drawn
+           ( LineIndex >= StartLine )
+       and ( LineIndex <= EndLine )
+
+       // and the line is within the cliprect
+       and ( BottomOfLine < FontManager.Canvas.GetClipRect.Bottom )
+       and ( Y            >=  FontManager.Canvas.GetClipRect.Top ) then
+    begin
+      // draw it. First decided whether selection is started or not.
+      DrawRichTextLine( FontManager,
+                        Layout,
+                        SelectionStart,
+                        SelectionEnd,
+                        Line,
+                        Point( StartPoint.X, BottomOfLine ) );
+
+    end;
+    inc( Y, Line.Height );
+
+    { TODO 99 -oGraeme -cMUST FIX : Must remove this hard-coded value. It's just a test!!! }
+    // 4 is the Border Width of 2px times 2 borders.
+    if Y > (FontManager.Widget.Height-4) then
+      // past bottom of output canvas
+      break;
+
+    inc( LineIndex );
+
+    if LineIndex >= Layout.FNumLines then
+      // end of text
+      break;
+
+  until false;
+ProfileEvent('DEBUG:  DrawRichTextLayout <<<');
+End;
+
+Procedure PrintRichTextLayout( var FontManager: TCanvasFontManager;
+                               var Layout: TRichTextLayout;
+                               const StartLine: longint;
+                               var EndLine: longint;
+                               const StartY: longint;
+                               var EndY: longint );
+Var
+  Selected: boolean;
+  Line: TLayoutLine;
+  LineIndex: longint;
+
+  Y: longint;
+
+  BottomOfLine: longint;
+
+  LinesPrinted: longint;
+begin
+  assert( StartLine >= 0 );
+  assert( StartLine <= Layout.FNumLines );
+
+  if Layout.FNumLines = 0 then
+    // no text to draw
+    exit;
+
+  Y := StartY
+       - Layout.FRichTextSettings.Margins.Top;
+
+  Selected := false; // it's not going to change.
+
+  LinesPrinted := 0;
+
+  LineIndex := StartLine;
+
+  repeat
+    Line := TLayoutLine(Layout.FLines[ LineIndex ]);
+    BottomOfLine := Y - Line.Height + 1; // bottom pixel row is top - height + 1
+
+    if BottomOfLine < Layout.FRichTextSettings.Margins.Bottom then
+      // past bottom of page (less margin)
+      if LinesPrinted > 0 then
+        // stop, as long as we've printed at least 1 line
+        break;
+
+    // draw it
+    DrawRichTextLine( FontManager,
+                      Layout,
+                      nil,
+                      nil,
+                      Line,
+                      Point( 0,
+                             BottomOfLine ) );
+
+    dec( Y, Line.Height );
+
+    inc( LinesPrinted );
+
+    inc( LineIndex );
+
+    if LineIndex >= Layout.FNumLines then
+      // end of text
+      break;
+
+  until false;
+
+  EndY := Y;
+  EndLine := LineIndex;
+end;
+
+
+end.
+
diff --git a/docview/components/richtext/RichTextDocumentUnit.pas b/docview/components/richtext/RichTextDocumentUnit.pas
new file mode 100644
index 00000000..dd2f9a96
--- /dev/null
+++ b/docview/components/richtext/RichTextDocumentUnit.pas
@@ -0,0 +1,787 @@
+Unit RichTextDocumentUnit;
+
+{$mode objfpc}{$H+}
+// Declarations of tags, and parsing functions
+
+Interface
+
+uses
+  Classes
+  ,fpg_base
+  ;
+
+type
+  COUNTRYCODE = string[2];
+
+  TTagType = ( ttInvalid,
+               ttBold, ttBoldOff,
+               ttItalic, ttItalicOff,
+               ttUnderline, ttUnderlineOff,
+               ttFixedWidthOn, ttFixedWidthOff,
+               ttHeading1, ttHeading2, ttHeading3, ttHeadingOff,
+               ttColor, ttColorOff,
+               ttBackgroundColor, ttBackgroundColorOff,
+               ttRed, ttBlue, ttGreen, ttBlack,
+               ttWrap,
+               ttAlign,
+               ttBeginLink, ttEndLink,
+               ttSetLeftMargin, ttSetRightMargin,
+               ttImage,
+               ttFont, ttFontOff,
+               ttEnd );
+
+  TStandardColor = record
+    Name: string[ 32 ];
+    Color: TfpgColor;
+  end;
+
+  TTag = record
+    TagType: TTagType;
+    Arguments: string;
+  end;
+
+  TTextElementType = ( teText, // a character
+                       teWordBreak,
+                       teLineBreak, // end of para
+                       teTextEnd,
+                       teImage,
+                       teStyle );
+
+  TTextElement = record
+    ElementType: TTextElementType;
+    Character: Char;
+    Tag: TTag;
+  end;
+
+  TTextAlignment = ( taLeft,
+                     taRight,
+                     taCenter );
+
+const
+  TagStr: array[ ttInvalid .. ttEnd ] of string =
+  (
+    '', //
+    'b',
+    '/b',
+    'i',
+    '/i',
+    'u',
+    '/u',
+    'tt',
+    '/tt',
+    'h1',
+    'h2',
+    'h3',
+    '/h',
+    'color',
+    '/color',
+    'backcolor',
+    '/backcolor',
+    'red',
+    'blue',
+    'green',
+    'black',
+    'wrap',
+    'align',
+    'link',
+    '/link',
+    'leftmargin',
+    'rightmargin',
+    'image',
+    'font',
+    '/font',
+    ''
+  );
+
+
+// Returns tag pointed to by TextPointer and
+// moves TextPointer to the first char after the tag.
+Function ExtractTag( Var TextPointer: PChar ): TTag;
+
+// Returns tag ending at TextPointer
+// (Expects textpointer is currently pointing at the >)
+// and moves TextPointer to the first char of the tag
+Function ExtractPreviousTag( const TextStart: PChar; Var TextPointer: PChar ): TTag;
+function ExtractNextTextElement( TextPointer: PChar; Var NextElement: PChar ): TTextElement;
+function ExtractPreviousTextElement( const TextStart: PChar; TextPointer: PChar; Var NextElement: PChar ): TTextElement;
+
+// Parse a color name or value (#hexval). Returns true if valid
+function GetTagColor( const ColorParam: string; var Color: TfpgColor ): boolean;
+
+function GetTagTextAlignment( const AlignParam: string;
+                              const Default: TTextAlignment ): TTextAlignment;
+
+function GetTagTextWrap( const WrapParam: string ): boolean;
+
+// Search within a rich text document for the given text
+// if found, returns true, pMatch is set to the first match,
+//   and MatchLength returns the length of the match
+//   (which may be greater than the length of Text due to
+//    to skipping tags)
+// if not found, returns false, pMatch is set to nil
+function RichTextFindString( pRichText: PChar;
+                             const Text: string;
+                             var pMatch: PChar;
+                             var MatchLength: longint ): boolean;
+
+// Returns the start of the previous word,
+// or the current word if pStart is in the middle of the word
+function RichTextWordLeft( pRichText: PChar;
+                           pStart: PChar ): PChar;
+
+// Returns the start of the next word.
+function RichTextWordRight( pStart: PChar ): PChar;
+
+// If pStart is in the middle of a word, then
+// returns true and sets the start and length of the word
+function RichTextWordAt( pRichText: PChar;
+                         pStart: PChar;
+                         Var pWordStart: PChar;
+                         Var WordLength: longint ): boolean;
+
+// Copies plaintext of richtext starting at StartP
+// to the given buffer. Returns number of characters copied.
+// Buffer may be nil
+// If BufferLength is negative, it is effectively ignored
+function CopyPlainTextToBuffer( StartP: PChar;
+                                EndP: PChar;
+                                Buffer: PChar;
+                                BufferLength: longint ): longint;
+
+Implementation
+
+uses
+//  BseDOS, // for NLS/case mapping
+  SysUtils
+  ,ACLStringUtility
+  ;
+
+const
+  StandardColors: array[ 0..7 ] of TStandardColor =
+  (
+    ( Name : 'white' ; Color: clWhite   ),
+    ( Name : 'black' ; Color: clBlack   ),
+    ( Name : 'red'   ; Color: clRed     ),
+    ( Name : 'blue'  ; Color: clBlue    ),
+    ( Name : 'green' ; Color: clLime    ),
+    ( Name : 'purple'; Color: clFuchsia ),
+    ( Name : 'yellow'; Color: clYellow  ),
+    ( Name : 'cyan'  ; Color: clAqua    )
+  );
+
+Procedure ParseTag( const Text: string;
+                    Var Tag: TTag );
+var
+  TagType: TTagType;
+  TagTypeText: string;
+  SpacePos: longint;
+begin
+  SpacePos := Pos( ' ', Text );
+  if SpacePos <> 0 then
+  begin
+    Tag.Arguments := trim( Copy( Text, SpacePos + 1, 255 ) );
+    TagTypeText := LowerCase( Copy( Text, 1, SpacePos - 1 ) );
+  end
+  else
+  begin
+    Tag.Arguments := ''; // to save time copying when not needed
+    TagTypeText := LowerCase( Text );
+  end;
+
+  for TagType := ttBold to ttEnd do
+  begin
+    if TagStr[ TagType ] = TagTypeText  then
+    begin
+      Tag.TagType := TagType;
+      exit;
+    end;
+  end;
+
+  // not found
+  Tag.TagType := ttInvalid;
+end;
+
+var
+  TagText: string;
+  TagArgText: string;
+
+Function ExtractTag( Var TextPointer: PChar ): TTag;
+var
+  CurrentChar: Char;
+  TagTooLong: boolean;
+  InQuote: boolean;
+begin
+//  assert( TextPointer[ 0 ] = '<' );
+  TagText := '';
+  TagTooLong := false;
+  InQuote := false;
+
+  repeat
+    CurrentChar := TextPointer^;
+
+    if     ( CurrentChar = '>' )
+       and ( not InQuote ) then
+    begin
+      // found tag end.
+      if TagTooLong then
+        Result.TagType := ttInvalid
+      else
+        ParseTag( TagText, Result );
+      inc( TextPointer );
+      exit;
+    end;
+
+    if CurrentChar = #0 then
+    begin
+      // if we reach here we have reached the end of text
+      // during a tag. invalid tag.
+      Result.TagType := ttInvalid;
+      exit;
+    end;
+
+    if CurrentChar = CharDoubleQuote then
+    begin
+      if not InQuote then
+      begin
+        InQuote := true
+      end
+      else
+      begin
+        // Could be escaped quote ""
+//        if (TextPointer + 1 )^ = DoubleQuote then
+        if ( TextPointer + 1 ) ^ = CharDoubleQuote then
+        begin
+          // yes it is
+          inc( TextPointer ); // skip second one
+        end
+        else
+        begin
+          // no, not an escaped quote
+          InQuote := false;
+        end;
+      end;
+
+    end;
+
+    if not TagTooLong then
+      if Length( TagText ) < 200 then
+        TagText := TagText + CurrentChar
+      else
+        TagTooLong := true; // but keep going until the end
+
+    inc( TextPointer );
+  until false;
+
+end;
+
+// Expects textpointer is currently pointing at the >
+Function ExtractPreviousTag( const TextStart: PChar;
+                             Var TextPointer: PChar ): TTag;
+var
+  CurrentChar: Char;
+  TagTooLong: boolean;
+  InQuote: boolean;
+begin
+  TagText := '';
+  TagTooLong := false;
+  InQuote := false;
+
+  repeat
+    dec( TextPointer );
+    if TextPointer < TextStart then
+    begin
+      // if we reach here we have reached the end of text
+      // during a tag. invalid tag.
+      Result.TagType := ttInvalid;
+      exit;
+    end;
+    CurrentChar := TextPointer^;
+
+    if     ( CurrentChar = '<' )
+       and ( not InQuote ) then
+    begin
+      // found tag end.
+      if TagTooLong then
+        Result.TagType := ttInvalid
+      else
+        ParseTag( TagText, Result );
+      exit;
+    end;
+
+    if CurrentChar = CharDoubleQuote then
+    begin
+      if not InQuote then
+      begin
+        InQuote := true
+      end
+      else
+      begin
+        // Could be escaped quote ""
+        if TextPointer <= TextStart then
+        begin
+          // start of text... somethin weird
+          InQuote := false;
+        end
+        else if ( TextPointer - 1 ) ^ = CharDoubleQuote then
+        begin
+          // yes it is
+          dec( TextPointer ); // skip second one
+        end
+        else
+        begin
+          // no, not an escaped quote
+          InQuote := false;
+        end;
+      end;
+
+    end;
+
+    if not TagTooLong then
+      if Length( TagText ) < 200 then
+        TagText := CurrentChar + TagText
+      else
+        TagTooLong := true; // but keep going until the end
+
+  until false;
+
+end;
+
+function ExtractNextTextElement( TextPointer: PChar; Var NextElement: PChar ): TTextElement;
+var
+  TheChar: Char;
+  NextChar: char;
+begin
+  with Result do
+  begin
+    TheChar := TextPointer^;
+    Character := TheChar;
+    inc( TextPointer );
+
+    case TheChar of
+      ' ': // ---- Space (word break) found ----
+        ElementType := teWordBreak;
+
+      #10, #13: // ---- End of line found ----
+      begin
+        ElementType := teLineBreak;
+        if TheChar = #13 then
+        begin
+          TheChar := TextPointer^;
+          if TheChar = #10 then
+            // skip CR following LF
+            inc( TextPointer );
+        end;
+      end;
+
+      #0: // ---- end of text found ----
+        ElementType := teTextEnd;
+
+      '<': // ---- tag found? ----
+      begin
+        NextChar := TextPointer^;
+        if NextChar = '<' then
+        begin
+          // no. just a literal <
+          ElementType := teText;
+          inc( TextPointer );
+        end
+        else
+        begin
+          Tag := ExtractTag( TextPointer );
+          if Tag.TagType = ttImage then
+            ElementType := teImage
+          else
+            ElementType := teStyle;
+        end;
+
+      end;
+
+      '>': // check - should be double
+      begin
+        ElementType := teText;
+        NextChar := TextPointer^;
+        if NextChar = '>' then
+          inc( TextPointer );
+      end;
+
+      else
+        ElementType := teText;
+    end;
+  end; // with
+  NextElement := TextPointer;
+end;
+
+function ExtractPreviousTextElement( const TextStart: PChar;
+                                     TextPointer: PChar;
+                                     Var NextElement: PChar ): TTextElement;
+var
+  TheChar: Char;
+  PreviousChar: Char;
+  FoundTag: boolean;
+begin
+  with Result do
+  begin
+    dec( TextPointer );
+    TheChar := TextPointer^;
+    Character := TheChar;
+    if TextPointer < TextStart then
+    begin
+      ElementType := teTextEnd;
+      exit;
+    end;
+
+    case TheChar of
+      ' ': // ---- Space (word break) found ----
+        ElementType := teWordBreak;
+
+      #10, #13: // ---- End of line found ----
+      begin
+        ElementType := teLineBreak;
+        if TheChar = #10 then
+        begin
+          dec( TextPointer );
+          TheChar := TextPointer^;
+          if TheChar = #13 then
+          begin
+            // skip CR preceeding LF
+          end
+          else
+            inc( TextPointer );
+        end;
+      end;
+
+      '>': // ---- tag found ----
+      begin
+        FoundTag := true;
+        if TextPointer > TextStart then
+        begin
+          PreviousChar := ( TextPointer - 1 )^;
+          if PreviousChar = '>' then
+          begin
+            // no. just a literal >
+            FoundTag := false;
+            ElementType := teText;
+            dec( TextPointer );
+          end
+        end;
+
+        if FoundTag then
+        begin
+          Tag := ExtractPreviousTag( TextStart, TextPointer );
+          if Tag.TagType = ttImage then
+            ElementType := teImage
+          else
+            ElementType := teStyle;
+        end;
+      end;
+
+      '<': // should be double
+      begin
+        ElementType := teText;
+        if TextPointer > TextStart then
+        begin
+          PreviousChar := TextPointer^;
+          if PreviousChar = '<' then
+            dec( TextPointer );
+        end;
+      end
+      else
+        ElementType := teText;
+    end;
+  end; // with
+  NextElement := TextPointer;
+end;
+
+function GetTagColor( const ColorParam: string;
+                      var Color: TfpgColor ): boolean;
+var
+  ColorIndex: longint;
+begin
+  Result := false;
+  if ColorParam <> '' then
+  begin
+    if ColorParam[ 1 ] = '#' then
+    begin
+      try
+        Color := HexToInt( StrRightFrom( ColorParam, 2 ) );
+        Result := true;
+      except
+      end;
+    end
+    else
+    begin
+      for ColorIndex := 0 to High( StandardColors ) do
+      begin
+        if StringsSame( ColorParam, StandardColors[ ColorIndex ].Name ) then
+        begin
+          Color := StandardColors[ ColorIndex ].Color;
+          Result := true;
+          break;
+        end;
+      end;
+    end;
+  end;
+end;
+
+function GetTagTextAlignment( const AlignParam: string;
+                              const Default: TTextAlignment ): TTextAlignment;
+begin
+  if StringsSame( AlignParam, 'left' ) then
+    Result := taLeft
+  else if StringsSame( AlignParam, 'center' ) then
+    Result := taCenter
+  else if StringsSame( AlignParam, 'right' ) then
+    Result := taRight
+  else
+    Result := Default;
+end;
+
+function GetTagTextWrap( const WrapParam: string ): boolean;
+begin
+  Result := StringsSame( WrapParam, 'yes' );
+end;
+
+function RichTextFindString( pRichText: PChar;
+                             const Text: string;
+                             var pMatch: PChar;
+                             var MatchLength: longint ): boolean;
+var
+  P: PChar;
+  NextP: PChar;
+  Element: TTextElement;
+  pMatchStart: pchar;
+  pMatchStartNext: pchar;
+  MatchIndex: longint;
+  C: Char;
+begin
+  if Length( Text ) = 0 then
+  begin
+    // null string always matches
+    Result := true;
+    pMatch := pRichText;
+    MatchLength := 0;
+    exit;
+  end;
+
+  P := pRichText;
+  MatchIndex := 1;
+
+  // Now search, case insensitively
+  while true do
+  begin
+    Element := ExtractNextTextElement( P, NextP );
+
+    case Element.ElementType of
+      teTextEnd:
+        // end of text
+        break;
+
+      teImage,
+      teLineBreak:
+        // breaks a potential match
+        MatchIndex := 1;
+
+      teStyle:
+        ; // ignore, matches can continue
+
+      else
+      begin
+        if Uppercase(Element.Character) = UpperCase(Text[Matchindex]) then
+        begin
+          // found a match
+          if MatchIndex = 1 then
+          begin
+            pMatchStart := P; // store start of match
+            pMatchStartNext := NextP;
+          end;
+
+          inc( MatchIndex );
+          if MatchIndex > Length( Text ) then
+          begin
+            // found a complete match
+            Result := true;
+            pMatch := pMatchStart;
+            MatchLength := PCharDiff( P, pMatchStart )
+                           + 1; // include this char
+            exit;
+          end;
+        end
+        else
+        begin
+          // not a match
+          if MatchIndex > 1 then
+          begin
+            // go back to start of match, + 1
+            NextP := pMatchStartNext;
+            MatchIndex := 1;
+          end;
+        end;
+      end;
+    end;
+
+    P := NextP;
+  end;
+
+  // no match found
+  Result := false;
+  pMatch := nil;
+  MatchLength := 0;
+end;
+
+function RichTextWordLeft( pRichText: PChar;
+                           pStart: PChar ): PChar;
+Var
+  P: PChar;
+  NextP: PChar;
+  Element: TTextElement;
+begin
+  P := pStart;
+
+  // skip whitespace/tags...
+  Element := ExtractPreviousTextElement( pRichText, P, NextP );
+  P := NextP;
+  while Element.ElementType in [ teWordBreak, teLineBreak, teImage, teStyle ] do
+  begin
+    Element := ExtractPreviousTextElement( pRichText, P, NextP );
+    P := NextP;
+  end;
+  if Element.ElementType = teTextEnd then
+  begin
+    Result := P;
+    // out of text
+    exit;
+  end;
+
+  // back to start of word, skip text/tags
+  while true do
+  begin
+    Element := ExtractPreviousTextElement( pRichText, P, NextP );
+    if not ( Element.ElementType in [ teText, teStyle ] ) then
+      break;
+    P := NextP;
+  end;
+  Result := P;
+end;
+
+function RichTextWordRight( pStart: PChar ): PChar;
+Var
+  P: PChar;
+  NextP: PChar;
+  Element: TTextElement;
+begin
+  P := pStart;
+
+  // skip text/tags...
+  Element := ExtractNextTextElement( P, NextP );
+  while Element.ElementType in [ teStyle, teText ] do
+  begin
+    P := NextP;
+    Element := ExtractNextTextElement( P, NextP );
+  end;
+  if Element.ElementType <> teTextEnd then
+  begin
+    // skip whitespace
+    Element := ExtractNextTextElement( P, NextP );
+    while Element.ElementType in [ teWordBreak, teLineBreak, teImage, teStyle ] do
+    begin
+      P := NextP;
+      Element := ExtractNextTextElement( P, NextP );
+    end;
+  end;
+
+  Result := P;
+end;
+
+function RichTextWordAt( pRichText: PChar;
+                         pStart: PChar;
+                         Var pWordStart: PChar;
+                         Var WordLength: longint ): boolean;
+Var
+  P: PChar;
+  NextP: PChar;
+  Element: TTextElement;
+  pWordEnd: PChar;
+begin
+  P := pStart;
+  Element := ExtractNextTextElement( P, NextP );
+  if not ( Element.ElementType in [ teStyle, teText ] ) then
+  begin
+    // not in a word.
+    result := false;
+    pWordStart := nil;
+    WordLength := 0;
+    exit;
+  end;
+  // find end of the word
+  while Element.ElementType in [ teStyle, teText ] do
+  begin
+    P := NextP;
+    Element := ExtractNextTextElement( P, NextP );
+  end;
+  pWordEnd := P;
+
+  P := pStart;
+  Element := ExtractPreviousTextElement( pRichText, P, NextP );
+  while Element.ElementType in [ teStyle, teText ] do
+  begin
+    P := NextP;
+    Element := ExtractPreviousTextElement( pRichText, P, NextP );
+  end;
+  pWordStart := P;
+  WordLength := PCharDiff( pWordEnd, pWordStart );
+  Result := true;
+end;
+
+function CopyPlainTextToBuffer( StartP: PChar;
+                                EndP: PChar;
+                                Buffer: PChar;
+                                BufferLength: longint ): longint;
+var
+  Q: PChar;
+  EndQ: Pchar;
+  P: PChar;
+  NextP: PChar;
+  Element: TTextElement;
+begin
+  P := StartP;
+  Q := Buffer;
+  EndQ := Buffer + BufferLength;
+
+  while P < EndP do
+  begin
+    Element := ExtractNextTextElement( P, NextP );
+    case Element.ElementType of
+      teText, teWordBreak:
+      begin
+        // copy char
+        if Buffer <> nil then
+          Q[ 0 ] := Element.Character;
+        inc( Q );
+      end;
+
+      teLineBreak:
+      begin
+        if Buffer <> nil then
+          Q[ 0 ] := #13;
+        inc( Q );
+        if Q = EndQ then
+          // end of buffer
+          break;
+
+        if Buffer <> nil then
+          Q[ 0 ] := #10;
+        inc( Q );
+      end;
+    end;
+
+   if Q = EndQ then
+     // end of buffer
+     break;
+
+    P := NextP;
+  end;
+  result := PCharDiff( Q, Buffer );
+end;
+
+Initialization
+End.
diff --git a/docview/components/richtext/RichTextLayoutUnit.pas b/docview/components/richtext/RichTextLayoutUnit.pas
new file mode 100644
index 00000000..97ffa131
--- /dev/null
+++ b/docview/components/richtext/RichTextLayoutUnit.pas
@@ -0,0 +1,1018 @@
+Unit RichTextLayoutUnit;
+
+{$mode objfpc}{$H+}
+
+// Dynamically created layout class.
+// Represents a laid out rich text document
+
+Interface
+
+Uses
+  Classes,
+  CanvasFontManager,
+  RichTextDocumentUnit, RichTextStyleUnit,
+  fpg_imagelist;
+
+Type
+  TLayoutLine = record
+    Text: PChar;
+    Length: longint;
+    Height: longint;
+    Width: longint;
+    MaxDescender: longint;
+    MaxTextHeight: longint; // maximum height of text, doesn't include images
+    LinkIndex: longint; // link index at start of line, if any
+    Style: TTextDrawStyle;
+    Wrapped: boolean;
+  end;
+
+
+  TLinesArray = array[ 0..0 ] of TLayoutLine;
+
+
+  TTextPosition =
+  (
+    tpAboveTextArea,
+    tpAboveText,
+    tpWithinText,
+    tpBelowText,
+    tpBelowTextArea
+  );
+
+
+  // forward declaration
+  TRichTextLayout = class;
+
+
+//  TLinkEvent = procedure( Sender: TRichTextLayout; Link: string ) of object;
+
+
+  TRichTextLayout = class(TObject)
+  Protected
+    FFontManager: TCanvasFontManager;
+    FText: PChar;
+    FImages: TfpgImageList;
+    FAllocatedNumLines: Longint;
+    FLayoutWidth: longint; // The target width for the layout. Used for centreing/right align
+    FWidth: longint;       // The actual width of the text. May be wider due to unaligned
+                           // parts or bitmaps or width so small individual characters don't fit.
+    FHeight: longint;
+    FLinks: TStringList;
+    FHorizontalImageScale: double;
+    FVerticalImageScale: double;
+  public
+    // Internal layout data
+    FLines: ^TLinesArray;
+    FNumLines: longint;
+    FRichTextSettings: TRichTextSettings;
+    // Drawing functions
+    Procedure PerformStyleTag( Const Tag: TTag;
+                               Var Style: TTextDrawStyle;
+                               const X: longint );
+    function GetElementWidth( Element: TTextElement ): longint;
+    // Queries
+    Function GetStartX( Style: TTextDrawStyle;
+                        Line: TLayoutLine ): longint;
+    Procedure GetXFromOffset( const Offset: longint;
+                              const LineIndex: longint;
+                              Var X: longint );
+    Procedure GetOffsetFromX( const XToFind: longint;
+                              const LineIndex: longint;
+                              Var Offset: longint;
+                              Var Link: string );
+    function FindPoint( XToFind, YToFind: longint;
+                        Var LineIndex: longint;
+                        Var Offset: longint;
+                        Var Link: string ): TTextPosition;
+    function GetLineFromCharIndex( Index: longint ): longint;
+    function GetOffsetFromCharIndex( Index: longint;
+                                     Line: longint ): longint;
+    function GetLinePosition( Line: longint ): longint;
+    function GetLineFromPosition( YToFind: longint;
+                                  Var LineIndex: longint;
+                                  Var Remainder: longint ): TTextPosition;
+    // Layout functions
+    Procedure   AddLineStart( Const Line: TLayoutLine );
+    Procedure   CheckFontHeights( Var Line: TLayoutLine );
+    Procedure   Layout;
+    function    IsValidBitmapIndex( Index: longint ): boolean;
+    // property handlers
+    Function    GetCharIndex( P: PChar ): longint;
+    Function    GetTextEnd: longint;
+  Public
+    constructor Create( Text: PChar; Images: TfpgImageList; RichTextSettings: TRichTextSettings; FontManager: TCanvasFontManager; Width: longint );
+    Destructor  Destroy; Override;
+    property    TextEnd: longint read GetTextEnd;
+    function    LinkFromIndex( const CharIndexToFind: longint): string;
+    property    Images: TfpgImageList read FImages;
+    property    Width: longint read FWidth;
+    property    Height: longint read FHeight;
+    property    HorizontalImageScale: double read FHorizontalImageScale;
+    property    VerticalImageScale: double read FVerticalImageScale;
+  End;
+
+
+Implementation
+
+
+Uses
+  SysUtils
+//  PMWin, BseDos, Dos, ClipBrd, Printers,
+//  ACLUtility,
+  ,ACLStringUtility
+//  ACLString,
+//  ControlScrolling;
+  ,nvUtilities
+  ,fpg_main
+  ;
+
+Function TRichTextLayout.GetTextEnd: longint;
+begin
+  Result := StrLen( FText );
+end;
+
+// Create a layout of the specified rich text.
+constructor TRichTextLayout.Create(Text: PChar; Images: TfpgImageList;
+    RichTextSettings: TRichTextSettings; FontManager: TCanvasFontManager;
+    Width: longint);
+var
+  DefaultFontSpec: TFontSpec;
+Begin
+ProfileEvent('DEBUG:  TRichTextLayout.Create >>>>');
+  Inherited Create;
+  FRichTextSettings := RichTextSettings;
+  FImages := Images;
+  FText := Text;
+  FAllocatedNumLines := 10;
+ProfileEvent('DEBUG:  TRichTextLayout.Create   1 of 4');
+  GetMem( FLines, FAllocatedNumLines * sizeof( TLayoutLine ) );
+  FNumLines := 0;
+  FLinks := TStringList.Create;
+  FLinks.Duplicates := dupIgnore;
+  FFontManager := FontManager;
+  FLayoutWidth := Width;
+ProfileEvent('DEBUG:  TRichTextLayout.Create   2');
+  FHorizontalImageScale := 1;
+  FVerticalImageScale := 1;
+  //FHorizontalImageScale :=   FFontManager.Canvas.HorizontalResolution
+  //                         / Screen.Canvas.HorizontalResolution;
+  //FVerticalImageScale   :=   FFontManager.Canvas.VerticalResolution
+  //                         / Screen.Canvas.VerticalResolution;
+
+  // use normal font for default font when specified fonts can't be found
+  FPGuiFontToFontSpec( RichTextSettings.NormalFont, DefaultFontSpec );
+ProfileEvent('DEBUG:  TRichTextLayout.Create   3');
+  FFontManager.DefaultFontSpec := DefaultFontSpec;
+ProfileEvent('DEBUG:  TRichTextLayout.Create   4');
+  Layout;
+ProfileEvent('DEBUG:  TRichTextLayout.Create <<<<');
+End;
+
+Destructor TRichTextLayout.Destroy;
+Begin
+  FreeMem( Flines, FAllocatedNumLines * sizeof( TLayoutLine ) );
+  FLines := nil;
+  FLinks.Free;
+  Inherited Destroy;
+End;
+
+Procedure TRichTextLayout.AddLineStart( Const Line: TLayoutLine );
+var
+  NewAllocation: longint;
+begin
+  if FNumLines >= FAllocatedNumLines then
+  begin
+    // reallocate the array twice the size
+    NewAllocation := FAllocatedNumLines * 2;
+    FLines := ReAllocMem( FLines,
+//                          FAllocatedNumLines * sizeof( TLayoutLine ),
+                          NewAllocation * sizeof( TLayoutLine ) );
+    FAllocatedNumLines := NewAllocation;
+  end;
+  FLines^[ FNumLines ] := Line;
+  inc( FNumLines );
+  ProfileEvent('          DEBUG:  TRichTextLayout.AddLineStart: FNumLines =' + intToStr(FNumLines));
+end;
+
+Procedure TRichTextLayout.PerformStyleTag( Const Tag: TTag;
+                                           Var Style: TTextDrawStyle;
+                                           const X: longint );
+begin
+ProfileEvent('DEBUG:  TRichTextLayout.PerformStyleTag >>>');
+  ApplyStyleTag( Tag,
+                 Style,
+                 FFontManager,
+                 FRichTextSettings,
+                 X );
+ProfileEvent('DEBUG:  TRichTextLayout.PerformStyleTag <<<');
+end;
+
+// Check the current font specifications and see if the
+// give line needs updating for max height/descender
+Procedure TRichTextLayout.CheckFontHeights( Var Line: TLayoutLine );
+var
+  FontHeight: longint;
+  Descender: longint;
+begin
+  FontHeight := FFontManager.CharHeight;
+  Descender := FFontManager.CharDescender;
+
+  if FontHeight > Line.Height then
+    Line.Height := FontHeight;
+
+  if FontHeight > Line.MaxTextHeight then
+    Line.MaxTextHeight := FontHeight;
+
+  if Descender > Line.MaxDescender then
+    Line.MaxDescender := Descender;
+end;
+
+function TRichTextLayout.IsValidBitmapIndex( Index: longint ): boolean;
+begin
+  if FImages = nil then
+    Result := false
+  else if FImages.Count = 0 then
+    Result := false
+  else
+    Result := Between( Index, 0, FImages.Count - 1 );
+end;
+
+// Main procedure: reads through the whole text currently stored
+// and breaks up into lines - each represented as a TLayoutLine in
+// the array FLines[ 0.. FNumLines ]
+Procedure TRichTextLayout.Layout;
+Var
+  CurrentLine: TLayoutLine;
+  CurrentLinkIndex: longint;
+  WrapX: longint; // X to wrap at
+  WordX: longint; // width of word so far
+  P: PChar;
+  NextP: PChar;
+  NextP2: PChar;
+  WordStart: PChar;
+  WordStarted: boolean; // if false, just skipping spaces..
+  WordStartX: longint; // X position of word start
+  LineWordsCompleted: longint; // how many words draw so far this line
+  CurrentElement: TTextElement;
+  NextElement: TTextElement;
+  CurrentCharWidth: longint;
+  Style: TTextDrawStyle;
+  DisplayedCharsSinceFontChange: boolean;
+  BitmapIndex: longint;
+  Bitmap: TfpgImage;
+  BitmapHeight: longint;
+  OnBreak: boolean;
+  DoWrap: boolean;
+
+  // Nested procedure
+  Procedure DoLine( EndPoint: PChar; NextLine: PChar; EndX: longint );
+  begin
+    // check if the max font
+    // height needs updating for the last string of the line
+    CheckFontHeights( CurrentLine );
+    inc( FHeight, CurrentLine.Height );
+    CurrentLine.Length := PCharDiff( EndPoint, CurrentLine.Text );
+    CurrentLine.Width := EndX;
+    if CurrentLine.Width > FWidth then
+      FWidth := CurrentLine.Width;
+    assert( CurrentLine.Height > 0 ); // we must have set the line height!
+    AddLineStart( CurrentLine );
+    CurrentLine.Text := NextLine;
+    CurrentLine.Style := Style;
+    CurrentLine.Height := 0;
+    CurrentLine.MaxDescender := 0;
+    CurrentLine.MaxTextHeight := 0;
+    CurrentLine.Width := 0;
+    CurrentLine.LinkIndex := CurrentLinkIndex;
+    CurrentLine.Wrapped := false;
+    assert( CurrentLinkIndex >= -1 );
+    assert( CurrentLinkIndex < FLinks.Count );
+    WordStartX := Style.LeftMargin{ * FontWidthPrecisionFactor};
+    // next line
+    // reset words completed count
+    LineWordsCompleted := 0;
+    WordStarted := false;
+  end;
+
+begin
+ProfileEvent('DEBUG:  TRichTextLayout.Layout  >>>>');
+  FNumLines := 0;
+  FWidth := FRichTextSettings.Margins.Left;
+  FHeight := FRichTextSettings.Margins.Top;
+  Style := GetDefaultStyle( FRichTextSettings );
+  ApplyStyle( Style, FFontManager );
+  CurrentLinkIndex := -1;
+  P := FText; // P is the current search position
+  CurrentLine.Text := P;
+  CurrentLine.Style := Style;
+  CurrentLine.Height := 0;
+  CurrentLine.MaxDescender := 0;
+  CurrentLine.MaxTextHeight := 0;
+  CurrentLine.Width := 0;
+  CurrentLine.LinkIndex := -1;
+  CurrentLine.Wrapped := false;
+  WordStartX := Style.LeftMargin{ * FontWidthPrecisionFactor};
+  WordX := 0;
+  WrapX := FLayoutWidth - (FRichTextSettings.Margins.Right{ * FontWidthPrecisionFactor});
+  LineWordsCompleted := 0;
+  WordStarted := false;
+  DisplayedCharsSinceFontChange := false;
+
+  repeat
+    CurrentElement := ExtractNextTextElement( P, NextP );
+    assert( NextP > P );
+    OnBreak := false;
+    case CurrentElement.ElementType of
+      teWordBreak:
+      begin
+        CurrentCharWidth := FFontManager.CharWidth( ' ' );
+        OnBreak := true;
+      end;
+
+      teLineBreak:
+      begin
+        DoLine( P, NextP, WordStartX + WordX );
+
+        // remember start of line
+        WordStart := NextP;
+        WordX := 0;
+
+        P := NextP;
+
+        continue;
+      end;
+
+      teTextEnd:
+      begin
+        DoLine( P, NextP, WordStartX + WordX );
+
+        // end of text, done
+        break;
+      end;
+
+      teImage:
+      begin
+        BitmapHeight := 0;
+        try
+          BitmapIndex := StrToInt( CurrentElement.Tag.Arguments );
+        except
+          BitmapIndex := -1;
+        end;
+        Bitmap := nil;
+        if IsValidBitmapIndex( BitmapIndex ) then
+        begin
+          Bitmap := FImages.Item[BitmapIndex].Image;
+          CurrentCharWidth := Trunc(Bitmap.Width * FontWidthPrecisionFactor * FHorizontalImageScale);
+          WordStarted := true;
+          BitmapHeight := Trunc(Bitmap.Height * FVerticalImageScale);
+        end;
+
+      end;
+
+      teText:
+      begin
+        // Normal (non-leading-space) character
+        CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
+        WordStarted := true;
+      end;
+
+      teStyle:
+      begin
+        case CurrentElement.Tag.TagType of
+          ttBeginLink:
+          begin
+            CurrentLinkIndex := FLinks.Add( CurrentElement.Tag.Arguments );
+            P := NextP;
+            continue;
+          end;
+
+          ttEndLink:
+          begin
+            CurrentLinkIndex := -1;
+            P := NextP;
+            continue;
+          end;
+
+          ttSetLeftMargin: // SPECIAL CASE... could affect display immediately
+          begin
+            PerformStyleTag( CurrentElement.Tag, Style, WordstartX + WordX );
+            if Style.LeftMargin {* FontWidthPrecisionFactor} < WordStartX then
+            begin
+              // we're already past the margin being set
+              if pos( 'breakifpast', CurrentElement.Tag.Arguments ) > 0 then
+              begin
+                // this argument means, do a line break
+                // if the margin is already past
+                // Seems unusual for most purposes, but needed for IPF rendering.
+                DoLine( P, NextP, WordStartX + WordX );
+
+                // remember start of line
+                WordStart := NextP;
+                WordX := 0;
+
+                P := NextP;
+
+                continue;
+              end;
+
+              // so ignore it for now.
+              P := NextP;
+              continue;
+            end;
+
+            // skip across to the new margin
+            CurrentCharWidth := (Style.LeftMargin {* FontWidthPrecisionFactor})
+                                - WordStartX - WordX;
+            // BUT! Don't treat it as a space, because you would not
+            // expect wrapping to take place in a margin change...
+            // at least not for IPF  :)
+
+          end;  { teSetLeftMargin }
+
+          else
+          begin
+            // before processing the tag see if font height needs updating
+            if DisplayedCharsSinceFontChange then
+              CheckFontHeights( CurrentLine );
+
+            if     ( CurrentElement.Tag.TagType = ttItalicOff )
+               and ( faItalic in Style.Font.Attributes ) then
+            begin
+              if not FFontManager.IsFixed then
+              begin
+                // end of italic; add a space
+                inc( WordX, FFontManager.CharWidth( ' ' ) );
+              end;
+            end;
+
+            PerformStyleTag( CurrentElement.Tag,
+                             Style,
+                             WordX );
+
+            DisplayedCharsSinceFontChange := false;
+            P := NextP;
+            continue; // continue loop
+          end;
+        end;
+
+      end
+
+    end;
+
+    if OnBreak then
+    begin
+      // we just processed a space
+      if WordStarted then
+      begin
+        DisplayedCharsSinceFontChange := true;
+        // remember that we have now completed a word on this line
+        inc( LineWordsCompleted );
+        WordStarted := false;
+
+        // Add the word width, and the space width,
+        // to get the start of the next word
+        inc( WordStartX, WordX + CurrentCharWidth );
+        WordX := 0;
+
+        // remember the start of the next word
+        WordStart := NextP;
+
+        P := NextP;
+
+        continue;
+      end;
+      // else - starting spaces - fall through like normal char
+    end;
+
+    // if we're still going here we have a normal char
+    // (or leading spaces)
+    if not Style.Wrap then
+    begin
+      // No alignment
+      // We don't care about how wide it gets
+      inc( WordX, CurrentCharWidth );
+      DisplayedCharsSinceFontChange := true;
+
+      if CurrentElement.ElementType = teImage then
+        if Bitmap <> nil then
+          if BitmapHeight > CurrentLine.Height then
+            CurrentLine.Height := BitmapHeight;
+
+      P := NextP;
+      continue;
+    end;
+
+    DoWrap := false;
+
+    // Calculate position of end of character
+    // see if char would exceed width
+    if (WordStartX + WordX + CurrentCharWidth) >= WrapX then
+    begin
+      // reached right hand side before finding end of word
+      if LineWordsCompleted > 0 then
+        // always wrap after at least one word displayed
+        DoWrap := true
+      else if not FRichTextSettings.AtLeastOneWordBeforeWrap then
+        // only wrap during the first word, if the "at least 1 word" flag is not set.
+        DoWrap := true;
+    end;
+
+    if DoWrap then
+    begin
+      if LineWordsCompleted = 0 then
+      begin
+        // the first word did not fit on the line. so draw
+        // as much as will fit
+        if WordX = 0 then
+        begin
+          // even the first char doesn't fit,
+          // but draw it anyway (otherwise, infinite loop)
+          NextElement := ExtractNextTextElement( NextP, NextP2 );
+          if NextElement.ElementType <> teLineBreak then
+            // there is still more on the line...
+            CurrentLine.Wrapped := true
+          else
+            // the line ends after this one char or image, we can skip the line end
+            NextP := NextP2;
+
+          if CurrentElement.ElementType = teImage then
+          begin
+            // the only thing on the line is the image. so check height
+            if Bitmap <> nil then
+              if BitmapHeight > CurrentLine.Height then
+                CurrentLine.Height := BitmapHeight;
+          end;
+
+          DoLine( NextP, NextP, WordStartX + WordX + CurrentCharWidth );
+          WordStart := NextP;
+          WordX := 0;
+        end
+        else
+        begin
+          CurrentLine.Wrapped := true;
+          // at least 1 char fits
+          // so draw up to, but not including this char
+          DoLine( P,
+                  P,
+                  WordStartX + WordX );
+          WordStart := P;
+          WordX := CurrentCharWidth;
+        end;
+      end
+      else
+      begin
+        // Normal wrap; at least one word fitted on the line
+        CurrentLine.Wrapped := true;
+
+        // take the width of the last space of the
+        // previous word off the line width
+        DoLine( WordStart, // current line ends at start of this word
+                WordStart, // next line starts at start of this word
+                WordStartX - FFontManager.CharWidth( ' ' ) );
+        if CurrentElement.ElementType = teImage then
+          if Bitmap <> nil then
+            if BitmapHeight > CurrentLine.Height then
+              CurrentLine.Height := BitmapHeight;
+
+        // do NOT reset WordX to zero; as we are continuing
+        // from partway thru the word on the next line.
+        inc( WordX, CurrentCharWidth );
+      end;
+      WordStarted := true; // by definition, for wrapping
+    end
+    else
+    begin
+      // Character fits.
+      inc( WordX, CurrentCharWidth );
+      DisplayedCharsSinceFontChange := true;
+      if CurrentElement.ElementType = teImage then
+        if Bitmap <> nil then
+          if BitmapHeight > CurrentLine.Height then
+            CurrentLine.Height := BitmapHeight;
+    end;
+
+    P := NextP;
+  until false; // loop is exited by finding end of text
+
+  inc( FHeight, FRichTextSettings.Margins.Bottom );
+ProfileEvent('DEBUG:  TRichTextLayout.Layout  <<<<');
+End;
+
+Function TRichTextLayout.GetStartX( Style: TTextDrawStyle;
+                                    Line: TLayoutLine ): longint;
+var
+  SpaceOnLine: longint;
+begin
+  case Style.Alignment of
+    taLeft:
+      Result := Style.LeftMargin * FontWidthPrecisionFactor;
+
+    taRight:
+      Result :=   Style.LeftMargin * FontWidthPrecisionFactor
+                + FLayoutWidth
+                - Style.RightMargin * FontWidthPrecisionFactor
+                - Line.Width;
+
+    taCenter:
+      begin
+        // |<------layout width------------------>|
+        // |                                      |
+        // |<-lm->[aaaaaaaaaaaaaaa]<-space-><-rm->|
+        // |<-----line width------>               |
+        // space = layoutw-rm-linew
+        SpaceOnLine :=   FLayoutWidth
+                       - Style.RightMargin * FontWidthPrecisionFactor
+                       - Line.Width; // Note: line width includes left margin
+        Result :=   Style.LeftMargin * FontWidthPrecisionFactor
+                  + SpaceOnLine div 2;
+      end;
+  end;
+end;
+
+Procedure TRichTextLayout.GetOffsetFromX( const XToFind: longint;
+                                          const LineIndex: longint;
+                                          Var Offset: longint;
+                                          Var Link: string );
+Var
+  X: longint;
+  P: PChar;
+  NextP: PChar;
+  EndP: PChar;
+  Element: TTextElement;
+  CurrentLink: string;
+  Line: TLayoutLine;
+  Style: TTextDrawStyle;
+  NewMarginX: longint;
+  StartedDrawing: boolean;
+begin
+  Line := TLayoutLine(FLines[ LineIndex ]);
+  P := Line.Text;
+  EndP := Line.Text + Line.Length;
+
+  Style := Line.Style;
+  FFontManager.SetFont( Style.Font );
+
+  StartedDrawing := false;
+
+  Link := '';
+  if Line.LinkIndex <> -1 then
+    CurrentLink := FLinks[ Line.LinkIndex ]
+  else
+    CurrentLink := '';
+
+  while P < EndP do
+  begin
+    Element := ExtractNextTextElement( P, NextP );
+
+    case Element.ElementType of
+      teWordBreak,
+      teText,
+      teImage:
+      begin
+        if not StartedDrawing then
+        begin
+          // we haven't yet started drawing:
+          // so work out alignment
+          X := GetStartX( Style, Line );
+
+          if X div FontWidthPrecisionFactor
+             > XToFind then
+          begin
+            // found before the start of the line
+            // don't set link
+            Offset := 0;
+            exit;
+          end;
+
+          StartedDrawing := true;
+
+        end;
+
+        // Now find out how wide the thing is
+        inc( X, GetElementWidth( Element ) );
+
+        if X div FontWidthPrecisionFactor
+           > XToFind then
+        begin
+          // found
+          Offset := PCharDiff( P, Line.Text );
+          Link := CurrentLink;
+          exit;
+        end;
+
+      end;
+
+      teStyle:
+        case Element.Tag.TagType of
+          ttBeginLink:
+            CurrentLink := Element.Tag.Arguments;
+          ttEndLink:
+            CurrentLink := '';
+          else
+          begin
+            if     ( Element.Tag.TagType = ttItalicOff )
+               and ( faItalic in Style.Font.Attributes )
+               and ( not FFontManager.IsFixed ) then
+              // end of italic; add a space
+              inc( X, FFontManager.CharWidth( ' ' )  );
+
+            PerformStyleTag( Element.Tag,
+                             Style,
+                             X );
+            NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
+            if NewMarginX > X then
+            begin
+              //skip across...
+              X := NewMarginX;
+            end;
+          end;
+        end;
+    end;
+
+    P := NextP;
+  end;
+  Offset := Line.Length;
+end;
+
+Procedure TRichTextLayout.GetXFromOffset( const Offset: longint;
+                                          const LineIndex: longint;
+                                          Var X: longint );
+Var
+  P: PChar;
+  NextP: PChar;
+  EndP: PChar;
+  Element: TTextElement;
+  StartedDrawing: boolean;
+  Line: TLayoutLine;
+  Style: TTextDrawStyle;
+  NewMarginX: longint;
+begin
+  Line := TLayoutLine(FLines[ LineIndex ]);
+  P := Line.Text;
+  EndP := Line.Text + Line.Length;
+
+  Style := Line.Style;
+  FFontManager.SetFont( Style.Font );
+
+  StartedDrawing := false;
+
+  while P < EndP do
+  begin
+    Element := ExtractNextTextElement( P, NextP );
+
+    case Element.ElementType of
+      teWordBreak,
+      teText,
+      teImage:
+      begin
+        if not StartedDrawing then
+        begin
+          // we haven't yet started drawing:
+          // so work out alignment
+          X := GetStartX( Style, Line );
+          StartedDrawing := true;
+        end;
+
+        if GetCharIndex( P ) - GetCharIndex( Line.Text ) >= Offset then
+        begin
+          X := X div FontWidthPrecisionFactor;
+          // found
+          exit;
+        end;
+
+        // Now find out how wide the thing is
+        inc( X, GetElementWidth( Element ) );
+
+      end;
+
+      teStyle:
+      begin
+        if     ( Element.Tag.TagType = ttItalicOff )
+           and ( faItalic in Style.Font.Attributes )
+           and ( not FFontManager.IsFixed ) then
+          // end of italic; add a space
+          inc( X, FFontManager.CharWidth( ' ' )  );
+
+        PerformStyleTag( Element.Tag,
+                         Style,
+                         X );
+
+        NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
+        if NewMarginX > X then
+        begin
+          //skip across...
+          X := NewMarginX;
+        end;
+      end;
+    end;
+
+    P := NextP;
+  end;
+  // went thru the whole line without finding the point,
+  if not StartedDrawing then
+    X := GetStartX( Style, Line );
+
+  X := X div FontWidthPrecisionFactor;
+end;
+
+function TRichTextLayout.GetLineFromPosition( YToFind: longint;
+                                              Var LineIndex: longint;
+                                              Var Remainder: longint ): TTextPosition;
+var
+  Y: longint;
+  LineHeight: longint;
+begin
+  LineIndex := 0;
+  Remainder := 0;
+
+  Y := FRichTextSettings.Margins.Top;
+
+  if YToFind < Y then
+  begin
+    Result := tpAboveText;
+    exit;
+  end;
+
+  while LineIndex < FNumLines do
+  begin
+    LineHeight := TLayoutLine(FLines[ LineIndex ]).Height;
+    if     ( YToFind >= Y )
+       and ( YToFind < Y + LineHeight ) then
+      begin
+        // YToFind is within the line
+        Result := tpWithinText;
+        Remainder := YToFind - Y;
+        exit;
+      end;
+
+    inc( Y, TLayoutLine(FLines[ LineIndex ]).Height );
+    inc( LineIndex );
+  end;
+
+  LineIndex := FNumLines - 1;
+  Remainder := TLayoutLine(FLines[ LineIndex ]).Height;
+
+  Result := tpBelowText;
+end;
+
+function TRichTextLayout.FindPoint( XToFind, YToFind: longint;
+                                    Var LineIndex: longint;
+                                    Var Offset: longint;
+                                    Var Link: string ): TTextPosition;
+var
+  Remainder: longint;
+begin
+  Link := '';
+  Result := GetLineFromPosition( YToFind,
+                                 LineIndex,
+                                 Remainder );
+  case Result of
+    tpAboveText:
+    begin
+      Offset := 0;
+      exit;
+    end;
+
+    tpBelowText:
+    begin
+      Offset := TLayoutLine(FLines[ LineIndex ]).Length;
+      exit;
+    end;
+  end;
+
+  // found the line
+  GetOffsetFromX( XToFind,
+                  LineIndex,
+                  Offset,
+                  Link );
+end;
+
+function TRichTextLayout.GetLineFromCharIndex( Index: longint ): longint;
+var
+  LineCharIndex: longint;
+  LineLength: longint;
+begin
+  Result := 0;
+  if Index <= 0 then
+    exit;
+
+  while Result < FNumLines do
+  begin
+    LineCharIndex := GetCharIndex( TLayoutLine(FLines[ Result ]).Text );
+    LineLength := TLayoutLine(FLines[ Result ]).Length;
+    if LineCharIndex + LineLength
+       > Index then
+    begin
+      // found
+      exit;
+    end;
+    inc( Result );
+  end;
+  Result := FNumLines - 1;
+end;
+
+function TRichTextLayout.GetOffsetFromCharIndex( Index: longint;
+                                                 Line: longint ): longint;
+begin
+  Result := Index - GetCharIndex( TLayoutLine( FLines[ Line ] ).Text );
+end;
+
+function TRichTextLayout.GetElementWidth( Element: TTextElement ): longint;
+var
+  Bitmap: TfpgImage;
+  BitmapIndex: longint;
+begin
+  // Now find out how wide the thing is
+  case Element.ElementType of
+    teImage:
+    begin
+      try
+        BitmapIndex := StrToInt( Element.Tag.Arguments );
+      except
+        BitmapIndex := -1;
+      end;
+      if IsValidBitmapIndex( BitmapIndex ) then
+      begin
+        Bitmap := FImages.Item[BitmapIndex].Image;
+        Result := Trunc(Bitmap.Width
+                  * FontWidthPrecisionFactor
+                  * FHorizontalImageScale);
+      end;
+    end;
+
+    teText, teWordBreak:
+      Result := FFontManager.CharWidth( Element.Character );
+
+    else
+      Assert( False ); // should never be trying to find the width of a style, etc
+
+  end;
+end;
+
+Function TRichTextLayout.GetCharIndex( P: PChar ): longint;
+begin
+  Result := PCharDiff( P, FText );
+end;
+
+function TRichTextLayout.GetLinePosition( Line: longint ): longint;
+begin
+  Result := FRichTextSettings.Margins.Top;
+  dec( line );
+  while line >= 0 do
+  begin
+    inc( Result,
+         TLayoutLine(Flines[ Line ]).Height );
+    dec( line );
+  end;
+end;
+
+function TRichTextLayout.LinkFromIndex( const CharIndexToFind: longint): string;
+Var
+  P: PChar;
+  NextP: PChar;
+  EndP: PChar;
+  Element: TTextElement;
+  LineIndex: longint;
+  Line: TLayoutLine;
+begin
+  if FNumLines = 0 then
+  begin
+    Result := '';
+    exit;
+  end;
+
+  LineIndex := GetLineFromCharIndex( CharIndexToFind );
+
+  Line := TLayoutLine(FLines[ LineIndex ]);
+  P := Line.Text;
+  EndP := Line.Text + Line.Length;
+
+  if Line.LinkIndex <> -1 then
+    Result := FLinks[ Line.LinkIndex ]
+  else
+    Result := '';
+
+  while P < EndP do
+  begin
+    if GetCharIndex( P ) >= CharIndexToFind then
+      exit;
+
+    Element := ExtractNextTextElement( P, NextP );
+
+    case Element.ElementType of
+      teStyle:
+        case Element.Tag.TagType of
+          ttBeginLink:
+            Result := Element.Tag.Arguments;
+          ttEndLink:
+            Result := '';
+        end;
+    end;
+
+    P := NextP;
+  end;
+end;
+
+Initialization
+End.
+
diff --git a/docview/components/richtext/RichTextPrintUnit.pas b/docview/components/richtext/RichTextPrintUnit.pas
new file mode 100644
index 00000000..01746c68
--- /dev/null
+++ b/docview/components/richtext/RichTextPrintUnit.pas
@@ -0,0 +1,75 @@
+Unit RichTextPrintUnit;

+

+Interface

+

+uses

+  Graphics,

+  RichTextStyleUnit;

+

+// Prints the specified rich text, starting at page position PageY.

+// Starts new pages as needed; when done, PageY is the final position used

+// on the final page.

+Procedure PrintRichText( Text: PChar;

+                         Images: TImageList;

+                         Settings: TRichTextSettings;

+                         var PageY: longint );

+

+Implementation

+

+uses

+  Classes,

+  Printers,

+  CanvasFontManager,

+  RichTextLayoutUnit, RichTextDisplayUnit, Forms

+  ;

+

+Procedure PrintRichText( Text: PChar;

+                         Images: TImageList;

+                         Settings: TRichTextSettings;

+                         var PageY: longint );

+var

+  Layout: TRichTextLayout;

+  FontManager: TCanvasFontManager;

+  LineIndex: longint;

+  Y: longint;

+  FinishLine: longint;

+  FinishY: longint;

+Begin

+  FontManager := TCanvasFontManager.Create( Printer.Canvas,

+                                            false // don't allow bitmap fonts

+                                          );

+

+  Layout := TRichTextLayout.Create( Text,

+                                    Images,

+                                    Settings,

+                                    FontManager,

+                                    Printer.PageWidth );

+

+  LineIndex := 0;

+  Y := PageY;

+  repeat

+    PrintRichTextLayout( FontManager,

+                         Layout,

+                         LineIndex,

+                         FinishLine,

+                         Y,

+                         FinishY );

+    LineIndex := FinishLine;

+    Y := FinishY;

+

+    if LineIndex < Layout.FNumLines then

+    begin

+      // didn't all fit on page, so new page

+      Printer.NewPage;

+      Y := Printer.PageHeight - 1;

+    end;

+

+  until LineIndex >= Layout.FNumLines;

+

+  Layout.Destroy;

+  FontManager.Destroy;

+  PageY := Y;

+end;

+

+Initialization

+End.

diff --git a/docview/components/richtext/RichTextStyleUnit.pas b/docview/components/richtext/RichTextStyleUnit.pas
new file mode 100644
index 00000000..b3c2830e
--- /dev/null
+++ b/docview/components/richtext/RichTextStyleUnit.pas
@@ -0,0 +1,641 @@
+Unit RichTextStyleUnit;
+
+{$mode objfpc}{$H+}
+
+Interface
+
+uses
+  Classes, fpg_base, fpg_main, CanvasFontManager, RichTextDocumentUnit;
+
+type
+  TTextDrawStyle = record
+    Font: TFontSpec;
+    Color: TfpgColor;
+    BackgroundColor: TfpgColor;
+    Alignment: TTextAlignment;
+    Wrap: boolean;
+    LeftMargin: longint;
+    RightMargin: longint;
+  end;
+
+  TMarginSizeStyle = ( msAverageCharWidth, msMaximumCharWidth, msSpecifiedChar );
+
+  TRichTextSettings = class( TfpgComponent )
+  protected
+    FHeading1Font: TfpgFont;
+    FHeading2Font: TfpgFont;
+    FHeading3Font: TfpgFont;
+    FFixedFont: TfpgFont;
+    FNormalFont: TfpgFont;
+    FDefaultBackgroundColor: TfpgColor;
+    FDefaultColor: TfpgColor;
+    FDefaultAlignment: TTextAlignment;
+    FDefaultWrap: boolean;
+    FAtLeastOneWordBeforeWrap: boolean;
+    FMarginSizeStyle: TMarginSizeStyle;
+    FMarginChar: longint;
+    FOnChange: TNotifyEvent;
+    FMargins: TRect;
+    FUpdateCount: longint;
+    FChangesPending: boolean;
+    Procedure Change;
+    Procedure SetNormalFont( NewFont: TfpgFont );
+    Procedure SetFixedFont( NewFont: TfpgFont );
+    Procedure SetHeading1Font( NewFont: TfpgFont );
+    Procedure SetHeading2Font( NewFont: TfpgFont );
+    Procedure SetHeading3Font( NewFont: TfpgFont );
+    Procedure SetDefaultColor( NewColor: TfpgColor );
+    Procedure SetDefaultBackgroundColor( NewColor: TfpgColor );
+    Procedure SetDefaultAlignment( Alignment: TTextAlignment );
+    Procedure SetDefaultWrap( Wrap: boolean );
+    Procedure SetAtLeastOneWordBeforeWrap( NewValue: boolean );
+    Procedure SetMarginSizeStyle( NewValue: TMarginSizeStyle );
+    Procedure SetMarginChar( NewValue: longint );
+    Procedure SetMargins( const NewMargins: TRect );
+    function GetMargin_Left: longint;
+    Procedure SetMargin_Left( NewValue: longint );
+    function GetMargin_Bottom: longint;
+    Procedure SetMargin_Bottom( NewValue: longint );
+    function GetMargin_Right: longint;
+    Procedure SetMargin_Right( NewValue: longint );
+    function GetMargin_Top: longint;
+    Procedure SetMargin_Top( NewValue: longint );
+    Procedure SetupComponent;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    Procedure AssignFont( Var Font: TfpgFont;
+                          NewFont: TfpgFont );
+
+    // Hide properties...
+    property Name;
+
+  public
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+
+    procedure BeginUpdate;
+    procedure EndUpdate;
+
+    // Stream in/out
+    //Procedure ReadSCUResource( Const ResName: TResourceName;
+    //                           Var Data;
+    //                           DataLen: LongInt ); override;
+    //Function WriteSCUResource( Stream: TResourceStream ): boolean; override;
+
+    property Margins: TRect read FMargins write SetMargins;
+
+    property Heading1Font: TfpgFont read FHeading1Font write SetHeading1Font;
+    property Heading2Font: TfpgFont read FHeading2Font write SetHeading2Font;
+    property Heading3Font: TfpgFont read FHeading3Font write SetHeading3Font;
+    property FixedFont: TfpgFont read FFixedFont write SetFixedFont;
+    property NormalFont: TfpgFont read FNormalFont write SetNormalFont;
+
+  published
+
+    property DefaultBackgroundColor: TfpgColor read FDefaultBackgroundColor write SetDefaultBackgroundColor;
+    property DefaultColor: TfpgColor read FDefaultColor write SetDefaultColor;
+
+    property DefaultAlignment: TTextAlignment read FDefaultAlignment write SetDefaultAlignment;
+    property DefaultWrap: boolean read FDefaultWrap write SetDefaultWrap default True;
+    property AtLeastOneWordBeforeWrap: boolean read FAtLeastOneWordBeforeWrap write SetAtLeastOneWordBeforeWrap;
+
+    property MarginSizeStyle: TMarginSizeStyle read FMarginSizeStyle write SeTMarginSizeStyle;
+    property MarginChar: longint read FMarginChar write SetMarginChar;
+
+    // margins are exposed as individual properties here
+    // since the Sibyl IDE cannot cope with editing a record property
+    // within a class property (as in RichTextView)
+    property Margin_Left: longint read GetMargin_Left write SetMargin_Left;
+    property Margin_Bottom: longint read GetMargin_Bottom write SetMargin_Bottom;
+    property Margin_Right: longint read GetMargin_Right write SetMargin_Right;
+    property Margin_Top: longint read GetMargin_Top write SetMargin_Top;
+  end;
+
+//  pRichTextSettings = ^TRichTextSettings;
+  Procedure ApplyStyle( var Style: TTextDrawStyle;
+                        FontManager: TCanvasFontManager );
+
+  Procedure ApplyStyleTag( const Tag: TTag;
+                           Var Style: TTextDrawStyle;
+                           FontManager: TCanvasFontManager;
+                           const Settings: TRichTextSettings;
+                           const X: longint );
+
+  function GetDefaultStyle( const Settings: TRichTextSettings ): TTextDrawStyle;
+
+//Exports
+//  TRichTextSettings,'User','';
+
+Implementation
+
+uses
+  SysUtils,
+  ACLStringUtility
+  ,nvUtilities
+//  , ACLProfile
+  ;
+
+Procedure ApplyStyle( var Style: TTextDrawStyle; FontManager: TCanvasFontManager );
+begin
+ProfileEvent('DEBUG:  ApplyStyle >>>');
+  assert(FontManager <> nil, 'FontManager should not have been nil');
+  FontManager.SetFont( Style.Font );
+  FontManager.Canvas.TextColor := Style.Color;
+ProfileEvent('DEBUG:  ApplyStyle <<<');
+end;
+
+Procedure ApplyStyleTag( Const Tag: TTag;
+                         var Style: TTextDrawStyle;
+                         FontManager: TCanvasFontManager;
+                         const Settings: TRichTextSettings;
+                         const X: longint );
+var
+  MarginParam1: string;
+  MarginParam2: string;
+  NewMargin: longint;
+  FontFaceName: string;
+  FontSizeString: string;
+  NewStyle: TTextDrawStyle;
+  ParseIndex: longint;
+  XSizeStr: string;
+  YSizeStr: string;
+  tmpFontParts : TStringList;
+
+  MarginSize: longint;
+  ParsePoint: longint;
+begin
+ProfileEvent('DEBUG:  ApplyStyleTag >>>');
+  case Tag.TagType of
+    ttBold:
+      Include( Style.Font.Attributes, faBold );
+    ttBoldOff:
+      Exclude( Style.Font.Attributes, faBold );
+    ttItalic:
+      Include( Style.Font.Attributes, faItalic );
+    ttItalicOff:
+      Exclude( Style.Font.Attributes, faItalic );
+    ttUnderline:
+      Include( Style.Font.Attributes, faUnderscore );
+    ttUnderlineOff:
+      Exclude( Style.Font.Attributes, faUnderscore );
+
+    ttFixedWidthOn:
+      FPGuiFontToFontSpec( Settings.FFixedFont, Style.Font );
+    ttFixedWidthOff:
+      FPGuiFontToFontSpec( Settings.FNormalFont, Style.Font );
+
+    ttHeading1:
+      FPGuiFontToFontSpec( Settings.FHeading1Font, Style.Font );
+    ttHeading2:
+      FPGuiFontToFontSpec( Settings.FHeading2Font, Style.Font );
+    ttHeading3:
+      FPGuiFontToFontSpec( Settings.FHeading3Font, Style.Font );
+    ttHeadingOff:
+      FPGuiFontToFontSpec( Settings.FNormalFont, Style.Font );
+
+    ttFont:
+    begin
+      tmpFontParts := TStringList.Create;
+      StrExtractStringsQuoted(tmpFontParts, Tag.Arguments);
+      FontFaceName := tmpFontParts[0];
+      FontSizeString := tmpFontParts[1];
+      tmpFontParts.Destroy;
+
+      NewStyle := Style;
+      try
+        NewStyle.Font.FaceName := FontFaceName;
+
+        if Pos( 'x', FontSizeString ) > 0 then
+        begin
+          tmpFontParts := TStringList.Create;
+          StrExtractStrings(tmpFontParts, FontSizeString, ['x'], #0);
+          XSizeStr := tmpFontParts[0];
+          YSizeStr := tmpFontParts[1];
+          tmpFontParts.Destroy;
+
+          NewStyle.Font.XSize := StrToInt( XSizeStr );
+          NewStyle.Font.YSize := StrToInt( YSizeStr );
+          NewStyle.Font.PointSize := 0;
+        end
+        else
+        begin
+          NewStyle.Font.PointSize := StrToInt( FontSizeString );
+        end;
+
+        if     ( NewStyle.Font.FaceName <> '' )
+           and ( NewStyle.Font.PointSize >= 1 ) then
+        begin
+          Style := NewStyle;
+        end;
+
+      except
+      end;
+    end;
+
+    ttFontOff:
+      // restore default
+      FPGuiFontToFontSpec( Settings.FNormalFont, Style.Font );
+
+    ttColor:
+      GetTagColor( Tag.Arguments, Style.Color );
+    ttColorOff:
+      Style.Color := Settings.FDefaultColor;
+    ttBackgroundColor:
+      GetTagColor( Tag.Arguments, Style.BackgroundColor );
+    ttBackgroundColorOff:
+      Style.BackgroundColor := Settings.FDefaultBackgroundColor;
+
+    ttRed:
+      Style.Color := clRed;
+    ttBlue:
+      Style.Color := clBlue;
+    ttGreen:
+      Style.Color := clGreen;
+    ttBlack:
+      Style.Color := clBlack;
+
+    ttAlign:
+      Style.Alignment := GetTagTextAlignment( Tag.Arguments,
+                                              Settings.FDefaultAlignment );
+
+    ttWrap:
+      Style.Wrap := GetTagTextWrap( Tag.Arguments );
+
+    ttSetLeftMargin,
+    ttSetRightMargin:
+    begin
+      tmpFontParts := TStringList.Create;
+      StrExtractStrings(tmpFontParts, Tag.Arguments, [' '], #0);
+      MarginParam1 := tmpFontParts[0];
+
+      ParsePoint := 1;
+      if     ( Tag.TagType = ttSetLeftMargin )
+         and ( MarginParam1 = 'here' ) then
+      begin
+        Style.LeftMargin := X {div FontWidthPrecisionFactor};
+      end
+      else
+      begin
+        try
+          MarginSize := StrToInt( MarginParam1 );
+          if tmpFontParts.Count > 1 then   // do we have a second parameter
+            MarginParam2 := tmpFontParts[1]
+          else
+            MarginParam2 := '';
+          if MarginParam2 = 'pixels' then
+            NewMargin := MarginSize
+
+          else if MarginParam2 = 'deffont' then
+            NewMargin := MarginSize * Settings.NormalFont.TextWidth('w')  // .Width
+
+          else
+          begin
+            case Settings.MarginSizeStyle of
+              msAverageCharWidth:
+                NewMargin := MarginSize * FontManager.AverageCharWidth;
+              msMaximumCharWidth:
+                NewMargin := MarginSize * FontManager.MaximumCharWidth;
+              msSpecifiedChar:
+                NewMargin := MarginSize
+                             * FontManager.CharWidth( Chr( Settings.MarginChar ) )
+                             div FontWidthPrecisionFactor;
+            end;
+          end;
+        except
+          NewMargin := 0;
+        end;
+
+        if Tag.TagType = ttSetLeftMargin then
+          Style.LeftMargin := Settings.Margins.Left
+                              + NewMargin
+        else
+          Style.RightMargin := Settings.Margins.Right
+                               + NewMargin;
+      end;
+      tmpFontParts.Free;
+    end;  { teSet[left|right]margin }
+
+  end;  { case Tag.TagType }
+
+  ApplyStyle( Style, FontManager );
+ProfileEvent('DEBUG:  ApplyStyleTag <<<');
+end;
+
+function GetDefaultStyle( const Settings: TRichTextSettings ): TTextDrawStyle;
+begin
+  FillChar(Result, SizeOf(TTextDrawStyle), 0);
+  FPGuiFontToFontSpec( Settings.FNormalFont, Result.Font );
+  Result.Alignment := Settings.FDefaultAlignment;
+  Result.Wrap := Settings.FDefaultWrap;
+  Result.Color := Settings.FDefaultColor;
+  Result.BackgroundColor := Settings.FDefaultBackgroundColor;
+  Result.LeftMargin := Settings.Margins.Left;
+  Result.RightMargin := Settings.Margins.Right;
+end;
+
+
+Procedure TRichTextSettings.SetupComponent;
+begin
+  Name := 'RichTextSettings';
+
+  FNormalFont := fpgGetFont('Arial-10');
+  FFixedFont := fpgGetFont('Courier New-10');
+  FHeading1Font := fpgGetFont('Arial-20');
+  FHeading2Font := fpgGetFont('Arial-14');
+  FHeading3Font := fpgGetFont('Arial-10:bold');
+
+  FDefaultColor := clBlack;
+  FDefaultBackgroundColor := clWhite;
+
+  FDefaultAlignment := taLeft;
+  FDefaultWrap := true;
+  FAtLeastOneWordBeforeWrap := false;
+
+  FMarginSizeStyle := msMaximumCharWidth;
+  FMarginChar := Ord( ' ' );
+
+  FMargins.Left := 0;
+  FMargins.Right := 0;
+  FMargins.Top := 0;
+  FMargins.Bottom := 0;
+
+  FUpdateCount := 0;
+  FChangesPending := false;
+end;
+
+constructor TRichTextSettings.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetupComponent;
+end;
+
+destructor TRichTextSettings.Destroy;
+begin
+  FNormalFont.Free;
+  FFixedFont.Free;
+  FHeading1Font.Free;
+  FHeading2Font.Free;
+  FHeading3Font.Free;
+  Inherited Destroy;
+end;
+
+// Font read/write from SCU. I have NO IDEA why I have to do this manually. But
+// this way works and everything else I tried doesn't
+//Procedure TRichTextSettings.ReadSCUResource( Const ResName: TResourceName;
+//                                             Var Data;
+//                                             DataLen: LongInt );
+//Begin
+//  If ResName = 'Heading1Font' Then
+//  Begin
+//    If DataLen <> 0 Then
+//      FHeading1Font := ReadSCUFont( Data, DataLen );
+//  End
+//  Else If ResName = 'Heading2Font' Then
+//  Begin
+//    If DataLen <> 0 Then
+//      FHeading2Font := ReadSCUFont( Data, DataLen );
+//  End
+//  Else If ResName = 'Heading3Font' Then
+//  Begin
+//    If DataLen <> 0 Then
+//      FHeading3Font := ReadSCUFont( Data, DataLen );
+//  End
+//  Else If ResName = 'FixedFont' Then
+//  Begin
+//    If DataLen <> 0 Then
+//      FFixedFont := ReadSCUFont( Data, DataLen );
+//  End
+//  Else if ResName = 'NormalFont' then
+//  Begin
+//    If DataLen <> 0 Then
+//      FNormalFont := ReadSCUFont( Data, DataLen );
+//  End
+//  Else
+//    Inherited ReadSCUResource( ResName, Data, DataLen );
+//End;
+
+//Function TRichTextSettings.WriteSCUResource( Stream: TResourceStream ): boolean;
+//begin
+//  Result := Inherited WriteSCUResource( Stream );
+//  If Not Result Then
+//    Exit;
+//
+//  If FHeading1Font <> Nil then
+//    Result := FHeading1Font.WriteSCUResourceName( Stream, 'Heading1Font' );
+//  If FHeading2Font <> Nil then
+//    Result := FHeading2Font.WriteSCUResourceName( Stream, 'Heading2Font' );
+//  If FHeading3Font <> Nil then
+//    Result := FHeading3Font.WriteSCUResourceName( Stream, 'Heading3Font' );
+//  If FFixedFont <> Nil then
+//    Result := FFixedFont.WriteSCUResourceName( Stream, 'FixedFont' );
+//  If FNormalFont <> Nil then
+//    Result := FNormalFont.WriteSCUResourceName( Stream, 'NormalFont' );
+//
+//end;
+
+Procedure TRichTextSettings.Change;
+begin
+  if FUpdateCount > 0 then
+  begin
+     FChangesPending := true;
+     exit;
+  end;
+
+  if FOnChange <> nil then
+    FOnChange( self );
+end;
+
+Procedure TRichTextSettings.SetDefaultAlignment( Alignment: TTextAlignment );
+begin
+  if Alignment = FDefaultAlignment then
+    exit; // no change
+
+  FDefaultAlignment := Alignment;
+  Change;
+end;
+
+Procedure TRichTextSettings.SetDefaultWrap( Wrap: boolean );
+begin
+  if Wrap = FDefaultWrap then
+    exit; // no change
+
+  FDefaultWrap := Wrap;
+  Change;
+end;
+
+Procedure TRichTextSettings.SetAtLeastOneWordBeforeWrap( NewValue: boolean );
+begin
+  if NewValue = FAtLeastOneWordBeforeWrap then
+    exit; // no change
+
+  FAtLeastOneWordBeforeWrap := NewValue;
+  Change;
+end;
+
+Procedure TRichTextSettings.SetMarginChar( NewValue: longint );
+begin
+  if NewValue = FMarginChar then
+    exit; // no change
+
+  FMarginChar := NewValue;
+
+  if FMarginSizeStyle <> msSpecifiedChar then
+    // doesn't matter, will be ignored
+    exit;
+  Change;
+end;
+
+Procedure TRichTextSettings.SetMarginSizeStyle( NewValue: TMarginSizeStyle );
+begin
+  if NewValue = FMarginSizeStyle then
+    exit; // no change
+
+  FMarginSizeStyle := NewValue;
+  Change;
+end;
+
+Function FontSame( FontA: TfpgFont; FontB: TfpgFont ): boolean;
+begin
+  if    ( FontA = nil )
+     or ( FontB = nil ) then
+  begin
+    Result := FontA = FontB;
+    exit;
+  end;
+
+  Result := FontA.FontDesc = FontB.FontDesc;
+end;
+
+Procedure TRichTextSettings.AssignFont( Var Font: TfpgFont;
+                                        NewFont: TfpgFont );
+begin
+  If NewFont = Nil Then
+    NewFont := fpgApplication.DefaultFont;
+
+  if FontSame( NewFont, Font ) then
+    exit; // no change
+
+  Font.Free;
+  Font := NewFont;
+//  Font.Free;
+
+  Change;
+End;
+
+Procedure TRichTextSettings.SetHeading1Font( NewFont: TfpgFont );
+begin
+//  ProfileEvent( 'TRichTextSettings.SetHeading1Font' );
+  AssignFont( FHeading1Font, NewFont );
+
+//  if FHeading1FOnt = nil then
+//    ProfileEvent( '  Set to nil' );
+
+end;
+
+Procedure TRichTextSettings.SetHeading2Font( NewFont: TfpgFont );
+begin
+  AssignFont( FHeading2Font, NewFont );
+End;
+
+Procedure TRichTextSettings.SetHeading3Font( NewFont: TfpgFont );
+begin
+  AssignFont( FHeading3Font, NewFont );
+End;
+
+Procedure TRichTextSettings.SetFixedFont( NewFont: TfpgFont );
+begin
+  AssignFont( FFixedFont, NewFont );
+end;
+
+Procedure TRichTextSettings.SetNormalFont( NewFont: TfpgFont );
+begin
+  AssignFont( FNormalFont, NewFont );
+end;
+
+Procedure TRichTextSettings.SetMargins( const NewMargins: TRect );
+begin
+  if NewMargins = FMargins then
+    exit; // no change
+  FMargins := NewMargins;
+  Change;
+end;
+
+function TRichTextSettings.GetMargin_Left: longint;
+begin
+  Result := FMargins.Left;
+end;
+
+Procedure TRichTextSettings.SetMargin_Left( NewValue: longint );
+begin
+  FMargins.Left := NewValue;
+end;
+
+function TRichTextSettings.GetMargin_Bottom: longint;
+begin
+  Result := FMargins.Bottom;
+end;
+
+Procedure TRichTextSettings.SetMargin_Bottom( NewValue: longint );
+begin
+  FMargins.Bottom := NewValue;
+end;
+
+function TRichTextSettings.GetMargin_Right: longint;
+begin
+  Result := FMargins.Right;
+end;
+
+Procedure TRichTextSettings.SetMargin_Right( NewValue: longint );
+begin
+  FMargins.Right := NewValue;
+end;
+
+function TRichTextSettings.GetMargin_Top: longint;
+begin
+  Result := FMargins.Top;
+end;
+
+Procedure TRichTextSettings.SetMargin_Top( NewValue: longint );
+begin
+  FMargins.Top := NewValue;
+end;
+
+Procedure TRichTextSettings.SetDefaultColor( NewColor: TfpgColor );
+begin
+  if NewColor = FDefaultColor then
+    exit;
+  FDefaultColor := NewColor;
+  Change;
+end;
+
+Procedure TRichTextSettings.SetDefaultBackgroundColor( NewColor: TfpgColor );
+begin
+  if NewColor = FDefaultBackgroundColor then
+    exit;
+  FDefaultBackgroundColor := NewColor;
+  Change;
+end;
+
+procedure TRichTextSettings.BeginUpdate;
+begin
+  inc( FUpdateCount );
+end;
+
+procedure TRichTextSettings.EndUpdate;
+begin
+  if FUpdateCount = 0 then
+    exit;
+
+  dec( FUpdateCount );
+  if FUpdateCount = 0 then
+  begin
+    if FChangesPending then
+    begin
+      Change;
+      FChangesPending := false;
+    end;
+  end;
+end;
+
+Initialization
+  RegisterClasses( [ TRichTextSettings ] );
+End.
diff --git a/docview/components/richtext/RichTextView.pas b/docview/components/richtext/RichTextView.pas
new file mode 100644
index 00000000..390ac376
--- /dev/null
+++ b/docview/components/richtext/RichTextView.pas
@@ -0,0 +1,2868 @@
+Unit RichTextView;
+
+{$mode objfpc}{$H+}
+
+Interface
+
+Uses
+  Classes,
+  fpg_base,
+  fpg_main,
+  fpg_widget,
+  fpg_scrollbar,
+  fpg_menu,
+  fpg_imagelist,
+  RichTextStyleUnit,
+  RichTextLayoutUnit,
+//  RichTextDocumentUnit,
+  CanvasFontManager;
+
+{
+Remaining keyboard support
+- cursor down to go to end of line (this is tricky)
+  I don't understand what I mean here!
+- If scrolllock is on, then scroll the screen, not move cursor.
+  Really? So few things obey it...
+}
+
+const
+  // for dragtext support, primarily.
+  RT_QUERYTEXT    = FPGM_USER + 500;
+    // Param1: pointer to buffer (may be nil)
+    // Param2: buffer size (-1 to ignore)
+    // Returns: number of bytes copied
+
+  RT_QUERYSELTEXT = FPGM_USER + 501;
+    // Param1: pointer to buffer (may be nil)
+    // Param2: buffer size (-1 to ignore)
+    // Returns: number of bytes copied
+
+Type
+  TFindOrigin = ( foFromStart, foFromCurrent );
+
+  TScrollingDirection = ( sdUp, sdDown );
+
+Type
+
+  TRichTextView = class;
+
+  // reimplement class
+  TLinkEvent = procedure( Sender: TRichTextView; Link: string ) of object;
+
+
+  TRichTextView = Class( TfpgWidget )
+  private
+    FPopupMenu: TfpgPopupMenu;
+    procedure   FVScrollbarScroll(Sender: TObject; position: integer);
+    procedure   FHScrollbarScroll(Sender: TObject; position: integer);
+    procedure   ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); virtual;
+    Procedure   CreateDefaultMenu;
+    Procedure   SelectAllMIClick( Sender: TObject );
+    Procedure   CopyMIClick( Sender: TObject );
+    Procedure   RefreshMIClick( Sender: TObject );
+    Procedure   WordWrapMIClick( Sender: TObject );
+    Procedure   SmoothScrollMIClick( Sender: TObject );
+    Procedure   DebugMIClick( Sender: TObject );
+    Procedure   DefaultMenuPopup( Sender: TObject );
+  protected
+    FFontManager: TCanvasFontManager;
+    FRichTextSettings: TRichTextSettings;
+
+    // Properties
+//    FBorderStyle:TfpgBorderStyle;
+    FScrollbarWidth: longint;
+    FSmoothScroll: boolean;
+    FUseDefaultMenu: boolean;
+    FDebug: boolean;
+
+    FOnOverLink: TLinkEvent;
+    FOnNotOverLink: TLinkEvent;
+    FOnClickLink: TLinkEvent;
+
+    FDefaultMenu: TfpgPopupMenu;
+      FSelectAllMI: TfpgMenuItem;
+      FCopyMI: TfpgMenuItem;
+      FRefreshMI: TfpgMenuItem;
+      FWordWrapMI: TfpgMenuItem;
+      FSmoothScrollMI: TfpgMenuItem;
+      FDebugMI: TfpgMenuItem;
+
+    // Internal layout data
+    FNeedVScroll, FNeedHScroll: boolean;
+
+    FLayoutRequired: boolean;
+    FLayout: TRichTextLayout;
+
+    // Child controls
+    FHScrollbar: TfpgScrollbar;
+    FVScrollbar: TfpgScrollbar;
+
+    // Text
+    FText: PChar;
+
+    FTopCharIndex: longint; // only applies until following flag set.
+    FVerticalPositionInitialised: boolean;
+
+    FCursorRow: longint;
+    FCursorOffset: longint;
+    FSelectionStart: longint;
+    FSelectionEnd: longint;
+    FImages: TfpgImageList;
+
+    // Selection scrolling
+    //FScrollTimer: TfpgTimer;
+    FOldMousePoint: TPoint;
+    FScrollingDirection: TScrollingDirection;
+
+    // Scroll information
+    // we use these rather than the scrollbar positions direct,
+    // since those are not updated during tracking
+    FXScroll: longint;
+    FYScroll: longint;
+
+    FLastXScroll: longint;
+    FLastYScroll: longint;
+
+    // Link
+    FLastLinkOver: string;
+    FClickedLink: string;
+
+    procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override;
+    Procedure CreateWnd;
+    procedure HandleResize(AWidth, AHeight: TfpgCoord); override;
+    procedure UpdateScrollBarCoords;
+    procedure HandlePaint; override;
+    procedure HandleHide; override;
+    procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
+    procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override;
+    procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
+    procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
+    procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
+
+    //procedure ScanEvent( Var KeyCode: TKeyCode;
+    //                     RepeatCount: Byte ); override;
+
+    //Procedure MouseDown( Button: TMouseButton;
+    //                     ShiftState: TShiftState;
+    //                     X, Y: Longint ); override;
+    //Procedure MouseUp( Button: TMouseButton;
+    //                   ShiftState: TShiftState;
+    //                   X, Y: Longint ); override;
+
+    //Procedure MouseDblClick( Button: TMouseButton;
+    //                         ShiftState: TShiftState;
+    //                         X, Y: Longint ); override;
+
+    //Procedure MouseMove( ShiftState: TShiftState;
+    //                     X, Y: Longint ); override;
+
+    //Procedure Scroll( Sender: TScrollbar;
+    //                  ScrollCode: TScrollCode;
+    //                  Var ScrollPos: Longint ); override;
+
+    //Procedure KillFocus; override;
+    //Procedure SetFocus; override;
+
+    // Messages for DragText
+    Procedure RTQueryText( Var Msg: TfpgMessageRec ); message RT_QUERYTEXT;
+    Procedure RTQuerySelText( Var Msg: TfpgMessageRec ); message RT_QUERYSELTEXT;
+
+    procedure Layout;
+
+    function FindPoint( XToFind: longint;
+                        YToFind: longint;
+                        Var LineIndex: longint;
+                        Var Offset: longint;
+                        Var Link: string ): TTextPosition;
+
+    // Scroll functions
+
+    // Scroll display to given positions (does NOT
+    // update scrollbars as this may be called during
+    // scrolling)
+    Procedure DoVerticalScroll( NewY: longint );
+    Procedure DoHorizontalScroll( NewX: longint );
+
+    // Set scrollbar position, and update display
+    Procedure SetVerticalPosition( NewY: longint );
+    Procedure SetHorizontalPosition( NewX: longint );
+
+    procedure OnScrollTimer( Sender: TObject );
+    Function GetLineDownPosition: longint;
+    Function GetLineUpPosition: longint;
+    Function GetSmallDownScrollPosition: longint;
+    Function GetSmallUpScrollPosition: longint;
+    Function GetSmallRightScrollPosition: longint;
+    Function GetSmallLeftScrollPosition: longint;
+
+    // Calculates line down position given the last line and displayed pixels
+    Function GetLineDownPositionFrom( LastLine: longint; PixelsDisplayed: longint ): longint;
+    Function GetLineUpPositionFrom( FirstVisibleLine: longint; Offset: longint ): longint;
+
+    // Drawing functions
+    Procedure DrawBorder;
+    Procedure Draw( StartLine, EndLine: longint );
+
+    // Rectangle (GetClientRect) minus scrollbars (if they are enabled)
+    Function GetDrawRect: TfpgRect;
+    // Rectangle minus scrollbars (GetDrawRect), minus extra 2px border all round
+    Function GetTextAreaRect: TfpgRect;
+    Function GetTextAreaHeight: longint;
+    Function GetTextAreaWidth: longint;
+
+    // Queries
+    procedure GetFirstVisibleLine( Var LineIndex: longint; Var Offset: longint );
+    procedure GetBottomLine( Var LineIndex: longint; Var PixelsDisplayed: longint );
+
+    // Layout functions
+    Procedure SetupScrollbars;
+    Procedure SetupCursor;
+    procedure RemoveCursor;
+
+    function GetTextEnd: longint;
+
+    // property handlers
+//    procedure SetBorder( BorderStyle: TBorderStyle );
+    Procedure SetDebug( Debug: boolean );
+    Procedure SetScrollBarWidth( NewValue: longint );
+
+    Procedure OnRichTextSettingsChanged( Sender: TObject );
+
+    function GetCursorIndex: longint;
+
+    Function GetTopCharIndex: longint;
+    Procedure SetTopCharIndex( NewValue: longint );
+    Function GetTopCharIndexPosition( NewValue: longint ): longint;
+
+    // Update the cursor row/column for the selction start/end
+    procedure RefreshCursorPosition;
+
+    procedure SetCursorIndex( Index: longint;
+                              PreserveSelection: boolean );
+    procedure SetCursorPosition( Offset: longint;
+                                 Row: longint;
+                                 PreserveSelection: boolean );
+
+    procedure MakeRowVisible( Row: longint );
+    procedure MakeRowAndColumnVisible( Row: longint;
+                                       Column: longint );
+
+    // These two methods set selection start and end,
+    // and redraw the screen, but do not set up cursor.
+    Procedure SetSelectionStartInternal( SelectionStart: longint );
+    Procedure SetSelectionEndInternal( SelectionEnd: longint );
+
+    // Property handlers. These are for programmatic access
+    // where a complete setup of selection is needed
+    Procedure SetSelectionStart( SelectionStart: longint );
+    Procedure SetSelectionEnd( SelectionEnd: longint );
+
+    Procedure SetImages( Images: TfpgImageList );
+    Procedure Notification( AComponent: TComponent;
+                            Operation: TOperation ); override;
+  Public
+    constructor Create(AOwner: TComponent); override;
+    destructor  Destroy; Override;
+    // rect (of component) minus frame borders - normally 2 pixels all round
+    function    GetClientRect: TfpgRect; override;
+    procedure   AddText( Text: PChar; ADelay: boolean = False );
+    procedure   AddParagraph( Text: PChar );
+    procedure   AddSelectedParagraph( Text: PChar );
+    procedure   Clear(const ADestroying: boolean = False);
+    procedure   InsertText( CharIndexToInsertAt: longword; TextToInsert: PChar );
+    property    Text: PChar read FText;
+    property    TextEnd: longint read GetTextEnd;
+    property    SelectionStart: longint read FSelectionStart write SetSelectionStart;
+    property    SelectionEnd: longint read FSelectionEnd write SetSelectionEnd;
+    property    CursorIndex: longint read GetCursorIndex;
+
+    // Copy all text to buffer
+    // Buffer can be nil to simply get size.
+    // If BufferLength is negative, it is ignored
+    Function CopyTextToBuffer( Buffer: PChar; BufferLength: longint ): longint;
+
+    // Clipboard
+    Procedure CopySelectionToClipboard;
+
+    // returns number of chars (that would be) copied.
+    // Buffer can be nil to simply get size.
+    // If BufferLength is negative, it is ignored
+    Function CopySelectionToBuffer( Buffer: PChar;
+                                    BufferLength: longint ): longint;
+
+    Function GetSelectionAsString: string; // returns up to 255 chars obviously
+
+    // Selection queries
+    Function SelectionLength: longint; // Note: includes formatting
+    Function SelectionSet: boolean; // returns true if there is a selection
+
+    // Selection actions
+    Procedure ClearSelection;
+    Procedure SelectAll;
+
+    property CursorRow: longint read FCursorRow;
+
+    // Navigation
+    procedure GoToTop;
+    procedure GotoBottom;
+    Procedure UpLine;
+    Procedure DownLine;
+    Procedure UpPage;
+    Procedure DownPage;
+
+    Procedure SmallScrollUp;
+    Procedure SmallScrollDown;
+    Procedure SmallScrollLeft;
+    Procedure SmallScrollRight;
+
+    Procedure MakeCharVisible( CharIndex: longint );
+    Property TopCharIndex: longint read GetTopCharIndex write SetTopCharIndex;
+
+    Procedure CursorLeft( PreserveSelection: boolean );
+    Procedure CursorRight( PreserveSelection: boolean );
+    Procedure CursorDown( PreserveSelection: boolean );
+    Procedure CursorUp( PreserveSelection: boolean );
+    Procedure CursorPageDown( PreserveSelection: boolean );
+    Procedure CursorPageUp( PreserveSelection: boolean );
+
+    Procedure CursorToLineStart( PreserveSelection: boolean );
+    Procedure CursorToLineEnd( PreserveSelection: boolean );
+
+    Procedure CursorWordLeft( PreserveSelection: boolean );
+    Procedure CursorWordRight( PreserveSelection: boolean );
+
+    function HighlightNextLink: boolean;
+    function HighlightPreviousLink: boolean;
+
+    // Search for the given text
+    // if found, returns true, MatchIndex is set to the first match,
+    //   and MatchLength returns the length of the match
+    //   (which may be greater than the length of Text due to
+    //    to skipping tags)
+    // if not found, returns false, pMatch is set to -1
+    function FindString( Origin: TFindOrigin;
+                         const AText: string;
+                         var MatchIndex: longint;
+                         var MatchLength: longint ): boolean;
+
+    // Searches for text and selects it found
+    // returns true if found, false if not
+    function Find( Origin: TFindOrigin;
+                   const AText: string ): boolean;
+
+    function LinkFromIndex( const CharIndexToFind: longint): string;
+
+  Published
+    property Align;
+    property BackgroundColor default clBoxColor;
+    //property ParentColor;
+    //property ParentFont;
+    //property ParentPenColor;
+    property ParentShowHint;
+    property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu;
+    property ShowHint;
+    Property TabOrder;
+    Property Focusable;
+    property Visible;
+    property RichTextSettings: TRichTextSettings read FRichTextSettings;
+    property ScrollBarWidth: longint read FScrollBarWidth write SetScrollBarWidth default 15;
+    property SmoothScroll: boolean read FSmoothScroll write FSmoothScroll;
+    property UseDefaultMenu: boolean read FUseDefaultMenu write FUseDefaultMenu default True;
+    property Debug: boolean read FDebug write SetDebug default False;
+    property Images: TfpgImageList read FImages write SetImages;
+
+    // ------- EVENTS ----------
+
+    // Called with the name of the link when the mouse first moves over it
+    property OnOverLink: TLinkEvent read FOnOverLink write FOnOverLink;
+
+    // Called with the name of the link when the mouse leaves it
+    property OnNotOverLink: TLinkEvent read FOnNotOverLink write FOnNotOverLink;
+
+    // Called when the link is clicked.
+    property OnClickLink: TLinkEvent read FOnClickLink write FOnClickLink;
+
+    Property OnClick;
+    Property OnDoubleClick;
+    //property OnDragOver;
+    //property OnDragDrop;
+    //property OnEndDrag;
+    Property OnEnter;
+    Property OnExit;
+    //Property OnFontChange;
+    //Property OnMouseClick;
+    //Property OnMouseDblClick;
+    //Property OnSetupShow;
+
+    //Property OnScan;
+  Protected
+    //Property Font;
+
+  End;
+
+
+implementation
+
+uses
+  SysUtils
+  ,ACLStringUtility
+  ,nvUtilities
+//  ControlScrolling, ControlsUtility,
+  ,RichTextDocumentUnit
+  ,RichTextDisplayUnit
+  ;
+
+Procedure TRichTextView.SetSelectionStart( SelectionStart: longint );
+begin
+  RemoveCursor;
+  SetSelectionStartInternal( SelectionStart );
+  RefreshCursorPosition;
+  SetupCursor;
+end;
+
+Procedure TRichTextView.SetSelectionEnd( SelectionEnd: longint );
+begin
+  RemoveCursor;
+  SetSelectionEndInternal( SelectionEnd );
+  RefreshCursorPosition;
+  SetupCursor;
+end;
+
+Procedure TRichTextView.SetSelectionStartInternal( SelectionStart: longint );
+begin
+  if SelectionStart = FSelectionStart then
+    exit;
+
+  if SelectionSet then
+    if SelectionStart = -1 then
+      // small side effect here - also sets selectionend to -1
+      ClearSelection;
+
+  FSelectionStart := SelectionStart;
+  if FSelectionEnd = -1 then
+    // still no selection
+    exit;
+  RePaint;
+end;
+
+Procedure TRichTextView.SetSelectionEndInternal( SelectionEnd: longint );
+var
+  StartRedrawLine: longint;
+  EndRedrawLine: longint;
+  OldClip: TfpgRect;
+begin
+  if SelectionEnd = FSelectionEnd then
+    exit;
+
+  if FSelectionStart = -1 then
+  begin
+    FSelectionEnd := SelectionEnd;
+    // still not a valid selection, no need to redraw
+    exit;
+  end;
+
+  if SelectionEnd = FSelectionStart then
+    SelectionEnd := -1;
+
+  if ( FSelectionEnd = -1 ) then
+  begin
+    // there is currently no selection,
+    // and we are setting one: need to draw it all
+    StartRedrawLine := FLayout.GetLineFromCharIndex( FSelectionStart );
+    EndRedrawLine := FLayout.GetLineFromCharIndex( SelectionEnd );
+  end
+  else
+  begin
+    // there is already a selection
+    if SelectionEnd = -1 then
+    begin
+      // and we're clearing it
+      StartRedrawLine := FLayout.GetLineFromCharIndex( FSelectionStart );
+      EndRedrawLine := FLayout.GetLineFromCharIndex( FSelectionEnd );
+    end
+    else
+    begin
+      // and we're setting a new one, so draw from the old end to the new
+      StartRedrawLine := FLayout.GetLineFromCharIndex( FSelectionEnd );
+      EndRedrawLine := FLayout.GetLineFromCharIndex( SelectionEnd );
+    end;
+  end;
+
+  FSelectionEnd := SelectionEnd;
+
+  OldClip := Canvas.GetClipRect;
+  Canvas.SetClipRect(GetTextAreaRect);
+
+  // (re)draw selection
+  { TODO -ograeme : Draw must not be called here }
+//  Draw( StartRedrawLine, EndRedrawLine );
+  Canvas.SetClipRect(OldClip);
+end;
+
+Procedure TRichTextView.ClearSelection;
+var
+  OldClip: TfpgRect;
+  StartLine: longint;
+  EndLine: longint;
+begin
+
+  if SelectionSet then
+  begin
+    OldClip := Canvas.GetClipRect;
+    Canvas.SetClipRect(GetTextAreaRect);
+
+    StartLine := FLayout.GetLineFromCharIndex( FSelectionStart );
+    EndLine := FLayout.GetLineFromCharIndex( FSelectionEnd );
+
+    FSelectionEnd := -1;
+    FSelectionStart := -1;
+
+    // clear display of selection
+    { TODO -oGraeme : Draw must not be called here }
+//    Draw( StartLine, EndLine );
+
+    Canvas.SetClipRect(OldClip);
+ end;
+
+  FSelectionEnd := -1;
+  FSelectionStart := -1;
+end;
+
+Function TRichTextView.GetTextEnd: longint;
+begin
+  Result := StrLen( FText );
+end;
+
+Procedure TRichTextView.CreateDefaultMenu;
+begin
+  FDefaultMenu := TfpgPopupMenu.Create(nil);
+  FDefaultMenu.OnShow := @DefaultMenuPopup;
+
+  FSelectAllMI := FDefaultMenu.AddMenuItem('Select &All', '', @SelectAllMIClick);
+  FCopyMI := FDefaultMenu.AddMenuItem('&Copy', '', @CopyMIClick);
+  FDefaultMenu.AddMenuItem('-', '', nil);
+  FRefreshMI := FDefaultMenu.AddMenuItem('&Refresh', '', @RefreshMIClick);
+  FDefaultMenu.AddMenuItem('-', '', nil);
+  FSmoothScrollMI := FDefaultMenu.AddMenuItem('&Smooth Scrolling', '', @SmoothScrollMIClick);
+  FWordWrapMI := FDefaultMenu.AddMenuItem('&Word Wrap', '', @WordWrapMIClick);
+  FDebugMI := FDefaultMenu.AddMenuItem('&Debug', '', @DebugMIClick);
+end;
+
+Procedure TRichTextView.SelectAllMIClick( Sender: TObject );
+begin
+  SelectAll;
+end;
+
+Procedure TRichTextView.CopyMIClick( Sender: TObject );
+begin
+  CopySelectionToClipBoard;
+end;
+
+Procedure TRichTextView.RefreshMIClick( Sender: TObject );
+begin
+  RePaint;
+end;
+
+Procedure TRichTextView.WordWrapMIClick( Sender: TObject );
+begin
+  FRichTextSettings.DefaultWrap := not FRichTextSettings.DefaultWrap;
+end;
+
+Procedure TRichTextView.SmoothScrollMIClick( Sender: TObject );
+begin
+  SmoothScroll := not SmoothScroll;
+end;
+
+Procedure TRichTextView.DebugMIClick( Sender: TObject );
+begin
+  Debug := not Debug;
+//  writeln('VScrollbar.Position=', FVScrollbar.Position, '  min/max=', FVScrollbar.Min, '/', FVScrollbar.Max);
+//  writeln('FNeedHScroll=', FNeedHScroll, '   FNeedVScroll=', FNeedVScroll);
+  RePaint;
+end;
+
+Procedure TRichTextView.DefaultMenuPopup( Sender: TObject );
+begin
+  FWordWrapMI.Checked := FRichTextSettings.DefaultWrap;
+  FSmoothScrollMI.Checked := SmoothScroll;
+  FDebugMI.Checked := Debug;
+end;
+
+constructor TRichTextView.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Name := 'RichTextView';
+  FWidth := 150;
+  FHeight := 70;
+  FFocusable := True;
+
+  FNeedVScroll := False;
+  FNeedHScroll := False;
+  FSmoothScroll := True;
+  FScrollbarWidth := 15;
+  FUseDefaultMenu := True;
+  FDebug          := False;
+  FLayoutRequired := True;
+
+  FTextColor        := Parent.TextColor;
+  FBackgroundColor  := clBoxColor;
+
+  FRichTextSettings := TRichTextSettings.Create( self );
+  FRichTextSettings.Margins := Rect( 5, 5, 5, 5 );
+  FRichTextSettings.OnChange := @OnRichTextSettingsChanged;
+
+  FImages := nil;
+
+  if not InDesigner then
+  begin
+    FFontManager := nil;
+
+    FText := StrAlloc( 100 );
+    FText[ 0 ] := #0;
+
+    FTopCharIndex := 0;
+    FVerticalPositionInitialised := false;
+  end;
+end;
+
+procedure TRichTextView.HandlePaint;
+Var
+  CornerRect: TfpgRect;
+  TextRect: TfpgRect;
+  DrawRect: TfpgRect;
+  x: integer;
+
+  // Just for fun! :-)
+  procedure DesignerPainting(const AText: string; AColor: TfpgColor; AFontDesc: TfpgString = '');
+  var
+    oldf: TfpgString;
+  begin
+    oldf := '';
+    if AFontDesc <> '' then
+    begin
+      oldf := Canvas.Font.FontDesc; // save original font
+      Canvas.Font := fpgGetFont(AFontDesc); // set new font
+    end;
+    Canvas.TextColor := AColor; // set new color
+    Canvas.DrawString(x, 10, AText);
+    x := x + Canvas.Font.TextWidth(AText);  // calc x offset for next text
+    if oldf <> '' then
+      Canvas.Font := fpgGetFont(oldf);  // restore original font
+  end;
+
+begin
+  ProfileEvent('TRichTextView.HandlePaint >>>');
+  Canvas.ClearClipRect;
+  DrawBorder;
+ProfileEvent('DEBUG:  TRichTextView.HandlePaint   1');
+  DrawRect := GetDrawRect;
+  Canvas.Color := BackgroundColor;
+  Canvas.FillRectangle(DrawRect);
+
+ProfileEvent('DEBUG:  TRichTextView.HandlePaint   2');
+  TextRect := GetTextAreaRect;
+  Canvas.SetClipRect(TextRect);
+
+ProfileEvent('DEBUG:  TRichTextView.HandlePaint   3');
+  if InDesigner then
+  begin
+    Canvas.TextColor := clInactiveWgFrame;
+    x := 10;
+    DesignerPainting('<', clInactiveWgFrame);
+    DesignerPainting('rich', clBlack, 'Sans-10:bold');
+    DesignerPainting(' text', clRed, 'Sans-10:italic');
+    DesignerPainting(' ', clInactiveWgFrame);
+    DesignerPainting('will', clBlue, 'Sans-10:underline');
+    DesignerPainting(' appear here>', clInactiveWgFrame);
+//    Canvas.DrawString(10, 10, '<rich text will appear here>');
+    Canvas.ClearClipRect;
+    Exit; //==>
+  end;
+
+  if Length(FText) = 0 then
+    exit;   // no need to paint anything further.
+
+ProfileEvent('DEBUG:  TRichTextView.HandlePaint   4');
+  Assert(FLayout <> nil, 'FLayout may not be nil at this point!');
+  if not Debug then
+    Draw( 0, FLayout.FNumLines )
+  else
+    Canvas.DrawText(8, 8, GetTextAreaWidth-FScrollbarWidth, 1000, FText, [txtLeft, txtTop, txtWrap]);
+ProfileEvent('DEBUG:  TRichTextView.HandlePaint   5');
+  Canvas.ClearClipRect;
+
+  if FHScrollbar.Visible and FVScrollbar.Visible then
+  begin
+    // blank out corner between scrollbars
+    CornerRect.Left := Width - 2 - FScrollBarWidth;
+    CornerRect.Top := Height - 2 - FScrollBarWidth;
+    CornerRect.Width := FScrollBarWidth;
+    CornerRect.Height := FScrollBarWidth;
+    Canvas.Color := clButtonFace;
+    Canvas.FillRectangle(CornerRect);
+  end;
+ProfileEvent('DEBUG:  TRichTextView.HandlePaint <<<');
+end;
+
+procedure TRichTextView.HandleHide;
+begin
+//  fpgCaret.UnSetCaret (Canvas);
+  inherited HandleHide;
+end;
+
+procedure TRichTextView.HandleKeyPress(var keycode: word; var shiftstate: TShiftState;
+  var consumed: boolean);
+begin
+ProfileEvent('HandleKeyPress');
+  case keycode of
+    keyPageDown:
+        begin
+          consumed := True;
+          UpPage;
+        end;
+    keyPageUp:
+        begin
+          consumed := True;
+          DownPage;
+        end;
+
+  end;
+  inherited HandleKeyPress(keycode, shiftstate, consumed);
+end;
+
+procedure TRichTextView.HandleRMouseUp(x, y: integer; shiftstate: TShiftState);
+begin
+  inherited HandleRMouseUp(x, y, shiftstate);
+  if Assigned(PopupMenu) then
+    PopupMenu.ShowAt(self, x, y)
+  else
+    ShowDefaultPopupMenu(x, y, ShiftState);
+end;
+
+procedure TRichTextView.HandleMouseScroll(x, y: integer; shiftstate: TShiftState;
+  delta: smallint);
+begin
+  inherited HandleMouseScroll(x, y, shiftstate, delta);
+  if delta < 0 then
+    // scroll up
+    SetVerticalPosition(FVScrollbar.Position - FVScrollbar.ScrollStep)
+  else
+    // scroll down
+    SetVerticalPosition(FVScrollbar.Position + FVScrollbar.ScrollStep);
+end;
+
+procedure TRichTextView.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
+var
+  Line: longint;
+  Offset: longint;
+  Link: string;
+  Position: TTextPosition;
+  Shift: boolean;
+begin
+  inherited HandleLMouseDown(x, y, shiftstate);
+  Position := FindPoint( X, Y, Line, Offset, Link );
+  FClickedLink := Link;
+//  writeln('Pos=', Ord(Position), '  link=', Link);
+end;
+
+procedure TRichTextView.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
+begin
+  inherited HandleLMouseUp(x, y, shiftstate);
+  if FClickedLink <> '' then
+    if Assigned( FOnClickLink ) then
+      FOnClickLink( Self, FClickedLink );
+  FClickedLink := ''; // reset link
+end;
+
+Destructor TRichTextView.Destroy;
+Begin
+  FDefaultMenu.Free;
+  // destroy the font manager NOW
+  // while the canvas is still valid
+  // (it will be freed in TControl.DisposeWnd)
+  // in order to release logical fonts
+  if FFontManager <> nil then
+    FFontManager.Free;
+  if Assigned(FLayout) then
+    FreeAndNil(FLayout);
+
+  //FScrollTimer.Free;
+  if not InDesigner then
+  begin
+    RemoveCursor;
+    StrDispose( FText );
+  end;
+  Inherited Destroy;
+End;
+
+//Procedure TRichTextView.KillFocus;
+//begin
+//  RemoveCursor;
+//  inherited KillFocus;
+//end;
+
+//Procedure TRichTextView.SetFocus;
+//begin
+//  inherited SetFocus;
+//  SetupCursor;
+//end;
+
+// Custom window messages for DragText support
+Procedure TRichTextView.RTQueryText( Var Msg: TfpgMessageRec );
+begin
+  //Msg.Handled := true;
+  //Msg.Result :=
+  //  CopyPlainTextToBuffer( FText,
+  //                         FText + strlen( FText ),
+  //                         PChar( Msg.Param1 ),
+  //                         Msg.Param2 );
+end;
+
+Procedure TRichTextView.RTQuerySelText( Var Msg: TfpgMessageRec );
+begin
+  //Msg.Handled := true;
+  //Msg.Result :=
+  //  CopySelectionToBuffer( PChar( Msg.Param1 ),
+  //                         Msg.Param2 );
+end;
+
+Procedure TRichTextView.SetDebug( Debug: boolean );
+begin
+  if Debug = FDebug then
+    exit;
+  FDebug := Debug;
+  RePaint;
+end;
+
+Procedure TRichTextView.SetScrollBarWidth( NewValue: longint );
+begin
+  if    ( NewValue < 0 )
+     or ( NewValue = FScrollBarWidth ) then
+    exit;
+  FScrollBarWidth := NewValue;
+  Layout;
+  RePaint;
+end;
+
+procedure TRichTextView.FVScrollbarScroll(Sender: TObject; position: integer);
+begin
+  SetVerticalPosition(position);
+end;
+
+procedure TRichTextView.FHScrollbarScroll(Sender: TObject; position: integer);
+begin
+  SetHorizontalPosition(position);
+end;
+
+procedure TRichTextView.ShowDefaultPopupMenu(const x, y: integer;
+  const shiftstate: TShiftState);
+begin
+  if not Assigned(FDefaultMenu) then
+    CreateDefaultMenu;
+  FDefaultMenu.ShowAt(x, y);
+end;
+
+procedure TRichTextView.DoAllocateWindowHandle(AParent: TfpgWindowBase);
+begin
+  inherited DoAllocateWindowHandle(AParent);
+  CreateWnd;
+end;
+
+Procedure TRichTextView.CreateWnd;
+begin
+ProfileEvent('DEBUG:  TRichTextView.CreateWnd >>>>');
+  if InDesigner then
+    exit;
+
+  { TODO -ograeme : I disabled bitmap fonts }
+  FFontManager := TCanvasFontManager.Create( Canvas,
+                                             False, // allow bitmap fonts
+                                             Self
+                                             );
+
+  FLastLinkOver := '';
+  FSelectionStart := -1;
+  FSelectionEnd := -1;
+
+  if FUseDefaultMenu then
+  begin
+    CreateDefaultMenu;
+    FPopupMenu := FDefaultMenu;
+  end;
+
+  FHScrollbar := TfpgScrollBar.Create( self );
+  FHScrollbar.Visible := False;
+  FHScrollbar.Orientation := orHorizontal;
+  FHScrollBar.SetPosition(2, Height-2-FScrollbarWidth, Width-4-FScrollbarWidth, FScrollbarWidth);
+
+  FVScrollbar := TfpgScrollBar.Create( self );
+  FVScrollBar.Visible := False;
+  FVScrollBar.Orientation := orVertical;
+  FVScrollbar.SetPosition(Width-2-FScrollbarWidth, 2, FScrollbarWidth, Height-4-FScrollbarWidth);
+
+//  FScrollTimer := TfpgTimer.Create( 100 );
+//  FScrollTimer.OnTimer := @OnScrollTimer;
+
+//  FLinkCursor := GetLinkCursor;
+
+  if FLayoutRequired then
+    // we haven't yet done a layout
+    Layout;
+ProfileEvent('DEBUG:  TRichTextView.CreateWnd <<<<');
+end;
+
+procedure TRichTextView.HandleResize(AWidth, AHeight: TfpgCoord);
+begin
+  inherited HandleResize(AWidth, AHeight);
+  if InDesigner then
+    exit;
+
+  if WinHandle = 0 then
+    exit;
+
+  RemoveCursor;
+  UpdateScrollbarCoords;
+
+  if FVerticalPositionInitialised then
+  begin
+    // Preserve current position
+    if FLayout.FNumLines > 0 then
+      FTopCharIndex := GetTopCharIndex
+    else
+      FTopCharIndex := 0;
+  end;
+
+  Layout;
+
+  // This is the point at which vertical position
+  // is initialised during first window show
+  FVScrollBar.Position := GetTopCharIndexPosition( FTopCharIndex );
+
+  FYScroll := FVScrollBar.Position;
+  FLastYScroll := FYScroll;
+  FVerticalPositionInitialised := true;
+
+  SetupCursor;
+end;
+
+procedure TRichTextView.UpdateScrollBarCoords;
+var
+  HWidth: integer;
+  VHeight: integer;
+begin
+  VHeight := Height - 4;
+  HWidth  := Width - 4;
+
+  if FVScrollBar.Visible then
+    Dec(HWidth, FScrollbarWidth);
+  if FHScrollBar.Visible then
+    Dec(VHeight, FScrollbarWidth);
+
+  FHScrollBar.Top     := Height -FHScrollBar.Height - 2;
+  FHScrollBar.Left    := 2;
+  FHScrollBar.Width   := HWidth;
+
+  FVScrollBar.Top     := 2;
+  FVScrollBar.Left    := Width - FVScrollBar.Width - 2;
+  FVScrollBar.Height  := VHeight;
+
+  FVScrollBar.UpdateWindowPosition;
+  FHScrollBar.UpdateWindowPosition;
+end;
+
+
+// Main procedure: reads through the whole text currently stored
+// and breaks up into lines - each represented as a TLayoutLine in
+// the array FLines[ 0.. FNumLines ]
+Procedure TRichTextView.Layout;
+Var
+  DrawWidth: longint;
+begin
+ProfileEvent('DEBUG:  TRichTextView.Layout >>>>');
+  FLayoutRequired := true;
+
+  if InDesigner then
+    exit;
+  if WinHandle = 0 then
+    exit;
+ProfileEvent('DEBUG:  TRichTextView.Layout    1 of 6');
+  FSelectionEnd := -1;
+  FSelectionStart := -1;
+  RemoveCursor;
+
+ProfileEvent('DEBUG:  TRichTextView.Layout    2');
+  DrawWidth := GetTextAreaRect.Width;
+
+  try
+    if Assigned(FLayout) then
+    begin
+ProfileEvent('DEBUG:  TRichTextView.Layout    3');
+      FLayout.Free;
+      FLayout := nil;
+    end;
+  except
+    // this is only every a issue under 64bit. FLayout can suddenly not be referenced anymore
+    on E: Exception do
+      ProfileEvent('ERROR:  Failed to free FLayout.  Error Msg: ' + E.Message);
+//      raise Exception.Create('Failed to free FLayout. Error msg: ' + E.Message);
+  end;
+
+ProfileEvent('DEBUG:  TRichTextView.Layout    4');
+  FLayout := TRichTextLayout.Create( FText,
+                                     FImages,
+                                     FRichTextSettings,
+                                     FFontManager,
+                                     DrawWidth-(FScrollbarWidth*6) );
+
+ProfileEvent('DEBUG:  TRichTextView.Layout    5');
+
+  SetupScrollBars;
+ProfileEvent('DEBUG:  TRichTextView.Layout    6');
+  RefreshCursorPosition;
+
+  FLayoutRequired := false;
+ProfileEvent('DEBUG:  TRichTextView.Layout <<<<');
+End;
+
+procedure TRichTextView.GetFirstVisibleLine( Var LineIndex: longint;
+                                             Var Offset: longint );
+begin
+  FLayout.GetLineFromPosition( FYScroll,
+                               LineIndex,
+                               Offset );
+end;
+
+procedure TRichTextView.GetBottomLine( Var LineIndex: longint;
+                                       Var PixelsDisplayed: longint );
+begin
+  FLayout.GetLineFromPosition( FYScroll + GetTextAreaHeight,
+                               LineIndex,
+                               PixelsDisplayed );
+end;
+
+function TRichTextView.FindPoint( XToFind: longint;
+                                  YToFind: longint;
+                                  Var LineIndex: longint;
+                                  Var Offset: longint;
+                                  Var Link: string ): TTextPosition;
+var
+  TextHeight: longint;
+begin
+  LineIndex := 0;
+  Offset := 0;
+  Link := '';
+
+  TextHeight := GetTextAreaHeight;
+
+//  YToFind := Height - YToFind;
+
+  //if FBorderStyle = bsSingle then
+  //begin
+  //  dec( YToFind, 2 );
+  //  dec( XToFind, 2 );
+  //end;
+
+  if YToFind < 3 then
+  begin
+    // above the top
+    Result := tpAboveTextArea;
+    exit;
+  end;
+
+  if YToFind >= TextHeight then
+  begin
+    // below the bottom
+    Result := tpBelowTextArea;
+    LineIndex := FLayout.FNumLines;
+    Offset := FLayout.FLines^[ FLayout.FNumLines - 1 ].Length - 1;
+    exit;
+  end;
+
+  Result := FLayout.FindPoint( XToFind + FXScroll,
+                               YToFind + FYScroll,
+                               LineIndex,
+                               Offset,
+                               Link );
+end;
+
+Procedure TRichTextView.DrawBorder;
+var
+  Rect: TfpgRect;
+begin
+  Canvas.GetWinRect(Rect);
+  Canvas.DrawControlFrame(Rect);
+end;
+
+Procedure TRichTextView.Draw( StartLine, EndLine: longint );
+Var
+  DrawRect: TfpgRect;
+  X: longint;
+  Y: longint;
+  SelectionStartP: PChar;
+  SelectionEndP: PChar;
+  Temp: longint;
+begin
+ProfileEvent('DEBUG:  TRichTextView.Draw >>>');
+  DrawRect := GetTextAreaRect;
+  if StartLine > EndLine then
+  begin
+    // swap
+    Temp := EndLine;
+    EndLine := StartLine;
+    StartLine := Temp;
+  end;
+  // calculate selection ptrs
+  if SelectionSet then
+  begin
+    SelectionStartP := FText + FSelectionStart;
+    SelectionEndP := FText + FSelectionEnd;
+  end
+  else
+  begin
+    SelectionStartP := nil;
+    SelectionEndP := nil;
+  end;
+  // calculate destination point
+  Y := DrawRect.Top + FYScroll;
+  X := DrawRect.Left - FXScroll;
+  DrawRichTextLayout( FFontManager,
+                      FLayout,
+                      SelectionStartP,
+                      SelectionEndP,
+                      StartLine,
+                      EndLine,
+                      Point(X, Y)
+                      );
+ProfileEvent('DEBUG:  TRichTextView.Draw <<<');
+End;
+
+// This gets the area of the control that we can draw on
+// (not taken up by vertical scroll bar)
+Function TRichTextView.GetDrawRect: TfpgRect;
+begin
+  Result := GetClientRect;
+  if InDesigner then
+    exit;
+
+  if FNeedHScroll then
+    dec( Result.Height, FScrollbarWidth );
+
+  if FNeedVScroll then
+    dec( Result.Width, FScrollbarWidth );
+end;
+
+// Gets the area that we are drawing text on, which is the
+// draw rect minus borders
+Function TRichTextView.GetTextAreaRect: TfpgRect;
+begin
+  Result := GetDrawRect;
+  InflateRect(Result, -2, -2);
+end;
+
+Function TRichTextView.GetTextAreaHeight: longint;
+var
+  TextArea: TfpgRect;
+begin
+  TextArea := GetTextAreaRect;
+  Result := TextArea.Height;
+end;
+
+Function TRichTextView.GetTextAreaWidth: longint;
+begin
+  Result := Width;
+  //if FBorderStyle <> bsNone then
+  dec( Result, 4 ); // borders of component
+  dec( Result, FScrollBarWidth ); // always allow space for vscrollbar
+end;
+
+Procedure TRichTextView.SetupScrollbars;
+var
+  AvailableWidth: longint;
+  MaxDisplayWidth: longint;
+  AvailableHeight: longint;
+Begin
+  // Calculate used and available width
+  AvailableWidth := GetTextAreaWidth;
+  MaxDisplayWidth := FLayout.Width;
+
+  // Defaults
+  FNeedVScroll := false;
+  FNeedHScroll := false;
+
+  // Horizontal scroll setup
+  if MaxDisplayWidth > AvailableWidth then
+    FNeedHScroll := true;
+
+//  FHScrollbar.SliderSize := AvailableWidth div 2;
+  FHScrollbar.Min := 0;
+  if FNeedHScroll then
+    FHScrollbar.Max := MaxDisplayWidth
+  else
+  begin
+    FHScrollBar.Position := 0;
+    FHScrollbar.Max := 0;
+  end;
+
+  // Calculate available height.
+  // Note: this depends on whether a h scroll bar is needed.
+  AvailableHeight := GetTextAreaHeight; // this includes borders and scrollbars and small margin
+  if FLayout.Height > AvailableHeight then
+    FNeedVScroll := true;
+  FVScrollBar.Min := 0;
+  if FNeedVScroll then
+    FVScrollBar.Max := (FLayout.Height - AvailableHeight) + FScrollbarWidth
+  else
+  begin
+    FVScrollBar.Position := 0;
+    FVScrollBar.Max := 0;
+  end;
+
+  FHScrollBar.ScrollStep :=  25; // pixels
+  FHScrollBar.PageSize := AvailableWidth div 2;
+  FVScrollBar.ScrollStep := 25; // not used (line up/down calculated explicitly)
+  FVScrollBar.PageSize := AvailableHeight div 2;
+
+  // Physical horizontal scroll setup
+  FHScrollbar.Visible := FNeedHScroll;
+  FHScrollbar.Enabled := FNeedHScroll;
+  FHScrollbar.Left := 2;
+  FHScrollbar.Top := Height - 2 - FScrollBarWidth;
+  FHScrollbar.Height := FScrollbarWidth;
+  if FNeedVScroll then
+    FHScrollbar.Width := Width - 4 - FScrollBarWidth
+  else
+    FHScrollbar.Width := Width - 4;
+
+  // Physical vertical scroll setup
+  FVScrollbar.Visible := FNeedVScroll;
+  FVScrollbar.Enabled := FNeedVScroll;
+  FVScrollbar.Left := Width - 2 - FScrollbarWidth;
+  FVScrollbar.Top := 2;
+  FVScrollbar.Width := FScrollbarWidth;
+  if FNeedHScroll then
+    FVScrollbar.Height := Height - 4 - FScrollbarWidth
+  else
+    FVScrollbar.Height := Height - 4;
+
+  // Initialise scroll
+  FYScroll := FVScrollBar.Position;
+  FLastYScroll := FYScroll;
+  FXScroll := FHScrollBar.Position;
+  FLastXScroll := FXScroll;
+
+  FVScrollbar.OnScroll := @FVScrollbarScroll;
+  FHScrollbar.OnScroll := @FHScrollbarScroll;
+End;
+
+Procedure TRichTextView.SetupCursor;
+var
+  Line: TLayoutLine;
+  X, Y: longint;
+  TextRect: TfpgRect;
+  DrawHeight: longint;
+  DrawWidth: longint;
+  CursorHeight: longint;
+  TextHeight: longint;
+  LineHeight: longint;
+  Descender: longint;
+  MaxDescender: longint;
+begin
+  RemoveCursor;
+  if FSelectionStart = -1 then
+    exit;
+
+  TextRect := GetTextAreaRect;
+  DrawHeight := TextRect.Top - TextRect.Bottom;
+  DrawWidth := TextRect.Right - TextRect.Left;
+
+  Line := FLayout.FLines^[ CursorRow ];
+  LineHeight := Line.Height;
+
+  Y := DrawHeight
+       - ( FLayout.GetLinePosition( CursorRow )
+           - FVScrollbar.Position );
+  // Now Y is the top of the line
+  if Y < 0 then
+    // off bottom
+    exit;
+  if ( Y - LineHeight ) > DrawHeight then
+    // off top
+    exit;
+
+  FLayout.GetXFromOffset( FCursorOffset, CursorRow, X );
+
+  X := X - FHScrollBar.Position;
+
+  if X < 0 then
+    // offscreen to left
+    exit;
+
+  if X > DrawWidth then
+    // offscreen to right
+    exit;
+
+  TextHeight := FFontManager.CharHeight;
+  Descender := FFontManager.CharDescender;
+  MaxDescender := FLayout.FLines^[ CursorRow ].MaxDescender;
+  CursorHeight := TextHeight;
+
+  dec( Y, LineHeight - 1 );
+  // now Y is the BOTTOM of the line
+
+  // move Y up to the bottom of the cursor;
+  // since the current text may be smaller than the highest in the line
+  inc( Y, MaxDescender - Descender );
+
+  if Y < 0 then
+  begin
+    // bottom of line will be below bottom of display.
+    dec( CursorHeight, 1 - Y );
+    Y := 0;
+  end;
+
+  if Y + CursorHeight - 1 > DrawHeight then
+  begin
+    // top of cursor will be above top of display
+    CursorHeight := DrawHeight - Y + 1;
+  end;
+
+//  fpgCaret.SetCaret(Canvas, TextRect.Left + X, TextRect.Bottom + Y, 2, CursorHeight);
+end;
+
+procedure TRichTextView.RemoveCursor;
+begin
+//  fpgCaret.UnSetCaret(Canvas);
+end;
+
+Function TRichTextView.GetLineDownPosition: longint;
+var
+  LastLine: longint;
+  PixelsDisplayed: longint;
+begin
+  GetBottomLine( LastLine,
+                 PixelsDisplayed );
+
+  Result := GetLineDownPositionFrom( LastLine, PixelsDisplayed );
+end;
+
+Function TRichTextView.GetLineDownPositionFrom( LastLine: longint;
+                                                PixelsDisplayed: longint ): longint;
+var
+  LineHeight: longint;
+begin
+  if LastLine = -1 then
+    exit;
+
+  LineHeight := FLayout.FLines^[ LastLine ].Height;
+
+  if LastLine = FLayout.FNumLines - 1 then
+  begin
+    // last line
+    if PixelsDisplayed >= LineHeight then
+    begin
+      // and it's fully displayed, so scroll to show margin
+      Result := FLayout.Height - GetTextAreaHeight;
+      exit;
+    end;
+  end;
+
+  // Scroll to make last line fully visible...
+  Result := FVScrollBar.Position
+            + LineHeight
+            - PixelsDisplayed;
+  if PixelsDisplayed > LineHeight div 2 then
+    // more than half line already displayed so
+    if LastLine < FLayout.FNumLines - 1 then
+      // AND to make next line fully visible
+      inc( Result, FLayout.FLines^[ LastLine + 1 ].Height );
+end;
+
+Function TRichTextView.GetSmallDownScrollPosition: longint;
+var
+  LastLine: longint;
+  PixelsDisplayed: longint;
+  LineTextHeight: longint;
+  Diff: longint;
+begin
+  GetBottomLine( LastLine,
+                 PixelsDisplayed );
+
+  Result := GetLineDownPositionFrom( LastLine, PixelsDisplayed );
+
+  // Now limit the scrolling to max text height for the bottom line
+  Diff := Result - FVScrollBar.Position;
+
+  LineTextHeight := FLayout.FLines^[ LastLine ].MaxTextHeight;
+  if Diff > LineTextHeight then
+    Diff := LineTextHeight;
+  Result := FVScrollBar.Position + Diff;
+end;
+
+Function TRichTextView.GetSmallUpScrollPosition: longint;
+var
+  FirstVisibleLine: longint;
+  Offset: longint;
+  LineTextHeight: longint;
+  Diff: longint;
+begin
+  GetFirstVisibleLine( FirstVisibleLine,
+                       Offset );
+  Result := GetLineUpPositionFrom( FirstVisibleLine,
+                                   Offset );
+  // Now limit the scrolling to max text height for the bottom line
+  Diff := FVScrollBar.Position - Result;
+
+  LineTextHeight := FLayout.FLines^[ FirstVisibleLine ].MaxTextHeight;
+  if Diff > LineTextHeight then
+    Diff := LineTextHeight;
+  Result := FVScrollBar.Position - Diff;
+end;
+
+Function TRichTextView.GetSmallRightScrollPosition: longint;
+begin
+  Result := FHScrollBar.Position + FHScrollBar.ScrollStep;
+  if Result > FHScrollBar.Max then
+    Result := FHScrollBar.Max;
+end;
+
+Function TRichTextView.GetSmallLeftScrollPosition: longint;
+begin
+  Result := FHScrollBar.Position - FHScrollBar.ScrollStep;
+  if Result < 0 then
+    Result := 0;
+end;
+
+Function TRichTextView.GetLineUpPosition: longint;
+var
+  FirstVisibleLine: longint;
+  Offset: longint;
+begin
+  GetFirstVisibleLine( FirstVisibleLine, Offset );
+  Result := GetLineUpPositionFrom( FirstVisibleLine, Offset );
+end;
+
+Function TRichTextView.GetLineUpPositionFrom( FirstVisibleLine: longint;
+                                              Offset: longint ): longint;
+begin
+  // we should never have scrolled all lines off the top!!
+  assert( FirstVisibleLine <> -1 );
+
+  if FirstVisibleLine = 0 then
+  begin
+    // first line
+    if Offset = 0 then
+    begin
+      // and it's already fully visible, so scroll to show margin
+      Result := 0;
+      exit;
+    end;
+  end;
+
+  // scroll so that top line is fully visible...
+  Result := FVScrollBar.Position
+            - Offset;
+
+  if Offset < (FLayout.FLines^[ FirstVisibleLine ].Height div 2) then
+    // more than half the line was already displayed so
+    if FirstVisibleLine > 0 then
+      // AND to make next line up visible
+      dec( Result, FLayout.FLines^[ FirstVisibleLine - 1 ].Height );
+
+end;
+
+Function Sign( arg: longint ): longint;
+begin
+  if arg>0 then
+    Result := 1
+  else if arg<0 then
+    Result := -1
+  else
+    Result := 0;
+end;
+
+Function FSign( arg: double ): double;
+begin
+  if arg>0 then
+    Result := 1
+  else if arg<0 then
+    Result := -1
+  else
+    Result := 0;
+end;
+
+Procedure ExactDelay( MS: Cardinal );
+begin
+  Sleep(MS);
+end;
+
+(*
+Procedure TRichTextView.Scroll( Sender: TScrollbar;
+                                ScrollCode: TScrollCode;
+                                Var ScrollPos: Longint );
+
+begin
+  case ScrollCode of
+//    scVertEndScroll,
+//    scVertPosition,
+    scPageUp,
+    scPageDown,
+    scVertTrack:
+      DoVerticalScroll( ScrollPos );
+
+    // Line up and down positions are calculated for each case
+    scLineDown:
+    begin
+      ScrollPos := GetSmallDownScrollPosition;
+      DoVerticalScroll( ScrollPos );
+    end;
+
+    scLineUp:
+    begin
+      ScrollPos := GetSmallUpScrollPosition;
+      DoVerticalScroll( ScrollPos );
+    end;
+
+    scHorzPosition,
+    scPageRight,
+    scPageLeft,
+    scHorzTrack,
+    scColumnRight,
+    scColumnLeft:
+    begin
+      DoHorizontalScroll( ScrollPos );
+    end;
+  end;
+end;
+*)
+
+Procedure TRichTextView.DoVerticalScroll( NewY: longint );
+//var
+//  ScrollDistance: longint;
+begin
+  FYScroll := 0 - NewY;
+
+  if not Visible then
+  begin
+    FLastYScroll := FYScroll;
+    exit;
+  end;
+
+//  ScrollDistance := FYScroll - FLastYScroll;
+
+  { TODO -ograeme -cscrolling : Implement vertical scrolling here }
+  //ScrollControlRect( Self,
+  //                   GetTextAreaRect,
+  //                   0,
+  //                   ScrollDistance,
+  //                   Color,
+  //                   FSmoothScroll );
+
+  FLastYScroll := FYScroll;
+  RePaint;
+  SetupCursor;
+end;
+
+Procedure TRichTextView.DoHorizontalScroll( NewX: longint );
+var
+  ScrollDistance: longint;
+begin
+  FXScroll := NewX;
+
+  if not Visible then
+  begin
+    FLastXScroll := FXScroll;
+    exit;
+  end;
+
+//  ScrollDistance := FXScroll - FLastXScroll;
+
+  { TODO -ograemeg -cscrolling : Implement horizontal scrolling }
+  //ScrollControlRect( Self,
+  //                   GetTextAreaRect,
+  //                   - ScrollDistance,
+  //                   0,
+  //                   Color,
+  //                   FSmoothScroll );
+
+  FLastXScroll := FXScroll;
+  RePaint;
+  SetupCursor;
+end;
+
+Procedure TRichTextView.SetVerticalPosition( NewY: longint );
+begin
+  FVScrollbar.Position := NewY;
+  FVScrollbar.RepaintSlider;
+  DoVerticalScroll( FVScrollbar.Position );
+end;
+
+Procedure TRichTextView.SetHorizontalPosition( NewX: longint );
+begin
+  FHScrollbar.Position := NewX;
+  FHScrollbar.RepaintSlider;
+  DoHorizontalScroll( FHScrollbar.Position );
+end;
+
+Procedure TRichTextView.AddParagraph( Text: PChar );
+begin
+  if GetTextEnd > 0 then
+  begin
+    AddText( #13, True );
+    AddText( #10, True );
+  end;
+  AddText( Text );
+end;
+
+Procedure TRichTextView.AddSelectedParagraph( Text: PChar );
+begin
+  if GetTextEnd > 0 then
+  begin
+    AddText( #13, True);
+    AddText( #10, True);
+  end;
+  SelectionStart := GetTextEnd;
+  AddText( Text );
+  SelectionEnd := GetTextEnd;
+  MakeCharVisible( SelectionStart );
+end;
+
+// ADelay = True means that we hold off on redoing the Layout and Painting.
+Procedure TRichTextView.AddText( Text: PChar; ADelay: boolean );
+var
+  s: string;
+begin
+  s := Text;
+  // Warning: Hack Alert! replace some strange Bell character found in some INF files
+//  s := SubstituteChar(s, Chr($07), Chr($20) );
+  s := StringReplace(s, Chr($07), '•', [rfReplaceAll, rfIgnoreCase]);
+
+//// Hack Alert #2: replace strange table chars with something we can actually see
+//  s := SubstituteChar(s, Chr(218), Char('+') );   // top-left corner
+//  s := SubstituteChar(s, Chr(196), Char('-') );   // horz row deviders
+//  s := SubstituteChar(s, Chr(194), Char('-') );   // centre top T connection
+//  s := SubstituteChar(s, Chr(191), Char('+') );   // top-right corner
+//  s := SubstituteChar(s, Chr(192), Char('+') );   // bot-left corner
+//  s := SubstituteChar(s, Chr(193), Char('-') );   // centre bottom inverted T
+//  s := SubstituteChar(s, Chr(197), Char('+') );
+//  s := SubstituteChar(s, Chr(179), Char('|') );  //
+//  s := SubstituteChar(s, Chr(195), Char('|') );
+//  s := SubstituteChar(s, Chr(180), Char('|') );
+//  s := SubstituteChar(s, Chr(217), Char('+') );   // bot-right corner
+
+
+
+
+  AddAndResize( FText, PChar(s) );
+  if not ADelay then
+  begin
+    Layout;
+    RePaint;
+  end;
+end;
+
+// Insert at current point
+Procedure TRichTextView.InsertText( CharIndexToInsertAt: longword;
+                                    TextToInsert: PChar );
+var
+  NewText: PChar;
+begin
+  if CharIndexToInsertAt < 0 then
+    exit;
+
+  NewText := StrAlloc( StrLen( FText ) + StrLen( TextToInsert ) + 1 );
+  StrLCopy( NewText, FText, CharIndexToInsertAt );
+  StrCat( NewText, TextToInsert );
+  StrCat( NewText, FText + CharIndexToInsertAt );
+
+  Clear;
+  AddText( NewText );
+  StrDispose( NewText );
+end;
+
+Procedure TRichTextView.Clear(const ADestroying: boolean = False);
+begin
+  ClearSelection;
+  FText[ 0 ] := #0;
+  FTopCharIndex := 0;
+  if not ADestroying then
+  begin
+    Layout;
+    if FLayout.FNumLines > 1 then
+      raise Exception.Create('FLayout.FNumLines should have been 0 but it was ' + IntToStr(FLayout.FNumLines));
+    RePaint;
+  end;
+end;
+
+//procedure TRichTextView.SetBorder( BorderStyle: TBorderStyle );
+//begin
+//  FBorderStyle := BorderStyle;
+//  Refresh;
+//end;
+
+Procedure TRichTextView.SetImages( Images: TfpgImageList );
+begin
+  if Images = FImages then
+    exit; // no change
+
+  { TODO -oGraeme : TfpgImageList is not a TComponent descendant. Maybe it should be? }
+  //if FImages <> nil then
+  //  // Tell the old imagelist not to inform us any more
+  //  FImages.Notification( Self, opRemove );
+
+  FImages := Images;
+  //if FImages <> nil then
+  //  // request notification when other is freed
+  //  FImages.FreeNotification( Self );
+
+  if GetTextEnd = 0 then
+    // no text - can't be any image references - no need to layout
+    exit;
+
+  Layout;
+  RePaint;
+end;
+
+Procedure TRichTextView.OnRichTextSettingsChanged( Sender: TObject );
+begin
+  if not InDesigner then
+  begin
+    Layout;
+    RePaint;
+  end;
+end;
+
+Procedure TRichTextView.Notification( AComponent: TComponent;
+                                      Operation: TOperation );
+begin
+  inherited Notification( AComponent, Operation );
+  { TODO -oGraeme : TfpgImageList is not a TComponent descendant. Maybe it should be? }
+  //if AComponent = FImages then
+  //  if Operation = opRemove then
+  //    FImages := nil;
+end;
+
+(*
+Procedure TRichTextView.MouseDown( Button: TMouseButton;
+                                   ShiftState: TShiftState;
+                                   X, Y: Longint );
+var
+  Line: longint;
+  Offset: longint;
+  Link: string;
+  Position: TTextPosition;
+  Shift: boolean;
+begin
+  Focus;
+
+  inherited MouseDown( Button, ShiftState, X, Y );
+
+  if Button <> mbLeft then
+  begin
+    if Button = mbRight then
+    begin
+      if MouseCapture then
+      begin
+        // this is a shortcut - left mouse drag to select, right mouse to copy
+        CopySelectionToClipboard;
+      end;
+    end;
+    exit;
+  end;
+
+//  if FText[ 0 ] = #0 then
+//    exit;
+
+  Position := FindPoint( X, Y, Line, Offset, Link );
+  FClickedLink := Link;
+
+  if Position in [ tpAboveTextArea,
+                   tpBelowTextArea ] then
+    // not on the control (this probably won't happen)
+    exit;
+
+  // if shift is pressed then keep the same selection start.
+
+  Shift := ssShift in ShiftState;
+  RemoveCursor;
+
+  if not Shift then
+    ClearSelection;
+
+  SetCursorPosition( Offset, Line, Shift );
+  MouseCapture := true;
+
+end;
+*)
+
+(*
+Procedure TRichTextView.MouseUp( Button: TMouseButton;
+                                 ShiftState: TShiftState;
+                                 X, Y: Longint );
+begin
+  if Button = mbRight then
+    if MouseCapture then
+      // don't popup menu for shortcut - left mouse drag to select, right mouse to copy
+      exit;
+
+  inherited MouseUp( Button, ShiftState, X, Y );
+
+  if Button <> mbLeft then
+    exit;
+
+  if not MouseCapture then
+    // not a mouse up from a link click
+    exit;
+
+  if FScrollTimer.Running then
+    FScrollTimer.Stop;
+
+  MouseCapture := false;
+
+  SetupCursor;
+
+  if FClickedLink <> '' then
+    if Assigned( FOnClickLink ) then
+      FOnClickLink( Self, FClickedLink );
+
+end;
+*)
+
+(*
+Procedure TRichTextView.MouseDblClick( Button: TMouseButton;
+                                       ShiftState: TShiftState;
+                                       X, Y: Longint );
+var
+  Row: longint;
+  Offset: longint;
+  Link: string;
+  Position: TTextPosition;
+  P: PChar;
+  pWordStart: PChar;
+  WordLength: longint;
+begin
+  inherited MouseDblClick( Button, ShiftState, X, Y );
+
+  if Button <> mbLeft then
+    exit;
+
+//  if FText[ 0 ] = #0 then
+//    exit;
+
+  Position := FindPoint( X, Y, Row, Offset, Link );
+
+  if Position in [ tpAboveTextArea,
+                   tpBelowTextArea ] then
+    // not on the control (this probably won't happen)
+    exit;
+
+  Assert( Row >= 0 );
+  Assert( Row < FLayout.FNumLines );
+
+  P := FLayout.FLines[ Row ].Text + Offset;
+
+  RemoveCursor;
+
+  if not RichTextWordAt( FText,
+                         P,
+                         pWordStart,
+                         WordLength ) then
+  begin
+    // not in a word
+    SetCursorPosition( Offset, Row, false );
+    SetupCursor;
+    exit;
+  end;
+
+  SetSelectionStartInternal( FLayout.GetCharIndex( pWordStart ) );
+  SetSelectionEndInternal( FLayout.GetCharIndex( pWordStart )
+                           + WordLength );
+  RefreshCursorPosition;
+  SetupCursor;
+end;
+*)
+
+(*
+Procedure TRichTextView.MouseMove( ShiftState: TShiftState;
+                                   X, Y: Longint );
+var
+  Line: longint;
+  Offset: longint;
+  Link: string;
+  Position: TTextPosition;
+begin
+  inherited MouseMove( ShiftState, X, Y );
+
+  Position := FindPoint( X, Y, Line, Offset, Link );
+
+  if not MouseCapture then
+  begin
+    if Link <> FLastLinkOver then
+    begin
+      if Link <> '' then
+      begin
+        if Assigned( FOnOverLink ) then
+          FOnOverLink( Self, Link )
+      end
+      else
+      begin
+        if Assigned( FOnNotOverLink ) then
+          FOnNotOverLink( Self, FLastLinkOver );
+      end;
+
+      FLastLinkOver := Link;
+    end;
+
+    if Link <> '' then
+      Cursor := FLinkCursor
+    else
+      Cursor := crIBeam;
+    exit;
+  end;
+
+  // We are holding mouse down and dragging to set a selection:
+
+  if Position in [ tpAboveTextArea,
+                   tpBelowTextArea ] then
+  begin
+    // above top or below bottom of control
+    FOldMousePoint := Point( X, Y );
+
+    if Position = tpAboveTextArea then
+      FScrollingDirection := sdUp
+    else
+      FScrollingDirection := sdDown;
+
+    if not FScrollTimer.Running then
+    begin
+      FScrollTimer.Start;
+      OnScrollTimer( self );
+    end;
+    exit;
+  end;
+
+  // Normal selection, cursor within text rect
+  if FScrollTimer.Running then
+    FScrollTimer.Stop;
+
+  SetCursorPosition( Offset,
+                     Line,
+                     true );
+
+  if SelectionSet then
+  begin
+    FClickedLink := ''; // if they move while on a link we don't want to follow it.
+    Cursor := crIBeam;
+  end;
+
+end;
+*)
+
+procedure TRichTextView.OnScrollTimer( Sender: TObject );
+var
+  Line, Offset: longint;
+  MousePoint: TPoint;
+  TextRect: TRect;
+begin
+  exit;
+  //MousePoint := Screen.MousePos;
+  //MousePoint := ScreenToClient( MousePoint );
+  //TextRect := GetTextAreaRect;
+  //
+  //if FScrollingDirection = sdDown then
+  //  // scrolling down
+  //  if FVScrollbar.Position = FVScrollbar.Max then
+  //    exit
+  //  else
+  //  begin
+  //    if ( TextRect.Bottom - MousePoint.Y ) < 20 then
+  //      DownLine
+  //    else
+  //      DownPage;
+  //
+  //    GetBottomLine( Line, Offset );
+  //    SetSelectionEndInternal( FLayout.GetCharIndex( FLayout.Flines[ Line ].Text )
+  //                             + FLayout.FLines[ Line ].Length );
+  //  end
+  //else
+  //  // scrolling up
+  //  if FVScrollbar.Position = FVScrollbar.Min then
+  //    exit
+  //  else
+  //  begin
+  //    if ( MousePoint.Y - TextRect.Top ) < 20 then
+  //      UpLine
+  //    else
+  //      UpPage;
+  //    GetFirstVisibleLine( Line, Offset );
+  //    SetSelectionEndInternal( FLayout.GetCharIndex( FLayout.FLines[ Line ].Text ) );
+  //  end;
+
+end;
+
+Procedure TRichTextView.UpLine;
+begin
+  SetVerticalPosition( GetLineUpPosition );
+end;
+
+Procedure TRichTextView.DownLine;
+begin
+  SetVerticalPosition( GetLineDownPosition );
+end;
+
+Procedure TRichTextView.UpPage;
+begin
+  SetVerticalPosition( FVScrollbar.Position - FVScrollbar.PageSize );
+end;
+
+Procedure TRichTextView.DownPage;
+begin
+  SetVerticalPosition( FVScrollbar.Position + FVScrollbar.PageSize );
+end;
+
+Procedure TRichTextView.SmallScrollUp;
+begin
+  SetVerticalPosition( GetSmallUpScrollPosition );
+end;
+
+Procedure TRichTextView.SmallScrollDown;
+begin
+  SetVerticalPosition( GetSmallDownScrollPosition );
+end;
+
+Procedure TRichTextView.SmallScrollRight;
+begin
+  SetHorizontalPosition( GetSmallRightScrollPosition );
+end;
+
+Procedure TRichTextView.SmallScrollLeft;
+begin
+  SetHorizontalPosition( GetSmallLeftScrollPosition );
+end;
+
+function TRichTextView.GetCursorIndex: longint;
+begin
+  if FCursorRow = -1 then
+  begin
+    Result := -1;
+    exit;
+  end;
+  Result := FLayout.GetCharIndex( FLayout.FLines^[ FCursorRow ].Text ) + FCursorOffset;
+end;
+
+procedure TRichTextView.RefreshCursorPosition;
+var
+  Index: longint;
+  Row: longint;
+begin
+  if SelectionSet then
+  begin
+    Index := FSelectionEnd
+  end
+  else
+  begin
+    Index := FSelectionStart;
+  end;
+
+  if Index = -1 then
+  begin
+    FCursorRow := -1;
+    FCursorOffset := 0;
+    RemoveCursor;
+    exit;
+  end;
+
+  Row := FLayout.GetLineFromCharIndex( Index );
+  SetCursorPosition( Index - FLayout.GetCharIndex( FLayout.FLines^[ Row ].Text ),
+                     Row,
+                     true );
+end;
+
+procedure TRichTextView.SetCursorIndex( Index: longint;
+                                        PreserveSelection: boolean );
+var
+  Row: longint;
+begin
+  Row := FLayout.GetLineFromCharIndex( Index );
+  SetCursorPosition( Index - FLayout.GetCharIndex( FLayout.FLines^[ Row ].Text ),
+                     Row,
+                     PreserveSelection );
+  SetupCursor;
+end;
+
+procedure TRichTextView.SetCursorPosition( Offset: longint;
+                                           Row: longint;
+                                           PreserveSelection: boolean );
+var
+  Index: longint;
+begin
+  RemoveCursor;
+  FCursorOffset := Offset;
+  FCursorRow := Row;
+  Index := FLayout.GetCharIndex( FLayout.FLines^[ Row ].Text ) + Offset;
+  if PreserveSelection then
+  begin
+    SetSelectionEndInternal( Index )
+  end
+  else
+  begin
+    SetSelectionEndInternal( -1 );
+    SetSelectionStartInternal( Index );
+  end;
+  MakeRowAndColumnVisible( FCursorRow, Offset );
+end;
+
+Procedure TRichTextView.CursorRight( PreserveSelection: boolean );
+Var
+  P: PChar;
+  NextP: PChar;
+  Element: TTextElement;
+  NewOffset: longint;
+  Line: TLayoutLine;
+begin
+  P := FText + CursorIndex;
+
+  Element := ExtractNextTextElement( P, NextP );
+  P := NextP;
+  while Element.ElementType = teStyle do
+  begin
+    Element := ExtractNextTextElement( P, NextP );
+    P := NextP;
+  end;
+
+//  if Element.ElementType = teTextEnd then
+//    exit;
+
+//  SetCursorIndex( GetCharIndex( P ), PreserveSelection );
+  Line := FLayout.FLines^[ CursorRow ];
+  NewOffset := PCharDiff( P, Line.Text );
+  if NewOffset < Line.Length then
+  begin
+    SetCursorPosition( NewOffset, FCursorRow, PreserveSelection )
+  end
+  else if ( NewOffset = Line.Length )
+          and not Line.Wrapped then
+  begin
+    SetCursorPosition( NewOffset, FCursorRow, PreserveSelection )
+  end
+  else
+  begin
+    if FCursorRow >= FLayout.FNumLines - 1 then
+      exit;
+    SetCursorPosition( 0, FCursorRow + 1, PreserveSelection );
+  end;
+  SetupCursor;
+end;
+
+Procedure TRichTextView.CursorLeft( PreserveSelection: boolean );
+Var
+  P: PChar;
+  NextP: PChar;
+  Element: TTextElement;
+  Line: TLayoutLine;
+  NewOffset: longint;
+begin
+  P := FText + CursorIndex;
+
+  Element := ExtractPreviousTextElement( FText, P, NextP );
+  P := NextP;
+  while Element.ElementType = teStyle do
+  begin
+    Element := ExtractPreviousTextElement( FText, P, NextP );
+    P := NextP;
+  end;
+
+//  if Element.ElementType = teTextEnd then
+//    exit;
+  Line := FLayout.FLines^[ CursorRow ];
+  NewOffset := PCharDiff( P, Line.Text );
+  if NewOffset >= 0 then
+  begin
+    SetCursorPosition( NewOffset, FCursorRow, PreserveSelection )
+  end
+  else
+  begin
+    if FCursorRow <= 0 then
+      exit;
+    Line := FLayout.FLines^[ CursorRow - 1 ];
+    if Line.Wrapped then
+      SetCursorPosition( Line.Length - 1, FCursorRow - 1, PreserveSelection )
+    else
+      SetCursorPosition( Line.Length, FCursorRow - 1, PreserveSelection )
+  end;
+  SetupCursor;
+
+end;
+
+Procedure TRichTextView.CursorWordLeft( PreserveSelection: boolean );
+Var
+  P: PChar;
+begin
+  P := FText + CursorIndex;
+
+  P := RichTextWordLeft( FText, P );
+
+  SetCursorIndex( FLayout.GetCharIndex( P ),
+                  PreserveSelection );
+end;
+
+Procedure TRichTextView.CursorWordRight( PreserveSelection: boolean );
+Var
+  P: PChar;
+begin
+  P := FText + CursorIndex;
+
+  P := RichTextWordRight( P );
+
+  SetCursorIndex( FLayout.GetCharIndex( P ),
+                  PreserveSelection );
+end;
+
+Procedure TRichTextView.CursorToLineStart( PreserveSelection: boolean );
+Var
+  Line: TLayoutLine;
+begin
+  Line := FLayout.FLines^[ FCursorRow ];
+  SetCursorPosition( 0, FCursorRow, PreserveSelection );
+  SetupCursor;
+end;
+
+Procedure TRichTextView.CursorToLineEnd( PreserveSelection: boolean );
+Var
+  Line: TLayoutLine;
+begin
+  Line := FLayout.FLines^[ FCursorRow ];
+  SetCursorPosition( Line.Length, FCursorRow, PreserveSelection );
+  SetupCursor;
+end;
+
+Procedure TRichTextView.CursorDown( PreserveSelection: boolean );
+var
+  X: longint;
+  Link: string;
+  Offset: longint;
+begin
+  if CursorRow >= FLayout.FNumLines - 1 then
+    exit;
+
+  FLayout.GetXFromOffset( FCursorOffset, FCursorRow, X );
+  FLayout.GetOffsetFromX( X,
+                          FCursorRow + 1,
+                          Offset,
+                          Link );
+
+  SetCursorPosition( Offset, FCursorRow + 1, PreserveSelection );
+  SetupCursor;
+end;
+
+Procedure TRichTextView.CursorUp( PreserveSelection: boolean );
+var
+  X: longint;
+  Link: string;
+  Offset: longint;
+begin
+  if CursorRow <= 0 then
+    exit;
+
+  FLayout.GetXFromOffset( FCursorOffset,
+                          FCursorRow,
+                          X );
+  FLayout.GetOffsetFromX( X,
+                          FCursorRow - 1,
+                          Offset,
+                          Link );
+
+  SetCursorPosition( Offset, FCursorRow - 1, PreserveSelection );
+  SetupCursor;
+
+end;
+
+Procedure TRichTextView.CursorPageDown( PreserveSelection: boolean );
+var
+  X: longint;
+  Link: string;
+  Offset: longint;
+  Distance: longint;
+  NewRow: longint;
+begin
+  NewRow := CursorRow;
+  Distance := 0;
+  while ( Distance < GetTextAreaHeight ) do
+  begin
+    if NewRow >= FLayout.FNumLines - 1 then
+      break;
+
+    Distance := Distance + FLayout.FLines^[ NewRow ].Height;
+    inc( NewRow );
+  end;
+
+  FLayout.GetXFromOffset( FCursorOffset, FCursorRow, X );
+  FLayout.GetOffsetFromX( X, NewRow, Offset, Link );
+  SetCursorPosition( Offset, NewRow, PreserveSelection );
+  SetupCursor;
+end;
+
+Procedure TRichTextView.CursorPageUp( PreserveSelection: boolean );
+var
+  X: longint;
+  Link: string;
+  Offset: longint;
+  Distance: longint;
+  NewRow: longint;
+begin
+  NewRow := CursorRow;
+  Distance := 0;
+  while ( Distance < GetTextAreaHeight ) do
+  begin
+    if NewRow <= 0 then
+      break;
+    dec( NewRow );
+    Distance := Distance + FLayout.FLines^[ NewRow ].Height;
+  end;
+
+  FLayout.GetXFromOffset( FCursorOffset, FCursorRow, X );
+  FLayout.GetOffsetFromX( X, NewRow, Offset, Link );
+  SetCursorPosition( Offset, NewRow, PreserveSelection );
+  SetupCursor;
+end;
+
+Function TRichTextView.GetSelectionAsString: string; // returns up to 255 chars obviously
+var
+  Buffer: array[ 0..255 ] of char;
+  Length: longint;
+begin
+  Length := CopySelectionToBuffer( Addr( Buffer ), 255 );
+
+  Result := StrNPas( Buffer, Length );
+end;
+
+Procedure TRichTextView.CopySelectionToClipboard;
+var
+  SelLength: Longint;
+  Buffer: PChar;
+begin
+  SelLength := SelectionLength;
+  if SelectionLength = 0 then
+    exit;
+
+  Buffer := StrAlloc( SelLength + 1 );
+
+  CopySelectionToBuffer( Buffer, SelLength + 1 );
+
+  fpgClipboard.Text := Buffer;
+
+  StrDispose( Buffer );
+end;
+
+function TRichTextView.CopySelectionToBuffer( Buffer: PChar;
+                                              BufferLength: longint ): longint;
+var
+  P, EndP: PChar;
+begin
+  Result := 0;
+  if    ( FSelectionStart = -1 )
+     or ( FSelectionEnd = -1 ) then
+    exit;
+
+  if FSelectionStart < FSelectionEnd then
+  begin
+    P := FText + FSelectionStart;
+    EndP := FText + FSelectionEnd;
+  end
+  else
+  begin
+    P := FText + FSelectionEnd;
+    EndP := FText + FSelectionStart;
+  end;
+
+  Result := CopyPlainTextToBuffer( P,
+                                   EndP,
+                                   Buffer,
+                                   BufferLength );
+end;
+
+function TRichTextView.CopyTextToBuffer( Buffer: PChar;
+                                         BufferLength: longint ): longint;
+begin
+  Result := CopyPlainTextToBuffer( FText,
+                                   FText + strlen( FText ),
+                                   Buffer,
+                                   BufferLength );
+end;
+
+Function TRichTextView.SelectionLength: longint;
+begin
+  Result := 0;
+  if    ( FSelectionStart = -1 )
+     or ( FSelectionEnd = -1 ) then
+    exit;
+
+  Result := FSelectionEnd - FSelectionStart;
+  if Result < 0 then
+    Result := FSelectionStart - FSelectionEnd;
+end;
+
+Function TRichTextView.SelectionSet: boolean;
+begin
+  Result :=     ( FSelectionStart <> -1 )
+            and ( FSelectionEnd <> - 1 )
+            and ( FSelectionStart <> FSelectionEnd );
+end;
+
+Procedure TRichTextView.SelectAll;
+begin
+  ClearSelection;
+  SelectionStart := FLayout.GetCharIndex( FText );
+  SelectionEnd := FLayout.GetTextEnd;
+end;
+
+(*
+procedure TRichTextView.ScanEvent( Var KeyCode: TKeyCode;
+                                   RepeatCount: Byte );
+var
+  CursorVisible: boolean;
+  Shift: boolean;
+  Key: TKeyCode;
+begin
+  CursorVisible := FSelectionStart <> -1;
+
+  Case KeyCode of
+    kbTab:
+    begin
+      if HighlightNextLink then
+      begin
+        KeyCode := kbNull;
+        exit;
+      end;
+    end;
+
+    kbShiftTab:
+    begin
+      if HighlightPreviousLink then
+      begin
+        KeyCode := kbNull;
+        exit;
+      end;
+    end;
+
+    kbEnter:
+    begin
+
+    end;
+  end;
+
+  Shift := KeyCode and kb_Shift > 0 ;
+  Key := KeyCode and ( not kb_Shift );
+
+  // Keys which work the same regardless of whether
+  // cursor is present or not
+  case Key of
+    kbCtrlC, kbCtrlIns:
+      CopySelectionToClipboard;
+    kbCtrlA:
+      SelectAll;
+
+    kbAltCUp:
+      SmallScrollUp;
+    kbAltCDown:
+      SmallScrollDown;
+    kbAltCLeft:
+      SmallScrollLeft;
+    kbAltCRight:
+      SmallScrollRight;
+  end;
+
+  // Keys which change behaviour if cursor is present
+  if CursorVisible then
+  begin
+    case Key of
+      kbCUp:
+        CursorUp( Shift );
+      kbCDown:
+        CursorDown( Shift );
+
+      // these next two are not exactly orthogonal or required,
+      // but better match other text editors.
+      kbCtrlCUp:
+        if Shift then
+          CursorUp( Shift )
+        else
+          SmallScrollUp;
+      kbCtrlCDown:
+        if Shift then
+          CursorDown( Shift )
+        else
+          SmallScrollDown;
+
+      kbCRight:
+        CursorRight( Shift );
+      kbCLeft:
+        CursorLeft( Shift );
+
+      kbCtrlCLeft:
+        CursorWordLeft( Shift );
+      kbCtrlCRight:
+        CursorWordRight( Shift );
+
+      kbCtrlHome, kbCtrlPageUp:
+        SetCursorIndex( 0, Shift );
+      kbCtrlEnd, kbCtrlPageDown:
+        SetCursorIndex( GetTextEnd, Shift );
+
+      kbPageUp:
+        CursorPageUp( Shift );
+      kbPageDown:
+        CursorPageDown( Shift );
+
+      kbHome:
+        CursorToLineStart( Shift );
+      kbEnd:
+        CursorToLineEnd( Shift );
+    end
+  end
+  else // no cursor visible
+  begin
+    case Key of
+      kbCUp, kbCtrlCUp:
+        SmallScrollUp;
+      kbCDown, kbCtrlCDown:
+        SmallScrollDown;
+
+      kbCLeft, kbCtrlCLeft:
+        SmallScrollLeft;
+      kbCRight, kbCtrlCRight:
+        SmallScrollRight;
+
+      kbPageUp:
+        UpPage;
+      kbPageDown:
+        DownPage;
+
+      kbHome, kbCtrlHome, kbCtrlPageUp:
+        GotoTop;
+      kbEnd, kbCtrlEnd, kbCtrlPageDown:
+        GotoBottom;
+    end;
+  end;
+
+  inherited ScanEvent( KeyCode, RepeatCount );
+
+end;
+*)
+
+function TRichTextView.HighlightNextLink: boolean;
+Var
+  P: PChar;
+  NextP: PChar;
+  T: TTextElement;
+  StartP: PChar;
+begin
+  if CursorIndex = -1 then
+    P := FText // no cursor yet
+  else
+    P := FText + CursorIndex;
+
+  result := false;
+
+  // if we're sitting on a begin-link, skip it...
+  T := ExtractNextTextElement( P, NextP );
+  if T.ElementType = teStyle then
+    if T.Tag.TagType = ttBeginLink then
+      P := NextP;
+
+  while true do
+  begin
+    T := ExtractNextTextElement( P, NextP );
+    if T.ElementType = teTextEnd then
+      // no link found
+      exit;
+
+    if T.ElementType = teStyle then
+      if T.Tag.TagType = ttBeginLink then
+        break;
+
+    p := NextP;
+
+  end;
+
+  StartP := P;
+  p := NextP; // skip begin link
+
+  while true do
+  begin
+    T := ExtractNextTextElement( P, NextP );
+    if T.ElementType = teTextEnd then
+      break; // no explicit link end...
+
+    if T.ElementType = teStyle then
+      if T.Tag.TagType = ttEndLink then
+        break;
+
+    p := NextP;
+  end;
+
+  SetSelectionStart( FLayout.GetCharIndex( StartP ) );
+  SetSelectionEnd( FLayout.GetCharIndex( NextP ) );
+
+  result := true;
+end;
+
+function TRichTextView.HighlightPreviousLink: boolean;
+Var
+  P: PChar;
+  PreviousP: PChar;
+  T: TTextElement;
+  EndP: PChar;
+begin
+  result := false;
+  if CursorIndex = -1 then
+    exit; // no cursor yet
+
+  P := FText + CursorIndex;
+
+  // if we're sitting on an end-of-link, skip it...
+  T := ExtractPreviousTextElement( FText, P, PreviousP );
+  if T.ElementType = teStyle then
+    if T.Tag.TagType = ttEndLink then
+      P := PreviousP;
+
+  while true do
+  begin
+    T := ExtractPreviousTextElement( FText, P, PreviousP );
+    if T.ElementType = teTextEnd then
+      // no link found
+      exit;
+
+    if T.ElementType = teStyle then
+      if T.Tag.TagType = ttEndLink then
+        break;
+
+    p := PreviousP;
+
+  end;
+
+  EndP := P;
+  p := PreviousP; // skip end link
+
+  while true do
+  begin
+    T := ExtractPreviousTextElement( FText, P, PreviousP );
+    if T.ElementType = teTextEnd then
+      break; // no explicit link end...
+
+    if T.ElementType = teStyle then
+      if T.Tag.TagType = ttBeginLink then
+        break;
+
+    p := PreviousP;
+  end;
+
+  SetSelectionStart( FLayout.GetCharIndex( EndP ) );
+  SetSelectionEnd( FLayout.GetCharIndex( PreviousP ) );
+
+  result := true;
+end;
+
+procedure TRichTextView.GoToTop;
+begin
+  SetVerticalPosition( 0 );
+end;
+
+procedure TRichTextView.GotoBottom;
+begin
+  SetVerticalPosition( FVScrollBar.Max );
+end;
+
+Function TRichTextView.GetTopCharIndex: longint;
+var
+  LineIndex: longint;
+  Y: longint;
+begin
+  if not FVerticalPositionInitialised then
+  begin
+    Result := FTopCharIndex;
+    exit;
+  end;
+  GetFirstVisibleLine( LineIndex,
+                       Y );
+  if LineIndex >= 0 then
+    Result := FLayout.GetCharIndex( FLayout.FLines^[ LineIndex ].Text )
+  else
+    Result := 0;
+end;
+
+Function TRichTextView.GetTopCharIndexPosition( NewValue: longint ): longint;
+var
+  Line: longint;
+  lHeight: longint;
+begin
+  if NewValue > GetTextEnd then
+  begin
+    Result := FVScrollBar.Max;
+    exit;
+  end;
+  Line := FLayout.GetLineFromCharIndex( NewValue );
+  if Line = 0 then
+  begin
+    Result := 0; // include top margin
+    exit;
+  end;
+
+  if Line < 0 then
+  begin
+    Result := FVScrollBar.Position;
+    exit;
+  end;
+  lHeight := FLayout.GetLinePosition( Line );
+  Result := lHeight;
+end;
+
+Procedure TRichTextView.SetTopCharIndex( NewValue: longint );
+var
+  NewPosition: longint;
+begin
+  if not FVerticalPositionInitialised then
+  begin
+    if ( NewValue >= 0 )
+       and ( NewValue < GetTextEnd ) then
+    begin
+      FTopCharIndex := NewValue;
+    end;
+    exit;
+  end;
+  NewPosition := GetTopCharIndexPosition( NewValue );
+  SetVerticalPosition( NewPosition );
+end;
+
+procedure TRichTextView.MakeCharVisible( CharIndex: longint );
+var
+  Line: longint;
+begin
+  Line := FLayout.GetLineFromCharIndex( CharIndex );
+
+  MakeRowAndColumnVisible( Line,
+                           FLayout.GetOffsetFromCharIndex( CharIndex, Line ) );
+end;
+
+procedure TRichTextView.MakeRowVisible( Row: longint );
+var
+  TopLine: longint;
+  BottomLine: longint;
+  Offset: longint;
+  NewPosition: longint;
+begin
+  GetFirstVisibleLine( TopLine, Offset );
+  GetBottomLine( BottomLine, Offset );
+
+  if     ( Row > TopLine )
+     and ( Row < BottomLine ) then
+    // already visible
+    exit;
+
+  if     ( Row = BottomLine )
+     and ( Offset >= FLayout.FLines^[ BottomLine ].Height - 1 ) then
+    // bottom row already entirely visible
+    exit;
+
+  if Row <= TopLine then
+  begin
+    // need to scroll up, desird row above top line
+    if Row = 0 then
+      NewPosition := 0 // include margins
+    else
+      NewPosition := FLayout.GetLinePosition( Row );
+
+    if NewPosition > FVScrollbar.Position then
+      // no need to scroll
+      exit;
+    SetVerticalPosition( NewPosition );
+  end
+  else
+  begin
+    // need to scroll down, desired row below bottom line
+    if     ( BottomLine <> -1 )
+       and ( Row >= BottomLine ) then
+      SetVerticalPosition( FLayout.GetLinePosition( Row )
+                           + FLayout.FLines^[ Row ].Height
+                           - GetTextAreaHeight );
+  end;
+end;
+
+procedure TRichTextView.MakeRowAndColumnVisible( Row: longint;
+                                                 Column: longint );
+var
+  X: Longint;
+begin
+  MakeRowVisible( Row );
+  FLayout.GetXFromOffset( Column, Row, X );
+
+  if X > FXScroll + GetTextAreaWidth then
+    // off the right
+    SetHorizontalPosition( X - GetTextAreaWidth + 5 )
+  else if X < FXScroll then
+    // off to left
+    SetHorizontalPosition( X );
+
+end;
+
+function TRichTextView.LinkFromIndex( const CharIndexToFind: longint): string;
+begin
+  Result := FLayout.LinkFromIndex( CharIndexToFind );
+end;
+
+function TRichTextView.FindString( Origin: TFindOrigin;
+                                   const AText: string;
+                                   var MatchIndex: longint;
+                                   var MatchLength: longint ): boolean;
+var
+  P: PChar;
+  pMatch: pchar;
+begin
+  if     ( Origin = foFromCurrent )
+     and ( FSelectionStart <> -1 ) then
+  begin
+    // start at current cursor position
+    P := FText + GetCursorIndex;
+  end
+  else
+  begin
+    P := FText;
+  end;
+
+  Result := RichTextFindString( P, AText, pMatch, MatchLength );
+
+  if Result then
+    // found
+    MatchIndex := FLayout.GetCharIndex( pMatch )
+  else
+    MatchIndex := -1;
+
+end;
+
+function TRichTextView.Find( Origin: TFindOrigin;
+                             const AText: string ): boolean;
+var
+  MatchIndex: longint;
+  MatchLength: longint;
+begin
+  Result := FindString( Origin,
+                        AText,
+                        MatchIndex,
+                        MatchLength );
+  if Result then
+  begin
+    MakeCharVisible( MatchIndex );
+    FSelectionStart := MatchIndex;
+    SelectionEnd := MatchIndex + MatchLength;
+  end;
+end;
+
+function TRichTextView.GetClientRect: TfpgRect;
+begin
+  // Standard border of 2px on all sides
+  Result.SetRect(0, 0, Width, Height);
+  InflateRect(Result, -2, -2);
+end;
+
+
+end.
+
diff --git a/docview/components/richtext/fpgui_richtext.lpk b/docview/components/richtext/fpgui_richtext.lpk
new file mode 100644
index 00000000..4a39379e
--- /dev/null
+++ b/docview/components/richtext/fpgui_richtext.lpk
@@ -0,0 +1,82 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="3">
+    <Name Value="fpgui_richtext"/>
+    <AddToProjectUsesSection Value="False"/>
+    <Author Value="Graeme Geldenhuys"/>
+    <CompilerOptions>
+      <Version Value="8"/>
+      <SearchPaths>
+        <OtherUnitFiles Value="../../src/"/>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Parsing>
+        <Style Value="1"/>
+        <SyntaxOptions>
+          <CStyleOperator Value="False"/>
+          <AllowLabel Value="False"/>
+          <CPPInline Value="False"/>
+        </SyntaxOptions>
+      </Parsing>
+      <CodeGeneration>
+        <TargetCPU Value="i386"/>
+        <TargetOS Value="Linux"/>
+        <Optimizations>
+          <OptimizationLevel Value="0"/>
+        </Optimizations>
+      </CodeGeneration>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="RichTextView component"/>
+    <License Value="LGPL2 with static linking exception."/>
+    <Version Minor="1"/>
+    <Files Count="7">
+      <Item1>
+        <Filename Value="RichTextDocumentUnit.pas"/>
+        <UnitName Value="RichTextDocumentUnit"/>
+      </Item1>
+      <Item2>
+        <Filename Value="ACLStringUtility.pas"/>
+        <UnitName Value="ACLStringUtility"/>
+      </Item2>
+      <Item3>
+        <Filename Value="CanvasFontManager.pas"/>
+        <UnitName Value="CanvasFontManager"/>
+      </Item3>
+      <Item4>
+        <Filename Value="RichTextStyleUnit.pas"/>
+        <UnitName Value="RichTextStyleUnit"/>
+      </Item4>
+      <Item5>
+        <Filename Value="RichTextLayoutUnit.pas"/>
+        <UnitName Value="RichTextLayoutUnit"/>
+      </Item5>
+      <Item6>
+        <Filename Value="RichTextDisplayUnit.pas"/>
+        <UnitName Value="RichTextDisplayUnit"/>
+      </Item6>
+      <Item7>
+        <Filename Value="RichTextView.pas"/>
+        <UnitName Value="RichTextView"/>
+      </Item7>
+    </Files>
+    <RequiredPkgs Count="2">
+      <Item1>
+        <PackageName Value="fpgui_toolkit"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item2>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)/"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>
diff --git a/docview/components/richtext/fpgui_richtext.pas b/docview/components/richtext/fpgui_richtext.pas
new file mode 100644
index 00000000..221e749c
--- /dev/null
+++ b/docview/components/richtext/fpgui_richtext.pas
@@ -0,0 +1,15 @@
+{ This file was automatically created by Lazarus. do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit fpgui_richtext; 
+
+interface
+
+uses
+    RichTextDocumentUnit, ACLStringUtility, CanvasFontManager, 
+  RichTextStyleUnit, RichTextLayoutUnit, RichTextDisplayUnit, RichTextView;
+
+implementation
+
+end.