;; Don't count the mode line.
(1- (nth 3 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).
+ ;; Save original automatic scrolling behavior (see below).
(auto-hscroll-mode-saved auto-hscroll-mode)
- (old-track-mouse track-mouse))
-
- (setq mouse-selection-click-count click-count)
- ;; In case the down click is in the middle of some intangible text,
- ;; use the end of that text, and put it in START-POINT.
- (if (< (point) start-point)
- (goto-char start-point))
- (setq start-point (point))
+ (scroll-margin-saved scroll-margin)
+ (old-track-mouse track-mouse)
+ (cleanup (lambda ()
+ (setq track-mouse old-track-mouse)
+ (setq auto-hscroll-mode auto-hscroll-mode-saved)
+ (setq scroll-margin scroll-margin-saved))))
+ (condition-case err
+ (progn
+ (setq mouse-selection-click-count click-count)
+
+ ;; Suppress automatic scrolling near the edges while tracking
+ ;; movement, as it interferes with the natural dragging behavior
+ ;; (point will unexpectedly be moved beneath the pointer, making
+ ;; selections in auto-scrolling margins impossible).
+ (setq auto-hscroll-mode nil)
+ (setq scroll-margin 0)
+
+ ;; In case the down click is in the middle of some intangible text,
+ ;; use the end of that text, and put it in START-POINT.
+ (if (< (point) start-point)
+ (goto-char start-point))
+ (setq start-point (point))
+
+ ;; Activate the region, using `mouse-start-end' to determine where
+ ;; to put point and mark (e.g., double-click will select a word).
+ (setq-local transient-mark-mode
+ (if (eq transient-mark-mode 'lambda)
+ '(only)
+ (cons 'only transient-mark-mode)))
+ (let ((range (mouse-start-end start-point start-point click-count)))
+ (push-mark (nth 0 range) t t)
+ (goto-char (nth 1 range)))
+
+ (setf (terminal-parameter nil 'mouse-drag-start) start-event)
- (setq track-mouse t)
++ ;; Set 'track-mouse' to something neither nil nor t, so that mouse
++ ;; events are not reported to have happened on the tool bar or the
++ ;; tab bar, as that breaks drag events that originate on the window
++ ;; body below these bars; see make_lispy_position and bug#51794.
++ (setq track-mouse 'drag-tracking)
- ;; Activate the region, using `mouse-start-end' to determine where
- ;; to put point and mark (e.g., double-click will select a word).
- (setq-local transient-mark-mode
- (if (eq transient-mark-mode 'lambda)
- '(only)
- (cons 'only transient-mark-mode)))
- (let ((range (mouse-start-end start-point start-point click-count)))
- (push-mark (nth 0 range) t t)
- (goto-char (nth 1 range)))
-
- (setf (terminal-parameter nil 'mouse-drag-start) start-event)
- ;; Set 'track-mouse' to something neither nil nor t, so that mouse
- ;; events are not reported to have happened on the tool bar or the
- ;; tab bar, as that breaks drag events that originate on the window
- ;; body below these bars; see make_lispy_position and bug#51794.
- (setq track-mouse 'drag-tracking)
- (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)
- ;; As soon as the user moves, we can re-enable auto-hscroll.
- (setq auto-hscroll-mode auto-hscroll-mode-saved)
- ;; And remember that we have moved, so mouse-set-region can know
- ;; its event is really a drag event.
- (setcar start-event 'mouse-movement))
- (if (and (eq (posn-window end) start-window)
- (integer-or-marker-p end-point))
- (mouse--drag-set-mark-and-point start-point
- end-point click-count)
- (let ((mouse-row (cdr (cdr (mouse-position)))))
- (cond
- ((null mouse-row))
- ((< mouse-row top)
- (mouse-scroll-subr start-window (- mouse-row top)
- nil start-point))
- ((>= mouse-row bottom)
- (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
- nil start-point))))))))
- map)
- t (lambda ()
- (setq track-mouse old-track-mouse)
- (setq auto-hscroll-mode auto-hscroll-mode-saved)
- ;; Don't deactivate the mark when the context menu was invoked
- ;; by down-mouse-3 immediately after down-mouse-1 and without
- ;; releasing the mouse button with mouse-1. This allows to use
- ;; region-related context menu to operate on the selected region.
- (unless (and context-menu-mode
- (eq (car-safe (aref (this-command-keys-vector) 0))
- 'down-mouse-3))
- (deactivate-mark)
- (pop-mark))))))
+ (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)
+ ;; And remember that we have moved, so mouse-set-region can know
+ ;; its event is really a drag event.
+ (setcar start-event 'mouse-movement))
+ (if (and (eq (posn-window end) start-window)
+ (integer-or-marker-p end-point))
+ (mouse--drag-set-mark-and-point start-point
+ end-point click-count)
+ (let ((mouse-row (cdr (cdr (mouse-position)))))
+ (cond
+ ((null mouse-row))
+ ((< mouse-row top)
+ (mouse-scroll-subr start-window (- mouse-row top)
+ nil start-point))
+ ((>= mouse-row bottom)
+ (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
+ nil start-point))))))))
+ map)
+ t (lambda ()
+ (funcall cleanup)
+ ;; Don't deactivate the mark when the context menu was invoked
+ ;; by down-mouse-3 immediately after down-mouse-1 and without
+ ;; releasing the mouse button with mouse-1. This allows to use
+ ;; region-related context menu to operate on the selected region.
+ (unless (and context-menu-mode
+ (eq (car-safe (aref (this-command-keys-vector) 0))
+ 'down-mouse-3))
+ (deactivate-mark)
+ (pop-mark)))))
+ ;; Cleanup on errors
+ (error (funcall cleanup)
+ (signal (car err) (cdr err))))))
(defun mouse--drag-set-mark-and-point (start click click-count)
(let* ((range (mouse-start-end start click click-count))
projects / emacs.git / commitdiff