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: Tue, 05 Dec 2017 13:57:13 +0900 (JST) Message-ID: <20171205.135713.548952609807146453.tak.kunihiro@gmail.com> References: <20171201.231604.2119730668205428159.tkk@misasa.okayama-u.ac.jp> <5A227D99.80001@gmx.at> <5A23CCB4.20608@gmx.at> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: Multipart/Mixed; boundary="--Next_Part(Tue_Dec__5_13_57_13_2017_901)--" Content-Transfer-Encoding: 7bit X-Trace: blaine.gmane.org 1512449959 26083 195.159.176.226 (5 Dec 2017 04:59:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 5 Dec 2017 04:59:19 +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 Tue Dec 05 05:58:05 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 1eM5IS-0004kK-9l for ged-emacs-devel@m.gmane.org; Tue, 05 Dec 2017 05:57:32 +0100 Original-Received: from localhost ([::1]:46408 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eM5IZ-00054p-Gv for ged-emacs-devel@m.gmane.org; Mon, 04 Dec 2017 23:57:39 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48319) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eM5IP-0004zm-JO for emacs-devel@gnu.org; Mon, 04 Dec 2017 23:57:31 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eM5IN-0007Zy-B1 for emacs-devel@gnu.org; Mon, 04 Dec 2017 23:57:29 -0500 Original-Received: from mail-pg0-x22d.google.com ([2607:f8b0:400e:c05::22d]:34068) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eM5IJ-0007Y4-A2; Mon, 04 Dec 2017 23:57:23 -0500 Original-Received: by mail-pg0-x22d.google.com with SMTP id j4so9901782pgp.1; Mon, 04 Dec 2017 20:57:21 -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=Ps5p7yFLMrmhiR8MMc1attb2DH/hQYAo3HOW155Sg6Q=; b=OT3wJTHA6+u1NBBVD5ocnR1C4OXUhruR6YX84ULKtX4lcNseBHdOgNYPztihkb8V6u Z06erlaOq/xwDwjSTGaisWH93zBNlyWgOdQawrUvvXM+wyqK8ZskKQIcNKZXHH5dwhaq RiU6GbAVT2rdHHywzHE1ZhorP8BCF9LdKCMtHMkDPK3U3J3qIVW9mr2wEayGS5RZDQng 7GlIFp2Ft2FOFFZgoYFMTqgdolKcgPp+4KwxBjGwLqLxBM7QpORcgGADKgcmMahVwOSB Ni8VMvw7xTjBaTCSGBaekGD1d4nftk06n4mZFTdYZiKOLZa1qaFF4oaAfXOzZsNkJMRb dgDg== 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=Ps5p7yFLMrmhiR8MMc1attb2DH/hQYAo3HOW155Sg6Q=; b=Yt83JkLoBe8BLYwPOvqd/37b+bhOm9yxN1TbiFYWP+pTvdiK6l4YgeGmWrs5ipZ9Em NSwtz8XuGF9G0w3dZbf7OC1bH12O/cI1e6Xpck53s59RknLGsSOyqourrWgaKTUHtfjA oQZboMIuyrQgM1+L93xPxw/U+9uWzl4z+PujvZsvMRpeMaPG5TwKChd4We/vd5rtMk+P HqVlSxvwU7oAnzHInGSWzZjAZrwF5wlw8UGLn61rdRuJWp7QLZ7Qjvdd98/W+vPQWjMO 0lnOyyvtgIJ+MH1QsDo/Njn0hoQT7C7ELfVnYosl+9548QlUepHQ0zWWMvM6Kr2huFJB x21Q== X-Gm-Message-State: AJaThX7qaHQvyTkc6uMIjkbk9xMQy+iNmHBMV2nf+XaVAmYReTOFyVDe ij+h5vq5U4lwQacGlo6btRI= X-Google-Smtp-Source: AGs4zMZvSGyq8jMI/DpggocknOC9hkHXb4r9y7rsZxv88DCJBdGaG7Mz+/PXmo0t39wqhMVJE9FjAg== X-Received: by 10.99.9.133 with SMTP id 127mr15760963pgj.16.1512449840457; Mon, 04 Dec 2017 20:57:20 -0800 (PST) Original-Received: from localhost (vesta.misasa.okayama-u.ac.jp. [150.46.48.154]) by smtp.gmail.com with ESMTPSA id u6sm26459747pfk.126.2017.12.04.20.57.17 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Mon, 04 Dec 2017 20:57:19 -0800 (PST) In-Reply-To: <5A23CCB4.20608@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:400e:c05::22d 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:220730 Archived-At: ----Next_Part(Tue_Dec__5_13_57_13_2017_901)-- Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit > So I think that we should remember for each window on the involved frame > its start and point positions and restore them unless the window is the > one where the drop happened. I attached a patch for this which also > restores the cursor type of every window. The patch includes all your > latest changes (so it should apply against the repository version) and > is largely untested but should give you the idea what to do. Thank you. I think that by your revision, the problem was solved. I also revised code not to let user drop the text to minibuffer. This time, I attach a patch as a separated file. > Please consider also the following four bindings in `mouse-drag-track': > > (echo-keystrokes 0) > > (make-cursor-line-fully-visible nil) > > ;; Suppress automatic hscrolling, because that is a nuisance > ;; when setting point near the right fringe (but see below). > (auto-hscroll-mode-saved auto-hscroll-mode) > > (old-track-mouse track-mouse) > > Maybe they are useful for you as well (a lot of experience went into the > coding of that function). I wonder if this is beyond my skill. Could you revise this part? > Also please consider to restrict the size of the tooltip shown (think of > someone who wants to drag the entire text of a buffer). I think > `mouse-drag-and-drop-region-show-tooltip' should optionally allow to > specify a number giving the maximum length of the string which I would > divide into one half for the beginning of the text, one half for the end > and ellipses in between. It is a good idea. Now tooltip shows only substring. I think mouse-drag-and-drop-region-show-tooltip should be something like 256 by default. > Finally, please think of how to embed your function into other packages: > For example, how would a user drag file names from one dired buffer to > another in order to copy or move the associated files from one directory > to another? Can we accomodate an exit function to do the pasting job? It is a good idea. I suppose you mean dragging `file' when event-start is with 'dired-filename. ----Next_Part(Tue_Dec__5_13_57_13_2017_901)-- 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..f1ca0ec --- 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,248 @@ 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 (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))) + (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(Tue_Dec__5_13_57_13_2017_901)----