paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 08:38:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

Cocoa: Fix the issue of missing sending LM_CUT/LM_PASTE to LCL

Browse Source
This commit is contained in:
rich2014 2024-06-14 23:08:28 +08:00
parent dcacf7aaac
commit 1c77cb1974
4 changed files with 67 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/interfaces/cocoa/cocoaobject.inc
View File

@ -338,11 +338,10 @@ begin
case ACapability of
lcCanDrawOutsideOnPaint,
lcNeedMininimizeAppWithMainForm,
lcApplicationTitle,
{$ifndef COCOA_USE_NATIVE_MODAL}
lcModalWindow,
{$endif}
lcReceivesLMClearCutCopyPasteReliably:
lcApplicationTitle:
Result := LCL_CAPABILITY_NO;
{$ifdef COCOA_USE_NATIVE_MODAL}
lcModalWindow,

2
lcl/interfaces/cocoa/cocoaprivate.pas
View File

@ -92,6 +92,8 @@ type
procedure ResignFirstResponder;
procedure DidBecomeKeyNotification;
procedure DidResignKeyNotification;
function SendOnEditCut: Boolean;
function SendOnEditPaste: Boolean;
procedure SendOnChange;
procedure SendOnTextChanged;
procedure scroll(isVert: Boolean; Pos: Integer; AScrollPart: NSScrollerPart = NSScrollerNoPart);

48
lcl/interfaces/cocoa/cocoatextedits.pas
View File

@ -126,6 +126,8 @@ type
procedure changeColor(sender: id); override;
// keyboard
procedure cut(sender: id); override;
procedure paste(sender: id); override;
procedure insertNewline(sender: id); override;
// mouse
procedure mouseDown(event: NSEvent); override;
@ -170,6 +172,8 @@ type
procedure setDelegate(adelegate: NSTextDelegateProtocol); override;
procedure lclReviseCursorColor; message 'lclReviseCursorColor';
// keyboard
procedure cut(sender: id); override;
procedure paste(sender: id); override;
procedure insertNewline(sender: id); override;
// mouse
procedure mouseDown(event: NSEvent); override;
@ -799,6 +803,30 @@ begin
setInsertionPointColor(ReverseColor(clr));
end;
procedure TCocoaFieldEditor.cut(sender: id);
var
callback: ICommonCallback;
accept: Boolean = False;
begin
callback:= self.lclGetCallback;
if Assigned(callback) then
accept:= callback.SendOnEditCut;
if accept then
inherited cut(sender);
end;
procedure TCocoaFieldEditor.paste(sender: id);
var
callback: ICommonCallback;
accept: Boolean = False;
begin
callback:= self.lclGetCallback;
if Assigned(callback) then
accept:= callback.SendOnEditPaste;
if accept then
inherited paste(sender);
end;
procedure TCocoaFieldEditor.insertNewline(sender: id);
begin
// 10.6 cocoa handles the editors Return key as "insertNewLine" command (that makes sense)
@ -1049,6 +1077,26 @@ begin
//inherited changeColor(sender);
end;
procedure TCocoaTextView.cut(sender: id);
var
accept: Boolean = False;
begin
if Assigned(callback) then
accept:= callback.SendOnEditCut;
if accept then
inherited cut(sender);
end;
procedure TCocoaTextView.paste(sender: id);
var
accept: Boolean = False;
begin
if Assigned(callback) then
accept:= callback.SendOnEditPaste;
if accept then
inherited paste(sender);
end;
procedure TCocoaTextView.dealloc;
begin
if Assigned(FUndoManager) then

16
lcl/interfaces/cocoa/cocoawscommon.pas
View File

@ -97,6 +97,8 @@ type
procedure ResignFirstResponder; virtual;
procedure DidBecomeKeyNotification; virtual;
procedure DidResignKeyNotification; virtual;
function SendOnEditCut: Boolean; virtual;
function SendOnEditPaste: Boolean; virtual;
procedure SendOnChange; virtual;
procedure SendOnTextChanged; virtual; // text controls (like spin) respond to OnChange for this event, but not for SendOnChange
procedure scroll(isVert: Boolean; Pos: Integer; AScrollPart: NSScrollerPart); virtual;
@ -1404,6 +1406,20 @@ begin
LCLSendKillFocusMsg(Target);
end;
function TLCLCommonCallback.SendOnEditCut: Boolean;
begin
Result:= false;
if Assigned(Target) then
Result:= SendSimpleMessage(Target, LM_CUT)=0;
end;
function TLCLCommonCallback.SendOnEditPaste: Boolean;
begin
Result:= false;
if Assigned(Target) then
Result:= SendSimpleMessage(Target, LM_PASTE)=0;
end;
procedure TLCLCommonCallback.SendOnChange;
begin
if not Assigned(Target) then Exit;