commit b1c6d5f2b766914807b8ee82a498bb25f40ea475 (HEAD, refs/remotes/origin/master) Merge: f62a6acd00 62e830c3d9 Author: Stefan Kangas Date: Wed Mar 16 06:30:35 2022 +0100 Merge from origin/emacs-28 62e830c3d9 * doc/misc/transient.texi: Fix @dircategory to "Emacs misc... commit f62a6acd00fa5045fbc537bcaa87756416e246a4 Author: Po Lu Date: Wed Mar 16 12:33:15 2022 +0800 Better handle drag-and-drop from one Emacs frame to another * doc/lispref/frames.texi (Drag and Drop): Document new parameter `return-frame' to `x-begin-drag'. * lisp/mouse.el (mouse-drag-and-drop-region): Utilize new feature. * src/xfns.c (Fx_begin_drag): New parameter `return-frame'. * src/xterm.c (x_dnd_begin_drag_and_drop): New parameter return_frame_p. (handle_one_xevent): Set new flags and return frame whenever appropriate. * src/xterm.h: Update prototypes. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 38897d6a0b..ea5dd4c675 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 some window systems, Emacs also supports dragging contents from itself to other frames. -@defun x-begin-drag targets action &optional frame +@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 @@ -4061,6 +4061,12 @@ 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. +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. + If the drop was rejected or no drop target was found, this function returns @code{nil}. Otherwise, it returns a symbol describing the action the target chose to perform, which can differ from @var{action} diff --git a/lisp/mouse.el b/lisp/mouse.el index 3e2097e761..b650bea1bd 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -3061,123 +3061,126 @@ is copied instead of being cut." (or (mouse-movement-p event) ;; Handle `mouse-autoselect-window'. (memq (car event) '(select-window switch-frame)))) - ;; Obtain the dragged text in region. When the loop was - ;; skipped, value-selection remains nil. - (unless value-selection - (setq value-selection (funcall region-extract-function nil)) - (when mouse-drag-and-drop-region-show-tooltip - (let ((text-size mouse-drag-and-drop-region-show-tooltip)) - (setq text-tooltip - (if (and (integerp text-size) - (> (length value-selection) text-size)) - (concat - (substring value-selection 0 (/ text-size 2)) - "\n...\n" - (substring value-selection (- (/ text-size 2)) -1)) - value-selection)))) - - ;; Check if selected text is read-only. - (setq text-from-read-only - (or text-from-read-only - (catch 'loop - (dolist (bound (region-bounds)) - (when (text-property-not-all - (car bound) (cdr bound) 'read-only nil) - (throw 'loop t))))))) - - (when (and mouse-drag-and-drop-region-cross-program - (fboundp 'x-begin-drag) - (framep (posn-window (event-end event))) - (let ((location (posn-x-y (event-end event))) - (frame (posn-window (event-end event)))) - (or (< (car location) 0) - (< (cdr location) 0) - (> (car location) - (frame-pixel-width frame)) - (> (cdr location) - (frame-pixel-height frame))))) - (tooltip-hide) - (gui-set-selection 'XdndSelection value-selection) - (x-begin-drag '("UTF8_STRING" "STRING") - 'XdndActionMove (posn-window (event-end event))) - (throw 'cross-program-drag nil)) - - (setq window-to-paste (posn-window (event-end event))) - (setq point-to-paste (posn-point (event-end event))) - ;; Set nil when target buffer is minibuffer. - (setq buffer-to-paste (let (buf) - (when (windowp window-to-paste) - (setq buf (window-buffer window-to-paste)) - (when (not (minibufferp buf)) - buf)))) - (setq cursor-in-text-area (and window-to-paste - point-to-paste - buffer-to-paste)) - - (when cursor-in-text-area - ;; Check if point under mouse is read-only. - (save-window-excursion - (select-window window-to-paste) - (setq point-to-paste-read-only - (or buffer-read-only - (get-text-property point-to-paste 'read-only)))) - - ;; Check if "drag but negligible". Operation "drag but - ;; negligible" is defined as drag-and-drop the text to - ;; the original region. When modifier is pressed, the - ;; text will be inserted to inside of the original - ;; region. - ;; - ;; If the region is rectangular, check if the newly inserted - ;; rectangular text would intersect the already selected - ;; region. If it would, then set "drag-but-negligible" to t. - ;; As a special case, allow dragging the region freely anywhere - ;; to the left, as this will never trigger its contents to be - ;; inserted into the overlays tracking it. - (setq drag-but-negligible - (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) - buffer-to-paste) - (if region-noncontiguous - (let ((dimensions (rectangle-dimensions start end)) - (start-coordinates - (rectangle-position-as-coordinates start)) - (point-to-paste-coordinates - (rectangle-position-as-coordinates - point-to-paste))) - (and (rectangle-intersect-p - start-coordinates dimensions - point-to-paste-coordinates dimensions) - (not (< (car point-to-paste-coordinates) - (car start-coordinates))))) - (and (<= (overlay-start - (car mouse-drag-and-drop-overlays)) - point-to-paste) - (<= point-to-paste - (overlay-end - (car mouse-drag-and-drop-overlays)))))))) - - ;; Show a tooltip. - (if mouse-drag-and-drop-region-show-tooltip - (tooltip-show text-tooltip) - (tooltip-hide)) - - ;; Show cursor and highlight the original region. - (when mouse-drag-and-drop-region-show-cursor - ;; Modify cursor even when point is out of frame. - (setq cursor-type (cond - ((not cursor-in-text-area) - nil) - ((or point-to-paste-read-only - drag-but-negligible) - 'hollow) - (t - 'bar))) + (catch 'drag-again + ;; Obtain the dragged text in region. When the loop was + ;; skipped, value-selection remains nil. + (unless value-selection + (setq value-selection (funcall region-extract-function nil)) + (when mouse-drag-and-drop-region-show-tooltip + (let ((text-size mouse-drag-and-drop-region-show-tooltip)) + (setq text-tooltip + (if (and (integerp text-size) + (> (length value-selection) text-size)) + (concat + (substring value-selection 0 (/ text-size 2)) + "\n...\n" + (substring value-selection (- (/ text-size 2)) -1)) + value-selection)))) + + ;; Check if selected text is read-only. + (setq text-from-read-only + (or text-from-read-only + (catch 'loop + (dolist (bound (region-bounds)) + (when (text-property-not-all + (car bound) (cdr bound) 'read-only nil) + (throw 'loop t))))))) + + (when (and mouse-drag-and-drop-region-cross-program + (fboundp 'x-begin-drag) + (framep (posn-window (event-end event))) + (let ((location (posn-x-y (event-end event))) + (frame (posn-window (event-end event)))) + (or (< (car location) 0) + (< (cdr location) 0) + (> (car location) + (frame-pixel-width frame)) + (> (cdr location) + (frame-pixel-height frame))))) + (tooltip-hide) + (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)) + (throw 'cross-program-drag nil)) + + (setq window-to-paste (posn-window (event-end event))) + (setq point-to-paste (posn-point (event-end event))) + ;; Set nil when target buffer is minibuffer. + (setq buffer-to-paste (let (buf) + (when (windowp window-to-paste) + (setq buf (window-buffer window-to-paste)) + (when (not (minibufferp buf)) + buf)))) + (setq cursor-in-text-area (and window-to-paste + point-to-paste + buffer-to-paste)) + (when cursor-in-text-area - (dolist (overlay mouse-drag-and-drop-overlays) - (overlay-put overlay - 'face 'mouse-drag-and-drop-region)) - (deactivate-mark) ; Maintain region in other window. - (mouse-set-point event)))))) + ;; Check if point under mouse is read-only. + (save-window-excursion + (select-window window-to-paste) + (setq point-to-paste-read-only + (or buffer-read-only + (get-text-property point-to-paste 'read-only)))) + + ;; Check if "drag but negligible". Operation "drag but + ;; negligible" is defined as drag-and-drop the text to + ;; the original region. When modifier is pressed, the + ;; text will be inserted to inside of the original + ;; region. + ;; + ;; If the region is rectangular, check if the newly inserted + ;; rectangular text would intersect the already selected + ;; region. If it would, then set "drag-but-negligible" to t. + ;; As a special case, allow dragging the region freely anywhere + ;; to the left, as this will never trigger its contents to be + ;; inserted into the overlays tracking it. + (setq drag-but-negligible + (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) + buffer-to-paste) + (if region-noncontiguous + (let ((dimensions (rectangle-dimensions start end)) + (start-coordinates + (rectangle-position-as-coordinates start)) + (point-to-paste-coordinates + (rectangle-position-as-coordinates + point-to-paste))) + (and (rectangle-intersect-p + start-coordinates dimensions + point-to-paste-coordinates dimensions) + (not (< (car point-to-paste-coordinates) + (car start-coordinates))))) + (and (<= (overlay-start + (car mouse-drag-and-drop-overlays)) + point-to-paste) + (<= point-to-paste + (overlay-end + (car mouse-drag-and-drop-overlays)))))))) + + ;; Show a tooltip. + (if mouse-drag-and-drop-region-show-tooltip + (tooltip-show text-tooltip) + (tooltip-hide)) + + ;; Show cursor and highlight the original region. + (when mouse-drag-and-drop-region-show-cursor + ;; Modify cursor even when point is out of frame. + (setq cursor-type (cond + ((not cursor-in-text-area) + nil) + ((or point-to-paste-read-only + drag-but-negligible) + 'hollow) + (t + 'bar))) + (when cursor-in-text-area + (dolist (overlay mouse-drag-and-drop-overlays) + (overlay-put overlay + 'face 'mouse-drag-and-drop-region)) + (deactivate-mark) ; Maintain region in other window. + (mouse-set-point event))))))) ;; Hide a tooltip. (when mouse-drag-and-drop-region-show-tooltip (tooltip-hide)) diff --git a/src/xfns.c b/src/xfns.c index 0d197c1dd7..b5d0b2c54e 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6582,7 +6582,7 @@ The coordinates X and Y are interpreted in pixels relative to a position return Qnil; } -DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 3, 0, +DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 4, 0, doc: /* Begin dragging contents on FRAME, with targets TARGETS. TARGETS is a list of strings, which defines the X selection targets that will be available to the drop target. Block until the mouse @@ -6607,9 +6607,14 @@ Emacs. For that reason, they are not mentioned here. Consult "Drag-and-Drop Protocol for the X Window System" for more details: https://freedesktop.org/wiki/Specifications/XDND/. +If RETURN-FRAME is non-nil, this function will return the frame if the +mouse pointer moves onto an Emacs frame, after first moving out of +FRAME. + If ACTION is not specified or nil, `XdndActionCopy' is used instead. */) - (Lisp_Object targets, Lisp_Object action, Lisp_Object frame) + (Lisp_Object targets, Lisp_Object action, Lisp_Object frame, + Lisp_Object return_frame) { struct frame *f = decode_window_system_frame (frame); int ntargets = 0; @@ -6655,7 +6660,7 @@ instead. */) x_set_dnd_targets (target_atoms, ntargets); lval = x_dnd_begin_drag_and_drop (f, FRAME_DISPLAY_INFO (f)->last_user_time, - xaction); + xaction, !NILP (return_frame)); return lval; } diff --git a/src/xterm.c b/src/xterm.c index 8a4344f2a4..a3d20a9d22 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -771,6 +771,15 @@ static void x_scroll_bar_end_update (struct x_display_info *, struct scroll_bar #endif static bool x_dnd_in_progress; + +/* Whether or not to return a frame from `x_dnd_begin_drag_and_drop'. + + 0 means to do nothing. 1 means to wait for the mouse to first exit + `x_dnd_frame'. 2 means to wait for the mouse to move onto a frame, + and 3 means to `x_dnd_return_frame_object'. */ +static int x_dnd_return_frame; +static struct frame *x_dnd_return_frame_object; + static Window x_dnd_last_seen_window; static int x_dnd_last_protocol_version; static Time x_dnd_selection_timestamp; @@ -1025,7 +1034,8 @@ x_set_dnd_targets (Atom *targets, int ntargets) } Lisp_Object -x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction) +x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, + bool return_frame_p) { XEvent next_event; struct input_event hold_quit; @@ -1054,6 +1064,10 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction) x_dnd_mouse_rect_target = None; x_dnd_action = None; x_dnd_wanted_action = xaction; + x_dnd_return_frame = 0; + + if (return_frame_p) + x_dnd_return_frame = 1; while (x_dnd_in_progress) { @@ -1085,6 +1099,14 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction) } } + if (x_dnd_return_frame == 3) + { + x_dnd_return_frame_object->mouse_moved = true; + + XSETFRAME (action, x_dnd_return_frame_object); + return action; + } + FRAME_DISPLAY_INFO (f)->grabbed = 0; if (x_dnd_wanted_action != None) @@ -11606,6 +11628,19 @@ handle_one_xevent (struct x_display_info *dpyinfo, && x_dnd_last_seen_window != FRAME_X_WINDOW (x_dnd_frame)) x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + if (x_dnd_last_seen_window == FRAME_X_WINDOW (x_dnd_frame) + && x_dnd_return_frame == 1) + x_dnd_return_frame = 2; + + if (x_dnd_return_frame == 2 + && x_window_to_frame (dpyinfo, target)) + { + x_dnd_in_progress = false; + x_dnd_return_frame_object + = x_window_to_frame (dpyinfo, target); + x_dnd_return_frame = 3; + } + x_dnd_wanted_action = None; x_dnd_last_seen_window = target; x_dnd_last_protocol_version @@ -12825,6 +12860,19 @@ handle_one_xevent (struct x_display_info *dpyinfo, && x_dnd_last_seen_window != FRAME_X_WINDOW (x_dnd_frame)) x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + if (x_dnd_last_seen_window == FRAME_X_WINDOW (x_dnd_frame) + && x_dnd_return_frame == 1) + x_dnd_return_frame = 2; + + if (x_dnd_return_frame == 2 + && x_window_to_frame (dpyinfo, target)) + { + x_dnd_in_progress = false; + x_dnd_return_frame_object + = x_window_to_frame (dpyinfo, target); + x_dnd_return_frame = 3; + } + x_dnd_last_seen_window = target; x_dnd_last_protocol_version = x_dnd_get_window_proto (dpyinfo, target); diff --git a/src/xterm.h b/src/xterm.h index 225aaf4cad..9665e92a9f 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1367,7 +1367,8 @@ extern void x_scroll_bar_configure (GdkEvent *); extern void x_display_set_last_user_time (struct x_display_info *, Time); -extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom); +extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom, + bool); extern void x_set_dnd_targets (Atom *, int); INLINE int commit 5ff13718a53c161c3a0d3e8795544a740c10064b Author: Po Lu Date: Wed Mar 16 11:45:46 2022 +0800 * src/xfns.c (Fx_begin_drag): Improve doc string. diff --git a/src/xfns.c b/src/xfns.c index 3e184571a0..0d197c1dd7 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6585,12 +6585,14 @@ The coordinates X and Y are interpreted in pixels relative to a position DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 3, 0, doc: /* Begin dragging contents on FRAME, with targets TARGETS. TARGETS is a list of strings, which defines the X selection targets -that will be available to the drop target. Dragging starts when the -mouse is pressed on FRAME, and the contents of the selection -`XdndSelection' will be sent to the X window underneath the mouse -pointer (the drop target) when the mouse button is released. ACTION -is a symbol which tells the target what to do, and can be one of the -following: +that will be available to the drop target. Block until the mouse +buttons are released, then return the action chosen by the target, or +`nil' if the drop was not accepted by the drop target. Dragging +starts when the mouse is pressed on FRAME, and the contents of the +selection `XdndSelection' will be sent to the X window underneath the +mouse pointer (the drop target) when the mouse button is released. +ACTION is a symbol which tells the target what the source will do, and +can be one of the following: - `XdndActionCopy', which means to copy the contents from the drag source (FRAME) to the drop target. @@ -6605,11 +6607,8 @@ Emacs. For that reason, they are not mentioned here. Consult "Drag-and-Drop Protocol for the X Window System" for more details: https://freedesktop.org/wiki/Specifications/XDND/. -If ACTION is not specified or nil, `XdndActionCopy' is used instead. - -Block until the mouse buttons are released, then return the action -chosen by the target, or `nil' if the drop was not accepted by the -drop target. */) +If ACTION is not specified or nil, `XdndActionCopy' is used +instead. */) (Lisp_Object targets, Lisp_Object action, Lisp_Object frame) { struct frame *f = decode_window_system_frame (frame); commit e53fba3fd4916029662e6619aba713d7dd7c7038 Author: Po Lu Date: Wed Mar 16 11:29:36 2022 +0800 Add support for dragging text from Emacs to other programs This still probably needs some more protection from malfunctioning clients which delete windows at random, but I don't know if that's a problem in practice. * doc/emacs/frames.texi (Drag and Drop): * doc/lispref/frames.texi (Drag and Drop): Document new features. * etc/NEWS: Announce new function `x-begin-drag' and new user option `mouse-drag-and-drop-region-cross-program'. * lisp/mouse.el (mouse-drag-and-drop-region-cross-program): New user option. (x-begin-drag): New variable declaration. (mouse-drag-and-drop-region): If the mouse moves out of an Emacs frame, begin a window system drag. * lisp/x-dnd.el (x-dnd-handle-xdnd): Remove left-over debugging code. * src/xfns.c (Fx_set_mouse_absolute_pixel_position): Fix indentation of opening paren. (Fx_begin_drag): New function. (syms_of_xfns): Define new subr. * src/xselect.c (x_timestamp_for_selection): New function. * src/xterm.c (X_DND_SUPPORTED_VERSION): New preprocessor declaration. (x_dnd_get_window_proto, x_dnd_send_enter, x_dnd_send_position) (x_dnd_send_leave, x_dnd_send_drop, x_set_dnd_targets) (x_dnd_begin_drag_and_drop): New functions. (handle_one_xevent): Handle drag-and-drop motion and button events when active. (x_free_frame_resources): If f is the DND source, stop drag-and-drop. (x_term_init): Intern new atoms. (syms_of_xterm): New symbol QXdndSelection. * src/xterm.h (struct x_display_info): New atoms Xatom_XdndAware, Xatom_XdndSelection, Xatom_XdndTypeList, Xatom_XdndActionCopy, Xatom_XdndActionMove, Xatom_XdndActionLink, Xatom_XdndActionAsk, Xatom_XdndActionPrivate, Xatom_XdndActionList, Xatom_XdndActionDescription, Xatom_XdndProxy, Xatom_XdndEnter, Xatom_XdndPosition, Xatom_XdndStatus, Xatom_XdndLeave, Xatom_XdndDrop, and Xatom_XdndFinished. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index e3cfe5f844..7489344cda 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1220,6 +1220,10 @@ cursor during dragging. To suppress such behavior, set the options @code{mouse-drag-and-drop-region-show-tooltip} and/or @code{mouse-drag-and-drop-region-show-cursor} to @code{nil}. +@vindex mouse-drag-and-drop-region-cross-program +To drag text from Emacs to other programs, set the option +@code{mouse-drag-and-drop-region-cross-program} to a non-@code{nil} +value. @node Menu Bars @section Menu Bars diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index bae8eb3c70..38897d6a0b 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4038,6 +4038,35 @@ there is no match there, Emacs looks for a match in 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. + +@defun x-begin-drag targets action &optional 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}). + +@var{targets} is a list of strings describing selection targets, much +like the @var{data-type} argument to @code{gui-get-selection}, that +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 +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. + +If the drop was rejected or no drop target was found, this function +returns @code{nil}. Otherwise, it returns a symbol describing the +action the target chose to perform, which can differ from @var{action} +if that isn't supported by the drop target. +@end defun + @node Color Names @section Color Names diff --git a/etc/NEWS b/etc/NEWS index d6b5da3902..f4d8756950 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -169,6 +169,11 @@ methods instead. * Changes in Emacs 29.1 ++++ +** New user option 'mouse-drag-and-drop-region-cross-program'. +If non-nil, this option allows dragging text in the region from Emacs +to another program. + +++ ** New function 'command-query'. This function makes its argument command prompt the user for @@ -1203,6 +1208,11 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** New function 'x-begin-drag'. +This function initiates a drag-and-drop request with the contents of +the selection 'XdndSelection', and returns when a drop occurs. + --- ** New function 'ietf-drums-parse-date-string'. This function parses RFC5322 (and RFC822) date strings, and should be diff --git a/lisp/mouse.el b/lisp/mouse.el index 1e205283de..3e2097e761 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2974,6 +2974,11 @@ in addition, temporarily highlight the original region with the :type 'boolean :version "26.1") +(defcustom mouse-drag-and-drop-region-cross-program nil + "If non-nil, allow dragging text to other programs." + :type 'boolean + :version "29.1") + (defface mouse-drag-and-drop-region '((t :inherit region)) "Face to highlight original text during dragging. This face is used by `mouse-drag-and-drop-region' to temporarily @@ -2984,6 +2989,7 @@ highlight the original region when (declare-function rectangle-dimensions "rect" (start end)) (declare-function rectangle-position-as-coordinates "rect" (position)) (declare-function rectangle-intersect-p "rect" (pos1 size1 pos2 size2)) +(declare-function x-begin-drag "xfns.c") (defun mouse-drag-and-drop-region (event) "Move text in the region to point where mouse is dragged to. @@ -3046,114 +3052,132 @@ is copied instead of being cut." states)))) (ignore-errors - (track-mouse - (setq track-mouse 'dropping) - ;; When event was "click" instead of "drag", skip loop. - (while (progn - (setq event (read-key)) ; read-event or read-key - (or (mouse-movement-p event) - ;; Handle `mouse-autoselect-window'. - (memq (car event) '(select-window switch-frame)))) - ;; Obtain the dragged text in region. When the loop was - ;; skipped, value-selection remains nil. - (unless value-selection - (setq value-selection (funcall region-extract-function nil)) - (when mouse-drag-and-drop-region-show-tooltip - (let ((text-size mouse-drag-and-drop-region-show-tooltip)) - (setq text-tooltip - (if (and (integerp text-size) - (> (length value-selection) text-size)) - (concat - (substring value-selection 0 (/ text-size 2)) - "\n...\n" - (substring value-selection (- (/ text-size 2)) -1)) - value-selection)))) - - ;; Check if selected text is read-only. - (setq text-from-read-only - (or text-from-read-only - (catch 'loop - (dolist (bound (region-bounds)) - (when (text-property-not-all - (car bound) (cdr bound) 'read-only nil) - (throw 'loop t))))))) - - (setq window-to-paste (posn-window (event-end event))) - (setq point-to-paste (posn-point (event-end event))) - ;; Set nil when target buffer is minibuffer. - (setq buffer-to-paste (let (buf) - (when (windowp window-to-paste) - (setq buf (window-buffer window-to-paste)) - (when (not (minibufferp buf)) - buf)))) - (setq cursor-in-text-area (and window-to-paste - point-to-paste - buffer-to-paste)) - - (when cursor-in-text-area - ;; Check if point under mouse is read-only. - (save-window-excursion - (select-window window-to-paste) - (setq point-to-paste-read-only - (or buffer-read-only - (get-text-property point-to-paste 'read-only)))) - - ;; Check if "drag but negligible". Operation "drag but - ;; negligible" is defined as drag-and-drop the text to - ;; the original region. When modifier is pressed, the - ;; text will be inserted to inside of the original - ;; region. - ;; - ;; If the region is rectangular, check if the newly inserted - ;; rectangular text would intersect the already selected - ;; region. If it would, then set "drag-but-negligible" to t. - ;; As a special case, allow dragging the region freely anywhere - ;; to the left, as this will never trigger its contents to be - ;; inserted into the overlays tracking it. - (setq drag-but-negligible - (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) - buffer-to-paste) - (if region-noncontiguous - (let ((dimensions (rectangle-dimensions start end)) - (start-coordinates - (rectangle-position-as-coordinates start)) - (point-to-paste-coordinates - (rectangle-position-as-coordinates - point-to-paste))) - (and (rectangle-intersect-p - start-coordinates dimensions - point-to-paste-coordinates dimensions) - (not (< (car point-to-paste-coordinates) - (car start-coordinates))))) - (and (<= (overlay-start - (car mouse-drag-and-drop-overlays)) - point-to-paste) - (<= point-to-paste - (overlay-end - (car mouse-drag-and-drop-overlays)))))))) - - ;; Show a tooltip. - (if mouse-drag-and-drop-region-show-tooltip - (tooltip-show text-tooltip) - (tooltip-hide)) - - ;; Show cursor and highlight the original region. - (when mouse-drag-and-drop-region-show-cursor - ;; Modify cursor even when point is out of frame. - (setq cursor-type (cond - ((not cursor-in-text-area) - nil) - ((or point-to-paste-read-only - drag-but-negligible) - 'hollow) - (t - 'bar))) + (catch 'cross-program-drag + (track-mouse + (setq track-mouse 'dropping) + ;; When event was "click" instead of "drag", skip loop. + (while (progn + (setq event (read-key)) ; read-event or read-key + (or (mouse-movement-p event) + ;; Handle `mouse-autoselect-window'. + (memq (car event) '(select-window switch-frame)))) + ;; Obtain the dragged text in region. When the loop was + ;; skipped, value-selection remains nil. + (unless value-selection + (setq value-selection (funcall region-extract-function nil)) + (when mouse-drag-and-drop-region-show-tooltip + (let ((text-size mouse-drag-and-drop-region-show-tooltip)) + (setq text-tooltip + (if (and (integerp text-size) + (> (length value-selection) text-size)) + (concat + (substring value-selection 0 (/ text-size 2)) + "\n...\n" + (substring value-selection (- (/ text-size 2)) -1)) + value-selection)))) + + ;; Check if selected text is read-only. + (setq text-from-read-only + (or text-from-read-only + (catch 'loop + (dolist (bound (region-bounds)) + (when (text-property-not-all + (car bound) (cdr bound) 'read-only nil) + (throw 'loop t))))))) + + (when (and mouse-drag-and-drop-region-cross-program + (fboundp 'x-begin-drag) + (framep (posn-window (event-end event))) + (let ((location (posn-x-y (event-end event))) + (frame (posn-window (event-end event)))) + (or (< (car location) 0) + (< (cdr location) 0) + (> (car location) + (frame-pixel-width frame)) + (> (cdr location) + (frame-pixel-height frame))))) + (tooltip-hide) + (gui-set-selection 'XdndSelection value-selection) + (x-begin-drag '("UTF8_STRING" "STRING") + 'XdndActionMove (posn-window (event-end event))) + (throw 'cross-program-drag nil)) + + (setq window-to-paste (posn-window (event-end event))) + (setq point-to-paste (posn-point (event-end event))) + ;; Set nil when target buffer is minibuffer. + (setq buffer-to-paste (let (buf) + (when (windowp window-to-paste) + (setq buf (window-buffer window-to-paste)) + (when (not (minibufferp buf)) + buf)))) + (setq cursor-in-text-area (and window-to-paste + point-to-paste + buffer-to-paste)) + (when cursor-in-text-area - (dolist (overlay mouse-drag-and-drop-overlays) - (overlay-put overlay - 'face 'mouse-drag-and-drop-region)) - (deactivate-mark) ; Maintain region in other window. - (mouse-set-point event))))) + ;; Check if point under mouse is read-only. + (save-window-excursion + (select-window window-to-paste) + (setq point-to-paste-read-only + (or buffer-read-only + (get-text-property point-to-paste 'read-only)))) + + ;; Check if "drag but negligible". Operation "drag but + ;; negligible" is defined as drag-and-drop the text to + ;; the original region. When modifier is pressed, the + ;; text will be inserted to inside of the original + ;; region. + ;; + ;; If the region is rectangular, check if the newly inserted + ;; rectangular text would intersect the already selected + ;; region. If it would, then set "drag-but-negligible" to t. + ;; As a special case, allow dragging the region freely anywhere + ;; to the left, as this will never trigger its contents to be + ;; inserted into the overlays tracking it. + (setq drag-but-negligible + (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) + buffer-to-paste) + (if region-noncontiguous + (let ((dimensions (rectangle-dimensions start end)) + (start-coordinates + (rectangle-position-as-coordinates start)) + (point-to-paste-coordinates + (rectangle-position-as-coordinates + point-to-paste))) + (and (rectangle-intersect-p + start-coordinates dimensions + point-to-paste-coordinates dimensions) + (not (< (car point-to-paste-coordinates) + (car start-coordinates))))) + (and (<= (overlay-start + (car mouse-drag-and-drop-overlays)) + point-to-paste) + (<= point-to-paste + (overlay-end + (car mouse-drag-and-drop-overlays)))))))) + + ;; Show a tooltip. + (if mouse-drag-and-drop-region-show-tooltip + (tooltip-show text-tooltip) + (tooltip-hide)) + + ;; Show cursor and highlight the original region. + (when mouse-drag-and-drop-region-show-cursor + ;; Modify cursor even when point is out of frame. + (setq cursor-type (cond + ((not cursor-in-text-area) + nil) + ((or point-to-paste-read-only + drag-but-negligible) + 'hollow) + (t + 'bar))) + (when cursor-in-text-area + (dolist (overlay mouse-drag-and-drop-overlays) + (overlay-put overlay + 'face 'mouse-drag-and-drop-region)) + (deactivate-mark) ; Maintain region in other window. + (mouse-set-point event)))))) ;; Hide a tooltip. (when mouse-drag-and-drop-region-show-tooltip (tooltip-hide)) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 559679131b..0529d223db 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -446,7 +446,6 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (version (x-dnd-version-from-flags flags)) (more-than-3 (x-dnd-more-than-3-from-flags flags)) (dnd-source (aref data 0))) - (message "%s %s" version more-than-3) (if version ;; If flags is bad, version will be nil. (x-dnd-save-state window nil nil diff --git a/src/xfns.c b/src/xfns.c index c8aefec8d7..3e184571a0 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6547,7 +6547,7 @@ DEFUN ("x-set-mouse-absolute-pixel-position", Fx_set_mouse_absolute_pixel_positi The coordinates X and Y are interpreted in pixels relative to a position \(0, 0) of the selected frame's display. */) (Lisp_Object x, Lisp_Object y) - { +{ struct frame *f = SELECTED_FRAME (); if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) @@ -6582,6 +6582,85 @@ The coordinates X and Y are interpreted in pixels relative to a position return Qnil; } +DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 3, 0, + doc: /* Begin dragging contents on FRAME, with targets TARGETS. +TARGETS is a list of strings, which defines the X selection targets +that will be available to the drop target. Dragging starts when the +mouse is pressed on FRAME, and the contents of the selection +`XdndSelection' will be sent to the X window underneath the mouse +pointer (the drop target) when the mouse button is released. ACTION +is a symbol which tells the target what to do, and can be one of the +following: + + - `XdndActionCopy', which means to copy the contents from the drag + source (FRAME) to the drop target. + + - `XdndActionMove', which means to first take the contents of + `XdndSelection', and to delete whatever was saved into that + selection afterwards. + +There are also some other valid values of ACTION that depend on +details of both the drop target's implementation details and that of +Emacs. For that reason, they are not mentioned here. Consult +"Drag-and-Drop Protocol for the X Window System" for more details: +https://freedesktop.org/wiki/Specifications/XDND/. + +If ACTION is not specified or nil, `XdndActionCopy' is used instead. + +Block until the mouse buttons are released, then return the action +chosen by the target, or `nil' if the drop was not accepted by the +drop target. */) + (Lisp_Object targets, Lisp_Object action, Lisp_Object frame) +{ + struct frame *f = decode_window_system_frame (frame); + int ntargets = 0; + char *target_names[2048]; + Atom *target_atoms; + Lisp_Object lval; + Atom xaction; + + CHECK_LIST (targets); + + for (; CONSP (targets); targets = XCDR (targets)) + { + CHECK_STRING (XCAR (targets)); + + if (ntargets < 2048) + { + target_names[ntargets] = SSDATA (XCAR (targets)); + ntargets++; + } + else + error ("Too many targets"); + } + + if (NILP (action) || EQ (action, QXdndActionCopy)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionCopy; + else if (EQ (action, QXdndActionMove)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionMove; + else if (EQ (action, QXdndActionLink)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionLink; + else if (EQ (action, QXdndActionAsk)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionAsk; + else if (EQ (action, QXdndActionPrivate)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionPrivate; + else + signal_error ("Invalid drag-and-drop action", action); + + target_atoms = xmalloc (ntargets * sizeof *target_atoms); + + block_input (); + XInternAtoms (FRAME_X_DISPLAY (f), target_names, + ntargets, False, target_atoms); + unblock_input (); + + x_set_dnd_targets (target_atoms, ntargets); + lval = x_dnd_begin_drag_and_drop (f, FRAME_DISPLAY_INFO (f)->last_user_time, + xaction); + + return lval; +} + /************************************************************************ X Displays ************************************************************************/ @@ -9150,6 +9229,12 @@ syms_of_xfns (void) DEFSYM (Qreverse_landscape, "reverse-landscape"); #endif + DEFSYM (QXdndActionCopy, "XdndActionCopy"); + DEFSYM (QXdndActionMove, "XdndActionMove"); + DEFSYM (QXdndActionLink, "XdndActionLink"); + DEFSYM (QXdndActionAsk, "XdndActionAsk"); + DEFSYM (QXdndActionPrivate, "XdndActionPrivate"); + Fput (Qundefined_color, Qerror_conditions, pure_list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, @@ -9423,6 +9508,7 @@ eliminated in future versions of Emacs. */); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); defsubr (&Sx_double_buffered_p); + defsubr (&Sx_begin_drag); tip_timer = Qnil; staticpro (&tip_timer); tip_frame = Qnil; diff --git a/src/xselect.c b/src/xselect.c index a88c15aa95..cdc70d3e24 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2647,6 +2647,25 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, +/* Return the timestamp where ownership of SELECTION was asserted, or + nil if no local selection is present. */ + +Lisp_Object +x_timestamp_for_selection (struct x_display_info *dpyinfo, + Lisp_Object selection) +{ + Lisp_Object value, local_value; + + local_value = LOCAL_SELECTION (selection, dpyinfo); + + if (NILP (local_value)) + return Qnil; + + value = XCAR (XCDR (XCDR (local_value))); + + return value; +} + static void syms_of_xselect_for_pdumper (void); void diff --git a/src/xterm.c b/src/xterm.c index fc90e37043..8a4344f2a4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -770,6 +770,338 @@ static void x_update_opaque_region (struct frame *, XEvent *); static void x_scroll_bar_end_update (struct x_display_info *, struct scroll_bar *); #endif +static bool x_dnd_in_progress; +static Window x_dnd_last_seen_window; +static int x_dnd_last_protocol_version; +static Time x_dnd_selection_timestamp; + +static Window x_dnd_mouse_rect_target; +static XRectangle x_dnd_mouse_rect; +static Atom x_dnd_action; +static Atom x_dnd_wanted_action; + +static Atom *x_dnd_targets = NULL; +static int x_dnd_n_targets; +static struct frame *x_dnd_frame; + +#define X_DND_SUPPORTED_VERSION 5 + +static Window +x_dnd_get_target_window (struct x_display_info *dpyinfo, + int root_x, int root_y) +{ + 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; + + child_return = dpyinfo->root_window; + dest_x_return = root_x; + dest_y_return = root_y; + + /* Not strictly necessary, but satisfies GCC. */ + child = dpyinfo->root_window; + + while (child_return != None) + { + child = child_return; + + x_catch_errors (dpyinfo->display); + rc = XTranslateCoordinates (dpyinfo->display, + child_return, child_return, + dest_x_return, dest_y_return, + &dest_x_return, &dest_y_return, + &child_return); + + if (x_had_errors_p (dpyinfo->display) || !rc) + { + x_uncatch_errors_after_check (); + break; + } + + if (child_return) + { + rc = XTranslateCoordinates (dpyinfo->display, + child, child_return, + dest_x_return, dest_y_return, + &dest_x_return, &dest_y_return, + &dummy); + + if (x_had_errors_p (dpyinfo->display) || !rc) + { + x_uncatch_errors_after_check (); + return None; + } + } + + 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); + + /* Verify the proxy window exists. */ + XGetWindowAttributes (dpyinfo->display, proxy, &attrs); + + if (!x_had_errors_p (dpyinfo->display)) + child = proxy; + } + + x_uncatch_errors_after_check (); + } + + return child; +} + +static int +x_dnd_get_window_proto (struct x_display_info *dpyinfo, Window wdesc) +{ + Atom actual, value; + unsigned char *tmp_data; + int rc, format; + unsigned long n, left; + bool had_errors; + + if (wdesc == None || wdesc == FRAME_X_WINDOW (x_dnd_frame)) + return -1; + + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, wdesc, dpyinfo->Xatom_XdndAware, + 0, 1, False, XA_ATOM, &actual, &format, &n, &left, + &tmp_data); + had_errors = x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + if (had_errors || rc != Success || actual != XA_ATOM || format != 32 || n < 1) + return -1; + + value = (int) *(Atom *) tmp_data; + XFree (tmp_data); + + return (int) value; +} + +static void +x_dnd_send_enter (struct frame *f, Window target, int supported) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + int i; + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndEnter; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = (((unsigned int) min (X_DND_SUPPORTED_VERSION, + supported) << 24) + | (x_dnd_n_targets > 3 ? 1 : 0)); + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + for (i = 0; i < min (3, x_dnd_n_targets); ++i) + msg.xclient.data.l[i + 2] = x_dnd_targets[i]; + + if (x_dnd_n_targets > 3) + XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + dpyinfo->Xatom_XdndTypeList, XA_ATOM, 32, + PropModeReplace, (unsigned char *) x_dnd_targets, + x_dnd_n_targets); + + XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); +} + +static void +x_dnd_send_position (struct frame *f, Window target, int supported, + unsigned short root_x, unsigned short root_y, + Time timestamp, Atom action) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + + if (target == x_dnd_mouse_rect_target + && x_dnd_mouse_rect.width + && x_dnd_mouse_rect.height) + { + if (root_x >= x_dnd_mouse_rect.x + && root_x < (x_dnd_mouse_rect.x + + x_dnd_mouse_rect.width) + && root_y >= x_dnd_mouse_rect.y + && root_y < (x_dnd_mouse_rect.y + + x_dnd_mouse_rect.height)) + return; + } + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndPosition; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + msg.xclient.data.l[2] = (root_x << 16) | root_y; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + if (supported >= 3) + msg.xclient.data.l[3] = timestamp; + + if (supported >= 4) + msg.xclient.data.l[4] = action; + + XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); +} + +static void +x_dnd_send_leave (struct frame *f, Window target) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndLeave; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); +} + +static void +x_dnd_send_drop (struct frame *f, Window target, Time timestamp, + int supported) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndDrop; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + if (supported >= 1) + msg.xclient.data.l[2] = timestamp; + + XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); +} + +void +x_set_dnd_targets (Atom *targets, int ntargets) +{ + if (x_dnd_targets) + xfree (x_dnd_targets); + + x_dnd_targets = targets; + x_dnd_n_targets = ntargets; +} + +Lisp_Object +x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction) +{ + XEvent next_event; + struct input_event hold_quit; + int finish; + char *atom_name; + Lisp_Object action, ltimestamp; + + if (x_dnd_in_progress) + error ("A drag-and-drop session is already in progress"); + + ltimestamp = x_timestamp_for_selection (FRAME_DISPLAY_INFO (f), + QXdndSelection); + + if (NILP (ltimestamp)) + error ("No local value for XdndSelection"); + + if (BIGNUMP (ltimestamp)) + x_dnd_selection_timestamp = bignum_to_intmax (ltimestamp); + else + x_dnd_selection_timestamp = XFIXNUM (ltimestamp); + + x_dnd_in_progress = true; + x_dnd_frame = f; + x_dnd_last_seen_window = FRAME_X_WINDOW (f); + x_dnd_last_protocol_version = -1; + x_dnd_mouse_rect_target = None; + x_dnd_action = None; + x_dnd_wanted_action = xaction; + + while (x_dnd_in_progress) + { + hold_quit.kind = NO_EVENT; + + block_input (); + XNextEvent (FRAME_X_DISPLAY (f), &next_event); + + handle_one_xevent (FRAME_DISPLAY_INFO (f), + &next_event, &finish, &hold_quit); + unblock_input (); + + if (hold_quit.kind != NO_EVENT) + { + if (x_dnd_in_progress) + { + block_input (); + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (f, x_dnd_last_seen_window); + unblock_input (); + + x_dnd_in_progress = false; + x_dnd_frame = NULL; + } + + FRAME_DISPLAY_INFO (f)->grabbed = 0; + quit (); + } + } + + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + if (x_dnd_wanted_action != None) + { + block_input (); + atom_name = XGetAtomName (FRAME_X_DISPLAY (f), + x_dnd_wanted_action); + action = intern (atom_name); + XFree (atom_name); + unblock_input (); + + return action; + } + + return Qnil; +} + /* Flush display of frame F. */ static void @@ -10084,6 +10416,42 @@ handle_one_xevent (struct x_display_info *dpyinfo, { case ClientMessage: { + if (x_dnd_in_progress + && FRAME_DISPLAY_INFO (x_dnd_frame) == dpyinfo + && event->xclient.message_type == dpyinfo->Xatom_XdndStatus) + { + Window target; + + target = event->xclient.data.l[0]; + + if (x_dnd_last_protocol_version != -1 + && target == x_dnd_last_seen_window + && event->xclient.data.l[1] & 2) + { + x_dnd_mouse_rect_target = target; + x_dnd_mouse_rect.x = (event->xclient.data.l[2] & 0xffff0000) >> 16; + x_dnd_mouse_rect.y = (event->xclient.data.l[2] & 0xffff); + x_dnd_mouse_rect.width = (event->xclient.data.l[3] & 0xffff0000) >> 16; + x_dnd_mouse_rect.height = (event->xclient.data.l[3] & 0xffff); + } + else + x_dnd_mouse_rect_target = None; + + if (x_dnd_last_protocol_version != -1 + && target == x_dnd_last_seen_window) + { + if (event->xclient.data.l[1] & 1) + { + if (x_dnd_last_protocol_version >= 2) + x_dnd_wanted_action = event->xclient.data.l[4]; + else + x_dnd_wanted_action = dpyinfo->Xatom_XdndActionCopy; + } + else + x_dnd_wanted_action = None; + } + } + if (event->xclient.message_type == dpyinfo->Xatom_wm_protocols && event->xclient.format == 32) { @@ -11222,6 +11590,43 @@ handle_one_xevent (struct x_display_info *dpyinfo, clear_mouse_face (hlinfo); } + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + Window target; + + target = x_dnd_get_target_window (dpyinfo, + event->xmotion.x_root, + event->xmotion.y_root); + + if (target != x_dnd_last_seen_window) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_X_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + + x_dnd_wanted_action = None; + x_dnd_last_seen_window = target; + x_dnd_last_protocol_version + = x_dnd_get_window_proto (dpyinfo, target); + + if (target != None && x_dnd_last_protocol_version != -1) + x_dnd_send_enter (x_dnd_frame, target, + x_dnd_last_protocol_version); + } + + if (x_dnd_last_protocol_version != -1 && target != None) + x_dnd_send_position (x_dnd_frame, target, + x_dnd_last_protocol_version, + event->xmotion.x_root, + event->xmotion.y_root, + x_dnd_selection_timestamp, + dpyinfo->Xatom_XdndActionCopy); + + goto OTHER; + } + f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); #ifdef USE_GTK @@ -11573,6 +11978,38 @@ handle_one_xevent (struct x_display_info *dpyinfo, Lisp_Object tab_bar_arg = Qnil; bool tab_bar_p = false; bool tool_bar_p = false; + bool dnd_grab = false; + + for (int i = 1; i < 8; ++i) + { + if (i != event->xbutton.button + && event->xbutton.state & (Button1Mask << (i - 1))) + dnd_grab = true; + } + + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame) + && !dnd_grab + && event->xbutton.type == ButtonRelease) + { + x_dnd_in_progress = false; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_selection_timestamp, + x_dnd_last_protocol_version); + + x_dnd_last_protocol_version = -1; + x_dnd_last_seen_window = None; + x_dnd_frame = NULL; + x_set_dnd_targets (NULL, 0); + + goto OTHER; + } + + if (x_dnd_in_progress) + goto OTHER; memset (&compose_status, 0, sizeof (compose_status)); dpyinfo->last_mouse_glyph_frame = NULL; @@ -12372,6 +12809,41 @@ handle_one_xevent (struct x_display_info *dpyinfo, clear_mouse_face (hlinfo); } + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + Window target; + + target = x_dnd_get_target_window (dpyinfo, + xev->root_x, + xev->root_y); + + if (target != x_dnd_last_seen_window) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_X_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + + x_dnd_last_seen_window = target; + x_dnd_last_protocol_version + = x_dnd_get_window_proto (dpyinfo, target); + + if (target != None && x_dnd_last_protocol_version != -1) + x_dnd_send_enter (x_dnd_frame, target, + x_dnd_last_protocol_version); + } + + if (x_dnd_last_protocol_version != -1 && target != None) + x_dnd_send_position (x_dnd_frame, target, + x_dnd_last_protocol_version, + xev->root_x, xev->root_y, + x_dnd_selection_timestamp, + dpyinfo->Xatom_XdndActionCopy); + + goto XI_OTHER; + } + f = mouse_or_wdesc_frame (dpyinfo, xev->event); #ifdef USE_GTK @@ -12467,6 +12939,37 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif /* A fake XButtonEvent for x_construct_mouse_click. */ XButtonEvent bv; + bool dnd_grab = false; + + for (int i = 0; i < xev->buttons.mask_len * 8; ++i) + { + if (i != xev->detail && XIMaskIsSet (xev->buttons.mask, i)) + dnd_grab = true; + } + + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame) + && !dnd_grab + && xev->evtype == XI_ButtonRelease) + { + x_dnd_in_progress = false; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_selection_timestamp, + x_dnd_last_protocol_version); + + x_dnd_last_protocol_version = -1; + x_dnd_last_seen_window = None; + x_dnd_frame = NULL; + x_set_dnd_targets (NULL, 0); + + goto XI_OTHER; + } + + if (x_dnd_in_progress) + goto XI_OTHER; #ifdef USE_MOTIF #ifdef USE_TOOLKIT_SCROLL_BARS @@ -16554,6 +17057,16 @@ x_free_frame_resources (struct frame *f) struct scroll_bar *b; #endif + if (x_dnd_in_progress && f == x_dnd_frame) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (f, x_dnd_last_seen_window); + + x_dnd_in_progress = false; + x_dnd_frame = NULL; + } + block_input (); /* If a display connection is dead, don't try sending more @@ -18014,6 +18527,24 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("ShiftLock", Xatom_ShiftLock) ATOM_REFS_INIT ("Alt", Xatom_Alt) #endif + /* DND source. */ + ATOM_REFS_INIT ("XdndAware", Xatom_XdndAware) + ATOM_REFS_INIT ("XdndSelection", Xatom_XdndSelection) + ATOM_REFS_INIT ("XdndTypeList", Xatom_XdndTypeList) + ATOM_REFS_INIT ("XdndActionCopy", Xatom_XdndActionCopy) + ATOM_REFS_INIT ("XdndActionMove", Xatom_XdndActionMove) + ATOM_REFS_INIT ("XdndActionLink", Xatom_XdndActionLink) + ATOM_REFS_INIT ("XdndActionAsk", Xatom_XdndActionAsk) + ATOM_REFS_INIT ("XdndActionPrivate", Xatom_XdndActionPrivate) + ATOM_REFS_INIT ("XdndActionList", Xatom_XdndActionList) + ATOM_REFS_INIT ("XdndActionDescription", Xatom_XdndActionDescription) + ATOM_REFS_INIT ("XdndProxy", Xatom_XdndProxy) + ATOM_REFS_INIT ("XdndEnter", Xatom_XdndEnter) + ATOM_REFS_INIT ("XdndPosition", Xatom_XdndPosition) + ATOM_REFS_INIT ("XdndStatus", Xatom_XdndStatus) + ATOM_REFS_INIT ("XdndLeave", Xatom_XdndLeave) + ATOM_REFS_INIT ("XdndDrop", Xatom_XdndDrop) + ATOM_REFS_INIT ("XdndFinished", Xatom_XdndFinished) }; int i; @@ -18689,6 +19220,7 @@ With MS Windows, Haiku windowing or Nextstep, the value is t. */); Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); DEFSYM (Qsuper, "super"); Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier)); + DEFSYM (QXdndSelection, "XdndSelection"); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, doc: /* Which keys Emacs uses for the ctrl modifier. diff --git a/src/xterm.h b/src/xterm.h index 3638f322e5..225aaf4cad 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -561,6 +561,14 @@ struct x_display_info /* SM */ Atom Xatom_SM_CLIENT_ID; + /* DND source. */ + Atom Xatom_XdndAware, Xatom_XdndSelection, Xatom_XdndTypeList, + Xatom_XdndActionCopy, Xatom_XdndActionMove, Xatom_XdndActionLink, + Xatom_XdndActionAsk, Xatom_XdndActionPrivate, Xatom_XdndActionList, + Xatom_XdndActionDescription, Xatom_XdndProxy, Xatom_XdndEnter, + Xatom_XdndPosition, Xatom_XdndStatus, Xatom_XdndLeave, Xatom_XdndDrop, + Xatom_XdndFinished; + #ifdef HAVE_XKB /* Virtual modifiers */ Atom Xatom_Meta, Xatom_Super, Xatom_Hyper, Xatom_ShiftLock, Xatom_Alt; @@ -1359,6 +1367,9 @@ extern void x_scroll_bar_configure (GdkEvent *); extern void x_display_set_last_user_time (struct x_display_info *, Time); +extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom); +extern void x_set_dnd_targets (Atom *, int); + INLINE int x_display_pixel_height (struct x_display_info *dpyinfo) { @@ -1453,6 +1464,9 @@ extern Lisp_Object x_property_data_to_lisp (struct frame *, extern void x_clipboard_manager_save_frame (Lisp_Object); extern void x_clipboard_manager_save_all (void); +extern Lisp_Object x_timestamp_for_selection (struct x_display_info *, + Lisp_Object); + #ifdef USE_GTK extern bool xg_set_icon (struct frame *, Lisp_Object); extern bool xg_set_icon_from_xpm_data (struct frame *, const char **); commit bf7d66aa1aa165bedbab33075820d25f405fcad5 Author: Po Lu Date: Wed Mar 16 08:41:24 2022 +0800 Fix build with GTK 3.18.0 or earlier * src/gtkutil.c (xg_update_scroll_bar_pos) (xg_update_horizontal_scrollbar_pos): Avoid gtk_widget_queue_allocate on older GTK versions. diff --git a/src/gtkutil.c b/src/gtkutil.c index 174a1bffea..ec2864e34a 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -4736,7 +4736,9 @@ xg_update_scrollbar_pos (struct frame *f, if (wdesc) { gdk_window_move_resize (wdesc, left, top, width, height); +#if GTK_CHECK_VERSION (3, 20, 0) gtk_widget_queue_allocate (wparent); +#endif } #endif } @@ -4841,7 +4843,9 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, if (wdesc) { gdk_window_move_resize (wdesc, left, top, width, height); +#if GTK_CHECK_VERSION (3, 20, 0) gtk_widget_queue_allocate (wparent); +#endif } #endif } commit 5e8fbf7789613511061d78a42ca7f91bc831f786 Author: Eli Zaretskii Date: Tue Mar 15 21:21:20 2022 +0200 Clean up implementation of N0 per UAX#9 * src/bidi.c (bidi_resolve_brackets): Instead of requiring prev_for_neutral's type to be known, fall back on SOS, per the UBA. diff --git a/src/bidi.c b/src/bidi.c index 44b7422bdc..4d2c74b17c 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -2927,8 +2927,11 @@ bidi_resolve_brackets (struct bidi_it *bidi_it) else if (bidi_it->bracket_enclosed_type == STRONG_L /* N0c, N0d */ || bidi_it->bracket_enclosed_type == STRONG_R) { - eassert (bidi_it->prev_for_neutral.type != UNKNOWN_BT); - switch (bidi_it->prev_for_neutral.type) + bidi_type_t prev_type_for_neutral = bidi_it->prev_for_neutral.type; + + if (prev_type_for_neutral == UNKNOWN_BT) + prev_type_for_neutral = embedding_type; + switch (prev_type_for_neutral) { case STRONG_R: case WEAK_EN: commit 62e830c3d9f3a74c65309d1f8f18f45a7f065a9f (refs/remotes/origin/emacs-28) Author: Juri Linkov Date: Tue Mar 15 19:28:50 2022 +0200 * doc/misc/transient.texi: Fix @dircategory to "Emacs misc features" for dir. diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index f91d0e5c10..191fe8cd85 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -23,9 +23,9 @@ General Public License for more details. @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry -* Transient: (transient). Transient Commands. +* Transient: (transient). Transient Commands. @end direntry @finalout commit d932e256a497d80de9dbcea6a8e019d2cb063429 Author: Sam Steingold Date: Tue Mar 15 12:22:48 2022 -0400 Extract `gnus-collect-urls-from-article' from `gnus-summary-browse-url' * lisp/gnus-sum.el (gnus-collect-urls-from-article): New function, extracted from `gnus-summary-browse-url'. (gnus-summary-browse-url): Use it. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 1be5a48068..769ad6d9eb 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9445,6 +9445,16 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." (push primary urls)) (delete-dups urls))) +(defun gnus-collect-urls-from-article () + "Select the article and return the list of URLs in it. +See 'gnus-collect-urls'." + (gnus-summary-select-article) + (gnus-with-article-buffer + (article-goto-body) + ;; Back up a char, in case body starts with a button. + (backward-char) + (gnus-collect-urls))) + (defun gnus-shorten-url (url max) "Return an excerpt from URL not exceeding MAX characters." (if (<= (length url) max) @@ -9460,33 +9470,27 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." "Scan the current article body for links, and offer to browse them. Links are opened using `browse-url' unless a prefix argument is -given: Then `browse-url-secondary-browser-function' is used instead. +given: then `browse-url-secondary-browser-function' is used instead. If only one link is found, browse that directly, otherwise use completion to select a link. The first link marked in the article text with `gnus-collect-urls-primary-text' is the default." (interactive "P" gnus-summary-mode) - (let (urls target) - (gnus-summary-select-article) - (gnus-with-article-buffer - (article-goto-body) - ;; Back up a char, in case body starts with a button. - (backward-char) - (setq urls (gnus-collect-urls)) - (setq target - (cond ((= (length urls) 1) - (car urls)) - ((> (length urls) 1) - (completing-read - (format-prompt "URL to browse" - (gnus-shorten-url (car urls) 40)) - urls nil t nil nil (car urls))))) - (if target - (if external - (funcall browse-url-secondary-browser-function target) - (browse-url target)) - (message "No URLs found."))))) + (let* ((urls (gnus-collect-urls-from-article)) + (target + (cond ((= (length urls) 1) + (car urls)) + ((> (length urls) 1) + (completing-read + (format-prompt "URL to browse" + (gnus-shorten-url (car urls) 40)) + urls nil t nil nil (car urls)))))) + (if target + (if external + (funcall browse-url-secondary-browser-function target) + (browse-url target)) + (message "No URLs found.")))) (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. commit b63f325e2eff03a0b5c288d5930322442a87b72f Author: Stefan Monnier Date: Tue Mar 15 10:18:07 2022 -0400 * lisp/url/url-vars.el: Cosmetic changes (url-mime-separator-chars): Simplify. (url-interactive-p): Tweak docstring. diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 07a638f1cc..922f26d65b 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -1,7 +1,6 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool -*- lexical-binding:t -*- -;; Copyright (C) 1996-1999, 2001, 2004-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 1996-2022 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -131,7 +130,7 @@ Samples: This variable controls several other variables and is _NOT_ automatically updated. Call the function `url-setup-privacy-info' after modifying this variable." - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (url-setup-privacy-info)) :type '(radio (const :tag "None (you believe in the basic goodness of humanity)" :value none) @@ -204,10 +203,9 @@ from the ACCESS_proxy environment variables." :type 'boolean :group 'url-cache) -(defvar url-mime-separator-chars (mapcar 'identity - (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - "abcdefghijklmnopqrstuvwxyz" - "0123456789'()+_,-./=?")) +(defvar url-mime-separator-chars (append "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz" + "0123456789'()+_,-./=?") "Characters allowable in a MIME multipart separator.") (defcustom url-bad-port-list @@ -254,7 +252,7 @@ Generated according to current coding system priorities." (push (car elt) accum))) (nreverse accum))))) (concat (format "%s;q=1, " (pop ordered)) - (mapconcat 'symbol-name ordered ";q=0.5, ") + (mapconcat #'symbol-name ordered ";q=0.5, ") ";q=0.5"))) (defvar url-mime-charset-string nil @@ -425,7 +423,7 @@ This should be set, e.g. by mail user agents rendering HTML to avoid `bugs' which call home.") (defun url-interactive-p () - "Say whether the current request is from a interactive context." + "Non-nil when the current request is from an interactive context." (not (or url-request-noninteractive (bound-and-true-p url-http-noninteractive)))) @@ -435,5 +433,4 @@ This should be set, e.g. by mail user agents rendering HTML to avoid (make-obsolete-variable 'url-version 'emacs-version "28.1") (provide 'url-vars) - ;;; url-vars.el ends here commit 7d9f9d4d8e8b8836e317dc85dd757bb78200c20e Author: Stefan Monnier Date: Tue Mar 15 10:12:46 2022 -0400 doctex-mode: Try and fix bug#35140 * lisp/textmodes/tex-mode.el (doctex-syntax-propertize-rules): Add support for the new ^^X and consider the first ^ of ^^A to be the closing char for the previous comment. (doctex-font-lock-^^A): Simplify accordingly. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index ab94036d01..aa6fd24518 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2989,13 +2989,7 @@ There might be text before point." (put-text-property (1- (match-beginning 1)) (match-beginning 1) 'syntax-table - (if (= (1+ (line-beginning-position)) (match-beginning 1)) - ;; The `%' is a single-char comment, which Emacs - ;; syntax-table can't deal with. We could turn it - ;; into a non-comment, or use `\n%' or `%^' as the comment. - ;; Instead, we include it in the ^^A comment. - (string-to-syntax "< b") - (string-to-syntax ">"))) + (string-to-syntax ">")) (let ((end (line-end-position))) (if (< end (point-max)) (put-text-property @@ -3018,8 +3012,9 @@ There might be text before point." (defconst doctex-syntax-propertize-rules (syntax-propertize-precompile-rules latex-syntax-propertize-rules - ;; For DocTeX comment-in-doc. - ("\\(\\^\\)\\^A" (1 (doctex-font-lock-^^A)))))) + ;; For DocTeX comment-in-doc (DocTeX ≥3 also allows ^^X). + ;; We make the comment start on the second char because of bug#35140. + ("\\^\\(\\^\\)[AX]" (1 (doctex-font-lock-^^A)))))) (defvar doctex-font-lock-keywords (append tex-font-lock-keywords commit 55bcad776de9b7ca0047c78229390a4aa11a82ca Author: Lars Ingebrigtsen Date: Tue Mar 15 12:44:50 2022 +0100 Fix byte-code button in help--describe-command * lisp/help.el (help--describe-command): Fix byte-code button (bug#24235). diff --git a/lisp/help.el b/lisp/help.el index d60b586779..f1a617f850 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1388,7 +1388,8 @@ Return nil if the key sequence is too long." ((keymapp definition) (insert "Prefix Command\n")) ((byte-code-function-p definition) - (insert "[%s]\n" (buttonize "byte-code" #'disassemble definition))) + (insert (format "[%s]\n" + (buttonize "byte-code" #'disassemble definition)))) ((and (consp definition) (memq (car definition) '(closure lambda))) (insert (format "[%s]\n" commit 8a9b4cfdff3422d9085cf052a8f6d34d81d7ac96 Author: Lars Ingebrigtsen Date: Tue Mar 15 12:36:06 2022 +0100 Revert "New command `gnus-summary-browse-all-urls' bound to "v"" This reverts commit f52dcfd03ad542704d9a43faab0c33be09ab442e. It was never agreed that this should be added. diff --git a/etc/NEWS b/etc/NEWS index fc6c8b8254..d6b5da3902 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -699,11 +699,6 @@ displayed as emojis. Default nil. This is bound to 'W D e' and will display symbols that have emoji representation as emojis. -+++ -*** New command 'gnus-summary-browse-all-urls'. -This is for the rare cases when you want to open _all_ the URLs in the -article, and is bound to "v". - ** EIEIO +++ diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 098d3a067d..1be5a48068 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -2010,7 +2010,6 @@ increase the score of each group you read." "s" #'gnus-summary-isearch-article "TAB" #'gnus-summary-button-forward "" #'gnus-summary-button-backward - "v" #'gnus-summary-browse-all-urls "w" #'gnus-summary-browse-url "t" #'gnus-summary-toggle-header "g" #'gnus-summary-show-article @@ -2197,7 +2196,6 @@ increase the score of each group you read." "s" #'gnus-summary-isearch-article "TAB" #'gnus-summary-button-forward "" #'gnus-summary-button-backward - "v" #'gnus-summary-browse-all-urls "w" #'gnus-summary-browse-url "P" #'gnus-summary-print-article "S" #'gnus-sticky-article @@ -9447,16 +9445,6 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." (push primary urls)) (delete-dups urls))) -(defun gnus-collect-urls-from-article () - "Select the article and return the list of URLs in it. -See 'gnus-collect-urls'." - (gnus-summary-select-article) - (gnus-with-article-buffer - (article-goto-body) - ;; Back up a char, in case body starts with a button. - (backward-char) - (gnus-collect-urls))) - (defun gnus-shorten-url (url max) "Return an excerpt from URL not exceeding MAX characters." (if (<= (length url) max) @@ -9468,38 +9456,37 @@ See 'gnus-collect-urls'." (concat "#" target))))) (concat host (string-truncate-left rest (- max (length host))))))) -(defun gnus-summary-browse-url (&optional _external) +(defun gnus-summary-browse-url (&optional external) "Scan the current article body for links, and offer to browse them. Links are opened using `browse-url' unless a prefix argument is -given: then `browse-url-secondary-browser-function' is used instead. +given: Then `browse-url-secondary-browser-function' is used instead. If only one link is found, browse that directly, otherwise use completion to select a link. The first link marked in the article text with `gnus-collect-urls-primary-text' is the default." (interactive "P" gnus-summary-mode) - (let* ((urls (gnus-collect-urls-from-article)) - (target - (cond ((= (length urls) 1) - (car urls)) - ((> (length urls) 1) - (completing-read - (format-prompt "URL to browse" - (gnus-shorten-url (car urls) 40)) - urls nil t nil nil (car urls)))))) - (if target - (browse-url-button-open-url target) ; this handles the prefix arg - (message "No URLs found.")))) - -(defun gnus-summary-browse-all-urls (&optional _external) - "Scan the current article body for links, and browse them. - -Links are opened using `browse-url' unless a prefix argument is -given: then `browse-url-secondary-browser-function' is used instead." - (interactive "P" gnus-summary-mode) - (dolist (url (gnus-collect-urls-from-article)) - (browse-url-button-open-url url))) ; this handles the prefix arg + (let (urls target) + (gnus-summary-select-article) + (gnus-with-article-buffer + (article-goto-body) + ;; Back up a char, in case body starts with a button. + (backward-char) + (setq urls (gnus-collect-urls)) + (setq target + (cond ((= (length urls) 1) + (car urls)) + ((> (length urls) 1) + (completing-read + (format-prompt "URL to browse" + (gnus-shorten-url (car urls) 40)) + urls nil t nil nil (car urls))))) + (if target + (if external + (funcall browse-url-secondary-browser-function target) + (browse-url target)) + (message "No URLs found."))))) (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article.