From: Stefan Monnier Date: Sun, 11 May 2014 05:49:14 +0000 (-0400) Subject: * lisp/mouse.el: Use the normal toplevel loop while dragging. X-Git-Tag: emacs-25.0.90~2640^2~122 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fbd5cc6ca433332307608c6dd03e28e2391c64bb;p=emacs.git * lisp/mouse.el: Use the normal toplevel loop while dragging. (mouse-set-point): Handle multi-clicks. (mouse-set-region): Handle multi-clicks for drags. (mouse-drag-region): Update call accordingly. (mouse-drag-track): Remove `do-mouse-drag-region-post-process' hack. Use the normal event loop instead of a local while/read-event loop. (global-map): Remove redundant bindings for double/triple-mouse-1. * lisp/xt-mouse.el (xterm-mouse-translate-1): Only process one event at a time. Generate synthetic down events when the protocol only sends up events. (xterm-mouse-last): Remove. (xterm-mouse--read-event-sequence-1000): Use xterm-mouse-last-down terminal parameter instead. (xterm-mouse--set-click-count): New function. (xterm-mouse-event): Detect/generate double/triple clicks. * lisp/reveal.el (reveal-close-old-overlays): Don't close while dragging. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 72c6d943710..52c1f0c164a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,21 @@ 2014-05-11 Stefan Monnier + * mouse.el: Use the normal toplevel loop while dragging. + (mouse-set-point): Handle multi-clicks. + (mouse-set-region): Handle multi-clicks for drags. + (mouse-drag-region): Update call accordingly. + (mouse-drag-track): Remove `do-mouse-drag-region-post-process' hack. + Use the normal event loop instead of a local while/read-event loop. + (global-map): Remove redundant bindings for double/triple-mouse-1. + * xt-mouse.el (xterm-mouse-translate-1): Only process one event at a time. + Generate synthetic down events when the protocol only sends up events. + (xterm-mouse-last): Remove. + (xterm-mouse--read-event-sequence-1000): Use xterm-mouse-last-down + terminal parameter instead. + (xterm-mouse--set-click-count): New function. + (xterm-mouse-event): Detect/generate double/triple clicks. + * reveal.el (reveal-close-old-overlays): Don't close while dragging. + * info.el (Info-quoted): New face. (Info-mode-font-lock-keywords): New var. (Info-mode): Use it. diff --git a/lisp/mouse.el b/lisp/mouse.el index 9b1422f0658..ca94a343c1a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -514,14 +514,18 @@ must be one of the symbols `header', `mode', or `vertical'." (interactive "e") (mouse-drag-line start-event 'vertical)) -(defun mouse-set-point (event) +(defun mouse-set-point (event &optional promote-to-region) "Move point to the position clicked on with the mouse. -This should be bound to a mouse click event type." - (interactive "e") +This should be bound to a mouse click event type. +If PROMOTE-TO-REGION is non-nil and event is a multiple-click, +select the corresponding element around point." + (interactive "e\np") (mouse-minibuffer-check event) - ;; Use event-end in case called from mouse-drag-region. - ;; If EVENT is a click, event-end and event-start give same value. - (posn-set-point (event-end event))) + (if (and promote-to-region (> (event-click-count event) 1)) + (mouse-set-region event) + ;; Use event-end in case called from mouse-drag-region. + ;; If EVENT is a click, event-end and event-start give same value. + (posn-set-point (event-end event)))) (defvar mouse-last-region-beg nil) (defvar mouse-last-region-end nil) @@ -534,6 +538,8 @@ This should be bound to a mouse click event type." (eq mouse-last-region-end (region-end)) (eq mouse-last-region-tick (buffer-modified-tick)))) +(defvar mouse--drag-start-event nil) + (defun mouse-set-region (click) "Set the region to the text dragged over, and copy to kill ring. This should be bound to a mouse drag event. @@ -543,7 +549,22 @@ command alters the kill ring or not." (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) (let ((beg (posn-point (event-start click))) - (end (posn-point (event-end click)))) + (end (posn-point (event-end click))) + (click-count (event-click-count click))) + (let ((drag-start (terminal-parameter nil 'mouse-drag-start))) + ;; Drag events don't come with a click count, sadly, so we hack + ;; our way around this problem by remembering the start-event in + ;; `mouse-drag-start' and fetching the click-count from there. + (when drag-start + (when (and (<= click-count 1) + (equal beg (posn-point (event-start drag-start)))) + (setq click-count (event-click-count drag-start))) + (setf (terminal-parameter nil 'mouse-drag-start) nil))) + (when (and (integerp beg) (integerp end)) + (let ((range (mouse-start-end beg end (1- click-count)))) + (if (< end beg) + (setq end (nth 0 range) beg (nth 1 range)) + (setq beg (nth 0 range) end (nth 1 range))))) (and mouse-drag-copy-region (integerp beg) (integerp end) ;; Don't set this-command to `kill-region', so a following ;; C-w won't double the text in the kill ring. Ignore @@ -637,13 +658,11 @@ Upon exit, point is at the far edge of the newly visible text." Highlight the drag area as you move the mouse. This must be bound to a button-down mouse event. In Transient Mark mode, the highlighting remains as long as the mark -remains active. Otherwise, it remains until the next input event. - -If the click is in the echo area, display the `*Messages*' buffer." +remains active. Otherwise, it remains until the next input event." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) - (mouse-drag-track start-event t)) + (mouse-drag-track start-event)) (defun mouse-posn-property (pos property) @@ -747,12 +766,9 @@ at the same position." "mouse-1" (substring msg 7))))))) msg) -(defun mouse-drag-track (start-event &optional - do-mouse-drag-region-post-process) +(defun mouse-drag-track (start-event) "Track mouse drags by highlighting area between point and cursor. -The region will be defined with mark and point. -DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by -`mouse-drag-region'." +The region will be defined with mark and point." (mouse-minibuffer-check start-event) (setq mouse-selection-click-count-buffer (current-buffer)) (deactivate-mark) @@ -765,8 +781,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) - (start-window-start (window-start start-window)) - (start-hscroll (window-hscroll start-window)) (bounds (window-edges start-window)) (make-cursor-line-fully-visible nil) (top (nth 1 bounds)) @@ -777,9 +791,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (click-count (1- (event-click-count start-event))) ;; 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) - (auto-hscroll-mode nil) - moved-off-start event end end-point) + (auto-hscroll-mode-saved auto-hscroll-mode)) (setq mouse-selection-click-count click-count) ;; In case the down click is in the middle of some intangible text, @@ -798,23 +810,21 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (push-mark (nth 0 range) t t) (goto-char (nth 1 range))) - ;; Track the mouse until we get a non-movement event. - (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (memq (car-safe event) '(switch-frame select-window)))) - (unless (memq (car-safe event) '(switch-frame select-window)) - ;; Automatic hscrolling did not occur during the call to - ;; `read-event'; but if the user subsequently drags the - ;; mouse, go ahead and hscroll. - (let ((auto-hscroll-mode auto-hscroll-mode-saved)) - (redisplay)) - (setq end (event-end event) - end-point (posn-point end)) - ;; Note whether the mouse has left the starting position. + (setf (terminal-parameter nil 'mouse-drag-start) start-event) + (setq track-mouse t) + (setq auto-hscroll-mode nil) + + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] + (lambda (event) (interactive "e") + (let* ((end (event-end event)) + (end-point (posn-point end))) (unless (eq end-point start-point) - (setq moved-off-start t)) + ;; As soon as the user moves, we can re-enable auto-hscroll. + (setq auto-hscroll-mode auto-hscroll-mode-saved)) (if (and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) (mouse--drag-set-mark-and-point start-point @@ -828,55 +838,12 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by ((>= mouse-row bottom) (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) nil start-point)))))))) - - ;; Handle the terminating event if possible. - (when (consp event) - ;; Ensure that point is on the end of the last event. - (when (and (setq end-point (posn-point (event-end event))) - (eq (posn-window end) start-window) - (integer-or-marker-p end-point) - (/= start-point end-point)) - (mouse--drag-set-mark-and-point start-point - end-point click-count)) - - ;; Find its binding. - (let* ((fun (key-binding (vector (car event)))) - ;; FIXME This doesn't make sense, because - ;; event-click-count always returns something >= 1. - (do-multi-click (and (> (event-click-count event) 0) - (functionp fun) - (not (memq fun '(mouse-set-point - mouse-set-region)))))) - (if (and (/= (mark) (point)) - (not do-multi-click)) - - ;; If point has moved, finish the drag. - (let* (last-command this-command) - (and mouse-drag-copy-region - do-mouse-drag-region-post-process - (let (deactivate-mark) - (copy-region-as-kill (mark) (point))))) - - ;; Otherwise, run binding of terminating up-event. + map) + t (lambda () + (setq track-mouse nil) + (setq auto-hscroll-mode auto-hscroll-mode-saved) (deactivate-mark) - (if do-multi-click - (goto-char start-point) - (unless moved-off-start - (pop-mark))) - - (when (and (functionp fun) - (= start-hscroll (window-hscroll start-window)) - ;; Don't run the up-event handler if the window - ;; start changed in a redisplay after the - ;; mouse-set-point for the down-mouse event at - ;; the beginning of this function. When the - ;; window start has changed, the up-mouse event - ;; contains a different position due to the new - ;; window contents, and point is set again. - (or end-point - (= (window-start start-window) - start-window-start))) - (push event unread-command-events))))))) + (pop-mark))))) (defun mouse--drag-set-mark-and-point (start click click-count) (let* ((range (mouse-start-end start click click-count)) @@ -1904,14 +1871,10 @@ choose a font." ;;; Bindings for mouse commands. -(define-key global-map [down-mouse-1] 'mouse-drag-region) +(global-set-key [down-mouse-1] 'mouse-drag-region) (global-set-key [mouse-1] 'mouse-set-point) (global-set-key [drag-mouse-1] 'mouse-set-region) -;; These are tested for in mouse-drag-region. -(global-set-key [double-mouse-1] 'mouse-set-point) -(global-set-key [triple-mouse-1] 'mouse-set-point) - (defun mouse--strip-first-event (_prompt) (substring (this-single-command-raw-keys) 1)) diff --git a/lisp/reveal.el b/lisp/reveal.el index f251c05f5eb..8d611ea04df 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -83,7 +83,8 @@ Each element has the form (WINDOW . OVERLAY).") (cond ((eq (car x) (selected-window)) (cdr x)) ((not (and (window-live-p (car x)) - (eq (window-buffer (car x)) (current-buffer)))) + (eq (window-buffer (car x)) + (current-buffer)))) ;; Adopt this since it's owned by a window that's ;; either not live or at least not showing this ;; buffer any more. @@ -135,8 +136,9 @@ Each element has the form (WINDOW . OVERLAY).") old-ols) (defun reveal-close-old-overlays (old-ols) - (if (not (eq reveal-last-tick - (setq reveal-last-tick (buffer-modified-tick)))) + (if (or track-mouse ;Don't close in the middle of a click. + (not (eq reveal-last-tick + (setq reveal-last-tick (buffer-modified-tick))))) ;; The buffer was modified since last command: let's refrain from ;; closing any overlay because it tends to behave poorly when ;; inserting text at the end of an overlay (basically the overlay diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index fc515974036..54fd1a44d5b 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -42,13 +42,12 @@ (defvar xterm-mouse-debug-buffer nil) -(defvar xterm-mouse-last) - ;; Mouse events symbols must have an 'event-kind property with ;; the value 'mouse-click. -(dolist (event-type '(mouse-1 mouse-2 mouse-3 - M-down-mouse-1 M-down-mouse-2 M-down-mouse-3)) - (put event-type 'event-kind 'mouse-click)) +(dolist (event '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)) + (let ((M-event (intern (concat "M-" (symbol-name event))))) + (put event 'event-kind 'mouse-click) + (put M-event 'event-kind 'mouse-click))) (defun xterm-mouse-translate (_event) "Read a click and release event from XTerm." @@ -65,59 +64,47 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (save-excursion (save-window-excursion ;FIXME: Why? (deactivate-mark) ;FIXME: Why? - (let* ((xterm-mouse-last nil) - (down (xterm-mouse-event extension)) - (down-command (nth 0 down)) - (down-data (nth 1 down)) - (down-where (nth 1 down-data)) - (down-binding (key-binding (if (symbolp down-where) - (vector down-where down-command) - (vector down-command)))) - (is-down (string-match "down" (symbol-name (car down))))) - - ;; Retrieve the expected preface for the up-event. - (unless is-down - (unless (cond ((null extension) - (and (eq (read-event) ?\e) - (eq (read-event) ?\[) - (eq (read-event) ?M))) - ((eq extension 1006) - (and (eq (read-event) ?\e) - (eq (read-event) ?\[) - (eq (read-event) ?<)))) - (error "Unexpected escape sequence from XTerm"))) - - ;; Process the up-event. - (let* ((click (if is-down (xterm-mouse-event extension) down)) - (click-data (nth 1 click)) - (click-where (nth 1 click-data))) + (let* ((event (xterm-mouse-event extension)) + (ev-command (nth 0 event)) + (ev-data (nth 1 event)) + (ev-where (nth 1 ev-data)) + (vec (if (and (symbolp ev-where) (consp ev-where)) + ;; FIXME: This condition can *never* be non-nil!?! + (vector (list ev-where ev-data) event) + (vector event))) + (is-down (string-match "down-" (symbol-name ev-command)))) + (cond - ((null down) nil) - ((memq down-binding '(nil ignore)) - (if (and (symbolp click-where) - (consp click-where)) - (vector (list click-where click-data) click) - (vector click))) + ((null event) nil) ;Unknown/bogus byte sequence! + (is-down + (setf (terminal-parameter nil 'xterm-mouse-last-down) event) + vec) + (t + (let* ((down (terminal-parameter nil 'xterm-mouse-last-down)) + (down-data (nth 1 down)) + (down-where (nth 1 down-data))) + (setf (terminal-parameter nil 'xterm-mouse-last-down) nil) + (cond + ((null down) + ;; This is an "up-only" event. Pretend there was an up-event + ;; right before and keep the up-event for later. + (push event unread-command-events) + (vector (cons (intern (replace-regexp-in-string + "\\`\\([ACMHSs]-\\)*" "\\&down-" + (symbol-name ev-command) t)) + (cdr event)))) + ((equal ev-where down-where) vec) (t - (setq unread-command-events - (append (if (eq down-where click-where) - (list click) - (list - ;; Cheat `mouse-drag-region' with move event. - (list 'mouse-movement click-data) - ;; Generate a drag event. - (if (symbolp down-where) - 0 - (list (intern (format "drag-mouse-%d" - (1+ xterm-mouse-last))) - down-data click-data)))) - unread-command-events)) - (if xterm-mouse-debug-buffer - (print unread-command-events xterm-mouse-debug-buffer)) - (if (and (symbolp down-where) - (consp down-where)) - (vector (list down-where down-data) down) - (vector down))))))))) + (let ((drag (if (symbolp ev-where) + 0 ;FIXME: Why?!? + (list (replace-regexp-in-string + "\\`\\([ACMHSs]-\\)*" "\\&drag-" + (symbol-name ev-command) t) + down-data ev-data)))) + (if (null track-mouse) + (vector drag) + (push drag unread-command-events) + (vector (list 'mouse-movement ev-data))))))))))))) ;; These two variables have been converted to terminal parameters. ;; @@ -165,16 +152,14 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (cond ((>= code 64) (format "mouse-%d" (- code 60))) ((memq code '(8 9 10)) - (setq xterm-mouse-last (- code 8)) (format "M-down-mouse-%d" (- code 7))) - ((and (= code 11) xterm-mouse-last) - (format "M-mouse-%d" (1+ xterm-mouse-last))) - ((and (= code 3) xterm-mouse-last) - ;; For buttons > 5 xterm only reports a button-release event. - ;; Drop them since they're not usable and can be spurious. - (format "mouse-%d" (1+ xterm-mouse-last))) + ((memq code '(3 11)) + (let ((down (car (terminal-parameter + nil 'xterm-mouse-last-down)))) + (when (and down (string-match "[0-9]" (symbol-name down))) + (format (if (eq code 3) "mouse-%s" "M-mouse-%s") + (match-string 0 (symbol-name down)))))) ((memq code '(0 1 2)) - (setq xterm-mouse-last code) (format "down-mouse-%d" (+ 1 code)))))) (x (- (read-event) 33)) (y (- (read-event) 33))) @@ -212,10 +197,20 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (if down "down-" "") (if wheel (- code 60) - (1+ (setq xterm-mouse-last (mod code 4))))))) + (1+ (mod code 4)))))) (1- (string-to-number (apply 'string (nreverse x-bytes)))) (1- (string-to-number (apply 'string (nreverse y-bytes))))))) +(defun xterm-mouse--set-click-count (event click-count) + (setcdr (cdr event) (list click-count)) + (let ((name (symbol-name (car event)))) + (when (string-match "\\(.*?\\)\\(\\(?:down-\\)?mouse-.*\\)" name) + (setcar event + (intern (concat (match-string 1 name) + (if (= click-count 2) + "double-" "triple-") + (match-string 2 name))))))) + (defun xterm-mouse-event (&optional extension) "Convert XTerm mouse event to Emacs mouse event. EXTENSION, if non-nil, means to use an extension to the usual @@ -241,18 +236,42 @@ which is the \"1006\" extension implemented in Xterm >= 277." (w (window-at x y)) (ltrb (window-edges w)) (left (nth 0 ltrb)) - (top (nth 1 ltrb))) - (set-terminal-parameter nil 'xterm-mouse-x x) - (set-terminal-parameter nil 'xterm-mouse-y y) - (setq - last-input-event - (list type - (let ((event (if w + (top (nth 1 ltrb)) + (posn (if w (posn-at-x-y (- x left) (- y top) w t) (append (list nil 'menu-bar) - (nthcdr 2 (posn-at-x-y x y)))))) - (setcar (nthcdr 3 event) timestamp) - event))))))) + (nthcdr 2 (posn-at-x-y x y))))) + (event (list type posn))) + (setcar (nthcdr 3 posn) timestamp) + + ;; Try to handle double/triple clicks. + (let* ((last-click (terminal-parameter nil 'xterm-mouse-last-click)) + (last-type (nth 0 last-click)) + (last-name (symbol-name last-type)) + (last-time (nth 1 last-click)) + (click-count (nth 2 last-click)) + (this-time (float-time)) + (name (symbol-name type))) + (cond + ((not (string-match "down-" name)) + ;; For up events, make the up side match the down side. + (setq this-time last-time) + (when (and (> click-count 1) + (string-match "down-" last-name) + (equal name (replace-match "" t t last-name))) + (xterm-mouse--set-click-count event click-count))) + ((not last-time) nil) + ((and (> double-click-time (* 1000 (- this-time last-time))) + (equal last-name (replace-match "" t t name))) + (setq click-count (1+ click-count)) + (xterm-mouse--set-click-count event click-count)) + (t (setq click-count 1))) + (set-terminal-parameter nil 'xterm-mouse-last-click + (list type this-time click-count))) + + (set-terminal-parameter nil 'xterm-mouse-x x) + (set-terminal-parameter nil 'xterm-mouse-y y) + (setq last-input-event event))))) ;;;###autoload (define-minor-mode xterm-mouse-mode