<commit_before>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 );<commit_msg>Fix compiler waring about unreachable code.<commit_after>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
  NewText := StrAlloc( StrLen( FText ) + StrLen( TextToInsert ) + 1 );
  StrLCopy( NewText, FText, CharIndexToInsertAt );
  StrCat( NewText, TextToInsert );
  StrCat( NewText, FText + CharIndexToInsertAt );

  Clear;
  AddText( NewText );
{'fraction_non_alphanumeric': 0.09020687300622006, 'fraction_numerical': 0.005046463741211365, 'mean_word_length': 3.030357757137943, 'pattern_counts': {'":': 0, '<': 72, '<?xml version=': 0, '>': 87, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 58, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3390599', 'n_tokens_mistral': 29066, 'n_tokens_neox': 27689, 'n_words': 7926}