From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tak Kunihiro Newsgroups: gmane.emacs.devel Subject: Re: mouse-drag-and-drop-region Date: Wed, 06 Dec 2017 18:29:39 +0900 (JST) Message-ID: <20171206.182939.453729203755008958.tak.kunihiro@gmail.com> References: <5A23CCB4.20608@gmx.at> <20171205.135713.548952609807146453.tak.kunihiro@gmail.com> <5A265E99.8030908@gmx.at> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: Multipart/Mixed; boundary="--Next_Part(Wed_Dec__6_18_29_39_2017_606)--" Content-Transfer-Encoding: 7bit X-Trace: blaine.gmane.org 1512577131 17746 195.159.176.226 (6 Dec 2017 16:18:51 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 6 Dec 2017 16:18:51 +0000 (UTC) Cc: eliz@gnu.org, tak.kunihiro@gmail.com, agrambot@gmail.com, emacs-devel@gnu.org To: rudalics@gmx.at Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Dec 06 17:18:43 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eMcOr-0001Nn-7K for ged-emacs-devel@m.gmane.org; Wed, 06 Dec 2017 17:18:21 +0100 Original-Received: from localhost ([::1]:54554 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eMW3i-000710-Me for ged-emacs-devel@m.gmane.org; Wed, 06 Dec 2017 04:32:06 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41426) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eMW1X-0006FC-Eg for emacs-devel@gnu.org; Wed, 06 Dec 2017 04:29:53 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eMW1V-0008NK-EA for emacs-devel@gnu.org; Wed, 06 Dec 2017 04:29:51 -0500 Original-Received: from mail-io0-x232.google.com ([2607:f8b0:4001:c06::232]:43876) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eMW1R-0008I5-Gl; Wed, 06 Dec 2017 04:29:45 -0500 Original-Received: by mail-io0-x232.google.com with SMTP id s37so1948364ioe.10; Wed, 06 Dec 2017 01:29:45 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=date:message-id:to:cc:subject:from:in-reply-to:references :mime-version:content-transfer-encoding; bh=PrKQbYfD66/M65U+V7GgQ8TMdFPoFmWqHWiZevuxYaQ=; b=Hoa8uGJySsE9VVQQuXuTo7srzYV3YBqfGAuymma4pve+CIH9bUB7wXVaxD4ss4/8ne +i8uGv12LfvZdt/WhZeL+x8iSYGpWO0iMNEpVcqOweh6zL4SiryPZstxY4yZWdDnBzoF npA1P6oMKDuRh65xvo/ENlYLtAQqxRin7XsU0+Dj4PGybGiP6z0z40njtPpfGMUbGlCA lEhNCdSjXfcs4uPmsI8ryUlt0Fq0+6PlHNCwrwsX5SZ3w6vTmHa9Ri658C5wgHYv6XTJ DjnEvZAC48NEv9DtkCsxThmJvuXrRo2gh3g5CiDuFKsMuKeRJ4L64m0fjcZaBinxZ3Ix YOJA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:date:message-id:to:cc:subject:from:in-reply-to :references:mime-version:content-transfer-encoding; bh=PrKQbYfD66/M65U+V7GgQ8TMdFPoFmWqHWiZevuxYaQ=; b=ahd/vaYrYUxLry7upGOc6/dU0pv6i06llYwM8zsHmcA/e+k1lkmnPsJUrYIpL5nRkR aurOQpr+gMQRcpzalWuAtG54drap8+iuEQEMghrN9kIieLTD2DYfAMJ9hCRcFlBcvLfb er2U4AXfw/YICz6rY6+ZCJAEZgH7DgS9wdGOMNQp6I+AK9ij9wPIdsU40e9FeENqy7Ju telKdQnQkOUMOD9BA8aExMsPaJL0FjGanLwx43gNca0Uk3uXred3/Anl83xX4C05oLV7 6pTVj9MD/k2gkCNgqMEEBq22M/sZbiknUAcfBf/lETTAVmgt/Us4bXXO0Td7yWqSHy70 sALw== X-Gm-Message-State: AKGB3mK0FS6Hofv7Uw97OlFyzvjwnPMUwEwM3ZNPWVFXf++DORVjC8gx QXP5mraQT/qmWCMqQ9ojAyVbUA== X-Google-Smtp-Source: AGs4zMYsN91WXXEUqNIm5PArRBuc14GngsGtgZpLfFF2/AeKmMlVdNmiQTHHQJluD5KFSn0W/FUSHQ== X-Received: by 10.107.46.92 with SMTP id i89mr17711451ioo.8.1512552584419; Wed, 06 Dec 2017 01:29:44 -0800 (PST) Original-Received: from localhost (vesta.misasa.okayama-u.ac.jp. [150.46.48.154]) by smtp.gmail.com with ESMTPSA id 25sm1125939iol.79.2017.12.06.01.29.41 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Wed, 06 Dec 2017 01:29:43 -0800 (PST) In-Reply-To: <5A265E99.8030908@gmx.at> X-Mailer: Mew version 6.7 on Emacs 25.3 / Mule 6.0 (HANACHIRUSATO) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:4001:c06::232 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:220758 Archived-At: ----Next_Part(Wed_Dec__6_18_29_39_2017_606)-- Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit Thank you for comments. > I'd expect the initial feedback via a tooltip to appear right away > as soon as I start dragging. Personally, I'd even show the tooltip > text when the mouse is temporarily out of the frame and leave it to > the cursor to indicate whether a drop is possible at that position. I think you are right. I revised the code back. >>> (echo-keystrokes 0) >>> (make-cursor-line-fully-visible nil) >>> (auto-hscroll-mode-saved auto-hscroll-mode) >>> (old-track-mouse track-mouse) > We probably should just wait until real problems show up in this > regard. Thank you for the comments. I agree. Let's postpone. > (dolist (state states) > (let ((window (car state))) > (unless (eq window window-dropped) > (set-window-start window (nth 1 state) 'noforce) > (set-marker (nth 1 state) nil) > ;; If window is selected, the following automatically sets > ;; point for that window's buffer. > (set-window-point window (nth 2 state)) > (set-marker (nth 2 state) nil)) > (with-current-buffer (window-buffer window) > (setq cursor-type (nth 3 state))))) I found a glitch. I think (unless (eq window window-dropped)... should be something like (when (and window-dropped (not (eq window window-dropped)))... . I attach the revise code. ----Next_Part(Wed_Dec__6_18_29_39_2017_606)-- Content-Type: Text/X-Patch; charset=us-ascii Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="mouse.el.diff" diff --git a/lisp/mouse.el b/lisp/mouse.el index 17d1732..aacb550 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2361,6 +2361,33 @@ text is copied instead of being cut." :version "26.1" :group 'mouse) +(defcustom mouse-drag-and-drop-region-cut-when-buffers-differ nil + "If non-nil, cut text also when source and destination buffers differ. +If this option is nil, `mouse-drag-and-drop-region' will leave +the text in the source buffer alone when dropping it in a +different buffer. If this is non-nil, it will cut the text just +as it does when dropping text in the source buffer." + :type 'boolean + :version "26.1" + :group 'mouse) + +(defcustom mouse-drag-and-drop-region-show-tooltip 256 + "If non-nil, text is shown by a tooltip in a graphic display. +If this option is an integer, such as 32 or 64, a number giving +the maximum length of the string shown in tooltip." + :type 'integer + :version "26.1" + :group 'mouse) + +(defvar mouse-drag-and-drop-region-show-cursor t + "If non-nil, move point with mouse cursor during dragging. +In addition, highlight the original region with +`mouse-drag-and-drop-region-face'.") + +(defvar mouse-drag-and-drop-region-face 'region + "Face to highlight the original text during dragging. +See also `mouse-drag-and-drop-region-show-cursor'.") + (defun mouse-drag-and-drop-region (event) "Move text in the region to point where mouse is dragged to. The transportation of text is also referred as `drag and drop'. @@ -2369,66 +2396,251 @@ modifier key was pressed when dropping, and the value of the variable `mouse-drag-and-drop-region' is that modifier, the text is copied instead of being cut." (interactive "e") - (require 'tooltip) - (let ((start (region-beginning)) - (end (region-end)) - (point (point)) - (buffer (current-buffer)) - (window (selected-window)) - value-selection) - (track-mouse - ;; When event was click instead of drag, skip loop - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - ;; Handle `mouse-autoselect-window'. - (eq (car-safe event) 'select-window))) - (unless value-selection ; initialization - (delete-overlay mouse-secondary-overlay) - (setq value-selection (buffer-substring start end)) - (move-overlay mouse-secondary-overlay start end)) ; (deactivate-mark) - (ignore-errors (deactivate-mark) ; care existing region in other window - (mouse-set-point event) - (tooltip-show value-selection))) - (tooltip-hide)) - ;; Do not modify buffer under mouse when "event was click", - ;; "drag negligible", or - ;; "drag to read-only". - (if (or (equal (mouse-posn-property (event-end event) 'face) 'region) ; "event was click" - (member 'secondary-selection ; "drag negligible" - (mapcar (lambda (xxx) (overlay-get xxx 'face)) - (overlays-at (posn-point (event-end event))))) - buffer-read-only) - ;; Do not modify buffer under mouse. - (cond - ;; "drag negligible" or "drag to read-only", restore region. - (value-selection - (select-window window) ; In case miss drag to other window - (goto-char point) - (setq deactivate-mark nil) - (activate-mark)) - ;; "event was click" - (t - (deactivate-mark) - (mouse-set-point event))) - ;; Modify buffer under mouse by inserting text. - (push-mark) - (insert value-selection) - (when (not (equal (mark) (point))) ; on success insert - (setq deactivate-mark nil) - (activate-mark)) ; have region on destination - ;; Take care of initial region on source. - (if (equal (current-buffer) buffer) ; when same buffer - (let (deactivate-mark) ; remove text - (unless (member mouse-drag-and-drop-region (event-modifiers event)) - (kill-region (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)))) - (let ((window1 (selected-window))) ; when beyond buffer - (select-window window) - (goto-char point) ; restore point on source window - (activate-mark) ; restore region - (select-window window1)))) - (delete-overlay mouse-secondary-overlay))) + (let* ((mouse-button (event-basic-type last-input-event)) + (mouse-drag-and-drop-region-show-tooltip + (when (and mouse-drag-and-drop-region-show-tooltip + (display-multi-frame-p) + (require 'tooltip)) + mouse-drag-and-drop-region-show-tooltip)) + (start (region-beginning)) + (end (region-end)) + (point (point)) + (buffer (current-buffer)) + (window (selected-window)) + (text-from-read-only buffer-read-only) + (mouse-drag-and-drop-overlay (make-overlay start end)) + point-to-paste + point-to-paste-read-only + window-to-paste + buffer-to-paste + cursor-in-text-area + no-modifier-on-drop + drag-but-negligible + clicked + value-selection ; This remains nil when event was "click". + text-tooltip + states + window-dropped) + + ;; STATES stores for each window on this frame its start and point + ;; positions so we can restore them on all windows but for the one + ;; where the drop occurs. For inter-frame drags we'll have to do + ;; this for all windows on all visible frames. In addition we save + ;; also the cursor type for the window's buffer so we can restore it + ;; in case we modified it. + ;; https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00090.html + (walk-window-tree + (lambda (window) + (setq states + (cons + (list + window + (copy-marker (window-start window)) + (copy-marker (window-point window)) + (with-current-buffer (window-buffer window) + cursor-type)) + states)))) + + (condition-case nil + (progn + (track-mouse + ;; When event was "click" instead of "drag", skip loop. + (while (progn + ;; https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00364.html + (setq event (read-key)) ; read-event or read-key + (or (mouse-movement-p event) + ;; Handle `mouse-autoselect-window'. + (eq (car-safe event) 'select-window))) + ;; Obtain the dragged text in region. When the loop was + ;; skipped, value-selection remains nil. + (unless value-selection + (setq value-selection (buffer-substring start end)) + (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. + ;; https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00663.html + ;; (add-text-properties (region-beginning) (region-end) '(read-only t)) + (setq text-from-read-only (or text-from-read-only + (get-text-property start 'read-only) + (not (equal + (next-single-char-property-change start 'read-only nil end) + end))))) + (setq window-to-paste (posn-window (event-end event))) + (setq point-to-paste (posn-point (event-end event))) + (setq buffer-to-paste (let (buf) ; Set nil when target buffer is minibuffer. + (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) + ;; (add-text-properties (region-beginning) (region-end) '(read-only t)) + (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. + (setq drag-but-negligible + (member mouse-drag-and-drop-region-face + (mapcar (lambda (xxx) (overlay-get xxx 'face)) + (overlays-at point-to-paste))))) + + ;; Show a tooltip. + (if mouse-drag-and-drop-region-show-tooltip + ;; (and mouse-drag-and-drop-region-show-tooltip + ;; (not drag-but-negligible) + ;; (not point-to-paste-read-only) + ;; cursor-in-text-area) + (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 + (overlay-put mouse-drag-and-drop-overlay + 'face mouse-drag-and-drop-region-face) + (deactivate-mark) ; Maintain region in other window. + (mouse-set-point event))))) + + ;; Hide a tooltip. + (when mouse-drag-and-drop-region-show-tooltip (tooltip-hide)) + + ;; Check if modifier was pressed on drop. + (setq no-modifier-on-drop + (not (member mouse-drag-and-drop-region (event-modifiers event)))) + + ;; Check if event was "click". + (setq clicked (not value-selection)) + + ;; Restore status on drag to outside of text-area or non-mouse input. + ;; https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00486.html + (when (or (not cursor-in-text-area) + (not (equal (event-basic-type event) mouse-button))) + (setq drag-but-negligible t + no-modifier-on-drop t)) + + ;; Do not modify any buffers when event is "click", + ;; "drag but negligible", or "drag to read-only". + (let* ((mouse-drag-and-drop-region-cut-when-buffers-differ + (if no-modifier-on-drop + mouse-drag-and-drop-region-cut-when-buffers-differ + (not mouse-drag-and-drop-region-cut-when-buffers-differ))) + (wanna-paste-to-same-buffer (equal buffer-to-paste buffer)) + (wanna-cut-on-same-buffer (and wanna-paste-to-same-buffer + no-modifier-on-drop)) + (wanna-cut-on-other-buffer (and (not wanna-paste-to-same-buffer) + mouse-drag-and-drop-region-cut-when-buffers-differ)) + (cannot-paste (or point-to-paste-read-only + (when (or wanna-cut-on-same-buffer + wanna-cut-on-other-buffer) + text-from-read-only)))) + + (cond + ;; Move point within region. + (clicked + (deactivate-mark) + (mouse-set-point event)) + ;; Undo operation. Set back the original text as region. + ((or (and drag-but-negligible + no-modifier-on-drop) + cannot-paste) + ;; Inform user either source or destination buffer cannot be modified. + (when (and (not drag-but-negligible) + cannot-paste) + (message "Buffer is read-only")) + + ;; Select source window back and restore region. + ;; (set-window-point window point) + (select-window window) + (goto-char point) + (setq deactivate-mark nil) + (activate-mark)) + ;; Modify buffers. + (t + ;; * DESTINATION BUFFER:: + ;; Insert the text to destination buffer under mouse. + (select-window window-to-paste) + (setq window-dropped window-to-paste) + (goto-char point-to-paste) + (push-mark) + (insert value-selection) + ;; On success, set the text as region on destination buffer. + (when (not (equal (mark) (point))) + (setq deactivate-mark nil) + (activate-mark)) + + ;; * SOURCE BUFFER:: + ;; Set back the original text as region or delete the original + ;; text, on source buffer. + (if wanna-paste-to-same-buffer + ;; When source buffer and destination buffer are the same, + ;; remove the original text. + (when no-modifier-on-drop + (let (deactivate-mark) + (delete-region (overlay-start mouse-drag-and-drop-overlay) + (overlay-end mouse-drag-and-drop-overlay)))) + ;; When source buffer and destination buffer are different, + ;; keep (set back the original text as region) or remove the + ;; original text. + (select-window window) ; Select window with source buffer. + (goto-char point) ; Move point to the original text on source buffer. + + (if mouse-drag-and-drop-region-cut-when-buffers-differ + ;; Remove the dragged text from source buffer like + ;; operation `cut'. + (delete-region (overlay-start mouse-drag-and-drop-overlay) + (overlay-end mouse-drag-and-drop-overlay)) + ;; Set back the dragged text as region on source buffer + ;; like operation `copy'. + (activate-mark)) + (select-window window-to-paste)))))) + (error nil)) + + ;; Clean up. + (delete-overlay mouse-drag-and-drop-overlay) + + ;; Restore old states but for the window where the drop + ;; occurred. Restore cursor types for all windows. + (dolist (state states) + (let ((window (car state))) + (when (and window-dropped + (not (eq window window-dropped))) + ;; unless (eq window window-dropped) + (set-window-start window (nth 1 state) 'noforce) + (set-marker (nth 1 state) nil) + ;; If window is selected, the following automatically sets + ;; point for that window's buffer. + (set-window-point window (nth 2 state)) + (set-marker (nth 2 state) nil)) + (with-current-buffer (window-buffer window) + (setq cursor-type (nth 3 state))))))) ;;; Bindings for mouse commands. ----Next_Part(Wed_Dec__6_18_29_39_2017_606)----