commit af90a4547167e9997ed2bd4a86b055c503c31462 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Thu Mar 17 08:56:42 2022 +0200 Fix compilation error of xterm.c * src/xterm.c (x_dnd_begin_drag_and_drop): Use current_count only if defined. Reported by Tassilo Horn . diff --git a/src/xterm.c b/src/xterm.c index 543046ca00..1b0b3ef793 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1119,7 +1119,9 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (return_frame_p) x_dnd_return_frame = 1; +#ifdef USE_GTK current_count = 0; +#endif while (x_dnd_in_progress) { commit 9916b49e4197d3aa23b3a5e6a383ae40f65b8222 Author: Po Lu Date: Thu Mar 17 05:31:03 2022 +0000 Prevent delivery of duplicate events when window is grabbed on Haiku * src/haiku_support.cc (grab_view, grab_view_locker): New variables. (MouseMoved, MouseDown, MouseUp): Keep track of the grab and don't deliver motion events to any other view. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 626b2fb607..f8acd2a4ec 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -118,6 +118,9 @@ static BLocker movement_locker; static BMessage volatile *popup_track_message; static int32 volatile alert_popup_value; +static void *grab_view = NULL; +static BLocker grab_view_locker; + /* This could be a private API, but it's used by (at least) the Qt port, so it's probably here to stay. */ extern status_t get_subpixel_antialiasing (bool *); @@ -1193,6 +1196,12 @@ class EmacsView : public BView gui_abort ("Wait for release message still exists"); TearDownDoubleBuffering (); + + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (grab_view == this) + grab_view = NULL; + grab_view_locker.Unlock (); } void @@ -1447,6 +1456,17 @@ class EmacsView : public BView ToolTip ()->SetMouseRelativeLocation (BPoint (-(point.x - tt_absl_pos.x), -(point.y - tt_absl_pos.y))); + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + + if (this != grab_view) + { + grab_view_locker.Unlock (); + return; + } + + grab_view_locker.Unlock (); + if (movement_locker.Lock ()) { haiku_write (MOUSE_MOTION, &rq); @@ -1462,6 +1482,12 @@ class EmacsView : public BView this->GetMouse (&point, &buttons, false); + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (buttons) + grab_view = this; + grab_view_locker.Unlock (); + rq.window = this->Window (); if (!(previous_buttons & B_PRIMARY_MOUSE_BUTTON) @@ -1496,7 +1522,8 @@ class EmacsView : public BView if (mods & B_OPTION_KEY) rq.modifiers |= HAIKU_MODIFIER_SUPER; - SetMouseEventMask (B_POINTER_EVENTS, B_LOCK_WINDOW_FOCUS); + SetMouseEventMask (B_POINTER_EVENTS, (B_LOCK_WINDOW_FOCUS + | B_NO_POINTER_HISTORY)); rq.time = system_time (); haiku_write (BUTTON_DOWN, &rq); @@ -1510,6 +1537,12 @@ class EmacsView : public BView this->GetMouse (&point, &buttons, false); + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (!buttons) + grab_view = NULL; + grab_view_locker.Unlock (); + if (!buttons && wait_for_release_message) { wait_for_release_message->SendReply (wait_for_release_message); commit f4a71e17f49da40ec625ad4771362d96712aff61 Author: Po Lu Date: Thu Mar 17 12:53:36 2022 +0800 * src/xterm.c (x_dnd_begin_drag_and_drop): Always initialize hold_quit. diff --git a/src/xterm.c b/src/xterm.c index 59c3cefd59..543046ca00 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1123,8 +1123,8 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, while (x_dnd_in_progress) { -#ifdef USE_GTK hold_quit.kind = NO_EVENT; +#ifdef USE_GTK current_finish = X_EVENT_NORMAL; current_hold_quit = &hold_quit; #endif commit a06ac9b6fdc0e6edc326c74240be1f7ba4e6471e Author: Po Lu Date: Thu Mar 17 11:59:56 2022 +0800 Restore old PGTK scrolling code * src/pgtkterm.c (pgtk_copy_bits): Restore old code using cairo_surface_create_similar. (bug#54040) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 9f9768cf2a..e00ed7fa85 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -2940,20 +2940,13 @@ pgtk_copy_bits (struct frame *f, cairo_rectangle_t *src_rect, cairo_rectangle_t *dst_rect) { cairo_t *cr; - GdkWindow *window; cairo_surface_t *surface; /* temporary surface */ - int scale; - - window = gtk_widget_get_window (FRAME_GTK_WIDGET (f)); surface = - gdk_window_create_similar_surface (window, CAIRO_CONTENT_COLOR_ALPHA, - FRAME_CR_SURFACE_DESIRED_WIDTH (f), - FRAME_CR_SURFACE_DESIRED_HEIGHT - (f)); - - scale = gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); - cairo_surface_set_device_scale (surface, scale, scale); + cairo_surface_create_similar (FRAME_CR_SURFACE (f), + CAIRO_CONTENT_COLOR_ALPHA, + (int) src_rect->width, + (int) src_rect->height); cr = cairo_create (surface); cairo_set_source_surface (cr, FRAME_CR_SURFACE (f), -src_rect->x, commit 667775e1ae259dc2fe0dee96ebb506beeef4d5ce Author: Po Lu Date: Thu Mar 17 11:51:32 2022 +0800 Make GTK inspector available on PGTK * src/pgtkfns.c (Fx_gtk_debug): New function. (syms_of_pgtkfns): Define new subr. diff --git a/src/pgtkfns.c b/src/pgtkfns.c index dd2e305965..38e6085843 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -3872,6 +3872,21 @@ nil, it defaults to the selected frame. */) return unbind_to (count, font); } +#if GTK_CHECK_VERSION (3, 14, 0) +DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, + doc: /* Toggle interactive GTK debugging. */) + (Lisp_Object enable) +{ + gboolean enable_debug = !NILP (enable); + + block_input (); + gtk_window_set_interactive_debugging (enable_debug); + unblock_input (); + + return NILP (enable) ? Qnil : Qt; +} +#endif /* GTK_CHECK_VERSION (3, 14, 0) */ + /* ========================================================================== Lisp interface declaration @@ -3971,6 +3986,10 @@ be used as the image of the icon representing the frame. */); defsubr (&Sx_close_connection); defsubr (&Sx_display_list); +#if GTK_CHECK_VERSION (3, 14, 0) + defsubr (&Sx_gtk_debug); +#endif + defsubr (&Spgtk_hide_others); defsubr (&Spgtk_hide_emacs); commit bbfad0a7880c4202a90001cd76ad7844a12b9273 Author: Po Lu Date: Thu Mar 17 11:49:23 2022 +0800 ; * lisp/term/haiku-win.el (x-begin-drag): Fix compiler warning. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 9fa50d62e8..83f70edd2c 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -183,7 +183,7 @@ 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) +(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")) commit dfdd2f6f2380c785d34f5eb2df0b356d33d0dae1 Author: Po Lu Date: Thu Mar 17 03:46:18 2022 +0000 * lisp/term/haiku-win.el (x-begin-drag): Fix type code of B_MIME_TYPE. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index b7f1991381..9fa50d62e8 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -200,7 +200,7 @@ take effect on menu items until the menu bar is updated again." (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 + (push 1296649541 (alist-get (car selection-result) message nil nil #'equal)))) (push (cadr selection-result) (cdr (alist-get (car selection-result) message commit 00172ae0c8a3087578f6e91251f887f6b7b4f682 Author: Po Lu Date: Thu Mar 17 03:42:19 2022 +0000 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. 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 . */ #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 @@ class EmacsView : public BView #endif BPoint tt_absl_pos; + BMessage *wait_for_release_message = NULL; color_space cspace; @@ -1187,6 +1189,9 @@ class EmacsView : public BView ~EmacsView () { + if (wait_for_release_message) + gui_abort ("Wait for release message still exists"); + TearDownDoubleBuffering (); } @@ -1196,6 +1201,28 @@ class EmacsView : public BView 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 @@ class EmacsView : public BView 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 . */ #include "coding.h" #include "haikuselect.h" #include "haikuterm.h" +#include "haiku_support.h" #include @@ -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 commit c223e2aefcabc7ad29c4be186fc07825bbcce196 Author: Po Lu Date: Thu Mar 17 08:54:30 2022 +0800 Improve GTK support for X11 drag-n-drop * src/xterm.c (x_dnd_begin_drag_and_drop): Run nested GTK event loop instead, so GTK gets the correct events. diff --git a/src/xterm.c b/src/xterm.c index 46a22d8dc1..59c3cefd59 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -702,6 +702,19 @@ static Lisp_Object xg_default_icon_file; static char emacs_class[] = EMACS_CLASS; #endif +#ifdef USE_GTK +static int current_count; +static int current_finish; +static struct input_event *current_hold_quit; +#endif + +enum +{ + X_EVENT_NORMAL, + X_EVENT_GOTO_OUT, + X_EVENT_DROP +}; + enum xembed_info { XEMBED_MAPPED = 1 << 0 @@ -1072,9 +1085,11 @@ Lisp_Object x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, bool return_frame_p) { +#ifndef USE_GTK XEvent next_event; - struct input_event hold_quit; int finish; +#endif + struct input_event hold_quit; char *atom_name; Lisp_Object action, ltimestamp; @@ -1104,15 +1119,25 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (return_frame_p) x_dnd_return_frame = 1; + current_count = 0; + while (x_dnd_in_progress) { +#ifdef USE_GTK hold_quit.kind = NO_EVENT; + current_finish = X_EVENT_NORMAL; + current_hold_quit = &hold_quit; +#endif block_input (); +#ifndef USE_GTK XNextEvent (FRAME_X_DISPLAY (f), &next_event); handle_one_xevent (FRAME_DISPLAY_INFO (f), &next_event, &finish, &hold_quit); +#else + gtk_main_iteration (); +#endif unblock_input (); if (hold_quit.kind != NO_EVENT) @@ -1130,10 +1155,17 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, } FRAME_DISPLAY_INFO (f)->grabbed = 0; +#ifdef USE_GTK + current_hold_quit = NULL; +#endif quit (); } } +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + if (x_dnd_return_frame == 3) { x_dnd_return_frame_object->mouse_moved = true; @@ -10125,13 +10157,6 @@ static struct x_display_info *XTread_socket_fake_io_error; static struct x_display_info *next_noop_dpyinfo; -enum -{ - X_EVENT_NORMAL, - X_EVENT_GOTO_OUT, - X_EVENT_DROP -}; - /* Filter events for the current X input method. DPYINFO is the display this event is for. EVENT is the X event to filter. @@ -10207,10 +10232,6 @@ x_filter_event (struct x_display_info *dpyinfo, XEvent *event) #endif #ifdef USE_GTK -static int current_count; -static int current_finish; -static struct input_event *current_hold_quit; - /* This is the filter function invoked by the GTK event loop. It is invoked before the XEvent is translated to a GdkEvent, so we have a chance to act on the event before GTK. */ commit f7e0e5b7aeb928353065a3667c5231c4e4559d28 Author: Paul Eggert Date: Wed Mar 16 17:21:55 2022 -0700 Simplify generate-new-buffer-name randomness * src/buffer.c (Fgenerate_new_buffer_name): Simplify by calling get_random instead of Frandom; that’s random enough here. diff --git a/src/buffer.c b/src/buffer.c index 91ff6b946f..f8a7a4f510 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1159,11 +1159,9 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) else { char number[sizeof "-999999"]; - - /* Use XFIXNUM instead of XFIXNAT to work around GCC bug 80776. */ - int i = XFIXNUM (Frandom (make_fixnum (1000000))); - eassume (0 <= i && i < 1000000); - + EMACS_INT r = get_random (); + eassume (0 <= r); + int i = r % 1000000; AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i)); genbase = concat2 (name, lnumber); if (NILP (Fget_buffer (genbase))) commit 2ef037c0dd3510a51ad73fdead1ded09848166f4 Author: Paul Eggert Date: Wed Mar 16 17:21:55 2022 -0700 Improve random bignum generation * src/bignum.c (get_random_limb, get_random_limb_lim) (get_random_bignum): New functions, for more-efficient generation of random bignums without using Frem etc. * src/fns.c (get_random_fixnum): New function. (Frandom): Use it, and get_random_bignum. Be consistent about signalling nonpositive integer arguments; since zero is invalid, Qnatnump is not quite right here. * src/sysdep.c (get_random_ulong): New function. diff --git a/src/bignum.c b/src/bignum.c index cb5322f291..e4e4d45d68 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -476,3 +476,96 @@ check_int_nonnegative (Lisp_Object x) CHECK_INTEGER (x); return NILP (Fnatnump (x)) ? 0 : check_integer_range (x, 0, INT_MAX); } + +/* Return a random mp_limb_t. */ + +static mp_limb_t +get_random_limb (void) +{ + if (GMP_NUMB_BITS <= ULONG_WIDTH) + return get_random_ulong (); + + /* Work around GCC -Wshift-count-overflow false alarm. */ + int shift = GMP_NUMB_BITS <= ULONG_WIDTH ? 0 : ULONG_WIDTH; + + /* This is in case someone builds GMP with unusual definitions for + MINI_GMP_LIMB_TYPE or _LONG_LONG_LIMB. */ + mp_limb_t r = 0; + for (int i = 0; i < GMP_NUMB_BITS; i += ULONG_WIDTH) + r = (r << shift) | get_random_ulong (); + return r; +} + +/* Return a random mp_limb_t I in the range 0 <= I < LIM. + If LIM is zero, simply return a random mp_limb_t. */ + +static mp_limb_t +get_random_limb_lim (mp_limb_t lim) +{ + /* Return the remainder of a random mp_limb_t R divided by LIM, + except reject the rare case where R is so close to the maximum + mp_limb_t that the remainder isn't random. */ + mp_limb_t difflim = - lim, diff, remainder; + do + { + mp_limb_t r = get_random_limb (); + if (lim == 0) + return r; + remainder = r % lim; + diff = r - remainder; + } + while (difflim < diff); + + return remainder; +} + +/* Return a random Lisp integer I in the range 0 <= I < LIMIT, + where LIMIT is a positive bignum. */ + +Lisp_Object +get_random_bignum (struct Lisp_Bignum const *limit) +{ + mpz_t const *lim = bignum_val (limit); + mp_size_t nlimbs = mpz_size (*lim); + eassume (0 < nlimbs); + mp_limb_t *r_limb = mpz_limbs_write (mpz[0], nlimbs); + mp_limb_t const *lim_limb = mpz_limbs_read (*lim); + mp_limb_t limhi = lim_limb[nlimbs - 1]; + eassert (limhi); + bool edgy; + + do + { + /* Generate the result one limb at a time, most significant first. + Choose the most significant limb RHI randomly from 0..LIMHI, + where LIMHI is the LIM's first limb, except choose from + 0..(LIMHI-1) if there is just one limb. RHI == LIMHI is an + unlucky edge case as later limbs might cause the result to be + exceed or equal LIM; if this happens, it causes another + iteration in the outer loop. */ + + mp_limb_t rhi = get_random_limb_lim (limhi + (1 < nlimbs)); + edgy = rhi == limhi; + r_limb[nlimbs - 1] = rhi; + + for (mp_size_t i = nlimbs - 1; 0 < i--; ) + { + /* get_random_limb_lim (edgy ? limb_lim[i] + 1 : 0) + would be wrong here, as the full mp_limb_t range is + needed in later limbs for the edge case to have the + proper weighting. */ + mp_limb_t ri = get_random_limb (); + if (edgy) + { + if (lim_limb[i] < ri) + break; + edgy = lim_limb[i] == ri; + } + r_limb[i] = ri; + } + } + while (edgy); + + mpz_limbs_finish (mpz[0], nlimbs); + return make_integer_mpz (); +} diff --git a/src/bignum.h b/src/bignum.h index 5f94ce850c..de9ee17c02 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -51,6 +51,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT) extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long) ARG_NONNULL ((1, 2)); extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST; +extern Lisp_Object get_random_bignum (struct Lisp_Bignum const *); INLINE_HEADER_BEGIN diff --git a/src/fns.c b/src/fns.c index e8cf185755..6e89fe3ca5 100644 --- a/src/fns.c +++ b/src/fns.c @@ -55,41 +55,24 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, return argument; } +/* Return a random Lisp fixnum I in the range 0 <= I < LIM, + where LIM is taken from a positive fixnum. */ static Lisp_Object -get_random_bignum (Lisp_Object limit) +get_random_fixnum (EMACS_INT lim) { - /* This is a naive transcription into bignums of the fixnum algorithm. - I'd be quite surprised if that's anywhere near the best algorithm - for it. */ - while (true) + /* Return the remainder of a random integer R (in range 0..INTMASK) + divided by LIM, except reject the rare case where R is so close + to INTMASK that the remainder isn't random. */ + EMACS_INT difflim = INTMASK - lim + 1, diff, remainder; + do { - Lisp_Object val = make_fixnum (0); - Lisp_Object lim = limit; - int bits = 0; - int bitsperiteration = FIXNUM_BITS - 1; - do - { - /* Shift by one so it is a valid positive fixnum. */ - EMACS_INT rand = get_random () >> 1; - Lisp_Object lrand = make_fixnum (rand); - bits += bitsperiteration; - val = CALLN (Flogior, - Fash (val, make_fixnum (bitsperiteration)), - lrand); - lim = Fash (lim, make_fixnum (- bitsperiteration)); - } - while (!EQ (lim, make_fixnum (0))); - /* Return the remainder, except reject the rare case where - get_random returns a number so close to INTMASK that the - remainder isn't random. */ - Lisp_Object remainder = Frem (val, limit); - if (!NILP (CALLN (Fleq, - CALLN (Fminus, val, remainder), - CALLN (Fminus, - Fash (make_fixnum (1), make_fixnum (bits)), - limit)))) - return remainder; + EMACS_INT r = get_random (); + remainder = r % lim; + diff = r - remainder; } + while (difflim < diff); + + return make_fixnum (remainder); } DEFUN ("random", Frandom, Srandom, 0, 1, 0, @@ -103,32 +86,26 @@ With a string argument, set the seed based on the string's contents. See Info node `(elisp)Random Numbers' for more details. */) (Lisp_Object limit) { - EMACS_INT val; - if (EQ (limit, Qt)) init_random (); else if (STRINGP (limit)) seed_random (SSDATA (limit), SBYTES (limit)); - if (BIGNUMP (limit)) + else if (FIXNUMP (limit)) + { + EMACS_INT lim = XFIXNUM (limit); + if (lim <= 0) + xsignal1 (Qargs_out_of_range, limit); + return get_random_fixnum (lim); + } + else if (BIGNUMP (limit)) { - if (0 > mpz_sgn (*xbignum_val (limit))) - xsignal2 (Qwrong_type_argument, Qnatnump, limit); - return get_random_bignum (limit); + struct Lisp_Bignum *lim = XBIGNUM (limit); + if (mpz_sgn (*bignum_val (lim)) <= 0) + xsignal1 (Qargs_out_of_range, limit); + return get_random_bignum (lim); } - val = get_random (); - if (FIXNUMP (limit) && 0 < XFIXNUM (limit)) - while (true) - { - /* Return the remainder, except reject the rare case where - get_random returns a number so close to INTMASK that the - remainder isn't random. */ - EMACS_INT remainder = val % XFIXNUM (limit); - if (val - remainder <= INTMASK - XFIXNUM (limit) + 1) - return make_fixnum (remainder); - val = get_random (); - } - return make_ufixnum (val); + return make_ufixnum (get_random ()); } /* Random data-structure functions. */ diff --git a/src/lisp.h b/src/lisp.h index 8053bbc977..c90f901ebc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4926,6 +4926,7 @@ extern void child_setup_tty (int); extern void setup_pty (int); extern int set_window_size (int, int, int); extern EMACS_INT get_random (void); +extern unsigned long int get_random_ulong (void); extern void seed_random (void *, ptrdiff_t); extern void init_random (void); extern void emacs_backtrace (int); diff --git a/src/sysdep.c b/src/sysdep.c index b5b18ee6c0..1632f46d13 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2200,6 +2200,16 @@ get_random (void) return val & INTMASK; } +/* Return a random unsigned long. */ +unsigned long int +get_random_ulong (void) +{ + unsigned long int r = 0; + for (int i = 0; i < (ULONG_WIDTH + RAND_BITS - 1) / RAND_BITS; i++) + r = random () ^ (r << RAND_BITS) ^ (r >> (ULONG_WIDTH - RAND_BITS)); + return r; +} + #ifndef HAVE_SNPRINTF /* Approximate snprintf as best we can on ancient hosts that lack it. */ int commit 31a2428d6f2ca792af18b43ceca5cec1ecce862f Author: Alan Mackenzie Date: Wed Mar 16 19:23:24 2022 +0000 Strip positions from symbols before the eval in eval-{when,and}-compile. This fixes bug #54079. * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Change the position of 'byte-run-strip-symbol-positions' in the eval-when-compile entry. Add a call to `byte-run-strip-symbol-positions' in the eval-and-compile entry. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 9be44a8d5a..c680437f32 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -500,8 +500,9 @@ Return the compile-time value of FORM." byte-compile-new-defuns)) (setf result (byte-compile-eval + (byte-run-strip-symbol-positions (byte-compile-top-level - (byte-compile-preprocess form))))))) + (byte-compile-preprocess form)))))))) (list 'quote result)))) (eval-and-compile . ,(lambda (&rest body) (byte-compile-recurse-toplevel @@ -512,9 +513,10 @@ Return the compile-time value of FORM." ;; or byte-compile-file-form. (let* ((print-symbols-bare t) ; Possibly redundant binding. (expanded - (macroexpand--all-toplevel - form - macroexpand-all-environment))) + (byte-run-strip-symbol-positions + (macroexpand--all-toplevel + form + macroexpand-all-environment)))) (eval expanded lexical-binding) expanded))))) (with-suppressed-warnings commit 0e5f8e24af525a1f9a441305b1c7d24c4fcf9cda Author: Robert Pluim Date: Mon Mar 7 11:26:25 2022 +0100 Report buffer-name when local mode-line is invalid * lisp/files.el (hack-local-variables-prop-line): Add '(buffer-name)' to the message reporting the malformed mode-line. diff --git a/lisp/files.el b/lisp/files.el index eca8cba93f..a0bc5bf262 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3741,8 +3741,8 @@ return as the symbol specifying the mode." (while (not (or (and (eq handle-mode t) result) (>= (point) end))) (unless (looking-at hack-local-variable-regexp) - (message "Malformed mode-line: %S" - (buffer-substring-no-properties (point) end)) + (message "Malformed mode-line: %S in buffer %S" + (buffer-substring-no-properties (point) end) (buffer-name)) (throw 'malformed-line nil)) (goto-char (match-end 0)) ;; There used to be a downcase here, commit a86205b060b01ab000e439091ed40c8ca8b68b73 Author: Robert Pluim Date: Sat Feb 26 11:46:32 2022 +0100 Guard against custom entries that can contain NULs There are custom entries that contain lambda's as values by default, which can result in them containing embedded NULs after byte-compilation, which wreaks havoc when they are saved to .emacs and later read in. (Bug#52554) * lisp/cus-edit.el (custom-save-all): Bind print-escape-control-characters to t. * lisp/startup.el (startup--load-user-init-file): Bind inhibit-null-byte-detection to t. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 7932031397..dae97b0230 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4798,7 +4798,11 @@ if only the first line of the docstring is shown.")) (delay-mode-hooks (emacs-lisp-mode))) (let ((inhibit-read-only t) (print-length nil) - (print-level nil)) + (print-level nil) + ;; We might be saving byte-code with embedded NULs, which + ;; can cause problems when read back, so print them + ;; readably. (Bug#52554) + (print-escape-control-characters t)) (atomic-change-group (custom-save-variables) (custom-save-faces))) diff --git a/lisp/startup.el b/lisp/startup.el index 9f0b23c904..ab7b81a707 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1044,7 +1044,11 @@ init-file, or to a default value if loading is not possible." (debug-on-error-initial (if (eq init-file-debug t) 'startup - init-file-debug))) + init-file-debug)) + ;; The init file might contain byte-code with embedded NULs, + ;; which can cause problems when read back, so disable nul + ;; byte detection. (Bug#52554) + (inhibit-null-byte-detection t)) (let ((debug-on-error debug-on-error-initial)) (condition-case-unless-debug error (when init-file-user commit fa8c93ad9a6ccd210324951d999adab3766bdf63 Author: Robert Pluim Date: Wed Feb 9 10:01:36 2022 +0100 Improve error message for 'not running' processes The current error message is simply 'not running', but 'status_message' can give information about why the process is in that state, such as network errors, so return that as well. (Bug#53762) * src/process.c (send_process, Fprocess_send_eof): Add the output of 'status_message' to the error string. diff --git a/src/process.c b/src/process.c index 94cc880097..993e1c5603 100644 --- a/src/process.c +++ b/src/process.c @@ -6420,7 +6420,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, if (p->raw_status_new) update_status (p); if (! EQ (p->status, Qrun)) - error ("Process %s not running", SDATA (p->name)); + error ("Process %s not running: %s", SDATA (p->name), SDATA (status_message (p))); if (p->outfd < 0) error ("Output file descriptor of %s is closed", SDATA (p->name)); @@ -7125,7 +7125,7 @@ process has been transmitted to the serial port. */) if (XPROCESS (proc)->raw_status_new) update_status (XPROCESS (proc)); if (! EQ (XPROCESS (proc)->status, Qrun)) - error ("Process %s not running", SDATA (XPROCESS (proc)->name)); + error ("Process %s not running: %s", SDATA (XPROCESS (proc)->name), SDATA (status_message (XPROCESS (proc)))); if (coding && CODING_REQUIRE_FLUSHING (coding)) { commit 6b2e6a53ecdc78411a167a1ea5718dcddaf9411c Author: Manuel Giraud Date: Wed Mar 16 17:38:18 2022 +0100 * lisp/net/tramp-sh.el (tramp-find-file-exists-command): Fix comment. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c80190a67f..475d48cc30 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4134,13 +4134,10 @@ file exists and nonzero exit status otherwise." ;; The algorithm is as follows: we try a list of several commands. ;; For each command, we first run `$cmd /' -- this should return ;; true, as the root directory always exists. And then we run - ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed - ;; does not exist. This should return false. We use the first - ;; command we find that seems to work. + ;; `$cmd /\ this\ file\ does\ not\ exist\ ', hoping that the file + ;; indeed does not exist. This should return false. We use the + ;; first command we find that seems to work. ;; The list of commands to try is as follows: - ;; `ls -d' This works on most systems, but NetBSD 1.4 - ;; has a bug: `ls' always returns zero exit - ;; status, even for files which don't exist. ;; `test -e' Some Bourne shells have a `test' builtin ;; which does not know the `-e' option. ;; `/bin/test -e' For those, the `test' binary on disk normally @@ -4148,6 +4145,10 @@ file exists and nonzero exit status otherwise." ;; is sometimes `/bin/test' and sometimes it's ;; `/usr/bin/test'. ;; `/usr/bin/test -e' In case `/bin/test' does not exist. + ;; `ls -d' This works on most systems, but NetBSD 1.4 + ;; has a bug: `ls' always returns zero exit + ;; status, even for files which don't exist. + (unless (or (ignore-errors (and (setq result (format "%s -e" (tramp-get-test-command vec))) commit 679b9cc9ff3c65b4b6d3da2987703e0dfd3001be Author: Robert Pluim Date: Wed Mar 16 15:24:35 2022 +0100 Link with libdl when using pgtk * configure.ac: Define LIBMODULES on GNU/Linux when using pgtk, even when not using modules, since pgtkterm.c uses dlsym. (Bug#54378) diff --git a/configure.ac b/configure.ac index a315eeb6bd..bc17935eb1 100644 --- a/configure.ac +++ b/configure.ac @@ -3940,6 +3940,16 @@ case "${opsys}" in darwin) MODULES_SECONDARY_SUFFIX='.so' ;; *) MODULES_SECONDARY_SUFFIX='' ;; esac + +# pgtkterm.c uses dlsym +if test $window_system = pgtk; then + case $opsys in + gnu|gnu-linux) + LIBMODULES="-ldl" + ;; + esac +fi + if test "${with_modules}" != "no"; then case $opsys in gnu|gnu-linux) commit d5e8f483f90395e8eda7a2c5c23765af2602caf1 Author: Po Lu Date: Wed Mar 16 21:47:37 2022 +0800 * doc/lispref/frames.texi (x-begin-drag): Improve wording. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 24b439e049..97283a525c 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4044,10 +4044,10 @@ from its frames to windows of other applications. @defun x-begin-drag targets action &optional frame return-frame This function begins a drag from @var{frame}, and returns when the -session ends, either because the drop was successful, or because the -drop was rejected. The drop occurs when all mouse buttons are -released on top of an X window other than @var{frame} (the @dfn{drop -target}). +drag-and-drop operation ends, either because the drop was successful, +or because the drop was rejected. The drop occurs when all mouse +buttons are released on top of an X window other than @var{frame} (the +@dfn{drop target}). @var{targets} is a list of strings describing selection targets, much like the @var{data-type} argument to @code{gui-get-selection}, that commit 549d0a441371f8e91ccf54037d24a1b6b5ae1ed9 Author: Po Lu Date: Wed Mar 16 13:43:37 2022 +0000 Fix 32-bit Haiku build * src/haikuselect.h (be_enum_message): Fix declaration for 32-bit types. diff --git a/src/haikuselect.h b/src/haikuselect.h index 14b779c36d..5b9abc7a8a 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -79,7 +79,7 @@ extern "C" /* Free the returned data. */ extern void BClipboard_free_data (void *ptr); - extern int be_enum_message (void *message, int32 *tc, int index, + extern int be_enum_message (void *message, int32 *tc, int32 index, int32 *count, const char **name_return); extern int be_get_message_data (void *message, const char *name, int32 type_code, int32 index, commit 79f3d9c8f317113b03de094f7989352724621154 Author: Po Lu Date: Wed Mar 16 13:24:18 2022 +0000 Add support for dropping plain text on Haiku * haiku-win.el (haiku-dnd-handle-drag-n-drop-event): Handle `text/plain'. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 322f1a18de..3b3f2f0874 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -137,7 +137,16 @@ If TYPE is nil, return \"text/plain\"." (dolist (filename (cddr (assoc "refs" string))) (dnd-handle-one-url window 'private (concat "file:" filename))))) - (t (message "Don't know how to drop: %s" event))))) + ((assoc "text/plain" string) + (with-selected-window window + (raise-frame) + (dolist (text (cddr (assoc "text/plain" string))) + (goto-char (posn-point (event-start event))) + (dnd-insert-text window 'private + (if (multibyte-string-p text) + text + (decode-coding-string text 'undecided)))))) + (t (message "Don't know how to drop any of: %s" (mapcar #'car string)))))) (define-key special-event-map [drag-n-drop] 'haiku-dnd-handle-drag-n-drop-event) commit 3de3f12b9402c731aca1a583a15fc6245efea136 Author: Po Lu Date: Wed Mar 16 13:18:12 2022 +0000 Redo Haiku DND support * lisp/term/haiku-win.el (haiku-dnd-handle-drag-n-drop-event): Update for new DND event format. * src/haiku_io.c (haiku_len): Handle DRAG_AND_DROP_EVENTs. * src/haiku_select.cc (be_enum_message, be_get_refs_data) (be_get_message_data): New function. * src/haiku_support.cc (class Emacs): Remove `RefsReceived'. (MessageReceived): Generate new kind of drag-n-drop events. * src/haiku_support.h (enum haiku_event_type): Rename `REFS_EVENT' to `DRAG_AND_DROP_EVENT'. (struct haiku_refs_event): Delete struct. (struct haiku_drag_and_drop_event): New struct. * src/haikuselect.c (haiku_message_to_lisp): New function. (syms_of_haikuselect): New symbols. * src/haikuselect.h: Update prototypes. * src/haikuterm.c (haiku_read_socket): Handle new type of drag-and-drop events by serializing drop message to Lisp and letting Lisp code do the processing. * src/haikuterm.h: Update prototypes. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index c4810f116d..322f1a18de 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -130,9 +130,14 @@ If TYPE is nil, return \"text/plain\"." (interactive "e") (let* ((string (caddr event)) (window (posn-window (event-start event)))) - (with-selected-window window - (raise-frame) - (dnd-handle-one-url window 'private (concat "file:" string))))) + (cond + ((assoc "refs" string) + (with-selected-window window + (raise-frame) + (dolist (filename (cddr (assoc "refs" string))) + (dnd-handle-one-url window 'private + (concat "file:" filename))))) + (t (message "Don't know how to drop: %s" event))))) (define-key special-event-map [drag-n-drop] 'haiku-dnd-handle-drag-n-drop-event) diff --git a/src/haiku_io.c b/src/haiku_io.c index f9fa4095f9..89f0877eb6 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -90,8 +90,8 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_menu_bar_help_event); case ZOOM_EVENT: return sizeof (struct haiku_zoom_event); - case REFS_EVENT: - return sizeof (struct haiku_refs_event); + case DRAG_AND_DROP_EVENT: + return sizeof (struct haiku_drag_and_drop_event); case APP_QUIT_REQUESTED_EVENT: return sizeof (struct haiku_app_quit_requested_event); case DUMMY_EVENT: diff --git a/src/haiku_select.cc b/src/haiku_select.cc index 011ad58036..abb07b2002 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -19,6 +19,9 @@ along with GNU Emacs. If not, see . */ #include #include +#include +#include +#include #include #include @@ -257,3 +260,64 @@ init_haiku_select (void) primary = new BClipboard ("primary"); secondary = new BClipboard ("secondary"); } + +int +be_enum_message (void *message, int32 *tc, int32 index, + int32 *count, const char **name_return) +{ + BMessage *msg = (BMessage *) message; + type_code type; + char *name; + status_t rc; + + rc = msg->GetInfo (B_ANY_TYPE, index, &name, &type, count); + + if (rc != B_OK) + return 1; + + *tc = type; + *name_return = name; + return 0; +} + +int +be_get_refs_data (void *message, const char *name, + int32 index, char **path_buffer) +{ + status_t rc; + BEntry entry; + BPath path; + entry_ref ref; + BMessage *msg; + + msg = (BMessage *) message; + rc = msg->FindRef (name, index, &ref); + + if (rc != B_OK) + return 1; + + rc = entry.SetTo (&ref, 0); + + if (rc != B_OK) + return 1; + + rc = entry.GetPath (&path); + + if (rc != B_OK) + return 1; + + *path_buffer = strdup (path.Path ()); + return 0; +} + +int +be_get_message_data (void *message, const char *name, + int32 type_code, int32 index, + const void **buf_return, + ssize_t *size_return) +{ + BMessage *msg = (BMessage *) message; + + return msg->FindData (name, type_code, + index, buf_return, size_return) != B_OK; +} diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 4bd801242a..884e3583e2 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -381,37 +381,6 @@ class Emacs : public BApplication haiku_write (APP_QUIT_REQUESTED_EVENT, &rq); return 0; } - - void - RefsReceived (BMessage *msg) - { - struct haiku_refs_event rq; - entry_ref ref; - BEntry entry; - BPath path; - int32 cookie = 0; - int32 x, y; - void *window; - - if ((msg->FindPointer ("window", 0, &window) != B_OK) - || (msg->FindInt32 ("x", 0, &x) != B_OK) - || (msg->FindInt32 ("y", 0, &y) != B_OK)) - return; - - rq.window = window; - rq.x = x; - rq.y = y; - - while (msg->FindRef ("refs", cookie++, &ref) == B_OK) - { - if (entry.SetTo (&ref, 0) == B_OK - && entry.GetPath (&path) == B_OK) - { - rq.ref = strdup (path.Path ()); - haiku_write (REFS_EVENT, &rq); - } - } - } }; class EmacsWindow : public BWindow @@ -665,21 +634,19 @@ class EmacsWindow : public BWindow if (msg->WasDropped ()) { - entry_ref ref; BPoint whereto; + struct haiku_drag_and_drop_event rq; - if (msg->FindRef ("refs", &ref) == B_OK) + if (msg->FindPoint ("_drop_point_", &whereto) == B_OK) { - msg->what = B_REFS_RECEIVED; - msg->AddPointer ("window", this); - if (msg->FindPoint ("_drop_point_", &whereto) == B_OK) - { - this->ConvertFromScreen (&whereto); - msg->AddInt32 ("x", whereto.x); - msg->AddInt32 ("y", whereto.y); - } - be_app->PostMessage (msg); - msg->SendReply (B_OK); + this->ConvertFromScreen (&whereto); + + rq.window = this; + rq.message = DetachCurrentMessage ();; + rq.x = whereto.x; + rq.y = whereto.y; + + haiku_write (DRAG_AND_DROP_EVENT, &rq); } } else if (msg->GetPointer ("menuptr")) @@ -3897,3 +3864,9 @@ EmacsWindow_signal_menu_update_complete (void *window) pthread_cond_signal (&w->menu_update_cv); pthread_mutex_unlock (&w->menu_update_mutex); } + +void +BMessage_delete (void *message) +{ + delete (BMessage *) message; +} diff --git a/src/haiku_support.h b/src/haiku_support.h index 41bd1e1c84..78d51b83d8 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -86,7 +86,7 @@ enum haiku_event_type FILE_PANEL_EVENT, MENU_BAR_HELP_EVENT, ZOOM_EVENT, - REFS_EVENT, + DRAG_AND_DROP_EVENT, APP_QUIT_REQUESTED_EVENT, DUMMY_EVENT, MENU_BAR_LEFT @@ -113,12 +113,11 @@ struct haiku_expose_event int height; }; -struct haiku_refs_event +struct haiku_drag_and_drop_event { void *window; int x, y; - /* Free this with free! */ - char *ref; + void *message; }; struct haiku_app_quit_requested_event @@ -943,6 +942,9 @@ extern "C" extern void BWindow_dimensions (void *window, int *width, int *height); + extern void + BMessage_delete (void *message); + #ifdef __cplusplus extern void * find_appropriate_view_for_draw (void *vw); diff --git a/src/haikuselect.c b/src/haikuselect.c index 65dac0e02f..f291fa70ed 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -179,6 +179,138 @@ same as `SECONDARY'. */) return value ? Qt : Qnil; } +/* 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. + + 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. */ +Lisp_Object +haiku_message_to_lisp (void *message) +{ + Lisp_Object list = Qnil, tem, t1, t2; + const char *name; + char *pbuf; + const void *buf; + ssize_t buf_size; + int32 i, j, count, type_code; + int rc; + + for (i = 0; !be_enum_message (message, &type_code, i, + &count, &name); ++i) + { + tem = Qnil; + + for (j = 0; j < count; ++j) + { + rc = be_get_message_data (message, name, + type_code, j, + &buf, &buf_size); + if (rc) + emacs_abort (); + + switch (type_code) + { + case 'BOOL': + t1 = (*(bool *) buf) ? Qt : Qnil; + break; + + case 'RREF': + rc = be_get_refs_data (message, name, + j, &pbuf); + + if (rc) + { + t1 = Qnil; + break; + } + + if (!pbuf) + memory_full (SIZE_MAX); + + t1 = build_string (pbuf); + free (pbuf); + break; + + case 'SHRT': + t1 = make_fixnum (*(int16 *) buf); + break; + + case 'LONG': + t1 = make_int (*(int32 *) buf); + break; + + case 'LLNG': + t1 = make_int ((intmax_t) *(int64 *) buf); + break; + + case 'BYTE': + case 'CHAR': + t1 = make_fixnum (*(int8 *) buf); + break; + + default: + t1 = make_uninit_string (buf_size); + memcpy (SDATA (t1), buf, buf_size); + } + + tem = Fcons (t1, tem); + } + + switch (type_code) + { + case 'CSTR': + t2 = Qstring; + break; + + case 'SHRT': + t2 = Qshort; + break; + + case 'LONG': + t2 = Qlong; + break; + + case 'LLNG': + t2 = Qllong; + break; + + case 'BYTE': + t2 = Qbyte; + break; + + case 'RREF': + t2 = Qref; + break; + + case 'CHAR': + t2 = Qchar; + break; + + case 'BOOL': + t2 = Qbool; + break; + + default: + t2 = make_int (type_code); + } + + tem = Fcons (t2, tem); + list = Fcons (Fcons (build_string_from_utf8 (name), tem), list); + } + + return list; +} + void syms_of_haikuselect (void) { @@ -188,6 +320,14 @@ syms_of_haikuselect (void) DEFSYM (QUTF8_STRING, "UTF8_STRING"); DEFSYM (Qforeign_selection, "foreign-selection"); DEFSYM (QTARGETS, "TARGETS"); + DEFSYM (Qstring, "string"); + DEFSYM (Qref, "ref"); + DEFSYM (Qshort, "short"); + DEFSYM (Qlong, "long"); + DEFSYM (Qllong, "llong"); + DEFSYM (Qbyte, "byte"); + DEFSYM (Qchar, "char"); + DEFSYM (Qbool, "bool"); defsubr (&Shaiku_selection_data); defsubr (&Shaiku_selection_put); diff --git a/src/haikuselect.h b/src/haikuselect.h index 566aae596f..14b779c36d 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -23,6 +23,8 @@ along with GNU Emacs. If not, see . */ #include #endif +#include + #ifdef __cplusplus #include extern "C" @@ -72,11 +74,19 @@ extern "C" extern bool BClipboard_owns_primary (void); - extern bool - BClipboard_owns_secondary (void); + extern bool BClipboard_owns_secondary (void); /* Free the returned data. */ extern void BClipboard_free_data (void *ptr); + + extern int be_enum_message (void *message, int32 *tc, int index, + int32 *count, const char **name_return); + extern int be_get_message_data (void *message, const char *name, + int32 type_code, int32 index, + const void **buf_return, + ssize_t *size_return); + extern int be_get_refs_data (void *message, const char *name, + int32 index, char **path_buffer); #ifdef __cplusplus }; #endif diff --git a/src/haikuterm.c b/src/haikuterm.c index 52846fc145..9844a09a02 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3545,27 +3545,25 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) haiku_make_fullscreen_consistent (f); break; } - case REFS_EVENT: + case DRAG_AND_DROP_EVENT: { - struct haiku_refs_event *b = buf; + struct haiku_drag_and_drop_event *b = buf; struct frame *f = haiku_window_to_frame (b->window); if (!f) { - free (b->ref); + BMessage_delete (b->message); continue; } inev.kind = DRAG_N_DROP_EVENT; - inev.arg = build_string_from_utf8 (b->ref); + inev.arg = haiku_message_to_lisp (b->message); XSETINT (inev.x, b->x); XSETINT (inev.y, b->y); XSETFRAME (inev.frame_or_window, f); - /* There should be no problem with calling free here. - free on Haiku is thread-safe. */ - free (b->ref); + BMessage_delete (b->message); break; } case APP_QUIT_REQUESTED_EVENT: diff --git a/src/haikuterm.h b/src/haikuterm.h index 64fd0ec2b7..8d0af8dc67 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -255,6 +255,7 @@ extern void haiku_free_frame_resources (struct frame *f); extern void haiku_scroll_bar_remove (struct scroll_bar *bar); extern void haiku_clear_under_internal_border (struct frame *f); extern void haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p); +extern Lisp_Object haiku_message_to_lisp (void *); extern struct haiku_display_info *haiku_term_init (void); commit 65f92837fa58c943f689fb847edcfd44c8a8a6c1 Author: Eli Zaretskii Date: Wed Mar 16 14:46:36 2022 +0200 Fix last change in frames.texi * doc/lispref/frames.texi (Drag and Drop): Improve and clarify the wording. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index ea5dd4c675..24b439e049 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4039,8 +4039,8 @@ still no match has been found, the text for the URL is inserted. If you want to alter Emacs behavior, you can customize these variables. @cindex initiating drag-and-drop - On some window systems, Emacs also supports dragging contents from -itself to other frames. + 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 This function begins a drag from @var{frame}, and returns when the @@ -4055,17 +4055,17 @@ the drop target can request from Emacs (@pxref{Window System Selections}). @var{action} is a symbol describing the action recommended to the -target. It can either be @code{XdndActionCopy}, which means which +target. It can either be @code{XdndActionCopy}, which means to copy the contents of the selection @code{XdndSelection} to -the drop target, or @code{XdndActionMove}, which means the same as -@code{XdndActionCopy}, but also means the caller should delete -whatever was saved into that selection afterwards. +the drop target; or @code{XdndActionMove}, which means copy as with +@code{XdndActionCopy}, and in addition the caller should delete +whatever was stored in that selection after copying it. If @var{return-frame} is non-nil and the mouse moves over an Emacs -frame after first moving out of @var{frame}, then that frame will be -returned immediately. This is useful when you want to treat dragging -content from one frame to another specially, while also being able to -drag content to other programs. +frame after first moving out of @var{frame}, then the frame to which +the mouse moves will be returned immediately. This is useful when you +want to treat dragging content from one frame to another specially, +while also being able to drag content to other programs. If the drop was rejected or no drop target was found, this function returns @code{nil}. Otherwise, it returns a symbol describing the commit 4f46ec8ddd28fc5968afee64beedec01e2e5dee3 Author: Po Lu Date: Wed Mar 16 19:43:06 2022 +0800 Pacify compiler warning in handle_one_xevent * src/xterm.c (x_dnd_get_target_window): Set proto_out even if it won't be used because target is None. Reported by Lars Ingebrigtsen . diff --git a/src/xterm.c b/src/xterm.c index 7d1a5f4043..46a22d8dc1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -866,6 +866,7 @@ x_dnd_get_target_window (struct x_display_info *dpyinfo, if (x_had_errors_p (dpyinfo->display) || !rc) { x_uncatch_errors_after_check (); + *proto_out = -1; return None; } } commit 1bf8eca626d67eb011e80079db76107e629332f6 Author: Po Lu Date: Wed Mar 16 17:07:17 2022 +0800 Correct last change for return-frame drags * src/xterm.c (handle_one_xevent): Use `x_any_window_to_frame' to determine `x_dnd_return_frame_object'. diff --git a/src/xterm.c b/src/xterm.c index 83651376bf..7d1a5f4043 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11669,11 +11669,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_return_frame = 2; if (x_dnd_return_frame == 2 - && x_window_to_frame (dpyinfo, target)) + && x_any_window_to_frame (dpyinfo, target)) { x_dnd_in_progress = false; x_dnd_return_frame_object - = x_window_to_frame (dpyinfo, target); + = x_any_window_to_frame (dpyinfo, target); x_dnd_return_frame = 3; } @@ -12903,11 +12903,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_return_frame = 2; if (x_dnd_return_frame == 2 - && x_window_to_frame (dpyinfo, target)) + && x_any_window_to_frame (dpyinfo, target)) { x_dnd_in_progress = false; x_dnd_return_frame_object - = x_window_to_frame (dpyinfo, target); + = x_any_window_to_frame (dpyinfo, target); x_dnd_return_frame = 3; } commit e8d7139b4e069f4641a7e11261541acb4c5fff7b Author: Po Lu Date: Wed Mar 16 17:03:19 2022 +0800 Fix minor bugs with XDND support * lisp/mouse.el (mouse-drag-and-drop-region): Report more selection targets for the benefit of Qt and Mozilla. * lisp/select.el (xselect--encode-string) (selection-converter-alist): Add new selection targets. * src/xterm.c (x_dnd_get_window_proxy): New function. (x_dnd_get_target_window): New argument proto_out, and return first window with XdndAware instead of bottommost window. (handle_one_xevent): Use new argument `proto_out'. diff --git a/lisp/mouse.el b/lisp/mouse.el index 4eead39925..3e7ae24697 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -3100,7 +3100,9 @@ is copied instead of being cut." (x-hide-tip) (gui-set-selection 'XdndSelection value-selection) (let ((drag-action-or-frame - (x-begin-drag '("UTF8_STRING" "STRING") + (x-begin-drag '("UTF8_STRING" "text/plain" + "text/plain;charset=utf-8" + "STRING" "TEXT" "COMPOUND_TEXT") (if mouse-drag-and-drop-region-cut-when-buffers-differ 'XdndActionMove 'XdndActionCopy) diff --git a/lisp/select.el b/lisp/select.el index 42b50c44e6..e9bc545117 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -485,7 +485,8 @@ two markers or an overlay. Otherwise, it is nil." (if eight-bit 'C_STRING 'STRING)))))))) (cond - ((eq type 'UTF8_STRING) + ((or (eq type 'UTF8_STRING) + (eq type 'text/plain\;charset=utf-8)) (if (or (not coding) (not (eq (coding-system-type coding) 'utf-8))) (setq coding 'utf-8)) @@ -497,6 +498,12 @@ two markers or an overlay. Otherwise, it is nil." (setq coding 'iso-8859-1)) (setq str (encode-coding-string str coding))) + ((eq type 'text/plain) + (if (or (not coding) + (not (eq (coding-system-type coding) 'charset))) + (setq coding 'ascii)) + (setq str (encode-coding-string str coding))) + ((eq type 'COMPOUND_TEXT) (if (or (not coding) (not (eq (coding-system-type coding) 'iso-2022))) @@ -630,6 +637,8 @@ This function returns the string \"emacs\"." (COMPOUND_TEXT . xselect-convert-to-string) (STRING . xselect-convert-to-string) (UTF8_STRING . xselect-convert-to-string) + (text/plain . xselect-convert-to-string) + (text/plain\;charset=utf-8 . xselect-convert-to-string) (TARGETS . xselect-convert-to-targets) (LENGTH . xselect-convert-to-length) (DELETE . xselect-convert-to-delete) diff --git a/src/xterm.c b/src/xterm.c index d01d3e7cce..83651376bf 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -795,23 +795,21 @@ static struct frame *x_dnd_frame; #define X_DND_SUPPORTED_VERSION 5 +static int x_dnd_get_window_proto (struct x_display_info *, Window); +static Window x_dnd_get_window_proxy (struct x_display_info *, Window); + static Window x_dnd_get_target_window (struct x_display_info *dpyinfo, - int root_x, int root_y) + int root_x, int root_y, int *proto_out) { Window child_return, child, dummy, proxy; - int dest_x_return, dest_y_return; - int rc; - int actual_format; - unsigned long actual_size, bytes_remaining; - unsigned char *tmp_data; - XWindowAttributes attrs; - Atom actual_type; - + int dest_x_return, dest_y_return, rc, proto; child_return = dpyinfo->root_window; dest_x_return = root_x; dest_y_return = root_y; + proto = -1; + /* Not strictly necessary, but satisfies GCC. */ child = dpyinfo->root_window; @@ -832,8 +830,33 @@ x_dnd_get_target_window (struct x_display_info *dpyinfo, break; } + proxy = x_dnd_get_window_proxy (dpyinfo, child_return); + + if (proxy != None) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *proto_out = proto; + + x_uncatch_errors_after_check (); + return proxy; + } + } + if (child_return) { + proto = x_dnd_get_window_proto (dpyinfo, child_return); + + if (proto != -1) + { + *proto_out = proto; + x_uncatch_errors_after_check (); + + return child_return; + } + rc = XTranslateCoordinates (dpyinfo->display, child, child_return, dest_x_return, dest_y_return, @@ -850,36 +873,47 @@ x_dnd_get_target_window (struct x_display_info *dpyinfo, x_uncatch_errors_after_check (); } - if (child != None) - { - x_catch_errors (dpyinfo->display); - rc = XGetWindowProperty (dpyinfo->display, child, - dpyinfo->Xatom_XdndProxy, - 0, 1, False, XA_WINDOW, - &actual_type, &actual_format, - &actual_size, &bytes_remaining, - &tmp_data); - - if (!x_had_errors_p (dpyinfo->display) - && rc == Success - && actual_type == XA_WINDOW - && actual_format == 32 - && actual_size == 1) - { - proxy = *(Window *) tmp_data; - XFree (tmp_data); + *proto_out = x_dnd_get_window_proto (dpyinfo, child); + return child; +} + +static Window +x_dnd_get_window_proxy (struct x_display_info *dpyinfo, Window wdesc) +{ + int rc, actual_format; + unsigned long actual_size, bytes_remaining; + unsigned char *tmp_data; + XWindowAttributes attrs; + Atom actual_type; + Window proxy; - /* Verify the proxy window exists. */ - XGetWindowAttributes (dpyinfo->display, proxy, &attrs); + proxy = None; + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, wdesc, + dpyinfo->Xatom_XdndProxy, + 0, 1, False, XA_WINDOW, + &actual_type, &actual_format, + &actual_size, &bytes_remaining, + &tmp_data); - if (!x_had_errors_p (dpyinfo->display)) - child = proxy; - } + if (!x_had_errors_p (dpyinfo->display) + && rc == Success + && actual_type == XA_WINDOW + && actual_format == 32 + && actual_size == 1) + { + proxy = *(Window *) tmp_data; + XFree (tmp_data); - x_uncatch_errors_after_check (); + /* Verify the proxy window exists. */ + XGetWindowAttributes (dpyinfo->display, proxy, &attrs); + + if (x_had_errors_p (dpyinfo->display)) + proxy = None; } + x_uncatch_errors_after_check (); - return child; + return proxy; } static int @@ -11616,10 +11650,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) { Window target; + int target_proto; target = x_dnd_get_target_window (dpyinfo, event->xmotion.x_root, - event->xmotion.y_root); + event->xmotion.y_root, + &target_proto); if (target != x_dnd_last_seen_window) { @@ -11643,8 +11679,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_wanted_action = None; x_dnd_last_seen_window = target; - x_dnd_last_protocol_version - = x_dnd_get_window_proto (dpyinfo, target); + x_dnd_last_protocol_version = target_proto; if (target != None && x_dnd_last_protocol_version != -1) x_dnd_send_enter (x_dnd_frame, target, @@ -12849,10 +12884,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) { Window target; + int target_proto; target = x_dnd_get_target_window (dpyinfo, xev->root_x, - xev->root_y); + xev->root_y, + &target_proto); if (target != x_dnd_last_seen_window) { @@ -12875,8 +12912,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } x_dnd_last_seen_window = target; - x_dnd_last_protocol_version - = x_dnd_get_window_proto (dpyinfo, target); + x_dnd_last_protocol_version = target_proto; if (target != None && x_dnd_last_protocol_version != -1) x_dnd_send_enter (x_dnd_frame, target, commit 1babe5fb2d7575fb15e515fffd3387d60a975553 Author: Po Lu Date: Wed Mar 16 15:51:02 2022 +0800 Fix XI 2.0 build * src/xterm.c (handle_one_xevent): Move declaration of dummy out of HAVE_XINPUT2_1. diff --git a/src/xterm.c b/src/xterm.c index a3d20a9d22..d01d3e7cce 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -12593,6 +12593,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; #endif + Window dummy; + #ifdef HAVE_XINPUT2_1 #ifdef HAVE_XWIDGETS struct xwidget_view *xv = xwidget_view_from_window (xev->event); @@ -12603,7 +12605,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, double total_y = 0.0; int real_x, real_y; - Window dummy; for (int i = 0; i < states->mask_len * 8; i++) { commit 47dcf72dec63b4b4b9cc3b8444bbbfcb85e31d3e Author: Po Lu Date: Wed Mar 16 15:18:02 2022 +0800 Fix tooltip text properties showing up in dragged text * lisp/mouse.el (mouse-drag-and-drop-region): Directly call x-show-tip and x-hide-tip instead of going through tooltip-show. diff --git a/lisp/mouse.el b/lisp/mouse.el index b650bea1bd..4eead39925 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -3097,12 +3097,28 @@ is copied instead of being cut." (frame-pixel-width frame)) (> (cdr location) (frame-pixel-height frame))))) - (tooltip-hide) + (x-hide-tip) (gui-set-selection 'XdndSelection value-selection) - (when (framep - (x-begin-drag '("UTF8_STRING" "STRING") 'XdndActionCopy - (posn-window (event-end event)) t)) - (throw 'drag-again nil)) + (let ((drag-action-or-frame + (x-begin-drag '("UTF8_STRING" "STRING") + (if mouse-drag-and-drop-region-cut-when-buffers-differ + 'XdndActionMove + 'XdndActionCopy) + (posn-window (event-end event)) t))) + (when (framep drag-action-or-frame) + (throw 'drag-again nil)) + + (when (eq drag-action-or-frame 'XdndActionMove) + ;; Remove the dragged text from source buffer like + ;; operation `cut'. + (dolist (overlay mouse-drag-and-drop-overlays) + (delete-region (overlay-start overlay) + (overlay-end overlay)))) + + (when (eq drag-action-or-frame 'XdndActionCopy) + ;; Set back the dragged text as region on source buffer + ;; like operation `copy'. + (activate-mark))) (throw 'cross-program-drag nil)) (setq window-to-paste (posn-window (event-end event))) @@ -3161,8 +3177,12 @@ is copied instead of being cut." ;; Show a tooltip. (if mouse-drag-and-drop-region-show-tooltip - (tooltip-show text-tooltip) - (tooltip-hide)) + ;; Don't use tooltip-show since it has side effects + ;; which change the text properties, and + ;; `text-tooltip' can potentially be the text which + ;; will be pasted. + (x-show-tip text-tooltip) + (x-hide-tip)) ;; Show cursor and highlight the original region. (when mouse-drag-and-drop-region-show-cursor @@ -3183,7 +3203,7 @@ is copied instead of being cut." (mouse-set-point event))))))) ;; Hide a tooltip. - (when mouse-drag-and-drop-region-show-tooltip (tooltip-hide)) + (when mouse-drag-and-drop-region-show-tooltip (x-hide-tip)) ;; Check if modifier was pressed on drop. (setq no-modifier-on-drop