Merge branch 'LoopHijackUndoRedo' into 'main'

Cocoa: Improve Undo/Redo handling for when COCOALOOPHIJACK is defined.

See merge request freepascal.org/lazarus/lazarus!361

lcl/interfaces/cocoa/cocoa_extra.pas

@@ -15,6 +15,7 @@
 unit Cocoa_Extra;
 
 {$mode objfpc}{$H+}
+{$modeswitch cblocks}
 {$modeswitch objectivec1}
 {$include cocoadefines.inc}
 
@@ -645,6 +646,14 @@ type
     patchVersion: NSInteger;
   end;
 
+  NSUndoManagerUndoWithTargetCBlock = reference to procedure(target: id); cblock; cdecl;
+
+  NSUndoManagerFix = objccategory external (NSUndoManager)
+    procedure registerUndoWithTarget_handler(target: id;
+      handler: NSUndoManagerUndoWithTargetCBlock);
+      message 'registerUndoWithTarget:handler:';
+  end;
+
 const
   // defined in NSApplication.h
   NSAppKitVersionNumber10_5 = 949;

lcl/interfaces/cocoa/cocoatextedits.pas

@@ -23,6 +23,9 @@ unit CocoaTextEdits;
 {.$DEFINE COCOA_DEBUG_SETBOUNDS}
 {.$DEFINE COCOA_SPIN_DEBUG}
 {.$DEFINE COCOA_SPINEDIT_INSIDE_CONTAINER}
+{$IFDEF COCOALOOPHIJACK}
+  {$DEFINE COCOA_OVERRIDE_UNDOMANAGER}
+{$ENDIF}
 
 interface
 
@@ -31,7 +34,7 @@ uses
   Math, // needed for MinDouble, MaxDouble
   LCLType,
   MacOSAll, CocoaAll, CocoaConfig, CocoaUtils, CocoaGDIObjects,
-  CocoaPrivate, CocoaCallback;
+  CocoaPrivate, CocoaCallback, Cocoa_Extra;
 
 const
   SPINEDIT_DEFAULT_STEPPER_WIDTH = 15;
@@ -64,7 +67,10 @@ type
     callback: ICommonCallback;
     maxLength: Integer;
     fixedInitSetting: Boolean;
-
+    {$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+    FUndoManager: NSUndoManager;
+    procedure dealloc; override;
+    {$ENDIF}
     function acceptsFirstResponder: LCLObjCBoolean; override;
     function lclGetCallback: ICommonCallback; override;
     procedure lclClearCallback; override;
@@ -83,6 +89,10 @@ type
     procedure scrollWheel(event: NSEvent); override;
 
     procedure lclSetMaxLength(amax: integer);
+    {$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+    function undoManagerForTextView(view: NSTextView): NSUndoManager; message 'undoManagerForTextView:';
+    {$ENDIF}
+
   end;
 
   { TCocoaSecureTextField }
@@ -91,6 +101,10 @@ type
   public
     maxLength: Integer;
     callback: ICommonCallback;
+    {$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+    FUndoManager: NSUndoManager;
+    procedure dealloc; override;
+    {$ENDIF}
     function acceptsFirstResponder: LCLObjCBoolean; override;
     function lclGetCallback: ICommonCallback; override;
     procedure lclClearCallback; override;
@@ -108,6 +122,9 @@ type
     procedure scrollWheel(event: NSEvent); override;
 
     procedure lclSetMaxLength(amax: integer);
+    {$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+    function undoManagerForTextView(view: NSTextView): NSUndoManager; message 'undoManagerForTextView:';
+    {$ENDIF}
   end;
 
   { TCocoaTextView }
@@ -458,6 +475,20 @@ type
   end;
 {$ENDIF}
 
+  { TCocoaUndoManager }
+{$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+  TCocoaUndoManager = objcclass(NSUndoManager)
+    lastEvent: NSEvent; // weak reference
+    function init: id; override;
+    procedure undo; override;
+    procedure registerUndoWithTarget_selector_object(target: id; selector: SEL;
+      anObject: id); override;
+    procedure registerUndoWithTarget_handler(target: id;
+      handler: NSUndoManagerUndoWithTargetCBlock); override;
+    procedure lclCheckGrouping; message 'lclCheckGrouping';
+  end;
+{$ENDIF} 
+
 // these constants are missing from CocoaAll for some reason
 const
   NSTextAlignmentLeft      = 0;
@@ -983,6 +1014,15 @@ end;
 
 { TCocoaTextField }
 
+{$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+procedure TCocoaTextField.dealloc;
+begin
+  if Assigned(FUndoManager) then
+    FUndoManager.release;
+  inherited dealloc;
+end;
+{$ENDIF}
+
 function TCocoaTextField.acceptsFirstResponder: LCLObjCBoolean;
 begin
   Result := NSViewCanFocus(Self);
@@ -1090,6 +1130,15 @@ begin
   maxLength := amax;
 end;
 
+{$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+function TCocoaTextField.undoManagerForTextView(view: NSTextView): NSUndoManager;
+begin
+  if not Assigned(FUndoManager) then
+    FUndoManager := TCocoaUndoManager.alloc.init;
+  Result := FUndoManager;
+end;
+{$ENDIF}
+
 { TCocoaTextView }
 
 procedure TCocoaTextView.changeColor(sender: id);
@@ -1244,12 +1293,25 @@ end;
 function TCocoaTextView.undoManagerForTextView(view: NSTextView): NSUndoManager;
 begin
   if not Assigned(FUndoManager) then
+    {$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+    FUndoManager := TCocoaUndoManager.alloc.init;
+    {$ELSE}
     FUndoManager := NSUndoManager.alloc.init;
+    {$ENDIF}
   Result := FUndoManager;
 end;
 
 { TCocoaSecureTextField }
 
+{$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+procedure TCocoaSecureTextField.dealloc;
+begin
+  if Assigned(FUndoManager) then
+    FUndoManager.release;
+  inherited dealloc;
+end;
+{$ENDIF}
+
 function TCocoaSecureTextField.acceptsFirstResponder: LCLObjCBoolean;
 begin
   Result := NSViewCanFocus(Self);
@@ -1338,6 +1400,15 @@ begin
   MaxLength := amax;
 end;
 
+{$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+function TCocoaSecureTextField.undoManagerForTextView(view: NSTextView): NSUndoManager;
+begin
+  if not Assigned(FUndoManager) then
+    FUndoManager := TCocoaUndoManager.alloc.init;
+  Result := FUndoManager;
+end;
+{$ENDIF}
+
 { TCocoaEditComboBoxList }
 
 procedure TCocoaEditComboBoxList.InsertItem(Index: Integer; const S: string;
@@ -2369,5 +2440,54 @@ end;
 
 {$ENDIF}
 
+{$IFDEF COCOA_OVERRIDE_UNDOMANAGER}
+
+{ TCocoaUndoManager }
+
+function TCocoaUndoManager.init: id;
+begin
+  // This manages top-level undo groups automatically to work around an issue
+  // where, if we hijack the run loop, all undoable actions are combined into a
+  // single undo group.  It isn't necessary for correct behavior in the other
+  // modes.
+  Result := inherited init;
+  Result.setGroupsByEvent(False);
+end;
+
+procedure TCocoaUndoManager.undo;
+begin
+  if not groupsByEvent and (groupingLevel = 1) then
+    endUndoGrouping;
+  inherited;
+end;
+
+procedure TCocoaUndoManager.registerUndoWithTarget_selector_object(target: id;
+  selector: SEL; anObject: id);
+begin
+  lclCheckGrouping;
+  inherited;
+end;
+
+procedure TCocoaUndoManager.registerUndoWithTarget_handler(target: id;
+  handler: NSUndoManagerUndoWithTargetCBlock);
+begin
+  lclCheckGrouping;
+  inherited registerUndoWithTarget_handler(target, handler);
+end;
+
+procedure TCocoaUndoManager.lclCheckGrouping;
+begin
+  if groupsByEvent or isUndoing or isRedoing then
+    Exit;
+  if (groupingLevel = 1) and (lastEvent <> NSApp.currentEvent) then
+    endUndoGrouping;
+  if groupingLevel = 0 then begin
+    lastEvent := NSApp.currentEvent;
+    beginUndoGrouping;
+  end;
+end;
+
+{$ENDIF}
+
 end.
 

lcl/interfaces/qt5/qtwidgets.pas

@@ -107,6 +107,7 @@ type
 
   TQtWidget = class(TQtObject, IUnknown)
   private
+    FDefaultFocusReason: QtFocusReason;
     FInResizeEvent: boolean;
     FWidgetState: TQtWidgetStates;
     FWidgetDefaultFont: TQtFont;
@@ -319,6 +320,7 @@ type
       nil): QPixmapH;
     property ChildOfComplexWidget: TChildOfComplexWidget read FChildOfComplexWidget write FChildOfComplexWidget;
     property Context: HDC read GetContext;
+    property DefaultFocusReason: QtFocusReason read FDefaultFocusReason write FDefaultFocusReason;
     property HasCaret: Boolean read FHasCaret write SetHasCaret;
     property HasPaint: Boolean read FHasPaint write FHasPaint;
     property InResizeEvent: boolean read FInResizeEvent write FInResizeEvent;
@@ -2161,6 +2163,7 @@ end;
 
 procedure TQtWidget.InitializeWidget;
 begin
+  FDefaultFocusReason := QtTabFocusReason;
   FInResizeEvent := False;
   // default states
   FWidgetState := [];
@@ -5164,7 +5167,7 @@ end;
 procedure TQtWidget.setFocus;
 begin
   if getFocusPolicy <> QtNoFocus then
-    QWidget_setFocus(Widget, QtTabFocusReason) {issue #10155}
+    QWidget_setFocus(Widget, FDefaultFocusReason) {issue #10155}
   else
     QWidget_setFocus(Widget);
 end;
@@ -9769,6 +9772,7 @@ begin
   FCachedSelectionLen := -1;
   FIntValidator := nil;
   FNumbersOnly := False;
+  FDefaultFocusReason := QtOtherFocusReason;
   if AParams.WndParent <> 0 then
     Parent := TQtWidget(AParams.WndParent).GetContainerWidget
   else
@@ -16412,6 +16416,7 @@ end;
 
 procedure TQtMenu.InitializeWidget;
 begin
+  FDefaultFocusReason := QtTabFocusReason;
   FWidgetState := [];
   ChildOfComplexWidget := ccwNone;
   WidgetColorRole := QPaletteWindow;

lcl/interfaces/qt6/qtwidgets.pas

@@ -107,6 +107,7 @@ type
 
   TQtWidget = class(TQtObject, IUnknown)
   private
+    FDefaultFocusReason: QtFocusReason;
     FInResizeEvent: boolean;
     FWidgetState: TQtWidgetStates;
     FWidgetDefaultFont: TQtFont;
@@ -316,6 +317,7 @@ type
       nil): QPixmapH;
     property ChildOfComplexWidget: TChildOfComplexWidget read FChildOfComplexWidget write FChildOfComplexWidget;
     property Context: HDC read GetContext;
+    property DefaultFocusReason: QtFocusReason read FDefaultFocusReason write FDefaultFocusReason;
     property HasCaret: Boolean read FHasCaret write SetHasCaret;
     property HasPaint: Boolean read FHasPaint write FHasPaint;
     property InResizeEvent: boolean read FInResizeEvent write FInResizeEvent;
@@ -2158,6 +2160,7 @@ end;
 
 procedure TQtWidget.InitializeWidget;
 begin
+  FDefaultFocusReason := QtTabFocusReason;
   FInResizeEvent := False;
   // default states
   FWidgetState := [];
@@ -5168,7 +5171,7 @@ end;
 procedure TQtWidget.setFocus;
 begin
   if getFocusPolicy <> QtNoFocus then
-    QWidget_setFocus(Widget, QtTabFocusReason) {issue #10155}
+    QWidget_setFocus(Widget, FDefaultFocusReason) {issue #10155}
   else
     QWidget_setFocus(Widget);
 end;
@@ -9725,6 +9728,7 @@ begin
   FCachedSelectionLen := -1;
   FIntValidator := nil;
   FNumbersOnly := False;
+  FDefaultFocusReason := QtOtherFocusReason;
   if AParams.WndParent <> 0 then
     Parent := TQtWidget(AParams.WndParent).GetContainerWidget
   else
@@ -16322,6 +16326,7 @@ end;
 
 procedure TQtMenu.InitializeWidget;
 begin
+  FDefaultFocusReason := QtTabFocusReason;
   FWidgetState := [];
   ChildOfComplexWidget := ccwNone;
   WidgetColorRole := QPaletteWindow;