Function: mouse-drag-track

mouse-drag-track is a byte-compiled function defined in mouse.el.gz.

Signature

(mouse-drag-track START-EVENT)

Documentation

Track mouse drags by highlighting area between point and cursor.

The region will be defined with mark and point.

Source Code

;; Defined in /usr/src/emacs/lisp/mouse.el.gz
(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."
  (mouse-minibuffer-check start-event)
  (setq mouse-selection-click-count-buffer (current-buffer))
  (deactivate-mark)
  (let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541).
	 (start-posn (event-start start-event))
	 (start-point (posn-point start-posn))
	 (start-window (posn-window start-posn))
	 (_ (with-current-buffer (window-buffer start-window)
	      (setq deactivate-mark nil)))
         ;; We've recorded what we needed from the current buffer and
         ;; window, now let's jump to the place of the event, where things
         ;; are happening.
         (_ (mouse-set-point start-event))
         (echo-keystrokes 0)
	 (bounds (window-edges start-window))
	 (make-cursor-line-fully-visible nil)
	 (top (nth 1 bounds))
	 (bottom (if (or (window-minibuffer-p start-window)
                         ;; Do not account for the mode line if there
                         ;; is no mode line, which is common for child
                         ;; frames.
                         (not mode-line-format))
		     (nth 3 bounds)
		   ;; 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).
	 (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))

    ;; 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))))))