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* ((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)))
         ;; Save original automatic scrolling behavior (see below).
	 (auto-hscroll-mode-saved auto-hscroll-mode)
	 (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)
          ;; 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)

          (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))))))
                 (ignore-preserving-kill-region)))
             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 enables 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))))))