(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.
2014-05-11 Stefan Monnier <monnier@iro.umontreal.ca>
+ * 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.
(interactive "e")
(mouse-drag-line start-event 'vertical))
\f
-(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)
(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.
(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
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)
"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)
(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))
(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,
(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
((>= 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))
\f
;;; 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))
(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.
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
(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."
(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.
;;
(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)))
(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
(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
projects / emacs.git / commitdiff