Merge pull request #12464 from keymanapp/fix/developer/12454-use-rich…

…edit-for-debugger-memo

fix(developer): use richedit in debug memo to support Egyptian cartouches

developer/src/common/delphi/components/Keyman.Developer.UI.RichEdit41.pas

@@ -0,0 +1,150 @@
+unit Keyman.Developer.UI.RichEdit41;
+
+interface
+
+uses
+  Vcl.Controls,
+  Vcl.ComCtrls,
+  Vcl.Themes,
+  Winapi.Windows;
+
+type
+  TRichEdit41 = class(TCustomRichEdit)
+  strict private
+    class constructor Create;
+    class destructor Destroy;
+  protected
+    procedure CreateParams(var Params: TCreateParams); override;
+  published
+    property Align;
+    property Alignment;
+    property Anchors;
+    property BevelEdges;
+    property BevelInner;
+    property BevelOuter;
+    property BevelKind default bkNone;
+    property BevelWidth;
+    property BiDiMode;
+    property BorderStyle;
+    property BorderWidth;
+    property Color;
+    property Ctl3D;
+    property DragCursor;
+    property DragKind;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property HideSelection;
+    property HideScrollBars;
+    property ImeMode;
+    property ImeName;
+    property Constraints;
+    property Lines;
+    property MaxLength;
+    property ParentBiDiMode;
+    property ParentColor;
+    property ParentCtl3D;
+    property ParentFont;
+    property ParentShowHint;
+    property PlainText;
+    property PopupMenu;
+    property ReadOnly;
+    property ScrollBars;
+    property ShowHint;
+    property TabOrder;
+    property TabStop default True;
+    property Touch;
+    property Visible;
+    property WantTabs;
+    property WantReturns;
+    property WordWrap;
+    property StyleElements;
+    property Zoom;
+    property OnChange;
+    property OnClick;
+    property OnContextPopup;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDock;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnGesture;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseActivate;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnProtectChange;
+    property OnResizeRequest;
+    property OnSaveClipboard;
+    property OnSelectionChange;
+    property OnStartDock;
+    property OnStartDrag;
+  end;
+
+procedure Register;
+
+implementation
+
+uses
+  System.Classes,
+  Winapi.RichEdit;
+
+{ TRichEdit41 }
+
+class constructor TRichEdit41.Create;
+begin
+  TCustomStyleEngine.RegisterStyleHook(TRichEdit41, TRichEditStyleHook);
+end;
+
+class destructor TRichEdit41.Destroy;
+begin
+  TCustomStyleEngine.UnRegisterStyleHook(TRichEdit41, TRichEditStyleHook);
+end;
+
+var
+  FRichEditModule: THandle = 0;
+
+procedure TRichEdit41.CreateParams(var Params: TCreateParams);
+const
+  HideScrollBars: array[Boolean] of DWORD = (ES_DISABLENOSCROLL, 0);
+  HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
+  RichEditClassName = 'RICHEDIT50W';
+  RichEditModuleName = 'MSFTEDIT.DLL';
+begin
+  if FRichEditModule = 0 then
+  begin
+    FRichEditModule := LoadLibrary(RichEditModuleName);
+    if FRichEditModule <= HINSTANCE_ERROR then FRichEditModule := 0;
+  end;
+
+  inherited CreateParams(Params);
+
+  CreateSubClass(Params, RichEditClassName);
+
+  with Params do
+  begin
+    Style := Style or HideScrollBars[Self.HideScrollBars] or
+      HideSelections[HideSelection];
+  end;
+end;
+
+procedure Register;
+begin
+  RegisterComponents('Keyman', [TRichEdit41]);
+end;
+
+initialization
+finalization
+  if FRichEditModule <> 0 then FreeLibrary(FRichEditModule);
+end.
+

developer/src/common/delphi/components/KeymanDeveloperDebuggerMemo.pas

@@ -1,18 +1,18 @@
 (*
   Name:             KeymanDeveloperDebuggerMemo
   Copyright:        Copyright (C) 2003-2017 SIL International.
-  Documentation:    
-  Description:      
+  Documentation:
+  Description:
   Create Date:      8 Jun 2012
 
   Modified Date:    8 Jun 2012
   Authors:          mcdurdin
-  Related Files:    
-  Dependencies:     
+  Related Files:
+  Dependencies:
 
-  Bugs:             
-  Todo:             
-  Notes:            
+  Bugs:
+  Todo:
+  Notes:
   History:          08 Jun 2012 - mcdurdin - I3323 - V9.0 - Extract debug-related code TPlus-Memo into subclass
 *)
 unit KeymanDeveloperDebuggerMemo;  // I3323
@@ -22,9 +22,13 @@ interface
 uses
   System.Classes,
   Winapi.Messages,
+  Winapi.RichEdit,
   Winapi.Windows,
   Vcl.Controls,
-  Vcl.StdCtrls;
+  Vcl.ComCtrls,
+  Vcl.StdCtrls,
+
+  Keyman.Developer.UI.RichEdit41;
 
 type
   TKeymanDeveloperDebuggerMessageEvent = procedure(Sender: TObject; var Message: TMessage; var Handled: Boolean) of object;
@@ -34,10 +38,11 @@   TMemoSelection = record
     Anchor: Integer;
   end;
 
-  TKeymanDeveloperDebuggerMemo = class(TMemo)
+  TKeymanDeveloperDebuggerMemo = class(TRichEdit41)
   private
     FOnMessage: TKeymanDeveloperDebuggerMessageEvent;
     FAllowUnicodeInput: Boolean;
+    FSelectionChanging: Boolean;
     FIsDebugging: Boolean;
     procedure SetAllowUnicode(const Value: Boolean);
     function GetSelection: TMemoSelection;
@@ -52,6 +57,7 @@   TKeymanDeveloperDebuggerMemo = class(TMemo)
     property AllowUnicode: Boolean read FAllowUnicodeInput write SetAllowUnicode default True;
     property OnMessage: TKeymanDeveloperDebuggerMessageEvent read FOnMessage write FOnMessage;
     property Selection: TMemoSelection read GetSelection write SetSelection;
+    property SelectionChanging: Boolean read FSelectionChanging;
     property IsDebugging: Boolean read FIsDebugging write FIsDebugging;
   end;
 
@@ -77,14 +83,21 @@ constructor TKeymanDeveloperDebuggerMemo.Create(AOwner: TComponent);
 begin
   FAllowUnicodeInput := True;
   inherited Create(AOwner);
+  PlainText := True;
 end;
 
 procedure TKeymanDeveloperDebuggerMemo.CreateHandle;
+const
+  TO_ADVANCEDTYPOGRAPHY = 1;
 begin
   inherited;
   if FAllowUnicodeInput
     then SetWindowLongW(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_WNDPROC))
     else SetWindowLongA(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_WNDPROC));
+  SendMessage(Handle, WM_SETTEXT, 0, NativeUInt(PChar('')));
+  SendMessage(Handle, EM_SETTEXTMODE, TM_PLAINTEXT or TM_MULTICODEPAGE, 0);
+  SendMessage(Handle, EM_SETTYPOGRAPHYOPTIONS, TO_ADVANCEDTYPOGRAPHY, TO_ADVANCEDTYPOGRAPHY);
+  SendMessage(Handle, EM_SETLANGOPTIONS, 0, $0040 {IMF_NOIMPLICITLANG} or $0200 {IMF_NOKBDLIDFIXUP});
 end;
 
 function TKeymanDeveloperDebuggerMemo.GetSelection: TMemoSelection;
@@ -93,9 +106,21 @@ function TKeymanDeveloperDebuggerMemo.GetSelection: TMemoSelection;
   // it out with this kludge. I am not aware of side effects from this
   // at this time.
   SendMessage(Handle, EM_GETSEL, NativeUInt(@Result.Start), NativeUInt(@Result.Finish));
-  SendMessage(Handle, EM_SETSEL, -1, 0);
-  SendMessage(Handle, EM_GETSEL, NativeUInt(@Result.Anchor), 0);
-  SetSelection(Result);
+  if Result.Start <> Result.Finish then
+  begin
+    // We only need to play the selection test game if there is a non-zero
+    // selection length
+    FSelectionChanging := True;
+    Lines.BeginUpdate;
+    try
+      SendMessage(Handle, EM_SETSEL, -1, 0);
+      SendMessage(Handle, EM_GETSEL, NativeUInt(@Result.Anchor), 0);
+      SetSelection(Result);
+    finally
+      Lines.EndUpdate;
+      FSelectionChanging := False;
+    end;
+  end;
 end;
 
 procedure TKeymanDeveloperDebuggerMemo.SetAllowUnicode(const Value: Boolean);

developer/src/tike/child/Keyman.Developer.UI.Debug.UfrmLdmlKeyboardDebug.pas

@@ -24,6 +24,7 @@ interface
   Vcl.Menus,
   Vcl.StdCtrls,
   Winapi.Messages,
+  Winapi.RichEdit,
   Winapi.Windows,
 
   CaptionPanel,
@@ -524,6 +525,11 @@     TMemoSelectionState = record
     end;
   end;
 
+type
+  TSetTextEx = record
+    flags: DWord;
+    codepage: UINT;
+  end;
 var
   actions: pkm_core_actions;
   context_items: pkm_core_context_item;
@@ -535,6 +541,8 @@     TMemoSelectionState = record
   context_items_length: Integer;
   state: TMemoSelectionState;
   Adjustment: Integer;
+  ste: TSetTextEx;
+  str: string;
 begin
   FIgnoreNextUIKey := True;
 
@@ -618,11 +626,20 @@     TMemoSelectionState = record
       // Merge left of context, context, and right of context and update memo
       // insertion point position
 
-      memo.Text := lhs + output + rhs;
-      selection.Start := lhs.Length + output.Length;
-      selection.Finish := selection.Start;
-      selection.Anchor := selection.Start;
-      memo.Selection := selection;
+      memo.Lines.BeginUpdate;
+      try
+        // Setting text directly for improved performance
+        ste.flags := $01 {ST_KEEPUNDO} or $04 {ST_NEWCHARS} or $08 {ST_UNICODE} or $20 {ST_PLAINTEXTONLY};
+        ste.codepage := 1200 {Unicode};
+        str := lhs + output + rhs;
+        SendMessage(memo.Handle, (WM_USER + 97) {EM_SETTEXTEX}, NativeUint(@ste), NativeUInt(PChar(str)));
+        selection.Start := lhs.Length + output.Length;
+        selection.Finish := selection.Start;
+        selection.Anchor := selection.Start;
+        memo.Selection := selection;
+      finally
+        memo.Lines.EndUpdate;
+      end;
     end;
 
     // actions.persist_options are not currently supported by LDML
@@ -639,12 +656,6 @@     TMemoSelectionState = record
 
   finally
     km_core_context_items_dispose(context_items);
-
-    UpdateCharacterGrid;
-
-    // We want to refresh the memo and character grid for rapid typing
-    memo.Update;
-    sgChars.Update;
   end;
 end;
 
@@ -824,19 +835,29 @@ procedure TfrmLdmlKeyboardDebug.memoSelMove(Sender: TObject);
     frmKeymanDeveloper.barStatus.Panels[0].Text := 'Debugger Active';
   end;
 
-  if not memo.ReadOnly then
+  if not memo.ReadOnly and not memo.SelectionChanging then
   begin
     UpdateCharacterGrid;   // I4808
   end;
 end;
 
 procedure TfrmLdmlKeyboardDebug.UpdateCharacterGrid;   // I4808
+var
+  start, len: Integer;
 begin
   if csDestroying in ComponentState then
     Exit;
 
-  TCharacterGridRenderer.Fill(sgChars, memo.Text, FDeadkeys, memo.SelStart,
-    memo.SelLength, memo.Selection.Anchor, True);
+  start := memo.SelStart;
+  len := memo.SelLength;
+  if start + len > Length(memo.Text) then
+  begin
+    // RichEdit has a virtual final character, which is selected when
+    // pressing Ctrl+A, etc.
+    len := Length(memo.Text) - start;
+  end;
+  TCharacterGridRenderer.Fill(sgChars, memo.Text, FDeadkeys, start, len,
+    memo.Selection.Anchor, True);
   TCharacterGridRenderer.Size(sgChars, memo.Font);
 end;