[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 00172ae0c8 1/2: Implement cross-program drag-and-drop on Haiku
|
From: |
Po Lu |
|
Subject: |
master 00172ae0c8 1/2: Implement cross-program drag-and-drop on Haiku |
|
Date: |
Wed, 16 Mar 2022 23:48:00 -0400 (EDT) |
branch: master
commit 00172ae0c8a3087578f6e91251f887f6b7b4f682
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Implement cross-program drag-and-drop on Haiku
* doc/lispref/frames.texi (Drag and Drop): Fix documentation of
`x-begin-drag' to match actual function arity.
* lisp/term/haiku-win.el (haiku-dnd-selection-value): New
variable.
(haiku-dnd-selection-converters): New variable.
(haiku-dnd-convert-string): New function.
(gui-backend-get-selection, gui-backend-set-selection): Handle
XdndSelection specially.
(x-begin-drag): New function.
* src/haiku_select.cc (be_create_simple_message)
(be_add_message_data): New functions.
* src/haiku_support.cc (WAIT_FOR_RELEASE): New message type.
(class EmacsView, MouseUp): If waiting for release, reply and
drop event.
(be_drag_message, be_drag_message_thread_entry): New functions.
* src/haiku_support.h: Update prototypes.
* src/haikuselect.c (lisp_to_type_code, haiku_lisp_to_message)
(Fhaiku_drag_message): New functions.
(syms_of_haikuselect): Define new subr.
* src/haikuselect.h: Update prototypes.
---
doc/lispref/frames.texi | 2 +-
lisp/term/haiku-win.el | 54 +++++++++++-
src/haiku_select.cc | 16 ++++
src/haiku_support.cc | 112 ++++++++++++++++++++++++
src/haiku_support.h | 6 ++
src/haikuselect.c | 224 +++++++++++++++++++++++++++++++++++++++++++++++-
src/haikuselect.h | 4 +
7 files changed, 411 insertions(+), 7 deletions(-)
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 97283a525c..31ebeb51b4 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4042,7 +4042,7 @@ you want to alter Emacs behavior, you can customize these
variables.
On capable window systems, Emacs also supports dragging contents
from its frames to windows of other applications.
-@defun x-begin-drag targets action &optional frame return-frame
+@defun x-begin-drag targets &optional action frame return-frame
This function begins a drag from @var{frame}, and returns when the
drag-and-drop operation ends, either because the drop was successful,
or because the drop was rejected. The drop occurs when all mouse
diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el
index 3b3f2f0874..b7f1991381 100644
--- a/lisp/term/haiku-win.el
+++ b/lisp/term/haiku-win.el
@@ -45,6 +45,25 @@
(defvar haiku-initialized)
+(defvar haiku-dnd-selection-value nil
+ "The local value of the special `XdndSelection' selection.")
+
+(defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string))
+ "Alist of X selection types to functions that act as selection converters.
+The functions should accept a single argument VALUE, describing
+the value of the drag-and-drop selection, and return a list of
+two elements TYPE and DATA, where TYPE is a string containing the
+MIME type of DATA, and DATA is a unibyte string, or nil if the
+data could not be converted.")
+
+(defun haiku-dnd-convert-string (value)
+ "Convert VALUE to a UTF-8 string and appropriate MIME type.
+Return a list of the appropriate MIME type, and UTF-8 data of
+VALUE as a unibyte string, or nil if VALUE was not a string."
+ (when (stringp value)
+ (list "text/plain" (string-to-unibyte
+ (encode-coding-string value 'utf-8)))))
+
(declare-function x-open-connection "haikufns.c")
(declare-function x-handle-args "common-win")
(declare-function haiku-selection-data "haikuselect.c")
@@ -52,6 +71,7 @@
(declare-function haiku-selection-targets "haikuselect.c")
(declare-function haiku-selection-owner-p "haikuselect.c")
(declare-function haiku-put-resource "haikufns.c")
+(declare-function haiku-drag-message "haikuselect.c")
(defun haiku--handle-x-command-line-resources (command-line-resources)
"Handle command line X resources specified with the option `-xrm'.
@@ -97,11 +117,15 @@ If TYPE is nil, return \"text/plain\"."
(if (eq data-type 'TARGETS)
(apply #'vector (mapcar #'intern
(haiku-selection-targets type)))
- (haiku-selection-data type (haiku--selection-type-to-mime data-type))))
+ (if (eq type 'XdndSelection)
+ haiku-dnd-selection-value
+ (haiku-selection-data type (haiku--selection-type-to-mime data-type)))))
(cl-defmethod gui-backend-set-selection (type value
&context (window-system haiku))
- (haiku-selection-put type "text/plain" value t))
+ (if (eq type 'XdndSelection)
+ (setq haiku-dnd-selection-value value)
+ (haiku-selection-put type "text/plain" value t)))
(cl-defmethod gui-backend-selection-exists-p (selection
&context (window-system haiku))
@@ -159,6 +183,32 @@ This is necessary because on Haiku `use-system-tooltip'
doesn't
take effect on menu items until the menu bar is updated again."
(force-mode-line-update t))
+(defun x-begin-drag (targets &optional action frame return-frame)
+ "SKIP: real doc in xfns.c."
+ (unless haiku-dnd-selection-value
+ (error "No local value for XdndSelection"))
+ (let ((message nil))
+ (dolist (target targets)
+ (let ((selection-converter (cdr (assoc (intern target)
+ haiku-dnd-selection-converters))))
+ (when selection-converter
+ (let ((selection-result
+ (funcall selection-converter
+ haiku-dnd-selection-value)))
+ (when selection-result
+ (let ((field (cdr (assoc (car selection-result) message))))
+ (unless (cadr field)
+ ;; Add B_MIME_TYPE to the message if the type was not
+ ;; previously defined.
+ (push 1296649641 (alist-get (car selection-result) message
+ nil nil #'equal))))
+ (push (cadr selection-result)
+ (cdr (alist-get (car selection-result) message
+ nil nil #'equal))))))))
+ (prog1 (or action 'XdndActionCopy)
+ (haiku-drag-message (or frame (selected-frame))
+ message))))
+
(add-variable-watcher 'use-system-tooltips #'haiku-use-system-tooltips-watcher)
(provide 'haiku-win)
diff --git a/src/haiku_select.cc b/src/haiku_select.cc
index abb07b2002..4212f60a48 100644
--- a/src/haiku_select.cc
+++ b/src/haiku_select.cc
@@ -321,3 +321,19 @@ be_get_message_data (void *message, const char *name,
return msg->FindData (name, type_code,
index, buf_return, size_return) != B_OK;
}
+
+void *
+be_create_simple_message (void)
+{
+ return new BMessage (B_SIMPLE_DATA);
+}
+
+int
+be_add_message_data (void *message, const char *name,
+ int32 type_code, const void *buf,
+ ssize_t buf_size)
+{
+ BMessage *msg = (BMessage *) message;
+
+ return msg->AddData (name, type_code, buf, buf_size) != B_OK;
+}
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index 884e3583e2..626b2fb607 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -81,6 +81,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "haiku_support.h"
#define SCROLL_BAR_UPDATE 3000
+#define WAIT_FOR_RELEASE 3001
static color_space dpy_color_space = B_NO_COLOR_SPACE;
static key_map *key_map = NULL;
@@ -1177,6 +1178,7 @@ public:
#endif
BPoint tt_absl_pos;
+ BMessage *wait_for_release_message = NULL;
color_space cspace;
@@ -1187,6 +1189,9 @@ public:
~EmacsView ()
{
+ if (wait_for_release_message)
+ gui_abort ("Wait for release message still exists");
+
TearDownDoubleBuffering ();
}
@@ -1196,6 +1201,28 @@ public:
cspace = B_RGBA32;
}
+ void
+ MessageReceived (BMessage *msg)
+ {
+ uint32 buttons;
+ BLooper *looper = Looper ();
+
+ if (msg->what == WAIT_FOR_RELEASE)
+ {
+ if (wait_for_release_message)
+ gui_abort ("Wait for release message already exists");
+
+ GetMouse (NULL, &buttons, false);
+
+ if (!buttons)
+ msg->SendReply (msg);
+ else
+ wait_for_release_message = looper->DetachCurrentMessage ();
+ }
+ else
+ BView::MessageReceived (msg);
+ }
+
#ifdef USE_BE_CAIRO
void
DetachCairoSurface (void)
@@ -1483,6 +1510,16 @@ public:
this->GetMouse (&point, &buttons, false);
+ if (!buttons && wait_for_release_message)
+ {
+ wait_for_release_message->SendReply (wait_for_release_message);
+ delete wait_for_release_message;
+ wait_for_release_message = NULL;
+
+ previous_buttons = buttons;
+ return;
+ }
+
rq.window = this->Window ();
if ((previous_buttons & B_PRIMARY_MOUSE_BUTTON)
@@ -3870,3 +3907,78 @@ BMessage_delete (void *message)
{
delete (BMessage *) message;
}
+
+static int32
+be_drag_message_thread_entry (void *thread_data)
+{
+ BMessenger *messenger;
+ BMessage reply;
+
+ messenger = (BMessenger *) thread_data;
+ messenger->SendMessage (WAIT_FOR_RELEASE, &reply);
+
+ return 0;
+}
+
+void
+be_drag_message (void *view, void *message,
+ void (*block_input_function) (void),
+ void (*unblock_input_function) (void),
+ void (*process_pending_signals_function) (void))
+{
+ EmacsView *vw = (EmacsView *) view;
+ BMessage *msg = (BMessage *) message;
+ BMessage wait_for_release;
+ BMessenger messenger (vw);
+ struct object_wait_info infos[2];
+ ssize_t stat;
+
+ block_input_function ();
+ if (!vw->LockLooper ())
+ gui_abort ("Failed to lock view looper for drag");
+
+ vw->DragMessage (msg, BRect (0, 0, 0, 0));
+ vw->UnlockLooper ();
+
+ infos[0].object = port_application_to_emacs;
+ infos[0].type = B_OBJECT_TYPE_PORT;
+ infos[0].events = B_EVENT_READ;
+
+ infos[1].object = spawn_thread (be_drag_message_thread_entry,
+ "Drag waiter thread",
+ B_DEFAULT_MEDIA_PRIORITY,
+ (void *) &messenger);
+ infos[1].type = B_OBJECT_TYPE_THREAD;
+ infos[1].events = B_EVENT_INVALID;
+ unblock_input_function ();
+
+ if (infos[1].object < B_OK)
+ return;
+
+ block_input_function ();
+ resume_thread (infos[1].object);
+ unblock_input_function ();
+
+ while (true)
+ {
+ block_input_function ();
+ stat = wait_for_objects ((struct object_wait_info *) &infos, 2);
+ unblock_input_function ();
+
+ if (stat == B_INTERRUPTED || stat == B_TIMED_OUT
+ || stat == B_WOULD_BLOCK)
+ continue;
+
+ if (stat < B_OK)
+ gui_abort ("Failed to wait for drag");
+
+ if (infos[0].events & B_EVENT_READ)
+ process_pending_signals_function ();
+
+ if (infos[1].events & B_EVENT_INVALID)
+ return;
+
+ infos[0].events = B_EVENT_READ;
+ infos[1].events = B_EVENT_INVALID;
+ }
+}
diff --git a/src/haiku_support.h b/src/haiku_support.h
index 78d51b83d8..af7216286a 100644
--- a/src/haiku_support.h
+++ b/src/haiku_support.h
@@ -945,6 +945,12 @@ extern "C"
extern void
BMessage_delete (void *message);
+ extern void
+ be_drag_message (void *view, void *message,
+ void (*block_input_function) (void),
+ void (*unblock_input_function) (void),
+ void (*process_pending_signals_function) (void));
+
#ifdef __cplusplus
extern void *
find_appropriate_view_for_draw (void *vw);
diff --git a/src/haikuselect.c b/src/haikuselect.c
index f291fa70ed..322e01f791 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "coding.h"
#include "haikuselect.h"
#include "haikuterm.h"
+#include "haiku_support.h"
#include <stdlib.h>
@@ -181,10 +182,10 @@ same as `SECONDARY'. */)
/* Return the Lisp representation of MESSAGE.
- It is an alist of strings, denoting message parameter names, to a
- list the form (TYPE . (DATA ...)), where TYPE is an integer
- denoting the system data type of DATA, and DATA is in the general
- case a unibyte string.
+ It is an alist of strings, denoting message field names, to a list
+ of the form (TYPE DATA ...), where TYPE is an integer denoting the
+ system data type of DATA, and DATA is in the general case a unibyte
+ string.
If TYPE is a symbol instead of an integer, then DATA was specially
decoded. If TYPE is `ref', then DATA is the absolute file name of
@@ -311,6 +312,220 @@ haiku_message_to_lisp (void *message)
return list;
}
+static int32
+lisp_to_type_code (Lisp_Object obj)
+{
+ if (BIGNUMP (obj))
+ return (int32) bignum_to_intmax (obj);
+
+ if (FIXNUMP (obj))
+ return XFIXNUM (obj);
+
+ if (EQ (obj, Qstring))
+ return 'CSTR';
+ else if (EQ (obj, Qshort))
+ return 'SHRT';
+ else if (EQ (obj, Qlong))
+ return 'LONG';
+ else if (EQ (obj, Qllong))
+ return 'LLNG';
+ else if (EQ (obj, Qbyte))
+ return 'BYTE';
+ else if (EQ (obj, Qref))
+ return 'RREF';
+ else if (EQ (obj, Qchar))
+ return 'CHAR';
+ else if (EQ (obj, Qbool))
+ return 'BOOL';
+ else
+ return -1;
+}
+
+static void
+haiku_lisp_to_message (Lisp_Object obj, void *message)
+{
+ Lisp_Object tem, t1, name, type_sym, t2, data;
+ int32 type_code, long_data;
+ int16 short_data;
+ int64 llong_data;
+ int8 char_data;
+ bool bool_data;
+ intmax_t t4;
+
+ CHECK_LIST (obj);
+ for (tem = obj; CONSP (tem); tem = XCDR (tem))
+ {
+ t1 = XCAR (tem);
+ CHECK_CONS (t1);
+
+ name = XCAR (t1);
+ CHECK_STRING (name);
+
+ t1 = XCDR (t1);
+ CHECK_CONS (t1);
+
+ type_sym = XCAR (t1);
+ type_code = lisp_to_type_code (type_sym);
+
+ if (type_code == -1)
+ signal_error ("Unknown data type", type_sym);
+
+ CHECK_LIST (t1);
+ for (t2 = XCDR (t1); CONSP (t2); t2 = XCDR (t2))
+ {
+ data = XCAR (t2);
+
+ switch (type_code)
+ {
+ case 'RREF':
+ signal_error ("Cannot deserialize data type", type_sym);
+ break;
+
+ case 'SHRT':
+ if (!TYPE_RANGED_FIXNUMP (int16, data))
+ signal_error ("Invalid value", data);
+ short_data = XFIXNUM (data);
+
+ block_input ();
+ be_add_message_data (message, SSDATA (name),
+ type_code, &short_data,
+ sizeof short_data);
+ unblock_input ();
+ break;
+
+ case 'LONG':
+ if (BIGNUMP (data))
+ {
+ t4 = bignum_to_intmax (data);
+
+ /* We know that int32 is signed. */
+ if (!t4 || t4 > TYPE_MINIMUM (int32)
+ || t4 < TYPE_MAXIMUM (int32))
+ signal_error ("Value too large", data);
+
+ long_data = (int32) t4;
+ }
+ else
+ {
+ if (!TYPE_RANGED_FIXNUMP (int32, data))
+ signal_error ("Invalid value", data);
+
+ long_data = (int32) XFIXNUM (data);
+ }
+
+ block_input ();
+ be_add_message_data (message, SSDATA (name),
+ type_code, &long_data,
+ sizeof long_data);
+ unblock_input ();
+ break;
+
+ case 'LLNG':
+ if (BIGNUMP (data))
+ {
+ t4 = bignum_to_intmax (data);
+
+ if (!t4 || t4 > TYPE_MINIMUM (int64)
+ || t4 < TYPE_MAXIMUM (int64))
+ signal_error ("Value too large", data);
+
+ llong_data = (int64) t4;
+ }
+ else
+ {
+ if (!TYPE_RANGED_FIXNUMP (int64, data))
+ signal_error ("Invalid value", data);
+
+ llong_data = (int64) XFIXNUM (data);
+ }
+
+ block_input ();
+ be_add_message_data (message, SSDATA (name),
+ type_code, &llong_data,
+ sizeof llong_data);
+ unblock_input ();
+ break;
+
+ case 'CHAR':
+ case 'BYTE':
+ if (!TYPE_RANGED_FIXNUMP (int8, data))
+ signal_error ("Invalid value", data);
+ char_data = XFIXNUM (data);
+
+ block_input ();
+ be_add_message_data (message, SSDATA (name),
+ type_code, &char_data,
+ sizeof char_data);
+ unblock_input ();
+ break;
+
+ case 'BOOL':
+ bool_data = !NILP (data);
+
+ block_input ();
+ be_add_message_data (message, SSDATA (name),
+ type_code, &bool_data,
+ sizeof bool_data);
+ unblock_input ();
+ break;
+
+ default:
+ CHECK_STRING (data);
+
+ block_input ();
+ be_add_message_data (message, SSDATA (name),
+ type_code, SDATA (data),
+ SBYTES (data));
+ unblock_input ();
+ }
+ }
+ CHECK_LIST_END (t2, t1);
+ }
+ CHECK_LIST_END (tem, obj);
+}
+
+DEFUN ("haiku-drag-message", Fhaiku_drag_message, Shaiku_drag_message,
+ 2, 2, 0,
+ doc: /* Begin dragging MESSAGE from FRAME.
+
+MESSAGE an alist of strings, denoting message field names, to a list
+the form (TYPE DATA ...), where TYPE is an integer denoting the system
+data type of DATA, and DATA is in the general case a unibyte string.
+
+If TYPE is a symbol instead of an integer, then DATA was specially
+decoded. If TYPE is `ref', then DATA is the absolute file name of a
+file, or nil if decoding the file name failed. If TYPE is `string',
+then DATA is a unibyte string. If TYPE is `short', then DATA is a
+16-bit signed integer. If TYPE is `long', then DATA is a 32-bit
+signed integer. If TYPE is `llong', then DATA is a 64-bit signed
+integer. If TYPE is `byte' or `char', then DATA is an 8-bit signed
+integer. If TYPE is `bool', then DATA is a boolean.
+
+FRAME is a window system frame that must be visible, from which the
+drag will originate. */)
+ (Lisp_Object frame, Lisp_Object message)
+{
+ specpdl_ref idx;
+ void *be_message;
+ struct frame *f;
+
+ idx = SPECPDL_INDEX ();
+ f = decode_window_system_frame (frame);
+
+ if (!FRAME_VISIBLE_P (f))
+ error ("Frame is invisible");
+
+ be_message = be_create_simple_message ();
+
+ record_unwind_protect_ptr (BMessage_delete, be_message);
+ haiku_lisp_to_message (message, be_message);
+ be_drag_message (FRAME_HAIKU_VIEW (f), be_message,
+ block_input, unblock_input,
+ process_pending_signals);
+
+ return unbind_to (idx, Qnil);
+}
+
void
syms_of_haikuselect (void)
{
@@ -333,4 +548,5 @@ syms_of_haikuselect (void)
defsubr (&Shaiku_selection_put);
defsubr (&Shaiku_selection_targets);
defsubr (&Shaiku_selection_owner_p);
+ defsubr (&Shaiku_drag_message);
}
diff --git a/src/haikuselect.h b/src/haikuselect.h
index 5b9abc7a8a..366890d1a4 100644
--- a/src/haikuselect.h
+++ b/src/haikuselect.h
@@ -87,6 +87,10 @@ extern "C"
ssize_t *size_return);
extern int be_get_refs_data (void *message, const char *name,
int32 index, char **path_buffer);
+ extern void *be_create_simple_message (void);
+ extern int be_add_message_data (void *message, const char *name,
+ int32 type_code, const void *buf,
+ ssize_t buf_size);
#ifdef __cplusplus
};
#endif