master 27de58af8b 1/2: Implement some drag and drop functions on NS

[Po Lu]

branch: master
commit 27de58af8b3a7617868408886f94bb12f7785800
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Implement some drag and drop functions on NS
    
    * lisp/term/ns-win.el (ns-selection-exists-p):
    (gui-backend-set-selection):
    (x-begin-drag): New functions and selection types.
    * src/nsfns.m (Fns_get_resource):
    (Fns_set_resource):
    (Fx_server_max_request_size): Fix coding style.
    * src/nsselect.m (ns_decode_data_to_pasteboard):
    (ns_lisp_to_pasteboard):
    (ns_dnd_action_to_operation):
    (ns_dnd_action_from_operation):
    (Fns_begin_drag): New functions.
    (syms_of_nsselect): New subrs.
    * src/nsterm.h (EmacsWindow): New fields and messages.
    (NSPasteboardNameGeneral): New define.
    * src/nsterm.m ([EmacsView mouseDown:]): Store last mouse event.
    ([EmacsWindow initWithEmacsFrame:fullscreen:screen:]): Clear that event.
    ([EmacsWindow dealloc]): Free last mouse event.
---
 lisp/term/ns-win.el |  24 ++++++++--
 src/nsfns.m         |   6 +--
 src/nsselect.m      | 128 +++++++++++++++++++++++++++++++++++++++++++++++++---
 src/nsterm.h        |  23 +++++++---
 src/nsterm.m        |  60 ++++++++++++++++++++++++
 5 files changed, 220 insertions(+), 21 deletions(-)

diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 6a414d83f1..0b0775f10a 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -870,12 +870,18 @@ See the documentation of 
`create-fontset-from-fontset-spec' for the format.")
 (declare-function ns-disown-selection-internal "nsselect.m" (selection))
 (declare-function ns-selection-owner-p "nsselect.m" (&optional selection))
 (declare-function ns-selection-exists-p "nsselect.m" (&optional selection))
+(declare-function ns-begin-drag "nsselect.m")
+
+(defvar ns-dnd-selection-value nil
+  "The value of the special `XdndSelection' selection on NS.")
+
 (declare-function ns-get-selection "nsselect.m" (selection-symbol target-type))
 
-(cl-defmethod gui-backend-set-selection (selection value
-                                         &context (window-system ns))
-  (if value (ns-own-selection-internal selection value)
-    (ns-disown-selection-internal selection)))
+(cl-defmethod gui-backend-set-selection (selection value &context 
(window-system ns))
+  (if (eq selection 'XdndSelection)
+      (setq ns-dnd-selection-value selection)
+    (if value (ns-own-selection-internal selection value)
+      (ns-disown-selection-internal selection))))
 
 (cl-defmethod gui-backend-selection-owner-p (selection
                                              &context (window-system ns))
@@ -889,6 +895,16 @@ See the documentation of 
`create-fontset-from-fontset-spec' for the format.")
                                          &context (window-system ns))
   (ns-get-selection selection-symbol target-type))
 
+(defun x-begin-drag (targets &optional action frame _return-frame 
_allow-current-frame)
+  "SKIP: real doc in xfns.c."
+  (unless ns-dnd-selection-value
+    (error "No local value for XdndSelection"))
+  (let ((pasteboard nil))
+    (when (and (member "STRING" targets)
+               (stringp ns-dnd-selection-value))
+      (push (cons 'string ns-dnd-selection-value) pasteboard))
+    (ns-begin-drag frame pasteboard action)))
+
 (provide 'ns-win)
 (provide 'term/ns-win)
 
diff --git a/src/nsfns.m b/src/nsfns.m
index 20c36209eb..1593338dc9 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1859,7 +1859,7 @@ ns_get_defaults_value (const char *key)
 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
        doc: /* Return the value of the property NAME of OWNER from the 
defaults database.
 If OWNER is nil, Emacs is assumed.  */)
-     (Lisp_Object owner, Lisp_Object name)
+  (Lisp_Object owner, Lisp_Object name)
 {
   const char *value;
 
@@ -1880,7 +1880,7 @@ DEFUN ("ns-set-resource", Fns_set_resource, 
Sns_set_resource, 3, 3, 0,
        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
 If OWNER is nil, Emacs is assumed.
 If VALUE is nil, the default is removed.  */)
-     (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
+  (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
 {
   check_window_system (NULL);
   if (NILP (owner))
@@ -1907,7 +1907,7 @@ DEFUN ("x-server-max-request-size", 
Fx_server_max_request_size,
        Sx_server_max_request_size,
        0, 1, 0,
        doc: /* SKIP: real doc in xfns.c.  */)
-     (Lisp_Object terminal)
+  (Lisp_Object terminal)
 {
   check_ns_display_info (terminal);
   /* This function has no real equivalent under Nextstep.  Return nil to
diff --git a/src/nsselect.m b/src/nsselect.m
index a7ef9df0e0..f7a8933c85 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -17,13 +17,11 @@ GNU General Public License for more details.
 You should have received a copy of the GNU General Public License
 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
-/*
-Originally by Carl Edman
-Updated by Christian Limpach (chris@nice.ch)
-OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
-macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
-GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
-*/
+/* Originally by Carl Edman
+   Updated by Christian Limpach (chris@nice.ch)
+   OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
+   macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
+   GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)  
*/
 
 /* This should be the first include, as it may set up #defines affecting
    interpretation of even the system includes.  */
@@ -559,6 +557,117 @@ nxatoms_of_nsselect (void)
         nil] retain];
 }
 
+static void
+ns_decode_data_to_pasteboard (Lisp_Object type, Lisp_Object data,
+                             NSPasteboard *pasteboard)
+{
+  CHECK_SYMBOL (type);
+
+  if (EQ (type, Qstring))
+    {
+      CHECK_STRING (data);
+
+      [pasteboard declareTypes: [NSArray arrayWithObject: 
NSPasteboardTypeString]
+                        owner: nil];
+      [pasteboard setString: [NSString stringWithLispString: data]
+                   forType: NSPasteboardTypeString];
+    }
+  else
+    signal_error ("Unknown pasteboard type", type);
+}
+
+static void
+ns_lisp_to_pasteboard (Lisp_Object object,
+                      NSPasteboard *pasteboard)
+{
+  Lisp_Object tem, type, data;
+
+  CHECK_LIST (object);
+  for (tem = object; CONSP (tem); tem = XCDR (tem))
+    {
+      maybe_quit ();
+
+      type = Fcar (Fcar (tem));
+      data = Fcdr (Fcar (tem));
+
+      ns_decode_data_to_pasteboard (type, data, pasteboard);
+    }
+  CHECK_LIST_END (tem, object);
+}
+
+static NSDragOperation
+ns_dnd_action_to_operation (Lisp_Object action)
+{
+  if (EQ (action, QXdndActionCopy))
+    return NSDragOperationCopy;
+
+  if (EQ (action, QXdndActionMove))
+    return NSDragOperationMove;
+
+  if (EQ (action, QXdndActionLink))
+    return NSDragOperationLink;
+
+  signal_error ("Unsupported drag-and-drop action", action);
+}
+
+static Lisp_Object
+ns_dnd_action_from_operation (NSDragOperation operation)
+{
+  switch (operation)
+    {
+    case NSDragOperationCopy:
+      return QXdndActionCopy;
+
+    case NSDragOperationMove:
+      return QXdndActionMove;
+
+    case NSDragOperationLink:
+      return QXdndActionLink;
+
+    case NSDragOperationNone:
+      return Qnil;
+
+    default:
+      return QXdndActionPrivate;
+    }
+}
+
+DEFUN ("ns-begin-drag", Fns_begin_drag, Sns_begin_drag, 3, 3, 0,
+       doc: /* Begin a drag-and-drop operation on FRAME.
+
+FRAME must be a window system frame.  PBOARD is an alist of (TYPE
+. DATA), where TYPE is one of the following data types that determine
+the meaning of DATA:
+
+  - `string' means DATA should be a string describing text that will
+    be dragged to another program.
+
+ACTION is the action that will be taken by the drop target towards the
+data inside PBOARD.
+
+Return the action that the drop target actually chose to perform, or
+nil if no action was performed (either because there was no drop
+target, or the drop was rejected).  */)
+  (Lisp_Object frame, Lisp_Object pboard, Lisp_Object action)
+{
+  struct frame *f;
+  NSPasteboard *pasteboard;
+  EmacsWindow *window;
+  NSDragOperation operation;
+
+  f = decode_window_system_frame (frame);
+  pasteboard = [NSPasteboard pasteboardWithName: NSDragPboard];
+  window = (EmacsWindow *) [FRAME_NS_VIEW (f) window];
+
+  operation = ns_dnd_action_to_operation (action);
+  ns_lisp_to_pasteboard (pboard, pasteboard);
+
+  operation = [window beginDrag: operation
+                 forPasteboard: pasteboard];
+
+  return ns_dnd_action_from_operation (operation);
+}
+
 void
 syms_of_nsselect (void)
 {
@@ -568,12 +677,17 @@ syms_of_nsselect (void)
   DEFSYM (QFILE_NAME, "FILE_NAME");
 
   DEFSYM (QTARGETS, "TARGETS");
+  DEFSYM (QXdndActionCopy, "XdndActionCopy");
+  DEFSYM (QXdndActionMove, "XdndActionMove");
+  DEFSYM (QXdndActionLink, "XdndActionLink");
+  DEFSYM (QXdndActionPrivate, "XdndActionPrivate");
 
   defsubr (&Sns_disown_selection_internal);
   defsubr (&Sns_get_selection);
   defsubr (&Sns_own_selection_internal);
   defsubr (&Sns_selection_exists_p);
   defsubr (&Sns_selection_owner_p);
+  defsubr (&Sns_begin_drag);
 
   Vselection_alist = Qnil;
   staticpro (&Vselection_alist);
diff --git a/src/nsterm.h b/src/nsterm.h
index 2c46298a93..43f21b0357 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -412,19 +412,27 @@ typedef id instancetype;
 @interface EmacsWindow : NSWindow
 {
   NSPoint grabOffset;
+  NSEvent *last_drag_event;
+  NSDragOperation drag_op;
+  NSDragOperation selected_op;
 }
 
 #ifdef NS_IMPL_GNUSTEP
 - (NSInteger) orderedIndex;
 #endif
 
-- (instancetype)initWithEmacsFrame:(struct frame *)f;
-- (instancetype)initWithEmacsFrame:(struct frame *)f 
fullscreen:(BOOL)fullscreen screen:(NSScreen *)screen;
-- (void)createToolbar:(struct frame *)f;
-- (void)setParentChildRelationships;
-- (NSInteger)borderWidth;
-- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
-- (void)setAppearance;
+- (instancetype) initWithEmacsFrame: (struct frame *) f;
+- (instancetype) initWithEmacsFrame: (struct frame *) f
+                        fullscreen: (BOOL) fullscreen
+                            screen: (NSScreen *) screen;
+- (void) createToolbar: (struct frame *) f;
+- (void) setParentChildRelationships;
+- (NSInteger) borderWidth;
+- (BOOL) restackWindow: (NSWindow *) win above: (BOOL) above;
+- (void) setAppearance;
+- (void) setLastDragEvent: (NSEvent *) event;
+- (NSDragOperation) beginDrag: (NSDragOperation) op
+               forPasteboard: (NSPasteboard *) pasteboard;
 @end
 
 
@@ -1323,6 +1331,7 @@ enum NSWindowTabbingMode
 #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_13)
 /* Deprecated in macOS 10.13.  */
 #define NSPasteboardNameGeneral NSGeneralPboard
+#define NSPasteboardNameDrag NSDragPBoard
 #endif
 
 #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_14)
diff --git a/src/nsterm.m b/src/nsterm.m
index d7e62a70c4..79e30d6ff9 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -7059,6 +7059,7 @@ ns_create_font_panel_buttons (id target, SEL select, SEL 
cancel_action)
 {
   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe);
   NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil];
+  EmacsWindow *window;
 
   NSTRACE ("[EmacsView mouseDown:]");
 
@@ -7070,6 +7071,9 @@ ns_create_font_panel_buttons (id target, SEL select, SEL 
cancel_action)
      button clicks.  */
   emacsframe->mouse_moved = 0;
 
+  window = (EmacsWindow *) [self window];
+  [window setLastDragEvent: theEvent];
+
   if ([theEvent type] == NSEventTypeScrollWheel)
     {
 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
@@ -8859,6 +8863,8 @@ ns_create_font_panel_buttons (id target, SEL select, SEL 
cancel_action)
                 | NSWindowStyleMaskMiniaturizable
                 | NSWindowStyleMaskClosable);
 
+  last_drag_event = nil;
+
   width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols);
   height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines);
 
@@ -8974,6 +8980,11 @@ ns_create_font_panel_buttons (id target, SEL select, SEL 
cancel_action)
 
   /* We need to release the toolbar ourselves.  */
   [[self toolbar] release];
+
+  /* Also the last button press event .  */
+  if (last_drag_event)
+    [last_drag_event release];
+
   [super dealloc];
 }
 
@@ -9498,6 +9509,55 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
   return YES;
 }
 
+- (void) setLastDragEvent: (NSEvent *) event
+{
+  if (last_drag_event)
+    [last_drag_event release];
+  last_drag_event = [event copy];
+}
+
+- (NSDragOperation) draggingSourceOperationMaskForLocal: (BOOL) is_local
+{
+  return drag_op;
+}
+
+- (void) draggedImage: (NSImage *) image
+             endedAt: (NSPoint) screen_point
+           operation: (NSDragOperation) operation
+{
+  selected_op = operation;
+}
+
+- (NSDragOperation) beginDrag: (NSDragOperation) op
+               forPasteboard: (NSPasteboard *) pasteboard
+{
+  NSImage *image;
+
+  drag_op = op;
+  selected_op = NSDragOperationNone;
+  image = [[NSImage alloc] initWithSize: NSMakeSize (1.0, 1.0)];
+
+  /* Now draw transparency onto the image.  */
+  [image lockFocus];
+  [[NSColor colorWithUnsignedLong: 0] set];
+  NSRectFillUsingOperation (NSMakeRect (0, 0, 1, 1),
+                           NSCompositingOperationCopy);
+  [image unlockFocus];
+
+  if (last_drag_event)
+    [self dragImage: image
+                at: NSMakePoint (0, 0)
+            offset: NSMakeSize (0, 0)
+             event: last_drag_event
+        pasteboard: pasteboard
+            source: self
+         slideBack: NO];
+
+  [image release];
+
+  return selected_op;
+}
+
 @end /* EmacsWindow */