lazarus/lcl/interfaces/cocoa/cocoacustomcontrol.pas

unit CocoaCustomControl;

{$mode objfpc}{$H+}
{$modeswitch objectivec2}
{$interfaces corba}

interface

uses
  Classes, SysUtils,
  Forms,
  MacOSAll, CocoaAll, CocoaPrivate, CocoaCallback,
  CocoaCursor, Cocoa_Extra, CocoaUtils;

type
  { TCocoaCustomControl }

  TCocoaCustomControl = objcclass(NSControl)
  private
    fstr : NSString;

    isdrawing   : integer;
    faileddraw  : Boolean;
  public
    callback: ICommonCallback;
    auxMouseByParent: Boolean;
    procedure dealloc; override;
    function acceptsFirstResponder: LCLObjCBoolean; override;
    procedure drawRect(dirtyRect: NSRect); override;
    function lclGetCallback: ICommonCallback; override;
    procedure lclClearCallback; override;
    function lclIsMouseInAuxArea(Event: NSevent): Boolean; override;
    // mouse
    function acceptsFirstMouse(event: NSEvent): LCLObjCBoolean; override;
    procedure mouseDown(event: NSEvent); override;
    procedure mouseUp(event: NSEvent); override;
    procedure rightMouseDown(event: NSEvent); override;
    procedure rightMouseUp(event: NSEvent); override;
    procedure rightMouseDragged(event: NSEvent); override;
    procedure otherMouseDown(event: NSEvent); override;
    procedure otherMouseUp(event: NSEvent); override;
    procedure otherMouseDragged(event: NSEvent); override;
    procedure mouseDragged(event: NSEvent); override;
    procedure mouseEntered(event: NSEvent); override;
    procedure mouseExited(event: NSEvent); override;
    procedure mouseMoved(event: NSEvent); override;
    procedure scrollWheel(event: NSEvent); override;
    // nsview
    procedure setFrame(aframe: NSRect); override;
    // value
    procedure setStringValue(avalue: NSString); override;
    function stringValue: NSString; override;
    procedure addSubView(aview: NSView); override;
    procedure doCommandBySelector (aSelector: SEL); override;
  end;

  { TCocoaCustomControlWithBaseInputClient }

  TCocoaCustomControlWithBaseInputClient = objcclass(TCocoaCustomControl, NSTextInputClientProtocol)
  private
    _inIME: Boolean;
  private
    function getWindowEditor(): NSTextView; message 'getWindowEditor';
    procedure DoCallInputClientInsertText(nsText:NSString); message 'DoCallInputClientInsertText:';
  public
    // NSTextInputClientProtocol related.
    // implements a base NSTextInputClient for non-editable LCL CustomControl,
    // like Form, Grid, ListView, that are not system control and not FullEditControl.
    // 1. when using IME in these controls, a temporary and one-time editor is shown
    //    at the bottom of the control, supporting IME such as Chinese.
    // 2. refers to MacOS Finder, when using IME in the file list view,
    //    a small window will pop up at the bottom of the screen for input.
    //    the text can then be used for filename starting character match.
    // 3. it is useful for implementing IME support for controls that do not
    //    have a text input window.
    procedure keyDown(theEvent: NSEvent); override;
    procedure insertText_replacementRange (aString: id; replacementRange: NSRange);
    procedure setMarkedText_selectedRange_replacementRange (aString: id; selectedRange: NSRange; replacementRange: NSRange);
    procedure unmarkText;
    function selectedRange: NSRange;
    function markedRange: NSRange;
    function hasMarkedText: LCLObjCBoolean;
    function firstRectForCharacterRange_actualRange (aRange: NSRange; actualRange: NSRangePointer): NSRect;

    function attributedSubstringForProposedRange_actualRange (aRange: NSRange; actualRange: NSRangePointer): NSAttributedString;
    function validAttributesForMarkedText: NSArray;
    function characterIndexForPoint (aPoint: NSPoint): NSUInteger;
  end;

implementation

{ TCocoaCustomControl }

procedure TCocoaCustomControl.setStringValue(avalue: NSString);
begin
  if Assigned(fstr) then fstr.release;
  if ASsigned(avalue) then
    fstr:=avalue.copyWithZone(nil)
  else
    fstr:=nil;
  inherited setStringValue(avalue);
end;

function TCocoaCustomControl.stringValue: NSString;
begin
  Result:=fstr;
end;

procedure TCocoaCustomControl.addSubView(aview: NSView);
var
  mask: NSUInteger;
begin
  inherited addSubView(aview);

  if Assigned(aview) then
  begin
    // forcing LCL compatible "auto-move" mode. Sticking to left/top corner
    if not autoresizesSubviews then
      {$ifdef BOOLFIX}
      setAutoresizesSubviews_(Ord(true));
      {$else}
      setAutoresizesSubviews(true);
      {$endif}
    if self.isFlipped then
      mask:= NSViewMaxYMargin or NSViewMaxXMargin
    else
      mask:= NSViewMinYMargin or NSViewMaxXMargin;
    aview.setAutoresizingMask(mask);
  end;
end;

procedure TCocoaCustomControl.dealloc;
begin
  if Assigned(fstr) then fstr.release;
  inherited dealloc;
end;

function TCocoaCustomControl.acceptsFirstResponder: LCLObjCBoolean;
begin
  Result := True;
end;

function TCocoaCustomControl.acceptsFirstMouse(event: NSEvent): LCLObjCBoolean;
begin
  // By default, a mouse-down event in a window that isn’t the key window
  // simply brings the window forward and makes it key; the event isn’t sent
  // to the NSView object over which the mouse click occurs. The NSView can
  // claim an initial mouse-down event, however, by overriding acceptsFirstMouse: to return YES.
  // see bug #33034
  Result:=true;
end;

procedure TCocoaCustomControl.drawRect(dirtyRect: NSRect);
begin
  if isdrawing=0 then faileddraw:=false;
  inc(isdrawing);
  inherited drawRect(dirtyRect);

  // Implement Color property
  if Assigned(callback) then
    callback.DrawBackground(NSGraphicsContext.currentContext, bounds, dirtyRect);

  if CheckMainThread and Assigned(callback) then
    callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
  dec(isdrawing);

  if (isdrawing=0) and (faileddraw) then
  begin
    // if the frame is changed during the Paint event,
    // redrawing must be triggered to ensure that the
    // correctly updated NSGraphicsContext is obtained.
    // 1. for the new version of macOS, just set setNeedsDisplay()
    // 2. for older versions of macOS, display() must be called by itself,
    //    and just setting by setNeedsDisplay() will not work.
    if NSAppKitVersionNumber >= NSAppKitVersionNumber11_0 then
      self.lclInvalidate
    else
      self.display;
  end;
end;

function TCocoaCustomControl.lclGetCallback: ICommonCallback;
begin
  Result := callback;
end;

procedure TCocoaCustomControl.lclClearCallback;
begin
  callback := nil;
end;

function TCocoaCustomControl.lclIsMouseInAuxArea(Event: NSevent): Boolean;
begin
  if auxMouseByParent and Assigned(superview) then
    Result := superview.lclIsMouseInAuxArea(Event)
  else
    Result := false;
end;

procedure TCocoaCustomControl.mouseDown(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited mouseDown(event);
end;

procedure TCocoaCustomControl.mouseDragged(event: NSEvent);
begin
  window.disableCursorRects;

  if not Assigned(callback) or not callback.MouseMove(event) then
    // calling inherited causes the drag event to be passed to the
    // parent controls

    //inherited mouseDragged(event);
    ;
end;

procedure TCocoaCustomControl.mouseEntered(event: NSEvent);
begin
  inherited mouseEntered(event);
end;

procedure TCocoaCustomControl.mouseExited(event: NSEvent);
begin
  inherited mouseExited(event);
end;

procedure TCocoaCustomControl.mouseMoved(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseMove(event) then
    inherited mouseMoved(event);
end;

procedure TCocoaCustomControl.scrollWheel(event: NSEvent);
begin
  if Assigned(self.lclGetTarget) and (self.lclGetTarget is TScrollingWinControl) then begin
    inherited scrollWheel(event);
    if Assigned(callback) then
      callback.scrollWheel(event);
  end else begin
    if NOT Assigned(callback) or NOT callback.scrollWheel(event) then
      inherited scrollWheel(event);
  end;
end;

procedure TCocoaCustomControl.setFrame(aframe: NSRect);
begin
  if NSEqualRects(aframe, frame) then Exit;
  if isdrawing>0 then
    faileddraw := true;

  inherited setFrame(aframe);
  // it actually should come from a notifcation
  if Assigned(callback) then callback.frameDidChange(self);
end;

procedure TCocoaCustomControl.mouseUp(event: NSEvent);
begin
  if not window.areCursorRectsEnabled then
  begin
    window.enableCursorRects;
    window.resetCursorRects;
    CursorHelper.SetCursorAtMousePos;
  end;

  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited mouseUp(event);
end;

procedure TCocoaCustomControl.rightMouseDown(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited rightMouseDown(event);
end;

procedure TCocoaCustomControl.rightMouseUp(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited rightMouseUp(event);
end;

procedure TCocoaCustomControl.rightMouseDragged(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseMove(event) then
    inherited rightMouseDragged(event);
end;

procedure TCocoaCustomControl.otherMouseDown(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited otherMouseDown(event);
end;

procedure TCocoaCustomControl.otherMouseUp(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited otherMouseUp(event);
end;

procedure TCocoaCustomControl.otherMouseDragged(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseMove(event) then
    inherited otherMouseDragged(event);
end;

procedure TCocoaCustomControl.doCommandBySelector(aSelector: SEL);
begin
  inherited doCommandBySelector(ASelector);
end;

{ TCocoaCustomControlWithBaseInputClient }

function TCocoaCustomControlWithBaseInputClient.getWindowEditor(): NSTextView;
begin
  Result:= NSTextView( self.window.fieldEditor_forObject(true,nil) );
end;

procedure TCocoaCustomControlWithBaseInputClient.DoCallInputClientInsertText(nsText:NSString);
begin
  if Assigned(callback) then
    callback.InputClientInsertText(nsText.UTF8String);
  nsText.release;
end;

procedure TCocoaCustomControlWithBaseInputClient.keyDown(theEvent: NSEvent);
var
  textView: NSView;
  isFirst: Boolean;
begin
  if (not _inIME) and (theEvent.keyCode in
     [kVK_Return, kVK_ANSI_KeypadEnter, kVK_Escape, kVK_Space]) then
  begin
    inherited;
    exit;
  end;

  isFirst:= not _inIME;
  inputContext.handleEvent(theEvent);
  if _inIME and isFirst then
  begin
    textView:= getWindowEditor();
    textView.setFrameSize( NSMakeSize(self.frame.size.width,16) );
    self.addSubView( textView );
  end
  else if not _inIME then
    inputContext.discardMarkedText;
end;

// in TCocoaCustomControl, such as Form, Grid, ListView,
// after inputting text, another control may be focused.
// in insertText_replacementRange(), Cocoa/InputContext doesn't like it,
// so calling InputClientInsertText() asynchronously.
procedure TCocoaCustomControlWithBaseInputClient.insertText_replacementRange(aString: id;
  replacementRange: NSRange);
var
  nsText: NSString;
begin
  if not _inIME then exit;

  unmarkText;

  nsText:= getNSStringObject(aString).copy;
  performSelector_withObject_afterDelay(ObjCSelector('DoCallInputClientInsertText:'), nsText, 0 );
end;

procedure TCocoaCustomControlWithBaseInputClient.setMarkedText_selectedRange_replacementRange(
  aString: id; selectedRange: NSRange; replacementRange: NSRange);
var
  textView: NSTextView;
  nsText: NSString;
begin
  nsText:= getNSStringObject(aString);
  if nsText.length > 0 then
  begin
    _inIME:= true;
    textView:= getWindowEditor();
    if Assigned(textView) then
      textView.setMarkedText_selectedRange_replacementRange(aString,selectedRange,replacementRange);
  end
  else
    unmarkText;
end;

function TCocoaCustomControlWithBaseInputClient.hasMarkedText: LCLObjCBoolean;
begin
  Result := _inIME;
end;

procedure TCocoaCustomControlWithBaseInputClient.unmarkText;
var
  textView: NSTextView;
begin
  _inIME:= false;
  textView:= getWindowEditor();
  if Assigned(textView) then
    textView.removeFromSuperview;
end;

function TCocoaCustomControlWithBaseInputClient.firstRectForCharacterRange_actualRange(
  aRange: NSRange; actualRange: NSRangePointer): NSRect;
var
  point: NSPoint;
  rect: NSRect;
begin
  point:= self.convertPoint_toView(NSZeroPoint, nil);
  rect:= NSMakeRect(point.x, point.y, 0, 16);
  Result:= self.window.convertRectToScreen(rect);
end;

function TCocoaCustomControlWithBaseInputClient.selectedRange: NSRange;
var
  textView: NSText;
begin
  textView:= getWindowEditor();
  if not Assigned(textView) then
    Result:= NSMakeRange( NSNotFound, 0 )
  else
    Result:= textView.selectedRange;
end;

function TCocoaCustomControlWithBaseInputClient.markedRange: NSRange;
var
  textView: NSTextView;
begin
  textView:= getWindowEditor();
  if not Assigned(textView) then
    Result:= NSMakeRange( NSNotFound, 0 )
  else
    Result:= textView.markedRange;
end;

function TCocoaCustomControlWithBaseInputClient.attributedSubstringForProposedRange_actualRange(
  aRange: NSRange; actualRange: NSRangePointer): NSAttributedString;
begin
  Result := nil;
end;

function TCocoaCustomControlWithBaseInputClient.validAttributesForMarkedText: NSArray;
begin
  Result := nil;
end;

function TCocoaCustomControlWithBaseInputClient.characterIndexForPoint(aPoint: NSPoint
  ): NSUInteger;
begin
  Result := 0;
end;

end.